[Emacs-diffs] Changes to emacs/lisp/net/tramp.el,v

[Michael Albinus]

CVSROOT:        /cvsroot/emacs
Module name:    emacs
Changes by:     Michael Albinus <albinus>       07/08/28 20:09:58

Index: net/tramp.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/net/tramp.el,v
retrieving revision 1.134
retrieving revision 1.135
diff -u -b -r1.134 -r1.135
--- net/tramp.el        24 Aug 2007 05:27:22 -0000      1.134
+++ net/tramp.el        28 Aug 2007 20:09:58 -0000      1.135
@@ -2506,6 +2506,7 @@
   (zerop
    (if (file-remote-p filename)
        (with-parsed-tramp-file-name filename nil
+        (tramp-flush-file-property v localname)
         (let ((time (if (or (null time) (equal time '(0 0)))
                         (current-time)
                       time))
@@ -2527,6 +2528,7 @@
                          (format-time-string "%Y%m%d%H%M.%S" time t)
                        (format-time-string "%Y%m%d%H%M.%S" time))
                      (tramp-shell-quote-argument localname)))))
+
      ;; We handle also the local part, because in older Emacsen,
      ;; without `set-file-times', this function is an alias for this.
      ;; We are local, so we don't need the UTC settings.
@@ -2535,6 +2537,34 @@
       (format-time-string "%Y%m%d%H%M.%S" time)
       (tramp-shell-quote-argument filename)))))
 
+(defun tramp-set-file-uid-gid (filename &optional uid gid)
+  "Set the ownership for FILENAME.
+If UID and GID are provided, these values are used; otherwise uid
+and gid of the corresponding user is taken.  Both parameters must be integers."
+  ;; CCC: Modern Unices allow chown only for root.  So we might need
+  ;;      another implementation, see `dired-do-chown'.  OTOH, it is
+  ;;      mostly working with su(do)? when it is needed, so it shall
+  ;;      succeed in the majority of cases.
+  (if (file-remote-p filename)
+      (with-parsed-tramp-file-name filename nil
+       (let ((uid (or (and (integerp uid) uid)
+                      (tramp-get-remote-uid v 'integer)))
+             (gid (or (and (integerp gid) gid)
+                      (tramp-get-remote-gid v 'integer))))
+         (tramp-send-command
+          v (format
+             "chown %d:%d %s" uid gid
+             (tramp-shell-quote-argument localname)))))
+
+    ;; We handle also the local part, because there doesn't exist
+    ;; `set-file-uid-gid'.
+    (let ((uid (or (and (integerp uid) uid) (tramp-get-local-uid 'integer)))
+         (gid (or (and (integerp gid) gid) (tramp-get-local-uid 'integer)))
+         (default-directory (tramp-temporary-file-directory)))
+      (call-process
+       "chown" nil nil nil
+       (format "%d:%d" uid gid) (tramp-shell-quote-argument filename)))))
+
 ;; Simple functions using the `test' command.
 
 (defun tramp-handle-file-executable-p (filename)
@@ -2840,7 +2870,7 @@
         (buffer-name))))))
 
 (defun tramp-handle-copy-file
-  (filename newname &optional ok-if-already-exists keep-date)
+  (filename newname &optional ok-if-already-exists keep-date preserve-uid-gid)
   "Like `copy-file' for Tramp files."
   ;; Check if both files are local -- invoke normal copy-file.
   ;; Otherwise, use tramp from local system.
@@ -2850,9 +2880,10 @@
   (if (or (tramp-tramp-file-p filename)
           (tramp-tramp-file-p newname))
       (tramp-do-copy-or-rename-file
-       'copy filename newname ok-if-already-exists keep-date)
+       'copy filename newname ok-if-already-exists keep-date preserve-uid-gid)
     (tramp-run-real-handler
-     'copy-file (list filename newname ok-if-already-exists keep-date))))
+     'copy-file
+     (list filename newname ok-if-already-exists keep-date preserve-uid-gid))))
 
 (defun tramp-handle-rename-file
   (filename newname &optional ok-if-already-exists)
@@ -2865,19 +2896,20 @@
   (if (or (tramp-tramp-file-p filename)
           (tramp-tramp-file-p newname))
       (tramp-do-copy-or-rename-file
-       'rename filename newname ok-if-already-exists t)
+       'rename filename newname ok-if-already-exists t t)
     (tramp-run-real-handler
      'rename-file (list filename newname ok-if-already-exists))))
 
 (defun tramp-do-copy-or-rename-file
-  (op filename newname &optional ok-if-already-exists keep-date)
+  (op filename newname &optional ok-if-already-exists keep-date 
preserve-uid-gid)
   "Copy or rename a remote file.
 OP must be `copy' or `rename' and indicates the operation to perform.
 FILENAME specifies the file to copy or rename, NEWNAME is the name of
 the new file (for copy) or the new name of the file (for rename).
 OK-IF-ALREADY-EXISTS means don't barf if NEWNAME exists already.
 KEEP-DATE means to make sure that NEWNAME has the same timestamp
-as FILENAME.
+as FILENAME.  PRESERVE-UID-GID, when non-nil, instructs to keep
+the uid and gid if both files are on the same host.
 
 This function is invoked by `tramp-handle-copy-file' and
 `tramp-handle-rename-file'.  It is an error if OP is neither of `copy'
@@ -2905,7 +2937,9 @@
               ;; directly.
               ((tramp-equal-remote filename newname)
                (tramp-do-copy-or-rename-file-directly
-                op v1 v1-localname v2-localname keep-date))
+                op filename newname
+                ok-if-already-exists keep-date preserve-uid-gid))
+
               ;; If both source and target are Tramp files,
               ;; both are using the same copy-program, then we
               ;; can invoke rcp directly.  Note that
@@ -2917,6 +2951,7 @@
                        tramp-copy-size-limit))
                (tramp-do-copy-or-rename-file-out-of-band
                 op filename newname keep-date))
+
               ;; No shortcut was possible.  So we copy the
               ;; file first.  If the operation was `rename', we go
               ;; back and delete the original file (if the copy was
@@ -2933,20 +2968,29 @@
         ;; One file is a Tramp file, the other one is local.
         ((or t1 t2)
          (with-parsed-tramp-file-name (if t1 filename newname) nil
+           (cond
+            ;; Fast track on local machine.
+            ((tramp-local-host-p v)
+             (tramp-do-copy-or-rename-file-directly
+              op filename newname
+              ok-if-already-exists keep-date preserve-uid-gid))
+
            ;; If the Tramp file has an out-of-band method, the corresponding
            ;; copy-program can be invoked.
-           (if (and (tramp-method-out-of-band-p v)
+            ((and (tramp-method-out-of-band-p v)
                     (> (nth 7 (file-attributes filename))
                        tramp-copy-size-limit))
                (tramp-do-copy-or-rename-file-out-of-band
-                op filename newname keep-date)
-             ;; Use the generic method via a Tramp buffer.
-             (tramp-do-copy-or-rename-file-via-buffer
-              op filename newname keep-date))))
+              op filename newname keep-date))
+
+            ;; Use the inline method via a Tramp buffer.
+            (t (tramp-do-copy-or-rename-file-via-buffer
+                op filename newname keep-date)))))
 
         (t
          ;; One of them must be a Tramp file.
          (error "Tramp implementation says this cannot happen")))
+
       ;; When newname did exist, we have wrong cached values.
       (when t2
        (with-parsed-tramp-file-name newname nil
@@ -2977,53 +3021,132 @@
       (delete-file filename))))
 
 (defun tramp-do-copy-or-rename-file-directly
-  (op vec localname1 localname2 keep-date)
+ (op filename newname ok-if-already-exists keep-date preserve-uid-gid)
   "Invokes `cp' or `mv' on the remote system.
 OP must be one of `copy' or `rename', indicating `cp' or `mv',
-respectively.  VEC specifies the connection.  LOCALNAME1 and
-LOCALNAME2 specify the two arguments of `cp' or `mv'.  If
-KEEP-DATE is non-nil, preserve the time stamp when copying."
-  ;; CCC: What happens to the timestamp when renaming?
-  (let ((cmd (cond ((and (eq op 'copy) keep-date) "cp -f -p")
+respectively.  FILENAME specifies the file to copy or rename,
+NEWNAME is the name of the new file (for copy) or the new name of
+the file (for rename).  Both files must reside on the same host.
+KEEP-DATE means to make sure that NEWNAME has the same timestamp
+as FILENAME.  PRESERVE-UID-GID, when non-nil, instructs to keep
+the uid and gid from FILENAME."
+  (with-parsed-tramp-file-name (if t1 filename newname) nil
+    (let* ((cmd (cond ((and (eq op 'copy) preserve-uid-gid) "cp -f -p")
                    ((eq op 'copy) "cp -f")
                    ((eq op 'rename) "mv -f")
                    (t (tramp-error
                       vec 'file-error
                        "Unknown operation `%s', must be `copy' or `rename'"
-                       op)))))
+                         op))))
+          (t1 (tramp-tramp-file-p filename))
+          (t2 (tramp-tramp-file-p newname))
+          (localname1
+           (if t1 (tramp-handle-file-remote-p filename 'localname) filename))
+          (localname2
+           (if t2 (tramp-handle-file-remote-p newname 'localname) newname))
+          (prefix (tramp-handle-file-remote-p (if t1 filename newname)))
+          (tmpfile (tramp-make-temp-file localname1)))
+
+      (cond
+       ;; Both files are on a remote host, with same user.
+       ((and t1 t2)
     (tramp-send-command
-     vec
-     (format "%s %s %s"
-            cmd
+        v
+        (format "%s %s %s" cmd
             (tramp-shell-quote-argument localname1)
             (tramp-shell-quote-argument localname2)))
-    (with-current-buffer (tramp-get-buffer vec)
+       (with-current-buffer (tramp-get-buffer v)
       (goto-char (point-min))
       (unless
          (or
-          (and (eq op 'copy) keep-date
+              (and keep-date
                ;; Mask cp -f error.
-               (re-search-forward tramp-operation-not-permitted-regexp nil t))
-          (zerop (tramp-send-command-and-check vec nil)))
+                   (re-search-forward
+                    tramp-operation-not-permitted-regexp nil t))
+              (zerop (tramp-send-command-and-check v nil)))
        (tramp-error-with-buffer
-        nil vec 'file-error
+            nil v 'file-error
         "Copying directly failed, see buffer `%s' for details."
-        (buffer-name))))
-    ;; Set the mode.
-    ;; CCC: Maybe `chmod --reference=localname1 localname2' could be used
-    ;;      where available?
-    (unless (or (eq op 'rename) keep-date)
-      (set-file-modes
-       (tramp-make-tramp-file-name
-       (tramp-file-name-method vec)
-       (tramp-file-name-user vec)
-       (tramp-file-name-host vec)
-       localname2)
-       (file-modes (tramp-make-tramp-file-name
-                   (tramp-file-name-method vec)
-                   (tramp-file-name-user vec)
-                   (tramp-file-name-host vec)
-                   localname1))))))
+            (buffer-name)))))
+
+       ;; We are on the local host.
+       ((or t1 t2)
+       (cond
+        ;; We can do it directly.
+        ((and (file-readable-p localname1)
+              (file-writable-p (file-name-directory localname2)))
+         (if (eq op 'copy)
+             (copy-file
+              localname1 localname2 ok-if-already-exists
+              keep-date preserve-uid-gid)
+           (rename-file localname1 localname2 ok-if-already-exists)))
+
+        ;; We can do it directly with `tramp-send-command'
+        ((and (file-readable-p (concat prefix localname1))
+              (file-writable-p
+               (file-name-directory (concat prefix localname2))))
+         (tramp-do-copy-or-rename-file-directly
+          op (concat prefix localname1) (concat prefix localname2)
+          ok-if-already-exists keep-date t)
+         ;; We must change the ownership to the local user.
+         (tramp-set-file-uid-gid
+          (concat prefix localname2)
+          (tramp-get-local-uid 'integer)
+          (tramp-get-local-gid 'integer)))
+
+        ;; We need a temporary file in between.
+        (t
+         ;; Create the temporary file.
+         (cond
+          (t1
+           (tramp-send-command
+            v (format
+               "%s %s %s" cmd
+               (tramp-shell-quote-argument localname1)
+               (tramp-shell-quote-argument tmpfile)))
+           ;; We must change the ownership as remote user.
+           (tramp-set-file-uid-gid
+            (concat prefix tmpfile)
+            (tramp-get-local-uid 'integer)
+            (tramp-get-local-gid 'integer)))
+          (t2
+           (if (eq op 'copy)
+               (copy-file
+                localname1 tmpfile ok-if-already-exists
+                keep-date preserve-uid-gid)
+             (rename-file localname1 tmpfile ok-if-already-exists))
+           ;; We must change the ownership as local user.
+           (tramp-set-file-uid-gid
+            tmpfile
+            (tramp-get-remote-uid v 'integer)
+            (tramp-get-remote-gid v 'integer))))
+
+         ;; Move the temporary file to its destination.
+         (cond
+          (t2
+           (tramp-send-command
+            v (format
+               "%s %s %s" cmd
+               (tramp-shell-quote-argument tmpfile)
+               (tramp-shell-quote-argument localname2))))
+          (t1
+           (if (eq op 'copy)
+               (copy-file
+                tmpfile localname2 ok-if-already-exists
+                keep-date preserve-uid-gid)
+             (rename-file tmpfile localname2 ok-if-already-exists))))
+
+         ;; Remove temporary file.
+         (when (eq op 'copy) (delete-file tmpfile))))))
+
+      ;; Set the time and mode. Mask possible errors.
+      ;; Won't be applied for 'rename.
+      (condition-case nil
+         (when (and keep-date (not preserve-uid-gid))
+           (set-file-times newname (nth 5 (file-attributes filename)))
+           (set-file-modes newname (file-modes filename)))
+       (error)))))
+
 
 (defun tramp-do-copy-or-rename-file-out-of-band (op filename newname keep-date)
   "Invoke rcp program to copy.
@@ -3669,22 +3792,17 @@
   (with-parsed-tramp-file-name filename nil
     (let ((rem-enc (tramp-get-remote-coding v "remote-encoding"))
          (loc-dec (tramp-get-local-coding v "local-decoding"))
-         tmpfil)
+         (tmpfil (tramp-make-temp-file filename)))
       (unless (file-exists-p filename)
        (tramp-error
         v 'file-error
         "Cannot make local copy of non-existing file `%s'" filename))
-      (setq tmpfil (tramp-make-temp-file filename))
 
       (cond
-       ;; Fast track on local machine.
-       ((tramp-local-host-p v)
-       (tramp-do-copy-or-rename-file-directly 'copy v localname tmpfil t)
-       (tramp-send-command v (format "chown %s %s" (user-login-name) tmpfil)))
-
-       ;; `copy-file' handles out-of-band methods.
-       ((and (tramp-method-out-of-band-p v)
-            (> (nth 7 (file-attributes filename)) tramp-copy-size-limit))
+       ;; `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)) tramp-copy-size-limit)))
        (copy-file filename tmpfil t t))
 
        ;; Use inline encoding for file transfer.
@@ -3723,7 +3841,9 @@
              (delete-file tmpfil2)))
          (tramp-message v 5 "Decoding remote file %s...done" filename)
          ;; Set proper permissions.
-         (set-file-modes tmpfil (file-modes filename))))
+         (set-file-modes tmpfil (file-modes filename))
+         ;; Set local user ownership.
+         (tramp-set-file-uid-gid tmpfil)))
 
        ;; Oops, I don't know what to do.
        (t (tramp-error
@@ -3743,6 +3863,7 @@
            ((eq identification 'method) method)
            ((eq identification 'user) user)
            ((eq identification 'host) host)
+           ((eq identification 'localname) localname)
            (t (tramp-make-tramp-file-name method user host "")))))))
 
 (defun tramp-handle-insert-file-contents
@@ -3750,7 +3871,9 @@
   "Like `insert-file-contents' for Tramp files."
   (barf-if-buffer-read-only)
   (setq filename (expand-file-name filename))
+  (let (coding-system-used result)
   (with-parsed-tramp-file-name filename nil
+
     (if (not (file-exists-p filename))
        (progn
          (when visit
@@ -3760,6 +3883,12 @@
          (tramp-error
           v 'file-error "File %s not found on remote host" filename)
          (list (expand-file-name filename) 0))
+
+       (if (and (tramp-local-host-p v)
+                (file-readable-p localname))
+           ;; Short track: if we are on the local host, we can run directly.
+         (insert-file-contents localname visit beg end replace)
+
       ;; `insert-file-contents-literally' takes care to avoid calling
       ;; jka-compr.  By let-binding inhibit-file-name-operation, we
       ;; propagate that care to the file-local-copy operation.
@@ -3768,25 +3897,25 @@
                    (when (eq inhibit-file-name-operation
                              'insert-file-contents)
                      'file-local-copy)))
-              (file-local-copy filename)))
-           coding-system-used result)
+                  (file-local-copy filename))))
        (tramp-message v 4 "Inserting local temp file `%s'..." local-copy)
        (setq result (insert-file-contents local-copy nil beg end replace))
-       (when visit
-         (setq buffer-file-name filename)
-         (set-visited-file-modtime)
-         (set-buffer-modified-p nil))
        ;; Now `last-coding-system-used' has right value.  Remember it.
        (when (boundp 'last-coding-system-used)
          (setq coding-system-used (symbol-value 'last-coding-system-used)))
        (tramp-message v 4 "Inserting local temp file `%s'...done" local-copy)
        (delete-file local-copy)
        (when (boundp 'last-coding-system-used)
-         (set 'last-coding-system-used coding-system-used))
+             (set 'last-coding-system-used coding-system-used))))
+
+       (when visit
+         (setq buffer-read-only (file-writable-p filename))
+         (setq buffer-file-name filename)
+         (set-visited-file-modtime)
+         (set-buffer-modified-p nil))
        (list (expand-file-name filename)
              (cadr result))))))
 
-
 (defun tramp-handle-find-backup-file-name (filename)
   "Like `find-backup-file-name' for Tramp files."
   (with-parsed-tramp-file-name filename nil
@@ -3892,10 +4021,12 @@
     ;;              (string= lockname filename))
     ;;    (error
     ;;     "tramp-handle-write-region: LOCKNAME must be nil or equal 
FILENAME"))
+
     ;; XEmacs takes a coding system as the seventh argument, not `confirm'
     (when (and (not (featurep 'xemacs)) confirm (file-exists-p filename))
       (unless (y-or-n-p (format "File %s exists; overwrite anyway? " filename))
        (tramp-error v 'file-error "File not overwritten")))
+
     (let ((rem-dec (tramp-get-remote-coding v "remote-decoding"))
          (loc-enc (tramp-get-local-coding v "local-encoding"))
          (modes (save-excursion (file-modes filename)))
@@ -3910,6 +4041,15 @@
          ;; use an encoding function, but currently we use it always
          ;; because this makes the logic simpler.
          (tmpfil (tramp-make-temp-file filename)))
+
+      (if (and (tramp-local-host-p v)
+              (file-writable-p (file-name-directory localname)))
+         ;; Short track: if we are on the local host, we can run directly.
+         (if confirm
+             (write-region
+              start end localname append 'no-message lockname confirm)
+           (write-region start end localname append 'no-message lockname))
+
       ;; 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.
@@ -3933,15 +4073,12 @@
       ;; decoding command must be specified.  However, if the method
       ;; _also_ specifies an encoding function, then that is used for
       ;; encoding the contents of the tmp file.
-      (cond ;; Fast track on local machine.
-            ((tramp-local-host-p v)
-            (tramp-do-copy-or-rename-file-directly
-             'rename v tmpfil localname t))
-
-           ;; `copy-file' handles out-of-band methods
-           ((and (tramp-method-out-of-band-p v)
+       (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)
                  (integerp start)
-                 (> (- end start) tramp-copy-size-limit))
+                  (> (- end start) tramp-copy-size-limit)))
             (rename-file tmpfil filename t))
 
            ;; Use inline file transfer
@@ -3977,8 +4114,7 @@
                                       loc-enc tmpfil t))
                       (tramp-error
                        v 'file-error
-                       (concat "Cannot write to `%s', local encoding"
-                               " command `%s' failed")
+                    "Cannot write to `%s', local encoding command `%s' failed"
                        filename loc-enc)))
 
                   ;; Send buffer into remote decoding command which
@@ -3997,8 +4133,7 @@
                     (buffer-string)))
                   (tramp-barf-unless-okay
                    v nil
-                   (concat "Couldn't write region to `%s',"
-                           " decode using `%s' failed")
+                "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
@@ -4007,22 +4142,18 @@
                     (erase-buffer)
                     (and
                      ;; cksum runs locally
-                     (let ((default-directory
-                             (tramp-temporary-file-directory)))
+                  (let ((default-directory (tramp-temporary-file-directory)))
                        (zerop (call-process "cksum" tmpfil t)))
                      ;; cksum runs remotely
                      (zerop
                       (tramp-send-command-and-check
                        v
-                       (format
-                        "cksum <%s"
-                        (tramp-shell-quote-argument localname))))
+                    (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))))
+                    (with-current-buffer (tramp-get-buffer v) 
(buffer-string))))
                      (tramp-error
                       v 'file-error
                       (concat "Couldn't write region to `%s',"
@@ -4041,15 +4172,17 @@
              v 'file-error
              (concat "Method `%s' should specify both encoding and "
                      "decoding command or an rcp program")
-             method)))
+          method))))
 
       (when (or (eq visit t) (stringp visit))
        (set-visited-file-modtime
         ;; We must pass modtime explicitely, because filename can be different
         ;; from (buffer-file-name), f.e. if `file-precious-flag' is set.
         (nth 5 (file-attributes filename))))
+      ;; Set the ownership.
+      (tramp-set-file-uid-gid filename)
       ;; Make `last-coding-system-used' have the right value.
-      (when (boundp 'last-coding-system-used)
+      (when coding-system-used
        (set 'last-coding-system-used coding-system-used))
       (when (or (eq visit t) (null visit) (stringp visit))
        (tramp-message v 0 "Wrote %s" filename))
@@ -5917,6 +6050,7 @@
       (let* ((target-alist (tramp-compute-multi-hops vec))
             (process-environment (copy-sequence process-environment))
             (process-connection-type tramp-process-connection-type)
+            (process-adaptive-read-buffering nil)
             (coding-system-for-read nil)
             ;; This must be done in order to avoid our file name handler.
             (p (let ((default-directory (tramp-temporary-file-directory)))
@@ -6705,6 +6839,12 @@
       ;; The command might not always return a number.
       (if (and (equal id-format 'integer) (not (integerp res))) -1 res))))
 
+(defun tramp-get-local-uid (id-format)
+  (if (equal id-format 'integer) (user-uid) (user-login-name)))
+
+(defun tramp-get-local-gid (id-format)
+  (nth 3 (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