Revise `net/sendmail'.

* Move the `X-Mailer' header to the top, so that the interesting headers
  are all together at the bottom (the top gets littered by server
  headers anyway).

* Use `subprocess' directly (`process*' wasn't really doing anything
  more than that).

* Allow the sender to be `#f', leaving the header out.  This makes all
  sendmails that I've used use the username that is running the process.

* Just search for a sendmail program: don't barf on windows, so it can
  be used in case there is a sendmail.exe executable there.

* Remove `no-mail-recipients' to make it in-line with other racket code
  that doesn't raise super-specific exceptions.

* Use port counting instead of doing the counts manually, much simpler
  code.

collects/net/scribblings/sendmail.scrbl

@@ -14,7 +14,7 @@ corresponding SMTP specifications, except as noted otherwise.
 
 @section{Sendmail Functions}
 
-@defproc[(send-mail-message/port [from string?]
+@defproc[(send-mail-message/port [from (or/c string? false/c)]
                                  [subject string?]
                                  [to (listof string?)]
                                  [cc (listof string?)]
@@ -34,8 +34,10 @@ the message.  Clients are urged to use @racket[close-output-port] on
 the return value as soon as the necessary text has been written, so
 that the sendmail process can complete.
 
-The @racket[from] argument can be any value; of course, spoofing
+The @racket[from] argument can be any value; of course, spoofing should
-should be used with care.}
+be used with care.  If it is @racket[#f], no ``From:'' header is
+generated, which usually means that your sendmail program will fill in
+the right value based on the user.}
 
 @defproc[(send-mail-message [from string?]
                             [subject string?]
@@ -52,13 +54,6 @@ of strings, each providing a line of the message body.
 Lines that contain a single period do not need to be quoted.}
 
 
-@defstruct[(no-mail-recipients exn) ()]{
-
-Raised when no mail recipients were specified for
-@racket[send-mail-message/port].}
-
-
-
 @; ----------------------------------------
 
 @section{Sendmail Unit}

collects/net/sendmail-sig.rkt

@@ -2,4 +2,3 @@
 
 send-mail-message/port
 send-mail-message
-(struct no-mail-recipients ())

collects/net/sendmail.rkt

@@ -1,120 +1,74 @@
 #lang racket/base
 
-(require racket/system)
+(provide send-mail-message/port send-mail-message)
-
-(provide send-mail-message/port
-         send-mail-message
-         (struct-out no-mail-recipients))
-
-(define-struct (no-mail-recipients exn) ())
 
 (define sendmail-search-path
-  '("/usr/lib" "/usr/sbin"))
+  '("/usr/sbin" "/sbin" "/usr/local/sbin" "/usr/lib"))
 
 (define sendmail-program-file
-  (if (or (eq? (system-type) 'unix)
+  (let ([exe (case (system-type)
-          (eq? (system-type) 'macosx))
+               [(windows) "sendmail.exe"]
-    (let loop ([paths sendmail-search-path])
+               [else "sendmail"])])
-      (if (null? paths)
+    (or (for/or ([path (in-list sendmail-search-path)])
+          (define p (build-path path exe))
+          (and (file-exists? p)
+               (memq 'execute (file-or-directory-permissions p))
+               p))
         (raise (make-exn:fail:unsupported
-                "unable to find sendmail on this Unix variant"
+                (format "unable to find a sendmail executable in ~s"
-                (current-continuation-marks)))
+                        sendmail-search-path)
-        (let ([p (build-path (car paths) "sendmail")])
+                (current-continuation-marks))))))
-          (if (and (file-exists? p)
-                   (memq 'execute (file-or-directory-permissions p)))
-            p
-            (loop (cdr paths))))))
-    (raise (make-exn:fail:unsupported
-            "sendmail only available under Unix"
-            (current-continuation-marks)))))
 
-;; send-mail-message/port :
+;; Main implementation, returns a port
-;; string x string x list (string) x list (string) x list (string)
+(define (send-mail-core who sender subject TOs CCs BCCs headers)
-;;   [x list (string)] -> oport
+  (define all-recipients (append TOs CCs BCCs))
+  (when (null? all-recipients)
+    (error who "no mail recipients were specified"))
+  (define-values [p pout pin perr]
+    ;; use -i, so "." lines are not a problem
+    (apply subprocess #f #f #f sendmail-program-file "-i" all-recipients))
+  (close-input-port pout)
+  (close-input-port perr)
+  (port-count-lines! pin)
+  (fprintf pin "X-Mailer: Racket (racket-lang.org)\n")
+  (when sender (fprintf pin "From: ~a\n" sender))
+  (for ([header (in-list '("To" "CC"))]
+        [recipients (in-list (list TOs CCs))]
+        #:unless (null? recipients))
+    (fprintf pin "~a: ~a" header (car recipients))
+    (for ([recipient (in-list (cdr recipients))])
+      (define col (let-values ([(line col pos) (port-next-location pin)]) col))
+      (fprintf pin ",~a~a"
+               (if ((+ col 2 (string-length recipient)) . > . 78)
+                 "\n    " " ")
+               recipient))
+    (newline pin))
+  (fprintf pin "Subject: ~a\n" subject)
+  (for ([h (in-list headers)]) (fprintf pin "~a\n" h))
+  (newline pin)
+  pin)
+
+;; send-mail-message/port:
+;;  String String (Listof String) (Listof String) (Listof String) String ...
+;;  -> Output-Port
 
 ;; -- sender can be anything, though spoofing is not recommended.
-;; The recipients must all be pure email addresses.  Note that
+;; The recipients must all be valid email addresses, they're passed to
-;; everything is expected to follow RFC conventions.  If any other
+;; sendmail as arguments -- and seems that it handles various name+email
-;; headers are specified, they are expected to be completely
+;; formats correctly.  Note that everything is expected to follow RFC
-;; formatted already.  Clients are urged to use close-output-port on
+;; conventions.  If any other headers are specified, they are expected
-;; the port returned by this procedure as soon as the necessary text
+;; to be completely formatted already.  Clients are urged to use
-;; has been written, so that the sendmail process can complete.
+;; close-output-port on the port returned by this procedure as soon as
-
+;; the necessary text has been written, so that the sendmail process can
-(define (send-mail-message/port
+;; complete.
-         sender subject to-recipients cc-recipients bcc-recipients
+(define (send-mail-message/port sender subject TOs CCs BCCs . headers)
-         . other-headers)
+  (send-mail-core 'send-mail-message/port sender subject TOs CCs BCCs headers))
-  (when (and (null? to-recipients) (null? cc-recipients)
-             (null? bcc-recipients))
-    (raise (make-no-mail-recipients
-            "no mail recipients were specified"
-            (current-continuation-marks))))
-  (let ([return (apply process* sendmail-program-file "-i"
-                       (append to-recipients cc-recipients bcc-recipients))])
-    (let ([reader (car return)]
-          [writer (cadr return)]
-          [pid (caddr return)]
-          [error-reader (cadddr return)])
-      (close-input-port reader)
-      (close-input-port error-reader)
-      (fprintf writer "From: ~a\n" sender)
-      (letrec ([write-recipient-header
-                (lambda (header-string recipients)
-                  (let ([header-space
-                         (+ (string-length header-string) 2)])
-                    (fprintf writer "~a: " header-string)
-                    (let loop ([to recipients] [indent header-space])
-                      (if (null? to)
-                        (newline writer)
-                        (let ([first (car to)]
-                              [rest (cdr to)])
-                          (let ([len (string-length first)])
-                            (if (>= (+ len indent) 80)
-                              (begin
-                                (fprintf writer
-                                         (if (null? rest)
-                                           "\n    ~a"
-                                           "\n    ~a, ")
-                                         first)
-                                (loop (cdr to)
-                                      (+ len header-space 2)))
-                              (begin
-                                (fprintf writer
-                                         (if (null? rest)
-                                           "~a "
-                                           "~a, ")
-                                         first)
-                                (loop (cdr to)
-                                      (+ len indent 2))))))))))])
-        (write-recipient-header "To" to-recipients)
-        (unless (null? cc-recipients)
-          (write-recipient-header "CC" cc-recipients)))
-      (fprintf writer "Subject: ~a\n" subject)
-      (fprintf writer "X-Mailer: Racket (racket-lang.org)\n")
-      (for-each (lambda (s)
-                  (display s writer)
-                  (newline writer))
-                other-headers)
-      (newline writer)
-      writer)))
 
 ;; send-mail-message :
 ;; string x string x list (string) x list (string) x list (string) x
 ;;   list (string) [x list (string)] -> ()
-
+(define (send-mail-message sender subject TOs CCs BCCs text . headers)
-;; -- sender can be anything, though spoofing is not recommended.  The
+  (define pin
-;; recipients must all be pure email addresses.  The text is expected
+    (send-mail-core 'send-mail-message sender subject TOs CCs BCCs headers))
-;; to be pre-formatted.  Note that everything is expected to follow
+  (for ([t (in-list text)]) (fprintf pin "~a\n" t))
-;; RFC conventions.  If any other headers are specified, they are
+  (close-output-port pin))
-;; expected to be completely formatted already.
-
-(define (send-mail-message
-         sender subject to-recipients cc-recipients bcc-recipients text
-         . other-headers)
-  (let ([writer (apply send-mail-message/port sender subject
-                       to-recipients cc-recipients bcc-recipients
-                       other-headers)])
-    (for-each (lambda (s)
-                (display s writer)      ; We use -i, so "." is not a problem
-                (newline writer))
-              text)
-    (close-output-port writer)))