changing login IDs in lemacs
Radey Shouman (rshouman@chpc.utexas.edu)
Tue, 12 Apr 94 12:39:02 CDT
Vamsee Lakamsani writes:
>
> I can use ange-ftp to write/save files as another user (different
> from my login ID) but is there some way to execute shell commands
> as another user? When I do 'M-x shell-command' in a ange-ftped buffer
> the commands are not executed with the other user's permissions and
> it would be nice to be able to do so. Please email any suggestions.
Here is a little package I have been using to provide an ange-ftp'ified
shell-command. Not much documentation, but then its not very complicated.
Will efs provide anything like this?
--Radey Shouman
---------------cut-here-------------------------cut-here----------
;$modified: Tue Apr 12 12:38:13 1994 by rshouman $
;; If you want ange-ftp to work, you have to load it before this file.
(require 'ange-ftp)
(define-key global-map "\M-!" 'shell-command)
(defvar rsh-remote-shell-file-name "rsh"
"*Remote shell used by rsh.el, should be the same as
ange-ftp-remote-shell=file-name if you are using ange-ftp.")
(if (boundp 'ange-ftp-remote-shell-file-name)
(setq rsh-remote-shell-file-name ange-ftp-remote-shell-file-name))
(defun rsh-path (path)
(and (fboundp 'ange-ftp-ftp-path)
(ange-ftp-ftp-path path)))
;; shell-command will use the default directory to decide whether to run
;; locally or remotely.
(defun shell-command (command &optional flag)
"Execute string COMMAND in inferior shell; display output, if any.
Optional second arg non-nil (prefix arg, if interactive)
means insert output in current buffer after point (leave mark after it).
This function has been modified to use the command given by the variable
rsh-remote-shell-file-name to execute COMMAND on remote hosts."
(interactive (list
(let ((host (nth 0 (rsh-path default-directory))))
(read-string
(concat (if host (concat "(" host ") "))
"Shell command: ")))
current-prefix-arg))
(if flag
(let ((arglst (rsh-arglst command t)))
(if arglst
(apply 'call-process (car arglst) nil t nil (cdr arglst))
(call-process shell-file-name nil t nil "-c" command)))
(remote-shell-command-on-region (point) (point) command nil)))
;; We'll always run shell-command-on-region locally, and provide
;; remote-shell-command-on-region for running on a possibly remote host.
(if (fboundp 'rsh-orig-shell-command-on-region)
nil
(fset 'rsh-orig-shell-command-on-region
(symbol-function 'shell-command-on-region)))
(defun shell-command-on-region (start end command &optional flag interactive)
"Execute string COMMAND in inferior shell with region as input.
Normally display output (if any) in temp buffer;
Prefix arg means replace the region with it.
Noninteractive args are START, END, COMMAND, FLAG.
Noninteractively FLAG means insert output in place of text from START to END,
and put point at the end, but don't alter the mark.
COMMAND will always be executed on the local host, even if the default
directory is an ange-ftp style remote directory."
(interactive "r\nsShell command on region: \nP\np")
; If the default directory is remote,
; use home.
(let ((default-directory
(if (rsh-path default-directory)
(expand-file-name "~/")
default-directory)))
(rsh-orig-shell-command-on-region start end command flag interactive)))
(defun remote-shell-command-on-region
(start end command &optional flag interactive)
"Execute string COMMAND in inferior shell with region as input.
Normally display output (if any) in temp buffer;
Prefix arg means replace the region with it.
Noninteractive args are START, END, COMMAND, FLAG.
Noninteractively FLAG means insert output in place of text from START to END,
and put point at the end, but don't alter the mark.
This function has been modified to use the command given by the variable
rsh-remote-shell-file-name to execute COMMAND on remote hosts."
(interactive (list
(if (null (mark))
(error "mark is not set")
(if (< (point) (mark)) (point) (mark)))
(if (> (point) (mark)) (point) (mark))
(let ((host (nth 0 (rsh-path default-directory))))
(read-string
(concat (if host (concat "(" host ") "))
"Shell command: ")))
current-prefix-arg
(prefix-numeric-value current-prefix-arg)))
(let ((arglst (rsh-arglst command t)))
(if flag
;; Replace specified region with output from command.
(let ((swap (and interactive (< (point) (mark)))))
;; Don't muck with mark
;; unless called interactively.
(and interactive (push-mark))
(if arglst
(apply 'call-process-region
start end (car arglst) t t nil (cdr arglst))
(call-process-region start end shell-file-name
t t nil "-c" command))
(and interactive swap (exchange-point-and-mark)))
(let ((buffer (get-buffer-create "*Shell Command Output*")))
(save-excursion
(set-buffer buffer)
(erase-buffer))
(if (eq buffer (current-buffer))
(setq start 1 end 1))
(if arglst
(apply 'call-process-region
start end (car arglst) nil buffer nil (cdr arglst))
(call-process-region start end shell-file-name
nil buffer nil "-c" command))
(if (save-excursion
(set-buffer buffer)
(> (buffer-size) 0))
(set-window-start (display-buffer buffer) 1)
(message "(Shell command completed with no output)"))))))
;; This is a subr in emacs-19.
(or (fboundp 'start-process-shell-command)
(defun start-process-shell-command (name buffer command &rest args)
(let ((arglst (or (rsh-arglst command t)
(list shell-file-name "-c" command))))
(setq arglst (append arglst args))
(apply 'start-process "compilation" buffer
(car arglst) (cdr arglst)))))
;; This is an extra function so that it can be redefined by ange-ftp.
(defun dired-run-shell-command (command &optional in-background)
(if (not in-background)
(shell-command command)
;; We need this only in Emacs 18 (19's shell command has `&').
;; comint::background is defined in emacs-19.el.
(comint::background command)))
(defun rsh-call-process (program infile buffer display &rest args)
(let ((arglst (rsh-arglst program t)))
(if (null arglst)
(apply 'call-process program infile buffer display args)
(setq arglst (append arglst (mapcar 'rsh-quote args)))
(apply 'call-process (car arglst) infile buffer display (cdr arglst)))))
;; Return a list of command arguments, including the command itself,
;; to execute a shell command on either a local or remote host.
;; The remote host name and logname to use are taken from the command,
;; if it starts like "user@host:command", or from the default directory,
;; if it is an ange-ftp style remote directory, otherwise, the command
;; will be run locally.
(defun rsh-arglst (command &optional directory &rest args)
"Return a list of arguments to call process, including the program
name as the first element, to run COMMAND in a subshell on a remote
host. If optional DIRECTORY is present, add a \"cd\" command to that
directory, t means use default directory.
If COMMAND is of the form \"/user@host:command\" then the command
is run on \"host\" as \"user\"; otherwise, if the buffer file name is
an ange-ftp style remote pathname then the indicated user and host
will be used; if neither of these is true then nil is returned.
If COMMAND is a list, then the car of COMMAND is taken as the command,
other members of COMMAND are appended to the argument list returned. "
(if (listp command)
(apply 'rsh-arglst (car command) directory (append (cdr command) args))
(let* ((path (rsh-path default-directory))
(remote-host (nth 0 path))
(logname (nth 1 path)))
(and (eq directory t)
(setq directory (or (nth 2 path) default-directory)))
(let ((parsed (rsh-path command)))
(if parsed
(setq
remote-host (nth 0 parsed)
logname (nth 1 parsed)
command (nth 2 parsed))))
(if remote-host
(let ((arglst (list (concat
(or (rsh-remote-set-environment) "")
(and directory (concat "cd " directory "; "))
command))))
(and logname
(not (string-equal logname (user-login-name)))
(setq arglst (cons "-l" (cons logname arglst))))
(setq arglst (cons remote-host arglst))
(append (cons rsh-remote-shell-file-name arglst)
(rsh-quote args)))
nil))))
(defun rsh-remote-set-environment ()
"Return a string to be inserted before any remote commands, to set the
remote environment, for example, a DISPLAY variable. "
(let ((display (catch 'exit
(mapcar (function
(lambda (arg)
(if (string-match "DISPLAY=" arg)
(throw 'exit arg))))
process-environment)
nil)))
(if display
(concat "export DISPLAY; " display "; "))))
(defun rsh-remote-filename (fname)
"Return the remote pathname for FNAME, an ange-ftp style file name. "
(let ((path (rsh-path fname)))
(or (nth 2 path) fname)))
(defun rsh-quote (str)
"Return STR enclosed in single quotes, replacing embedded single
quotes with the string: '\\'' . "
(if (listp str)
(mapcar 'rsh-quote str)
(if (string-match "^'.*'$" str nil) ; If it's already quoted, don't quote
str ; it again.
(let (outstr)
(while (string-match "'" str nil)
(setq outstr
(concat
outstr
(substring str 0 (match-beginning 0))
"'\\''"))
(setq str (substring str (match-end 0) nil)))
(concat "'" outstr str "'")))))
(provide 'rsh)