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
next prev 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).