(eval-when-compile (require 'cl))
(eval-when-compile (require 'static))
+(eval-when-compile
+ (ignore-errors (require 'digest-md5)))
(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")
+ (autoload 'digest-md5-digest-response "digest-md5")
(autoload 'rfc2104-hash "rfc2104")
(autoload 'utf7-encode "utf7")
(autoload 'utf7-decode "utf7")
(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.
(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.")
'((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)
server support the stream and OPEN is a function for opening the
stream.")
-(defvar imap-authenticators '(kerberos4 cram-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)
- (login imap-login-p imap-login-auth)
- (anonymous imap-anonymous-p imap-anonymous-auth))
+ '((kerberos4 imap-kerberos4a-p imap-kerberos4-auth)
+ (cram-md5 imap-cram-md5-p imap-cram-md5-auth)
+ (login imap-login-p imap-login-auth)
+ (anonymous imap-anonymous-p imap-anonymous-auth)
+ (digest-md5 imap-digest-md5-p imap-digest-md5-auth))
"Definition of authenticators.
(NAME CHECK AUTHENTICATE)
(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))
(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))))
(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)))
(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)
'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)
+ (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
+ (imap-send-command
+ (list
+ "AUTHENTICATE DIGEST-MD5"
+ (lambda (challenge)
+ (digest-md5-parse-digest-challenge
+ (base64-decode-string challenge))
+ (let* ((digest-uri
+ (digest-md5-digest-uri
+ "imap" (digest-md5-challenge 'realm)))
+ (response
+ (digest-md5-digest-response
+ user passwd digest-uri)))
+ (base64-encode-string response 'no-line-break))))
+ )))
+ (if (not (eq (imap-wait-for-tag tag) 'INCOMPLETE))
+ nil
+ (setq imap-continuation nil)
+ (imap-send-command-1 "")
+ (imap-ok-p (imap-wait-for-tag tag)))))))
+
(defun imap-login-p (buffer)
(not (imap-capability 'X-LOGIN-CMD-DISABLED buffer)))
projects / elisp / gnus.git- / blobdiff