Re: gssapi authentication for nnimap

[Jochen Hein <jochen@jochen.org>]

Lars Ingebrigtsen <larsi@gnus.org> writes:

> No, open-protocol-stream shouldn't know anything about nnimap.

Maybe, I'm not sure.  First, I've been confused, because my changes to
lisp/proto-stream.el didn't have an effect - I still got the message
"Invalid connection type".  Gnus uses the function as defined in
network-stream.el from Emacs24.  The file proto-stream.el should be
deleted while removing compat stuff :-)

Iff we want to add connection type 'gssapi to open-network-stream we
need to handle the username somehow.  gssapi.el execpts to get the
username, but gsasl and imtest work without the name:

$ imtest -m gssapi -p imap imap.jochen.org
...
Authenticated.
...

Feb 10 22:08:06 jupiter imap[6255]: login: [...] jochen@jochen.org GSSAPI User logged in

For my usage that would work - I have no idea if we really need to
handle different usernames on the Gnus host and the IMAP host when using
GSSAPI.  We may want to decide that this case will be handled when a
user requests it :-)

So one way forward might be to change the commands in gssapi.el
(untested, I didn't make any changes to open-network-stream yet):

--- gssapi.el.orig	2016-02-10 22:11:24.000000000 +0100
+++ gssapi.el	2016-02-10 22:13:28.000000000 +0100
@@ -29,19 +29,18 @@
 
 (defcustom gssapi-program (list
 			   (concat "gsasl %s %p "
-				   "--mechanism GSSAPI "
-				   "--authentication-id %l")
-			   "imtest -m gssapi -u %l -p %p %s")
+				   "--mechanism GSSAPI ")
+			   "imtest -m gssapi -p %p %s")
   "List of strings containing commands for GSSAPI (krb5) authentication.
-%s is replaced with server hostname, %p with port to connect to,
-and %l with the user name.  The program should accept commands on
+%s is replaced with server hostname and %p with port to connect to.
+The program should accept commands on
 stdin and return responses to stdout.  Each entry in the list is
 tried until a successful connection is made."
   :version "24.1"
   :group 'network
   :type '(repeat string))
 
