[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

nnimap 0.3.24



Turned out the 0.3.23 archive was broken, it included a old version of
imap4rev1.el. Sorry about that.

If you still get 'server denied', please try the previous patch --
it's probably the new login code that's buggy then.

Get it from http://vic20.dzp.se/gnus-imap/nnimap.tar.gz

/s

1998-08-20 22:52:12  Simon Josefsson  <jas@pdc.kth.se>

	* nnimap 0.3.24 released.

1998-08-20 12:26:41  Simon Josefsson  <jas@pdc.kth.se>

	* imap4rev1.el (imap-authenticate-cram-md5): Re-indent.

1998-08-20 12:25:14  Simon Josefsson  <jas@pdc.kth.se>

	* nnimap.el (nnimap-split-articles): Wipe out imap-current-folder.

diff -u nnimap-0.3.23/ChangeLog nnimap-0.3.24/ChangeLog
--- nnimap-0.3.23/ChangeLog	Thu Aug 20 00:34:50 1998
+++ nnimap-0.3.24/ChangeLog	Thu Aug 20 22:55:23 1998
@@ -1,3 +1,15 @@
+1998-08-20 22:52:12  Simon Josefsson  <jas@pdc.kth.se>
+
+	* nnimap 0.3.24 released.
+
+1998-08-20 12:26:41  Simon Josefsson  <jas@pdc.kth.se>
+
+	* imap4rev1.el (imap-authenticate-cram-md5): Re-indent.
+
+1998-08-20 12:25:14  Simon Josefsson  <jas@pdc.kth.se>
+
+	* nnimap.el (nnimap-split-articles): Wipe out imap-current-folder.
+
 1998-08-20 00:29:53  Simon Josefsson  <jas@pdc.kth.se>
 
 	* nnimap 0.3.23 released.
diff -u nnimap-0.3.23/imap4rev1.el nnimap-0.3.24/imap4rev1.el
--- nnimap-0.3.23/imap4rev1.el	Thu Aug 20 00:34:51 1998
+++ nnimap-0.3.24/imap4rev1.el	Thu Aug 20 22:55:24 1998
@@ -1,4 +1,4 @@
-;;; nnimap.el --- IMAP library for emacs
+;;; imap.el --- IMAP library for emacs
 
 ;;; Copyright (C) 1998 Simon Josefsson
 ;;; Copyright (C) 1998 Jim Radford
@@ -31,18 +31,21 @@
 ;;;   On expunge, remove messages from message-data. Note it doesn't
 ;;;     return UIDs.  Ouch.
 
+(eval-when-compile (require 'cl))
+
 (eval-and-compile
   (autoload 'open-ssl-stream "ssl")
   (unless (fboundp 'open-network-stream)
     (require 'tcp)))
 
-(eval-when-compile (require 'cl))
-
 ;;; 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.")
+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.
@@ -53,13 +56,27 @@
 (message) hash.")
 
 (defvar imap-open-stream nil
-  "*The name of a function to use for opening an imap stream.  (Set to
-imap-open-imtest-stream to use imtest).  Defaults on nil to open a
-networked stream to the server.")
+  "*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.")
 
@@ -69,14 +86,17 @@
 (defvar imap-timeout 20
   "*Timeout in seconds to wait for server response.")
 
-;;; Internal variables
-
 (defvar imap-username nil
-  "Username for server.")
+  "Username for server. ")
 
 (defvar imap-password nil
   "Password for server.")
 
+;;; 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.")
 
@@ -111,7 +131,10 @@
   "Unique tag char per connection.")
 
 (defvar imap-do-login t
-  "This should be set of by your `imap-open-stream' function.")
+  "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)
@@ -132,7 +155,6 @@
 				 (default . imap-cb-default))
   "Alist of IMAP code to function callbacks.")
 
-
 (defvar imap-cb-tag-alist '()
   "Alist of tags to callbacks for tagged responses.")
 
@@ -143,11 +165,12 @@
                       imap-current-server
                       imap-data-capability
                       imap-data-folder
+		      imap-open-stream
+		      imap-auth-method
                       imap-do-login
                       imap-message-data
                       imap-default-name
-		      imap-username
-		      imap-password
+		      imap-authinfo
                       imap-last-status
                       imap-process
                       imap-tag-num
@@ -174,13 +197,17 @@
           imap-send-command
           imap-send-command-wait
           imap-send-commands-wait
+;	  imap-ok-p
 	  imap-wait-for-tag
 	  imap-capability-get
+	  imap-authinfo-get
           imap-folder-set
           imap-folder-get
           imap-folder-plist
           imap-dispatch
-	  imap-login
+	  imap-authenticate
+	  imap-authenticate-login
+	  imap-authenticate-cram-md5
           imap-message-set
           imap-message-get
           imap-message-map
@@ -290,6 +317,41 @@
   (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 'mel-b) ;; from TM/FLIM
+  (require 'hmac)
+  (require 'md5)
+  (with-current-buffer (or buffer (current-buffer))
+    (and (imap-authinfo-get server)
+	 (or (imap-capability-get) (imap-send-command-wait "CAPABILITY"))
+	 (memq 'AUTH=CRAM-MD5 (imap-capability-get))
+	 (imap-ok-p 
+	  (imap-send-command-wait
+	   (list 
+	    "AUTHENTICATE CRAM-MD5"
+	    (lambda (challenge)
+	      (let* ((decoded (base64-decode-string challenge))
+		     (hmaced (hmac 'md5 64 16 (cdr imap-authinfo) decoded))
+		     (response (concat (car imap-authinfo) " " hmaced))
+		     (encoded (base64-encode-string response)))
+		encoded))))))))
+
+(defun imap-authenticate (server &optional buffer)
+  (when imap-do-login
+    (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)
@@ -301,8 +363,10 @@
       (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))))
+      ;; 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))
 ; I really don't get this.  Is it needed.  If it is, does it really save
 ;   all that much time and/or effort.
@@ -316,6 +380,7 @@
 ;; be internal.  It currently doesn't accept a buffer (nor set one).
 ;; I guess until then this is an internal command also.  Use
 ;; `imap-send-command-wait' instead.
+
 (defun imap-send-command (command &optional buffer callback)
   "Send a COMMAND to the server for BUFFER returning the command's TAG.  If
 BUFFER is omitted or is nil the current buffer is used.  You can
@@ -401,6 +466,12 @@
     (mapcar 'imap-wait-for-tag 
             (mapcar 'imap-send-command command-list))))
 
+(defun imap-ok-p (status)
+  (when (and status
+	     (eq 'OK (car status)))
+    (setq imap-last-status nil)
+    t))
+
 ;;; Variable setters and getters
 
 (defun imap-capability-get (&optional buffer)
@@ -429,6 +500,37 @@
 
 ;;; Internal functions
 
+(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-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))
@@ -632,7 +734,7 @@
                    (mapconcat 'identity
                               '("\"[^\"]*\"" ; quoted strings
                                 "\\[\\|\\]" ; [] characters
-                                "\\(UIDVALIDITY\\|APPENDUID\\) \\([0123456789]+\\)"
+                                "\\(UIDVALIDITY\\|COPYUID\\|APPENDUID\\) \\([0123456789]+\\)"
                                 "\\."   ; . characters
                                 "\\#"   ; # characters
                                 "\\\\"  ; \ characters
@@ -678,7 +780,6 @@
              (insert-buffer-substring buffer))))
       
     (read (current-buffer))))
-      
   
 (defun imap-cb-default (&rest a)
   (error "Default Callback Called %s" a))
diff -u nnimap-0.3.23/manual.html nnimap-0.3.24/manual.html
--- nnimap-0.3.23/manual.html	Thu Aug 20 00:34:51 1998
+++ nnimap-0.3.24/manual.html	Thu Aug 20 22:55:24 1998
@@ -19,6 +19,7 @@
 	<li><a href="#config-server-address">nnimap-server-address</a>
 	<li><a href="#config-server-port">nnimap-server-port</a>
 	<li><a href="#config-list-pattern">nnimap-list-pattern</a>
+	<li><a href="#config-auth-method">nnimap-auth-method</a>
 	<li><a href="#configkrb">Configuring for kerberos</a>
 	<li><a href="#configssl">Configuring for ssl</a>
       </ul>
@@ -90,6 +91,7 @@
 		(nnimap-server-address "cyrus.andrew.cmu.edu")
 		(nnimap-list-pattern ("INBOX" "archive.*")))
 	(nnimap "yoyo"
+                (nnimap-auth-method cram-md5)
 		(nnimap-server-address "your.mail.server"))))
 </pre>
 
@@ -126,21 +128,32 @@
 
 -->
 
-<h3><a name="configkrb">Configuring for kerberos</a></h3>
+<h4><a name="config-auth-method">nnimap-auth-method</a></h4>
 
-<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>:
+<p>This server variable let's you change the login scheme used for the server.
 
-<pre>
-(setq-default imap-open-stream 'imap-open-imtest-stream)
-</pre>
+<p>Valid options are:
 
-<h3><a name="configssl">Configuring for ssl</a></h3>
+<p><dl>
+  <dt>smart
+  <dd>Try to figure out which scheme we should use. Currently this cannot deal with kerberos and ssl, but it will choose CRAM MD5 over plain text passwords.
+  <dt>login
+  <dd>Force plain text password LOGIN.
+  <dt>cram-md5
+  <dd>Force CRAM MD5 authentication.
+  <dt>kerberos4
+  <dd>Force KERBEROS_V4 authentication. See <a href="#configkrb">Configuring for kerberos</a> for further notes.
+  <dt>ssl
+  <dd>Force SSL encryption. See <a href="#configssl">Configuring for SSL</a> for further notes.
+</dl>  
+
+<h3><a name="configkrb">Configuring for kerberos</a></h3>
 
-<p>For SSL encryption you need to have the external program "s_client" (comes with SSLeay) 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 <a href="#config-auth-method">configure nnimap-auth-method</a> accordingly.
 
-<pre>
-(setq-default imap-open-stream 'imap-open-ssl-stream)
-</pre>
+<h3><a name="configssl">Configuring for ssl</a></h3>
+
+<p>For SSL encryption you need to have the external program "s_client" (comes with SSLeay) in your path, and also <a href="#config-auth-method">configure nnimap-auth-method</a> accordingly.
 
 <p><b>Note!</b> If you get SSL to work, please send me a note!  I have not been able to verify that this work.
 
@@ -261,6 +274,6 @@
 <hr>
 <a href="mailto:jas@pdc.kth.se"><address>jas@pdc.kth.se</address></a>
 <!-- hhmts start -->
-Last modified: Sun Aug 16 14:26:44 METDST 1998
+Last modified: Thu Aug 20 00:14:45 METDST 1998
 <!-- hhmts end -->
 </body> </html>
diff -u nnimap-0.3.23/nnimap.el nnimap-0.3.24/nnimap.el
--- nnimap-0.3.23/nnimap.el	Thu Aug 20 00:34:51 1998
+++ nnimap-0.3.24/nnimap.el	Thu Aug 20 22:55:25 1998
@@ -63,7 +63,6 @@
 ;;;     servers/inboxes
 ;;;   o fix nnimap-request-list 'fast and default to it if possible
 ;;;   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 use \Draft to support the draft group??
 ;;;   o What do I do with gnus-newsgroup-*?
@@ -110,7 +109,7 @@
 
 (nnoo-declare nnimap) ; we derive from no one
 
-(defconst nnimap-version "nnimap 0.3.23")
+(defconst nnimap-version "nnimap 0.3.24")
 
 (defvoo nnimap-list-pattern "*" 
 "*PATTERN or list of PATTERNS use to limit available groups.  
@@ -954,7 +953,9 @@
 		;; 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")))))
+		(when (nnimap-send-command-wait "CLOSE")
+		  (setq imap-current-folder nil
+			imap-message-data nil))))))
     t))
 
 ;; nnimap-request-scan doesn't need to do anything. the delivery agent