bug#54154: Emacs commit ae963e80a79f5a9184daabfc8197f211a39b136d (sieve-manage)

[Kai Tetzlaff <emacs+bug@tetzco.de>]

[-- Attachment #1.1: Type: text/plain, Size: 1077 bytes --]


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?



[-- 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 097edd5192164578e96db75c0b7f76dc340121ca 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/5] 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 5e9c5c14bc2c115b0d36d06bbdd39f6f90687e3b 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/5] 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 9e84b0a7206ba6796e25ebd1045646a48907cbe7 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/5] 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 4889ffcd509f08e6fabb073dd7764e2cd5ffc916 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/5] 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 cde0b4bdcc159edc07ed367f3682f80e5f834725 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/5] 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