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"))