Mercurial > hg > xemacs-beta

comparison lisp/packages/netunam.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children 0293115a14e9
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 ;;; netunam.el --- HP-UX RFA Commands
2
3 ;; Copyright (C) 1988 Free Software Foundation, Inc.
4
5 ;; Author: Chris Hanson <cph@zurich.ai.mit.edu>
6 ;; Keywords: comm
7
8 ;; This file is part of XEmacs.
9
10 ;; XEmacs is free software; you can redistribute it and/or modify it
11 ;; under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
13 ;; any later version.
14
15 ;; XEmacs is distributed in the hope that it will be useful, but
16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18 ;; General Public License for more details.
19
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with XEmacs; see the file COPYING. If not, write to the Free
22 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
23
24 ;;; Synched up with: Not in FSF.
25 ;;; #### Chuck -- maybe we should nuke this file. I somehow or
26 ;;; other get the sense that it's extremely obsolete.
27
28 ;;; Commentary:
29
30 ;; Use the Remote File Access (RFA) facility of HP-UX from Emacs.
31
32 ;;; Code:
33
34 (defconst rfa-node-directory "/net/"
35 "Directory in which RFA network special files are stored.
36 By HP convention, this is \"/net/\".")
37
38 (defvar rfa-default-node nil
39 "If not nil, this is the name of the default RFA network special file.")
40
41 (defvar rfa-password-memoize-p t
42 "If non-nil, remember login user's passwords after they have been entered.")
43
44 (defvar rfa-password-alist '()
45 "An association from node-name strings to password strings.
46 Used if `rfa-password-memoize-p' is non-nil.")
47
48 (defvar rfa-password-per-node-p t
49 "If nil, login user uses same password on all machines.
50 Has no effect if `rfa-password-memoize-p' is nil.")
51
52 (defun rfa-set-password (password &optional node user)
53 "Add PASSWORD to the RFA password database.
54 Optional second arg NODE is a string specifying a particular nodename;
55 if supplied and not nil, PASSWORD applies to only that node.
56 Optional third arg USER is a string specifying the (remote) user whose
57 password this is; if not supplied this defaults to (user-login-name)."
58 (if (not user) (setq user (user-login-name)))
59 (let ((node-entry (assoc node rfa-password-alist)))
60 (if node-entry
61 (let ((user-entry (assoc user (cdr node-entry))))
62 (if user-entry
63 (rplacd user-entry password)
64 (rplacd node-entry
65 (nconc (cdr node-entry)
66 (list (cons user password))))))
67 (setq rfa-password-alist
68 (nconc rfa-password-alist
69 (list (list node (cons user password))))))))
70
71 (defun rfa-open (node &optional user password)
72 "Open a network connection to a server using remote file access.
73 First argument NODE is the network node for the remote machine.
74 Second optional argument USER is the user name to use on that machine.
75 If called interactively, the user name is prompted for.
76 Third optional argument PASSWORD is the password string for that user.
77 If not given, this is filled in from the value of
78 `rfa-password-alist', or prompted for. A prefix argument of - will
79 cause the password to be prompted for even if previously memoized."
80 (interactive
81 (list (read-file-name "rfa-open: " rfa-node-directory rfa-default-node t)
82 (read-string "user-name: " (user-login-name))))
83 (let ((node
84 (and (or rfa-password-per-node-p
85 (not (equal user (user-login-name))))
86 node)))
87 (if (not password)
88 (setq password
89 (let ((password
90 (cdr (assoc user (cdr (assoc node rfa-password-alist))))))
91 (or (and (not current-prefix-arg) password)
92 (rfa-password-read
93 (format "password for user %s%s: "
94 user
95 (if node (format " on node \"%s\"" node) ""))
96 password))))))
97 (let ((result
98 (sysnetunam (expand-file-name node rfa-node-directory)
99 (concat user ":" password))))
100 (if (interactive-p)
101 (if result
102 (message "Opened network connection to %s as %s" node user)
103 (error "Unable to open network connection")))
104 (if (and rfa-password-memoize-p result)
105 (rfa-set-password password node user))
106 result))
107
108 (defun rfa-close (node)
109 "Close a network connection to a server using remote file access.
110 NODE is the network node for the remote machine."
111 (interactive
112 (list (read-file-name "rfa-close: " rfa-node-directory rfa-default-node t)))
113 (let ((result (sysnetunam (expand-file-name node rfa-node-directory) "")))
114 (cond ((not (interactive-p)) result)
115 ((not result) (error "Unable to close network connection"))
116 (t (message "Closed network connection to %s" node)))))
117
118 (defun rfa-password-read (prompt default)
119 (let ((rfa-password-accumulator (or default "")))
120 (read-from-minibuffer prompt
121 (and default
122 (let ((copy (concat default))
123 (index 0)
124 (length (length default)))
125 (while (< index length)
126 (aset copy index ?.)
127 (setq index (1+ index)))
128 copy))
129 rfa-password-map)
130 rfa-password-accumulator))
131
132 (defvar rfa-password-map nil)
133 (if (not rfa-password-map)
134 (let ((char ? ))
135 (setq rfa-password-map (make-keymap))
136 (while (< char 127)
137 (define-key rfa-password-map (char-to-string char)
138 'rfa-password-self-insert)
139 (setq char (1+ char)))
140 (define-key rfa-password-map "\C-g"
141 'abort-recursive-edit)
142 (define-key rfa-password-map "\177"
143 'rfa-password-rubout)
144 (define-key rfa-password-map "\n"
145 'exit-minibuffer)
146 (define-key rfa-password-map "\r"
147 'exit-minibuffer)))
148
149 (defvar rfa-password-accumulator nil)
150
151 (defun rfa-password-self-insert ()
152 (interactive)
153 (setq rfa-password-accumulator
154 (concat rfa-password-accumulator
155 (char-to-string last-command-char)))
156 (insert ?.))
157
158 (defun rfa-password-rubout ()
159 (interactive)
160 (delete-char -1)
161 (setq rfa-password-accumulator
162 (substring rfa-password-accumulator 0 -1)))
163
164 ;;; netunam.el ends here