[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
nnimap 0.3.23 released
Bugfixes and lots of new stuff.
This version should be =way= faster than the previous. The downside is
that Gnus's "guess" of how many unread articles there are in a group
are somewhat worse than in previous versions (in previous versions it
did go through alot of pain to get the count absolutely correct),
shouldn't be that much of a problem though. When you enter the group,
all flags will be updated and Gnus will guess better.
The authentication stuff is more tightly integrated in nnimap, and
there have been documentation added for this. CRAM-MD5 is now
officially supported.
There might be show-stopping bugs in this release, take it careful.
Note! If you use Cyrus IMAPD version < 1.5.10 you will have great
problems using this and coming releases (client flags didn't work
until 1.5.10). I'm not planning a workaround for this, upgrade your
server.
Get it from http://vic20.dzp.se/gnus-imap/nnimap.tar.gz.
/s
1998-08-20 00:29:53 Simon Josefsson <jas@pdc.kth.se>
* nnimap 0.3.23 released.
1998-08-20 00:27:17 Simon Josefsson <jas@pdc.kth.se>
* imap4rev1.el: Re-ordered compile-time require's.
1998-08-20 00:25:10 Simon Josefsson <jas@pdc.kth.se>
* nnimap.el (nnimap-group-mode-hook): Emacs 19.34 compatibility.
* nnimap.el (gnus-group-edit-nnimap-acl): Removed confused
comment, I think I'm less confused now.
* nnimap.el (nnimap-ok-p): Use imap-ok-p.
* nnimap.el (nnimap-request-accept-article): Use APPENDUID
(RFC2359), Don't return a cons if APPEND failed.
* nnimap.el (nnimap-request-update-info): Don't do anything unless
silly is set. Removed old code.
* nnimap.el (nnimap-request-list-mapper): Change gnus-message.
* nnimap.el (nnimap-request-group): Call nnimap-request-update-info.
* nnimap.el (nnimap-open-server): Set imap-open-stream, Don't kill
buffer if it doesn't exist.
* nnimap.el (nnimap-authenticate): Use imap-authenticate, Don't
oo-loop.
* nnimap.el (nnimap-read-passwd):
(nnimap-login): Functions removed.
* nnimap.el (nnimap-auth-method): Doc changes.
* nnimap.el: Doc changes, todo changes, added RFC support summary.
1998-08-19 23:35:29 Simon Josefsson <jas@pdc.kth.se>
* imap4rev1.el (imap-authenticate-cram-md5):
(imap-authenticate-login):
(imap-authenticate):
(imap-read-passwd):
(imap-authinfo-get):
(imap-ok-p): New functions.
* imap4rev1.el (imap-locals): Added imap-open-stream,
imap-auth-method, imap-authinfo. Removed imap-username,
imap-password.
* imap4rev1.el (imap-auth-method):
(imap-authinfo): New variables.
1998-08-19 23:29:36 Simon Josefsson <jas@pdc.kth.se>
* imap4rev1.el (imap-default-port):
(imap-open-stream):
(imap-do-login): Doc changes.
1998-08-19 14:26:03 Simon Josefsson <jas@pdc.kth.se>
* imap4rev1.el (imap-parse-line): Make COPYUID uid-validity into
strings.
1998-08-18 18:32:51 Simon Josefsson <jas@pdc.kth.se>
* nnimap.el (nnimap-request-group):
(nnimap-request-list-mapper): Work around for bug in Lotus CCmail.
1998-08-18 14:27:35 Simon Josefsson <jas@pdc.kth.se>
* nnimap.el (nnimap-login): Quote username and password.
1998-08-17 12:56:24 Simon Josefsson <jas@pdc.kth.se>
* nnimap.el (nnimap-send-command-wait): Handle functions.
1998-08-17 12:11:03 Simon Josefsson <jas@pdc.kth.se>
* hmac.el (hmac): Use append instead of char-list-to-string.
1998-08-17 01:41:26 Simon Josefsson <jas@pdc.kth.se>
* imap4rev1.el (imap-send-command): Funcall function.
1998-08-16 Jim Radford <radford@robby.caltech.edu>
* nnimap.el (nnimap-open-server): Added a stupid debug check for
when we get called with nnimap-server-buffer nil. This shouldn't
happen. It does. This is a bug. Find it.
* nnimap.el (nnimap-open-server): Support the changed
authentication interface. Make sure that we call `nnimap-login'
which protected by the condition-case so that we can recover
gracefully from a C-g used to skip a server. Clean up the
connection cleanly if this is not an IMAP4* server. Also use
nnheader-report to report errors instead of message or warn.
* nnimap.el (nnimap-authenticate): New function. Mostly just
parses the netrc and loops calling nnimap-login.
* nnimap.el (nnimap-login): Merge most if the MD5 and normal login
code. Do authentication based on the new extened interface to
imap-send-command. This should cut down on replicated code.
* imap4rev1.el (imap-send): removed.
* imap4rev1.el (imap-send-command): Add in logic to do the
authentication "+" magic. You now pass in a function, just like
you pass buffers, that caries out the authentication dialogue.
* imap4rev1.el (imap-wait-for-tag): Add the ability to stop
waiting when a certain tag is received before the one you actually
want arrives. This is so we don't have to time out if for some
reason "+" taged data doesn't arrive. This can happen when there
is an error in a command that expects "+" data (like an APPEND on
a non existent mailbox) or during authentication.
1998-08-16 20:10:10 Simon Josefsson <jas@pdc.kth.se>
* nnimap.el (nnimap-open-server): No condition-case any more,
give a valid error code.
1998-08-15 Jim Radford <radford@saladin.caltech.edu>
* nnimap.el (nnimap-close-group): Only mess with the flags if
there are any actually PERMANENTFLAGS.
* nnimap.el (nnimap-request-list): Clean up
and add support for nnimap-list-pattern of '().
1998-08-15 17:58:19 Simon Josefsson <jas@pdc.kth.se>
* nnimap.el (nnimap-request-list): really handle
nnimap-list-pattern of ("INBOX")
diff -u nnimap-0.3.22/hmac.el nnimap-0.3.23/hmac.el
--- nnimap-0.3.22/hmac.el Sat Aug 15 16:07:49 1998
+++ nnimap-0.3.23/hmac.el Thu Aug 20 00:34:50 1998
@@ -1,4 +1,4 @@
-;;; hmac.el --- Hashed Message Authentication Codes
+;;; hmac.el --- RFC2104 Hashed Message Authentication Codes
;;; Copyright (C) 1998 Simon Josefsson <jas@pdc.kth.se>
@@ -18,7 +18,9 @@
;;; Commentary:
-;;; This is a quick'n'dirty implementation of RFC2104.
+;;; This library is part of nnimap, http://vic20.dzp.se/gnus-imap/.
+
+;;; This is a quick'n'dirty, low performance, implementation of RFC2104.
;;;
;;; Example:
;;;
@@ -29,43 +31,34 @@
;;; 64 is block length of hash function (64 for MD5 and SHA), 16 is
;;; resulting hash length (16 for MD5, 20 for SHA).
;;;
-;;; Tested with FSF Emacs 20.2 and XEmacs 20.3. Does not work with
-;;; FSF Emacs 19.
-;;;
+;;; Tested with Emacs 20.2 and XEmacs 20.3.
+;;; Release history:
+;;;
+;;; 1998-08-16 initial release posted to gnu.emacs.sources
+;;; 1998-08-17 use append instead of char-list-to-string
+
(require 'cl)
-;; 0x36 == 54 == '6'
+;; Magic character for inner HMAC round. 0x36 == 54 == '6'
(defconst hmac-ipad ?\x36)
-;; 0x5C == 92 == '\'
+;; Magic character for outer HMAC round. 0x5C == 92 == '\'
(defconst hmac-opad ?\x5C)
-;; 0x00
+;; Not so magic character for padding the key. 0x00
(defconst hmac-zero ?\x00)
(if (not (fboundp 'hexl-hex-string-to-integer))
(defun hexl-hex-string-to-integer (string)
(string-to-number string 16)))
-(if (not (fboundp 'string-to-char-list))
- (defun string-to-char-list (string)
- "Return a list of which elements are characters in the STRING."
- (let* ((len (length string))
- (i 0)
- l chr)
- (while (< i len)
- (setq chr (string-to-char (substring string i)))
- (setq l (cons chr l))
- (setq i (1+ i)))
- (nreverse l))))
-
(defun hmac (hash block-length hash-length key text)
(let* (;; if key is longer than B, reset it to HASH(key)
(key (if (> (length key) block-length)
(funcall hash key) key))
- (k_ipad (string-to-char-list key))
- (k_opad (string-to-char-list key)))
+ (k_ipad (append key nil))
+ (k_opad (append key nil)))
;; zero pad k_ipad/k_opad
(while (< (length k_ipad) block-length)
(setq k_ipad (append k_ipad (list hmac-zero))))
@@ -81,34 +74,6 @@
(push (hexl-hex-string-to-integer (substring first-round -2)) de-hexed)
(setq first-round (substring first-round 0 -2)))
;; perform outer hash
- (let ((second-round
- (funcall hash (concat k_opad de-hexed))))
- second-round))))
-
-
-; (let ((k_ipad (make-vector block-length hmac-zero))
-; (k_opad (make-vector block-length hmac-zero))
-; ;; if key is longer than B, reset it to HASH(key)
-; (key (if (> (length key) block-length)
-; (funcall hash key) key)))
-; ;; copy in key into k_ipad/k_opad
-; (let ((j 0))
-; (while (< j (length key))
-; (aset k_ipad j (string-to-char (substring key j)))
-; (setq j (1+ j))))
-; (let ((j 0))
-; (while (< j (length key))
-; (aset k_opad j (string-to-char (substring key j)))
-; (setq j (1+ j))))
-; ;; XOR key with ipad/opad into k_ipad/k_opad
-; (setq k_ipad (mapvector (lambda (c) (logxor c hmac-ipad)) k_ipad))
-; (setq k_opad (mapvector (lambda (c) (logxor c hmac-opad)) k_opad))
-; ;; perform inner hash
-; (let ((first-round
-; (funcall hash (concat k_ipad text))))
-; ;; perform outer hash
-; (let ((second-round
-; (funcall hash (concat k_opad first-round))))
-; second-round))))
+ (funcall hash (concat k_opad de-hexed)))))
(provide 'hmac)
diff -u nnimap-0.3.22/imap4rev1.el nnimap-0.3.23/imap4rev1.el
--- nnimap-0.3.22/imap4rev1.el Sat Aug 15 16:07:50 1998
+++ nnimap-0.3.23/imap4rev1.el Thu Aug 20 00:34:51 1998
@@ -175,6 +175,7 @@
imap-send-command-wait
imap-send-commands-wait
imap-wait-for-tag
+ imap-capability-get
imap-folder-set
imap-folder-get
imap-folder-plist
@@ -272,6 +273,7 @@
"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
@@ -308,14 +310,6 @@
; (make-vector imap-convenient-group-prime 0))
(current-buffer))))
-(defun imap-send (string &optional buffer)
- "Send a STRING to the server for BUFFER."
- (with-current-buffer (or buffer (current-buffer))
- (and imap-log (with-current-buffer (get-buffer-create imap-log)
- (goto-char (point-max))
- (insert-string string)))
- (process-send-string imap-process string)))
-
;; 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
@@ -328,8 +322,10 @@
then call `imap-wait-for-tag'. If CALLBACK is provided, then you cannot
call `imap-wait-for-tag'.
-COMMAND may be a list of strings and buffers which should
-be `concat'ed together. The buffers are sent as IMAP string literals."
+COMMAND may be a list of strings, buffers and/or functions which should
+be `concat'ed together. The buffers are sent as IMAP string literals.
+The functions accept one argument and are called with a server challenge and
+should return the client response or \"*\" to give up."
(with-current-buffer (or buffer (current-buffer))
(setq imap-last-status nil) ; Yuck
(let* ((tag (format "%c%d" imap-tag-char (setq imap-tag-num (1+ imap-tag-num))))
@@ -344,11 +340,15 @@
(while (stringp (car commands)) ; This should be easier
(push (car commands) strings) ; How to append without reversing???
(pop commands))
- (when commands ; buffer
- (push (format "{%d}%s" (with-current-buffer (car commands)
- (buffer-size))
- imap-eol)
- strings)
+ (when commands ; buffer or function
+ (cond
+ ((bufferp (car commands))
+ (push (format "{%d}%s" (with-current-buffer (car commands)
+ (buffer-size))
+ imap-eol)
+ strings))
+ ((functionp (car commands))
+ (push imap-eol strings)))
(setq imap-cb-tag-alist ;; removed by `imap-dispatch'
(cons (cons "+" 'imap-cb-tag-default) imap-cb-tag-alist)))
(setq strings (apply 'concat (nreverse strings)))
@@ -358,16 +358,29 @@
(insert strings)))
(process-send-string nil strings)
(setq strings nil)
- (when commands ; buffer
- (if (not (imap-wait-for-tag "+"))
- (setq commands nil) ; Don't bother sending the rest
- (and imap-log (with-current-buffer (get-buffer-create imap-log)
- (goto-char (point-max))
- (insert-buffer-substring (car commands))))
- (let ((process imap-process))
- (with-current-buffer (car commands)
- (process-send-region process (point-min) (point-max))))
- (pop commands))))
+ (when commands ; buffer or function
+ ;; Waiting for "+" and bail out if we get tag.
+ (let ((data (imap-wait-for-tag "+" tag)))
+ (if (not data)
+ (setq commands nil) ; Don't bother sending the rest
+ (cond
+ ((bufferp (car commands)) ; buffer
+ (and imap-log (with-current-buffer (get-buffer-create imap-log)
+ (goto-char (point-max))
+ (insert-buffer-substring (car commands))))
+ (let ((process imap-process))
+ (with-current-buffer (car commands)
+ (process-send-region process (point-min) (point-max))))
+ (pop commands))
+ ((functionp (car commands)) ; function
+ ;; Assume function comes at the end.
+ ;; Send result of function call by prepending it to
+ ;; the list of command strings.
+ ;; The function gets removed only after the end
+ ;; of the exchange (by an `imap-wait-for-tag' bailout).
+ (setq commands
+ (cons (funcall (car commands) (car data))
+ commands))))))))
tag)))
(defun imap-send-command-wait (command &optional buffer)
@@ -414,39 +427,6 @@
(get (intern (or folder
imap-current-folder) imap-data-folder) prop)))
-(defun imap-read-passwd (prompt &rest args)
- "Read a password using PROMPT.
-If ARGS, PROMPT is used as an argument to `format'."
- (let ((prompt
- (if args
- (apply 'format prompt args)
- prompt)))
- (funcall (if (load "passwd" t)
- 'read-passwd
- (unless (fboundp 'ange-ftp-read-passwd)
- (autoload 'ange-ftp-read-passwd "ange-ftp"))
- 'ange-ftp-read-passwd) prompt)))
-
-(defun imap-login (&optional name buffer)
- "Login to server, optionally using NAME."
- (with-current-buffer (or buffer (current-buffer))
- (if imap-do-login
- (let* ((user (or name
- imap-username
- imap-default-name
- (setq imap-username
- (read-from-minibuffer
- (concat "IMAP Name for "
- imap-current-server ": ")))))
- (passwd (or imap-password
- (setq imap-password
- (imap-read-passwd
- (concat "IMAP Password for " user "@"
- imap-current-server ": "))))))
- (eq 'OK (car (imap-send-command-wait
- (concat "LOGIN " user " " passwd)))))
- t)))
-
;;; Internal functions
(defun imap-open-stream (name buffer host &optional port)
@@ -817,16 +797,17 @@
(setq imap-cb-finished-tags (cons (cons (symbol-name tag) stats)
imap-cb-finished-tags))))
-(defun imap-wait-for-tag (tag)
+(defun imap-wait-for-tag (tag &optional bail)
"Wait for TAG to complete by calling `imap-cb-tag-default' and return
-its args."
- (let ((data))
- (while (when (not (setq data (assoc tag imap-cb-finished-tags)))
- ; timeout after imap-timeout seconds with no data
+its args. Stop waiting if BAIL is seen"
+ (let (data bailed)
+ (while (when (not (or (setq data (assoc tag imap-cb-finished-tags))
+ (setq bailed (assoc bail imap-cb-finished-tags))))
+ ;; timeout after imap-timeout seconds with no data
(accept-process-output imap-process imap-timeout)))
- (unless data
+ (unless (or data bailed)
(message "IMAP: Timed out waiting for %s" tag))
- (when data
+ (when (or data bailed)
(setq imap-cb-finished-tags (remassoc tag imap-cb-finished-tags))
(cdr data))))
diff -u nnimap-0.3.22/manual.html nnimap-0.3.23/manual.html
--- nnimap-0.3.22/manual.html Sat Aug 15 16:07:50 1998
+++ nnimap-0.3.23/manual.html Thu Aug 20 00:34:51 1998
@@ -128,7 +128,7 @@
<h3><a name="configkrb">Configuring for kerberos</a></h3>
-<p>For Kerberos authentication and encryption you need to have the external program "imtest" (comes with some IMAP server?? I dunno) in your path, and also add the following to <code>~/.gnus</code>:
+<p>For Kerberos authentication and encryption you need to have the external program "imtest" (comes with <a href="http://andrew2.andrew.cmu.edu/cyrus/">Cyrus IMAPD</a>) in your path, and also add the following to <code>~/.gnus</code>:
<pre>
(setq-default imap-open-stream 'imap-open-imtest-stream)
@@ -261,6 +261,6 @@
<hr>
<a href="mailto:jas@pdc.kth.se"><address>jas@pdc.kth.se</address></a>
<!-- hhmts start -->
-Last modified: Fri Aug 14 20:08:16 METDST 1998
+Last modified: Sun Aug 16 14:26:44 METDST 1998
<!-- hhmts end -->
</body> </html>
diff -u nnimap-0.3.22/nnimap.el nnimap-0.3.23/nnimap.el
--- nnimap-0.3.22/nnimap.el Sat Aug 15 16:07:51 1998
+++ nnimap-0.3.23/nnimap.el Thu Aug 20 00:34:51 1998
@@ -29,8 +29,11 @@
;;; "yoyo"
;;; (nnimap-server-address "robby.caltech.edu"))))
-;;; And inside Gnus, use 'U' (gnus-group-unsubscribe-group) to subscribe to
-;;; mailboxes.
+;;; And inside Gnus, list all available groups with A A (search for
+;;; 'nnimap')and subscribe to the mailboxes you are interested in with U.
+;;; If you know the name of the mailbox, you can also use 'U'
+;;; (gnus-group-unsubscribe-group) to subscribe to it (no mailbox
+;;; completion here, sorry).
;;; Note that Gnus can't deal with groups starting with '.' (a dot),
;;; this means that you will have to use ~/iMail/ instead of ./iMail
@@ -42,9 +45,16 @@
;;; Yep, I just checked. It is fixed in at least 5.6.27. It was
;;; still broken in 5.5.
+;;; RFC1730 (IMAP4): done
+;;; RFC1731 (Authentication mecanisms): currently only support for KERBEROS_V4
+;;; RFC2060 (IMAP4rev1): done
+;;; RFC2086 (ACL's): done
+;;; RFC2195 (CRAM-MD5): done
+;;; RFC2359 (UIDPLUS ext): done
+
;;; Todo (roughly in order of priority):
-;;; o Clean up the login stuff. It's a huge mess.
+;;; o Convert the manual to texi.
;;; o Verify that we don't use IMAP4rev1 specific things (RFC2060 App B)
;;; o nnimap-request-close-group should do incremental flag setting
;;; instead of first clearing all flags and setting them again. It also
@@ -100,7 +110,7 @@
(nnoo-declare nnimap) ; we derive from no one
-(defconst nnimap-version "nnimap 0.3.21")
+(defconst nnimap-version "nnimap 0.3.23")
(defvoo nnimap-list-pattern "*"
"*PATTERN or list of PATTERNS use to limit available groups.
@@ -195,13 +205,19 @@
;; Authorization / Privacy variables
;; todo:
-;; 'smart that open a connection, check the capabilities and
-;; set this variable to the "best" method. easy, but we need to fallback
+;; 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 'plain
+(defvoo nnimap-auth-method 'smart
"How nnimap authenticate itself to the server.
-Either 'plain or 'md5.")
+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."
@@ -261,8 +277,7 @@
nnimap-close-group
nnimap-close-server
nnimap-open-server
- nnimap-auth-cram-md5
- nnimap-auth-plaintext
+ nnimap-authenticate
nnimap-possibly-change-group
nnimap-possibly-change-server
nnimap-request-accept-article
@@ -280,6 +295,8 @@
nnimap-request-post
nnimap-request-rename-group
nnimap-request-scan
+; nnimap-send-command-wait
+; nnimap-ok-p
nnimap-split-copy-delete-article
nnimap-split-move-article
nnimap-split-to-groups
@@ -363,86 +380,38 @@
uncompressed)
'headers)))))
-(defun nnimap-read-passwd (prompt &rest args)
- "Read a password using PROMPT.
-If ARGS, PROMPT is used as an argument to `format'."
- (let ((prompt
- (if args
- (apply 'format prompt args)
- prompt)))
- (funcall (if (load "passwd" t)
- 'read-passwd
- (unless (fboundp 'ange-ftp-read-passwd)
- (autoload 'ange-ftp-read-passwd "ange-ftp"))
- 'ange-ftp-read-passwd) prompt)))
-
-(defun nnimap-login (&optional name buffer)
- "Login to server, optionally using NAME."
+(defun nnimap-authenticate (server &optional buffer)
(with-current-buffer (or buffer (current-buffer))
- (if imap-do-login
- (let* ((user (or name
- imap-username
- imap-default-name
- (setq imap-username
- (read-from-minibuffer
- (concat "IMAP Name for "
- imap-current-server ": ")))))
- (passwd (or imap-password
- (setq imap-password
- (imap-read-passwd
- (concat "IMAP Password for " user "@"
- imap-current-server ": "))))))
- (eq 'OK (car (nnimap-send-command-wait
- (concat "LOGIN " user " " passwd)))))
- t)))
-
-(defun nnimap-auth-plaintext (server buf)
- ;; Login
- (let (list alist user passwd)
- (and (fboundp 'gnus-parse-netrc)
- (setq list (gnus-parse-netrc nnimap-authinfo-file)
- alist (gnus-netrc-machine
- list nnimap-server-address)
- user (gnus-netrc-get alist "login")
- passwd (gnus-netrc-get alist "password")))
- (with-current-buffer buf
- (setq imap-password passwd))
- (while (not (nnimap-login user buf))
- (with-current-buffer buf
- (setq imap-password nil))
- (message "Bad Password for %s, Try again." server)
- (sleep-for 2))
- t))
-
-(defun nnimap-auth-cram-md5 (server buf)
- (when (memq 'AUTH=CRAM-MD5 (imap-capability-get buf))
- (require 'mel-b)
- (require 'hmac)
- (require 'md5)
- (with-current-buffer buf
- (let (list alist user passwd)
- (and (fboundp 'gnus-parse-netrc)
- (setq list (gnus-parse-netrc nnimap-authinfo-file)
- alist (gnus-netrc-machine
- list nnimap-server-address)
- user (gnus-netrc-get alist "login")
- passwd (gnus-netrc-get alist "password")))
- (setq imap-cb-tag-alist ;; removed by `imap-dispatch'
- (cons (cons "+" 'imap-cb-tag-default) imap-cb-tag-alist))
- (let ((tag (imap-send-command "AUTHENTICATE CRAM-MD5"))
- (challenge (imap-wait-for-tag "+")))
- (when challenge
- (let* ((challenge (car challenge))
- (decoded (base64-decode-string challenge))
- (hmaced (hmac 'md5 64 16 passwd decoded))
- (response (concat user " " hmaced))
- (encoded (base64-encode-string response)))
- (imap-send (concat encoded imap-eol) buf)
- (imap-wait-for-tag tag))))))))
-
+ ;; Login
+ (let (list alist user passwd ok)
+ (and (fboundp 'gnus-parse-netrc)
+ (setq list (gnus-parse-netrc nnimap-authinfo-file)
+ alist (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)))
+
(deffoo nnimap-open-server (server &optional defs)
(or (and (nnimap-server-opened server)
- (nnoo-change-server 'nnimap server defs))
+ (nnoo-change-server 'nnimap server defs)
+ (if (null nnimap-server-buffer)
+ (error "this shouldn't happen")
+ t))
(progn
(unless (assq 'nnimap-server-address defs)
(push (list 'nnimap-server-address server) defs))
@@ -453,38 +422,46 @@
(port (and pos
(string-to-number
(substring nnimap-server-address (1+ pos)))))
- (host (substring nnimap-server-address 0 pos))
- buf)
- (condition-case ()
- (setq buf (imap-open-server host (or port nnimap-server-port)
- nnimap-server-buffer
- nnimap-imap-defs))
+ (host (substring nnimap-server-address 0 pos)))
+ (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 host (or port nnimap-server-port)
+ nnimap-server-buffer
+ nnimap-imap-defs)
+ ;; we only support imap4.*
+ (unless (and (nnimap-ok-p (nnimap-send-command-wait
+ "CAPABILITY" nnimap-server-buffer))
+ (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." host)
+ (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)
- nil)
+ (nnheader-report 'nnimap (cdr err)))
(quit (let (imap-last-status)
(imap-close-server nnimap-server-buffer)
- (kill-buffer nnimap-server-buffer)
- nil)))
- (when buf
- ;; we only support imap4.*
- (unless (and (nnimap-ok-p (nnimap-send-command-wait
- "CAPABILITY" nnimap-server-buffer))
- (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)
- (message "Sorry, this is not a IMAP4(rev1) server.")
- (sit-for 2)
- (error))
- ;; authenticate ourself
- (when (if (eq nnimap-auth-method 'md5)
- (nnimap-auth-cram-md5 server nnimap-server-buffer)
- (nnimap-auth-plaintext server nnimap-server-buffer))
- (push (cons server nnimap-server-buffer)
- nnimap-server-buffer-alist)))))))
+ (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
@@ -576,6 +553,11 @@
;;; The 'fast' concept is broken. Gnus =relies= on getting data
;;; back from this function even if called with fast=t. Yuck.
(deffoo nnimap-request-group (group &optional server fast)
+ (nnimap-request-update-info group (gnus-get-info
+ (gnus-group-normally-qualified
+ 'nnimap server group))
+ server
+ t)
(when (nnimap-possibly-change-group group server) ;; SELECT group
; (if fast
; (with-current-buffer nntp-server-buffer
@@ -589,7 +571,20 @@
(setq articles '(0))
(when (nnimap-ok-p (nnimap-send-command-wait "FETCH 1,* (UID)"))
(imap-message-map (lambda (uid Uid)
- (push uid articles)) 'UID)))
+ (push uid articles)) 'UID)
+ ;; start of bug workaround code
+ ;; Lotus CCmail is broken, returns:
+ ;; C13 FETCH 1,* (UID)
+ ;; * 1 FETCH (UID 4198)
+ ;; C13 OK Completed
+ ;; we fetch 1:* instead
+ (when (< 2 (length articles))
+ (setq articles nil)
+ (when (nnimap-ok-p (nnimap-send-command-wait "FETCH 1:* (UID"))
+ (imap-message-map (lambda (uid Uid)
+ (push uid articles)) 'UID)))
+ ;; end of bug workaround code
+ ))
(when articles
(with-current-buffer nntp-server-buffer
(erase-buffer)
@@ -633,7 +628,8 @@
(with-current-buffer nnimap-server-buffer
;; For now we assume that we need to sync the group-info
;; with the server here.
- (if (imap-folder-get 'writable)
+ (if (and (imap-folder-get 'writable)
+ (imap-folder-get 'permanentflags group))
(let* ((info (gnus-get-info
(gnus-group-normally-qualified 'nnimap server group)))
(marks (gnus-info-marks info)))
@@ -675,7 +671,7 @@
;; We ignore groups with spaces (Gnus can't handle them)
(string-match " " group))
(let (high)
- (gnus-message 7 "Generating active list, group %s" group)
+ (gnus-message 7 "Generating active list for nnimap group %s" group)
(cond
((eq nnimap-group-list-speed 'slow)
(when (nnimap-possibly-change-group group nil)
@@ -689,6 +685,19 @@
"FETCH 1,* (UID)"))
(imap-message-map (lambda (uid Uid)
(push uid articles)) 'UID)
+ ;; start of bug workaround code
+ ;; Lotus CCmail is broken, returns:
+ ;; C13 FETCH 1,* (UID)
+ ;; * 1 FETCH (UID 4198)
+ ;; C13 OK Completed
+ ;; we fetch 1:* instead
+ (when (< 2 (length articles))
+ (setq articles nil)
+ (when (nnimap-ok-p (nnimap-send-command-wait
+ "FETCH 1:* (UID"))
+ (imap-message-map (lambda (uid Uid)
+ (push uid articles)) 'UID)))
+ ;; end of bug workaround code
(when articles
(with-current-buffer nntp-server-buffer
(insert (format "%s %d %d y\n" group
@@ -719,17 +728,17 @@
(with-current-buffer nnimap-server-buffer
(setq imap-data-folder (make-vector imap-convenient-group-prime 0)
imap-current-folder nil)
- (let* ((patterns (mapcar (lambda (p) (if (and (consp p)
- (cdr p))
+ (message "ok")
+ (let* ((patterns (mapcar (lambda (p) (if (consp p)
p
(cons "\"\"" p)))
- (if (or (atom nnimap-list-pattern)
- (atom (cdr nnimap-list-pattern)))
- (list nnimap-list-pattern)
- nnimap-list-pattern)))
- pattern)
- (while (setq pattern (pop patterns))
- (nnimap-ok-p (nnimap-send-command-wait
+ (if (and (listp nnimap-list-pattern)
+ (listp (cdr nnimap-list-pattern)))
+ nnimap-list-pattern
+ (list nnimap-list-pattern))))
+ pattern)
+ (while (setq pattern (pop patterns))
+ (nnimap-ok-p (nnimap-send-command-wait
(concat nnimap-list-method " "
(car pattern) " "
(cdr pattern)))))
@@ -787,68 +796,51 @@
(member "\\*" (imap-folder-get 'permanentflags group)))))
;;; I really think this should update the active-info too???
-(deffoo nnimap-request-update-info (group info &optional server)
- (when (nnimap-possibly-change-group group server) ;; SELECT
- (with-current-buffer nnimap-server-buffer
- (gnus-message 5 "Updating active info for mailbox %s" group)
-
- ;; extend info to have parameters (otherwise when we set them,
- ;; they don't get set)
- (or (gnus-info-params info)
- (gnus-info-set-params info nil t))
-
- ;; update active info -- how do we propagate this to gnus???
-; (let ((imap-message-data (make-vector 2 0))
-; (exists (imap-folder-get 'EXISTS))
-; active)
-; (if (eq 0 exists)
-; (setq active (cons 0 1))
-; (when (nnimap-ok-p (nnimap-send-command-wait "FETCH 1,* (UID)"))
-; (let (articles)
-; (imap-message-map (lambda (uid Uid) (push uid articles))
-; 'UID)
-; (setq active (cons (apply 'max articles)
-; (apply 'min articles)))))
-; (when active
-; (setq nnimap-group-alist
-; (nnimap-update-alist-soft group (list active)
-; nnimap-group-alist)))))
-
- ;; Replace list of read and marked articles with authoritative
- ;; data from server
- (gnus-info-set-read
- info
- ;; xxx This is extremely slow.
- (let* (
- ;; oldseen could contain articles marked unread by other
- ;; imap clients! need to correct this
- (oldseentmp (gnus-uncompress-range (gnus-info-read info)))
- (unseen (nnimap-search "UNSEEN"))
- (oldseen (gnus-set-difference oldseentmp unseen))
- ;; oldseen might lack articles marked as read by other
- ;; imap clients! correct this
- (newseen (nnimap-search "SEEN"))
- ;; ok, read articles are in oldseen+newseen (xxx lots of dupes)
- (seen (append oldseen newseen))
- ;; sort to have gnus-compress-sequence remove dupes
- (seens (sort seen '<))
- (read (gnus-compress-sequence seens t)))
- (if (and read
- (atom (car read)))
- (list (cons (car read) (car read))) ;; xxx not my bug
- read)))
- (mapc
- (lambda (mark-search)
- (if (nnimap-flag-permanent-p mark-search group)
- (gnus-info-set-marks
- info
- (nnimap-update-alist-soft (car mark-search)
- (gnus-compress-sequence
- (nnimap-search (cdr mark-search)))
- (gnus-info-marks info)))))
- nnimap-mark-to-predicate-alist))
- info))
-
+(deffoo nnimap-request-update-info (group info &optional server silly)
+ (when silly
+ (when (nnimap-possibly-change-group group server) ;; SELECT
+ (with-current-buffer nnimap-server-buffer
+ (gnus-message 5 "Updating active info for mailbox %s" group)
+
+ ;; extend info to have parameters (otherwise when we set them,
+ ;; they don't get set)
+ (or (gnus-info-params info)
+ (gnus-info-set-params info nil t))
+
+ ;; Replace list of read and marked articles with authoritative
+ ;; data from server
+ (gnus-info-set-read
+ info
+ ;; xxx This is extremely slow.
+ (let* (
+ ;; oldseen could contain articles marked unread by other
+ ;; imap clients! we correct this
+ (oldseentmp (gnus-uncompress-range (gnus-info-read info)))
+ (unseen (nnimap-search "UNSEEN"))
+ (oldseen (gnus-set-difference oldseentmp unseen))
+ ;; oldseen might lack articles marked as read by other
+ ;; imap clients! we correct this
+ (newseen (nnimap-search "SEEN"))
+ ;; ok, read articles are in oldseen+newseen (xxx lots of dupes)
+ (seen (append oldseen newseen))
+ ;; sort to have gnus-compress-sequence remove dupes
+ (seens (sort seen '<))
+ (read (gnus-compress-sequence seens t)))
+ (if (and read
+ (atom (car read)))
+ (list (cons (car read) (car read))) ;; xxx not my bug
+ read)))
+ (mapc
+ (lambda (mark-search)
+ (if (nnimap-flag-permanent-p mark-search group)
+ (gnus-info-set-marks
+ info
+ (nnimap-update-alist-soft (car mark-search)
+ (gnus-compress-sequence
+ (nnimap-search (cdr mark-search)))
+ (gnus-info-marks info)))))
+ nnimap-mark-to-predicate-alist))
+ info)))
;;; Respond to articles with mail
(deffoo nnimap-request-type (group article)
@@ -959,6 +951,8 @@
(nnimap-split-move-article article inbox
(car groups))))))))
(when (nnimap-possibly-change-group inbox) ;; just in case
+ ;; todo: only remove splitted articles
+ ;; use UID EXPUNGE, unfortunely not in the standard :-(
(nnimap-send-command-wait "EXPUNGE") ;; to get tagged data
(nnimap-send-command-wait "CLOSE")))))
t))
@@ -1043,25 +1037,33 @@
(nnimap-request-expire-articles (list article) group server t))
result)))
+;;; todo:
;;; Maybe we should update the group-alist???
(deffoo nnimap-request-accept-article (group &optional server last)
(when (nnimap-possibly-change-server server)
;; The article will be appended as UIDNEXT
- (when (nnimap-ok-p (nnimap-send-command-wait
- (concat "STATUS " group " (UIDNEXT)")
- nnimap-server-buffer))
+ (when (or (memq 'UIDPLUS (imap-capability-get nnimap-server-buffer))
+ (nnimap-ok-p (nnimap-send-command-wait
+ (concat "STATUS " group " (UIDNEXT)")
+ nnimap-server-buffer)))
(with-current-buffer (current-buffer)
(goto-char (point-min))
(unless (string= "\n" imap-eol)
(while (re-search-forward "\n" nil t)
(replace-match imap-eol))))
- (nnimap-ok-p (nnimap-send-command-wait
- ;; Optional flags,date???
- (list (format "APPEND %s " group) (current-buffer))
- nnimap-server-buffer))
- (let ((high (imap-folder-get 'UIDNEXT group nnimap-server-buffer)))
- (when high
- (cons group high))))))
+ (when (nnimap-ok-p (nnimap-send-command-wait
+ ;; Optional flags,date???
+ (list (concat "APPEND " group " ")
+ (current-buffer))
+ nnimap-server-buffer))
+ (let ((high (cdr (imap-folder-get
+ (if (memq 'UIDPLUS (imap-capability-get
+ nnimap-server-buffer))
+ 'appenduid
+ 'UIDNEXT)
+ group nnimap-server-buffer))))
+ (when high
+ (cons group high)))))))
;; (deffoo nnimap-request-replace-article -- IMAP does not support replacing
@@ -1107,20 +1109,22 @@
(defun nnimap-send-command-wait (command &optional buffer)
(unless (and (stringp command) (string-match "%" command))
(gnus-message 10 (apply 'concat
- (if (listp command)
- (mapcar
- (lambda (s-b)
- (if (bufferp s-b) (buffer-name s-b) s-b))
- command)
- (list command)))))
+ (if (listp command)
+ (mapcar
+ (lambda (s-b)
+ (cond
+ ((bufferp s-b) (buffer-name s-b))
+ ((functionp s-b) "<func>")
+ (s-b)))
+ command)
+ (list command)))))
(imap-send-command-wait command buffer))
(defun nnimap-ok-p (status)
(if status
- (if (not (eq 'OK (car status)))
- (nnheader-report 'nnimap (cdr status))
- (setq imap-last-status nil)
- t)
+ (if (imap-ok-p status)
+ t
+ (nnheader-report 'nnimap (cdr status)))
(nnheader-report 'nnimap (format "IMAP Command Timed Out"))))
(defun nnimap-search (predicate)
@@ -1157,22 +1161,23 @@
;; check/set UIDVALIDITY
(let ((new-uid (imap-folder-get 'uidvalidity))
(old-uid (gnus-group-get-parameter groupname
- 'uidvalidity)))
- (if old-uid
- (when (not (equal old-uid new-uid))
+ 'uidvalidity))
+ (info (gnus-get-info groupname)))
+ (if (not old-uid)
+ (gnus-group-add-parameter groupname (cons 'uidvalidity
+ new-uid))
+ (when (not (equal old-uid new-uid))
+ (if (and (not (gnus-info-marks info))
+ (not (gnus-info-read info)))
+ (gnus-group-set-parameter groupname 'uidvalidity
+ new-uid)
(message "UIDVALIDITY clash. Old value `%s', new `%s'"
old-uid new-uid)
- (setq imap-current-folder nil))
- (gnus-group-add-parameter groupname
- (cons 'uidvalidity new-uid))))))))
+ (setq imap-current-folder nil)))))))))
imap-current-folder)))
;;; Other functions
-;; Is this a Gnus function or a nnimap function? Is this the way to implement
-;; backend specific functions that can't be done through the backend interface?
-;; Should this be in nnimap.el or somewhere else?
-;; I've no idea, feel free to re-write.
(defun gnus-group-edit-nnimap-acl (group)
"Edit the Access Control List of current nnimap GROUP."
(interactive (list (gnus-group-group-name)))
@@ -1259,7 +1264,11 @@
;;; Glue
(defun nnimap-group-mode-hook ()
- (define-key gnus-group-mode-map (kbd "G l") 'gnus-group-edit-nnimap-acl))
+ (define-key gnus-group-mode-map (if (fboundp 'kbd) (kbd "G l")
+ (read-kbd-macro "G l"))
+ 'gnus-group-edit-nnimap-acl))
(add-hook 'gnus-group-mode-hook 'nnimap-group-mode-hook)
+
+;; We're done.
(provide 'nnimap)
diff -u nnimap-0.3.22/ChangeLog nnimap-0.3.23/ChangeLog
--- nnimap-0.3.22/ChangeLog Sat Aug 15 16:07:49 1998
+++ nnimap-0.3.23/ChangeLog Thu Aug 20 00:34:50 1998
@@ -1,3 +1,142 @@
+1998-08-20 00:29:53 Simon Josefsson <jas@pdc.kth.se>
+
+ * nnimap 0.3.23 released.
+
+1998-08-20 00:27:17 Simon Josefsson <jas@pdc.kth.se>
+
+ * imap4rev1.el: Re-ordered compile-time require's.
+
+1998-08-20 00:25:10 Simon Josefsson <jas@pdc.kth.se>
+
+ * nnimap.el (nnimap-group-mode-hook): Emacs 19.34 compatibility.
+
+ * nnimap.el (gnus-group-edit-nnimap-acl): Removed confused
+ comment, I think I'm less confused now.
+
+ * nnimap.el (nnimap-ok-p): Use imap-ok-p.
+
+ * nnimap.el (nnimap-request-accept-article): Use APPENDUID
+ (RFC2359), Don't return a cons if APPEND failed.
+
+ * nnimap.el (nnimap-request-update-info): Don't do anything unless
+ silly is set. Removed old code.
+
+ * nnimap.el (nnimap-request-list-mapper): Change gnus-message.
+
+ * nnimap.el (nnimap-request-group): Call nnimap-request-update-info.
+
+ * nnimap.el (nnimap-open-server): Set imap-open-stream, Don't kill
+ buffer if it doesn't exist.
+
+ * nnimap.el (nnimap-authenticate): Use imap-authenticate, Don't
+ oo-loop.
+
+ * nnimap.el (nnimap-read-passwd):
+ (nnimap-login): Functions removed.
+
+ * nnimap.el (nnimap-auth-method): Doc changes.
+
+ * nnimap.el: Doc changes, todo changes, added RFC support summary.
+
+1998-08-19 23:35:29 Simon Josefsson <jas@pdc.kth.se>
+
+ * imap4rev1.el (imap-authenticate-cram-md5):
+ (imap-authenticate-login):
+ (imap-authenticate):
+ (imap-read-passwd):
+ (imap-authinfo-get):
+ (imap-ok-p): New functions.
+
+ * imap4rev1.el (imap-locals): Added imap-open-stream,
+ imap-auth-method, imap-authinfo. Removed imap-username,
+ imap-password.
+
+ * imap4rev1.el (imap-auth-method):
+ (imap-authinfo): New variables.
+
+1998-08-19 23:29:36 Simon Josefsson <jas@pdc.kth.se>
+
+ * imap4rev1.el (imap-default-port):
+ (imap-open-stream):
+ (imap-do-login): Doc changes.
+
+1998-08-19 14:26:03 Simon Josefsson <jas@pdc.kth.se>
+
+ * imap4rev1.el (imap-parse-line): Make COPYUID uid-validity into
+ strings.
+
+1998-08-18 18:32:51 Simon Josefsson <jas@pdc.kth.se>
+
+ * nnimap.el (nnimap-request-group):
+ (nnimap-request-list-mapper): Work around for bug in Lotus CCmail.
+
+1998-08-18 14:27:35 Simon Josefsson <jas@pdc.kth.se>
+
+ * nnimap.el (nnimap-login): Quote username and password.
+
+1998-08-17 12:56:24 Simon Josefsson <jas@pdc.kth.se>
+
+ * nnimap.el (nnimap-send-command-wait): Handle functions.
+
+1998-08-17 12:11:03 Simon Josefsson <jas@pdc.kth.se>
+
+ * hmac.el (hmac): Use append instead of char-list-to-string.
+
+1998-08-17 01:41:26 Simon Josefsson <jas@pdc.kth.se>
+
+ * imap4rev1.el (imap-send-command): Funcall function.
+
+1998-08-16 Jim Radford <radford@robby.caltech.edu>
+
+ * nnimap.el (nnimap-open-server): Added a stupid debug check for
+ when we get called with nnimap-server-buffer nil. This shouldn't
+ happen. It does. This is a bug. Find it.
+
+ * nnimap.el (nnimap-open-server): Support the changed
+ authentication interface. Make sure that we call `nnimap-login'
+ which protected by the condition-case so that we can recover
+ gracefully from a C-g used to skip a server. Clean up the
+ connection cleanly if this is not an IMAP4* server. Also use
+ nnheader-report to report errors instead of message or warn.
+
+ * nnimap.el (nnimap-authenticate): New function. Mostly just
+ parses the netrc and loops calling nnimap-login.
+
+ * nnimap.el (nnimap-login): Merge most if the MD5 and normal login
+ code. Do authentication based on the new extened interface to
+ imap-send-command. This should cut down on replicated code.
+
+ * imap4rev1.el (imap-send): removed.
+
+ * imap4rev1.el (imap-send-command): Add in logic to do the
+ authentication "+" magic. You now pass in a function, just like
+ you pass buffers, that caries out the authentication dialogue.
+
+ * imap4rev1.el (imap-wait-for-tag): Add the ability to stop
+ waiting when a certain tag is received before the one you actually
+ want arrives. This is so we don't have to time out if for some
+ reason "+" taged data doesn't arrive. This can happen when there
+ is an error in a command that expects "+" data (like an APPEND on
+ a non existent mailbox) or during authentication.
+
+1998-08-16 20:10:10 Simon Josefsson <jas@pdc.kth.se>
+
+ * nnimap.el (nnimap-open-server): No condition-case any more,
+ give a valid error code.
+
+1998-08-15 Jim Radford <radford@saladin.caltech.edu>
+
+ * nnimap.el (nnimap-close-group): Only mess with the flags if
+ there are any actually PERMANENTFLAGS.
+
+ * nnimap.el (nnimap-request-list): Clean up
+ and add support for nnimap-list-pattern of '().
+
+1998-08-15 17:58:19 Simon Josefsson <jas@pdc.kth.se>
+
+ * nnimap.el (nnimap-request-list): really handle
+ nnimap-list-pattern of ("INBOX")
+
1998-08-15 15:31:09 Simon Josefsson <jas@pdc.kth.se>
* nnimap 0.3.22 released