;;; 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
;;; specially. The variable `ange-ftp-generate-anonymous-password'
;;; controls what happens: if the value of this variable is a string,
;;; then this is used as the password; if non-nil (the default), then
-;;; a password is created from the name of the user and the hostname
-;;; of the machine on which GNU Emacs is running; if nil then the user
+;;; the value of `user-mail-address' is used; if nil then the user
;;; is prompted for a password as normal.
;;; "Dumb" UNIX hosts:
;;; If you have a "smart" ftp program that allows you to issue commands like
;;; "USER foo@bar" which do nice proxy things, then look at the variables
;;; ange-ftp-smart-gateway and ange-ftp-smart-gateway-port.
+;;;
+;;; Otherwise, if there is an alternate ftp program that implements proxy in
+;;; a transparent way (i.e. w/o specifying the proxy host), that will
+;;; connect you directly to the desired destination host:
+;;; Set ange-ftp-gateway-ftp-program-name to that program's name.
+;;; Set ange-ftp-local-host-regexp to a value as stated earlier on.
+;;; Leave ange-ftp-gateway-host set to nil.
+;;; Set ange-ftp-smart-gateway to t.
;;; Tips for using ange-ftp:
;;;
;;; 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.")
"*Account password to use when the user is the same as ange-ftp-default-user.")
(defvar ange-ftp-generate-anonymous-password t
- "*If t, use a password of user@host when logging in as the anonymous user.
-If a string then use that as the password.
-If nil then prompt the user for a password.")
+ "*If t, use value of `user-mail-address' as password for anonymous ftp.
+If a string, then use that string as the password.
+If nil, prompt the user for a password.")
(defvar ange-ftp-dumb-unix-host-regexp nil
"*If non-nil, regexp matching hosts on which `dir' command lists directory.")
(defvar ange-ftp-local-host-regexp ".*"
"*Regexp selecting hosts which can be reached directly with ftp.
For other hosts the FTP process is started on \`ange-ftp-gateway-host\'
-instead.")
+instead, and/or reached via \`ange-ftp-gateway-ftp-program-name\'.")
(defvar ange-ftp-gateway-program-interactive nil
"*If non-nil then the gateway program should give a shell prompt.
Both telnet and rlogin do something like this.")
-(defvar ange-ftp-gateway-program (if (eq system-type 'hpux) "remsh" "rsh")
+(defvar ange-ftp-gateway-program remote-shell-program
"*Name of program to spawn a shell on the gateway machine.
-Valid candidates are rsh (remsh on hp-ux), telnet and rlogin. See
+Valid candidates are rsh (remsh on some systems), telnet and rlogin. See
also the gateway variable above.")
(defvar ange-ftp-gateway-prompt-pattern "^[^#$%>;\n]*[#$%>;] *"
arrange to strip out trailing ^M characters.")
(defvar ange-ftp-smart-gateway nil
- "*Non-nil means the ftp gateway is smart.
-Don't bother telnetting, etc., just issue a user@host command instead.")
+ "*Non-nil means the ftp gateway and/or the gateway ftp program is smart.
+Don't bother telnetting, etc., already connected to desired host transparently,
+or just issue a user@host command in case \`ange-ftp-gateway-host\' is non-nil.")
(defvar ange-ftp-smart-gateway-port "21"
"*Port on gateway machine to use when smart gateway is in operation.")
"*Name of FTP program to run.")
(defvar ange-ftp-gateway-ftp-program-name "ftp"
- "*Name of FTP program to run on gateway machine.
+ "*Name of FTP program to run when accessing non-local hosts.
Some AT&T folks claim to use something called `pftp' here.")
(defvar ange-ftp-ftp-program-args '("-i" "-n" "-g" "-v")
;;;; Internal variables.
;;;; ------------------------------------------------------------
-(defconst ange-ftp-version "$Revision: 1.53 $")
-
(defvar ange-ftp-data-buffer-name " *ftp data*"
"Buffer name to hold directory listing data received from ftp process.")
;; (put 'ftp-error 'error-message "FTP error")
\f
;;; ------------------------------------------------------------
-;;; Match-data support (stolen from Kyle I think)
-;;; ------------------------------------------------------------
-
-(defmacro ange-ftp-save-match-data (&rest body)
- "Execute the BODY forms, restoring the global value of the match data.
-Also makes matching case-sensitive within BODY."
- (let ((original (make-symbol "match-data"))
- case-fold-search)
- (list
- 'let (list (list original '(match-data)))
- (list 'unwind-protect
- (cons 'progn body)
- (list 'store-match-data original)))))
-
-(put 'ange-ftp-save-match-data 'lisp-indent-hook 0)
-(put 'ange-ftp-save-match-data 'edebug-form-hook '(&rest form))
-\f
-;;; ------------------------------------------------------------
;;; Enhanced message support.
;;; ------------------------------------------------------------
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.
If the optional parameter NEW is given and the non-directory parts match,
only return the directory part of FILE."
- (ange-ftp-save-match-data
+ (save-match-data
(if (and default-directory
(string-match (concat "^"
(regexp-quote default-directory)
(if (ange-ftp-lookup-passwd host user)
(throw 'found-one host))))
ange-ftp-user-hashtable)
- (ange-ftp-save-match-data
+ (save-match-data
(ange-ftp-map-hashtable
(function
(lambda (key value)
ange-ftp-generate-anonymous-password)
(if (stringp ange-ftp-generate-anonymous-password)
ange-ftp-generate-anonymous-password
- (concat (user-login-name) "@" (system-name))))
+ user-mail-address))
;; see if same user has logged in to other hosts; if so then prompt
;; with the password that was used there.
;; record the information found.
(defun ange-ftp-parse-netrc-group ()
- (beginning-of-line)
(let ((start (point))
- (end (progn (re-search-forward "machine\\|default"
- (point-max) 'end 2) (point)))
+ (end (save-excursion
+ (if (looking-at "machine\\>")
+ ;; Skip `machine' and the machine name that follows.
+ (progn
+ (skip-chars-forward "^ \t\n")
+ (skip-chars-forward " \t\n")
+ (skip-chars-forward "^ \t\n"))
+ ;; Skip `default'.
+ (skip-chars-forward "^ \t\n"))
+ ;; Find start of the next `machine' or `default'
+ ;; or the end of the buffer.
+ (if (re-search-forward "machine\\>\\|default\\>" nil t)
+ (match-beginning 0)
+ (point-max))))
machine login password account)
- (goto-char start)
(setq machine (ange-ftp-parse-netrc-token "machine" end)
login (ange-ftp-parse-netrc-token "login" end)
password (ange-ftp-parse-netrc-token "password" end)
;; 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
- (ange-ftp-save-match-data
+ (save-match-data
(if (or ange-ftp-disable-netrc-security-check
(and (eq (nth 2 attr) (user-uid)) ; Same uids.
(string-match ".r..------" (nth 8 attr))))
(mapcar 'funcall find-file-hooks)
(setq buffer-file-name nil)
(goto-char (point-min))
+ (skip-chars-forward " \t\n")
(while (not (eobp))
(ange-ftp-parse-netrc-group))
(kill-buffer (current-buffer)))
(defun ange-ftp-generate-root-prefixes ()
(ange-ftp-parse-netrc)
- (ange-ftp-save-match-data
+ (save-match-data
(let (res)
(ange-ftp-map-hashtable
(function
ange-ftp-ftp-name-res
(setq ange-ftp-ftp-name-arg name
ange-ftp-ftp-name-res
- (ange-ftp-save-match-data
- (if (string-match (car ange-ftp-name-format) name)
+ (save-match-data
+ (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))
;; Take a FULLNAME that matches according to ange-ftp-name-format and
;; replace the name component with NAME.
(defun ange-ftp-replace-name-component (fullname name)
- (ange-ftp-save-match-data
- (if (string-match (car ange-ftp-name-format) fullname)
+ (save-match-data
+ (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))
"Set correct modes for the current buffer if visiting a remote file."
(if (and (stringp buffer-file-name)
(ange-ftp-ftp-name buffer-file-name))
- (progn
- (make-local-variable 'make-backup-files)
- (setq make-backup-files ange-ftp-make-backup-files)
- (auto-save-mode ange-ftp-auto-save))))
+ (auto-save-mode ange-ftp-auto-save)))
(defun ange-ftp-kill-ftp-process (buffer)
"Kill the FTP process associated with BUFFER.
(setq ange-ftp-process-busy nil
ange-ftp-process-result t
ange-ftp-process-result-line line))
+ ;; Check this before checking for errors.
+ ;; Otherwise the last line of these three seems to be an error:
+ ;; 230-see a significant impact from the move. For those of you who can't
+ ;; 230-use DNS to resolve hostnames and get an error message like
+ ;; 230-"ftp.stsci.edu: unknown host", the new IP address will be...
+ ((string-match ange-ftp-multi-msgs line)
+ (setq ange-ftp-process-multi-skip t))
((string-match ange-ftp-fatal-msgs line)
(delete-process proc)
(setq ange-ftp-process-busy nil
ange-ftp-process-result-line line))
- ((string-match ange-ftp-multi-msgs line)
- (setq ange-ftp-process-multi-skip t))
(ange-ftp-process-multi-skip
t)
(t
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
;; see if the buffer is still around... it could have been deleted.
(if (buffer-name buffer)
(unwind-protect
- (ange-ftp-save-match-data
+ (progn
(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)
+ ;; Replace STR by the result of the comint processing.
+ (setq str (buffer-substring comint-last-output-start
+ (process-mark proc)))
(if ange-ftp-process-busy
(progn
(setq ange-ftp-process-string (concat ange-ftp-process-string
(defun ange-ftp-process-sentinel (proc str)
"When ftp process changes state, nuke all file-entries in cache."
- (ange-ftp-save-match-data
- (let ((name (process-name proc)))
- (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))))
- (setq ange-ftp-ls-cache-file nil)))
+ (let ((name (process-name proc)))
+ (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))))
+ (setq ange-ftp-ls-cache-file nil))
\f
;;;; ------------------------------------------------------------
;;;; Gateway support.
;; yes, I know that I could simplify the following expression, but it is
;; clearer (to me at least) this way.
(and (not ange-ftp-smart-gateway)
- (ange-ftp-save-match-data
+ (save-match-data
(not (string-match ange-ftp-local-host-regexp host)))))
(defun ange-ftp-use-smart-gateway-p (host)
"Returns whether to access this host via a smart gateway."
(and ange-ftp-smart-gateway
- (ange-ftp-save-match-data
+ (save-match-data
(not (string-match ange-ftp-local-host-regexp host)))))
\f
(setq ange-ftp-gwp-running nil))
(defun ange-ftp-gwp-filter (proc str)
- (ange-ftp-save-match-data
- (comint-output-filter proc str)
- (cond ((string-match "login: *$" str)
- (send-string proc
- (concat
- (let ((ange-ftp-default-user t))
- (ange-ftp-get-user ange-ftp-gateway-host))
- "\n")))
- ((string-match "Password: *$" str)
- (send-string proc
- (concat
- (ange-ftp-get-passwd ange-ftp-gateway-host
- (ange-ftp-get-user
- ange-ftp-gateway-host))
- "\n")))
- ((string-match ange-ftp-gateway-fatal-msgs str)
- (delete-process proc)
- (setq ange-ftp-gwp-running nil))
- ((string-match ange-ftp-gateway-prompt-pattern str)
- (setq ange-ftp-gwp-running nil
- ange-ftp-gwp-status t)))))
+ (comint-output-filter proc str)
+ (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
+ (let ((ange-ftp-default-user t))
+ (ange-ftp-get-user ange-ftp-gateway-host))
+ "\n")))
+ ((string-match "Password: *$" str)
+ (send-string proc
+ (concat
+ (ange-ftp-get-passwd ange-ftp-gateway-host
+ (ange-ftp-get-user
+ ange-ftp-gateway-host))
+ "\n")))
+ ((string-match ange-ftp-gateway-fatal-msgs str)
+ (delete-process proc)
+ (setq ange-ftp-gwp-running nil))
+ ((string-match ange-ftp-gateway-prompt-pattern str)
+ (setq ange-ftp-gwp-running nil
+ ange-ftp-gwp-status t))))
(defun ange-ftp-gwp-start (host user name args)
"Login to the gateway machine and fire up an ftp process."
(goto-char (point-max))
(move-marker comint-last-input-start (point))
;; don't insert the password into the buffer on the USER command.
- (ange-ftp-save-match-data
+ (save-match-data
(if (string-match "^user \"[^\"]*\"" cmd)
(insert (substring cmd 0 (match-end 0)) " Turtle Power!\n")
(insert cmd)))
If HOST is only ftp-able through a gateway machine then spawn a shell
on the gateway machine to do the ftp instead."
(let* ((use-gateway (ange-ftp-use-gateway-p host))
- (ftp-prog (if use-gateway
+ (use-smart-ftp (and (not ange-ftp-gateway-host)
+ (ange-ftp-use-smart-gateway-p host)))
+ (ftp-prog (if (or use-gateway
+ use-smart-ftp)
ange-ftp-gateway-ftp-program-name
ange-ftp-ftp-program-name))
(args (append (list ftp-prog) ange-ftp-ftp-program-args))
;; 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
(let* ((status (ange-ftp-raw-send-cmd proc "hash"))
(result (car status))
(line (cdr status)))
- (ange-ftp-save-match-data
+ (save-match-data
(if (string-match ange-ftp-hash-mark-msgs line)
(let ((size (string-to-int
(substring line
(setq proc (ange-ftp-start-process host user name))
;; login to FTP server.
- (if (ange-ftp-use-smart-gateway-p host)
+ (if (and (ange-ftp-use-smart-gateway-p host)
+ ange-ftp-gateway-host)
(ange-ftp-smart-login host user pass account proc)
(ange-ftp-normal-login host user pass account proc))
(key (concat host "/" user "/~")))
(if (eq host-type 'unix)
;; Note that ange-ftp-host-type returns unix as the default value.
- (ange-ftp-save-match-data
+ (save-match-data
(let* ((result (ange-ftp-get-pwd host user))
(dir (car result))
fix-name-func)
;; 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
- (ange-ftp-save-match-data
+ (and host ange-ftp-dumb-unix-host-regexp
+ (save-match-data
(string-match ange-ftp-dumb-unix-host-regexp host))))
(defun ange-ftp-add-dumb-unix-host (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
;; a listing, then return nil.
(defun ange-ftp-parse-dired-listing (&optional switches)
- (ange-ftp-save-match-data
+ (save-match-data
(cond
((looking-at "^total [0-9]+$")
(forward-line 1)
NO-ERROR, if a listing for DIRECTORY cannot be obtained."
(setq directory (file-name-as-directory directory)) ;normalize
(or (ange-ftp-get-hash-entry directory ange-ftp-files-hashtable)
- (ange-ftp-save-match-data
+ (save-match-data
(and (ange-ftp-ls directory
;; This is an efficiency hack. We try to
;; anticipate what sort of listing dired
(ange-ftp-error host user (concat "BINARY failed: " (cdr result)))
(save-excursion
(set-buffer (process-buffer (ange-ftp-get-process host user)))
- (setq ange-ftp-hash-mark-unit (ash ange-ftp-binary-hash-mark-size -4))))))
+ (and ange-ftp-binary-hash-mark-size
+ (setq ange-ftp-hash-mark-unit
+ (ash ange-ftp-binary-hash-mark-size -4)))))))
(defun ange-ftp-set-ascii-mode (host user)
"Tell the ftp process for the given HOST & USER to switch to ascii mode."
(ange-ftp-error host user (concat "ASCII failed: " (cdr result)))
(save-excursion
(set-buffer (process-buffer (ange-ftp-get-process host user)))
- (setq ange-ftp-hash-mark-unit (ash ange-ftp-ascii-hash-mark-size -4))))))
+ (and ange-ftp-ascii-hash-mark-size
+ (setq ange-ftp-hash-mark-unit
+ (ash ange-ftp-ascii-hash-mark-size -4)))))))
\f
(defun ange-ftp-cd (host user dir)
(let ((result (ange-ftp-send-cmd host user (list 'cd dir) "Doing CD")))
(line (cdr result))
dir)
(if (car result)
- (ange-ftp-save-match-data
+ (save-match-data
(and (or (string-match "\"\\([^\"]*\\)\"" line)
(string-match " \\([^ ]+\\) " line)) ; stone-age VMS servers!
(setq dir (substring line
(error "Unable to obtain CWD")))))
;; If name starts with //, preserve that, for apollo system.
- (if (not (string-match "^//" path))
+ (if (not (string-match "^//" name))
(progn
- (setq path (ange-ftp-real-expand-file-name path))
+ (setq name (ange-ftp-real-expand-file-name name))
- (if (string-match "^//" path)
- (setq path (substring path 1)))))
+ (if (string-match "^//" name)
+ (setq name (substring name 1)))))
;; Now substitute the expanded name back into the overall filename.
(ange-ftp-replace-name-component n name))
(defun ange-ftp-expand-file-name (name &optional default)
"Documented as original."
- (ange-ftp-save-match-data
+ (save-match-data
(if (eq (string-to-char name) ?/)
(while (cond ((string-match "[^:]+//" name) ;don't upset Apollo users
(setq name (substring name (1- (match-end 0)))))
(let ((parsed (ange-ftp-ftp-name name)))
(if parsed
(let ((filename (nth 2 parsed)))
- (if (ange-ftp-save-match-data
+ (if (save-match-data
(string-match "^~[^/]*$" filename))
name
(ange-ftp-replace-name-component
(let ((parsed (ange-ftp-ftp-name name)))
(if parsed
(let ((filename (nth 2 parsed)))
- (if (ange-ftp-save-match-data
+ (if (save-match-data
(string-match "^~[^/]*$" filename))
""
(ange-ftp-real-file-name-nondirectory name)))
;; Returns non-nil if should transfer FILE in binary mode.
(defun ange-ftp-binary-file (file)
- (ange-ftp-save-match-data
+ (save-match-data
(string-match ange-ftp-binary-file-name-regexp file)))
(defun ange-ftp-write-region (start end filename &optional append visit)
(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
(ange-ftp-get-files directory)))
files f)
(setq directory (file-name-as-directory directory))
- (ange-ftp-save-match-data
+ (save-match-data
(while tail
(setq f (car tail)
tail (cdr tail))
(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)
"/"))) ; / never in filename
completion-ignored-extensions
"\\|")))
- (ange-ftp-save-match-data
+ (save-match-data
(or (ange-ftp-file-name-completion-1
file tbl ange-ftp-this-dir
(function ange-ftp-file-entry-not-ignored-p))
(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)
(cdr (assq (ange-ftp-host-type (car parsed))
ange-ftp-make-compressed-filename-alist))))
(let* ((decision
- (ange-ftp-save-match-data (funcall conversion-func name)))
+ (save-match-data (funcall conversion-func name)))
(compressing (car decision))
(newfile (nth 1 decision)))
(if compressing
(ange-ftp-copy-file-internal tmp2 nfile t nil msg2))))
(ange-ftp-del-tmp-name tmp1)
(ange-ftp-del-tmp-name tmp2))))
+
+(defun ange-ftp-find-backup-file-name (fn)
+ ;; Either return the ordinary backup name, etc.,
+ ;; or return nil meaning don't make a backup.
+ (if ange-ftp-make-backup-files
+ (ange-ftp-real-find-backup-file-name fn)))
\f
;;; Define the handler for special file names
;;; that causes ange-ftp to be invoked.
;;; 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,
(put 'dired-uncache 'ange-ftp 'ange-ftp-dired-uncache)
(put 'dired-compress-file 'ange-ftp 'ange-ftp-dired-compress-file)
(put 'load 'ange-ftp 'ange-ftp-load)
+(put 'find-backup-file-name 'ange-ftp 'ange-ftp-find-backup-file-name)
;; Turn off truename processing to save time.
;; Treat each name as its own truename.
(ange-ftp-run-real-handler 'shell-command args))
(defun ange-ftp-real-load (&rest args)
(ange-ftp-run-real-handler 'load args))
+(defun ange-ftp-real-find-backup-file-name (&rest args)
+ (ange-ftp-run-real-handler 'find-backup-file-name args))
\f
;; Here we support using dired on remote hosts.
;; I have turned off the support for using dired on foreign directory formats.
(if func (funcall func file keep-backup-version)
(ange-ftp-real-file-name-sans-versions file keep-backup-version))))
-(defvar ange-ftp-remote-shell-file-name
- (if (memq system-type '(hpux usg-unix-v)) ; hope that's right
- "remsh"
- "rsh")
- "Name of command to run a remote shell, for ange-ftp.")
-
;;; This doesn't work yet; a new hook needs to be created.
;;; Maybe the new hook should be in call-process.
(defun ange-ftp-shell-command (command)
(setq command
(format "%s %s \"%s\"" ; remsh -l USER does not work well
; on a hp-ux machine I tried
- ange-ftp-remote-shell-file-name host command))
+ remote-shell-program host command))
(ange-ftp-message "Remote command '%s' ..." command)
;; Cannot call ange-ftp-real-dired-run-shell-command here as it
;; would prepend "cd default-directory" --- which bombs because
;
;(defun ange-ftp-vos-host (host)
; (and ange-ftp-vos-host-regexp
-; (ange-ftp-save-match-data
+; (save-match-data
; (string-match ange-ftp-vos-host-regexp host))))
;
;(defun ange-ftp-parse-vos-listing ()
; ("^Dirs: [0-9]+\n+" t 30)))
; type-regexp type-is-dir type-col file)
; (goto-char (point-min))
-; (ange-ftp-save-match-data
+; (save-match-data
; (while type-list
; (setq type-regexp (car (car type-list))
; type-is-dir (nth 1 (car type-list))
;; Convert NAME from UNIX-ish to VMS. If REVERSE given then convert from VMS
;; to UNIX-ish.
(defun ange-ftp-fix-name-for-vms (name &optional reverse)
- (ange-ftp-save-match-data
+ (save-match-data
(if reverse
(if (string-match "^\\([^:]+:\\)?\\(\\[.*\\]\\)?\\([^][]*\\)$" name)
(let (drive dir file)
;; Return non-nil if HOST is running VMS.
(defun ange-ftp-vms-host (host)
(and ange-ftp-vms-host-regexp
- (ange-ftp-save-match-data
+ (save-match-data
(string-match ange-ftp-vms-host-regexp host))))
;; Because some VMS ftp servers convert filenames to lower case
(let ((tbl (ange-ftp-make-hashtable))
file)
(goto-char (point-min))
- (ange-ftp-save-match-data
+ (save-match-data
(while (setq file (ange-ftp-parse-vms-filename))
(if (string-match "\\.\\(DIR\\|dir\\);[0-9]+" file)
;; deal with directories
(defun ange-ftp-vms-delete-file-entry (name &optional dir-p)
(if dir-p
(ange-ftp-internal-delete-file-entry name t)
- (ange-ftp-save-match-data
+ (save-match-data
(let ((file (ange-ftp-get-file-part name)))
(if (string-match ";[0-9]+$" file)
;; In VMS you can't delete a file without an explicit
ange-ftp-files-hashtable)))
(if files
(let ((file (ange-ftp-get-file-part name)))
- (ange-ftp-save-match-data
+ (save-match-data
(if (string-match ";[0-9]+$" file)
(ange-ftp-put-hash-entry
(substring file 0 (match-beginning 0))
(defun ange-ftp-vms-file-name-as-directory (name)
- (ange-ftp-save-match-data
+ (save-match-data
(if (string-match "\\.\\(DIR\\|dir\\)\\(;[0-9]+\\)?$" name)
(setq name (substring name 0 (match-beginning 0))))
(ange-ftp-real-file-name-as-directory name)))
;; (cons '(vms . ange-ftp-dired-vms-ls-trim)
;; ange-ftp-dired-ls-trim-alist)))
-(defun ange-ftp-vms-sans-version (name)
- (ange-ftp-save-match-data
+(defun ange-ftp-vms-sans-version (name &rest args)
+ (save-match-data
(if (string-match ";[0-9]+$" name)
(substring name 0 (match-beginning 0))
name)))
;; Convert NAME from UNIX-ish to MTS. If REVERSE given then convert from
;; MTS to UNIX-ish.
(defun ange-ftp-fix-name-for-mts (name &optional reverse)
- (ange-ftp-save-match-data
+ (save-match-data
(if reverse
(if (string-match "^\\([^:]+:\\)?\\(.*\\)$" name)
(let (acct file)
;; Return non-nil if HOST is running MTS.
(defun ange-ftp-mts-host (host)
(and ange-ftp-mts-host-regexp
- (ange-ftp-save-match-data
+ (save-match-data
(string-match ange-ftp-mts-host-regexp host))))
;; Parse the current buffer which is assumed to be in mts ftp dir format.
(defun ange-ftp-parse-mts-listing ()
(let ((tbl (ange-ftp-make-hashtable)))
(goto-char (point-min))
- (ange-ftp-save-match-data
+ (save-match-data
(while (re-search-forward ange-ftp-date-regexp nil t)
(end-of-line)
(skip-chars-backward " ")
;; Have I got the filename character set right?
(defun ange-ftp-fix-name-for-cms (name &optional reverse)
- (ange-ftp-save-match-data
+ (save-match-data
(if reverse
;; Since we only convert output from a pwd in this direction,
;; we'll assume that it's a minidisk, and make it into a
;; Return non-nil if HOST is running CMS.
(defun ange-ftp-cms-host (host)
(and ange-ftp-cms-host-regexp
- (ange-ftp-save-match-data
+ (save-match-data
(string-match ange-ftp-cms-host-regexp host))))
(defun ange-ftp-add-cms-host (host)
;; Now do the usual parsing
(let ((tbl (ange-ftp-make-hashtable)))
(goto-char (point-min))
- (ange-ftp-save-match-data
+ (save-match-data
(while
(re-search-forward
"^\\([-A-Z0-9$_]+\\) +\\([-A-Z0-9$_]+\\) +[VF] +[0-9]+ " nil t)