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 <michael.albinus(a)gmx.de&gt; + + * Makefile (AUTHOR_VERSION): Bump to 2.2.9. + 2013-10-04 Norbert Koch <viteno(a)xemacs.org&gt; * 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 <michael.albinus(a)gmx.de&gt; + + 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 <michael.albinus(a)gmx.de&gt; + + * configure.ac (TRAMP_CLEAN_FILES): + * Makefile.in (clean, distclean): Add "test" directory. + + * README (Subdirectories): Add "obsolete" directory. + +2013-10-08 Michael Albinus <michael.albinus(a)gmx.de&gt; + + * Makefile.XEmacs, package-info.in: Remove. + +2013-10-07 Michael Albinus <michael.albinus(a)gmx.de&gt; + + * configure.ac: Bump version (to 2.2.9-pre). Update merge + version to 2.2.8. + 2013-10-02 Michael Albinus <michael.albinus(a)gmx.de&gt; 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 <michael.albinus(a)gmx.de&gt; 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:anonymous＠cvs.tramp.sf.net:/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 <Kai.Grossjohann(a)CS.Uni-Dortmund.DE&gt; diff -r 0892454ab2fe330753b0ca75f59150149b6bee99 -r cd01316d8d7f917cc9b433656c56eafef4729ce5 lisp/ChangeLog --- a/lisp/ChangeLog +++ b/lisp/ChangeLog ＠＠ -1,3 +1,227 ＠＠ +2014-02-16 Michael Albinus <michael.albinus(a)gmx.de&gt; + + Version 2.2.9 released. + +2014-02-10 Michael Albinus <michael.albinus(a)gmx.de&gt; + + * tramp-sh.el (tramp-sh-handle-vc-registered): Apply heredoc + script more robustly. + +2014-02-08 Michael Albinus <michael.albinus(a)gmx.de&gt; + + * tramp-sh.el (tramp-sh-handle-start-file-process): Insert output + at end of buffer. (Bug#16120) + +2014-02-06 Michael Albinus <michael.albinus(a)gmx.de&gt; + + * 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 <michael.albinus(a)gmx.de&gt; + + * 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 <michael.albinus(a)gmx.de&gt; + + * 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 <michael.albinus(a)gmx.de&gt; + + * tramp-sh.el (tramp-sh-handle-start-file-process): Handle long + command lines, lasting from "sh -c ...". (Bug#16045) + +2013-12-02 Michael Albinus <michael.albinus(a)gmx.de&gt; + + * 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 <michael.albinus(a)gmx.de&gt; + + * 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 <michael.albinus(a)gmx.de&gt; + + * tramp-cmds.el (tramp-cleanup-connection): Clean up + `tramp-current-connection' only when KEEP-PASSWORD is non-nil. + +2013-11-16 Michael Albinus <michael.albinus(a)gmx.de&gt; + + * tramp-cmds.el (tramp-cleanup-connection): Clean up + `tramp-current-connection'. + +2013-11-15 Michael Albinus <michael.albinus(a)gmx.de&gt; + + * 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 <michael.albinus(a)gmx.de&gt; + + * 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 <michael.albinus(a)gmx.de&gt; + + * 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 <michael.albinus(a)gmx.de&gt; + + * 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 <michael.albinus(a)gmx.de&gt; + + 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 <michael.albinus(a)gmx.de&gt; + + 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 <michael.albinus(a)gmx.de&gt; + + * 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 <michael.albinus(a)gmx.de&gt; + + * 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 <michael.albinus(a)gmx.de&gt; + + 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 <michael.albinus(a)gmx.de&gt; + + * 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 <michael.albinus(a)gmx.de&gt; + + * 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 <michael.albinus(a)gmx.de&gt; 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 <juergen(a)archlinux.org&gt; ;; 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 <daniel(a)inanna.danann.net&gt; ;; Michael Albinus <michael.albinus(a)gmx.de&gt; ＠＠ -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 <michael.albinus(a)gmx.de&gt; ;; 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 <michael.albinus(a)gmx.de&gt; ;; 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 <kai.grossjohann(a)gmx.net&gt; ;; 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 <lektu(a)terra.es&gt;. -# 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 <lektu(a)terra.es&gt;. -# 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 <michael.albinus(a)gmx.de&gt; ;; 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 <kai.grossjohann(a)gmx.net&gt; ;; 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 XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches