1 ;;; tramp-fish.el --- Tramp access functions for FISH protocol
3 ;; Copyright (C) 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
5 ;; Author: Michael Albinus <michael.albinus@gmx.de>
6 ;; Keywords: comm, processes
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software: you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
26 ;; Access functions for FIles transferred over SHell protocol from Tramp.
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.
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.
44 ;; The GNU Midnight Commander implements the original fish protocol
45 ;; version 0.0.2. The KDE Konqueror has its own implementation, which
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.
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 "\ ".
57 ;; Command/Return Code Comment
59 ;; #FISH initial connection, not used
61 ;; ### 100 transfer fish server missing server, or wrong checksum
64 ;; #VER a.b.c <commands requested>
65 ;; VER x.y.z <commands offered> .fishsrv.pl response is not uptodate
72 ;; #COPY /path/a /path/b version 0.0.3 only
74 ;; #RENAME /path/a /path/b
76 ;; #SYMLINK /path/a /path/b
78 ;; #LINK /path/a /path/b
86 ;; #CHOWN user /file/name
88 ;; #CHGRP group /file/name
92 ;; #READ <offset> <size> /path/and/filename
93 ;; ### 291 successful exit when reading
95 ;; ### 292 successful exit when reading
98 ;; #WRITE <offset> <size> /path/and/filename
100 ;; #APPEND <size> /path/and/filename version 0.0.3 only
103 ;; <number of entries> version 0.0.3 only
104 ;; ### 100 version 0.0.3 only
105 ;; P<unix permissions> <owner>.<group>
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>
111 ;; L<filename symlink points to>
112 ;; M<mimetype> version 0.0.3 only
113 ;; <blank line to separate items>
115 ;; #STAT /file version 0.0.3 only
116 ;; like #LIST except for directories
117 ;; <number of entries>
119 ;; P<unix permissions> <owner>.<group>
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>
125 ;; L<filename symlink points to>
126 ;; <blank line to separate items>
131 ;; <binary data> exactly filesize bytes
132 ;; ### 200 with no preceding newline
134 ;; #STOR <size> /file/name
136 ;; <data> exactly size bytes
137 ;; ### 001 partial success
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>
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.
156 ;; Pacify byte-compiler.
160 (require 'tramp-cache
)
161 (require 'tramp-compat
)
163 ;; Define FISH method ...
164 (defcustom tramp-fish-method
"fish"
165 "*Method to connect via FISH protocol."
169 ;; ... and add it to the method list.
170 (add-to-list 'tramp-methods
(cons tramp-fish-method nil
))
172 ;; Add a default for `tramp-default-user-alist'. Default is the local user.
173 (add-to-list 'tramp-default-user-alist
174 `(,tramp-fish-method nil
,(user-login-name)))
176 ;; Add completion function for FISH method.
177 (tramp-set-completion-function
178 tramp-fish-method tramp-completion-function-alist-ssh
)
180 (defconst tramp-fish-continue-prompt-regexp
"^### 100.*\n"
181 "FISH return code OK.")
183 ;; It cannot be a defconst, occasionally we bind it locally.
184 (defvar tramp-fish-ok-prompt-regexp
"^### 200\n"
185 "FISH return code OK.")
187 (defconst tramp-fish-error-prompt-regexp
"^### \\(4\\|5\\)[0-9]+.*\n"
188 "Regexp for possible error strings of FISH servers.
189 Used instead of analyzing error codes of commands.")
191 (defcustom tramp-fish-start-fish-server-command
192 (concat "stty intr \"\" quit \"\" erase \"\" kill \"\" eof \"\" eol \"\" eol2 \"\" swtch \"\" start \"\" stop \"\" susp \"\" rprnt \"\" werase \"\" lnext \"\" flush \"\"; "
194 "`grep 'ARGV\\[0\\]' .fishsrv.pl | "
195 "sed -e 's/^[^\"]*\"//' -e 's/\"[^\"]*$//'`; "
197 "*Command to connect via FISH protocol."
201 ;; New handlers should be added here.
202 (defconst tramp-fish-file-name-handler-alist
204 ;; `access-file' performed by default handler
205 (add-name-to-file . tramp-fish-handle-add-name-to-file
)
206 ;; `byte-compiler-base-file-name' performed by default handler
207 (copy-file . tramp-fish-handle-copy-file
)
208 (delete-directory . tramp-fish-handle-delete-directory
)
209 (delete-file . tramp-fish-handle-delete-file
)
210 ;; `diff-latest-backup-file' performed by default handler
211 (directory-file-name . tramp-handle-directory-file-name
)
212 (directory-files . tramp-handle-directory-files
)
213 (directory-files-and-attributes . tramp-fish-handle-directory-files-and-attributes
)
214 ;; `dired-call-process' performed by default handler
215 ;; `dired-compress-file' performed by default handler
216 (dired-uncache . tramp-handle-dired-uncache
)
217 (expand-file-name . tramp-fish-handle-expand-file-name
)
218 ;; `file-accessible-directory-p' performed by default handler
219 (file-attributes . tramp-fish-handle-file-attributes
)
220 (file-directory-p . tramp-fish-handle-file-directory-p
)
221 (file-executable-p . tramp-fish-handle-file-executable-p
)
222 (file-exists-p . tramp-fish-handle-file-exists-p
)
223 (file-local-copy . tramp-fish-handle-file-local-copy
)
224 (file-modes . tramp-handle-file-modes
)
225 (file-name-all-completions . tramp-fish-handle-file-name-all-completions
)
226 (file-name-as-directory . tramp-handle-file-name-as-directory
)
227 (file-name-completion . tramp-handle-file-name-completion
)
228 (file-name-directory . tramp-handle-file-name-directory
)
229 (file-name-nondirectory . tramp-handle-file-name-nondirectory
)
230 ;; `file-name-sans-versions' performed by default handler
231 (file-newer-than-file-p . tramp-fish-handle-file-newer-than-file-p
)
232 (file-ownership-preserved-p . ignore
)
233 (file-readable-p . tramp-fish-handle-file-readable-p
)
234 (file-regular-p . tramp-handle-file-regular-p
)
235 (file-remote-p . tramp-handle-file-remote-p
)
236 ;; `file-selinux-context' performed by default handler.
237 (file-symlink-p . tramp-handle-file-symlink-p
)
238 ;; `file-truename' performed by default handler
239 (file-writable-p . tramp-fish-handle-file-writable-p
)
240 (find-backup-file-name . tramp-handle-find-backup-file-name
)
241 ;; `find-file-noselect' performed by default handler
242 ;; `get-file-buffer' performed by default handler
243 (insert-directory . tramp-fish-handle-insert-directory
)
244 (insert-file-contents . tramp-fish-handle-insert-file-contents
)
245 (load . tramp-handle-load
)
246 (make-directory . tramp-fish-handle-make-directory
)
247 (make-directory-internal . tramp-fish-handle-make-directory-internal
)
248 (make-symbolic-link . tramp-fish-handle-make-symbolic-link
)
249 (rename-file . tramp-fish-handle-rename-file
)
250 (set-file-modes . tramp-fish-handle-set-file-modes
)
251 ;; `set-file-selinux-context' performed by default handler.
252 (set-file-times . tramp-fish-handle-set-file-times
)
253 (set-visited-file-modtime . ignore
)
254 (shell-command . tramp-handle-shell-command
)
255 (substitute-in-file-name . tramp-handle-substitute-in-file-name
)
256 (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory
)
257 (vc-registered . ignore
)
258 (verify-visited-file-modtime . ignore
)
259 (write-region . tramp-fish-handle-write-region
)
260 (executable-find . tramp-fish-handle-executable-find
)
261 (start-file-process . ignore
)
262 (process-file . tramp-fish-handle-process-file
)
264 "Alist of handler functions for Tramp FISH method.
265 Operations not mentioned here will be handled by the default Emacs primitives.")
267 (defun tramp-fish-file-name-p (filename)
268 "Check if it's a filename for FISH protocol."
269 (let ((v (tramp-dissect-file-name filename
)))
270 (string= (tramp-file-name-method v
) tramp-fish-method
)))
272 (defun tramp-fish-file-name-handler (operation &rest args
)
273 "Invoke the FISH related OPERATION.
274 First arg specifies the OPERATION, second arg is a list of arguments to
275 pass to the OPERATION."
276 (let ((fn (assoc operation tramp-fish-file-name-handler-alist
)))
278 (save-match-data (apply (cdr fn
) args
))
279 (tramp-run-real-handler operation args
))))
281 (add-to-list 'tramp-foreign-file-name-handler-alist
282 (cons 'tramp-fish-file-name-p
'tramp-fish-file-name-handler
))
285 ;; File name primitives
287 (defun tramp-fish-handle-add-name-to-file
288 (filename newname
&optional ok-if-already-exists
)
289 "Like `add-name-to-file' for Tramp files."
290 (unless (tramp-equal-remote filename newname
)
291 (with-parsed-tramp-file-name
292 (if (tramp-tramp-file-p filename
) filename newname
) nil
295 "add-name-to-file: %s"
296 "only implemented for same method, same user, same host")))
297 (with-parsed-tramp-file-name filename v1
298 (with-parsed-tramp-file-name newname v2
299 (when (and (not ok-if-already-exists
)
300 (file-exists-p newname
)
301 (not (numberp ok-if-already-exists
))
304 "File %s already exists; make it a new name anyway? "
308 "add-name-to-file: file %s already exists" newname
))
309 (tramp-flush-file-property v2 v2-localname
)
310 (unless (tramp-fish-send-command-and-check
311 v1
(format "#LINK %s %s" v1-localname v2-localname
))
313 v1
'file-error
"Error with add-name-to-file %s" newname
)))))
315 (defun tramp-fish-handle-copy-file
316 (filename newname
&optional ok-if-already-exists keep-date
317 preserve-uid-gid preserve-selinux-context
)
318 "Like `copy-file' for Tramp files."
319 (tramp-fish-do-copy-or-rename-file
320 'copy filename newname ok-if-already-exists keep-date preserve-uid-gid
))
322 (defun tramp-fish-handle-delete-directory (directory &optional recursive
)
323 "Like `delete-directory' for Tramp files."
324 (when (file-exists-p directory
)
328 (if (file-directory-p file
)
329 (tramp-compat-delete-directory file recursive
)
331 ;; We do not want to delete "." and "..".
333 directory
'full
"^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")))
334 (with-parsed-tramp-file-name
335 (directory-file-name (expand-file-name directory
)) nil
336 (tramp-flush-directory-property v localname
)
337 (tramp-fish-send-command-and-check v
(format "#RMD %s" localname
)))))
339 (defun tramp-fish-handle-delete-file (filename &optional trash
)
340 "Like `delete-file' for Tramp files."
341 (when (file-exists-p filename
)
342 (with-parsed-tramp-file-name (expand-file-name filename
) nil
343 (tramp-flush-file-property v localname
)
344 (tramp-fish-send-command-and-check v
(format "#DELE %s" localname
)))))
346 (defun tramp-fish-handle-directory-files-and-attributes
347 (directory &optional full match nosort id-format
)
348 "Like `directory-files-and-attributes' for Tramp files."
352 (tramp-compat-file-attributes
353 (if full x
(expand-file-name x directory
))
355 (directory-files directory full match nosort
)))
357 (defun tramp-fish-handle-expand-file-name (name &optional dir
)
358 "Like `expand-file-name' for Tramp files."
359 ;; If DIR is not given, use DEFAULT-DIRECTORY or "/".
360 (setq dir
(or dir default-directory
"/"))
361 ;; Unless NAME is absolute, concat DIR and NAME.
362 (unless (file-name-absolute-p name
)
363 (setq name
(concat (file-name-as-directory dir
) name
)))
364 ;; If NAME is not a Tramp file, run the real handler,
365 (if (or (tramp-completion-mode-p) (not (tramp-tramp-file-p name
)))
366 (tramp-drop-volume-letter
367 (tramp-run-real-handler 'expand-file-name
(list name nil
)))
369 (with-parsed-tramp-file-name name nil
370 (unless (tramp-run-real-handler 'file-name-absolute-p
(list localname
))
371 (setq localname
(concat "~/" localname
)))
372 ;; Tilde expansion if necessary.
373 (when (string-match "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname
)
374 (let ((uname (match-string 1 localname
))
375 (fname (match-string 2 localname
)))
376 ;; We cannot apply "~user/", because this is not supported
377 ;; by the FISH protocol.
378 (unless (string-equal uname
"~")
380 v
'file-error
"Tilde expansion not supported for %s" name
))
382 (with-connection-property v uname
383 (tramp-fish-send-command-and-check v
"#PWD")
384 (with-current-buffer (tramp-get-buffer v
)
385 (goto-char (point-min))
386 (buffer-substring (point) (tramp-compat-line-end-position)))))
387 (setq localname
(concat uname fname
))))
388 ;; There might be a double slash, for example when "~/"
389 ;; expands to "/". Remove this.
390 (while (string-match "//" localname
)
391 (setq localname
(replace-match "/" t t localname
)))
392 ;; No tilde characters in file name, do normal
393 ;; expand-file-name (this does "/./" and "/../"). We bind
394 ;; `directory-sep-char' here for XEmacs on Windows, which
395 ;; would otherwise use backslash. `default-directory' is
396 ;; bound, because on Windows there would be problems with UNC
397 ;; shares or Cygwin mounts.
398 (let ((directory-sep-char ?
/)
399 (default-directory (tramp-compat-temporary-file-directory)))
400 (tramp-make-tramp-file-name
402 (tramp-drop-volume-letter
403 (tramp-run-real-handler
404 'expand-file-name
(list localname
))))))))
406 (defun tramp-fish-handle-file-attributes (filename &optional id-format
)
407 "Like `file-attributes' for Tramp files."
408 (with-parsed-tramp-file-name (expand-file-name filename
) nil
409 (with-file-property v localname
(format "file-attributes-%s" id-format
)
410 (cdr (car (tramp-fish-get-file-entries v localname nil
))))))
412 (defun tramp-fish-handle-file-directory-p (filename)
413 "Like `file-directory-p' for Tramp files."
414 (let ((attributes (file-attributes filename
)))
416 (or (string-match "d" (nth 8 attributes
))
417 (and (file-symlink-p filename
)
418 (with-parsed-tramp-file-name filename nil
420 (tramp-make-tramp-file-name
421 method user host
(nth 0 attributes
))))))
424 (defun tramp-fish-handle-file-exists-p (filename)
425 "Like `file-exists-p' for Tramp files."
426 (and (file-attributes filename
) t
))
428 (defun tramp-fish-handle-file-executable-p (filename)
429 "Like `file-executable-p' for Tramp files."
430 (with-parsed-tramp-file-name (expand-file-name filename
) nil
431 (with-file-property v localname
"file-executable-p"
432 (when (file-exists-p filename
)
433 (let ((mode-chars (string-to-vector (nth 8 (file-attributes filename
))))
435 (tramp-make-tramp-file-name
437 (tramp-get-connection-property v
"home-directory" nil
))))
438 (or (and (char-equal (aref mode-chars
3) ?x
)
439 (equal (nth 2 (file-attributes filename
))
440 (nth 2 (file-attributes home-directory
))))
441 (and (char-equal (aref mode-chars
6) ?x
)
442 (equal (nth 3 (file-attributes filename
))
443 (nth 3 (file-attributes home-directory
))))
444 (char-equal (aref mode-chars
9) ?x
)))))))
446 (defun tramp-fish-handle-file-readable-p (filename)
447 "Like `file-readable-p' for Tramp files."
448 (with-parsed-tramp-file-name (expand-file-name filename
) nil
449 (with-file-property v localname
"file-readable-p"
450 (when (file-exists-p filename
)
451 (let ((mode-chars (string-to-vector (nth 8 (file-attributes filename
))))
453 (tramp-make-tramp-file-name
455 (tramp-get-connection-property v
"home-directory" nil
))))
456 (or (and (char-equal (aref mode-chars
1) ?r
)
457 (equal (nth 2 (file-attributes filename
))
458 (nth 2 (file-attributes home-directory
))))
459 (and (char-equal (aref mode-chars
4) ?r
)
460 (equal (nth 3 (file-attributes filename
))
461 (nth 3 (file-attributes home-directory
))))
462 (char-equal (aref mode-chars
7) ?r
)))))))
464 (defun tramp-fish-handle-file-writable-p (filename)
465 "Like `file-writable-p' for Tramp files."
466 (with-parsed-tramp-file-name (expand-file-name filename
) nil
467 (with-file-property v localname
"file-writable-p"
468 (if (not (file-exists-p filename
))
469 ;; If file doesn't exist, check if directory is writable.
470 (and (file-directory-p (file-name-directory filename
))
471 (file-writable-p (file-name-directory filename
)))
472 ;; Existing files must be writable.
473 (let ((mode-chars (string-to-vector (nth 8 (file-attributes filename
))))
475 (tramp-make-tramp-file-name
477 (tramp-get-connection-property v
"home-directory" nil
))))
478 (or (and (char-equal (aref mode-chars
2) ?w
)
479 (equal (nth 2 (file-attributes filename
))
480 (nth 2 (file-attributes home-directory
))))
481 (and (char-equal (aref mode-chars
5) ?w
)
482 (equal (nth 3 (file-attributes filename
))
483 (nth 3 (file-attributes home-directory
))))
484 (char-equal (aref mode-chars
8) ?w
)))))))
486 (defun tramp-fish-handle-file-local-copy (filename)
487 "Like `file-local-copy' for Tramp files."
488 (with-parsed-tramp-file-name (expand-file-name filename
) nil
489 (unless (file-exists-p filename
)
492 "Cannot make local copy of non-existing file `%s'" filename
))
493 (let ((tmpfile (tramp-compat-make-temp-file filename
)))
494 (with-progress-reporter
495 v
3 (format "Fetching %s to tmp file %s" filename tmpfile
)
496 (when (tramp-fish-retrieve-data v
)
498 (with-current-buffer (tramp-get-buffer v
)
499 (write-region (point-min) (point-max) tmpfile
))
502 ;; This function should return "foo/" for directories and "bar" for
504 (defun tramp-fish-handle-file-name-all-completions (filename directory
)
505 "Like `file-name-all-completions' for Tramp files."
508 (with-parsed-tramp-file-name (expand-file-name directory
) nil
509 (with-file-property v localname
"file-name-all-completions"
512 (with-file-property v localname
"file-entries"
513 (tramp-fish-get-file-entries v localname t
))))
517 (if (string-match "d" (nth 9 x
))
518 (file-name-as-directory (nth 0 x
))
522 (defun tramp-fish-handle-file-newer-than-file-p (file1 file2
)
523 "Like `file-newer-than-file-p' for Tramp files."
525 ((not (file-exists-p file1
)) nil
)
526 ((not (file-exists-p file2
)) t
)
527 (t (tramp-time-less-p (nth 5 (file-attributes file2
))
528 (nth 5 (file-attributes file1
))))))
530 (defun tramp-fish-handle-insert-directory
531 (filename switches
&optional wildcard full-directory-p
)
532 "Like `insert-directory' for Tramp files.
533 WILDCARD and FULL-DIRECTORY-P are not handled."
534 (setq filename
(expand-file-name filename
))
535 (when (file-directory-p filename
)
536 ;; This check is a little bit strange, but in `dired-add-entry'
537 ;; this function is called with a non-directory ...
538 (setq filename
(file-name-as-directory filename
)))
540 (with-parsed-tramp-file-name filename nil
541 (tramp-flush-file-property v localname
)
544 (with-file-property v localname
"file-entries"
545 (tramp-fish-get-file-entries v localname t
))))
552 (if (string-match "t" switches
)
554 (tramp-time-less-p (nth 6 y
) (nth 6 x
))
556 (string-lessp (nth 0 x
) (nth 0 y
))))))
563 "%10s %3d %-8s %-8s %8s %s %s%s\n"
570 (if (tramp-time-less-p
571 (tramp-time-subtract (current-time) (nth 6 x
))
576 (nth 0 x
) ; file name
577 (if (stringp (nth 1 x
)) (format " -> %s" (nth 1 x
)) "")))
582 (defun tramp-fish-handle-insert-file-contents
583 (filename &optional visit beg end replace
)
584 "Like `insert-file-contents' for Tramp files."
585 (barf-if-buffer-read-only)
587 (setq buffer-file-name
(expand-file-name filename
))
588 (set-visited-file-modtime)
589 (set-buffer-modified-p nil
))
591 (with-parsed-tramp-file-name filename nil
592 (if (not (file-exists-p filename
))
594 v
'file-error
"File %s not found on remote host" filename
)
596 (let ((point (point))
598 (with-progress-reporter v
3 (format "Fetching file %s" filename
)
599 (when (tramp-fish-retrieve-data v
)
602 (with-current-buffer (tramp-get-buffer v
)
603 (let ((beg (or beg
(point-min)))
604 (end (min (or end
(point-max)) (point-max))))
605 (setq size
(- end beg
))
606 (buffer-substring beg end
))))
609 (list (expand-file-name filename
) size
)))))
611 (defun tramp-fish-handle-make-directory (dir &optional parents
)
612 "Like `make-directory' for Tramp files."
613 (setq dir
(directory-file-name (expand-file-name dir
)))
614 (unless (file-name-absolute-p dir
)
615 (setq dir
(expand-file-name dir default-directory
)))
616 (with-parsed-tramp-file-name dir nil
618 (let ((ldir (file-name-directory dir
)))
619 ;; Make missing directory parts
620 (when (and parents
(not (file-directory-p ldir
)))
621 (make-directory ldir parents
))
623 (when (file-directory-p ldir
)
624 (make-directory-internal dir
))
625 (unless (file-directory-p dir
)
626 (tramp-error v
'file-error
"Couldn't make directory %s" dir
))))))
628 (defun tramp-fish-handle-make-directory-internal (directory)
629 "Like `make-directory-internal' for Tramp files."
630 (setq directory
(directory-file-name (expand-file-name directory
)))
631 (unless (file-name-absolute-p directory
)
632 (setq directory
(expand-file-name directory default-directory
)))
633 (when (file-directory-p (file-name-directory directory
))
634 (with-parsed-tramp-file-name directory nil
637 (tramp-fish-send-command-and-check v
(format "#MKD %s" localname
))
639 v
'file-error
"Couldn't make directory %s" directory
))))))
641 (defun tramp-fish-handle-make-symbolic-link
642 (filename linkname
&optional ok-if-already-exists
)
643 "Like `make-symbolic-link' for Tramp files.
644 If LINKNAME is a non-Tramp file, it is used verbatim as the target of
645 the symlink. If LINKNAME is a Tramp file, only the localname component is
646 used as the target of the symlink.
648 If LINKNAME is a Tramp file and the localname component is relative, then
649 it is expanded first, before the localname component is taken. Note that
650 this can give surprising results if the user/host for the source and
651 target of the symlink differ."
652 (with-parsed-tramp-file-name linkname nil
653 ;; Do the 'confirm if exists' thing.
654 (when (file-exists-p linkname
)
656 (if (or (null ok-if-already-exists
) ; not allowed to exist
657 (and (numberp ok-if-already-exists
)
660 "File %s already exists; make it a link anyway? "
663 v
'file-already-exists
"File %s already exists" localname
)
664 (delete-file linkname
)))
666 ;; If FILENAME is a Tramp name, use just the localname component.
667 (when (tramp-tramp-file-p filename
)
668 (setq filename
(tramp-file-name-localname
669 (tramp-dissect-file-name (expand-file-name filename
)))))
671 ;; Right, they are on the same host, regardless of user, method, etc.
672 ;; We now make the link on the remote machine. This will occur as the user
673 ;; that FILENAME belongs to.
675 (tramp-fish-send-command-and-check
676 v
(format "#SYMLINK %s %s" filename localname
))
677 (tramp-error v
'file-error
"Error creating symbolic link %s" linkname
))))
679 (defun tramp-fish-handle-rename-file
680 (filename newname
&optional ok-if-already-exists
)
681 "Like `rename-file' for Tramp files."
682 (tramp-fish-do-copy-or-rename-file
683 'rename filename newname ok-if-already-exists t
))
685 (defun tramp-fish-handle-set-file-modes (filename mode
)
686 "Like `set-file-modes' for Tramp files."
687 (with-parsed-tramp-file-name filename nil
688 (tramp-flush-file-property v localname
)
689 (unless (tramp-fish-send-command-and-check
690 v
(format "#CHMOD %s %s"
691 (tramp-decimal-to-octal mode
)
692 (tramp-shell-quote-argument localname
)))
694 v
'file-error
"Error while changing file's mode %s" filename
))))
696 (defun tramp-fish-handle-set-file-times (filename &optional time
)
697 "Like `set-file-times' for Tramp files."
698 (with-parsed-tramp-file-name filename nil
699 (let ((time (if (or (null time
) (equal time
'(0 0))) (current-time) time
)))
701 "touch" nil nil nil
"-t"
702 (format-time-string "%Y%m%d%H%M.%S" time
)
703 (tramp-shell-quote-argument localname
))))))
705 (defun tramp-fish-handle-write-region
706 (start end filename
&optional append visit lockname confirm
)
707 "Like `write-region' for Tramp files."
708 (setq filename
(expand-file-name filename
))
709 (with-parsed-tramp-file-name filename nil
710 ;; XEmacs takes a coding system as the seventh argument, not `confirm'
711 (when (and (not (featurep 'xemacs
))
712 confirm
(file-exists-p filename
))
713 (unless (y-or-n-p (format "File %s exists; overwrite anyway? "
715 (tramp-error v
'file-error
"File not overwritten")))
717 (tramp-flush-file-property v localname
)
720 (let ((tramp-fish-ok-prompt-regexp
722 tramp-fish-ok-prompt-regexp
"\\|"
723 tramp-fish-continue-prompt-regexp
)))
724 (tramp-fish-send-command
725 v
(format "%s %d %s\n### 100"
726 (if append
"#APPEND" "#STOR") (- end start
) localname
)))
728 ;; Send data, if there are any.
730 (tramp-fish-send-command v
(buffer-substring-no-properties start end
)))
733 (set-visited-file-modtime))))
735 (defun tramp-fish-handle-executable-find (command)
736 "Like `executable-find' for Tramp files."
738 (if (zerop (process-file "which" nil t nil command
))
740 (goto-char (point-min))
741 (buffer-substring (point-min) (tramp-compat-line-end-position))))))
743 (defun tramp-fish-handle-process-file
744 (program &optional infile destination display
&rest args
)
745 "Like `process-file' for Tramp files."
746 ;; The implementation is not complete yet.
747 (when (and (numberp destination
) (zerop destination
))
748 (error "Implementation does not handle immediate return"))
750 (with-parsed-tramp-file-name default-directory nil
751 (let (command input tmpinput output tmpoutput stderr tmpstderr
754 (setq command
(mapconcat 'tramp-shell-quote-argument
755 (cons program args
) " "))
758 (setq input
"/dev/null")
759 (setq infile
(expand-file-name infile
))
760 (if (tramp-equal-remote default-directory infile
)
761 ;; INFILE is on the same remote host.
762 (setq input
(with-parsed-tramp-file-name infile nil localname
))
763 ;; INFILE must be copied to remote host.
764 (setq input
(tramp-make-tramp-temp-file v
)
765 tmpinput
(tramp-make-tramp-file-name method user host input
))
766 (copy-file infile tmpinput t
)))
767 (when input
(setq command
(format "%s <%s" command input
)))
770 (setq output
(tramp-make-tramp-temp-file v
)
771 tmpoutput
(tramp-make-tramp-file-name method user host output
))
774 ((bufferp destination
)
775 (setq outbuf destination
))
777 ((stringp destination
)
778 (setq outbuf
(get-buffer-create destination
)))
779 ;; (REAL-DESTINATION ERROR-DESTINATION)
783 ((bufferp (car destination
))
784 (setq outbuf
(car destination
)))
785 ((stringp (car destination
))
786 (setq outbuf
(get-buffer-create (car destination
)))))
789 ((stringp (cadr destination
))
790 (setcar (cdr destination
) (expand-file-name (cadr destination
)))
791 (if (tramp-equal-remote default-directory
(cadr destination
))
792 ;; stderr is on the same remote host.
793 (setq stderr
(with-parsed-tramp-file-name
794 (cadr destination
) nil localname
))
795 ;; stderr must be copied to remote host. The temporary
796 ;; file must be deleted after execution.
797 (setq stderr
(tramp-make-tramp-temp-file v
)
798 tmpstderr
(tramp-make-tramp-file-name
799 method user host stderr
))))
800 ;; stderr to be discarded
801 ((null (cadr destination
))
802 (setq stderr
"/dev/null"))))
805 (setq outbuf
(current-buffer))))
806 (when stderr
(setq command
(format "%s 2>%s" command stderr
)))
808 ;; Goto working directory.
810 (tramp-fish-send-command-and-check
811 v
(format "#CWD %s" (tramp-shell-quote-argument localname
)))
812 (tramp-error v
'file-error
"No such directory: %s" default-directory
))
813 ;; Send the command. It might not return in time, so we protect it.
816 (unless (tramp-fish-send-command-and-check
819 (tramp-shell-quote-argument command
) output
))
821 ;; Check return code.
824 (tramp-make-tramp-file-name method user host output
)))
826 (insert-file-contents tmpfile
)
827 (goto-char (point-max))
829 (looking-at "^###RESULT: \\([0-9]+\\)")
830 (setq ret
(string-to-number (match-string 1)))
831 (delete-region (point) (point-max))
832 (write-region (point-min) (point-max) tmpfile
))
833 ;; We should show the output anyway.
835 (with-current-buffer outbuf
(insert-file-contents tmpfile
))
836 (when display
(display-buffer outbuf
))))
837 ;; When the user did interrupt, we should do it also.
838 (error (setq ret
1)))
840 ;; Provide error file.
841 (when tmpstderr
(rename-file tmpstderr
(cadr destination
) t
))
843 (when tmpinput
(delete-file tmpinput
))
844 (when tmpoutput
(delete-file tmpoutput
))
845 ;; Return exit status.
849 ;; Internal file name functions
851 (defun tramp-fish-do-copy-or-rename-file
852 (op filename newname
&optional ok-if-already-exists keep-date preserve-uid-gid
)
853 "Copy or rename a remote file.
854 OP must be `copy' or `rename' and indicates the operation to
855 perform. FILENAME specifies the file to copy or rename, NEWNAME
856 is the name of the new file (for copy) or the new name of the
857 file (for rename). OK-IF-ALREADY-EXISTS means don't barf if
858 NEWNAME exists already. KEEP-DATE means to make sure that
859 NEWNAME has the same timestamp as FILENAME.
861 This function is invoked by `tramp-fish-handle-copy-file' and
862 `tramp-fish-handle-rename-file'. It is an error if OP is neither
863 of `copy' and `rename'. FILENAME and NEWNAME must be absolute
865 (unless (memq op
'(copy rename
))
866 (error "Unknown operation `%s', must be `copy' or `rename'" op
))
867 (let ((t1 (tramp-tramp-file-p filename
))
868 (t2 (tramp-tramp-file-p newname
)))
870 (unless ok-if-already-exists
871 (when (and t2
(file-exists-p newname
))
872 (with-parsed-tramp-file-name newname nil
874 v
'file-already-exists
"File %s already exists" newname
))))
878 ;; Both are Tramp files.
881 ;; Shortcut: if method, host, user are the same for both
882 ;; files, we invoke `cp' or `mv' on the remote host
884 ((tramp-equal-remote filename newname
)
885 (tramp-fish-do-copy-or-rename-file-directly
886 op filename newname keep-date preserve-uid-gid
))
887 ;; No shortcut was possible. So we copy the
888 ;; file first. If the operation was `rename', we go
889 ;; back and delete the original file (if the copy was
890 ;; successful). The approach is simple-minded: we
891 ;; create a new buffer, insert the contents of the
892 ;; source file into it, then write out the buffer to
893 ;; the target file. The advantage is that it doesn't
894 ;; matter which filename handlers are used for the
895 ;; source and target file.
897 (tramp-do-copy-or-rename-file-via-buffer
898 op filename newname keep-date
))))
900 ;; One file is a Tramp file, the other one is local.
902 ;; Use the generic method via a Tramp buffer.
903 (tramp-do-copy-or-rename-file-via-buffer
904 op filename newname keep-date
))
907 ;; One of them must be a Tramp file.
908 (error "Tramp implementation says this cannot happen")))
909 ;; When newname did exist, we have wrong cached values.
911 (with-parsed-tramp-file-name newname nil
912 (tramp-flush-file-property v localname
)
913 (tramp-flush-file-property v
(file-name-directory localname
)))))))
915 (defun tramp-fish-do-copy-or-rename-file-directly
916 (op filename newname keep-date preserve-uid-gid
)
917 "Invokes `COPY' or `RENAME' on the remote system.
918 OP must be one of `copy' or `rename', indicating `cp' or `mv',
919 respectively. VEC specifies the connection. LOCALNAME1 and
920 LOCALNAME2 specify the two arguments of `cp' or `mv'. If
921 KEEP-DATE is non-nil, preserve the time stamp when copying.
922 PRESERVE-UID-GID is completely ignored."
923 (with-parsed-tramp-file-name filename v1
924 (with-parsed-tramp-file-name newname v2
925 (tramp-fish-send-command
928 (if (eq op
'copy
) "#COPY" "#RENAME")
929 (tramp-shell-quote-argument v1-localname
)
930 (tramp-shell-quote-argument v2-localname
)))))
931 ;; KEEP-DATE handling.
932 (when (and keep-date
(functionp 'set-file-times
))
933 (set-file-times newname
(nth 5 (file-attributes filename
))))
935 (set-file-modes newname
(tramp-default-file-modes filename
)))
937 (defun tramp-fish-get-file-entries (vec localname list
)
938 "Read entries returned by FISH server.
939 When LIST is true, a #LIST command will be sent, including all entries
940 of a directory. Otherwise, #STAT is sent for just one entry.
941 Result is a list of (LOCALNAME LINK COUNT UID GID ATIME MTIME CTIME
942 SIZE MODE WEIRD INODE DEVICE)."
944 (with-current-buffer (tramp-get-buffer vec
)
945 ;; #LIST does not work properly with trailing "/", at least in
947 (when (string-match "/$" localname
)
948 (setq localname
(concat localname
".")))
950 (let ((command (format "%s %s" (if list
"#LIST" "#STAT") localname
))
951 buffer-read-only num res
)
954 (tramp-fish-send-command vec command
)
956 ;; Read number of entries
957 (goto-char (point-min))
959 (unless (integerp (setq num
(read (current-buffer)))) (error nil
))
960 (error (return nil
)))
962 (delete-region (point-min) (point))
965 (goto-char (point-min))
967 (unless (looking-at tramp-fish-continue-prompt-regexp
) (error nil
))
968 (error (return nil
)))
970 (delete-region (point-min) (point))
974 (let ((item (tramp-fish-read-file-entry)))
975 ;; Add inode and device.
978 (list (tramp-get-inode vec
)
979 (tramp-get-device vec
))))))
982 (goto-char (point-min))
984 (unless (looking-at tramp-fish-ok-prompt-regexp
) (error nil
))
987 "`%s' does not return a valid Lisp expression: `%s'"
988 command
(buffer-string))))
990 (delete-region (point-min) (point))
994 (defun tramp-fish-read-file-entry ()
995 "Parse entry in output buffer.
996 Result is the list (LOCALNAME LINK COUNT UID GID ATIME MTIME CTIME
998 ;; We are called from `tramp-fish-get-file-entries', which sets the
1000 (let (buffer-read-only localname link uid gid mtime size mode
)
1004 ;; P<unix permissions> <owner>.<group>
1005 ((looking-at "^P\\(.+\\)\\s-\\(.+\\)\\.\\(.+\\)$")
1006 (setq mode
(match-string 1))
1007 (setq uid
(match-string 2))
1008 (setq gid
(match-string 3))
1009 (when (string-match "^d" mode
) (setq link t
)))
1011 ((looking-at "^S\\([0-9]+\\)$")
1012 (setq size
(string-to-number (match-string 1))))
1013 ;; D<year> <month> <day> <hour> <minute> <second>[.1234]
1015 "^D\\([0-9]+\\)\\s-\\([0-9]+\\)\\s-\\([0-9]+\\)\\s-\\([0-9]+\\)\\s-\\([0-9]+\\)\\s-\\(\\S-+\\)$")
1018 (string-to-number (match-string 6))
1019 (string-to-number (match-string 5))
1020 (string-to-number (match-string 4))
1021 (string-to-number (match-string 3))
1022 (string-to-number (match-string 2))
1023 (string-to-number (match-string 1)))))
1024 ;; d<3-letters month name> <day> <year or HH:MM>
1025 ((looking-at "^d") nil
)
1026 ;; E<major-of-device>,<minor>
1027 ((looking-at "^E") nil
)
1029 ((looking-at "^:\\(.+\\)$")
1030 (setq localname
(match-string 1)))
1031 ;; L<filename symlink points to>
1032 ((looking-at "^L\\(.+\\)$")
1033 (setq link
(match-string 1)))
1035 ((looking-at "^M\\(.+\\)$") nil
)
1041 (delete-region (point-min) (point))))
1043 ;; Delete trailing empty line.
1045 (delete-region (point-min) (point))
1047 ;; Return entry in `file-attributes' format.
1048 (list localname link -
1 uid gid
'(0 0) mtime
'(0 0) size mode nil
)))
1050 (defun tramp-fish-retrieve-data (vec)
1051 "Reads remote data for FISH protocol.
1052 The data are left in the connection buffer of VEC for further processing.
1053 Returns the size of the data."
1055 (with-current-buffer (tramp-get-buffer vec
)
1056 ;; The retrieved data might be in binary format, without
1057 ;; trailing newline. Therefore, the OK prompt might not start
1058 ;; at the beginning of a line.
1059 (let ((tramp-fish-ok-prompt-regexp "### 200\n")
1063 (tramp-fish-send-command
1064 vec
(format "#RETR %s" (tramp-file-name-localname vec
)))
1067 (goto-char (point-min))
1069 (unless (integerp (setq size
(read (current-buffer)))) (error nil
))
1070 (error (return nil
)))
1072 (delete-region (point-min) (point))
1075 (goto-char (point-min))
1077 (unless (looking-at tramp-fish-continue-prompt-regexp
) (error nil
))
1078 (error (return nil
)))
1080 (delete-region (point-min) (point))
1082 ;; The received data might contain the OK prompt already, so
1083 ;; there might be outstanding data.
1084 (while (/= (+ size
(length tramp-fish-ok-prompt-regexp
))
1085 (- (point-max) (point-min)))
1086 (tramp-wait-for-regexp
1087 (tramp-get-connection-process vec
) nil
1088 (concat tramp-fish-ok-prompt-regexp
"$")))
1091 (goto-char (+ (point-min) size
))
1093 (unless (looking-at tramp-fish-ok-prompt-regexp
) (error nil
))
1094 (error (return nil
)))
1095 (delete-region (+ (point-min) size
) (point-max))
1099 ;; Connection functions
1101 (defun tramp-fish-maybe-open-connection (vec)
1102 "Maybe open a connection VEC.
1103 Does not do anything if a connection is already open, but re-opens the
1104 connection if a previous connection has died for some reason."
1105 (let ((process-connection-type tramp-process-connection-type
)
1106 (p (get-buffer-process (tramp-get-buffer vec
))))
1108 ;; New connection must be opened.
1109 (unless (and p
(processp p
) (memq (process-status p
) '(run open
)))
1111 ;; Set variables for computing the prompt for reading password.
1112 (setq tramp-current-method
(tramp-file-name-method vec
)
1113 tramp-current-user
(tramp-file-name-user vec
)
1114 tramp-current-host
(tramp-file-name-host vec
))
1116 ;; Start new process.
1117 (when (and p
(processp p
))
1119 (setenv "TERM" tramp-terminal-type
)
1120 (setenv "PS1" tramp-initial-end-of-output
)
1121 (with-progress-reporter
1123 (format "Opening connection for %s@%s using %s"
1124 tramp-current-user tramp-current-host tramp-current-method
)
1126 (let* ((process-connection-type tramp-process-connection-type
)
1127 (inhibit-eol-conversion nil
)
1128 (coding-system-for-read 'binary
)
1129 (coding-system-for-write 'binary
)
1130 ;; This must be done in order to avoid our file name handler.
1131 (p (let ((default-directory
1132 (tramp-compat-temporary-file-directory)))
1134 (or (tramp-get-connection-property vec
"process-name" nil
)
1135 (tramp-buffer-name vec
))
1136 (tramp-get-connection-buffer vec
)
1138 (tramp-file-name-user vec
)
1139 (tramp-file-name-host vec
)))))
1141 vec
6 "%s" (mapconcat 'identity
(process-command p
) " "))
1143 ;; Check whether process is alive.
1144 (tramp-set-process-query-on-exit-flag p nil
)
1146 (tramp-process-actions p vec tramp-actions-before-shell
60)
1147 (tramp-fish-send-command vec tramp-fish-start-fish-server-command
)
1150 "Found remote shell prompt on `%s'" (tramp-file-name-host vec
)))))))
1152 (defun tramp-fish-send-command (vec command
)
1153 "Send the COMMAND to connection VEC."
1154 (tramp-fish-maybe-open-connection vec
)
1155 (tramp-message vec
6 "%s" command
)
1156 (tramp-send-string vec command
)
1157 (tramp-wait-for-regexp
1158 (tramp-get-connection-process vec
) nil
1159 (concat tramp-fish-ok-prompt-regexp
"\\|" tramp-fish-error-prompt-regexp
)))
1161 (defun tramp-fish-send-command-and-check (vec command
)
1162 "Send the COMMAND to connection VEC.
1163 Returns nil if there has been an error message."
1166 (tramp-fish-send-command vec command
)
1168 ;; Read return code.
1169 (with-current-buffer (tramp-get-buffer vec
)
1170 (goto-char (point-min))
1171 (looking-at tramp-fish-ok-prompt-regexp
)))
1173 (provide 'tramp-fish
)
1177 ;; * Evaluate the MIME information with #LIST or #STAT.
1180 ;; arch-tag: a66df7df-5f29-42a7-a921-643ceb29db49
1181 ;;;; tramp-fish.el ends here