Rewrite IMAP URL parser to eliminate unused authentication component,

and to clarify the allowed partial forms.

diff --git a/v7/src/imail/imail-imap.scm b/v7/src/imail/imail-imap.scm
index b257ce3a8ecd617d9ecc20b761aab12d4af8afcb..96c07f6fedf6cc5a19046591878c0541b3b6cb15 100644 (file)
--- a/v7/src/imail/imail-imap.scm
+++ b/v7/src/imail/imail-imap.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-imap.scm,v 1.37 2000/05/15 19:20:50 cph Exp $
+;;; $Id: imail-imap.scm,v 1.38 2000/05/16 01:46:37 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -40,24 +40,28 @@
   (save-url (%make-imap-url user-id host port mailbox)))
 
 (define-url-protocol "imap" <imap-url>
-  (let ((//server/
-        (optional-parser
-         (sequence-parser (noise-parser (string-matcher "//"))
-                          imap:parse:server
-                          (noise-parser (string-matcher "/")))))
-       (mbox (optional-parser imap:parse:simple-message)))
-    (lambda (string)
-      (let ((end (string-length string)))
-       (let ((pv1 (//server/ string 0 end)))
-         (let ((pv2
-                (or (parse-substring mbox string (car pv1) end)
-                    (error:bad-range-argument string 'STRING->URL))))
-           (%make-imap-url (parser-token pv1 'USER-ID)
-                           (parser-token pv1 'HOST)
-                           (let ((port (parser-token pv1 'PORT)))
-                             (and port
-                                  (string->number port)))
-                           (parser-token pv2 'MAILBOX))))))))
+  (lambda (string)
+    (let ((pv
+          (or (parse-string imap:parse:imail-url string)
+              (error:bad-range-argument string 'STRING->URL))))
+      (%make-imap-url (parser-token pv 'USER-ID)
+                     (parser-token pv 'HOST)
+                     (let ((port (parser-token pv 'PORT)))
+                       (and port
+                            (string->number port)))
+                     (parser-token pv 'MAILBOX)))))
+
+(define imap:parse:imail-url
+  (let ((//server
+        (sequence-parser (noise-parser (string-matcher "//"))
+                         (imap:server-parser #f)))
+       (/mbox
+        (sequence-parser (noise-parser (string-matcher "/"))
+                         (optional-parser imap:parse:enc-mailbox))))
+    (alternatives-parser
+     (sequence-parser //server (optional-parser /mbox))
+     /mbox
+     imap:parse:enc-mailbox)))
 
 (define-method url-body ((url <imap-url>))
   (string-append

diff --git a/v7/src/imail/imail.pkg b/v7/src/imail/imail.pkg
index 63a065cb6f28228d8a8e1a7be3bfecb50373d874..f030780a3669a4c6f604a12ff0080be7764f2dc6 100644 (file)
--- a/v7/src/imail/imail.pkg
+++ b/v7/src/imail/imail.pkg
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail.pkg,v 1.30 2000/05/15 17:47:54 cph Exp $
+;;; $Id: imail.pkg,v 1.31 2000/05/16 01:46:30 cph Exp $
 ;;;
 ;;; Copyright (c) 2000 Massachusetts Institute of Technology
 ;;;
@@ -133,11 +133,11 @@
          imap:char-set:tag-char
          imap:char-set:text-char
          imap:match:tag
+         imap:parse:enc-mailbox
          imap:parse:section
-         imap:parse:server
-         imap:parse:simple-message
          imap:quoted-char?
          imap:quoted-special?
+         imap:server-parser
          imap:string-may-be-quoted?
          imap:write-literal-string-body
          imap:write-literal-string-header

diff --git a/v7/src/imail/imap-syntax.scm b/v7/src/imail/imap-syntax.scm
index 3d42ac800c0e9502676b8fd10e506523296308f6..f16d85ea4ab38cb4d3b86fab4367b28c8afc8a93 100644 (file)
--- a/v7/src/imail/imap-syntax.scm
+++ b/v7/src/imail/imap-syntax.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imap-syntax.scm,v 1.6 2000/04/28 16:14:42 cph Exp $
+;;; $Id: imap-syntax.scm,v 1.7 2000/05/16 01:46:42 cph Exp $
 ;;;
 ;;; Copyright (c) 2000 Massachusetts Institute of Technology
 ;;;
@@ -286,32 +286,37 @@
                   url:decode-substring
                   (simple-parser match-decoded keyword)))
 
-(define imap:parse:server
+(define (imap:server-parser allow-auth?)
   (sequence-parser
    (optional-parser
-    (let ((parse-user-id
-          (url:decoding-parser imap:match:achar+
-                               imap:match:astring
-                               'USER-ID))
-         (parse-auth
-          (sequence-parser
-           (noise-parser (ci-string-matcher ";auth="))
-           (alternatives-parser
-            (simple-parser (string-matcher "*") 'AUTH-TYPE)
-            (url:decoding-parser imap:match:achar+
-                                 imap:match:atom
-                                 'AUTH-TYPE)))))
-      (sequence-parser
-       (alternatives-parser
-       (sequence-parser parse-user-id
-                        (optional-parser parse-auth))
-       (sequence-parser (optional-parser parse-user-id)
-                        parse-auth))
-       (noise-parser (string-matcher "@")))))
+    (sequence-parser
+     (let ((parse-user-id
+           (url:decoding-parser imap:match:achar+
+                                imap:match:astring
+                                'USER-ID)))
+       (if allow-auth?
+          (let ((parse-auth
+                 (sequence-parser
+                  (noise-parser (ci-string-matcher ";auth="))
+                  (alternatives-parser
+                   (simple-parser (string-matcher "*") 'AUTH-TYPE)
+                   (url:decoding-parser imap:match:achar+
+                                        imap:match:atom
+                                        'AUTH-TYPE)))))
+            (alternatives-parser
+             (sequence-parser parse-user-id
+                              (optional-parser parse-auth))
+             (sequence-parser (optional-parser parse-user-id)
+                              parse-auth)))
+          parse-user-id))
+     (noise-parser (string-matcher "@"))))
    (simple-parser (rexp-matcher url:rexp:host) 'HOST)
    (optional-parser
     (noise-parser (string-matcher ":"))
     (simple-parser (rexp-matcher (rexp+ char-set:numeric)) 'PORT))))
+
+(define imap:parse:server
+  (imap:server-parser #t))
 \f
 (define imap:parse:mailboxlist
   (sequence-parser
@@ -354,12 +359,6 @@
                    (decoding-parser imap:match:bchar+
                                     url:decode-substring
                                     imap:parse:section))))
-
-(define imap:parse:simple-message
-  (sequence-parser imap:parse:enc-mailbox
-                  (optional-parser
-                   (noise-parser (ci-string-matcher "/;uid="))
-                   (simple-parser imap:match:nz-number 'UID))))
 \f
 ;;;; Mailbox-name encoding (modified UTF-7)