xemacs-beta: lisp/efs/efs.el comparison

comparison 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

comparison

equal deleted inserted replaced

-:11c6df210d7f
+:56c54cf7c5b6
 ;; File:         efs.el
 ;; Release:      $efs release: 1.15 $
 ;; 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)
 ;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 Applies when nslookup is used to compute a fully qualified domain name
 for the local host, in the case when `system-name' does not return one.
 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.
 For example:
 the option to type commands at the FTP connection.  Normally, the connection
 is killed first.  Note that doing this may result in the FTP process filter
 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
 "Hook to run immediately after starting the FTP client.
 This hook is run before the FTP OPEN command is sent.")
 ;; file existence.
 (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.
 (defvar efs-passwd-cmds
 "^quote pass \\|^quote acct \\|^quote site gpass ")
 "^2[01345][0-7] \\|" ; 2yz = positive completion reply
 "^22[02-7] \\|"      ; 221 = successful logout
 			; (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.
 (defvar efs-failed-msgs
 		(progn
 		  ;; 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)
 			(case-fold-search t))
 		    (while alist
 		    (if (string-match "^[0-9]+$" size)
 			(set (if gate-p
 				 'efs-gateway-hash-mark-size
 			       '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.
 ;;;; ------------------------------------------------------------
 					   (efs-fix-path host-type cmd1))
 		    cmd2 (efs-quote-string host-type
 					   (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))))
 	;; Actually send the resulting command.
 (let ((gate (efs-use-gateway-p host)))
 (if (eq gate 'kerberos)
 	(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)
 	(if (string-match "#" to)
 	    (setq port (substring to (match-end 0))
 (defun efs-login-send-user (host user proc &optional gate retry)
 "Send user command to HOST and USER. PROC is the ftp client process.
 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))
 			   (efs-nslookup-host host)
 			 host)))
 		       (setq to (concat to "@" port))))
 		 (format "quote user \"%s\"@%s" user to)))
 	      (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)
 ;; Send the message by hand so that we can report on the size
 ;; of the MOTD.
 	 (sticky (memq int '(1 3 5 7))))
 (concat (efs-build-mode-string-element owner-int suid nil)
 	    (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.
 ;; This is because efs-file-modes returns nil if the modes
 ;; of a remote file couldn't be determined, even if the file exists.
 	    host user
 	    (list 'quote 'site 'chmod omode r-file)
 	    nil nil
 	    (efs-cont (result line cont-lines) (host file r-file omode)
 	      (if result
-		  (progn
+		  (let ((exit-code
-		    (efs-set-host-property host 'chmod-failed t)
+			 (efs-shell-call-process
-		    (message "CHMOD %s failed for %s on %s." omode r-file host)
+			  (concat "chmod " mode " " (file-name-nondirectory file))
-		    (if efs-ding-on-chmod-failure
+			  (file-name-directory file))))
-			(progn (ding) (sit-for 1))))
+		    (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
 			      (cond
 			       ((null (car ent)) "-")
 				      (downcase def-user))
 	  (string-equal user def-user))
 	(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))
 (while tail
 	(if (string-match (car (car tail)) filename)
 (apply operation args))))
 ;; 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
+(defvar efs-path-sifn-regexp "\\(^\\|[^$]\\)\\(\\$\\$\\)*\\$[{a-zA-Z0-9]"
-(list
+"Regexp to match environment variables in file names.")
-	(cons "\\(^\\|[^$]\\)\\(\\$\\$\\)*\\$[{a-zA-Z0-9]"
-	      'efs-sifn-handler-function)))
+(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.
 ;;;; ------------------------------------------------------------

Mercurial > hg > xemacs-beta

comparison lisp/efs/efs.el @ 48:56c54cf7c5b6 r19-16b90