diff options
author | Ted Zlatanov <tzz@lifelogs.com> | 2017-12-13 23:58:40 -0500 |
---|---|---|
committer | Ted Zlatanov <tzz@lifelogs.com> | 2017-12-13 23:58:40 -0500 |
commit | adebcb647abd82564f0e245974f74f05c9b4cd2e (patch) | |
tree | 183b14151631fd769b9ac79c4a1d6646f62024bd | |
parent | 57e2ca5c504fda014ba1971e850a26ef001a7bfd (diff) | |
download | emacs-scratch/tzz/gnus-cloud-aead.tar.gz |
WIP: gnus-cloud: add native AEAD encryptionscratch/tzz/gnus-cloud-aead
-rw-r--r-- | lisp/gnus/gnus-cloud.el | 137 |
1 files changed, 136 insertions, 1 deletions
diff --git a/lisp/gnus/gnus-cloud.el b/lisp/gnus/gnus-cloud.el index f3acd9e4c53..3801db89cec 100644 --- a/lisp/gnus/gnus-cloud.el +++ b/lisp/gnus/gnus-cloud.el @@ -27,6 +27,7 @@ (eval-when-compile (require 'cl)) (require 'parse-time) (require 'nnimap) +(require 'hex-util) (eval-when-compile (require 'epg)) ;; setf-method for `epg-context-armor' (autoload 'epg-make-context "epg") @@ -55,7 +56,8 @@ :type '(radio (const :tag "No encoding" nil) (const :tag "Base64" base64) (const :tag "Base64+gzip" base64-gzip) - (const :tag "EPG" epg))) + (const :tag "EPG" epg) + (const :tag "GnuTLS AEAD cipher" 'gnutls-aead-user)) (defcustom gnus-cloud-interactive t "Whether Gnus Cloud changes should be confirmed." @@ -63,6 +65,7 @@ :type 'boolean) (defvar gnus-cloud-group-name "Emacs-Cloud") +(defvar gnus-cloud-AEAD-auth "gnus-cloud auth") (defvar gnus-cloud-covered-servers nil) (defvar gnus-cloud-version 1) @@ -109,6 +112,23 @@ easy interactive way to set this from the Server buffer." (gnus-cloud-encode-data) (buffer-string))) +;; TODO: replace with s-pad-right please +(defun gnus-cloud-pad-right (len padding s) + "If S is shorter than LEN, pad it with PADDING on the right." + (declare (pure t) (side-effect-free t)) + (let ((extra (max 0 (- len (length s))))) + (concat s + (make-string extra (string-to-char padding))))) + +(defun gnus-cloud-pad-buffer-to-multiple (b blocksize) + "Pad buffer B to BLOCKSIZE numeric size and return it." + (let ((e (if (zerop (buffer-size b)) + blocksize + (* blocksize (ceiling (buffer-size b) blocksize))))) + (goto-char (point-max)) + (insert (make-string (- e (buffer-size b)) 0))) + b) + (defun gnus-cloud-encode-data () (cond ((eq gnus-cloud-storage-method 'base64-gzip) @@ -133,6 +153,53 @@ easy interactive way to set this from the Server buffer." nil))) (delete-region (point-min) (point-max)) (insert data)))) + ((eq gnus-cloud-storage-method 'gnutls-aead-user) + ;; TODO: factor this out into an external library + (if (memq 'AEAD-ciphers (gnutls-available-p)) + (let* ((input (current-buffer)) + (auth gnus-cloud-AEAD-auth) + (ciphers (remove-if-not + (lambda (c) (plist-get (cdr c) :cipher-aead-capable)) + (gnutls-ciphers))) + (cipher (completing-read "Select a GnuTLS AEAD cipher" + ciphers nil t)) + (cipher (and cipher (assq (intern cipher) ciphers)))) + (when cipher + (let* ((cname (car cipher)) + (cdata (cdr cipher)) + (keysize (plist-get cdata :cipher-keysize)) + (ivsize (plist-get cdata :cipher-ivsize)) + (iv (list 'iv-auto ivsize)) + (blocksize (plist-get cdata :cipher-blocksize)) + (passwd-prompt + (format "Enter encryption key (max %s): " keysize)) + ;; TODO: add check function to read-passwd for min/max etc + (key (read-passwd passwd-prompt))) + (if (and key (<= (length key) keysize)) + (let* ((key (gnus-cloud-pad-right keysize "\000" key)) + (payload-length (buffer-size input)) + (input (gnus-cloud-pad-buffer-to-multiple + input blocksize)) + (output (gnutls-symmetric-encrypt + cdata key iv input auth)) + (data (nth 0 output)) + (actual-iv (encode-hex-string (nth 1 output))) + (ep (append cipher + (list + :payload-length payload-length + :data-length (length data) + :iv actual-iv)))) + (delete-region (point-min) (point-max)) + (insert data) + (let* ((encoded-length (base64-encode-region + (point-min) (point-max))) + (ep (append ep + (list :encoded-length encoded-length)))) + (goto-char (point-min)) + (insert (format "Gnus-Cloud-Encryption %S\n\n" ep)))) + (error "Sorry, the encryption key was invalid")) + (clear-string key)))) + (error "Sorry, the available GnuTLS ciphers do not include AEAD"))) ((null gnus-cloud-storage-method) (gnus-message 5 "Leaving cloud data plaintext")) @@ -157,6 +224,74 @@ easy interactive way to set this from the Server buffer." (delete-region (point-min) (point-max)) (insert data))) + ((eq gnus-cloud-storage-method 'gnutls-aead-user) + ;; TODO: factor this out into an external library + (if (memq 'AEAD-ciphers (gnutls-available-p)) + (progn + (goto-char (point-min)) + (if (looking-at "Gnus-Cloud-Encryption \\(.+\\)") + (let* ((input (current-buffer)) + (auth gnus-cloud-AEAD-auth) + (encryption-parameter-string (match-string 1)) + (control (read encryption-parameter-string)) + (cipher (assq (car control) (gnutls-ciphers))) + (cname (car cipher)) + (cdata (cdr cipher)) + (ep (cdr control)) + (payload-length (plist-get ep :payload-length)) + (decoded-length (plist-get ep :data-length)) + (encoded-length (plist-get ep :encoded-length)) + (proposed-iv (plist-get ep :iv)) + (iv (and (stringp proposed-iv) + (decode-hex-string proposed-iv)))) + (if (and cipher cname cdata ep iv + (integerp payload-length) + (integerp encoded-length) + (integerp decoded-length)) + (let* ((cname (car cipher)) + (cdata (cdr cipher)) + (keysize (plist-get cdata :cipher-keysize)) + (blocksize (plist-get cdata :cipher-blocksize)) + (passwd-prompt + (format "Enter decryption key (max %s): " keysize)) + ;; TODO: add check function to read-passwd for min/max etc + (key (read-passwd passwd-prompt))) + ;; Advance past the data header and delete it + (forward-line 2) + (delete-region (point-min) (point)) + ;; Delete any trailing data in the buffer + (when (> (buffer-size) encoded-length) + (delete-region (+ (point-min) encoded-length) (point-max))) + + (base64-decode-region (point-min) (point-max)) + (unless (equal (buffer-size) decoded-length) + (error "Sorry, the encrypted data length %d != %d" + (buffer-size) decoded-length)) + + (if (and key (<= (length key) keysize)) + (let* ((key (gnus-cloud-pad-right keysize "\000" key)) + (input (gnus-cloud-pad-buffer-to-multiple + input blocksize)) + ;; TODO: fix docs to note this returns a list + (aead-output (gnutls-symmetric-decrypt + cdata key iv input auth)) + (data (nth 0 aead-output))) + ;; trim the data back to original length + (when (> (length data) payload-length) + (setq data (substring data 0 payload-length))) + + (unless (equal (length data) payload-length) + (error "Sorry, the decrypted data length %d != %d" + (length data) payload-length)) + (delete-region (point-min) (point-max)) + (insert data)) + (error "Sorry, the decryption key was invalid")) + (clear-string key)) + (error "Sorry, invalid decryption parameters %s" + encryption-parameter-string))) + (error "Sorry, there was no valid Gnus-Cloud-Encryption header"))) + (error "Sorry, the available GnuTLS ciphers do not include AEAD"))) + ((null gnus-cloud-storage-method) (gnus-message 5 "Reading cloud data as plaintext")) |