* bug#54154: 29.0.50; [PATCH] `sieve-manage-getscript' fails if script contains multibyte characters
@ 2022-02-25 9:04 Kai Tetzlaff
2022-02-25 12:19 ` Lars Ingebrigtsen
[not found] ` <87bkmwi0ut.fsf@tetzco.de>
0 siblings, 2 replies; 43+ messages in thread
From: Kai Tetzlaff @ 2022-02-25 9:04 UTC (permalink / raw)
To: 54154
[-- Attachment #1: Type: text/plain, Size: 568 bytes --]
The sieve-manage package uses the managesieve protocol (s.
https://datatracker.ietf.org/doc/html/draft-ietf-sieve-managesieve) to
communicate with a sieve server process.
When the sieve-manage client retrieves a script from the server it uses
the `sieve-manage-getscript' function to send command `GETSCRIPT
"<scriptname>"<CRLF>` to the server and tries to parse the response.
If the downloaded sieve script contains multibyte characters the attempt
to parse the response results in an infloop (in
`sieve-manage-parse-okno').
To reproduce, save the following code
[-- Attachment #2: minimal example --]
[-- Type: application/emacs-lisp, Size: 1077 bytes --]
(require 'sieve-manage)
(require 'cl) ; for flet below
(let* ((script-name "test.sieve")
;; variables `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)))
(with-current-buffer sieve-buffer
(goto-char (point-min))
;; simulate managesieve response-getscript with a single multibyte
;; character: `ä`
(insert "{32}\r\nif body :matches \"ä\" { stop; }\n\r\nOK \"Getscript completed.\"\r\n"))
;; use flet to mock some functions in call chain of sieve-manage-getscript
(flet ((sieve-manage-send (_) nil)
(accept-process-output (&optional _ _ _ _) nil)
(get-buffer-process (_) nil))
;; watch `sieve-manage-getscript' infloop
(sieve-manage-getscript script-name output-buffer sieve-buffer)
(kill-buffer sieve-buffer)))
;; Local Variables:
;; coding: utf-8-unix
;; End:
[-- Attachment #3: Type: text/plain, Size: 1875 bytes --]
to a file and run: emacs -Q -l <file>
* Detailed analysis:
The example code sets up a response buffer for a successful managesieve
`response-getscript` defined as:
response-getscript = (sieve-script CRLF response-ok)
Here's the buffer content:
```
1: {32}<CRLF>
2: if body :matches "ä" { stop; }<LF>
3: <CRLF>
4: OK "Getscript completed."<CRLF>
```
It comprises:
1. lines 1-2 (`sieve-script`): encoded as a managesieve `literal-s2c`
string which:
a. starts with a length in the form '{<OCTETS>}<CRLF>' (i.e. 32)
b. followed by the string data (i.e. the actual script: 'if
body :matches "ä" { stop;}<LF>') using UTF-8 encoding
2. line 3 (`CRLF`)
3. line 4 (`response-ok`): 'OK' SP "Getscript completed." (the latter is
an optional `quoted` string which can be shown to the user)
The sieve-manage code is parsing the length into an integer and uses it
to skip over `sieve-script` to get to the start of line 3 (<CRLF> -
empty) which is then also skipped to get to line 4 in order to parse the
result ('OK').
Now the problem:
Since sieve-manage explicitly enables multibyte support in the response
buffer (by calling '(mm-enable-multibyte)' in
`sieve-manage-make-process-buffer`) and uses `goto-char' for the purpose
of skipping/jumping over `sieve-script`, each multibyte character in
`sieve-script` causes the jump to go 1 (2, 3) character(s) too far. In
the example above there's only a single 2 byte character (`ä`), so
instead of skipping to the beginning of line 3, we land in the middle of
<CRLF>: <CR(point)LF>.
This causes the following attempt to parse the result code (i.e. the 'OK
"Getscript completed."<CRLF>' line) to infloop in
`sieve-manage-parse-okno'.
* An attempt of a fix:
As far as I can tell, the attached patch fixes the issue for the
GETSCRIPT command.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: Fix for multibyte issue in `sieve-manage-getscript' --]
[-- Type: text/x-diff, Size: 1131 bytes --]
diff --git a/lisp/net/sieve-manage.el b/lisp/net/sieve-manage.el
index 50342b9105..8020e6fdca 100644
--- a/lisp/net/sieve-manage.el
+++ b/lisp/net/sieve-manage.el
@@ -449,10 +449,19 @@ sieve-manage-deletescript
(defun sieve-manage-getscript (name output-buffer &optional buffer)
(with-current-buffer (or buffer (current-buffer))
(sieve-manage-send (format "GETSCRIPT \"%s\"" name))
+ (set-buffer-multibyte nil)
(let ((script (sieve-manage-parse-string)))
+ (set-buffer-multibyte t)
(sieve-manage-parse-crlf)
(with-current-buffer output-buffer
- (insert script))
+ (insert (decode-coding-string
+ script
+ ;; not sure if using `buffer-file-coding-system' is
+ ;; the right approach, it might be better to hardcode
+ ;; it to utf-8-* (managesieve requires UTF-8
+ ;; encoding) but in that case, which variant of
+ ;; utf-8-unix/dos/... is to be used?
+ buffer-file-coding-system t)))
(sieve-manage-parse-okno))))
(defun sieve-manage-setactive (name &optional buffer)
[-- Attachment #5: Type: text/plain, Size: 1904 bytes --]
* Additional remarks:
There might be more problems. E.g. `sieve-manage-putscript' contains the
following comment:
;; Here we assume that the coding-system will
;; replace each char with a single byte.
;; This is always the case if `content' is
;; a unibyte string.
which seems to indicate that it might also have an issue with multibyte
content (even though I have not experienced any uploading issues). I
will try do some more testing to check that.
In general, it is also not clear to me why the response (or process)
buffer needs to be multibyte enabled at all as it should only be used
for the line/byte oriented protocol data. But the commit message of
8e16fb987df9b which introduced the multibyte handling states:
commit 8e16fb987df9b80b8328e9dbf80351a5f9d85bbb
Author: Albert Krewinkel <krewinkel@moltkeplatz.de>
Date: 2013-06-11 07:32:25 +0000
...
* Enable Multibyte for SieveManage buffers: The parser won't properly
handle umlauts and line endings unless multibyte is turned on in the
process buffer.
...
so this was obviously done on purpose. I contacted Albert about this but
he couldn't remember the details (it's been nearly 10 years).
In GNU Emacs 29.0.50 (build 2, x86_64-pc-linux-gnu, GTK+ Version 3.24.31, cairo version 1.16.0)
of 2022-02-18 built on moka
Repository revision: 51e51ce2df46fc0c6e17a97e74b00366bb9c09d8
Repository branch: master
System Description: Debian GNU/Linux bookworm/sid
Configured using:
'configure --with-pgtk --with-native-compilation'
Configured features:
ACL CAIRO DBUS FREETYPE GIF GLIB GMP GNUTLS GPM GSETTINGS HARFBUZZ JPEG
JSON LCMS2 LIBOTF LIBSELINUX LIBXML2 MODULES NATIVE_COMP NOTIFY INOTIFY
PDUMPER PGTK PNG RSVG SECCOMP SOUND SQLITE3 THREADS TIFF
TOOLKIT_SCROLL_BARS XIM GTK3 ZLIB
Important settings:
value of $LANG: en_US.UTF-8
locale-coding-system: utf-8-unix
^ permalink raw reply related [flat|nested] 43+ messages in thread
* bug#54154: 29.0.50; [PATCH] `sieve-manage-getscript' fails if script contains multibyte characters
2022-02-25 9:04 bug#54154: 29.0.50; [PATCH] `sieve-manage-getscript' fails if script contains multibyte characters Kai Tetzlaff
@ 2022-02-25 12:19 ` Lars Ingebrigtsen
2022-02-25 13:10 ` Lars Ingebrigtsen
[not found] ` <87bkmwi0ut.fsf@tetzco.de>
1 sibling, 1 reply; 43+ messages in thread
From: Lars Ingebrigtsen @ 2022-02-25 12:19 UTC (permalink / raw)
To: Kai Tetzlaff; +Cc: 54154
"Kai Tetzlaff" <kai.tetzlaff@t-online.de> writes:
> (with-current-buffer (or buffer (current-buffer))
> (sieve-manage-send (format "GETSCRIPT \"%s\"" name))
> + (set-buffer-multibyte nil)
> (let ((script (sieve-manage-parse-string)))
> + (set-buffer-multibyte t)
Changing multibyteness in a buffer like this is (virtually) never the
right thing to do -- it usually leads to obscure breakages.
> In general, it is also not clear to me why the response (or process)
> buffer needs to be multibyte enabled at all as it should only be used
> for the line/byte oriented protocol data. But the commit message of
> 8e16fb987df9b which introduced the multibyte handling states:
>
> commit 8e16fb987df9b80b8328e9dbf80351a5f9d85bbb
> Author: Albert Krewinkel <krewinkel@moltkeplatz.de>
> Date: 2013-06-11 07:32:25 +0000
> ...
> * Enable Multibyte for SieveManage buffers: The parser won't properly
> handle umlauts and line endings unless multibyte is turned on in the
> process buffer.
> ...
>
> so this was obviously done on purpose. I contacted Albert about this but
> he couldn't remember the details (it's been nearly 10 years).
I don't see why this buffer should be multibyte, either. The
communication with the server is done using bytes, not characters. When
we need to have characters, we should decode the data and put it in a
multibyte buffer.
So can you try to back out that commit and see whether it fixes the
problem instead?
--
(domestic pets only, the antidote for overdose, milk.)
bloggy blog: http://lars.ingebrigtsen.no
^ permalink raw reply [flat|nested] 43+ messages in thread
* bug#54154: 29.0.50; [PATCH] `sieve-manage-getscript' fails if script contains multibyte characters
2022-02-25 12:19 ` Lars Ingebrigtsen
@ 2022-02-25 13:10 ` Lars Ingebrigtsen
2022-02-25 16:00 ` Kai Tetzlaff
0 siblings, 1 reply; 43+ messages in thread
From: Lars Ingebrigtsen @ 2022-02-25 13:10 UTC (permalink / raw)
To: Kai Tetzlaff; +Cc: 54154
The mail bounced with:
kai.tetzlaff@t-online.de
host mx03.t-online.de [194.25.134.73]
SMTP error from remote mail server after initial connection:
554 IP=95.216.78.240 - A problem occurred. (Ask your postmaster for help or to contact tosa@rx.t-online.de to clarify.)
Trying to send via a different SMTP server...
Lars Ingebrigtsen <larsi@gnus.org> writes:
> "Kai Tetzlaff" <kai.tetzlaff@t-online.de> writes:
>
>> (with-current-buffer (or buffer (current-buffer))
>> (sieve-manage-send (format "GETSCRIPT \"%s\"" name))
>> + (set-buffer-multibyte nil)
>> (let ((script (sieve-manage-parse-string)))
>> + (set-buffer-multibyte t)
>
> Changing multibyteness in a buffer like this is (virtually) never the
> right thing to do -- it usually leads to obscure breakages.
>
>> In general, it is also not clear to me why the response (or process)
>> buffer needs to be multibyte enabled at all as it should only be used
>> for the line/byte oriented protocol data. But the commit message of
>> 8e16fb987df9b which introduced the multibyte handling states:
>>
>> commit 8e16fb987df9b80b8328e9dbf80351a5f9d85bbb
>> Author: Albert Krewinkel <krewinkel@moltkeplatz.de>
>> Date: 2013-06-11 07:32:25 +0000
>> ...
>> * Enable Multibyte for SieveManage buffers: The parser won't properly
>> handle umlauts and line endings unless multibyte is turned on in the
>> process buffer.
>> ...
>>
>> so this was obviously done on purpose. I contacted Albert about this but
>> he couldn't remember the details (it's been nearly 10 years).
>
> I don't see why this buffer should be multibyte, either. The
> communication with the server is done using bytes, not characters. When
> we need to have characters, we should decode the data and put it in a
> multibyte buffer.
>
> So can you try to back out that commit and see whether it fixes the
> problem instead?
--
(domestic pets only, the antidote for overdose, milk.)
bloggy blog: http://lars.ingebrigtsen.no
^ permalink raw reply [flat|nested] 43+ messages in thread
* bug#54154: 29.0.50; [PATCH] `sieve-manage-getscript' fails if script contains multibyte characters
2022-02-25 13:10 ` Lars Ingebrigtsen
@ 2022-02-25 16:00 ` Kai Tetzlaff
2022-02-26 15:07 ` Lars Ingebrigtsen
0 siblings, 1 reply; 43+ messages in thread
From: Kai Tetzlaff @ 2022-02-25 16:00 UTC (permalink / raw)
To: Lars Ingebrigtsen; +Cc: 54154
Lars Ingebrigtsen <larsi@gnus.org> writes:
> The mail bounced with:
>
> kai.tetzlaff@t-online.de
> host mx03.t-online.de [194.25.134.73]
> SMTP error from remote mail server after initial connection:
> 554 IP=95.216.78.240 - A problem occurred. (Ask your postmaster for help or to contact tosa@rx.t-online.de to clarify.)
Sorry, not sure what is happening there. Using a different From:
address, now (hopefully - using the t-online address was accidental
anyway).
>>> (with-current-buffer (or buffer (current-buffer))
>>> (sieve-manage-send (format "GETSCRIPT \"%s\"" name))
>>> + (set-buffer-multibyte nil)
>>> (let ((script (sieve-manage-parse-string)))
>>> + (set-buffer-multibyte t)
>>
>> Changing multibyteness in a buffer like this is (virtually) never the
>> right thing to do -- it usually leads to obscure breakages.
>>
>>> In general, it is also not clear to me why the response (or process)
>>> buffer needs to be multibyte enabled at all as it should only be used
>>> for the line/byte oriented protocol data. But the commit message of
>>> 8e16fb987df9b which introduced the multibyte handling states:
>>>
>>> commit 8e16fb987df9b80b8328e9dbf80351a5f9d85bbb
>>> Author: Albert Krewinkel <krewinkel@moltkeplatz.de>
>>> Date: 2013-06-11 07:32:25 +0000
>>> ...
>>> * Enable Multibyte for SieveManage buffers: The parser won't properly
>>> handle umlauts and line endings unless multibyte is turned on in the
>>> process buffer.
>>> ...
>>>
>>> so this was obviously done on purpose. I contacted Albert about this but
>>> he couldn't remember the details (it's been nearly 10 years).
>>
>> I don't see why this buffer should be multibyte, either. The
>> communication with the server is done using bytes, not characters. When
>> we need to have characters, we should decode the data and put it in a
>> multibyte buffer.
>>
>> So can you try to back out that commit and see whether it fixes the
>> problem instead?
Most of the referenced commit was about changes related to STARTTLS
handling. Here's the full commit message:
lisp/gnus/sievel-manage.el: fully support STARTTLS, fix bit rot
* Make sieve-manage-open work with STARTTLS: shorten stream managing
functions by using open-protocol-stream to do most of the work.
Has the nice benefit of enabling STARTTLS.
* Remove unneeded functions and options: the following functions and
options are neither in the API, nor called by any other function,
so they are deleted:
- sieve-manage-network-p
- sieve-manage-network-open
- sieve-manage-starttls-p
- sieve-manage-starttls-open
- sieve-manage-forward
- sieve-manage-streams
- sieve-manage-stream-alist
The options could not be applied in a meaningful way anymore; they
didn't happen to have much effect before.
* Cosmetic changes and code clean-up
* Enable Multibyte for SieveManage buffers: The parser won't properly
handle umlauts and line endings unless multibyte is turned on in the
process buffer.
* Wait for capabilities after STARTTLS: following RFC5804, the server
sends new capabilities after successfully establishing a TLS
connection with the client. The client should update the cached list
of capabilities, but we just ignore the answer for now.
So just reverting it won't work. I will try to undo the parts relevant
to this issue.
For clarification: The original code before Alberts change was using
this macro (which seemingly contains an error in the doc string):
(defmacro sieve-manage-disable-multibyte ()
"Enable multibyte in the current buffer."
(unless (featurep 'xemacs)
'(set-buffer-multibyte nil)))
to *disable* multibyte handling in the response/protocol buffer. If
using `set-buffer-multibyte' is not the right thing, what should be used
instead?
^ permalink raw reply [flat|nested] 43+ messages in thread
* bug#54154: 29.0.50; [PATCH] `sieve-manage-getscript' fails if script contains multibyte characters
2022-02-25 16:00 ` Kai Tetzlaff
@ 2022-02-26 15:07 ` Lars Ingebrigtsen
2022-02-28 12:27 ` Kai Tetzlaff
` (2 more replies)
0 siblings, 3 replies; 43+ messages in thread
From: Lars Ingebrigtsen @ 2022-02-26 15:07 UTC (permalink / raw)
To: Kai Tetzlaff; +Cc: 54154
Kai Tetzlaff <kai@tetzlaff.eu> writes:
> So just reverting it won't work. I will try to undo the parts relevant
> to this issue.
Sounds good.
> For clarification: The original code before Alberts change was using
> this macro (which seemingly contains an error in the doc string):
>
> (defmacro sieve-manage-disable-multibyte ()
> "Enable multibyte in the current buffer."
> (unless (featurep 'xemacs)
> '(set-buffer-multibyte nil)))
>
> to *disable* multibyte handling in the response/protocol buffer. If
> using `set-buffer-multibyte' is not the right thing, what should be used
> instead?
Using (set-buffer-multibyte nil) is the right thing to do to make a
buffer unibyte -- but usually only when the buffer is empty. There's
been some discussion about making `set-buffer-multibyte' signal an error
if used in a non-empty buffer, because in 99.7% of the cases where
people do that, it's the wrong thing to do.
--
(domestic pets only, the antidote for overdose, milk.)
bloggy blog: http://lars.ingebrigtsen.no
^ permalink raw reply [flat|nested] 43+ messages in thread
* bug#54154: 29.0.50; [PATCH] `sieve-manage-getscript' fails if script contains multibyte characters
2022-02-26 15:07 ` Lars Ingebrigtsen
@ 2022-02-28 12:27 ` Kai Tetzlaff
2022-09-06 11:34 ` Lars Ingebrigtsen
2022-02-28 12:35 ` Kai Tetzlaff
2022-02-28 13:03 ` Kai Tetzlaff
2 siblings, 1 reply; 43+ messages in thread
From: Kai Tetzlaff @ 2022-02-28 12:27 UTC (permalink / raw)
To: Lars Ingebrigtsen; +Cc: 54154
[-- Attachment #1: Type: text/plain, Size: 1067 bytes --]
Lars Ingebrigtsen <larsi@gnus.org> writes:
> Kai Tetzlaff <kai@tetzlaff.eu> writes:
>
>> So just reverting it won't work. I will try to undo the parts relevant
>> to this issue.
>
> Sounds good.
Ok, I'm attaching two patches which fix all issues I noticed.
What I ended up with is quite a bit more than the initial attempt. Since
these changes are non-trivial, I will need to do the copyright
assignment. About a week ago I actually sent an email to assign@gnu.org
to get the process started. But I haven't received a reply. Could you
please send me the necessary papers? I'm in Germany, so my understanding
is that it should be possible to do this electronically?
The first (and major) set of fixes are in sieve-manage.el for the issues
with multibyte characters in sieve scripts
(sieve-manage-getscript/putscript). This also adds supports for
multibyte characters in script names
(sieve-manage-listscripts/getscript/putscript/havespace/deletescript/setactive).
There is now also some handling of getscript errors reported by the
server and improved logging.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: fix multibyte issues --]
[-- Type: text/x-diff, Size: 11810 bytes --]
From fd18929ce2004f7448ab997bc86e206afdbd8673 Mon Sep 17 00:00:00 2001
From: Kai Tetzlaff <emacs@tetzco.de>
Date: Mon, 28 Feb 2022 11:08:07 +0100
Subject: [PATCH 1/2] Fix (mostly multibyte) issues in sieve-manage.el
(Bug#54154)
The managesieve protocol (s. RFC5804) requires support for (a sightly
restricted variant of) UTF-8 in script content and script names. This
commit fixes/improves the handling of multibyte characters.
In addition, `sieve-manage-getscript' now properly handles NO
responses from the server instead of inflooping.
There are also some logging improvements.
* lisp/net/sieve-manage.el
(sieve-manage--append-to-log):
(sieve-manage--message):
(sieve-manage--error):
(sieve-manage-encode):
(sieve-manage-decode):
(sieve-manage-no-p): New functions.
(sieve-manage-make-process-buffer): Switch process buffer to unibyte.
(sieve-manage-open-server): Add `:coding 'raw-text-unix` to
`open-network-stream' call. Use unix EOLs in order to keep matching
CRLF (aka "\r\n") intact.
(sieve-manage-send): Make sure that UTF-8 multibyte characters are
properly encoded before sending data to the server.
(sieve-manage-getscript):
(sieve-manage-putscript): Use the changes above to fix down/uploading
scripts containing UTF-8 multibyte characters.
(sieve-manage-listscripts):
(sieve-manage-havespace)
(sieve-manage-getscript)
(sieve-manage-putscript):
(sieve-manage-deletescript):
(sieve-manage-setactive): Use the changes above to fix handling of
script names which contain UTF-8 multibyte characters.
(sieve-manage-parse-string):
(sieve-manage-getscript): Add handling of server responses with type
NO. Abort `sieve-manage-getscript' and show error message in message
area.
(sieve-manage-erase):
(sieve-manage-drop-next-answer):
(sieve-manage-parse-crlf): Return erased/dropped data (instead of nil).
(sieve-sasl-auth):
(sieve-manage-getscript):
(sieve-manage-erase):
(sieve-manage-open-server):
(sieve-manage-open):
(sieve-manage-send): Improve logging.
---
lisp/net/sieve-manage.el | 125 +++++++++++++++++++++++++++------------
1 file changed, 86 insertions(+), 39 deletions(-)
diff --git a/lisp/net/sieve-manage.el b/lisp/net/sieve-manage.el
index 50342b9105..a57d81efcd 100644
--- a/lisp/net/sieve-manage.el
+++ b/lisp/net/sieve-manage.el
@@ -167,7 +167,52 @@ sieve-manage-process
(defvar sieve-manage-capability nil)
;; Internal utility functions
-(autoload 'mm-enable-multibyte "mm-util")
+(defun sieve-manage--append-to-log (&rest args)
+ "Append ARGS to sieve-manage log buffer.
+
+ARGS can be a string or a list of strings.
+The buffer to use for logging is specifified via
+`sieve-manage-log'. If it is nil, logging is disabled."
+ (when sieve-manage-log
+ (with-current-buffer (or (get-buffer sieve-manage-log)
+ (with-current-buffer
+ (get-buffer-create sieve-manage-log)
+ (set-buffer-multibyte nil)
+ (buffer-disable-undo)))
+ (goto-char (point-max))
+ (apply #'insert args))))
+
+(defun sieve-manage--message (format-string &rest args)
+ "Wrapper around `message' which also logs to sieve manage log.
+
+See `sieve-manage--append-to-log'."
+ (let ((ret (apply #'message
+ (concat "sieve-manage: " format-string)
+ args)))
+ (sieve-manage--append-to-log ret "\n")
+ ret))
+
+(defun sieve-manage--error (format-string &rest args)
+ "Wrapper around `error' which also logs to sieve manage log.
+
+See `sieve-manage--append-to-log'."
+ (let ((msg (apply #'format
+ (concat "sieve-manage/ERROR: " format-string)
+ args)))
+ (sieve-manage--append-to-log msg "\n")
+ (error msg)))
+
+(defun sieve-manage-encode (utf8-string)
+ "Convert UTF8-STRING to managesieve protocol octets."
+ (encode-coding-string utf8-string 'raw-text t))
+
+(defun sieve-manage-decode (octets &optional buffer)
+ "Convert managesieve protocol OCTETS to utf-8 string.
+
+If optional BUFFER is non-nil, insert decoded string into BUFFER."
+ (when octets
+ ;; eol type unix is required to preserve "\r\n"
+ (decode-coding-string octets 'utf-8-unix t buffer)))
(defun sieve-manage-make-process-buffer ()
(with-current-buffer
@@ -175,22 +220,19 @@ sieve-manage-make-process-buffer
sieve-manage-server
sieve-manage-port))
(mapc #'make-local-variable sieve-manage-local-variables)
- (mm-enable-multibyte)
+ (set-buffer-multibyte nil)
+ (setq-local after-change-functions nil)
(buffer-disable-undo)
(current-buffer)))
(defun sieve-manage-erase (&optional p buffer)
- (let ((buffer (or buffer (current-buffer))))
- (and sieve-manage-log
- (with-current-buffer (get-buffer-create sieve-manage-log)
- (mm-enable-multibyte)
- (buffer-disable-undo)
- (goto-char (point-max))
- (insert-buffer-substring buffer (with-current-buffer buffer
- (point-min))
- (or p (with-current-buffer buffer
- (point-max)))))))
- (delete-region (point-min) (or p (point-max))))
+ (with-current-buffer (or buffer (current-buffer))
+ (let* ((start (point-min))
+ (end (or p (point-max)))
+ (logdata (buffer-substring-no-properties start end)))
+ (sieve-manage--append-to-log logdata)
+ (delete-region start end)
+ logdata)))
(defun sieve-manage-open-server (server port &optional stream buffer)
"Open network connection to SERVER on PORT.
@@ -202,6 +244,8 @@ sieve-manage-open-server
(open-network-stream
"SIEVE" buffer server port
:type stream
+ ;; eol type unix is required to preserve "\r\n"
+ :coding 'raw-text-unix
:capability-command "CAPABILITY\r\n"
:end-of-command "^\\(OK\\|NO\\).*\n"
:success "^OK.*\n"
@@ -224,7 +268,7 @@ sieve-manage-open-server
;; Authenticators
(defun sieve-sasl-auth (buffer mech)
"Login to server using the SASL MECH method."
- (message "sieve: Authenticating using %s..." mech)
+ (sieve-manage--message "Authenticating using %s..." mech)
(with-current-buffer buffer
(let* ((auth-info (auth-source-search :host sieve-manage-server
:port "sieve"
@@ -275,11 +319,15 @@ sieve-sasl-auth
(if (and (setq step (sasl-next-step client step))
(setq data (sasl-step-data step)))
;; We got data for server but it's finished
- (error "Server not ready for SASL data: %s" data)
+ (sieve-manage--error
+ "Server not ready for SASL data: %s" data)
;; The authentication process is finished.
+ (sieve-manage--message "Logged in as %s using %s"
+ user-name mech)
(throw 'done t)))
(unless (stringp rsp)
- (error "Server aborted SASL authentication: %s" (caddr rsp)))
+ (sieve-manage--error
+ "Server aborted SASL authentication: %s" (caddr rsp)))
(sasl-step-set-data step (base64-decode-string rsp))
(setq step (sasl-next-step client step))
(sieve-manage-send
@@ -288,8 +336,7 @@ sieve-sasl-auth
(base64-encode-string (sasl-step-data step)
'no-line-break)
"\"")
- ""))))
- (message "sieve: Login using %s...done" mech))))
+ "")))))))
(defun sieve-manage-cram-md5-p (buffer)
(sieve-manage-capability "SASL" "CRAM-MD5" buffer))
@@ -353,7 +400,7 @@ sieve-manage-open
sieve-manage-default-stream)
sieve-manage-auth (or auth
sieve-manage-auth))
- (message "sieve: Connecting to %s..." sieve-manage-server)
+ (sieve-manage--message "Connecting to %s..." sieve-manage-server)
(sieve-manage-open-server sieve-manage-server
sieve-manage-port
sieve-manage-stream
@@ -368,7 +415,8 @@ sieve-manage-open
(setq sieve-manage-auth auth)
(cl-return)))
(unless sieve-manage-auth
- (error "Couldn't figure out authenticator for server")))
+ (sieve-manage--error
+ "Couldn't figure out authenticator for server")))
(sieve-manage-erase)
(current-buffer))))
@@ -433,11 +481,7 @@ sieve-manage-havespace
(defun sieve-manage-putscript (name content &optional buffer)
(with-current-buffer (or buffer (current-buffer))
(sieve-manage-send (format "PUTSCRIPT \"%s\" {%d+}%s%s" name
- ;; Here we assume that the coding-system will
- ;; replace each char with a single byte.
- ;; This is always the case if `content' is
- ;; a unibyte string.
- (length content)
+ (length (sieve-manage-encode content))
sieve-manage-client-eol content))
(sieve-manage-parse-okno)))
@@ -449,11 +493,10 @@ sieve-manage-deletescript
(defun sieve-manage-getscript (name output-buffer &optional buffer)
(with-current-buffer (or buffer (current-buffer))
(sieve-manage-send (format "GETSCRIPT \"%s\"" name))
- (let ((script (sieve-manage-parse-string)))
- (sieve-manage-parse-crlf)
- (with-current-buffer output-buffer
- (insert script))
- (sieve-manage-parse-okno))))
+ (sieve-manage-decode (sieve-manage-parse-string)
+ output-buffer)
+ (sieve-manage-parse-crlf)
+ (sieve-manage-parse-okno)))
(defun sieve-manage-setactive (name &optional buffer)
(with-current-buffer (or buffer (current-buffer))
@@ -478,6 +521,9 @@ sieve-manage-drop-next-answer
(defun sieve-manage-ok-p (rsp)
(string= (downcase (or (car-safe rsp) "")) "ok"))
+(defun sieve-manage-no-p (rsp)
+ (string= (downcase (or (car-safe rsp) "")) "no"))
+
(defun sieve-manage-is-okno ()
(when (looking-at (concat
"^\\(OK\\|NO\\)\\( (\\([^)]+\\))\\)?\\( \\(.*\\)\\)?"
@@ -528,7 +574,11 @@ sieve-manage-parse-string
(while (null rsp)
(accept-process-output (get-buffer-process (current-buffer)) 1)
(goto-char (point-min))
- (setq rsp (sieve-manage-is-string)))
+ (unless (setq rsp (sieve-manage-is-string))
+ (when (sieve-manage-no-p (sieve-manage-is-okno))
+ ;; simple `error' is enough since `sieve-manage-erase'
+ ;; already adds the server response to the log
+ (error (sieve-manage-erase)))))
(sieve-manage-erase (point))
rsp))
@@ -540,7 +590,8 @@ sieve-manage-parse-listscripts
(let (tmp rsp data)
(while (null rsp)
(while (null (or (setq rsp (sieve-manage-is-okno))
- (setq tmp (sieve-manage-is-string))))
+ (setq tmp (sieve-manage-decode
+ (sieve-manage-is-string)))))
(accept-process-output (get-buffer-process (current-buffer)) 1)
(goto-char (point-min)))
(when tmp
@@ -559,13 +610,9 @@ sieve-manage-parse-listscripts
rsp)))
(defun sieve-manage-send (cmdstr)
- (setq cmdstr (concat cmdstr sieve-manage-client-eol))
- (and sieve-manage-log
- (with-current-buffer (get-buffer-create sieve-manage-log)
- (mm-enable-multibyte)
- (buffer-disable-undo)
- (goto-char (point-max))
- (insert cmdstr)))
+ (setq cmdstr (sieve-manage-encode
+ (concat cmdstr sieve-manage-client-eol)))
+ (sieve-manage--append-to-log cmdstr)
(process-send-string sieve-manage-process cmdstr))
(provide 'sieve-manage)
--
2.34.1
[-- Attachment #3: Type: text/plain, Size: 907 bytes --]
Both, the (internal) process/protocol buffer and the log buffer are now
unibyte. The conversion to multibyte UTF-8 is only done for user visible
(UI) buffers.
To properly handle the protocol line termination (CRLF), I added
`:coding 'raw-text-unix` (with explicit unix EOL convention) to the
`open-network-stream' call (also in the new `manage-sieve-encode'
function. This was needed to allow keep the various (looking-at
"...\r\n" ...) calls working. This is something which still feels a bit
weird, but I haven't found another way to do it. I did some tests with
(setq-default buffer-file-coding-system 'utf-8-unix/'utf-8-dos) which
did not show any issues.
I would also add some ERT tests, probably in a separate commit?
In addition, I found that `sieve-manage-quit' in sieve.el had the
tendency to kill unrelated buffers in case of errors during earlier
steps. For this, I created a sepate patch:
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: avoid killing unrelated buffers --]
[-- Type: text/x-diff, Size: 892 bytes --]
From 559ce20b4c9b75f67bef3a1e23b7501bdeaa98d2 Mon Sep 17 00:00:00 2001
From: Kai Tetzlaff <emacs@tetzco.de>
Date: Mon, 28 Feb 2022 11:33:56 +0100
Subject: [PATCH 2/2] Improve robustnes of `sieve-manage-quit' in case of
errors
* lisp/net/sieve.el (sieve-manage-quit): Avoid killing buffers it's
not supposed to touch.
---
lisp/net/sieve.el | 3 ++-
1 file changed, 2 insertions(+), 1 deletion(-)
diff --git a/lisp/net/sieve.el b/lisp/net/sieve.el
index 630ea04070..5680526389 100644
--- a/lisp/net/sieve.el
+++ b/lisp/net/sieve.el
@@ -154,7 +154,8 @@ sieve-manage-quit
(interactive)
(sieve-manage-close sieve-manage-buffer)
(kill-buffer sieve-manage-buffer)
- (kill-buffer (current-buffer)))
+ (when-let ((buffer (get-buffer sieve-buffer)))
+ (kill-buffer buffer)))
(defun sieve-bury-buffer ()
"Bury the Manage Sieve buffer without closing the connection."
--
2.34.1
^ permalink raw reply related [flat|nested] 43+ messages in thread
* bug#54154: 29.0.50; [PATCH] `sieve-manage-getscript' fails if script contains multibyte characters
2022-02-26 15:07 ` Lars Ingebrigtsen
2022-02-28 12:27 ` Kai Tetzlaff
@ 2022-02-28 12:35 ` Kai Tetzlaff
2022-02-28 13:06 ` Lars Ingebrigtsen
2022-02-28 13:08 ` Lars Ingebrigtsen
2022-02-28 13:03 ` Kai Tetzlaff
2 siblings, 2 replies; 43+ messages in thread
From: Kai Tetzlaff @ 2022-02-28 12:35 UTC (permalink / raw)
To: Lars Ingebrigtsen; +Cc: 54154
[-- Attachment #1: Type: text/plain, Size: 1217 bytes --]
Oh - the previous version of the first patch in my last email still
contained a bug (I forgot to re-run `git format-patch` before sending
the mail).
Lars Ingebrigtsen <larsi@gnus.org> writes:
> Kai Tetzlaff <emacs@tetzco.de> writes:
>
>> So just reverting it won't work. I will try to undo the parts relevant
>> to this issue.
>
> Sounds good.
Ok, I'm attaching two patches which fix all issues I noticed.
What I ended up with is quite a bit more than the initial attempt. Since
these changes are non-trivial, I will need to do the copyright
assignment. About a week ago I actually sent an email to assign@gnu.org
to get the process started. But I haven't received a reply. Could you
please send me the necessary papers? I'm in Germany, so my understanding
is that it should be possible to do this electronically?
The first (and major) set of fixes are in sieve-manage.el for the issues
with multibyte characters in sieve scripts
(sieve-manage-getscript/putscript). This also adds supports for
multibyte characters in script names
(sieve-manage-listscripts/getscript/putscript/havespace/deletescript/setactive).
There is now also some handling of getscript errors reported by the
server and improved logging.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: fix multibyte issues --]
[-- Type: text/x-diff, Size: 11859 bytes --]
From 3a4ecad9f680d130fba9e792b87824e1f5e6a6eb Mon Sep 17 00:00:00 2001
From: Kai Tetzlaff <emacs@tetzco.de>
Date: Mon, 28 Feb 2022 11:08:07 +0100
Subject: [PATCH 1/2] Fix (mostly multibyte) issues in sieve-manage.el
(Bug#54154)
The managesieve protocol (s. RFC5804) requires support for (a sightly
restricted variant of) UTF-8 in script content and script names. This
commit fixes/improves the handling of multibyte characters.
In addition, `sieve-manage-getscript' now properly handles NO
responses from the server instead of inflooping.
There are also some logging improvements.
* lisp/net/sieve-manage.el
(sieve-manage--append-to-log):
(sieve-manage--message):
(sieve-manage--error):
(sieve-manage-encode):
(sieve-manage-decode):
(sieve-manage-no-p): New functions.
(sieve-manage-make-process-buffer): Switch process buffer to unibyte.
(sieve-manage-open-server): Add `:coding 'raw-text-unix` to
`open-network-stream' call. Use unix EOLs in order to keep matching
CRLF (aka "\r\n") intact.
(sieve-manage-send): Make sure that UTF-8 multibyte characters are
properly encoded before sending data to the server.
(sieve-manage-getscript):
(sieve-manage-putscript): Use the changes above to fix down/uploading
scripts containing UTF-8 multibyte characters.
(sieve-manage-listscripts):
(sieve-manage-havespace)
(sieve-manage-getscript)
(sieve-manage-putscript):
(sieve-manage-deletescript):
(sieve-manage-setactive): Use the changes above to fix handling of
script names which contain UTF-8 multibyte characters.
(sieve-manage-parse-string):
(sieve-manage-getscript): Add handling of server responses with type
NO. Abort `sieve-manage-getscript' and show error message in message
area.
(sieve-manage-erase):
(sieve-manage-drop-next-answer):
(sieve-manage-parse-crlf): Return erased/dropped data (instead of nil).
(sieve-sasl-auth):
(sieve-manage-getscript):
(sieve-manage-erase):
(sieve-manage-open-server):
(sieve-manage-open):
(sieve-manage-send): Improve logging.
---
lisp/net/sieve-manage.el | 126 +++++++++++++++++++++++++++------------
1 file changed, 87 insertions(+), 39 deletions(-)
diff --git a/lisp/net/sieve-manage.el b/lisp/net/sieve-manage.el
index 50342b9105..4a36f94431 100644
--- a/lisp/net/sieve-manage.el
+++ b/lisp/net/sieve-manage.el
@@ -167,7 +167,53 @@ sieve-manage-process
(defvar sieve-manage-capability nil)
;; Internal utility functions
-(autoload 'mm-enable-multibyte "mm-util")
+(defun sieve-manage--append-to-log (&rest args)
+ "Append ARGS to sieve-manage log buffer.
+
+ARGS can be a string or a list of strings.
+The buffer to use for logging is specifified via
+`sieve-manage-log'. If it is nil, logging is disabled."
+ (when sieve-manage-log
+ (with-current-buffer (or (get-buffer sieve-manage-log)
+ (with-current-buffer
+ (get-buffer-create sieve-manage-log)
+ (set-buffer-multibyte nil)
+ (buffer-disable-undo)
+ (current-buffer)))
+ (goto-char (point-max))
+ (apply #'insert args))))
+
+(defun sieve-manage--message (format-string &rest args)
+ "Wrapper around `message' which also logs to sieve manage log.
+
+See `sieve-manage--append-to-log'."
+ (let ((ret (apply #'message
+ (concat "sieve-manage: " format-string)
+ args)))
+ (sieve-manage--append-to-log ret "\n")
+ ret))
+
+(defun sieve-manage--error (format-string &rest args)
+ "Wrapper around `error' which also logs to sieve manage log.
+
+See `sieve-manage--append-to-log'."
+ (let ((msg (apply #'format
+ (concat "sieve-manage/ERROR: " format-string)
+ args)))
+ (sieve-manage--append-to-log msg "\n")
+ (error msg)))
+
+(defun sieve-manage-encode (utf8-string)
+ "Convert UTF8-STRING to managesieve protocol octets."
+ (encode-coding-string utf8-string 'raw-text t))
+
+(defun sieve-manage-decode (octets &optional buffer)
+ "Convert managesieve protocol OCTETS to utf-8 string.
+
+If optional BUFFER is non-nil, insert decoded string into BUFFER."
+ (when octets
+ ;; eol type unix is required to preserve "\r\n"
+ (decode-coding-string octets 'utf-8-unix t buffer)))
(defun sieve-manage-make-process-buffer ()
(with-current-buffer
@@ -175,22 +221,19 @@ sieve-manage-make-process-buffer
sieve-manage-server
sieve-manage-port))
(mapc #'make-local-variable sieve-manage-local-variables)
- (mm-enable-multibyte)
+ (set-buffer-multibyte nil)
+ (setq-local after-change-functions nil)
(buffer-disable-undo)
(current-buffer)))
(defun sieve-manage-erase (&optional p buffer)
- (let ((buffer (or buffer (current-buffer))))
- (and sieve-manage-log
- (with-current-buffer (get-buffer-create sieve-manage-log)
- (mm-enable-multibyte)
- (buffer-disable-undo)
- (goto-char (point-max))
- (insert-buffer-substring buffer (with-current-buffer buffer
- (point-min))
- (or p (with-current-buffer buffer
- (point-max)))))))
- (delete-region (point-min) (or p (point-max))))
+ (with-current-buffer (or buffer (current-buffer))
+ (let* ((start (point-min))
+ (end (or p (point-max)))
+ (logdata (buffer-substring-no-properties start end)))
+ (sieve-manage--append-to-log logdata)
+ (delete-region start end)
+ logdata)))
(defun sieve-manage-open-server (server port &optional stream buffer)
"Open network connection to SERVER on PORT.
@@ -202,6 +245,8 @@ sieve-manage-open-server
(open-network-stream
"SIEVE" buffer server port
:type stream
+ ;; eol type unix is required to preserve "\r\n"
+ :coding 'raw-text-unix
:capability-command "CAPABILITY\r\n"
:end-of-command "^\\(OK\\|NO\\).*\n"
:success "^OK.*\n"
@@ -224,7 +269,7 @@ sieve-manage-open-server
;; Authenticators
(defun sieve-sasl-auth (buffer mech)
"Login to server using the SASL MECH method."
- (message "sieve: Authenticating using %s..." mech)
+ (sieve-manage--message "Authenticating using %s..." mech)
(with-current-buffer buffer
(let* ((auth-info (auth-source-search :host sieve-manage-server
:port "sieve"
@@ -275,11 +320,15 @@ sieve-sasl-auth
(if (and (setq step (sasl-next-step client step))
(setq data (sasl-step-data step)))
;; We got data for server but it's finished
- (error "Server not ready for SASL data: %s" data)
+ (sieve-manage--error
+ "Server not ready for SASL data: %s" data)
;; The authentication process is finished.
+ (sieve-manage--message "Logged in as %s using %s"
+ user-name mech)
(throw 'done t)))
(unless (stringp rsp)
- (error "Server aborted SASL authentication: %s" (caddr rsp)))
+ (sieve-manage--error
+ "Server aborted SASL authentication: %s" (caddr rsp)))
(sasl-step-set-data step (base64-decode-string rsp))
(setq step (sasl-next-step client step))
(sieve-manage-send
@@ -288,8 +337,7 @@ sieve-sasl-auth
(base64-encode-string (sasl-step-data step)
'no-line-break)
"\"")
- ""))))
- (message "sieve: Login using %s...done" mech))))
+ "")))))))
(defun sieve-manage-cram-md5-p (buffer)
(sieve-manage-capability "SASL" "CRAM-MD5" buffer))
@@ -353,7 +401,7 @@ sieve-manage-open
sieve-manage-default-stream)
sieve-manage-auth (or auth
sieve-manage-auth))
- (message "sieve: Connecting to %s..." sieve-manage-server)
+ (sieve-manage--message "Connecting to %s..." sieve-manage-server)
(sieve-manage-open-server sieve-manage-server
sieve-manage-port
sieve-manage-stream
@@ -368,7 +416,8 @@ sieve-manage-open
(setq sieve-manage-auth auth)
(cl-return)))
(unless sieve-manage-auth
- (error "Couldn't figure out authenticator for server")))
+ (sieve-manage--error
+ "Couldn't figure out authenticator for server")))
(sieve-manage-erase)
(current-buffer))))
@@ -433,11 +482,7 @@ sieve-manage-havespace
(defun sieve-manage-putscript (name content &optional buffer)
(with-current-buffer (or buffer (current-buffer))
(sieve-manage-send (format "PUTSCRIPT \"%s\" {%d+}%s%s" name
- ;; Here we assume that the coding-system will
- ;; replace each char with a single byte.
- ;; This is always the case if `content' is
- ;; a unibyte string.
- (length content)
+ (length (sieve-manage-encode content))
sieve-manage-client-eol content))
(sieve-manage-parse-okno)))
@@ -449,11 +494,10 @@ sieve-manage-deletescript
(defun sieve-manage-getscript (name output-buffer &optional buffer)
(with-current-buffer (or buffer (current-buffer))
(sieve-manage-send (format "GETSCRIPT \"%s\"" name))
- (let ((script (sieve-manage-parse-string)))
- (sieve-manage-parse-crlf)
- (with-current-buffer output-buffer
- (insert script))
- (sieve-manage-parse-okno))))
+ (sieve-manage-decode (sieve-manage-parse-string)
+ output-buffer)
+ (sieve-manage-parse-crlf)
+ (sieve-manage-parse-okno)))
(defun sieve-manage-setactive (name &optional buffer)
(with-current-buffer (or buffer (current-buffer))
@@ -478,6 +522,9 @@ sieve-manage-drop-next-answer
(defun sieve-manage-ok-p (rsp)
(string= (downcase (or (car-safe rsp) "")) "ok"))
+(defun sieve-manage-no-p (rsp)
+ (string= (downcase (or (car-safe rsp) "")) "no"))
+
(defun sieve-manage-is-okno ()
(when (looking-at (concat
"^\\(OK\\|NO\\)\\( (\\([^)]+\\))\\)?\\( \\(.*\\)\\)?"
@@ -528,7 +575,11 @@ sieve-manage-parse-string
(while (null rsp)
(accept-process-output (get-buffer-process (current-buffer)) 1)
(goto-char (point-min))
- (setq rsp (sieve-manage-is-string)))
+ (unless (setq rsp (sieve-manage-is-string))
+ (when (sieve-manage-no-p (sieve-manage-is-okno))
+ ;; simple `error' is enough since `sieve-manage-erase'
+ ;; already adds the server response to the log
+ (error (sieve-manage-erase)))))
(sieve-manage-erase (point))
rsp))
@@ -540,7 +591,8 @@ sieve-manage-parse-listscripts
(let (tmp rsp data)
(while (null rsp)
(while (null (or (setq rsp (sieve-manage-is-okno))
- (setq tmp (sieve-manage-is-string))))
+ (setq tmp (sieve-manage-decode
+ (sieve-manage-is-string)))))
(accept-process-output (get-buffer-process (current-buffer)) 1)
(goto-char (point-min)))
(when tmp
@@ -559,13 +611,9 @@ sieve-manage-parse-listscripts
rsp)))
(defun sieve-manage-send (cmdstr)
- (setq cmdstr (concat cmdstr sieve-manage-client-eol))
- (and sieve-manage-log
- (with-current-buffer (get-buffer-create sieve-manage-log)
- (mm-enable-multibyte)
- (buffer-disable-undo)
- (goto-char (point-max))
- (insert cmdstr)))
+ (setq cmdstr (sieve-manage-encode
+ (concat cmdstr sieve-manage-client-eol)))
+ (sieve-manage--append-to-log cmdstr)
(process-send-string sieve-manage-process cmdstr))
(provide 'sieve-manage)
--
2.34.1
[-- Attachment #3: Type: text/plain, Size: 907 bytes --]
Both, the (internal) process/protocol buffer and the log buffer are now
unibyte. The conversion to multibyte UTF-8 is only done for user visible
(UI) buffers.
To properly handle the protocol line termination (CRLF), I added
`:coding 'raw-text-unix` (with explicit unix EOL convention) to the
`open-network-stream' call (also in the new `manage-sieve-encode'
function. This was needed to allow keep the various (looking-at
"...\r\n" ...) calls working. This is something which still feels a bit
weird, but I haven't found another way to do it. I did some tests with
(setq-default buffer-file-coding-system 'utf-8-unix/'utf-8-dos) which
did not show any issues.
I would also add some ERT tests, probably in a separate commit?
In addition, I found that `sieve-manage-quit' in sieve.el had the
tendency to kill unrelated buffers in case of errors during earlier
steps. For this, I created a sepate patch:
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: avoid killing unrelated buffers --]
[-- Type: text/x-diff, Size: 892 bytes --]
From 83ab45907c7b528ae4db98f33415e05e679c312e Mon Sep 17 00:00:00 2001
From: Kai Tetzlaff <emacs@tetzco.de>
Date: Mon, 28 Feb 2022 11:33:56 +0100
Subject: [PATCH 2/2] Improve robustnes of `sieve-manage-quit' in case of
errors
* lisp/net/sieve.el (sieve-manage-quit): Avoid killing buffers it's
not supposed to touch.
---
lisp/net/sieve.el | 3 ++-
1 file changed, 2 insertions(+), 1 deletion(-)
diff --git a/lisp/net/sieve.el b/lisp/net/sieve.el
index 630ea04070..5680526389 100644
--- a/lisp/net/sieve.el
+++ b/lisp/net/sieve.el
@@ -154,7 +154,8 @@ sieve-manage-quit
(interactive)
(sieve-manage-close sieve-manage-buffer)
(kill-buffer sieve-manage-buffer)
- (kill-buffer (current-buffer)))
+ (when-let ((buffer (get-buffer sieve-buffer)))
+ (kill-buffer buffer)))
(defun sieve-bury-buffer ()
"Bury the Manage Sieve buffer without closing the connection."
--
2.34.1
^ permalink raw reply related [flat|nested] 43+ messages in thread
* bug#54154: 29.0.50; [PATCH] `sieve-manage-getscript' fails if script contains multibyte characters
2022-02-26 15:07 ` Lars Ingebrigtsen
2022-02-28 12:27 ` Kai Tetzlaff
2022-02-28 12:35 ` Kai Tetzlaff
@ 2022-02-28 13:03 ` Kai Tetzlaff
2 siblings, 0 replies; 43+ messages in thread
From: Kai Tetzlaff @ 2022-02-28 13:03 UTC (permalink / raw)
To: Lars Ingebrigtsen; +Cc: 54154
[-- Attachment #1: Type: text/plain, Size: 1217 bytes --]
Oh - the previous version of the first patch in my last email still
contained a bug (I forgot to re-run `git format-patch` before sending
the mail).
Lars Ingebrigtsen <larsi@gnus.org> writes:
> Kai Tetzlaff <emacs@tetzco.de> writes:
>
>> So just reverting it won't work. I will try to undo the parts relevant
>> to this issue.
>
> Sounds good.
Ok, I'm attaching two patches which fix all issues I noticed.
What I ended up with is quite a bit more than the initial attempt. Since
these changes are non-trivial, I will need to do the copyright
assignment. About a week ago I actually sent an email to assign@gnu.org
to get the process started. But I haven't received a reply. Could you
please send me the necessary papers? I'm in Germany, so my understanding
is that it should be possible to do this electronically?
The first (and major) set of fixes are in sieve-manage.el for the issues
with multibyte characters in sieve scripts
(sieve-manage-getscript/putscript). This also adds supports for
multibyte characters in script names
(sieve-manage-listscripts/getscript/putscript/havespace/deletescript/setactive).
There is now also some handling of getscript errors reported by the
server and improved logging.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: fix multibyte issues --]
[-- Type: text/x-diff, Size: 11859 bytes --]
From 3a4ecad9f680d130fba9e792b87824e1f5e6a6eb Mon Sep 17 00:00:00 2001
From: Kai Tetzlaff <emacs@tetzco.de>
Date: Mon, 28 Feb 2022 11:08:07 +0100
Subject: [PATCH 1/2] Fix (mostly multibyte) issues in sieve-manage.el
(Bug#54154)
The managesieve protocol (s. RFC5804) requires support for (a sightly
restricted variant of) UTF-8 in script content and script names. This
commit fixes/improves the handling of multibyte characters.
In addition, `sieve-manage-getscript' now properly handles NO
responses from the server instead of inflooping.
There are also some logging improvements.
* lisp/net/sieve-manage.el
(sieve-manage--append-to-log):
(sieve-manage--message):
(sieve-manage--error):
(sieve-manage-encode):
(sieve-manage-decode):
(sieve-manage-no-p): New functions.
(sieve-manage-make-process-buffer): Switch process buffer to unibyte.
(sieve-manage-open-server): Add `:coding 'raw-text-unix` to
`open-network-stream' call. Use unix EOLs in order to keep matching
CRLF (aka "\r\n") intact.
(sieve-manage-send): Make sure that UTF-8 multibyte characters are
properly encoded before sending data to the server.
(sieve-manage-getscript):
(sieve-manage-putscript): Use the changes above to fix down/uploading
scripts containing UTF-8 multibyte characters.
(sieve-manage-listscripts):
(sieve-manage-havespace)
(sieve-manage-getscript)
(sieve-manage-putscript):
(sieve-manage-deletescript):
(sieve-manage-setactive): Use the changes above to fix handling of
script names which contain UTF-8 multibyte characters.
(sieve-manage-parse-string):
(sieve-manage-getscript): Add handling of server responses with type
NO. Abort `sieve-manage-getscript' and show error message in message
area.
(sieve-manage-erase):
(sieve-manage-drop-next-answer):
(sieve-manage-parse-crlf): Return erased/dropped data (instead of nil).
(sieve-sasl-auth):
(sieve-manage-getscript):
(sieve-manage-erase):
(sieve-manage-open-server):
(sieve-manage-open):
(sieve-manage-send): Improve logging.
---
lisp/net/sieve-manage.el | 126 +++++++++++++++++++++++++++------------
1 file changed, 87 insertions(+), 39 deletions(-)
diff --git a/lisp/net/sieve-manage.el b/lisp/net/sieve-manage.el
index 50342b9105..4a36f94431 100644
--- a/lisp/net/sieve-manage.el
+++ b/lisp/net/sieve-manage.el
@@ -167,7 +167,53 @@ sieve-manage-process
(defvar sieve-manage-capability nil)
;; Internal utility functions
-(autoload 'mm-enable-multibyte "mm-util")
+(defun sieve-manage--append-to-log (&rest args)
+ "Append ARGS to sieve-manage log buffer.
+
+ARGS can be a string or a list of strings.
+The buffer to use for logging is specifified via
+`sieve-manage-log'. If it is nil, logging is disabled."
+ (when sieve-manage-log
+ (with-current-buffer (or (get-buffer sieve-manage-log)
+ (with-current-buffer
+ (get-buffer-create sieve-manage-log)
+ (set-buffer-multibyte nil)
+ (buffer-disable-undo)
+ (current-buffer)))
+ (goto-char (point-max))
+ (apply #'insert args))))
+
+(defun sieve-manage--message (format-string &rest args)
+ "Wrapper around `message' which also logs to sieve manage log.
+
+See `sieve-manage--append-to-log'."
+ (let ((ret (apply #'message
+ (concat "sieve-manage: " format-string)
+ args)))
+ (sieve-manage--append-to-log ret "\n")
+ ret))
+
+(defun sieve-manage--error (format-string &rest args)
+ "Wrapper around `error' which also logs to sieve manage log.
+
+See `sieve-manage--append-to-log'."
+ (let ((msg (apply #'format
+ (concat "sieve-manage/ERROR: " format-string)
+ args)))
+ (sieve-manage--append-to-log msg "\n")
+ (error msg)))
+
+(defun sieve-manage-encode (utf8-string)
+ "Convert UTF8-STRING to managesieve protocol octets."
+ (encode-coding-string utf8-string 'raw-text t))
+
+(defun sieve-manage-decode (octets &optional buffer)
+ "Convert managesieve protocol OCTETS to utf-8 string.
+
+If optional BUFFER is non-nil, insert decoded string into BUFFER."
+ (when octets
+ ;; eol type unix is required to preserve "\r\n"
+ (decode-coding-string octets 'utf-8-unix t buffer)))
(defun sieve-manage-make-process-buffer ()
(with-current-buffer
@@ -175,22 +221,19 @@ sieve-manage-make-process-buffer
sieve-manage-server
sieve-manage-port))
(mapc #'make-local-variable sieve-manage-local-variables)
- (mm-enable-multibyte)
+ (set-buffer-multibyte nil)
+ (setq-local after-change-functions nil)
(buffer-disable-undo)
(current-buffer)))
(defun sieve-manage-erase (&optional p buffer)
- (let ((buffer (or buffer (current-buffer))))
- (and sieve-manage-log
- (with-current-buffer (get-buffer-create sieve-manage-log)
- (mm-enable-multibyte)
- (buffer-disable-undo)
- (goto-char (point-max))
- (insert-buffer-substring buffer (with-current-buffer buffer
- (point-min))
- (or p (with-current-buffer buffer
- (point-max)))))))
- (delete-region (point-min) (or p (point-max))))
+ (with-current-buffer (or buffer (current-buffer))
+ (let* ((start (point-min))
+ (end (or p (point-max)))
+ (logdata (buffer-substring-no-properties start end)))
+ (sieve-manage--append-to-log logdata)
+ (delete-region start end)
+ logdata)))
(defun sieve-manage-open-server (server port &optional stream buffer)
"Open network connection to SERVER on PORT.
@@ -202,6 +245,8 @@ sieve-manage-open-server
(open-network-stream
"SIEVE" buffer server port
:type stream
+ ;; eol type unix is required to preserve "\r\n"
+ :coding 'raw-text-unix
:capability-command "CAPABILITY\r\n"
:end-of-command "^\\(OK\\|NO\\).*\n"
:success "^OK.*\n"
@@ -224,7 +269,7 @@ sieve-manage-open-server
;; Authenticators
(defun sieve-sasl-auth (buffer mech)
"Login to server using the SASL MECH method."
- (message "sieve: Authenticating using %s..." mech)
+ (sieve-manage--message "Authenticating using %s..." mech)
(with-current-buffer buffer
(let* ((auth-info (auth-source-search :host sieve-manage-server
:port "sieve"
@@ -275,11 +320,15 @@ sieve-sasl-auth
(if (and (setq step (sasl-next-step client step))
(setq data (sasl-step-data step)))
;; We got data for server but it's finished
- (error "Server not ready for SASL data: %s" data)
+ (sieve-manage--error
+ "Server not ready for SASL data: %s" data)
;; The authentication process is finished.
+ (sieve-manage--message "Logged in as %s using %s"
+ user-name mech)
(throw 'done t)))
(unless (stringp rsp)
- (error "Server aborted SASL authentication: %s" (caddr rsp)))
+ (sieve-manage--error
+ "Server aborted SASL authentication: %s" (caddr rsp)))
(sasl-step-set-data step (base64-decode-string rsp))
(setq step (sasl-next-step client step))
(sieve-manage-send
@@ -288,8 +337,7 @@ sieve-sasl-auth
(base64-encode-string (sasl-step-data step)
'no-line-break)
"\"")
- ""))))
- (message "sieve: Login using %s...done" mech))))
+ "")))))))
(defun sieve-manage-cram-md5-p (buffer)
(sieve-manage-capability "SASL" "CRAM-MD5" buffer))
@@ -353,7 +401,7 @@ sieve-manage-open
sieve-manage-default-stream)
sieve-manage-auth (or auth
sieve-manage-auth))
- (message "sieve: Connecting to %s..." sieve-manage-server)
+ (sieve-manage--message "Connecting to %s..." sieve-manage-server)
(sieve-manage-open-server sieve-manage-server
sieve-manage-port
sieve-manage-stream
@@ -368,7 +416,8 @@ sieve-manage-open
(setq sieve-manage-auth auth)
(cl-return)))
(unless sieve-manage-auth
- (error "Couldn't figure out authenticator for server")))
+ (sieve-manage--error
+ "Couldn't figure out authenticator for server")))
(sieve-manage-erase)
(current-buffer))))
@@ -433,11 +482,7 @@ sieve-manage-havespace
(defun sieve-manage-putscript (name content &optional buffer)
(with-current-buffer (or buffer (current-buffer))
(sieve-manage-send (format "PUTSCRIPT \"%s\" {%d+}%s%s" name
- ;; Here we assume that the coding-system will
- ;; replace each char with a single byte.
- ;; This is always the case if `content' is
- ;; a unibyte string.
- (length content)
+ (length (sieve-manage-encode content))
sieve-manage-client-eol content))
(sieve-manage-parse-okno)))
@@ -449,11 +494,10 @@ sieve-manage-deletescript
(defun sieve-manage-getscript (name output-buffer &optional buffer)
(with-current-buffer (or buffer (current-buffer))
(sieve-manage-send (format "GETSCRIPT \"%s\"" name))
- (let ((script (sieve-manage-parse-string)))
- (sieve-manage-parse-crlf)
- (with-current-buffer output-buffer
- (insert script))
- (sieve-manage-parse-okno))))
+ (sieve-manage-decode (sieve-manage-parse-string)
+ output-buffer)
+ (sieve-manage-parse-crlf)
+ (sieve-manage-parse-okno)))
(defun sieve-manage-setactive (name &optional buffer)
(with-current-buffer (or buffer (current-buffer))
@@ -478,6 +522,9 @@ sieve-manage-drop-next-answer
(defun sieve-manage-ok-p (rsp)
(string= (downcase (or (car-safe rsp) "")) "ok"))
+(defun sieve-manage-no-p (rsp)
+ (string= (downcase (or (car-safe rsp) "")) "no"))
+
(defun sieve-manage-is-okno ()
(when (looking-at (concat
"^\\(OK\\|NO\\)\\( (\\([^)]+\\))\\)?\\( \\(.*\\)\\)?"
@@ -528,7 +575,11 @@ sieve-manage-parse-string
(while (null rsp)
(accept-process-output (get-buffer-process (current-buffer)) 1)
(goto-char (point-min))
- (setq rsp (sieve-manage-is-string)))
+ (unless (setq rsp (sieve-manage-is-string))
+ (when (sieve-manage-no-p (sieve-manage-is-okno))
+ ;; simple `error' is enough since `sieve-manage-erase'
+ ;; already adds the server response to the log
+ (error (sieve-manage-erase)))))
(sieve-manage-erase (point))
rsp))
@@ -540,7 +591,8 @@ sieve-manage-parse-listscripts
(let (tmp rsp data)
(while (null rsp)
(while (null (or (setq rsp (sieve-manage-is-okno))
- (setq tmp (sieve-manage-is-string))))
+ (setq tmp (sieve-manage-decode
+ (sieve-manage-is-string)))))
(accept-process-output (get-buffer-process (current-buffer)) 1)
(goto-char (point-min)))
(when tmp
@@ -559,13 +611,9 @@ sieve-manage-parse-listscripts
rsp)))
(defun sieve-manage-send (cmdstr)
- (setq cmdstr (concat cmdstr sieve-manage-client-eol))
- (and sieve-manage-log
- (with-current-buffer (get-buffer-create sieve-manage-log)
- (mm-enable-multibyte)
- (buffer-disable-undo)
- (goto-char (point-max))
- (insert cmdstr)))
+ (setq cmdstr (sieve-manage-encode
+ (concat cmdstr sieve-manage-client-eol)))
+ (sieve-manage--append-to-log cmdstr)
(process-send-string sieve-manage-process cmdstr))
(provide 'sieve-manage)
--
2.34.1
[-- Attachment #3: Type: text/plain, Size: 907 bytes --]
Both, the (internal) process/protocol buffer and the log buffer are now
unibyte. The conversion to multibyte UTF-8 is only done for user visible
(UI) buffers.
To properly handle the protocol line termination (CRLF), I added
`:coding 'raw-text-unix` (with explicit unix EOL convention) to the
`open-network-stream' call (also in the new `manage-sieve-encode'
function. This was needed to allow keep the various (looking-at
"...\r\n" ...) calls working. This is something which still feels a bit
weird, but I haven't found another way to do it. I did some tests with
(setq-default buffer-file-coding-system 'utf-8-unix/'utf-8-dos) which
did not show any issues.
I would also add some ERT tests, probably in a separate commit?
In addition, I found that `sieve-manage-quit' in sieve.el had the
tendency to kill unrelated buffers in case of errors during earlier
steps. For this, I created a sepate patch:
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: avoid killing unrelated buffers --]
[-- Type: text/x-diff, Size: 892 bytes --]
From 83ab45907c7b528ae4db98f33415e05e679c312e Mon Sep 17 00:00:00 2001
From: Kai Tetzlaff <emacs@tetzco.de>
Date: Mon, 28 Feb 2022 11:33:56 +0100
Subject: [PATCH 2/2] Improve robustnes of `sieve-manage-quit' in case of
errors
* lisp/net/sieve.el (sieve-manage-quit): Avoid killing buffers it's
not supposed to touch.
---
lisp/net/sieve.el | 3 ++-
1 file changed, 2 insertions(+), 1 deletion(-)
diff --git a/lisp/net/sieve.el b/lisp/net/sieve.el
index 630ea04070..5680526389 100644
--- a/lisp/net/sieve.el
+++ b/lisp/net/sieve.el
@@ -154,7 +154,8 @@ sieve-manage-quit
(interactive)
(sieve-manage-close sieve-manage-buffer)
(kill-buffer sieve-manage-buffer)
- (kill-buffer (current-buffer)))
+ (when-let ((buffer (get-buffer sieve-buffer)))
+ (kill-buffer buffer)))
(defun sieve-bury-buffer ()
"Bury the Manage Sieve buffer without closing the connection."
--
2.34.1
^ permalink raw reply related [flat|nested] 43+ messages in thread
* bug#54154: 29.0.50; [PATCH] `sieve-manage-getscript' fails if script contains multibyte characters
2022-02-28 12:35 ` Kai Tetzlaff
@ 2022-02-28 13:06 ` Lars Ingebrigtsen
2022-02-28 13:08 ` Lars Ingebrigtsen
1 sibling, 0 replies; 43+ messages in thread
From: Lars Ingebrigtsen @ 2022-02-28 13:06 UTC (permalink / raw)
To: Kai Tetzlaff; +Cc: 54154
"Kai Tetzlaff" <kai.tetzlaff@t-online.de> writes:
> Ok, I'm attaching two patches which fix all issues I noticed.
The patches look good to me, but I haven't tried them myself, because I
don't use sieve-manage. If somebody who does could try the patches,
that would be helpful. Anybody?
> What I ended up with is quite a bit more than the initial attempt. Since
> these changes are non-trivial, I will need to do the copyright
> assignment. About a week ago I actually sent an email to assign@gnu.org
> to get the process started. But I haven't received a reply. Could you
> please send me the necessary papers? I'm in Germany, so my understanding
> is that it should be possible to do this electronically?
It sometimes takes a while to get the process going -- if you don't get
a response from the copyright clerk within a couple more days, send me
an email and I'll get in touch with them to see what's up.
^ permalink raw reply [flat|nested] 43+ messages in thread
* bug#54154: 29.0.50; [PATCH] `sieve-manage-getscript' fails if script contains multibyte characters
2022-02-28 12:35 ` Kai Tetzlaff
2022-02-28 13:06 ` Lars Ingebrigtsen
@ 2022-02-28 13:08 ` Lars Ingebrigtsen
1 sibling, 0 replies; 43+ messages in thread
From: Lars Ingebrigtsen @ 2022-02-28 13:08 UTC (permalink / raw)
To: emacs; +Cc: 54154
(Re-sending because the previous mail went to to-online.de, which
rejected it.)
"Kai Tetzlaff" <kai.tetzlaff@t-online.de> writes:
> Ok, I'm attaching two patches which fix all issues I noticed.
The patches look good to me, but I haven't tried them myself, because I
don't use sieve-manage. If somebody who does could try the patches,
that would be helpful. Anybody?
> What I ended up with is quite a bit more than the initial attempt. Since
> these changes are non-trivial, I will need to do the copyright
> assignment. About a week ago I actually sent an email to assign@gnu.org
> to get the process started. But I haven't received a reply. Could you
> please send me the necessary papers? I'm in Germany, so my understanding
> is that it should be possible to do this electronically?
It sometimes takes a while to get the process going -- if you don't get
a response from the copyright clerk within a couple more days, send me
an email and I'll get in touch with them to see what's up.
^ permalink raw reply [flat|nested] 43+ messages in thread
* bug#54154: 29.0.50; [PATCH] `sieve-manage-getscript' fails if script contains multibyte characters
2022-02-28 12:27 ` Kai Tetzlaff
@ 2022-09-06 11:34 ` Lars Ingebrigtsen
0 siblings, 0 replies; 43+ messages in thread
From: Lars Ingebrigtsen @ 2022-09-06 11:34 UTC (permalink / raw)
To: Kai Tetzlaff; +Cc: 54154
Kai Tetzlaff <kai@tetzlaff.eu> writes:
> Ok, I'm attaching two patches which fix all issues I noticed.
Sorry; looks like I forgot about this. Now finally pushed to Emacs 29.
^ permalink raw reply [flat|nested] 43+ messages in thread
* bug#54154: Emacs commit ae963e80a79f5a9184daabfc8197f211a39b136d (sieve-manage)
[not found] ` <87bkmw8b02.fsf@tetzco.de>
@ 2023-01-18 18:28 ` Herbert J. Skuhra
2023-01-18 19:17 ` Eli Zaretskii
0 siblings, 1 reply; 43+ messages in thread
From: Herbert J. Skuhra @ 2023-01-18 18:28 UTC (permalink / raw)
To: Kai Tetzlaff; +Cc: larsi, 54154
[-- Attachment #1: Type: text/plain, Size: 2143 bytes --]
On Wed, Jan 18, 2023 at 10:09:33AM +0100, Kai Tetzlaff wrote:
> Hello Herbert,
>
> it seems that I'm responsible for this issue. Unfortunately, I cannot
> reproduce it with my imap/sieve server setup. However, if you're willing
> to provide some additional info, we should hopefully be able to find the
> bug.
Hello,
this is strange because I can reproduce it easily on different systems:
- master on FreeBSD 13.1-STABLE
- emacs-29 and master on macOS 12.6.2
- master on WLS2/Windows11 (Ubuntu)
> "Herbert J. Skuhra" writes:
> > I think commit ae963e80a79f5a9184daabfc8197f211a39b136d is causing the
> > following issue:
> >
> > 1. build master or emacs-29
> > 2. run emacs -Q
> > 3. M-x sieve-manage and enter imap server.
> In my case, after entering the server address, I do get prompted for a
> username followed by a password prompt.
>
> > The following error is displayed:
> > sieve-manage: Connecting to <imap server>...
> > sieve-manage--message: Wrong type argument: stringp, t
> > 4. Repeat step 3 and this time sieve-manage will connect and prompt for username/password
> As I wrote above, I already get these prompts after 3. So somehow, my
> setup is different from the one you're using. What imap server are you using?
> Is the connection to the server using SSL/TLS (in my case it is)?
I use imap.mailbox.org and the connection is encrypted (using STARTTLS).
But tcpdump doesn't capture any packets when I run sieve-manage for the
first time.
> Could you re-run the steps above with the following additional steps
> before 3.:
>
> 2a) M-x find-library sieve-manage
> 2b) M-x eval-buffer
> 2c) M-x find-library sieve
> 2d) M-x eval-buffer
> 2e) M-x toggle-debug-on-error
>
> to get a full backtrace and send it to me?
Backtrace attached.
On Wed, Jan 18, 2023 at 10:09:33AM +0100, Kai Tetzlaff wrote:
> Hello Herbert,
>
> a small update: Please also send the content of the '*sieve-manage-log*'
> buffer.
There is no *sieve-manage-log* buffer after running sieve-manage for the
first time.
> (I also added a - hopefully working - email address for Lars.)
Sorry, copy&paste error. :-(
Thanks.
--
Herbert
[-- Attachment #2: sieve-manage.txt --]
[-- Type: text/plain, Size: 3047 bytes --]
Debugger entered--Lisp error: (wrong-type-argument stringp t)
set-buffer(t)
(save-current-buffer (set-buffer (or (get-buffer sieve-manage-log) (save-current-buffer (set-buffer (get-buffer-create sieve-manage-log)) (set-buffer-multibyte nil) (buffer-disable-undo)))) (goto-char (point-max)) (apply #'insert args))
(progn (save-current-buffer (set-buffer (or (get-buffer sieve-manage-log) (save-current-buffer (set-buffer (get-buffer-create sieve-manage-log)) (set-buffer-multibyte nil) (buffer-disable-undo)))) (goto-char (point-max)) (apply #'insert args)))
(if sieve-manage-log (progn (save-current-buffer (set-buffer (or (get-buffer sieve-manage-log) (save-current-buffer (set-buffer (get-buffer-create sieve-manage-log)) (set-buffer-multibyte nil) (buffer-disable-undo)))) (goto-char (point-max)) (apply #'insert args))))
sieve-manage--append-to-log("sieve-manage: Connecting to imap.mailbox.org..." "\n")
(let ((ret (apply #'message (concat "sieve-manage: " format-string) args))) (sieve-manage--append-to-log ret "\n") ret)
sieve-manage--message("Connecting to %s..." "imap.mailbox.org")
(save-current-buffer (set-buffer (or buffer (sieve-manage-make-process-buffer))) (progn (setq sieve-manage-server (or server sieve-manage-server)) (setq sieve-manage-stream (or stream sieve-manage-stream sieve-manage-default-stream)) (setq sieve-manage-auth (or auth sieve-manage-auth))) (sieve-manage--message "Connecting to %s..." sieve-manage-server) (sieve-manage-open-server sieve-manage-server sieve-manage-port sieve-manage-stream (current-buffer)) (if (sieve-manage-opened (current-buffer)) (progn (if (and (null sieve-manage-auth) (not (eq sieve-manage-state 'auth))) (progn (catch '--cl-block-nil-- (let (...) (while tail ...))) (if sieve-manage-auth nil (sieve-manage--error "Couldn't figure out authenticator for server")))) (sieve-manage-erase) (current-buffer))))
sieve-manage-open("imap.mailbox.org" nil)
(set (make-local-variable 'sieve-manage-buffer) (sieve-manage-open server port))
(or (set (make-local-variable 'sieve-manage-buffer) (sieve-manage-open server port)) (error "Error opening server %s" server))
(set-buffer (or (set (make-local-variable 'sieve-manage-buffer) (sieve-manage-open server port)) (error "Error opening server %s" server)))
(save-current-buffer (set-buffer (or (set (make-local-variable 'sieve-manage-buffer) (sieve-manage-open server port)) (error "Error opening server %s" server))) (sieve-manage-authenticate))
sieve-open-server("imap.mailbox.org" nil)
(if (sieve-open-server server port) (sieve-refresh-scriptlist) (message "Could not open server %s" server))
sieve-manage("imap.mailbox.org")
funcall-interactively(sieve-manage "imap.mailbox.org")
call-interactively(sieve-manage record nil)
command-execute(sieve-manage record)
execute-extended-command(nil "sieve-manage" "sieve-man")
funcall-interactively(execute-extended-command nil "sieve-manage" "sieve-man")
call-interactively(execute-extended-command nil nil)
command-execute(execute-extended-command)
^ permalink raw reply [flat|nested] 43+ messages in thread
* bug#54154: Emacs commit ae963e80a79f5a9184daabfc8197f211a39b136d (sieve-manage)
2023-01-18 18:28 ` bug#54154: Emacs commit ae963e80a79f5a9184daabfc8197f211a39b136d (sieve-manage) Herbert J. Skuhra
@ 2023-01-18 19:17 ` Eli Zaretskii
2023-01-18 23:22 ` Herbert J. Skuhra
0 siblings, 1 reply; 43+ messages in thread
From: Eli Zaretskii @ 2023-01-18 19:17 UTC (permalink / raw)
To: Herbert J. Skuhra; +Cc: larsi, 54154, emacs+bug
> Cc: larsi <larsi@gnus.org>, 54154@debbugs.gnu.org
> Date: Wed, 18 Jan 2023 19:28:40 +0100
> From: "Herbert J. Skuhra" <herbert@gojira.at>
>
> On Wed, Jan 18, 2023 at 10:09:33AM +0100, Kai Tetzlaff wrote:
> > Hello Herbert,
> >
> > it seems that I'm responsible for this issue. Unfortunately, I cannot
> > reproduce it with my imap/sieve server setup. However, if you're willing
> > to provide some additional info, we should hopefully be able to find the
> > bug.
>
> Hello,
>
> this is strange because I can reproduce it easily on different systems:
>
> - master on FreeBSD 13.1-STABLE
> - emacs-29 and master on macOS 12.6.2
> - master on WLS2/Windows11 (Ubuntu)
Is this problem still relevant? I thought that Lars closed the bug
report back in September?
> > Could you re-run the steps above with the following additional steps
> > before 3.:
> >
> > 2a) M-x find-library sieve-manage
> > 2b) M-x eval-buffer
> > 2c) M-x find-library sieve
> > 2d) M-x eval-buffer
> > 2e) M-x toggle-debug-on-error
> >
> > to get a full backtrace and send it to me?
>
> Backtrace attached.
Thanks. The error is here:
(defun sieve-manage--append-to-log (&rest args)
"Append ARGS to sieve-manage log buffer.
ARGS can be a string or a list of strings.
The buffer to use for logging is specifified via
`sieve-manage-log'. If it is nil, logging is disabled."
(when sieve-manage-log
(with-current-buffer (or (get-buffer sieve-manage-log)
(with-current-buffer <<<<<<<<<<<<<<<<<<<<<<
(get-buffer-create sieve-manage-log)
(set-buffer-multibyte nil)
(buffer-disable-undo)))
And I admit that I don't understand this code. What is it trying to
do? Shouldn't it be just
(when sieve-manage-log
(with-current-buffer (get-buffer-create sieve-manage-log)
(set-buffer-multibyte nil)
(buffer-disable-undo)))
Kai, am I missing something?
Herbert, if you make the change above, does the problem go away?
^ permalink raw reply [flat|nested] 43+ messages in thread
* bug#54154: Emacs commit ae963e80a79f5a9184daabfc8197f211a39b136d (sieve-manage)
2023-01-18 19:17 ` Eli Zaretskii
@ 2023-01-18 23:22 ` Herbert J. Skuhra
2023-01-19 4:06 ` Kai Tetzlaff
2023-01-19 4:50 ` bug#54154: [update] " Kai Tetzlaff
0 siblings, 2 replies; 43+ messages in thread
From: Herbert J. Skuhra @ 2023-01-18 23:22 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: larsi, 54154, emacs+bug
On Wed, Jan 18, 2023 at 09:17:59PM +0200, Eli Zaretskii wrote:
> > Cc: larsi <larsi@gnus.org>, 54154@debbugs.gnu.org
> > Date: Wed, 18 Jan 2023 19:28:40 +0100
> > From: "Herbert J. Skuhra" <herbert@gojira.at>
> >
> > On Wed, Jan 18, 2023 at 10:09:33AM +0100, Kai Tetzlaff wrote:
> > > Hello Herbert,
> > >
> > > it seems that I'm responsible for this issue. Unfortunately, I cannot
> > > reproduce it with my imap/sieve server setup. However, if you're willing
> > > to provide some additional info, we should hopefully be able to find the
> > > bug.
> >
> > Hello,
> >
> > this is strange because I can reproduce it easily on different systems:
> >
> > - master on FreeBSD 13.1-STABLE
> > - emacs-29 and master on macOS 12.6.2
> > - master on WLS2/Windows11 (Ubuntu)
>
> Is this problem still relevant? I thought that Lars closed the bug
> report back in September?
>
> > > Could you re-run the steps above with the following additional steps
> > > before 3.:
> > >
> > > 2a) M-x find-library sieve-manage
> > > 2b) M-x eval-buffer
> > > 2c) M-x find-library sieve
> > > 2d) M-x eval-buffer
> > > 2e) M-x toggle-debug-on-error
> > >
> > > to get a full backtrace and send it to me?
> >
> > Backtrace attached.
>
> Thanks. The error is here:
>
> (defun sieve-manage--append-to-log (&rest args)
> "Append ARGS to sieve-manage log buffer.
>
> ARGS can be a string or a list of strings.
> The buffer to use for logging is specifified via
> `sieve-manage-log'. If it is nil, logging is disabled."
> (when sieve-manage-log
> (with-current-buffer (or (get-buffer sieve-manage-log)
> (with-current-buffer <<<<<<<<<<<<<<<<<<<<<<
> (get-buffer-create sieve-manage-log)
> (set-buffer-multibyte nil)
> (buffer-disable-undo)))
>
> And I admit that I don't understand this code. What is it trying to
> do? Shouldn't it be just
>
> (when sieve-manage-log
> (with-current-buffer (get-buffer-create sieve-manage-log)
> (set-buffer-multibyte nil)
> (buffer-disable-undo)))
>
> Kai, am I missing something?
>
> Herbert, if you make the change above, does the problem go away?
Yes, this change resolves the issue:
diff --git a/lisp/net/sieve-manage.el b/lisp/net/sieve-manage.el
index 5bee4f4c4a..636c7cbc5b 100644
--- a/lisp/net/sieve-manage.el
+++ b/lisp/net/sieve-manage.el
@@ -174,11 +174,9 @@ sieve-manage--append-to-log
The buffer to use for logging is specifified via
`sieve-manage-log'. If it is nil, logging is disabled."
(when sieve-manage-log
- (with-current-buffer (or (get-buffer sieve-manage-log)
- (with-current-buffer
- (get-buffer-create sieve-manage-log)
+ (with-current-buffer (get-buffer-create sieve-manage-log)
(set-buffer-multibyte nil)
- (buffer-disable-undo)))
+ (buffer-disable-undo)
(goto-char (point-max))
(apply #'insert args))))
Thanks.
--
Herbert
^ permalink raw reply related [flat|nested] 43+ messages in thread
* bug#54154: Emacs commit ae963e80a79f5a9184daabfc8197f211a39b136d (sieve-manage)
2023-01-18 23:22 ` Herbert J. Skuhra
@ 2023-01-19 4:06 ` Kai Tetzlaff
2023-01-19 7:45 ` Eli Zaretskii
2023-01-19 4:50 ` bug#54154: [update] " Kai Tetzlaff
1 sibling, 1 reply; 43+ messages in thread
From: Kai Tetzlaff @ 2023-01-19 4:06 UTC (permalink / raw)
To: Herbert J. Skuhra; +Cc: Eli Zaretskii, 54154, larsi
[-- Attachment #1: Type: text/plain, Size: 3676 bytes --]
"Herbert J. Skuhra" <herbert@gojira.at> writes:
> On Wed, Jan 18, 2023 at 09:17:59PM +0200, Eli Zaretskii wrote:
>> > this is strange because I can reproduce it easily on different systems:
>> >
>> > - master on FreeBSD 13.1-STABLE
>> > - emacs-29 and master on macOS 12.6.2
>> > - master on WLS2/Windows11 (Ubuntu)
I can now reproduce the error, too. The problem was that at the time Lars
closed the bug report by applying the attached patch (after quite a long
time of it sitting dormant), I had some additional local changes for
sieve.el and sieve-manage.el on a branch which I didn't get to submit.
And when I tried to reproduce the error, I've still been using this
branch without realizing it. Sorry for that.
>> ...
>> Thanks. The error is here:
>>
>> (defun sieve-manage--append-to-log (&rest args)
>> "Append ARGS to sieve-manage log buffer.
>>
>> ARGS can be a string or a list of strings.
>> The buffer to use for logging is specifified via
>> `sieve-manage-log'. If it is nil, logging is disabled."
>> (when sieve-manage-log
>> (with-current-buffer (or (get-buffer sieve-manage-log)
>> (with-current-buffer <<<<<<<<<<<<<<<<<<<<<<
>> (get-buffer-create sieve-manage-log)
>> (set-buffer-multibyte nil)
>> (buffer-disable-undo)))
>>
>> And I admit that I don't understand this code. What is it trying to
>> do? Shouldn't it be just
>>
>> (when sieve-manage-log
>> (with-current-buffer (get-buffer-create sieve-manage-log)
>> (set-buffer-multibyte nil)
>> (buffer-disable-undo)))
>>
>> Kai, am I missing something?
The additional '(or ...' was meant to only run
(set-buffer-multibyte nil)
(buffer-disable-undo)
once, when creating the log buffer (not everytime something gets
appended to the log). What is missing in my code is an additional
`current-buffer'. Here's the complete fixed function:
(defun sieve-manage--append-to-log (&rest args)
"Append ARGS to sieve-manage log buffer.
ARGS can be a string or a list of strings.
The buffer to use for logging is specifified via
`sieve-manage-log'. If it is nil, logging is disabled."
(when sieve-manage-log
(with-current-buffer (or (get-buffer sieve-manage-log)
(with-current-buffer
(get-buffer-create sieve-manage-log)
(set-buffer-multibyte nil)
(buffer-disable-undo)
(current-buffer)))
(goto-char (point-max))
(apply #'insert args))))
>> Herbert, if you make the change above, does the problem go away?
>
> Yes, this change resolves the issue:
>
> diff --git a/lisp/net/sieve-manage.el b/lisp/net/sieve-manage.el
> index 5bee4f4c4a..636c7cbc5b 100644
> --- a/lisp/net/sieve-manage.el
> +++ b/lisp/net/sieve-manage.el
> @@ -174,11 +174,9 @@ sieve-manage--append-to-log
> The buffer to use for logging is specifified via
> `sieve-manage-log'. If it is nil, logging is disabled."
> (when sieve-manage-log
> - (with-current-buffer (or (get-buffer sieve-manage-log)
> - (with-current-buffer
> - (get-buffer-create sieve-manage-log)
> + (with-current-buffer (get-buffer-create sieve-manage-log)
> (set-buffer-multibyte nil)
> - (buffer-disable-undo)))
> + (buffer-disable-undo)
> (goto-char (point-max))
> (apply #'insert args))))
>
Here's a patch which preserves the logic of the original code:
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: fix sieve-manage--append-to-log for Emacs 29 --]
[-- Type: text/x-diff, Size: 1004 bytes --]
From 4198e776da13b603c56acbae0ae89cd9d31cf207 Mon Sep 17 00:00:00 2001
From: Kai Tetzlaff <emacs@tetzco.de>
Date: Thu, 19 Jan 2023 03:16:14 +0100
Subject: [PATCH] Fix bug in sieve-manage--append-to-log
* lisp/net/sieve-manage.el
(sieve-manage--append-to-log): Fix log buffer creation
---
lisp/net/sieve-manage.el | 3 ++-
1 file changed, 2 insertions(+), 1 deletion(-)
diff --git a/lisp/net/sieve-manage.el b/lisp/net/sieve-manage.el
index 5bee4f4c4ad..ab22294a272 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))))
--
2.39.0
[-- Attachment #3: Type: text/plain, Size: 375 bytes --]
The additional changes I mentioned above solve the problem in a different
way by introducing a helper function. The also add some other improvements
including a new test for handling multibyte characters in sieve server
responses. I'm attaching the additional patches below. They might be
too large for the current emacs-29 branch. But maybe they can be applied
to master?
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: fix sieve-manage--append-to-log --]
[-- Type: text/x-diff, Size: 4998 bytes --]
From 062ade7fe5cdbae36f4b488761e6367beb6e3a41 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: 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 | 50 +++++++++++++++++++++++++++++-----------
1 file changed, 36 insertions(+), 14 deletions(-)
diff --git a/lisp/net/sieve-manage.el b/lisp/net/sieve-manage.el
index 5bee4f4c4ad..4f0f9b1891b 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 'raw-text-unix
+ "Use 'raw-text-unix coding system for (network) communication.
+
+Sets the coding system used for the internal (process, log)
+buffers and the network stream created to communicate with the
+managesieve server. Using 'raw-text encoding enables unibyte
+mode and makes sure that sent/received octets (bytes) remain
+untouched by the coding system. The explicit use of `-unix`
+avoids EOL conversions (and thus keeps CRLF (\"\\r\\n\") intact).")
(defconst sieve-manage-local-variables '(sieve-manage-server
sieve-manage-port
@@ -167,6 +176,24 @@ 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.
@@ -175,10 +202,8 @@ sieve-manage--append-to-log
`sieve-manage-log'. If it is nil, logging is disabled."
(when sieve-manage-log
(with-current-buffer (or (get-buffer sieve-manage-log)
- (with-current-buffer
- (get-buffer-create sieve-manage-log)
- (set-buffer-multibyte nil)
- (buffer-disable-undo)))
+ (sieve-manage--set-internal-buffer-properties
+ (get-buffer-create sieve-manage-log)))
(goto-char (point-max))
(apply #'insert args))))
@@ -204,7 +229,7 @@ sieve-manage--error
(defun sieve-manage-encode (utf8-string)
"Convert UTF8-STRING to managesieve protocol octets."
- (encode-coding-string utf8-string 'raw-text t))
+ (encode-coding-string utf8-string sieve-manage--coding-system t))
(defun sieve-manage-decode (octets &optional buffer)
"Convert managesieve protocol OCTETS to utf-8 string.
@@ -216,13 +241,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 +267,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 #5: handle bye in sieve-manage.el --]
[-- Type: text/x-diff, Size: 5782 bytes --]
From e09d82fec3fc86d797396b753f3b8c4411df9d1f 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 4f0f9b1891b..4e63603bbab 100644
--- a/lisp/net/sieve-manage.el
+++ b/lisp/net/sieve-manage.el
@@ -269,8 +269,8 @@ sieve-manage-open-server
:type stream
:coding `(binary . ,sieve-manage--coding-system)
: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)
@@ -329,7 +329,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)
@@ -498,19 +498,19 @@ 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\" {%d+}%s%s" name
(length (sieve-manage-encode content))
sieve-manage-client-eol 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))
@@ -518,17 +518,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))
@@ -546,10 +551,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)))
@@ -558,12 +561,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))
@@ -597,7 +600,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)))))
@@ -611,7 +614,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 #6: test for sieve-manage multibyte character handling --]
[-- Type: text/x-diff, Size: 5040 bytes --]
From 3d6891878a6701afada4fcdd1d426b310366a31d 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 | 105 ++++++++++++++++++++++++++++
1 file changed, 105 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..2b381a63ad1
--- /dev/null
+++ b/test/lisp/net/sieve-manage-tests.el
@@ -0,0 +1,105 @@
+;;; 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
+ (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)))))
+
+(ert-deftest 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 #7: minor fixes in lisp/net/sieve.el --]
[-- Type: text/x-diff, Size: 3244 bytes --]
From 8ddb42546242d56d9437a3d33d79719618aa54ac 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.
---
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
^ permalink raw reply related [flat|nested] 43+ messages in thread
* bug#54154: [update] bug#54154: Emacs commit ae963e80a79f5a9184daabfc8197f211a39b136d (sieve-manage)
2023-01-18 23:22 ` Herbert J. Skuhra
2023-01-19 4:06 ` Kai Tetzlaff
@ 2023-01-19 4:50 ` Kai Tetzlaff
1 sibling, 0 replies; 43+ messages in thread
From: Kai Tetzlaff @ 2023-01-19 4:50 UTC (permalink / raw)
To: Herbert J. Skuhra; +Cc: Eli Zaretskii, 54154, larsi
[-- Attachment #1: Type: text/plain, Size: 3903 bytes --]
Sorry, the patch with the new test/lisp/net/sieve-manage-tests.el was
incomplete and contained a bug. The attached updated patch(es) should
fix this (the only change is in
0003-Add-test-lisp-net-sieve-manage-tests.el.patch).
"Herbert J. Skuhra" <herbert@gojira.at> writes:
> On Wed, Jan 18, 2023 at 09:17:59PM +0200, Eli Zaretskii wrote:
>> > this is strange because I can reproduce it easily on different systems:
>> >
>> > - master on FreeBSD 13.1-STABLE
>> > - emacs-29 and master on macOS 12.6.2
>> > - master on WLS2/Windows11 (Ubuntu)
I can now reproduce the error, too. The problem was that at the time Lars
closed the bug report by applying the attached patch (after quite a long
time of it sitting dormant), I had some additional local changes for
sieve.el and sieve-manage.el on a branch which I didn't get to submit.
And when I tried to reproduce the error, I've still been using this
branch without realizing it. Sorry for that.
>> ...
>> Thanks. The error is here:
>>
>> (defun sieve-manage--append-to-log (&rest args)
>> "Append ARGS to sieve-manage log buffer.
>>
>> ARGS can be a string or a list of strings.
>> The buffer to use for logging is specifified via
>> `sieve-manage-log'. If it is nil, logging is disabled."
>> (when sieve-manage-log
>> (with-current-buffer (or (get-buffer sieve-manage-log)
>> (with-current-buffer <<<<<<<<<<<<<<<<<<<<<<
>> (get-buffer-create sieve-manage-log)
>> (set-buffer-multibyte nil)
>> (buffer-disable-undo)))
>>
>> And I admit that I don't understand this code. What is it trying to
>> do? Shouldn't it be just
>>
>> (when sieve-manage-log
>> (with-current-buffer (get-buffer-create sieve-manage-log)
>> (set-buffer-multibyte nil)
>> (buffer-disable-undo)))
>>
>> Kai, am I missing something?
The additional '(or ...' was meant to only run
(set-buffer-multibyte nil)
(buffer-disable-undo)
once, when creating the log buffer (not everytime something gets
appended to the log). What is missing in my code is an additional
`current-buffer'. Here's the complete fixed function:
(defun sieve-manage--append-to-log (&rest args)
"Append ARGS to sieve-manage log buffer.
ARGS can be a string or a list of strings.
The buffer to use for logging is specifified via
`sieve-manage-log'. If it is nil, logging is disabled."
(when sieve-manage-log
(with-current-buffer (or (get-buffer sieve-manage-log)
(with-current-buffer
(get-buffer-create sieve-manage-log)
(set-buffer-multibyte nil)
(buffer-disable-undo)
(current-buffer)))
(goto-char (point-max))
(apply #'insert args))))
>> Herbert, if you make the change above, does the problem go away?
>
> Yes, this change resolves the issue:
>
> diff --git a/lisp/net/sieve-manage.el b/lisp/net/sieve-manage.el
> index 5bee4f4c4a..636c7cbc5b 100644
> --- a/lisp/net/sieve-manage.el
> +++ b/lisp/net/sieve-manage.el
> @@ -174,11 +174,9 @@ sieve-manage--append-to-log
> The buffer to use for logging is specifified via
> `sieve-manage-log'. If it is nil, logging is disabled."
> (when sieve-manage-log
> - (with-current-buffer (or (get-buffer sieve-manage-log)
> - (with-current-buffer
> - (get-buffer-create sieve-manage-log)
> + (with-current-buffer (get-buffer-create sieve-manage-log)
> (set-buffer-multibyte nil)
> - (buffer-disable-undo)))
> + (buffer-disable-undo)
> (goto-char (point-max))
> (apply #'insert args))))
>
Here's a patch which preserves the logic of the original code:
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: fix sieve-manage--append-to-log for Emacs 29 --]
[-- Type: text/x-diff, Size: 1004 bytes --]
From 4198e776da13b603c56acbae0ae89cd9d31cf207 Mon Sep 17 00:00:00 2001
From: Kai Tetzlaff <emacs@tetzco.de>
Date: Thu, 19 Jan 2023 03:16:14 +0100
Subject: [PATCH] Fix bug in sieve-manage--append-to-log
* lisp/net/sieve-manage.el
(sieve-manage--append-to-log): Fix log buffer creation
---
lisp/net/sieve-manage.el | 3 ++-
1 file changed, 2 insertions(+), 1 deletion(-)
diff --git a/lisp/net/sieve-manage.el b/lisp/net/sieve-manage.el
index 5bee4f4c4ad..ab22294a272 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))))
--
2.39.0
[-- Attachment #3: Type: text/plain, Size: 375 bytes --]
The additional changes I mentioned above solve the problem in a different
way by introducing a helper function. The also add some other improvements
including a new test for handling multibyte characters in sieve server
responses. I'm attaching the additional patches below. They might be
too large for the current emacs-29 branch. But maybe they can be applied
to master?
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: fix sieve-manage--append-to-log --]
[-- Type: text/x-diff, Size: 4998 bytes --]
From 062ade7fe5cdbae36f4b488761e6367beb6e3a41 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: 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 | 50 +++++++++++++++++++++++++++++-----------
1 file changed, 36 insertions(+), 14 deletions(-)
diff --git a/lisp/net/sieve-manage.el b/lisp/net/sieve-manage.el
index 5bee4f4c4ad..4f0f9b1891b 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 'raw-text-unix
+ "Use 'raw-text-unix coding system for (network) communication.
+
+Sets the coding system used for the internal (process, log)
+buffers and the network stream created to communicate with the
+managesieve server. Using 'raw-text encoding enables unibyte
+mode and makes sure that sent/received octets (bytes) remain
+untouched by the coding system. The explicit use of `-unix`
+avoids EOL conversions (and thus keeps CRLF (\"\\r\\n\") intact).")
(defconst sieve-manage-local-variables '(sieve-manage-server
sieve-manage-port
@@ -167,6 +176,24 @@ 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.
@@ -175,10 +202,8 @@ sieve-manage--append-to-log
`sieve-manage-log'. If it is nil, logging is disabled."
(when sieve-manage-log
(with-current-buffer (or (get-buffer sieve-manage-log)
- (with-current-buffer
- (get-buffer-create sieve-manage-log)
- (set-buffer-multibyte nil)
- (buffer-disable-undo)))
+ (sieve-manage--set-internal-buffer-properties
+ (get-buffer-create sieve-manage-log)))
(goto-char (point-max))
(apply #'insert args))))
@@ -204,7 +229,7 @@ sieve-manage--error
(defun sieve-manage-encode (utf8-string)
"Convert UTF8-STRING to managesieve protocol octets."
- (encode-coding-string utf8-string 'raw-text t))
+ (encode-coding-string utf8-string sieve-manage--coding-system t))
(defun sieve-manage-decode (octets &optional buffer)
"Convert managesieve protocol OCTETS to utf-8 string.
@@ -216,13 +241,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 +267,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 #5: handle BYE in sieve-manage.el --]
[-- Type: text/x-diff, Size: 5782 bytes --]
From e09d82fec3fc86d797396b753f3b8c4411df9d1f 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 4f0f9b1891b..4e63603bbab 100644
--- a/lisp/net/sieve-manage.el
+++ b/lisp/net/sieve-manage.el
@@ -269,8 +269,8 @@ sieve-manage-open-server
:type stream
:coding `(binary . ,sieve-manage--coding-system)
: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)
@@ -329,7 +329,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)
@@ -498,19 +498,19 @@ 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\" {%d+}%s%s" name
(length (sieve-manage-encode content))
sieve-manage-client-eol 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))
@@ -518,17 +518,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))
@@ -546,10 +551,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)))
@@ -558,12 +561,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))
@@ -597,7 +600,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)))))
@@ -611,7 +614,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 #6: test for sieve-manage multibyte character handling --]
[-- Type: text/x-diff, Size: 5141 bytes --]
From 8ef9ad845b5a07e75b26ec226a558ea32a593237 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 | 106 ++++++++++++++++++++++++++++
1 file changed, 106 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..d4c616b3364
--- /dev/null
+++ b/test/lisp/net/sieve-manage-tests.el
@@ -0,0 +1,106 @@
+;;; 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 #7: minor fixes in lisp/net/sieve.el --]
[-- Type: text/x-diff, Size: 3244 bytes --]
From 59457ec8ec88e4c0b22499f782b8db24fb7b5cc4 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.
---
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
^ permalink raw reply related [flat|nested] 43+ messages in thread
* bug#54154: Emacs commit ae963e80a79f5a9184daabfc8197f211a39b136d (sieve-manage)
2023-01-19 4:06 ` Kai Tetzlaff
@ 2023-01-19 7:45 ` Eli Zaretskii
2023-01-19 12:38 ` Kai Tetzlaff
` (2 more replies)
0 siblings, 3 replies; 43+ messages in thread
From: Eli Zaretskii @ 2023-01-19 7:45 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: Thu, 19 Jan 2023 05:06:01 +0100
>
> >> Kai, am I missing something?
>
> The additional '(or ...' was meant to only run
>
> (set-buffer-multibyte nil)
> (buffer-disable-undo)
>
> once, when creating the log buffer (not everytime something gets
> appended to the log). What is missing in my code is an additional
> `current-buffer'. Here's the complete fixed function:
>
> (defun sieve-manage--append-to-log (&rest args)
> "Append ARGS to sieve-manage log buffer.
>
> ARGS can be a string or a list of strings.
> The buffer to use for logging is specifified via
> `sieve-manage-log'. If it is nil, logging is disabled."
> (when sieve-manage-log
> (with-current-buffer (or (get-buffer sieve-manage-log)
> (with-current-buffer
> (get-buffer-create sieve-manage-log)
> (set-buffer-multibyte nil)
> (buffer-disable-undo)
> (current-buffer)))
> (goto-char (point-max))
> (apply #'insert args))))
Thanks. The duplicate use of with-current-buffer is sub-optimal,
IMO. What about the simpler code below:
(when sieve-manage-log
(let* ((existing-log-buffer (get-buffer sieve-manage-log))
(log-buffer (or existing-log-buffer
(get-buffer-create sieve-manage-log))))
(with-current-buffer log-buffer
(unless existing-log-buffer
;; Do this only once, when creating the log buffer.
(set-buffer-multibyte nil)
(buffer-disable-undo))
(goto-char (point-max))
(apply #'insert args)))))
> ;; 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.
>
> @@ -175,10 +202,8 @@ sieve-manage--append-to-log
> `sieve-manage-log'. If it is nil, logging is disabled."
> (when sieve-manage-log
> (with-current-buffer (or (get-buffer sieve-manage-log)
> - (with-current-buffer
> - (get-buffer-create sieve-manage-log)
> - (set-buffer-multibyte nil)
> - (buffer-disable-undo)))
> + (sieve-manage--set-internal-buffer-properties
> + (get-buffer-create sieve-manage-log)))
> (goto-char (point-max))
> (apply #'insert args))))
This still uses a less-than-elegant implementation that calls
with-current-buffer twice.
> (defun sieve-manage-encode (utf8-string)
> "Convert UTF8-STRING to managesieve protocol octets."
> - (encode-coding-string utf8-string 'raw-text t))
> + (encode-coding-string utf8-string sieve-manage--coding-system t))
Why is the argument called utf8-string? If it's indeed a string
encoded in UTF-8, why do you need to encode it again with
raw-text-unix? it should be a no-op in that case. So please tell more
about the underlying issue.
> @@ -244,8 +267,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)
Same question about encoding with raw-text-unix here: using it means
some other code will need to encode the text with a real encoding,
which in this case is UTF-8 (AFAIU the managesieve protocol RFC). So
why not use utf-8-unix here?
Should the addition of BYE support be mentioned in NEWS?
On balance, I think the additional patches should go to master,
indeed. But let's resolve the issues mentioned above first.
Thanks.
^ permalink raw reply [flat|nested] 43+ messages in thread
* bug#54154: Emacs commit ae963e80a79f5a9184daabfc8197f211a39b136d (sieve-manage)
2023-01-19 7:45 ` Eli Zaretskii
@ 2023-01-19 12:38 ` Kai Tetzlaff
2023-01-19 14:08 ` Eli Zaretskii
2023-01-19 13:22 ` Kai Tetzlaff
2023-01-19 14:16 ` Kai Tetzlaff
2 siblings, 1 reply; 43+ messages in thread
From: Kai Tetzlaff @ 2023-01-19 12:38 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: herbert, 54154, larsi
[-- Attachment #1: Type: text/plain, Size: 804 bytes --]
Hello Eli,
thanks for looking into this!
Eli Zaretskii <eliz@gnu.org> writes:
> The duplicate use of with-current-buffer is sub-optimal,
> IMO. What about the simpler code below:
>
> (when sieve-manage-log
> (let* ((existing-log-buffer (get-buffer sieve-manage-log))
> (log-buffer (or existing-log-buffer
> (get-buffer-create sieve-manage-log))))
> (with-current-buffer log-buffer
> (unless existing-log-buffer
> ;; Do this only once, when creating the log buffer.
> (set-buffer-multibyte nil)
> (buffer-disable-undo))
> (goto-char (point-max))
> (apply #'insert args)))))
Yes, that provides more insight into what the code intends to do. Here's
the patch (with additional updated doc string):
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: fix sieve-manage--append-to-log for emacs-29 --]
[-- Type: text/x-diff, Size: 2230 bytes --]
From 62d03f302125c0b1aab2e3ae4f5b12b531d30d74 Mon Sep 17 00:00:00 2001
From: Kai Tetzlaff <emacs@tetzco.de>
Date: Thu, 19 Jan 2023 03:16:14 +0100
Subject: [PATCH] ; Fix bug in sieve-manage--append-to-log (emacs-29 only)
This is emacs-29 only, use more elaborate fix for Emacs 30.x (master).
* lisp/net/sieve-manage.el
(sieve-manage--append-to-log): Fix log buffer creation.
---
lisp/net/sieve-manage.el | 26 ++++++++++++++++----------
1 file changed, 16 insertions(+), 10 deletions(-)
diff --git a/lisp/net/sieve-manage.el b/lisp/net/sieve-manage.el
index 5bee4f4c4ad..4866f788bff 100644
--- a/lisp/net/sieve-manage.el
+++ b/lisp/net/sieve-manage.el
@@ -168,19 +168,25 @@ sieve-manage-capability
;; Internal utility functions
(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)))
- (goto-char (point-max))
- (apply #'insert args))))
+ (let* ((existing-log-buffer (get-buffer sieve-manage-log))
+ (log-buffer (or existing-log-buffer
+ (get-buffer-create sieve-manage-log))))
+ (with-current-buffer log-buffer
+ (unless existing-log-buffer
+ ;; Do this only once, when creating the log buffer.
+ (set-buffer-multibyte nil)
+ (buffer-disable-undo))
+ (goto-char (point-max))
+ (apply #'insert args)))))
(defun sieve-manage--message (format-string &rest args)
"Wrapper around `message' which also logs to sieve manage log.
--
2.39.0
[-- Attachment #3: Type: text/plain, Size: 7359 bytes --]
>> ;; 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.
>>
>> @@ -175,10 +202,8 @@ sieve-manage--append-to-log
>> `sieve-manage-log'. If it is nil, logging is disabled."
>> (when sieve-manage-log
>> (with-current-buffer (or (get-buffer sieve-manage-log)
>> - (with-current-buffer
>> - (get-buffer-create sieve-manage-log)
>> - (set-buffer-multibyte nil)
>> - (buffer-disable-undo)))
>> + (sieve-manage--set-internal-buffer-properties
>> + (get-buffer-create sieve-manage-log)))
>> (goto-char (point-max))
>> (apply #'insert args))))
>
> This still uses a less-than-elegant implementation that calls
> with-current-buffer twice.
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. In particular because
`set-buffer-file-coding-system' and `setq-local' only work with
(current-buffer). If you can point me to code which can replace these
with something that takes BUFFER arguments, I can rewrite
`sieve-manage--set-internal-buffer-properties' and avoid using
`with-current-buffer'.
>> (defun sieve-manage-encode (utf8-string)
>> "Convert UTF8-STRING to managesieve protocol octets."
>> - (encode-coding-string utf8-string 'raw-text t))
>> + (encode-coding-string utf8-string sieve-manage--coding-system t))
>
> Why is the argument called utf8-string? If it's indeed a string
> encoded in UTF-8, why do you need to encode it again with
> raw-text-unix? it should be a no-op in that case. So please tell more
> about the underlying issue.
I chose the name as a hint to the user that the incoming string should
be UTF-8 encoded. But that is probably misleading since the string
itself doesn't have an encoding? So let's change the function to:
(defun sieve-manage-encode (str)
"Convert STR to managesieve protocol octets."
(encode-coding-string str sieve-manage--coding-system t))
Regarding the potential double encoding: When sending data over the
network connection, `sieve-manage-encode' intends to make sure that
`utf8-string' data is converted to a byte/octet representation. I tried
to explain that in the doc string of `sieve-manage--coding-system':
(defconst sieve-manage--coding-system 'raw-text-unix
"Use 'raw-text-unix coding system for (network) communication.
Sets the coding system used for the internal (process, log)
buffers and the network stream created to communicate with the
managesieve server. Using 'raw-text encoding enables unibyte
mode and makes sure that sent/received octets (bytes) remain
untouched by the coding system. The explicit use of `-unix`
avoids EOL conversions (and thus keeps CRLF (\"\\r\\n\") intact).")
The original problem was that when communicating with the sievemanage
server, we need to handle length elements where we need make sure that
calculated values take into account that UTF-8 characters may comprise
multiple octets.
Even after reading the relevant sections of the documentation multiple
times I was (and am still) not sure what exactly the various coding
system settings do and how they interact with buffers and networking
functions. So forgive me if what I'm doing there looks weird to your
expert eyes.
When working on the original patch, I had several uhoh moments where
data sent to or received from the network seemed to have been
automatically modified by the coding system (unfortunately, I don't
remember the exact details). So I tried to eliminate any such automatic
modifications by using 'binary or 'raw-text encodings on code paths
which handle network data. Basically, my thinking was: 'better do things
twice/thrice/... before introducing new points of failure'.
>> @@ -244,8 +267,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)
>
> Same question about encoding with raw-text-unix here: using it means
> some other code will need to encode the text with a real encoding,
> which in this case is UTF-8 (AFAIU the managesieve protocol RFC). So
> why not use utf-8-unix here?
Same as above: I'm just not sure that this is the right thing.
But after thinking about it some more, I made the following changes (as
an experiment):
1. set `sieve-manage--coding-system' to 'utf-8-unix and
2. changed the call to `open-network-stream' in the patch above to
>> @@ -244,8 +267,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 sieve-manage--coding-system
instead of the previous, asymmetric mix of `binary and
`sieve-manage--coding-system'.
With these changes, there are still no issues when connecting to my
managesieve server which still contains a script with a name that
contains utf-8 multibyte characters. Also, the test I wrote still works
with that change.
So if you think that this makes things clearer, I'm happy to make these
changes. I'm just don't feel confident enough to do this without
additional guidance.
I was also experimenting with some additional changes with the hope to
to just use coding system settings instead of calling
`sieve-manage-encode'/`sieve-manage-decode'. But I couldn't get that to
work.
I added an updated set of Emacs 30.x patches with the changes described
above (plus an additional change in sieve.el which makes sure that the
sieve-manage buffer containing the list of available sieve scripts is
also using coding system 'utf-8-unix).
> Should the addition of BYE support be mentioned in NEWS?
I can certainly do that if you think that this is useful. It just seems
to be more of an internal detail which probably doesn't mean much to
most users.
> On balance, I think the additional patches should go to master,
> indeed. But let's resolve the issues mentioned above first.
Ok, awaiting further input...
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0001-Fix-bug-in-sieve-manage-append-to-log-improve-sieve-.patch --]
[-- Type: text/x-diff, Size: 5943 bytes --]
From f8d255124777c7da5c029ac7be04d770cd4dc0f3 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..7721ca139b7 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 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 #5: 0002-Handle-BYE-in-sieve-manage-server-responses.patch --]
[-- Type: text/x-diff, Size: 5769 bytes --]
From 84d6b0cb6559b27b506556aa32894cc6d2752508 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 7721ca139b7..b1a77219c61 100644
--- a/lisp/net/sieve-manage.el
+++ b/lisp/net/sieve-manage.el
@@ -270,8 +270,8 @@ sieve-manage-open-server
:type stream
:coding sieve-manage--coding-system
: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)
@@ -330,7 +330,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)
@@ -499,19 +499,19 @@ 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\" {%d+}%s%s" name
(length (sieve-manage-encode content))
sieve-manage-client-eol 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))
@@ -519,17 +519,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))
@@ -547,10 +552,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)))
@@ -559,12 +562,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))
@@ -598,7 +601,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)))))
@@ -612,7 +615,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 #6: 0003-Add-test-lisp-net-sieve-manage-tests.el.patch --]
[-- Type: text/x-diff, Size: 5141 bytes --]
From 07ace6346d66862fc84cb3fd1764f6b676558430 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 | 106 ++++++++++++++++++++++++++++
1 file changed, 106 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..d4c616b3364
--- /dev/null
+++ b/test/lisp/net/sieve-manage-tests.el
@@ -0,0 +1,106 @@
+;;; 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 #7: 0004-Some-minor-fixes-in-lisp-net-sieve.el.patch --]
[-- Type: text/x-diff, Size: 3759 bytes --]
From 4dde8d5a544c94ebc3f6001e46dca484d3632902 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 7:45 ` Eli Zaretskii
2023-01-19 12:38 ` Kai Tetzlaff
@ 2023-01-19 13:22 ` Kai Tetzlaff
2023-01-19 14:16 ` Kai Tetzlaff
2 siblings, 0 replies; 43+ messages in thread
From: Kai Tetzlaff @ 2023-01-19 13:22 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: herbert, 54154, larsi
Hmm, my previous mail with the updated patches was sent to early. The
changes I made now cause issues when actually downloading a script from
the server. So ignore my last message for now. I will send an updated
version.
^ permalink raw reply [flat|nested] 43+ messages in thread
* bug#54154: Emacs commit ae963e80a79f5a9184daabfc8197f211a39b136d (sieve-manage)
2023-01-19 12:38 ` Kai Tetzlaff
@ 2023-01-19 14:08 ` Eli Zaretskii
2023-01-19 15:59 ` Kai Tetzlaff
0 siblings, 1 reply; 43+ messages in thread
From: Eli Zaretskii @ 2023-01-19 14:08 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: Thu, 19 Jan 2023 13:38:13 +0100
>
> Eli Zaretskii <eliz@gnu.org> writes:
> > The duplicate use of with-current-buffer is sub-optimal,
> > IMO. What about the simpler code below:
> >
> > (when sieve-manage-log
> > (let* ((existing-log-buffer (get-buffer sieve-manage-log))
> > (log-buffer (or existing-log-buffer
> > (get-buffer-create sieve-manage-log))))
> > (with-current-buffer log-buffer
> > (unless existing-log-buffer
> > ;; Do this only once, when creating the log buffer.
> > (set-buffer-multibyte nil)
> > (buffer-disable-undo))
> > (goto-char (point-max))
> > (apply #'insert args)))))
>
> Yes, that provides more insight into what the code intends to do. Here's
> the patch (with additional updated doc string):
Thanks, installed on the emacs-29 branch.
> > This still uses a less-than-elegant implementation that calls
> > with-current-buffer twice.
>
> 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?
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.
> >> (defun sieve-manage-encode (utf8-string)
> >> "Convert UTF8-STRING to managesieve protocol octets."
> >> - (encode-coding-string utf8-string 'raw-text t))
> >> + (encode-coding-string utf8-string sieve-manage--coding-system t))
> >
> > Why is the argument called utf8-string? If it's indeed a string
> > encoded in UTF-8, why do you need to encode it again with
> > raw-text-unix? it should be a no-op in that case. So please tell more
> > about the underlying issue.
>
> I chose the name as a hint to the user that the incoming string should
> be UTF-8 encoded. But that is probably misleading since the string
> itself doesn't have an encoding? So let's change the function to:
>
> (defun sieve-manage-encode (str)
> "Convert STR to managesieve protocol octets."
> (encode-coding-string str sieve-manage--coding-system t))
>
> Regarding the potential double encoding: When sending data over the
> network connection, `sieve-manage-encode' intends to make sure that
> `utf8-string' data is converted to a byte/octet representation. I tried
> to explain that in the doc string of `sieve-manage--coding-system':
>
> (defconst sieve-manage--coding-system 'raw-text-unix
> "Use 'raw-text-unix coding system for (network) communication.
>
> Sets the coding system used for the internal (process, log)
> buffers and the network stream created to communicate with the
> managesieve server. Using 'raw-text encoding enables unibyte
> mode and makes sure that sent/received octets (bytes) remain
> untouched by the coding system. The explicit use of `-unix`
> avoids EOL conversions (and thus keeps CRLF (\"\\r\\n\") intact).")
>
> The original problem was that when communicating with the sievemanage
> server, we need to handle length elements where we need make sure that
> calculated values take into account that UTF-8 characters may comprise
> multiple octets.
>
> Even after reading the relevant sections of the documentation multiple
> times I was (and am still) not sure what exactly the various coding
> system settings do and how they interact with buffers and networking
> functions. So forgive me if what I'm doing there looks weird to your
> expert eyes.
>
> When working on the original patch, I had several uhoh moments where
> data sent to or received from the network seemed to have been
> automatically modified by the coding system (unfortunately, I don't
> remember the exact details). So I tried to eliminate any such automatic
> modifications by using 'binary or 'raw-text encodings on code paths
> which handle network data. Basically, my thinking was: 'better do things
> twice/thrice/... before introducing new points of failure'.
Since you seem to be encoding and decoding to/from UTF-8 by hand in
sieve-manage-encode/decode, you should use 'binary' as the
process-codings-system for the network connection to the server, and
that's it. I see no reason to encode again using raw-text-unix.
What you should do is call sieve-manage-encode inside
sieve-manage-send, and count the bytes there after encoding the
payload.
> >> @@ -244,8 +267,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)
> >
> > Same question about encoding with raw-text-unix here: using it means
> > some other code will need to encode the text with a real encoding,
> > which in this case is UTF-8 (AFAIU the managesieve protocol RFC). So
> > why not use utf-8-unix here?
>
> Same as above: I'm just not sure that this is the right thing.
See above.
> But after thinking about it some more, I made the following changes (as
> an experiment):
>
> 1. set `sieve-manage--coding-system' to 'utf-8-unix and
> 2. changed the call to `open-network-stream' in the patch above to
> >> @@ -244,8 +267,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 sieve-manage--coding-system
> instead of the previous, asymmetric mix of `binary and
> `sieve-manage--coding-system'.
This could work, but AFAIU, you need to specify the content length in
bytes for the PUTSCRIPT command, so you must encode the content
yourself. Thus my suggestion to use 'binary' in the :coding attribute
of the process, and instead encode/decode using
sieve-manage-encode/decode to/from UTF-8 inside sieve-manage-send and
sieve-manage-parse-* functions.
> > Should the addition of BYE support be mentioned in NEWS?
>
> I can certainly do that if you think that this is useful. It just seems
> to be more of an internal detail which probably doesn't mean much to
> most users.
Isn't BYE provides some capabilities that user/callers would like to
know about?
^ permalink raw reply [flat|nested] 43+ messages in thread
* bug#54154: Emacs commit ae963e80a79f5a9184daabfc8197f211a39b136d (sieve-manage)
2023-01-19 7:45 ` Eli Zaretskii
2023-01-19 12:38 ` Kai Tetzlaff
2023-01-19 13:22 ` Kai Tetzlaff
@ 2023-01-19 14:16 ` Kai Tetzlaff
2 siblings, 0 replies; 43+ messages in thread
From: Kai Tetzlaff @ 2023-01-19 14:16 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: herbert, 54154, larsi
[-- Attachment #1: Type: text/plain, Size: 1732 bytes --]
Here's the update. As a summary, this change:
2. changed the call to `open-network-stream' in the patch above to
>> @@ -244,8 +267,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 sieve-manage--coding-system
needed to be reverted to what I had earlier:
>> @@ -244,8 +267,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)
I updated the text below and the patches accordingly.
Hello Eli,
thanks for looking into this!
Eli Zaretskii <eliz@gnu.org> writes:
> The duplicate use of with-current-buffer is sub-optimal,
> IMO. What about the simpler code below:
>
> (when sieve-manage-log
> (let* ((existing-log-buffer (get-buffer sieve-manage-log))
> (log-buffer (or existing-log-buffer
> (get-buffer-create sieve-manage-log))))
> (with-current-buffer log-buffer
> (unless existing-log-buffer
> ;; Do this only once, when creating the log buffer.
> (set-buffer-multibyte nil)
> (buffer-disable-undo))
> (goto-char (point-max))
> (apply #'insert args)))))
Yes, that provides more insight into what the code intends to do. Here's
the patch (with additional updated doc string):
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: fix sieve-manage--append-to-log for emacs-29 --]
[-- Type: text/x-diff, Size: 2230 bytes --]
From 62d03f302125c0b1aab2e3ae4f5b12b531d30d74 Mon Sep 17 00:00:00 2001
From: Kai Tetzlaff <emacs@tetzco.de>
Date: Thu, 19 Jan 2023 03:16:14 +0100
Subject: [PATCH] ; Fix bug in sieve-manage--append-to-log (emacs-29 only)
This is emacs-29 only, use more elaborate fix for Emacs 30.x (master).
* lisp/net/sieve-manage.el
(sieve-manage--append-to-log): Fix log buffer creation.
---
lisp/net/sieve-manage.el | 26 ++++++++++++++++----------
1 file changed, 16 insertions(+), 10 deletions(-)
diff --git a/lisp/net/sieve-manage.el b/lisp/net/sieve-manage.el
index 5bee4f4c4ad..4866f788bff 100644
--- a/lisp/net/sieve-manage.el
+++ b/lisp/net/sieve-manage.el
@@ -168,19 +168,25 @@ sieve-manage-capability
;; Internal utility functions
(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)))
- (goto-char (point-max))
- (apply #'insert args))))
+ (let* ((existing-log-buffer (get-buffer sieve-manage-log))
+ (log-buffer (or existing-log-buffer
+ (get-buffer-create sieve-manage-log))))
+ (with-current-buffer log-buffer
+ (unless existing-log-buffer
+ ;; Do this only once, when creating the log buffer.
+ (set-buffer-multibyte nil)
+ (buffer-disable-undo))
+ (goto-char (point-max))
+ (apply #'insert args)))))
(defun sieve-manage--message (format-string &rest args)
"Wrapper around `message' which also logs to sieve manage log.
--
2.39.0
[-- Attachment #3: Type: text/plain, Size: 6913 bytes --]
>> ;; 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.
>>
>> @@ -175,10 +202,8 @@ sieve-manage--append-to-log
>> `sieve-manage-log'. If it is nil, logging is disabled."
>> (when sieve-manage-log
>> (with-current-buffer (or (get-buffer sieve-manage-log)
>> - (with-current-buffer
>> - (get-buffer-create sieve-manage-log)
>> - (set-buffer-multibyte nil)
>> - (buffer-disable-undo)))
>> + (sieve-manage--set-internal-buffer-properties
>> + (get-buffer-create sieve-manage-log)))
>> (goto-char (point-max))
>> (apply #'insert args))))
>
> This still uses a less-than-elegant implementation that calls
> with-current-buffer twice.
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. In particular because
`set-buffer-file-coding-system' and `setq-local' only work with
(current-buffer). If you can point me to code which can replace these
with something that takes BUFFER arguments, I can rewrite
`sieve-manage--set-internal-buffer-properties' and avoid using
`with-current-buffer'.
>> (defun sieve-manage-encode (utf8-string)
>> "Convert UTF8-STRING to managesieve protocol octets."
>> - (encode-coding-string utf8-string 'raw-text t))
>> + (encode-coding-string utf8-string sieve-manage--coding-system t))
>
> Why is the argument called utf8-string? If it's indeed a string
> encoded in UTF-8, why do you need to encode it again with
> raw-text-unix? it should be a no-op in that case. So please tell more
> about the underlying issue.
I chose the name as a hint to the user that the incoming string should
be UTF-8 encoded. But that is probably misleading since the string
itself doesn't have an encoding? So let's change the function to:
(defun sieve-manage-encode (str)
"Convert STR to managesieve protocol octets."
(encode-coding-string str sieve-manage--coding-system t))
Regarding the potential double encoding: When sending data over the
network connection, `sieve-manage-encode' intends to make sure that
`utf8-string' data is converted to a byte/octet representation. I tried
to explain that in the doc string of `sieve-manage--coding-system':
(defconst sieve-manage--coding-system 'raw-text-unix
"Use 'raw-text-unix coding system for (network) communication.
Sets the coding system used for the internal (process, log)
buffers and the network stream created to communicate with the
managesieve server. Using 'raw-text encoding enables unibyte
mode and makes sure that sent/received octets (bytes) remain
untouched by the coding system. The explicit use of `-unix`
avoids EOL conversions (and thus keeps CRLF (\"\\r\\n\") intact).")
The original problem was that when communicating with the sievemanage
server, we need to handle length elements where we need make sure that
calculated values take into account that UTF-8 characters may comprise
multiple octets.
Even after reading the relevant sections of the documentation multiple
times I was (and am still) not sure what exactly the various coding
system settings do and how they interact with buffers and networking
functions. So forgive me if what I'm doing there looks weird to your
expert eyes.
When working on the original patch, I had several uhoh moments where
data sent to or received from the network seemed to have been
automatically modified by the coding system (unfortunately, I don't
remember the exact details). So I tried to eliminate any such automatic
modifications by using 'binary or 'raw-text encodings on code paths
which handle network data. Basically, my thinking was: 'better do things
twice/thrice/... before introducing new points of failure'.
>> @@ -244,8 +267,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)
>
> Same question about encoding with raw-text-unix here: using it means
> some other code will need to encode the text with a real encoding,
> which in this case is UTF-8 (AFAIU the managesieve protocol RFC). So
> why not use utf-8-unix here?
Same as above: I'm just not sure that this is the right thing.
But after thinking about it some more, I made the following change (as
an experiment):
1. set `sieve-manage--coding-system' to 'utf-8-unix (and update
the doc string)
With this change, there are still no issues when connecting to my
managesieve server which still contains a script with a name that
contains utf-8 multibyte characters. Also, the test I wrote still works
with that change.
So if you think that this makes things clearer, I'm happy to make the
change. I just don't feel confident enough to do this without
additional guidance.
I was also experimenting with some additional changes with the hope to
to just use coding system settings instead of calling
`sieve-manage-encode'/`sieve-manage-decode'. But I couldn't get that to
work.
I added an updated set of Emacs 30.x patches with the changes described
above (plus an additional change in sieve.el which makes sure that the
sieve-manage buffer containing the list of available sieve scripts is
also using coding system 'utf-8-unix from `sieve-manage--coding-system').
> Should the addition of BYE support be mentioned in NEWS?
I can certainly do that if you think that this is useful. It just seems
to be more of an internal detail which probably doesn't mean much to
most users.
> On balance, I think the additional patches should go to master,
> indeed. But let's resolve the issues mentioned above first.
Ok, awaiting further input...
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 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 #5: 0002-Handle-BYE-in-sieve-manage-server-responses.patch --]
[-- Type: text/x-diff, Size: 5782 bytes --]
From 55e3dfae66be5df73aff96fccd8dc5704a2c5dc5 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 adfecc7b309..ed3dcef8d04 100644
--- a/lisp/net/sieve-manage.el
+++ b/lisp/net/sieve-manage.el
@@ -270,8 +270,8 @@ sieve-manage-open-server
:type stream
:coding `(binary . ,sieve-manage--coding-system)
: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)
@@ -330,7 +330,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)
@@ -499,19 +499,19 @@ 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\" {%d+}%s%s" name
(length (sieve-manage-encode content))
sieve-manage-client-eol 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))
@@ -519,17 +519,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))
@@ -547,10 +552,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)))
@@ -559,12 +562,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))
@@ -598,7 +601,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)))))
@@ -612,7 +615,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 #6: 0003-Add-test-lisp-net-sieve-manage-tests.el.patch --]
[-- Type: text/x-diff, Size: 5141 bytes --]
From 786325d3adf7514967ae74c2db84c532f19dc070 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 | 106 ++++++++++++++++++++++++++++
1 file changed, 106 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..d4c616b3364
--- /dev/null
+++ b/test/lisp/net/sieve-manage-tests.el
@@ -0,0 +1,106 @@
+;;; 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 #7: 0004-Some-minor-fixes-in-lisp-net-sieve.el.patch --]
[-- Type: text/x-diff, Size: 3759 bytes --]
From 6c63f891589e6525bf91ef53a0a8114a836a7781 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 14:08 ` Eli Zaretskii
@ 2023-01-19 15:59 ` Kai Tetzlaff
2023-01-19 17:41 ` Eli Zaretskii
0 siblings, 1 reply; 43+ messages in thread
From: Kai Tetzlaff @ 2023-01-19 15:59 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: herbert, 54154, larsi
[-- Attachment #1: Type: text/plain, Size: 6123 bytes --]
Eli Zaretskii <eliz@gnu.org> writes:
>> > This still uses a less-than-elegant implementation that calls
>> > with-current-buffer twice.
>>
>> 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.
> 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?
> Since you seem to be encoding and decoding to/from UTF-8 by hand in
> sieve-manage-encode/decode, you should use 'binary' as the
> process-codings-system for the network connection to the server, and
> that's it.
That works. Done.
> 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)))
>> 1. set `sieve-manage--coding-system' to 'utf-8-unix and
>> 2. changed the call to `open-network-stream' in the patch above to
>> >> @@ -244,8 +267,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 sieve-manage--coding-system
>> instead of the previous, asymmetric mix of `binary and
>> `sieve-manage--coding-system'.
>
> This could work, but AFAIU, you need to specify the content length in
> bytes for the PUTSCRIPT command, so you must encode the content
> yourself. Thus my suggestion to use 'binary' in the :coding attribute
> of the process, and instead encode/decode using
> sieve-manage-encode/decode to/from UTF-8 inside sieve-manage-send and
> sieve-manage-parse-* functions.
Yes, that's what I explained above (before reading this part of your
reply). Unfortunately, just using `sieve-manage--coding-system' for the
:coding property didn't work, but I'm now using 'binary' encoding for
both directions.
>> > Should the addition of BYE support be mentioned in NEWS?
>>
>> I can certainly do that if you think that this is useful. It just seems
>> to be more of an internal detail which probably doesn't mean much to
>> most users.
>
> Isn't BYE provides some capabilities that user/callers would like to
> know about?
From RFC5804:
response-nobye = ("NO" / "BYE") [SP "(" resp-code ")"]
[SP string] CRLF
;; The string contains human-readable text
;; encoded as UTF-8.
As far as I understand, the difference between NO and BYE is that BYE is
just a different (and more drastic, because the server will also
disconnect) way of signalling an error. Fortunately, the human readable
<string> is typically included in these responses and will be shown to
the user.
Here is some more info about where BYE SHOULD (not MUST) be used:
The BYE response SHOULD be used if the server wishes to close the
connection. A server may wish to do this because the client was idle
for too long or there were too many failed authentication attempts.
This response can be issued at any time and should be immediately
followed by a server hang-up of the connection. ...
If I remember correctly, the timeout case was the reason why I added the
BYE handling (since during my experiments, I sometimes used the debugger
to understand what's going on which introduced long delays between
connection establishment/authentication and sending the first request
and resulted in a BYE instead of a NO).
There's also one additional (more interesting) case:
REFERRAL
This response code may be returned with a BYE result from any
command, and includes a mandatory parameter that indicates what
server to access to manage this user's Sieve scripts. The server
will be specified by a Sieve URL (see Section 3). The scriptname
portion of the URL MUST NOT be specified. The client should
authenticate to the specified server and use it for all further
commands in the current session.
However, even my updated sieve-manage code doesn't handle REFERRALs.
So I still think that to understand the difference between a BYE and a
NO would require the user to take a (deeper) dive into the RFC. But to
avoid a longer discussion, how about:
* Changes in Specialized Modes and Packages in Emacs 30.1
...
** sieve-manage
--
*** Added (partial) handling of BYE responses
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).
[-- 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: 5782 bytes --]
From 55e3dfae66be5df73aff96fccd8dc5704a2c5dc5 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 adfecc7b309..ed3dcef8d04 100644
--- a/lisp/net/sieve-manage.el
+++ b/lisp/net/sieve-manage.el
@@ -270,8 +270,8 @@ sieve-manage-open-server
:type stream
:coding `(binary . ,sieve-manage--coding-system)
: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)
@@ -330,7 +330,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)
@@ -499,19 +499,19 @@ 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\" {%d+}%s%s" name
(length (sieve-manage-encode content))
sieve-manage-client-eol 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))
@@ -519,17 +519,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))
@@ -547,10 +552,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)))
@@ -559,12 +562,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))
@@ -598,7 +601,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)))))
@@ -612,7 +615,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: 5141 bytes --]
From 786325d3adf7514967ae74c2db84c532f19dc070 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 | 106 ++++++++++++++++++++++++++++
1 file changed, 106 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..d4c616b3364
--- /dev/null
+++ b/test/lisp/net/sieve-manage-tests.el
@@ -0,0 +1,106 @@
+;;; 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 6c63f891589e6525bf91ef53a0a8114a836a7781 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 15:59 ` Kai Tetzlaff
@ 2023-01-19 17:41 ` Eli Zaretskii
2023-01-19 21:33 ` Kai Tetzlaff
` (3 more replies)
0 siblings, 4 replies; 43+ messages in thread
From: Eli Zaretskii @ 2023-01-19 17:41 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: 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.
> > Since you seem to be encoding and decoding to/from UTF-8 by hand in
> > sieve-manage-encode/decode, you should use 'binary' as the
> > process-codings-system for the network connection to the server, and
> > that's it.
>
> That works. Done.
>
> > 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.
^ permalink raw reply [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
` (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: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: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 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 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 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
* 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
* 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
end of thread, other threads:[~2024-09-29 12:43 UTC | newest]
Thread overview: 43+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2022-02-25 9:04 bug#54154: 29.0.50; [PATCH] `sieve-manage-getscript' fails if script contains multibyte characters Kai Tetzlaff
2022-02-25 12:19 ` Lars Ingebrigtsen
2022-02-25 13:10 ` Lars Ingebrigtsen
2022-02-25 16:00 ` Kai Tetzlaff
2022-02-26 15:07 ` Lars Ingebrigtsen
2022-02-28 12:27 ` Kai Tetzlaff
2022-09-06 11:34 ` Lars Ingebrigtsen
2022-02-28 12:35 ` Kai Tetzlaff
2022-02-28 13:06 ` Lars Ingebrigtsen
2022-02-28 13:08 ` Lars Ingebrigtsen
2022-02-28 13:03 ` Kai Tetzlaff
[not found] ` <87bkmwi0ut.fsf@tetzco.de>
[not found] ` <87fsc8i2c5.fsf@tetzco.de>
[not found] ` <87bkmw8b02.fsf@tetzco.de>
2023-01-18 18:28 ` bug#54154: Emacs commit ae963e80a79f5a9184daabfc8197f211a39b136d (sieve-manage) Herbert J. Skuhra
2023-01-18 19:17 ` Eli Zaretskii
2023-01-18 23:22 ` Herbert J. Skuhra
2023-01-19 4:06 ` Kai Tetzlaff
2023-01-19 7:45 ` Eli Zaretskii
2023-01-19 12:38 ` Kai Tetzlaff
2023-01-19 14:08 ` Eli Zaretskii
2023-01-19 15:59 ` Kai Tetzlaff
2023-01-19 17:41 ` Eli Zaretskii
2023-01-19 21:33 ` Kai Tetzlaff
2023-01-20 6:54 ` Kai Tetzlaff
2023-01-22 2:12 ` Kai Tetzlaff
2023-01-23 0:59 ` Kai Tetzlaff
2023-01-23 12:47 ` Herbert J. Skuhra
2023-01-23 13:01 ` Kai Tetzlaff
2023-01-23 13:36 ` Herbert J. Skuhra
2023-01-23 13:57 ` Kai Tetzlaff
2023-01-23 14:27 ` Andreas Schwab
2023-01-23 17:07 ` Kai Tetzlaff
2023-01-23 17:53 ` Andreas Schwab
2024-09-29 9:11 ` Herbert J. Skuhra
[not found] ` <87o74696he.wl-herbert@gojira.at>
2024-09-29 9:29 ` Eli Zaretskii
2024-09-29 10:23 ` Eli Zaretskii
2024-09-29 12:15 ` Herbert J. Skuhra
2024-09-29 12:43 ` Eli Zaretskii
2023-01-23 13:40 ` Eli Zaretskii
2023-01-23 16:22 ` Kai Tetzlaff
2023-01-23 16:49 ` Eli Zaretskii
2023-01-23 17:12 ` Kai Tetzlaff
2023-01-19 13:22 ` Kai Tetzlaff
2023-01-19 14:16 ` Kai Tetzlaff
2023-01-19 4:50 ` bug#54154: [update] " Kai Tetzlaff
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).