Mercurial > hg > xemacs-beta

comparison lisp/efs/efs-kerberos.el @ 98:0d2f883870bc r20-1b1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b1
author cvs
date Mon, 13 Aug 2007 09:13:56 +0200
parents 8fc7fe29b841
children 4103f0995bd7 4be1180a9e89
comparison
equal deleted inserted replaced
97:498bf5da1c90 98:0d2f883870bc
1 ;; -*-Emacs-Lisp-*-
2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3 ;;
4 ;; File: efs-efs-kerberos.el
5 ;; Release: $efs release: 1.15 $
6 ;; Version: $Revision: 1.1 $
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 "/"
24 (substring "$Revision: 1.1 $" 11 -2)))
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