>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