X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/c71a0d48f3c880248a7f7f25e92ddbcbad5ef0e7..f99ced353f1e6d41f085d6325b0182ed2d644753:/lisp/net/tramp-smb.el?ds=sidebyside diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 5a62b71bda..b4bf10d471 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -1,6 +1,6 @@ ;;; tramp-smb.el --- Tramp access functions for SMB servers -;; Copyright (C) 2002-2011 Free Software Foundation, Inc. +;; Copyright (C) 2002-2013 Free Software Foundation, Inc. ;; Author: Michael Albinus ;; Keywords: comm, processes @@ -33,12 +33,20 @@ ;; Define SMB method ... ;;;###tramp-autoload (defconst tramp-smb-method "smb" - "*Method to connect SAMBA and M$ SMB servers.") + "Method to connect SAMBA and M$ SMB servers.") ;; ... and add it to the method list. ;;;###tramp-autoload (unless (memq system-type '(cygwin windows-nt)) - (add-to-list 'tramp-methods (cons tramp-smb-method nil))) + (add-to-list 'tramp-methods + `(,tramp-smb-method + ;; We define an empty command, because `tramp-smb-call-winexe' + ;; opens already the powershell. Used in `tramp-handle-shell-command'. + (tramp-remote-shell "") + ;; This is just a guess. We don't know whether the share "C$" + ;; is available for public use, and whether the user has write + ;; access. + (tramp-tmpdir "/C$/Temp")))) ;; Add a default for `tramp-default-method-alist'. Rule: If there is ;; a domain in USER, it must be the SMB method. @@ -53,27 +61,39 @@ `(,(concat "\\`" tramp-smb-method "\\'") nil nil)) ;; Add completion function for SMB method. -(tramp-set-completion-function - tramp-smb-method - '((tramp-parse-netrc "~/.netrc"))) +;;;###tramp-autoload +(eval-after-load 'tramp + '(tramp-set-completion-function + tramp-smb-method + '((tramp-parse-netrc "~/.netrc")))) (defcustom tramp-smb-program "smbclient" - "*Name of SMB client to run." + "Name of SMB client to run." :group 'tramp :type 'string) (defcustom tramp-smb-conf "/dev/null" - "*Path of the smb.conf file. + "Path of the smb.conf file. If it is nil, no smb.conf will be added to the `tramp-smb-program' call, letting the SMB client use the default one." :group 'tramp :type '(choice (const nil) (file :must-match t))) (defvar tramp-smb-version nil - "*Version string of the SMB client.") + "Version string of the SMB client.") + +(defconst tramp-smb-server-version + "Domain=\\[[^]]*\\] OS=\\[[^]]*\\] Server=\\[[^]]*\\]" + "Regexp of SMB server identification.") -(defconst tramp-smb-prompt "^smb: .+> \\|^\\s-+Server\\s-+Comment$" - "Regexp used as prompt in smbclient.") +(defconst tramp-smb-prompt "^\\(smb:\\|PS\\) .+> \\|^\\s-+Server\\s-+Comment$" + "Regexp used as prompt in smbclient or powershell.") + +(defconst tramp-smb-wrong-passwd-regexp + (regexp-opt + '("NT_STATUS_LOGON_FAILURE" + "NT_STATUS_WRONG_PASSWORD")) + "Regexp for login error strings of SMB servers.") (defconst tramp-smb-errors (mapconcat @@ -96,7 +116,8 @@ call, letting the SMB client use the default one." "ERRnomem" "ERRnosuchshare" ;; Windows 4.0 (Windows NT), Windows 5.0 (Windows 2000), - ;; Windows 5.1 (Windows XP), Windows 5.2 (Windows Server 2003). + ;; Windows 5.1 (Windows XP), Windows 5.2 (Windows Server 2003), + ;; Windows 6.0 (Windows Vista), Windows 6.1 (Windows 7). "NT_STATUS_ACCESS_DENIED" "NT_STATUS_ACCOUNT_LOCKED_OUT" "NT_STATUS_BAD_NETWORK_NAME" @@ -105,6 +126,7 @@ call, letting the SMB client use the default one." "NT_STATUS_DIRECTORY_NOT_EMPTY" "NT_STATUS_DUPLICATE_NAME" "NT_STATUS_FILE_IS_A_DIRECTORY" + "NT_STATUS_IMAGE_ALREADY_LOADED" "NT_STATUS_IO_TIMEOUT" "NT_STATUS_LOGON_FAILURE" "NT_STATUS_NETWORK_ACCESS_DENIED" @@ -143,6 +165,16 @@ This list is used for login to SMB servers. See `tramp-actions-before-shell' for more info.") +(defconst tramp-smb-actions-with-tar + '((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-with-tar)) + "List of pattern/action pairs. +This list is used for tar-like copy of directories. + +See `tramp-actions-before-shell' for more info.") + ;; New handlers should be added here. (defconst tramp-smb-file-name-handler-alist '( @@ -193,12 +225,14 @@ See `tramp-actions-before-shell' for more info.") (make-directory . tramp-smb-handle-make-directory) (make-directory-internal . tramp-smb-handle-make-directory-internal) (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-modes . tramp-smb-handle-set-file-modes) ;; `set-file-selinux-context' performed by default handler. (set-file-times . ignore) (set-visited-file-modtime . ignore) - (shell-command . ignore) + (shell-command . tramp-handle-shell-command) + (start-file-process . tramp-smb-handle-start-file-process) (substitute-in-file-name . tramp-smb-handle-substitute-in-file-name) (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory) (vc-registered . ignore) @@ -208,11 +242,34 @@ See `tramp-actions-before-shell' for more info.") "Alist of handler functions for Tramp SMB method. Operations not mentioned here will be handled by the default Emacs primitives.") +;; Options for remote processes via winexe. +(defcustom tramp-smb-winexe-program "winexe" + "Name of winexe client to run. +If it isn't found in the local $PATH, the absolute path of winexe +shall be given. This is needed for remote processes." + :group 'tramp + :type 'string + :version "24.3") + +(defcustom tramp-smb-winexe-shell-command "powershell.exe" + "Shell to be used for processes on remote machines. +This must be Powershell V2 compatible." + :group 'tramp + :type 'string + :version "24.3") + +(defcustom tramp-smb-winexe-shell-command-switch "-file -" + "Command switch used together with `tramp-smb-winexe-shell-command'. +This can be used to disable echo etc." + :group 'tramp + :type 'string + :version "24.3") + ;;;###tramp-autoload (defsubst tramp-smb-file-name-p (filename) "Check if it's a filename for SMB servers." - (let ((v (tramp-dissect-file-name filename))) - (string= (tramp-file-name-method v) tramp-smb-method))) + (string= (tramp-file-name-method (tramp-dissect-file-name filename)) + tramp-smb-method)) ;;;###tramp-autoload (defun tramp-smb-file-name-handler (operation &rest args) @@ -275,14 +332,31 @@ pass to the OPERATION." "error with add-name-to-file, see buffer `%s' for details" (buffer-name)))))) +(defun tramp-smb-action-with-tar (proc vec) + "Untar from connection buffer." + (if (not (memq (process-status proc) '(run open))) + (throw 'tramp-action 'process-died) + + (with-current-buffer (tramp-get-connection-buffer vec) + (goto-char (point-min)) + (when (search-forward-regexp tramp-smb-server-version nil t) + ;; There might be a hidden password prompt. + (widen) + (forward-line) + (tramp-message vec 6 (buffer-substring (point-min) (point))) + (delete-region (point-min) (point)) + (throw 'tramp-action 'ok))))) + (defun tramp-smb-handle-copy-directory - (dirname newname &optional keep-date parents) - "Like `copy-directory' for Tramp files. KEEP-DATE is not handled." + (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) @@ -299,87 +373,165 @@ pass to the OPERATION." ;; We can copy recursively. ((or t1 t2) - (let ((prompt (tramp-smb-send-command v "prompt")) - (recurse (tramp-smb-send-command v "recurse"))) - (unless (file-directory-p newname) + (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 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 (file-name-as-directory + (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"))) + + (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 + (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 -"))))) + (unwind-protect - (unless - (and - prompt recurse - (tramp-smb-send-command - v (format "cd \"%s\"" (tramp-smb-get-localname v))) - (tramp-smb-send-command - v (format "lcd \"%s\"" (if t1 newname dirname))) - (if t1 - (tramp-smb-send-command v "mget *") - (tramp-smb-send-command v "mput *"))) - ;; Error. - (with-current-buffer (tramp-get-connection-buffer v) - (goto-char (point-min)) - (search-forward-regexp tramp-smb-errors nil t) - (tramp-error - v 'file-error - "%s `%s'" (match-string 0) (if t1 dirname newname)))) - ;; Go home. - (tramp-smb-send-command - v (format - "cd %s" (if (tramp-smb-get-cifs-capabilities v) "/" "\\"))) - ;; Toggle prompt and recurse OFF. - (if prompt (tramp-smb-send-command v "prompt")) - (if recurse (tramp-smb-send-command v "recurse"))))) + (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 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)))) + + ;; 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 " ")))) + + (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) + + (while (memq (process-status p) '(run open)) + (sit-for 0.1)) + (tramp-message v 6 "\n%s" (buffer-string)))) + + ;; 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)))) + + ;; Handle KEEP-DATE argument. + (when keep-date + (set-file-times newname (nth 5 (file-attributes dirname)))) + + ;; Set the mode. + (unless keep-date + (set-file-modes newname (tramp-default-file-modes 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)))) ;; We must do it file-wise. (t (tramp-run-real-handler - 'copy-directory (list dirname newname keep-date parents))))))) + 'copy-directory (list dirname newname keep-date parents)))))))) (defun tramp-smb-handle-copy-file (filename newname &optional ok-if-already-exists keep-date preserve-uid-gid preserve-selinux-context) "Like `copy-file' for Tramp files. -KEEP-DATE is not handled in case NEWNAME resides on an SMB server. +KEEP-DATE has no effect in case NEWNAME resides on an SMB server. PRESERVE-UID-GID and PRESERVE-SELINUX-CONTEXT are completely ignored." (setq filename (expand-file-name filename) newname (expand-file-name newname)) - (with-progress-reporter + (with-tramp-progress-reporter (tramp-dissect-file-name (if (file-remote-p filename) filename newname)) 0 (format "Copying %s to %s" filename newname) - (let ((tmpfile (file-local-copy filename))) - - (if tmpfile - ;; Remote filename. - (condition-case err - (rename-file tmpfile newname ok-if-already-exists) - ((error quit) - (delete-file tmpfile) - (signal (car err) (cdr err)))) - - ;; Remote newname. - (when (file-directory-p newname) - (setq newname - (expand-file-name (file-name-nondirectory filename) newname))) - - (with-parsed-tramp-file-name newname nil - (when (and (not ok-if-already-exists) - (file-exists-p newname)) - (tramp-error v 'file-already-exists newname)) - - ;; We must also flush the cache of the directory, because - ;; `file-attributes' reads the values from there. - (tramp-flush-file-property v (file-name-directory localname)) - (tramp-flush-file-property v localname) - (unless (tramp-smb-get-share v) - (tramp-error - v 'file-error "Target `%s' must contain a share name" newname)) - (unless (tramp-smb-send-command - v (format "put \"%s\" \"%s\"" - filename (tramp-smb-get-localname v))) - (tramp-error v 'file-error "Cannot copy `%s'" filename)))))) + (if (file-directory-p filename) + (tramp-compat-copy-directory filename newname keep-date t t) + + (let ((tmpfile (file-local-copy filename))) + (if tmpfile + ;; Remote filename. + (condition-case err + (rename-file tmpfile newname ok-if-already-exists) + ((error quit) + (delete-file tmpfile) + (signal (car err) (cdr err)))) + + ;; Remote newname. + (when (file-directory-p newname) + (setq newname + (expand-file-name (file-name-nondirectory filename) newname))) + + (with-parsed-tramp-file-name newname nil + (when (and (not ok-if-already-exists) + (file-exists-p newname)) + (tramp-error v 'file-already-exists newname)) + + ;; We must also flush the cache of the directory, because + ;; `file-attributes' reads the values from there. + (tramp-flush-file-property v (file-name-directory localname)) + (tramp-flush-file-property v localname) + (unless (tramp-smb-get-share v) + (tramp-error + v 'file-error "Target `%s' must contain a share name" newname)) + (unless (tramp-smb-send-command + v (format "put \"%s\" \"%s\"" + filename (tramp-smb-get-localname v))) + (tramp-error v 'file-error "Cannot copy `%s'" filename)))))) - ;; KEEP-DATE handling. - (when keep-date (set-file-times newname (nth 5 (file-attributes filename))))) + ;; KEEP-DATE handling. + (when keep-date + (set-file-times newname (nth 5 (file-attributes filename)))))) (defun tramp-smb-handle-delete-directory (directory &optional recursive) "Like `delete-directory' for Tramp files." @@ -468,7 +620,7 @@ PRESERVE-UID-GID and PRESERVE-SELINUX-CONTEXT are completely ignored." ;; Dissect NAME. (with-parsed-tramp-file-name name nil ;; Tilde expansion if necessary. We use the user name as share, - ;; which is offen the case in domains. + ;; which is often the case in domains. (when (string-match "\\`/?~\\([^/]*\\)" localname) (setq localname (replace-match @@ -488,45 +640,47 @@ PRESERVE-UID-GID and PRESERVE-SELINUX-CONTEXT are completely ignored." (defun tramp-smb-handle-file-attributes (filename &optional id-format) "Like `file-attributes' for Tramp files." (unless id-format (setq id-format 'integer)) - (with-parsed-tramp-file-name filename nil - (with-file-property v localname (format "file-attributes-%s" id-format) - (if (and (tramp-smb-get-share v) (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 - ;; smbclient versions return the content of the directory, and - ;; other versions don't. Therefore, the whole content of the - ;; upper directory is retrieved, and the entry of the filename - ;; is extracted from. - (let* ((entries (tramp-smb-get-file-entries - (file-name-directory filename))) - (entry (assoc (file-name-nondirectory filename) entries)) - (uid (if (equal id-format 'string) "nobody" -1)) - (gid (if (equal id-format 'string) "nogroup" -1)) - (inode (tramp-get-inode v)) - (device (tramp-get-device v))) - - ;; Check result. - (when entry - (list (and (string-match "d" (nth 1 entry)) - t) ;0 file type - -1 ;1 link count - uid ;2 uid - gid ;3 gid - '(0 0) ;4 atime - (nth 3 entry) ;5 mtime - '(0 0) ;6 ctime - (nth 2 entry) ;7 size - (nth 1 entry) ;8 mode - nil ;9 gid weird - inode ;10 inode number - device))))))) ;11 file system number + (ignore-errors + (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)) + (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 + ;; smbclient versions return the content of the directory, and + ;; other versions don't. Therefore, the whole content of the + ;; upper directory is retrieved, and the entry of the filename + ;; is extracted from. + (let* ((entries (tramp-smb-get-file-entries + (file-name-directory filename))) + (entry (assoc (file-name-nondirectory filename) entries)) + (uid (if (equal id-format 'string) "nobody" -1)) + (gid (if (equal id-format 'string) "nogroup" -1)) + (inode (tramp-get-inode v)) + (device (tramp-get-device v))) + + ;; Check result. + (when entry + (list (and (string-match "d" (nth 1 entry)) + t) ;0 file type + -1 ;1 link count + uid ;2 uid + gid ;3 gid + '(0 0) ;4 atime + (nth 3 entry) ;5 mtime + '(0 0) ;6 ctime + (nth 2 entry) ;7 size + (nth 1 entry) ;8 mode + nil ;9 gid weird + inode ;10 inode number + device)))))))) ;11 file system number (defun tramp-smb-do-file-attributes-with-stat (vec &optional id-format) "Implement `file-attributes' for Tramp files using stat command." (tramp-message vec 5 "file attributes with stat: %s" (tramp-file-name-localname vec)) - (with-current-buffer (tramp-get-buffer vec) + (with-current-buffer (tramp-get-connection-buffer vec) (let* (size id link uid gid atime mtime ctime mode inode) (when (tramp-smb-send-command vec (format "stat \"%s\"" (tramp-smb-get-localname vec))) @@ -600,7 +754,7 @@ PRESERVE-UID-GID and PRESERVE-SELINUX-CONTEXT are completely ignored." v 'file-error "Cannot make local copy of non-existing file `%s'" filename)) (let ((tmpfile (tramp-compat-make-temp-file filename))) - (with-progress-reporter + (with-tramp-progress-reporter v 3 (format "Fetching %s to tmp file %s" filename tmpfile) (unless (tramp-smb-send-command v (format "get \"%s\" \"%s\"" @@ -618,7 +772,7 @@ PRESERVE-UID-GID and PRESERVE-SELINUX-CONTEXT are completely ignored." (all-completions filename (with-parsed-tramp-file-name directory nil - (with-file-property v localname "file-name-all-completions" + (with-tramp-file-property v localname "file-name-all-completions" (save-match-data (let ((entries (tramp-smb-get-file-entries directory))) (mapcar @@ -832,44 +986,170 @@ target of the symlink differ." "error with make-symbolic-link, see buffer `%s' for details" (buffer-name)))))) +(defun tramp-smb-handle-process-file + (program &optional infile destination display &rest args) + "Like `process-file' for Tramp files." + ;; The implementation is not complete yet. + (when (and (numberp destination) (zerop destination)) + (error "Implementation does not handle immediate return")) + + (with-parsed-tramp-file-name default-directory nil + (let* ((name (file-name-nondirectory program)) + (name1 name) + (i 0) + input tmpinput outbuf command ret) + + ;; Determine input. + (when infile + (setq infile (expand-file-name infile)) + (if (tramp-equal-remote default-directory infile) + ;; INFILE is on the same remote host. + (setq input (with-parsed-tramp-file-name infile nil localname)) + ;; INFILE must be copied to remote host. + (setq input (tramp-make-tramp-temp-file v) + tmpinput (tramp-make-tramp-file-name method user host input)) + (copy-file infile tmpinput t)) + ;; Transform input into a filename powershell does understand. + (setq input (format "//%s%s" host input))) + + ;; Determine output. + (cond + ;; Just a buffer. + ((bufferp destination) + (setq outbuf destination)) + ;; A buffer name. + ((stringp destination) + (setq outbuf (get-buffer-create destination))) + ;; (REAL-DESTINATION ERROR-DESTINATION) + ((consp destination) + ;; output. + (cond + ((bufferp (car destination)) + (setq outbuf (car destination))) + ((stringp (car destination)) + (setq outbuf (get-buffer-create (car destination)))) + ((car destination) + (setq outbuf (current-buffer)))) + ;; stderr. + (tramp-message v 2 "%s" "STDERR not supported")) + ;; 't + (destination + (setq outbuf (current-buffer)))) + + ;; Construct command. + (setq command (mapconcat 'identity (cons program args) " ") + command (if input + (format + "get-content %s | & %s" + (tramp-smb-shell-quote-argument input) command) + (format "& %s" command))) + + (while (get-process name1) + ;; NAME must be unique as process name. + (setq i (1+ i) + name1 (format "%s<%d>" name i))) + + ;; Set the new process properties. + (tramp-set-connection-property v "process-name" name1) + (tramp-set-connection-property + v "process-buffer" + (or outbuf (generate-new-buffer tramp-temp-buffer-name))) + + ;; Call it. + (condition-case nil + (with-current-buffer (tramp-get-connection-buffer v) + ;; Preserve buffer contents. + (narrow-to-region (point-max) (point-max)) + (tramp-smb-call-winexe v) + (when (tramp-smb-get-share v) + (tramp-smb-send-command + v (format "cd \"//%s%s\"" host (file-name-directory localname)))) + (tramp-smb-send-command v command) + ;; Preserve command output. + (narrow-to-region (point-max) (point-max)) + (let ((p (tramp-get-connection-process v))) + (tramp-smb-send-command v "exit $lasterrorcode") + (while (memq (process-status p) '(run open)) + (sleep-for 0.1) + (setq ret (process-exit-status p)))) + (delete-region (point-min) (point-max)) + (widen)) + + ;; When the user did interrupt, we should do it also. We use + ;; return code -1 as marker. + (quit + (setq ret -1)) + ;; Handle errors. + (error + (setq ret 1))) + + ;; We should show the output anyway. + (when (and outbuf display) (display-buffer outbuf)) + + ;; Cleanup. We remove all file cache values for the connection, + ;; because the remote process could have changed them. + (tramp-set-connection-property v "process-name" nil) + (tramp-set-connection-property v "process-buffer" nil) + (when tmpinput (delete-file tmpinput)) + (unless outbuf + (kill-buffer (tramp-get-connection-property v "process-buffer" nil))) + + ;; `process-file-side-effects' has been introduced with GNU + ;; Emacs 23.2. If set to `nil', no remote file will be changed + ;; by `program'. If it doesn't exist, we assume its default + ;; value `t'. + (unless (and (boundp 'process-file-side-effects) + (not (symbol-value 'process-file-side-effects))) + (tramp-flush-directory-property v "")) + + ;; Return exit status. + (if (equal ret -1) + (keyboard-quit) + ret)))) + (defun tramp-smb-handle-rename-file (filename newname &optional ok-if-already-exists) "Like `rename-file' for Tramp files." (setq filename (expand-file-name filename) newname (expand-file-name newname)) - (with-progress-reporter + + (when (and (not ok-if-already-exists) + (file-exists-p newname)) + (tramp-error + (tramp-dissect-file-name + (if (file-remote-p filename) filename newname)) + 'file-already-exists newname)) + + (with-tramp-progress-reporter (tramp-dissect-file-name (if (file-remote-p filename) filename newname)) 0 (format "Renaming %s to %s" filename newname) - (let ((tmpfile (file-local-copy filename))) - - (if tmpfile - ;; Remote filename. - (condition-case err - (rename-file tmpfile newname ok-if-already-exists) - ((error quit) - (delete-file tmpfile) - (signal (car err) (cdr err)))) - - ;; Remote newname. - (when (file-directory-p newname) - (setq newname (expand-file-name - (file-name-nondirectory filename) newname))) - - (with-parsed-tramp-file-name newname nil - (when (and (not ok-if-already-exists) - (file-exists-p newname)) - (tramp-error v 'file-already-exists newname)) - ;; We must also flush the cache of the directory, because - ;; `file-attributes' reads the values from there. - (tramp-flush-file-property v (file-name-directory localname)) - (tramp-flush-file-property v localname) - (unless (tramp-smb-send-command - v (format "put %s \"%s\"" - filename (tramp-smb-get-localname v))) - (tramp-error v 'file-error "Cannot rename `%s'" filename))))) + (if (and (tramp-equal-remote filename newname) + (string-equal + (tramp-smb-get-share (tramp-dissect-file-name filename)) + (tramp-smb-get-share (tramp-dissect-file-name newname)))) + ;; We can rename directly. + (with-parsed-tramp-file-name filename v1 + (with-parsed-tramp-file-name newname v2 + + ;; We must also flush the cache of the directory, because + ;; `file-attributes' reads the values from there. + (tramp-flush-file-property v2 (file-name-directory v2-localname)) + (tramp-flush-file-property v2 v2-localname) + (unless (tramp-smb-get-share v2) + (tramp-error + v2 'file-error "Target `%s' must contain a share name" newname)) + (unless (tramp-smb-send-command + v2 (format "rename \"%s\" \"%s\"" + (tramp-smb-get-localname v1) + (tramp-smb-get-localname v2))) + (tramp-error v2 'file-error "Cannot rename `%s'" filename)))) - (delete-file filename))) + ;; We must rename via copy. + (tramp-compat-copy-file filename newname ok-if-already-exists t t t) + (if (file-directory-p filename) + (tramp-compat-delete-directory filename 'recursive) + (delete-file filename))))) (defun tramp-smb-handle-set-file-modes (filename mode) "Like `set-file-modes' for Tramp files." @@ -883,6 +1163,54 @@ target of the symlink differ." (tramp-error v 'file-error "Error while changing file's mode %s" filename))))) +;; We use BUFFER also as connection buffer during setup. Because of +;; this, its original contents must be saved, and restored once +;; connection has been setup. +(defun tramp-smb-handle-start-file-process (name buffer program &rest args) + "Like `start-file-process' for Tramp files." + (with-parsed-tramp-file-name default-directory nil + (let ((command (mapconcat 'identity (cons program args) " ")) + (bmp (and (buffer-live-p buffer) (buffer-modified-p buffer))) + (name1 name) + (i 0)) + (unwind-protect + (save-excursion + (save-restriction + (unless buffer + ;; BUFFER can be nil. We use a temporary buffer. + (setq buffer (generate-new-buffer tramp-temp-buffer-name))) + (while (get-process name1) + ;; NAME must be unique as process name. + (setq i (1+ i) + name1 (format "%s<%d>" name i))) + ;; Set the new process properties. + (tramp-set-connection-property v "process-name" name1) + (tramp-set-connection-property v "process-buffer" buffer) + ;; Activate narrowing in order to save BUFFER contents. + (with-current-buffer (tramp-get-connection-buffer v) + (let ((buffer-undo-list t)) + (narrow-to-region (point-max) (point-max)) + (tramp-smb-call-winexe v) + (when (tramp-smb-get-share v) + (tramp-smb-send-command + v (format + "cd \"//%s%s\"" + host (file-name-directory localname)))) + (tramp-message v 6 "(%s); exit" command) + (tramp-send-string v command))) + ;; Return value. + (tramp-get-connection-process v))) + + ;; Save exit. + (with-current-buffer (tramp-get-connection-buffer v) + (if (string-match tramp-temp-buffer-name (buffer-name)) + (progn + (set-process-buffer (tramp-get-connection-process v) nil) + (kill-buffer (current-buffer))) + (set-buffer-modified-p bmp))) + (tramp-set-connection-property v "process-name" nil) + (tramp-set-connection-property v "process-buffer" nil))))) + (defun tramp-smb-handle-substitute-in-file-name (filename) "Like `handle-substitute-in-file-name' for Tramp files. \"//\" substitutes only in the local filename part. Catches @@ -926,7 +1254,7 @@ errors for shares like \"C$/\", which are common in Microsoft Windows." (list start end tmpfile append 'no-message lockname confirm) (list start end tmpfile append 'no-message lockname))) - (with-progress-reporter + (with-tramp-progress-reporter v 3 (format "Moving tmp file %s to %s" tmpfile filename) (unwind-protect (unless (tramp-smb-send-command @@ -960,7 +1288,7 @@ If VEC has no cifs capabilities, exchange \"/\" by \"\\\\\"." (setq localname (if (string-match "^/?[^/]+\\(/.*\\)" localname) - ;; There is a share, sparated by "/". + ;; There is a share, separated by "/". (if (not (tramp-smb-get-cifs-capabilities vec)) (mapconcat (lambda (x) (if (equal x ?/) "\\" (char-to-string x))) @@ -985,8 +1313,8 @@ Either the shares are listed, or the `dir' command is executed. Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)." (with-parsed-tramp-file-name (file-name-as-directory directory) nil (setq localname (or localname "/")) - (with-file-property v localname "file-entries" - (with-current-buffer (tramp-get-buffer v) + (with-tramp-file-property v localname "file-entries" + (with-current-buffer (tramp-get-connection-buffer v) (let* ((share (tramp-smb-get-share v)) (cache (tramp-get-connection-property v "share-cache" nil)) res entry) @@ -1170,11 +1498,11 @@ Result is the list (LOCALNAME MODE SIZE MTIME)." ;; 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)))) - (with-connection-property + (with-tramp-connection-property (tramp-get-connection-process vec) "cifs-capabilities" (save-match-data (when (tramp-smb-send-command vec "posix") - (with-current-buffer (tramp-get-buffer vec) + (with-current-buffer (tramp-get-connection-buffer vec) (goto-char (point-min)) (when (re-search-forward "Server supports CIFS capabilities" nil t) @@ -1188,7 +1516,7 @@ Result is the list (LOCALNAME MODE SIZE MTIME)." ;; 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)))) - (with-connection-property + (with-tramp-connection-property (tramp-get-connection-process vec) "stat-capability" (tramp-smb-send-command vec "stat .")))) @@ -1203,18 +1531,20 @@ Returns nil if there has been an error message from smbclient." (tramp-send-string vec command) (tramp-smb-wait-for-output vec)) -(defun tramp-smb-maybe-open-connection (vec) +(defun tramp-smb-maybe-open-connection (vec &optional argument) "Maybe open a connection to HOST, log in as USER, using `tramp-smb-program'. Does not do anything if a connection is already open, but re-opens the -connection if a previous connection has died for some reason." +connection if a previous connection has died for some reason. +If ARGUMENT is non-nil, use it as argument for +`tramp-smb-winexe-program', and suppress any checks." (let* ((share (tramp-smb-get-share vec)) - (buf (tramp-get-buffer vec)) + (buf (tramp-get-connection-buffer vec)) (p (get-buffer-process buf))) ;; Check whether we still have the same smbclient version. ;; Otherwise, we must delete the connection cache, because ;; capabilities migh have changed. - (unless (processp p) + (unless (or argument (processp p)) (let ((default-directory (tramp-compat-temporary-file-directory)) (command (concat tramp-smb-program " -V"))) @@ -1258,9 +1588,10 @@ connection if a previous connection has died for some reason." ;; Check whether it is still the same share. (unless (and p (processp p) (memq (process-status p) '(run open)) - (string-equal - share - (tramp-get-connection-property p "smb-share" ""))) + (or argument + (string-equal + share + (tramp-get-connection-property p "smb-share" "")))) (save-match-data ;; There might be unread output from checking for share names. @@ -1275,9 +1606,13 @@ connection if a previous connection has died for some reason." (port (tramp-file-name-port vec)) args) - (if share - (setq args (list (concat "//" real-host "/" share))) - (setq args (list "-g" "-L" real-host ))) + (cond + (argument + (setq args (list (concat "//" real-host)))) + (share + (setq args (list (concat "//" real-host "/" share)))) + (t + (setq args (list "-g" "-L" real-host )))) (if (not (zerop (length real-user))) (setq args (append args (list "-U" real-user))) @@ -1287,9 +1622,11 @@ connection if a previous connection has died for some reason." (when port (setq args (append args (list "-p" port)))) (when tramp-smb-conf (setq args (append args (list "-s" tramp-smb-conf)))) + (when argument + (setq args (append args (list argument)))) ;; OK, let's go. - (with-progress-reporter + (with-tramp-progress-reporter vec 3 (format "Opening connection for //%s%s/%s" (if (not (zerop (length user))) (concat user "@") "") @@ -1300,8 +1637,11 @@ connection if a previous connection has died for some reason." (p (let ((default-directory (tramp-compat-temporary-file-directory))) (apply #'start-process - (tramp-buffer-name vec) (tramp-get-buffer vec) - tramp-smb-program args)))) + (tramp-get-connection-name vec) + (tramp-get-connection-buffer vec) + (if argument + tramp-smb-winexe-program tramp-smb-program) + args)))) (tramp-message vec 6 "%s" (mapconcat 'identity (process-command p) " ")) @@ -1312,53 +1652,72 @@ connection if a previous connection has died for some reason." tramp-current-user user tramp-current-host host) - ;; Play login scenario. - (tramp-process-actions - p vec nil - (if share - tramp-smb-actions-with-share - tramp-smb-actions-without-share)) - - ;; Check server version. - (with-current-buffer (tramp-get-connection-buffer vec) - (goto-char (point-min)) - (search-forward-regexp - "Domain=\\[[^]]*\\] OS=\\[[^]]*\\] Server=\\[[^]]*\\]" nil t) - (let ((smbserver-version (match-string 0))) - (unless - (string-equal - smbserver-version - (tramp-get-connection-property - vec "smbserver-version" smbserver-version)) - (tramp-flush-directory-property vec "") - (tramp-flush-connection-property vec)) - (tramp-set-connection-property - vec "smbserver-version" smbserver-version))) - - ;; Set chunksize. Otherwise, `tramp-send-string' might - ;; try it itself. - (tramp-set-connection-property p "smb-share" share) - (tramp-set-connection-property - p "chunksize" tramp-chunksize)))))))) + (condition-case err + (let (tramp-message-show-message) + ;; Play login scenario. + (tramp-process-actions + p vec nil + (if (or argument share) + tramp-smb-actions-with-share + tramp-smb-actions-without-share)) + + ;; Check server version. + (unless argument + (with-current-buffer (tramp-get-connection-buffer vec) + (goto-char (point-min)) + (search-forward-regexp tramp-smb-server-version nil t) + (let ((smbserver-version (match-string 0))) + (unless + (string-equal + smbserver-version + (tramp-get-connection-property + vec "smbserver-version" smbserver-version)) + (tramp-flush-directory-property vec "") + (tramp-flush-connection-property vec)) + (tramp-set-connection-property + vec "smbserver-version" smbserver-version)))) + + ;; Set chunksize to 1. smbclient reads its input + ;; character by character; if we send the string + ;; at once, it is read painfully slow. + (tramp-set-connection-property p "smb-share" share) + (tramp-set-connection-property p "chunksize" 1)) + + ;; Check for the error reason. If it was due to wrong + ;; password, reestablish the connection. We cannot + ;; handle this in `tramp-process-actions', because + ;; smbclient does not ask for the password, again. + (error + (with-current-buffer (tramp-get-connection-buffer vec) + (goto-char (point-min)) + (if (search-forward-regexp + tramp-smb-wrong-passwd-regexp nil t) + ;; Disable `auth-source' and `password-cache'. + (let (auth-sources) + (tramp-cleanup vec) + (tramp-smb-maybe-open-connection vec argument)) + ;; Propagate the error. + (signal (car err) (cdr err))))))))))))) ;; We don't use timeouts. If needed, the caller shall wrap around. (defun tramp-smb-wait-for-output (vec) "Wait for output from smbclient command. Returns nil if an error message has appeared." - (with-current-buffer (tramp-get-buffer vec) + (with-current-buffer (tramp-get-connection-buffer vec) (let ((p (get-buffer-process (current-buffer))) (found (progn (goto-char (point-min)) (re-search-forward tramp-smb-prompt nil t))) (err (progn (goto-char (point-min)) - (re-search-forward tramp-smb-errors nil t)))) + (re-search-forward tramp-smb-errors nil t))) + buffer-read-only) ;; Algorithm: get waiting output. See if last line contains - ;; tramp-smb-prompt sentinel or tramp-smb-errors strings. + ;; `tramp-smb-prompt' sentinel or `tramp-smb-errors' strings. ;; If not, wait a bit and again get waiting output. - (while (and (not found) (not err)) + (while (and (not found) (not err) (memq (process-status p) '(run open))) ;; Accept pending output. - (tramp-accept-process-output p) + (tramp-accept-process-output p 0.1) ;; Search for prompt. (goto-char (point-min)) @@ -1372,16 +1731,74 @@ Returns nil if an error message has appeared." (while (and (not found) (memq (process-status p) '(run open))) ;; Accept pending output. - (tramp-accept-process-output p) + (tramp-accept-process-output p 0.1) ;; Search for prompt. (goto-char (point-min)) (setq found (re-search-forward tramp-smb-prompt nil t))) - ;; Return value is whether no error message has appeared. (tramp-message vec 6 "\n%s" (buffer-string)) + + ;; Remove prompt. + (when found + (goto-char (point-max)) + (re-search-backward tramp-smb-prompt nil t) + (delete-region (point) (point-max))) + + ;; Return value is whether no error message has appeared. (not err)))) +(defun tramp-smb-kill-winexe-function () + "Send SIGKILL to the winexe process." + (ignore-errors + (let ((p (get-buffer-process (current-buffer)))) + (when (and p (processp p) (memq (process-status p) '(run open))) + (signal-process (process-id p) 'SIGINT))))) + +(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 (let ((default-directory + (tramp-compat-temporary-file-directory))) + (executable-find tramp-smb-winexe-program)) + (tramp-error + vec 'file-error "Cannot find program: %s" tramp-smb-winexe-program)) + + ;; winexe does not supports ports. + (when (tramp-file-name-port vec) + (tramp-error vec 'file-error "Port not supported for remote processes")) + + (tramp-smb-maybe-open-connection + vec + (format + "%s %s" + tramp-smb-winexe-shell-command tramp-smb-winexe-shell-command-switch)) + + (set (make-local-variable 'kill-buffer-hook) + '(tramp-smb-kill-winexe-function)) + + ;; Suppress "^M". Shouldn't we specify utf8? + (set-process-coding-system (tramp-get-connection-process vec) 'raw-text-dos) + + ;; Set width to 128. This avoids mixing prompt and long error messages. + (tramp-smb-send-command vec "$rawui = (Get-Host).UI.RawUI") + (tramp-smb-send-command vec "$bufsize = $rawui.BufferSize") + (tramp-smb-send-command vec "$winsize = $rawui.WindowSize") + (tramp-smb-send-command vec "$bufsize.Width = 128") + (tramp-smb-send-command vec "$winsize.Width = 128") + (tramp-smb-send-command vec "$rawui.BufferSize = $bufsize") + (tramp-smb-send-command vec "$rawui.WindowSize = $winsize")) + +(defun tramp-smb-shell-quote-argument (s) + "Similar to `shell-quote-argument', but uses windows cmd syntax." + (let ((system-type 'ms-dos)) + (shell-quote-argument s))) + (add-hook 'tramp-unload-hook (lambda () (unload-feature 'tramp-smb 'force))) @@ -1390,13 +1807,9 @@ Returns nil if an error message has appeared." ;;; TODO: -;; * Error handling in case password is wrong. -;; * Read password from "~/.netrc". ;; * Return more comprehensive file permission string. ;; * Try to remove the inclusion of dummy "" directory. Seems to be at ;; several places, especially in `tramp-smb-handle-insert-directory'. -;; * (RMS) Use unwind-protect to clean up the state so as to make the state -;; regular again. -;; * Make it multi-hop capable. +;; * Ignore case in file names. ;;; tramp-smb.el ends here