annotate lisp/packages/netunam.el @ 100:4be1180a9e89 r20-1b2

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