diff --git a/collects/net/doc.txt b/collects/net/doc.txt
index c9be7a27b6..a49f403aa5 100644
--- a/collects/net/doc.txt
+++ b/collects/net/doc.txt
@@ -524,6 +524,7 @@ PROCEDURES -----------------------------------------------------------
                      [#:auth-user user-string-or-#f]
                      [#:auth-passwd pw-string-or-#f]
                      [#:tcp-connect proc]
+                     [#:tls-encode #f]
                      [port-no]) -> void
 
   The first argument is the IP address of the SMTP server. The
@@ -552,6 +553,17 @@ PROCEDURES -----------------------------------------------------------
   `ssl-connect' from `(lib "mzssl.ss" "openssl")' to connect to the
   server via SSL.
 
+  If the optional #:tls-encode keyword argument supplies a procedure
+  instead of #f, then the ESMTP STARTTLS protocol is used to request
+  SSL communication with the server. The procedure given as the
+  #:tls-encode argument should be like `ports->ssl-ports' from `(lib
+  "mzssl.ss" "openssl")'; it will be called as
+
+    (encode r w #:mode 'connect #:encrypt 'tls #:close-original? #t)
+
+  and it should return two values: an input port and an export port.
+  All further SMTP communication uses the returned ports.
+
   See the "head.ss" library for utilities that construct a message
   headers and validate mail address strings.
 
diff --git a/collects/net/smtp-unit.ss b/collects/net/smtp-unit.ss
index 553c75e534..4c07028692 100644
--- a/collects/net/smtp-unit.ss
+++ b/collects/net/smtp-unit.ss
@@ -1,5 +1,5 @@
 (module smtp-unit (lib "a-unit.ss")
-  (require (lib "kw.ss") "base64.ss" "smtp-sig.ss")
+  (require (lib "list.ss") (lib "kw.ss") "base64.ss" "smtp-sig.ss")
 
   (import)
   (export smtp^)
@@ -16,7 +16,7 @@
     (and (>= (string-length l) (string-length n))
          (string=? n (substring l 0 (string-length n)))))
 
-  (define (check-reply r v w)
+  (define (check-reply/accum r v w a)
     (flush-output w)
     (let ([l (read-line r (if debug-via-stdio? 'linefeed 'return-linefeed))])
       (log "server: ~a\n" l)
@@ -26,9 +26,24 @@
           (unless (starts-with? l n)
             (error 'check-reply "expected reply ~a; got: ~a" v l))
           (let ([n- (string-append n "-")])
-            (when (starts-with? l n-)
-              ;; Multi-line reply. Go again.
-              (check-reply r v w)))))))
+            (if (starts-with? l n-)
+                ;; Multi-line reply. Go again.
+                (check-reply/accum r v w (if a (cons (substring l 4) a) #f))
+                ;; We're finished, so add the last and reverse the result
+                (when a
+                  (reverse (cons (substring l 4) a)))))))))
+  
+  (define (check-reply/commands r v w . commands)
+    ;; drop the first response, which is just the flavor text -- we expect the rest to
+    ;; be a list of supported ESMTP commands.
+    (let ([cmdlist (rest (check-reply/accum r v w '()))])
+      (for-each (lambda (c1)
+                  (unless (findf (lambda (c2) (string=? c1 c2)) cmdlist)
+                    (error "expected advertisement of ESMTP command ~a" c1)))
+                commands)))
+  
+  (define (check-reply r v w)
+    (check-reply/accum r v w #f))
 
   (define (protect-line l)
     ;; If begins with a dot, add one more
@@ -52,7 +67,7 @@
                       f)))
 
   (define (smtp-send-message* r w sender recipients header message-lines
-                              auth-user auth-passwd)
+                              auth-user auth-passwd tls-encode)
     (with-handlers ([void (lambda (x)
                             (close-input-port r)
                             (close-output-port w)
@@ -60,6 +75,21 @@
       (check-reply r 220 w)
       (log "hello\n")
       (fprintf w "EHLO ~a\r\n" (smtp-sending-server))
+      (when tls-encode
+        (check-reply/commands r 250 w "STARTTLS")
+        (log "starttls\n")
+        (fprintf w "STARTTLS\r\n")
+        (check-reply r 220 w)
+        (let-values ([(ssl-r ssl-w)
+                      (tls-encode r w
+                                   #:mode 'connect
+                                   #:encrypt 'tls
+                                   #:close-original? #t)])
+          (set! r ssl-r)
+          (set! w ssl-w))
+        ;; According to RFC 3207 Sec 4.2, we must start anew with the EHLO.
+        (log "tls hello\n")
+        (fprintf w "EHLO ~a\r\n" (smtp-sending-server)))
       (check-reply r 250 w)
 
       (when auth-user
@@ -100,9 +130,19 @@
       (flush-output w)
       (check-reply r 250 w)
 
-      (log "quit\n")
-      (fprintf w "QUIT\r\n")
-      (check-reply r 221 w)
+      ;; Once a 250 has been received in response to the . at the end of
+      ;; the DATA block, the email has been sent successfully and out of our
+      ;; hands.  This function should thus indicate success at this point
+      ;; no matter what else happens.
+      ;;
+      ;; Some servers (like smtp.gmail.com) will just close the connection
+      ;; on a QUIT, so instead of causing any QUIT errors to look like the
+      ;; email failed, we'll just log them.
+      (with-handlers ([void (lambda (x)
+                              (log "error after send: ~a\n" (exn-message x)))])
+        (log "quit\n")
+        (fprintf w "QUIT\r\n")
+        (check-reply r 221 w))
 
       (close-output-port w)
       (close-input-port r)))
@@ -114,12 +154,13 @@
                        [auth-user #f]
                        [auth-passwd #f]
                        [tcp-connect tcp-connect]
+                       [tls-encode #f]
                        #:body
                        (#:optional [opt-port-no port-no]))
       (when (null? recipients)
         (error 'send-smtp-message "no receivers"))
       (let-values ([(r w) (if debug-via-stdio?
-                            (values (current-input-port) (current-output-port))
-                            (tcp-connect server opt-port-no))])
+                              (values (current-input-port) (current-output-port))
+                              (tcp-connect server opt-port-no))])
         (smtp-send-message* r w sender recipients header message-lines
-                            auth-user auth-passwd)))))
+                            auth-user auth-passwd tls-encode)))))