From ffcfac99012f9a34b4bd3e735ad2337df988b5a8 Mon Sep 17 00:00:00 2001 From: Kai Tetzlaff Date: Mon, 23 Jan 2023 16:53:39 +0100 Subject: [PATCH 4/6] Autodetect eol-type of sieve(-manage) scripts When using `sieve-manage-getscript' to download a sieve script, sieve-manage now automatically detects the eol-type (either 'utf-8-unix or 'utf-8-dos), uses it to decode the script data and sets `buffer-file-coding-system' accordingly. This gets rid of '^M' in sieve script buffers (for scripts which use CRLF type EOLs). The same eol-type is then used to encode the script during upload with `sieve-manage-putscript'. * lisp/net/sieve-manage.el (sieve-manage--detect-buffer-coding-system): New function which detects the eol-type of a downloaded script and returns either 'utf-8-unix, 'utf-8-dos or 'utf-8-mac (if the latter is actually supported by any existing server or even makes sense ...). (sieve-manage-decode): Use `sieve-manage--guess-buffer-coding-system' to decode downloaded script data with the correct coding-system and sets the `buffer-file-coding-system' of the resulting sieve script buffer. (sieve-manage-putscript): Now takes a sieve script buffer (instead of a string) argument and forwards it to `sieve-manage-send'. (sieve-manage-send): Now also uses a (payload-)buffer instead of a string. The `buffer-file-coding-system' of the buffer is then used when encoding the payload in order to use the correct eol-type. * lisp/net/sieve.el: (sieve-upload): Adapt to changed argument type of `sieve-manage-putscript'. * etc/NEWS: Add a short description of the changes. --- etc/NEWS | 10 +++++++ lisp/net/sieve-manage.el | 56 ++++++++++++++++++++++++++++++---------- lisp/net/sieve.el | 6 ++--- 3 files changed, 55 insertions(+), 17 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index bebea918b11..769aed9dfa8 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -207,6 +207,16 @@ failures. Note: The special case of a REFERRAL/BYE responses is still not handled by the client (s. RFC5804 for more details). +--- +*** Autodetect eol-type of downloaded sieve scripts. +When a downloaded script contained CRLF type EOLs, they caused '^M's +to appear in the sieve script edit buffer. To avoid that, the +eol-type of sieve scripts is now detected during download via +'sieve-manage-getscript', used when decoding the data and stored in +'buffer-file-coding-system' of the script buffer. The +'buffer-file-coding-system' is then also used for encoding during +upload by 'sieve-manage-putscript'. + * New Modes and Packages in Emacs 30.1 diff --git a/lisp/net/sieve-manage.el b/lisp/net/sieve-manage.el index 79f97f371e0..cecdeb6f8e7 100644 --- a/lisp/net/sieve-manage.el +++ b/lisp/net/sieve-manage.el @@ -239,15 +239,37 @@ sieve-manage--convert-multibyte The conversion is done using `sieve-manage--coding-system'." (encode-coding-string str sieve-manage--coding-system t)) +(defun sieve-manage--detect-buffer-coding-system (&optional buffer) + "Return the coding system to be use for (sieve script) BUFFER. + +Since rfc5804 requires sieve scripts to use (a subset of) UTF-8, the +returned coding system is of type \\='utf-8 with either \\='-unix\\=', +\\='-dos\\=' or \\='-mac\\=' eol-type." + (with-current-buffer (or buffer (current-buffer)) + (let ((coding-system (detect-coding-region + (point-min) (point-max) t))) + (alist-get (coding-system-eol-type coding-system) + '((0 . utf-8-unix) + (1 . utf-8-dos) + (2 . utf-8-mac)) + 'utf-8-unix)))) + (defun sieve-manage-decode (octets &optional buffer) "Convert managesieve protocol OCTETS to UTF-8 string. If optional BUFFER is non-nil, insert decoded string into BUFFER." (when octets - ;; eol type unix is required to preserve "\r\n" - (decode-coding-string octets - sieve-manage--coding-system - t buffer))) + (if buffer + (with-current-buffer buffer + (insert octets) + (let ((coding-system + (sieve-manage--detect-buffer-coding-system))) + (set-buffer-file-coding-system coding-system) + (decode-coding-region (point-min) (point-max) + coding-system)) + buffer) + (decode-coding-string + octets sieve-manage--coding-system t)))) (defun sieve-manage-make-process-buffer () (let ((buffer (sieve-manage--set-buffer-maybe-append-text @@ -512,9 +534,9 @@ sieve-manage-havespace (sieve-manage-send (format "HAVESPACE \"%s\" %s" name size)) (sieve-manage-parse-oknobye))) -(defun sieve-manage-putscript (name content &optional buffer) +(defun sieve-manage-putscript (name script-buffer &optional buffer) (with-current-buffer (or buffer (current-buffer)) - (sieve-manage-send (format "PUTSCRIPT \"%s\"" name) content) + (sieve-manage-send (format "PUTSCRIPT \"%s\"" name) script-buffer) (sieve-manage-parse-oknobye))) (defun sieve-manage-deletescript (name &optional buffer) @@ -644,14 +666,20 @@ sieve-manage-parse-listscripts data rsp))) -(defun sieve-manage-send (command &optional payload-str) - "Send COMMAND with optional PAYLOAD-STR. - -If non-nil, PAYLOAD-STR will be appended to COMMAND using the -\\='literal-s2c\\' representation according to rfc5804." - (let ((encoded (when payload-str (sieve-manage--convert-multibyte - payload-str))) - literal-c2s cmdstr) +(defun sieve-manage-send (command &optional payload-buffer) + "Send COMMAND with optional string from PAYLOAD-BUFFER. + +If non-nil, the content of PAYLOAD-BUFFER will be appended to +COMMAND using the \\='literal-s2c\\=' representation according to rfc5804." + (let* ((encoded (when (and payload-buffer + (> (buffer-size payload-buffer) 0)) + (with-current-buffer payload-buffer + (encode-coding-region + (point-min) (point-max) + (buffer-local-value 'buffer-file-coding-system + payload-buffer) + t)))) + cmdstr literal-c2s) (when encoded (setq literal-c2s (format " {%d+}%s%s" (length encoded) diff --git a/lisp/net/sieve.el b/lisp/net/sieve.el index a73584f203c..437486c8a13 100644 --- a/lisp/net/sieve.el +++ b/lisp/net/sieve.el @@ -366,13 +366,13 @@ sieve-upload (interactive) (when (or (get-buffer sieve-buffer) (save-current-buffer (call-interactively 'sieve-manage))) - (let ((script (buffer-string)) + (let ((script-buffer (current-buffer)) (script-name (file-name-sans-extension (buffer-name))) err) (with-current-buffer (get-buffer sieve-buffer) - (setq err (sieve-manage-putscript + (setq err (sieve-manage-putscript (or name sieve-buffer-script-name script-name) - script sieve-manage-buffer)) + script-buffer sieve-manage-buffer)) (if (not (sieve-manage-ok-p err)) (message "Sieve upload failed: %s" (nth 2 err)) (message "Sieve upload done. Use %s to manage scripts." -- 2.39.0