(eval-when-compile (require 'cl))
(eval-when-compile (require 'static))
-(eval-when-compile
- (ignore-errors (require 'sasl)))
(eval-and-compile
(autoload 'open-ssl-stream "ssl")
(autoload 'utf7-encode "utf7")
(autoload 'utf7-decode "utf7")
(autoload 'format-spec "format-spec")
- (autoload 'format-spec-make "format-spec"))
+ (autoload 'format-spec-make "format-spec")
+ (autoload 'sasl-digest-md5-digest-response "sasl"))
;; User variables.
-(defvar imap-kerberos4-program '("imtest -m kerberos_v4 -u %l -p %p %s"
- "imtest -kp %s %p")
+(defgroup imap nil
+ "Low-level IMAP issues."
+ :group 'mail)
+
+(defcustom imap-kerberos4-program '("imtest -m kerberos_v4 -u %l -p %p %s"
+ "imtest -kp %s %p")
"List of strings containing commands for Kerberos 4 authentication.
%s is replaced with server hostname, %p with port to connect to, and
%l with the value of `imap-default-user'. The program should accept
-IMAP commands on stdin and return responses to stdout.")
+IMAP commands on stdin and return responses to stdout. Each entry in
+the list is tried until a successful connection is made."
+ :group 'imap
+ :type '(repeat string))
-(defvar imap-gssapi-program '("imtest -m gssapi -u %l -p %p %s")
+(defcustom imap-gssapi-program '("imtest -m gssapi -u %l -p %p %s")
"List of strings containing commands for GSSAPI (krb5) authentication.
%s is replaced with server hostname, %p with port to connect to, and
%l with the value of `imap-default-user'. The program should accept
-IMAP commands on stdin and return responses to stdout.")
-
-(defvar imap-ssl-program '("openssl s_client -ssl3 -connect %s:%p"
- "openssl s_client -ssl2 -connect %s:%p"
- "s_client -ssl3 -connect %s:%p"
- "s_client -ssl2 -connect %s:%p")
+IMAP commands on stdin and return responses to stdout. Each entry in
+the list is tried until a successful connection is made."
+ :group 'imap
+ :type '(repeat string))
+
+(defcustom imap-ssl-program '("openssl s_client -ssl3 -connect %s:%p"
+ "openssl s_client -ssl2 -connect %s:%p"
+ "s_client -ssl3 -connect %s:%p"
+ "s_client -ssl2 -connect %s:%p")
"A string, or list of strings, containing commands for SSL connections.
Within a string, %s is replaced with the server address and %p with
port number on server. The program should accept IMAP commands on
-stdin and return responses to stdout.")
+stdin and return responses to stdout. Each entry in the list is tried
+until a successful connection is made."
+ :group 'imap
+ :type '(choice string
+ (repeat string)))
+
+(defcustom imap-shell-program '("ssh %s imapd"
+ "rsh %s imapd"
+ "ssh %g ssh %s imapd"
+ "rsh %g rsh %s imapd")
+ "A list of strings, containing commands for IMAP connection.
+Within a string, %s is replaced with the server address, %p with port
+number on server, %g with `imap-shell-host', and %l with
+`imap-default-user'. The program should read IMAP commands from stdin
+and write IMAP response to stdout. Each entry in the list is tried
+until a successful connection is made."
+ :group 'imap
+ :type '(repeat string))
+
+(defvar imap-shell-host "gateway"
+ "Hostname of rlogin proxy.")
(defvar imap-default-user (user-login-name)
"Default username to use.")
(defvar imap-fetch-data-hook nil
"Hooks called after receiving each FETCH response.")
-(defvar imap-streams '(gssapi kerberos4 starttls ssl network)
+(defvar imap-streams '(gssapi kerberos4 starttls ssl network shell)
"Priority of streams to consider when opening connection to server.")
(defvar imap-stream-alist
(kerberos4 imap-kerberos4-stream-p imap-kerberos4-open)
(ssl imap-ssl-p imap-ssl-open)
(network imap-network-p imap-network-open)
+ (shell imap-shell-p imap-shell-open)
(starttls imap-starttls-p imap-starttls-open))
"Definition of network streams.
"Priority of authenticators to consider when authenticating to server.")
(defvar imap-authenticator-alist
- '((gssapi imap-gssapi-auth-p imap-gssapia-auth)
+ '((gssapi imap-gssapi-auth-p imap-gssapi-auth)
(kerberos4 imap-kerberos4-auth-p imap-kerberos4-auth)
(cram-md5 imap-cram-md5-p imap-cram-md5-auth)
(login imap-login-p imap-login-auth)
imap-failed-tags
imap-tag
imap-process
+ imap-calculate-literal-size-first
imap-mailbox-data))
;; Internal variables.
(defvar imap-port nil)
(defvar imap-username nil)
(defvar imap-password nil)
+(defvar imap-calculate-literal-size-first nil)
(defvar imap-state 'closed
"IMAP state.
Valid states are `closed', `initial', `nonauth', `auth', `selected'
The actually value is really the text on the continuation line.")
(defvar imap-log nil
- "Imap session trace.")
+ "Name of buffer for imap session trace.
+For example: (setq imap-log \"*imap-log*\")")
(defvar imap-debug nil ;"*imap-debug*"
- "Random debug spew.")
+ "Name of buffer for random debug spew.
+For example: (setq imap-debug \"*imap-debug*\")")
\f
;; Utility functions:
response)
(when process
(with-current-buffer buffer
- (setq imap-client-eol "\n")
+ (setq imap-client-eol "\n"
+ imap-calculate-literal-size-first t)
(while (and (memq (process-status process) '(open run))
(goto-char (point-min))
;; cyrus 1.6.x (13? < x <= 22) queries capabilities
(setq imap-client-eol "\n")
(while (and (memq (process-status process) '(open run))
(goto-char (point-min))
+ ;; cyrus 1.6.x (13? < x <= 22) queries capabilities
+ (or (while (looking-at "^C:")
+ (forward-line))
+ t)
;; cyrus 1.6 imtest print "S: " before server greeting
(or (not (looking-at "S: "))
(forward-char 3)
(when (memq (process-status process) '(open run))
process))))
+(defun imap-shell-p (buffer)
+ nil)
+
+(defun imap-shell-open (name buffer server port)
+ (let ((cmds imap-shell-program)
+ cmd done)
+ (while (and (not done) (setq cmd (pop cmds)))
+ (message "imap: Opening IMAP connection with `%s'..." cmd)
+ (setq imap-client-eol "\n")
+ (let* ((port (or port imap-default-port))
+ (process (as-binary-process
+ (start-process
+ name buffer shell-file-name shell-command-switch
+ (format-spec
+ cmd
+ (format-spec-make
+ ?s server
+ ?g imap-shell-host
+ ?p (number-to-string port)
+ ?l imap-default-user))))))
+ (when process
+ (while (and (memq (process-status process) '(open run))
+ (goto-char (point-min))
+ (not (imap-parse-greeting)))
+ (accept-process-output process 1)
+ (sit-for 1))
+ (erase-buffer)
+ (and imap-log
+ (with-current-buffer (get-buffer-create imap-log)
+ (buffer-disable-undo)
+ (goto-char (point-max))
+ (insert-buffer-substring buffer)))
+ (when (memq (process-status process) '(open run))
+ (setq done process)))))
+ (if done
+ (progn
+ (message "imap: Opening IMAP connection with `%s'...done" cmd)
+ done)
+ (message "imap: Failed opening IMAP connection")
+ nil)))
+
(defun imap-starttls-p (buffer)
(and (condition-case ()
(require 'starttls)
(if (imap-opened buffer)
(imap-close buffer))
(mapcar 'make-variable-buffer-local imap-local-variables)
+ (set-buffer-multibyte nil)
(buffer-disable-undo)
(setq imap-server (or server imap-server))
(setq imap-port (or port imap-port))
(setq imap-capability nil)))
(if (imap-opened buffer)
;; Choose authenticator
- (when (null imap-auth)
+ (when (and (null imap-auth) (not (eq imap-state 'auth)))
(let ((auths imap-authenticators))
(while (setq auth (pop auths))
(if (funcall (nth 1 (assq auth imap-authenticator-alist))
specified, the user will not be questioned and the username and/or
password is remembered in the buffer."
(with-current-buffer (or buffer (current-buffer))
- (when (eq imap-state 'nonauth)
+ (if (not (eq imap-state 'nonauth))
+ (or (eq imap-state 'auth)
+ (eq imap-state 'select)
+ (eq imap-state 'examine))
(make-variable-buffer-local 'imap-username)
(make-variable-buffer-local 'imap-password)
(if user (setq imap-username user))
(imap-utf7-decode
(imap-mailbox-select-1 (imap-utf7-encode mailbox) examine))))
+(defun imap-mailbox-examine-1 (mailbox &optional buffer)
+ (with-current-buffer (or buffer (current-buffer))
+ (imap-mailbox-select-1 mailbox 'exmine)))
+
(defun imap-mailbox-examine (mailbox &optional buffer)
"Examine MAILBOX on server in BUFFER."
(imap-mailbox-select mailbox 'exmine buffer))
(list list))
","))
+(defun imap-range-to-message-set (range)
+ (mapconcat
+ (lambda (item)
+ (if (consp item)
+ (format "%d:%d"
+ (car item) (cdr item))
+ (format "%d" item)))
+ (if (and (listp range) (not (listp (cdr range))))
+ (list range) ;; make (1 . 2) into ((1 . 2))
+ range)
+ ","))
+
(defun imap-fetch-asynch (uids props &optional nouidfetch buffer)
(with-current-buffer (or buffer (current-buffer))
(imap-send-command (format "%sFETCH %s %s" (if nouidfetch "" "UID ")
(let ((old-mailbox imap-current-mailbox)
(state imap-state)
(imap-message-data (make-vector 2 0)))
- (when (imap-mailbox-examine mailbox)
+ (when (imap-mailbox-examine-1 mailbox)
(prog1
(and (imap-fetch "*" "UID")
(list (imap-mailbox-get-1 'uidvalidity mailbox)
(let ((old-mailbox imap-current-mailbox)
(state imap-state)
(imap-message-data (make-vector 2 0)))
- (when (imap-mailbox-examine mailbox)
+ (when (imap-mailbox-examine-1 mailbox)
(prog1
(and (imap-fetch "*" "UID")
(list (imap-mailbox-get-1 'uidvalidity mailbox)
"Return number of lines in article by looking at the mime bodystructure BODY."
(if (listp body)
(if (stringp (car body))
- ;; upcase for bug in courier imap server
(cond ((and (string= (upcase (car body)) "TEXT")
(numberp (nth 7 body)))
(nth 7 body))
(cond ((stringp cmd)
(setq cmdstr (concat cmdstr cmd)))
((bufferp cmd)
- (setq cmdstr
- (concat cmdstr (format "{%d}" (with-current-buffer cmd
- (buffer-size)))))
+ (let ((eol imap-client-eol)
+ (calcfirst imap-calculate-literal-size-first)
+ size)
+ (with-current-buffer cmd
+ (if calcfirst
+ (setq size (buffer-size)))
+ (when (not (equal eol "\r\n"))
+ ;; XXX modifies buffer!
+ (goto-char (point-min))
+ (while (search-forward "\r\n" nil t)
+ (replace-match eol)))
+ (if (not calcfirst)
+ (setq size (buffer-size))))
+ (setq cmdstr
+ (concat cmdstr (format "{%d}" size))))
(unwind-protect
(progn
(imap-send-command-1 cmdstr)
(stream imap-stream)
(eol imap-client-eol))
(with-current-buffer cmd
- (when (not (equal eol "\r\n"))
- ;; XXX modifies buffer!
- (goto-char (point-min))
- (while (search-forward "\r\n" nil t)
- (replace-match eol)))
(and imap-log
(with-current-buffer (get-buffer-create
imap-log)
(imap-forward)
(while (setq str (imap-parse-string))
(push str strlist)
- (imap-forward))
+ ;; buggy stalker communigate pro 3.0 doesn't print SPC
+ ;; between body-fld-param's sometimes
+ (or (eq (char-after) ?\")
+ (imap-forward)))
(nreverse strlist)))
((imap-parse-nil)
nil)))
(let (subbody)
(while (and (eq (char-after) ?\()
(setq subbody (imap-parse-body)))
+ ;; buggy stalker communigate pro 3.0 insert a SPC between
+ ;; parts in multiparts
+ (when (and (eq (char-after) ?\ )
+ (eq (char-after (1+ (point))) ?\())
+ (imap-forward))
(push subbody body))
(imap-forward)
(push (imap-parse-string) body);; media-subtype
(push (imap-parse-envelope) body);; envelope
(imap-forward)
(push (imap-parse-body) body);; body
- (imap-forward)
- (push (imap-parse-number) body));; body-fld-lines
- ((setq lines (imap-parse-number));; body-type-text:
- (push lines body));; body-fld-lines
+ ;; buggy stalker communigate pro 3.0 doesn't print
+ ;; number of lines in message/rfc822 attachment
+ (if (eq (char-after) ?\))
+ (push 0 body)
+ (imap-forward)
+ (push (imap-parse-number) body))) ;; body-fld-lines
+ ((setq lines (imap-parse-number)) ;; body-type-text:
+ (push lines body)) ;; body-fld-lines
(t
- (backward-char)))));; no match...
+ (backward-char))))) ;; no match...
;; ...and then parse the third one here...
imap-current-mailbox-p
imap-mailbox-select-1
imap-mailbox-select
+ imap-mailbox-examine-1
imap-mailbox-examine
imap-mailbox-unselect
imap-mailbox-expunge
projects / elisp / gnus.git- / blobdiff