(imap-ssl-open-2): If `system-type' is windows-nt, bind

[elisp/gnus.git-] / lisp / imap.el

diff --git a/lisp/imap.el b/lisp/imap.el
index 3544238..d9e3fb1 100644 (file)
--- a/lisp/imap.el
+++ b/lisp/imap.el
@@ -139,6 +139,8 @@
 
 (eval-and-compile
   (autoload 'open-ssl-stream "ssl")
+  (autoload 'base64-decode-string "base64")
+  (autoload 'base64-encode-string "base64")
   (autoload 'starttls-open-stream "starttls")
   (autoload 'starttls-negotiate "starttls")
   (autoload 'digest-md5-parse-digest-challenge "digest-md5")
@@ -149,25 +151,6 @@
   (autoload 'format-spec "format-spec")
   (autoload 'format-spec-make "format-spec"))
 
-(static-if (and (fboundp 'base64-decode-string)
-               (subrp (symbol-function 'base64-decode-string)))
-    (eval-and-compile (fset 'imap-base64-decode-string 'base64-decode-string))
-  (require 'mel)
-  (defun imap-base64-decode-string (string)
-    (fset 'imap-base64-decode-string
-         (symbol-function (mel-find-function 'mime-decode-string "base64")))
-    (imap-base64-decode-string string))
-  )
-
-(static-if (and (fboundp 'base64-encode-string)
-               (subrp (symbol-function 'base64-encode-string)))
-    (eval-and-compile (fset 'imap-base64-encode-string 'base64-encode-string))
-  (defun imap-base64-encode-string (string)
-    (fset 'imap-base64-encode-string
-         (symbol-function (mel-find-function 'mime-encode-string "base64")))
-    (imap-base64-encode-string string))
-  )
-
 (autoload 'md5 "md5")
 
 ;; User variables.
@@ -210,7 +193,7 @@ If `imap-ssl-program' is 'auto this variable has no effect.")
 (defvar imap-fetch-data-hook nil
   "Hooks called after receiving each FETCH response.")
 
-(defvar imap-streams '(kerberos4 ssl network)
+(defvar imap-streams '(kerberos4 starttls ssl network)
   "Priority of streams to consider when opening connection to
 server.")
 
@@ -218,7 +201,7 @@ server.")
   '((kerberos4 imap-kerberos4s-p imap-kerberos4-open)
     (ssl       imap-ssl-p        imap-ssl-open)
     (network   imap-network-p    imap-network-open)
-    (tls       imap-tls-p        imap-tls-open))
+    (starttls  imap-starttls-p   imap-starttls-open))
   "Definition of network streams.
 
 (NAME CHECK OPEN)
@@ -227,16 +210,16 @@ NAME names the stream, CHECK is a function returning non-nil if the
 server support the stream and OPEN is a function for opening the
 stream.")
 
-(defvar imap-authenticators '(kerberos4 cram-md5 digest-md5 login anonymous)
+(defvar imap-authenticators '(kerberos4 digest-md5 cram-md5 login anonymous)
   "Priority of authenticators to consider when authenticating to
 server.")
 
 (defvar imap-authenticator-alist 
   '((kerberos4   imap-kerberos4a-p imap-kerberos4-auth)
     (cram-md5    imap-cram-md5-p   imap-cram-md5-auth)
-    (digest-md5  imap-digest-md5-p imap-digest-md5-auth)
     (login       imap-login-p      imap-login-auth)
-    (anonymous   imap-anonymous-p  imap-anonymous-auth))
+    (anonymous   imap-anonymous-p  imap-anonymous-auth)
+    (digest-md5  imap-digest-md5-p imap-digest-md5-auth))
   "Definition of authenticators.
 
 (NAME CHECK AUTHENTICATE)
@@ -448,9 +431,15 @@ argument to `format'."
         (ssl-program-arguments (append imap-ssl-arguments extra-ssl-args
                                        (list "-connect" 
                                              (format "%s:%d" server port))))
-        (process (ignore-errors 
-                   (as-binary-process 
-                    (open-ssl-stream name buffer server port)))))
+        (process (ignore-errors
+                   (cond ((eq system-type 'windows-nt)
+                          (let (selective-display
+                                (coding-system-for-write 'binary)
+                                (coding-system-for-read 'raw-text-dos))
+                            (open-ssl-stream name buffer server port)))
+                         (t
+                          (as-binary-process 
+                           (open-ssl-stream name buffer server port)))))))
     (when process
       (with-current-buffer buffer
        (goto-char (point-min))
@@ -511,10 +500,13 @@ argument to `format'."
       (when (memq (process-status process) '(open run))
        process))))
 
-(defun imap-tls-p (buffer)
-  (imap-capability 'STARTTLS buffer))
+(defun imap-starttls-p (buffer)
+  (and (condition-case ()
+          (require 'starttls)
+        (error nil))
+       (imap-capability 'STARTTLS buffer)))
 
-(defun imap-tls-open (name buffer server port)
+(defun imap-starttls-open (name buffer server port)
   (let* ((port (or port imap-default-port))
         (process (as-binary-process
                   (starttls-open-stream name buffer server port))))
@@ -533,7 +525,7 @@ argument to `format'."
        (unwind-protect
            (progn
              (set-process-filter imap-process 'imap-arrival-filter)
-             (when (and (eq imap-stream 'tls)
+             (when (and (eq imap-stream 'starttls)
                         (imap-ok-p (imap-send-command-wait "STARTTLS")))
                (starttls-negotiate imap-process)))
          (set-process-filter imap-process nil)))
@@ -599,7 +591,7 @@ successful, nil otherwise."
        (list
        "AUTHENTICATE CRAM-MD5"
        (lambda (challenge)
-         (let* ((decoded (imap-base64-decode-string challenge))
+         (let* ((decoded (base64-decode-string challenge))
                 (hash-function (if (and (featurep 'xemacs)
                                         (>= (function-max-args 'md5) 4))
                                    (lambda (object &optional start end)
@@ -607,31 +599,34 @@ successful, nil otherwise."
                                  'md5))
                 (hash (rfc2104-hash hash-function 64 16 passwd decoded))
                 (response (concat user " " hash))
-                (encoded (imap-base64-encode-string response)))
+                (encoded (base64-encode-string response)))
            encoded))))))))
 
 (defun imap-digest-md5-p (buffer)
-  (imap-capability 'AUTH=DIGEST-MD5 buffer))
+  (and (condition-case ()
+          (require 'digest-md5)
+        (error nil))
+       (imap-capability 'AUTH=DIGEST-MD5 buffer)))
 
 (defun imap-digest-md5-auth (buffer)
   "Login to server using the AUTH DIGEST-MD5 method."
   (imap-interactive-login
    buffer
    (lambda (user passwd)
-     (let ((tag 
+     (let ((tag
            (imap-send-command
             (list
              "AUTHENTICATE DIGEST-MD5"
              (lambda (challenge)
                (digest-md5-parse-digest-challenge
-                (imap-base64-decode-string challenge))
+                (base64-decode-string challenge))
                (let* ((digest-uri
-                       (digest-md5-digest-uri 
+                       (digest-md5-digest-uri
                         "imap" (digest-md5-challenge 'realm)))
                       (response
-                       (digest-md5-digest-response 
+                       (digest-md5-digest-response
                         user passwd digest-uri)))
-                 (imap-base64-encode-string response 'no-line-break))))
+                 (base64-encode-string response 'no-line-break))))
             )))
        (if (not (eq (imap-wait-for-tag tag) 'INCOMPLETE))
           nil