mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-01-30 04:10:54 -08:00
Fix (mostly multibyte) issues in sieve-manage.el (Bug#54154)
The managesieve protocol (s. RFC5804) requires support for (a sightly restricted variant of) UTF-8 in script content and script names. This commit fixes/improves the handling of multibyte characters. In addition, `sieve-manage-getscript' now properly handles NO responses from the server instead of inflooping. There are also some logging improvements. * lisp/net/sieve-manage.el (sieve-manage--append-to-log): (sieve-manage--message): (sieve-manage--error): (sieve-manage-encode): (sieve-manage-decode): (sieve-manage-no-p): New functions. (sieve-manage-make-process-buffer): Switch process buffer to unibyte. (sieve-manage-open-server): Add `:coding 'raw-text-unix` to `open-network-stream' call. Use unix EOLs in order to keep matching CRLF (aka "\r\n") intact. (sieve-manage-send): Make sure that UTF-8 multibyte characters are properly encoded before sending data to the server. (sieve-manage-getscript): (sieve-manage-putscript): Use the changes above to fix down/uploading scripts containing UTF-8 multibyte characters. (sieve-manage-listscripts): (sieve-manage-havespace) (sieve-manage-getscript) (sieve-manage-putscript): (sieve-manage-deletescript): (sieve-manage-setactive): Use the changes above to fix handling of script names which contain UTF-8 multibyte characters. (sieve-manage-parse-string): (sieve-manage-getscript): Add handling of server responses with type NO. Abort `sieve-manage-getscript' and show error message in message area. (sieve-manage-erase): (sieve-manage-drop-next-answer): (sieve-manage-parse-crlf): Return erased/dropped data (instead of nil). (sieve-sasl-auth): (sieve-manage-getscript): (sieve-manage-erase): (sieve-manage-open-server): (sieve-manage-open): (sieve-manage-send): Improve logging.
This commit is contained in:
Kai Tetzlaff
Lars Ingebrigtsen
parent
46963d0bc9
commit
ae963e80a7
1 changed files with 86 additions and 39 deletions
|
|
@ -167,7 +167,52 @@ Valid states are `closed', `initial', `nonauth', and `auth'.")
|
|||
(defvar sieve-manage-capability nil)
|
||||
|
||||
;; Internal utility functions
|
||||
(autoload 'mm-enable-multibyte "mm-util")
|
||||
(defun sieve-manage--append-to-log (&rest args)
|
||||
"Append ARGS to sieve-manage log buffer.
|
||||
|
||||
ARGS can be a string or a list of strings.
|
||||
The buffer to use for logging is specifified via
|
||||
`sieve-manage-log'. If it is nil, logging is disabled."
|
||||
(when sieve-manage-log
|
||||
(with-current-buffer (or (get-buffer sieve-manage-log)
|
||||
(with-current-buffer
|
||||
(get-buffer-create sieve-manage-log)
|
||||
(set-buffer-multibyte nil)
|
||||
(buffer-disable-undo)))
|
||||
(goto-char (point-max))
|
||||
(apply #'insert args))))
|
||||
|
||||
(defun sieve-manage--message (format-string &rest args)
|
||||
"Wrapper around `message' which also logs to sieve manage log.
|
||||
|
||||
See `sieve-manage--append-to-log'."
|
||||
(let ((ret (apply #'message
|
||||
(concat "sieve-manage: " format-string)
|
||||
args)))
|
||||
(sieve-manage--append-to-log ret "\n")
|
||||
ret))
|
||||
|
||||
(defun sieve-manage--error (format-string &rest args)
|
||||
"Wrapper around `error' which also logs to sieve manage log.
|
||||
|
||||
See `sieve-manage--append-to-log'."
|
||||
(let ((msg (apply #'format
|
||||
(concat "sieve-manage/ERROR: " format-string)
|
||||
args)))
|
||||
(sieve-manage--append-to-log msg "\n")
|
||||
(error msg)))
|
||||
|
||||
(defun sieve-manage-encode (utf8-string)
|
||||
"Convert UTF8-STRING to managesieve protocol octets."
|
||||
(encode-coding-string utf8-string 'raw-text t))
|
||||
|
||||
(defun sieve-manage-decode (octets &optional buffer)
|
||||
"Convert managesieve protocol OCTETS to utf-8 string.
|
||||
|
||||
If optional BUFFER is non-nil, insert decoded string into BUFFER."
|
||||
(when octets
|
||||
;; eol type unix is required to preserve "\r\n"
|
||||
(decode-coding-string octets 'utf-8-unix t buffer)))
|
||||
|
||||
(defun sieve-manage-make-process-buffer ()
|
||||
(with-current-buffer
|
||||
|
|
@ -175,22 +220,19 @@ Valid states are `closed', `initial', `nonauth', and `auth'.")
|
|||
sieve-manage-server
|
||||
sieve-manage-port))
|
||||
(mapc #'make-local-variable sieve-manage-local-variables)
|
||||
(mm-enable-multibyte)
|
||||
(set-buffer-multibyte nil)
|
||||
(setq-local after-change-functions nil)
|
||||
(buffer-disable-undo)
|
||||
(current-buffer)))
|
||||
|
||||
(defun sieve-manage-erase (&optional p buffer)
|
||||
(let ((buffer (or buffer (current-buffer))))
|
||||
(and sieve-manage-log
|
||||
(with-current-buffer (get-buffer-create sieve-manage-log)
|
||||
(mm-enable-multibyte)
|
||||
(buffer-disable-undo)
|
||||
(goto-char (point-max))
|
||||
(insert-buffer-substring buffer (with-current-buffer buffer
|
||||
(point-min))
|
||||
(or p (with-current-buffer buffer
|
||||
(point-max)))))))
|
||||
(delete-region (point-min) (or p (point-max))))
|
||||
(with-current-buffer (or buffer (current-buffer))
|
||||
(let* ((start (point-min))
|
||||
(end (or p (point-max)))
|
||||
(logdata (buffer-substring-no-properties start end)))
|
||||
(sieve-manage--append-to-log logdata)
|
||||
(delete-region start end)
|
||||
logdata)))
|
||||
|
||||
(defun sieve-manage-open-server (server port &optional stream buffer)
|
||||
"Open network connection to SERVER on PORT.
|
||||
|
|
@ -202,6 +244,8 @@ Return the buffer associated with the connection."
|
|||
(open-network-stream
|
||||
"SIEVE" buffer server port
|
||||
:type stream
|
||||
;; eol type unix is required to preserve "\r\n"
|
||||
:coding 'raw-text-unix
|
||||
:capability-command "CAPABILITY\r\n"
|
||||
:end-of-command "^\\(OK\\|NO\\).*\n"
|
||||
:success "^OK.*\n"
|
||||
|
|
@ -224,7 +268,7 @@ Return the buffer associated with the connection."
|
|||
;; Authenticators
|
||||
(defun sieve-sasl-auth (buffer mech)
|
||||
"Login to server using the SASL MECH method."
|
||||
(message "sieve: Authenticating using %s..." mech)
|
||||
(sieve-manage--message "Authenticating using %s..." mech)
|
||||
(with-current-buffer buffer
|
||||
(let* ((auth-info (auth-source-search :host sieve-manage-server
|
||||
:port "sieve"
|
||||
|
|
@ -275,11 +319,15 @@ Return the buffer associated with the connection."
|
|||
(if (and (setq step (sasl-next-step client step))
|
||||
(setq data (sasl-step-data step)))
|
||||
;; We got data for server but it's finished
|
||||
(error "Server not ready for SASL data: %s" data)
|
||||
(sieve-manage--error
|
||||
"Server not ready for SASL data: %s" data)
|
||||
;; The authentication process is finished.
|
||||
(sieve-manage--message "Logged in as %s using %s"
|
||||
user-name mech)
|
||||
(throw 'done t)))
|
||||
(unless (stringp rsp)
|
||||
(error "Server aborted SASL authentication: %s" (caddr rsp)))
|
||||
(sieve-manage--error
|
||||
"Server aborted SASL authentication: %s" (caddr rsp)))
|
||||
(sasl-step-set-data step (base64-decode-string rsp))
|
||||
(setq step (sasl-next-step client step))
|
||||
(sieve-manage-send
|
||||
|
|
@ -288,8 +336,7 @@ Return the buffer associated with the connection."
|
|||
(base64-encode-string (sasl-step-data step)
|
||||
'no-line-break)
|
||||
"\"")
|
||||
""))))
|
||||
(message "sieve: Login using %s...done" mech))))
|
||||
"")))))))
|
||||
|
||||
(defun sieve-manage-cram-md5-p (buffer)
|
||||
(sieve-manage-capability "SASL" "CRAM-MD5" buffer))
|
||||
|
|
@ -353,7 +400,7 @@ to work in."
|
|||
sieve-manage-default-stream)
|
||||
sieve-manage-auth (or auth
|
||||
sieve-manage-auth))
|
||||
(message "sieve: Connecting to %s..." sieve-manage-server)
|
||||
(sieve-manage--message "Connecting to %s..." sieve-manage-server)
|
||||
(sieve-manage-open-server sieve-manage-server
|
||||
sieve-manage-port
|
||||
sieve-manage-stream
|
||||
|
|
@ -368,7 +415,8 @@ to work in."
|
|||
(setq sieve-manage-auth auth)
|
||||
(cl-return)))
|
||||
(unless sieve-manage-auth
|
||||
(error "Couldn't figure out authenticator for server")))
|
||||
(sieve-manage--error
|
||||
"Couldn't figure out authenticator for server")))
|
||||
(sieve-manage-erase)
|
||||
(current-buffer))))
|
||||
|
||||
|
|
@ -433,11 +481,7 @@ If NAME is nil, return the full server list of capabilities."
|
|||
(defun sieve-manage-putscript (name content &optional buffer)
|
||||
(with-current-buffer (or buffer (current-buffer))
|
||||
(sieve-manage-send (format "PUTSCRIPT \"%s\" {%d+}%s%s" name
|
||||
;; Here we assume that the coding-system will
|
||||
;; replace each char with a single byte.
|
||||
;; This is always the case if `content' is
|
||||
;; a unibyte string.
|
||||
(length content)
|
||||
(length (sieve-manage-encode content))
|
||||
sieve-manage-client-eol content))
|
||||
(sieve-manage-parse-okno)))
|
||||
|
||||
|
|
@ -449,11 +493,10 @@ If NAME is nil, return the full server list of capabilities."
|
|||
(defun sieve-manage-getscript (name output-buffer &optional buffer)
|
||||
(with-current-buffer (or buffer (current-buffer))
|
||||
(sieve-manage-send (format "GETSCRIPT \"%s\"" name))
|
||||
(let ((script (sieve-manage-parse-string)))
|
||||
(sieve-manage-parse-crlf)
|
||||
(with-current-buffer output-buffer
|
||||
(insert script))
|
||||
(sieve-manage-parse-okno))))
|
||||
(sieve-manage-decode (sieve-manage-parse-string)
|
||||
output-buffer)
|
||||
(sieve-manage-parse-crlf)
|
||||
(sieve-manage-parse-okno)))
|
||||
|
||||
(defun sieve-manage-setactive (name &optional buffer)
|
||||
(with-current-buffer (or buffer (current-buffer))
|
||||
|
|
@ -478,6 +521,9 @@ If NAME is nil, return the full server list of capabilities."
|
|||
(defun sieve-manage-ok-p (rsp)
|
||||
(string= (downcase (or (car-safe rsp) "")) "ok"))
|
||||
|
||||
(defun sieve-manage-no-p (rsp)
|
||||
(string= (downcase (or (car-safe rsp) "")) "no"))
|
||||
|
||||
(defun sieve-manage-is-okno ()
|
||||
(when (looking-at (concat
|
||||
"^\\(OK\\|NO\\)\\( (\\([^)]+\\))\\)?\\( \\(.*\\)\\)?"
|
||||
|
|
@ -528,7 +574,11 @@ to local variable `sieve-manage-capability'."
|
|||
(while (null rsp)
|
||||
(accept-process-output (get-buffer-process (current-buffer)) 1)
|
||||
(goto-char (point-min))
|
||||
(setq rsp (sieve-manage-is-string)))
|
||||
(unless (setq rsp (sieve-manage-is-string))
|
||||
(when (sieve-manage-no-p (sieve-manage-is-okno))
|
||||
;; simple `error' is enough since `sieve-manage-erase'
|
||||
;; already adds the server response to the log
|
||||
(error (sieve-manage-erase)))))
|
||||
(sieve-manage-erase (point))
|
||||
rsp))
|
||||
|
||||
|
|
@ -540,7 +590,8 @@ to local variable `sieve-manage-capability'."
|
|||
(let (tmp rsp data)
|
||||
(while (null rsp)
|
||||
(while (null (or (setq rsp (sieve-manage-is-okno))
|
||||
(setq tmp (sieve-manage-is-string))))
|
||||
(setq tmp (sieve-manage-decode
|
||||
(sieve-manage-is-string)))))
|
||||
(accept-process-output (get-buffer-process (current-buffer)) 1)
|
||||
(goto-char (point-min)))
|
||||
(when tmp
|
||||
|
|
@ -559,13 +610,9 @@ to local variable `sieve-manage-capability'."
|
|||
rsp)))
|
||||
|
||||
(defun sieve-manage-send (cmdstr)
|
||||
(setq cmdstr (concat cmdstr sieve-manage-client-eol))
|
||||
(and sieve-manage-log
|
||||
(with-current-buffer (get-buffer-create sieve-manage-log)
|
||||
(mm-enable-multibyte)
|
||||
(buffer-disable-undo)
|
||||
(goto-char (point-max))
|
||||
(insert cmdstr)))
|
||||
(setq cmdstr (sieve-manage-encode
|
||||
(concat cmdstr sieve-manage-client-eol)))
|
||||
(sieve-manage--append-to-log cmdstr)
|
||||
(process-send-string sieve-manage-process cmdstr))
|
||||
|
||||
(provide 'sieve-manage)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue