;;; ange-ftp.el --- transparent FTP support for GNU Emacs
-;;; Copyright (C) 1989,90,91,92,93,94 Free Software Foundation, Inc.
+;;; Copyright (C) 1989,90,91,92,93,94,95 Free Software Foundation, Inc.
;;;
;; Author: Andy Norman (ange@hplb.hpl.hp.com)
;; Keywords: comm
;;; 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.
(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.")
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.
;; 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
(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))
;; 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))
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
(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)
(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))))
(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
;; 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))
(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)))
(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
(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
;; 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))))
;;
;; 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
(user (nth 1 parsed))
(name (ange-ftp-quote-string (nth 2 parsed)))
(temp (ange-ftp-make-tmp-name host))
- (binary (ange-ftp-binary-file filename))
+ (binary (or (ange-ftp-binary-file filename)
+ (eq (ange-ftp-host-type host user) 'unix)))
(cmd (if append 'append 'put))
(abbr (ange-ftp-abbreviate-filename filename)))
(unwind-protect
(user (nth 1 parsed))
(name (ange-ftp-quote-string (nth 2 parsed)))
(temp (ange-ftp-make-tmp-name host))
- (binary (ange-ftp-binary-file filename))
+ (binary (or (ange-ftp-binary-file filename)
+ (eq (ange-ftp-host-type host user) 'unix)))
(abbr (ange-ftp-abbreviate-filename filename))
size)
(unwind-protect
(t-name (and t-parsed (ange-ftp-quote-string (nth 2 t-parsed))))
(t-abbr (ange-ftp-abbreviate-filename newname filename))
(binary (or (ange-ftp-binary-file filename)
- (ange-ftp-binary-file newname)))
+ (ange-ftp-binary-file newname)
+ (and (eq (ange-ftp-host-type f-host f-user) 'unix)
+ (eq (ange-ftp-host-type t-host t-user) 'unix))))
temp1
temp2)
;;;; File renaming support.
;;;; ------------------------------------------------------------
-(defun ange-ftp-rename-remote-to-remote (filename newname f-parsed t-parsed
- binary)
+(defun ange-ftp-rename-remote-to-remote (filename newname f-parsed t-parsed)
"Rename remote file FILE to remote file NEWNAME."
(let ((f-host (nth 0 f-parsed))
(f-user (nth 1 f-parsed))
(setq filename (expand-file-name filename))
(setq newname (expand-file-name newname))
(let* ((f-parsed (ange-ftp-ftp-name filename))
- (t-parsed (ange-ftp-ftp-name newname))
- (binary (if (or f-parsed t-parsed) (ange-ftp-binary-file filename))))
+ (t-parsed (ange-ftp-ftp-name newname)))
(if (and (or f-parsed t-parsed)
(or (not ok-if-already-exists)
(numberp ok-if-already-exists)))
(if f-parsed
(if t-parsed
(ange-ftp-rename-remote-to-remote filename newname f-parsed
- t-parsed binary)
+ t-parsed)
(ange-ftp-rename-remote-to-local filename newname))
(if t-parsed
(ange-ftp-rename-local-to-remote filename newname)
(let* ((fn1 (expand-file-name file))
(pa1 (ange-ftp-ftp-name fn1)))
(if pa1
- (let* ((tmp1 (ange-ftp-make-tmp-name (car pa1)))
- (bin1 (ange-ftp-binary-file fn1)))
+ (let ((tmp1 (ange-ftp-make-tmp-name (car pa1))))
(ange-ftp-copy-file-internal fn1 tmp1 t nil
(format "Getting %s" fn1))
tmp1))))
(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)
;;; 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,
;; (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))