Function: ange-ftp-send-cmd

ange-ftp-send-cmd is a byte-compiled function defined in ange-ftp.el.gz.

Signature

(ange-ftp-send-cmd HOST USER CMD &optional MSG CONT NOWAIT)

Documentation

Find an FTP process connected to HOST logged in as USER and send it CMD.

MSG is an optional status message to be output before and after issuing the command. See the documentation for ange-ftp-raw-send-cmd for a description of CONT and NOWAIT.

Source Code

;; Defined in /usr/src/emacs/lisp/net/ange-ftp.el.gz
(defun ange-ftp-send-cmd (host user cmd &optional msg cont nowait)
  "Find an FTP process connected to HOST logged in as USER and send it CMD.
MSG is an optional status message to be output before and after issuing the
command.
See the documentation for `ange-ftp-raw-send-cmd' for a description of CONT
and NOWAIT."
  ;; Handle conversion to remote file name syntax and remote ls option
  ;; capability.
  (let ((cmd0 (car cmd))
	(cmd1 (nth 1 cmd))
	(ange-ftp-this-user user)
	(ange-ftp-this-host host)
	(ange-ftp-this-msg msg)
	cmd2 cmd3 host-type fix-name-func result)

    (cond

     ;; pwd case (We don't care what host-type.)
     ((null cmd1))

     ;; cmd == 'dir "remote-name" "local-name" "ls-switches"
     ((progn
       (setq cmd2 (nth 2 cmd)
	     host-type (ange-ftp-host-type host user))
       ;; This will trigger an FTP login, if one doesn't exist
       (eq cmd0 'dir))
      (setq cmd1 (funcall
		  (or (cdr (assq host-type ange-ftp-fix-dir-name-func-alist))
		      'identity)
		  cmd1)
	    cmd3 (nth 3 cmd))
      ;; Need to deal with the HP-UX ftp bug. This should also allow us to
      ;; resolve symlinks to directories on SysV machines. (Sebastian will
      ;; be happy.)
      (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-search " " cmd1)
	;; Keep the result.  In case of failure, we will (see below)
	;; short-circuit CMD and return this result directly.
	(setq result (ange-ftp-cd host user (nth 1 cmd) 'noerror))
	(setq cmd1 "."))

      ;; If the remote ls can take switches, put them in
      (unless (memq host-type ange-ftp-dumb-host-types)
	(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)))

     ;; First argument is the remote name
     ((progn
	(setq fix-name-func (or (cdr (assq host-type
					   ange-ftp-fix-name-func-alist))
				'identity))
	(memq cmd0 '(get delete mkdir rmdir cd)))
      (setq cmd1 (funcall fix-name-func cmd1)))

     ;; Second argument is the remote name
     ((or (memq cmd0 '(append put chmod))
          (and (eq cmd0 'quote) (member cmd1 '("mdtm" "size"))))
      (setq cmd2 (funcall fix-name-func cmd2)))
     ;; Both arguments are remote names
     ((eq cmd0 'rename)
      (setq cmd1 (funcall fix-name-func cmd1)
	    cmd2 (funcall fix-name-func cmd2))))

    ;; Turn the command into one long string
    (setq cmd0 (symbol-name cmd0))
    (setq cmd (concat cmd0
		      (and cmd1 (concat " " cmd1))
		      (and cmd2 (concat " " cmd2))))

    ;; Actually send the resulting command.
    (if (and (consp result) (null (car result)))
	;; `ange-ftp-cd' has failed, so there's no point sending `cmd'.
	result
      (let (afsc-result
	    afsc-line)
	(ange-ftp-raw-send-cmd
	 (ange-ftp-get-process host user)
	 cmd
	 msg
	 (list (lambda (result line host user cmd msg cont nowait)
		 (or cont (setq afsc-result result
				afsc-line line))
		 (if result (ange-ftp-call-cont cont result line)
                   (ange-ftp-raw-send-cmd
                    (ange-ftp-get-process host user)
                    cmd
                    msg
                    (list (lambda (result line cont)
                            (or cont (setq afsc-result result
                                           afsc-line line))
                            (ange-ftp-call-cont cont result line))
                          cont)
		    nowait)))
	       host user cmd msg cont nowait)
	 nowait)

	(if nowait
	    nil
	  (if cont
	      nil
	    (cons afsc-result afsc-line)))))))