-(defun open-gssapi-stream (name buffer server port user)
+(defun open-gssapi-stream (name buffer server port)
   (let ((cmds gssapi-program)
 	cmd done)
     (with-current-buffer buffer
@@ -57,8 +56,7 @@
 			  cmd
 			  (format-spec-make
 			   ?s server
-			   ?p (number-to-string port)
-			   ?l user))))
+			   ?p (number-to-string port)))))
 	       response)
 	  (when process
 	    (while (and (memq (process-status process) '(open run))

The other option I see is to add an additional parameter to
open-network-stream for usage with type 'gssapi, something like the
following (patch will not work - must patch network-stream.el from emacs):

diff --git a/lisp/proto-stream.el b/lisp/proto-stream.el
index 11ffd0c..a059b0b 100644
--- a/lisp/proto-stream.el
+++ b/lisp/proto-stream.el
@@ -50,6 +50,7 @@
 
 (require 'tls)
 (require 'starttls)
+(require 'gssapi)
 
 (autoload 'gnutls-negotiate "gnutls")
 (autoload 'open-gnutls-stream "gnutls")
@@ -80,6 +81,9 @@ PARAMETERS should be a sequence of keywords and values:
   `tls'      -- A TLS connection.
   `ssl'      -- Equivalent to `tls'.
   `shell'    -- A shell connection.
+  `gssapi'   -- a GSSAPI connection.
+
+:gssapi-user specifies the username for GSSAPI authentication.
 
 :return-list specifies this function's return value.
   If omitted or nil, return a process object.  A non-nil means to
@@ -129,9 +137,12 @@ PARAMETERS should be a sequence of keywords and values:
 		'proto-stream-open-starttls)
 	       ((memq type '(tls ssl)) 'proto-stream-open-tls)
 	       ((eq type 'shell) 'proto-stream-open-shell)
-	       (t (error "Invalid connection type %s" type))))
+	       ((eq type "gssapi") 'proto-stream-open-gssapi)
+	       (t (error "Invalid x connection type %s" type))))
 	     (result (funcall connection-function
 			      name buffer host service parameters)))
 	(if return-list
 	    (list (car result)
 		  :greeting     (nth 1 result)
@@ -148,6 +159,26 @@ PARAMETERS should be a sequence of keywords and values:
 	  nil
 	  'plain)))
 
+(defun proto-stream-open-gssapi (name buffer host service parameters)
+  (let* ((start (with-current-buffer buffer (point)))
+	 (gssapi-user         (plist-get parameters :gssapi-user))
+	 (capability-command  (plist-get parameters :capability-command))
+	 (eoc                 (plist-get parameters :end-of-command))
+ 	 (eo-capa             (or (plist-get parameters :end-of-capability)
+ 				 eoc))
+	 (stream (open-gssapi-stream name buffer host service gssapi-user)))
+	 (greeting (proto-stream-get-response stream start eoc))
+	 (capabilities (when capability-command
+			 (proto-stream-command stream
+					       capability-command
+					       (or eo-capa eoc))))
+    (list stream
+	  (proto-stream-get-response stream start
+				     (plist-get parameters :end-of-command))
+	  greeting
+	  capabitilies
+	  'gssapi)))
+
 (defun proto-stream-open-starttls (name buffer host service parameters)
   (let* ((start (with-current-buffer buffer (point)))
 	 (require-tls    (eq (plist-get parameters :type) 'starttls))


>
>> +	(let* ((stream-list
>> +		(if (eq nnimap-stream 'gssapi)
>> +		     (list (open-gssapi-stream
>> +		      "*nnimap*" (current-buffer) nnimap-address
>> +		      (nnimap-map-port (car ports)) nnimap-user))
>
> That looks OK...

Here's my minimal and working diff (with fake greeting/capabilities),
the commented hunk was a try to fake gssapi with connection-type 'shell.
The fake was successful for a GSSAPI user, but I failed to run the same
code for a normal mailbox - I guess my lisp skill needs some help...:

diff --git a/lisp/gssapi.el b/lisp/gssapi.el
index 1f72805..ae4fefa 100644
--- a/lisp/gssapi.el
+++ b/lisp/gssapi.el
@@ -92,7 +92,7 @@ tried until a successful connection is made."
 				  (setq response (match-string 1)))))
 	      (accept-process-output process 1)
 	      (sit-for 1))
-	    (erase-buffer)
+	    ;(erase-buffer)
 	    (message "GSSAPI connection: %s" (or response "failed"))
 	    (if (and response (let ((case-fold-search nil))
 				(not (string-match "failed" response))))
diff --git a/lisp/nnimap.el b/lisp/nnimap.el
index 05251ed..facb36c 100644
--- a/lisp/nnimap.el
+++ b/lisp/nnimap.el
@@ -65,7 +65,7 @@ it will default to `imap'.")
 (defvoo nnimap-stream 'undecided
   "How nnimap talks to the IMAP server.
 The value should be either `undecided', `ssl' or `tls',
-`network', `starttls', `plain', or `shell'.
+`network', `starttls', `plain', `gssapi', or `shell'.
 
 If the value is `undecided', nnimap tries `ssl' first, then falls
 back on `network'.")
@@ -408,6 +408,10 @@ textual parts.")
 	      (nnheader-message 7 "Opening connection to %s via shell..."
 				nnimap-address)
 	      '("imap"))
+	     ((eq nnimap-stream 'gssapi)
+	      (nnheader-message 7 "Opening connection to %s via GSSAPI..."
+				nnimap-address)
+	      '(143))
 	     ((memq nnimap-stream '(ssl tls))
 	      (nnheader-message 7 "Opening connection to %s via tls..."
 				nnimap-address)
@@ -417,7 +421,19 @@ textual parts.")
            login-result credentials)
       (when nnimap-server-port
 	(push nnimap-server-port ports))
+
+;      (setq nnimap-auth (eq nnimap-stream 'gssapi))
+;      (if (eq nnimap-stream 'gssapi)
+;	  (let ((nnimap-stream   'shell)
+;		 (nnimap-auth     'gssapi)
+;		 (nnimap-shell-command "gsasl %s %p --mechanism=GSSAPI --authentication-id=%l"))))
+
       (let* ((stream-list
+		(if (eq nnimap-stream 'gssapi)
+		    (list (open-gssapi-stream "*nnimap*" (current-buffer) nnimap-address
+		      (nnimap-map-port (car ports)) nnimap-user)
+			   :greeting "* OK [CAPABILITY IMAP4rev1 LITERAL+ ID ENABLE STARTTLS LOGINDISABLED AUTH=GSSAPI SASL-IR] jupiter.jochen.org Cyrus IMAP git2.5+0-ebian-2.5~dev2015021301-0~kolab2 server ready"
+			   :capabilities ". OK [CAPABILITY IMAP4rev1 LITERAL+ ID ENABLE ACL RIGHTS=kxten QUOTA MAILBOX-REFERRALS NAMESPACE UIDPLUS NO_ATOMIC_RENAME UNSELECT CHILDREN MULTIAPPEND BINARY CATENATE CONDSTORE ESEARCH SORT SORT=MODSEQ SORT=DISPLAY SORT=UID THREAD=ORDEREDSUBJECT THREAD=REFERENCES ANNOTATEMORE ANNOTATE-EXPERIMENT-1 METADATA LIST-EXTENDED LIST-STATUS LIST-MYRIGHTS WITHIN QRESYNC SCAN XLIST XMOVE MOVE SPECIAL-USE CREATE-SPECIAL-USE URLAUTH URLAUTH=BINARY LOGINDISABLED COMPRESS=DEFLATE X-QUOTA=STORAGE X-QUOTA=MESSAGE X-QUOTA=X-ANNOTATION-STORAGE X-QUOTA=X-NUM-FOLDERS IDLE] Success (tls protection) SESSIONID=<jupiter.jochen.org-13079-1455130571-1-11713551379411196108>")
 	      (open-protocol-stream
 	       "*nnimap*" (current-buffer) nnimap-address
 	       (nnimap-map-port (car ports))
@@ -433,6 +449,7 @@ textual parts.")
 	       (lambda (capabilities)
 		 (when (gnus-string-match-p "STARTTLS" capabilities)
 		   "1 STARTTLS\r\n"))))
+		 			)
 	     (stream (car stream-list))
 	     (props (cdr stream-list))
 	     (greeting (plist-get props :greeting))
@@ -463,7 +480,9 @@ textual parts.")
 	    (setf (nnimap-capabilities nnimap-object)
 		  (mapcar #'upcase
 			  (split-string capabilities)))
-	    (unless (gnus-string-match-p "[*.] PREAUTH" greeting)
+	    (unless (or
+			(eq nnimap-stream 'gssapi)
+			(gnus-string-match-p "[*.] PREAUTH" greeting))
 	      (if (not (setq credentials
 			     (if (eq nnimap-authenticator 'anonymous)
 				 (list "anonymous"

> open-protocol-stream returns the greetings and the capabilities, but
> open-gssapi-stream doesn't do that.  So perhaps there should be a
> wrapper around the latter function that will save the greeting and issue
> the capability command?

Something like that.  First open-gssapi-stream must not call
erase-buffer, see the patch above.  Now I'm confused how I can transfer
to code from open-network-stream in my code.

Still unsure how to proceed, but quite happy with my success :-)
Hopefully nobody gets confused by my trial and error hacking...

Jochen

-- 
The only problem with troubleshooting is that the trouble shoots back.