diff 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
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/packages/netunam.el	Mon Aug 13 08:45:50 2007 +0200
@@ -0,0 +1,164 @@
+;;; netunam.el --- HP-UX RFA Commands
+
+;; Copyright (C) 1988 Free Software Foundation, Inc.
+
+;; Author: Chris Hanson <cph@zurich.ai.mit.edu>
+;; Keywords: comm
+
+;; This file is part of XEmacs.
+
+;; XEmacs is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; XEmacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING.  If not, write to the Free
+;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; Synched up with: Not in FSF.
+;;; #### Chuck -- maybe we should nuke this file.  I somehow or
+;;; other get the sense that it's extremely obsolete.
+
+;;; Commentary:
+
+;; Use the Remote File Access (RFA) facility of HP-UX from Emacs.
+
+;;; Code:
+
+(defconst rfa-node-directory "/net/"
+  "Directory in which RFA network special files are stored.
+By HP convention, this is \"/net/\".")
+
+(defvar rfa-default-node nil
+  "If not nil, this is the name of the default RFA network special file.")
+
+(defvar rfa-password-memoize-p t
+  "If non-nil, remember login user's passwords after they have been entered.")
+
+(defvar rfa-password-alist '()
+  "An association from node-name strings to password strings.
+Used if `rfa-password-memoize-p' is non-nil.")
+
+(defvar rfa-password-per-node-p t
+  "If nil, login user uses same password on all machines.
+Has no effect if `rfa-password-memoize-p' is nil.")
+
+(defun rfa-set-password (password &optional node user)
+  "Add PASSWORD to the RFA password database.
+Optional second arg NODE is a string specifying a particular nodename;
+ if supplied and not nil, PASSWORD applies to only that node.
+Optional third arg USER is a string specifying the (remote) user whose
+ password this is; if not supplied this defaults to (user-login-name)."
+  (if (not user) (setq user (user-login-name)))
+  (let ((node-entry (assoc node rfa-password-alist)))
+    (if node-entry
+	(let ((user-entry (assoc user (cdr node-entry))))
+	  (if user-entry
+	      (rplacd user-entry password)
+	      (rplacd node-entry
+		      (nconc (cdr node-entry)
+			     (list (cons user password))))))
+	(setq rfa-password-alist
+	      (nconc rfa-password-alist
+		     (list (list node (cons user password))))))))
+
+(defun rfa-open (node &optional user password)
+  "Open a network connection to a server using remote file access.
+First argument NODE is the network node for the remote machine.
+Second optional argument USER is the user name to use on that machine.
+  If called interactively, the user name is prompted for.
+Third optional argument PASSWORD is the password string for that user.
+  If not given, this is filled in from the value of
+`rfa-password-alist', or prompted for.  A prefix argument of - will
+cause the password to be prompted for even if previously memoized."
+  (interactive
+   (list (read-file-name "rfa-open: " rfa-node-directory rfa-default-node t)
+	 (read-string "user-name: " (user-login-name))))
+  (let ((node
+	 (and (or rfa-password-per-node-p
+		  (not (equal user (user-login-name))))
+	      node)))
+    (if (not password)
+	(setq password
+	      (let ((password
+		     (cdr (assoc user (cdr (assoc node rfa-password-alist))))))
+		(or (and (not current-prefix-arg) password)
+		    (rfa-password-read
+		     (format "password for user %s%s: "
+			     user
+			     (if node (format " on node \"%s\"" node) ""))
+		     password))))))
+  (let ((result
+	 (sysnetunam (expand-file-name node rfa-node-directory)
+		     (concat user ":" password))))
+    (if (interactive-p)
+	(if result
+	    (message "Opened network connection to %s as %s" node user)
+	    (error "Unable to open network connection")))
+    (if (and rfa-password-memoize-p result)
+	(rfa-set-password password node user))
+    result))
+
+(defun rfa-close (node)
+  "Close a network connection to a server using remote file access.
+NODE is the network node for the remote machine."
+  (interactive
+   (list (read-file-name "rfa-close: " rfa-node-directory rfa-default-node t)))
+  (let ((result (sysnetunam (expand-file-name node rfa-node-directory) "")))
+    (cond ((not (interactive-p)) result)
+	  ((not result) (error "Unable to close network connection"))
+	  (t (message "Closed network connection to %s" node)))))
+
+(defun rfa-password-read (prompt default)
+  (let ((rfa-password-accumulator (or default "")))
+    (read-from-minibuffer prompt
+			  (and default
+			       (let ((copy (concat default))
+				     (index 0)
+				     (length (length default)))
+				 (while (< index length)
+				   (aset copy index ?.)
+				   (setq index (1+ index)))
+				 copy))
+			  rfa-password-map)
+    rfa-password-accumulator))
+
+(defvar rfa-password-map nil)
+(if (not rfa-password-map)
+    (let ((char ? ))
+      (setq rfa-password-map (make-keymap))
+      (while (< char 127)
+	(define-key rfa-password-map (char-to-string char)
+	  'rfa-password-self-insert)
+	(setq char (1+ char)))
+      (define-key rfa-password-map "\C-g"
+	'abort-recursive-edit)
+      (define-key rfa-password-map "\177"
+	'rfa-password-rubout)
+      (define-key rfa-password-map "\n"
+	'exit-minibuffer)
+      (define-key rfa-password-map "\r"
+	'exit-minibuffer)))
+
+(defvar rfa-password-accumulator nil)
+
+(defun rfa-password-self-insert ()
+  (interactive)
+  (setq rfa-password-accumulator
+	(concat rfa-password-accumulator
+		(char-to-string last-command-char)))
+  (insert ?.))
+
+(defun rfa-password-rubout ()
+  (interactive)
+  (delete-char -1)
+  (setq rfa-password-accumulator
+	(substring rfa-password-accumulator 0 -1)))
+
+;;; netunam.el ends here