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

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