From 07eb3be4b6c34575d2c23b8f78a09f63cdf520c7 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Fri, 9 Dec 2016 09:59:27 -0700
Subject: [PATCH] net/imap: detect full set of special characters for encoding

Quote marks (at a minimum) should be triggered by any of the
characters in `atom-specials` from the IMAP RFC. The previous trigger
would not have worked for a password that includes parentheses, curly
braces, or an open quare bracket, for example.
---
 pkgs/net-lib/net/imap.rkt        |  7 ++++--
 pkgs/net-test/tests/net/imap.rkt | 43 ++++++++++++++++++++++++++++++++
 2 files changed, 48 insertions(+), 2 deletions(-)

diff --git a/pkgs/net-lib/net/imap.rkt b/pkgs/net-lib/net/imap.rkt
index db71fe6739..96588d171c 100644
--- a/pkgs/net-lib/net/imap.rkt
+++ b/pkgs/net-lib/net/imap.rkt
@@ -217,8 +217,11 @@
         [(box? cmd) (fprintf w "~a" (unbox cmd))]
         [(string? cmd) (loop (string->bytes/utf-8 cmd))]
         [(bytes? cmd)
-         (if (or (regexp-match #rx#"[ *\"\r\n]" cmd)
-                 (equal? cmd #""))
+         (if (or
+              ;; Check for anything in `atom-specials` from the IMAP RFC:
+              (regexp-match #px#"[] *%\"\r\n(){}\\\\[:cntrl:]]" cmd)
+              ;; The empty string is also a special case:
+              (equal? cmd #""))
            (if (regexp-match #rx#"[\"\r\n]" cmd)
              (begin
                ;; Have to send size, then continue if the
diff --git a/pkgs/net-test/tests/net/imap.rkt b/pkgs/net-test/tests/net/imap.rkt
index d9745535f0..657510fc9a 100644
--- a/pkgs/net-test/tests/net/imap.rkt
+++ b/pkgs/net-test/tests/net/imap.rkt
@@ -10,6 +10,49 @@
   (unless (equal? expect got)
     (error 'test "failed: ~s vs. ~s" expect got)))
 
+;; ----------------------------------------
+
+(define (try-connect username password expected-login)
+  
+  (define-values (ci so) (make-pipe))
+  (define-values (si co) (make-pipe))
+  
+  (define got-login #f)
+  
+  (define t
+    (thread (lambda ()
+              (let loop ()
+                (define l (read-line si))
+                (define m (regexp-match #rx"^([a-z0-9]*) ([A-Z]+)(.*)\r$" l))
+                (unless m (log-error "?? ~s" l))
+                (define (reply s)
+                  (fprintf so "~a ~a\r\n" (cadr m) s)
+                  (flush-output so))
+                (case (caddr m)
+                  [("NOOP") (reply "OK NOOP completed")]
+                  [("CAPABILITY") (reply "OK CAPABILITY completed")]
+                  [("LOGIN") 
+                   (set! got-login (cadddr m))
+                   (reply "OK LOGIN completed")]
+                  [("SELECT")
+                   (reply "OK SELECT completed")]
+                  [else
+                   (log-error "?? ~s" l)])
+                (loop)))))
+
+  (imap-connect* ci co username password "INBOX")
+  
+  (test expected-login 'login got-login))
+
+
+(try-connect "user" "password" " user password")
+(for ([special-char (in-string "](){}\\%")])
+  (try-connect "user"
+               (format "pass~aword" special-char)
+               (format " user \"pass~aword\"" special-char)))
+  
+;; ----------------------------------------
+
 (define imap-config-file
   (build-path (find-system-path 'home-dir) ".imap-test-config"))