[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
nnimap 0.3.21 released
Lots of stuff, including some bugs. You should probably stay with
0.3.20 unless you want to play with the sources.
Thanks to Jim for the patches, I think I've applied them all.
Thanks to Chris Newman of Innosoft for providing me with a server to
test CRAM-MD5 authentication against. It works, but require's mel-b
(from FLIM) for BASE64 encoding/decoding. I'm not sure how to deal
with this in the future, I don't want nnimap to depend on FLIM.
The login stuff is huge mess but I wanted to get this release out
before I go to sleep.
Documentation about the MD5 authentication will not be written until
the login functions have been cleaned up.
Get it from http://vic20.dzp.se/gnus-imap/nnimap.tar.gz
/s
1998-08-14 02:32:46 Simon Josefsson <jas@pdc.kth.se>
* nnimap 0.3.21 released
1998-08-14 02:34:58 Simon Josefsson <jas@pdc.kth.se>
* hmac.el: new file
* imap4rev1.el (imap-send): new function
* nnimap.el (nnimap-auth-method): new variable
* nnimap.el (nnimap-read-passwd):
(nnimap-login):
(nnimap-auth-plaintext):
(nnimap-auth-cram-md5): new functions
(nnimap-open-server): use them
* imap4rev1.el (imap-send): new function
1998-08-13 Jim Radford <radford@robby.caltech.edu>
* nnimap.el (nnimap-mark-to-flag-alist):
1998-08-14 00:54:02 Simon Josefsson <jas@pdc.kth.se>
* nnimap.el (gnus-declare-backend): no 'respool
1998-08-13 Jim Radford <radford@robby.caltech.edu>
* nnimap.el (nnimap-request-update-info):
(nnimap-close-server): We now update all the flags if possible.
We now respect PERMANENTFLAGS and \\*. We use the IMAP builtin
ones that make sense and we create our own flags like
`gnus-bookmark' for those that don't fit. There are a few
inefficiencies, but it works for now.
* nnimap.el (nnimap-mark-to-flag-alist):
* nnimap.el (nnimap-mark-to-predicate-alist: New variables
* nnimap.el (nnimap-flag-permanent-p): Function to decide if
we can expect to change a flag.
* nnimap.el (nnimap-ok): Try and report the correct error
to gnus by setting `imap-last-status' to nil when command
works, thereby allowing nnheader-report to superceed.
We now actually report UIDVALIDITY mismatches to the user.
1998-08-12 Jim Radford <radford@robby.caltech.edu>
* imap4rev1.el (imap-parse-line):
* nnimap.el (nnimap-request-accept-article): I shouldn't have
allowed for large UIDNEXTs. We can't deal with large numbers
(UIDS) and until we can do it, it is pointless to quote them.
* nnimap.el (nnimap-retrieve-groups): Revive/rewrite. This
function gets called instead of nnimap-request-list when
gnus-read-active-file is 'some. This will speed things up, since
you shouldn't have to open every group on the server every time
you check for mail. Just once in the beginning.
* nnimap.el: (nnimap-request-list-mapper): Generalize so that
nnimap-retrieve-groups and nnimap-request-list can call.
* nnimap.el: (nnimap-retrieve-groups): Sync call call to
nnimap-request-list-mapper.
* nnimap.el (nnimap-status-message):
* nnimap.el (nnimap-server-opened):
* nnimap.el (nnimap-close-server): Make sure to use the real
server name for calling functions even if you are passed nil,
meaning the current server. Passing nil to `nnimap-close-server'
hosed `nnimap-server-buffer' when using multiple servers. Similar
for the others.
diff -u nnimap-0.3.20/imap4rev1.el nnimap-0.3.21/imap4rev1.el
--- nnimap-0.3.20/imap4rev1.el Wed Aug 12 15:00:15 1998
+++ nnimap-0.3.21/imap4rev1.el Fri Aug 14 02:10:07 1998
@@ -307,6 +307,14 @@
; (setq imap-data-folder
; (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
@@ -644,7 +652,7 @@
(mapconcat 'identity
'("\"[^\"]*\"" ; quoted strings
"\\[\\|\\]" ; [] characters
- "\\(UIDNEXT\\|UIDVALIDITY\\|APPENDUID\\) \\([0123456789]+\\)"
+ "\\(UIDVALIDITY\\|APPENDUID\\) \\([0123456789]+\\)"
"\\." ; . characters
"\\#" ; # characters
"\\\\" ; \ characters
diff -u nnimap-0.3.20/manual.html nnimap-0.3.21/manual.html
--- nnimap-0.3.20/manual.html Wed Aug 12 23:03:09 1998
+++ nnimap-0.3.21/manual.html Fri Aug 14 02:36:06 1998
@@ -12,7 +12,7 @@
<p>The intent of this document is to describe every aspect of nnimap at the user level.
<ul>
- <li><a href="#download">Downloading and unpacking nnimap</a>
+ <li><a href="#download">Downloading, unpacking and compiling nnimap</a>
<li><a href="#install">Installing nnimap</a>
<li><a href="#config">Configuring nnimap</a>
<ul>
@@ -39,9 +39,9 @@
</ul>
</ul>
-<h2><a name="download">Downloading and unpacking nnimap</a></h2>
+<h2><a name="download">Downloading, unpacking and compiling nnimap</a></h2>
-<p>The latest version of this nnimap implementation is always available as <a href="nnimap.tar.gz">nnimap.tar.gz</a>.
+<p>The latest version of this nnimap implementation is always available as <a href="nnimap.tar.gz">http://vic20.dzp.se/gnus-imap/nnimap.tar.gz</a>.
<p>Download the archive and unpack it.
@@ -51,7 +51,14 @@
<p>This will create a directory nnimap-X/ which contain all files. X is the current version number.
-<p><b>Warning!</b> Do not byte-compile it, it does not work yet.
+<p>Compile it by issuing the following commands:
+
+<pre>
+$ cd nnimap-0.3.11
+$ make
+</pre>
+
+<p>If you use XEmacs, use <code>make EMACS=xemacs</code> instead.
<h2><a name="install">Installing nnimap</a></h2>
@@ -239,6 +246,6 @@
<hr>
<a href="mailto:jas@pdc.kth.se"><address>jas@pdc.kth.se</address></a>
<!-- hhmts start -->
-Last modified: Mon Aug 10 13:41:46 METDST 1998
+Last modified: Thu Aug 13 13:04:38 METDST 1998
<!-- hhmts end -->
</body> </html>
diff -u nnimap-0.3.20/nnimap.el nnimap-0.3.21/nnimap.el
--- nnimap-0.3.20/nnimap.el Wed Aug 12 22:58:55 1998
+++ nnimap-0.3.21/nnimap.el Fri Aug 14 02:31:37 1998
@@ -36,6 +36,12 @@
;;; this means that you will have to use ~/iMail/ instead of ./iMail
;;; (or similair).
+;;; Note also that you shouldn't subscribe to goups on your nnimap
+;;; server from the server buffer if the server is your primary server
+;;; i.e. in `gnus-select-method'. I think this is a bug in Gnus.
+;;; Yep, I just checked. It is fixed in at least 5.6.27. It was
+;;; still broken in 5.5.
+
;;; Todo (roughly in order of priority):
;;; o Verify that we don't use IMAP4rev1 specific things (RFC2060 App B)
@@ -48,7 +54,6 @@
;;; o Do we dare to send the EXPUNGE command?
;;; o fix nnimap-list-pattern (FIXED?)
;;; o Split up big fetches (1,* header especially) in smaller chunks
-;;; o test ephemeral group support
;;; o use \Draft to support the draft group??
;;; o What do I do with gnus-newsgroup-*?
;;; o Figure out when update-info is called and why and if we need to
@@ -72,9 +77,9 @@
;;; o MIME
;;; o Fix the flag situation when using the Gnus Agent
;;; o Support RFC2221 (Login referrals)
-;;; o Support RFC2195 (MD5 logins -- use Gareth Rees's library?)
;;; o IMAP2BIS compatibility (RFC2061)
;;; o Debug imtest, it dumps with "Time is out of bounds" sometimes
+;;; o Clean up the login stuff. It's a huge mess.
;;;
(require 'imap4rev1)
@@ -87,12 +92,12 @@
(eval-when-compile (require 'cl))
-(gnus-declare-backend "nnimap" 'mail 'respool 'address 'prompt-address
+(gnus-declare-backend "nnimap" 'mail 'address 'prompt-address
'physical-address)
(nnoo-declare nnimap) ; we derive from no one
-(defconst nnimap-version "nnimap 0.3.20")
+(defconst nnimap-version "nnimap 0.3.21")
(defvoo nnimap-list-pattern "*"
"*PATTERN or list of PATTERNS use to limit available groups.
@@ -146,6 +151,8 @@
port-extended address in your authinfo file, and don't use this
variable at all.")
+;; Splitting variables
+
(defvar nnimap-split-crosspost t
"If non-nil, do crossposting if several split methods match the mail.
If nil, the first match found will be used.")
@@ -182,6 +189,17 @@
the argument. It should return a non-nil value if it thinks that the
mail belongs in that group.")
+;; 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
+;; if it doesn't work.
+(defvoo nnimap-auth-method 'plain
+ "How nnimap authenticate itself to the server.
+
+Either 'plain or 'md5.")
+
(defcustom nnimap-authinfo-file "~/.authinfo"
"Authorization information for IMAP servers. In .netrc format."
:type
@@ -240,6 +258,8 @@
nnimap-close-group
nnimap-close-server
nnimap-open-server
+ nnimap-auth-cram-md5
+ nnimap-auth-plaintext
nnimap-possibly-change-group
nnimap-possibly-change-server
nnimap-request-accept-article
@@ -340,6 +360,83 @@
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."
+ (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))))))))
+
(deffoo nnimap-open-server (server &optional defs)
(or (and (nnimap-server-opened server)
(nnoo-change-server 'nnimap server defs))
@@ -353,48 +450,43 @@
(port (and pos
(string-to-number
(substring nnimap-server-address (1+ pos)))))
- (host (substring nnimap-server-address 0 pos)))
+ (host (substring nnimap-server-address 0 pos))
+ buf)
(condition-case ()
- (when (imap-open-server host (or port nnimap-server-port)
- nnimap-server-buffer nnimap-imap-defs)
- (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))
- ;; 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 nnimap-server-buffer
- (setq imap-password passwd))
- (while (not (imap-login user nnimap-server-buffer))
- (with-current-buffer nnimap-server-buffer
- (setq imap-password nil))
- (message "Bad Password for %s, Try again." server)
- (sleep-for 2)))
- (push (cons server nnimap-server-buffer)
- nnimap-server-buffer-alist))
+ (setq buf (imap-open-server host (or port nnimap-server-port)
+ nnimap-server-buffer
+ nnimap-imap-defs))
(error (kill-buffer nnimap-server-buffer)
- nil)
+ nil)
(quit (let (imap-last-status)
- (imap-close-server nnimap-server-buffer)
- (kill-buffer nnimap-server-buffer)
- nil)))))))
+ (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)))))))
(deffoo nnimap-close-server (&optional server)
- (let ((s-b (assoc server nnimap-server-buffer-alist)))
+ (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))
@@ -408,8 +500,9 @@
(setq nnimap-server-buffer-alist nil))
(deffoo nnimap-server-opened (&optional server)
- (let ((buffer (if server (cdr (assoc server nnimap-server-buffer-alist))
- nnimap-server-buffer)))
+ (let ((buffer (cdr (assoc
+ (setq server (or server (nnoo-current-server 'nnimap)))
+ nnimap-server-buffer-alist))))
(if (and (gnus-buffer-live-p buffer)
(gnus-buffer-live-p nntp-server-buffer))
(let ((running (imap-server-opened buffer)))
@@ -422,9 +515,11 @@
; (imap-server-opened nnimap-server-buffer)))
(deffoo nnimap-status-message (&optional server)
- (let ((s-b (assoc server nnimap-server-buffer-alist)))
- (when s-b
- (with-current-buffer (cdr s-b)
+ (let ((buffer (cdr (assoc
+ (setq server (or server (nnoo-current-server 'nnimap)))
+ nnimap-server-buffer-alist))))
+ (when buffer
+ (with-current-buffer buffer
(or (cdr imap-last-status)
(nnoo-status-message 'nnimap server))))))
@@ -500,6 +595,10 @@
(apply 'max articles) group)))
t)))));)
+;; Note that there is no need for this in current Gnus (5.6.27), all
+;; you need to do is use gnus-group-prefixed-name. I'm not sure when
+;; this got fixed. That's what I get for not using the current
+;; version.
(defun gnus-group-normally-qualified (backend server group)
;; This is the format for groups in the group-info.
;; native groups are not qualified. Why?
@@ -510,31 +609,53 @@
group
(gnus-group-prefixed-name group method))))
+(defvar nnimap-mark-to-flag-alist
+ (mapcar
+ (lambda (pair) ; cdr is the mark
+ (or (assoc (cdr pair)
+ '((read . "\\Seen")
+ (tick . "\\Flagged")
+ ;;(expire . "\\Deleted")
+ (draft . "\\Draft")
+ (reply . "\\Answered")))
+ (cons (cdr pair)
+ (format "gnus-%s" (symbol-name (cdr pair))))))
+ (cons '(read . read) gnus-article-mark-lists)))
+
+;;; We need to optimize for no changes i.e. doing Q. We should
+;;; not touch the server.
(deffoo nnimap-close-group (group &optional server)
(when (nnimap-possibly-change-group group server)
+ (setq server (or server (nnoo-current-server 'nnimap)))
(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)
(let* ((info (gnus-get-info
(gnus-group-normally-qualified 'nnimap server group)))
- (read (gnus-info-read info))
- (marks (gnus-info-marks info))
- (tick (cdr (assoc 'tick marks)))
- (reply (cdr (assoc 'reply marks))))
+ (marks (gnus-info-marks info)))
(unless (eq 0 (imap-folder-get 'EXISTS))
;; Cyrus server (v1.5.2) disconnects on empty groups ???
(nnimap-send-command-wait
- "UID STORE 1:* -FLAGS.SILENT (\\Seen \\Flagged \\Answered)"))
+ (concat "UID STORE 1:* -FLAGS.SILENT ("
+ (mapconcat
+ 'symbol-name
+ (remove '\\* (imap-folder-get 'permanentflags group))
+ " ")
+ ")")))
(mapc
- (lambda (mark)
- (if (car mark)
+ (lambda (mark-flag)
+ (if (nnimap-flag-permanent-p mark-flag group)
+ (let ((val (if (equal 'read (car mark-flag))
+ (gnus-info-read info)
+ (cdr (assoc (car mark-flag) marks)))))
+ (if val
(nnimap-send-command-wait
(concat "UID STORE "
- (nnimap-range-to-string (car mark))
- " +FLAGS.SILENT (" (cdr mark) ")"))))
- (list (cons read "\\Seen")
- (cons tick "\\Flagged")
- (cons reply "\\Answered"))))
+ (nnimap-range-to-string val)
+ " +FLAGS.SILENT (" (cdr mark-flag) ")"))))))
+ nnimap-mark-to-flag-alist)))
+ ;; When someone Qs out of a group we could EXAMINE first???
;; Close her up. We don't necessarily have to do this.
(when (nnimap-ok-p (nnimap-send-command-wait "CLOSE"))
(setq imap-current-folder nil
@@ -542,11 +663,11 @@
t))))
;;; Returns: GROUP HIGHEST LOWEST [ynmxj=]
-(defun nnimap-request-list-mapper (sym)
- (unless (or (member '\\NoSelect (imap-folder-get 'flags (symbol-name sym)))
+(defun nnimap-request-list-mapper (group)
+ (unless (or (member '\\NoSelect (imap-folder-get 'flags group))
;; We ignore groups with spaces (Gnus can't handle them)
- (string-match " " (symbol-name sym)))
- (let ((group (symbol-name sym)) high)
+ (string-match " " group))
+ (let (high)
(gnus-message 7 "Generating active list, group %s" group)
(cond
((eq nnimap-group-list-speed 'slow)
@@ -606,7 +727,8 @@
(car pattern) " "
(cdr pattern)))))
(gnus-message 5 "Generating active list for %s" server)
- (mapatoms 'nnimap-request-list-mapper imap-data-folder)))
+ (mapatoms (lambda (sym) (nnimap-request-list-mapper (symbol-name sym)))
+ imap-data-folder)))
(setq nnimap-group-alist (nnmail-get-active))
t))
@@ -618,29 +740,44 @@
;;; Interface functions, optional backend functions
-
-;; Note that request-scan gets called right before this
-;; from `read-active-file'.
-;; Switch to active format to convey READ-ONLY status???
-(deffoo nnimap-retrieve-----groups (groups &optional server)
- ;; comment this function out ----- until we see if it is needed, since
- ;; it really doesn't provide accurate info
+;;; This gets called instead of `nnimap-request-list' when
+;;; `gnus-read-active-file' is 'some instead of t.
+;;; Returns: GROUP HIGHEST LOWEST [ynmxj=] ???
+(deffoo nnimap-retrieve-groups (groups &optional server)
+ (when (nnimap-possibly-change-server server)
(with-current-buffer nntp-server-buffer (erase-buffer))
- (when (nnimap-possibly-change-server server)
- (with-current-buffer nnimap-server-buffer
- (while groups
- (when (nnimap-send-command-wait (concat "STATUS " (car groups)
- " (MESSAGES UIDNEXT)"))
- (let* ((uidnext (imap-folder-get 'UIDNEXT (car groups)))
- (messages (imap-folder-get 'MESSAGES (car groups))))
- (with-current-buffer nntp-server-buffer
- ;; What should I return on empty???
- (if messages
- (insert (format "211 %d 1 %d %s\n"
- messages (- uidnext 1) (car groups)))))))
- (pop groups)))
- 'group))
-
+ (with-current-buffer nnimap-server-buffer
+ ;; Force the slow method for now since this will only be called
+ ;; for subscribed groups.
+ (let (group (nnimap-group-list-speed 'slow)) ; ???
+ (gnus-message 5 "Generating active info for certain groups on %s"
+ server)
+ (while (setq group (pop groups))
+ (nnimap-request-list-mapper group)))
+ ;; (setq nnimap-group-alist (nnmail-get-active)))
+ 'active)))
+
+(defvar nnimap-mark-to-predicate-alist
+ (mapcar
+ (lambda (pair) ; cdr is the mark
+ (or (assoc (cdr pair)
+ '(;;(read . "SEEN")
+ (tick . "FLAGGED")
+ ;;(expire . "DELETED")
+ (draft . "DRAFT")
+ (reply . "ANSWERED")))
+ (cons (cdr pair)
+ (format "KEYWORD gnus-%s" (symbol-name (cdr pair))))))
+ gnus-article-mark-lists))
+
+(defun nnimap-flag-permanent-p (mark-string group)
+ (or (member (cdr (assoc (car mark-string)
+ nnimap-mark-to-flag-alist))
+ (mapcar 'symbol-name ; Yuck
+ (imap-folder-get 'permanentflags group)))
+ (and (string-match "gnus-" (cdr mark-string))
+ (memq '\\* (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
@@ -692,18 +829,19 @@
(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 'tick (gnus-compress-sequence
- (nnimap-search "FLAGGED"))
- (gnus-info-marks info)))
- (gnus-info-set-marks
- info
- (nnimap-update-alist-soft 'reply (gnus-compress-sequence
- (nnimap-search "ANSWERED"))
- (gnus-info-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)
'mail)
@@ -912,8 +1050,7 @@
;; Optional flags,date???
(list (format "APPEND %s " group) (current-buffer))
nnimap-server-buffer))
- (let ((high (string-to-number
- (imap-folder-get 'UIDNEXT group nnimap-server-buffer))))
+ (let ((high (imap-folder-get 'UIDNEXT group nnimap-server-buffer)))
(when high
(cons group high))))))
@@ -971,8 +1108,10 @@
(defun nnimap-ok-p (status)
(if status
- (or (eq 'OK (car status))
- (nnheader-report 'nnimap (cdr status)))
+ (if (not (eq 'OK (car status)))
+ (nnheader-report 'nnimap (cdr status))
+ (setq imap-last-status nil)
+ t)
(nnheader-report 'nnimap (format "IMAP Command Timed Out"))))
(defun nnimap-search (predicate)
--- nnimap-0.3.20/hmac.el Fri Aug 14 02:37:14 1998
+++ nnimap-0.3.21/hmac.el Fri Aug 14 02:34:16 1998
@@ -0,0 +1,111 @@
+;;; hmac.el --- Hashed Message Authentication Codes
+
+;;; Copyright (C) 1998 Simon Josefsson <jas@pdc.kth.se>
+
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+;;; Commentary:
+
+;;;
+;;; This is a quick'n'dirty implementation of RFC2104.
+;;;
+;;; Example:
+;;;
+;;; (require 'md5)
+;;; (hmac 'md5 64 16 "Jefe" "what do ya want for nothing?")
+;;; "750c783e6ab0b503eaa86e310a5db738"
+;;;
+;;; Tested with FSF Emacs 20.2 and XEmacs 20.3.
+;;;
+
+(require 'cl)
+
+;; 0x36 == 54 == '6'
+(defconst hmac-ipad ?\x36)
+
+;; 0x5C == 92 == '\'
+(defconst hmac-opad ?\x5C)
+
+;; 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)))
+ ;; zero pad k_ipad/k_opad
+ (while (< (length k_ipad) block-length)
+ (setq k_ipad (append k_ipad (list hmac-zero))))
+ (while (< (length k_opad) block-length)
+ (setq k_opad (append k_opad (list hmac-zero))))
+ ;; XOR key with ipad/opad into k_ipad/k_opad
+ (setq k_ipad (mapcar (lambda (c) (logxor c hmac-ipad)) k_ipad))
+ (setq k_opad (mapcar (lambda (c) (logxor c hmac-opad)) k_opad))
+ ;; perform inner hash
+ (let ((first-round (funcall hash (concat k_ipad text)))
+ de-hexed)
+ (while (< 0 (length first-round))
+ (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))))
+
+(provide 'hmac)
diff -u nnimap-0.3.20/ChangeLog nnimap-0.3.21/ChangeLog
--- nnimap-0.3.20/ChangeLog Wed Aug 12 22:59:09 1998
+++ nnimap-0.3.21/ChangeLog Fri Aug 14 02:35:13 1998
@@ -1,3 +1,78 @@
+1998-08-14 02:32:46 Simon Josefsson <jas@pdc.kth.se>
+
+ * nnimap 0.3.21 released
+
+1998-08-14 02:34:58 Simon Josefsson <jas@pdc.kth.se>
+
+ * hmac.el: new file
+
+ * imap4rev1.el (imap-send): new function
+
+ * nnimap.el (nnimap-auth-method): new variable
+
+ * nnimap.el (nnimap-read-passwd):
+ (nnimap-login):
+ (nnimap-auth-plaintext):
+ (nnimap-auth-cram-md5): new functions
+ (nnimap-open-server): use them
+
+ * imap4rev1.el (imap-send): new function
+
+1998-08-13 Jim Radford <radford@robby.caltech.edu>
+
+ * nnimap.el (nnimap-mark-to-flag-alist):
+
+1998-08-14 00:54:02 Simon Josefsson <jas@pdc.kth.se>
+
+ * nnimap.el (gnus-declare-backend): no 'respool
+
+1998-08-13 Jim Radford <radford@robby.caltech.edu>
+
+ * nnimap.el (nnimap-request-update-info):
+ (nnimap-close-server): We now update all the flags if possible.
+ We now respect PERMANENTFLAGS and \\*. We use the IMAP builtin
+ ones that make sense and we create our own flags like
+ `gnus-bookmark' for those that don't fit. There are a few
+ inefficiencies, but it works for now.
+
+ * nnimap.el (nnimap-mark-to-flag-alist):
+ * nnimap.el (nnimap-mark-to-predicate-alist: New variables
+
+ * nnimap.el (nnimap-flag-permanent-p): Function to decide if
+ we can expect to change a flag.
+
+ * nnimap.el (nnimap-ok): Try and report the correct error
+ to gnus by setting `imap-last-status' to nil when command
+ works, thereby allowing nnheader-report to superceed.
+ We now actually report UIDVALIDITY mismatches to the user.
+
+1998-08-12 Jim Radford <radford@robby.caltech.edu>
+
+ * imap4rev1.el (imap-parse-line):
+ * nnimap.el (nnimap-request-accept-article): I shouldn't have
+ allowed for large UIDNEXTs. We can't deal with large numbers
+ (UIDS) and until we can do it, it is pointless to quote them.
+
+ * nnimap.el (nnimap-retrieve-groups): Revive/rewrite. This
+ function gets called instead of nnimap-request-list when
+ gnus-read-active-file is 'some. This will speed things up, since
+ you shouldn't have to open every group on the server every time
+ you check for mail. Just once in the beginning.
+
+ * nnimap.el: (nnimap-request-list-mapper): Generalize so that
+ nnimap-retrieve-groups and nnimap-request-list can call.
+
+ * nnimap.el: (nnimap-retrieve-groups): Sync call call to
+ nnimap-request-list-mapper.
+
+ * nnimap.el (nnimap-status-message):
+ * nnimap.el (nnimap-server-opened):
+ * nnimap.el (nnimap-close-server): Make sure to use the real
+ server name for calling functions even if you are passed nil,
+ meaning the current server. Passing nil to `nnimap-close-server'
+ hosed `nnimap-server-buffer' when using multiple servers. Similar
+ for the others.
+
1998-08-12 22:59:05 Simon Josefsson <jas@pdc.kth.se>
* nnimap 0.3.20 released