[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] /srv/bzr/emacs/trunk r100103: Implement compression for in
|
From: |
Michael Albinus |
|
Subject: |
[Emacs-diffs] /srv/bzr/emacs/trunk r100103: Implement compression for inline methods. |
|
Date: |
Sat, 01 May 2010 11:34:14 +0200 |
|
User-agent: |
Bazaar (2.0.3) |
------------------------------------------------------------
revno: 100103
committer: Michael Albinus <address@hidden>
branch nick: trunk
timestamp: Sat 2010-05-01 11:34:14 +0200
message:
Implement compression for inline methods.
* net/tramp.el (tramp-inline-compress-start-size): New defcustom.
(tramp-copy-size-limit): Allow also nil.
(tramp-inline-compress-commands): New defconst.
(tramp-find-inline-compress, tramp-get-inline-compress)
(tramp-get-inline-coding): New defuns.
(tramp-get-remote-coding, tramp-get-local-coding): Removed,
replaced by `tramp-get-inline-coding'.
(tramp-handle-file-local-copy, tramp-handle-write-region)
(tramp-method-out-of-band-p): Use `tramp-get-inline-coding'.
modified:
lisp/ChangeLog
lisp/net/tramp.el
=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog 2010-05-01 02:19:40 +0000
+++ b/lisp/ChangeLog 2010-05-01 09:34:14 +0000
@@ -1,3 +1,18 @@
+2010-05-01 Toru TSUNEYOSHI <address@hidden>
+ Michael Albinus <address@hidden>
+
+ Implement compression for inline methods.
+
+ * net/tramp.el (tramp-inline-compress-start-size): New defcustom.
+ (tramp-copy-size-limit): Allow also nil.
+ (tramp-inline-compress-commands): New defconst.
+ (tramp-find-inline-compress, tramp-get-inline-compress)
+ (tramp-get-inline-coding): New defuns.
+ (tramp-get-remote-coding, tramp-get-local-coding): Removed,
+ replaced by `tramp-get-inline-coding'.
+ (tramp-handle-file-local-copy, tramp-handle-write-region)
+ (tramp-method-out-of-band-p): Use `tramp-get-inline-coding'.
+
2010-05-01 Chong Yidong <address@hidden>
* server.el (server-sentinel, server-start, server-force-delete):
=== modified file 'lisp/net/tramp.el'
--- a/lisp/net/tramp.el 2010-04-28 18:42:20 +0000
+++ b/lisp/net/tramp.el 2010-05-01 09:34:14 +0000
@@ -285,10 +285,19 @@
: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').
+If it is nil, no compression at all will be applied."
+ :group 'tramp
+ :type '(choice (const nil) integer))
+
(defcustom tramp-copy-size-limit 10240
- "*The maximum file size where inline copying is preferred over an
out-of-the-band copy."
+ "*The maximum file size where inline copying is preferred over an
out-of-the-band copy.
+If it is nil, inline out-of-the-band copy will be used without a check."
:group 'tramp
- :type 'integer)
+ :type '(choice (const nil) integer))
(defcustom tramp-terminal-type "dumb"
"*Value of TERM environment variable for logging in to remote host.
@@ -4722,16 +4731,16 @@
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)))
+ (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 (nth 7 (file-attributes filename))))
+ (tramp-method-out-of-band-p v size))
(copy-file filename tmpfile t t))
;; Use inline encoding for file transfer.
@@ -4739,12 +4748,11 @@
(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))
+ v (format 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 (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,12 +5101,10 @@
'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)))
+ (let ((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' 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
@@ -5121,7 +5127,8 @@
;; 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
@@ -5153,124 +5160,125 @@
;; specified. However, if the method _also_ specifies an
;; encoding function, then that is used for encoding the
;; contents of the tmp file.
- (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))
- (tramp-get-method-parameter
- method 'tramp-copy-keep-tmpfile))
- (progn
- (setq tramp-temp-buffer-file-name tmpfile)
- (condition-case err
- ;; We keep the local file for performance
- ;; reasons, useful for "rsync".
- (copy-file tmpfile filename t)
- ((error quit)
- (setq tramp-temp-buffer-file-name nil)
- (delete-file tmpfile)
- (signal (car err) (cdr err)))))
- (setq tramp-temp-buffer-file-name nil)
- ;; Don't rename, in order to keep context in SELinux.
+ (let* ((size (nth 7 (file-attributes tmpfile)))
+ (rem-dec (tramp-get-inline-coding v "remote-decoding" size))
+ (loc-enc (tramp-get-inline-coding v "local-encoding" size)))
+ (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))
+ (tramp-get-method-parameter
+ method 'tramp-copy-keep-tmpfile))
+ (progn
+ (setq tramp-temp-buffer-file-name tmpfile)
+ (condition-case err
+ ;; We keep the local file for performance
+ ;; reasons, useful for "rsync".
+ (copy-file tmpfile filename t)
+ ((error quit)
+ (setq tramp-temp-buffer-file-name nil)
+ (delete-file tmpfile)
+ (signal (car err) (cdr err)))))
+ (setq tramp-temp-buffer-file-name nil)
+ ;; Don't rename, in order to keep context in SELinux.
+ (unwind-protect
+ (copy-file tmpfile filename t)
+ (delete-file tmpfile))))
+
+ ;; Use inline file transfer.
+ (rem-dec
+ ;; Encode tmpfile.
+ (tramp-message v 5 "Encoding region...")
(unwind-protect
- (copy-file tmpfile filename t)
- (delete-file tmpfile))))
-
- ;; Use inline file transfer.
- (rem-dec
- ;; Encode tmpfile.
- (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
- ;; base64.el that comes with pgnus-0.84. If
- ;; both of the following conditions are
- ;; satisfied, it tries to write to a local
- ;; file in default-directory, but at this
- ;; point, default-directory is remote.
- ;; (`call-process-region' can't write to
- ;; remote files, it seems.) The file in
- ;; question is a tmp file anyway.
- (let ((default-directory
- (tramp-compat-temporary-file-directory)))
- (funcall loc-enc (point-min) (point-max))))
-
- (tramp-message
- v 5 "Encoding region using command `%s'..." loc-enc)
- (unless (equal 0 (tramp-call-local-coding-command
+ (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
+ ;; base64.el that comes with pgnus-0.84. If
+ ;; both of the following conditions are
+ ;; satisfied, it tries to write to a local
+ ;; file in default-directory, but at this
+ ;; point, default-directory is remote.
+ ;; (`call-process-region' can't write to
+ ;; remote files, it seems.) The file in
+ ;; question is a tmp file anyway.
+ (let ((default-directory
+ (tramp-compat-temporary-file-directory)))
+ (funcall loc-enc (point-min) (point-max))))
+
+ (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"
- filename loc-enc)))
-
- ;; Send buffer into remote decoding command which
- ;; writes to remote file. Because this happens on
- ;; 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)
- (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)
- ;; 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.
- (when file-precious-flag
- (erase-buffer)
- (and
- ;; cksum runs locally, if possible.
- (zerop (tramp-local-call-process "cksum" tmpfile t))
- ;; cksum runs remotely.
- (zerop
- (tramp-send-command-and-check
- v
- (format
- "cksum <%s" (tramp-shell-quote-argument localname))))
- ;; ... they are different.
- (not
- (string-equal
- (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)))
- (tramp-message
- v 5 "Decoding region into remote file %s...done" filename))
-
- ;; Save exit.
- (delete-file tmpfile)))
-
- ;; That's not expected.
- (t
- (tramp-error
- v 'file-error
- (concat "Method `%s' should specify both encoding and "
- "decoding command or an rcp program")
- method)))
+ (tramp-error
+ v 'file-error
+ "Cannot write to `%s', local encoding command `%s'
failed"
+ filename loc-enc)))
+
+ ;; Send buffer into remote decoding command which
+ ;; writes to remote file. Because this happens on
+ ;; 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)
+ (tramp-send-command
+ v
+ (format
+ (concat rem-dec " <<'EOF'\n%sEOF")
+ (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)
+ ;; 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.
+ (when file-precious-flag
+ (erase-buffer)
+ (and
+ ;; cksum runs locally, if possible.
+ (zerop (tramp-local-call-process "cksum" tmpfile t))
+ ;; cksum runs remotely.
+ (zerop
+ (tramp-send-command-and-check
+ v
+ (format
+ "cksum <%s" (tramp-shell-quote-argument localname))))
+ ;; ... they are different.
+ (not
+ (string-equal
+ (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)))
+ (tramp-message
+ v 5 "Decoding region into remote file %s...done" filename))
+
+ ;; Save exit.
+ (delete-file tmpfile)))
+
+ ;; That's not expected.
+ (t
+ (tramp-error
+ v 'file-error
+ (concat "Method `%s' should specify both encoding and "
+ "decoding command or an rcp program")
+ method))))
;; Make `last-coding-system-used' have the right value.
(when coding-system-used
@@ -7200,6 +7208,64 @@
(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."
@@ -8079,8 +8145,9 @@
(tramp-get-method-parameter (tramp-file-name-method vec)
'tramp-copy-program)
;; 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")))))
+ (or (null tramp-copy-size-limit)
+ (> 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,31 +8428,82 @@
(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)))
+(defun tramp-get-inline-compress (vec prop size)
+ "Return the compress command related to PROP.
+PROP is either `inline-compress' or `inline-decompress'. SIZE is
+the length of the file to be compressed.
+
+If no corresponding command is found, nil is returned."
+ (when (and (integerp tramp-inline-compress-start-size)
+ (> 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 - maybe.
- (when (and ret (symbolp ret))
- (let ((name (symbol-name ret)))
+ ;; 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 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))))
+ (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)
+ (let ((coding-system-for-write 'binary)
+ (coding-system-for-read 'binary))
+ (apply
+ 'call-process-region (point-min) (point-max)
+ (car (split-string ,compress)) t t nil
+ (cdr (split-string ,compress)))))
+ `(lambda (beg end)
+ (let ((coding-system-for-write 'binary)
+ (coding-system-for-read 'binary))
+ (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.
-If the `tramp-methods' entry does not exist, return NIL."
+If the `tramp-methods' entry does not exist, return nil."
(let ((entry (assoc param (assoc method tramp-methods))))
(when entry (cadr entry))))
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] /srv/bzr/emacs/trunk r100103: Implement compression for inline methods.,
Michael Albinus <=