Toru TSUNEYOSHI <[email protected]> writes:
Hi Toru san,
>>> But, if any part of the patch is effective, plese make use of it.
>>
>> I will check further. Maybe you are right, and inline compression is
>> more effective than scp/pscp. But it needs some more description in the
>> manual, how a user shall tune it.
>
> I hope that is useful.
I've reviewed your code in detail. After a while I felt lost, because
the changes happened at several places, making that code less readable.
So I have changed your patch, focussing the logic into the (new) defun
`tramp-get-inline-coding'. Could you, please, check, whether it would be OK?
The patch is towards the trunk, you might need some care when applying
to your Tramp version.
> Thanks again, Michael san.
Best regards, Michael.
*** /home/albinus/src/tramp/lisp/tramp.el.~2.785~ 2010-04-30 05:50:29.619245904 +0200
--- /home/albinus/src/tramp/lisp/tramp.el 2010-04-29 18:14:53.139400813 +0200
***************
*** 285,290 ****
--- 285,297 ----
:group 'tramp
:type 'string)
+ (defcustom tramp-inline-compress-start-size 4096
+ "*The minimum size of compressing where inline transfer.
+ When inline transfer, compress transfered data of file
+ whose size is this value or above (up to `tramp-copy-size-limit')."
+ :group 'tramp
+ :type 'integer)
+
(defcustom tramp-copy-size-limit 10240
"*The maximum file size where inline copying is preferred over an out-of-the-band copy."
:group 'tramp
***************
*** 4722,4737 ****
v 'file-error
"Cannot make local copy of non-existing file `%s'" filename))
! (let ((rem-enc (tramp-get-remote-coding v "remote-encoding"))
! (loc-dec (tramp-get-local-coding v "local-decoding"))
! (tmpfile (tramp-compat-make-temp-file filename)))
(condition-case err
(cond
;; `copy-file' handles direct copy and out-of-band methods.
((or (tramp-local-host-p v)
! (tramp-method-out-of-band-p
! v (nth 7 (file-attributes filename))))
(copy-file filename tmpfile t t))
;; Use inline encoding for file transfer.
--- 4729,4744 ----
v 'file-error
"Cannot make local copy of non-existing file `%s'" filename))
! (let* ((size (nth 7 (file-attributes filename)))
! (rem-enc (tramp-get-inline-coding v "remote-encoding" size))
! (loc-dec (tramp-get-inline-coding v "local-decoding" size))
! (tmpfile (tramp-compat-make-temp-file filename)))
(condition-case err
(cond
;; `copy-file' handles direct copy and out-of-band methods.
((or (tramp-local-host-p v)
! (tramp-method-out-of-band-p v size))
(copy-file filename tmpfile t t))
;; Use inline encoding for file transfer.
***************
*** 4739,4750 ****
(save-excursion
(tramp-message v 5 "Encoding remote file %s..." filename)
(tramp-barf-unless-okay
! v
! (format "%s < %s" rem-enc (tramp-shell-quote-argument localname))
"Encoding remote file failed")
(tramp-message v 5 "Encoding remote file %s...done" filename)
! (if (and (symbolp loc-dec) (fboundp loc-dec))
;; If local decoding is a function, we call it. We
;; must disable multibyte, because
;; `uudecode-decode-region' doesn't handle it
--- 4746,4756 ----
(save-excursion
(tramp-message v 5 "Encoding remote file %s..." filename)
(tramp-barf-unless-okay
! v (format rem-enc (tramp-shell-quote-argument localname))
"Encoding remote file failed")
(tramp-message v 5 "Encoding remote file %s...done" filename)
! (if (functionp loc-dec)
;; If local decoding is a function, we call it. We
;; must disable multibyte, because
;; `uudecode-decode-region' doesn't handle it
***************
*** 5093,5116 ****
'write-region
(list start end localname append 'no-message lockname confirm))
! (let ((rem-dec (tramp-get-remote-coding v "remote-decoding"))
! (loc-enc (tramp-get-local-coding v "local-encoding"))
! (modes (save-excursion (tramp-default-file-modes filename)))
! ;; We use this to save the value of
! ;; `last-coding-system-used' after writing the tmp file.
! ;; At the end of the function, we set
! ;; `last-coding-system-used' to this saved value. This
! ;; way, any intermediary coding systems used while
! ;; talking to the remote shell or suchlike won't hose
! ;; this variable. This approach was snarfed from
! ;; ange-ftp.el.
! coding-system-used
! ;; Write region into a tmp file. This isn't really
! ;; needed if we use an encoding function, but currently
! ;; we use it always because this makes the logic
! ;; simpler.
! (tmpfile (or tramp-temp-buffer-file-name
! (tramp-compat-make-temp-file filename))))
;; If `append' is non-nil, we copy the file locally, and let
;; the native `write-region' implementation do the job.
--- 5099,5125 ----
'write-region
(list start end localname append 'no-message lockname confirm))
! (let* ((size (or (and (stringp start) (length start))
! (- (or end (point-max))
! (or start (point-min)))))
! (rem-dec (tramp-get-inline-coding v "remote-decoding" size))
! (loc-enc (tramp-get-inline-coding v "local-encoding" size))
! (modes (save-excursion (tramp-default-file-modes filename)))
! ;; We use this to save the value of
! ;; `last-coding-system-used' after writing the tmp
! ;; file. At the end of the function, we set
! ;; `last-coding-system-used' to this saved value. This
! ;; way, any intermediary coding systems used while
! ;; talking to the remote shell or suchlike won't hose
! ;; this variable. This approach was snarfed from
! ;; ange-ftp.el.
! coding-system-used
! ;; Write region into a tmp file. This isn't really
! ;; needed if we use an encoding function, but currently
! ;; we use it always because this makes the logic
! ;; simpler.
! (tmpfile (or tramp-temp-buffer-file-name
! (tramp-compat-make-temp-file filename))))
;; If `append' is non-nil, we copy the file locally, and let
;; the native `write-region' implementation do the job.
***************
*** 5156,5163 ****
(cond
;; `copy-file' handles direct copy and out-of-band methods.
((or (tramp-local-host-p v)
! (tramp-method-out-of-band-p
! v (nth 7 (file-attributes tmpfile))))
(if (and (not (stringp start))
(= (or end (point-max)) (point-max))
(= (or start (point-min)) (point-min))
--- 5165,5171 ----
(cond
;; `copy-file' handles direct copy and out-of-band methods.
((or (tramp-local-host-p v)
! (tramp-method-out-of-band-p v size))
(if (and (not (stringp start))
(= (or end (point-max)) (point-max))
(= (or start (point-min)) (point-min))
***************
*** 5185,5196 ****
(tramp-message v 5 "Encoding region...")
(unwind-protect
(with-temp-buffer
;; Use encoding function or command.
! (if (and (symbolp loc-enc) (fboundp loc-enc))
(progn
(tramp-message
! v 5 "Encoding region using function `%s'..."
! (symbol-name loc-enc))
(let ((coding-system-for-read 'binary))
(insert-file-contents-literally tmpfile))
;; The following `let' is a workaround for the
--- 5193,5204 ----
(tramp-message v 5 "Encoding region...")
(unwind-protect
(with-temp-buffer
+ (set-buffer-multibyte nil)
;; Use encoding function or command.
! (if (functionp loc-enc)
(progn
(tramp-message
! v 5 "Encoding region using function `%s'..." loc-enc)
(let ((coding-system-for-read 'binary))
(insert-file-contents-literally tmpfile))
;; The following `let' is a workaround for the
***************
*** 5208,5215 ****
(tramp-message
v 5 "Encoding region using command `%s'..." loc-enc)
! (unless (equal 0 (tramp-call-local-coding-command
! loc-enc tmpfile t))
(tramp-error
v 'file-error
"Cannot write to `%s', local encoding command `%s' failed"
--- 5216,5223 ----
(tramp-message
v 5 "Encoding region using command `%s'..." loc-enc)
! (unless (zerop (tramp-call-local-coding-command
! loc-enc tmpfile t))
(tramp-error
v 'file-error
"Cannot write to `%s', local encoding command `%s' failed"
***************
*** 5225,5232 ****
(tramp-send-command
v
(format
! "%s >%s <<'EOF'\n%sEOF"
! rem-dec
(tramp-shell-quote-argument localname)
(buffer-string)))
(tramp-barf-unless-okay
--- 5233,5239 ----
(tramp-send-command
v
(format
! (concat rem-dec " <<'EOF'\n%sEOF")
(tramp-shell-quote-argument localname)
(buffer-string)))
(tramp-barf-unless-okay
***************
*** 7200,7205 ****
--- 7207,7270 ----
(if (string-match "%s" cmd) (format cmd input) cmd)
(if (stringp output) (concat "> " output) ""))))
+ (defconst tramp-inline-compress-commands
+ '(("gzip" "gzip -d")
+ ("bzip2" "bzip2 -d")
+ ("compress" "compress -d"))
+ "List of compress and decompress commands for inline transfer.
+ Each item is a list that looks like this:
+
+ \(COMPRESS DECOMPRESS\)
+
+ COMPRESS or DECOMPRESS are strings with the respective commands.")
+
+ (defun tramp-find-inline-compress (vec)
+ "Find an inline transfer compress command that works.
+ Goes through the list `tramp-inline-compress-commands'."
+ (save-excursion
+ (let ((commands tramp-inline-compress-commands)
+ (magic "xyzzy")
+ item compress decompress
+ found)
+ (while (and commands (not found))
+ (catch 'next
+ (setq item (pop commands)
+ compress (nth 0 item)
+ decompress (nth 1 item))
+ (tramp-message
+ vec 5
+ "Checking local compress command `%s', `%s' for sanity"
+ compress decompress)
+ (unless (zerop (tramp-call-local-coding-command
+ (format "echo %s | %s | %s"
+ magic compress decompress) nil nil))
+ (throw 'next nil))
+ (tramp-message
+ vec 5
+ "Checking remote compress command `%s', `%s' for sanity"
+ compress decompress)
+ (unless (zerop (tramp-send-command-and-check
+ vec (format "echo %s | %s | %s"
+ magic compress decompress) t))
+ (throw 'next nil))
+ (setq found t)))
+
+ ;; Did we find something?
+ (if found
+ (progn
+ ;; Set connection properties.
+ (tramp-message
+ vec 5 "Using inline transfer compress command `%s'" compress)
+ (tramp-set-connection-property vec "inline-compress" compress)
+ (tramp-message
+ vec 5 "Using inline transfer decompress command `%s'" decompress)
+ (tramp-set-connection-property vec "inline-decompress" decompress))
+
+ (tramp-set-connection-property vec "inline-compress" nil)
+ (tramp-set-connection-property vec "inline-decompress" nil)
+ (tramp-message
+ vec 2 "Couldn't find an inline transfer compress command")))))
+
(defun tramp-compute-multi-hops (vec)
"Expands VEC according to `tramp-default-proxies-alist'.
Gateway hops are already opened."
***************
*** 8080,8086 ****
;; Either the file size is large enough, or (in rare cases) there
;; does not exist a remote encoding.
(or (> size tramp-copy-size-limit)
! (null (tramp-get-remote-coding vec "remote-encoding")))))
(defun tramp-local-host-p (vec)
"Return t if this points to the local host, nil otherwise."
--- 8145,8151 ----
;; Either the file size is large enough, or (in rare cases) there
;; does not exist a remote encoding.
(or (> size tramp-copy-size-limit)
! (null (tramp-get-inline-coding vec "remote-encoding" size)))))
(defun tramp-local-host-p (vec)
"Return t if this points to the local host, nil otherwise."
***************
*** 8361,8387 ****
(nth 3 (tramp-compat-file-attributes "~/" id-format)))
;; Some predefined connection properties.
! (defun tramp-get-remote-coding (vec prop)
! ;; Local coding handles properties like remote coding. So we could
! ;; call it without pain.
! (let ((ret (tramp-get-local-coding vec prop)))
;; The connection property might have been cached. So we must send
! ;; the script - maybe.
! (when (and ret (symbolp ret))
! (let ((name (symbol-name ret)))
(while (string-match (regexp-quote "-") name)
(setq name (replace-match "_" nil t name)))
! (tramp-maybe-send-script vec (symbol-value ret) name)
! (setq ret name)))
! ;; Return the value.
! ret))
!
! (defun tramp-get-local-coding (vec prop)
! (or
! (tramp-get-connection-property vec prop nil)
! (progn
! (tramp-find-inline-encoding vec)
! (tramp-get-connection-property vec prop nil))))
(defun tramp-get-method-parameter (method param)
"Return the method parameter PARAM.
--- 8426,8493 ----
(nth 3 (tramp-compat-file-attributes "~/" id-format)))
;; Some predefined connection properties.
! (defun tramp-get-inline-compress (vec prop size)
! (when (> size tramp-inline-compress-start-size)
! (with-connection-property vec prop
! (tramp-find-inline-compress vec)
! (tramp-get-connection-property vec prop nil))))
!
! (defun tramp-get-inline-coding (vec prop size)
! "Return the coding command related to PROP.
! PROP is either `remote-encoding', `remode-decoding',
! `local-encoding' or `local-decoding'.
!
! SIZE is the length of the file to be coded. Depending on SIZE,
! compression might be applied.
!
! If no corresponding command is found, NIL is returned.
! Otherwise, either a string is returned which contains a `%s' mark
! to be used for the respective input or output file; or a Lisp
! function cell is returned to be applied on a buffer."
! (let ((coding
! (with-connection-property vec prop
! (tramp-find-inline-encoding vec)
! (tramp-get-connection-property vec prop nil)))
! (prop1 (if (string-match "encoding" prop)
! "inline-compress" "inline-decompress"))
! compress)
;; The connection property might have been cached. So we must send
! ;; the script to the remote side - maybe.
! (when (and coding (symbolp coding) (string-match "remote" prop))
! (let ((name (symbol-name coding)))
(while (string-match (regexp-quote "-") name)
(setq name (replace-match "_" nil t name)))
! (tramp-maybe-send-script vec (symbol-value coding) name)
! (setq coding name)))
! (when coding
! ;; Check for the `compress' command.
! (setq compress (tramp-get-inline-compress vec prop1 size))
! ;; Return the value.
! (cond
! ((and compress (symbolp coding))
! (if (string-match "decompress" prop1)
! `(lambda (beg end)
! (,coding beg end)
! (apply
! 'call-process-region (point-min) (point-max)
! (car (split-string ,compress)) t t nil
! (cdr (split-string ,compress))))
! `(lambda (beg end)
! (apply
! 'call-process-region beg end
! (car (split-string ,compress)) t t nil
! (cdr (split-string ,compress)))
! (,coding (point-min) (point-max)))))
! ((symbolp coding)
! coding)
! ((and compress (string-match "decoding" prop))
! (format "(%s | %s >%%s)" coding compress))
! (compress
! (format "(%s <%%s | %s)" compress coding))
! ((string-match "decoding" prop)
! (format "%s >%%s" coding))
! (t
! (format "%s <%%s" coding))))))
(defun tramp-get-method-parameter (method param)
"Return the method parameter PARAM.
_______________________________________________
Tramp-devel mailing list
[email protected]
http://lists.gnu.org/mailman/listinfo/tramp-devel