X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/f470f9bd66f6bf522f9adc23fcc90ab8285a04e7..8e735883f4696be337577300537480fe64f11fdf:/lisp/ange-ftp.el

diff --git a/lisp/ange-ftp.el b/lisp/ange-ftp.el
index cf3141c91e..2b79cf5757 100644
--- a/lisp/ange-ftp.el
+++ b/lisp/ange-ftp.el
@@ -395,7 +395,7 @@
 ;;;    when asked to list a non-existent directory.  Some of the ai.mit.edu
 ;;;    machines cause this problem for some FTP clients. Using
 ;;;    ange-ftp-kill-ftp-process can restart the ftp process, which
-;;;    should get things back in synch.
+;;;    should get things back in sync.
 ;;;
 ;;; 3. Ange-ftp does not check to make sure that when creating a new file,
 ;;;    you provide a valid filename for the remote operating system.
@@ -653,6 +653,7 @@ parenthesized expressions in REGEXP for the components (in that order).")
 (defvar ange-ftp-skip-msgs
   (concat "^200 \\(PORT\\|Port\\) \\|^331 \\|^150 \\|^350 \\|^[0-9]+ bytes \\|"
 	  "^Connected \\|^$\\|^Remote system\\|^Using\\|^ \\|Password:\\|"
+	  "^Data connection \\|"
 	  "^local:\\|^Trying\\|^125 \\|^550-\\|^221 .*oodbye")
   "*Regular expression matching ftp messages that can be ignored.")
 
