lisp/gnus/gssapi.el

   1 ;;; gssapi.el --- GSSAPI/Kerberos 5 interface for Emacs
   2
   3 ;; Copyright (C) 2011-2012 Free Software Foundation, Inc.
   4
   5 ;; Author: Simon Josefsson <simon@josefsson.org>
   6 ;;         Lars Magne Ingebrigtsen <larsi@gnus.org>
   7 ;; Keywords: network
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software: you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation, either version 3 of the License, or
  14 ;; (at your option) any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  23
  24 ;;; Commentary:
  25
  26 ;;; Code:
  27
  28 (require 'format-spec)
  29
  30 (defcustom gssapi-program (list
  31                            (concat "gsasl %s %p "
  32                                    "--mechanism GSSAPI "
  33                                    "--authentication-id %l")
  34                            "imtest -m gssapi -u %l -p %p %s")
  35   "List of strings containing commands for GSSAPI (krb5) authentication.
  36 %s is replaced with server hostname, %p with port to connect to,
  37 and %l with the user name.  The program should accept commands on
  38 stdin and return responses to stdout.  Each entry in the list is
  39 tried until a successful connection is made."
  40   :group 'network
  41   :type '(repeat string))
  42
  43 (defun open-gssapi-stream (name buffer server port user)
  44   (let ((cmds gssapi-program)
  45         cmd done)
  46     (with-current-buffer buffer
  47       (while (and (not done)
  48                   (setq cmd (pop cmds)))
  49         (message "Opening GSSAPI connection with `%s'..." cmd)
  50         (erase-buffer)
  51         (let* ((coding-system-for-read 'binary)
  52                (coding-system-for-write 'binary)
  53                (process (start-process
  54                          name buffer shell-file-name shell-command-switch
  55                          (format-spec
  56                           cmd
  57                           (format-spec-make
  58                            ?s server
  59                            ?p (number-to-string port)
  60                            ?l user))))
  61                response)
  62           (when process
  63             (while (and (memq (process-status process) '(open run))
  64                         (goto-char (point-min))
  65                         ;; Athena IMTEST can output SSL verify errors
  66                         (or (while (looking-at "^verify error:num=")
  67                               (forward-line))
  68                             t)
  69                         (or (while (looking-at "^TLS connection established")
  70                               (forward-line))
  71                             t)
  72                         ;; cyrus 1.6.x (13? < x <= 22) queries capabilities
  73                         (or (while (looking-at "^C:")
  74                               (forward-line))
  75                             t)
  76                         ;; cyrus 1.6 imtest print "S: " before server greeting
  77                         (or (not (looking-at "S: "))
  78                             (forward-char 3)
  79                             t)
  80                         ;; GNU SASL may print 'Trying ...' first.
  81                         (or (not (looking-at "Trying "))
  82                             (forward-line)
  83                             t)
  84                         (not (and (looking-at "\\* \\(OK\\|PREAUTH\\|BYE\\) ")
  85                                   ;; success in imtest 1.6:
  86                                   (re-search-forward
  87                                    (concat "^\\(\\(Authenticat.*\\)\\|\\("
  88                                            "Client authentication "
  89                                            "finished.*\\)\\)")
  90                                    nil t)
  91                                   (setq response (match-string 1)))))
  92               (accept-process-output process 1)
  93               (sit-for 1))
  94             (erase-buffer)
  95             (message "GSSAPI connection: %s" (or response "failed"))
  96             (if (and response (let ((case-fold-search nil))
  97                                 (not (string-match "failed" response))))
  98                 (setq done process)
  99               (delete-process process)
 100               nil))))
 101       done)))
 102
 103 (provide 'gssapi)
 104
 105 ;;; gssapi.el ends here