;;; ange-ftp.el --- transparent FTP support for GNU Emacs
-;; Copyright (C) 1989-1996, 1998, 2000-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1989-1996, 1998, 2000-2015 Free Software Foundation,
+;; Inc.
;; Author: Andy Norman (ange@hplb.hpl.hp.com)
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: comm
;; This file is part of GNU Emacs.
;;
;; Filename syntax:
;;
-;; CMS filenames are entered in a UNIX-y way. In otherwords, minidisks are
+;; CMS filenames are entered in a UNIX-y way. In other words, minidisks are
;; treated as UNIX directories. For example to access the file READ.ME in
;; minidisk *.311 on cuvmb.cc.columbia.edu, you would enter
;; /anonymous@cuvmb.cc.columbia.edu:/*.311/READ.ME
"Regular expression matching the start of a multiline FTP reply.")
(defvar ange-ftp-good-msgs
- "^220 \\|^230 \\|^226 \\|^25. \\|^221 \\|^200 \\|^[Hh]ash mark"
+ "^220 \\|^230 \\|^226 \\|^25. \\|^221 \\|^200 \\|^[Hh]ash mark\\|^Remote directory:"
"Regular expression matching FTP \"success\" messages.")
;; CMS and the odd VMS machine say 200 Port rather than 200 PORT.
"^Data connection \\|"
"^local:\\|^Trying\\|^125 \\|^550-\\|^221 .*oodbye\\|"
"^500 .*AUTH\\|^KERBEROS\\|"
+ "^500 This security scheme is not implemented\\|"
"^504 Unknown security mechanism\\|"
"^530 Please login with USER and PASS\\|" ; non kerberized vsFTPd
"^534 Kerberos Authentication not enabled\\|"
- "^22[789] .*[Pp]assive\\|^200 EPRT\\|^500 .*EPRT")
+ "^22[789] .*[Pp]assive\\|^200 EPRT\\|^500 .*EPRT\\|^500 .*EPSV")
"Regular expression matching FTP messages that can be ignored."
:group 'ange-ftp
+ :version "24.4" ; add EPSV
:type 'regexp)
(defcustom ange-ftp-fatal-msgs
(defvar ange-ftp-trample-marker)
\f
;; New error symbols.
-(put 'ftp-error 'error-conditions '(ftp-error file-error error))
-;; (put 'ftp-error 'error-message "FTP error")
+(define-error 'ftp-error nil 'file-error) ;"FTP error"
\f
;;; ------------------------------------------------------------
;;; Enhanced message support.
files ange-ftp-files-hashtable)))
(defun ange-ftp-switches-ok (switches)
- "Return SWITCHES (a string) if suitable for our use."
+ "Return SWITCHES (a string) if suitable for use with ls over ftp."
(and (stringp switches)
- ;; We allow the A switch, which lists all files except "." and
- ;; "..". This is OK because we manually insert these entries
- ;; in the hash table.
+ ;; We allow the --almost-all switch, which lists all files
+ ;; except "." and "..". This is OK because we manually
+ ;; insert these entries in the hash table.
(string-match
- "--\\(almost-\\)?all\\>\\|\\(\\`\\| \\)-[[:alpha:]]*[aA]" switches)
+ "--\\(almost-\\)?all\\>\\|\\(\\`\\| \\)-[[:alpha:]]*[aA]"
+ switches)
+ ;; Disallow other long flags except --(almost-)all.
+ (not (string-match "\\(\\`\\| \\)--\\w+"
+ (replace-regexp-in-string
+ "--\\(almost-\\)?all\\>" ""
+ switches)))
+ ;; Must include 'l'.
(string-match "\\(\\`\\| \\)-[[:alpha:]]*l" switches)
+ ;; Disallow recursive flag.
(not (string-match
- "--recursive\\>\\|\\(\\`\\| \\)-[[:alpha:]]*R" switches))
+ "\\(\\`\\| \\)-[[:alpha:]]*R" switches))
switches))
(defun ange-ftp-get-files (directory &optional no-error)
(if (car result)
(save-match-data
(and (or (string-match "\"\\([^\"]*\\)\"" line)
+ ;; Some clients cache the value and return it in
+ ;; this way without asking the server. (Bug#15058)
+ (string-match "^Remote directory: \\(.*\\)" line)
(string-match " \\([^ ]+\\) " line)) ; stone-age VMS servers!
(setq dir (match-string 1 line)))))
(cons dir line)))
(name (ange-ftp-quote-string (nth 2 parsed)))
(temp (ange-ftp-make-tmp-name host))
(binary (ange-ftp-binary-file filename))
- (buffer-file-type buffer-file-type)
(abbr (ange-ftp-abbreviate-filename filename))
(coding-system-used last-coding-system-used)
size)
size
(nth 1 (ange-ftp-real-insert-file-contents
temp visit beg end replace))
- coding-system-used last-coding-system-used
- ;; override autodetection of buffer file type
- ;; to ensure buffer is saved in DOS format
- buffer-file-type binary)
+ coding-system-used last-coding-system-used)
(signal 'ftp-error
(list
"Opening input file:"
;; next part of copying routine.
(defun ange-ftp-cf1 (result line
filename newname binary msg
- f-parsed f-host f-user f-name f-abbr
+ f-parsed f-host f-user _f-name f-abbr
t-parsed t-host t-user t-name t-abbr
temp1 temp2 cont nowait)
(if line
(defun ange-ftp-copy-file (filename newname &optional ok-if-already-exists
keep-date preserve-uid-gid
- preserve-selinux-context)
+ _preserve-selinux-context)
(interactive "fCopy file: \nFCopy %s to file: \np")
(ange-ftp-copy-file-internal filename
newname
(or (file-exists-p parent)
(ange-ftp-make-directory parent parents))))
(if (file-exists-p dir)
- (error "Cannot make directory %s: file already exists" dir)
+ (unless parents
+ (error "Cannot make directory %s: file already exists" dir))
(let ((parsed (ange-ftp-ftp-name dir)))
(if parsed
(let* ((host (nth 0 parsed))
(while (and tryfiles (not copy))
(catch 'ftp-error
(let ((ange-ftp-waiting-flag t))
- (condition-case error
+ (condition-case _error
(setq copy (ange-ftp-file-local-copy (car tryfiles)))
(ftp-error nil))))
(setq tryfiles (cdr tryfiles)))
(ange-ftp-real-load file noerror nomessage nosuffix)))
;; Calculate default-unhandled-directory for a given ange-ftp buffer.
-(defun ange-ftp-unhandled-file-name-directory (filename)
+(defun ange-ftp-unhandled-file-name-directory (_filename)
nil)
\f
;;; Define ways of getting at unmodified Emacs primitives,
;;; turning off our handler.
-;(defun ange-ftp-run-real-handler (operation args)
-; (let ((inhibit-file-name-handlers
-; (cons 'ange-ftp-hook-function
-; (cons 'ange-ftp-completion-hook-function
-; (and (eq inhibit-file-name-operation operation)
-; inhibit-file-name-handlers))))
-; (inhibit-file-name-operation operation))
-; (apply operation args)))
+(defun ange-ftp-run-real-handler-orig (operation args)
+ (let ((inhibit-file-name-handlers
+ (cons 'ange-ftp-hook-function
+ (cons 'ange-ftp-completion-hook-function
+ (and (eq inhibit-file-name-operation operation)
+ inhibit-file-name-handlers))))
+ (inhibit-file-name-operation operation))
+ (apply operation args)))
-(defalias 'ange-ftp-run-real-handler 'tramp-run-real-handler)
+(defalias 'ange-ftp-run-real-handler
+ (if (fboundp 'tramp-run-real-handler)
+ 'tramp-run-real-handler 'ange-ftp-run-real-handler-orig))
(defun ange-ftp-real-file-name-directory (&rest args)
(ange-ftp-run-real-handler 'file-name-directory args))
(defun ange-ftp-shell-command (command &optional output-buffer error-buffer)
(let* ((parsed (ange-ftp-ftp-name default-directory))
(host (nth 0 parsed))
- (user (nth 1 parsed))
(name (nth 2 parsed)))
(if (not parsed)
(ange-ftp-real-shell-command command output-buffer error-buffer)
(forward-line 1))
;; Would like to look for a "Total" line, or a "Directory" line to
;; make sure that the listing isn't complete garbage before putting
- ;; in "." and "..", but we can't even count on all VAX's giving us
+ ;; in "." and "..", but we can't count on VMS giving us
;; either of these.
(puthash "." t tbl)
(puthash ".." t tbl))
;; versions left. If not, then delete the
;; root entry.
(maphash
- (lambda (key val)
+ (lambda (key _val)
(and (string-match regexp key)
(setq versions t)))
files)
;; compressed files. Instead, we turn "FILE.TYPE" into
;; "FILE.TYPE-Z". Hope that this is a reasonable thing to do.
-(defun ange-ftp-vms-make-compressed-filename (name &optional reverse)
+(defun ange-ftp-vms-make-compressed-filename (name &optional _reverse)
(cond
((string-match "-Z;[0-9]+\\'" name)
(list nil (substring name 0 (match-beginning 0))))
;; (cons '(vms . ange-ftp-dired-vms-ls-trim)
;; ange-ftp-dired-ls-trim-alist)))
-(defun ange-ftp-vms-sans-version (name &rest args)
+(defun ange-ftp-vms-sans-version (name &rest _args)
(save-match-data
(if (string-match ";[0-9]+\\'" name)
(substring name 0 (match-beginning 0))
;; (cons '(cms . ange-ftp-dired-cms-move-to-end-of-filename)
;; ange-ftp-dired-move-to-end-of-filename-alist)))
-(defun ange-ftp-cms-make-compressed-filename (name &optional reverse)
+(defun ange-ftp-cms-make-compressed-filename (name &optional _reverse)
(if (string-match "-Z\\'" name)
(list nil (substring name 0 -2))
(list t (concat name "-Z"))))