;;; ange-ftp.el --- transparent FTP support for GNU Emacs
-;; Copyright (C) 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1998,
-;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
-;; Free Software Foundation, Inc.
+;; Copyright (C) 1989-1996, 1998, 2000-2011 Free Software Foundation, Inc.
;; Author: Andy Norman (ange@hplb.hpl.hp.com)
;; Maintainer: FSF
"Accessing remote files and directories using FTP
made as simple and transparent as possible."
:group 'files
+ :group 'comm
:prefix "ange-ftp-")
(defcustom ange-ftp-name-format
"^Data connection \\|"
"^local:\\|^Trying\\|^125 \\|^550-\\|^221 .*oodbye\\|"
"^500 .*AUTH\\|^KERBEROS\\|"
+ "^504 Unknown security mechanism\\|"
"^530 Please login with USER and PASS\\|" ; non kerberised vsFTPd
"^534 Kerberos Authentication not enabled\\|"
"^22[789] .*[Pp]assive\\|^200 EPRT\\|^500 .*EPRT")
:type '(choice (const :tag "Default" nil)
string))
-(defcustom ange-ftp-binary-file-name-regexp
- (concat "TAGS\\'\\|\\.\\(?:"
- (eval-when-compile
- (regexp-opt '("z" "Z" "lzh" "arc" "zip" "zoo" "tar" "dvi"
- "ps" "elc" "gif" "gz" "taz" "tgz")))
- "\\|EXE\\(;[0-9]+\\)?\\|[zZ]-part-..\\)\\'")
+(defcustom ange-ftp-binary-file-name-regexp ""
"If a file matches this regexp then it is transferred in binary mode."
:group 'ange-ftp
- :type 'regexp)
+ :type 'regexp
+ :version "24.1")
(defcustom ange-ftp-gateway-host nil
"Name of host to use as gateway machine when local FTP isn't possible."
ange-ftp-gateway-tmp-name-template
ange-ftp-tmp-name-template)))
-(defalias 'ange-ftp-del-tmp-name 'delete-file)
+(defun ange-ftp-del-tmp-name (filename)
+ "Force to delete temporary file."
+ (delete-file filename))
+
\f
;;;; ------------------------------------------------------------
;;;; Interactive gateway program support.
(and files (puthash (file-name-as-directory directory)
files ange-ftp-files-hashtable)))
+(defun ange-ftp-switches-ok (switches)
+ "Return SWITCHES (a string) if suitable for our use."
+ (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.
+ (string-match
+ "--\\(almost-\\)?all\\>\\|\\(\\`\\| \\)-[[:alpha:]]*[aA]" switches)
+ (string-match "\\(\\`\\| \\)-[[:alpha:]]*l" switches)
+ (not (string-match
+ "--recursive\\>\\|\\(\\`\\| \\)-[[:alpha:]]*R" switches))
+ switches))
+
(defun ange-ftp-get-files (directory &optional no-error)
"Given a DIRECTORY, return a hashtable of file entries.
This will give an error or return nil, depending on the value of
;; This is an efficiency hack. We try to
;; anticipate what sort of listing dired
;; might want, and cache just such a listing.
- (if (and (boundp 'dired-actual-switches)
- (stringp dired-actual-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.
- (string-match
- "[aA]" dired-actual-switches)
- (string-match
- "l" dired-actual-switches)
- (not (string-match
- "R" dired-actual-switches)))
- dired-actual-switches
- (if (and (boundp 'dired-listing-switches)
- (stringp dired-listing-switches)
- (string-match
- "[aA]" dired-listing-switches)
- (string-match
- "l" dired-listing-switches)
- (not (string-match
- "R" dired-listing-switches)))
- dired-listing-switches
- "-al"))
+ (or (and (boundp 'dired-actual-switches)
+ (ange-ftp-switches-ok dired-actual-switches))
+ (and (boundp 'dired-listing-switches)
+ (ange-ftp-switches-ok
+ dired-listing-switches))
+ "-al")
t no-error)
(gethash directory ange-ftp-files-hashtable)))))
;; What we REALLY need here is a way to determine if the mode
;; of the transfer is irrelevant, i.e. we can use binary mode
;; regardless. Maybe a system-type to host-type lookup?
- (binary (or (ange-ftp-binary-file filename)
- (and (not (memq system-type
- '(ms-dos windows-nt)))
- (memq (ange-ftp-host-type host user)
- '(unix dumb-unix)))))
+ (binary (ange-ftp-binary-file filename))
(cmd (if append 'append 'put))
(abbr (ange-ftp-abbreviate-filename filename))
;; we need to reset `last-coding-system-used' to its
(user (nth 1 parsed))
(name (ange-ftp-quote-string (nth 2 parsed)))
(temp (ange-ftp-make-tmp-name host))
- (binary (or (ange-ftp-binary-file filename)
- (memq (ange-ftp-host-type host user)
- '(unix dumb-unix))))
+ (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)
(file-exists-p file)
(ange-ftp-real-file-executable-p file))))
-(defun ange-ftp-delete-file (file)
- (interactive "fDelete file: ")
+(defun ange-ftp-delete-file (file &optional trash)
+ (interactive (list (read-file-name "Delete file: " nil default-directory)
+ (null current-prefix-arg)))
(setq file (expand-file-name file))
(let ((parsed (ange-ftp-ftp-name file)))
(if parsed
(format "FTP Error: \"%s\"" (cdr result))
file)))
(ange-ftp-delete-file-entry file))
- (ange-ftp-real-delete-file file))))
+ (ange-ftp-real-delete-file file trash))))
(defun ange-ftp-file-modtime (file)
"Return the modification time of remote file FILE.
(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)
- (and (memq (ange-ftp-host-type f-host f-user)
- '(unix dumb-unix))
- (memq (ange-ftp-host-type t-host t-user)
- '(unix dumb-unix)))))
+ (ange-ftp-binary-file newname)))
temp1
temp2)
(ange-ftp-call-cont cont result line)))
(defun ange-ftp-copy-file (filename newname &optional ok-if-already-exists
- keep-date preserve-uid-gid)
+ keep-date preserve-uid-gid
+ preserve-selinux-context)
(interactive "fCopy file: \nFCopy %s to file: \np")
(ange-ftp-copy-file-internal filename
newname
(ange-ftp-get-files dir t))))
\f
(defun ange-ftp-make-directory (dir &optional parents)
- (interactive (list (expand-file-name (read-file-name "Make directory: "))))
+ (interactive (list (expand-file-name (read-directory-name "Make directory: "))))
(if parents
(let ((parent (file-name-directory (directory-file-name dir))))
(or (file-exists-p parent)
;; ;; This is the Unix dl version.
;; (let ((opoint (point))
;; case-fold-search hidden)
-;; (or eol (setq eol (save-excursion (end-of-line) (point))))
+;; (or eol (setq eol (line-end-position)))
;; (setq hidden (and selective-display
;; (save-excursion
;; (search-forward "\r" eol t))))
;; ;; This is the VMS version.
;; (let (opoint hidden case-fold-search)
;; (setq opoint (point))
-;; (or eol (setq eol (save-excursion (end-of-line) (point))))
+;; (or eol (setq eol (line-end-position)))
;; (setq hidden (and selective-display
;; (save-excursion (search-forward "\r" eol t))))
;; (if hidden
;; base-versions
;; (file-name-directory fn)))
;; (versions (mapcar
-;; '(lambda (arg)
+;; (lambda (arg)
;; (if (and (string-match
;; "[0-9]+$" arg bv-length)
;; (= (match-beginning 0) bv-length))
;; ;; This is the MTS version.
;; (let (opoint hidden case-fold-search)
;; (setq opoint (point)
-;; eol (save-excursion (end-of-line) (point))
+;; eol (line-end-position)
;; hidden (and selective-display
;; (save-excursion (search-forward "\r" eol t))))
;; (if hidden
;; ;; This is the CMS version.
;; (let ((opoint (point))
;; case-fold-search hidden)
-;; (or eol (setq eol (save-excursion (end-of-line) (point))))
+;; (or eol (setq eol (line-end-position)))
;; (setq hidden (and selective-display
;; (save-excursion
;; (search-forward "\r" eol t))))
(provide 'ange-ftp)
-;; arch-tag: 2987ef88-cb56-4ec1-87a9-79132572e316
;;; ange-ftp.el ends here