emacs-diffs
[Top][All Lists]
Advanced

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

[Emacs-diffs] /srv/bzr/emacs/trunk r112353: * net/tramp-compat.el (tramp


From: Michael Albinus
Subject: [Emacs-diffs] /srv/bzr/emacs/trunk r112353: * net/tramp-compat.el (tramp-compat-call-process): Move function ...
Date: Mon, 22 Apr 2013 12:26:09 +0200
User-agent: Bazaar (2.5.0)

------------------------------------------------------------
revno: 112353
committer: Michael Albinus <address@hidden
branch nick: trunk
timestamp: Mon 2013-04-22 12:26:09 +0200
message:
  * net/tramp-compat.el (tramp-compat-call-process): Move function ...
  * net/tramp.el (tramp-call-process): ... here
  (tramp-set-completion-function, tramp-parse-putty):
  * net/tramp-adb.el (tramp-adb-execute-adb-command):
  * net/tramp-gvfs.el (tramp-gvfs-send-command):
  * net/tramp-sh.el (tramp-sh-handle-set-file-times)
  (tramp-set-file-uid-gid, tramp-sh-handle-write-region)
  (tramp-call-local-coding-command): Use `tramp-call-process'
  instead of `tramp-compat-call-process'.
  
  * net/tramp-sh.el (tramp-perl-pack, tramp-perl-unpack): New defconst.
  (tramp-local-coding-commands, tramp-remote-coding-commands): Use them.
  (tramp-sh-handle-file-local-copy, tramp-sh-handle-write-region):
  (tramp-find-inline-compress):Improve traces.
  (tramp-maybe-send-script): Check for Perl binary.
  (tramp-get-inline-coding): Do not redirect STDOUT for local decoding.
modified:
  lisp/ChangeLog
  lisp/net/tramp-adb.el
  lisp/net/tramp-compat.el
  lisp/net/tramp-gvfs.el
  lisp/net/tramp-sh.el
  lisp/net/tramp.el
=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2013-04-22 04:53:05 +0000
+++ b/lisp/ChangeLog    2013-04-22 10:26:09 +0000
@@ -1,3 +1,24 @@
+2013-04-22  Michael Albinus  <address@hidden>
+
+       Fix pack/unpack coding.  Reported by David Smith <address@hidden>.
+
+       * net/tramp-compat.el (tramp-compat-call-process): Move function ...
+       * net/tramp.el (tramp-call-process): ... here
+       (tramp-set-completion-function, tramp-parse-putty):
+       * net/tramp-adb.el (tramp-adb-execute-adb-command):
+       * net/tramp-gvfs.el (tramp-gvfs-send-command):
+       * net/tramp-sh.el (tramp-sh-handle-set-file-times)
+       (tramp-set-file-uid-gid, tramp-sh-handle-write-region)
+       (tramp-call-local-coding-command): Use `tramp-call-process'
+       instead of `tramp-compat-call-process'.
+
+       * net/tramp-sh.el (tramp-perl-pack, tramp-perl-unpack): New defconst.
+       (tramp-local-coding-commands, tramp-remote-coding-commands): Use them.
+       (tramp-sh-handle-file-local-copy, tramp-sh-handle-write-region):
+       (tramp-find-inline-compress):Improve traces.
+       (tramp-maybe-send-script): Check for Perl binary.
+       (tramp-get-inline-coding): Do not redirect STDOUT for local decoding.
+
 2013-04-22  Daiki Ueno  <address@hidden>
 
        * epg.el (epg-context-pinentry-mode): New function.

=== modified file 'lisp/net/tramp-adb.el'
--- a/lisp/net/tramp-adb.el     2013-03-18 13:04:13 +0000
+++ b/lisp/net/tramp-adb.el     2013-04-22 10:26:09 +0000
@@ -982,11 +982,10 @@
     (setq args (append (list "-s" (tramp-file-name-host vec)) args)))
   (with-temp-buffer
     (prog1
-       (unless (zerop (apply 'call-process tramp-adb-program nil t nil args))
+       (unless
+           (zerop (apply 'tramp-call-process tramp-adb-program nil t nil args))
          (buffer-string))
-      (tramp-message
-       vec 6 "%s %s\n%s"
-       tramp-adb-program (mapconcat 'identity args " ") (buffer-string)))))
+      (tramp-message vec 6 "%s" (buffer-string)))))
 
 (defun tramp-adb-find-test-command (vec)
   "Checks, whether the ash has a builtin \"test\" command.

=== modified file 'lisp/net/tramp-compat.el'
--- a/lisp/net/tramp-compat.el  2013-03-18 13:04:13 +0000
+++ b/lisp/net/tramp-compat.el  2013-04-22 10:26:09 +0000
@@ -438,20 +438,6 @@
 element is not omitted."
   (delete "" (split-string string pattern)))
 
-(defun tramp-compat-call-process
-  (program &optional infile destination display &rest args)
-  "Calls `call-process' on the local host.
-This is needed because for some Emacs flavors Tramp has
-defadvised `call-process' to behave like `process-file'.  The
-Lisp error raised when PROGRAM is nil is trapped also, returning 1."
-  (let ((default-directory
-         (if (file-remote-p default-directory)
-             (tramp-compat-temporary-file-directory)
-           default-directory)))
-    (if (executable-find program)
-       (apply 'call-process program infile destination display args)
-      1)))
-
 (defun tramp-compat-process-running-p (process-name)
   "Returns `t' if system process PROCESS-NAME is running for 
`user-login-name'."
   (when (stringp process-name)

=== modified file 'lisp/net/tramp-gvfs.el'
--- a/lisp/net/tramp-gvfs.el    2013-03-18 13:04:13 +0000
+++ b/lisp/net/tramp-gvfs.el    2013-04-22 10:26:09 +0000
@@ -1572,7 +1572,7 @@
       (tramp-gvfs-maybe-open-connection vec)
       (erase-buffer)
       (tramp-message vec 6 "%s %s" command (mapconcat 'identity args " "))
-      (setq result (apply 'tramp-compat-call-process command nil t nil args))
+      (setq result (apply 'tramp-call-process command nil t nil args))
       (tramp-message vec 6 "\n%s" (buffer-string))
       (zerop result))))
 

=== modified file 'lisp/net/tramp-sh.el'
--- a/lisp/net/tramp-sh.el      2013-04-18 12:47:01 +0000
+++ b/lisp/net/tramp-sh.el      2013-04-22 10:26:09 +0000
@@ -767,6 +767,16 @@
 Escape sequence %s is replaced with name of Perl binary.
 This string is passed to `format', so percent characters need to be doubled.")
 
+(defconst tramp-perl-pack
+  "%s -e 'binmode STDIN; binmode STDOUT; print pack(q{u*}, join q{}, <>)'"
+  "Perl program to use for encoding a file.
+Escape sequence %s is replaced with name of Perl binary.")
+
+(defconst tramp-perl-unpack
+  "%s -e 'binmode STDIN; binmode STDOUT; print unpack(q{u*}, join q{}, <>)'"
+  "Perl program to use for decoding a file.
+Escape sequence %s is replaced with name of Perl binary.")
+
 (defconst tramp-vc-registered-read-file-names
   "echo \"(\"
 while read file; do
@@ -1309,7 +1319,7 @@
     ;; without `set-file-times', this function is an alias for this.
     ;; We are local, so we don't need the UTC settings.
     (zerop
-     (tramp-compat-call-process
+     (tramp-call-process
       "touch" nil nil nil "-t"
       (format-time-string "%Y%m%d%H%M.%S" time)
       (tramp-shell-quote-argument filename)))))
@@ -1343,7 +1353,7 @@
       ;; `set-file-uid-gid'.  On W32 "chown" might not work.
       (let ((uid (or (and (natnump uid) uid) (tramp-get-local-uid 'integer)))
            (gid (or (and (natnump gid) gid) (tramp-get-local-gid 'integer))))
-       (tramp-compat-call-process
+       (tramp-call-process
         "chown" nil nil nil
          (format "%d:%d" uid gid) (tramp-shell-quote-argument filename))))))
 
@@ -2891,40 +2901,39 @@
           (rem-enc
            (save-excursion
              (with-tramp-progress-reporter
-              v 3 (format "Encoding remote file %s" filename)
+              v 3
+              (format "Encoding remote file `%s' with `%s'" filename rem-enc)
               (tramp-barf-unless-okay
                v (format rem-enc (tramp-shell-quote-argument localname))
                "Encoding remote file failed"))
 
-             (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
-                 ;; correctly.
-                 (with-temp-buffer
-                   (set-buffer-multibyte nil)
-                   (insert-buffer-substring (tramp-get-buffer v))
-                   (with-tramp-progress-reporter
-                       v 3 (format "Decoding remote file %s with function %s"
-                                   filename loc-dec)
+             (with-tramp-progress-reporter
+                 v 3 (format "Decoding local file `%s' with `%s'"
+                             tmpfile 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
+                   ;; correctly.
+                   (with-temp-buffer
+                     (set-buffer-multibyte nil)
+                     (insert-buffer-substring (tramp-get-buffer v))
                      (funcall loc-dec (point-min) (point-max))
                      ;; Unset `file-name-handler-alist'.  Otherwise,
                      ;; epa-file gets confused.
                      (let (file-name-handler-alist
                            (coding-system-for-write 'binary))
-                       (write-region (point-min) (point-max) tmpfile))))
+                       (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)))
-                 ;; Unset `file-name-handler-alist'.  Otherwise,
-                 ;; epa-file gets confused.
-                 (let (file-name-handler-alist
-                       (coding-system-for-write 'binary))
-                   (write-region (point-min) (point-max) tmpfile2))
-                 (with-tramp-progress-reporter
-                     v 3 (format "Decoding remote file %s with command %s"
-                                 filename loc-dec)
+                 ;; If tramp-decoding-function is not defined for this
+                 ;; method, we invoke tramp-decoding-command instead.
+                 (let ((tmpfile2 (tramp-compat-make-temp-file filename)))
+                   ;; Unset `file-name-handler-alist'.  Otherwise,
+                   ;; epa-file gets confused.
+                   (let (file-name-handler-alist
+                         (coding-system-for-write 'binary))
+                     (with-current-buffer (tramp-get-buffer v)
+                       (write-region (point-min) (point-max) tmpfile2)))
                    (unwind-protect
                        (tramp-call-local-coding-command
                         loc-dec tmpfile2 tmpfile)
@@ -3149,28 +3158,25 @@
                  (with-temp-buffer
                    (set-buffer-multibyte nil)
                    ;; Use encoding function or command.
-                   (if (functionp loc-enc)
-                       (with-tramp-progress-reporter
-                           v 3 (format "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
+                   (with-tramp-progress-reporter
+                       v 3 (format "Encoding local file `%s' using `%s'"
+                                   tmpfile loc-enc)
+                     (if (functionp loc-enc)
+                         ;; 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
+                         (let ((coding-system-for-read 'binary)
+                               (default-directory
                                  (tramp-compat-temporary-file-directory)))
-                           (funcall loc-enc (point-min) (point-max))))
+                           (insert-file-contents-literally tmpfile)
+                           (funcall loc-enc (point-min) (point-max)))
 
-                     (with-tramp-progress-reporter
-                         v 3 (format "Encoding region using command `%s'"
-                                     loc-enc)
                        (unless (zerop (tramp-call-local-coding-command
                                        loc-enc tmpfile t))
                          (tramp-error
@@ -3183,8 +3189,8 @@
                    ;; writes to remote file.  Because this happens on
                    ;; the remote host, we cannot use the function.
                    (with-tramp-progress-reporter
-                       v 3
-                       (format "Decoding region into remote file %s" filename)
+                       v 3 (format "Decoding remote file `%s' using `%s'"
+                                   filename rem-dec)
                      (goto-char (point-max))
                      (unless (bolp) (newline))
                      (tramp-send-command
@@ -3204,7 +3210,7 @@
                        (erase-buffer)
                        (and
                         ;; cksum runs locally, if possible.
-                        (zerop (tramp-compat-call-process "cksum" tmpfile t))
+                        (zerop (tramp-call-process "cksum" tmpfile t))
                         ;; cksum runs remotely.
                         (tramp-send-command-and-check
                          v
@@ -3382,6 +3388,9 @@
     (unless (member name scripts)
       (with-tramp-progress-reporter vec 5 (format "Sending script `%s'" name)
        ;; The script could contain a call of Perl.  This is masked with `%s'.
+       (when (and (string-match "%s" script)
+                  (not (tramp-get-remote-perl vec)))
+         (tramp-error vec 'file-error "No Perl available on remote host"))
        (tramp-barf-unless-okay
         vec
         (format "%s () {\n%s\n}" name
@@ -3811,11 +3820,6 @@
       (tramp-send-command
        vec (format "unset %s" (mapconcat 'identity unset " ")) t))))
 
-;; CCC: We should either implement a Perl version of base64 encoding
-;; and decoding.  Then we just use that in the last item.  The other
-;; alternative is to use the Perl version of UU encoding.  But then
-;; we need a Lisp version of uuencode.
-;;
 ;; Old text from documentation of tramp-methods:
 ;; Using a uuencode/uudecode inline method is discouraged, please use one
 ;; of the base64 methods instead since base64 encoding is much more
@@ -3832,11 +3836,9 @@
 (autoload 'uudecode-decode-region "uudecode")
 
 (defconst tramp-local-coding-commands
-  '((b64 base64-encode-region base64-decode-region)
+  `((b64 base64-encode-region base64-decode-region)
     (uu  tramp-uuencode-region uudecode-decode-region)
-    (pack
-     "perl -e 'binmode STDIN; binmode STDOUT; print pack(q{u*}, join q{}, <>)'"
-     "perl -e 'binmode STDIN; binmode STDOUT; print unpack(q{u*}, join q{}, 
<>)'"))
+    (pack ,(format tramp-perl-pack "perl") ,(format tramp-perl-unpack "perl")))
   "List of local coding commands for inline transfer.
 Each item is a list that looks like this:
 
@@ -3871,9 +3873,7 @@
     (uu  "uuencode xxx" "uudecode -o -")
     (uu  "uuencode xxx" "uudecode -p")
     (uu  "uuencode xxx" tramp-uudecode)
-    (pack
-     "perl -e 'binmode STDIN; binmode STDOUT; print pack(q{u*}, join q{}, <>)'"
-     "perl -e 'binmode STDIN; binmode STDOUT; print unpack(q{u*}, join q{}, 
<>)'"))
+    (pack tramp-perl-pack tramp-perl-unpack))
   "List of remote coding commands for inline transfer.
 Each item is a list that looks like this:
 
@@ -4014,7 +4014,7 @@
 OUTPUT can be a string (which specifies a filename), or t (which
 means standard output and thus the current buffer), or nil (which
 means discard it)."
-  (tramp-compat-call-process
+  (tramp-call-process
    tramp-encoding-shell
    (when (and input (not (string-match "%s" cmd))) input)
    (if (eq output t) t nil)
@@ -4022,7 +4022,7 @@
    tramp-encoding-command-switch
    (concat
     (if (string-match "%s" cmd) (format cmd input) cmd)
-    (if (stringp output) (concat "> " output) ""))))
+    (if (stringp output) (concat " >" output) ""))))
 
 (defconst tramp-inline-compress-commands
   '(("gzip" "gzip -d")
@@ -4051,7 +4051,7 @@
                decompress (nth 1 item))
          (tramp-message
           vec 5
-          "Checking local compress command `%s', `%s' for sanity"
+          "Checking local compress commands `%s', `%s' for sanity"
           compress decompress)
          (unless
              (zerop
@@ -4067,7 +4067,7 @@
            (throw 'next nil))
          (tramp-message
           vec 5
-          "Checking remote compress command `%s', `%s' for sanity"
+          "Checking remote compress commands `%s', `%s' for sanity"
           compress decompress)
          (unless (tramp-send-command-and-check
                   vec (format "echo %s | %s | %s" magic compress decompress) t)
@@ -4981,10 +4981,12 @@
           ;; Windows shells need the program file name after
           ;; the pipe symbol be quoted if they use forward
           ;; slashes as directory separators.
-          (if (and (string-match "local" prop)
-                   (memq system-type '(windows-nt)))
-              "(%s | \"%s\" >%%s)"
-            "(%s | %s >%%s)")
+          (cond
+           ((and (string-match "local" prop)
+                 (memq system-type '(windows-nt)))
+              "(%s | \"%s\")")
+           ((string-match "local" prop) "(%s | %s)")
+           (t "(%s | %s >%%s)"))
           coding compress))
         (compress
          (format
@@ -4997,7 +4999,9 @@
             "(%s <%%s | %s)")
           compress coding))
         ((string-match "decoding" prop)
-         (format "%s >%%s" coding))
+         (cond
+          ((string-match "local" prop) (format "%s" coding))
+          (t (format "%s >%%s" coding))))
         (t
          (format "%s <%%s" coding)))))))
 

=== modified file 'lisp/net/tramp.el'
--- a/lisp/net/tramp.el 2013-03-30 16:55:47 +0000
+++ b/lisp/net/tramp.el 2013-04-22 10:26:09 +0000
@@ -1717,7 +1717,7 @@
                       ;; Windows registry.
                       (and (memq system-type '(cygwin windows-nt))
                            (zerop
-                            (tramp-compat-call-process
+                            (tramp-call-process
                              "reg" nil nil nil "query" (nth 1 (car v)))))
                     ;; Configuration file.
                     (file-exists-p (nth 1 (car v)))))
@@ -2769,7 +2769,7 @@
 User is always nil."
   (if (memq system-type '(windows-nt))
       (with-temp-buffer
-       (when (zerop (tramp-compat-call-process
+       (when (zerop (tramp-call-process
                      "reg" nil t nil "query" registry-or-dirname))
          (goto-char (point-min))
          (loop while (not (eobp)) collect
@@ -3897,6 +3897,24 @@
 
 ;;; Compatibility functions section:
 
+(defun tramp-call-process
+  (program &optional infile destination display &rest args)
+  "Calls `call-process' on the local host.
+This is needed because for some Emacs flavors Tramp has
+defadvised `call-process' to behave like `process-file'.  The
+Lisp error raised when PROGRAM is nil is trapped also, returning 1.
+Furthermore, traces are written with verbosity of 6."
+  (let ((default-directory
+         (if (file-remote-p default-directory)
+             (tramp-compat-temporary-file-directory)
+           default-directory)))
+    (tramp-message
+     (vector tramp-current-method tramp-current-user tramp-current-host nil 
nil)
+     6 "%s %s %s" program infile args)
+    (if (executable-find program)
+       (apply 'call-process program infile destination display args)
+      1)))
+
 ;;;###tramp-autoload
 (defun tramp-read-passwd (proc &optional prompt)
   "Read a password from user (compat function).


reply via email to

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