1 new commit in tramp:
https://bitbucket.org/xemacs/tramp/commits/cd01316d8d7f/
Changeset: cd01316d8d7f
User: albinus
Date: 2014-04-07 10:47:25
Summary: Sync with Tramp 2.2.9.
Affected #: 25 files
diff -r 0892454ab2fe330753b0ca75f59150149b6bee99 -r cd01316d8d7f917cc9b433656c56eafef4729ce5 ChangeLog
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,7 @@
+2014-04-07 Michael Albinus <[email protected]>
+
+ * Makefile (AUTHOR_VERSION): Bump to 2.2.9.
+
2013-10-04 Norbert Koch <[email protected]>
* Makefile (VERSION): XEmacs package 1.46 released.
diff -r 0892454ab2fe330753b0ca75f59150149b6bee99 -r cd01316d8d7f917cc9b433656c56eafef4729ce5 ChangeLog.upstream
--- a/ChangeLog.upstream
+++ b/ChangeLog.upstream
@@ -1,3 +1,31 @@
+2014-02-16 Michael Albinus <[email protected]>
+
+ Version 2.2.9 released.
+
+ * Makefile.in (XEMACS_FILES): Remove test/*.el.
+ (check): New target.
+ (.PHONY): Add check.
+ (clean): No special handling of test directory.
+ (tags): Add test/*.el.
+
+ * configure.ac: Bump version.
+
+2013-11-07 Michael Albinus <[email protected]>
+
+ * configure.ac (TRAMP_CLEAN_FILES):
+ * Makefile.in (clean, distclean): Add "test" directory.
+
+ * README (Subdirectories): Add "obsolete" directory.
+
+2013-10-08 Michael Albinus <[email protected]>
+
+ * Makefile.XEmacs, package-info.in: Remove.
+
+2013-10-07 Michael Albinus <[email protected]>
+
+ * configure.ac: Bump version (to 2.2.9-pre). Update merge
+ version to 2.2.8.
+
2013-10-02 Michael Albinus <[email protected]>
Version 2.2.8 released.
diff -r 0892454ab2fe330753b0ca75f59150149b6bee99 -r cd01316d8d7f917cc9b433656c56eafef4729ce5 Makefile
--- a/Makefile
+++ b/Makefile
@@ -18,7 +18,7 @@
# Boston, MA 02111-1307, USA.
VERSION = 1.46
-AUTHOR_VERSION = 2.2.8
+AUTHOR_VERSION = 2.2.9
MAINTAINER = Michael Albinus <[email protected]>
PACKAGE = tramp
PKG_TYPE = regular
diff -r 0892454ab2fe330753b0ca75f59150149b6bee99 -r cd01316d8d7f917cc9b433656c56eafef4729ce5 README
--- a/README
+++ b/README
@@ -26,17 +26,4 @@
test Some Lisp files to test Tramp.
texi The documentation.
-
-
-Getting Tramp2:
----------------
-The experimental Tramp2 code is not included in the XEmacs package. To
-get hold of it, just grab it from CVS:
-
- cvs -d :pserver:[email protected]:/cvsroot/tramp co tramp
-
-You'll find the Tramp2 code in the 'tramp2' subdirectory. But be warned,
-this is experimental code. More likely than not, it probably won't run,
-and probably will break things. Use at your own risk.
-
Kai Grossjohann <[email protected]>
diff -r 0892454ab2fe330753b0ca75f59150149b6bee99 -r cd01316d8d7f917cc9b433656c56eafef4729ce5 lisp/ChangeLog
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,227 @@
+2014-02-16 Michael Albinus <[email protected]>
+
+ Version 2.2.9 released.
+
+2014-02-10 Michael Albinus <[email protected]>
+
+ * tramp-sh.el (tramp-sh-handle-vc-registered): Apply heredoc
+ script more robustly.
+
+2014-02-08 Michael Albinus <[email protected]>
+
+ * tramp-sh.el (tramp-sh-handle-start-file-process): Insert output
+ at end of buffer. (Bug#16120)
+
+2014-02-06 Michael Albinus <[email protected]>
+
+ * tramp-sh.el (tramp-sh-handle-start-file-process): Use "&&"
+ instead of ";" in order to avoid additional prompts. Let heredoc
+ scripts read from tty. (Bug#16582)
+ (tramp-send-command): No special handling of heredocs, it isn't
+ necessary anymore.
+
+2014-02-05 Michael Albinus <[email protected]>
+
+ * tramp-sh.el (tramp-end-of-heredoc): New defconst.
+ (tramp-sh-handle-set-file-acl)
+ (tramp-sh-handle-start-file-process)
+ (tramp-sh-handle-write-region, tramp-sh-handle-vc-registered)
+ (tramp-find-executable, tramp-send-command): Use it.
+
+2014-01-17 Michael Albinus <[email protected]>
+
+ * tramp.el (tramp-password-prompt-regexp): Use
+ `password-word-equivalents' if available.
+ (tramp-action-password, tramp-process-one-action)
+ (tramp-read-passwd): Let-bind `case-fold-search' to t. (Bug#13124)
+
+2013-12-06 Michael Albinus <[email protected]>
+
+ * tramp-sh.el (tramp-sh-handle-start-file-process): Handle long
+ command lines, lasting from "sh -c ...". (Bug#16045)
+
+2013-12-02 Michael Albinus <[email protected]>
+
+ * tramp-sh.el (tramp-remote-process-environment): Do not set "LC_ALL".
+ (tramp-get-remote-locale): New defun.
+ (tramp-open-connection-setup-interactive-shell): Use it.
+
+2013-11-26 Michael Albinus <[email protected]>
+
+ * tramp.el (tramp-file-name-regexp-unified): Support IPv6 host
+ names on MS Windows, like "/[::1]:".
+
+ * tramp-sh.el (tramp-sh-handle-insert-directory): Accept nil
+ SWITCHES.
+
+2013-11-25 Michael Albinus <[email protected]>
+
+ * tramp-cmds.el (tramp-cleanup-connection): Clean up
+ `tramp-current-connection' only when KEEP-PASSWORD is non-nil.
+
+2013-11-16 Michael Albinus <[email protected]>
+
+ * tramp-cmds.el (tramp-cleanup-connection): Clean up
+ `tramp-current-connection'.
+
+2013-11-15 Michael Albinus <[email protected]>
+
+ * tramp-sh.el (tramp-remote-process-environment): Set "LC_ALL" to
+ "en_US.utf8" and "LC_CTYPE" to "".
+ (tramp-maybe-open-connection): Set "LC_ALL" to "en_US.utf8".
+ (tramp-sh-handle-insert-directory): Don't set "LC_ALL" and "LC_CTYPE".
+
+2013-11-14 Michael Albinus <[email protected]>
+
+ * tramp-gvfs.el (top): Run init code only when
+ `tramp-gvfs-enabled' is not nil.
+ (tramp-gvfs-enabled): Check also :system bus.
+
+2013-11-13 Michael Albinus <[email protected]>
+
+ * tramp.el (tramp-remote-file-name-spec-regexp): An IPv6 address
+ can be empty.
+
+ * tramp-gvfs.el (tramp-gvfs-handle-insert-directory): Accept nil
+ SWITCHES.
+ (tramp-gvfs-handle-write-region): Implement APPEND.
+
+2013-11-11 Michael Albinus <[email protected]>
+
+ * tramp-sh.el (tramp-do-copy-or-rename-file-via-buffer)
+ (tramp-sh-handle-file-local-copy): Don't write a message when
+ saving temporary files.
+
+ * tramp-smb.el (tramp-smb-handle-copy-directory): Fix bug when
+ both directories are remote.
+ (tramp-smb-handle-directory-files): Do not return double entries.
+ Do not expand full file names.
+ (tramp-smb-handle-insert-directory): Accept nil SWITCHES.
+ (tramp-smb-handle-write-region): Implement APPEND.
+ (tramp-smb-get-stat-capability): Fix a stupid bug.
+
+2013-11-05 Michael Albinus <[email protected]>
+
+ Fix problems found while writing a test suite.
+
+ * tramp-compat.el (tramp-compat-load): New defun.
+ * tramp.el (tramp-handle-load): Use it.
+
+ * tramp-sh.el (tramp-sh-handle-add-name-to-file): Handle the case
+ "(numberp ok-if-already-exists)" correctly.
+
+2013-11-04 Michael Albinus <[email protected]>
+
+ Fix problems found while writing a test suite.
+
+ * tramp.el (tramp-file-name-regexp-unified): Simplify.
+ (tramp-file-name-for-operation): Use `tramp-tramp-file-p'.
+ (tramp-handle-substitute-in-file-name): Let-bind `process-environment'
+ to nil when running original file name handler. Otherwise,
+ there are problems with constructs like "$$FOO".
+
+ * tramp-sh.el (tramp-do-copy-or-rename-file): Use correct prefix
+ for `localname'.
+
+2013-10-28 Michael Albinus <[email protected]>
+
+ * tramp-sh.el (tramp-sh-handle-copy-directory):
+ * tramp-smb.el (tramp-smb-handle-copy-directory):
+ Handle COPY-CONTENTS. (Bug#15737)
+
+2013-10-18 Michael Albinus <[email protected]>
+
+ * tramp-smb.el (tramp-smb-maybe-open-connection): Fix an error
+ introduced on 2013-09-08, which results in an infinite loop
+ requesting a password.
+
+2013-10-17 Michael Albinus <[email protected]>
+
+ Code cleanup.
+
+ * tramp.el (tramp-debug-message): Do not check for connection buffer.
+ (tramp-message): Use "vector" connection property.
+ (tramp-rfn-eshadow-update-overlay, tramp-equal-remote)
+ (tramp-eshell-directory-change): Use `tramp-tramp-file-p' instead
+ of `file-remote-p'.
+ (tramp-connectable-p, tramp-handle-file-remote-p): Suppress
+ unrelated traces.
+
+ * tramp-adb.el (tramp-adb-handle-copy-file)
+ (tramp-adb-handle-rename-file): Use `tramp-tramp-file-p' instead
+ of `file-remote-p'.
+ (tramp-adb-maybe-open-connection): Set "vector" connection property.
+
+ * tramp-cache.el (top): Suppress traces when reading persistency file.
+
+ * tramp-cmds.el (tramp-list-remote-buffers)
+ (tramp-cleanup-connection, tramp-cleanup-this-connection): Use
+ `tramp-tramp-file-p' instead of `file-remote-p'.
+
+ * tramp-compat.el (tramp-compat-process-running-p): Use
+ `tramp-tramp-file-p' instead of `file-remote-p'.
+
+ * tramp-ftp.el (tramp-ftp-file-name-handler): Use
+ `tramp-tramp-file-p' instead of `file-remote-p'.
+
+ * tramp-gvfs.el (tramp-gvfs-handle-copy-file)
+ (tramp-gvfs-handle-rename-file): Use `tramp-tramp-file-p' instead
+ of `file-remote-p'.
+ (tramp-gvfs-handle-file-notify-add-watch): Set "vector" connection
+ property.
+
+ * tramp-gw.el (tramp-gw-gw-proc-sentinel)
+ (tramp-gw-aux-proc-sentinel, tramp-gw-process-filter)
+ (tramp-gw-open-network-stream): Suppress unrelated traces.
+
+ * tramp-sh.el (tramp-sh-handle-set-file-times)
+ (tramp-set-file-uid-gid): Use `tramp-tramp-file-p' instead of
+ `file-remote-p'.
+ (tramp-do-copy-or-rename-file-out-of-band): Set "vector"
+ connection property. Improve debug message.
+ (tramp-sh-handle-file-notify-add-watch): Refactor common code.
+ Set "vector" connection property. Improve debug message.
+ (tramp-maybe-open-connection): Do not request connection buffer
+ too early.
+
+ * tramp-smb.el (tramp-smb-actions-get-acl): New defconst, renamed
+ from `tramp-smb-actions-with-acl'.
+ (tramp-smb-actions-set-acl): New defconst.
+ (tramp-smb-handle-copy-directory)
+ (tramp-smb-maybe-open-connection): Set "vector" connection
+ property.
+ (tramp-smb-handle-copy-file, tramp-smb-handle-rename-file): Use
+ `tramp-tramp-file-p' instead of `file-remote-p'.
+ (tramp-smb-action-get-acl): New defun, renamed from
+ `tramp-smb-action-with-acl'.
+ (tramp-smb-action-set-acl): New defun.
+ (tramp-smb-handle-set-file-acl): Rewrite.
+ (tramp-smb-call-winexe): Do not request connection buffer
+ too early.
+
+2013-10-16 Michael Albinus <[email protected]>
+
+ * tramp-smb.el (tramp-smb-acl-program): New customer option.
+ (tramp-smb-errors): Add error messages.
+ (tramp-smb-actions-with-acl): New defconst.
+ (tramp-smb-file-name-handler-alist) [set-file-acl]: Add handler.
+ (tramp-smb-action-with-acl, tramp-smb-handle-set-file-acl): New defuns.
+ (tramp-smb-handle-file-acl): Rewrite, using "smbcacls".
+ (tramp-smb-handle-file-attributes): Simplify test for "stat" capability.
+ (tramp-smb-get-stat-capability): Fix tests.
+
+2013-10-07 Michael Albinus <[email protected]>
+
+ * tramp.el (tramp-handle-insert-file-contents): Improve handling
+ of BEG and END.
+
+ * tramp-gvfs.el (tramp-gvfs-file-name-handler-alist): Use
+ `tramp-handle-insert-file-contents'.
+ (tramp-gvfs-handle-insert-file-contents): Remove function.
+
+ * tramp-sh.el (tramp-sh-handle-insert-directory): Use
+ `save-restriction' in order to keep markers.
+
2013-10-02 Michael Albinus <[email protected]>
Version 2.2.8 released.
diff -r 0892454ab2fe330753b0ca75f59150149b6bee99 -r cd01316d8d7f917cc9b433656c56eafef4729ce5 lisp/tramp-adb.el
--- a/lisp/tramp-adb.el
+++ b/lisp/tramp-adb.el
@@ -1,6 +1,6 @@
;;; tramp-adb.el --- Functions for calling Android Debug Bridge from Tramp
-;; Copyright (C) 2011-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2014 Free Software Foundation, Inc.
;; Author: Juergen Hoetzel <[email protected]>
;; Keywords: comm, processes
@@ -662,7 +662,8 @@
(if (file-directory-p filename)
(tramp-file-name-handler 'copy-directory filename newname keep-date t)
(with-tramp-progress-reporter
- (tramp-dissect-file-name (if (file-remote-p filename) filename newname))
+ (tramp-dissect-file-name
+ (if (tramp-tramp-file-p filename) filename newname))
0 (format "Copying %s to %s" filename newname)
(let ((tmpfile (file-local-copy filename)))
@@ -704,7 +705,7 @@
newname (expand-file-name newname))
(with-parsed-tramp-file-name
- (if (file-remote-p filename) filename newname) nil
+ (if (tramp-tramp-file-p filename) filename newname) nil
(with-tramp-progress-reporter
v 0 (format "Renaming %s to %s" newname filename)
@@ -1134,6 +1135,7 @@
(tramp-adb-wait-for-output p 30)
(unless (eq 'run (process-status p))
(tramp-error vec 'file-error "Terminated!"))
+ (tramp-set-connection-property p "vector" vec)
(tramp-compat-set-process-query-on-exit-flag p nil)
;; Check whether the properties have been changed. If
diff -r 0892454ab2fe330753b0ca75f59150149b6bee99 -r cd01316d8d7f917cc9b433656c56eafef4729ce5 lisp/tramp-cache.el
--- a/lisp/tramp-cache.el
+++ b/lisp/tramp-cache.el
@@ -1,6 +1,6 @@
;;; tramp-cache.el --- file information caching for Tramp
-;; Copyright (C) 2000, 2005-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2005-2014 Free Software Foundation, Inc.
;; Author: Daniel Pittman <[email protected]>
;; Michael Albinus <[email protected]>
@@ -405,6 +405,7 @@
(with-temp-buffer
(insert-file-contents tramp-persistency-file-name)
(let ((list (read (current-buffer)))
+ (tramp-verbose 0)
element key item)
(while (setq element (pop list))
(setq key (pop element))
diff -r 0892454ab2fe330753b0ca75f59150149b6bee99 -r cd01316d8d7f917cc9b433656c56eafef4729ce5 lisp/tramp-cmds.el
--- a/lisp/tramp-cmds.el
+++ b/lisp/tramp-cmds.el
@@ -1,6 +1,6 @@
;;; tramp-cmds.el --- Interactive commands for Tramp
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2014 Free Software Foundation, Inc.
;; Author: Michael Albinus <[email protected]>
;; Keywords: comm, processes
@@ -48,10 +48,7 @@
nil
(mapcar
(lambda (x)
- (with-current-buffer x
- (when (and (stringp default-directory)
- (file-remote-p default-directory))
- x)))
+ (with-current-buffer x (when (tramp-tramp-file-p default-directory) x)))
(buffer-list))))
;;;###tramp-autoload
@@ -81,8 +78,7 @@
(completing-read
"Enter Tramp connection: " connections nil t
(try-completion "" connections)))
- (when (and name (file-remote-p name))
- (with-parsed-tramp-file-name name nil v))))
+ (and (tramp-tramp-file-p name) (tramp-dissect-file-name name))))
nil nil))
(if (not vec)
@@ -92,6 +88,11 @@
;; Flush password cache.
(unless keep-password (tramp-clear-passwd vec))
+ ;; Cleanup `tramp-current-connection'. Otherwise, we would be
+ ;; suppressed in the test suite. We use `keep-password' as
+ ;; indicator; it is not worth to add a new argument.
+ (when keep-password (setq tramp-current-connection nil))
+
;; Flush file cache.
(tramp-flush-directory-property vec "")
@@ -113,8 +114,7 @@
(defun tramp-cleanup-this-connection ()
"Flush all connection related objects of the current buffer's connection."
(interactive)
- (and (stringp default-directory)
- (file-remote-p default-directory)
+ (and (tramp-tramp-file-p default-directory)
(tramp-cleanup-connection
(tramp-dissect-file-name default-directory 'noexpand))))
diff -r 0892454ab2fe330753b0ca75f59150149b6bee99 -r cd01316d8d7f917cc9b433656c56eafef4729ce5 lisp/tramp-compat.el
--- a/lisp/tramp-compat.el
+++ b/lisp/tramp-compat.el
@@ -1,6 +1,6 @@
;;; tramp-compat.el --- Tramp compatibility functions
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2014 Free Software Foundation, Inc.
;; Author: Michael Albinus <[email protected]>
;; Keywords: comm, processes
@@ -416,6 +416,13 @@
directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")))
(delete-directory directory))))
+;; MUST-SUFFIX doesn't exist on XEmacs.
+(defun tramp-compat-load (file &optional noerror nomessage nosuffix must-suffix)
+ "Like `load' for Tramp files (compat function)."
+ (if must-suffix
+ (tramp-compat-funcall 'load file noerror nomessage nosuffix must-suffix)
+ (load file noerror nomessage nosuffix)))
+
;; `number-sequence' does not exist in XEmacs. Implementation is
;; taken from Emacs 23.
(defun tramp-compat-number-sequence (from &optional to inc)
@@ -471,7 +478,7 @@
;; Fallback, if there is no Lisp support yet.
(t (let ((default-directory
- (if (file-remote-p default-directory)
+ (if (tramp-tramp-file-p default-directory)
(tramp-compat-temporary-file-directory)
default-directory))
(unix95 (getenv "UNIX95"))
diff -r 0892454ab2fe330753b0ca75f59150149b6bee99 -r cd01316d8d7f917cc9b433656c56eafef4729ce5 lisp/tramp-efs.el
--- a/lisp/tramp-efs.el
+++ b/lisp/tramp-efs.el
@@ -1,6 +1,6 @@
;;; tramp-efs.el --- Make EFS a foreign method in Tramp
-;; Copyright (C) 2003-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2014 Free Software Foundation, Inc.
;; Author: Kai Großjohann <[email protected]>
;; Keywords: comm, processes
diff -r 0892454ab2fe330753b0ca75f59150149b6bee99 -r cd01316d8d7f917cc9b433656c56eafef4729ce5 lisp/tramp-sh.el
--- a/lisp/tramp-sh.el
+++ b/lisp/tramp-sh.el
@@ -1,6 +1,6 @@
;;; tramp-sh.el --- Tramp access functions for (s)sh-like connections
-;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2014 Free Software Foundation, Inc.
;; (copyright statements below in code to be updated with the above notice)
@@ -79,6 +79,9 @@
(defconst tramp-initial-end-of-output "#$ "
"Prompt when establishing a connection.")
+(defconst tramp-end-of-heredoc (md5 tramp-end-of-output)
+ "String used to recognize end of heredoc strings.")
+
;; Initialize `tramp-methods' with the supported methods.
;;;###tramp-autoload
(add-to-list 'tramp-methods
@@ -419,7 +422,7 @@
;;;###tramp-autoload
(defcustom tramp-remote-process-environment
- `("HISTFILE=$HOME/.tramp_history" "HISTSIZE=1" "TMOUT=0" "LC_ALL=C"
+ `("HISTFILE=$HOME/.tramp_history" "HISTSIZE=1" "TMOUT=0" "LC_CTYPE=''"
,(format "TERM=%s" tramp-terminal-type)
"EMACS=t" ;; Deprecated.
,(format "INSIDE_EMACS='%s,tramp:%s'" emacs-version tramp-version)
@@ -685,7 +688,7 @@
(defconst tramp-perl-encode
"%s -e '
# This script contributed by Juanma Barranquero <[email protected]>.
-# Copyright (C) 2002-2013 Free Software Foundation, Inc.
+# Copyright (C) 2002-2014 Free Software Foundation, Inc.
use strict;
my %%trans = do {
@@ -723,7 +726,7 @@
(defconst tramp-perl-decode
"%s -e '
# This script contributed by Juanma Barranquero <[email protected]>.
-# Copyright (C) 2002-2013 Free Software Foundation, Inc.
+# Copyright (C) 2002-2014 Free Software Foundation, Inc.
use strict;
my %%trans = do {
@@ -1300,7 +1303,7 @@
(defun tramp-sh-handle-set-file-times (filename &optional time)
"Like `set-file-times' for Tramp files."
- (if (file-remote-p filename)
+ (if (tramp-tramp-file-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)))
@@ -1339,7 +1342,7 @@
;; the majority of cases.
;; Don't modify `last-coding-system-used' by accident.
(let ((last-coding-system-used last-coding-system-used))
- (if (file-remote-p filename)
+ (if (tramp-tramp-file-p filename)
(with-parsed-tramp-file-name filename nil
(if (and (zerop (user-uid)) (tramp-local-host-p v))
;; If we are root on the local host, we can do it directly.
@@ -1443,8 +1446,11 @@
(if (and (stringp acl-string) (tramp-remote-acl-p v)
(progn
(tramp-send-command
- v (format "setfacl --set-file=- %s <<'EOF'\n%s\nEOF\n"
- (tramp-shell-quote-argument localname) acl-string))
+ v (format "setfacl --set-file=- %s <<'%s'\n%s\n%s\n"
+ (tramp-shell-quote-argument localname)
+ tramp-end-of-heredoc
+ acl-string
+ tramp-end-of-heredoc))
(tramp-send-command-and-check v nil)))
;; Success.
(progn
@@ -1784,21 +1790,21 @@
(with-parsed-tramp-file-name filename v1
(with-parsed-tramp-file-name newname v2
(let ((ln (when v1 (tramp-get-remote-ln v1))))
- (when (and (not ok-if-already-exists)
+ (when (and (numberp ok-if-already-exists)
(file-exists-p newname)
- (not (numberp ok-if-already-exists))
- (y-or-n-p
+ (yes-or-no-p
(format
"File %s already exists; make it a new name anyway? "
newname)))
(tramp-error
- v2 'file-error
- "add-name-to-file: file %s already exists" newname))
+ v2 'file-error "add-name-to-file: file %s already exists" newname))
+ (when ok-if-already-exists (setq ln (concat ln " -f")))
(tramp-flush-file-property v2 (file-name-directory v2-localname))
(tramp-flush-file-property v2 v2-localname)
(tramp-barf-unless-okay
v1
- (format "%s %s %s" ln (tramp-shell-quote-argument v1-localname)
+ (format "%s %s %s" ln
+ (tramp-shell-quote-argument v1-localname)
(tramp-shell-quote-argument v2-localname))
"error with add-name-to-file, see buffer `%s' for details"
(buffer-name))))))
@@ -1831,18 +1837,20 @@
'copy-file (list filename newname ok-if-already-exists keep-date)))))
(defun tramp-sh-handle-copy-directory
- (dirname newname &optional keep-date parents _copy-contents)
+ (dirname newname &optional keep-date parents copy-contents)
"Like `copy-directory' for Tramp files."
(let ((t1 (tramp-tramp-file-p dirname))
(t2 (tramp-tramp-file-p newname)))
(with-parsed-tramp-file-name (if t1 dirname newname) nil
- (if (and (tramp-get-method-parameter method 'tramp-copy-recursive)
+ (if (and (not copy-contents)
+ (tramp-get-method-parameter method 'tramp-copy-recursive)
;; When DIRNAME and NEWNAME are remote, they must have
;; the same method.
(or (null t1) (null t2)
(string-equal
(tramp-file-name-method (tramp-dissect-file-name dirname))
- (tramp-file-name-method (tramp-dissect-file-name newname)))))
+ (tramp-file-name-method
+ (tramp-dissect-file-name newname)))))
;; scp or rsync DTRT.
(progn
(setq dirname (directory-file-name (expand-file-name dirname))
@@ -1859,7 +1867,10 @@
'copy dirname newname keep-date))
;; We must do it file-wise.
(tramp-run-real-handler
- 'copy-directory (list dirname newname keep-date parents)))
+ 'copy-directory
+ (if copy-contents
+ (list dirname newname keep-date parents copy-contents)
+ (list dirname newname keep-date parents))))
;; When newname did exist, we have wrong cached values.
(when t2
@@ -1983,14 +1994,14 @@
;; In case of `rename', we must flush the cache of the source file.
(when (and t1 (eq op 'rename))
(with-parsed-tramp-file-name filename v1
- (tramp-flush-file-property v1 (file-name-directory localname))
- (tramp-flush-file-property v1 localname)))
+ (tramp-flush-file-property v1 (file-name-directory v1-localname))
+ (tramp-flush-file-property v1 v1-localname)))
;; When newname did exist, we have wrong cached values.
(when t2
(with-parsed-tramp-file-name newname v2
- (tramp-flush-file-property v2 (file-name-directory localname))
- (tramp-flush-file-property v2 localname)))))))
+ (tramp-flush-file-property v2 (file-name-directory v2-localname))
+ (tramp-flush-file-property v2 v2-localname)))))))
(defun tramp-do-copy-or-rename-file-via-buffer (op filename newname keep-date)
"Use an Emacs buffer to copy or rename a file.
@@ -2008,7 +2019,7 @@
;; `jka-compr-inhibit' to t.
(let ((coding-system-for-write 'binary)
(jka-compr-inhibit t))
- (write-region (point-min) (point-max) newname)))
+ (write-region (point-min) (point-max) newname nil 'no-message)))
;; KEEP-DATE handling.
(when keep-date (set-file-times newname (nth 5 (file-attributes filename))))
;; Set the mode.
@@ -2323,6 +2334,7 @@
(tramp-message
orig-vec 6 "%s"
(mapconcat 'identity (process-command p) " "))
+ (tramp-set-connection-property p "vector" orig-vec)
(tramp-compat-set-process-query-on-exit-flag p nil)
(tramp-process-actions
p v nil tramp-actions-copy-out-of-band)
@@ -2333,7 +2345,8 @@
(re-search-backward "tramp_exit_status [0-9]+" nil t)
(tramp-error
orig-vec 'file-error
- "Couldn't find exit status of `%s'" (process-command p)))
+ "Couldn't find exit status of `%s'"
+ (mapconcat 'identity (process-command p) " ")))
(skip-chars-forward "^ ")
(unless (zerop (read (current-buffer)))
(forward-line -1)
@@ -2485,6 +2498,7 @@
(filename switches &optional wildcard full-directory-p)
"Like `insert-directory' for Tramp files."
(setq filename (expand-file-name filename))
+ (unless switches (setq switches ""))
(with-parsed-tramp-file-name filename nil
(if (and (featurep 'ls-lisp)
(not (symbol-value 'ls-lisp-use-insert-directory-program)))
@@ -2511,13 +2525,10 @@
(if full-directory-p "yes" "no"))
;; If `full-directory-p', we just say `ls -l FILENAME'.
;; Else we chdir to the parent directory, then say `ls -ld BASENAME'.
- ;; "--dired" returns byte positions. Therefore, the file names
- ;; must be encoded, which is guaranteed by "LC_ALL=en_US.utf8
- ;; LC_CTYPE=''".
(if full-directory-p
(tramp-send-command
v
- (format "env LC_ALL=en_US.utf8 LC_CTYPE='' %s %s %s 2>/dev/null"
+ (format "%s %s %s 2>/dev/null"
(tramp-get-ls-command v)
switches
(if wildcard
@@ -2533,7 +2544,7 @@
(tramp-run-real-handler 'file-name-directory (list localname))))
(tramp-send-command
v
- (format "env LC_ALL=en_US.utf8 LC_CTYPE='' %s %s %s 2>/dev/null"
+ (format "%s %s %s 2>/dev/null"
(tramp-get-ls-command v)
switches
(if (or wildcard
@@ -2544,61 +2555,64 @@
(tramp-shell-quote-argument
(tramp-run-real-handler
'file-name-nondirectory (list localname)))))))
- (let ((beg (point)))
- ;; We cannot use `insert-buffer-substring' because the Tramp
- ;; buffer changes its contents before insertion due to calling
- ;; `expand-file' and alike.
- (insert
- (with-current-buffer (tramp-get-buffer v)
- (buffer-string)))
-
- ;; Check for "--dired" output.
- (forward-line -2)
- (when (looking-at "//SUBDIRED//")
- (forward-line -1))
- (when (looking-at "//DIRED//\\s-+")
- (let ((databeg (match-end 0))
- (end (point-at-eol)))
- ;; Now read the numeric positions of file names.
- (goto-char databeg)
- (while (< (point) end)
- (let ((start (+ beg (read (current-buffer))))
- (end (+ beg (read (current-buffer)))))
- (if (memq (char-after end) '(?\n ?\ ))
- ;; End is followed by \n or by " -> ".
- (put-text-property start end 'dired-filename t))))))
- ;; Remove trailing lines.
- (goto-char (point-at-bol))
- (while (looking-at "//")
- (forward-line 1)
- (delete-region (match-beginning 0) (point)))
-
- ;; Some busyboxes are reluctant to discard colors.
- (unless (string-match "color" (tramp-get-connection-property v "ls" ""))
- (goto-char beg)
- (while (re-search-forward tramp-color-escape-sequence-regexp nil t)
- (replace-match "")))
-
- ;; Decode the output, it could be multibyte.
- (decode-coding-region
- beg (point-max)
- (or file-name-coding-system
- (and (boundp 'default-file-name-coding-system)
- (symbol-value 'default-file-name-coding-system))))
-
- ;; The inserted file could be from somewhere else.
- (when (and (not wildcard) (not full-directory-p))
- (goto-char (point-max))
- (when (file-symlink-p filename)
- (goto-char (search-backward "->" beg 'noerror)))
- (search-backward
- (if (zerop (length (file-name-nondirectory filename)))
- "."
- (file-name-nondirectory filename))
- beg 'noerror)
- (replace-match (file-relative-name filename) t))
-
- (goto-char (point-max))))))
+
+ (save-restriction
+ (let ((beg (point)))
+ (narrow-to-region (point) (point))
+ ;; We cannot use `insert-buffer-substring' because the Tramp
+ ;; buffer changes its contents before insertion due to calling
+ ;; `expand-file' and alike.
+ (insert
+ (with-current-buffer (tramp-get-buffer v)
+ (buffer-string)))
+
+ ;; Check for "--dired" output.
+ (forward-line -2)
+ (when (looking-at "//SUBDIRED//")
+ (forward-line -1))
+ (when (looking-at "//DIRED//\\s-+")
+ (let ((databeg (match-end 0))
+ (end (point-at-eol)))
+ ;; Now read the numeric positions of file names.
+ (goto-char databeg)
+ (while (< (point) end)
+ (let ((start (+ beg (read (current-buffer))))
+ (end (+ beg (read (current-buffer)))))
+ (if (memq (char-after end) '(?\n ?\ ))
+ ;; End is followed by \n or by " -> ".
+ (put-text-property start end 'dired-filename t))))))
+ ;; Remove trailing lines.
+ (goto-char (point-at-bol))
+ (while (looking-at "//")
+ (forward-line 1)
+ (delete-region (match-beginning 0) (point)))
+
+ ;; Some busyboxes are reluctant to discard colors.
+ (unless (string-match "color" (tramp-get-connection-property v "ls" ""))
+ (goto-char beg)
+ (while (re-search-forward tramp-color-escape-sequence-regexp nil t)
+ (replace-match "")))
+
+ ;; Decode the output, it could be multibyte.
+ (decode-coding-region
+ beg (point-max)
+ (or file-name-coding-system
+ (and (boundp 'default-file-name-coding-system)
+ (symbol-value 'default-file-name-coding-system))))
+
+ ;; The inserted file could be from somewhere else.
+ (when (and (not wildcard) (not full-directory-p))
+ (goto-char (point-max))
+ (when (file-symlink-p filename)
+ (goto-char (search-backward "->" beg 'noerror)))
+ (search-backward
+ (if (zerop (length (file-name-nondirectory filename)))
+ "."
+ (file-name-nondirectory filename))
+ beg 'noerror)
+ (replace-match (file-relative-name filename) t))
+
+ (goto-char (point-max)))))))
;; Canonicalization of file names.
@@ -2678,27 +2692,47 @@
(defun tramp-sh-handle-start-file-process (name buffer program &rest args)
"Like `start-file-process' for Tramp files."
(with-parsed-tramp-file-name default-directory nil
- ;; When PROGRAM is nil, we just provide a tty.
- (let ((command
- (when (stringp program)
- (format "cd %s; exec env PS1=%s %s"
- (tramp-shell-quote-argument localname)
- ;; Use a human-friendly prompt, for example for `shell'.
- (tramp-shell-quote-argument
- (format "%s %s"
- (file-remote-p default-directory)
- tramp-initial-end-of-output))
- (mapconcat 'tramp-shell-quote-argument
- (cons program args) " "))))
- (tramp-process-connection-type
- (or (null program) tramp-process-connection-type))
- (bmp (and (buffer-live-p buffer) (buffer-modified-p buffer)))
- (name1 name)
- (i 0)
- ;; We do not want to raise an error when
- ;; `start-file-process' has been started several time in
- ;; `eshell' and friends.
- (tramp-current-connection nil))
+ (let* (;; When PROGRAM matches "*sh", and the first arg is "-c",
+ ;; it might be that the arguments exceed the command line
+ ;; length. Therefore, we modify the command.
+ (heredoc (and (stringp program)
+ (string-match "sh$" program)
+ (string-equal "-c" (car args))
+ (= (length args) 2)))
+ ;; When PROGRAM is nil, we just provide a tty.
+ (args (if (not heredoc) args
+ (let ((i 250))
+ (while (and (< i (length (cadr args)))
+ (string-match " " (cadr args) i))
+ (setcdr
+ args
+ (list (replace-match " \\\\\n" nil nil (cadr args))))
+ (setq i (+ i 250))))
+ (cdr args)))
+ (command
+ (when (stringp program)
+ (format "cd %s && exec %s env PS1=%s %s"
+ (tramp-shell-quote-argument localname)
+ (if heredoc (format "<<'%s'" tramp-end-of-heredoc) "")
+ ;; Use a human-friendly prompt, for example for `shell'.
+ (tramp-shell-quote-argument
+ (format "%s %s"
+ (file-remote-p default-directory)
+ tramp-initial-end-of-output))
+ (if heredoc
+ (format "%s\n(\n%s\n) </dev/tty\n%s"
+ program (car args) tramp-end-of-heredoc)
+ (mapconcat 'tramp-shell-quote-argument
+ (cons program args) " ")))))
+ (tramp-process-connection-type
+ (or (null program) tramp-process-connection-type))
+ (bmp (and (buffer-live-p buffer) (buffer-modified-p buffer)))
+ (name1 name)
+ (i 0)
+ ;; We do not want to raise an error when
+ ;; `start-file-process' has been started several time in
+ ;; `eshell' and friends.
+ (tramp-current-connection nil))
(unless buffer
;; BUFFER can be nil. We use a temporary buffer.
@@ -2724,7 +2758,7 @@
;; `verify-visited-file-modtime'.
(let ((buffer-undo-list t)
(buffer-read-only nil)
- (mark (point)))
+ (mark (point-max)))
(clear-visited-file-modtime)
(narrow-to-region (point-max) (point-max))
;; We call `tramp-maybe-open-connection', in order
@@ -2922,7 +2956,8 @@
;; 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 nil 'no-message)))
;; If tramp-decoding-function is not defined for this
;; method, we invoke tramp-decoding-command instead.
@@ -2932,7 +2967,8 @@
(let (file-name-handler-alist
(coding-system-for-write 'binary))
(with-current-buffer (tramp-get-buffer v)
- (write-region (point-min) (point-max) tmpfile2)))
+ (write-region
+ (point-min) (point-max) tmpfile2 nil 'no-message)))
(unwind-protect
(tramp-call-local-coding-command
loc-dec tmpfile2 tmpfile)
@@ -3153,9 +3189,11 @@
(tramp-send-command
v
(format
- (concat rem-dec " <<'EOF'\n%sEOF")
+ (concat rem-dec " <<'%s'\n%s%s")
(tramp-shell-quote-argument localname)
- (buffer-string)))
+ tramp-end-of-heredoc
+ (buffer-string)
+ tramp-end-of-heredoc))
(tramp-barf-unless-okay
v nil
"Couldn't write region to `%s', decode using `%s' failed"
@@ -3270,13 +3308,24 @@
(dolist
(elt
- (tramp-send-command-and-read
- v
- (format
- "tramp_vc_registered_read_file_names <<'EOF'\n%s\nEOF\n"
- (mapconcat 'tramp-shell-quote-argument
- tramp-vc-registered-file-names
- "\n"))))
+ (ignore-errors
+ ;; We cannot use `tramp-send-command-and-read',
+ ;; because this does not cooperate well with
+ ;; heredoc documents.
+ (tramp-send-command
+ v
+ (format
+ "tramp_vc_registered_read_file_names <<'%s'\n%s\n%s\n"
+ tramp-end-of-heredoc
+ (mapconcat 'tramp-shell-quote-argument
+ tramp-vc-registered-file-names
+ "\n")
+ tramp-end-of-heredoc))
+ (tramp-send-command-and-check v nil)
+ (with-current-buffer (tramp-get-connection-buffer v)
+ ;; Read the expression.
+ (goto-char (point-min))
+ (read (current-buffer)))))
(tramp-set-file-property
v (car elt) (cadr elt) (cadr (cdr elt))))))
@@ -3339,14 +3388,12 @@
(setq file-name (expand-file-name file-name))
(with-parsed-tramp-file-name file-name nil
(let* ((default-directory (file-name-directory file-name))
- command events filter p)
+ command events filter p sequence)
(cond
;; gvfs-monitor-dir.
((setq command (tramp-get-remote-gvfs-monitor-dir v))
(setq filter 'tramp-sh-file-gvfs-monitor-dir-process-filter
- p (start-file-process
- "gvfs-monitor-dir" (generate-new-buffer " *gvfs-monitor-dir*")
- command localname)))
+ sequence `(,command ,localname)))
;; inotifywait.
((setq command (tramp-get-remote-inotifywait v))
(setq filter 'tramp-sh-file-inotifywait-process-filter
@@ -3356,18 +3403,27 @@
"create,modify,move,delete,attrib")
((memq 'change flags) "create,modify,move,delete")
((memq 'attribute-change flags) "attrib"))
- p (start-file-process
- "inotifywait" (generate-new-buffer " *inotifywait*")
- command "-mq" "-e" events localname)))
+ sequence `(,command "-mq" "-e" ,events ,localname)))
;; None.
(t (tramp-error
v 'file-notify-error
"No file notification program found on %s"
(file-remote-p file-name))))
+ ;; Start process.
+ (setq p (apply
+ 'start-file-process
+ (file-name-nondirectory command)
+ (generate-new-buffer
+ (format " *%s*" (file-name-nondirectory command)))
+ sequence))
;; Return the process object as watch-descriptor.
(if (not (processp p))
(tramp-error
- v 'file-notify-error "`%s' failed to start on remote host" command)
+ v 'file-notify-error
+ "`%s' failed to start on remote host"
+ (mapconcat 'identity sequence " "))
+ (tramp-message v 6 "Run `%s', %S" (mapconcat 'identity sequence " ") p)
+ (tramp-set-connection-property p "vector" v)
(tramp-compat-set-process-query-on-exit-flag p nil)
(set-process-filter p filter)
p))))
@@ -3544,9 +3600,12 @@
(format (concat "while read d; "
"do if test -x $d/%s -a -f $d/%s; "
"then echo tramp_executable $d/%s; "
- "break; fi; done <<'EOF'\n"
- "%s\nEOF")
- progname progname progname (mapconcat 'identity dirlist "\n")))
+ "break; fi; done <<'%s'\n"
+ "%s\n%s")
+ progname progname progname
+ tramp-end-of-heredoc
+ (mapconcat 'identity dirlist "\n")
+ tramp-end-of-heredoc))
(goto-char (point-max))
(when (search-backward "tramp_executable " nil t)
(skip-chars-forward "^ ")
@@ -3871,7 +3930,8 @@
;; Set the environment.
(tramp-message vec 5 "Setting default environment")
- (let ((env (copy-sequence tramp-remote-process-environment))
+ (let ((env (append `(,(tramp-get-remote-locale vec))
+ (copy-sequence tramp-remote-process-environment)))
unset item)
(while env
(setq item (tramp-compat-split-string (car env) "="))
@@ -4330,10 +4390,6 @@
(condition-case err
(unless (and p (processp p) (memq (process-status p) '(run open)))
- ;; We call `tramp-get-buffer' in order to get a debug buffer
- ;; for messages from the beginning.
- (tramp-get-buffer vec)
-
;; If `non-essential' is non-nil, don't reopen a new connection.
(when (and (boundp 'non-essential) (symbol-value 'non-essential))
(throw 'non-essential 'non-essential))
@@ -4354,7 +4410,7 @@
(when (and p (processp p))
(delete-process p))
(setenv "TERM" tramp-terminal-type)
- (setenv "LC_ALL" "C")
+ (setenv "LC_ALL" "en_US.utf8")
(setenv "PROMPT_COMMAND")
(setenv "PS1" tramp-initial-end-of-output)
(let* ((target-alist (tramp-compute-multi-hops vec))
@@ -4464,7 +4520,7 @@
tramp-current-user (or g-user l-user)
tramp-current-host (or g-host l-host))
- ;; Replace login-args place holders.
+ ;; Replace `login-args' place holders.
(setq
l-host (or l-host "")
l-user (or l-user "")
@@ -4524,14 +4580,6 @@
;; We mark the command string that it can be erased in the output buffer.
(tramp-set-connection-property p "check-remote-echo" t)
(setq command (format "%s%s%s" tramp-echo-mark command tramp-echo-mark)))
- ;; Some busyboxes tend to close the connection when we use the
- ;; following syntax for here-documents. This we cannot test; it
- ;; shall be set via `tramp-connection-properties'.
- (when (and (string-match "<<'EOF'" command)
- (not (tramp-get-connection-property vec "busybox" nil)))
- ;; Unset $PS1 when using here documents, in order to avoid
- ;; multiple prompts.
- (setq command (concat "(PS1= ; " command "\n)")))
;; Send the command.
(tramp-message vec 6 "%s" command)
(tramp-send-string vec command)
@@ -4813,6 +4861,21 @@
x))
remote-path)))))
+(defun tramp-get-remote-locale (vec)
+ (with-tramp-connection-property vec "locale"
+ (tramp-send-command vec "locale -a")
+ (let ((candidates '("en_US.utf8" "C.utf8" "C"))
+ locale)
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (while candidates
+ (goto-char (point-min))
+ (if (string-match (concat "^" (car candidates) "$") (buffer-string))
+ (setq locale (car candidates)
+ candidates nil)
+ (setq candidates (cdr candidates)))))
+ ;; Return value.
+ (when locale (format "LC_ALL=%s" locale)))))
+
(defun tramp-get-ls-command (vec)
(with-tramp-connection-property vec "ls"
(tramp-message vec 5 "Finding a suitable `ls' command")
diff -r 0892454ab2fe330753b0ca75f59150149b6bee99 -r cd01316d8d7f917cc9b433656c56eafef4729ce5 lisp/tramp-smb.el
--- a/lisp/tramp-smb.el
+++ b/lisp/tramp-smb.el
@@ -1,6 +1,6 @@
;;; tramp-smb.el --- Tramp access functions for SMB servers
-;; Copyright (C) 2002-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2014 Free Software Foundation, Inc.
;; Author: Michael Albinus <[email protected]>
;; Keywords: comm, processes
@@ -75,6 +75,12 @@
:group 'tramp
:type 'string)
+(defcustom tramp-smb-acl-program "smbcacls"
+ "Name of SMB acls to run."
+:group 'tramp
+:type 'string
+:version "24.4")
+
(defcustom tramp-smb-conf "/dev/null"
"Path of the smb.conf file.
If it is nil, no smb.conf will be added to the `tramp-smb-program'
@@ -129,11 +135,14 @@
"NT_STATUS_DIRECTORY_NOT_EMPTY"
"NT_STATUS_DUPLICATE_NAME"
"NT_STATUS_FILE_IS_A_DIRECTORY"
+ "NT_STATUS_HOST_UNREACHABLE"
"NT_STATUS_IMAGE_ALREADY_LOADED"
+ "NT_STATUS_INVALID_LEVEL"
"NT_STATUS_IO_TIMEOUT"
"NT_STATUS_LOGON_FAILURE"
"NT_STATUS_NETWORK_ACCESS_DENIED"
"NT_STATUS_NOT_IMPLEMENTED"
+ "NT_STATUS_NO_LOGON_SERVERS"
"NT_STATUS_NO_SUCH_FILE"
"NT_STATUS_NO_SUCH_USER"
"NT_STATUS_OBJECT_NAME_COLLISION"
@@ -178,6 +187,26 @@
See `tramp-actions-before-shell' for more info.")
+(defconst tramp-smb-actions-get-acl
+ '((tramp-password-prompt-regexp tramp-action-password)
+ (tramp-wrong-passwd-regexp tramp-action-permission-denied)
+ (tramp-smb-errors tramp-action-permission-denied)
+ (tramp-process-alive-regexp tramp-smb-action-get-acl))
+ "List of pattern/action pairs.
+This list is used for smbcacls actions.
+
+See `tramp-actions-before-shell' for more info.")
+
+(defconst tramp-smb-actions-set-acl
+ '((tramp-password-prompt-regexp tramp-action-password)
+ (tramp-wrong-passwd-regexp tramp-action-permission-denied)
+ (tramp-smb-errors tramp-action-permission-denied)
+ (tramp-process-alive-regexp tramp-smb-action-set-acl))
+ "List of pattern/action pairs.
+This list is used for smbcacls actions.
+
+See `tramp-actions-before-shell' for more info.")
+
;; New handlers should be added here.
(defconst tramp-smb-file-name-handler-alist
'(;; `access-file' performed by default handler.
@@ -235,7 +264,7 @@
(make-symbolic-link . tramp-smb-handle-make-symbolic-link)
(process-file . tramp-smb-handle-process-file)
(rename-file . tramp-smb-handle-rename-file)
- (set-file-acl . ignore)
+ (set-file-acl . tramp-smb-handle-set-file-acl)
(set-file-modes . tramp-smb-handle-set-file-modes)
(set-file-selinux-context . ignore)
(set-file-times . ignore)
@@ -358,140 +387,152 @@
(throw 'tramp-action 'ok)))))
(defun tramp-smb-handle-copy-directory
- (dirname newname &optional keep-date parents _copy-contents)
+ (dirname newname &optional keep-date parents copy-contents)
"Like `copy-directory' for Tramp files."
- (setq dirname (expand-file-name dirname)
- newname (expand-file-name newname))
- (let ((t1 (tramp-tramp-file-p dirname))
- (t2 (tramp-tramp-file-p newname)))
- (with-parsed-tramp-file-name (if t1 dirname newname) nil
- (with-tramp-progress-reporter
- v 0 (format "Copying %s to %s" dirname newname)
- (cond
- ;; We must use a local temporary directory.
- ((and t1 t2)
- (let ((tmpdir
- (make-temp-name
- (expand-file-name
- tramp-temp-name-prefix
- (tramp-compat-temporary-file-directory)))))
- (unwind-protect
- (progn
- (tramp-compat-copy-directory dirname tmpdir keep-date parents)
- (tramp-compat-copy-directory tmpdir newname keep-date parents))
- (tramp-compat-delete-directory tmpdir 'recursive))))
+ (if copy-contents
+ ;; We must do it file-wise.
+ (tramp-run-real-handler
+ 'copy-directory (list dirname newname keep-date parents copy-contents))
- ;; We can copy recursively.
- ((or t1 t2)
- (when (and (file-directory-p newname)
- (not (string-equal (file-name-nondirectory dirname)
- (file-name-nondirectory newname))))
- (setq newname
- (expand-file-name
- (file-name-nondirectory dirname) newname))
- (if t2 (setq v (tramp-dissect-file-name newname))))
- (if (not (file-directory-p newname))
- (make-directory newname parents))
+ (setq dirname (expand-file-name dirname)
+ newname (expand-file-name newname))
+ (let ((t1 (tramp-tramp-file-p dirname))
+ (t2 (tramp-tramp-file-p newname)))
+ (with-parsed-tramp-file-name (if t1 dirname newname) nil
+ (with-tramp-progress-reporter
+ v 0 (format "Copying %s to %s" dirname newname)
+ (cond
+ ;; We must use a local temporary directory.
+ ((and t1 t2)
+ (let ((tmpdir
+ (make-temp-name
+ (expand-file-name
+ tramp-temp-name-prefix
+ (tramp-compat-temporary-file-directory)))))
+ (unwind-protect
+ (progn
+ (make-directory tmpdir)
+ (tramp-compat-copy-directory
+ dirname tmpdir keep-date 'parents)
+ (tramp-compat-copy-directory
+ (expand-file-name (file-name-nondirectory dirname) tmpdir)
+ newname keep-date parents))
+ (tramp-compat-delete-directory tmpdir 'recursive))))
- (setq tramp-current-method (tramp-file-name-method v)
- tramp-current-user (tramp-file-name-user v)
- tramp-current-host (tramp-file-name-real-host v))
+ ;; We can copy recursively.
+ ((or t1 t2)
+ (when (and (file-directory-p newname)
+ (not (string-equal (file-name-nondirectory dirname)
+ (file-name-nondirectory newname))))
+ (setq newname
+ (expand-file-name
+ (file-name-nondirectory dirname) newname))
+ (if t2 (setq v (tramp-dissect-file-name newname))))
+ (if (not (file-directory-p newname))
+ (make-directory newname parents))
- (let* ((real-user (tramp-file-name-real-user v))
- (real-host (tramp-file-name-real-host v))
- (domain (tramp-file-name-domain v))
- (port (tramp-file-name-port v))
- (share (tramp-smb-get-share v))
- (localname (file-name-as-directory
- (tramp-compat-replace-regexp-in-string
- "\\\\" "/" (tramp-smb-get-localname v))))
- (tmpdir (make-temp-name
- (expand-file-name
- tramp-temp-name-prefix
- (tramp-compat-temporary-file-directory))))
- (args (list tramp-smb-program
- (concat "//" real-host "/" share) "-E")))
+ (setq tramp-current-method (tramp-file-name-method v)
+ tramp-current-user (tramp-file-name-user v)
+ tramp-current-host (tramp-file-name-real-host v))
- (if (not (zerop (length real-user)))
- (setq args (append args (list "-U" real-user)))
- (setq args (append args (list "-N"))))
+ (let* ((real-user (tramp-file-name-real-user v))
+ (real-host (tramp-file-name-real-host v))
+ (domain (tramp-file-name-domain v))
+ (port (tramp-file-name-port v))
+ (share (tramp-smb-get-share v))
+ (localname (file-name-as-directory
+ (tramp-compat-replace-regexp-in-string
+ "\\\\" "/" (tramp-smb-get-localname v))))
+ (tmpdir (make-temp-name
+ (expand-file-name
+ tramp-temp-name-prefix
+ (tramp-compat-temporary-file-directory))))
+ (args (list tramp-smb-program
+ (concat "//" real-host "/" share) "-E")))
- (when domain (setq args (append args (list "-W" domain))))
- (when port (setq args (append args (list "-p" port))))
- (when tramp-smb-conf
- (setq args (append args (list "-s" tramp-smb-conf))))
- (setq args
- (if t1
- ;; Source is remote.
- (append args
- (list "-D" (shell-quote-argument localname)
- "-c" (shell-quote-argument "tar qc - *")
- "|" "tar" "xfC" "-"
- (shell-quote-argument tmpdir)))
- ;; Target is remote.
- (append (list "tar" "cfC" "-" (shell-quote-argument dirname)
- "." "|")
- args
- (list "-D" (shell-quote-argument localname)
- "-c" (shell-quote-argument "tar qx -")))))
+ (if (not (zerop (length real-user)))
+ (setq args (append args (list "-U" real-user)))
+ (setq args (append args (list "-N"))))
- (unwind-protect
- (with-temp-buffer
- ;; Set the transfer process properties.
- (tramp-set-connection-property
- v "process-name" (buffer-name (current-buffer)))
- (tramp-set-connection-property
- v "process-buffer" (current-buffer))
+ (when domain (setq args (append args (list "-W" domain))))
+ (when port (setq args (append args (list "-p" port))))
+ (when tramp-smb-conf
+ (setq args (append args (list "-s" tramp-smb-conf))))
+ (setq args
+ (if t1
+ ;; Source is remote.
+ (append args
+ (list "-D" (shell-quote-argument localname)
+ "-c" (shell-quote-argument "tar qc - *")
+ "|" "tar" "xfC" "-"
+ (shell-quote-argument tmpdir)))
+ ;; Target is remote.
+ (append (list "tar" "cfC" "-"
+ (shell-quote-argument dirname) "." "|")
+ args
+ (list "-D" (shell-quote-argument localname)
+ "-c" (shell-quote-argument "tar qx -")))))
- (when t1
- ;; The smbclient tar command creates always complete
- ;; paths. We must emulate the directory structure,
- ;; and symlink to the real target.
- (make-directory
- (expand-file-name ".." (concat tmpdir localname)) 'parents)
- (make-symbolic-link
- newname (directory-file-name (concat tmpdir localname))))
+ (unwind-protect
+ (with-temp-buffer
+ ;; Set the transfer process properties.
+ (tramp-set-connection-property
+ v "process-name" (buffer-name (current-buffer)))
+ (tramp-set-connection-property
+ v "process-buffer" (current-buffer))
- ;; Use an asynchronous processes. By this, password
- ;; can be handled.
- (let* ((default-directory tmpdir)
- (p (start-process-shell-command
- (tramp-get-connection-name v)
- (tramp-get-connection-buffer v)
- (mapconcat 'identity args " "))))
+ (when t1
+ ;; The smbclient tar command creates always
+ ;; complete paths. We must emulate the
+ ;; directory structure, and symlink to the real
+ ;; target.
+ (make-directory
+ (expand-file-name
+ ".." (concat tmpdir localname)) 'parents)
+ (make-symbolic-link
+ newname (directory-file-name (concat tmpdir localname))))
- (tramp-message
- v 6 "%s" (mapconcat 'identity (process-command p) " "))
- (tramp-compat-set-process-query-on-exit-flag p nil)
- (tramp-process-actions p v nil tramp-smb-actions-with-tar)
+ ;; Use an asynchronous processes. By this,
+ ;; password can be handled.
+ (let* ((default-directory tmpdir)
+ (p (start-process-shell-command
+ (tramp-get-connection-name v)
+ (tramp-get-connection-buffer v)
+ (mapconcat 'identity args " "))))
- (while (memq (process-status p) '(run open))
- (sit-for 0.1))
- (tramp-message v 6 "\n%s" (buffer-string))))
+ (tramp-message
+ v 6 "%s" (mapconcat 'identity (process-command p) " "))
+ (tramp-set-connection-property p "vector" v)
+ (tramp-compat-set-process-query-on-exit-flag p nil)
+ (tramp-process-actions p v nil tramp-smb-actions-with-tar)
- ;; Reset the transfer process properties.
- (tramp-set-connection-property v "process-name" nil)
- (tramp-set-connection-property v "process-buffer" nil)
- (when t1 (delete-directory tmpdir 'recurse))))
+ (while (memq (process-status p) '(run open))
+ (sit-for 0.1))
+ (tramp-message v 6 "\n%s" (buffer-string))))
- ;; Handle KEEP-DATE argument.
- (when keep-date
- (set-file-times newname (nth 5 (file-attributes dirname))))
+ ;; Reset the transfer process properties.
+ (tramp-set-connection-property v "process-name" nil)
+ (tramp-set-connection-property v "process-buffer" nil)
+ (when t1 (delete-directory tmpdir 'recurse))))
- ;; Set the mode.
- (unless keep-date
- (set-file-modes newname (tramp-default-file-modes dirname)))
+ ;; Handle KEEP-DATE argument.
+ (when keep-date
+ (set-file-times newname (nth 5 (file-attributes dirname))))
- ;; When newname did exist, we have wrong cached values.
- (when t2
- (with-parsed-tramp-file-name newname nil
- (tramp-flush-file-property v (file-name-directory localname))
- (tramp-flush-file-property v localname))))
+ ;; Set the mode.
+ (unless keep-date
+ (set-file-modes newname (tramp-default-file-modes dirname)))
- ;; We must do it file-wise.
- (t
- (tramp-run-real-handler
- 'copy-directory (list dirname newname keep-date parents))))))))
+ ;; When newname did exist, we have wrong cached values.
+ (when t2
+ (with-parsed-tramp-file-name newname nil
+ (tramp-flush-file-property v (file-name-directory localname))
+ (tramp-flush-file-property v localname))))
+
+ ;; We must do it file-wise.
+ (t
+ (tramp-run-real-handler
+ 'copy-directory (list dirname newname keep-date parents)))))))))
(defun tramp-smb-handle-copy-file
(filename newname &optional ok-if-already-exists keep-date
@@ -502,7 +543,8 @@
(setq filename (expand-file-name filename)
newname (expand-file-name newname))
(with-tramp-progress-reporter
- (tramp-dissect-file-name (if (file-remote-p filename) filename newname))
+ (tramp-dissect-file-name
+ (if (tramp-tramp-file-p filename) filename newname))
0 (format "Copying %s to %s" filename newname)
(if (file-directory-p filename)
@@ -600,7 +642,8 @@
(directory &optional full match nosort)
"Like `directory-files' for Tramp files."
(let ((result (mapcar 'directory-file-name
- (file-name-all-completions "" directory))))
+ (file-name-all-completions "" directory)))
+ res)
;; Discriminate with regexp.
(when match
(setq result
@@ -611,12 +654,13 @@
(when full
(setq result
(mapcar
- (lambda (x) (expand-file-name x directory))
+ (lambda (x) (format "%s/%s" directory x))
result)))
;; Sort them if necessary.
(unless nosort (setq result (sort result 'string-lessp)))
- ;; That's it.
- result))
+ ;; Remove double entries.
+ (dolist (elt result res)
+ (add-to-list 'res elt 'append))))
(defun tramp-smb-handle-expand-file-name (name &optional dir)
"Like `expand-file-name' for Tramp files."
@@ -648,22 +692,83 @@
method user host
(tramp-run-real-handler 'expand-file-name (list localname))))))
+(defun tramp-smb-action-get-acl (proc vec)
+ "Read ACL data from connection buffer."
+ (when (not (memq (process-status proc) '(run open)))
+ ;; Accept pending output.
+ (while (tramp-accept-process-output proc 0.1))
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ ;; There might be a hidden password prompt.
+ (widen)
+ (tramp-message vec 10 "\n%s" (buffer-string))
+ (goto-char (point-min))
+ (while (and (not (eobp)) (not (looking-at "^REVISION:")))
+ (forward-line)
+ (delete-region (point-min) (point)))
+ (while (and (not (eobp)) (looking-at "^.+:.+"))
+ (forward-line))
+ (delete-region (point) (point-max))
+ (throw 'tramp-action 'ok))))
+
(defun tramp-smb-handle-file-acl (filename)
"Like `file-acl' for Tramp files."
(with-parsed-tramp-file-name filename nil
(with-tramp-file-property v localname "file-acl"
- (when (tramp-smb-send-command
- v (format "getfacl \"%s\"" (tramp-smb-get-localname v)))
- (with-current-buffer (tramp-get-connection-buffer v)
- (goto-char (point-min))
- (while (looking-at "^#")
- (forward-line)
- (delete-region (point-min) (point)))
- (goto-char (point-max))
- (delete-blank-lines)
- (when (> (point-max) (point-min))
- (tramp-compat-funcall
- 'substring-no-properties (buffer-string))))))))
+ (when (executable-find tramp-smb-acl-program)
+
+ (setq tramp-current-method (tramp-file-name-method v)
+ tramp-current-user (tramp-file-name-user v)
+ tramp-current-host (tramp-file-name-real-host v))
+
+ (let* ((real-user (tramp-file-name-real-user v))
+ (real-host (tramp-file-name-real-host v))
+ (domain (tramp-file-name-domain v))
+ (port (tramp-file-name-port v))
+ (share (tramp-smb-get-share v))
+ (localname (tramp-compat-replace-regexp-in-string
+ "\\\\" "/" (tramp-smb-get-localname v)))
+ (args (list (concat "//" real-host "/" share) "-E")))
+
+ (if (not (zerop (length real-user)))
+ (setq args (append args (list "-U" real-user)))
+ (setq args (append args (list "-N"))))
+
+ (when domain (setq args (append args (list "-W" domain))))
+ (when port (setq args (append args (list "-p" port))))
+ (when tramp-smb-conf
+ (setq args (append args (list "-s" tramp-smb-conf))))
+ (setq
+ args
+ (append args (list (shell-quote-argument localname) "2>/dev/null")))
+
+ (unwind-protect
+ (with-temp-buffer
+ ;; Set the transfer process properties.
+ (tramp-set-connection-property
+ v "process-name" (buffer-name (current-buffer)))
+ (tramp-set-connection-property
+ v "process-buffer" (current-buffer))
+
+ ;; Use an asynchronous processes. By this, password
+ ;; can be handled.
+ (let ((p (apply
+ 'start-process
+ (tramp-get-connection-name v)
+ (tramp-get-connection-buffer v)
+ tramp-smb-acl-program args)))
+
+ (tramp-message
+ v 6 "%s" (mapconcat 'identity (process-command p) " "))
+ (tramp-set-connection-property p "vector" v)
+ (tramp-compat-set-process-query-on-exit-flag p nil)
+ (tramp-process-actions p v nil tramp-smb-actions-get-acl)
+ (when (> (point-max) (point-min))
+ (tramp-compat-funcall
+ 'substring-no-properties (buffer-string)))))
+
+ ;; Reset the transfer process properties.
+ (tramp-set-connection-property v "process-name" nil)
+ (tramp-set-connection-property v "process-buffer" nil)))))))
(defun tramp-smb-handle-file-attributes (filename &optional id-format)
"Like `file-attributes' for Tramp files."
@@ -672,7 +777,7 @@
(with-parsed-tramp-file-name filename nil
(with-tramp-file-property
v localname (format "file-attributes-%s" id-format)
- (if (and (tramp-smb-get-share v) (tramp-smb-get-stat-capability v))
+ (if (tramp-smb-get-stat-capability v)
(tramp-smb-do-file-attributes-with-stat v id-format)
;; Reading just the filename entry via "dir localname" is not
;; possible, because when filename is a directory, some
@@ -823,6 +928,7 @@
(filename switches &optional wildcard full-directory-p)
"Like `insert-directory' for Tramp files."
(setq filename (expand-file-name filename))
+ (unless switches (setq switches ""))
(if full-directory-p
;; Called from `dired-add-entry'.
(setq filename (file-name-as-directory filename))
@@ -1145,11 +1251,12 @@
(file-exists-p newname))
(tramp-error
(tramp-dissect-file-name
- (if (file-remote-p filename) filename newname))
+ (if (tramp-tramp-file-p filename) filename newname))
'file-already-exists newname))
(with-tramp-progress-reporter
- (tramp-dissect-file-name (if (file-remote-p filename) filename newname))
+ (tramp-dissect-file-name
+ (if (tramp-tramp-file-p filename) filename newname))
0 (format "Renaming %s to %s" filename newname)
(if (and (not (file-exists-p newname))
@@ -1180,6 +1287,86 @@
(tramp-compat-delete-directory filename 'recursive)
(delete-file filename)))))
+(defun tramp-smb-action-set-acl (proc vec)
+ "Read ACL data from connection buffer."
+ (when (not (memq (process-status proc) '(run open)))
+ ;; Accept pending output.
+ (while (tramp-accept-process-output proc 0.1))
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (tramp-message vec 10 "\n%s" (buffer-string))
+ (throw 'tramp-action 'ok))))
+
+(defun tramp-smb-handle-set-file-acl (filename acl-string)
+ "Like `set-file-acl' for Tramp files."
+ (ignore-errors
+ (with-parsed-tramp-file-name filename nil
+ (when (and (stringp acl-string) (executable-find tramp-smb-acl-program))
+ (setq tramp-current-method (tramp-file-name-method v)
+ tramp-current-user (tramp-file-name-user v)
+ tramp-current-host (tramp-file-name-real-host v))
+ (tramp-set-file-property v localname "file-acl" 'undef)
+
+ (let* ((real-user (tramp-file-name-real-user v))
+ (real-host (tramp-file-name-real-host v))
+ (domain (tramp-file-name-domain v))
+ (port (tramp-file-name-port v))
+ (share (tramp-smb-get-share v))
+ (localname (tramp-compat-replace-regexp-in-string
+ "\\\\" "/" (tramp-smb-get-localname v)))
+ (args (list (concat "//" real-host "/" share) "-E" "-S"
+ (tramp-compat-replace-regexp-in-string
+ "\n" "," acl-string))))
+
+ (if (not (zerop (length real-user)))
+ (setq args (append args (list "-U" real-user)))
+ (setq args (append args (list "-N"))))
+
+ (when domain (setq args (append args (list "-W" domain))))
+ (when port (setq args (append args (list "-p" port))))
+ (when tramp-smb-conf
+ (setq args (append args (list "-s" tramp-smb-conf))))
+ (setq
+ args
+ (append args (list (shell-quote-argument localname)
+ "&&" "echo" "tramp_exit_status" "0"
+ "||" "echo" "tramp_exit_status" "1")))
+
+ (unwind-protect
+ (with-temp-buffer
+ ;; Set the transfer process properties.
+ (tramp-set-connection-property
+ v "process-name" (buffer-name (current-buffer)))
+ (tramp-set-connection-property
+ v "process-buffer" (current-buffer))
+
+ ;; Use an asynchronous processes. By this, password can
+ ;; be handled.
+ (let ((p (apply
+ 'start-process-shell-command
+ (tramp-get-connection-name v)
+ (tramp-get-connection-buffer v)
+ tramp-smb-acl-program args)))
+
+ (tramp-message
+ v 6 "%s" (mapconcat 'identity (process-command p) " "))
+ (tramp-set-connection-property p "vector" v)
+ (tramp-compat-set-process-query-on-exit-flag p nil)
+ (tramp-process-actions p v nil tramp-smb-actions-set-acl)
+ (goto-char (point-max))
+ (unless (re-search-backward "tramp_exit_status [0-9]+" nil t)
+ (tramp-error
+ v 'file-error
+ "Couldn't find exit status of `%s'" tramp-smb-acl-program))
+ (skip-chars-forward "^ ")
+ (when (zerop (read (current-buffer)))
+ ;; Success.
+ (tramp-set-file-property v localname "file-acl" acl-string)
+ t)))
+
+ ;; Reset the transfer process properties.
+ (tramp-set-connection-property v "process-name" nil)
+ (tramp-set-connection-property v "process-buffer" nil)))))))
+
(defun tramp-smb-handle-set-file-modes (filename mode)
"Like `set-file-modes' for Tramp files."
(with-parsed-tramp-file-name filename nil
@@ -1259,9 +1446,6 @@
"Like `write-region' for Tramp files."
(setq filename (expand-file-name filename))
(with-parsed-tramp-file-name filename nil
- (unless (eq append nil)
- (tramp-error
- v 'file-error "Cannot append to file using Tramp (`%s')" filename))
;; XEmacs takes a coding system as the seventh argument, not `confirm'.
(when (and (not (featurep 'xemacs))
confirm (file-exists-p filename))
@@ -1274,6 +1458,8 @@
(tramp-flush-file-property v localname)
(let ((curbuf (current-buffer))
(tmpfile (tramp-compat-make-temp-file filename)))
+ (when (and append (file-exists-p filename))
+ (copy-file filename tmpfile 'ok))
;; 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.
@@ -1543,11 +1729,12 @@
(defun tramp-smb-get-stat-capability (vec)
"Check, whether the SMB server supports the STAT command."
;; When we are not logged in yet, we return nil.
- (if (let ((p (tramp-get-connection-process vec)))
- (and p (processp p) (memq (process-status p) '(run open))))
+ (if (and (tramp-smb-get-share vec)
+ (let ((p (tramp-get-connection-process vec)))
+ (and p (processp p) (memq (process-status p) '(run open)))))
(with-tramp-connection-property
(tramp-get-connection-process vec) "stat-capability"
- (tramp-smb-send-command vec "stat ."))))
+ (tramp-smb-send-command vec "stat \"/\""))))
;; Connection functions.
@@ -1676,6 +1863,7 @@
(tramp-message
vec 6 "%s" (mapconcat 'identity (process-command p) " "))
+ (tramp-set-connection-property p "vector" vec)
(tramp-compat-set-process-query-on-exit-flag p nil)
;; Set variables for computing the prompt for reading password.
@@ -1726,9 +1914,9 @@
(search-forward-regexp
tramp-smb-wrong-passwd-regexp nil t))
;; Disable `auth-source' and `password-cache'.
- (tramp-message
- vec 3 "Retry connection with new password")
(let (auth-sources)
+ (tramp-message
+ vec 3 "Retry connection with new password")
(tramp-cleanup-connection vec t)
(tramp-smb-maybe-open-connection vec argument))
;; Propagate the error.
@@ -1793,10 +1981,6 @@
(defun tramp-smb-call-winexe (vec)
"Apply a remote command, if possible, using `tramp-smb-winexe-program'."
- ;; We call `tramp-get-buffer' in order to get a debug buffer for
- ;; messages.
- (tramp-get-buffer vec)
-
;; Check for program.
(unless (executable-find tramp-smb-winexe-program)
(tramp-error
diff -r 0892454ab2fe330753b0ca75f59150149b6bee99 -r cd01316d8d7f917cc9b433656c56eafef4729ce5 lisp/tramp-uu.el
--- a/lisp/tramp-uu.el
+++ b/lisp/tramp-uu.el
@@ -1,6 +1,6 @@
;;; tramp-uu.el --- uuencode in Lisp
-;; Copyright (C) 2002-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2014 Free Software Foundation, Inc.
;; Author: Kai Großjohann <[email protected]>
;; Keywords: comm, terminals
This diff is so big that we needed to truncate the remainder.
Repository URL: https://bitbucket.org/xemacs/tramp/
--
This is a commit notification from bitbucket.org. You are receiving
this because you have the service enabled, addressing the recipient of
this email.
_______________________________________________
XEmacs-Patches mailing list
[email protected]
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
lmpx.com only provides a reader for public news (NNTP) servers. It is not
affiliated with the servers or forums shown here and is not responsible for
the content of articles, which is written by their respective authors.