|
22
|
1 ;; -*-Emacs-Lisp-*-
|
|
|
2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
3 ;;
|
|
24
|
4 ;; File: efs-kerberos.el
|
|
22
|
5 ;; Release: $efs release: 1.15 $
|
|
42
|
6 ;; Version: #Revision: 1.0 $
|
|
22
|
7 ;; RCS:
|
|
|
8 ;; Description: Support for Kerberos gateways.
|
|
|
9 ;; Author: Sandy Rutherford <sandy@gandalf.sissa.it>
|
|
|
10 ;; Created: Thu Nov 24 21:19:25 1994 by sandy on gandalf
|
|
|
11 ;; Modified:
|
|
|
12 ;;
|
|
|
13 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
14
|
|
|
15 ;;; Support for the Kerberos gateway authentication system from MIT's
|
|
|
16 ;;; Project Athena.
|
|
|
17
|
|
|
18 (provide 'efs-kerberos)
|
|
|
19 (require 'efs)
|
|
|
20
|
|
|
21 (defconst efs-kerberos-version
|
|
|
22 (concat (substring "$efs release: 1.15 $" 14 -2)
|
|
|
23 "/"
|
|
42
|
24 (substring "#Revision: 1.0 $" 11 -2)))
|
|
22
|
25
|
|
|
26 ;;; Internal Variables
|
|
|
27
|
|
|
28 (defvar efs-kerberos-passwd-sent nil)
|
|
|
29 ;; Set to t after the passwd has been sent.
|
|
|
30 (defvar efs-kerberos-output "")
|
|
|
31 ;; Holds the output lines from the kinit process.
|
|
|
32 (defvar efs-kerberos-buffer-name "*efs kerberos*")
|
|
|
33 ;; Buffer where kinit output is logged.
|
|
|
34 (defvar efs-kerberos-passwd-prompt-regexp "^Password: *$")
|
|
|
35 ;; Regular expression to match prompt used by the kinit program.
|
|
|
36 (defvar efs-kerberos-failed-msgs "[^ ]+")
|
|
|
37 ;; Regular expression to match output for an invalid kinit ticket password.
|
|
|
38 ;; Is this too general?
|
|
|
39 (defvar efs-kerberos-passwd-failed nil)
|
|
|
40 ;; Whether the kinit command worked.
|
|
|
41 (defvar efs-kerberos-passwd-retry nil)
|
|
|
42
|
|
|
43 ;;; Code
|
|
|
44
|
|
|
45 (defun efs-kerberos-process-filter (proc str)
|
|
|
46 ;; Process filter for the kinit process.
|
|
|
47 (setq efs-kerberos-output (concat efs-kerberos-output str))
|
|
|
48 (let ((buff (get-buffer (process-buffer proc))))
|
|
|
49 (if buff
|
|
|
50 (efs-save-buffer-excursion
|
|
|
51 (set-buffer buff)
|
|
|
52 (efs-save-match-data
|
|
|
53 (goto-char (point-max))
|
|
|
54 (while (string-match "\n" efs-kerberos-output)
|
|
|
55 (let ((line (substring efs-kerberos-output 0
|
|
|
56 (match-beginning 0))))
|
|
|
57 (insert line "\n")
|
|
|
58 (and efs-kerberos-passwd-sent
|
|
|
59 (string-match efs-kerberos-failed-msgs line)
|
|
|
60 (setq efs-kerberos-passwd-failed t)))
|
|
|
61 (setq efs-kerberos-output (substring efs-kerberos-output
|
|
|
62 (match-end 0))))
|
|
|
63 (and (null efs-kerberos-passwd-sent)
|
|
|
64 (string-match efs-kerberos-passwd-prompt-regexp
|
|
|
65 efs-kerberos-output)
|
|
|
66 (memq (process-status proc) '(run open))
|
|
|
67 (let ((passwd (or
|
|
|
68 (efs-lookup-passwd efs-gateway-host "kerberos")
|
|
|
69 (read-passwd
|
|
|
70 (if efs-kerberos-passwd-retry
|
|
|
71 "Password failed. Try again: "
|
|
|
72 (format "Kerberos password for %s: "
|
|
|
73 efs-gateway-host))))))
|
|
|
74 (unwind-protect
|
|
|
75 (progn
|
|
|
76 (insert efs-kerberos-output)
|
|
|
77 (setq efs-kerberos-output "")
|
|
|
78 (process-send-string proc passwd)
|
|
|
79 (insert "Turtle Power!\n"))
|
|
|
80 (fillarray passwd 0)))))))))
|
|
|
81
|
|
|
82 (defun efs-kerberos-get-ticket ()
|
|
|
83 ;; Gets a kerbos ticket. The password is actually sent by the process
|
|
|
84 ;; filter.
|
|
|
85 (let ((mess (format "Getting kerberos ticket for %s..." efs-gateway-host)))
|
|
|
86 (message mess)
|
|
|
87 (setq efs-kerberos-passwd-failed nil
|
|
|
88 efs-kerberos-passwd-sent nil
|
|
|
89 efs-kerberos-output "")
|
|
|
90 (condition-case nil (delete-process "*efs kerberos*") (eror nil))
|
|
|
91 (let* ((program (or (nth 3 efs-gateway-type) "kinit"))
|
|
|
92 (args (nth 4 efs-gateway-type))
|
|
|
93 (proc (apply 'start-process
|
|
|
94 "*efs kerberos*" efs-kerberos-buffer-name
|
|
|
95 program args)))
|
|
|
96 (set-process-filter proc (function efs-kerberos-process-filter))
|
|
|
97 ;; Should check for a pty, but efs-pty-check will potentially eat
|
|
|
98 ;; important output. Need to wait until Emacs 19.29 to do this properly.
|
|
|
99 (while (memq (process-status proc) '(run open))
|
|
|
100 (accept-process-output proc))
|
|
|
101 (if efs-kerberos-passwd-failed
|
|
|
102 (let ((efs-kerberos-passwd-failed t))
|
|
|
103 (efs-kerberos-get-ticket))))
|
|
|
104 (message "%sdone" mess)))
|
|
|
105
|
|
|
106 (defun efs-kerberos-login (host user proc)
|
|
|
107 ;; Open a connection using process PROC to HOST adn USER, using a
|
|
|
108 ;; kerberos gateway. Returns the process object of the connection.
|
|
|
109 ;; This may not be PROC, if a ticket collection was necessary.
|
|
|
110 (let ((to host)
|
|
|
111 result port cmd)
|
|
|
112 (if (string-match "#" host)
|
|
|
113 (setq to (substring host 0 (match-beginning 0))
|
|
|
114 port (substring host (match-end 0))))
|
|
|
115 (and efs-nslookup-on-connect
|
|
|
116 (string-match "[^0-9.]" to)
|
|
|
117 (setq to (efs-nslookup-host to)))
|
|
|
118 (setq cmd (concat "open " to))
|
|
|
119 (if port (setq cmd (concat cmd " " port)))
|
|
|
120 (setq result (efs-raw-send-cmd proc cmd))
|
|
|
121 (while (and (car result)
|
|
|
122 (string-match "\\bcannot authenticate to server\\b"
|
|
|
123 (nth 1 result)))
|
|
|
124 (let ((name (process-name proc)))
|
|
|
125 (condition-case nil (delete-process proc) (error nil))
|
|
|
126 (efs-kerberos-get-ticket)
|
|
|
127 (setq proc (efs-start-process host user name)
|
|
|
128 result (efs-raw-send-cmd proc cmd))))
|
|
|
129 (if (car result)
|
|
|
130 (progn
|
|
|
131 (condition-case nil (delete-process proc) (error nil))
|
|
|
132 (efs-error host user (concat "OPEN request failed: "
|
|
|
133 (nth 1 result)))))
|
|
|
134 proc))
|
|
|
135
|
|
|
136 ;;; End of efs-kerberos.el
|
