sievel-manage.el: fully support STARTTLS, fix bit rot

* Make sieve-manage-open work with STARTTLS: shorten stream managing
  functions by using open-protocol-stream to do most of the work.  Has
  the nice benefit of enabling STARTTLS.

* Remove unneeded functions and options: the following functions and
  options are neither in the API, nor called by any other function, so
  they are deleted:
  - sieve-manage-network-p
  - sieve-manage-network-open
  - sieve-manage-starttls-p
  - sieve-manage-starttls-open
  - sieve-manage-forward
  - sieve-manage-streams
  - sieve-manage-stream-alist

  The options could not be applied in a meaningful way anymore; they
  didn't happen to have much effect before.

* Cosmetic changes and code clean-up

* Enable Multibyte for SieveManage buffers: The parser won't properly
  handle umlauts and line endings unless multibyte is turned on in the
  process buffer.

* Wait for capabilities after STARTTLS: following RFC5804, the server
  sends new capabilities after successfully establishing a TLS
  connection with the client.  The client should update the cached list
  of capabilities, but we just ignore the answer for now.

Signed-off-by: Julien Danjou <julien@danjou.info>

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 3765033..29f678c 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,21 @@
+2013-06-10  Albert Krewinkel  <krewinkel@moltkeplatz.de>
+
+       * sieve-manage.el (sieve-manage-open): work with STARTTLS: shorten
+       stream managing functions by using open-protocol-stream to do most of
+       the work. Has the nice benefit of enabling STARTTLS.
+       Wait for capabilities after STARTTLS: following RFC5804, the server
+       sends new capabilities after successfully establishing a TLS connection
+       with the client. The client should update the cached list of
+       capabilities, but we just ignore the answer for now.
+       (sieve-manage-network-p, sieve-manage-network-open)
+       (sieve-manage-starttls-p, sieve-manage-starttls-open)
+       (sieve-manage-forward, sieve-manage-streams)
+       (sieve-manage-stream-alist): Remove unneeded functions neither in the
+       API, nor called by any other function.
+       Enable Multibyte for SieveManage buffers: The parser won't properly
+       handle umlauts and line endings unless multibyte is turned on in the
+       process buffer.
+
 2013-06-11  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 
        * eww.el (eww-tag-input): Support password fields.

diff --git a/lisp/sieve-manage.el b/lisp/sieve-manage.el
index b962617..23ab241 100644 (file)
--- a/lisp/sieve-manage.el
+++ b/lisp/sieve-manage.el
@@ -3,6 +3,7 @@
 ;; Copyright (C) 2001-2013 Free Software Foundation, Inc.
 
 ;; Author: Simon Josefsson <simon@josefsson.org>
+;;         Albert Krewinkel <tarleb@moltkeplatz.de>
 
 ;; This file is part of GNU Emacs.
 
@@ -66,6 +67,7 @@
 ;; 2001-10-31 Committed to Oort Gnus.
 ;; 2002-07-27 Added DELETESCRIPT.  Suggested by Ned Ludd.
 ;; 2002-08-03 Use SASL library.
+;; 2013-06-05 Enabled STARTTLS support, fixed bit rot.
 
 ;;; Code:
 
