unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
From: Kai Tetzlaff <emacs+bug@tetzco.de>
To: Eli Zaretskii <eliz@gnu.org>
Cc: herbert@gojira.at, 54154@debbugs.gnu.org, larsi@gnus.org
Subject: bug#54154: Emacs commit ae963e80a79f5a9184daabfc8197f211a39b136d (sieve-manage)
Date: Mon, 23 Jan 2023 01:59:09 +0100	[thread overview]
Message-ID: <878rhut6aq.fsf@tetzco.de> (raw)
In-Reply-To: <83v8l2o212.fsf@gnu.org> (Eli Zaretskii's message of "Thu, 19 Jan 2023 19:41:13 +0200")

[-- Attachment #1: Type: text/plain, Size: 2227 bytes --]

Just a quick update (also answering my own question(s) below):

Regarding the status of this bug report: The fix for emacs-29 which was
initially intended to be emacs-29 only has (inadvertently?) found its way
to master. So I think we can close the report.

The discussion about the additional changes I made (I'm still working on
that s. below) could be moved elsewhere (emacs-devel?). Even though,
from my side there is no urgent need for that. I really appreciate the
feedback I got from Eli and hope to get some more.

> I've now added an additional patch which automatically handles unix/dos
> eol-types when downloading/uploading sieve scripts. So far, if a script
> downloaded from the server contained CRLF EOLs, the script buffer was
> full of '^M's. With the additional patch
> (0005-Autodetect-eol-type-of-sieve-manage-scripts), the EOL type is
> detected and used for decoding during script download (and subsequently
> also for encoding during upload).
> 
> For that, I changed the interface between 'sieve-upload' (in sieve.el),
> and 'manage-sieve-putscript' (plus 'sieve-manage-decode' and
> 'sieve-manage-send' in sieve-manage.el). Instead of transferring the
> script data as a string, the functions are now using the actual script
> buffer.
> 
> The eol-type detection is done in the new function
> 'sieve-manage--guess-buffer-coding-system'. But I would assume, that
> this functionality already exists somewhere else. E.g. 'find-file' must
> do a similar, much more detailed analysis. However, that seems to happen
> in the C implementation, so it's not directly usable in sieve-manage. Or
> am I missing something?

In the meantime, I found `detect-coding-region'/`detect-coding-string'
which in combination with `coding-system-eol-type' do exactly what I was
missing.


I've now started to refactor the encoding and sending functions in
sieve-manage.el with the intent to improve the readability and
testability of the code. I'm also adding some more tests. These
additional changes are in yet another patch
(0006-WiP-new-encode-tested-OK.patch).

I also added NEWS entries to patches 0002-Handle-BYE... and
0005-Autodetect-eol-type... (these were already present in the patches
of the previous mail).



[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Fix-bug-in-sieve-manage-append-to-log-and-do-some-re.patch --]
[-- Type: text/x-diff, Size: 8982 bytes --]

From 8b659e704a6b39b586168a6851923fcfd6035d8e 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/6] Fix bug in sieve-manage--append-to-log and do some
 refactoring

- simplify buffer creation and setup for process and log buffers
- handle all encoding tasks in `sieve-manage-send' (and thus simplify
  `sieve-manage-putscript')
- add/update doc-strings
- update some comments

* lisp/net/sieve-manage.el
(sieve-manage-coding-system-for-read)
(sieve-manage-coding-system-for-write): Remove unused constants.
(sieve-manage-encode): Change misleading argument name (utf8-string ->
str).
(sieve-manage--coding-system): New constant.
(sieve-manage-encode): Use `sieve-manage--coding-system', rename
arguments, update doc string.
(sieve-manage--set-buffer-maybe-append-text): New function.
(sieve-manage-open-server): Change :coding property of
`open-network-stream' from 'raw-text-unix to 'binary.
(sieve-manage--append-to-log): Use
`sieve-manage--set-buffer-maybe-append-text' to fix log buffer
creation.
(sieve-manage-decode)
(sieve-manage-make-process-buffer): Use
`sieve-manage--set-buffer-maybe-append-text'.
(sieve-manage-send): Handle all encoding steps (including the
'literal-c2s' encoding previously done in `sieve-manage-putscript').
(sieve-manage-putscript): Move all encoding steps to
`sieve-manage-send'.
---
 lisp/net/sieve-manage.el | 117 ++++++++++++++++++++++++++-------------
 1 file changed, 79 insertions(+), 38 deletions(-)

diff --git a/lisp/net/sieve-manage.el b/lisp/net/sieve-manage.el
index 5bee4f4c4ad..bc8ba25f400 100644
--- a/lisp/net/sieve-manage.el
+++ b/lisp/net/sieve-manage.el
@@ -58,7 +58,7 @@
 ;;
 ;; References:
 ;;
-;; draft-martin-managesieve-02.txt,
+;; RFC5804,
 ;; "A Protocol for Remotely Managing Sieve Scripts",
 ;; by Tim Martin.
 ;;
@@ -145,6 +145,15 @@ sieve-manage-ignore-starttls
   :type 'boolean)
 
 ;; Internal variables:
+(defconst sieve-manage--coding-system 'utf-8-unix
+  "Use \\='utf-8-unix coding system for (network) communication.
+
+Defines the coding system used for the internal (process, log)
+buffers and the network stream created to communicate with the
+managesieve server.  Using \\='utf-8-unix encoding corresponds to
+the use of UTF-8 in RFC5804 (managesieve).  The explicit use of
+\\='-unix\\=' avoids EOL conversions (and thus keeps CRLF (\"\\r\\n\")
+sequences intact).")
 
 (defconst sieve-manage-local-variables '(sieve-manage-server
 					 sieve-manage-port
@@ -154,8 +163,6 @@ sieve-manage-local-variables
 					 sieve-manage-client-eol
 					 sieve-manage-server-eol
 					 sieve-manage-capability))
-(defconst sieve-manage-coding-system-for-read 'binary)
-(defconst sieve-manage-coding-system-for-write 'binary)
 (defvar sieve-manage-stream nil)
 (defvar sieve-manage-auth nil)
 (defvar sieve-manage-server nil)
@@ -167,20 +174,45 @@ sieve-manage-process
 (defvar sieve-manage-capability nil)
 
 ;; Internal utility functions
+(defun sieve-manage--set-buffer-maybe-append-text (buffer-name
+                                                   &rest args)
+  "Append ARGS to buffer named BUFFER-NAME and return buffer.
+
+To be used with process and log buffers.  When the buffer doesn't
+exist, it gets created and configure as follows:
+- set coding system to 'sieve-manage--coding-system',
+- set buffer to single-byte mode,
+- set `after-change-functions' to nil to avoid those
+  functions messing with buffer content,
+- disable undo (to save a bit of memory and improve
+  performance).
+
+ARGS can be a nil, a string or a list of strings.  If no
+ARGS are provided, the content of buffer will not be
+modified."
+  (let* ((existing-buffer (get-buffer buffer-name))
+         (buffer (or existing-buffer
+                     (get-buffer-create buffer-name))))
+    (with-current-buffer buffer
+      (unless existing-buffer
+        (set-buffer-file-coding-system sieve-manage--coding-system)
+        (set-buffer-multibyte nil)
+        (setq-local after-change-functions nil)
+        (buffer-disable-undo))
+      (when args
+        (goto-char (point-max))
+        (apply #'insert args)))
+    buffer))
+
 (defun sieve-manage--append-to-log (&rest args)
-  "Append ARGS to sieve-manage log buffer.
+  "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."
+If `sieve-manage-log' is nil, logging is disabled.  See also
+`sieve-manage--set-buffer-maybe-append-text'."
   (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))))
+    (apply #'sieve-manage--set-buffer-maybe-append-text
+           sieve-manage-log
+           args)))
 
 (defun sieve-manage--message (format-string &rest args)
   "Wrapper around `message' which also logs to sieve manage log.
@@ -202,28 +234,28 @@ sieve-manage--error
     (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-encode (str)
+  "Convert STR to managesieve protocol octets."
+  (encode-coding-string str sieve-manage--coding-system t))
 
 (defun sieve-manage-decode (octets &optional buffer)
-  "Convert managesieve protocol OCTETS to utf-8 string.
+  "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)))
+    (decode-coding-string octets
+                          sieve-manage--coding-system
+                          t buffer)))
 
 (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)
