Mercurial > hg > xemacs-beta
diff lisp/efs/efs.el @ 48:56c54cf7c5b6 r19-16b90
Import from CVS: tag r19-16b90
author | cvs |
---|---|
date | Mon, 13 Aug 2007 08:56:04 +0200 |
parents | 8d2a9b52c682 |
children |
line wrap: on
line diff
--- a/lisp/efs/efs.el Mon Aug 13 08:55:32 2007 +0200 +++ b/lisp/efs/efs.el Mon Aug 13 08:56:04 2007 +0200 @@ -6,7 +6,7 @@ ;; Version: #Revision: 1.56 $ ;; RCS: ;; Description: Transparent FTP support for the original GNU Emacs -;; from FSF and Lucid Emacs +;; from FSF and XEmacs ;; Authors: Andy Norman <ange@hplb.hpl.hp.com>, ;; Sandy Rutherford <sandy@ibm550.sissa.it> ;; Created: Thu Oct 12 14:00:05 1989 (as ange-ftp) @@ -1388,6 +1388,18 @@ If you set this to nil, efs will wait an arbitrary amount of time to get output.") +(defvar efs-remote-shell-file-name + (if (memq system-type '(hpux usg-unix-v)) ; hope that's right + "remsh" + "rsh") + "Remote shell used by efs.") + +(defvar efs-remote-shell-takes-user + (null (null (memq system-type '(aix aix-v3 hpux silicon-graphics-unix + berkeley-unix)))) + ;; Complete? Doubt it. + "Set to non-nil if your remote shell command takes \"-l USER\".") + (defvar efs-make-backup-files efs-unix-host-types "*A list of operating systems for which efs will make Emacs backup files. The backup files are made on the remote host. @@ -1585,6 +1597,9 @@ getting out of synch with the FTP client, so using this feature routinely isn't recommended.") +(defvar efs-use-passive-mode nil + "*If non-nil, the ftp client will specify passive mode for all transfers.") + ;;; Hooks and crooks. (defvar efs-ftp-startup-hook nil @@ -1645,7 +1660,7 @@ (defvar efs-cmd-ok-cmds (concat "^quote port \\|^type \\|^quote site \\|^chmod \\|^quote noop\\|" - "^quote pasv")) + "^quote pasv\\|^passive")) ;; Regexp to match commands for which efs-cmd-ok-msgs is a valid server ;; response for success. @@ -1678,6 +1693,8 @@ ; (Sometimes get this with a timeout, ; so treat as fatal.) "^3[0-5][0-7] \\|" ; 3yz = positive intermediate reply + ;; passive + "^[Pp]assive \\|" ;; client codes "^[Hh]ash mark ")) ;; Response to indicate that the requested action was successfully completed. @@ -3644,6 +3661,9 @@ ;; Tell client to send back hash-marks as progress. It isn't ;; usually fatal if this command fails. (efs-guess-hash-mark-size proc) + + (if efs-use-passive-mode + (efs-passive-mode host user)) ;; Run any user startup functions (let ((alist efs-ftp-startup-function-alist) @@ -3685,6 +3705,10 @@ 'efs-hash-mark-size) (string-to-int size)))))))))) +(defun efs-passive-mode (host user) + ;; put ftp into passive mode + (efs-send-cmd host user '(passive))) + ;;;; ------------------------------------------------------------ ;;;; Simple FTP process shell support. ;;;; ------------------------------------------------------------ @@ -4066,6 +4090,10 @@ (efs-fix-path host-type cmd2)) cmd-string (concat "rename " cmd1 " " cmd2)))) + ;; passive command + ((eq cmd0 'passive) + (setq cmd-string "passive")) + (t (error "efs: Don't know how to send %s %s %s %s" cmd0 cmd1 cmd2 cmd3)))) @@ -4199,7 +4227,7 @@ (progn (setq proc (efs-kerberos-login host user proc)) (efs-login-send-user host user proc gate)) - (let ((to (if (memq gate '(proxy local raptor)) + (let ((to (if (memq gate '(proxy raptor)) efs-gateway-host host)) port cmd result) @@ -4233,7 +4261,7 @@ Optional argument GATE specifies which type of gateway is being used. RETRY argument specifies to try twice if we get a 421 response." (let ((cmd (cond - ((memq gate '(local proxy interlock)) + ((memq gate '(proxy interlock)) (format "quote USER \"%s\"@%s" user (if (and efs-nslookup-on-connect (string-match "[^0-9.]" host)) @@ -4261,7 +4289,7 @@ (t (format "quote user \"%s\"" user)))) (msg (format "Logging in as user %s%s..." user - (if (memq gate '(proxy local raptor kerberos)) + (if (memq gate '(proxy raptor kerberos)) (concat "@" host) ""))) result code) @@ -8089,6 +8117,37 @@ (efs-build-mode-string-element group-int sgid nil) (efs-build-mode-string-element other-int nil sticky)))) +(defun efs-shell-call-process (command dir &optional in-background) + ;; Runs shell process on remote hosts. + (let* ((parsed (efs-ftp-path dir)) + (host (car parsed)) + (user (nth 1 parsed)) + (rdir (nth 2 parsed)) + (file-name-handler-alist nil)) + (or (string-equal (efs-internal-directory-file-name dir) + (efs-expand-tilde "~" (efs-host-type host) host user)) + (string-match "^cd " command) + (setq command (concat "cd " rdir "; " command))) + (setq command + (format "%s %s%s \"%s\"" ; remsh -l USER does not work well + ; on a hp-ux machine I tried + efs-remote-shell-file-name host + (if efs-remote-shell-takes-user + (concat " -l " user) + "") + command)) + (message "Doing shell command on %s..." host) + ;; do it + (let ((process-connection-type ; don't waste pty's + (null (null in-background)))) + (setq default-directory (file-name-directory efs-tmp-name-template)) + (if in-background + (progn + (setq mode-line-process '(": %s")) + (start-process "Shell" (current-buffer) + shell-file-name "-c" command)) + (call-process shell-file-name nil t nil "-c" command))))) + (defun efs-set-file-modes (file mode) ;; set-file-modes for remote files. ;; For remote files, if mode is nil, does nothing. @@ -8111,11 +8170,16 @@ nil nil (efs-cont (result line cont-lines) (host file r-file omode) (if result - (progn - (efs-set-host-property host 'chmod-failed t) - (message "CHMOD %s failed for %s on %s." omode r-file host) - (if efs-ding-on-chmod-failure - (progn (ding) (sit-for 1)))) + (let ((exit-code + (efs-shell-call-process + (concat "chmod " mode " " (file-name-nondirectory file)) + (file-name-directory file)))) + (if (not (equal 0 exit-code)) + (progn + (efs-set-host-property host 'chmod-failed t) + (message "CHMOD %s failed for %s on %s." omode r-file host) + (if efs-ding-on-chmod-failure + (progn (ding) (sit-for 1)))))) (let ((ent (efs-get-file-entry file))) (if ent (let* ((type @@ -8861,7 +8925,7 @@ (format efs-path-format-without-user host path) (format efs-path-format-string user host path)))) -(efs-define-fun efs-abbreviate-file-name (filename) +(efs-define-fun efs-abbreviate-file-name (filename &optional ignored-for-now) ;; Version of abbreviate-file-name for remote files. (efs-save-match-data (let ((tail directory-abbrev-alist)) @@ -10761,10 +10825,14 @@ ;; Yes, this is what it looks like. I'm defining the handler to run our ;; version whenever there is an environment variable. -(nconc file-name-handler-alist - (list - (cons "\\(^\\|[^$]\\)\\(\\$\\$\\)*\\$[{a-zA-Z0-9]" - 'efs-sifn-handler-function))) +(defvar efs-path-sifn-regexp "\\(^\\|[^$]\\)\\(\\$\\$\\)*\\$[{a-zA-Z0-9]" + "Regexp to match environment variables in file names.") + +(or (assoc efs-path-sifn-regexp file-name-handler-alist) + (nconc file-name-handler-alist + (list + (cons efs-path-sifn-regexp + 'efs-sifn-handler-function)))) ;;;; ------------------------------------------------------------ ;;;; Necessary overloads.