lisp/gnus/gssapi.el

   1 ;;; gssapi.el --- GSSAPI/Kerberos 5 interface for Emacs
   2
   3 ;; Copyright (C) 2011-2013 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   :version "24.1"
  41   :group 'network
  42   :type '(repeat string))
  43
  44 (defun open-gssapi-stream (name buffer server port user)
  45   (let ((cmds gssapi-program)
  46         cmd done)
  47     (with-current-buffer buffer
  48       (while (and (not done)
  49                   (setq cmd (pop cmds)))
  50         (message "Opening GSSAPI connection with `%s'..." cmd)
  51         (erase-buffer)
  52         (let* ((coding-system-for-read 'binary)
  53                (coding-system-for-write 'binary)
  54                (process (start-process
  55                          name buffer shell-file-name shell-command-switch
  56                          (format-spec
  57                           cmd
  58                           (format-spec-make
  59                            ?s server
  60                            ?p (number-to-string port)
  61                            ?l user))))
  62                response)
  63           (when process
  64             (while (and (memq (process-status process) '(open run))
  65                         (goto-char (point-min))
  66                         ;; Athena IMTEST can output SSL verify errors
  67                         (or (while (looking-at "^verify error:num=")
  68                               (forward-line))
  69                             t)
  70                         (or (while (looking-at "^TLS connection established")
  71                               (forward-line))
  72                             t)
  73                         ;; cyrus 1.6.x (13? < x <= 22) queries capabilities
  74                         (or (while (looking-at "^C:")
  75                               (forward-line))
  76                             t)
  77                         ;; cyrus 1.6 imtest print "S: " before server greeting
  78                         (or (not (looking-at "S: "))
  79                             (forward-char 3)
  80                             t)
  81                         ;; GNU SASL may print 'Trying ...' first.
  82                         (or (not (looking-at "Trying "))
  83                             (forward-line)
  84                             t)
  85                         (not (and (looking-at "\\* \\(OK\\|PREAUTH\\|BYE\\) ")
  86                                   ;; success in imtest 1.6:
  87                                   (re-search-forward
  88                                    (concat "^\\(\\(Authenticat.*\\)\\|\\("
  89                                            "Client authentication "
  90                                            "finished.*\\)\\)")
  91                                    nil t)
  92                                   (setq response (match-string 1)))))
  93               (accept-process-output process 1)
  94               (sit-for 1))
  95             (erase-buffer)
  96             (message "GSSAPI connection: %s" (or response "failed"))
  97             (if (and response (let ((case-fold-search nil))
  98                                 (not (string-match "failed" response))))
  99                 (setq done process)
 100               (delete-process process)
 101               nil))))
 102       done)))
 103
 104 (provide 'gssapi)
 105
 106 ;;; gssapi.el ends here