-    (set-buffer-multibyte nil)
-    (setq-local after-change-functions nil)
-    (buffer-disable-undo)
-    (current-buffer)))
+  (let ((buffer (sieve-manage--set-buffer-maybe-append-text
+                 (format " *sieve %s:%s*"
+                         sieve-manage-server
+                         sieve-manage-port))))
+    (with-current-buffer buffer
+      (mapc #'make-local-variable sieve-manage-local-variables))
+    buffer))
 
 (defun sieve-manage-erase (&optional p buffer)
   (with-current-buffer (or buffer (current-buffer))
@@ -244,8 +276,7 @@ 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
+                  :coding 'binary
                   :capability-command "CAPABILITY\r\n"
                   :end-of-command "^\\(OK\\|NO\\).*\n"
                   :success "^OK.*\n"
@@ -480,9 +511,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
-			       (length (sieve-manage-encode content))
-			       sieve-manage-client-eol content))
+    (sieve-manage-send (format "PUTSCRIPT \"%s\"" name) content)
     (sieve-manage-parse-okno)))
 
 (defun sieve-manage-deletescript (name &optional buffer)
@@ -609,11 +638,23 @@ sieve-manage-parse-listscripts
 	data
       rsp)))
 
-(defun sieve-manage-send (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))
+(defun sieve-manage-send (command &optional payload-str)
+  "Send COMMAND with optional PAYLOAD-STR.
+
+If non-nil, PAYLOAD-STR will be appended to COMMAND using the
+\\='literal-s2c\\' representation according to RFC5804."
+  (let ((encoded (when payload-str (sieve-manage-encode payload-str)))
+        literal-c2s cmdstr)
+    (when encoded
+      (setq literal-c2s (format " {%d+}%s%s"
+                                (length encoded)
+                                sieve-manage-client-eol
+                                encoded)))
+    (setq cmdstr (concat (sieve-manage-encode command)
+                         literal-c2s
+                         sieve-manage-client-eol))
+    (sieve-manage--append-to-log cmdstr)
+    (process-send-string sieve-manage-process cmdstr)))
 
 (provide 'sieve-manage)
 
-- 
2.39.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-Handle-BYE-in-sieve-manage-server-responses.patch --]
[-- Type: text/x-diff, Size: 6496 bytes --]

From 196aaf2d7f7ebea1f5a8999970092fd80dfc8f4e Mon Sep 17 00:00:00 2001
From: Kai Tetzlaff <emacs@tetzco.de>
Date: Thu, 19 Jan 2023 03:52:43 +0100
Subject: [PATCH 2/6] Handle BYE in sieve-manage server responses

* etc/NEWS: Mention the support for BYE.

* lisp/net/sieve-manage.el
(sieve-manage-regex-oknobye): New function.
(sieve-manage-parse-oknobye): Renamed from `sieve-manage-parse-okno'.
(sieve-manage-open-server)
(sieve-sasl-auth)
(sieve-manage-listscripts)
(sieve-manage-putscript)
(sieve-manage-deletescript)
(sieve-manage-getscript)
(sieve-manage-setactive)
(sieve-manage-is-okno)
(sieve-manage-parse-oknobye)
(sieve-manage-parse-parse-string)
(sieve-manage-parse-parse-crlf): Use `sieve-manage-regex-oknobye' to
handle BYE in addition to OK and NO.
---
 etc/NEWS                 | 12 ++++++++++++
 lisp/net/sieve-manage.el | 37 ++++++++++++++++++++-----------------
 2 files changed, 32 insertions(+), 17 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 4851802716a..f8e4aed6703 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -181,6 +181,18 @@ the new argument NEW-BUFFER non-nil, it will use a new buffer instead.
 Interactively, invoke 'eww-open-file' with a prefix argument to
 activate this behavior.
 
+** sieve-manage
+
+---
+*** Support handling of BYE responses from managesieve servers.
+The managesieve client in sieve-manage now handles BYE responses sent
+be the server (in addition to OK and NO).  This makes the
+implementation more robust in case of e.g. timeouts and authentication
+failures.
+
+Note: The special case of a REFERRAL/BYE responses is still not
+handled by the client (s. RFC5804 for more details).
+
 \f
 * New Modes and Packages in Emacs 30.1
 
diff --git a/lisp/net/sieve-manage.el b/lisp/net/sieve-manage.el
index bc8ba25f400..de5c3cd1386 100644
--- a/lisp/net/sieve-manage.el
+++ b/lisp/net/sieve-manage.el
@@ -278,8 +278,8 @@ sieve-manage-open-server
                   :type stream
                   :coding 'binary
                   :capability-command "CAPABILITY\r\n"
-                  :end-of-command "^\\(OK\\|NO\\).*\n"
-                  :success "^OK.*\n"
+                  :end-of-command "^\\(OK\\|NO\\|BYE\\).*\r\n"
+                  :success "^OK.*\r\n"
                   :return-list t
                   :starttls-function
                   (lambda (capabilities)
@@ -338,7 +338,7 @@ sieve-sasl-auth
                                  (setq rsp nil)
                                (goto-char (match-end 0))
                                rsp))
-                           (setq rsp (sieve-manage-is-okno))))
+                           (setq rsp (sieve-manage-is-oknobye))))
             (accept-process-output sieve-manage-process 1)
             (goto-char (point-min)))
           (sieve-manage-erase)
@@ -507,17 +507,17 @@ sieve-manage-listscripts
 (defun sieve-manage-havespace (name size &optional buffer)
   (with-current-buffer (or buffer (current-buffer))
     (sieve-manage-send (format "HAVESPACE \"%s\" %s" name size))
-    (sieve-manage-parse-okno)))
+    (sieve-manage-parse-oknobye)))
 
 (defun sieve-manage-putscript (name content &optional buffer)
   (with-current-buffer (or buffer (current-buffer))
     (sieve-manage-send (format "PUTSCRIPT \"%s\"" name) content)
-    (sieve-manage-parse-okno)))
+    (sieve-manage-parse-oknobye)))
 
 (defun sieve-manage-deletescript (name &optional buffer)
   (with-current-buffer (or buffer (current-buffer))
     (sieve-manage-send (format "DELETESCRIPT \"%s\"" name))
-    (sieve-manage-parse-okno)))
+    (sieve-manage-parse-oknobye)))
 
 (defun sieve-manage-getscript (name output-buffer &optional buffer)
   (with-current-buffer (or buffer (current-buffer))
@@ -525,17 +525,22 @@ sieve-manage-getscript
     (sieve-manage-decode (sieve-manage-parse-string)
                          output-buffer)
     (sieve-manage-parse-crlf)
-    (sieve-manage-parse-okno)))
+    (sieve-manage-parse-oknobye)))
 
 (defun sieve-manage-setactive (name &optional buffer)
   (with-current-buffer (or buffer (current-buffer))
     (sieve-manage-send (format "SETACTIVE \"%s\"" name))
-    (sieve-manage-parse-okno)))
+    (sieve-manage-parse-oknobye)))
 
 ;; Protocol parsing routines
