/[emacs]/emacs/lisp/net/ange-ftp.el
ViewVC logotype

Diff of /emacs/lisp/net/ange-ftp.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.18 by rms, Fri Dec 21 23:57:20 2001 UTC revision 1.19 by rms, Sat Dec 29 00:46:11 2001 UTC
# Line 937  Don't use any other value." Line 937  Don't use any other value."
937                   (const :tag "Allow" 1)))                   (const :tag "Allow" 1)))
938    
939  (defcustom ange-ftp-try-passive-mode nil  (defcustom ange-ftp-try-passive-mode nil
940    "It t, try to use passive mode in ftp, if the client program    "It t, try to use passive mode in ftp, if the client program supports it."
 supports the `passive' command."  
941    :group 'ange-ftp    :group 'ange-ftp
942    :type 'boolean    :type 'boolean
943    :version 21.1)    :version 21.1)
944    
945    (defcustom ange-ftp-passive-host-alist nil
946      "Alist of FTP servers that need \"passive\" mode.
947    Each element is of the form (HOSTNAME . SETTING).
948    HOSTNAME is a regular expression to match the FTP server host name(s).
949    SETTING is \"on\" to turn passive mode on, \"off\" to turn it off,
950    or nil meaning don't change it."
951      :group 'ange-ftp
952      :type '(list (cons regex (choice (const :tag "On" "on")
953                                       (const :tag "Off" "off")
954                                       (const :tag "Don't change" nil))))
955      :version 21.3)
956    
957  ;;;; ------------------------------------------------------------  ;;;; ------------------------------------------------------------
958  ;;;; Hash table support.  ;;;; Hash table support.
# Line 2103  Create a new process if needed." Line 2113  Create a new process if needed."
2113          ;; Guess at the host type.          ;; Guess at the host type.
2114          (ange-ftp-guess-host-type host user)          (ange-ftp-guess-host-type host user)
2115    
2116          ;; Try to use passive mode if asked to.          ;; Turn passive mode on or off as requested.
2117          (when ange-ftp-try-passive-mode          (let* ((case-fold-search t)
2118            (let ((answer (cdr (ange-ftp-raw-send-cmd                 (passive
2119                                proc "passive" "Trying passive mode..." nil))))                  (or (assoc-default host ange-ftp-passive-host-alist
2120              (if (string-match "\\?\\|refused" answer)                                     'string-match)
2121                  (message "Trying passive mode...ok")                      (if ange-ftp-try-passive-mode "on"))))
2122                (message "Trying passive mode...failed"))))            (if passive
2123                  (ange-ftp-passive-mode passive)))
2124    
2125          ;; Run any user-specified hooks.  Note that proc, host and user are          ;; Run any user-specified hooks.  Note that proc, host and user are
2126          ;; dynamically bound at this point.          ;; dynamically bound at this point.
2127          (run-hooks 'ange-ftp-process-startup-hook))          (run-hooks 'ange-ftp-process-startup-hook))
2128        proc)))        proc)))
2129    
2130    (defun ange-ftp-passive-mode (on-or-off)
2131      (if (string-match (concat "Passive mode " on-or-off)
2132                        (cdr (ange-ftp-raw-send-cmd
2133                              proc (concat "passive " on-or-off)
2134                              "Trying passive mode..." nil)))
2135          (ange-ftp-message (concat "Trying passive mode..." on-or-off))
2136        (error "Trying passive mode...failed")))
2137    
2138  ;; Variables for caching host and host-type  ;; Variables for caching host and host-type
2139  (defvar ange-ftp-host-cache nil)  (defvar ange-ftp-host-cache nil)
2140  (defvar ange-ftp-host-type-cache nil)  (defvar ange-ftp-host-type-cache nil)
# Line 2789  NO-ERROR, if a listing for DIRECTORY can Line 2808  NO-ERROR, if a listing for DIRECTORY can
2808  ;; 2. The syntax of FILE and DIR make it impossible that FILE could be a valid  ;; 2. The syntax of FILE and DIR make it impossible that FILE could be a valid
2809  ;;     subdirectory. This is of course an OS dependent judgement.  ;;     subdirectory. This is of course an OS dependent judgement.
2810    
2811    ;;; Nowadays, the judgement for #2 is always "no".
2812    ;;; With today's ftp servers on Unix and GNU systems,
2813    ;;; it appears to be impossible to tell from the result
2814    ;;; of the directory listing whether the argument is a directory.
2815    ;;; This appears to be true even in Emacs 20.7
2816    
2817  (defmacro ange-ftp-allow-child-lookup (dir file)  (defmacro ange-ftp-allow-child-lookup (dir file)
2818    `(not    nil)
2819      (let* ((efile ,file) ; expand once.  ;;;   `(not
2820             (edir ,dir)  ;;;     (let* ((efile ,file) ; expand once.
2821             (parsed (ange-ftp-ftp-name edir))  ;;;            (edir ,dir)
2822             (host-type (ange-ftp-host-type  ;;;            (parsed (ange-ftp-ftp-name edir))
2823                         (car parsed))))  ;;;            (host-type (ange-ftp-host-type
2824        (or  ;;;                        (car parsed))))
2825         ;; Deal with dired  ;;;       (or
2826         (and (boundp 'dired-local-variables-file) ; in the dired-x package  ;;;        ;; Deal with dired
2827              (stringp dired-local-variables-file)  ;;;        (and (boundp 'dired-local-variables-file) ; in the dired-x package
2828              (string-equal dired-local-variables-file efile))  ;;;             (stringp dired-local-variables-file)
2829         ;; No dots in dir names in vms.  ;;;             (string-equal dired-local-variables-file efile))
2830         (and (eq host-type 'vms)  ;;;        ;; No dots in dir names in vms.
2831              (string-match "\\." efile))  ;;;        (and (eq host-type 'vms)
2832         ;; No subdirs in mts of cms.  ;;;             (string-match "\\." efile))
2833         (and (memq host-type '(mts cms))  ;;;        ;; No subdirs in mts of cms.
2834              (not (string-equal "/" (nth 2 parsed))))))))  ;;;        (and (memq host-type '(mts cms))
2835    ;;;             (not (string-equal "/" (nth 2 parsed)))))))
2836    
2837  (defun ange-ftp-file-entry-p (name)  (defun ange-ftp-file-entry-p (name)
2838    "Given NAME, return whether there is a file entry for it."    "Given NAME, return whether there is a file entry for it."

Legend:
Removed from v.1.18  
changed lines
  Added in v.1.19

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26