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.