@@ -926,9 +927,12 @@ SIZE, if supplied, should be a prime number."
 Args are as in `message': a format string, plus arguments to be formatted."
   (let ((msg (apply (function format) fmt args))
 	(max (window-width (minibuffer-window))))
-    (if (>= (length msg) max)
-	(setq msg (concat "> " (substring msg (- 3 max)))))
-    (message "%s" msg)))
+    (if noninteractive
+	msg
+      (if (>= (length msg) max)
+	  ;; Take just the last MAX - 3 chars of the string.
+	  (setq msg (concat "> " (substring msg (- 3 max)))))
+      (message "%s" msg))))
 
 (defun ange-ftp-abbreviate-filename (file &optional new)
   "Abbreviate the file name FILE relative to the default-directory.
@@ -1195,9 +1199,11 @@ Optional DEFAULT is password to start with."
   ;; We set this before actually doing it to avoid the possibility
   ;; of an infinite loop if ange-ftp-netrc-filename is an FTP file.
   (interactive)
-  (let* ((file (ange-ftp-chase-symlinks
-		(ange-ftp-real-expand-file-name ange-ftp-netrc-filename)))
-	 (attr (ange-ftp-real-file-attributes file)))
+  (let (file attr)
+    (let ((default-directory "/"))
+      (setq file (ange-ftp-chase-symlinks
+		  (ange-ftp-real-expand-file-name ange-ftp-netrc-filename)))
+      (setq attr (ange-ftp-real-file-attributes file)))
     (if (and attr			; file exists.
 	     (not (equal (nth 5 attr) ange-ftp-netrc-modtime)))	; file changed
 	(save-match-data
@@ -1270,7 +1276,7 @@ Optional DEFAULT is password to start with."
     (setq ange-ftp-ftp-name-arg name
 	  ange-ftp-ftp-name-res
 	  (save-match-data
-	    (if (string-match (car ange-ftp-name-format) name)
+	    (if (posix-string-match (car ange-ftp-name-format) name)
 		(let* ((ns (cdr ange-ftp-name-format))
 		       (host (ange-ftp-ftp-name-component 0 ns name))
 		       (user (ange-ftp-ftp-name-component 1 ns name))
@@ -1284,7 +1290,7 @@ Optional DEFAULT is password to start with."
 ;; replace the name component with NAME.
 (defun ange-ftp-replace-name-component (fullname name)
   (save-match-data
-    (if (string-match (car ange-ftp-name-format) fullname)
+    (if (posix-string-match (car ange-ftp-name-format) fullname)
 	(let* ((ns (cdr ange-ftp-name-format))
 	       (elt (nth 2 ns)))
 	  (concat (substring fullname 0 (match-beginning elt))
@@ -1416,7 +1422,8 @@ good, skip, fatal, or unknown."
 	ange-ftp-hash-mark-count (+ (- (match-end 0)
 				       (match-beginning 0))
 				    ange-ftp-hash-mark-count))
-  (and ange-ftp-process-msg
+  (and ange-ftp-hash-mark-unit
+       ange-ftp-process-msg
        ange-ftp-process-verbose
        (not (eq (selected-window) (minibuffer-window)))
        (not (boundp 'search-message))	;screws up isearch otherwise
@@ -1460,8 +1467,7 @@ good, skip, fatal, or unknown."
 	      (set-buffer (process-buffer proc))
 	      
 	      ;; handle hash mark printing
-	      (and ange-ftp-hash-mark-unit
-		   ange-ftp-process-busy
+	      (and ange-ftp-process-busy
 		   (string-match "^#+$" str)
 		   (setq str (ange-ftp-process-handle-hash str)))
 	      (comint-output-filter proc str)
@@ -1517,7 +1523,7 @@ good, skip, fatal, or unknown."
 (defun ange-ftp-process-sentinel (proc str)
   "When ftp process changes state, nuke all file-entries in cache."
   (let ((name (process-name proc)))
-    (if (string-match "\\*ftp \\([^@]+\\)@\\([^*]+\\)*" name)
+    (if (string-match "\\*ftp \\([^@]+\\)@\\([^*]+\\)\\*" name)
 	(let ((user (substring name (match-beginning 1) (match-end 1)))
 	      (host (substring name (match-beginning 2) (match-end 2))))
 	  (ange-ftp-wipe-file-entries host user))))
@@ -1596,8 +1602,10 @@ good, skip, fatal, or unknown."
 
 (defun ange-ftp-gwp-filter (proc str)
   (comint-output-filter proc str)
-  ;; Replace STR by the result of the comint processing.
-  (setq str (buffer-substring comint-last-output-start (process-mark proc)))
+  (save-excursion
+    (set-buffer (process-buffer proc))
+    ;; Replace STR by the result of the comint processing.
+    (setq str (buffer-substring comint-last-output-start (process-mark proc))))
   (cond ((string-match "login: *$" str)
 	 (send-string proc
 		      (concat
@@ -1770,7 +1778,10 @@ on the gateway machine to do the ftp instead."
     ;; It would be nice to make process-connection-type nil,
     ;; but that doesn't work: ftp never responds.
     ;; Can anyone find a fix for that?
-    (let ((process-connection-type t))
+    (let ((process-connection-type t)
+	  (process-environment process-environment))
+      ;; This tells GNU ftp not to output any fancy escape sequences.
+      (setenv "TERM" "dumb")
       (if use-gateway
 	  (if ange-ftp-gateway-program-interactive
 	      (setq proc (ange-ftp-gwp-start host user name args))
@@ -1818,6 +1829,10 @@ on the gateway machine to do the ftp instead."
     (setq ange-ftp-process-result-line "")
 
     (setq comint-prompt-regexp "^ftp> ")
+    (make-local-variable 'comint-password-prompt-regexp)
+    ;; This is a regexp that can't match anything.
+    ;; ange-ftp has its own ways of handling passwords.
+    (setq comint-password-prompt-regexp "^a\\'z")
     (make-local-variable 'paragraph-start)
     (setq paragraph-start comint-prompt-regexp)))
 
@@ -1856,9 +1871,10 @@ host specified in ``ange-ftp-gateway-host''."
 (defun ange-ftp-normal-login (host user pass account proc)
   "Connect to the FTP-server on HOST as USER using PASSWORD and ACCOUNT.
 PROC is the process to the FTP-client."
-  (let ((result (ange-ftp-raw-send-cmd
+  (let* ((nshost (ange-ftp-nslookup-host host))
+	 (result (ange-ftp-raw-send-cmd
 		 proc
-		 (format "open %s" (ange-ftp-nslookup-host host))
+		 (format "open %s" nshost)
 		 (format "Opening FTP connection to %s" host))))
     (or (car result)
 	(ange-ftp-error host user
@@ -1866,7 +1882,9 @@ PROC is the process to the FTP-client."
 				(cdr result))))
     (setq result (ange-ftp-raw-send-cmd
 		  proc
-		  (format "user \"%s\" %s %s" user pass account)
+		  (if (ange-ftp-use-smart-gateway-p host)
+		      (format "user \"%s\"@%s %s %s" user nshost pass account)
+		    (format "user \"%s\" %s %s" user pass account))
 		  (format "Logging in as user %s@%s" user host)))
     (or (car result)
 	(progn
@@ -2194,7 +2212,7 @@ Works by doing a pwd and examining the directory syntax."
 ;; Returns whether HOST's FTP server doesn't like \'ls\' or \'dir\' commands
 ;; to take switch arguments.
 (defun ange-ftp-dumb-unix-host (host)
-  (and ange-ftp-dumb-unix-host-regexp
+  (and host ange-ftp-dumb-unix-host-regexp
        (save-match-data
 	 (string-match ange-ftp-dumb-unix-host-regexp host))))
 
@@ -2224,7 +2242,7 @@ which can parse the output from a DIR listing for a host of type TYPE.")
 ;; 
 ;; With no-error t, it returns:
 ;; an error if not an ange-ftp-name
-;; error if listing is unreable (most likely caused by a slow connection)
+;; error if listing is unreadable (most likely caused by a slow connection)
 ;; nil if ftp error (this is because although asking to list a nonexistent
 ;;                   directory on a remote unix machine usually (except
 ;;                   maybe for dumb hosts) returns an ls error, but no
@@ -3688,7 +3706,8 @@ system TYPE.")
 	(while (and tryfiles (not copy))
 	  (condition-case error
 	      (setq copy (ange-ftp-file-local-copy (car tryfiles)))
-	    (ftp-error nil)))
+	    (ftp-error nil))
+	  (setq tryfiles (cdr tryfiles)))
 	(if copy
 	    (unwind-protect
 		(funcall 'load copy noerror nomessage nosuffix)
@@ -3818,10 +3837,11 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
 
 ;;; This regexp takes care of real ange-ftp file names (with a slash
 ;;; and colon).
+;;; Don't allow the host name to end in a period--some systems use /.:
 ;;;###autoload
-(or (assoc "^/[^/:]*[^/:]:" file-name-handler-alist)
+(or (assoc "^/[^/:]*[^/:.]:" file-name-handler-alist)
     (setq file-name-handler-alist
-	  (cons '("^/[^/:]*[^/:]:" . ange-ftp-hook-function)
+	  (cons '("^/[^/:]*[^/:.]:" . ange-ftp-hook-function)
 		file-name-handler-alist)))
 
 ;;; This regexp recognizes and absolute filenames with only one component,
@@ -4826,7 +4846,7 @@ Other orders of $ and _ seem to all work just fine.")
 ;;	  (cons '(vms . ange-ftp-dired-vms-ls-trim)
 ;;		ange-ftp-dired-ls-trim-alist)))	
 
-(defun ange-ftp-vms-sans-version (name)
+(defun ange-ftp-vms-sans-version (name &rest args)
   (save-match-data
     (if (string-match ";[0-9]+$" name)
 	(substring name 0 (match-beginning 0))