[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
nnimap 0.90 -> 0.91 patches
Index: nnimap/ChangeLog
diff -c nnimap/ChangeLog:1.166 nnimap/ChangeLog:1.168
*** nnimap/ChangeLog:1.166 Mon Jan 4 13:49:56 1999
--- nnimap/ChangeLog Thu Jan 7 13:26:01 1999
***************
*** 1,3 ****
--- 1,42 ----
+ 1999-01-07 22:23:35 Simon Josefsson <jas@pdc.kth.se>
+
+ * nnimap 0.91 released.
+
+ 1999-01-07 22:21:23 Simon Josefsson <jas@pdc.kth.se>
+
+ * nnimap.el (gnus-group-nnimap-edit-acl):
+ (gnus-group-nnimap-edit-acl-done): Use IMAP ACL functions.
+
+ 1999-01-07 22:19:00 Simon Josefsson <jas@pdc.kth.se>
+
+ * imap.el (imap-parse-astring): Turn IMAP-atoms into
+ elisp-strings.
+
+ 1999-01-07 22:18:53 Simon Josefsson <jas@pdc.kth.se>
+
+ * imap.el (imap-mailbox-acl-get):
+ (imap-mailbox-acl-set):
+ (imap-mailbox-acl-delete):
+ (imap-response-data-acl): New functions for ACL stuff.
+
+ 1999-01-07 21:10:36 Simon Josefsson <jas@pdc.kth.se>
+
+ * imap.el (imap-open-1): Condition-case open function. Check
+ process status.
+
+ 1999-01-07 21:09:08 Simon Josefsson <jas@pdc.kth.se>
+
+ * imap.el (imap-network-open): Parse greeting. Don't condition-case.
+
+ 1999-01-05 17:48:11 Simon Josefsson <jas@pdc.kth.se>
+
+ * nnimap.el (nnimap-retrieve-headers): Request BODYSTRUCTURE
+ instead of BODY (has no use for extension data).
+
+ 1999-01-05 00:16:05 Simon Josefsson <jas@pdc.kth.se>
+
+ * nnimap.el: Comments separating new and old code.
+
1999-01-04 22:46:52 Simon Josefsson <jas@pdc.kth.se>
* nnimap 0.90 released.
Index: nnimap/imap.el
diff -c nnimap/imap.el:1.104 nnimap/imap.el:1.105
*** nnimap/imap.el:1.104 Mon Jan 4 13:44:52 1999
--- nnimap/imap.el Thu Jan 7 13:23:00 1999
***************
*** 333,347 ****
(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" imap-imtest-arguments
server (number-to-string port))))
! (with-current-buffer (process-buffer process)
! (setq imap-client-eol "\n")
! (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-min))
--- 333,347 ----
(imap-capability 'AUTH=KERBEROS_V4 buffer))
(defun imap-kerberos4-open (name buffer server port)
! (message "Opening Kerberized IMAP connection...")
! (let* ((port (or port imap-default-port))
! (coding-system-for-read imap-coding-system-for-read)
(coding-system-for-write imap-coding-system-for-write)
(process (start-process name buffer "imtest" imap-imtest-arguments
server (number-to-string port))))
! (when process
! (with-current-buffer buffer
! (setq imap-client-eol "\n")
;; Result of authentication is a string: __Full privacy protection__
(while (and (memq (process-status process) '(open run))
(goto-char (point-min))
***************
*** 354,420 ****
(imap-disable-multibyte)
(buffer-disable-undo)
(goto-char (point-max))
! (insert-buffer (process-buffer process))))
! (let ((response (match-string 1)))
! (erase-buffer)
! (message "Kerberized IMAP connection: %s" response)
! (if (let ((case-fold-search nil))
! (and response
! (not (string-match "failed" response))))
! process
! (if (memq (process-status process) '(open run))
! (imap-send-command-wait "LOGOUT"))
! (delete-process process)
! nil))))))
(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-max))
! (forward-line -1)
! (not (imap-parse-greeting)))
! (accept-process-output proc 1)
! (sit-for 1))
! (and imap-log
! (with-current-buffer (get-buffer-create imap-log)
! (imap-disable-multibyte)
! (buffer-disable-undo)
! (goto-char (point-max))
! (insert-buffer buffer)))
! (erase-buffer)
! (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:
--- 354,430 ----
(imap-disable-multibyte)
(buffer-disable-undo)
(goto-char (point-max))
! (insert-buffer buffer)))
! (let ((response (match-string 1)))
! (erase-buffer)
! (message "Kerberized IMAP connection: %s" response)
! (if (and response (let ((case-fold-search nil))
! (not (string-match "failed" response))))
! process
! (if (memq (process-status process) '(open run))
! (imap-send-command-wait "LOGOUT"))
! (delete-process process)
! nil))))))
(defun imap-ssl-p (buffer)
nil)
(defun imap-ssl-open-1 (name buffer server port extra-arg)
! (let* ((port (or port imap-default-ssl-port))
! (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" server port)))
! (process (open-ssl-stream name buffer server port)))
! (when process
! (with-current-buffer buffer
! (goto-char (point-min))
! (while (and (memq (process-status process) '(open run))
! (goto-char (point-max))
! (forward-line -1)
! (not (imap-parse-greeting)))
! (accept-process-output process 1)
! (sit-for 1))
! (and imap-log
! (with-current-buffer (get-buffer-create imap-log)
! (imap-disable-multibyte)
! (buffer-disable-undo)
! (goto-char (point-max))
! (insert-buffer buffer)))
! (erase-buffer))
! (when (memq (process-status process) '(open run))
! process))))
(defun imap-ssl-open (name buffer server port)
! (message "Opening SSL3 IMAP connection...")
(let ((ret (imap-ssl-open-1 name buffer server port "-ssl3")))
(if ret
ret
! (message "Opening SSL2 IMAP connection...")
(imap-ssl-open-1 name buffer server port "-ssl2"))))
(defun imap-network-p (buffer)
t)
(defun imap-network-open (name buffer server port)
! (let* ((port (or port imap-default-port))
! (coding-system-for-read imap-coding-system-for-read)
! (coding-system-for-write imap-coding-system-for-write)
! (process (open-network-stream name buffer server port)))
! (when process
! (while (and (memq (process-status process) '(open run))
! (goto-char (point-min))
! (not (imap-parse-greeting)))
! (accept-process-output process 1)
! (sit-for 1))
! (and imap-log
! (with-current-buffer (get-buffer-create imap-log)
! (imap-disable-multibyte)
! (buffer-disable-undo)
! (goto-char (point-max))
! (insert-buffer buffer)))
! (when (memq (process-status process) '(open run))
! process))))
;; Server functions; authenticator stuff:
***************
*** 509,524 ****
(setq imap-current-mailbox nil
imap-current-message nil
imap-state 'initial
! imap-process (funcall (nth 2 (assq imap-stream imap-stream-alist))
! "imap" buffer imap-server imap-port))
(when imap-process
(set-process-filter imap-process 'imap-arrival-filter)
(set-process-sentinel imap-process 'imap-sentinel)
! (while (eq imap-state 'initial)
! (message "Waiting for server response...")
(accept-process-output imap-process 1))
! (message "Waiting for server response...done")
! imap-process)))
(defun imap-open (server &optional port stream auth buffer)
"Open a IMAP connection to host SERVER at PORT returning a
--- 519,539 ----
(setq imap-current-mailbox nil
imap-current-message nil
imap-state 'initial
! imap-process (condition-case ()
! (funcall (nth 2 (assq imap-stream
! imap-stream-alist))
! "imap" buffer imap-server imap-port)
! ((error quit) nil)))
(when imap-process
(set-process-filter imap-process 'imap-arrival-filter)
(set-process-sentinel imap-process 'imap-sentinel)
! (while (and (eq imap-state 'initial)
! (memq (process-status imap-process) '(open run)))
! (message "Waiting for response from %s..." imap-server)
(accept-process-output imap-process 1))
! (message "Waiting for response from %s...done" imap-server)
! (and (memq (process-status imap-process) '(open run))
! imap-process))))
(defun imap-open (server &optional port stream auth buffer)
"Open a IMAP connection to host SERVER at PORT returning a
***************
*** 774,779 ****
--- 789,824 ----
items)
(imap-mailbox-get items mailbox)))))
+ (defun imap-mailbox-acl-get (&optional mailbox buffer)
+ "Get ACL on mailbox from server in BUFFER."
+ (with-current-buffer (or buffer (current-buffer))
+ (when (imap-ok-p
+ (imap-send-command-wait (list "GETACL "
+ (or mailbox imap-current-mailbox))))
+ (imap-mailbox-get 'acl (or mailbox imap-current-mailbox)))))
+
+ (defun imap-mailbox-acl-set (identifier rights &optional mailbox buffer)
+ "Change/set ACL for IDENTIFIER to RIGHTS in MAILBOX from server in
+ BUFFER."
+ (with-current-buffer (or buffer (current-buffer))
+ (imap-ok-p
+ (imap-send-command-wait (list "SETACL "
+ (or mailbox imap-current-mailbox)
+ " "
+ identifier
+ " "
+ rights)))))
+
+ (defun imap-mailbox-acl-delete (identifier &optional mailbox buffer)
+ "Removes any <identifier,rights> pair for IDENTIFIER in MAILBOX from
+ server in BUFFER."
+ (with-current-buffer (or buffer (current-buffer))
+ (imap-ok-p
+ (imap-send-command-wait (list "DELETEACL "
+ (or mailbox imap-current-mailbox)
+ " "
+ identifier)))))
+
;; Message functions:
***************
*** 980,986 ****
(defsubst imap-parse-astring ()
(or (imap-parse-string)
! (read (current-buffer))))
;; mailbox = "INBOX" / astring
;; ; INBOX is case-insensitive. All case variants of
--- 1025,1031 ----
(defsubst imap-parse-astring ()
(or (imap-parse-string)
! (symbol-name (read (current-buffer)))))
;; mailbox = "INBOX" / astring
;; ; INBOX is case-insensitive. All case variants of
***************
*** 1358,1363 ****
--- 1403,1427 ----
(t
(message "Unknown status data %s in mailbox %s ignored"
token mailbox))))))))
+
+ ;; acl_data ::= "ACL" SPACE mailbox *(SPACE identifier SPACE
+ ;; rights)
+ ;;
+ ;; identifier ::= astring
+ ;;
+ ;; rights ::= astring
+
+ (defun imap-response-data-acl (response)
+ (let ((mailbox (imap-parse-mailbox)))
+ (when (eq (char-after) ?\ )
+ (let (acl)
+ (while (eq (char-after) ?\ )
+ (let (identifier rights)
+ (setq identifier (imap-parse-astring))
+ (when (equal (char-after) ?\ )
+ (setq rights (imap-parse-astring))
+ (setq acl (append acl (list (cons identifier rights)))))))
+ (imap-mailbox-put 'acl acl mailbox)))))
;; flag-list = "(" [flag *(SP flag)] ")"
;;
Index: nnimap/nnimap.el
diff -c nnimap/nnimap.el:1.122 nnimap/nnimap.el:1.124
*** nnimap/nnimap.el:1.122 Mon Jan 4 13:50:28 1999
--- nnimap/nnimap.el Thu Jan 7 13:26:12 1999
***************
*** 81,86 ****
--- 81,90 ----
;;; .newsrc.eld)
;;; o MIME
+ ;; nnimap 1.x variables:
+
+ ;; Legacy variables:
+
(require 'imap)
(require 'nnoo)
***************
*** 96,102 ****
(nnoo-declare nnimap) ; we derive from no one
! (defconst nnimap-version "nnimap 0.90")
;; Various server variables.
--- 100,106 ----
(nnoo-declare nnimap) ; we derive from no one
! (defconst nnimap-version "nnimap 0.91")
;; Various server variables.
***************
*** 340,345 ****
--- 344,353 ----
nnimap-update-flags-hook
)))
+ ;; nnimap 1.x functions:
+
+ ;; legacy functions:
+
;;; Interface functions, required backend functions
***************
*** 399,409 ****
(if (and fetch-old (not (numberp fetch-old)))
"1:*"
(nnimap-range-to-string compressed))
! " (UID RFC822.HEADER RFC822.SIZE BODY)"))))
(mapc (lambda (num)
(let* ((header (imap-message-get num 'RFC822.HEADER))
(size (imap-message-get num 'RFC822.SIZE))
! (body (imap-message-get num 'BODY))
(lines (nnimap-body-lines body)))
(with-current-buffer nntp-server-buffer
(if (not header)
--- 407,417 ----
(if (and fetch-old (not (numberp fetch-old)))
"1:*"
(nnimap-range-to-string compressed))
! " (UID RFC822.HEADER RFC822.SIZE BODYSTRUCTURE)"))))
(mapc (lambda (num)
(let* ((header (imap-message-get num 'RFC822.HEADER))
(size (imap-message-get num 'RFC822.SIZE))
! (body (imap-message-get num 'BODYSTRUCTURE))
(lines (nnimap-body-lines body)))
(with-current-buffer nntp-server-buffer
(if (not header)
***************
*** 1235,1251 ****
(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-mailbox-put 'acl nil mailbox)
! (nnimap-send-command-wait (format "GETACL %s" mailbox))
! (setq acl (destructive-plist-to-alist
! (imap-mailbox-get 'acl mailbox))))
(format "Editing the access control list for `%s'.
An access control list is a list of (identifier . rights) elements.
! The identifier specifies the corresponding user. The identifier
! `anyone' is reserved to refer to the universal identity.
Rights is a string listing a (possibly empty) set of alphanumeric
characters, each character listing a set of operations which is being
--- 1243,1256 ----
(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 (setq acl (imap-mailbox-acl-get mailbox
! nnimap-server-buffer))
(format "Editing the access control list for `%s'.
An access control list is a list of (identifier . rights) elements.
! The identifier string specifies the corresponding user. The
! identifier \"anyone\" is reserved to refer to the universal identity.
Rights is a string listing a (possibly empty) set of alphanumeric
characters, each character listing a set of operations which is being
***************
*** 1268,1300 ****
(gnus-group-nnimap-edit-acl-done
,mailbox ',method ',acl form))))))
! (defun gnus-group-nnimap-edit-acl-done (mailbox method old-acls acls)
(when (nnimap-possibly-change-server (cadr method))
(with-current-buffer nnimap-server-buffer
;; delete all removed identifiers
! (let ((deleted (copy-list old-acls))
! (dontdelete acls) acl)
! (while (setq acl (pop deleted))
! (unless (assoc (car acl) dontdelete)
! (let ((status
! (nnimap-send-command-wait
! (format "DELETEACL %s %s" mailbox (car acl)))))
! (when (and (listp status)
! (eq 'NO (car status)))
! (error "Can't delete ACL: %s" (cadr status))))))
;; set all changed acl's
! (let ((new-acls acls) acl)
! (while (setq acl (pop new-acls))
! (let* ((user (car acl))
! (access (cdr acl))
! (old-access (cdr (assoc user old-acls))))
! (unless (string= access old-access)
! (let ((status
! (nnimap-send-command-wait
! (format "SETACL %s %s %s" mailbox user access))))
! (when (and (listp status)
! (eq 'NO (car status)))
! (error "Can't set ACL: %s" (cadr status))))))))))))
;;; Gnus glue
--- 1273,1298 ----
(gnus-group-nnimap-edit-acl-done
,mailbox ',method ',acl form))))))
! (defun gnus-group-nnimap-edit-acl-done (mailbox method old-acls new-acls)
(when (nnimap-possibly-change-server (cadr method))
(with-current-buffer nnimap-server-buffer
;; delete all removed identifiers
! (mapcar (lambda (old-acl)
! (unless (assoc (car old-acl) new-acls)
! (or (imap-mailbox-acl-delete (car old-acl) mailbox)
! (error "Can't delete ACL for %s..." (car old-acl)))))
! old-acls)
;; set all changed acl's
! (mapcar (lambda (new-acl)
! (let ((new-rights (cdr new-acl))
! (old-rights (cdr (assoc (car new-acl) old-acls))))
! (unless (and old-rights new-rights
! (string= old-rights new-rights))
! (or (imap-mailbox-acl-set (car new-acl) new-rights mailbox)
! (error "Can't set ACL for %s to %s..." (car new-acl)
! new-rights)))))
! new-acls)
! t)))
;;; Gnus glue