From 599501989322142f751de171ff4c138c0ec05956 Mon Sep 17 00:00:00 2001 From: Kai Tetzlaff Date: Mon, 23 Jan 2023 04:05:54 +0100 Subject: [PATCH 6/6] WiP: new encode, tested OK --- lisp/net/sieve-manage.el | 328 +++++++++++++++++++++------- test/lisp/net/sieve-manage-tests.el | 296 +++++++++++++++++++++---- 2 files changed, 504 insertions(+), 120 deletions(-) diff --git a/lisp/net/sieve-manage.el b/lisp/net/sieve-manage.el index cecdeb6f8e7..6a343874de4 100644 --- a/lisp/net/sieve-manage.el +++ b/lisp/net/sieve-manage.el @@ -144,6 +144,25 @@ sieve-manage-ignore-starttls :version "26.1" :type 'boolean) +(defconst sieve-manage-supported-commands + '(CAPABILITY ;; send automatically when connecting + STARTTLS ;; supported implicilty by sasl/networking + AUTHENTICATE + LISTSCRIPTS + SETACTIVE + GETSCRIPT + DELETESCRIPT + HAVESPACE + PUTSCRIPT + LOGOUT) + "Commands supported by the \\='sieve-manage\\=' client. + +The following commands from rfc5804 are not implemented: +- NOOP +- RENAMESCRIPT +- CHECKSCRIPT +- UNAUTHENTICATE") + ;; Internal variables: (defconst sieve-manage--coding-system 'utf-8-unix "Use \\='utf-8-unix coding system for (network) communication. @@ -173,6 +192,18 @@ sieve-manage-state (defvar sieve-manage-process nil) (defvar sieve-manage-capability nil) +(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) +(define-error 'sieve-manage-client-error + "sieve-manage client error" 'sieve-manage-error) +(define-error 'sieve-manage-unsupported-cmd + "Command not supported by sieve-manage client." + 'sieve-manage-client-error) + ;; Internal utility functions (defun sieve-manage--set-buffer-maybe-append-text (buffer-name &rest args) @@ -216,7 +247,7 @@ sieve-manage--append-to-log (defun sieve-manage--message (format-string &rest args) "Wrapper around `message' which also logs to sieve manage log. - +See `message' for the use of FORMAT-STRING and ARGS. See `sieve-manage--append-to-log'." (let ((ret (apply #'message (concat "sieve-manage: " format-string) @@ -224,21 +255,120 @@ sieve-manage--message (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. +(defun sieve-manage--error (err format-string &rest args) + "Signal an error of type ERR. +ERR should be an error type derived from +\\='sieve-manage-error\\='. See `format' for the use of +FORMAT-STRING and ARGS. -See `sieve-manage--append-to-log'." +Errors are also logged to sieve manage log (see +`sieve-manage--append-to-log')." (let ((msg (apply #'format - (concat "sieve-manage/ERROR: " format-string) + (concat "Error: " format-string) args))) (sieve-manage--append-to-log msg "\n") - (error msg))) + (signal err (list msg)))) (defun sieve-manage--convert-multibyte (str) "Convert multibyte STR to unibyte octet string. The conversion is done using `sieve-manage--coding-system'." (encode-coding-string str sieve-manage--coding-system t)) +(defun sieve-manage--mk-quoted (octet-str) + "Convert OCTET-STR to rfc5804 \\='quoted\\=' 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 \\='literal-c2s\\=' 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 \\='literal-s2c\\=' 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. symbol (will be interpreted as sieve command name), +2. number (positive integer or 0), +3. string (will be converted to unibyte using \\='utf-8-unix + coding system and encoded as \\='quoted\\=' rfc5804 string), +4. buffer (buffer content will be converted to unibyte using + `buffer-file-coding-system and encoded as \\='literal-c2s\\=' rfc5804 + string), +5. 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 either a unibyte string or one of + the symbols from `sieve-manage-supported-commands' + - ( . ) where is one of \\='quoted, + \\='literal-c2s, \\='literal-s2c and is a unibyte string + - ( . ) where is one of \\='mb-quoted, + \\='mb-literal-c2s, \\='mb-literal-s2c and is a (multibyte) UTF-8 + string which will be converted to unibyte using coding system + \\='utf-8-unix." + (cond + ((symbolp item) + (sieve-manage-encode (cons 'cmd-name item))) + ((and (integerp item) (>= 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 (with-current-buffer item + (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 + (when (and (symbolp data) + (not (memq data sieve-manage-supported-commands))) + (sieve-manage--error 'sieve-manage-unsupported-cmd + "Command '%s' is not supported" data)) + (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. @@ -257,7 +387,13 @@ sieve-manage--detect-buffer-coding-system (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." +If BUFFER is non-nil detect \\='eol-type\\=' of OCTETS, use corresponding +\\='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' (\\='utf-8-unix) +and return the resulting UTF-8 string." (when octets (if buffer (with-current-buffer buffer @@ -339,18 +475,13 @@ sieve-sasl-auth ;; somehow. (lambda (_prompt) (copy-sequence user-password))) (step (sasl-next-step client nil)) - (_tag (sieve-manage-send - (concat - "AUTHENTICATE \"" - mech - "\"" + (_tag (sieve-manage-send-command + 'AUTHENTICATE + (cons 'quoted mech) (and (sasl-step-data step) - (concat - " \"" - (base64-encode-string - (sasl-step-data step) - 'no-line-break) - "\""))))) + (cons 'quoted (base64-encode-string + (sasl-step-data step) + 'no-line-break))))) data rsp) (catch 'done (while t @@ -375,24 +506,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) + "")))))))) (defun sieve-manage-cram-md5-p (buffer) (sieve-manage-capability "SASL" "CRAM-MD5" buffer)) @@ -471,7 +601,7 @@ sieve-manage-open (setq sieve-manage-auth auth) (cl-return))) (unless sieve-manage-auth - (sieve-manage--error + (sieve-manage--error 'sieve-manage-client-error "Couldn't figure out authenticator for server"))) (sieve-manage-erase) (current-buffer)))) @@ -496,12 +626,21 @@ sieve-manage-opened (and sieve-manage-process (memq (process-status sieve-manage-process) '(open run)))))) +(defun sieve-manage--check-script-name (cmd name) + "Check for script NAME for CMD. +Signals an error for unsupported names." + (when (and (not (eq 'SETACTIVE cmd)) + (string-empty-p name)) + (sieve-manage--error 'sieve-manage-client-error + "%s script name cannot be empty" cmd)) + t) + (defun sieve-manage-close (&optional buffer) "Close connection to managesieve server in BUFFER. 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))) @@ -525,41 +664,73 @@ sieve-manage-capability server-value))))) (defun sieve-manage-listscripts (&optional buffer) + "Send LISTSCRIPTS command to download list of available scripts. +BUFFER is the \\='sieve-manage\\=' process buffer (default: \\='(current-buffer)\\=')." (with-current-buffer (or buffer (current-buffer)) - (sieve-manage-send "LISTSCRIPTS") + (sieve-manage-send-command 'LISTSCRIPTS) (sieve-manage-parse-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-oknobye))) + "Send HAVESPACE command for script NAME and SIZE. +BUFFER is the \\='sieve-manage\\=' process buffer (default: \\='(current-buffer)\\=')." + (let ((cmd 'HAVESPACE)) + (sieve-manage--check-script-name cmd name) + (with-current-buffer (or buffer (current-buffer)) + (sieve-manage-send-command cmd name size) + (sieve-manage-parse-oknobye)))) (defun sieve-manage-putscript (name script-buffer &optional buffer) - (with-current-buffer (or buffer (current-buffer)) - (sieve-manage-send (format "PUTSCRIPT \"%s\"" name) script-buffer) - (sieve-manage-parse-oknobye))) + "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 +\\='utf-8-unix, \\='utf-8-dos or \\='utf-8-mac. +BUFFER is the \\='sieve-manage\\=' process buffer (default: \\='(current-buffer)\\=')." + (let ((cmd 'PUTSCRIPT)) + (sieve-manage--check-script-name cmd name) + (with-current-buffer (or buffer (current-buffer)) + (sieve-manage-send-command cmd name script-buffer) + (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-oknobye))) - -(defun sieve-manage-getscript (name output-buffer &optional buffer) - (with-current-buffer (or buffer (current-buffer)) - (sieve-manage-send (format "GETSCRIPT \"%s\"" name)) - (sieve-manage-decode (sieve-manage-parse-string) - output-buffer) - (sieve-manage-parse-crlf) - (sieve-manage-parse-oknobye))) + "Send DELETESCRIPT command to delete script named NAME. +BUFFER is the \\='sieve-manage\\=' process buffer (default: \\='(current-buffer)\\=')." + (let ((cmd 'DELETESCRIPT)) + (sieve-manage--check-script-name cmd name) + (with-current-buffer (or buffer (current-buffer)) + (sieve-manage-send-command cmd name) + (sieve-manage-parse-oknobye)))) + +(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 \\='eol-type\\=' 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 \\='utf-8\\=' variant with the detected \\='eol-type\\='. +BUFFER is the \\='sieve-manage\\=' process buffer (default: \\='(current-buffer)\\=')." + (let ((cmd 'GETSCRIPT)) + (sieve-manage--check-script-name cmd name) + (with-current-buffer (or buffer (current-buffer)) + (sieve-manage-send-command cmd name) + (sieve-manage-decode (sieve-manage-parse-string) + script-buffer) + (sieve-manage-parse-crlf) + (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-oknobye))) + "Send SETACTIVE command to activate script named NAME. +Use an empty NAME to deactivate/disable any active script. +BUFFER is the \\='sieve-manage\\=' process buffer (default: \\='(current-buffer)\\=')." + (let ((cmd 'SETACTIVE)) + (sieve-manage--check-script-name cmd name) + (with-current-buffer (or buffer (current-buffer)) + (sieve-manage-send-command cmd name) + (sieve-manage-parse-oknobye)))) ;; Protocol parsing routines (defun sieve-manage-regexp-oknobye () - "Return regexp for managesieve 'response-oknobye'." + "Return regexp for managesieve \\='response-oknobye\\'." (concat "^\\(OK\\|NO\\|BYE\\)\\( (\\([^)]+\\))\\)?\\( \\(.*\\)\\)?" sieve-manage-server-eol)) @@ -633,9 +804,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)) @@ -666,28 +838,36 @@ sieve-manage-parse-listscripts data rsp))) -(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) - sieve-manage-client-eol - encoded))) - (setq cmdstr (concat (sieve-manage--convert-multibyte 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))) diff --git a/test/lisp/net/sieve-manage-tests.el b/test/lisp/net/sieve-manage-tests.el index 010c9071608..e58854ff6b0 100644 --- a/test/lisp/net/sieve-manage-tests.el +++ b/test/lisp/net/sieve-manage-tests.el @@ -26,79 +26,283 @@ (require 'ert) (require 'sieve-manage) -(defvar sieve-script-multibyte-unix +;;; test data + +(defvar smt/script-multibyte-unix "if body :matches \"ä\" { stop; }\n" - "Simple multibyte sieve script.") + "Simple multibyte sieve script with unix EOL.") + +(defvar smt/script-multibyte-dos + "if body :matches \"ä\" { stop; }\r\n" + "Simple multibyte sieve script with dos EOL.") + +(defvar smt/script-multibyte-mac + "if body :matches \"ä\" { 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 "äöüßÄÖÜ" + "Multibyte sieve string.") + +(defvar smt/script-name-unibyte "abcdefg.sieve" + "Unibyte sieve script name.") -(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-multibyte "äöüßÄÖÜ.sieve" + "Multibyte sieve script name.") -(defun mk-rsp-oknobye (type &optional resp-code string) +;;; 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.") -(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 \\='response-getscript\\='." + (concat (smt/mk-literal-s2c script) "\r\n" - (mk-rsp-oknobye 'OK "Getscript completed."))) -;; (mk-rsp-getscript-ok sieve-script-multibyte-unix) + (smt/mk-rsp-oknobye 'OK "Getscript completed."))) +;; (smt/mk-rsp-getscript-ok smt/script-multibyte-unix) -(defun managesieve-getscript (script) - "Simulate managesieve getscript response to test -`sieve-manage-getscript' function." +(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 `ä` - (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)))) - -(ert-deftest ert/managesieve-getscript-multibyte () - (should (string= sieve-script-multibyte-unix - (managesieve-getscript sieve-script-multibyte-unix)))) + (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 smt/sieve-manage--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 (string-equal (format "\"%s\"" smt/script-name-unibyte) + (sieve-manage--mk-quoted smt/script-name-unibyte))) + (should (string-equal "\"\"" + (sieve-manage--mk-quoted "")))) + +(ert-deftest smt/sieve-manage--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 (string-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 (string-equal "{0+}\r\n" + (sieve-manage--mk-literal-c2s "")))) + +(ert-deftest smt/sieve-manage--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 (string-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 (string-equal "{0}\r\n" + (sieve-manage--mk-literal-s2c "")))) + +(ert-deftest smt/sieve-manage-encode () + ;;; unsupported data types + (should-error + ;; RFC5804 doesn't support negative numbers + (sieve-manage-encode -1) :type 'sieve-manage-encode-error) + + ;;; symbol (supported) commands + (should-error (sieve-manage-encode nil) + :type 'sieve-manage-unsupported-cmd) + (should-error (sieve-manage-encode t) + :type 'sieve-manage-unsupported-cmd) + (should-error (sieve-manage-encode 'CHECKSCRIPT) + :type 'sieve-manage-unsupported-cmd) + (should (sieve-manage-encode 'LISTSCRIPTS)) + + ;;; number [0..4294967296] + (should (string-equal (format "%d" 0) (sieve-manage-encode 0))) + (should (string-equal (format "%d" 255) (sieve-manage-encode 255))) + (should (string-equal (format "%d" 4294967296) + (sieve-manage-encode 4294967296))) + + ;;; (simple) string + (should (string-equal (format "\"%s\"" smt/script-name-unibyte) + (sieve-manage-encode smt/script-name-unibyte))) + (should (string-equal (format "\"%s\"" (encode-coding-string + smt/script-name-multibyte + 'utf-8-unix)) + (sieve-manage-encode smt/script-name-multibyte))) + + ;;; TODO: (number . ) + + ;;; TODO: (cmd-name . ) + + ;;; (quoted/literal-c2s/literal-s2c . ) + ;; 'quoted + (should (string-equal "\"\"" (sieve-manage-encode (cons 'quoted "")))) + (should (string-equal (format "\"%s\"" smt/script-name-unibyte) + (sieve-manage-encode + (cons 'quoted smt/script-name-unibyte)))) + + ;; 'literal-c2s + (should (string-equal "{0+}\r\n" + (sieve-manage-encode (cons 'literal-c2s "")))) + (should (string-equal (format "{%d+}\r\n%s" + (length smt/script-name-unibyte) + smt/script-name-unibyte) + (sieve-manage-encode + (cons 'literal-c2s smt/script-name-unibyte)))) + + ;; 'literal-s2c + (should (string-equal "{0}\r\n" + (sieve-manage-encode (cons 'literal-s2c "")))) + (should (string-equal (format "{%d}\r\n%s" + (length smt/script-name-unibyte) + smt/script-name-unibyte) + (sieve-manage-encode + (cons 'literal-s2c smt/script-name-unibyte)))) + + ;;; TODO: (mb-quoted/mb-literal-c2s/mb-literal-s2c . ) + ) + + +(ert-deftest smt/sieve-manage--detect-buffer-coding-system () + ;; TODO + ) + + +(ert-deftest smt/sieve-manage-decode () + ;; TODO + ) + + +(ert-deftest smt/sieve-sasl-auth () + ;; TODO + ) + + +(ert-deftest smt/sieve-manage-authenticate () + ;; TODO + ) + + +;; TODO: check which sieve-manage-parse-... functions can be tested + + +(ert-deftest smt/sieve-manage-is-string () + ;; TODO + ) + + +(ert-deftest smt/sieve-manage--check-script-name () + (should-error (sieve-manage--check-script-name 'PUTSCRIPT "") + :type 'sieve-manage-client-error) + (should (sieve-manage--check-script-name 'SETACTIVE ""))) + + +(ert-deftest smt/managesieve-authenticate () + ;; TODO + ) + + +(ert-deftest smt/managesieve-listscripts () + ;; TODO + ) + + +(ert-deftest smt/managesieve-havespace () + ;; TODO + ) + + +(ert-deftest smt/managesieve-putscript () + ;; TODO + ) + + +(ert-deftest smt/managesieve-deletescript () + ;; TODO + ) + + +(ert-deftest smt/managesieve-getscript () + (let ((ret (smt/managesieve-getscript smt/script-multibyte-unix))) + (should (string= smt/script-multibyte-unix (car ret))) + (should (eq 'utf-8-unix (cdr ret)))) + (let ((ret (smt/managesieve-getscript smt/script-multibyte-dos))) + (should (string= smt/script-multibyte-unix (car ret))) + (should (eq 'utf-8-dos (cdr ret)))) + (let ((ret (smt/managesieve-getscript smt/script-multibyte-mac))) + (should (string= smt/script-multibyte-unix (car ret))) + (should (eq 'utf-8-mac (cdr ret)))) + ) + + +(ert-deftest smt/managesieve-setactive () + ;; TODO + ) ;;; sieve-manage-tests.el ends here -- 2.39.0