* bug#54154: Emacs commit ae963e80a79f5a9184daabfc8197f211a39b136d (sieve-manage)
2023-01-19 17:41 ` Eli Zaretskii
@ 2023-01-19 21:33 ` Kai Tetzlaff
2023-01-20 6:54 ` Kai Tetzlaff
` (2 subsequent siblings)
3 siblings, 0 replies; 43+ messages in thread
From: Kai Tetzlaff @ 2023-01-19 21:33 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: herbert, 54154, larsi
[-- Attachment #1: Type: text/plain, Size: 8054 bytes --]
Eli Zaretskii <eliz@gnu.org> writes:
>> From: Kai Tetzlaff <emacs+bug@tetzco.de>
>> Cc: herbert@gojira.at, larsi@gnus.org, 54154@debbugs.gnu.org
>> Date: Thu, 19 Jan 2023 16:59:36 +0100
>>
>> >> Yes, true. But since `sieve-manage--set-internal-buffer-properties' is
>> >> used in two different places, the more elegant solution you suggested
>> >> above would require duplicating the body of the function in those
>> >> places. I just didn't see a better way.
>> >
>> > I'm not sure why you need to force the encoding of the process buffer,
>> > when you already set the coding-system to be used for decoding stuff
>> > from the process. Is that really needed?
>>
>> Not sure if it is really needed. But I wanted to make sure that both,
>> the process buffer and the log buffer use identical settings. Otherwise,
>> the content of the log buffer might be misleading.
>
> I don't think it could mislead, but OK.
>
>> > But if you really need this, then just make the insertion of the text
>> > into the buffer you create optional: then for the process-buffer pass
>> > nil as the text to insert, and you can do the with-current-buffer
>> > dance only inside that function.
>>
>> Sorry, you lost me there. I don't understand what you want to tell me.
>> Which (optional) text in which buffer?
>
> I meant this:
>
> (defun sieve-manage--set-buffer-and-append-text (buffer-name &rest args)
> (let ((existing-buffer (get-buffer buffer-name))
> new-buffer)
> (if existing-buffer
> (setq new-buffer existing-buffer)
> (setq new-buffer (get-buffer-create buffer-name)))
> (with-current-buffer new-buffer
> (when (not existing-buffer)
> (set-buffer-file-coding-system sieve-manage--coding-system)
> (setq-local after-change-functions nil)
> (buffer-disable-undo)
> ; What happened to set-buffer-multibyte?
> )
> (goto-char (point-max))
> (apply #'insert args))))
>
> Then you can call it from sieve-manage-make-process-buffer like this:
>
> (sieve-manage--set-buffer-and-append-text
> (format " *sieve %s:%s*" sieve-manage-server sieve-manage-port)
> "")
>
> i.e. with an empty string, so nothing gets inserted into the process
> buffer. Or you could instead change the signature to accept a single
> &optional argument that is a list, and then you could make the last
> two lines in the function above conditional on that argument being
> non-nil.
Ok, I now implemented it like this:
(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.
If `sieve-manage-log' is nil, logging is disabled. See also
`sieve-manage--set-buffer-maybe-append-text'."
(when sieve-manage-log
(apply #'sieve-manage--set-buffer-maybe-append-text
sieve-manage-log
args)))
(defun sieve-manage-make-process-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))
Is that better, now? I also added the (set-buffer-multibyte nil) back
into the mix. My understanding was that it was not needed when using the
'raw-text-unix coding system but it is now after switching to
'utf-8-unix?
>> > What you should do is call sieve-manage-encode inside
>> > sieve-manage-send, and count the bytes there after encoding the
>> > payload.
>>
>> Unfortunately, that is too late since the sent data - in case that the
>> sent text may contain CRLF sequences - contains its own length. So in
>> order to insert the correct length, I need to encode before sending.
>> See:
>>
>> (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-parse-oknobye)))
>
> This is because you pass both the text and the number to 'format'.
> But that is not carved in stone: the "%d" part can never produce any
> non-ASCII characters, so there's no need to encode it together with
> CONTENT. You could do this instead:
>
> (defun sieve-manage-send (command &optional payload)
> (let ((encoded (if payload (encode-coding-string payload 'utf-8-unix)))
> size cmdstr)
> (if encoded
> (setq size (format " {%d+}%s"
> (length encoded) sieve-manage-client-eol)))
> (setq cmdstr (concat command size encoded))
> (sieve-manage--append-to-log cmdstr)
> (process-send-string sieve-manage-process cmdstr)))
>
> And then you call this like below:
>
> (sieve-manage-send (format "PUTSCRIPT \"%s\"" name) content)
> (sieve-manage-send (format "HAVESPACE \"%s\" %s" name size))
>
> I hope this clarifies my proposal.
Yes, it does. Actually, I like it.
RFC5804 specifies three variants for string encoding:
string = quoted / literal-c2s / literal-s2c
Only the first two are relevant for `sieve-menage-send' ('literal-s2c'
is for messages from s(server) to c(lient)).
For PUTSCRIPT, we need to use 'literal-c2s' which requires the
additional length element (since 'quoted' is a) limited in the character
set and b) may not exceed 1024 characters). So I would just modify the
your `sieve-manage-send' like this:
(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)))
Apart from renaming some of the variables, this adds encoding of
`command' itself (since command may contain multibyte characters in
script names) and an additional `sieve-manage-client-eol' at the end
of `cmdstr'.
As before, updated patches are attached.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Fix-bug-in-sieve-manage-append-to-log-improve-sieve-.patch --]
[-- Type: text/x-diff, Size: 5956 bytes --]
From 977734f16874636c4f2f5e3bb41a86e4338247c4 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/4] Fix bug in sieve-manage--append-to-log, improve
sieve-manage buffer config
Also update/add some comments/docs.
* 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--set-internal-buffer-properties): New function.
(sieve-manage-open-server): Use `sieve-manage--coding-system'.
(sieve-manage--append-to-log): Use
`sieve-manage--set-internal-buffer-properties' to fix log buffer creation.
(sieve-manage-encode)
(sieve-manage-make-process-buffer): Use
`sieve-manage--set-internal-buffer-properties'.
---
lisp/net/sieve-manage.el | 65 +++++++++++++++++++++++++++-------------
1 file changed, 44 insertions(+), 21 deletions(-)
diff --git a/lisp/net/sieve-manage.el b/lisp/net/sieve-manage.el
index 5bee4f4c4ad..adfecc7b309 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,18 +174,37 @@ sieve-manage-process
(defvar sieve-manage-capability nil)
;; Internal utility functions
+(defun sieve-manage--set-internal-buffer-properties (buffer)
+ "Set BUFFER properties for internally used buffers.
+
+Used for process and log buffers, this function makes sure that
+those buffers keep received and sent data intact by:
+- setting the coding system to 'sieve-manage--coding-system',
+- setting `after-change-functions' to nil to avoid those
+ functions messing with buffer content.
+Also disables undo (to save a bit of memory and improve
+performance).
+
+Returns BUFFER."
+ (with-current-buffer buffer
+ (set-buffer-file-coding-system sieve-manage--coding-system)
+ (setq-local after-change-functions nil)
+ (buffer-disable-undo)
+ (current-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."
+The buffer to use for logging is specifified via `sieve-manage-log'.
+If it is nil, logging is disabled.
+
+When the `sieve-manage-log' buffer doesn't exist, it gets created (and
+configured with some initial settings)."
(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)))
+ (sieve-manage--set-internal-buffer-properties
+ (get-buffer-create sieve-manage-log)))
(goto-char (point-max))
(apply #'insert args))))
@@ -202,9 +228,9 @@ 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.
@@ -216,13 +242,11 @@ sieve-manage-decode
(defun sieve-manage-make-process-buffer ()
(with-current-buffer
- (generate-new-buffer (format " *sieve %s:%s*"
- sieve-manage-server
- sieve-manage-port))
+ (sieve-manage--set-internal-buffer-properties
+ (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)))
(defun sieve-manage-erase (&optional p buffer)
@@ -244,8 +268,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 . ,sieve-manage--coding-system)
:capability-command "CAPABILITY\r\n"
:end-of-command "^\\(OK\\|NO\\).*\n"
:success "^OK.*\n"
--
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: 5654 bytes --]
From c35bbe4a8ece09d0755386009a97ba4a91839753 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/4] Handle BYE in sieve-manage server responses
* 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.
---
lisp/net/sieve-manage.el | 37 ++++++++++++++++++++-----------------
1 file changed, 20 insertions(+), 17 deletions(-)
diff --git a/lisp/net/sieve-manage.el b/lisp/net/sieve-manage.el
index 70d100ead36..b8f91962194 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 8a04e8aaaf3abac0fb9d42bb535633c05be909a2 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/4] 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: 3759 bytes --]
From 24cef4c762f5c5f5de9799b57bf6789ff0724b1d 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/4] 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.
(sieve-edit-script): Make sure that the newly created user facing
sieve-manage buffer is using 'utf-8-unix encoding.
---
lisp/net/sieve.el | 40 +++++++++++++++++++++++++++-------------
1 file changed, 27 insertions(+), 13 deletions(-)
diff --git a/lisp/net/sieve.el b/lisp/net/sieve.el
index fbd07dee27c..1e5aae7825c 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)
@@ -204,6 +206,8 @@ sieve-edit-script
(if (not (string-equal name sieve-new-script))
(let ((newbuf (generate-new-buffer name))
err)
+ (with-current-buffer newbuf
+ (set-buffer-file-coding-system sieve-manage--coding-system))
(setq err (sieve-manage-getscript name newbuf sieve-manage-buffer))
(switch-to-buffer newbuf)
(if (sieve-manage-ok-p err)
@@ -235,23 +239,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 +328,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 +373,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
^ permalink raw reply related [flat|nested] 43+ messages in thread* bug#54154: Emacs commit ae963e80a79f5a9184daabfc8197f211a39b136d (sieve-manage)
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
3 siblings, 0 replies; 43+ messages in thread
From: Kai Tetzlaff @ 2023-01-20 6:54 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: herbert, 54154, larsi
[-- Attachment #1: Type: text/plain, Size: 8147 bytes --]
Eli Zaretskii <eliz@gnu.org> writes:
Sorry, the first patch in the last email was outdated. Please check the
updated ones below.
>> From: Kai Tetzlaff <emacs+bug@tetzco.de>
>> Cc: herbert@gojira.at, larsi@gnus.org, 54154@debbugs.gnu.org
>> Date: Thu, 19 Jan 2023 16:59:36 +0100
>>
>> >> Yes, true. But since `sieve-manage--set-internal-buffer-properties' is
>> >> used in two different places, the more elegant solution you suggested
>> >> above would require duplicating the body of the function in those
>> >> places. I just didn't see a better way.
>> >
>> > I'm not sure why you need to force the encoding of the process buffer,
>> > when you already set the coding-system to be used for decoding stuff
>> > from the process. Is that really needed?
>>
>> Not sure if it is really needed. But I wanted to make sure that both,
>> the process buffer and the log buffer use identical settings. Otherwise,
>> the content of the log buffer might be misleading.
>
> I don't think it could mislead, but OK.
>
>> > But if you really need this, then just make the insertion of the text
>> > into the buffer you create optional: then for the process-buffer pass
>> > nil as the text to insert, and you can do the with-current-buffer
>> > dance only inside that function.
>>
>> Sorry, you lost me there. I don't understand what you want to tell me.
>> Which (optional) text in which buffer?
>
> I meant this:
>
> (defun sieve-manage--set-buffer-and-append-text (buffer-name &rest args)
> (let ((existing-buffer (get-buffer buffer-name))
> new-buffer)
> (if existing-buffer
> (setq new-buffer existing-buffer)
> (setq new-buffer (get-buffer-create buffer-name)))
> (with-current-buffer new-buffer
> (when (not existing-buffer)
> (set-buffer-file-coding-system sieve-manage--coding-system)
> (setq-local after-change-functions nil)
> (buffer-disable-undo)
> ; What happened to set-buffer-multibyte?
> )
> (goto-char (point-max))
> (apply #'insert args))))
>
> Then you can call it from sieve-manage-make-process-buffer like this:
>
> (sieve-manage--set-buffer-and-append-text
> (format " *sieve %s:%s*" sieve-manage-server sieve-manage-port)
> "")
>
> i.e. with an empty string, so nothing gets inserted into the process
> buffer. Or you could instead change the signature to accept a single
> &optional argument that is a list, and then you could make the last
> two lines in the function above conditional on that argument being
> non-nil.
Ok, I now implemented it like this:
(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.
If `sieve-manage-log' is nil, logging is disabled. See also
`sieve-manage--set-buffer-maybe-append-text'."
(when sieve-manage-log
(apply #'sieve-manage--set-buffer-maybe-append-text
sieve-manage-log
args)))
(defun sieve-manage-make-process-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))
Is that better, now? I also added the (set-buffer-multibyte nil) back
into the mix. My understanding was that it was not needed when using the
'raw-text-unix coding system but it is now after switching to
'utf-8-unix?
>> > What you should do is call sieve-manage-encode inside
>> > sieve-manage-send, and count the bytes there after encoding the
>> > payload.
>>
>> Unfortunately, that is too late since the sent data - in case that the
>> sent text may contain CRLF sequences - contains its own length. So in
>> order to insert the correct length, I need to encode before sending.
>> See:
>>
>> (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-parse-oknobye)))
>
> This is because you pass both the text and the number to 'format'.
> But that is not carved in stone: the "%d" part can never produce any
> non-ASCII characters, so there's no need to encode it together with
> CONTENT. You could do this instead:
>
> (defun sieve-manage-send (command &optional payload)
> (let ((encoded (if payload (encode-coding-string payload 'utf-8-unix)))
> size cmdstr)
> (if encoded
> (setq size (format " {%d+}%s"
> (length encoded) sieve-manage-client-eol)))
> (setq cmdstr (concat command size encoded))
> (sieve-manage--append-to-log cmdstr)
> (process-send-string sieve-manage-process cmdstr)))
>
> And then you call this like below:
>
> (sieve-manage-send (format "PUTSCRIPT \"%s\"" name) content)
> (sieve-manage-send (format "HAVESPACE \"%s\" %s" name size))
>
> I hope this clarifies my proposal.
Yes, it does. Actually, I like it.
RFC5804 specifies three variants for string encoding:
string = quoted / literal-c2s / literal-s2c
Only the first two are relevant for `sieve-menage-send' ('literal-s2c'
is for messages from s(server) to c(lient)).
For PUTSCRIPT, we need to use 'literal-c2s' which requires the
additional length element (since 'quoted' is a) limited in the character
set and b) may not exceed 1024 characters). So I would just modify the
your `sieve-manage-send' like this:
(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)))
Apart from renaming some of the variables, this adds encoding of
`command' itself (since command may contain multibyte characters in
script names) and an additional `sieve-manage-client-eol' at the end
of `cmdstr'.
As before, updated patches are attached.
[-- 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: 8960 bytes --]
From a8e07ffdfb150f63c77bfb2a3f3ca59e2633cfbd 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/4] 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 | 115 ++++++++++++++++++++++++++-------------
1 file changed, 78 insertions(+), 37 deletions(-)
diff --git a/lisp/net/sieve-manage.el b/lisp/net/sieve-manage.el
index 5bee4f4c4ad..70d100ead36 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,9 +234,9 @@ 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.
@@ -212,18 +244,18 @@ sieve-manage-decode
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: 5654 bytes --]
From c35bbe4a8ece09d0755386009a97ba4a91839753 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/4] Handle BYE in sieve-manage server responses
* 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.
---
lisp/net/sieve-manage.el | 37 ++++++++++++++++++++-----------------
1 file changed, 20 insertions(+), 17 deletions(-)
diff --git a/lisp/net/sieve-manage.el b/lisp/net/sieve-manage.el
index 70d100ead36..b8f91962194 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 8a04e8aaaf3abac0fb9d42bb535633c05be909a2 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/4] 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: 3759 bytes --]
From 24cef4c762f5c5f5de9799b57bf6789ff0724b1d 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/4] 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.
(sieve-edit-script): Make sure that the newly created user facing
sieve-manage buffer is using 'utf-8-unix encoding.
---
lisp/net/sieve.el | 40 +++++++++++++++++++++++++++-------------
1 file changed, 27 insertions(+), 13 deletions(-)
diff --git a/lisp/net/sieve.el b/lisp/net/sieve.el
index fbd07dee27c..1e5aae7825c 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)
@@ -204,6 +206,8 @@ sieve-edit-script
(if (not (string-equal name sieve-new-script))
(let ((newbuf (generate-new-buffer name))
err)
+ (with-current-buffer newbuf
+ (set-buffer-file-coding-system sieve-manage--coding-system))
(setq err (sieve-manage-getscript name newbuf sieve-manage-buffer))
(switch-to-buffer newbuf)
(if (sieve-manage-ok-p err)
@@ -235,23 +239,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 +328,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 +373,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
^ permalink raw reply related [flat|nested] 43+ messages in thread* bug#54154: Emacs commit ae963e80a79f5a9184daabfc8197f211a39b136d (sieve-manage)
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
3 siblings, 0 replies; 43+ messages in thread
From: Kai Tetzlaff @ 2023-01-22 2:12 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: herbert, 54154, larsi
[-- 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
^ permalink raw reply related [flat|nested] 43+ messages in thread* bug#54154: Emacs commit ae963e80a79f5a9184daabfc8197f211a39b136d (sieve-manage)
2023-01-19 17:41 ` Eli Zaretskii
` (2 preceding siblings ...)
2023-01-22 2:12 ` Kai Tetzlaff
@ 2023-01-23 0:59 ` Kai Tetzlaff
2023-01-23 12:47 ` Herbert J. Skuhra
3 siblings, 1 reply; 43+ messages in thread
From: Kai Tetzlaff @ 2023-01-23 0:59 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: herbert, 54154, larsi
[-- 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
^ permalink raw reply related [flat|nested] 43+ messages in thread* bug#54154: Emacs commit ae963e80a79f5a9184daabfc8197f211a39b136d (sieve-manage)
2023-01-23 0:59 ` Kai Tetzlaff
@ 2023-01-23 12:47 ` Herbert J. Skuhra
2023-01-23 13:01 ` Kai Tetzlaff
0 siblings, 1 reply; 43+ messages in thread
From: Herbert J. Skuhra @ 2023-01-23 12:47 UTC (permalink / raw)
To: Kai Tetzlaff; +Cc: Eli Zaretskii, 54154, larsi
On Mon, Jan 23, 2023 at 01:59:09AM +0100, Kai Tetzlaff wrote:
> 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.
No, the change was not merged to master.
Thanks.
--
Herbert
^ permalink raw reply [flat|nested] 43+ messages in thread
* bug#54154: Emacs commit ae963e80a79f5a9184daabfc8197f211a39b136d (sieve-manage)
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:40 ` Eli Zaretskii
0 siblings, 2 replies; 43+ messages in thread
From: Kai Tetzlaff @ 2023-01-23 13:01 UTC (permalink / raw)
To: Herbert J. Skuhra; +Cc: Eli Zaretskii, 54154, larsi
"Herbert J. Skuhra" <herbert@gojira.at> writes:
> On Mon, Jan 23, 2023 at 01:59:09AM +0100, Kai Tetzlaff wrote:
>> 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.
>
> No, the change was not merged to master.
Hmm, what about:
$ git log --grep "^Fix bug in 'sieve-manage--append-to-log" origin/master
commit 12d7670b90f66f1d45a8c69d9acfc25238a65b02
Author: Kai Tetzlaff <emacs@tetzco.de>
Date: 2023-01-19 03:16:14 +0100
Fix bug in 'sieve-manage--append-to-log'
* lisp/net/sieve-manage.el (sieve-manage--append-to-log): Fix
log buffer creation. (Bug#54154) Do not merge to master.
BR, Kai
^ permalink raw reply [flat|nested] 43+ messages in thread* bug#54154: Emacs commit ae963e80a79f5a9184daabfc8197f211a39b136d (sieve-manage)
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 13:40 ` Eli Zaretskii
1 sibling, 1 reply; 43+ messages in thread
From: Herbert J. Skuhra @ 2023-01-23 13:36 UTC (permalink / raw)
To: Kai Tetzlaff; +Cc: Eli Zaretskii, 54154, larsi
On Mon, Jan 23, 2023 at 02:01:02PM +0100, Kai Tetzlaff wrote:
>
> Hmm, what about:
>
> $ git log --grep "^Fix bug in 'sieve-manage--append-to-log" origin/master
> commit 12d7670b90f66f1d45a8c69d9acfc25238a65b02
> Author: Kai Tetzlaff <emacs@tetzco.de>
> Date: 2023-01-19 03:16:14 +0100
>
> Fix bug in 'sieve-manage--append-to-log'
>
> * lisp/net/sieve-manage.el (sieve-manage--append-to-log): Fix
> log buffer creation. (Bug#54154) Do not merge to master.
Well, I don't see this change in my checkout (and even in a fresh clone)
and sieve-manage still produces the reported error.
Last entry of 'git log lisp/net/sieve-manage.el' is:
commit cae528457cb862dc886a34240c9d4c73035b6659
Author: Eli Zaretskii
Date: Sun Jan 1 05:31:12 2023 -0500
; Add 2023 to copyright years.
--
Herbert
^ permalink raw reply [flat|nested] 43+ messages in thread* bug#54154: Emacs commit ae963e80a79f5a9184daabfc8197f211a39b136d (sieve-manage)
2023-01-23 13:36 ` Herbert J. Skuhra
@ 2023-01-23 13:57 ` Kai Tetzlaff
2023-01-23 14:27 ` Andreas Schwab
0 siblings, 1 reply; 43+ messages in thread
From: Kai Tetzlaff @ 2023-01-23 13:57 UTC (permalink / raw)
To: Herbert J. Skuhra; +Cc: Eli Zaretskii, 54154, larsi
"Herbert J. Skuhra" <herbert@gojira.at> writes:
> On Mon, Jan 23, 2023 at 02:01:02PM +0100, Kai Tetzlaff wrote:
>>
>> Hmm, what about:
>>
>> $ git log --grep "^Fix bug in 'sieve-manage--append-to-log" origin/master
>> commit 12d7670b90f66f1d45a8c69d9acfc25238a65b02
>> Author: Kai Tetzlaff <emacs@tetzco.de>
>> Date: 2023-01-19 03:16:14 +0100
>>
>> Fix bug in 'sieve-manage--append-to-log'
>>
>> * lisp/net/sieve-manage.el (sieve-manage--append-to-log): Fix
>> log buffer creation. (Bug#54154) Do not merge to master.
>
>
> Well, I don't see this change in my checkout (and even in a fresh clone)
> and sieve-manage still produces the reported error.
>
> Last entry of 'git log lisp/net/sieve-manage.el' is:
>
> commit cae528457cb862dc886a34240c9d4c73035b6659
> Author: Eli Zaretskii
> Date: Sun Jan 1 05:31:12 2023 -0500
>
> ; Add 2023 to copyright years.
You're right!
And I learned something about git again. `git log --grep ...` apparently
silently ignores my origin/master ref and greps through all available
refs.
^ permalink raw reply [flat|nested] 43+ messages in thread
* bug#54154: Emacs commit ae963e80a79f5a9184daabfc8197f211a39b136d (sieve-manage)
2023-01-23 13:57 ` Kai Tetzlaff
@ 2023-01-23 14:27 ` Andreas Schwab
2023-01-23 17:07 ` Kai Tetzlaff
0 siblings, 1 reply; 43+ messages in thread
From: Andreas Schwab @ 2023-01-23 14:27 UTC (permalink / raw)
To: Kai Tetzlaff; +Cc: larsi, Herbert J. Skuhra, 54154, Eli Zaretskii
On Jan 23 2023, Kai Tetzlaff wrote:
> And I learned something about git again. `git log --grep ...` apparently
> silently ignores my origin/master ref and greps through all available
> refs.
It searches through all commit messages that you would see without the
--grep option.
--
Andreas Schwab, SUSE Labs, schwab@suse.de
GPG Key fingerprint = 0196 BAD8 1CE9 1970 F4BE 1748 E4D4 88E3 0EEA B9D7
"And now for something completely different."
^ permalink raw reply [flat|nested] 43+ messages in thread
* bug#54154: Emacs commit ae963e80a79f5a9184daabfc8197f211a39b136d (sieve-manage)
2023-01-23 14:27 ` Andreas Schwab
@ 2023-01-23 17:07 ` Kai Tetzlaff
2023-01-23 17:53 ` Andreas Schwab
0 siblings, 1 reply; 43+ messages in thread
From: Kai Tetzlaff @ 2023-01-23 17:07 UTC (permalink / raw)
To: Andreas Schwab; +Cc: larsi, Herbert J. Skuhra, 54154, Eli Zaretskii
Andreas Schwab <schwab@suse.de> writes:
> On Jan 23 2023, Kai Tetzlaff wrote:
>
>> And I learned something about git again. `git log --grep ...` apparently
>> silently ignores my origin/master ref and greps through all available
>> refs.
>
> It searches through all commit messages that you would see without the
> --grep option.
And right again. This really stumped me. So after some investigation on
my part, here's where my confusion originated. To check git logs, I
typically use an alias (l2) which adds the `--graph` option to git log.
And `git log --pretty=oneline --graph` then actually results in:
...
| * 0d3b6518e39a28774e4e70ed9bb7ef4aa009c0cf (ruby-ts--indent-rules): Indent inside empty parens properly
| * 7fb69ce233b8a655af63d4c47b7359c43660acf6 (emacs-29) ; * doc/emacs/modes.texi (Choosing Modes): Add index entries.
* | ede5e82418a0b8cfce2bf96b2a3255ca86b65000 ; Merge from origin/emacs-29
|\|
| * 12d7670b90f66f1d45a8c69d9acfc25238a65b02 Fix bug in 'sieve-manage--append-to-log'
* | e9ceeee1198aa10cac3cd61ff9537b64640455c2 Merge from origin/emacs-29
|\|
| * 21be03cccb611ea9e6c73fb04e578c48edf49a25 CC Mode: Prevent two classes of "type" prematurely entering c-found-types
* | 117f90865adca03eab84778db0370ddc05ba8ae7 Add new command `kill-matching-buffers-no-ask' (bug#60714)
...
Which seems to indicate that commit
12d7670b90f66f1d45a8c69d9acfc25238a65b02 Fix bug in 'sieve-manage--append-to-log'
has been merged to master.
However, here's the actual merge commit:
$ git log --patch -1 ede5e82418a0b8cfce2bf96b2a3255ca86b65000
commit ede5e82418a0b8cfce2bf96b2a3255ca86b65000
Merge: e9ceeee1198 12d7670b90f
Author: Stefan Kangas <stefankangas@gmail.com>
Date: 2023-01-20 11:30:22 +0100
; Merge from origin/emacs-29
The following commit was skipped:
12d7670b90f Fix bug in 'sieve-manage--append-to-log'
That's it. I.e. it is completely empty because the only commit which was
actually (supposed to be) merged was then just skipped. I guess that this is
needed for git to recognize that the commit was purposely skipped (so
that git will not include it in subsequent merges).
So, as ever so often, the problem was sitting in front of the monitor. I
must admit that I still find this behaviour surprising/unexpected. But
good to know! Beware of `git log --graph` ...
BR, Kai
^ permalink raw reply [flat|nested] 43+ messages in thread* bug#54154: Emacs commit ae963e80a79f5a9184daabfc8197f211a39b136d (sieve-manage)
2023-01-23 17:07 ` Kai Tetzlaff
@ 2023-01-23 17:53 ` Andreas Schwab
2024-09-29 9:11 ` Herbert J. Skuhra
[not found] ` <87o74696he.wl-herbert@gojira.at>
0 siblings, 2 replies; 43+ messages in thread
From: Andreas Schwab @ 2023-01-23 17:53 UTC (permalink / raw)
To: Kai Tetzlaff; +Cc: larsi, 54154, Herbert J. Skuhra, Eli Zaretskii
On Jan 23 2023, Kai Tetzlaff wrote:
> That's it. I.e. it is completely empty because the only commit which was
> actually (supposed to be) merged was then just skipped.
In other words, it is an evil merge.
--
Andreas Schwab, SUSE Labs, schwab@suse.de
GPG Key fingerprint = 0196 BAD8 1CE9 1970 F4BE 1748 E4D4 88E3 0EEA B9D7
"And now for something completely different."
^ permalink raw reply [flat|nested] 43+ messages in thread* bug#54154: Emacs commit ae963e80a79f5a9184daabfc8197f211a39b136d (sieve-manage)
2023-01-23 17:53 ` Andreas Schwab
@ 2024-09-29 9:11 ` Herbert J. Skuhra
[not found] ` <87o74696he.wl-herbert@gojira.at>
1 sibling, 0 replies; 43+ messages in thread
From: Herbert J. Skuhra @ 2024-09-29 9:11 UTC (permalink / raw)
To: 54154
Hi,
Unfortunately I still see the following issue in master and emacs-30:
- Run emacs -Q
- M-x sieve-manage
- Input IMAP server (e.g. imap.mailbox.org)
Debugger entered--Lisp error: (wrong-type-argument stringp t)
sieve-manage--append-to-log("sieve-manage: Connecting to imap.mailbox.org..." "\n")
sieve-manage--message("Connecting to %s..." "imap.mailbox.org")
sieve-manage-open("imap.mailbox.org" nil)
sieve-open-server("imap.mailbox.org" nil)
sieve-manage("imap.mailbox.org")
funcall-interactively(sieve-manage "imap.mailbox.org")
command-execute(sieve-manage record)
execute-extended-command(nil "sieve-manage" "sieve-ma")
funcall-interactively(execute-extended-command nil "sieve-manage" "sieve-ma")
command-execute(execute-extended-command)
On 2nd try it works!
--
Herber
^ permalink raw reply [flat|nested] 43+ messages in thread[parent not found: <87o74696he.wl-herbert@gojira.at>]
* bug#54154: Emacs commit ae963e80a79f5a9184daabfc8197f211a39b136d (sieve-manage)
[not found] ` <87o74696he.wl-herbert@gojira.at>
@ 2024-09-29 9:29 ` Eli Zaretskii
2024-09-29 10:23 ` Eli Zaretskii
0 siblings, 1 reply; 43+ messages in thread
From: Eli Zaretskii @ 2024-09-29 9:29 UTC (permalink / raw)
To: Herbert J. Skuhra; +Cc: larsi, 54154, emacs+bug
> Date: Sun, 29 Sep 2024 11:03:41 +0200
> From: "Herbert J. Skuhra" <herbert@gojira.at>
> Cc: Kai Tetzlaff <emacs+bug@tetzco.de>,
> larsi@gnus.org,
> 54154@debbugs.gnu.org,
> Eli Zaretskii <eliz@gnu.org>
>
> Hi,
>
> Unfortunately I still see the following issue in master and emacs-30:
>
> - Run emacs -Q
> - M-x sieve-manage
> - Input IMAP server (e.g. imap.mailbox.org)
>
> Debugger entered--Lisp error: (wrong-type-argument stringp t)
> sieve-manage--append-to-log("sieve-manage: Connecting to imap.mailbox.org..." "\n")
> sieve-manage--message("Connecting to %s..." "imap.mailbox.org")
> sieve-manage-open("imap.mailbox.org" nil)
> sieve-open-server("imap.mailbox.org" nil)
> sieve-manage("imap.mailbox.org")
> funcall-interactively(sieve-manage "imap.mailbox.org")
> command-execute(sieve-manage record)
> execute-extended-command(nil "sieve-manage" "sieve-ma")
> funcall-interactively(execute-extended-command nil "sieve-manage" "sieve-ma")
> command-execute(execute-extended-command)
>
> On 2nd try it works!
The fix was not merged to the-then master branch, so it is not in
Emacs 30. Therefore, it is not a surprise you still see the problem:
it was only fixed in Emacs 29.
I lost the context long ago, so I hope Kai will suggest how to handle
this.
^ permalink raw reply [flat|nested] 43+ messages in thread* bug#54154: Emacs commit ae963e80a79f5a9184daabfc8197f211a39b136d (sieve-manage)
2024-09-29 9:29 ` Eli Zaretskii
@ 2024-09-29 10:23 ` Eli Zaretskii
2024-09-29 12:15 ` Herbert J. Skuhra
0 siblings, 1 reply; 43+ messages in thread
From: Eli Zaretskii @ 2024-09-29 10:23 UTC (permalink / raw)
To: herbert; +Cc: larsi, 54154, emacs+bug
> Cc: larsi@gnus.org, 54154@debbugs.gnu.org, emacs+bug@tetzco.de
> Date: Sun, 29 Sep 2024 12:29:39 +0300
> From: Eli Zaretskii <eliz@gnu.org>
>
> > - Run emacs -Q
> > - M-x sieve-manage
> > - Input IMAP server (e.g. imap.mailbox.org)
> >
> > Debugger entered--Lisp error: (wrong-type-argument stringp t)
> > sieve-manage--append-to-log("sieve-manage: Connecting to imap.mailbox.org..." "\n")
> > sieve-manage--message("Connecting to %s..." "imap.mailbox.org")
> > sieve-manage-open("imap.mailbox.org" nil)
> > sieve-open-server("imap.mailbox.org" nil)
> > sieve-manage("imap.mailbox.org")
> > funcall-interactively(sieve-manage "imap.mailbox.org")
> > command-execute(sieve-manage record)
> > execute-extended-command(nil "sieve-manage" "sieve-ma")
> > funcall-interactively(execute-extended-command nil "sieve-manage" "sieve-ma")
> > command-execute(execute-extended-command)
> >
> > On 2nd try it works!
>
> The fix was not merged to the-then master branch, so it is not in
> Emacs 30. Therefore, it is not a surprise you still see the problem:
> it was only fixed in Emacs 29.
>
> I lost the context long ago, so I hope Kai will suggest how to handle
> this.
However, it's quite possible that the following band-aid should fix
this particular issue:
diff --git a/lisp/net/sieve-manage.el b/lisp/net/sieve-manage.el
index 0faeb02..da2167c 100644
--- a/lisp/net/sieve-manage.el
+++ b/lisp/net/sieve-manage.el
@@ -178,7 +178,8 @@ sieve-manage--append-to-log
(with-current-buffer
(get-buffer-create sieve-manage-log)
(set-buffer-multibyte nil)
- (buffer-disable-undo)))
+ (buffer-disable-undo)
+ (current-buffer)))
(goto-char (point-max))
(apply #'insert args))))
Can you test this?
^ permalink raw reply related [flat|nested] 43+ messages in thread* bug#54154: Emacs commit ae963e80a79f5a9184daabfc8197f211a39b136d (sieve-manage)
2024-09-29 10:23 ` Eli Zaretskii
@ 2024-09-29 12:15 ` Herbert J. Skuhra
2024-09-29 12:43 ` Eli Zaretskii
0 siblings, 1 reply; 43+ messages in thread
From: Herbert J. Skuhra @ 2024-09-29 12:15 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: larsi, 54154, emacs+bug
On Sun, 29 Sep 2024 12:23:03 +0200,
Eli Zaretskii <eliz@gnu.org> wrote:
>
> > Cc: larsi@gnus.org, 54154@debbugs.gnu.org, emacs+bug@tetzco.de
> > Date: Sun, 29 Sep 2024 12:29:39 +0300
> > From: Eli Zaretskii <eliz@gnu.org>
> >
> > > - Run emacs -Q
> > > - M-x sieve-manage
> > > - Input IMAP server (e.g. imap.mailbox.org)
> > >
> > > Debugger entered--Lisp error: (wrong-type-argument stringp t)
> > > sieve-manage--append-to-log("sieve-manage: Connecting to imap.mailbox.org..." "\n")
> > > sieve-manage--message("Connecting to %s..." "imap.mailbox.org")
> > > sieve-manage-open("imap.mailbox.org" nil)
> > > sieve-open-server("imap.mailbox.org" nil)
> > > sieve-manage("imap.mailbox.org")
> > > funcall-interactively(sieve-manage "imap.mailbox.org")
> > > command-execute(sieve-manage record)
> > > execute-extended-command(nil "sieve-manage" "sieve-ma")
> > > funcall-interactively(execute-extended-command nil "sieve-manage" "sieve-ma")
> > > command-execute(execute-extended-command)
> > >
> > > On 2nd try it works!
> >
> > The fix was not merged to the-then master branch, so it is not in
> > Emacs 30. Therefore, it is not a surprise you still see the problem:
> > it was only fixed in Emacs 29.
> >
> > I lost the context long ago, so I hope Kai will suggest how to handle
> > this.
>
> However, it's quite possible that the following band-aid should fix
> this particular issue:
>
> diff --git a/lisp/net/sieve-manage.el b/lisp/net/sieve-manage.el
> index 0faeb02..da2167c 100644
> --- a/lisp/net/sieve-manage.el
> +++ b/lisp/net/sieve-manage.el
> @@ -178,7 +178,8 @@ sieve-manage--append-to-log
> (with-current-buffer
> (get-buffer-create sieve-manage-log)
> (set-buffer-multibyte nil)
> - (buffer-disable-undo)))
> + (buffer-disable-undo)
> + (current-buffer)))
> (goto-char (point-max))
> (apply #'insert args))))
Yes, this works. Thanks.
As manage-sieve logs credentials maybe logging should be disabled by
default and/or credentials shouldn't be logged when logging is
enabled?
^ permalink raw reply [flat|nested] 43+ messages in thread* bug#54154: Emacs commit ae963e80a79f5a9184daabfc8197f211a39b136d (sieve-manage)
2024-09-29 12:15 ` Herbert J. Skuhra
@ 2024-09-29 12:43 ` Eli Zaretskii
0 siblings, 0 replies; 43+ messages in thread
From: Eli Zaretskii @ 2024-09-29 12:43 UTC (permalink / raw)
To: Herbert J. Skuhra; +Cc: larsi, 54154, emacs+bug
> Date: Sun, 29 Sep 2024 14:15:47 +0200
> From: "Herbert J. Skuhra" <herbert@gojira.at>
> Cc: larsi@gnus.org,
> 54154@debbugs.gnu.org,
> emacs+bug@tetzco.de
>
> On Sun, 29 Sep 2024 12:23:03 +0200,
> Eli Zaretskii <eliz@gnu.org> wrote:
> >
> > > Cc: larsi@gnus.org, 54154@debbugs.gnu.org, emacs+bug@tetzco.de
> > > Date: Sun, 29 Sep 2024 12:29:39 +0300
> > > From: Eli Zaretskii <eliz@gnu.org>
> > >
> > > > - Run emacs -Q
> > > > - M-x sieve-manage
> > > > - Input IMAP server (e.g. imap.mailbox.org)
> > > >
> > > > Debugger entered--Lisp error: (wrong-type-argument stringp t)
> > > > sieve-manage--append-to-log("sieve-manage: Connecting to imap.mailbox.org..." "\n")
> > > > sieve-manage--message("Connecting to %s..." "imap.mailbox.org")
> > > > sieve-manage-open("imap.mailbox.org" nil)
> > > > sieve-open-server("imap.mailbox.org" nil)
> > > > sieve-manage("imap.mailbox.org")
> > > > funcall-interactively(sieve-manage "imap.mailbox.org")
> > > > command-execute(sieve-manage record)
> > > > execute-extended-command(nil "sieve-manage" "sieve-ma")
> > > > funcall-interactively(execute-extended-command nil "sieve-manage" "sieve-ma")
> > > > command-execute(execute-extended-command)
> > > >
> > > > On 2nd try it works!
> > >
> > > The fix was not merged to the-then master branch, so it is not in
> > > Emacs 30. Therefore, it is not a surprise you still see the problem:
> > > it was only fixed in Emacs 29.
> > >
> > > I lost the context long ago, so I hope Kai will suggest how to handle
> > > this.
> >
> > However, it's quite possible that the following band-aid should fix
> > this particular issue:
> >
> > diff --git a/lisp/net/sieve-manage.el b/lisp/net/sieve-manage.el
> > index 0faeb02..da2167c 100644
> > --- a/lisp/net/sieve-manage.el
> > +++ b/lisp/net/sieve-manage.el
> > @@ -178,7 +178,8 @@ sieve-manage--append-to-log
> > (with-current-buffer
> > (get-buffer-create sieve-manage-log)
> > (set-buffer-multibyte nil)
> > - (buffer-disable-undo)))
> > + (buffer-disable-undo)
> > + (current-buffer)))
> > (goto-char (point-max))
> > (apply #'insert args))))
>
> Yes, this works. Thanks.
Thanks, installed on the emacs-30 branch.
> As manage-sieve logs credentials maybe logging should be disabled by
> default and/or credentials shouldn't be logged when logging is
> enabled?
I'll let Kai and others comment on that.
^ permalink raw reply [flat|nested] 43+ messages in thread
* bug#54154: Emacs commit ae963e80a79f5a9184daabfc8197f211a39b136d (sieve-manage)
2023-01-23 13:01 ` Kai Tetzlaff
2023-01-23 13:36 ` Herbert J. Skuhra
@ 2023-01-23 13:40 ` Eli Zaretskii
2023-01-23 16:22 ` Kai Tetzlaff
1 sibling, 1 reply; 43+ messages in thread
From: Eli Zaretskii @ 2023-01-23 13:40 UTC (permalink / raw)
To: Kai Tetzlaff; +Cc: herbert, 54154, larsi
> From: Kai Tetzlaff <emacs+bug@tetzco.de>
> Cc: Eli Zaretskii <eliz@gnu.org>, larsi@gnus.org, 54154@debbugs.gnu.org
> Date: Mon, 23 Jan 2023 14:01:02 +0100
>
> "Herbert J. Skuhra" <herbert@gojira.at> writes:
>
> > On Mon, Jan 23, 2023 at 01:59:09AM +0100, Kai Tetzlaff wrote:
> >> 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.
> >
> > No, the change was not merged to master.
> Hmm, what about:
>
> $ git log --grep "^Fix bug in 'sieve-manage--append-to-log" origin/master
> commit 12d7670b90f66f1d45a8c69d9acfc25238a65b02
> Author: Kai Tetzlaff <emacs@tetzco.de>
> Date: 2023-01-19 03:16:14 +0100
>
> Fix bug in 'sieve-manage--append-to-log'
>
> * lisp/net/sieve-manage.el (sieve-manage--append-to-log): Fix
> log buffer creation. (Bug#54154) Do not merge to master.
The "Do not merge to master" part prevents its merging to the master
branch.
This was according to your request: you intended (and still do, AFAIU)
to fix this differently on the master branch, for Emacs 30.
^ permalink raw reply [flat|nested] 43+ messages in thread
* bug#54154: Emacs commit ae963e80a79f5a9184daabfc8197f211a39b136d (sieve-manage)
2023-01-23 13:40 ` Eli Zaretskii
@ 2023-01-23 16:22 ` Kai Tetzlaff
2023-01-23 16:49 ` Eli Zaretskii
0 siblings, 1 reply; 43+ messages in thread
From: Kai Tetzlaff @ 2023-01-23 16:22 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: herbert, 54154, larsi
[-- Attachment #1: Type: text/plain, Size: 2990 bytes --]
Eli Zaretskii <eliz@gnu.org> writes:
>> From: Kai Tetzlaff <emacs+bug@tetzco.de>
>> Cc: Eli Zaretskii <eliz@gnu.org>, larsi@gnus.org, 54154@debbugs.gnu.org
>> Date: Mon, 23 Jan 2023 14:01:02 +0100
>>
>> "Herbert J. Skuhra" <herbert@gojira.at> writes:
>>
>> > On Mon, Jan 23, 2023 at 01:59:09AM +0100, Kai Tetzlaff wrote:
>> >> 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.
>> >
>> > No, the change was not merged to master.
>> Hmm, what about:
>>
>> $ git log --grep "^Fix bug in 'sieve-manage--append-to-log" origin/master
>> commit 12d7670b90f66f1d45a8c69d9acfc25238a65b02
>> Author: Kai Tetzlaff <emacs@tetzco.de>
>> Date: 2023-01-19 03:16:14 +0100
>>
>> Fix bug in 'sieve-manage--append-to-log'
>>
>> * lisp/net/sieve-manage.el (sieve-manage--append-to-log): Fix
>> log buffer creation. (Bug#54154) Do not merge to master.
>
> The "Do not merge to master" part prevents its merging to the master
> branch.
Yes, I just was under the wrong assumption that this didn't work.
> This was according to your request: you intended (and still do, AFAIU)
> to fix this differently on the master branch, for Emacs 30.
Correct, I'm still working on additional sieve-manage changes for
master. However, I've now updated/reordered the patches. And from
my POV, the following are ready to be applied to master:
1. 0001-Fix-bug-in-sieve-manage-append-to-log-and-do-some-re.patch: This
is the master version of the patch which has been added to emacs-29.
2. 0002-Handle-BYE-in-sieve-manage-server-responses.patch: Adds support
for BYE in server responses.
3. 0003-Some-minor-fixes-in-lisp-net-sieve.el.patch: Fixes some minor
usability issues in sieve.el.
4. 0004-Autodetect-eol-type-of-sieve-manage-scripts.patch: Adds eol-type
autodetection. Avoids showing '^M's in sieve script buffers for
scripts which use CRLF EOLs.
For the other two:
5. 0005-Add-test-lisp-net-sieve-manage-tests.el.patch: This adds a first
test which verifies that multibyte script names and scripts can be
downloaded without issues. I wrote this already last year, but then
Lars committed what was on debbugs before I got to add it there.
However, since I've already added additional tests in patch 0006-*,
it might not be worth adding this one right now. Up to you...
6. 0006-WiP-new-encode-tested-OK.patch: This is contains my current WiP
status. It works but is not ready/finished. It will probably take me
one or two weeks to finish it. Some of the changes affect code
which got updated/added in patches 0001/0002/0004. And there are a
lot of new tests.
Eli, how do you want to handle this? Apply the first patches now? Wait
until I'm done with all all of them? Or, ...? Feedback appreciated!
Thanks,
Kai
[-- 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: 9120 bytes --]
From 3a3fb7d4a44d00d8450261a9bc5eca08014c3594 Mon Sep 17 00:00:00 2001
From: Kai Tetzlaff <emacs@tetzco.de>
Date: Mon, 23 Jan 2023 15:28:57 +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--convert-multibyte): Renamed from `sieve-manage-encode',
change misleading argument name (utf8-string -> str), use
`sieve-manage--coding-system'.
(sieve-manage--coding-system): New constant.
(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 | 119 ++++++++++++++++++++++++++-------------
1 file changed, 81 insertions(+), 38 deletions(-)
diff --git a/lisp/net/sieve-manage.el b/lisp/net/sieve-manage.el
index 5bee4f4c4ad..b6d3fa573e8 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 the value of `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,29 @@ 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--convert-multibyte (str)
+ "Convert multibyte STR to unibyte octet string.
+The conversion is done using `sieve-manage--coding-system'."
+ (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 +277,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 +512,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 +639,24 @@ 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--convert-multibyte
+ 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--convert-multibyte 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: 7261 bytes --]
From 30695a712ac7fdecf276c2bb3806b8cbba20b576 Mon Sep 17 00:00:00 2001
From: Kai Tetzlaff <emacs@tetzco.de>
Date: Mon, 23 Jan 2023 16:53:10 +0100
Subject: [PATCH 2/6] Handle BYE in sieve-manage server responses
* 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.
(sieve-manage-open-server): Use `sieve-manager-(client|server)-eol'
for consistency.
* etc/NEWS: Mention the support for BYE.
---
etc/NEWS | 12 +++++++++++
lisp/net/sieve-manage.el | 43 ++++++++++++++++++++++------------------
2 files changed, 36 insertions(+), 19 deletions(-)
diff --git a/etc/NEWS b/etc/NEWS
index 5b8ab06086c..bebea918b11 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -195,6 +195,18 @@ This command adds a docstring comment to the current defun. If a
comment already exists, point is only moved to the comment. It is
bound to 'C-c C-d' in 'go-ts-mode'.
+** 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 b6d3fa573e8..79f97f371e0 100644
--- a/lisp/net/sieve-manage.el
+++ b/lisp/net/sieve-manage.el
@@ -278,15 +278,17 @@ sieve-manage-open-server
"SIEVE" buffer server port
:type stream
:coding 'binary
- :capability-command "CAPABILITY\r\n"
- :end-of-command "^\\(OK\\|NO\\).*\n"
- :success "^OK.*\n"
+ :capability-command (concat "CAPABILITY"
+ sieve-manage-client-eol)
+ :end-of-command (concat "^\\(OK\\|NO\\|BYE\\).*"
+ sieve-manage-server-eol)
+ :success (concat "^OK.*" sieve-manage-server-eol)
:return-list t
:starttls-function
(lambda (capabilities)
(when (and (not sieve-manage-ignore-starttls)
(string-match "\\bSTARTTLS\\b" capabilities))
- "STARTTLS\r\n")))))
+ (concat "STARTTLS" sieve-manage-client-eol))))))
(setq sieve-manage-process proc)
(setq sieve-manage-capability
(sieve-manage-parse-capability (plist-get props :capabilities)))
@@ -339,7 +341,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)
@@ -508,17 +510,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))
@@ -526,17 +528,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))
@@ -554,10 +561,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)))
@@ -566,12 +571,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))
@@ -605,7 +610,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)))))
@@ -619,7 +624,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
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0003-Some-minor-fixes-in-lisp-net-sieve.el.patch --]
[-- Type: text/x-diff, Size: 4488 bytes --]
From 75348dd4bcd40ed2ce732ecd91a887fb1ce0be1d Mon Sep 17 00:00:00 2001
From: Kai Tetzlaff <emacs@tetzco.de>
Date: Mon, 23 Jan 2023 16:53:24 +0100
Subject: [PATCH 3/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.
(sieve-edit-script): Improve upload hint in the message area of the
created sieve script buffer.
---
lisp/net/sieve.el | 49 +++++++++++++++++++++++++++++++----------------
1 file changed, 33 insertions(+), 16 deletions(-)
diff --git a/lisp/net/sieve.el b/lisp/net/sieve.el
index fbd07dee27c..a73584f203c 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)
@@ -219,8 +221,13 @@ sieve-edit-script
(setq sieve-buffer-script-name name)
(goto-char (point-min))
(set-buffer-modified-p nil)
- (message "Press %s to upload script to server."
- (substitute-command-keys "\\[sieve-upload]"))))
+ (message (string-join '("Type %s to upload script"
+ "%s to upload and kill buffer"
+ "%s to return to *sieve* buffer")
+ ", ")
+ (substitute-command-keys "\\[sieve-upload]")
+ (substitute-command-keys "\\[sieve-upload-and-kill]")
+ (substitute-command-keys "\\[sieve-manage]"))))
(defmacro sieve-change-region (&rest body)
"Turn off sieve-region before executing BODY, then re-enables it after.
@@ -235,23 +242,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."
@@ -285,7 +297,7 @@ sieve-highlight
(overlay-put (car (overlays-at (point))) 'face (if on 'highlight 'default)))
(defun sieve-insert-scripts (scripts)
- "Format and insert LANGUAGE-LIST strings into current buffer at point."
+ "Format and insert SCRIPTS strings into current buffer at point."
(while scripts
(let ((p (point))
(ext nil)
@@ -319,6 +331,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 +376,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 #5: 0004-Autodetect-eol-type-of-sieve-manage-scripts.patch --]
[-- Type: text/x-diff, Size: 7351 bytes --]
From ffcfac99012f9a34b4bd3e735ad2337df988b5a8 Mon Sep 17 00:00:00 2001
From: Kai Tetzlaff <emacs@tetzco.de>
Date: Mon, 23 Jan 2023 16:53:39 +0100
Subject: [PATCH 4/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--detect-buffer-coding-system): New function which
detects the eol-type of a downloaded script and returns either
'utf-8-unix, 'utf-8-dos or 'utf-8-mac (if the latter is actually
supported by any existing server or even makes sense ...).
(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 | 56 ++++++++++++++++++++++++++++++----------
lisp/net/sieve.el | 6 ++---
3 files changed, 55 insertions(+), 17 deletions(-)
diff --git a/etc/NEWS b/etc/NEWS
index bebea918b11..769aed9dfa8 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -207,6 +207,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 79f97f371e0..cecdeb6f8e7 100644
--- a/lisp/net/sieve-manage.el
+++ b/lisp/net/sieve-manage.el
@@ -239,15 +239,37 @@ sieve-manage--convert-multibyte
The conversion is done using `sieve-manage--coding-system'."
(encode-coding-string str sieve-manage--coding-system t))
+(defun sieve-manage--detect-buffer-coding-system (&optional buffer)
+ "Return the coding system to be use for (sieve script) BUFFER.
+
+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 ((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."
(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--detect-buffer-coding-system)))
+ (set-buffer-file-coding-system coding-system)
+ (decode-coding-region (point-min) (point-max)
+ coding-system))
+ buffer)
+ (decode-coding-string
+ octets sieve-manage--coding-system t))))
(defun sieve-manage-make-process-buffer ()
(let ((buffer (sieve-manage--set-buffer-maybe-append-text
@@ -512,9 +534,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)
+(defun sieve-manage-putscript (name script-buffer &optional buffer)
(with-current-buffer (or buffer (current-buffer))
- (sieve-manage-send (format "PUTSCRIPT \"%s\"" name) content)
+ (sieve-manage-send (format "PUTSCRIPT \"%s\"" name) script-buffer)
(sieve-manage-parse-oknobye)))
(defun sieve-manage-deletescript (name &optional buffer)
@@ -644,14 +666,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--convert-multibyte
- 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 a73584f203c..437486c8a13 100644
--- a/lisp/net/sieve.el
+++ b/lisp/net/sieve.el
@@ -366,13 +366,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 #6: 0005-Add-test-lisp-net-sieve-manage-tests.el.patch --]
[-- Type: text/x-diff, Size: 5135 bytes --]
From 216571ea17e3e1d4aa670ba6c554d434f5c762db Mon Sep 17 00:00:00 2001
From: Kai Tetzlaff <emacs@tetzco.de>
Date: Mon, 23 Jan 2023 15:32:40 +0100
Subject: [PATCH 5/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
[-- Attachment #7: 0006-WiP-new-encode-tested-OK.patch --]
[-- Type: text/x-diff, Size: 33174 bytes --]
From 599501989322142f751de171ff4c138c0ec05956 Mon Sep 17 00:00:00 2001
From: Kai Tetzlaff <emacs@tetzco.de>
Date: Mon, 23 Jan 2023 04:05:54 +0100
Subject: [PATCH 6/6] WiP: new encode, tested OK
---
lisp/net/sieve-manage.el | 328 +++++++++++++++++++++-------
test/lisp/net/sieve-manage-tests.el | 296 +++++++++++++++++++++----
2 files changed, 504 insertions(+), 120 deletions(-)
diff --git a/lisp/net/sieve-manage.el b/lisp/net/sieve-manage.el
index cecdeb6f8e7..6a343874de4 100644
--- a/lisp/net/sieve-manage.el
+++ b/lisp/net/sieve-manage.el
@@ -144,6 +144,25 @@ sieve-manage-ignore-starttls
:version "26.1"
:type 'boolean)
+(defconst sieve-manage-supported-commands
+ '(CAPABILITY ;; send automatically when connecting
+ STARTTLS ;; supported implicilty by sasl/networking
+ AUTHENTICATE
+ LISTSCRIPTS
+ SETACTIVE
+ GETSCRIPT
+ DELETESCRIPT
+ HAVESPACE
+ PUTSCRIPT
+ LOGOUT)
+ "Commands supported by the \\='sieve-manage\\=' client.
+
+The following commands from rfc5804 are not implemented:
+- NOOP
+- RENAMESCRIPT
+- CHECKSCRIPT
+- UNAUTHENTICATE")
+
;; Internal variables:
(defconst sieve-manage--coding-system 'utf-8-unix
"Use \\='utf-8-unix coding system for (network) communication.
@@ -173,6 +192,18 @@ 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)
+(define-error 'sieve-manage-client-error
+ "sieve-manage client error" 'sieve-manage-error)
+(define-error 'sieve-manage-unsupported-cmd
+ "Command not supported by sieve-manage client."
+ 'sieve-manage-client-error)
+
;; Internal utility functions
(defun sieve-manage--set-buffer-maybe-append-text (buffer-name
&rest args)
@@ -216,7 +247,7 @@ sieve-manage--append-to-log
(defun sieve-manage--message (format-string &rest args)
"Wrapper around `message' which also logs to sieve manage log.
-
+See `message' for the use of FORMAT-STRING and ARGS.
See `sieve-manage--append-to-log'."
(let ((ret (apply #'message
(concat "sieve-manage: " format-string)
@@ -224,21 +255,120 @@ 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 (err format-string &rest args)
+ "Signal an error of type ERR.
+ERR should be an error type derived from
+\\='sieve-manage-error\\='. See `format' for the use of
+FORMAT-STRING and ARGS.
-See `sieve-manage--append-to-log'."
+Errors are also logged to sieve manage log (see
+`sieve-manage--append-to-log')."
(let ((msg (apply #'format
- (concat "sieve-manage/ERROR: " format-string)
+ (concat "Error: " format-string)
args)))
(sieve-manage--append-to-log msg "\n")
- (error msg)))
+ (signal err (list msg))))
(defun sieve-manage--convert-multibyte (str)
"Convert multibyte STR to unibyte octet string.
The conversion is done using `sieve-manage--coding-system'."
(encode-coding-string str sieve-manage--coding-system t))
+(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. symbol (will be interpreted as sieve command name),
+2. number (positive integer or 0),
+3. string (will be converted to unibyte using \\='utf-8-unix
+ coding system and encoded as \\='quoted\\=' rfc5804 string),
+4. buffer (buffer content will be converted to unibyte using
+ `buffer-file-coding-system and encoded as \\='literal-c2s\\=' rfc5804
+ string),
+5. 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 . <name>) where <name> is either a unibyte string or one of
+ the symbols from `sieve-manage-supported-commands'
+ - (<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
+ ((symbolp item)
+ (sieve-manage-encode (cons 'cmd-name item)))
+ ((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 (with-current-buffer item
+ (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
+ (when (and (symbolp data)
+ (not (memq data sieve-manage-supported-commands)))
+ (sieve-manage--error 'sieve-manage-unsupported-cmd
+ "Command '%s' is not supported" data))
+ (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.
@@ -257,7 +387,13 @@ sieve-manage--detect-buffer-coding-system
(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
@@ -339,18 +475,13 @@ sieve-sasl-auth
;; somehow.
(lambda (_prompt) (copy-sequence user-password)))
(step (sasl-next-step client nil))
- (_tag (sieve-manage-send
- (concat
- "AUTHENTICATE \""
- mech
- "\""
+ (_tag (sieve-manage-send-command
+ 'AUTHENTICATE
+ (cons 'quoted mech)
(and (sasl-step-data step)
- (concat
- " \""
- (base64-encode-string
- (sasl-step-data step)
- 'no-line-break)
- "\"")))))
+ (cons 'quoted (base64-encode-string
+ (sasl-step-data step)
+ 'no-line-break)))))
data rsp)
(catch 'done
(while t
@@ -375,24 +506,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))
@@ -471,7 +601,7 @@ sieve-manage-open
(setq sieve-manage-auth auth)
(cl-return)))
(unless sieve-manage-auth
- (sieve-manage--error
+ (sieve-manage--error 'sieve-manage-client-error
"Couldn't figure out authenticator for server")))
(sieve-manage-erase)
(current-buffer))))
@@ -496,12 +626,21 @@ sieve-manage-opened
(and sieve-manage-process
(memq (process-status sieve-manage-process) '(open run))))))
+(defun sieve-manage--check-script-name (cmd name)
+ "Check for script NAME for CMD.
+Signals an error for unsupported names."
+ (when (and (not (eq 'SETACTIVE cmd))
+ (string-empty-p name))
+ (sieve-manage--error 'sieve-manage-client-error
+ "%s script name cannot be empty" cmd))
+ t)
+
(defun sieve-manage-close (&optional buffer)
"Close connection to managesieve server in BUFFER.
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)))
@@ -525,41 +664,73 @@ 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)
- (with-current-buffer (or buffer (current-buffer))
- (sieve-manage-send (format "HAVESPACE \"%s\" %s" name size))
- (sieve-manage-parse-oknobye)))
+ "Send HAVESPACE command for script NAME and SIZE.
+BUFFER is the \\='sieve-manage\\=' process buffer (default: \\='(current-buffer)\\=')."
+ (let ((cmd 'HAVESPACE))
+ (sieve-manage--check-script-name cmd name)
+ (with-current-buffer (or buffer (current-buffer))
+ (sieve-manage-send-command cmd name size)
+ (sieve-manage-parse-oknobye))))
(defun sieve-manage-putscript (name script-buffer &optional buffer)
- (with-current-buffer (or buffer (current-buffer))
- (sieve-manage-send (format "PUTSCRIPT \"%s\"" name) script-buffer)
- (sieve-manage-parse-oknobye)))
+ "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)\\=')."
+ (let ((cmd 'PUTSCRIPT))
+ (sieve-manage--check-script-name cmd name)
+ (with-current-buffer (or buffer (current-buffer))
+ (sieve-manage-send-command cmd name script-buffer)
+ (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-oknobye)))
-
-(defun sieve-manage-getscript (name output-buffer &optional buffer)
- (with-current-buffer (or buffer (current-buffer))
- (sieve-manage-send (format "GETSCRIPT \"%s\"" name))
- (sieve-manage-decode (sieve-manage-parse-string)
- output-buffer)
- (sieve-manage-parse-crlf)
- (sieve-manage-parse-oknobye)))
+ "Send DELETESCRIPT command to delete script named NAME.
+BUFFER is the \\='sieve-manage\\=' process buffer (default: \\='(current-buffer)\\=')."
+ (let ((cmd 'DELETESCRIPT))
+ (sieve-manage--check-script-name cmd name)
+ (with-current-buffer (or buffer (current-buffer))
+ (sieve-manage-send-command cmd name)
+ (sieve-manage-parse-oknobye))))
+
+(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)\\=')."
+ (let ((cmd 'GETSCRIPT))
+ (sieve-manage--check-script-name cmd name)
+ (with-current-buffer (or buffer (current-buffer))
+ (sieve-manage-send-command cmd name)
+ (sieve-manage-decode (sieve-manage-parse-string)
+ script-buffer)
+ (sieve-manage-parse-crlf)
+ (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-oknobye)))
+ "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)\\=')."
+ (let ((cmd 'SETACTIVE))
+ (sieve-manage--check-script-name cmd name)
+ (with-current-buffer (or buffer (current-buffer))
+ (sieve-manage-send-command cmd name)
+ (sieve-manage-parse-oknobye))))
;; Protocol parsing routines
(defun sieve-manage-regexp-oknobye ()
- "Return regexp for managesieve 'response-oknobye'."
+ "Return regexp for managesieve \\='response-oknobye\\'."
(concat
"^\\(OK\\|NO\\|BYE\\)\\( (\\([^)]+\\))\\)?\\( \\(.*\\)\\)?"
sieve-manage-server-eol))
@@ -633,9 +804,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))
@@ -666,28 +838,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--convert-multibyte 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..e58854ff6b0 100644
--- a/test/lisp/net/sieve-manage-tests.el
+++ b/test/lisp/net/sieve-manage-tests.el
@@ -26,79 +26,283 @@
(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.")
+
+(defvar smt/script-name-unibyte "abcdefg.sieve"
+ "Unibyte sieve script name.")
-(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-multibyte "äöüßÄÖÜ.sieve"
+ "Multibyte sieve script name.")
-(defun mk-rsp-oknobye (type &optional resp-code string)
+;;; 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)
+ (smt/mk-rsp-oknobye 'OK "Getscript completed.")))
+;; (smt/mk-rsp-getscript-ok smt/script-multibyte-unix)
-(defun managesieve-getscript (script)
- "Simulate managesieve getscript response to test
-`sieve-manage-getscript' function."
+(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))))
-
-(ert-deftest ert/managesieve-getscript-multibyte ()
- (should (string= sieve-script-multibyte-unix
- (managesieve-getscript sieve-script-multibyte-unix))))
+ (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 smt/sieve-manage--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 (string-equal (format "\"%s\"" smt/script-name-unibyte)
+ (sieve-manage--mk-quoted smt/script-name-unibyte)))
+ (should (string-equal "\"\""
+ (sieve-manage--mk-quoted ""))))
+
+(ert-deftest smt/sieve-manage--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 (string-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 (string-equal "{0+}\r\n"
+ (sieve-manage--mk-literal-c2s ""))))
+
+(ert-deftest smt/sieve-manage--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 (string-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 (string-equal "{0}\r\n"
+ (sieve-manage--mk-literal-s2c ""))))
+
+(ert-deftest smt/sieve-manage-encode ()
+ ;;; unsupported data types
+ (should-error
+ ;; RFC5804 doesn't support negative numbers
+ (sieve-manage-encode -1) :type 'sieve-manage-encode-error)
+
+ ;;; symbol (supported) commands
+ (should-error (sieve-manage-encode nil)
+ :type 'sieve-manage-unsupported-cmd)
+ (should-error (sieve-manage-encode t)
+ :type 'sieve-manage-unsupported-cmd)
+ (should-error (sieve-manage-encode 'CHECKSCRIPT)
+ :type 'sieve-manage-unsupported-cmd)
+ (should (sieve-manage-encode 'LISTSCRIPTS))
+
+ ;;; number [0..4294967296]
+ (should (string-equal (format "%d" 0) (sieve-manage-encode 0)))
+ (should (string-equal (format "%d" 255) (sieve-manage-encode 255)))
+ (should (string-equal (format "%d" 4294967296)
+ (sieve-manage-encode 4294967296)))
+
+ ;;; (simple) string
+ (should (string-equal (format "\"%s\"" smt/script-name-unibyte)
+ (sieve-manage-encode smt/script-name-unibyte)))
+ (should (string-equal (format "\"%s\"" (encode-coding-string
+ smt/script-name-multibyte
+ 'utf-8-unix))
+ (sieve-manage-encode smt/script-name-multibyte)))
+
+ ;;; TODO: (number . <int>)
+
+ ;;; TODO: (cmd-name . <name-or-symbol>)
+
+ ;;; (quoted/literal-c2s/literal-s2c . <octet-str>)
+ ;; 'quoted
+ (should (string-equal "\"\"" (sieve-manage-encode (cons 'quoted ""))))
+ (should (string-equal (format "\"%s\"" smt/script-name-unibyte)
+ (sieve-manage-encode
+ (cons 'quoted smt/script-name-unibyte))))
+
+ ;; 'literal-c2s
+ (should (string-equal "{0+}\r\n"
+ (sieve-manage-encode (cons 'literal-c2s ""))))
+ (should (string-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))))
+
+ ;; 'literal-s2c
+ (should (string-equal "{0}\r\n"
+ (sieve-manage-encode (cons 'literal-s2c ""))))
+ (should (string-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))))
+
+ ;;; TODO: (mb-quoted/mb-literal-c2s/mb-literal-s2c . <str>)
+ )
+
+
+(ert-deftest smt/sieve-manage--detect-buffer-coding-system ()
+ ;; TODO
+ )
+
+
+(ert-deftest smt/sieve-manage-decode ()
+ ;; TODO
+ )
+
+
+(ert-deftest smt/sieve-sasl-auth ()
+ ;; TODO
+ )
+
+
+(ert-deftest smt/sieve-manage-authenticate ()
+ ;; TODO
+ )
+
+
+;; TODO: check which sieve-manage-parse-... functions can be tested
+
+
+(ert-deftest smt/sieve-manage-is-string ()
+ ;; TODO
+ )
+
+
+(ert-deftest smt/sieve-manage--check-script-name ()
+ (should-error (sieve-manage--check-script-name 'PUTSCRIPT "")
+ :type 'sieve-manage-client-error)
+ (should (sieve-manage--check-script-name 'SETACTIVE "")))
+
+
+(ert-deftest smt/managesieve-authenticate ()
+ ;; TODO
+ )
+
+
+(ert-deftest smt/managesieve-listscripts ()
+ ;; TODO
+ )
+
+
+(ert-deftest smt/managesieve-havespace ()
+ ;; TODO
+ )
+
+
+(ert-deftest smt/managesieve-putscript ()
+ ;; TODO
+ )
+
+
+(ert-deftest smt/managesieve-deletescript ()
+ ;; TODO
+ )
+
+
+(ert-deftest smt/managesieve-getscript ()
+ (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))))
+ )
+
+
+(ert-deftest smt/managesieve-setactive ()
+ ;; TODO
+ )
;;; sieve-manage-tests.el ends here
--
2.39.0
^ permalink raw reply related [flat|nested] 43+ messages in thread* bug#54154: Emacs commit ae963e80a79f5a9184daabfc8197f211a39b136d (sieve-manage)
2023-01-23 16:22 ` Kai Tetzlaff
@ 2023-01-23 16:49 ` Eli Zaretskii
2023-01-23 17:12 ` Kai Tetzlaff
0 siblings, 1 reply; 43+ messages in thread
From: Eli Zaretskii @ 2023-01-23 16:49 UTC (permalink / raw)
To: Kai Tetzlaff; +Cc: herbert, 54154, larsi
> From: Kai Tetzlaff <emacs+bug@tetzco.de>
> Cc: herbert@gojira.at, larsi@gnus.org, 54154@debbugs.gnu.org
> Date: Mon, 23 Jan 2023 17:22:13 +0100
>
> Eli, how do you want to handle this? Apply the first patches now? Wait
> until I'm done with all all of them? Or, ...? Feedback appreciated!
I have yet to review the final version of this. So if you are still
working on the changes, I prefer to wait until you have the final
version, and review then.
Thanks.
^ permalink raw reply [flat|nested] 43+ messages in thread
* bug#54154: Emacs commit ae963e80a79f5a9184daabfc8197f211a39b136d (sieve-manage)
2023-01-23 16:49 ` Eli Zaretskii
@ 2023-01-23 17:12 ` Kai Tetzlaff
0 siblings, 0 replies; 43+ messages in thread
From: Kai Tetzlaff @ 2023-01-23 17:12 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: herbert, 54154, larsi
Eli Zaretskii <eliz@gnu.org> writes:
>> From: Kai Tetzlaff <emacs+bug@tetzco.de>
>> Cc: herbert@gojira.at, larsi@gnus.org, 54154@debbugs.gnu.org
>> Date: Mon, 23 Jan 2023 17:22:13 +0100
>>
>> Eli, how do you want to handle this? Apply the first patches now? Wait
>> until I'm done with all all of them? Or, ...? Feedback appreciated!
>
> I have yet to review the final version of this. So if you are still
> working on the changes, I prefer to wait until you have the final
> version, and review then.
Ok, fine with me.
Thank, Kai
^ permalink raw reply [flat|nested] 43+ messages in thread