From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Kai Tetzlaff Newsgroups: gmane.emacs.bugs Subject: bug#54154: Emacs commit ae963e80a79f5a9184daabfc8197f211a39b136d (sieve-manage) Date: Mon, 23 Jan 2023 01:59:09 +0100 Message-ID: <878rhut6aq.fsf@tetzco.de> References: <87wnhj5nbk.fsf@tetzco.de> <835yd31wk8.fsf@gnu.org> <874jsngod2.fsf@tetzco.de> <83tu0nynla.fsf@gnu.org> <873586d7ii.fsf@tetzco.de> <834jsmpqf9.fsf@gnu.org> <87bkmua51z.fsf@tetzco.de> <83v8l2o212.fsf@gnu.org> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="5908"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Cc: herbert@gojira.at, 54154@debbugs.gnu.org, larsi@gnus.org To: Eli Zaretskii Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Mon Jan 23 02:00:27 2023 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1pJlCE-0001PZ-5e for geb-bug-gnu-emacs@m.gmane-mx.org; Mon, 23 Jan 2023 02:00:26 +0100 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1pJlBt-00006I-QE; Sun, 22 Jan 2023 20:00:05 -0500 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pJlBr-00005l-PZ for bug-gnu-emacs@gnu.org; Sun, 22 Jan 2023 20:00:03 -0500 Original-Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1pJlBr-0002MA-DF for bug-gnu-emacs@gnu.org; Sun, 22 Jan 2023 20:00:03 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1pJlBq-0007BJ-Qq for bug-gnu-emacs@gnu.org; Sun, 22 Jan 2023 20:00:02 -0500 X-Loop: help-debbugs@gnu.org Resent-From: Kai Tetzlaff Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Mon, 23 Jan 2023 01:00:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 54154 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch Original-Received: via spool by 54154-submit@debbugs.gnu.org id=B54154.167443556827531 (code B ref 54154); Mon, 23 Jan 2023 01:00:02 +0000 Original-Received: (at 54154) by debbugs.gnu.org; 23 Jan 2023 00:59:28 +0000 Original-Received: from localhost ([127.0.0.1]:52854 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pJlBG-00079x-0g for submit@debbugs.gnu.org; Sun, 22 Jan 2023 19:59:28 -0500 Original-Received: from mx2.tetzco.de ([152.67.86.91]:40205) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pJlBB-00079f-CY for 54154@debbugs.gnu.org; Sun, 22 Jan 2023 19:59:25 -0500 Original-Received: from mail.tetzco.de (unknown [IPv6:2a02:810d:1380:7900::9]) (Authenticated sender: relay@tetzco.de) by mx2.tetzco.de (Postfix) with ESMTPSA id 1C98BBD078; Mon, 23 Jan 2023 01:59:13 +0100 (CET) Original-Received: from moka (moka.tetzco.de [172.30.42.200]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange ECDHE (P-256) server-signature RSA-PSS (2048 bits) server-digest SHA256) (No client certificate requested) (Authenticated sender: kai@tetzco.de) by mail.tetzco.de (Postfix) with ESMTPSA id D7B276C00B2; Mon, 23 Jan 2023 02:19:08 +0100 (CET) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=tetzco.de; s=20210624; t=1674436748; h=from:from:reply-to:subject:subject:date:date:message-id:message-id: to:to:cc:cc:mime-version:mime-version:content-type:content-type: in-reply-to:in-reply-to:references:references; bh=6lm1MnSYrlltuBMPA2gnQTpxs9LlD7DCQp2nyc7gzmo=; b=Qy63e8dzecfQKhvB41qmSKlibuUIo7VLqkc5vUkd7S4KPcxQGrjKrGZS9BTZpoM2UYeeuz 5cmuHMsjmk+T6e3BxpGOya8EWKHwetJCDMqYPnpXNJ/EGBts+j7LUd6zP9RsiPcNfbGTXm mEvn0ccg4weLikwgYri5mfyTUIdWhrxaBfd1vqzwoNCmpsxrbqv9jNfr8u0sD4AuymlymU 1zXsTexXx+CC61jLTwbd5h9zNI11MlZHbFPfNiAK7z0HXvCr0/g269wzQGM6xtDCxWnkL/ d8JPy1LG1LVDgUTBGgn8KB3HOwXePle44e6G+NGeIjlFWHYYm5oOpTsEZZLgOBXBDXRvp7 KMLVv384na1SHAaPlfx7ZXFtBl/XbWDS4Bd+0uTY+JAjQ3oOLQz9LaIuBYJJwz/rlcMe69 Lr11qAKyjeCXKgRIQ7gTa1gO6ASkLDh1cMck1zc/L7fo09GeiU48VDHzzKl5zvUkq+sHOM 0kg7fjTj92FuA5jw27AkDQXiI+xJ23wkggOzp79ddHjP7oqg409InX8kYEdBBry In-Reply-To: <83v8l2o212.fsf@gnu.org> (Eli Zaretskii's message of "Thu, 19 Jan 2023 19:41:13 +0200") X-Rspamd-Server: rakaposhi X-Rspamd-Queue-Id: D7B276C00B2 X-Rspamd-Action: no action X-Spamd-Result: default: False [-6.83 / 30.00]; BAYES_HAM(-3.00)[100.00%]; NEURAL_HAM(-3.00)[-0.999]; GENERIC_REPUTATION(-0.73)[-0.72664186213518]; MIME_GOOD(-0.10)[multipart/mixed,text/plain,text/x-diff]; RCVD_COUNT_ZERO(0.00)[0]; FROM_EQ_ENVFROM(0.00)[]; MIME_TRACE(0.00)[0:+,1:+,2:+,3:+,4:+,5:+,6:+,7:+]; DKIM_SIGNED(0.00)[tetzco.de:s=20210624]; ARC_NA(0.00)[]; HAS_ATTACHMENT(0.00)[]; TO_MATCH_ENVRCPT_ALL(0.00)[]; FROM_HAS_DN(0.00)[]; TAGGED_FROM(0.00)[bug]; RCPT_COUNT_THREE(0.00)[4]; TO_DN_SOME(0.00)[]; MID_RHS_MATCH_FROM(0.00)[] X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.bugs:253969 Archived-At: --=-=-= Content-Type: text/plain 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). --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0001-Fix-bug-in-sieve-manage-append-to-log-and-do-some-re.patch >From 8b659e704a6b39b586168a6851923fcfd6035d8e Mon Sep 17 00:00:00 2001 From: Kai Tetzlaff 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 --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0002-Handle-BYE-in-sieve-manage-server-responses.patch >From 196aaf2d7f7ebea1f5a8999970092fd80dfc8f4e Mon Sep 17 00:00:00 2001 From: Kai Tetzlaff 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). + * 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 --=-=-= Content-Type: text/x-diff; charset=utf-8 Content-Disposition: attachment; filename=0003-Add-test-lisp-net-sieve-manage-tests.el.patch Content-Transfer-Encoding: quoted-printable >From 86ba9f91e4c78fee72eab0c752cd9c5e78fab402 Mon Sep 17 00:00:00 2001 From: Kai Tetzlaff 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-mana= ge-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 + +;; 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 . + +;;; Commentary: + +;;; Code: + +(require 'ert) +(require 'sieve-manage) + +(defvar sieve-script-multibyte-unix + "if body :matches \"=C3=A4\" { 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 `=C3=A4` + (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=3D sieve-script-multibyte-unix + (managesieve-getscript sieve-script-multibyte-unix)))) + +;;; sieve-manage-tests.el ends here --=20 2.39.0 --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0004-Some-minor-fixes-in-lisp-net-sieve.el.patch >From aef415f651e59542fe7bb3a2ab76c2b27bb51a07 Mon Sep 17 00:00:00 2001 From: Kai Tetzlaff 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 --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0005-Autodetect-eol-type-of-sieve-manage-scripts.patch >From 4b144b0eff79cdcba1af4e46bd0a57836747d9ce Mon Sep 17 00:00:00 2001 From: Kai Tetzlaff 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'. + * 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 --=-=-= Content-Type: text/x-diff; charset=utf-8 Content-Disposition: attachment; filename=0006-WiP-new-encode-tested-OK.patch Content-Transfer-Encoding: quoted-printable >From 334792ee0072890800933f080d9ca86ac2aecf3f Mon Sep 17 00:00:00 2001 From: Kai Tetzlaff 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 \\=3D'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 \\=3D'-unix\\=3D' avoids EOL conversions (and thus keeps CRLF (\"\\r\\n\") sequences intact).") =20 @@ -173,6 +173,13 @@ sieve-manage-state (defvar sieve-manage-process nil) (defvar sieve-manage-capability nil) =20 +(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)) =20 -(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 \\=3D'sieve-manage-error\\=3D' of TYPE. +FORMAT-STRONG and ARGS are used as arguments to `format'. +Errors are also logged to sieve manage log. =20 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)))) =20 -(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' +(\\=3D'utf-8-unix)." (encode-coding-string str sieve-manage--coding-system t)) =20 -(defun sieve-manage--guess-buffer-coding-system (&optional buffer) +(defun sieve-manage-mk-quoted (octet-str) + "Convert OCTET-STR to rfc5804 \\=3D'quoted\\=3D' 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 \\=3D'literal-c2s\\=3D' 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 \\=3D'literal-s2c\\=3D' 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 \\=3D'utf-8-unix + coding system and encoded as \\=3D'quoted\\=3D' rfc5804 string), +3. buffer (buffer content will be converted to unibyte using + `buffer-file-coding-system and encoded as \\=3D'literal-c2s\\=3D' rfc58= 04 + string), +4. cons cell (TYPE . DATA) where the following combinations of TYPE + and DATA are supported: + - (number . ) where is an integer in the range of + [0..4294967296] + - (cmd-name . ) where is a unibyte string + - ( . ) where is one of \\=3D'quoted, + \\=3D'literal-c2s, \\=3D'literal-s2c and is a unibyte str= ing + - ( . ) where is one of \\=3D'mb-quoted, + \\=3D'mb-literal-c2s, \\=3D'mb-literal-s2c and is a (multibyte)= UTF-8 + string which will be converted to unibyte using coding system + \\=3D'utf-8-unix." + (cond + ((and (integerp item) (>=3D 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. =20 -Since RFC5804 requires scripts to be encoded as UTF-8, the -returned coding system is either \\=3D'utf-8-unix or \\=3D'utf-8-dos." +Since rfc5804 requires sieve scripts to use (a subset of) UTF-8, the +returned coding system is of type \\=3D'utf-8 with either \\=3D'-unix\\=3D= ', +\\=3D'-dos\\=3D' or \\=3D'-mac\\=3D' 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 (=3D #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)))) =20 (defun sieve-manage-decode (octets &optional buffer) "Convert managesieve protocol OCTETS to UTF-8 string. =20 -If optional BUFFER is non-nil, insert decoded string into BUFFER." +If BUFFER is non-nil detect \\=3D'eol-type\\=3D' of OCTETS, use correspond= ing +\\=3D'utf-8- 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' (\\=3D'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)))) =20 @@ -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) + "")))))))) =20 (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))))) =20 (defun sieve-manage-listscripts (&optional buffer) + "Send LISTSCRIPTS command to download list of available scripts. +BUFFER is the \\=3D'sieve-manage\\=3D' process buffer (default: \\=3D'(cur= rent-buffer)\\=3D')." (with-current-buffer (or buffer (current-buffer)) - (sieve-manage-send "LISTSCRIPTS") + (sieve-manage-send-command "LISTSCRIPTS") (sieve-manage-parse-listscripts))) =20 (defun sieve-manage-havespace (name size &optional buffer) + "Send HAVESPACE command for script NAME and SIZE. +BUFFER is the \\=3D'sieve-manage\\=3D' process buffer (default: \\=3D'(cur= rent-buffer)\\=3D')." + (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))) =20 -(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 +\\=3D'utf-8-unix, \\=3D'utf-8-dos or \\=3D'utf-8-mac. +BUFFER is the \\=3D'sieve-manage\\=3D' process buffer (default: \\=3D'(cur= rent-buffer)\\=3D')." + (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))) =20 (defun sieve-manage-deletescript (name &optional buffer) + "Send DELETESCRIPT command to delete script named NAME. +BUFFER is the \\=3D'sieve-manage\\=3D' process buffer (default: \\=3D'(cur= rent-buffer)\\=3D')." + (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))) =20 -(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 \\=3D'eol-type\\=3D= ' 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 \\=3D'utf-8\\=3D' variant with the detected \\=3D'eol= -type\\=3D'. +BUFFER is the \\=3D'sieve-manage\\=3D' process buffer (default: \\=3D'(cur= rent-buffer)\\=3D')." + (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))) =20 (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 \\=3D'sieve-manage\\=3D' process buffer (default: \\=3D'(cur= rent-buffer)\\=3D')." (with-current-buffer (or buffer (current-buffer)) - (sieve-manage-send (format "SETACTIVE \"%s\"" name)) + (sieve-manage-send-command "SETACTIVE" name) (sieve-manage-parse-oknobye))) =20 ;; 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)) =20 @@ -669,28 +788,36 @@ sieve-manage-parse-listscripts data rsp))) =20 -(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 \\=3D'literal-s2c\\=3D' representation according to RFC5= 804." - (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))) =20 diff --git a/test/lisp/net/sieve-manage-tests.el b/test/lisp/net/sieve-mana= ge-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) =20 -(defvar sieve-script-multibyte-unix +;;; test data + +(defvar smt/script-multibyte-unix "if body :matches \"=C3=A4\" { stop; }\n" - "Simple multibyte sieve script.") + "Simple multibyte sieve script with unix EOL.") + +(defvar smt/script-multibyte-dos + "if body :matches \"=C3=A4\" { stop; }\r\n" + "Simple multibyte sieve script with dos EOL.") + +(defvar smt/script-multibyte-mac + "if body :matches \"=C3=A4\" { 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 "=C3=A4=C3=B6=C3=BC=C3=9F=C3=84=C3=96=C3=9C" + "Multibyte sieve string.") =20 -(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.") =20 -(defun mk-rsp-oknobye (type &optional resp-code string) +(defvar smt/script-name-multibyte "=C3=A4=C3=B6=C3=BC=C3=9F=C3=84=C3=96=C3= =9C.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.") =20 -(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 \\=3D'response-getscript\\=3D'." + (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 `=C3=A4` - (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-u= nibyte)))) + (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-u= nibyte)))) + (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-u= nibyte)))) + (should (equal "{0}\r\n" + (sieve-manage-encode (cons 'literal-s2c "")))) + ) + =20 (ert-deftest ert/managesieve-getscript-multibyte () - (should (string=3D sieve-script-multibyte-unix - (managesieve-getscript sieve-script-multibyte-unix)))) + (let ((ret (smt/managesieve-getscript smt/script-multibyte-unix))) + (should (string=3D smt/script-multibyte-unix (car ret))) + (should (eq 'utf-8-unix (cdr ret)))) + (let ((ret (smt/managesieve-getscript smt/script-multibyte-dos))) + (should (string=3D smt/script-multibyte-unix (car ret))) + (should (eq 'utf-8-dos (cdr ret)))) + (let ((ret (smt/managesieve-getscript smt/script-multibyte-mac))) + (should (string=3D smt/script-multibyte-unix (car ret))) + (should (eq 'utf-8-mac (cdr ret)))) + ) =20 ;;; sieve-manage-tests.el ends here --=20 2.39.0 --=-=-=--