tramp-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: problem of `tramp-handle-file-local-copy' and inline transfer compre


From: Toru TSUNEYOSHI
Subject: Re: problem of `tramp-handle-file-local-copy' and inline transfer compressing
Date: Sun, 25 Apr 2010 22:40:03 +0900 (JST)

> Here I am a little bit lost. It is possible to sign papers for both
> Tramp and Emacs. Regular committers for Tramp have done both.
> 
> OTOH, there are (non-trivial) changes of Tramp in the Emacs repository,
> which I take over into the Tramp repository, without asking, whether the
> submitter has signed papers for Tramp. Having papers just for Emacs
> might be sufficient. (I add the licensing clerk of the FSF in Cc, in case
> there are other opinions.)
> 
> So I will do in your case :-)
> 

Thanks.

> However, if it is not a burden for you, you might ask FSF also for
> papers with respect to Tramp.

I'm a little bit lost, too.
I want to wait opinions of licensing clerk.
What opinion do you have of this topic, licensing clerk?

(I will sign for Tramp as the memory, :) I thik a little.
 However, it is burden a little.)

And I updated the patch. It pays attention to coding system mainly.
Please check it.
--- tramp.el.original   2009-07-08 22:22:51.000000000 +0900
+++ tramp.el    2010-04-25 01:37:53.539160600 +0900
@@ -263,6 +263,13 @@
   :group 'tramp
   :type 'string)
 
+(defcustom tramp-inline-transfer-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
@@ -4062,24 +4069,31 @@
 
     (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)))
