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