bug#54154: 29.0.50; [PATCH] `sieve-manage-getscript' fails if script contains multibyte characters

[Kai Tetzlaff]

Lars Ingebrigtsen <larsi@gnus.org> writes:

> Kai Tetzlaff <kai@tetzlaff.eu> writes:
>
>> So just reverting it won't work. I will try to undo the parts relevant
>> to this issue.
>
> Sounds good.

Ok, I'm attaching two patches which fix all issues I noticed.

What I ended up with is quite a bit more than the initial attempt. Since
these changes are non-trivial, I will need to do the copyright
assignment. About a week ago I actually sent an email to assign@gnu.org
to get the process started. But I haven't received a reply. Could you
please send me the necessary papers? I'm in Germany, so my understanding
is that it should be possible to do this electronically?


The first (and major) set of fixes are in sieve-manage.el for the issues
with multibyte characters in sieve scripts
(sieve-manage-getscript/putscript). This also adds supports for
multibyte characters in script names
(sieve-manage-listscripts/getscript/putscript/havespace/deletescript/setactive).

There is now also some handling of getscript errors reported by the
server and improved logging.

>From fd18929ce2004f7448ab997bc86e206afdbd8673 Mon Sep 17 00:00:00 2001
From: Kai Tetzlaff <emacs@tetzco.de>
Date: Mon, 28 Feb 2022 11:08:07 +0100
Subject: [PATCH 1/2] Fix (mostly multibyte) issues in sieve-manage.el 
 (Bug#54154)

The managesieve protocol (s. RFC5804) requires support for (a sightly
restricted variant of) UTF-8 in script content and script names. This
commit fixes/improves the handling of multibyte characters.

In addition, `sieve-manage-getscript' now properly handles NO
responses from the server instead of inflooping.

There are also some logging improvements.

* lisp/net/sieve-manage.el
(sieve-manage--append-to-log):
(sieve-manage--message):
(sieve-manage--error):
(sieve-manage-encode):
(sieve-manage-decode):
(sieve-manage-no-p): New functions.
(sieve-manage-make-process-buffer): Switch process buffer to unibyte.
(sieve-manage-open-server): Add `:coding 'raw-text-unix` to
`open-network-stream' call. Use unix EOLs in order to keep matching
CRLF (aka "\r\n") intact.
(sieve-manage-send): Make sure that UTF-8 multibyte characters are
properly encoded before sending data to the server.
(sieve-manage-getscript):
(sieve-manage-putscript): Use the changes above to fix down/uploading
scripts containing UTF-8 multibyte characters.
(sieve-manage-listscripts):
(sieve-manage-havespace)
(sieve-manage-getscript)
(sieve-manage-putscript):
(sieve-manage-deletescript):
(sieve-manage-setactive): Use the changes above to fix handling of
script names which contain UTF-8 multibyte characters.
(sieve-manage-parse-string):
(sieve-manage-getscript): Add handling of server responses with type
NO. Abort `sieve-manage-getscript' and show error message in message
area.
(sieve-manage-erase):
(sieve-manage-drop-next-answer):
(sieve-manage-parse-crlf): Return erased/dropped data (instead of nil).
(sieve-sasl-auth):
(sieve-manage-getscript):
(sieve-manage-erase):
(sieve-manage-open-server):
(sieve-manage-open):
(sieve-manage-send): Improve logging.
---
 lisp/net/sieve-manage.el | 125 +++++++++++++++++++++++++++------------
 1 file changed, 86 insertions(+), 39 deletions(-)

diff --git a/lisp/net/sieve-manage.el b/lisp/net/sieve-manage.el
index 50342b9105..a57d81efcd 100644
--- a/lisp/net/sieve-manage.el
+++ b/lisp/net/sieve-manage.el
@@ -167,7 +167,52 @@ sieve-manage-process
 (defvar sieve-manage-capability nil)
 
 ;; Internal utility functions
-(autoload 'mm-enable-multibyte "mm-util")
+(defun sieve-manage--append-to-log (&rest args)
+  "Append ARGS to sieve-manage log buffer.
+
+ARGS can be a string or a list of strings.
+The buffer to use for logging is specifified via
+`sieve-manage-log'. If it is nil, logging is disabled."
+  (when sieve-manage-log
+    (with-current-buffer (or (get-buffer sieve-manage-log)
+                             (with-current-buffer
+                                 (get-buffer-create sieve-manage-log)
+                               (set-buffer-multibyte nil)
+                               (buffer-disable-undo)))
+      (goto-char (point-max))
+      (apply #'insert args))))
+
+(defun sieve-manage--message (format-string &rest args)
+  "Wrapper around `message' which also logs to sieve manage log.
+
+See `sieve-manage--append-to-log'."
+  (let ((ret (apply #'message
+                    (concat "sieve-manage: " format-string)
+                    args)))
+    (sieve-manage--append-to-log ret "\n")
+    ret))
+
+(defun sieve-manage--error (format-string &rest args)
+  "Wrapper around `error' which also logs to sieve manage log.
+
+See `sieve-manage--append-to-log'."
+  (let ((msg (apply #'format
+                    (concat "sieve-manage/ERROR: " format-string)
+                    args)))
+    (sieve-manage--append-to-log msg "\n")
+    (error msg)))
+
+(defun sieve-manage-encode (utf8-string)
+  "Convert UTF8-STRING to managesieve protocol octets."
+  (encode-coding-string utf8-string 'raw-text t))
+
+(defun sieve-manage-decode (octets &optional buffer)
+  "Convert managesieve protocol OCTETS to utf-8 string.
+
+If optional BUFFER is non-nil, insert decoded string into BUFFER."
+  (when octets
+    ;; eol type unix is required to preserve "\r\n"
+    (decode-coding-string octets 'utf-8-unix t buffer)))
 
 (defun sieve-manage-make-process-buffer ()
   (with-current-buffer
@@ -175,22 +220,19 @@ sieve-manage-make-process-buffer
                                    sieve-manage-server
                                    sieve-manage-port))
     (mapc #'make-local-variable sieve-manage-local-variables)
-    (mm-enable-multibyte)
+    (set-buffer-multibyte nil)
+    (setq-local after-change-functions nil)
     (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)
-          (mm-enable-multibyte)
-          (buffer-disable-undo)
-          (goto-char (point-max))
-          (insert-buffer-substring buffer (with-current-buffer buffer
-                                            (point-min))
-                                   (or p (with-current-buffer buffer
-                                           (point-max)))))))
-  (delete-region (point-min) (or p (point-max))))
+  (with-current-buffer (or buffer (current-buffer))
+    (let* ((start (point-min))
+           (end (or p (point-max)))
+           (logdata (buffer-substring-no-properties start end)))
+      (sieve-manage--append-to-log logdata)
+      (delete-region start end)
+      logdata)))
 
 (defun sieve-manage-open-server (server port &optional stream buffer)
   "Open network connection to SERVER on PORT.
@@ -202,6 +244,8 @@ sieve-manage-open-server
                  (open-network-stream
                   "SIEVE" buffer server port
                   :type stream
+                  ;; eol type unix is required to preserve "\r\n"
+                  :coding 'raw-text-unix
                   :capability-command "CAPABILITY\r\n"
                   :end-of-command "^\\(OK\\|NO\\).*\n"
                   :success "^OK.*\n"
@@ -224,7 +268,7 @@ sieve-manage-open-server
 ;; Authenticators
 (defun sieve-sasl-auth (buffer mech)
   "Login to server using the SASL MECH method."
-  (message "sieve: Authenticating using %s..." mech)
+  (sieve-manage--message "Authenticating using %s..." mech)
   (with-current-buffer buffer
     (let* ((auth-info (auth-source-search :host sieve-manage-server
                                           :port "sieve"
@@ -275,11 +319,15 @@ sieve-sasl-auth
             (if (and (setq step (sasl-next-step client step))
                      (setq data (sasl-step-data step)))
                 ;; We got data for server but it's finished
-                (error "Server not ready for SASL data: %s" data)
+                (sieve-manage--error
+                 "Server not ready for SASL data: %s" data)
               ;; The authentication process is finished.
+              (sieve-manage--message "Logged in as %s using %s"
+                                     user-name mech)
               (throw 'done t)))
           (unless (stringp rsp)
-            (error "Server aborted SASL authentication: %s" (caddr rsp)))
+            (sieve-manage--error
+             "Server aborted SASL authentication: %s" (caddr rsp)))
           (sasl-step-set-data step (base64-decode-string rsp))
           (setq step (sasl-next-step client step))
           (sieve-manage-send
@@ -288,8 +336,7 @@ sieve-sasl-auth
                        (base64-encode-string (sasl-step-data step)
                                              'no-line-break)
                        "\"")
-             ""))))
-      (message "sieve: Login using %s...done" mech))))
+             "")))))))
 
 (defun sieve-manage-cram-md5-p (buffer)
   (sieve-manage-capability "SASL" "CRAM-MD5" buffer))
@@ -353,7 +400,7 @@ sieve-manage-open
                                   sieve-manage-default-stream)
           sieve-manage-auth   (or auth
                                   sieve-manage-auth))
-    (message "sieve: Connecting to %s..." sieve-manage-server)
+    (sieve-manage--message "Connecting to %s..." sieve-manage-server)
     (sieve-manage-open-server sieve-manage-server
                               sieve-manage-port
                               sieve-manage-stream
@@ -368,7 +415,8 @@ sieve-manage-open
             (setq sieve-manage-auth auth)
             (cl-return)))
         (unless sieve-manage-auth
-          (error "Couldn't figure out authenticator for server")))
+          (sieve-manage--error
+           "Couldn't figure out authenticator for server")))
       (sieve-manage-erase)
       (current-buffer))))
 
@@ -433,11 +481,7 @@ sieve-manage-havespace
 (defun sieve-manage-putscript (name content &optional buffer)
   (with-current-buffer (or buffer (current-buffer))
     (sieve-manage-send (format "PUTSCRIPT \"%s\" {%d+}%s%s" name
-                               ;; Here we assume that the coding-system will
-                               ;; replace each char with a single byte.
-                               ;; This is always the case if `content' is
-                               ;; a unibyte string.
-                              (length content)
+                              (length (sieve-manage-encode content))
                               sieve-manage-client-eol content))
     (sieve-manage-parse-okno)))
 