+         (tmpfile (tramp-compat-make-temp-file filename))
+         (filesize (nth 7 (file-attributes filename)))
+         compress decompress)
 
       (condition-case err
          (cond
           ;; `copy-file' handles direct copy and out-of-band methods.
           ((or (tramp-local-host-p v)
                (and (tramp-method-out-of-band-p v)
-                    (> (nth 7 (file-attributes filename))
+                    (> filesize
                        tramp-copy-size-limit)))
            (copy-file filename tmpfile t t))
 
           ;; Use inline encoding for file transfer.
           (rem-enc
+           (if (<= tramp-inline-transfer-compress-start-size filesize)
+               (setq compress (tramp-get-inline-transfer-compress v 
"inline-transfer-compress")
+                     decompress (tramp-get-inline-transfer-compress v 
"inline-transfer-decompress")))
            (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))
+              (if compress
+                  (format "%s < %s | %s" compress (tramp-shell-quote-argument 
localname) rem-enc)
+                (format "%s < %s" rem-enc (tramp-shell-quote-argument 
localname)))
               "Encoding remote file failed")
              (tramp-message v 5 "Encoding remote file %s...done" filename)
 
@@ -4095,19 +4109,50 @@
                     v 5 "Decoding remote file %s with function %s..."
                     filename loc-dec)
                    (funcall loc-dec (point-min) (point-max))
-                   (let ((coding-system-for-write 'binary))
+                   (let (file-name-handler-alist
+                         (coding-system-for-write 'binary))
+                     (if decompress
+                         (let ((coding-system-for-read 'binary)
+                               (default-directory 
(tramp-compat-temporary-file-directory)))
+                           (tramp-message
+                            v 5 "Decompressing remote file %s with command 
`%s'..."
+                            filename decompress)
+                           (call-process-region (point-min) (point-max)
+                                                tramp-encoding-shell
+                                                t t nil
+                                                tramp-encoding-command-switch
+                                                decompress)))
                      (write-region (point-min) (point-max) tmpfile)))
 
                ;; If tramp-decoding-function is not defined for this
                ;; method, we invoke tramp-decoding-command instead.
                (let ((tmpfile2 (tramp-compat-make-temp-file filename)))
-                 (let ((coding-system-for-write 'binary))
+                 (let (file-name-handler-alist
+                       (coding-system-for-write 'binary))
                    (write-region (point-min) (point-max) tmpfile2))
                  (tramp-message
                   v 5 "Decoding remote file %s with command %s..."
                   filename loc-dec)
                  (unwind-protect
-                     (tramp-call-local-coding-command loc-dec tmpfile2 tmpfile)
+                     (progn
+                       (tramp-call-local-coding-command loc-dec tmpfile2 
tmpfile)
+                       (if decompress
+                           (with-temp-buffer
+                             (set-buffer-multibyte nil)
+                             (insert-file-contents-literally tmpfile)
+                             (let (file-name-handler-alist
+                                   (coding-system-for-write 'binary))
+                               (let ((coding-system-for-read 'binary)
+                                     (default-directory 
(tramp-compat-temporary-file-directory)))
+                                 (tramp-message
+                                  v 5 "Decompressing remote file %s with 
command `%s'..."
+                                  filename decompress)
+                                 (call-process-region (point-min) (point-max)
+                                                      tramp-encoding-shell
+                                                      t t nil
+                                                      
tramp-encoding-command-switch
+                                                      decompress))
+                               (write-region (point-min) (point-max) 
tmpfile)))))
                    (delete-file tmpfile2))))
 
              (tramp-message v 5 "Decoding remote file %s...done" filename)
@@ -4389,14 +4434,17 @@
              ;; needed if we use an encoding function, but currently
              ;; we use it always because this makes the logic
              ;; simpler.
-             (tmpfile (tramp-compat-make-temp-file filename)))
+             (tmpfile (tramp-compat-make-temp-file filename))
+             filesize
+             compress decompress)
 
          ;; We say `no-message' here because we don't want the
          ;; visited file modtime data to be clobbered from the temp
          ;; file.  We call `set-visited-file-modtime' ourselves later
          ;; on.  We must ensure that `file-coding-system-alist'
          ;; matches `tmpfile'.
-         (let ((file-coding-system-alist
+         (let (file-name-handler-alist
+               (file-coding-system-alist
                 (tramp-find-file-name-coding-system-alist filename tmpfile)))
            (condition-case err
                (tramp-run-real-handler
@@ -4424,11 +4472,12 @@
          ;; specified.  However, if the method _also_ specifies an
          ;; encoding function, then that is used for encoding the
          ;; contents of the tmp file.
+         (setq filesize (nth 7 (file-attributes tmpfile)))
          (cond
           ;; `rename-file' handles direct copy and out-of-band methods.
           ((or (tramp-local-host-p v)
                (and (tramp-method-out-of-band-p v)
-                    (> (- (or end (point-max)) (or start (point-min)))
+                    (> filesize
                        tramp-copy-size-limit)))
            (condition-case err
                (rename-file tmpfile filename t)
@@ -4438,10 +4487,14 @@
 
           ;; Use inline file transfer.
           (rem-dec
+           (if (<= tramp-inline-transfer-compress-start-size filesize)
+               (setq compress (tramp-get-inline-transfer-compress v 
"inline-transfer-compress")
+                     decompress (tramp-get-inline-transfer-compress v 
"inline-transfer-decompress")))
            ;; Encode tmpfile.
            (tramp-message v 5 "Encoding region...")
            (unwind-protect
                (with-temp-buffer
+                 (set-buffer-multibyte nil)
                  ;; Use encoding function or command.
                  (if (and (symbolp loc-enc) (fboundp loc-enc))
                      (progn
@@ -4461,6 +4514,17 @@
                        ;; a tmp file anyway.
                        (let ((default-directory
                                (tramp-compat-temporary-file-directory)))
+                         (if compress
+                             (let ((coding-system-for-write 'binary)
+                                   (coding-system-for-read 'binary))
+                               (tramp-message
+                                v 5 "Compressing local file %s with command 
`%s'..."
+                                filename compress)
+                               (call-process-region (point-min) (point-max)
+                                                    tramp-encoding-shell
+                                                    t t nil
+                                                    
tramp-encoding-command-switch
+                                                    compress)))
                          (funcall loc-enc (point-min) (point-max))))
 
                    (tramp-message
@@ -4477,19 +4541,34 @@
                  ;; the remote host, we cannot use the function.
                  (goto-char (point-max))
                  (unless (bolp) (newline))
-                 (tramp-message
-                  v 5 "Decoding region into remote file %s..." filename)
+                 (if decompress
+                     (tramp-message
+                      v 5 "Decoding and decompressing region into remote file 
%s..." filename)
+                   (tramp-message
+                    v 5 "Decoding region into remote file %s..." filename))
                  (tramp-send-command
                   v
-                  (format
-                   "%s >%s <<'EOF'\n%sEOF"
-                   rem-dec
-                   (tramp-shell-quote-argument localname)
-                   (buffer-string)))
-                 (tramp-barf-unless-okay
-                  v nil
-                  "Couldn't write region to `%s', decode using `%s' failed"
-                  filename rem-dec)
+                  (if decompress
+                      (format
+                       "(%s | %s >%s) <<'EOF'\n%sEOF"
+                       rem-dec
+                       decompress
+                       (tramp-shell-quote-argument localname)
+                       (buffer-string))
+                    (format
+                     "%s >%s <<'EOF'\n%sEOF"
+                     rem-dec
+                     (tramp-shell-quote-argument localname)
+                     (buffer-string))))
+                 (if decompress
+                     (tramp-barf-unless-okay
+                      v nil
+                      "Couldn't write region to `%s', decode using `%s' and 
`%s' failed"
+                      filename rem-dec decompress)
+                   (tramp-barf-unless-okay
+                    v nil
+                    "Couldn't write region to `%s', decode using `%s' failed"
+                    filename rem-dec))
                  ;; When `file-precious-flag' is set, the region is
                  ;; written to a temporary file.  Check that the
                  ;; checksum is equal to that from the local tmpfile.
@@ -4510,11 +4589,17 @@
                       (buffer-string)
                       (with-current-buffer (tramp-get-buffer v)
                         (buffer-string))))
-                    (tramp-error
-                     v 'file-error
-                     (concat "Couldn't write region to `%s',"
-                             " decode using `%s' failed")
-                     filename rem-dec)))
+                    (if decompress
+                        (tramp-error
+                         v 'file-error
+                         (concat "Couldn't write region to `%s',"
+                                 " decode using `%s' and `%s' failed")
+                         filename rem-dec decompress)
+                      (tramp-error
+                       v 'file-error
+                       (concat "Couldn't write region to `%s',"
+                               " decode using `%s' failed")
+                       filename rem-dec))))
                  (tramp-message
                   v 5 "Decoding region into remote file %s...done" filename)
                  (tramp-flush-file-property v localname))
@@ -6312,6 +6397,62 @@
       (tramp-message vec 5 "Using remote decoding `%s'" rem-dec)
       (tramp-set-connection-property vec "remote-decoding" rem-dec))))
 
+(defconst tramp-inline-transfer-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 is a list that looks like this:
+
+\(\"executable program\")
+or
+\(\"executable program\" \"option\" ...)")
+
+(defun tramp-find-inline-transfer-compress (vec)
+  "Find an inline transfer compress command that works.
+Goes through the list `tramp-inline-transfer-compress-commands'."
+  (save-excursion
+    (let ((commands tramp-inline-transfer-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 inline transfer 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 inline transfer 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-transfer-compress" 
compress)
+           (tramp-message vec 5 "Using inline transfer decompress command 
`%s'" decompress)
+           (tramp-set-connection-property vec "inline-transfer-decompress" 
decompress))
+       ;; Set connection properties as checked (t).
+       (tramp-set-connection-property vec "inline-transfer-compress" t)
+       (tramp-set-connection-property vec "inline-transfer-decompress" t)
+       (tramp-message vec 2 "Couldn't find an inline transfer compress 
command")))))
+
 (defun tramp-call-local-coding-command (cmd input output)
   "Call the local encoding or decoding command.
 If CMD contains \"%s\", provide input file INPUT there in command.
@@ -7388,6 +7529,19 @@
      (tramp-find-inline-encoding vec)
      (tramp-get-connection-property vec prop nil))))
 
+(defun tramp-get-inline-transfer-compress (vec prop)
+  (let ((val (tramp-get-connection-property vec prop nil)))
+    (if (eq val t)     ; already checked, and compress command not found
+       nil
+      (or
+       val
+       (progn
+        (tramp-find-inline-transfer-compress vec)
+        (setq val (tramp-get-inline-transfer-compress vec prop))
+        (if (eq val t)                 ; compress command not found
+            nil
+          val))))))
+
 (defun tramp-get-method-parameter (method param)
   "Return the method parameter PARAM.
 If the `tramp-methods' entry does not exist, return NIL."

reply via email to

[Prev in Thread] Current Thread [Next in Thread]