comparison lisp/net/ange-ftp.el @ 90237:aa89c814f853

Revision: [e-mail]--gnu-2005/emacs--unicode--0--patch-88 Merge from emacs--cvs-trunk--0 Patches applied: * emacs--cvs-trunk--0 (patch 569-579) - Update from CVS - Merge from gnus--rel--5.10 * gnus--rel--5.10 (patch 129-132) - Update from CVS - Merge from emacs--cvs-trunk--0

90236:7871ecd1281b

  (let (temp)
    (while (setq temp (ange-ftp-real-file-symlink-p file))
      (setq file
	    (if (file-name-absolute-p temp)
		temp
	      (concat (file-name-directory file) temp)))))
  file)

;; Move along current line looking for the value of the TOKEN.
;; Valid separators between TOKEN and its value are commas and

	     (not (equal (nth 5 attr) ange-ftp-netrc-modtime)))	; file changed
	(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))))
	      (save-excursion
		;; we are cheating a bit here.  I'm trying to do the equivalent
		;; of find-file on the .netrc file, but then nuke it afterwards.
		;; with the bit of logic below we should be able to have
		;; encrypted .netrc files.
		(set-buffer (generate-new-buffer "*ftp-.netrc*"))
		(ange-ftp-real-insert-file-contents file)
		(setq buffer-file-name file)
		(setq default-directory (file-name-directory file))
		(normal-mode t)
		(run-hooks 'find-file-hook)

  (interactive "bKill FTP process associated with buffer: ")
  (if (null buffer)
      (setq buffer (current-buffer))
    (setq buffer (get-buffer buffer)))
  (let ((file (or (buffer-file-name buffer)
		  (save-excursion (set-buffer buffer) default-directory))))
    (if file
	(let ((parsed (ange-ftp-ftp-name (expand-file-name file))))
	  (if parsed
	      (let ((host (nth 0 parsed))
		    (user (nth 1 parsed)))

  "Set the size of the next FTP transfer in bytes."
  (let ((proc (ange-ftp-get-process host user)))
    (if proc
	(let ((buf (process-buffer proc)))
	  (if buf
	      (save-excursion
		(set-buffer buf)
		(setq ange-ftp-xfer-size
		      ;; For very large files, BYTES can be a float.
		      (if (integerp bytes)
			  (ash bytes -10)
			(/ bytes 1024)))))))))

(defun ange-ftp-gwp-sentinel (proc str)
  (setq ange-ftp-gwp-running nil))

(defun ange-ftp-gwp-filter (proc str)
  (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)
	 (process-send-string proc
                              (concat

				ange-ftp-gateway-host)))
	 (ftp (mapconcat 'identity args " ")))
    (set-process-query-on-exit-flag proc nil)
    (set-process-sentinel proc 'ange-ftp-gwp-sentinel)
    (set-process-filter proc 'ange-ftp-gwp-filter)
    (save-excursion
      (set-buffer (process-buffer proc))
      (goto-char (point-max))
      (set-marker (process-mark proc) (point)))
    (setq ange-ftp-gwp-running t
	  ange-ftp-gwp-status nil)
    (ange-ftp-message "Connecting to gateway %s..." ange-ftp-gateway-host)

	    (proc (let ((process-connection-type t))
		    (start-process " *nslookup*" " *nslookup*"
				   ange-ftp-nslookup-program host)))
	    (res host))
	(set-process-query-on-exit-flag proc nil)
	(save-excursion
	  (set-buffer (process-buffer proc))
	  (while (memq (process-status proc) '(run open))
	    (accept-process-output proc))
	  (goto-char (point-min))
	  (if (re-search-forward "Name:.*\nAddress: *\\(.*\\)$" nil t)
	      (setq res (match-string 1)))

    ;; Can anyone find a fix for that?
    (let ((process-connection-type t)
	  ;; Copy this so we don't alter it permanently.
	  (process-environment (copy-tree process-environment))
	  (buffer (get-buffer-create name)))
      (save-excursion
	(set-buffer buffer)
	(internal-ange-ftp-mode))
      ;; 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 (apply 'start-process name name
			      (append (list ange-ftp-gateway-program
					    ange-ftp-gateway-host)
				      args))))
	(setq proc (apply 'start-process name name args))))
    (save-excursion
      (set-buffer (process-buffer proc))
      (goto-char (point-max))
      (set-marker (process-mark proc) (point)))
    (set-process-query-on-exit-flag proc nil)
    (set-process-sentinel proc 'ange-ftp-process-sentinel)
    (set-process-filter proc 'ange-ftp-process-filter)

  "[hH]ash mark [^0-9]*\\([0-9]+\\)"
  "*Regexp matching the FTP client's output upon doing a HASH command.")

(defun ange-ftp-guess-hash-mark-size (proc)
  (if ange-ftp-send-hash
      (save-excursion
	(set-buffer (process-buffer proc))
	(let* ((status (ange-ftp-raw-send-cmd proc "hash"))
	       (line (cdr status)))
	  (save-match-data
	    (if (string-match ange-ftp-hash-mark-msgs line)
		(let ((size (string-to-number (match-string 1 line))))

      (and (eq host-type 'unix)
	   (string-match "/\\'" cmd1)
	   (not (string-match "R" cmd3))
	   (setq cmd1 (concat cmd1 ".")))

      ;; If the dir name contains a space, some ftp servers will
      ;; refuse to list it.  We instead change directory to the
      ;; directory in question and ls ".".
      (when (string-match " " cmd1)
	;; Keep the result.  In case of failure, we will (see below)

	(setq cmd0 'ls)
	;; We cd and then use `ls' with no directory argument.
	;; This works around a misfeature of some versions of netbsd ftpd
	;; where `ls' can only take one argument: either one set of flags
	;; or a file/directory name.
	;; FIXME: if we're trying to `ls' a single file, this fails since we
	;; can't cd to a file.  We can't fix this problem here, tho, because
	;; at this point we don't know whether the argument is a file or
	;; a directory.  Such an `ls' is only every used (apparently) from
	;; `insert-directory' when the `full-directory-p' argument is nil
	;; (which seems to only be used by dired when updating its display
	;; after operating on a set of files).  We should change
	;; ange-ftp-insert-directory so that this case is handled by getting
	;; a full listing of the directory and extracting the line
	;; corresponding to the requested file.
	(unless (equal cmd1 ".")
	  (setq result (ange-ftp-cd host user (nth 1 cmd) 'noerror)))
	(setq cmd1 cmd3)))

				       user
				       lscmd
				       (format "Listing %s"
					       (ange-ftp-abbreviate-filename
						ange-ftp-this-file)))))
		    (save-excursion
		      (set-buffer (get-buffer-create
				   ange-ftp-data-buffer-name))
		      (erase-buffer)
		      (if (ange-ftp-real-file-readable-p temp)
			  (ange-ftp-real-insert-file-contents temp)
			(sleep-for ange-ftp-retry-time)
					;wait for file to possibly appear

(defun ange-ftp-set-binary-mode (host user)
  "Tell the ftp process for the given HOST & USER to switch to binary mode."
  (let ((result (ange-ftp-send-cmd host user '(type "binary"))))
    (if (not (car result))
	(ange-ftp-error host user (concat "BINARY failed: " (cdr result)))
      (save-excursion
	(set-buffer (process-buffer (ange-ftp-get-process host user)))
	(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."
  (let ((result (ange-ftp-send-cmd host user '(type "ascii"))))
    (if (not (car result))
	(ange-ftp-error host user (concat "ASCII failed: " (cdr result)))
      (save-excursion
	(set-buffer (process-buffer (ange-ftp-get-process host user)))
	(and ange-ftp-ascii-hash-mark-size
	     (setq ange-ftp-hash-mark-unit
		   (ash ange-ftp-ascii-hash-mark-size -4)))))))

(defun ange-ftp-cd (host user dir &optional noerror)

	(ange-ftp-real-expand-file-name
	 (ange-ftp-real-file-name-nondirectory n)
	 (ange-ftp-real-file-name-directory n))))))

(defun ange-ftp-expand-file-name (name &optional default)
  "Documented as original."
  (save-match-data
    (setq default (or default default-directory))
    (cond ((eq (string-to-char name) ?~)
	   (ange-ftp-real-expand-file-name name))
	  ((eq (string-to-char name) ?/)

						    (or visit 'quiet))
			(setq coding-system-used last-coding-system-used))
		    ;; cleanup forms
		    (setq coding-system-used last-coding-system-used)
		    (setq buffer-file-name filename)
		    (set-buffer-modified-p mod-p)))
		(if binary
		    (ange-ftp-set-binary-mode host user))

		;; tell the process filter what size the transfer will be.
		(let ((attr (file-attributes temp)))

      ;; machines (VMS) use a .DIR to indicate the filename associated
      ;; with a directory. This needs to be canonicalized.
      (let ((file-ent (ange-ftp-get-file-entry
		       (ange-ftp-file-name-as-directory name))))
	(if (stringp file-ent)
	    (file-directory-p
	     (ange-ftp-expand-symlink file-ent
				      (file-name-directory
				       (directory-file-name name))))
	  file-ent))
    (ange-ftp-real-file-directory-p name)))

;;     (process-kill-without-query proc)
;;     (with-current-buffer (process-buffer proc)
;;       (set (make-local-variable 'copy-cont) cont))))
;;
;; (defun ange-ftp-copy-file-locally-sentinel (proc status)
;;   (save-excursion
;;     (set-buffer (process-buffer proc))
;;     (let ((cont copy-cont)
;; 	  (result (buffer-string)))
;;       (unwind-protect
;; 	  (if (and (string-equal status "finished\n")
;; 		   (zerop (length result)))

;; When called from dired, SWITCHES may start with "--dired".
;; `ange-ftp-ls' handles this.

(defun ange-ftp-insert-directory (file switches &optional wildcard full)
  (let ((parsed (ange-ftp-ftp-name (expand-file-name file)))
	tem)
    (if parsed
	(if (and (not wildcard)
		 (setq tem (file-symlink-p (directory-file-name file))))
	    (ange-ftp-insert-directory
	     (ange-ftp-expand-symlink
	      tem (file-name-directory (directory-file-name file)))
	     switches wildcard full)
	  (insert
	   (if wildcard
	       (let ((default-directory (file-name-directory file)))
		 (ange-ftp-ls (file-name-nondirectory file) switches nil nil t))
	     (ange-ftp-ls file switches full))))
      (ange-ftp-real-insert-directory file switches wildcard full))))

(defun ange-ftp-dired-uncache (dir)
  (if (ange-ftp-ftp-name (expand-file-name dir))
      (setq ange-ftp-ls-cache-file nil)))

  "Alist of mapping host type into function to remove file version numbers.")

(defun ange-ftp-file-name-sans-versions (file keep-backup-version)
  (let* ((short (ange-ftp-abbreviate-filename file))
	 (parsed (ange-ftp-ftp-name short))
	 func)
    (if parsed
	(setq func (cdr (assq (ange-ftp-host-type (car parsed))
			      ange-ftp-sans-version-alist))))
    (if func (funcall func file keep-backup-version)
      (ange-ftp-real-file-name-sans-versions file keep-backup-version))))

;; This is the handler for shell-command.
(defun ange-ftp-shell-command (command &optional output-buffer error-buffer)

;;(defun ange-ftp-dcf-1 (file-creator operation fn-list name-constructor
;;		       target marker-char buffer overwrite-query
;;		       overwrite-backup-query failures skipped
;;		       success-count total)
;;  (let ((old-buf (current-buffer)))
;;    (unwind-protect
;;	(progn
;;	  (set-buffer buffer)
;;	  (if (null fn-list)
;;	      (ange-ftp-dcf-3 failures operation total skipped
;;			      success-count buffer)

;;	    (let* ((from (car fn-list))

;;				     overwrite
;;				     overwrite-confirmed
;;				     overwrite-query
;;				     overwrite-backup-query
;;				     failures skipped success-count
;;				     total))))))))
;;      (set-buffer old-buf))))

;;(defun ange-ftp-dcf-2 (result line err
;;			      file-creator operation fn-list
;;			      name-constructor
;;			      target

;;			      overwrite-confirmed
;;			      overwrite-query
;;			      overwrite-backup-query
;;			      failures skipped success-count
;;			      total)
;;  (let ((old-buf (current-buffer)))
;;    (unwind-protect
;;	(progn
;;	  (set-buffer buffer)
;;	  (if (or err (not result))
;;	      (progn
;;		(setq failures (cons (dired-make-relative from) failures))
;;		(dired-log "%s `%s' to `%s' failed:\n%s\n"
;;			   operation from to (or err line)))

;;			  marker-char
;;			  buffer
;;			  overwrite-query
;;			  overwrite-backup-query
;;			  failures skipped success-count
;;			  total))
;;      (set-buffer old-buf))))

;;(defun ange-ftp-dcf-3 (failures operation total skipped success-count
;;				buffer)
;;  (let ((old-buf (current-buffer)))
;;    (unwind-protect
;;	(progn
;;	  (set-buffer buffer)
;;	  (cond
;;	   (failures
;;	    (dired-log-summary
;;	     (message "%s failed for %d of %d file%s %s"
;;		      operation (length failures) total

;;		      operation (length skipped) total
;;		      (dired-plural-s total) skipped)))
;;	   (t
;;	    (message "%s: %s file%s."
;;		     operation success-count (dired-plural-s success-count))))
;;	  (dired-move-to-filename))
;;      (set-buffer old-buf))))

;;;; -----------------------------------------------
;;;; Unix Descriptive Listing (dl) Support
;;;; -----------------------------------------------

90237:aa89c814f853

  (let (temp)
    (while (setq temp (ange-ftp-real-file-symlink-p file))
      (setq file
	    (if (file-name-absolute-p temp)
		temp
	      ;; Wouldn't `expand-file-name' be better than `concat' ?
	      ;; It would fail when `a/b/..' != `a', tho.  --Stef
	      (concat (file-name-directory file) temp)))))
  file)

;; Move along current line looking for the value of the TOKEN.
;; Valid separators between TOKEN and its value are commas and

	     (not (equal (nth 5 attr) ange-ftp-netrc-modtime)))	; file changed
	(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))))
	      (with-current-buffer
		;; we are cheating a bit here.  I'm trying to do the equivalent
		;; of find-file on the .netrc file, but then nuke it afterwards.
		;; with the bit of logic below we should be able to have
		;; encrypted .netrc files.
                  (generate-new-buffer "*ftp-.netrc*")
		(ange-ftp-real-insert-file-contents file)
		(setq buffer-file-name file)
		(setq default-directory (file-name-directory file))
		(normal-mode t)
		(run-hooks 'find-file-hook)

  (interactive "bKill FTP process associated with buffer: ")
  (if (null buffer)
      (setq buffer (current-buffer))
    (setq buffer (get-buffer buffer)))
  (let ((file (or (buffer-file-name buffer)
		  (with-current-buffer buffer default-directory))))
    (if file
	(let ((parsed (ange-ftp-ftp-name (expand-file-name file))))
	  (if parsed
	      (let ((host (nth 0 parsed))
		    (user (nth 1 parsed)))

  "Set the size of the next FTP transfer in bytes."
  (let ((proc (ange-ftp-get-process host user)))
    (if proc
	(let ((buf (process-buffer proc)))
	  (if buf
	      (with-current-buffer buf
		(setq ange-ftp-xfer-size
		      ;; For very large files, BYTES can be a float.
		      (if (integerp bytes)
			  (ash bytes -10)
			(/ bytes 1024)))))))))

(defun ange-ftp-gwp-sentinel (proc str)
  (setq ange-ftp-gwp-running nil))

(defun ange-ftp-gwp-filter (proc str)
  (comint-output-filter proc str)
  (with-current-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)
	 (process-send-string proc
                              (concat

				ange-ftp-gateway-host)))
	 (ftp (mapconcat 'identity args " ")))
    (set-process-query-on-exit-flag proc nil)
    (set-process-sentinel proc 'ange-ftp-gwp-sentinel)
    (set-process-filter proc 'ange-ftp-gwp-filter)
    (with-current-buffer (process-buffer proc)
      (goto-char (point-max))
      (set-marker (process-mark proc) (point)))
    (setq ange-ftp-gwp-running t
	  ange-ftp-gwp-status nil)
    (ange-ftp-message "Connecting to gateway %s..." ange-ftp-gateway-host)

	    (proc (let ((process-connection-type t))
		    (start-process " *nslookup*" " *nslookup*"
				   ange-ftp-nslookup-program host)))
	    (res host))
	(set-process-query-on-exit-flag proc nil)
	(with-current-buffer (process-buffer proc)
	  (while (memq (process-status proc) '(run open))
	    (accept-process-output proc))
	  (goto-char (point-min))
	  (if (re-search-forward "Name:.*\nAddress: *\\(.*\\)$" nil t)
	      (setq res (match-string 1)))

    ;; Can anyone find a fix for that?
    (let ((process-connection-type t)
	  ;; Copy this so we don't alter it permanently.
	  (process-environment (copy-tree process-environment))
	  (buffer (get-buffer-create name)))
      (with-current-buffer buffer
	(internal-ange-ftp-mode))
      ;; 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 (apply 'start-process name name
			      (append (list ange-ftp-gateway-program
					    ange-ftp-gateway-host)
				      args))))
	(setq proc (apply 'start-process name name args))))
    (with-current-buffer (process-buffer proc)
      (goto-char (point-max))
      (set-marker (process-mark proc) (point)))
    (set-process-query-on-exit-flag proc nil)
    (set-process-sentinel proc 'ange-ftp-process-sentinel)
    (set-process-filter proc 'ange-ftp-process-filter)

  "[hH]ash mark [^0-9]*\\([0-9]+\\)"
  "*Regexp matching the FTP client's output upon doing a HASH command.")

(defun ange-ftp-guess-hash-mark-size (proc)
  (if ange-ftp-send-hash
      (with-current-buffer (process-buffer proc)
	(let* ((status (ange-ftp-raw-send-cmd proc "hash"))
	       (line (cdr status)))
	  (save-match-data
	    (if (string-match ange-ftp-hash-mark-msgs line)
		(let ((size (string-to-number (match-string 1 line))))

      (and (eq host-type 'unix)
	   (string-match "/\\'" cmd1)
	   (not (string-match "R" cmd3))
	   (setq cmd1 (concat cmd1 ".")))

      ;; Using "ls -flags foo" has several problems:
      ;; - if foo is a symlink, we may get a single line showing the symlink
      ;;   rather than the listing of the directory it points to.
      ;; - if "foo" has spaces, the parsing of the command may be done wrong.
      ;; - some version of netbsd's ftpd only accept a single argument after
      ;;   `ls', which can either be the directory or the flags.
      ;; So to work around those problems, we use "cd foo; ls -flags".

      ;; If the dir name contains a space, some ftp servers will
      ;; refuse to list it.  We instead change directory to the
      ;; directory in question and ls ".".
      (when (string-match " " cmd1)
	;; Keep the result.  In case of failure, we will (see below)

	(setq cmd0 'ls)
	;; We cd and then use `ls' with no directory argument.
	;; This works around a misfeature of some versions of netbsd ftpd
	;; where `ls' can only take one argument: either one set of flags
	;; or a file/directory name.
	;; If we're trying to `ls' a single file, this fails since we
	;; can't cd to a file.  We can't fix this problem here, tho, because
	;; at this point we don't know whether the argument is a file or
	;; a directory.  Such an `ls' is only ever used (apparently) from
	;; `insert-directory' when the `full-directory-p' argument is nil
	;; (which seems to only be used by dired when updating its display
	;; after operating on a set of files).  So we've changed
	;; `ange-ftp-insert-directory' such that in this case it gets
	;; a full listing of the directory and extracting the line
	;; corresponding to the requested file.
	(unless (equal cmd1 ".")
	  (setq result (ange-ftp-cd host user (nth 1 cmd) 'noerror)))
	(setq cmd1 cmd3)))

				       user
				       lscmd
				       (format "Listing %s"
					       (ange-ftp-abbreviate-filename
						ange-ftp-this-file)))))
		    (with-current-buffer (get-buffer-create
                                          ange-ftp-data-buffer-name)
		      (erase-buffer)
		      (if (ange-ftp-real-file-readable-p temp)
			  (ange-ftp-real-insert-file-contents temp)
			(sleep-for ange-ftp-retry-time)
					;wait for file to possibly appear

(defun ange-ftp-set-binary-mode (host user)
  "Tell the ftp process for the given HOST & USER to switch to binary mode."
  (let ((result (ange-ftp-send-cmd host user '(type "binary"))))
    (if (not (car result))
	(ange-ftp-error host user (concat "BINARY failed: " (cdr result)))
      (with-current-buffer (process-buffer (ange-ftp-get-process host user))
	(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."
  (let ((result (ange-ftp-send-cmd host user '(type "ascii"))))
    (if (not (car result))
	(ange-ftp-error host user (concat "ASCII failed: " (cdr result)))
      (with-current-buffer (process-buffer (ange-ftp-get-process host user))
	(and ange-ftp-ascii-hash-mark-size
	     (setq ange-ftp-hash-mark-unit
		   (ash ange-ftp-ascii-hash-mark-size -4)))))))

(defun ange-ftp-cd (host user dir &optional noerror)

	(ange-ftp-real-expand-file-name
	 (ange-ftp-real-file-name-nondirectory n)
	 (ange-ftp-real-file-name-directory n))))))

(defun ange-ftp-expand-file-name (name &optional default)
  "Documented as `expand-file-name'."
  (save-match-data
    (setq default (or default default-directory))
    (cond ((eq (string-to-char name) ?~)
	   (ange-ftp-real-expand-file-name name))
	  ((eq (string-to-char name) ?/)

						    (or visit 'quiet))
			(setq coding-system-used last-coding-system-used))
		    ;; cleanup forms
		    (setq coding-system-used last-coding-system-used)
		    (setq buffer-file-name filename)
		    (restore-buffer-modified-p mod-p)))
		(if binary
		    (ange-ftp-set-binary-mode host user))

		;; tell the process filter what size the transfer will be.
		(let ((attr (file-attributes temp)))

      ;; machines (VMS) use a .DIR to indicate the filename associated
      ;; with a directory. This needs to be canonicalized.
      (let ((file-ent (ange-ftp-get-file-entry
		       (ange-ftp-file-name-as-directory name))))
	(if (stringp file-ent)
	    ;; Calling file-directory-p doesn't work because ange-ftp
	    ;; is temporarily disabled for this operation.
	    (ange-ftp-file-directory-p
	     (ange-ftp-expand-symlink file-ent
				      (file-name-directory
				       (directory-file-name name))))
	  file-ent))
    (ange-ftp-real-file-directory-p name)))

;;     (process-kill-without-query proc)
;;     (with-current-buffer (process-buffer proc)
;;       (set (make-local-variable 'copy-cont) cont))))
;;
;; (defun ange-ftp-copy-file-locally-sentinel (proc status)
;;   (with-current-buffer (process-buffer proc)
;;     (let ((cont copy-cont)
;; 	  (result (buffer-string)))
;;       (unwind-protect
;; 	  (if (and (string-equal status "finished\n")
;; 		   (zerop (length result)))

;; When called from dired, SWITCHES may start with "--dired".
;; `ange-ftp-ls' handles this.

(defun ange-ftp-insert-directory (file switches &optional wildcard full)
  (if (not (ange-ftp-ftp-name (expand-file-name file)))
      (ange-ftp-real-insert-directory file switches wildcard full)
    ;; We used to follow symlinks on `file' here.  Apparently it was done
    ;; because some FTP servers react to "ls foo" by listing the symlink foo
    ;; rather than the directory it points to.  Now that ange-ftp-ls uses
    ;; "cd foo; ls" instead, this is not necesssary any more.
    (insert
     (cond
      (wildcard
       (let ((default-directory (file-name-directory file)))
         (ange-ftp-ls (file-name-nondirectory file) switches nil nil t)))
      (full
       (ange-ftp-ls file switches 'parse))
      (t
       ;; If `full' is nil we're going to do `ls' for a single file.
       ;; Problem is that for various reasons, ange-ftp-ls needs to cd and
       ;; then do an ls of current dir, which obviously won't work if we
       ;; want to ls a file.  So instead, we get a full listing of the
       ;; parent directory and extract the line corresponding to `file'.
       (when (string-match "d\\'" switches)
         ;; Remove "d" which dired added to `switches'.
         (setq switches (substring switches 0 (match-beginning 0))))
       (let* ((dirlist (ange-ftp-ls (or (file-name-directory file) ".")
                                    switches nil))
              (filename (file-name-nondirectory (directory-file-name file)))
              (case-fold-search nil))
         ;; FIXME: This presumes a particular output format, which is
         ;; basically Unix.
         (if (string-match (concat "^.+[^ ] " (regexp-quote filename)
                                   "\\( -> .*\\)?[@/*=]?\n") dirlist)
             (match-string 0 dirlist)
           "")))))))

(defun ange-ftp-dired-uncache (dir)
  (if (ange-ftp-ftp-name (expand-file-name dir))
      (setq ange-ftp-ls-cache-file nil)))

  "Alist of mapping host type into function to remove file version numbers.")

(defun ange-ftp-file-name-sans-versions (file keep-backup-version)
  (let* ((short (ange-ftp-abbreviate-filename file))
	 (parsed (ange-ftp-ftp-name short))
	 (func (if parsed (cdr (assq (ange-ftp-host-type (car parsed))
                                     ange-ftp-sans-version-alist)))))
    (if func (funcall func file keep-backup-version)
      (ange-ftp-real-file-name-sans-versions file keep-backup-version))))

;; This is the handler for shell-command.
(defun ange-ftp-shell-command (command &optional output-buffer error-buffer)

;;(defun ange-ftp-dcf-1 (file-creator operation fn-list name-constructor
;;		       target marker-char buffer overwrite-query
;;		       overwrite-backup-query failures skipped
;;		       success-count total)
;;  (with-current-buffer buffer
;;	  (if (null fn-list)
;;	      (ange-ftp-dcf-3 failures operation total skipped
;;			      success-count buffer)

;;	    (let* ((from (car fn-list))

;;				     overwrite
;;				     overwrite-confirmed
;;				     overwrite-query
;;				     overwrite-backup-query
;;				     failures skipped success-count
;;				     total)))))))))

;;(defun ange-ftp-dcf-2 (result line err
;;			      file-creator operation fn-list
;;			      name-constructor
;;			      target

;;			      overwrite-confirmed
;;			      overwrite-query
;;			      overwrite-backup-query
;;			      failures skipped success-count
;;			      total)
;;  (with-current-buffer buffer
;;	  (if (or err (not result))
;;	      (progn
;;		(setq failures (cons (dired-make-relative from) failures))
;;		(dired-log "%s `%s' to `%s' failed:\n%s\n"
;;			   operation from to (or err line)))

;;			  marker-char
;;			  buffer
;;			  overwrite-query
;;			  overwrite-backup-query
;;			  failures skipped success-count
;;			  total)))

;;(defun ange-ftp-dcf-3 (failures operation total skipped success-count
;;				buffer)
;;  (with-current-buffer buffer
;;	  (cond
;;	   (failures
;;	    (dired-log-summary
;;	     (message "%s failed for %d of %d file%s %s"
;;		      operation (length failures) total

;;		      operation (length skipped) total
;;		      (dired-plural-s total) skipped)))
;;	   (t
;;	    (message "%s: %s file%s."
;;		     operation success-count (dired-plural-s success-count))))
;;	  (dired-move-to-filename)))

;;;; -----------------------------------------------
;;;; Unix Descriptive Listing (dl) Support
;;;; -----------------------------------------------