@@ -82,7 +84,6 @@
   (require 'sasl)
   (require 'starttls))
 (autoload 'sasl-find-mechanism "sasl")
-(autoload 'starttls-open-stream "starttls")
 (autoload 'auth-source-search "auth-source")
 
 ;; User customizable variables:
@@ -107,23 +108,6 @@
   :type 'string
   :group 'sieve-manage)
 
-(defcustom sieve-manage-streams '(network starttls shell)
-  "Priority of streams to consider when opening connection to server."
-  :group 'sieve-manage)
-
-(defcustom sieve-manage-stream-alist
-  '((network   sieve-manage-network-p          sieve-manage-network-open)
-    (shell     sieve-manage-shell-p            sieve-manage-shell-open)
-    (starttls  sieve-manage-starttls-p         sieve-manage-starttls-open))
-  "Definition of network streams.
-
-\(NAME CHECK OPEN)
-
-NAME names the stream, CHECK is a function returning non-nil if the
-server support the stream and OPEN is a function for opening the
-stream."
-  :group 'sieve-manage)
-
 (defcustom sieve-manage-authenticators '(digest-md5
                                         cram-md5
                                         scram-md5
@@ -156,8 +140,7 @@ for doing the actual authentication."
   :group 'sieve-manage)
 
 (defcustom sieve-manage-default-stream 'network
-  "Default stream type to use for `sieve-manage'.
-Must be a name of a stream in `sieve-manage-stream-alist'."
+  "Default stream type to use for `sieve-manage'."
   :version "24.1"
   :type 'symbol
   :group 'sieve-manage)
@@ -185,17 +168,21 @@ Valid states are `closed', `initial', `nonauth', and `auth'.")
 (defvar sieve-manage-capability nil)
 
 ;; Internal utility functions
-
-(defmacro sieve-manage-disable-multibyte ()
-  "Enable multibyte in the current buffer."
-  (unless (featurep 'xemacs)
-    '(set-buffer-multibyte nil)))
+(defun sieve-manage-make-process-buffer ()
+  (with-current-buffer
+      (generate-new-buffer (format " *sieve %s:%s*"
+                                   sieve-manage-server
+                                   sieve-manage-port))
+    (mapc 'make-local-variable sieve-manage-local-variables)
+    (mm-enable-multibyte)
+    (buffer-disable-undo)
+    (current-buffer)))
 
 (defun sieve-manage-erase (&optional p buffer)
   (let ((buffer (or buffer (current-buffer))))
     (and sieve-manage-log
         (with-current-buffer (get-buffer-create sieve-manage-log)
-          (sieve-manage-disable-multibyte)
+          (mm-enable-multibyte)
           (buffer-disable-undo)
           (goto-char (point-max))
           (insert-buffer-substring buffer (with-current-buffer buffer
@@ -204,71 +191,32 @@ Valid states are `closed', `initial', `nonauth', and `auth'.")
                                            (point-max)))))))
   (delete-region (point-min) (or p (point-max))))
 
-(defun sieve-manage-open-1 (buffer)
+(defun sieve-manage-open-server (server port &optional stream buffer)
+  "Open network connection to SERVER on PORT.
+Return the buffer associated with the connection."
   (with-current-buffer buffer
     (sieve-manage-erase)
-    (setq sieve-manage-state 'initial
-         sieve-manage-process
-         (condition-case ()
-             (funcall (nth 2 (assq sieve-manage-stream
-                                   sieve-manage-stream-alist))
-                      "sieve" buffer sieve-manage-server sieve-manage-port)
-           ((error quit) nil)))
-    (when sieve-manage-process
-      (while (and (eq sieve-manage-state 'initial)
-                 (memq (process-status sieve-manage-process) '(open run)))
-       (message "Waiting for response from %s..." sieve-manage-server)
-       (accept-process-output sieve-manage-process 1))
-      (message "Waiting for response from %s...done" sieve-manage-server)
-      (and (memq (process-status sieve-manage-process) '(open run))
-          sieve-manage-process))))
-
-;; Streams
-
-(defun sieve-manage-network-p (buffer)
-  t)
-
-(defun sieve-manage-network-open (name buffer server port)
-  (let* ((port (or port sieve-manage-default-port))
-        (coding-system-for-read sieve-manage-coding-system-for-read)
-        (coding-system-for-write sieve-manage-coding-system-for-write)
-        (process (open-network-stream name buffer server port)))
-    (when process
-      (while (and (memq (process-status process) '(open run))
-                 (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
-                 (goto-char (point-min))
-                 (not (sieve-manage-parse-greeting-1)))
-       (accept-process-output process 1)
-       (sit-for 1))
-      (sieve-manage-erase nil buffer)
-      (when (memq (process-status process) '(open run))
-       process))))
-
-(defun sieve-manage-starttls-p (buffer)
-  (condition-case ()
-      (progn
-       (require 'starttls)
-       (call-process "starttls"))
-    (error nil)))
-
-(defun sieve-manage-starttls-open (name buffer server port)
-  (let* ((port (or port sieve-manage-default-port))
-        (coding-system-for-read sieve-manage-coding-system-for-read)
-        (coding-system-for-write sieve-manage-coding-system-for-write)
-        (process (starttls-open-stream name buffer server port))
-        done)
-    (when process
-      (while (and (memq (process-status process) '(open run))
-                 (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
-                 (goto-char (point-min))
-                 (not (sieve-manage-parse-greeting-1)))
-       (accept-process-output process 1)
-       (sit-for 1))
-      (sieve-manage-erase nil buffer)
-      (sieve-manage-send "STARTTLS")
-      (starttls-negotiate process))
-    (when (memq (process-status process) '(open run))
-      process)))
+    (setq sieve-manage-state 'initial)
+    (destructuring-bind (proc . props)
+        (open-protocol-stream
+         "SIEVE" buffer server port
+         :type stream
+         :capability-command "CAPABILITY\r\n"
+         :end-of-command "^\\(OK\\|NO\\).*\n"
+         :success "^OK.*\n"
+         :return-list t
+         :starttls-function
+         '(lambda (capabilities)
+            (when (string-match "\\bSTARTTLS\\b" capabilities)
+              "STARTTLS\r\n")))
+      (setq sieve-manage-process proc)
+      (setq sieve-manage-capability
+            (sieve-manage-parse-capability (getf props :capabilities)))
+      ;; Ignore new capabilities issues after successful STARTTLS
+      (when (and (memq stream '(nil network starttls))
+                 (eq (getf props :type) 'tls))
+        (sieve-manage-drop-next-answer))
+      (current-buffer))))
 
 ;; Authenticators
 (defun sieve-sasl-auth (buffer mech)
@@ -396,63 +344,33 @@ Optional argument AUTH indicates authenticator to use, see
 If nil, chooses the best stream the server is capable of.
 Optional argument BUFFER is buffer (buffer, or string naming buffer)
 to work in."
-  (or port (setq port sieve-manage-default-port))
-  (setq buffer (or buffer (format " *sieve* %s:%s" server port)))
-  (with-current-buffer (get-buffer-create buffer)
-    (mapc 'make-local-variable sieve-manage-local-variables)
-    (sieve-manage-disable-multibyte)
-    (buffer-disable-undo)
-    (setq sieve-manage-server (or server sieve-manage-server))
-    (setq sieve-manage-port port)
-    (setq sieve-manage-stream (or stream sieve-manage-stream))
+  (setq sieve-manage-port (or port sieve-manage-default-port))
+  (with-current-buffer (or buffer (sieve-manage-make-process-buffer))
+    (setq sieve-manage-server (or server
+                                  sieve-manage-server)
+          sieve-manage-stream (or stream
+                                  sieve-manage-stream
+                                  sieve-manage-default-stream)
+          sieve-manage-auth   (or auth
+                                  sieve-manage-auth))
     (message "sieve: Connecting to %s..." sieve-manage-server)
-    (if (let ((sieve-manage-stream
-              (or sieve-manage-stream sieve-manage-default-stream)))
-         (sieve-manage-open-1 buffer))
-       ;; Choose stream.
-       (let (stream-changed)
-         (message "sieve: Connecting to %s...done" sieve-manage-server)
-         (when (null sieve-manage-stream)
-           (let ((streams sieve-manage-streams))
-             (while (setq stream (pop streams))
-               (if (funcall (nth 1 (assq stream
-                                         sieve-manage-stream-alist)) buffer)
-                   (setq stream-changed
-                         (not (eq (or sieve-manage-stream
-                                      sieve-manage-default-stream)
-                                  stream))
-                         sieve-manage-stream stream
-                         streams nil)))
-             (unless sieve-manage-stream
-               (error "Couldn't figure out a stream for server"))))
-         (when stream-changed
-           (message "sieve: Reconnecting with stream `%s'..."
-                    sieve-manage-stream)
-           (sieve-manage-close buffer)
-           (if (sieve-manage-open-1 buffer)
-               (message "sieve: Reconnecting with stream `%s'...done"
-                        sieve-manage-stream)
-             (message "sieve: Reconnecting with stream `%s'...failed"
-                      sieve-manage-stream))
-           (setq sieve-manage-capability nil))
-         (if (sieve-manage-opened buffer)
-             ;; Choose authenticator
-             (when (and (null sieve-manage-auth)
-                        (not (eq sieve-manage-state 'auth)))
-               (let ((auths sieve-manage-authenticators))
-                 (while (setq auth (pop auths))
-                   (if (funcall (nth 1 (assq
-                                        auth
-                                        sieve-manage-authenticator-alist))
-                                buffer)
-                       (setq sieve-manage-auth auth
-                             auths nil)))
-                 (unless sieve-manage-auth
-                   (error "Couldn't figure out authenticator for server"))))))
-      (message "sieve: Connecting to %s...failed" sieve-manage-server))
-    (when (sieve-manage-opened buffer)
+    (sieve-manage-open-server sieve-manage-server
+                              sieve-manage-port
+                              sieve-manage-stream
+                              (current-buffer))
+    (when (sieve-manage-opened (current-buffer))
+      ;; Choose authenticator
+      (when (and (null sieve-manage-auth)
+                 (not (eq sieve-manage-state 'auth)))
+        (dolist (auth sieve-manage-authenticators)
+          (when (funcall (nth 1 (assq auth sieve-manage-authenticator-alist))
+                       buffer)
+            (setq sieve-manage-auth auth)
+            (return)))
+        (unless sieve-manage-auth
+          (error "Couldn't figure out authenticator for server")))
       (sieve-manage-erase)
-      buffer)))
+      (current-buffer))))
 
 (defun sieve-manage-authenticate (&optional buffer)
   "Authenticate on server in BUFFER.
@@ -544,12 +462,22 @@ If NAME is nil, return the full server list of capabilities."
 
 ;; Protocol parsing routines
 
+(defun sieve-manage-wait-for-answer ()
+  (let ((pattern "^\\(OK\\|NO\\).*\n")
+        pos)
+    (while (not pos)
+      (setq pos (search-forward-regexp pattern nil t))
+      (goto-char (point-min))
+      (sleep-for 0 50))
+    pos))
+
+(defun sieve-manage-drop-next-answer ()
+  (sieve-manage-wait-for-answer)
+  (sieve-manage-erase))
+
 (defun sieve-manage-ok-p (rsp)
   (string= (downcase (or (car-safe rsp) "")) "ok"))
 
-(defsubst sieve-manage-forward ()
-  (or (eobp) (forward-char)))
-
 (defun sieve-manage-is-okno ()
   (when (looking-at (concat
                     "^\\(OK\\|NO\\)\\( (\\([^)]+\\))\\)?\\( \\(.*\\)\\)?"
@@ -571,21 +499,15 @@ If NAME is nil, return the full server list of capabilities."
     (sieve-manage-erase)
     rsp))
 
-(defun sieve-manage-parse-capability-1 ()
-  "Accept a managesieve greeting."
-  (let (str)
-    (while (setq str (sieve-manage-is-string))
-      (if (eq (char-after) ? )
-         (progn
-           (sieve-manage-forward)
-           (push (list str (sieve-manage-is-string))
-                 sieve-manage-capability))
-       (push (list str) sieve-manage-capability))
-      (forward-line)))
-  (when (re-search-forward (concat "^OK.*" sieve-manage-server-eol) nil t)
-    (setq sieve-manage-state 'nonauth)))
-
-(defalias 'sieve-manage-parse-greeting-1 'sieve-manage-parse-capability-1)
+(defun sieve-manage-parse-capability (str)
+  "Parse managesieve capability string `STR'.
+Set variable `sieve-manage-capability' to "
+  (let ((capas (remove-if #'null
+                          (mapcar #'split-string-and-unquote
+                                  (split-string str "\n")))))
+    (when (string= "OK" (caar (last capas)))
+      (setq sieve-manage-state 'nonauth))
+    capas))
 
 (defun sieve-manage-is-string ()
   (cond ((looking-at "\"\\([^\"]+\\)\"")
@@ -639,7 +561,7 @@ If NAME is nil, return the full server list of capabilities."
   (setq cmdstr (concat cmdstr sieve-manage-client-eol))
   (and sieve-manage-log
        (with-current-buffer (get-buffer-create sieve-manage-log)
-        (sieve-manage-disable-multibyte)
+        (mm-enable-multibyte)
         (buffer-disable-undo)
         (goto-char (point-max))
         (insert cmdstr)))