+(defun sieve-manage-regexp-oknobye ()
+  "Return regexp for managesieve 'response-oknobye'."
+  (concat
+   "^\\(OK\\|NO\\|BYE\\)\\( (\\([^)]+\\))\\)?\\( \\(.*\\)\\)?"
+   sieve-manage-server-eol))
 
 (defun sieve-manage-wait-for-answer ()
-  (let ((pattern "^\\(OK\\|NO\\).*\n")
+  (let ((pattern (sieve-manage-regexp-oknobye))
         pos)
     (while (not pos)
       (setq pos (search-forward-regexp pattern nil t))
@@ -553,10 +558,8 @@ sieve-manage-ok-p
 (defun sieve-manage-no-p (rsp)
   (string= (downcase (or (car-safe rsp) "")) "no"))
 
-(defun sieve-manage-is-okno ()
-  (when (looking-at (concat
-		     "^\\(OK\\|NO\\)\\( (\\([^)]+\\))\\)?\\( \\(.*\\)\\)?"
-		     sieve-manage-server-eol))
+(defun sieve-manage-is-oknobye ()
+  (when (looking-at (sieve-manage-regexp-oknobye))
     (let ((status (match-string 1))
 	  (resp-code (match-string 3))
 	  (response (match-string 5)))
@@ -565,12 +568,12 @@ sieve-manage-is-okno
 	(setq response (sieve-manage-is-string)))
       (list status resp-code response))))
 
-(defun sieve-manage-parse-okno ()
+(defun sieve-manage-parse-oknobye ()
   (let (rsp)
     (while (null rsp)
       (accept-process-output (get-buffer-process (current-buffer)) 1)
       (goto-char (point-min))
-      (setq rsp (sieve-manage-is-okno)))
+      (setq rsp (sieve-manage-is-oknobye)))
     (sieve-manage-erase)
     rsp))
 
@@ -604,7 +607,7 @@ sieve-manage-parse-string
       (accept-process-output (get-buffer-process (current-buffer)) 1)
       (goto-char (point-min))
       (unless (setq rsp (sieve-manage-is-string))
-        (when (sieve-manage-no-p (sieve-manage-is-okno))
+        (when (sieve-manage-no-p (sieve-manage-is-oknobye))
           ;; simple `error' is enough since `sieve-manage-erase'
           ;; already adds the server response to the log
           (error (sieve-manage-erase)))))
@@ -618,7 +621,7 @@ sieve-manage-parse-crlf
 (defun sieve-manage-parse-listscripts ()
   (let (tmp rsp data)
     (while (null rsp)
-      (while (null (or (setq rsp (sieve-manage-is-okno))
+      (while (null (or (setq rsp (sieve-manage-is-oknobye))
                        (setq tmp (sieve-manage-decode
                                   (sieve-manage-is-string)))))
 	(accept-process-output (get-buffer-process (current-buffer)) 1)
-- 
2.39.0


[-- Attachment #4: 0003-Add-test-lisp-net-sieve-manage-tests.el.patch --]
[-- Type: text/x-diff, Size: 5135 bytes --]

From 86ba9f91e4c78fee72eab0c752cd9c5e78fab402 Mon Sep 17 00:00:00 2001
From: Kai Tetzlaff <emacs@tetzco.de>
Date: Tue, 22 Mar 2022 20:48:09 +0100
Subject: [PATCH 3/6] Add test/lisp/net/sieve-manage-tests.el

* test/lisp/net/sieve-manage-tests.el:
(mk-literal-s2c)
(mk-rsp-oknobye)
(mk-rsp-getscript-ok)
(managesieve-getscript): Test helper functions.
(ert/managesieve-getscript-multibyte): Test `sieve-manage-getscript'
with script names containing multibyte characters.
---
 test/lisp/net/sieve-manage-tests.el | 104 ++++++++++++++++++++++++++++
 1 file changed, 104 insertions(+)
 create mode 100644 test/lisp/net/sieve-manage-tests.el

diff --git a/test/lisp/net/sieve-manage-tests.el b/test/lisp/net/sieve-manage-tests.el
new file mode 100644
index 00000000000..010c9071608
--- /dev/null
+++ b/test/lisp/net/sieve-manage-tests.el
@@ -0,0 +1,104 @@
+;;; sieve-manage-tests.el --- tests for sieve-manage.el       -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2022 Free Software Foundation, Inc.
+
+;; Author: Kai Tetzlaff <emacs@tetzco.de>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs 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 GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+(require 'sieve-manage)
+
+(defvar sieve-script-multibyte-unix
+  "if body :matches \"ä\" { stop; }\n"
+  "Simple multibyte sieve script.")
+
+(defun mk-literal-s2c (string)
+  "Encode STRING to managesieve 'literal-s2c'."
+  (let ((data (sieve-manage-encode string)))
+    (concat (format "{%d}\r\n" (length data))
+            data)))
+
+(defun mk-rsp-oknobye (type &optional resp-code string)
+  "Encode TYPE, RESP-CODE and STRING to managesieve 'response-oknobye'."
+  (when (memq type '(OK NO BYE))
+    (concat
+     (mapconcat #'identity
+                (delq nil
+                      (list (symbol-name type)
+                            (when resp-code
+                              (format "(%s)" resp-code))
+                            (when string
+                              (format "\"%s\""
+                                      (sieve-manage-encode string)))))
+                " ")
+     "\r\n")))
+;; (mk-rsp-oknobye 'OK nil "Getscript completed.")
+;; (mk-rsp-oknobye 'NO "TRYLATER" "Server is busy.")
+
+(defun mk-rsp-getscript-ok (script)
+  "Encode SCRIPT to managesieve 'response-getscript'."
+    (concat (mk-literal-s2c script)
+            "\r\n"
+            (mk-rsp-oknobye 'OK "Getscript completed.")))
+;; (mk-rsp-getscript-ok sieve-script-multibyte-unix)
+
+(defun managesieve-getscript (script)
+  "Simulate managesieve getscript response to test
+`sieve-manage-getscript' function."
+  (let* ((script-name "test.sieve")
+         ;; `sieve-manage-server' and `sieve-manage-port' are used in
+         ;; `sieve-manage-make-process-buffer'
+         (sieve-manage-server)
+         (sieve-manage-port "sieve")
+         (sieve-buffer (sieve-manage-make-process-buffer))
+         (output-buffer (generate-new-buffer script-name)))
+    ;; use cl-letf to mock some functions in call chain of
+    ;; sieve-manage-getscript
+    (cl-letf (((symbol-function 'sieve-manage-send)
+               ;; simulate sieve server response with a single
+               ;; multibyte character `ä`
+               (lambda (_)
+                 (with-current-buffer sieve-buffer
+                   (goto-char (point-min))
+                   (insert (mk-rsp-getscript-ok script)))))
+              ((symbol-function 'accept-process-output)
+               (lambda (&optional _ _ _ _) nil))
+              ((symbol-function 'get-buffer-process) (lambda (_) nil)))
+      ;; extract sieve script from sieve-buffer and put it into
+      ;; output-buffer
+      (sieve-manage-getscript script-name output-buffer sieve-buffer)
+      ;; extract script from output-buffer and return it as a string
+      (let ((script (with-current-buffer output-buffer
+                      (set-buffer-modified-p nil)
+                      (buffer-string))))
+        ;; cleanup
+        (kill-buffer sieve-buffer)
+        (kill-buffer output-buffer)
+        (when (get-buffer sieve-manage-log)
+          (kill-buffer sieve-manage-log))
+        ;; return script
+        script))))
+
+(ert-deftest ert/managesieve-getscript-multibyte ()
+  (should (string= sieve-script-multibyte-unix
+                   (managesieve-getscript sieve-script-multibyte-unix))))
+
+;;; sieve-manage-tests.el ends here
-- 
2.39.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: 0004-Some-minor-fixes-in-lisp-net-sieve.el.patch --]
[-- Type: text/x-diff, Size: 3246 bytes --]

From aef415f651e59542fe7bb3a2ab76c2b27bb51a07 Mon Sep 17 00:00:00 2001
From: Kai Tetzlaff <emacs@tetzco.de>
Date: Thu, 19 Jan 2023 04:06:22 +0100
Subject: [PATCH 4/6] Some minor fixes in lisp/net/sieve.el

* lisp/net/sieve.el
(sieve-next-line)
(sieve-prev-line): Handle situations where point in `sieve-buffer'
is either before or after the list of server side scripts.
(sieve-server-script-list): New variable.
(sieve-refresh-scriptlist)
(sieve-upload): Use `sieve-server-script-list' to make sure that local
list of server side scripts in`sieve-buffer' is up-to-date after
uploading a (new) script.
---
 lisp/net/sieve.el | 38 +++++++++++++++++++++++++-------------
 1 file changed, 25 insertions(+), 13 deletions(-)

diff --git a/lisp/net/sieve.el b/lisp/net/sieve.el
index fbd07dee27c..12a85e89d7e 100644
--- a/lisp/net/sieve.el
+++ b/lisp/net/sieve.el
@@ -95,6 +95,8 @@ sieve-template
 
 (defvar sieve-manage-buffer nil)
 (defvar sieve-buffer-header-end nil)
+(defvar sieve-server-script-list nil
+  "Current list of server-side sieve scripts.")
 (defvar sieve-buffer-script-name nil
   "The real script name of the buffer.")
 (make-local-variable 'sieve-buffer-script-name)
@@ -235,23 +237,28 @@ sieve-next-line
   (interactive)
   (unless arg
     (setq arg 1))
-  (if (save-excursion
-	(forward-line arg)
-	(sieve-script-at-point))
-      (sieve-change-region
-	(forward-line arg))
-    (message "End of list")))
+  (if (sieve-script-at-point)
+      (if (save-excursion
+	    (forward-line arg)
+	    (sieve-script-at-point))
+          (sieve-change-region
+	    (forward-line arg))
+        (message "End of list"))
+    (goto-char (next-overlay-change sieve-buffer-header-end))))
 
 (defun sieve-prev-line (&optional arg)
   (interactive)
   (unless arg
     (setq arg -1))
-  (if (save-excursion
-	(forward-line arg)
-	(sieve-script-at-point))
-      (sieve-change-region
-	(forward-line arg))
-    (message "Beginning of list")))
+  (if (sieve-script-at-point)
+      (if (save-excursion
+	    (forward-line arg)
+	    (sieve-script-at-point))
+          (sieve-change-region
+	    (forward-line arg))
+        (message "Beginning of list"))
+    (goto-char (previous-overlay-change (point-max)))
+    (beginning-of-line)))
 
 (defun sieve-help ()
   "Display help for various sieve commands."
@@ -319,6 +326,9 @@ sieve-refresh-scriptlist
     (let* ((scripts (sieve-manage-listscripts sieve-manage-buffer))
            (count (length scripts))
            (keys (substitute-command-keys "\\[sieve-edit-script]")))
+      (setq sieve-server-script-list
+            (mapcar (lambda (elt) (if (consp elt) (cdr elt) elt))
+                    scripts))
       (insert
        (if (null scripts)
            (format
@@ -361,7 +371,9 @@ sieve-upload
         (if (not (sieve-manage-ok-p err))
             (message "Sieve upload failed: %s" (nth 2 err))
           (message "Sieve upload done.  Use %s to manage scripts."
-                   (substitute-command-keys "\\[sieve-manage]"))))
+                   (substitute-command-keys "\\[sieve-manage]"))
+          (when (not (member script-name sieve-server-script-list))
+            (sieve-refresh-scriptlist))))
       (set-buffer-modified-p nil))))
 
 ;;;###autoload
-- 
2.39.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #6: 0005-Autodetect-eol-type-of-sieve-manage-scripts.patch --]
[-- Type: text/x-diff, Size: 7397 bytes --]

From 4b144b0eff79cdcba1af4e46bd0a57836747d9ce Mon Sep 17 00:00:00 2001
From: Kai Tetzlaff <emacs@tetzco.de>
Date: Sun, 22 Jan 2023 01:06:57 +0100
Subject: [PATCH 5/6] Autodetect eol-type of sieve(-manage) scripts

When using `sieve-manage-getscript' to download a sieve script,
sieve-manage now automatically detects the eol-type (either
'utf-8-unix or 'utf-8-dos), uses it to decode the script data and sets
`buffer-file-coding-system' accordingly. This gets rid of '^M' in
sieve script buffers (for scripts which use CRLF type EOLs).

The same eol-type is then used to encode the script during upload with
`sieve-manage-putscript'.

* lisp/net/sieve-manage.el
(sieve-manage--guess-buffer-coding-system): New function which
analyzes the eol-type of the first couple of lines of a downloaded
script to make a best guess and returns either 'utf-8-unix or
'utf-8-dos.
(sieve-manage-decode): Use `sieve-manage--guess-buffer-coding-system'
to decode downloaded script data with the correct coding-system and
sets the `buffer-file-coding-system' of the resulting sieve script
buffer.
(sieve-manage-putscript): Now takes a sieve script buffer (instead
of a string) argument and forwards it to `sieve-manage-send'.
(sieve-manage-send): Now also uses a (payload-)buffer instead of a
string. The `buffer-file-coding-system' of the buffer is then used
when encoding the payload in order to use the correct eol-type.

* lisp/net/sieve.el:
(sieve-upload): Adapt to changed argument type of
`sieve-manage-putscript'.

* etc/NEWS: Add a short description of the changes.
---
 etc/NEWS                 | 10 +++++++
 lisp/net/sieve-manage.el | 63 +++++++++++++++++++++++++++++++---------
 lisp/net/sieve.el        |  6 ++--
 3 files changed, 62 insertions(+), 17 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index f8e4aed6703..e3791171220 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -193,6 +193,16 @@ failures.
 Note: The special case of a REFERRAL/BYE responses is still not
 handled by the client (s. RFC5804 for more details).
 
+---
+*** Autodetect eol-type of downloaded sieve scripts.
+When a downloaded script contained CRLF type EOLs, they caused '^M's
+to appear in the sieve script edit buffer.  To avoid that, the
+eol-type of sieve scripts is now detected during download via
+'sieve-manage-getscript', used when decoding the data and stored in
+'buffer-file-coding-system' of the script buffer.  The
+'buffer-file-coding-system' is then also used for encoding during
+upload by 'sieve-manage-putscript'.
+
 \f
 * New Modes and Packages in Emacs 30.1
 
diff --git a/lisp/net/sieve-manage.el b/lisp/net/sieve-manage.el
index de5c3cd1386..7c680007042 100644
--- a/lisp/net/sieve-manage.el
+++ b/lisp/net/sieve-manage.el
@@ -238,15 +238,43 @@ sieve-manage-encode
   "Convert STR to managesieve protocol octets."
   (encode-coding-string str sieve-manage--coding-system t))
 
+(defun sieve-manage--guess-buffer-coding-system (&optional buffer)
+  "Return the coding system to be use for (sieve script) BUFFER.
+
+Since RFC5804 requires scripts to be encoded as UTF-8, the
+returned coding system is either \\='utf-8-unix or \\='utf-8-dos."
+  (with-current-buffer (or buffer (current-buffer))
+    (let ((pos (point))
+          (max-lines 10)
+          (line 0)
+          (crlf-count 0))
+      (goto-char (point-min))
+      (while (and (> max-lines line) (not (eobp)))
+        (when (= #x0d (char-before (pos-eol)))
+          (cl-incf crlf-count))
+        (let ((eol (pos-eol)))
+          (when (> (goto-char (+ eol 1)) eol)
+            (cl-incf line))))
+      (goto-char pos)
+      (if (> crlf-count (/ line 2))
+          'utf-8-dos
+        'utf-8-unix))))
+
 (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
-                          sieve-manage--coding-system
-                          t buffer)))
+    (if buffer
+        (with-current-buffer buffer
+          (insert octets)
+          (let ((coding-system
+                 (sieve-manage--guess-buffer-coding-system)))
+            (set-buffer-file-coding-system coding-system)
+            (decode-coding-region (point-min) (point-max)
+                                  coding-system)))
+      (decode-coding-string
+       octets sieve-manage--coding-system t))))
 
 (defun sieve-manage-make-process-buffer ()
   (let ((buffer (sieve-manage--set-buffer-maybe-append-text
@@ -509,9 +537,9 @@ sieve-manage-havespace
     (sieve-manage-send (format "HAVESPACE \"%s\" %s" name size))
     (sieve-manage-parse-oknobye)))
 
-(defun sieve-manage-putscript (name content &optional buffer)
-  (with-current-buffer (or buffer (current-buffer))
-    (sieve-manage-send (format "PUTSCRIPT \"%s\"" name) content)
+(defun sieve-manage-putscript (name script-buffer &optional process-buffer)
+  (with-current-buffer (or process-buffer (current-buffer))
+    (sieve-manage-send (format "PUTSCRIPT \"%s\"" name) script-buffer)
     (sieve-manage-parse-oknobye)))
 
 (defun sieve-manage-deletescript (name &optional buffer)
@@ -641,13 +669,20 @@ sieve-manage-parse-listscripts
 	data
       rsp)))
 
-(defun sieve-manage-send (command &optional payload-str)
-  "Send COMMAND with optional PAYLOAD-STR.
-
-If non-nil, PAYLOAD-STR will be appended to COMMAND using the
-\\='literal-s2c\\' representation according to RFC5804."
-  (let ((encoded (when payload-str (sieve-manage-encode payload-str)))
-        literal-c2s cmdstr)
+(defun sieve-manage-send (command &optional payload-buffer)
+  "Send COMMAND with optional string from PAYLOAD-BUFFER.
+
+If non-nil, the content of PAYLOAD-BUFFER will be appended to
+COMMAND using the \\='literal-s2c\\=' representation according to RFC5804."
+  (let* ((encoded (when (and payload-buffer
+                             (> (buffer-size payload-buffer) 0))
+                    (with-current-buffer payload-buffer
+                        (encode-coding-region
+                         (point-min) (point-max)
+                         (buffer-local-value 'buffer-file-coding-system
+                                             payload-buffer)
+                         t))))
+         cmdstr literal-c2s)
     (when encoded
       (setq literal-c2s (format " {%d+}%s%s"
                                 (length encoded)
diff --git a/lisp/net/sieve.el b/lisp/net/sieve.el
index 12a85e89d7e..2108732c5dd 100644
--- a/lisp/net/sieve.el
+++ b/lisp/net/sieve.el
@@ -361,13 +361,13 @@ sieve-upload
   (interactive)
   (when (or (get-buffer sieve-buffer)
             (save-current-buffer (call-interactively 'sieve-manage)))
-    (let ((script (buffer-string))
+    (let ((script-buffer (current-buffer))
           (script-name (file-name-sans-extension (buffer-name)))
           err)
       (with-current-buffer (get-buffer sieve-buffer)
-	(setq err (sieve-manage-putscript
+        (setq err (sieve-manage-putscript
                    (or name sieve-buffer-script-name script-name)
-                   script sieve-manage-buffer))
+                   script-buffer sieve-manage-buffer))
         (if (not (sieve-manage-ok-p err))
             (message "Sieve upload failed: %s" (nth 2 err))
           (message "Sieve upload done.  Use %s to manage scripts."
-- 
2.39.0


[-- Attachment #7: 0006-WiP-new-encode-tested-OK.patch --]
[-- Type: text/x-diff, Size: 30422 bytes --]

From 334792ee0072890800933f080d9ca86ac2aecf3f Mon Sep 17 00:00:00 2001
From: Kai Tetzlaff <emacs@tetzco.de>
Date: Mon, 23 Jan 2023 00:50:18 +0100
Subject: [PATCH 6/6] WiP: new encode, tested OK

---
 lisp/net/sieve-manage.el            | 293 ++++++++++++++++++++--------
 test/lisp/net/sieve-manage-tests.el | 216 +++++++++++++++-----
 2 files changed, 381 insertions(+), 128 deletions(-)

diff --git a/lisp/net/sieve-manage.el b/lisp/net/sieve-manage.el
index 7c680007042..ea96dfd14ef 100644
--- a/lisp/net/sieve-manage.el
+++ b/lisp/net/sieve-manage.el
@@ -151,7 +151,7 @@ sieve-manage--coding-system
 Defines the coding system used for the internal (process, log)
 buffers and the network stream created to communicate with the
 managesieve server.  Using \\='utf-8-unix encoding corresponds to
-the use of UTF-8 in RFC5804 (managesieve).  The explicit use of
+the use of UTF-8 in rfc5804 (managesieve).  The explicit use of
 \\='-unix\\=' avoids EOL conversions (and thus keeps CRLF (\"\\r\\n\")
 sequences intact).")
 
@@ -173,6 +173,13 @@ sieve-manage-state
 (defvar sieve-manage-process nil)
 (defvar sieve-manage-capability nil)
 
+(define-error 'sieve-manage-error
+              "Unknown sieve-manage error")
+(define-error 'sieve-manage-encode-error
+              "sieve-manage encoding error" 'sieve-manage-error)
+(define-error 'sieve-manage-server-error
+              "Managesieve server signaled an error" 'sieve-manage-error)
+
 ;; Internal utility functions
 (defun sieve-manage--set-buffer-maybe-append-text (buffer-name
                                                    &rest args)
@@ -224,55 +231,144 @@ sieve-manage--message
     (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.
+(defun sieve-manage--error (type format-string &rest args)
+  "Generate a \\='sieve-manage-error\\=' of TYPE.
+FORMAT-STRONG and ARGS are used as arguments to `format'.
+Errors are also logged 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)))
+    (signal type (list msg))))
 
-(defun sieve-manage-encode (str)
-  "Convert STR to managesieve protocol octets."
+(defun sieve-manage--convert-multibyte (str)
+  "Convert multibyte STR to unibyte octet string.
+The conversion is done using `sieve-manage--coding-system'
+(\\='utf-8-unix)."
   (encode-coding-string str sieve-manage--coding-system t))
 
-(defun sieve-manage--guess-buffer-coding-system (&optional buffer)
+(defun sieve-manage-mk-quoted (octet-str)
+  "Convert OCTET-STR to rfc5804 \\='quoted\\=' string."
+  (or (stringp octet-str)
+      (sieve-manage--error 'sieve-manage-encode-error
+                           "Argument must be a string"))
+  (format "\"%s\"" octet-str))
+
+(defun sieve-manage-mk-literal-c2s (octet-str)
+  "Convert OCTET-STR to rfc5804 \\='literal-c2s\\=' string."
+  (or (stringp octet-str)
+      (sieve-manage--error 'sieve-manage-encode-error
+                           "Argument must be a string"))
+  (format "{%d+}%s%s"
+          (length octet-str)
+          sieve-manage-client-eol
+          octet-str))
+
+(defun sieve-manage-mk-literal-s2c (octet-str)
+  "Convert OCTET-STR to rfc5804 \\='literal-s2c\\=' string."
+  (or (stringp octet-str)
+      (sieve-manage--error 'sieve-manage-encode-error
+                           "Argument must be a string"))
+  (format "{%d}%s%s"
+            (length octet-str)
+            sieve-manage-client-eol
+            octet-str))
+
+(defun sieve-manage-encode (item)
+  "Convert ITEM to a rfc5804 protocol string.
+
+An ITEM can be a:
+1. number (positive integer or 0),
+2. string (will be converted to unibyte using \\='utf-8-unix
+   coding system and encoded as \\='quoted\\=' rfc5804 string),
+3. buffer (buffer content will be converted to unibyte using
+   `buffer-file-coding-system and encoded as \\='literal-c2s\\=' rfc5804
+   string),
+4. cons cell (TYPE . DATA) where the following combinations of TYPE
+   and DATA are supported:
+   - (number . <int>) where <int> is an integer in the range of
+     [0..4294967296]
+   - (cmd-name . <octet-str>) where <octet-str> is a unibyte string
+   - (<str-type> . <octet-str>) where <str-type> is one of \\='quoted,
+     \\='literal-c2s, \\='literal-s2c and <octet-str> is a unibyte string
+   - (<str-type> . <str>) where <str-type> is one of \\='mb-quoted,
+     \\='mb-literal-c2s, \\='mb-literal-s2c and <str> is a (multibyte) UTF-8
+     string which will be converted to unibyte using coding system
+     \\='utf-8-unix."
+  (cond
+   ((and (integerp item) (>= item 0))
+    (sieve-manage-encode (cons 'number item)))
+   ((stringp item)
+    ;; TODO:
+    ;; - check if character set of item requires use of 'literal-c2s
+    ;; - check if length of item requires use of 'literal-c2s
+    (sieve-manage-encode (cons 'quoted
+                               (sieve-manage--convert-multibyte item))))
+   ((bufferp item)
+    (sieve-manage-encode
+     (cons 'literal-c2s (encode-coding-region
+                         (point-min) (point-max)
+                         (buffer-local-value 'buffer-file-coding-system
+                                             item)
+                         t))))
+   ((consp item)
+    (let ((type (car item))
+          (data (cdr item)))
+      (pcase type
+        ('number (format "%d" data))
+        ('cmd-name (format "%s" data))
+        ('quoted (sieve-manage-mk-quoted data))
+        ('literal-c2s (sieve-manage-mk-literal-c2s data))
+        ('literal-s2c (sieve-manage-mk-literal-s2c data))
+        ('mb-quoted (sieve-manage-mk-quoted
+                     (sieve-manage--convert-multibyte data)))
+        ('mb-literal-c2s (sieve-manage-mk-literal-c2s
+                          (sieve-manage--convert-multibyte data)))
+        ('mb-literal-s2c (sieve-manage-mk-literal-s2c
+                          (sieve-manage--convert-multibyte data)))
+        (_ (sieve-manage--error 'sieve-manage-encode-error
+                                "Unknown encoding type: '%s'"
+                                type)))))
+   (t (sieve-manage--error 'sieve-manage-encode-error
+                           "Don't know how to encode '%s'" item))))
+
+(defun sieve-manage--detect-buffer-coding-system (&optional buffer)
   "Return the coding system to be use for (sieve script) BUFFER.
 
-Since RFC5804 requires scripts to be encoded as UTF-8, the
-returned coding system is either \\='utf-8-unix or \\='utf-8-dos."
+Since rfc5804 requires sieve scripts to use (a subset of) UTF-8, the
+returned coding system is of type \\='utf-8 with either \\='-unix\\=',
+\\='-dos\\=' or \\='-mac\\=' eol-type."
   (with-current-buffer (or buffer (current-buffer))
-    (let ((pos (point))
-          (max-lines 10)
-          (line 0)
-          (crlf-count 0))
-      (goto-char (point-min))
-      (while (and (> max-lines line) (not (eobp)))
-        (when (= #x0d (char-before (pos-eol)))
-          (cl-incf crlf-count))
-        (let ((eol (pos-eol)))
-          (when (> (goto-char (+ eol 1)) eol)
-            (cl-incf line))))
-      (goto-char pos)
-      (if (> crlf-count (/ line 2))
-          'utf-8-dos
-        'utf-8-unix))))
+    (let ((coding-system (detect-coding-region
+                          (point-min) (point-max) t)))
+          (alist-get (coding-system-eol-type coding-system)
+                '((0 . utf-8-unix)
+                  (1 . utf-8-dos)
+                  (2 . utf-8-mac))
+                'utf-8-unix))))
 
 (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."
+If BUFFER is non-nil detect \\='eol-type\\=' of OCTETS, use corresponding
+\\='utf-8-<eol-type> coding system to decode octets, set
+`buffer-file-coding-system` of BUFFER, insert the decoded UTF-8 string
+into BUFFER and return BUFFER.
+
+Otherwise, decode OCTETS using `sieve-manage--coding-system' (\\='utf-8-unix)
+and return the resulting UTF-8 string."
   (when octets
     (if buffer
         (with-current-buffer buffer
           (insert octets)
           (let ((coding-system
-                 (sieve-manage--guess-buffer-coding-system)))
+                 (sieve-manage--detect-buffer-coding-system)))
             (set-buffer-file-coding-system coding-system)
             (decode-coding-region (point-min) (point-max)
-                                  coding-system)))
+                                  coding-system))
+          buffer)
       (decode-coding-string
        octets sieve-manage--coding-system t))))
 
@@ -342,18 +438,11 @@ sieve-sasl-auth
             ;; somehow.
             (lambda (_prompt) (copy-sequence user-password)))
            (step (sasl-next-step client nil))
-           (_tag (sieve-manage-send
-                 (concat
-                  "AUTHENTICATE \""
-                  mech
-                  "\""
-                  (and (sasl-step-data step)
-                       (concat
-                        " \""
-                        (base64-encode-string
-                         (sasl-step-data step)
-                         'no-line-break)
-                        "\"")))))
+           (_tag (sieve-manage-send-command
+                  "AUTHENTICATE" mech (and (sasl-step-data step)
+                                           (base64-encode-string
+                                            (sasl-step-data step)
+                                            'no-line-break))))
            data rsp)
       (catch 'done
         (while t
@@ -378,24 +467,23 @@ 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
-                (sieve-manage--error
+                (sieve-manage--error 'sieve-manage-server-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)
-            (sieve-manage--error
+            (sieve-manage--error 'sieve-manage-server-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
-           (if (sasl-step-data step)
-               (concat "\""
-                       (base64-encode-string (sasl-step-data step)
-                                             'no-line-break)
-                       "\"")
-             "")))))))
+           (cons 'quoted
+                 (if (sasl-step-data step)
+                     (base64-encode-string (sasl-step-data step)
+                                           'no-line-break)
+                   ""))))))))
 
 (defun sieve-manage-cram-md5-p (buffer)
   (sieve-manage-capability "SASL" "CRAM-MD5" buffer))
@@ -474,7 +562,7 @@ sieve-manage-open
             (setq sieve-manage-auth auth)
             (cl-return)))
         (unless sieve-manage-auth
-          (sieve-manage--error
+          (sieve-manage--error 'sieve-manage-error
            "Couldn't figure out authenticator for server")))
       (sieve-manage-erase)
       (current-buffer))))
@@ -504,7 +592,7 @@ sieve-manage-close
 If BUFFER is nil, the current buffer is used."
   (with-current-buffer (or buffer (current-buffer))
     (when (sieve-manage-opened)
-      (sieve-manage-send "LOGOUT")
+      (sieve-manage-send-command "LOGOUT")
       (sit-for 1))
     (when (and sieve-manage-process
 	       (memq (process-status sieve-manage-process) '(open run)))
@@ -528,36 +616,66 @@ sieve-manage-capability
           server-value)))))
 
 (defun sieve-manage-listscripts (&optional buffer)
+  "Send LISTSCRIPTS command to download list of available scripts.
+BUFFER is the \\='sieve-manage\\=' process buffer (default: \\='(current-buffer)\\=')."
   (with-current-buffer (or buffer (current-buffer))
-    (sieve-manage-send "LISTSCRIPTS")
+    (sieve-manage-send-command "LISTSCRIPTS")
     (sieve-manage-parse-listscripts)))
 
 (defun sieve-manage-havespace (name size &optional buffer)
+  "Send HAVESPACE command for script NAME and SIZE.
+BUFFER is the \\='sieve-manage\\=' process buffer (default: \\='(current-buffer)\\=')."
+  (when (string-empty-p name)
+    (sieve-manage-error "HAVESPACE script name cannot be empty"))
   (with-current-buffer (or buffer (current-buffer))
-    (sieve-manage-send (format "HAVESPACE \"%s\" %s" name size))
+    (sieve-manage-send-command "HAVESPACE" name size)
     (sieve-manage-parse-oknobye)))
 
-(defun sieve-manage-putscript (name script-buffer &optional process-buffer)
-  (with-current-buffer (or process-buffer (current-buffer))
-    (sieve-manage-send (format "PUTSCRIPT \"%s\"" name) script-buffer)
+(defun sieve-manage-putscript (name script-buffer &optional buffer)
+  "Send PUTSCRIPT command to upload script named NAME.
+Uses the content of SCRIPT-BUFFER as the actual script to upload.
+`buffer-file-coding-system' of SCRIPT-BUFFER is used to convert
+the script to unibyte before the uploaded.  It shall be set to either
+\\='utf-8-unix, \\='utf-8-dos or \\='utf-8-mac.
+BUFFER is the \\='sieve-manage\\=' process buffer (default: \\='(current-buffer)\\=')."
+  (when (string-empty-p name)
+    (sieve-manage-error "PUTSCRIPT script name cannot be empty"))
+  (with-current-buffer (or buffer (current-buffer))
+    (sieve-manage-send-command "PUTSCRIPT" name script-buffer)
     (sieve-manage-parse-oknobye)))
 
 (defun sieve-manage-deletescript (name &optional buffer)
+  "Send DELETESCRIPT command to delete script named NAME.
+BUFFER is the \\='sieve-manage\\=' process buffer (default: \\='(current-buffer)\\=')."
+  (when (string-empty-p name)
+    (sieve-manage-error "DELETESCRIPT script name cannot be empty"))
   (with-current-buffer (or buffer (current-buffer))
-    (sieve-manage-send (format "DELETESCRIPT \"%s\"" name))
+    (sieve-manage-send-command "DELETESCRIPT" name)
     (sieve-manage-parse-oknobye)))
 
-(defun sieve-manage-getscript (name output-buffer &optional buffer)
+(defun sieve-manage-getscript (name script-buffer &optional buffer)
+  "Send GETSCRIPT command to download script named NAME.
+Inserts the downloaded script into SCRIPT-BUFFER.  The \\='eol-type\\=' of
+the downloaded script will be detected automatically and gets
+used to decode the script data before inserting it into
+SCRIPT-BUFFER.  Also sets `buffer-file-coding-system' of
+SCRIPT-BUFFER to the \\='utf-8\\=' variant with the detected \\='eol-type\\='.
+BUFFER is the \\='sieve-manage\\=' process buffer (default: \\='(current-buffer)\\=')."
+  (when (string-empty-p name)
+    (sieve-manage-error "GETSCRIPT script name cannot be empty"))
   (with-current-buffer (or buffer (current-buffer))
-    (sieve-manage-send (format "GETSCRIPT \"%s\"" name))
+    (sieve-manage-send-command "GETSCRIPT" name)
     (sieve-manage-decode (sieve-manage-parse-string)
-                         output-buffer)
+                         script-buffer)
     (sieve-manage-parse-crlf)
     (sieve-manage-parse-oknobye)))
 
 (defun sieve-manage-setactive (name &optional buffer)
+  "Send SETACTIVE command to activate script named NAME.
+Use an empty NAME to deactivate/disable any active script.
+BUFFER is the \\='sieve-manage\\=' process buffer (default: \\='(current-buffer)\\=')."
   (with-current-buffer (or buffer (current-buffer))
-    (sieve-manage-send (format "SETACTIVE \"%s\"" name))
+    (sieve-manage-send-command "SETACTIVE" name)
     (sieve-manage-parse-oknobye)))
 
 ;; Protocol parsing routines
@@ -636,9 +754,10 @@ sieve-manage-parse-string
       (goto-char (point-min))
       (unless (setq rsp (sieve-manage-is-string))
         (when (sieve-manage-no-p (sieve-manage-is-oknobye))
-          ;; simple `error' is enough since `sieve-manage-erase'
+          ;; no further details required since `sieve-manage-erase'
           ;; already adds the server response to the log
-          (error (sieve-manage-erase)))))
+          (sieve-manage--error 'sieve-manage-server-error
+                               "%s" (sieve-manage-erase)))))
     (sieve-manage-erase (point))
     rsp))
 
@@ -669,28 +788,36 @@ sieve-manage-parse-listscripts
 	data
       rsp)))
 
-(defun sieve-manage-send (command &optional payload-buffer)
-  "Send COMMAND with optional string from PAYLOAD-BUFFER.
-
-If non-nil, the content of PAYLOAD-BUFFER will be appended to
-COMMAND using the \\='literal-s2c\\=' representation according to RFC5804."
-  (let* ((encoded (when (and payload-buffer
-                             (> (buffer-size payload-buffer) 0))
-                    (with-current-buffer payload-buffer
-                        (encode-coding-region
-                         (point-min) (point-max)
-                         (buffer-local-value 'buffer-file-coding-system
-                                             payload-buffer)
-                         t))))
-         cmdstr literal-c2s)
-    (when encoded
-      (setq literal-c2s (format " {%d+}%s%s"
-                                (length encoded)
-                                sieve-manage-client-eol
-                                encoded)))
-    (setq cmdstr (concat (sieve-manage-encode command)
-                         literal-c2s
-                         sieve-manage-client-eol))
+(defun sieve-manage-send-command (cmd-name &rest items)
+  "Assemble rfc5804 command from CMD-NAME and ITEMS and send it.
+See `sieve-manage-send' for further details."
+  (when (string-empty-p cmd-name)
+    (sieve-manage--error 'sieve-manage-encode-error
+     "Command name cannot be empty"))
+  (when (multibyte-string-p cmd-name)
+    (sieve-manage--error 'sieve-manage-encode-error
+     "Command name '%s' cannot must be a unibyte string" cmd-name))
+  (apply #'sieve-manage-send (cons 'cmd-name cmd-name) items))
+
+(defun sieve-manage-send (&rest items)
+  "Encode and concatenate ITEMS, send the result to the sieve server.
+ITEMs will be:
+
+1. skipped/ignored if nil
+2. converted to unibyte (optional, depends on item type)
+3. encoded according to rfc5804
+4. concatenated (using SPaces as separators)
+
+The result will then be sent to the managesieve server.
+
+See `sieve-manage-encode' for details regarding supported ITEMS and their
+handling."
+  (let ((cmdstr (concat
+                 (string-join
+                  (remove nil (mapcar #'sieve-manage-encode
+                                      items))
+                  " ")
+                 sieve-manage-client-eol)))
     (sieve-manage--append-to-log cmdstr)
     (process-send-string sieve-manage-process cmdstr)))
 
diff --git a/test/lisp/net/sieve-manage-tests.el b/test/lisp/net/sieve-manage-tests.el
index 010c9071608..60f47518f67 100644
--- a/test/lisp/net/sieve-manage-tests.el
+++ b/test/lisp/net/sieve-manage-tests.el
@@ -26,79 +26,205 @@
 (require 'ert)
 (require 'sieve-manage)
 
-(defvar sieve-script-multibyte-unix
+;;; test data
+
+(defvar smt/script-multibyte-unix
   "if body :matches \"ä\" { stop; }\n"
-  "Simple multibyte sieve script.")
+  "Simple multibyte sieve script with unix EOL.")
+
+(defvar smt/script-multibyte-dos
+  "if body :matches \"ä\" { stop; }\r\n"
+  "Simple multibyte sieve script with dos EOL.")
+
+(defvar smt/script-multibyte-mac
+  "if body :matches \"ä\" { stop; }\r"
+  "Simple multibyte sieve script with mac EOL.")
+
+(defvar smt/string-empty ""
+  "Empty sieve string.")
+
+(defvar smt/string-unibyte "Hello world!"
+  "Unibyte sieve string.")
+
+(defvar smt/string-multibyte "äöüßÄÖÜ"
+  "Multibyte sieve string.")
 
-(defun mk-literal-s2c (string)
-  "Encode STRING to managesieve 'literal-s2c'."
-  (let ((data (sieve-manage-encode string)))
-    (concat (format "{%d}\r\n" (length data))
-            data)))
+(defvar smt/script-name-unibyte "abcdefg.sieve"
+  "Unibyte sieve script name.")
 
-(defun mk-rsp-oknobye (type &optional resp-code string)
+(defvar smt/script-name-multibyte "äöüßÄÖÜ.sieve"
+  "Multibyte sieve script name.")
+
+;;; helper functions
+
+(defun smt/mk-literal-s2c (string)
+  "Encode multibyte STRING to managesieve 'literal-s2c'."
+  (sieve-manage-encode (cons 'mb-literal-s2c string)))
+;; (smt/mk-literal-s2c smt/string-multibyte)
+
+(defun smt/mk-rsp-oknobye (type &optional resp-code string)
   "Encode TYPE, RESP-CODE and STRING to managesieve 'response-oknobye'."
   (when (memq type '(OK NO BYE))
     (concat
-     (mapconcat #'identity
-                (delq nil
-                      (list (symbol-name type)
-                            (when resp-code
-                              (format "(%s)" resp-code))
-                            (when string
-                              (format "\"%s\""
-                                      (sieve-manage-encode string)))))
-                " ")
+     (string-join
+      (delete nil
+              (list (symbol-name type)
+                    (when resp-code
+                      (format "(%s)" resp-code))
+                    (when string
+                      (format "\"%s\""
+                              (sieve-manage--encode-multibyte string)))))
+      " ")
      "\r\n")))
-;; (mk-rsp-oknobye 'OK nil "Getscript completed.")
-;; (mk-rsp-oknobye 'NO "TRYLATER" "Server is busy.")
+;; (smt/mk-rsp-oknobye 'OK nil "Getscript completed.")
+;; (smt/mk-rsp-oknobye 'NO "TRYLATER" "Server is busy.")
 
-(defun mk-rsp-getscript-ok (script)
-  "Encode SCRIPT to managesieve 'response-getscript'."
-    (concat (mk-literal-s2c script)
+(defun smt/mk-rsp-getscript-ok (script)
+  "Encode SCRIPT to rfc5804 \\='response-getscript\\='."
+    (concat (smt/mk-literal-s2c script)
             "\r\n"
-            (mk-rsp-oknobye 'OK "Getscript completed.")))
-;; (mk-rsp-getscript-ok sieve-script-multibyte-unix)
-
-(defun managesieve-getscript (script)
-  "Simulate managesieve getscript response to test
-`sieve-manage-getscript' function."
+            (smt/mk-rsp-oknobye 'OK "Getscript completed.")))
+;; (smt/mk-rsp-getscript-ok smt/script-multibyte-unix)
+
+(defun smt/managesieve-getscript (script &optional nocleanup)
+  "Simulate rfc5804 response for GETSCRIPT command.
+The value of SCRIPT is used as the actual sieve script.
+Use for testing `sieve-manage-getscript' function.
+If NOCLEANUP is non-nil, keep all created buffers."
   (let* ((script-name "test.sieve")
          ;; `sieve-manage-server' and `sieve-manage-port' are used in
          ;; `sieve-manage-make-process-buffer'
          (sieve-manage-server)
          (sieve-manage-port "sieve")
-         (sieve-buffer (sieve-manage-make-process-buffer))
+         ;; sieve-manage process buffer
+         (process-buffer (sieve-manage-make-process-buffer))
+         ;; sieve-manage buffer to receive downloaded sieve script
          (output-buffer (generate-new-buffer script-name)))
     ;; use cl-letf to mock some functions in call chain of
     ;; sieve-manage-getscript
     (cl-letf (((symbol-function 'sieve-manage-send)
-               ;; simulate sieve server response with a single
-               ;; multibyte character `ä`
-               (lambda (_)
-                 (with-current-buffer sieve-buffer
+               ;; simulate sieve server getscript response
+               ;; containing 'script'
+               (lambda (&rest _)
+                 (with-current-buffer process-buffer
                    (goto-char (point-min))
-                   (insert (mk-rsp-getscript-ok script)))))
+                   (insert (smt/mk-rsp-getscript-ok script)))))
               ((symbol-function 'accept-process-output)
                (lambda (&optional _ _ _ _) nil))
               ((symbol-function 'get-buffer-process) (lambda (_) nil)))
-      ;; extract sieve script from sieve-buffer and put it into
+      ;; extract sieve script from process-buffer and put it into
       ;; output-buffer
-      (sieve-manage-getscript script-name output-buffer sieve-buffer)
+      (sieve-manage-getscript script-name output-buffer process-buffer)
       ;; extract script from output-buffer and return it as a string
       (let ((script (with-current-buffer output-buffer
                       (set-buffer-modified-p nil)
-                      (buffer-string))))
+                      (buffer-string)))
+              (coding-system
+               (buffer-local-value 'buffer-file-coding-system
+                                   output-buffer)))
         ;; cleanup
-        (kill-buffer sieve-buffer)
-        (kill-buffer output-buffer)
-        (when (get-buffer sieve-manage-log)
-          (kill-buffer sieve-manage-log))
-        ;; return script
-        script))))
+        (unless nocleanup
+          (kill-buffer process-buffer)
+          (kill-buffer output-buffer)
+          (when (get-buffer sieve-manage-log)
+            (kill-buffer sieve-manage-log)))
+        ;; return (script . coding-system)
+        (cons script coding-system)))))
+
+;;; tests
+
+(ert-deftest ert/manage-sieve-mk-quoted ()
+  (should-error (sieve-manage-mk-quoted 42)
+                :type 'sieve-manage-encode-error)
+  (should-error (sieve-manage-mk-quoted nil)
+                :type 'sieve-manage-encode-error)
+  (should (equal (format "\"%s\"" smt/script-name-unibyte)
+                 (sieve-manage-mk-quoted smt/script-name-unibyte)))
+  (should (equal "\"\""
+                 (sieve-manage-mk-quoted ""))))
+
+(ert-deftest ert/manage-sieve-mk-literal-c2s ()
+  (should-error (sieve-manage-mk-literal-c2s 42)
+                :type 'sieve-manage-encode-error)
+  (should-error (sieve-manage-mk-literal-c2s nil)
+                :type 'sieve-manage-encode-error)
+  (should (equal (format "{%d+}\r\n%s"
+                         (length smt/script-name-unibyte)
+                         smt/script-name-unibyte)
+                 (sieve-manage-mk-literal-c2s smt/script-name-unibyte)))
+  (should (equal "{0+}\r\n"
+                 (sieve-manage-mk-literal-c2s ""))))
+
+(ert-deftest ert/manage-sieve-mk-literal-s2c ()
+  (should-error (sieve-manage-mk-literal-s2c 42)
+                :type 'sieve-manage-encode-error)
+  (should-error (sieve-manage-mk-literal-s2c nil)
+                :type 'sieve-manage-encode-error)
+  (should (equal (format "{%d}\r\n%s"
+                         (length smt/script-name-unibyte)
+                         smt/script-name-unibyte)
+                 (sieve-manage-mk-literal-s2c smt/script-name-unibyte)))
+  (should (equal "{0}\r\n"
+                 (sieve-manage-mk-literal-s2c ""))))
+
+(ert-deftest ert/sieve-manage-encode ()
+  ;; unsupported data types
+  (should-error (sieve-manage-encode nil)
+                :type 'sieve-manage-encode-error)
+  (should-error
+   ;; RFC5804 doesn't support negative numbers
+   (sieve-manage-encode -1) :type 'sieve-manage-encode-error)
+
+  ;; number [0..4294967296]
+  (should (equal (format "%d" 0) (sieve-manage-encode 0)))
+  (should (equal (format "%d" 255) (sieve-manage-encode 255)))
+  (should (equal (format "%d" 4294967296)
+                 (sieve-manage-encode 4294967296)))
+
+  ;; simple string
+  (should (equal (format "\"%s\"" smt/script-name-unibyte)
+                 (sieve-manage-encode smt/script-name-unibyte)))
+  (should (equal (format "\"%s\"" (encode-coding-string
+                                   smt/script-name-multibyte
+                                   'utf-8-unix))
+                 (sieve-manage-encode smt/script-name-multibyte)))
+
+  ;; request explicit quoted encoding
+  (should (equal (format "{%d+}\r\n%s"
+                         (length smt/script-name-unibyte)
+                         smt/script-name-unibyte)
+                 (sieve-manage-encode (cons 'literal-c2s smt/script-name-unibyte))))
+  (should (equal "{0+}\r\n"
+                 (sieve-manage-encode (cons 'literal-c2s ""))))
+
+  ;; request explicit literal-c2s encoding
+  (should (equal (format "{%d+}\r\n%s"
+                         (length smt/script-name-unibyte)
+                         smt/script-name-unibyte)
+                 (sieve-manage-encode (cons 'literal-c2s smt/script-name-unibyte))))
+  (should (equal "{0+}\r\n"
+                 (sieve-manage-encode (cons 'literal-c2s ""))))
+
+  ;; request explicit literal-s2c encoding
+  (should (equal (format "{%d}\r\n%s"
+                         (length smt/script-name-unibyte)
+                         smt/script-name-unibyte)
+                 (sieve-manage-encode (cons 'literal-s2c smt/script-name-unibyte))))
+  (should (equal "{0}\r\n"
+                 (sieve-manage-encode (cons 'literal-s2c ""))))
+  )
+
 
 (ert-deftest ert/managesieve-getscript-multibyte ()
-  (should (string= sieve-script-multibyte-unix
-                   (managesieve-getscript sieve-script-multibyte-unix))))
+  (let ((ret (smt/managesieve-getscript smt/script-multibyte-unix)))
+    (should (string= smt/script-multibyte-unix (car ret)))
+    (should (eq 'utf-8-unix (cdr ret))))
+  (let ((ret (smt/managesieve-getscript smt/script-multibyte-dos)))
+    (should (string= smt/script-multibyte-unix (car ret)))
+    (should (eq 'utf-8-dos (cdr ret))))
+  (let ((ret (smt/managesieve-getscript smt/script-multibyte-mac)))
+    (should (string= smt/script-multibyte-unix (car ret)))
+    (should (eq 'utf-8-mac (cdr ret))))
+  )
 
 ;;; sieve-manage-tests.el ends here
-- 
2.39.0


  parent reply	other threads:[~2023-01-23  0:59 UTC|newest]

Thread overview: 38+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2022-02-25  9:04 bug#54154: 29.0.50; [PATCH] `sieve-manage-getscript' fails if script contains multibyte characters Kai Tetzlaff
2022-02-25 12:19 ` Lars Ingebrigtsen
2022-02-25 13:10   ` Lars Ingebrigtsen
2022-02-25 16:00     ` Kai Tetzlaff
2022-02-26 15:07       ` Lars Ingebrigtsen
2022-02-28 12:27         ` Kai Tetzlaff
2022-09-06 11:34           ` Lars Ingebrigtsen
2022-02-28 12:35         ` Kai Tetzlaff
2022-02-28 13:06           ` Lars Ingebrigtsen
2022-02-28 13:08           ` Lars Ingebrigtsen
2022-02-28 13:03         ` Kai Tetzlaff
     [not found] ` <87bkmwi0ut.fsf@tetzco.de>
     [not found]   ` <87fsc8i2c5.fsf@tetzco.de>
     [not found]     ` <87bkmw8b02.fsf@tetzco.de>
2023-01-18 18:28       ` bug#54154: Emacs commit ae963e80a79f5a9184daabfc8197f211a39b136d (sieve-manage) Herbert J. Skuhra
2023-01-18 19:17         ` Eli Zaretskii
2023-01-18 23:22           ` Herbert J. Skuhra
2023-01-19  4:06             ` Kai Tetzlaff
2023-01-19  7:45               ` Eli Zaretskii
2023-01-19 12:38                 ` Kai Tetzlaff
2023-01-19 14:08                   ` Eli Zaretskii
2023-01-19 15:59                     ` Kai Tetzlaff
2023-01-19 17:41                       ` Eli Zaretskii
2023-01-19 21:33                         ` Kai Tetzlaff
2023-01-20  6:54                         ` Kai Tetzlaff
2023-01-22  2:12                         ` Kai Tetzlaff
2023-01-23  0:59                         ` Kai Tetzlaff [this message]
2023-01-23 12:47                           ` Herbert J. Skuhra
2023-01-23 13:01                             ` Kai Tetzlaff
2023-01-23 13:36                               ` Herbert J. Skuhra
2023-01-23 13:57                                 ` Kai Tetzlaff
2023-01-23 14:27                                   ` Andreas Schwab
2023-01-23 17:07                                     ` Kai Tetzlaff
2023-01-23 17:53                                       ` Andreas Schwab
2023-01-23 13:40                               ` Eli Zaretskii
2023-01-23 16:22                                 ` Kai Tetzlaff
2023-01-23 16:49                                   ` Eli Zaretskii
2023-01-23 17:12                                     ` Kai Tetzlaff
2023-01-19 13:22                 ` Kai Tetzlaff
2023-01-19 14:16                 ` Kai Tetzlaff
2023-01-19  4:50             ` bug#54154: [update] " Kai Tetzlaff

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.gnu.org/software/emacs/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=878rhut6aq.fsf@tetzco.de \
    --to=emacs+bug@tetzco.de \
    --cc=54154@debbugs.gnu.org \
    --cc=eliz@gnu.org \
    --cc=herbert@gojira.at \
    --cc=larsi@gnus.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).