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: Thu, 19 Jan 2023 22:33:14 +0100 Message-ID: <87sfg65hwl.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="35376"; 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 Thu Jan 19 22:34:25 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 1pIcYD-0008qu-Am for geb-bug-gnu-emacs@m.gmane-mx.org; Thu, 19 Jan 2023 22:34:25 +0100 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1pIcXt-0005Bd-I8; Thu, 19 Jan 2023 16:34: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 1pIcXr-0005BU-Iu for bug-gnu-emacs@gnu.org; Thu, 19 Jan 2023 16:34: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 1pIcXr-000161-27 for bug-gnu-emacs@gnu.org; Thu, 19 Jan 2023 16:34:03 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1pIcXq-0001HB-0I for bug-gnu-emacs@gnu.org; Thu, 19 Jan 2023 16:34: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: Thu, 19 Jan 2023 21:34:01 +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.16741640094856 (code B ref 54154); Thu, 19 Jan 2023 21:34:01 +0000 Original-Received: (at 54154) by debbugs.gnu.org; 19 Jan 2023 21:33:29 +0000 Original-Received: from localhost ([127.0.0.1]:44872 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pIcXH-0001GF-Hv for submit@debbugs.gnu.org; Thu, 19 Jan 2023 16:33:29 -0500 Original-Received: from mx2.tetzco.de ([152.67.86.91]:48629) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pIcXC-0001Fu-7N for 54154@debbugs.gnu.org; Thu, 19 Jan 2023 16:33:25 -0500 Original-Received: from mail.tetzco.de (ipb21a9472.dynamic.kabel-deutschland.de [178.26.148.114]) (Authenticated sender: relay@tetzco.de) by mx2.tetzco.de (Postfix) with ESMTPSA id 88D32BD078; Thu, 19 Jan 2023 22:33:16 +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 DC4396C00B2; Thu, 19 Jan 2023 22:53:07 +0100 (CET) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=tetzco.de; s=20210624; t=1674165188; 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=26r7YvUIhD0Xo0LV3v01iVRkMh3PSr+lzY6LEZPLZtE=; b=LEcBBTm5J4wWXm44Hd6+M6xCZCVaB2bOouyf8QEKyBSKIkdLgXm74ukCP26gUSZOpg46co BBRQD76UsmOZSgXtKSjsf8larRHRZYE6lZDuE99tAjjDNdiFQ2GOOrGfjcUEJbkRTbSjBc UfkVRA4ntrTw3PzQV+tueerq2IFEAWmz0yEk6yYduWEZbLvTsbHK0GyC/gVrm1G2+QLPrD kA8D3neASAq1/Ac+RYXsYty0W0YaqK5gbLOXcu/w8n2xuqvPkPGNXT6ZISdus+Ei9rhQq9 XTBb7oYb1qaOrxVg/EVnU8ob5PlmYsoX2qe/bESl9WM7u2oYmsJVBPj5GWbZd6DoFFivUt +7rLlLXB0AGayff4hHQ8+X4nv0WTnY5Vj7Qb3Gg2HcRqJFBXig+EtMTh8TZhxI1OdwcHp9 osePGbh82C9SoXWCyXmaL/+dH/ZibIEBWWfME5nrQCAB6Ydx6/+mV6epTt6ZvElL3Ielvi e3bBuqGrZWC3XepZMd+2aKp2cLiJOvsLPOFkIthS8CByxF5YT27PVo1DSeA3AeW 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: DC4396C00B2 X-Rspamd-Action: no action X-Spamd-Result: default: False [-6.82 / 30.00]; BAYES_HAM(-3.00)[100.00%]; NEURAL_HAM(-3.00)[-0.999]; GENERIC_REPUTATION(-0.73)[-0.72663819828647]; 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:+]; 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:253733 Archived-At: --=-=-= Content-Type: text/plain Eli Zaretskii writes: >> From: Kai Tetzlaff >> 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. --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0001-Fix-bug-in-sieve-manage-append-to-log-improve-sieve-.patch >From 977734f16874636c4f2f5e3bb41a86e4338247c4 Mon Sep 17 00:00:00 2001 From: Kai Tetzlaff 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 --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0002-Handle-BYE-in-sieve-manage-server-responses.patch >From c35bbe4a8ece09d0755386009a97ba4a91839753 Mon Sep 17 00:00:00 2001 From: Kai Tetzlaff 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 --=-=-= 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 8a04e8aaaf3abac0fb9d42bb535633c05be909a2 Mon Sep 17 00:00:00 2001 From: Kai Tetzlaff 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-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 24cef4c762f5c5f5de9799b57bf6789ff0724b1d Mon Sep 17 00:00:00 2001 From: Kai Tetzlaff 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 --=-=-=--