emacs-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: Request for advice on GNUS internals. GSSAPI progress report


From: Elias Mårtenson
Subject: Re: Request for advice on GNUS internals. GSSAPI progress report
Date: Thu, 16 Feb 2017 18:17:51 +0800

I am now able to read my email using a GSSAPI-authenticated connection.

If anyone is willing to try it, build the native module here: https://github.com/lokedhs/emacs-gssapi

Then apply the below patch to nnimap.el. To enable the use of GSSAPI for authentication, set ‘nnimap-authenticator’ to ‘gssapi’.

Regards,
Elias

*** /home/emartenson/src/emacs/lisp/gnus/nnimap.el 2017-01-31 10:04:34.692388829 +0800
--- /usr/local/share/emacs/26.0.50/lisp/gnus/nnimap.el 2017-02-16 18:08:44.883875947 +0800
***************
*** 331,336 ****
--- 331,337 ----
      (set (make-local-variable 'nnimap-object)
  (make-nnimap :server (nnoo-current-server 'nnimap)
       :initial-resync 0))
+     (set (make-local-variable 'nnimap-send-string-function) 'nnimap--unencoded-send-string-to-server)
      (push (list buffer (current-buffer)) nnimap-connection-alist)
      (push (current-buffer) nnimap-process-buffers)
      (current-buffer)))
***************
*** 513,520 ****
--- 514,652 ----
  
  (autoload 'rfc2104-hash "rfc2104")
  
+ (defun nnimap--send-string-to-server (string)
+   (message "Sending string using %S: %S" nnimap-send-string-function string)
+   (funcall nnimap-send-string-function string))
+ (defun nnimap--unencoded-send-string-to-server (string)
+   (process-send-string (get-buffer-process (current-buffer)) string))
+ (defun nnimap--gss-send-string-to-server (string)
+   (cond ((eq nnimap-gss-protection-type :none)
+          (nnimap--unencoded-send-string-to-server string))
+         (t
+          ;; TODO: We should check the maximum block size here.
+          (destructuring-bind (encoded conf)
+              (gss-wrap nnimap-gss-context string :conf (eq nnimap-gss-protection-type :priv))
+            (let ((size (length encoded)))
+              (nnimap--unencoded-send-string-to-server (format "%c%c%c%c%s"
+                                                               (logand (ash size -24) #xff)
+                                                               (logand (ash size -16) #xff)
+                                                               (logand (ash size -8) #xff)
+                                                               (logand size #xff)
+                                                               encoded)))))))
+ (defun nnimap--gss-read-filter (proc string)
+   (message "Read block using type %S: %S" nnimap-gss-protection-type string)
+   (cond ((eq nnimap-gss-protection-type :none)
+          (internal-default-process-filter proc string))
+         (t
+          ;; TODO: This function is currently unimplemented. Although
+          ;; its implementation isn't particularly complicated, I've
+          ;; left it blank for now since I don't have access to a mail
+          ;; server which uses wrapped streams.
+          ;;
+          ;; Implementing this should be reasonably simple. ‘string’
+          ;; contains a sequence of bytes that has been received from
+          ;; the IMAP server. The first 4 bytes of the stream is the
+          ;; length of the packet in network byte-order. The bytes in
+          ;; the packet should be passed to ‘gss-unwrap’. The ‘:conf’
+          ;; parameter to this call should be nil if
+          ;; ‘nnimap-gss-protection-type’ is ‘:integ’ or t if it is
+          ;; ‘:priv’. The resulting string should then be passed to
+          ;; ‘internal-default-process-filter’ in a similar way as what
+          ;; is done in the non-encrypted case.
+          (error "Wrapped streams are not implemented. Please see comments in the function ‘nnimap--gss-read-filter’"))))
+ (defun nnimap--strip-cr (string)
+   (let ((length (length string)))
+     (if (and (plusp length)
+              (eql (aref string (1- length)) ?\r))
+         (subseq string 0 (1- length))
+       string)))
+ (defun nnimap--decode-token (decrypted)
+   ;; The first octet is the bitmask
+   (let ((flags (aref decrypted 0))
+         (max-message-size (logior (ash (aref decrypted 1) 16)
+                                   (ash (aref decrypted 2) 8)
+                                   (aref decrypted 3))))
+     (list flags max-message-size)))
+ ;;; GSSAPI authentication documented at: https://tools.ietf.org/html/rfc1731
+ (defun nnimap-auth-gssapi (user)
+   (require 'gss)
+   (let ((sequence (nnimap-send-command "AUTHENTICATE GSSAPI")))
+     (let ((resp (nnimap--strip-cr (nnimap-wait-for-line "^\\+\\(.*\\)\n"))))
+       (assert (equal resp ""))
+       (let ((context nil))
+         (loop with authenticated-p = nil
+               with input-token = nil
+               with name = (gss-make-name (format "address@hidden" (downcase nnimap-address)))
+               while (not authenticated-p)
+               do (erase-buffer)
+               do (multiple-value-bind (continue-needed context-result token flags)
+                      (gss-init-sec-context name :context context :input-token input-token :flags '(:replay :conf :integ :mutual))
+                    (setq context context-result)
+                    (if token
+                        (nnimap--send-string-to-server (concat (base64-encode-string token) "\r\n"))
+                      ;; ELSE: The spec says that if there is no output token, there should be a response with no data
+                      (nnimap--send-string-to-server "\r\n"))
+                    (if continue-needed
+                        (let ((server-message (nnimap-wait-for-line "^\\+\\(.*\\)\n")))
+                          (setq input-token (base64-decode-string server-message)))
+                      ;; ELSE: We now have a valid context
+                      (setq authenticated-p t))))
+         ;; After initial GSS handshake, the server is expected to send a blank response.
+         (let ((token (nnimap-wait-for-line "^\\+\\(.*\\)\n")))
+           (destructuring-bind (decrypted conf-p)
+               (gss-unwrap context (base64-decode-string token))
+             (destructuring-bind (flags max-server-size)
+                 (nnimap--decode-token decrypted)
+               ;; Select the strictest protection mechanism that the
+               ;; server supports.
+               (let ((protection-type (cond ((not (zerop (logand flags #x4)))
+                                             :priv)
+                                            ((not (zerop (logand flags #x2)))
+                                             :integ)
+                                            ((not (zerop (logand flags #x1)))
+                                             :none)
+                                            (t
+                                             (error "Unsupported privacy type: %d" flags)))))
+                 ;; I don't know what the actual max message size should
+                 ;; be, so for now let's just use whatever the server is
+                 ;; using.
+                 (let* ((max-client-size max-server-size))
+                   (erase-buffer)
+                   (destructuring-bind (encoded conf)
+                       (gss-wrap context (format "%c%c%c%c%s"
+                                                 (ecase protection-type
+                                                   (:priv #x4)
+                                                   (:integ #x2)
+                                                   (:none #x1))
+                                                 (logand (ash max-client-size -16) #xff)
+                                                 (logand (ash max-client-size -8) #xff)
+                                                 (logand max-client-size #xff)
+                                                 user))
+                     (nnimap--send-string-to-server (concat (base64-encode-string encoded) "\r\n")))
+                   (nnimap-wait-for-response sequence "OK")
+                   (cond ((equal (caar (nnimap-get-response sequence)) "OK")
+                          (setq-local nnimap-gss-context context)
+                          (setq-local nnimap-gss-expected-size nil)
+                          (setq-local nnimap-gss-read-buf "")
+                          (setq-local nnimap-gss-protection-type protection-type)
+                          (setq-local nnimap-send-string-function #'nnimap--gss-send-string-to-server)
+                          (set-process-filter (get-buffer-process (current-buffer)) #'nnimap--gss-read-filter)
+                          (cons user nil))
+                         (t
+                          (error "Authentication error"))))))))))))
  (defun nnimap-login (user password)
+   (set-process-filter (get-buffer-process (current-buffer)) (lambda (proc string) (message "Input: %S" string) (insert string)))
    (cond
+    ((and (nnimap-capability "AUTH=GSSAPI")
+          (eq nnimap-authenticator 'gssapi))
+     (nnimap-auth-gssapi user))
     ;; Prefer plain LOGIN if it's enabled (since it requires fewer
     ;; round trips than CRAM-MD5, and it's less likely to be buggy),
     ;; and we're using an encrypted connection.
***************
*** 529,536 ****
      (erase-buffer)
      (let ((sequence (nnimap-send-command "AUTHENTICATE CRAM-MD5"))
   (challenge (nnimap-wait-for-line "^\\+\\(.*\\)\n")))
!       (process-send-string
!        (get-buffer-process (current-buffer))
         (concat
  (base64-encode-string
  (concat user " "
--- 661,667 ----
      (erase-buffer)
      (let ((sequence (nnimap-send-command "AUTHENTICATE CRAM-MD5"))
   (challenge (nnimap-wait-for-line "^\\+\\(.*\\)\n")))
!       (nnimap--send-string-to-server
         (concat
  (base64-encode-string
  (concat user " "
***************
*** 1192,1202 ****
   (length message)))
   (unless nnimap-streaming
     (nnimap-wait-for-connection "^[+]"))
!  (process-send-string (get-buffer-process (current-buffer)) message)
!  (process-send-string (get-buffer-process (current-buffer))
!       (if (nnimap-newlinep nnimap-object)
!   "\n"
! "\r\n"))
   (let ((result (nnimap-get-response sequence)))
     (if (not (nnimap-ok-p result))
  (progn
--- 1323,1332 ----
   (length message)))
   (unless nnimap-streaming
     (nnimap-wait-for-connection "^[+]"))
!  (nnimap--send-string-to-server message)
!  (nnimap--send-string-to-server (if (nnimap-newlinep nnimap-object)
!                                              "\n"
!                                            "\r\n"))
   (let ((result (nnimap-get-response sequence)))
     (if (not (nnimap-ok-p result))
  (progn
***************
*** 1864,1871 ****
  
  (defun nnimap-send-command (&rest args)
    (setf (nnimap-last-command-time nnimap-object) (current-time))
!   (process-send-string
!    (get-buffer-process (current-buffer))
     (nnimap-log-command
      (format "%d %s%s\n"
     (incf nnimap-sequence)
--- 1994,2000 ----
  
  (defun nnimap-send-command (&rest args)
    (setf (nnimap-last-command-time nnimap-object) (current-time))
!   (nnimap--send-string-to-server
     (nnimap-log-command
      (format "%d %s%s\n"
     (incf nnimap-sequence)


On 15 February 2017 at 18:13, Elias Mårtenson <address@hidden> wrote:
On 15 February 2017 at 12:37, Elias Mårtenson <address@hidden> wrote:

What approach should I take here?

I have come up with a solution that uses a process filter to deal with this. It probably works, but I can't really test it since my server doesn't use GSS encryption, only the authentication part.

Other than that, it seems to work now, and I'm working on cleaning up the code.

Regards,
Elias 


reply via email to

[Prev in Thread] Current Thread [Next in Thread]