@@ -449,11 +493,10 @@ sieve-manage-deletescript
 (defun sieve-manage-getscript (name output-buffer &optional buffer)
   (with-current-buffer (or buffer (current-buffer))
     (sieve-manage-send (format "GETSCRIPT \"%s\"" name))
-    (let ((script (sieve-manage-parse-string)))
-      (sieve-manage-parse-crlf)
-      (with-current-buffer output-buffer
-       (insert script))
-      (sieve-manage-parse-okno))))
+    (sieve-manage-decode (sieve-manage-parse-string)
+                         output-buffer)
+    (sieve-manage-parse-crlf)
+    (sieve-manage-parse-okno)))
 
 (defun sieve-manage-setactive (name &optional buffer)
   (with-current-buffer (or buffer (current-buffer))
@@ -478,6 +521,9 @@ sieve-manage-drop-next-answer
 (defun sieve-manage-ok-p (rsp)
   (string= (downcase (or (car-safe rsp) "")) "ok"))
 
+(defun sieve-manage-no-p (rsp)
+  (string= (downcase (or (car-safe rsp) "")) "no"))
+
 (defun sieve-manage-is-okno ()
   (when (looking-at (concat
                     "^\\(OK\\|NO\\)\\( (\\([^)]+\\))\\)?\\( \\(.*\\)\\)?"
@@ -528,7 +574,11 @@ sieve-manage-parse-string
     (while (null rsp)
       (accept-process-output (get-buffer-process (current-buffer)) 1)
       (goto-char (point-min))
-      (setq rsp (sieve-manage-is-string)))
+      (unless (setq rsp (sieve-manage-is-string))
+        (when (sieve-manage-no-p (sieve-manage-is-okno))
+          ;; simple `error' is enough since `sieve-manage-erase'
+          ;; already adds the server response to the log
+          (error (sieve-manage-erase)))))
     (sieve-manage-erase (point))
     rsp))
 
@@ -540,7 +590,8 @@ sieve-manage-parse-listscripts
   (let (tmp rsp data)
     (while (null rsp)
       (while (null (or (setq rsp (sieve-manage-is-okno))
-                      (setq tmp (sieve-manage-is-string))))
+                       (setq tmp (sieve-manage-decode
+                                  (sieve-manage-is-string)))))
        (accept-process-output (get-buffer-process (current-buffer)) 1)
        (goto-char (point-min)))
       (when tmp
@@ -559,13 +610,9 @@ sieve-manage-parse-listscripts
       rsp)))
 
 (defun sieve-manage-send (cmdstr)
-  (setq cmdstr (concat cmdstr sieve-manage-client-eol))
-  (and sieve-manage-log
-       (with-current-buffer (get-buffer-create sieve-manage-log)
-        (mm-enable-multibyte)
-        (buffer-disable-undo)
-        (goto-char (point-max))
-        (insert cmdstr)))
+  (setq cmdstr (sieve-manage-encode
+                (concat cmdstr sieve-manage-client-eol)))
+  (sieve-manage--append-to-log cmdstr)
   (process-send-string sieve-manage-process cmdstr))
 
 (provide 'sieve-manage)
-- 
2.34.1

Both, the (internal) process/protocol buffer and the log buffer are now
unibyte. The conversion to multibyte UTF-8 is only done for user visible
(UI) buffers.

To properly handle the protocol line termination (CRLF), I added
`:coding 'raw-text-unix` (with explicit unix EOL convention) to the
`open-network-stream' call (also in the new `manage-sieve-encode'
function. This was needed to allow keep the various (looking-at
"...\r\n" ...) calls working. This is something which still feels a bit
weird, but I haven't found another way to do it. I did some tests with
(setq-default buffer-file-coding-system 'utf-8-unix/'utf-8-dos) which
did not show any issues.

I would also add some ERT tests, probably in a separate commit?


In addition, I found that `sieve-manage-quit' in sieve.el had the
tendency to kill unrelated buffers in case of errors during earlier
steps. For this, I created a sepate patch:

>From 559ce20b4c9b75f67bef3a1e23b7501bdeaa98d2 Mon Sep 17 00:00:00 2001
From: Kai Tetzlaff <emacs@tetzco.de>
Date: Mon, 28 Feb 2022 11:33:56 +0100
Subject: [PATCH 2/2] Improve robustnes of `sieve-manage-quit' in case of
 errors

* lisp/net/sieve.el (sieve-manage-quit): Avoid killing buffers it's
not supposed to touch.
---
 lisp/net/sieve.el | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/lisp/net/sieve.el b/lisp/net/sieve.el
index 630ea04070..5680526389 100644
--- a/lisp/net/sieve.el
+++ b/lisp/net/sieve.el
@@ -154,7 +154,8 @@ sieve-manage-quit
   (interactive)
   (sieve-manage-close sieve-manage-buffer)
   (kill-buffer sieve-manage-buffer)
-  (kill-buffer (current-buffer)))
+  (when-let ((buffer (get-buffer sieve-buffer)))
+    (kill-buffer buffer)))
 
 (defun sieve-bury-buffer ()
   "Bury the Manage Sieve buffer without closing the connection."
-- 
2.34.1