[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
nnimap 0.39 -> 0.80 patches
- To: nnimap@extundo.com
- Subject: nnimap 0.39 -> 0.80 patches
- From: Simon Josefsson <jas@pdc.kth.se>
- Date: 02 Dec 1998 06:38:36 +0100
- User-Agent: Gnus/5.070059 (Pterodactyl Gnus v0.59) XEmacs/21.0 (Poitou)
Index: nnimap/ChangeLog
diff -c nnimap/ChangeLog:1.118 nnimap/ChangeLog:1.120
*** nnimap/ChangeLog:1.118 Tue Dec 1 18:47:30 1998
--- nnimap/ChangeLog Tue Dec 1 21:34:02 1998
***************
*** 1,3 ****
--- 1,174 ----
+ 1998-12-02 06:31:48 Simon Josefsson <jas@pdc.kth.se>
+
+ * nnimap 0.80 released.
+
+ 1998-12-02 06:19:33 Simon Josefsson <jas@pdc.kth.se>
+
+ * imap.el (imap-namespace-get):
+ (imap-mailbox-unselect): Use new imap-capability.
+
+ 1998-12-02 06:10:20 Simon Josefsson <jas@pdc.kth.se>
+
+ * imap.el (imap-open-stream):
+ (imap-do-login):
+ (imap-default-name): Removed.
+ (imap-locals): Removed imap-open-stream, imap-do-login.
+
+ 1998-12-02 05:58:30 Simon Josefsson <jas@pdc.kth.se>
+
+ * nnimap.el (nnimap-request-accept-article): Use new imap api.
+ (gnus-group-nnimap-edit-acl): Use new imap api.
+
+ * nnimap.el (nnimap-server-opened): Use new imap api.
+ (nnimap-pattern-to-list-arguments): Quote cdr in LIST command.
+ (nnimap-close-server): Don't kill buffer, use new imap api.
+
+ * nnimap.el (nnimap-authenticate): Removed.
+ (nnimap-open-server): Use new imap api.
+
+ * nnimap.el (nnimap-auth-method): Obsolete.
+ (nnimap-stream):
+ (nnimap-authenticator): New server variables.
+
+ 1998-12-02 05:45:56 Simon Josefsson <jas@pdc.kth.se>
+
+ * imap.el (imap-capability-get): Checks identifier, renamed to
+ imap-capability.
+
+ 1998-12-02 05:35:11 Simon Josefsson <jas@pdc.kth.se>
+
+ * imap.el (imap-server-opened): Rewritten, renamed to imap-opened.
+ (imap-close-server): Rewritten, renamed to imap-close.
+ (imap-open-server): Rewritten, renamed to imap-open.
+
+ 1998-12-02 05:33:54 Simon Josefsson <jas@pdc.kth.se>
+
+ * imap.el (imap-open-ssl-stream):
+ (imap-authenticate-login):
+ (imap-authenticate-cram-md5):
+ (imap-authenticate):
+ (imap-authinfo-get):
+ (imap-open-stream):
+ (imap-open-network-stream):
+ (imap-open-imtest-stream): Removed.
+
+ 1998-12-02 05:31:37 Simon Josefsson <jas@pdc.kth.se>
+
+ * imap.el (imap-kerberos4s-p):
+ (imap-kerberos4-open):
+ (imap-ssl-p):
+ (imap-ssl-open-1):
+ (imap-ssl-open):
+ (imap-network-p):
+ (imap-network-open):
+ (imap-interactive-login):
+ (imap-kerberos4a-p):
+ (imap-kerberos4-auth):
+ (imap-cram-md5-p):
+ (imap-cram-md5-auth):
+ (imap-login-p):
+ (imap-login-auth):
+ (imap-anonymous-p):
+ (imap-anonymous-open):
+ (imap-open-1): New functions to support imap-open.
+
+ 1998-12-02 05:23:18 Simon Josefsson <jas@pdc.kth.se>
+
+ * imap.el (imap-buffer-list):
+ (imap-stream):
+ (imap-auth):
+ (imap-server):
+ (imap-port): New internal variables.
+ (imap-username):
+ (imap-password): External definition removed, new internal variables.
+
+ 1998-12-02 05:21:09 Simon Josefsson <jas@pdc.kth.se>
+
+ * imap.el (imap-default-port): Made variable a internal constant.
+ (imap-default-ssl-port):
+ (imap-default-stream):
+ (imap-coding-system-for-read):
+ (imap-coding-system-for-write):
+ (imap-local-variables): New constants.
+
+ 1998-12-02 05:18:42 Simon Josefsson <jas@pdc.kth.se>
+
+ * imap.el (imap-default-user):
+ (imap-streams):
+ (imap-stream-alist):
+ (imap-authenticators):
+ (imap-authenticator-alist): New variables.
+
+ 1998-12-02 05:11:20 Simon Josefsson <jas@pdc.kth.se>
+
+ * nnimap.el (nnimap-request-list):
+ (nnimap-request-list-mapper):
+ (nnimap-split-articles):
+ (nnimap-expunge-close-group):
+ (nnimap-possibly-change-group):
+ (nnimap-split-copy-delete-article):
+ (nnimap-request-set-mark):
+ (nnimap-request-expire-articles): Use new function names.
+
+ 1998-12-02 05:04:37 Simon Josefsson <jas@pdc.kth.se>
+
+ * imap.el (imap-mailbox-lsub):
+ (imap-mailbox-list): Use new function names.
+
+ 1998-12-02 05:02:09 Simon Josefsson <jas@pdc.kth.se>
+
+ * imap.el (imap-folder-map): Renamed to imap-mailbox-map.
+ (imap-folder-reset): Renamed to imap-mailbox-reset.
+ (imap-select-folder): Renamed to imap-mailbox-select.
+ (imap-unselect-folder): Renamed to imap-mailbox-unselect.
+ (imap-expunge-close-folder): Renamed to imap-mailbox-close.
+ (imap-folder-lsub): Renamed to imap-mailbox-lsub.
+ (imap-folder-list): Renamed to imap-mailbox-list.
+ (imap-folder-subscribe): Renamed to imap-mailbox-subscribe.
+ (imap-folder-unsubscribe): Renamed to imap-mailbox-unsubscribe.
+ (imap-store-flags-set): Renamed to imap-message-flags-set.
+ (imap-store-flags-del): Renamed to imap-message-flags-del.
+ (imap-store-flags-add): Renamed to imap-message-flags-add.
+
+ 1998-12-02 04:54:22 Simon Josefsson <jas@pdc.kth.se>
+
+ * imap.el (imap-open-ssl-stream):
+ (imap-authenticate-login):
+ (imap-authenticate-cram-md5):
+ (imap-authenticate):
+ (imap-capability-get):
+ (imap-namespace-get):
+ (imap-disable-multibyte):
+ (imap-folder-map):
+ (imap-folder-reset):
+ (imap-select-folder):
+ (imap-unselect-folder):
+ (imap-expunge-close-folder):
+ (imap-folder-lsub):
+ (imap-folder-list):
+ (imap-folder-subscribe):
+ (imap-folder-unsubscribe):
+ (imap-search):
+ (imap-store-flags-set):
+ (imap-store-flags-del):
+ (imap-store-flags-add):
+ (imap-message-reset):
+ (imap-cb-capability):
+ (imap-cb-acl):
+ (imap-cb-namespace): Functions under my copyright, moved.
+
+ 1998-12-02 04:49:28 Simon Josefsson <jas@pdc.kth.se>
+
+ * imap.el (imap-auth-method):
+ (imap-authinfo):
+ (imap-data-capability):
+ (imap-data-namespace):
+ (imap-cb-fetch-hook): Variables under my copyright, moved.
+
+ 1998-12-02 04:32:00 Simon Josefsson <jas@pdc.kth.se>
+
+ * imap.el: Comments separating new/old code.
+
1998-12-02 03:45:14 Simon Josefsson <jas@pdc.kth.se>
* nnimap 0.39 released.
Index: nnimap/imap.el
diff -c nnimap/imap.el:1.51 nnimap/imap.el:1.58
*** nnimap/imap.el:1.51 Tue Dec 1 18:27:42 1998
--- nnimap/imap.el Tue Dec 1 21:21:58 1998
***************
*** 54,131 ****
(unless (fboundp 'open-network-stream)
(require 'tcp)))
! ;;; External variables
! (defvar imap-default-port 143
! "*Default port number to be used for IMAP connections. This should
! probably be \"imap\", but a lot of machines lack the services entry.
! This can be overrided by the server definition imap-port, and is the
! prefered way of specifying this.")
! (defvar imap-convenient-group-prime 2999
! "*A convenient prime which will be used to set the size of the group hash.
! We have a lot of groups at CMU, so this should probably be adjusted down.")
! (defvar imap-convenient-folder-prime 997
! "*A convenient prime which will be used to set the size of the folder
! (message) hash.")
! (defvar imap-open-stream nil
! "*The name of a function to use for opening an imap stream. Defaults on
! nil to open a networked stream to the server.
! Examples; imap-open-imtest-stream, imap-open-ssl-stream.
! This can be overrided by the server definition imap-open-stram, and
! this is the prefered way of specifying this.")
! (defvar imap-auth-method nil
! "*The name of a function to use for loging on to the server. Defaults on
! nil to plain text logins using the LOGIN command.
! Examples; imap-authenticate-cram-md5.
! This can be overried by the server definition imap-auth-method, and
! this is the prefered way of specifying this.")
(defvar imap-eol "\r\n"
"*The string sent to end a command.")
- ;; remove?
- (defvar imap-default-name nil
- "*Your name, should you choose to accept it.")
-
(defvar imap-last-status nil
"*Status returned by last IMAP command")
(defvar imap-timeout 60
"*Timeout in seconds to wait for server response.")
- (defvar imap-username nil
- "Username for server. ")
-
- (defvar imap-password nil
- "Password for server.")
-
- (defvar imap-cb-fetch-hook nil
- "Hook called when receiving a FETCH response. Called with article NUM,
- FETCH and DATA response.")
-
;;; Internal variables
- (defvar imap-authinfo nil
- "Buffer local variable which contains (user . password) for server.")
-
(defvar imap-process nil
"The active process for the current IMAP buffer.")
- (defvar imap-data-capability nil
- "Current server's capability list")
-
- (defvar imap-data-namespace nil
- "Current server's namespace.")
-
(defvar imap-data-folder nil
"Obarray which contains group information.")
--- 54,172 ----
(unless (fboundp 'open-network-stream)
(require 'tcp)))
! ;;; New varibles (copyright jas):
! (defvar imap-auth-method nil
! "*The name of a function to use for loging on to the server. Defaults on
! nil to plain text logins using the LOGIN command.
! Examples; imap-authenticate-cram-md5.
! This can be overried by the server definition imap-auth-method, and
! this is the prefered way of specifying this.")
! (defvar imap-authinfo nil
! "Buffer local variable which contains (user . password) for server.")
! (defvar imap-data-capability nil
! "Current server's capability list")
! (defvar imap-data-namespace nil
! "Current server's namespace.")
! (defvar imap-cb-fetch-hook nil
! "Hook called when receiving a FETCH response. Called with article NUM,
! FETCH and DATA response.")
! (defvar imap-default-user (user-login-name)
! "Default username to use.")
! (defvar imap-streams '(kerberos4 ssl network)
! "Priority of streams to consider when opening connection to
! server.")
!
! (defvar imap-stream-alist
! '((kerberos4 imap-kerberos4s-p imap-kerberos4-open)
! (ssl imap-ssl-p imap-ssl-open)
! (network imap-network-p imap-network-open))
! "Definition of network streams.
!
! (NAME CHECK OPEN)
!
! 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 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))
! "Definition of authenticators.
!
! (NAME CHECK AUTHENTICATE)
!
! NAME names the authenticator. CHECK is a function returning non-nil if
! the server support the authenticator and AUTHENTICATE is a function
! for doing the actuall authentification.")
!
! ;; Internal constants. Change theese and die.
!
! (defconst imap-default-port 143)
! (defconst imap-default-ssl-port 993)
! (defconst imap-default-stream 'network)
! (defconst imap-coding-system-for-read 'binary)
! (defconst imap-coding-system-for-write 'binary)
! (defconst imap-local-variables '(imap-server
! imap-port
! imap-auth
! imap-stream
! imap-username
! imap-password))
!
! ;; Internal variables:
!
! (defvar imap-buffer-list nil
! "List of buffers the imap library has created, which are destroyed
! on call to `imap-done'.")
!
! (defvar imap-stream nil)
! (defvar imap-auth nil)
! (defvar imap-server nil)
! (defvar imap-port nil)
! (defvar imap-username nil)
! (defvar imap-password nil)
! ;;; Old varibles (see changelog for copyright status):
!
! ;;; External variables
!
! (defvar imap-convenient-group-prime 2999
! "*A convenient prime which will be used to set the size of the group hash.
! We have a lot of groups at CMU, so this should probably be adjusted down.")
!
! (defvar imap-convenient-folder-prime 997
! "*A convenient prime which will be used to set the size of the folder
! (message) hash.")
(defvar imap-eol "\r\n"
"*The string sent to end a command.")
(defvar imap-last-status nil
"*Status returned by last IMAP command")
(defvar imap-timeout 60
"*Timeout in seconds to wait for server response.")
;;; Internal variables
(defvar imap-process nil
"The active process for the current IMAP buffer.")
(defvar imap-data-folder nil
"Obarray which contains group information.")
***************
*** 153,164 ****
(defvar imap-connection-number 0
"Unique tag char per connection.")
- (defvar imap-do-login t
- "Wheter imap-authenticate should try to log in or not.
-
- This is normally only turned off by a `imap-open-stream' that does
- it's own authentication.")
-
(defvar imap-cb-function-alist '((OK . imap-cb-response)
(NO . imap-cb-response)
(BAD . imap-cb-response)
--- 194,199 ----
***************
*** 190,198 ****
imap-data-capability
imap-data-namespace
imap-data-folder
- imap-open-stream
imap-auth-method
- imap-do-login
imap-message-data
imap-default-name
imap-authinfo
--- 225,231 ----
***************
*** 211,221 ****
--- 244,671 ----
(defvar imap-last nil);"*imap-last*") ; last line we attempted to parse
(defvar imap-debug nil);"*imap-debug*") ; random debug spew
+ ;;; New functions (copyright jas):
+
+
+ ;; Server functions; stream stuff:
+
+ (defun imap-kerberos4s-p (buffer)
+ (imap-capability 'AUTH=KERBEROS_V4 buffer))
+
+ (defun imap-kerberos4-open (name buffer server port)
+ (setq port (or port imap-default-port))
+ (let* ((coding-system-for-read imap-coding-system-for-read)
+ (coding-system-for-write imap-coding-system-for-write)
+ (process (start-process name buffer "imtest" "-kp" server
+ (number-to-string port))))
+ (with-current-buffer (process-buffer process)
+ (setq imap-eol "\n") ;; xxx
+ (when process
+ (message "Opening Kerberized IMAP connection...")
+ ;; Result of authentication is a string: __Full privacy protection__
+ (while (and (memq (process-status process) '(open run))
+ (goto-char (point-max))
+ (not (or
+ ;; if everything is ok, this will match...
+ (re-search-backward "__\\(.*\\)__\n" nil t)
+ ;; ...errors will match this
+ (re-search-backward
+ "\\. \\([^OA][^KU][^T][^H].*\\)\r\n" nil t))))
+ (accept-process-output process 1)
+ (sit-for 1))
+ (let ((response (match-string 1)))
+ (message "Kerberized IMAP connection: %s" response)
+ (if (string-match "failed\\|NO\\|BAD" response)
+ (progn
+ (imap-send-command-wait "LOGOUT")
+ (delete-process process)
+ response)
+ (erase-buffer)
+ process))))))
+
+ (defun imap-ssl-p (buffer)
+ nil)
+
+ (defun imap-ssl-open-1 (name buffer server port extra-arg)
+ (setq port (or port imap-default-ssl-port))
+ (let* ((coding-system-for-read imap-coding-system-for-read)
+ (coding-system-for-write imap-coding-system-for-write)
+ (ssl-program-arguments (list extra-arg
+ "-connect"
+ (format "%s:%d" imap-server port)))
+ (proc (open-ssl-stream name buffer server port)))
+ (with-current-buffer buffer
+ (goto-char (point-min))
+ (while (and (memq (process-status proc) '(open run))
+ (goto-char (point-min))
+ (not (re-search-forward "^\r*\\* OK" nil t)))
+ (accept-process-output proc 1)
+ (goto-char (point-min)))
+ (beginning-of-line)
+ (delete-region (point-min) (point))
+ (when (memq (process-status proc) '(open run))
+ proc))))
+
+ (defun imap-ssl-open (name buffer server port)
+ (message "Opening SSL3 connection...")
+ (let ((ret (imap-ssl-open-1 name buffer server port "-ssl3")))
+ (if ret
+ ret
+ (message "Opening SSL2 connection...")
+ (imap-ssl-open-1 name buffer server port "-ssl2"))))
+
+ (defun imap-network-p (buffer)
+ t)
+
+ (defun imap-network-open (name buffer server port)
+ (setq port (or port imap-default-port))
+ (let ((coding-system-for-read imap-coding-system-for-read)
+ (coding-system-for-write imap-coding-system-for-write))
+ (condition-case ()
+ (open-network-stream name buffer server port)
+ (error nil)
+ (quit nil))))
+
+ ;; Server functions; authenticator stuff:
+
+ (defun imap-interactive-login (buffer loginfunc)
+ "Login to server in BUFFER. LOGINFUNC is passed a username and a
+ password, it should return t if it where sucessful authenticating
+ itself to the server, nil otherwise. Returns t if login was
+ successful, nil otherwise."
+ (with-current-buffer buffer
+ (make-variable-buffer-local 'imap-username)
+ (make-variable-buffer-local 'imap-password)
+ (let (user passwd ret)
+ (condition-case ()
+ (while (or (not user) (not passwd))
+ (setq user (or imap-username
+ (read-from-minibuffer
+ (concat "IMAP username for " imap-server ": ")
+ (or user imap-default-user))))
+ (setq passwd (or imap-password
+ (imap-read-passwd
+ (concat "IMAP password for " user "@"
+ imap-server ": "))))
+ (when (and user passwd)
+ (if (funcall loginfunc user passwd)
+ (progn
+ (setq ret t
+ imap-username user)
+ (if (and (not imap-password)
+ (y-or-n-p "Store password for this session? "))
+ (setq imap-password passwd)))
+ (message "Login failed...")
+ (setq passwd nil)
+ (sit-for 1))))
+ (quit (with-current-buffer buffer
+ (setq user nil
+ passwd nil))))
+ ret)))
+
+ (defun imap-kerberos4a-p (buffer)
+ (imap-capability 'AUTH=KERBEROS_V4 buffer))
+
+ (defun imap-kerberos4-auth (buffer)
+ (eq imap-stream 'kerberos4))
+
+ (defun imap-cram-md5-p (buffer)
+ (imap-capability 'AUTH=CRAM-MD5 buffer))
+
+ (defun imap-cram-md5-auth (buffer)
+ "Login to server using the AUTH CRAM-MD5 method."
+ (imap-interactive-login
+ buffer
+ (lambda (user passwd)
+ (imap-ok-p
+ (imap-send-command-wait
+ (list
+ "AUTHENTICATE CRAM-MD5"
+ (lambda (challenge)
+ (let* ((decoded (base64-decode challenge))
+ (hash (rfc2104-hash 'md5 64 16 passwd decoded))
+ (response (concat user " " hash))
+ (encoded (base64-encode response)))
+ encoded))))))))
+
+ (defun imap-login-p (buffer)
+ (not (imap-capability 'X-LOGIN-CMD-DISABLED buffer)))
+
+ (defun imap-login-auth (buffer)
+ "Login to server using the LOGIN command."
+ (imap-interactive-login buffer
+ (lambda (user passwd)
+ (imap-ok-p (imap-send-command-wait
+ (concat "LOGIN \"" user "\" \""
+ passwd "\""))))))
+
+ (defun imap-anonymous-p (buffer)
+ t)
+
+ (defun imap-anonymous-open (buffer)
+ (with-current-buffer buffer
+ (imap-ok-p (imap-send-command-wait
+ (concat "LOGIN anonymous \"" (concat (user-login-name) "@"
+ (system-name)) "\"")))))
+
+ ;; Server functions:
+
+ (defun imap-open-1 (buffer)
+ (with-current-buffer buffer
+ (setq imap-process (funcall (nth 2 (assq imap-stream imap-stream-alist))
+ "imap" buffer imap-server imap-port))
+ (when imap-process
+ (set-marker (process-mark imap-process) (point-min))
+ (set-process-filter imap-process 'imap-arrival-filter)
+ (setq imap-current-folder nil
+ imap-current-message nil)
+ ;; legacy:
+ (setq imap-tag-char (int-char (+ (char-int ?A)
+ (% imap-connection-number 26))))
+ (setq imap-connection-number (1+ imap-connection-number))
+ (setq imap-data-folder (make-vector imap-convenient-group-prime 0))
+ ;; end legacy
+ imap-process)))
+
(defsubst imap-disable-multibyte ()
"Enable multibyte in the current buffer."
(when (fboundp 'set-buffer-multibyte)
(set-buffer-multibyte nil)))
+ (defun imap-open (server &optional port stream auth buffer)
+ (setq buffer (or buffer (format " *imap* %s:%d" server port)))
+ (unless (get-buffer buffer)
+ (setq imap-buffer-list (cons buffer imap-buffer-list)))
+ (with-current-buffer (get-buffer-create buffer)
+ (let (stream-changed)
+ (if (imap-opened buffer)
+ (imap-close buffer)
+ (mapc 'make-variable-buffer-local imap-locals)
+ (mapc 'make-variable-buffer-local imap-local-variables)
+ (setq imap-server server)
+ (setq imap-port port)
+ (buffer-disable-undo)
+ (imap-disable-multibyte)) ;; we shouldn't do this
+ (if auth (setq imap-auth auth))
+ (if stream (setq imap-stream stream))
+ (when (or (null imap-stream) (null imap-auth))
+ ;; Determine network stream and/or auth mechanism to use
+ (if (not (let ((imap-stream (or imap-stream imap-default-stream)))
+ (imap-open-1 buffer)))
+ ;; clean up and exit
+ (when (memq buffer imap-buffer-list)
+ (kill-buffer buffer)
+ (setq imap-buffer-list (delq buffer imap-buffer-list)))
+ ;; Choose stream.
+ (when (null imap-stream)
+ (let ((streams imap-streams))
+ (while (setq stream (pop streams))
+ (if (funcall (nth 1 (assq stream imap-stream-alist)) buffer)
+ (setq stream-changed (not (eq imap-stream stream))
+ imap-stream stream
+ streams nil)))
+ (unless imap-stream
+ (error "Couldn't figure out a stream for server"))))
+ ;; Choose authenticator
+ (when (null imap-auth)
+ (let ((auths imap-authenticators))
+ (while (setq auth (pop auths))
+ (if (funcall (nth 1 (assq auth imap-authenticator-alist))
+ buffer)
+ (setq imap-auth auth
+ auths nil)))
+ (unless imap-auth
+ (error "Couldn't figure out authenticator for server"))))
+ (when stream-changed
+ (imap-close buffer)
+ (imap-open-1 buffer))))))
+ (if (imap-opened buffer)
+ buffer))
+
+ (defun imap-opened (&optional buffer)
+ (and (setq buffer (get-buffer (or buffer (current-buffer))))
+ (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (and imap-process
+ (memq (process-status imap-process) '(open run))))))
+
+ (defun imap-authenticate (buffer)
+ (with-current-buffer buffer
+ (funcall (nth 2 (assq imap-auth imap-authenticator-alist)) buffer)))
+
+ (defun imap-close (&optional buffer)
+ (with-current-buffer (or buffer (current-buffer))
+ (if (imap-opened)
+ (imap-send-command-wait "LOGOUT"))
+ (when (get-buffer-process buffer)
+ (message "Couldn't log out from server, reaping process...")
+ (sit-for 1)
+ (delete-process imap-process))
+ (setq imap-current-folder nil
+ imap-current-message nil
+ imap-process nil)
+ (erase-buffer)
+ t))
+
+ (defun imap-capability (&optional identifier buffer)
+ "Return a list of identifiers which the server support. If IDENTIFIER,
+ return non-nil if it's among the servers capabilities."
+ (with-current-buffer (or buffer (current-buffer))
+ (unless imap-data-capability
+ (unless (imap-ok-p (imap-send-command-wait "CAPABILITY"))
+ (setq imap-data-capability '(IMAP2))))
+ (if identifier
+ (memq identifier imap-data-capability)
+ imap-data-capability)))
+
+ (defun imap-namespace-get (&optional buffer)
+ "Return server's namespace."
+ (with-current-buffer (or buffer (current-buffer))
+ (unless imap-data-namespace
+ (when (imap-capability 'NAMESPACE)
+ (imap-send-command-wait "NAMESPACE")))
+ imap-data-namespace))
+
+
+ ;; Mailbox functions:
+
+ (defun imap-mailbox-map (func &optional buffer)
+ "Call (func FOLDER) for each folder in `imap-data-folder', returning
+ a sequence."
+ (with-current-buffer (or buffer (current-buffer))
+ (let (result)
+ (mapatoms
+ (lambda (s)
+ (push (funcall func (symbol-name s)) result))
+ imap-data-folder)
+ result)))
+
+ (defun imap-mailbox-reset (&optional buffer)
+ (with-current-buffer (or buffer (current-buffer))
+ (setq imap-data-folder (make-vector imap-convenient-group-prime 0))))
+
+ (defun imap-mailbox-select (folder &optional buffer examine)
+ (with-current-buffer (or buffer (current-buffer))
+ ;; xxx: check SELECT/EXAMINE status! This is BAD.
+ (unless (string= folder imap-current-folder)
+ (setq imap-current-folder folder)
+ (if (imap-ok-p (imap-send-command-wait
+ (concat (if examine "EXAMINE" "SELECT") " " folder)))
+ (setq imap-message-data (make-vector imap-convenient-folder-prime 0))
+ ;; Failed SELECT unselects the current group
+ (setq imap-current-folder nil
+ imap-message-data nil)))
+ imap-current-folder))
+
+ (defun imap-mailbox-unselect (&optional group buffer)
+ "Close current folder in BUFFER, without expunging articles."
+ (with-current-buffer (or buffer (current-buffer))
+ (when (or (and (imap-capability 'UNSELECT)
+ (imap-ok-p (imap-send-command-wait "UNSELECT")))
+ (and (imap-ok-p
+ (imap-send-command-wait (concat "EXAMINE "
+ (or group
+ imap-current-folder))))
+ (imap-ok-p (imap-send-command-wait "CLOSE"))))
+ (setq imap-current-folder nil
+ imap-message-data nil)
+ t)))
+
+ (defun imap-mailbox-close (&optional buffer)
+ "Expunge articles and close current folder in BUFFER."
+ (with-current-buffer (or buffer (current-buffer))
+ (when (imap-ok-p (imap-send-command-wait "CLOSE"))
+ (setq imap-current-folder nil
+ imap-message-data nil)
+ t)))
+
+ (defun imap-mailbox-lsub (&optional reference buffer)
+ "Return a list of strings of subscribed mailboxes on server in
+ BUFFER. REFERENCE is the implementation-specific string that has to be
+ passed to LSUB."
+ (with-current-buffer (or buffer (current-buffer))
+ (imap-mailbox-reset)
+ (when (imap-ok-p (imap-send-command-wait
+ (concat "LSUB \"" reference "\" \"*\"")))
+ (imap-mailbox-map 'identity))))
+
+ (defun imap-mailbox-list (&optional root have-delimiter reference buffer)
+ "List all mailboxes that starts with ROOT in BUFFER. If
+ HAVE-DELIMITER is non-nil, a hierarchy delimiter is not added to
+ ROOT. REFERENCE is the implementation-specific string that has to be
+ passed to LIST."
+ (with-current-buffer (or buffer (current-buffer))
+ (imap-mailbox-reset)
+ ;; Find hierarchy separator
+ (unless have-delimiter
+ (imap-send-command-wait (concat "LIST \"" reference "\" \"" root "\"")))
+ (when (imap-ok-p
+ (imap-send-command-wait
+ (concat "LIST \"" reference "\" \"" root
+ (when (and (not have-delimiter) root)
+ (imap-folder-get 'delimiter root))
+ "%\"")))
+ (imap-mailbox-map 'identity))))
+
+ (defun imap-mailbox-subscribe (mailbox &optional buffer)
+ "Send the SUBSCRIBE command on the mailbox to server in
+ BUFFER. Returns non-nil if successful."
+ (with-current-buffer (or buffer (current-buffer))
+ (imap-ok-p (imap-send-command-wait (concat "SUBSCRIBE " mailbox)))))
+
+ (defun imap-mailbox-unsubscribe (mailbox &optional buffer)
+ "Send the SUBSCRIBE command on the mailbox to server in
+ BUFFER. Returns non-nil if successful."
+ (with-current-buffer (or buffer (current-buffer))
+ (imap-ok-p (imap-send-command-wait (concat "UNSUBSCRIBE " mailbox)))))
+
+
+ ;; Message functions:
+
+ (defun imap-search (predicate &optional buffer)
+ (with-current-buffer (or buffer (current-buffer))
+ (imap-folder-set 'search nil)
+ (when (imap-ok-p (imap-send-command-wait (concat "UID SEARCH " predicate)))
+ (imap-folder-get 'search))))
+
+ (defun imap-message-flags-set (articles flags &optional buffer silent)
+ (when (and articles flags)
+ (with-current-buffer (or buffer (current-buffer))
+ (imap-ok-p (imap-send-command-wait
+ (concat "UID STORE " articles
+ " FLAGS" (if silent ".SILENT") " (" flags ")"))))))
+
+ (defun imap-message-flags-del (articles flags &optional buffer silent)
+ (when (and articles flags)
+ (with-current-buffer (or buffer (current-buffer))
+ (imap-ok-p (imap-send-command-wait
+ (concat "UID STORE " articles
+ " -FLAGS" (if silent ".SILENT") " (" flags ")"))))))
+
+ (defun imap-message-flags-add (articles flags &optional buffer silent)
+ (when (and articles flags)
+ (with-current-buffer (or buffer (current-buffer))
+ (imap-ok-p (imap-send-command-wait
+ (concat "UID STORE " articles
+ " +FLAGS" (if silent ".SILENT") " (" flags ")"))))))
+
+ (defun imap-message-reset (&optional buffer)
+ (with-current-buffer (or buffer (current-buffer))
+ (setq imap-message-data (make-vector imap-convenient-folder-prime 0))))
+
+ ;; Stuff:
+
+ (defun imap-cb-capability (code &rest capabilities)
+ (setq imap-data-capability capabilities))
+
+ (defun imap-cb-acl (code group &rest acls)
+ (imap-folder-set 'acl acls (symbol-name group)))
+
+ (defun imap-cb-namespace (code &rest namespace)
+ (setq imap-data-namespace namespace))
+
+ ;;; Old functions (see changelog for copyright status):
+
(when imap-debug ; (untrace-all)
(require 'trace)
(buffer-disable-undo (get-buffer-create imap-debug))
***************
*** 223,244 ****
(mapc (lambda (f) (trace-function-background f imap-debug))
'(imap-open-server
imap-close-server
! imap-server-opened
! imap-select-folder
! imap-unselect-folder
! imap-expunge-close-folder
imap-send-command
imap-send-command-wait
imap-send-commands-wait
; imap-ok-p
imap-wait-for-tag
! imap-capability-get
imap-namespace-get
imap-authinfo-get
imap-folder-set
imap-folder-get
imap-folder-plist
! imap-folder-reset
imap-dispatch
imap-authenticate
imap-authenticate-login
--- 673,693 ----
(mapc (lambda (f) (trace-function-background f imap-debug))
'(imap-open-server
imap-close-server
! imap-mailbox-select
! imap-mailbox-unselect
! imap-mailbox-expunge-close
imap-send-command
imap-send-command-wait
imap-send-commands-wait
; imap-ok-p
imap-wait-for-tag
! imap-capability
imap-namespace-get
imap-authinfo-get
imap-folder-set
imap-folder-get
imap-folder-plist
! imap-mailbox-reset
imap-dispatch
imap-authenticate
imap-authenticate-login
***************
*** 329,414 ****
;;; Interface functions
- (defun imap-server-opened (&optional buffer)
- (with-current-buffer (or buffer (current-buffer))
- (and imap-process
- (member (process-status imap-process) '(open run)))))
-
- (defun imap-close-server (&optional buffer autologout)
- "Logout if needed and close down the process. Clean out buffer.
- Ensure all `imap-locals' are local and reset them to their default
- values such that the buffer will be suitable for opening a new server."
- ;; What is this for???
- (setq buffer (get-buffer (or buffer (current-buffer))))
- (when buffer
- (with-current-buffer buffer
- (mapc 'make-variable-buffer-local imap-locals) ; just in case
- (when imap-process
- (and (member (process-status imap-process) '(open run))
- (imap-send-command-wait "LOGOUT"))
- (delete-process imap-process))
- (mapc (lambda (local) (set local (default-value local))) imap-locals)
- (erase-buffer)
- t)))
-
(defun imap-current-server (&optional buffer)
(with-current-buffer (or buffer (current-buffer))
imap-current-server))
- (defun imap-authenticate-login (server &optional buffer)
- "Login to server using the LOGIN command."
- (with-current-buffer (or buffer (current-buffer))
- (and (imap-authinfo-get server)
- (imap-ok-p (imap-send-command-wait
- (concat "LOGIN \"" (car imap-authinfo)
- "\" \"" (cdr imap-authinfo) "\""))))))
-
- (defun imap-authenticate-cram-md5 (server &optional buffer)
- "Login to server using the AUTH CRAM-MD5 method."
- (require 'rfc2104)
- (require 'md5)
- (with-current-buffer (or buffer (current-buffer))
- (and (imap-authinfo-get server)
- (memq 'AUTH=CRAM-MD5 (imap-capability-get))
- (imap-ok-p
- (imap-send-command-wait
- (list
- "AUTHENTICATE CRAM-MD5"
- (lambda (challenge)
- (let* ((decoded (base64-decode challenge))
- (hash (rfc2104-hash 'md5 64 16 (cdr imap-authinfo) decoded))
- (response (concat (car imap-authinfo) " " hash))
- (encoded (base64-encode response)))
- encoded))))))))
-
- (defun imap-authenticate (server &optional buffer)
- (if (not imap-do-login)
- t
- (with-current-buffer (or buffer (current-buffer))
- (if imap-auth-method
- (funcall imap-auth-method server buffer)
- (imap-authenticate-login server buffer)))))
-
- (defun imap-open-server (server &optional port buffer local-defs)
- (with-current-buffer (get-buffer-create (or buffer (current-buffer)))
- (buffer-disable-undo)
- (imap-disable-multibyte)
- (imap-close-server) ; makes vars local, sets them to their defaults, erases
- (mapc (lambda (ld) (set (car ld) (cdr ld))) local-defs)
- (when (setq imap-process
- (imap-open-stream "imap" (current-buffer)
- server (or port imap-default-port)))
- (set-marker (process-mark imap-process) (point-min))
- (set-process-filter imap-process 'imap-arrival-filter)
- (setq imap-current-server server)
- ;; Give each connection a more or less unique letter just so the log
- ;; is easy to read
- (setq imap-tag-char (int-char (+ (char-int ?A)
- (% imap-connection-number 26))))
- (setq imap-connection-number (1+ imap-connection-number))
- (setq imap-data-folder (make-vector imap-convenient-group-prime 0))
- (current-buffer))))
-
;; If there is a need for sending commands without a callback, then
;; have `imap-send-command-wait'ing commands pass
;; `imap-cb-tag-default' itself. Maybe `imap-wait-for-tag' should
--- 778,787 ----
***************
*** 508,633 ****
(setq imap-last-status nil)
t))
- (defun imap-search (predicate &optional buffer)
- (with-current-buffer (or buffer (current-buffer))
- (imap-folder-set 'search nil)
- (when (imap-ok-p (imap-send-command-wait (concat "UID SEARCH " predicate)))
- (imap-folder-get 'search))))
-
- (defun imap-store-flags-set (articles flags &optional buffer silent)
- (when (and articles flags)
- (with-current-buffer (or buffer (current-buffer))
- (imap-ok-p (imap-send-command-wait
- (concat "UID STORE " articles
- " FLAGS" (if silent ".SILENT") " (" flags ")"))))))
-
- (defun imap-store-flags-del (articles flags &optional buffer silent)
- (when (and articles flags)
- (with-current-buffer (or buffer (current-buffer))
- (imap-ok-p (imap-send-command-wait
- (concat "UID STORE " articles
- " -FLAGS" (if silent ".SILENT") " (" flags ")"))))))
-
- (defun imap-store-flags-add (articles flags &optional buffer silent)
- (when (and articles flags)
- (with-current-buffer (or buffer (current-buffer))
- (imap-ok-p (imap-send-command-wait
- (concat "UID STORE " articles
- " +FLAGS" (if silent ".SILENT") " (" flags ")"))))))
-
- (defun imap-select-folder (folder &optional buffer examine)
- (with-current-buffer (or buffer (current-buffer))
- ;; xxx: check SELECT/EXAMINE status! This is BAD.
- (unless (string= folder imap-current-folder)
- (setq imap-current-folder folder)
- (if (imap-ok-p (imap-send-command-wait
- (concat (if examine "EXAMINE" "SELECT") " " folder)))
- (setq imap-message-data (make-vector imap-convenient-folder-prime 0))
- ;; Failed SELECT unselects the current group
- (setq imap-current-folder nil
- imap-message-data nil)))
- imap-current-folder))
-
- (defun imap-unselect-folder (&optional group buffer)
- "Close current folder in BUFFER, without expunging articles."
- (with-current-buffer (or buffer (current-buffer))
- (when (or (and (memq 'UNSELECT (imap-capability-get))
- (imap-ok-p (imap-send-command-wait "UNSELECT")))
- (and (imap-ok-p
- (imap-send-command-wait (concat "EXAMINE "
- (or group
- imap-current-folder))))
- (imap-ok-p (imap-send-command-wait "CLOSE"))))
- (setq imap-current-folder nil
- imap-message-data nil)
- t)))
-
- (defun imap-expunge-close-folder (&optional buffer)
- "Expunge articles and close current folder in BUFFER."
- (with-current-buffer (or buffer (current-buffer))
- (when (imap-ok-p (imap-send-command-wait "CLOSE"))
- (setq imap-current-folder nil
- imap-message-data nil)
- t)))
-
- (defun imap-folder-lsub (&optional reference buffer)
- "Return a list of strings of subscribed mailboxes on server in
- BUFFER. REFERENCE is the implementation-specific string that has to be
- passed to LSUB."
- (with-current-buffer (or buffer (current-buffer))
- (imap-folder-reset)
- (when (imap-ok-p (imap-send-command-wait
- (concat "LSUB \"" reference "\" \"*\"")))
- (imap-folder-map 'identity))))
-
- (defun imap-folder-list (&optional root have-delimiter reference buffer)
- "List all mailboxes that starts with ROOT in BUFFER. If
- HAVE-DELIMITER is non-nil, a hierarchy delimiter is not added to
- ROOT. REFERENCE is the implementation-specific string that has to be
- passed to LIST."
- (with-current-buffer (or buffer (current-buffer))
- (imap-folder-reset)
- ;; Find hierarchy separator
- (unless have-delimiter
- (imap-send-command-wait (concat "LIST \"" reference "\" \"" root "\"")))
- (when (imap-ok-p
- (imap-send-command-wait
- (concat "LIST \"" reference "\" \"" root
- (when (and (not have-delimiter) root)
- (imap-folder-get 'delimiter root))
- "%\"")))
- (imap-folder-map 'identity))))
-
- (defun imap-folder-subscribe (mailbox &optional buffer)
- "Send the SUBSCRIBE command on the mailbox to server in
- BUFFER. Returns non-nil if successful."
- (with-current-buffer (or buffer (current-buffer))
- (imap-ok-p (imap-send-command-wait (concat "SUBSCRIBE " mailbox)))))
-
- (defun imap-folder-unsubscribe (mailbox &optional buffer)
- "Send the SUBSCRIBE command on the mailbox to server in
- BUFFER. Returns non-nil if successful."
- (with-current-buffer (or buffer (current-buffer))
- (imap-ok-p (imap-send-command-wait (concat "UNSUBSCRIBE " mailbox)))))
-
;;; Variable setters and getters
- (defun imap-capability-get (&optional buffer)
- "Return a list of identifiers which the server support."
- (with-current-buffer (or buffer (current-buffer))
- (unless imap-data-capability
- (unless (imap-send-command-wait "CAPABILITY")
- (setq imap-data-capability '(IMAP2))))
- imap-data-capability))
-
- (defun imap-namespace-get (&optional buffer)
- "Return server's namespace."
- (with-current-buffer (or buffer (current-buffer))
- (unless imap-data-namespace
- (when (memq 'NAMESPACE (imap-capability-get))
- (imap-send-command-wait "NAMESPACE")))
- imap-data-namespace))
-
(defun imap-folder-plist (&optional folder buffer)
"Set PROP to VALUE for FOLDER in BUFFER."
(with-current-buffer (or buffer (current-buffer))
--- 881,888 ----
***************
*** 648,668 ****
(get (intern (or folder
imap-current-folder) imap-data-folder) prop)))
- (defun imap-folder-map (func &optional buffer)
- "Call (func FOLDER) for each folder in `imap-data-folder', returning
- a sequence."
- (with-current-buffer (or buffer (current-buffer))
- (let (result)
- (mapatoms
- (lambda (s)
- (push (funcall func (symbol-name s)) result))
- imap-data-folder)
- result)))
-
- (defun imap-folder-reset (&optional buffer)
- (with-current-buffer (or buffer (current-buffer))
- (setq imap-data-folder (make-vector imap-convenient-group-prime 0))))
-
;;; Internal functions
(defun imap-read-passwd (prompt &rest args)
--- 903,908 ----
***************
*** 677,760 ****
(autoload 'ange-ftp-read-passwd "ange-ftp"))
'ange-ftp-read-passwd) prompt)))
- (defun imap-authinfo-get (server &optional buffer)
- "Get user authentication information. Uses imap-username and/or
- imap-password. Asks the user if necessery. If successful, sets
- imap-authinfo to (username . password)."
- (with-current-buffer (or buffer (current-buffer))
- (let (user passwd)
- (setq user (or imap-username
- (read-from-minibuffer (concat "IMAP Name for " server
- ": ")
- imap-default-name)))
- (setq passwd (or imap-password
- (imap-read-passwd (concat "IMAP Password for " user "@"
- server ": "))))
- (if (and user passwd)
- (progn
- (setq imap-authinfo (cons user passwd))
- t)
- (setq imap-authinfo nil)))))
-
- (defun imap-open-stream (name buffer host &optional port)
- (let ((coding-system-for-read 'binary)
- (coding-system-for-write 'binary))
- (if imap-open-stream
- (funcall imap-open-stream name buffer host port)
- (imap-open-network-stream name buffer host port))))
-
- (defun imap-open-network-stream (name buffer host &optional port)
- (open-network-stream name buffer host port))
-
- (defun imap-open-ssl-stream (name buffer host &optional port)
- (let ((ssl-program-arguments '("-connect" (concat host ":" service)))
- (proc (open-ssl-stream name buffer host port)))
- (save-excursion
- (set-buffer buffer)
- (goto-char (point-min))
- (while (not (re-search-forward "^\r*\* OK" nil t))
- (accept-process-output proc imap-timeout)
- (goto-char (point-min)))
- (beginning-of-line)
- (delete-region (point-min) (point))
- proc)))
-
- (defun imap-open-imtest-stream (name buffer host &optional port)
- (let ((process (start-process name (or buffer (current-buffer))
- "imtest" "-kp" host
- (number-to-string (or port
- imap-default-port)))))
- (with-current-buffer (process-buffer process)
- (setq imap-eol "\n")
- (setq imap-do-login nil) ;; don't login even if kerberos auth fails
- (when process
- (message "Opening Kerberized IMAP connection...")
- ;; Result of authentication is a string: __Full privacy protection__
- (while (and (member (process-status imap-process) '(open run))
- (not (or
- ;; if everything is ok, this will match...
- (re-search-backward "__\\(.*\\)__\n" nil t)
- ;; ...errors will match this
- (re-search-backward
- "\\. \\([^OA][^KU][^T][^H].*\\)\r\n" nil t))))
- (accept-process-output process 1)
- (sit-for 1)) ; Yes, this is an oo loop, allow for C-g
- (let ((response (match-string 1)))
- (erase-buffer)
- (message "Kerberized IMAP connection: %s" response)
- ;; If the __string__ contains "failed" authentication failed
- ;; (imtest will bug out if you try to login the usual way, so
- ;; close connection with an error)
- (when (string-match "failed\\|NO\\|BAD" response)
- (mapc 'make-variable-buffer-local imap-locals) ; just in case
- ;; XXX logout here (can't use send-command since we don't
- ;; have the server opened..)
- (delete-process imap-process)
- (mapc (lambda (local) (set local (default-value local))) imap-locals)
- (erase-buffer)
- (error "imtest: %s" response))))
- process)))
-
(defun imap-arrival-filter (proc string)
"Process filter for imap process. Stow the string, then call the routines
to try to handle any input. We need this because we're not guaranteed to
--- 917,922 ----
***************
*** 996,1005 ****
(with-current-buffer (or buffer (current-buffer))
(get (intern (imap-message-to-string id) imap-message-data) prop)))
- (defun imap-message-reset (&optional buffer)
- (with-current-buffer (or buffer (current-buffer))
- (setq imap-message-data (make-vector imap-convenient-folder-prime 0))))
-
; Fetches MUST include (UID) otherwise we can't store the results.
; NUM is always the logical message number not the UID. We ignore it.
(defun imap-cb-fetch (num fetch data)
--- 1158,1163 ----
***************
*** 1018,1032 ****
(defun imap-cb-search (search &rest found)
;; For some reason found doesn't have parens so we need the &rest
(imap-folder-set 'search found))
-
- (defun imap-cb-capability (code &rest capabilities)
- (setq imap-data-capability capabilities))
-
- (defun imap-cb-acl (code group &rest acls)
- (imap-folder-set 'acl acls (symbol-name group)))
-
- (defun imap-cb-namespace (code &rest namespace)
- (setq imap-data-namespace namespace))
(defun imap-cb-status (code folder statuses)
; (check-valid-plist statuses)
--- 1176,1181 ----
Index: nnimap/nnimap.el
diff -c nnimap/nnimap.el:1.93 nnimap/nnimap.el:1.96
*** nnimap/nnimap.el:1.93 Tue Dec 1 18:47:42 1998
--- nnimap/nnimap.el Tue Dec 1 21:19:21 1998
***************
*** 47,52 ****
--- 47,53 ----
;;; Todo (roughly in order of priority):
+ ;;; o What about Gnus's article editing, can we support it?
;;; o Move common IMAP commands to functions in imap.el.
;;; o Verify that we don't use IMAP4rev1 specific things (RFC2060 App B)
;;; o dont uid fetch 1,* in nnimap-retrive-groups (slow)
***************
*** 95,101 ****
(nnoo-declare nnimap) ; we derive from no one
! (defconst nnimap-version "nnimap 0.39")
;; Various server variables.
--- 96,102 ----
(nnoo-declare nnimap) ; we derive from no one
! (defconst nnimap-version "nnimap 0.80")
;; Various server variables.
***************
*** 203,222 ****
;; Authorization / Privacy variables
! ;; todo:
! ;; better 'smart that open a connection, check the capabilities and
! ;; set this variable to the "best" method. easy, but we should fallback
! ;; if it doesn't work.
! (defvoo nnimap-auth-method 'smart
"How nnimap authenticate itself to the server.
! The default, `smart', will try to use the \"best\" method the server
! can handle.
! Unfortunely, the `smart' option isn't all that clever and will not
! recognize KERBEROS_V4 or SSL so you should set this if you use them.
! Available options: smart, login, cram-md5, kerberos4 and ssl.")
(defcustom nnimap-authinfo-file "~/.authinfo"
"Authorization information for IMAP servers. In .netrc format."
--- 204,242 ----
;; Authorization / Privacy variables
! (defvoo nnimap-auth-method nil
! "Obsolete.")
!
! (defvoo nnimap-stream nil
! "How nnimap will connect to the server.
!
! The default, nil, will try to use the \"best\" method the server can
! handle.
!
! Change this if
!
! 1) you want to connect with SSL. The SSL integration with IMAP is
! brain-dead so you'll have to tell it specifically.
!
! 2) your server is more capable than your environment -- i.e. your
! server accept Kerberos login's but you haven't installed the
! `imtest' program or your machine isn't configured for Kerberos.
!
! Possible choices: kerberos4, ssl, network")
!
! (defvoo nnimap-authenticator nil
"How nnimap authenticate itself to the server.
! The default, nil, will try to use the \"best\" method the server can
! handle.
! There is only one reason for fiddling with this variable, and that is
! if your server is more capable than your environment -- i.e. you
! connect to a server that accept Kerberos login's but you haven't
! installed the `imtest' program or your machine isn't configured for
! Kerberos.
! Possible choices: kerberos4, cram-md5, login, anonymous.")
(defcustom nnimap-authinfo-file "~/.authinfo"
"Authorization information for IMAP servers. In .netrc format."
***************
*** 269,275 ****
nnimap-close-group
nnimap-close-server
nnimap-open-server
- nnimap-authenticate
nnimap-expunge-close-group
nnimap-date-days-ago
nnimap-time-substract
--- 289,294 ----
***************
*** 382,417 ****
uncompressed)
'headers))))
- (defun nnimap-authenticate (server &optional buffer)
- (with-current-buffer (or buffer (current-buffer))
- ;; Login
- (let (list alist ok)
- (and (fboundp 'gnus-parse-netrc)
- (setq list (gnus-parse-netrc nnimap-authinfo-file)
- alist (or (and (gnus-netrc-get (gnus-netrc-machine
- list server) "machine")
- (gnus-netrc-machine list server))
- (gnus-netrc-machine list nnimap-server-address))
- imap-username (gnus-netrc-get alist "login")
- imap-password (gnus-netrc-get alist "password")))
- (cond ((eq nnimap-auth-method 'smart)
- (and (memq 'AUTH=CRAM-MD5 (imap-capability-get))
- (setq imap-auth-method 'imap-authenticate-cram-md5)))
- ((eq nnimap-auth-method 'md5)
- (setq imap-auth-method 'imap-authenticate-cram-md5)))
- (setq ok (imap-authenticate server buffer))
- ;; only loop if 1) the server didn't validate us AND 2) the user
- ;; actually typed something
- (while (and (not ok)
- imap-username
- (not (not imap-password))) ;; no password in backtraces
- (message "Bad Password for %s, Try again." server)
- (sleep-for 2)
- (setq ok (imap-authenticate server buffer)))
- ok)))
-
- ;; todo:
- ;; only condition-case on imap-open-stream??
(deffoo nnimap-open-server (server &optional defs)
(or (and (nnimap-server-opened server)
(nnoo-change-server 'nnimap server defs)
--- 401,406 ----
***************
*** 424,478 ****
(unless (assq 'nnimap-server-buffer defs)
(push (list 'nnimap-server-buffer (concat " *nnimap* " server)) defs))
(nnoo-change-server 'nnimap server defs)
! (condition-case err
! ;; todo: do clever things here if nnimap-auth-method is 'smart
! (let ((imap-open-stream (cond ((eq nnimap-auth-method
! 'kerberos4)
! 'imap-open-imtest-stream)
! ((eq nnimap-auth-method
! 'ssl)
! 'imap-open-ssl-stream))))
! (when (imap-open-server nnimap-server-address
! nnimap-server-port
! nnimap-server-buffer
! nnimap-imap-defs)
! ;; we only support imap4.*
! (unless (or (memq 'IMAP4 (imap-capability-get
! nnimap-server-buffer))
! (memq 'IMAP4rev1 (imap-capability-get
! nnimap-server-buffer))
! (memq 'IMAP4REV1 (imap-capability-get
! nnimap-server-buffer)))
! (imap-close-server nnimap-server-buffer)
! (nnheader-report
! 'nnimap
! "Sorry, %s is not a IMAP4(rev1) server."
! nnimap-server-address)
! (sit-for 2)
! ;; Make sure we close the server
! (signal 'quit))
! ;; authenticate ourself
! (when (nnimap-authenticate server nnimap-server-buffer)
! (push (cons server nnimap-server-buffer)
! nnimap-server-buffer-alist))))
! ;; Assume error comes from host unknow so we are not connected yet
! (error (kill-buffer nnimap-server-buffer)
! (nnheader-report 'nnimap (cdr err)))
! (quit (let (imap-last-status)
! (imap-close-server nnimap-server-buffer)
! (unless (get-buffer nnimap-server-buffer)
! (kill-buffer nnimap-server-buffer))
! (nnheader-report 'nnimap (cdr err))))))))
(deffoo nnimap-close-server (&optional server)
! (let ((s-b (assoc
! (setq server (or server (nnoo-current-server 'nnimap)))
! nnimap-server-buffer-alist)))
(when s-b
(setq nnimap-server-buffer nil)
(setq nnimap-server-buffer-alist (delq s-b nnimap-server-buffer-alist))
! (imap-close-server (cdr s-b))
! (kill-buffer (cdr s-b)))
(nnoo-close-server 'nnimap server)))
(deffoo nnimap-request-close ()
--- 413,441 ----
(unless (assq 'nnimap-server-buffer defs)
(push (list 'nnimap-server-buffer (concat " *nnimap* " server)) defs))
(nnoo-change-server 'nnimap server defs)
! (if (not (imap-open nnimap-server-address nnimap-server-port
! nnimap-stream nnimap-authenticator
! nnimap-server-buffer))
! (nnheader-report 'nnimap "Could not connect to server %s" server)
! (unless (or (imap-capability 'IMAP4 nnimap-server-buffer)
! (imap-capability 'IMAP4rev1 nnimap-server-buffer)
! (imap-capability 'IMAP4REV1 nnimap-server-buffer))
! (imap-close nnimap-server-buffer)
! (nnheader-report 'nnimap "Server %s not IMAP4" server))
! (if (imap-authenticate nnimap-server-buffer)
! (push (cons server nnimap-server-buffer)
! nnimap-server-buffer-alist)
! (imap-close nnimap-server-buffer)
! (nnheader-report 'nnimap "Could not authenticate to %s"
! server))))))
(deffoo nnimap-close-server (&optional server)
! (let ((s-b (assoc (setq server (or server (nnoo-current-server 'nnimap)))
! nnimap-server-buffer-alist)))
(when s-b
(setq nnimap-server-buffer nil)
(setq nnimap-server-buffer-alist (delq s-b nnimap-server-buffer-alist))
! (imap-close (cdr s-b)))
(nnoo-close-server 'nnimap server)))
(deffoo nnimap-request-close ()
***************
*** 486,500 ****
nnimap-server-buffer-alist))))
(if (and (gnus-buffer-live-p buffer)
(gnus-buffer-live-p nntp-server-buffer))
! (let ((running (imap-server-opened buffer)))
;; clean up autologouts
(unless running
(nnimap-close-server server))
running))))
- ; (and (nnoo-server-opened 'nnimap server)
- ; (imap-server-opened nnimap-server-buffer)))
-
(deffoo nnimap-status-message (&optional server)
(let ((buffer (cdr (assoc
(setq server (or server (nnoo-current-server 'nnimap)))
--- 449,460 ----
nnimap-server-buffer-alist))))
(if (and (gnus-buffer-live-p buffer)
(gnus-buffer-live-p nntp-server-buffer))
! (let ((running (imap-opened buffer)))
;; clean up autologouts
(unless running
(nnimap-close-server server))
running))))
(deffoo nnimap-status-message (&optional server)
(let ((buffer (cdr (assoc
(setq server (or server (nnoo-current-server 'nnimap)))
***************
*** 616,622 ****
(gnus-message 7 "Generating active list for nnimap group %s" group)
(cond
((eq nnimap-group-list-speed 'slow)
! (when (imap-select-folder group)
(let ((exists (imap-folder-get 'EXISTS))
articles)
(if (eq 0 exists)
--- 576,582 ----
(gnus-message 7 "Generating active list for nnimap group %s" group)
(cond
((eq nnimap-group-list-speed 'slow)
! (when (imap-mailbox-select group)
(let ((exists (imap-folder-get 'EXISTS))
articles)
(if (eq 0 exists)
***************
*** 663,670 ****
(defun nnimap-pattern-to-list-arguments (pattern)
(mapcar (lambda (p) (if (consp p)
! p
! (cons "\"\"" p)))
(if (and (listp pattern)
(listp (cdr pattern)))
pattern
--- 623,631 ----
(defun nnimap-pattern-to-list-arguments (pattern)
(mapcar (lambda (p) (if (consp p)
! (cons (concat "\"" (car p) "\"")
! (concat "\"" (cdr p) "\""))
! (cons "\"\"" (concat "\"" p "\""))))
(if (and (listp pattern)
(listp (cdr pattern)))
pattern
***************
*** 684,690 ****
(car pattern) " "
(cdr pattern))))))
(let ((nnimap-group-list-speed 'fast))
! (imap-folder-map 'nnimap-request-list-mapper))
t)))
--- 645,651 ----
(car pattern) " "
(cdr pattern))))))
(let ((nnimap-group-list-speed 'fast))
! (imap-mailbox-map 'nnimap-request-list-mapper))
t)))
***************
*** 779,785 ****
(when (nnimap-ok-p (nnimap-send-command-wait
(format "UID COPY %d %s" article to-group)))
(setq nnimap-need-expunge t)
! (if (imap-store-flags-add (format "%d" article) "\\Seen \\Deleted")
(message "IMAP split moved %s:%s:%d to %s" server group
article to-group)
(error "IMAP flag store failed: you may have unread mail marked as read!"))))
--- 740,746 ----
(when (nnimap-ok-p (nnimap-send-command-wait
(format "UID COPY %d %s" article to-group)))
(setq nnimap-need-expunge t)
! (if (imap-message-flags-add (format "%d" article) "\\Seen \\Deleted")
(message "IMAP split moved %s:%s:%d to %s" server group
article to-group)
(error "IMAP flag store failed: you may have unread mail marked as read!"))))
***************
*** 845,851 ****
;; move to first matching box, if any
(nnimap-split-move-article article inbox
(car groups) server)))))))
! (when (imap-select-folder inbox) ;; just in case
;; todo: UID EXPUNGE (if available) to remove splitted articles
(nnimap-expunge-close-group)))
t))))
--- 806,812 ----
;; move to first matching box, if any
(nnimap-split-move-article article inbox
(car groups) server)))))))
! (when (imap-mailbox-select inbox) ;; just in case
;; todo: UID EXPUNGE (if available) to remove splitted articles
(nnimap-expunge-close-group)))
t))))
***************
*** 906,918 ****
(setq pred (cons 'tick pred)))
(when (and range pred)
(cond ((eq what 'del)
! (imap-store-flags-del (nnimap-range-to-string range)
(nnimap-mark-to-flag pred nil t)))
((eq what 'add)
! (imap-store-flags-add (nnimap-range-to-string range)
(nnimap-mark-to-flag pred nil t)))
((eq what 'set)
! (imap-store-flags-set (nnimap-range-to-string range)
(nnimap-mark-to-flag pred nil t)))))))
(gnus-message 7 "Setting marks in %s:%s...done"
(nnoo-current-server 'nnimap) group)))))
--- 867,879 ----
(setq pred (cons 'tick pred)))
(when (and range pred)
(cond ((eq what 'del)
! (imap-message-flags-del (nnimap-range-to-string range)
(nnimap-mark-to-flag pred nil t)))
((eq what 'add)
! (imap-message-flags-add (nnimap-range-to-string range)
(nnimap-mark-to-flag pred nil t)))
((eq what 'set)
! (imap-message-flags-set (nnimap-range-to-string range)
(nnimap-mark-to-flag pred nil t)))))))
(gnus-message 7 "Setting marks in %s:%s...done"
(nnoo-current-server 'nnimap) group)))))
***************
*** 953,959 ****
(with-current-buffer nnimap-server-buffer
(if force
;; add delete flag to article
! (when (imap-store-flags-add (nnimap-range-to-string artseq)
"\\Deleted")
(setq nnimap-need-expunge t)
(setq articles nil))
--- 914,920 ----
(with-current-buffer nnimap-server-buffer
(if force
;; add delete flag to article
! (when (imap-message-flags-add (nnimap-range-to-string artseq)
"\\Deleted")
(setq nnimap-need-expunge t)
(setq articles nil))
***************
*** 962,969 ****
nnmail-expiry-wait)))
(cond ((eq days 'immediate)
;; add delete flag to article
! (when (imap-store-flags-add (nnimap-range-to-string artseq)
! "\\Deleted")
(setq nnimap-need-expunge t)
(setq articles nil)))
((numberp days)
--- 923,930 ----
nnmail-expiry-wait)))
(cond ((eq days 'immediate)
;; add delete flag to article
! (when (imap-message-flags-add
! (nnimap-range-to-string artseq) "\\Deleted")
(setq nnimap-need-expunge t)
(setq articles nil)))
((numberp days)
***************
*** 978,984 ****
(nnimap-date-days-ago days))))
(let ((imap-cb-fetch-hook
'nnimap-request-expire-articles-progress))
! (when (and oldarts (imap-store-flags-add
(nnimap-range-to-string
(gnus-compress-sequence oldarts))
"\\Deleted"))
--- 939,945 ----
(nnimap-date-days-ago days))))
(let ((imap-cb-fetch-hook
'nnimap-request-expire-articles-progress))
! (when (and oldarts (imap-message-flags-add
(nnimap-range-to-string
(gnus-compress-sequence oldarts))
"\\Deleted"))
***************
*** 1008,1014 ****
(deffoo nnimap-request-accept-article (group &optional server last)
(when (nnimap-possibly-change-server server)
;; We assume article is appended as UIDNEXT if no UIDPLUS support.
! (when (or (memq 'UIDPLUS (imap-capability-get nnimap-server-buffer))
(nnimap-ok-p (nnimap-send-command-wait
(concat "STATUS " group " (UIDNEXT)")
nnimap-server-buffer)))
--- 969,975 ----
(deffoo nnimap-request-accept-article (group &optional server last)
(when (nnimap-possibly-change-server server)
;; We assume article is appended as UIDNEXT if no UIDPLUS support.
! (when (or (imap-capability 'UIDPLUS nnimap-server-buffer)
(nnimap-ok-p (nnimap-send-command-wait
(concat "STATUS " group " (UIDNEXT)")
nnimap-server-buffer)))
***************
*** 1022,1029 ****
(list (concat "APPEND " group " ")
(current-buffer))
nnimap-server-buffer))
! (let ((high (if (memq 'UIDPLUS (imap-capability-get
! nnimap-server-buffer))
(cdr (imap-folder-get 'appenduid nil
nnimap-server-buffer))
(imap-folder-get 'UIDNEXT group
--- 983,989 ----
(list (concat "APPEND " group " ")
(current-buffer))
nnimap-server-buffer))
! (let ((high (if (imap-capability 'UIDPLUS nnimap-server-buffer)
(cdr (imap-folder-get 'appenduid nil
nnimap-server-buffer))
(imap-folder-get 'UIDNEXT group
***************
*** 1171,1186 ****
(when nnimap-need-expunge
(setq nnimap-need-expunge nil)
(imap-send-command "EXPUNGE"))
! (imap-expunge-close-folder))
((eq nnimap-expunge-on-close 'never)
! (imap-unselect-folder))
((eq nnimap-expunge-on-close 'ask)
(when (imap-search "DELETED")
(if (gnus-y-or-n-p (format "Expunge articles in group `%s'? "
imap-current-folder))
(and (nnimap-ok-p (nnimap-send-command-wait "EXPUNGE"))
! (imap-expunge-close-folder))
! (imap-unselect-folder)))))))
(not imap-current-folder))
(defun nnimap-possibly-change-server (server)
--- 1131,1146 ----
(when nnimap-need-expunge
(setq nnimap-need-expunge nil)
(imap-send-command "EXPUNGE"))
! (imap-mailbox-close))
((eq nnimap-expunge-on-close 'never)
! (imap-mailbox-unselect))
((eq nnimap-expunge-on-close 'ask)
(when (imap-search "DELETED")
(if (gnus-y-or-n-p (format "Expunge articles in group `%s'? "
imap-current-folder))
(and (nnimap-ok-p (nnimap-send-command-wait "EXPUNGE"))
! (imap-mailbox-close))
! (imap-mailbox-unselect)))))))
(not imap-current-folder))
(defun nnimap-possibly-change-server (server)
***************
*** 1199,1205 ****
(if (and imap-current-folder
(not (string= group imap-current-folder)))
(nnimap-expunge-close-group))
! (when (imap-select-folder group nil
(gnus-ephemeral-group-p groupname))
;; check/set UIDVALIDITY
(let ((new-uid (imap-folder-get 'uidvalidity))
--- 1159,1165 ----
(if (and imap-current-folder
(not (string= group imap-current-folder)))
(nnimap-expunge-close-group))
! (when (imap-mailbox-select group nil
(gnus-ephemeral-group-p groupname))
;; check/set UIDVALIDITY
(let ((new-uid (imap-folder-get 'uidvalidity))
***************
*** 1215,1221 ****
new-uid)
(message "UIDVALIDITY clash. Old value `%s', new `%s'"
old-uid new-uid)
! (imap-unselect-folder))))))))
imap-current-folder)))
;;; Gnus functions
--- 1175,1181 ----
new-uid)
(message "UIDVALIDITY clash. Old value `%s', new `%s'"
old-uid new-uid)
! (imap-mailbox-unselect))))))))
imap-current-folder)))
;;; Gnus functions
***************
*** 1246,1252 ****
(unless (eq 'nnimap (car (setq method (gnus-find-method-for-group group))))
(error "ACL editing only available for nnimap groups"))
(when (nnimap-possibly-change-server (cadr method))
! (unless (memq 'ACL (imap-capability-get nnimap-server-buffer))
(error "Your server does not support ACL editing"))
(gnus-edit-form (with-current-buffer nnimap-server-buffer
(imap-folder-set 'acl nil mailbox)
--- 1206,1212 ----
(unless (eq 'nnimap (car (setq method (gnus-find-method-for-group group))))
(error "ACL editing only available for nnimap groups"))
(when (nnimap-possibly-change-server (cadr method))
! (unless (imap-capability 'ACL nnimap-server-buffer)
(error "Your server does not support ACL editing"))
(gnus-edit-form (with-current-buffer nnimap-server-buffer
(imap-folder-set 'acl nil mailbox)