code.delx.au - gnu-emacs/blob - lisp/net/tramp-fish.el

   1 ;;; tramp-fish.el --- Tramp access functions for FISH protocol
   2
   3 ;; Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
   4
   5 ;; Author: Michael Albinus <michael.albinus@gmx.de>
   6 ;; Keywords: comm, processes
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software: you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation, either version 3 of the License, or
  13 ;; (at your option) any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 ;;; Commentary:
  24
  25 ;; Access functions for FIles transferred over SHell protocol from Tramp.
  26
  27 ;; FISH is a protocol developped for the GNU Midnight Commander
  28 ;; <https://savannah.gnu.org/projects/mc>.  A client connects to a
  29 ;; remote host via ssh (or rsh, shall be configurable), and starts
  30 ;; there a fish server via the command "start_fish_server".  All
  31 ;; commands from the client have the form "#FISH_COMMAND\n" (always
  32 ;; one line), followed by equivalent shell commands in case there is
  33 ;; no fish server running.
  34
  35 ;; The fish server (or the equivalent shell commands) must return the
  36 ;; response, which is finished by a line "### xxx  <optional text>\n".
  37 ;; "xxx" stands for 3 digits, representing a return code.  Return
  38 ;; codes "# 000" and "# 001" are reserved for fallback implementation
  39 ;; with native shell commands; they are not used inside the server.  See
  40 ;; <http://cvs.savannah.gnu.org/viewvc/mc/vfs/README.fish?root=mc&view=markup>
  41 ;; for details of original specification.
  42
  43 ;; The GNU Midnight Commander implements the original fish protocol
  44 ;; version 0.0.2.  The KDE Konqueror has its own implementation, which
  45 ;; can be found at
  46 ;; <http://websvn.kde.org/branches/KDE/3.5/kdebase/kioslave/fish>.  It
  47 ;; implements an extended protocol version 0.0.3.  Additionally, it
  48 ;; provides a fish server implementation in Perl (which is the only
  49 ;; implementation I've heard of).  The following command reference is
  50 ;; based on that implementation.
  51
  52 ;; All commands return either "### 2xx\n" (OK) or "### 5xx <optional text>\n"
  53 ;; (NOK).  Return codes are mentioned only if they are different from this.
  54 ;; Spaces in any parameter must be escaped by "\ ".
  55
  56 ;; Command/Return Code                  Comment
  57 ;;
  58 ;; #FISH                                initial connection, not used
  59 ;;                                      in .fishsrv.pl
  60 ;; ### 100 transfer fish server         missing server, or wrong checksum
  61 ;;                                      version 0.0.3 only
  62
  63 ;; #VER a.b.c <commands requested>
  64 ;; VER x.y.z <commands offered>         .fishsrv.pl response is not uptodate
  65
  66 ;; #PWD
  67 ;; /path/to/file
  68
  69 ;; #CWD /some/path
  70
  71 ;; #COPY /path/a /path/b                version 0.0.3 only
  72
  73 ;; #RENAME /path/a /path/b
  74
  75 ;; #SYMLINK /path/a /path/b
  76
  77 ;; #LINK /path/a /path/b
  78
  79 ;; #DELE /some/path
  80
  81 ;; #MKD /some/path
  82
  83 ;; #RMD /some/path
  84
  85 ;; #CHOWN user /file/name
  86
  87 ;; #CHGRP group /file/name
  88
  89 ;; #CHMOD 1234 file
  90
  91 ;; #READ <offset> <size> /path/and/filename
  92 ;; ### 291                              successful exit when reading
  93 ;;                                      ended at eof
  94 ;; ### 292                              successful exit when reading
  95 ;;                                      did not end at eof
  96
  97 ;; #WRITE <offset> <size> /path/and/filename
  98
  99 ;; #APPEND <size> /path/and/filename    version 0.0.3 only
 100
 101 ;; #LIST /directory
 102 ;; <number of entries>                  version 0.0.3 only
 103 ;; ### 100                              version 0.0.3 only
 104 ;; P<unix permissions> <owner>.<group>
 105 ;; S<size>
 106 ;; d<3-letters month name> <day> <year or HH:MM>
 107 ;; D<year> <month> <day> <hour> <minute> <second>[.1234]
 108 ;; E<major-of-device>,<minor>
 109 ;; :<filename>
 110 ;; L<filename symlink points to>
 111 ;; M<mimetype>                          version 0.0.3 only
 112 ;; <blank line to separate items>
 113
 114 ;; #STAT /file                          version 0.0.3 only
 115 ;;                                      like #LIST except for directories
 116 ;; <number of entries>
 117 ;; ### 100
 118 ;; P<unix permissions> <owner>.<group>
 119 ;; S<size>
 120 ;; d<3-letters month name> <day> <year or HH:MM>
 121 ;; D<year> <month> <day> <hour> <minute> <second>[.1234]
 122 ;; E<major-of-device>,<minor>
 123 ;; :<filename>
 124 ;; L<filename symlink points to>
 125 ;; <blank line to separate items>
 126
 127 ;; #RETR /some/name
 128 ;; <filesize>
 129 ;; ### 100
 130 ;; <binary data>                        exactly filesize bytes
 131 ;; ### 200                              with no preceding newline
 132
 133 ;; #STOR <size> /file/name
 134 ;; ### 100
 135 ;; <data>                               exactly size bytes
 136 ;; ### 001                              partial success
 137
 138 ;; #EXEC <command> <tmpfile>            version 0.0.3 only
 139 ;; <tmpfile> must not exists.  It contains the output of <command>.
 140 ;; It can be retrieved afterwards.  Last line is
 141 ;; ###RESULT: <returncode>
 142
 143 ;; This implementation is meant as proof of the concept, whether there
 144 ;; is a better performance compared with the native ssh method.  It
 145 ;; looks like the file information retrieval is slower, especially the
 146 ;; #LIST command.  On the other hand, the file contents transmission
 147 ;; seems to perform better than other inline methods, because there is
 148 ;; no need for data encoding/decoding, and it supports the APPEND
 149 ;; parameter of `write-region'.  Transfer of binary data fails due to
 150 ;; Emacs' process input/output handling.
 151
 152 ;;; Code:
 153
 154 (eval-when-compile
 155   ;; Pacify byte-compiler.
 156   (require 'cl))
 157
 158 (require 'tramp)
 159 (require 'tramp-cache)
 160 (require 'tramp-compat)
 161
 162 ;; Define FISH method ...
 163 (defcustom tramp-fish-method "fish"
 164   "*Method to connect via FISH protocol."
 165   :group 'tramp
 166   :type 'string)
 167
 168 ;; ... and add it to the method list.
 169 (add-to-list 'tramp-methods (cons tramp-fish-method nil))
 170
 171 ;; Add a default for `tramp-default-user-alist'. Default is the local user.
 172 (add-to-list 'tramp-default-user-alist
 173              `(,tramp-fish-method nil ,(user-login-name)))
 174
 175 ;; Add completion function for FISH method.
 176 (tramp-set-completion-function
 177  tramp-fish-method tramp-completion-function-alist-ssh)
 178
 179 (defconst tramp-fish-continue-prompt-regexp "^### 100.*\n"
 180   "FISH return code OK.")
 181
 182 ;; It cannot be a defconst, occasionally we bind it locally.
 183 (defvar tramp-fish-ok-prompt-regexp "^### 200\n"
 184   "FISH return code OK.")
 185
 186 (defconst tramp-fish-error-prompt-regexp "^### \\(4\\|5\\)[0-9]+.*\n"
 187   "Regexp for possible error strings of FISH servers.
 188 Used instead of analyzing error codes of commands.")
 189
 190 (defcustom tramp-fish-start-fish-server-command
 191   (concat "stty intr \"\" quit \"\" erase \"\" kill \"\" eof \"\" eol \"\" eol2 \"\" swtch \"\" start \"\" stop \"\" susp \"\" rprnt \"\" werase \"\" lnext \"\" flush \"\"; "
 192           "perl .fishsrv.pl "
 193             "`grep 'ARGV\\[0\\]' .fishsrv.pl | "
 194             "sed -e 's/^[^\"]*\"//' -e 's/\"[^\"]*$//'`; "
 195           "exit")
 196   "*Command to connect via FISH protocol."
 197   :group 'tramp
 198   :type 'string)
 199
 200 ;; New handlers should be added here.
 201 (defconst tramp-fish-file-name-handler-alist
 202   '(
 203     ;; `access-file' performed by default handler
 204     (add-name-to-file . tramp-fish-handle-add-name-to-file)
 205     ;; `byte-compiler-base-file-name' performed by default handler
 206     (copy-file . tramp-fish-handle-copy-file)
 207     (delete-directory . tramp-fish-handle-delete-directory)
 208     (delete-file . tramp-fish-handle-delete-file)
 209     ;; `diff-latest-backup-file' performed by default handler
 210     (directory-file-name . tramp-handle-directory-file-name)
 211     (directory-files . tramp-handle-directory-files)
 212     (directory-files-and-attributes . tramp-fish-handle-directory-files-and-attributes)
 213     ;; `dired-call-process' performed by default handler
 214     ;; `dired-compress-file' performed by default handler
 215     (dired-uncache . tramp-handle-dired-uncache)
 216     (expand-file-name . tramp-fish-handle-expand-file-name)
 217     ;; `file-accessible-directory-p' performed by default handler
 218     (file-attributes . tramp-fish-handle-file-attributes)
 219     (file-directory-p .  tramp-fish-handle-file-directory-p)
 220     (file-executable-p . tramp-fish-handle-file-executable-p)
 221     (file-exists-p . tramp-fish-handle-file-exists-p)
 222     (file-local-copy . tramp-fish-handle-file-local-copy)
 223     (file-modes . tramp-handle-file-modes)
 224     (file-name-all-completions . tramp-fish-handle-file-name-all-completions)
 225     (file-name-as-directory . tramp-handle-file-name-as-directory)
 226     (file-name-completion . tramp-handle-file-name-completion)
 227     (file-name-directory . tramp-handle-file-name-directory)
 228     (file-name-nondirectory . tramp-handle-file-name-nondirectory)
 229     ;; `file-name-sans-versions' performed by default handler
 230     (file-newer-than-file-p . tramp-fish-handle-file-newer-than-file-p)
 231     (file-ownership-preserved-p . ignore)
 232     (file-readable-p . tramp-fish-handle-file-readable-p)
 233     (file-regular-p . tramp-handle-file-regular-p)
 234     (file-remote-p . tramp-handle-file-remote-p)
 235     ;; `file-selinux-context' performed by default handler.
 236     (file-symlink-p . tramp-handle-file-symlink-p)
 237     ;; `file-truename' performed by default handler
 238     (file-writable-p . tramp-fish-handle-file-writable-p)
 239     (find-backup-file-name . tramp-handle-find-backup-file-name)
 240     ;; `find-file-noselect' performed by default handler
 241     ;; `get-file-buffer' performed by default handler
 242     (insert-directory . tramp-fish-handle-insert-directory)
 243     (insert-file-contents . tramp-fish-handle-insert-file-contents)
 244     (load . tramp-handle-load)
 245     (make-directory . tramp-fish-handle-make-directory)
 246     (make-directory-internal . tramp-fish-handle-make-directory-internal)
 247     (make-symbolic-link . tramp-fish-handle-make-symbolic-link)
 248     (rename-file . tramp-fish-handle-rename-file)
 249     (set-file-modes . tramp-fish-handle-set-file-modes)
 250     ;; `set-file-selinux-context' performed by default handler.
 251     (set-file-times . tramp-fish-handle-set-file-times)
 252     (set-visited-file-modtime . ignore)
 253     (shell-command . tramp-handle-shell-command)
 254     (substitute-in-file-name . tramp-handle-substitute-in-file-name)
 255     (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory)
 256     (vc-registered . ignore)
 257     (verify-visited-file-modtime . ignore)
 258     (write-region . tramp-fish-handle-write-region)
 259     (executable-find . tramp-fish-handle-executable-find)
 260     (start-file-process . ignore)
 261     (process-file . tramp-fish-handle-process-file)
 262 )
 263   "Alist of handler functions for Tramp FISH method.
 264 Operations not mentioned here will be handled by the default Emacs primitives.")
 265
 266 (defun tramp-fish-file-name-p (filename)
 267   "Check if it's a filename for FISH protocol."
 268   (let ((v (tramp-dissect-file-name filename)))
 269     (string= (tramp-file-name-method v) tramp-fish-method)))
 270
 271 (defun tramp-fish-file-name-handler (operation &rest args)
 272   "Invoke the FISH related OPERATION.
 273 First arg specifies the OPERATION, second arg is a list of arguments to
 274 pass to the OPERATION."
 275   (let ((fn (assoc operation tramp-fish-file-name-handler-alist)))
 276     (if fn
 277         (save-match-data (apply (cdr fn) args))
 278       (tramp-run-real-handler operation args))))
 279
 280 (add-to-list 'tramp-foreign-file-name-handler-alist
 281              (cons 'tramp-fish-file-name-p 'tramp-fish-file-name-handler))
 282
 283
 284 ;; File name primitives
 285
 286 (defun tramp-fish-handle-add-name-to-file
 287   (filename newname &optional ok-if-already-exists)
 288   "Like `add-name-to-file' for Tramp files."
 289   (unless (tramp-equal-remote filename newname)
 290     (with-parsed-tramp-file-name
 291         (if (tramp-tramp-file-p filename) filename newname) nil
 292       (tramp-error
 293        v 'file-error
 294        "add-name-to-file: %s"
 295        "only implemented for same method, same user, same host")))
 296   (with-parsed-tramp-file-name filename v1
 297     (with-parsed-tramp-file-name newname v2
 298       (when (and (not ok-if-already-exists)
 299                  (file-exists-p newname)
 300                  (not (numberp ok-if-already-exists))
 301                  (y-or-n-p
 302                   (format
 303                    "File %s already exists; make it a new name anyway? "
 304                    newname)))
 305         (tramp-error
 306          v2 'file-error
 307          "add-name-to-file: file %s already exists" newname))
 308       (tramp-flush-file-property v2 v2-localname)
 309       (unless (tramp-fish-send-command-and-check
 310                v1 (format "#LINK %s %s" v1-localname v2-localname))
 311         (tramp-error
 312          v1 'file-error "Error with add-name-to-file %s" newname)))))
 313
 314 (defun tramp-fish-handle-copy-file
 315   (filename newname &optional ok-if-already-exists keep-date
 316             preserve-uid-gid preserve-selinux-context)
 317   "Like `copy-file' for Tramp files."
 318   (tramp-fish-do-copy-or-rename-file
 319    'copy filename newname ok-if-already-exists keep-date preserve-uid-gid))
 320
 321 (defun tramp-fish-handle-delete-directory (directory &optional recursive)
 322   "Like `delete-directory' for Tramp files."
 323   (when (file-exists-p directory)
 324     (if recursive
 325         (mapc
 326          (lambda (file)
 327            (if (file-directory-p file)
 328                (tramp-compat-delete-directory file recursive)
 329              (delete-file file)))
 330          ;; We do not want to delete "." and "..".
 331          (directory-files
 332           directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")))
 333     (with-parsed-tramp-file-name
 334         (directory-file-name (expand-file-name directory)) nil
 335       (tramp-flush-directory-property v localname)
 336       (tramp-fish-send-command-and-check v (format "#RMD %s" localname)))))
 337
 338 (defun tramp-fish-handle-delete-file (filename &optional trash)
 339   "Like `delete-file' for Tramp files."
 340   (when (file-exists-p filename)
 341     (with-parsed-tramp-file-name (expand-file-name filename) nil
 342       (tramp-flush-file-property v localname)
 343       (tramp-fish-send-command-and-check v (format "#DELE %s" localname)))))
 344
 345 (defun tramp-fish-handle-directory-files-and-attributes
 346   (directory &optional full match nosort id-format)
 347   "Like `directory-files-and-attributes' for Tramp files."
 348   (mapcar
 349    (lambda (x)
 350      (cons x
 351            (tramp-compat-file-attributes
 352             (if full x (expand-file-name x directory))
 353             id-format)))
 354    (directory-files directory full match nosort)))
 355
 356 (defun tramp-fish-handle-expand-file-name (name &optional dir)
 357   "Like `expand-file-name' for Tramp files."
 358   ;; If DIR is not given, use DEFAULT-DIRECTORY or "/".
 359   (setq dir (or dir default-directory "/"))
 360   ;; Unless NAME is absolute, concat DIR and NAME.
 361   (unless (file-name-absolute-p name)
 362     (setq name (concat (file-name-as-directory dir) name)))
 363   ;; If NAME is not a Tramp file, run the real handler,
 364   (if (or (tramp-completion-mode-p) (not (tramp-tramp-file-p name)))
 365       (tramp-drop-volume-letter
 366        (tramp-run-real-handler 'expand-file-name (list name nil)))
 367     ;; Dissect NAME.
 368     (with-parsed-tramp-file-name name nil
 369       (unless (tramp-run-real-handler 'file-name-absolute-p (list localname))
 370         (setq localname (concat "~/" localname)))
 371       ;; Tilde expansion if necessary.
 372       (when (string-match "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)
 373         (let ((uname (match-string 1 localname))
 374               (fname (match-string 2 localname)))
 375           ;; We cannot apply "~user/", because this is not supported
 376           ;; by the FISH protocol.
 377           (unless (string-equal uname "~")
 378             (tramp-error
 379              v 'file-error "Tilde expansion not supported for %s" name))
 380           (setq uname
 381             (with-connection-property v uname
 382               (tramp-fish-send-command-and-check v "#PWD")
 383               (with-current-buffer (tramp-get-buffer v)
 384                 (goto-char (point-min))
 385                 (buffer-substring (point) (tramp-compat-line-end-position)))))
 386           (setq localname (concat uname fname))))
 387       ;; There might be a double slash, for example when "~/"
 388       ;; expands to "/". Remove this.
 389       (while (string-match "//" localname)
 390         (setq localname (replace-match "/" t t localname)))
 391       ;; No tilde characters in file name, do normal
 392       ;; expand-file-name (this does "/./" and "/../").  We bind
 393       ;; `directory-sep-char' here for XEmacs on Windows, which
 394       ;; would otherwise use backslash.  `default-directory' is
 395       ;; bound, because on Windows there would be problems with UNC
 396       ;; shares or Cygwin mounts.
 397       (let ((directory-sep-char ?/)
 398             (default-directory (tramp-compat-temporary-file-directory)))
 399         (tramp-make-tramp-file-name
 400          method user host
 401          (tramp-drop-volume-letter
 402           (tramp-run-real-handler
 403            'expand-file-name (list localname))))))))
 404
 405 (defun tramp-fish-handle-file-attributes (filename &optional id-format)
 406   "Like `file-attributes' for Tramp files."
 407   (with-parsed-tramp-file-name (expand-file-name filename) nil
 408     (with-file-property v localname (format "file-attributes-%s" id-format)
 409       (cdr (car (tramp-fish-get-file-entries v localname nil))))))
 410
 411 (defun tramp-fish-handle-file-directory-p (filename)
 412   "Like `file-directory-p' for Tramp files."
 413   (let ((attributes (file-attributes filename)))
 414     (and attributes
 415          (or (string-match "d" (nth 8 attributes))
 416              (and (file-symlink-p filename)
 417                   (with-parsed-tramp-file-name filename nil
 418                     (file-directory-p
 419                      (tramp-make-tramp-file-name
 420                       method user host (nth 0 attributes))))))
 421          t)))
 422
 423 (defun tramp-fish-handle-file-exists-p (filename)
 424   "Like `file-exists-p' for Tramp files."
 425   (and (file-attributes filename) t))
 426
 427 (defun tramp-fish-handle-file-executable-p (filename)
 428   "Like `file-executable-p' for Tramp files."
 429   (with-parsed-tramp-file-name (expand-file-name filename) nil
 430     (with-file-property v localname "file-executable-p"
 431       (when (file-exists-p filename)
 432         (let ((mode-chars (string-to-vector (nth 8 (file-attributes filename))))
 433               (home-directory
 434                (tramp-make-tramp-file-name
 435                 method user host
 436                 (tramp-get-connection-property v "home-directory" nil))))
 437           (or (and (char-equal (aref mode-chars 3) ?x)
 438                    (equal (nth 2 (file-attributes filename))
 439                           (nth 2 (file-attributes home-directory))))
 440               (and (char-equal (aref mode-chars 6) ?x)
 441                    (equal (nth 3 (file-attributes filename))
 442                           (nth 3 (file-attributes home-directory))))
 443               (char-equal (aref mode-chars 9) ?x)))))))
 444
 445 (defun tramp-fish-handle-file-readable-p (filename)
 446   "Like `file-readable-p' for Tramp files."
 447   (with-parsed-tramp-file-name (expand-file-name filename) nil
 448     (with-file-property v localname "file-readable-p"
 449       (when (file-exists-p filename)
 450         (let ((mode-chars (string-to-vector (nth 8 (file-attributes filename))))
 451               (home-directory
 452                (tramp-make-tramp-file-name
 453                 method user host
 454                 (tramp-get-connection-property v "home-directory" nil))))
 455           (or (and (char-equal (aref mode-chars 1) ?r)
 456                    (equal (nth 2 (file-attributes filename))
 457                           (nth 2 (file-attributes home-directory))))
 458               (and (char-equal (aref mode-chars 4) ?r)
 459                    (equal (nth 3 (file-attributes filename))
 460                           (nth 3 (file-attributes home-directory))))
 461               (char-equal (aref mode-chars 7) ?r)))))))
 462
 463 (defun tramp-fish-handle-file-writable-p (filename)
 464   "Like `file-writable-p' for Tramp files."
 465   (with-parsed-tramp-file-name (expand-file-name filename) nil
 466     (with-file-property v localname "file-writable-p"
 467       (if (not (file-exists-p filename))
 468           ;; If file doesn't exist, check if directory is writable.
 469           (and (file-directory-p (file-name-directory filename))
 470                (file-writable-p (file-name-directory filename)))
 471         ;; Existing files must be writable.
 472         (let ((mode-chars (string-to-vector (nth 8 (file-attributes filename))))
 473               (home-directory
 474                (tramp-make-tramp-file-name
 475                 method user host
 476                 (tramp-get-connection-property v "home-directory" nil))))
 477           (or (and (char-equal (aref mode-chars 2) ?w)
 478                    (equal (nth 2 (file-attributes filename))
 479                           (nth 2 (file-attributes home-directory))))
 480               (and (char-equal (aref mode-chars 5) ?w)
 481                    (equal (nth 3 (file-attributes filename))
 482                           (nth 3 (file-attributes home-directory))))
 483               (char-equal (aref mode-chars 8) ?w)))))))
 484
 485 (defun tramp-fish-handle-file-local-copy (filename)
 486   "Like `file-local-copy' for Tramp files."
 487   (with-parsed-tramp-file-name (expand-file-name filename) nil
 488     (unless (file-exists-p filename)
 489       (tramp-error
 490        v 'file-error
 491        "Cannot make local copy of non-existing file `%s'" filename))
 492     (let ((tmpfile (tramp-compat-make-temp-file filename)))
 493       (with-progress-reporter
 494           v 3 (format "Fetching %s to tmp file %s" filename tmpfile)
 495         (when (tramp-fish-retrieve-data v)
 496           ;; Save file
 497           (with-current-buffer (tramp-get-buffer v)
 498             (write-region (point-min) (point-max) tmpfile))
 499           tmpfile)))))
 500
 501 ;; This function should return "foo/" for directories and "bar" for
 502 ;; files.
 503 (defun tramp-fish-handle-file-name-all-completions (filename directory)
 504   "Like `file-name-all-completions' for Tramp files."
 505   (all-completions
 506    filename
 507    (with-parsed-tramp-file-name (expand-file-name directory) nil
 508      (with-file-property v localname "file-name-all-completions"
 509        (save-match-data
 510          (let ((entries
 511                 (with-file-property v localname "file-entries"
 512                   (tramp-fish-get-file-entries v localname t))))
 513            (mapcar
 514             (lambda (x)
 515               (list
 516                (if (string-match "d" (nth 9 x))
 517                    (file-name-as-directory (nth 0 x))
 518                  (nth 0 x))))
 519             entries)))))))
 520
 521 (defun tramp-fish-handle-file-newer-than-file-p (file1 file2)
 522   "Like `file-newer-than-file-p' for Tramp files."
 523   (cond
 524    ((not (file-exists-p file1)) nil)
 525    ((not (file-exists-p file2)) t)
 526    (t (tramp-time-less-p (nth 5 (file-attributes file2))
 527                          (nth 5 (file-attributes file1))))))
 528
 529 (defun tramp-fish-handle-insert-directory
 530   (filename switches &optional wildcard full-directory-p)
 531   "Like `insert-directory' for Tramp files.
 532 WILDCARD and FULL-DIRECTORY-P are not handled."
 533   (setq filename (expand-file-name filename))
 534   (when (file-directory-p filename)
 535     ;; This check is a little bit strange, but in `dired-add-entry'
 536     ;; this function is called with a non-directory ...
 537     (setq filename (file-name-as-directory filename)))
 538
 539   (with-parsed-tramp-file-name filename nil
 540     (tramp-flush-file-property v localname)
 541     (save-match-data
 542       (let ((entries
 543              (with-file-property v localname "file-entries"
 544                (tramp-fish-get-file-entries v localname t))))
 545
 546         ;; Sort entries
 547         (setq entries
 548               (sort
 549                entries
 550                (lambda (x y)
 551                  (if (string-match "t" switches)
 552                      ;; Sort by date.
 553                      (tramp-time-less-p (nth 6 y) (nth 6 x))
 554                    ;; Sort by name.
 555                    (string-lessp (nth 0 x) (nth 0 y))))))
 556
 557         ;; Print entries.
 558         (mapcar
 559          (lambda (x)
 560            (insert
 561             (format
 562              "%10s %3d %-8s %-8s %8s %s %s%s\n"
 563              (nth 9 x) ; mode
 564              1         ; hardlinks
 565              (nth 3 x) ; uid
 566              (nth 4 x) ; gid
 567              (nth 8 x) ; size
 568              (format-time-string
 569               (if (tramp-time-less-p
 570                    (tramp-time-subtract (current-time) (nth 6 x))
 571                    tramp-half-a-year)
 572                   "%b %e %R"
 573                 "%b %e  %Y")
 574               (nth 6 x)) ; date
 575              (nth 0 x) ; file name
 576              (if (stringp (nth 1 x)) (format " -> %s" (nth 1 x)) "")))
 577            (forward-line)
 578            (beginning-of-line))
 579          entries)))))
 580
 581 (defun tramp-fish-handle-insert-file-contents
 582   (filename &optional visit beg end replace)
 583   "Like `insert-file-contents' for Tramp files."
 584   (barf-if-buffer-read-only)
 585   (when visit
 586     (setq buffer-file-name (expand-file-name filename))
 587     (set-visited-file-modtime)
 588     (set-buffer-modified-p nil))
 589
 590   (with-parsed-tramp-file-name filename nil
 591     (if (not (file-exists-p filename))
 592         (tramp-error
 593          v 'file-error "File %s not found on remote host" filename)
 594
 595       (let ((point (point))
 596             size)
 597         (with-progress-reporter v 3 (format "Fetching file %s" filename)
 598           (when (tramp-fish-retrieve-data v)
 599             ;; Insert file
 600             (insert
 601              (with-current-buffer (tramp-get-buffer v)
 602                (let ((beg (or beg (point-min)))
 603                      (end (min (or end (point-max)) (point-max))))
 604                  (setq size (- end beg))
 605                  (buffer-substring beg end))))
 606             (goto-char point)))
 607
 608         (list (expand-file-name filename) size)))))
 609
 610 (defun tramp-fish-handle-make-directory (dir &optional parents)
 611   "Like `make-directory' for Tramp files."
 612   (setq dir (directory-file-name (expand-file-name dir)))
 613   (unless (file-name-absolute-p dir)
 614     (setq dir (expand-file-name dir default-directory)))
 615   (with-parsed-tramp-file-name dir nil
 616     (save-match-data
 617       (let ((ldir (file-name-directory dir)))
 618         ;; Make missing directory parts
 619         (when (and parents (not (file-directory-p ldir)))
 620           (make-directory ldir parents))
 621         ;; Just do it
 622         (when (file-directory-p ldir)
 623           (make-directory-internal dir))
 624         (unless (file-directory-p dir)
 625           (tramp-error v 'file-error "Couldn't make directory %s" dir))))))
 626
 627 (defun tramp-fish-handle-make-directory-internal (directory)
 628   "Like `make-directory-internal' for Tramp files."
 629   (setq directory (directory-file-name (expand-file-name directory)))
 630   (unless (file-name-absolute-p directory)
 631     (setq directory (expand-file-name directory default-directory)))
 632   (when (file-directory-p (file-name-directory directory))
 633     (with-parsed-tramp-file-name directory nil
 634       (save-match-data
 635         (unless
 636             (tramp-fish-send-command-and-check v (format "#MKD %s" localname))
 637           (tramp-error
 638            v 'file-error "Couldn't make directory %s" directory))))))
 639
 640 (defun tramp-fish-handle-make-symbolic-link
 641   (filename linkname &optional ok-if-already-exists)
 642   "Like `make-symbolic-link' for Tramp files.
 643 If LINKNAME is a non-Tramp file, it is used verbatim as the target of
 644 the symlink.  If LINKNAME is a Tramp file, only the localname component is
 645 used as the target of the symlink.
 646
 647 If LINKNAME is a Tramp file and the localname component is relative, then
 648 it is expanded first, before the localname component is taken.  Note that
 649 this can give surprising results if the user/host for the source and
 650 target of the symlink differ."
 651   (with-parsed-tramp-file-name linkname nil
 652     ;; Do the 'confirm if exists' thing.
 653     (when (file-exists-p linkname)
 654       ;; What to do?
 655       (if (or (null ok-if-already-exists) ; not allowed to exist
 656               (and (numberp ok-if-already-exists)
 657                    (not (yes-or-no-p
 658                          (format
 659                           "File %s already exists; make it a link anyway? "
 660                           localname)))))
 661           (tramp-error
 662            v 'file-already-exists "File %s already exists" localname)
 663         (delete-file linkname)))
 664
 665     ;; If FILENAME is a Tramp name, use just the localname component.
 666     (when (tramp-tramp-file-p filename)
 667       (setq filename (tramp-file-name-localname
 668                       (tramp-dissect-file-name (expand-file-name filename)))))
 669
 670     ;; Right, they are on the same host, regardless of user, method, etc.
 671     ;; We now make the link on the remote machine. This will occur as the user
 672     ;; that FILENAME belongs to.
 673     (unless
 674         (tramp-fish-send-command-and-check
 675          v (format "#SYMLINK %s %s" filename localname))
 676       (tramp-error v 'file-error "Error creating symbolic link %s" linkname))))
 677
 678 (defun tramp-fish-handle-rename-file
 679   (filename newname &optional ok-if-already-exists)
 680   "Like `rename-file' for Tramp files."
 681   (tramp-fish-do-copy-or-rename-file
 682    'rename filename newname ok-if-already-exists t))
 683
 684 (defun tramp-fish-handle-set-file-modes (filename mode)
 685   "Like `set-file-modes' for Tramp files."
 686   (with-parsed-tramp-file-name filename nil
 687     (tramp-flush-file-property v localname)
 688     (unless (tramp-fish-send-command-and-check
 689              v (format "#CHMOD %s %s"
 690                        (tramp-decimal-to-octal mode)
 691                        (tramp-shell-quote-argument localname)))
 692       (tramp-error
 693        v 'file-error "Error while changing file's mode %s" filename))))
 694
 695 (defun tramp-fish-handle-set-file-times (filename &optional time)
 696   "Like `set-file-times' for Tramp files."
 697   (with-parsed-tramp-file-name filename nil
 698     (let ((time (if (or (null time) (equal time '(0 0))) (current-time) time)))
 699       (zerop (process-file
 700               "touch" nil nil nil "-t"
 701               (format-time-string "%Y%m%d%H%M.%S" time)
 702               (tramp-shell-quote-argument localname))))))
 703
 704 (defun tramp-fish-handle-write-region
 705   (start end filename &optional append visit lockname confirm)
 706   "Like `write-region' for Tramp files."
 707   (setq filename (expand-file-name filename))
 708   (with-parsed-tramp-file-name filename nil
 709     ;; XEmacs takes a coding system as the seventh argument, not `confirm'
 710     (when (and (not (featurep 'xemacs))
 711                confirm (file-exists-p filename))
 712       (unless (y-or-n-p (format "File %s exists; overwrite anyway? "
 713                                 filename))
 714         (tramp-error v 'file-error "File not overwritten")))
 715
 716     (tramp-flush-file-property v localname)
 717
 718     ;; Send command
 719     (let ((tramp-fish-ok-prompt-regexp
 720            (concat
 721             tramp-fish-ok-prompt-regexp "\\|"
 722             tramp-fish-continue-prompt-regexp)))
 723       (tramp-fish-send-command
 724        v (format "%s %d %s\n### 100"
 725                  (if append "#APPEND" "#STOR") (- end start) localname)))
 726
 727     ;; Send data, if there are any.
 728     (when (> end start)
 729       (tramp-fish-send-command v (buffer-substring-no-properties start end)))
 730
 731     (when (eq visit t)
 732       (set-visited-file-modtime))))
 733
 734 (defun tramp-fish-handle-executable-find (command)
 735   "Like `executable-find' for Tramp files."
 736   (with-temp-buffer
 737     (if (zerop (process-file "which" nil t nil command))
 738         (progn
 739           (goto-char (point-min))
 740           (buffer-substring (point-min) (tramp-compat-line-end-position))))))
 741
 742 (defun tramp-fish-handle-process-file
 743   (program &optional infile destination display &rest args)
 744   "Like `process-file' for Tramp files."
 745   ;; The implementation is not complete yet.
 746   (when (and (numberp destination) (zerop destination))
 747     (error "Implementation does not handle immediate return"))
 748
 749   (with-parsed-tramp-file-name default-directory nil
 750     (let (command input tmpinput output tmpoutput stderr tmpstderr
 751                   outbuf tmpfile ret)
 752       ;; Compute command.
 753       (setq command (mapconcat 'tramp-shell-quote-argument
 754                                (cons program args) " "))
 755       ;; Determine input.
 756       (if (null infile)
 757           (setq input "/dev/null")
 758         (setq infile (expand-file-name infile))
 759         (if (tramp-equal-remote default-directory infile)
 760             ;; INFILE is on the same remote host.
 761             (setq input (with-parsed-tramp-file-name infile nil localname))
 762           ;; INFILE must be copied to remote host.
 763           (setq input (tramp-make-tramp-temp-file v)
 764                 tmpinput (tramp-make-tramp-file-name method user host input))
 765           (copy-file infile tmpinput t)))
 766       (when input (setq command (format "%s <%s" command input)))
 767
 768       ;; Determine output.
 769       (setq output (tramp-make-tramp-temp-file v)
 770             tmpoutput (tramp-make-tramp-file-name method user host output))
 771       (cond
 772        ;; Just a buffer
 773        ((bufferp destination)
 774         (setq outbuf destination))
 775        ;; A buffer name
 776        ((stringp destination)
 777         (setq outbuf (get-buffer-create destination)))
 778        ;; (REAL-DESTINATION ERROR-DESTINATION)
 779        ((consp destination)
 780         ;; output
 781         (cond
 782          ((bufferp (car destination))
 783           (setq outbuf (car destination)))
 784          ((stringp (car destination))
 785           (setq outbuf (get-buffer-create (car destination)))))
 786         ;; stderr
 787         (cond
 788          ((stringp (cadr destination))
 789           (setcar (cdr destination) (expand-file-name (cadr destination)))
 790           (if (tramp-equal-remote default-directory (cadr destination))
 791               ;; stderr is on the same remote host.
 792               (setq stderr (with-parsed-tramp-file-name
 793                                (cadr destination) nil localname))
 794             ;; stderr must be copied to remote host.  The temporary
 795             ;; file must be deleted after execution.
 796             (setq stderr (tramp-make-tramp-temp-file v)
 797                   tmpstderr (tramp-make-tramp-file-name
 798                              method user host stderr))))
 799          ;; stderr to be discarded
 800          ((null (cadr destination))
 801           (setq stderr "/dev/null"))))
 802        ;; 't
 803        (destination
 804         (setq outbuf (current-buffer))))
 805       (when stderr (setq command (format "%s 2>%s" command stderr)))
 806
 807       ;; Goto working directory.
 808       (unless
 809           (tramp-fish-send-command-and-check
 810            v (format "#CWD %s" (tramp-shell-quote-argument localname)))
 811         (tramp-error v 'file-error "No such directory: %s" default-directory))
 812       ;; Send the command.  It might not return in time, so we protect it.
 813       (condition-case nil
 814           (unwind-protect
 815               (unless (tramp-fish-send-command-and-check
 816                        v (format
 817                           "#EXEC %s %s"
 818                           (tramp-shell-quote-argument command) output))
 819                 (error nil))
 820             ;; Check return code.
 821             (setq tmpfile
 822                   (file-local-copy
 823                    (tramp-make-tramp-file-name method user host output)))
 824             (with-temp-buffer
 825               (insert-file-contents tmpfile)
 826               (goto-char (point-max))
 827               (forward-line -1)
 828               (looking-at "^###RESULT: \\([0-9]+\\)")
 829               (setq ret (string-to-number (match-string 1)))
 830               (delete-region (point) (point-max))
 831               (write-region (point-min) (point-max) tmpfile))
 832             ;; We should show the output anyway.
 833             (when outbuf
 834               (with-current-buffer outbuf (insert-file-contents tmpfile))
 835               (when display (display-buffer outbuf))))
 836         ;; When the user did interrupt, we should do it also.
 837         (error (setq ret 1)))
 838
 839       ;; Provide error file.
 840       (when tmpstderr (rename-file tmpstderr (cadr destination) t))
 841       ;; Cleanup.
 842       (when tmpinput (delete-file tmpinput))
 843       (when tmpoutput (delete-file tmpoutput))
 844       ;; Return exit status.
 845       ret)))
 846
 847
 848 ;; Internal file name functions
 849
 850 (defun tramp-fish-do-copy-or-rename-file
 851   (op filename newname &optional ok-if-already-exists keep-date preserve-uid-gid)
 852   "Copy or rename a remote file.
 853 OP must be `copy' or `rename' and indicates the operation to
 854 perform.  FILENAME specifies the file to copy or rename, NEWNAME
 855 is the name of the new file (for copy) or the new name of the
 856 file (for rename).  OK-IF-ALREADY-EXISTS means don't barf if
 857 NEWNAME exists already.  KEEP-DATE means to make sure that
 858 NEWNAME has the same timestamp as FILENAME.
 859
 860 This function is invoked by `tramp-fish-handle-copy-file' and
 861 `tramp-fish-handle-rename-file'.  It is an error if OP is neither
 862 of `copy' and `rename'.  FILENAME and NEWNAME must be absolute
 863 file names."
 864   (unless (memq op '(copy rename))
 865     (error "Unknown operation `%s', must be `copy' or `rename'" op))
 866   (let ((t1 (tramp-tramp-file-p filename))
 867         (t2 (tramp-tramp-file-p newname)))
 868
 869     (unless ok-if-already-exists
 870       (when (and t2 (file-exists-p newname))
 871         (with-parsed-tramp-file-name newname nil
 872           (tramp-error
 873            v 'file-already-exists "File %s already exists" newname))))
 874
 875     (prog1
 876         (cond
 877          ;; Both are Tramp files.
 878          ((and t1 t2)
 879           (cond
 880            ;; Shortcut: if method, host, user are the same for both
 881            ;; files, we invoke `cp' or `mv' on the remote host
 882            ;; directly.
 883            ((tramp-equal-remote filename newname)
 884             (tramp-fish-do-copy-or-rename-file-directly
 885              op filename newname keep-date preserve-uid-gid))
 886            ;; No shortcut was possible.  So we copy the
 887            ;; file first.  If the operation was `rename', we go
 888            ;; back and delete the original file (if the copy was
 889            ;; successful).  The approach is simple-minded: we
 890            ;; create a new buffer, insert the contents of the
 891            ;; source file into it, then write out the buffer to
 892            ;; the target file.  The advantage is that it doesn't
 893            ;; matter which filename handlers are used for the
 894            ;; source and target file.
 895            (t
 896             (tramp-do-copy-or-rename-file-via-buffer
 897              op filename newname keep-date))))
 898
 899          ;; One file is a Tramp file, the other one is local.
 900          ((or t1 t2)
 901           ;; Use the generic method via a Tramp buffer.
 902           (tramp-do-copy-or-rename-file-via-buffer
 903            op filename newname keep-date))
 904
 905          (t
 906           ;; One of them must be a Tramp file.
 907           (error "Tramp implementation says this cannot happen")))
 908       ;; When newname did exist, we have wrong cached values.
 909       (when t2
 910         (with-parsed-tramp-file-name newname nil
 911           (tramp-flush-file-property v localname)
 912           (tramp-flush-file-property v (file-name-directory localname)))))))
 913
 914 (defun tramp-fish-do-copy-or-rename-file-directly
 915   (op filename newname keep-date preserve-uid-gid)
 916   "Invokes `COPY' or `RENAME' on the remote system.
 917 OP must be one of `copy' or `rename', indicating `cp' or `mv',
 918 respectively.  VEC specifies the connection.  LOCALNAME1 and
 919 LOCALNAME2 specify the two arguments of `cp' or `mv'.  If
 920 KEEP-DATE is non-nil, preserve the time stamp when copying.
 921 PRESERVE-UID-GID is completely ignored."
 922   (with-parsed-tramp-file-name filename v1
 923     (with-parsed-tramp-file-name newname v2
 924       (tramp-fish-send-command
 925        v1
 926        (format "%s %s %s"
 927                (if (eq op 'copy) "#COPY" "#RENAME")
 928                (tramp-shell-quote-argument v1-localname)
 929                (tramp-shell-quote-argument v2-localname)))))
 930   ;; KEEP-DATE handling.
 931   (when (and keep-date (functionp 'set-file-times))
 932     (set-file-times newname (nth 5 (file-attributes filename))))
 933   ;; Set the mode.
 934   (set-file-modes newname (tramp-default-file-modes filename)))
 935
 936 (defun tramp-fish-get-file-entries (vec localname list)
 937   "Read entries returned by FISH server.
 938 When LIST is true, a #LIST command will be sent, including all entries
 939 of a directory.  Otherwise, #STAT is sent for just one entry.
 940 Result is a list of (LOCALNAME LINK COUNT UID GID ATIME MTIME CTIME
 941 SIZE MODE WEIRD INODE DEVICE)."
 942   (block nil
 943     (with-current-buffer (tramp-get-buffer vec)
 944       ;; #LIST does not work properly with trailing "/", at least in
 945       ;; .fishsrv.pl.
 946       (when (string-match "/$" localname)
 947         (setq localname (concat localname ".")))
 948
 949       (let ((command (format "%s %s" (if list "#LIST" "#STAT") localname))
 950             buffer-read-only num res)
 951
 952         ;; Send command
 953         (tramp-fish-send-command vec command)
 954
 955         ;; Read number of entries
 956         (goto-char (point-min))
 957         (condition-case nil
 958             (unless (integerp (setq num (read (current-buffer)))) (error nil))
 959           (error (return nil)))
 960         (forward-line)
 961         (delete-region (point-min) (point))
 962
 963         ;; Read return code
 964         (goto-char (point-min))
 965         (condition-case nil
 966             (unless (looking-at tramp-fish-continue-prompt-regexp) (error nil))
 967           (error (return nil)))
 968         (forward-line)
 969         (delete-region (point-min) (point))
 970
 971         ;; Loop the listing
 972         (dotimes (i num)
 973           (let ((item (tramp-fish-read-file-entry)))
 974             ;; Add inode and device.
 975             (add-to-list
 976              'res (append item
 977                           (list (tramp-get-inode vec)
 978                                 (tramp-get-device vec))))))
 979
 980         ;; Read return code
 981         (goto-char (point-min))
 982         (condition-case nil
 983             (unless (looking-at tramp-fish-ok-prompt-regexp) (error nil))
 984           (error (tramp-error
 985                   vec 'file-error
 986                   "`%s' does not return a valid Lisp expression: `%s'"
 987                   command (buffer-string))))
 988         (forward-line)
 989         (delete-region (point-min) (point))
 990
 991         res))))
 992
 993 (defun tramp-fish-read-file-entry ()
 994   "Parse entry in output buffer.
 995 Result is the list (LOCALNAME LINK COUNT UID GID ATIME MTIME CTIME
 996 SIZE MODE WEIRD)."
 997   ;; We are called from `tramp-fish-get-file-entries', which sets the
 998   ;; current buffer.
 999   (let (buffer-read-only localname link uid gid mtime size mode)
1000     (block nil
1001       (while t
1002         (cond
1003          ;; P<unix permissions> <owner>.<group>
1004          ((looking-at "^P\\(.+\\)\\s-\\(.+\\)\\.\\(.+\\)$")
1005           (setq mode (match-string 1))
1006           (setq uid (match-string 2))
1007           (setq gid (match-string 3))
1008           (when (string-match "^d" mode) (setq link t)))
1009          ;; S<size>
1010          ((looking-at "^S\\([0-9]+\\)$")
1011           (setq size (string-to-number (match-string 1))))
1012          ;; D<year> <month> <day> <hour> <minute> <second>[.1234]
1013          ((looking-at
1014            "^D\\([0-9]+\\)\\s-\\([0-9]+\\)\\s-\\([0-9]+\\)\\s-\\([0-9]+\\)\\s-\\([0-9]+\\)\\s-\\(\\S-+\\)$")
1015           (setq mtime
1016                 (encode-time
1017                  (string-to-number (match-string 6))
1018                  (string-to-number (match-string 5))
1019                  (string-to-number (match-string 4))
1020                  (string-to-number (match-string 3))
1021                  (string-to-number (match-string 2))
1022                  (string-to-number (match-string 1)))))
1023          ;; d<3-letters month name> <day> <year or HH:MM>
1024          ((looking-at "^d") nil)
1025          ;; E<major-of-device>,<minor>
1026          ((looking-at "^E") nil)
1027          ;; :<filename>
1028          ((looking-at "^:\\(.+\\)$")
1029           (setq localname (match-string 1)))
1030          ;; L<filename symlink points to>
1031          ((looking-at "^L\\(.+\\)$")
1032           (setq link (match-string 1)))
1033          ;; M<mimetype>
1034          ((looking-at "^M\\(.+\\)$") nil)
1035          ;; last line
1036          ((looking-at "^$")
1037           (return)))
1038         ;; Delete line.
1039         (forward-line)
1040         (delete-region (point-min) (point))))
1041
1042     ;; Delete trailing empty line.
1043     (forward-line)
1044     (delete-region (point-min) (point))
1045
1046     ;; Return entry in `file-attributes' format.
1047     (list localname link -1 uid gid '(0 0) mtime '(0 0) size mode nil)))
1048
1049 (defun tramp-fish-retrieve-data (vec)
1050   "Reads remote data for FISH protocol.
1051 The data are left in the connection buffer of VEC for further processing.
1052 Returns the size of the data."
1053   (block nil
1054     (with-current-buffer (tramp-get-buffer vec)
1055       ;; The retrieved data might be in binary format, without
1056       ;; trailing newline.  Therefore, the OK prompt might not start
1057       ;; at the beginning of a line.
1058       (let ((tramp-fish-ok-prompt-regexp "### 200\n")
1059             size)
1060
1061         ;; Send command
1062         (tramp-fish-send-command
1063          vec (format "#RETR %s" (tramp-file-name-localname vec)))
1064
1065         ;; Read filesize
1066         (goto-char (point-min))
1067         (condition-case nil
1068             (unless (integerp (setq size (read (current-buffer)))) (error nil))
1069           (error (return nil)))
1070         (forward-line)
1071         (delete-region (point-min) (point))
1072
1073         ;; Read return code
1074         (goto-char (point-min))
1075         (condition-case nil
1076             (unless (looking-at tramp-fish-continue-prompt-regexp) (error nil))
1077           (error (return nil)))
1078         (forward-line)
1079         (delete-region (point-min) (point))
1080
1081         ;; The received data might contain the OK prompt already, so
1082         ;; there might be outstanding data.
1083         (while (/= (+ size (length tramp-fish-ok-prompt-regexp))
1084                    (- (point-max) (point-min)))
1085           (tramp-wait-for-regexp
1086            (tramp-get-connection-process vec) nil
1087            (concat tramp-fish-ok-prompt-regexp "$")))
1088
1089         ;; Read return code
1090         (goto-char (+ (point-min) size))
1091         (condition-case nil
1092             (unless (looking-at tramp-fish-ok-prompt-regexp) (error nil))
1093           (error (return nil)))
1094         (delete-region (+ (point-min) size) (point-max))
1095         size))))
1096
1097
1098 ;; Connection functions
1099
1100 (defun tramp-fish-maybe-open-connection (vec)
1101   "Maybe open a connection VEC.
1102 Does not do anything if a connection is already open, but re-opens the
1103 connection if a previous connection has died for some reason."
1104   (let ((process-connection-type tramp-process-connection-type)
1105         (p (get-buffer-process (tramp-get-buffer vec))))
1106
1107     ;; New connection must be opened.
1108     (unless (and p (processp p) (memq (process-status p) '(run open)))
1109
1110       ;; Set variables for computing the prompt for reading password.
1111       (setq tramp-current-method (tramp-file-name-method vec)
1112             tramp-current-user (tramp-file-name-user vec)
1113             tramp-current-host (tramp-file-name-host vec))
1114
1115       ;; Start new process.
1116       (when (and p (processp p))
1117         (delete-process p))
1118       (setenv "TERM" tramp-terminal-type)
1119       (setenv "PS1" tramp-initial-end-of-output)
1120       (with-progress-reporter
1121           vec 3
1122           (format "Opening connection for %s@%s using %s"
1123                   tramp-current-user tramp-current-host tramp-current-method)
1124
1125         (let* ((process-connection-type tramp-process-connection-type)
1126                (inhibit-eol-conversion nil)
1127                (coding-system-for-read 'binary)
1128                (coding-system-for-write 'binary)
1129                ;; This must be done in order to avoid our file name handler.
1130                (p (let ((default-directory
1131                           (tramp-compat-temporary-file-directory)))
1132                     (start-process
1133                      (or (tramp-get-connection-property vec "process-name" nil)
1134                          (tramp-buffer-name vec))
1135                      (tramp-get-connection-buffer vec)
1136                      "ssh" "-l"
1137                      (tramp-file-name-user vec)
1138                      (tramp-file-name-host vec)))))
1139           (tramp-message
1140            vec 6 "%s" (mapconcat 'identity (process-command p) " "))
1141
1142           ;; Check whether process is alive.
1143           (tramp-set-process-query-on-exit-flag p nil)
1144
1145           (tramp-process-actions p vec tramp-actions-before-shell 60)
1146           (tramp-fish-send-command vec tramp-fish-start-fish-server-command)
1147           (tramp-message
1148            vec 3
1149            "Found remote shell prompt on `%s'" (tramp-file-name-host vec)))))))
1150
1151 (defun tramp-fish-send-command (vec command)
1152   "Send the COMMAND to connection VEC."
1153   (tramp-fish-maybe-open-connection vec)
1154   (tramp-message vec 6 "%s" command)
1155   (tramp-send-string vec command)
1156   (tramp-wait-for-regexp
1157    (tramp-get-connection-process vec) nil
1158    (concat tramp-fish-ok-prompt-regexp "\\|" tramp-fish-error-prompt-regexp)))
1159
1160 (defun tramp-fish-send-command-and-check (vec command)
1161   "Send the COMMAND to connection VEC.
1162 Returns nil if there has been an error message."
1163
1164   ;; Send command.
1165   (tramp-fish-send-command vec command)
1166
1167   ;; Read return code.
1168   (with-current-buffer (tramp-get-buffer vec)
1169     (goto-char (point-min))
1170     (looking-at tramp-fish-ok-prompt-regexp)))
1171
1172 (provide 'tramp-fish)
1173 ;
1174 ;;;; TODO:
1175 ;
1176 ;; * Evaluate the MIME information with #LIST or #STAT.
1177 ;
1178
1179 ;; arch-tag: a66df7df-5f29-42a7-a921-643ceb29db49
1180 ;;;; tramp-fish.el ends here