]> code.delx.au - gnu-emacs/blobdiff - lisp/net/ange-ftp.el
* net/shr.el (shr-tag-img): Don't bug out on <img src=""> data.
[gnu-emacs] / lisp / net / ange-ftp.el
index 2b8c7ae145baf4247fd83746eebaba592c1e63c1..67c74f882504f50e122fa49efc412eac5b27a364 100644 (file)
@@ -1,7 +1,6 @@
 ;;; ange-ftp.el --- transparent FTP support for GNU Emacs
 
-;; Copyright (C) 1989-1996, 1998, 2000-2013 Free Software Foundation,
-;; Inc.
+;; Copyright (C) 1989-1996, 1998, 2000-2013 Free Software Foundation, Inc.
 
 ;; Author: Andy Norman (ange@hplb.hpl.hp.com)
 ;; Maintainer: FSF
@@ -700,7 +699,7 @@ parenthesized expressions in REGEXP for the components (in that order)."
   "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.
@@ -724,9 +723,10 @@ parenthesized expressions in REGEXP for the components (in that order)."
           "^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
@@ -1097,8 +1097,7 @@ All HOST values should be in lower case.")
 (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.
@@ -3022,6 +3021,9 @@ and LINE is the relevant success or fail line from the FTP-client."
     (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)))
@@ -3731,7 +3733,7 @@ so return the size on the remote host exactly. See RFC 3659."
 ;; 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
@@ -3833,7 +3835,7 @@ so return the size on the remote host exactly. See RFC 3659."
 
 (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
@@ -4198,7 +4200,7 @@ directory, so that Emacs will know its current contents."
        (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)))
@@ -4212,7 +4214,7 @@ directory, so that Emacs will know its current contents."
     (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
@@ -4437,16 +4439,18 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
 ;;; 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))
@@ -4601,7 +4605,6 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
 (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)
@@ -5172,7 +5175,7 @@ Other orders of $ and _ seem to all work just fine.")
                    ;; 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)
@@ -5354,7 +5357,7 @@ Other orders of $ and _ seem to all work just fine.")
 ;; 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))))
@@ -5395,7 +5398,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 &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))
@@ -5916,7 +5919,7 @@ Other orders of $ and _ seem to all work just fine.")
 ;;       (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"))))