Mercurial > hg > xemacs-beta
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