code.delx.au - gnu-emacs/blob - lisp/net/tramp-smb.el

   1 ;;; tramp-smb.el --- Tramp access functions for SMB servers
   2
   3 ;; Copyright (C) 2002-2013 Free Software Foundation, Inc.
   4
   5 ;; Author: Michael Albinus <michael.albinus@gmx.de>
   6 ;; Keywords: comm, processes
   7 ;; Package: tramp
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software: you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation, either version 3 of the License, or
  14 ;; (at your option) any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  23
  24 ;;; Commentary:
  25
  26 ;; Access functions for SMB servers like SAMBA or M$ Windows from Tramp.
  27
  28 ;;; Code:
  29
  30 (require 'tramp)
  31
  32 ;; Pacify byte-compiler.
  33 (eval-when-compile
  34   (require 'cl))
  35
  36 ;; Define SMB method ...
  37 ;;;###tramp-autoload
  38 (defconst tramp-smb-method "smb"
  39   "Method to connect SAMBA and M$ SMB servers.")
  40
  41 ;; ... and add it to the method list.
  42 ;;;###tramp-autoload
  43 (unless (memq system-type '(cygwin windows-nt))
  44   (add-to-list 'tramp-methods
  45     `(,tramp-smb-method
  46       ;; We define an empty command, because `tramp-smb-call-winexe'
  47       ;; opens already the powershell.  Used in `tramp-handle-shell-command'.
  48       (tramp-remote-shell "")
  49       ;; This is just a guess.  We don't know whether the share "C$"
  50       ;; is available for public use, and whether the user has write
  51       ;; access.
  52       (tramp-tmpdir "/C$/Temp"))))
  53
  54 ;; Add a default for `tramp-default-method-alist'. Rule: If there is
  55 ;; a domain in USER, it must be the SMB method.
  56 ;;;###tramp-autoload
  57 (add-to-list 'tramp-default-method-alist
  58              `(nil ,tramp-prefix-domain-regexp ,tramp-smb-method))
  59
  60 ;; Add a default for `tramp-default-user-alist'. Rule: For the SMB method,
  61 ;; the anonymous user is chosen.
  62 ;;;###tramp-autoload
  63 (add-to-list 'tramp-default-user-alist
  64              `(,(concat "\\`" tramp-smb-method "\\'") nil nil))
  65
  66 ;; Add completion function for SMB method.
  67 ;;;###tramp-autoload
  68 (eval-after-load 'tramp
  69   '(tramp-set-completion-function
  70     tramp-smb-method
  71     '((tramp-parse-netrc "~/.netrc"))))
  72
  73 (defcustom tramp-smb-program "smbclient"
  74   "Name of SMB client to run."
  75   :group 'tramp
  76   :type 'string)
  77
  78 (defcustom tramp-smb-conf "/dev/null"
  79   "Path of the smb.conf file.
  80 If it is nil, no smb.conf will be added to the `tramp-smb-program'
  81 call, letting the SMB client use the default one."
  82   :group 'tramp
  83   :type '(choice (const nil) (file :must-match t)))
  84
  85 (defvar tramp-smb-version nil
  86   "Version string of the SMB client.")
  87
  88 (defconst tramp-smb-server-version
  89   "Domain=\\[[^]]*\\] OS=\\[[^]]*\\] Server=\\[[^]]*\\]"
  90   "Regexp of SMB server identification.")
  91
  92 (defconst tramp-smb-prompt "^\\(smb:\\|PS\\) .+> \\|^\\s-+Server\\s-+Comment$"
  93   "Regexp used as prompt in smbclient or powershell.")
  94
  95 (defconst tramp-smb-wrong-passwd-regexp
  96   (regexp-opt
  97    '("NT_STATUS_LOGON_FAILURE"
  98      "NT_STATUS_WRONG_PASSWORD"))
  99   "Regexp for login error strings of SMB servers.")
 100
 101 (defconst tramp-smb-errors
 102   (mapconcat
 103    'identity
 104    `(;; Connection error / timeout / unknown command.
 105      "Connection\\( to \\S-+\\)? failed"
 106      "Read from server failed, maybe it closed the connection"
 107      "Call timed out: server did not respond"
 108      "\\S-+: command not found"
 109      "Server doesn't support UNIX CIFS calls"
 110      ,(regexp-opt
 111        '(;; Samba.
 112          "ERRDOS"
 113          "ERRHRD"
 114          "ERRSRV"
 115          "ERRbadfile"
 116          "ERRbadpw"
 117          "ERRfilexists"
 118          "ERRnoaccess"
 119          "ERRnomem"
 120          "ERRnosuchshare"
 121          ;; Windows 4.0 (Windows NT), Windows 5.0 (Windows 2000),
 122          ;; Windows 5.1 (Windows XP), Windows 5.2 (Windows Server 2003),
 123          ;; Windows 6.0 (Windows Vista), Windows 6.1 (Windows 7).
 124          "NT_STATUS_ACCESS_DENIED"
 125          "NT_STATUS_ACCOUNT_LOCKED_OUT"
 126          "NT_STATUS_BAD_NETWORK_NAME"
 127          "NT_STATUS_CANNOT_DELETE"
 128          "NT_STATUS_CONNECTION_REFUSED"
 129          "NT_STATUS_DIRECTORY_NOT_EMPTY"
 130          "NT_STATUS_DUPLICATE_NAME"
 131          "NT_STATUS_FILE_IS_A_DIRECTORY"
 132          "NT_STATUS_IMAGE_ALREADY_LOADED"
 133          "NT_STATUS_IO_TIMEOUT"
 134          "NT_STATUS_LOGON_FAILURE"
 135          "NT_STATUS_NETWORK_ACCESS_DENIED"
 136          "NT_STATUS_NOT_IMPLEMENTED"
 137          "NT_STATUS_NO_SUCH_FILE"
 138          "NT_STATUS_NO_SUCH_USER"
 139          "NT_STATUS_OBJECT_NAME_COLLISION"
 140          "NT_STATUS_OBJECT_NAME_INVALID"
 141          "NT_STATUS_OBJECT_NAME_NOT_FOUND"
 142          "NT_STATUS_SHARING_VIOLATION"
 143          "NT_STATUS_TRUSTED_RELATIONSHIP_FAILURE"
 144          "NT_STATUS_UNSUCCESSFUL"
 145          "NT_STATUS_WRONG_PASSWORD")))
 146    "\\|")
 147   "Regexp for possible error strings of SMB servers.
 148 Used instead of analyzing error codes of commands.")
 149
 150 (defconst tramp-smb-actions-with-share
 151   '((tramp-smb-prompt tramp-action-succeed)
 152     (tramp-password-prompt-regexp tramp-action-password)
 153     (tramp-wrong-passwd-regexp tramp-action-permission-denied)
 154     (tramp-smb-errors tramp-action-permission-denied)
 155     (tramp-process-alive-regexp tramp-action-process-alive))
 156   "List of pattern/action pairs.
 157 This list is used for login to SMB servers.
 158
 159 See `tramp-actions-before-shell' for more info.")
 160
 161 (defconst tramp-smb-actions-without-share
 162   '((tramp-password-prompt-regexp tramp-action-password)
 163     (tramp-wrong-passwd-regexp tramp-action-permission-denied)
 164     (tramp-smb-errors tramp-action-permission-denied)
 165     (tramp-process-alive-regexp tramp-action-out-of-band))
 166   "List of pattern/action pairs.
 167 This list is used for login to SMB servers.
 168
 169 See `tramp-actions-before-shell' for more info.")
 170
 171 (defconst tramp-smb-actions-with-tar
 172   '((tramp-password-prompt-regexp tramp-action-password)
 173     (tramp-wrong-passwd-regexp tramp-action-permission-denied)
 174     (tramp-smb-errors tramp-action-permission-denied)
 175     (tramp-process-alive-regexp tramp-smb-action-with-tar))
 176   "List of pattern/action pairs.
 177 This list is used for tar-like copy of directories.
 178
 179 See `tramp-actions-before-shell' for more info.")
 180
 181 ;; New handlers should be added here.
 182 (defconst tramp-smb-file-name-handler-alist
 183   '(;; `access-file' performed by default handler.
 184     (add-name-to-file . tramp-smb-handle-add-name-to-file)
 185     ;; `byte-compiler-base-file-name' performed by default handler.
 186     (copy-directory . tramp-smb-handle-copy-directory)
 187     (copy-file . tramp-smb-handle-copy-file)
 188     (delete-directory . tramp-smb-handle-delete-directory)
 189     (delete-file . tramp-smb-handle-delete-file)
 190     ;; `diff-latest-backup-file' performed by default handler.
 191     (directory-file-name . tramp-handle-directory-file-name)
 192     (directory-files . tramp-smb-handle-directory-files)
 193     (directory-files-and-attributes
 194      . tramp-handle-directory-files-and-attributes)
 195     (dired-call-process . ignore)
 196     (dired-compress-file . ignore)
 197     (dired-uncache . tramp-handle-dired-uncache)
 198     (expand-file-name . tramp-smb-handle-expand-file-name)
 199     (file-accessible-directory-p . tramp-smb-handle-file-directory-p)
 200     (file-acl . tramp-smb-handle-file-acl)
 201     (file-attributes . tramp-smb-handle-file-attributes)
 202     (file-directory-p .  tramp-smb-handle-file-directory-p)
 203     ;; `file-equal-p' performed by default handler.
 204     (file-executable-p . tramp-handle-file-exists-p)
 205     (file-exists-p . tramp-handle-file-exists-p)
 206     ;; `file-in-directory-p' performed by default handler.
 207     (file-local-copy . tramp-smb-handle-file-local-copy)
 208     (file-modes . tramp-handle-file-modes)
 209     (file-name-all-completions . tramp-smb-handle-file-name-all-completions)
 210     (file-name-as-directory . tramp-handle-file-name-as-directory)
 211     (file-name-completion . tramp-handle-file-name-completion)
 212     (file-name-directory . tramp-handle-file-name-directory)
 213     (file-name-nondirectory . tramp-handle-file-name-nondirectory)
 214     ;; `file-name-sans-versions' performed by default handler.
 215     (file-newer-than-file-p . tramp-handle-file-newer-than-file-p)
 216     (file-notify-add-watch . tramp-handle-file-notify-add-watch)
 217     (file-notify-rm-watch . tramp-handle-file-notify-rm-watch)
 218     (file-ownership-preserved-p . ignore)
 219     (file-readable-p . tramp-handle-file-exists-p)
 220     (file-regular-p . tramp-handle-file-regular-p)
 221     (file-remote-p . tramp-handle-file-remote-p)
 222     ;; `file-selinux-context' performed by default handler.
 223     (file-symlink-p . tramp-handle-file-symlink-p)
 224     ;; `file-truename' performed by default handler.
 225     (file-writable-p . tramp-smb-handle-file-writable-p)
 226     (find-backup-file-name . tramp-handle-find-backup-file-name)
 227     ;; `find-file-noselect' performed by default handler.
 228     ;; `get-file-buffer' performed by default handler.
 229     (insert-directory . tramp-smb-handle-insert-directory)
 230     (insert-file-contents . tramp-handle-insert-file-contents)
 231     (load . tramp-handle-load)
 232     ;; `make-auto-save-file-name' performed by default handler.
 233     (make-directory . tramp-smb-handle-make-directory)
 234     (make-directory-internal . tramp-smb-handle-make-directory-internal)
 235     (make-symbolic-link . tramp-smb-handle-make-symbolic-link)
 236     (process-file . tramp-smb-handle-process-file)
 237     (rename-file . tramp-smb-handle-rename-file)
 238     (set-file-acl . ignore)
 239     (set-file-modes . tramp-smb-handle-set-file-modes)
 240     (set-file-selinux-context . ignore)
 241     (set-file-times . ignore)
 242     (set-visited-file-modtime . tramp-handle-set-visited-file-modtime)
 243     (shell-command . tramp-handle-shell-command)
 244     (start-file-process . tramp-smb-handle-start-file-process)
 245     (substitute-in-file-name . tramp-smb-handle-substitute-in-file-name)
 246     (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory)
 247     (vc-registered . ignore)
 248     (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
 249     (write-region . tramp-smb-handle-write-region))
 250   "Alist of handler functions for Tramp SMB method.
 251 Operations not mentioned here will be handled by the default Emacs primitives.")
 252
 253 ;; Options for remote processes via winexe.
 254 (defcustom tramp-smb-winexe-program "winexe"
 255   "Name of winexe client to run.
 256 If it isn't found in the local $PATH, the absolute path of winexe
 257 shall be given.  This is needed for remote processes."
 258   :group 'tramp
 259   :type 'string
 260   :version "24.3")
 261
 262 (defcustom tramp-smb-winexe-shell-command "powershell.exe"
 263   "Shell to be used for processes on remote machines.
 264 This must be Powershell V2 compatible."
 265   :group 'tramp
 266   :type 'string
 267   :version "24.3")
 268
 269 (defcustom tramp-smb-winexe-shell-command-switch "-file -"
 270   "Command switch used together with `tramp-smb-winexe-shell-command'.
 271 This can be used to disable echo etc."
 272   :group 'tramp
 273   :type 'string
 274   :version "24.3")
 275
 276 ;; It must be a `defsubst' in order to push the whole code into
 277 ;; tramp-loaddefs.el.  Otherwise, there would be recursive autoloading.
 278 ;;;###tramp-autoload
 279 (defsubst tramp-smb-file-name-p (filename)
 280   "Check if it's a filename for SMB servers."
 281   (string= (tramp-file-name-method (tramp-dissect-file-name filename))
 282            tramp-smb-method))
 283
 284 ;;;###tramp-autoload
 285 (defun tramp-smb-file-name-handler (operation &rest args)
 286   "Invoke the SMB related OPERATION.
 287 First arg specifies the OPERATION, second arg is a list of arguments to
 288 pass to the OPERATION."
 289   (let ((fn (assoc operation tramp-smb-file-name-handler-alist)))
 290     (if fn
 291         (save-match-data (apply (cdr fn) args))
 292       (tramp-run-real-handler operation args))))
 293
 294 ;;;###tramp-autoload
 295 (unless (memq system-type '(cygwin windows-nt))
 296   (add-to-list 'tramp-foreign-file-name-handler-alist
 297                (cons 'tramp-smb-file-name-p 'tramp-smb-file-name-handler)))
 298
 299
 300 ;; File name primitives.
 301
 302 (defun tramp-smb-handle-add-name-to-file
 303   (filename newname &optional ok-if-already-exists)
 304   "Like `add-name-to-file' for Tramp files."
 305   (unless (tramp-equal-remote filename newname)
 306     (with-parsed-tramp-file-name
 307         (if (tramp-tramp-file-p filename) filename newname) nil
 308       (tramp-error
 309        v 'file-error
 310        "add-name-to-file: %s"
 311        "only implemented for same method, same user, same host")))
 312   (with-parsed-tramp-file-name filename v1
 313     (with-parsed-tramp-file-name newname v2
 314       (when (file-directory-p filename)
 315         (tramp-error
 316          v2 'file-error
 317          "add-name-to-file: %s must not be a directory" filename))
 318       (when (and (not ok-if-already-exists)
 319                  (file-exists-p newname)
 320                  (not (numberp ok-if-already-exists))
 321                  (y-or-n-p
 322                   (format
 323                    "File %s already exists; make it a new name anyway? "
 324                    newname)))
 325         (tramp-error
 326          v2 'file-error
 327          "add-name-to-file: file %s already exists" newname))
 328       ;; We must also flush the cache of the directory, because
 329       ;; `file-attributes' reads the values from there.
 330       (tramp-flush-file-property v2 (file-name-directory v2-localname))
 331       (tramp-flush-file-property v2 v2-localname)
 332       (unless
 333           (tramp-smb-send-command
 334            v1
 335            (format
 336             "%s \"%s\" \"%s\""
 337             (if (tramp-smb-get-cifs-capabilities v1) "link" "hardlink")
 338             (tramp-smb-get-localname v1)
 339             (tramp-smb-get-localname v2)))
 340         (tramp-error
 341          v2 'file-error
 342          "error with add-name-to-file, see buffer `%s' for details"
 343          (buffer-name))))))
 344
 345 (defun tramp-smb-action-with-tar (proc vec)
 346   "Untar from connection buffer."
 347   (if (not (memq (process-status proc) '(run open)))
 348       (throw 'tramp-action 'process-died)
 349
 350     (with-current-buffer (tramp-get-connection-buffer vec)
 351       (goto-char (point-min))
 352       (when (search-forward-regexp tramp-smb-server-version nil t)
 353         ;; There might be a hidden password prompt.
 354         (widen)
 355         (forward-line)
 356         (tramp-message vec 6 (buffer-substring (point-min) (point)))
 357         (delete-region (point-min) (point))
 358         (throw 'tramp-action 'ok)))))
 359
 360 (defun tramp-smb-handle-copy-directory
 361   (dirname newname &optional keep-date parents _copy-contents)
 362   "Like `copy-directory' for Tramp files."
 363   (setq dirname (expand-file-name dirname)
 364         newname (expand-file-name newname))
 365   (let ((t1 (tramp-tramp-file-p dirname))
 366         (t2 (tramp-tramp-file-p newname)))
 367     (with-parsed-tramp-file-name (if t1 dirname newname) nil
 368       (with-tramp-progress-reporter
 369           v 0 (format "Copying %s to %s" dirname newname)
 370       (cond
 371        ;; We must use a local temporary directory.
 372        ((and t1 t2)
 373         (let ((tmpdir
 374                (make-temp-name
 375                 (expand-file-name
 376                  tramp-temp-name-prefix
 377                  (tramp-compat-temporary-file-directory)))))
 378           (unwind-protect
 379               (progn
 380                 (tramp-compat-copy-directory dirname tmpdir keep-date parents)
 381                 (tramp-compat-copy-directory tmpdir newname keep-date parents))
 382             (tramp-compat-delete-directory tmpdir 'recursive))))
 383
 384        ;; We can copy recursively.
 385        ((or t1 t2)
 386         (when (and (file-directory-p newname)
 387                    (not (string-equal (file-name-nondirectory dirname)
 388                                       (file-name-nondirectory newname))))
 389           (setq newname
 390                 (expand-file-name
 391                  (file-name-nondirectory dirname) newname))
 392           (if t2 (setq v (tramp-dissect-file-name newname))))
 393         (if (not (file-directory-p newname))
 394             (make-directory newname parents))
 395
 396         (setq tramp-current-method (tramp-file-name-method v)
 397               tramp-current-user (tramp-file-name-user v)
 398               tramp-current-host (tramp-file-name-real-host v))
 399
 400         (let* ((real-user (tramp-file-name-real-user v))
 401                (real-host (tramp-file-name-real-host v))
 402                (domain    (tramp-file-name-domain v))
 403                (port      (tramp-file-name-port v))
 404                (share     (tramp-smb-get-share v))
 405                (localname (file-name-as-directory
 406                            (replace-regexp-in-string
 407                             "\\\\" "/" (tramp-smb-get-localname v))))
 408                (tmpdir    (make-temp-name
 409                            (expand-file-name
 410                             tramp-temp-name-prefix
 411                             (tramp-compat-temporary-file-directory))))
 412                (args      (list tramp-smb-program
 413                                 (concat "//" real-host "/" share) "-E")))
 414
 415           (if (not (zerop (length real-user)))
 416               (setq args (append args (list "-U" real-user)))
 417             (setq args (append args (list "-N"))))
 418
 419           (when domain (setq args (append args (list "-W" domain))))
 420           (when port   (setq args (append args (list "-p" port))))
 421           (when tramp-smb-conf
 422             (setq args (append args (list "-s" tramp-smb-conf))))
 423           (setq args
 424                 (if t1
 425                     ;; Source is remote.
 426                     (append args
 427                             (list "-D" (shell-quote-argument localname)
 428                                   "-c" (shell-quote-argument "tar qc - *")
 429                                   "|" "tar" "xfC" "-"
 430                                   (shell-quote-argument tmpdir)))
 431                   ;; Target is remote.
 432                   (append (list "tar" "cfC" "-" (shell-quote-argument dirname)
 433                                 "." "|")
 434                           args
 435                           (list "-D" (shell-quote-argument localname)
 436                                 "-c" (shell-quote-argument "tar qx -")))))
 437
 438           (unwind-protect
 439               (with-temp-buffer
 440                 ;; Set the transfer process properties.
 441                 (tramp-set-connection-property
 442                  v "process-name" (buffer-name (current-buffer)))
 443                 (tramp-set-connection-property
 444                  v "process-buffer" (current-buffer))
 445
 446                 (when t1
 447                   ;; The smbclient tar command creates always complete
 448                   ;; paths.  We must emulate the directory structure,
 449                   ;; and symlink to the real target.
 450                   (make-directory
 451                    (expand-file-name ".." (concat tmpdir localname)) 'parents)
 452                   (make-symbolic-link
 453                    newname (directory-file-name (concat tmpdir localname))))
 454
 455                 ;; Use an asynchronous processes.  By this, password
 456                 ;; can be handled.
 457                 (let* ((default-directory tmpdir)
 458                        (p (start-process-shell-command
 459                            (tramp-get-connection-name v)
 460                            (tramp-get-connection-buffer v)
 461                            (mapconcat 'identity args " "))))
 462
 463                   (tramp-message
 464                    v 6 "%s" (mapconcat 'identity (process-command p) " "))
 465                   (tramp-compat-set-process-query-on-exit-flag p nil)
 466                   (tramp-process-actions p v nil tramp-smb-actions-with-tar)
 467
 468                   (while (memq (process-status p) '(run open))
 469                     (sit-for 0.1))
 470                   (tramp-message v 6 "\n%s" (buffer-string))))
 471
 472             ;; Reset the transfer process properties.
 473             (tramp-set-connection-property v "process-name" nil)
 474             (tramp-set-connection-property v "process-buffer" nil)
 475             (when t1 (delete-directory tmpdir 'recurse))))
 476
 477         ;; Handle KEEP-DATE argument.
 478         (when keep-date
 479           (set-file-times newname (nth 5 (file-attributes dirname))))
 480
 481         ;; Set the mode.
 482         (unless keep-date
 483           (set-file-modes newname (tramp-default-file-modes dirname)))
 484
 485         ;; When newname did exist, we have wrong cached values.
 486         (when t2
 487           (with-parsed-tramp-file-name newname nil
 488             (tramp-flush-file-property v (file-name-directory localname))
 489             (tramp-flush-file-property v localname))))
 490
 491        ;; We must do it file-wise.
 492        (t
 493         (tramp-run-real-handler
 494          'copy-directory (list dirname newname keep-date parents))))))))
 495
 496 (defun tramp-smb-handle-copy-file
 497   (filename newname &optional ok-if-already-exists keep-date
 498             _preserve-uid-gid _preserve-extended-attributes)
 499   "Like `copy-file' for Tramp files.
 500 KEEP-DATE has no effect in case NEWNAME resides on an SMB server.
 501 PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
 502   (setq filename (expand-file-name filename)
 503         newname (expand-file-name newname))
 504   (with-tramp-progress-reporter
 505       (tramp-dissect-file-name (if (file-remote-p filename) filename newname))
 506       0 (format "Copying %s to %s" filename newname)
 507
 508     (if (file-directory-p filename)
 509         (tramp-compat-copy-directory filename newname keep-date t t)
 510
 511       (let ((tmpfile (file-local-copy filename)))
 512         (if tmpfile
 513             ;; Remote filename.
 514             (condition-case err
 515                 (rename-file tmpfile newname ok-if-already-exists)
 516               ((error quit)
 517                (delete-file tmpfile)
 518                (signal (car err) (cdr err))))
 519
 520           ;; Remote newname.
 521           (when (file-directory-p newname)
 522             (setq newname
 523                   (expand-file-name (file-name-nondirectory filename) newname)))
 524
 525           (with-parsed-tramp-file-name newname nil
 526             (when (and (not ok-if-already-exists)
 527                        (file-exists-p newname))
 528               (tramp-error v 'file-already-exists newname))
 529
 530             ;; We must also flush the cache of the directory, because
 531             ;; `file-attributes' reads the values from there.
 532             (tramp-flush-file-property v (file-name-directory localname))
 533             (tramp-flush-file-property v localname)
 534             (unless (tramp-smb-get-share v)
 535               (tramp-error
 536                v 'file-error "Target `%s' must contain a share name" newname))
 537             (unless (tramp-smb-send-command
 538                      v (format "put \"%s\" \"%s\""
 539                                filename (tramp-smb-get-localname v)))
 540               (tramp-error v 'file-error "Cannot copy `%s'" filename))))))
 541
 542     ;; KEEP-DATE handling.
 543     (when keep-date
 544       (set-file-times newname (nth 5 (file-attributes filename))))))
 545
 546 (defun tramp-smb-handle-delete-directory (directory &optional recursive)
 547   "Like `delete-directory' for Tramp files."
 548   (setq directory (directory-file-name (expand-file-name directory)))
 549   (when (file-exists-p directory)
 550     (if recursive
 551         (mapc
 552          (lambda (file)
 553            (if (file-directory-p file)
 554                (tramp-compat-delete-directory file recursive)
 555              (delete-file file)))
 556          ;; We do not want to delete "." and "..".
 557          (directory-files
 558           directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")))
 559
 560     (with-parsed-tramp-file-name directory nil
 561       ;; We must also flush the cache of the directory, because
 562       ;; `file-attributes' reads the values from there.
 563       (tramp-flush-file-property v (file-name-directory localname))
 564       (tramp-flush-directory-property v localname)
 565       (unless (tramp-smb-send-command
 566                v (format
 567                   "%s \"%s\""
 568                   (if (tramp-smb-get-cifs-capabilities v) "posix_rmdir" "rmdir")
 569                   (tramp-smb-get-localname v)))
 570         ;; Error.
 571         (with-current-buffer (tramp-get-connection-buffer v)
 572           (goto-char (point-min))
 573           (search-forward-regexp tramp-smb-errors nil t)
 574           (tramp-error
 575            v 'file-error "%s `%s'" (match-string 0) directory))))))
 576
 577 (defun tramp-smb-handle-delete-file (filename &optional _trash)
 578   "Like `delete-file' for Tramp files."
 579   (setq filename (expand-file-name filename))
 580   (when (file-exists-p filename)
 581     (with-parsed-tramp-file-name filename nil
 582       ;; We must also flush the cache of the directory, because
 583       ;; `file-attributes' reads the values from there.
 584       (tramp-flush-file-property v (file-name-directory localname))
 585       (tramp-flush-file-property v localname)
 586       (unless (tramp-smb-send-command
 587                v (format
 588                   "%s \"%s\""
 589                   (if (tramp-smb-get-cifs-capabilities v) "posix_unlink" "rm")
 590                   (tramp-smb-get-localname v)))
 591         ;; Error.
 592         (with-current-buffer (tramp-get-connection-buffer v)
 593           (goto-char (point-min))
 594           (search-forward-regexp tramp-smb-errors nil t)
 595           (tramp-error
 596            v 'file-error "%s `%s'" (match-string 0) filename))))))
 597
 598 (defun tramp-smb-handle-directory-files
 599   (directory &optional full match nosort)
 600   "Like `directory-files' for Tramp files."
 601   (let ((result (mapcar 'directory-file-name
 602                         (file-name-all-completions "" directory))))
 603     ;; Discriminate with regexp.
 604     (when match
 605       (setq result
 606             (delete nil
 607                     (mapcar (lambda (x) (when (string-match match x) x))
 608                             result))))
 609     ;; Append directory.
 610     (when full
 611       (setq result
 612             (mapcar
 613              (lambda (x) (expand-file-name x directory))
 614              result)))
 615     ;; Sort them if necessary.
 616     (unless nosort (setq result (sort result 'string-lessp)))
 617     ;; That's it.
 618     result))
 619
 620 (defun tramp-smb-handle-expand-file-name (name &optional dir)
 621   "Like `expand-file-name' for Tramp files."
 622   ;; If DIR is not given, use DEFAULT-DIRECTORY or "/".
 623   (setq dir (or dir default-directory "/"))
 624   ;; Unless NAME is absolute, concat DIR and NAME.
 625   (unless (file-name-absolute-p name)
 626     (setq name (concat (file-name-as-directory dir) name)))
 627   ;; If NAME is not a Tramp file, run the real handler.
 628   (if (not (tramp-tramp-file-p name))
 629       (tramp-run-real-handler 'expand-file-name (list name nil))
 630     ;; Dissect NAME.
 631     (with-parsed-tramp-file-name name nil
 632       ;; Tilde expansion if necessary.  We use the user name as share,
 633       ;; which is often the case in domains.
 634       (when (string-match "\\`/?~\\([^/]*\\)" localname)
 635         (setq localname
 636               (replace-match
 637                (if (zerop (length (match-string 1 localname)))
 638                    (tramp-file-name-real-user v)
 639                  (match-string 1 localname))
 640                nil nil localname)))
 641       ;; Make the file name absolute.
 642       (unless (tramp-run-real-handler 'file-name-absolute-p (list localname))
 643         (setq localname (concat "/" localname)))
 644       ;; No tilde characters in file name, do normal
 645       ;; `expand-file-name' (this does "/./" and "/../").
 646       (tramp-make-tramp-file-name
 647        method user host
 648        (tramp-run-real-handler 'expand-file-name (list localname))))))
 649
 650 (defun tramp-smb-handle-file-acl (filename)
 651   "Like `file-acl' for Tramp files."
 652   (with-parsed-tramp-file-name filename nil
 653     (with-tramp-file-property v localname "file-acl"
 654       (when (tramp-smb-send-command
 655              v (format "getfacl \"%s\"" (tramp-smb-get-localname v)))
 656         (with-current-buffer (tramp-get-connection-buffer v)
 657           (goto-char (point-min))
 658           (while (looking-at "^#")
 659             (forward-line)
 660             (delete-region (point-min) (point)))
 661           (goto-char (point-max))
 662           (delete-blank-lines)
 663           (when (> (point-max) (point-min))
 664             (tramp-compat-funcall
 665              'substring-no-properties (buffer-string))))))))
 666
 667 (defun tramp-smb-handle-file-attributes (filename &optional id-format)
 668   "Like `file-attributes' for Tramp files."
 669   (unless id-format (setq id-format 'integer))
 670   (ignore-errors
 671     (with-parsed-tramp-file-name filename nil
 672       (with-tramp-file-property
 673           v localname (format "file-attributes-%s" id-format)
 674         (if (and (tramp-smb-get-share v) (tramp-smb-get-stat-capability v))
 675             (tramp-smb-do-file-attributes-with-stat v id-format)
 676           ;; Reading just the filename entry via "dir localname" is not
 677           ;; possible, because when filename is a directory, some
 678           ;; smbclient versions return the content of the directory, and
 679           ;; other versions don't.  Therefore, the whole content of the
 680           ;; upper directory is retrieved, and the entry of the filename
 681           ;; is extracted from.
 682           (let* ((entries (tramp-smb-get-file-entries
 683                            (file-name-directory filename)))
 684                  (entry (assoc (file-name-nondirectory filename) entries))
 685                  (uid (if (equal id-format 'string) "nobody" -1))
 686                  (gid (if (equal id-format 'string) "nogroup" -1))
 687                  (inode (tramp-get-inode v))
 688                  (device (tramp-get-device v)))
 689
 690             ;; Check result.
 691             (when entry
 692               (list (and (string-match "d" (nth 1 entry))
 693                          t)        ;0 file type
 694                     -1             ;1 link count
 695                     uid            ;2 uid
 696                     gid            ;3 gid
 697                     '(0 0)         ;4 atime
 698                     (nth 3 entry)  ;5 mtime
 699                     '(0 0)         ;6 ctime
 700                     (nth 2 entry)  ;7 size
 701                     (nth 1 entry)  ;8 mode
 702                     nil            ;9 gid weird
 703                     inode          ;10 inode number
 704                     device)))))))) ;11 file system number
 705
 706 (defun tramp-smb-do-file-attributes-with-stat (vec &optional id-format)
 707   "Implement `file-attributes' for Tramp files using stat command."
 708   (tramp-message
 709    vec 5 "file attributes with stat: %s" (tramp-file-name-localname vec))
 710   (with-current-buffer (tramp-get-connection-buffer vec)
 711     (let* (size id link uid gid atime mtime ctime mode inode)
 712       (when (tramp-smb-send-command
 713              vec (format "stat \"%s\"" (tramp-smb-get-localname vec)))
 714
 715         ;; Loop the listing.
 716         (goto-char (point-min))
 717         (unless (re-search-forward tramp-smb-errors nil t)
 718           (while (not (eobp))
 719             (cond
 720              ((looking-at
 721                "Size:\\s-+\\([0-9]+\\)\\s-+Blocks:\\s-+[0-9]+\\s-+\\(\\w+\\)")
 722               (setq size (string-to-number (match-string 1))
 723                     id (if (string-equal "directory" (match-string 2)) t
 724                          (if (string-equal "symbolic" (match-string 2)) ""))))
 725              ((looking-at
 726                "Inode:\\s-+\\([0-9]+\\)\\s-+Links:\\s-+\\([0-9]+\\)")
 727               (setq inode (string-to-number (match-string 1))
 728                     link (string-to-number (match-string 2))))
 729              ((looking-at
 730                "Access:\\s-+([0-9]+/\\(\\S-+\\))\\s-+Uid:\\s-+\\([0-9]+\\)\\s-+Gid:\\s-+\\([0-9]+\\)")
 731               (setq mode (match-string 1)
 732                     uid (if (equal id-format 'string) (match-string 2)
 733                           (string-to-number (match-string 2)))
 734                     gid (if (equal id-format 'string) (match-string 3)
 735                           (string-to-number (match-string 3)))))
 736              ((looking-at
 737                "Access:\\s-+\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)\\s-+\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)")
 738               (setq atime
 739                     (encode-time
 740                      (string-to-number (match-string 6)) ;; sec
 741                      (string-to-number (match-string 5)) ;; min
 742                      (string-to-number (match-string 4)) ;; hour
 743                      (string-to-number (match-string 3)) ;; day
 744                      (string-to-number (match-string 2)) ;; month
 745                      (string-to-number (match-string 1))))) ;; year
 746              ((looking-at
 747                "Modify:\\s-+\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)\\s-+\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)")
 748               (setq mtime
 749                     (encode-time
 750                      (string-to-number (match-string 6)) ;; sec
 751                      (string-to-number (match-string 5)) ;; min
 752                      (string-to-number (match-string 4)) ;; hour
 753                      (string-to-number (match-string 3)) ;; day
 754                      (string-to-number (match-string 2)) ;; month
 755                      (string-to-number (match-string 1))))) ;; year
 756              ((looking-at
 757                "Change:\\s-+\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)\\s-+\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)")
 758               (setq ctime
 759                     (encode-time
 760                      (string-to-number (match-string 6)) ;; sec
 761                      (string-to-number (match-string 5)) ;; min
 762                      (string-to-number (match-string 4)) ;; hour
 763                      (string-to-number (match-string 3)) ;; day
 764                      (string-to-number (match-string 2)) ;; month
 765                      (string-to-number (match-string 1)))))) ;; year
 766             (forward-line))
 767           ;; Return the result.
 768           (list id link uid gid atime mtime ctime size mode nil inode
 769                 (tramp-get-device vec)))))))
 770
 771 (defun tramp-smb-handle-file-directory-p (filename)
 772   "Like `file-directory-p' for Tramp files."
 773   (and (file-exists-p filename)
 774        (eq ?d (aref (nth 8 (file-attributes filename)) 0))))
 775
 776 (defun tramp-smb-handle-file-local-copy (filename)
 777   "Like `file-local-copy' for Tramp files."
 778   (with-parsed-tramp-file-name filename nil
 779     (unless (file-exists-p filename)
 780       (tramp-error
 781        v 'file-error
 782        "Cannot make local copy of non-existing file `%s'" filename))
 783     (let ((tmpfile (tramp-compat-make-temp-file filename)))
 784       (with-tramp-progress-reporter
 785           v 3 (format "Fetching %s to tmp file %s" filename tmpfile)
 786         (unless (tramp-smb-send-command
 787                  v (format "get \"%s\" \"%s\""
 788                            (tramp-smb-get-localname v) tmpfile))
 789           ;; Oops, an error.  We shall cleanup.
 790           (delete-file tmpfile)
 791           (tramp-error
 792            v 'file-error "Cannot make local copy of file `%s'" filename)))
 793       tmpfile)))
 794
 795 ;; This function should return "foo/" for directories and "bar" for
 796 ;; files.
 797 (defun tramp-smb-handle-file-name-all-completions (filename directory)
 798   "Like `file-name-all-completions' for Tramp files."
 799   (all-completions
 800    filename
 801    (with-parsed-tramp-file-name directory nil
 802      (with-tramp-file-property v localname "file-name-all-completions"
 803        (save-match-data
 804          (let ((entries (tramp-smb-get-file-entries directory)))
 805            (mapcar
 806             (lambda (x)
 807               (list
 808                (if (string-match "d" (nth 1 x))
 809                    (file-name-as-directory (nth 0 x))
 810                  (nth 0 x))))
 811             entries)))))))
 812
 813 (defun tramp-smb-handle-file-writable-p (filename)
 814   "Like `file-writable-p' for Tramp files."
 815   (if (file-exists-p filename)
 816       (string-match "w" (or (nth 8 (file-attributes filename)) ""))
 817     (let ((dir (file-name-directory filename)))
 818       (and (file-exists-p dir)
 819            (file-writable-p dir)))))
 820
 821 (defun tramp-smb-handle-insert-directory
 822   (filename switches &optional wildcard full-directory-p)
 823   "Like `insert-directory' for Tramp files."
 824   (setq filename (expand-file-name filename))
 825   (if full-directory-p
 826       ;; Called from `dired-add-entry'.
 827       (setq filename (file-name-as-directory filename))
 828     (setq filename (directory-file-name filename)))
 829   (with-parsed-tramp-file-name filename nil
 830     (save-match-data
 831       (let ((base (file-name-nondirectory filename))
 832             ;; We should not destroy the cache entry.
 833             (entries (copy-sequence
 834                       (tramp-smb-get-file-entries
 835                        (file-name-directory filename)))))
 836
 837         (when wildcard
 838           (string-match "\\." base)
 839           (setq base (replace-match "\\\\." nil nil base))
 840           (string-match "\\*" base)
 841           (setq base (replace-match ".*" nil nil base))
 842           (string-match "\\?" base)
 843           (setq base (replace-match ".?" nil nil base)))
 844
 845         ;; Filter entries.
 846         (setq entries
 847               (delq
 848                nil
 849                (if (or wildcard (zerop (length base)))
 850                    ;; Check for matching entries.
 851                    (mapcar
 852                     (lambda (x)
 853                       (when (string-match
 854                              (format "^%s" base) (nth 0 x))
 855                         x))
 856                     entries)
 857                  ;; We just need the only and only entry FILENAME.
 858                  (list (assoc base entries)))))
 859
 860         ;; Sort entries.
 861         (setq entries
 862               (sort
 863                entries
 864                (lambda (x y)
 865                  (if (string-match "t" switches)
 866                      ;; Sort by date.
 867                      (tramp-time-less-p (nth 3 y) (nth 3 x))
 868                    ;; Sort by name.
 869                    (string-lessp (nth 0 x) (nth 0 y))))))
 870
 871         ;; Handle "-F" switch.
 872         (when (string-match "F" switches)
 873           (mapc
 874            (lambda (x)
 875              (when (not (zerop (length (car x))))
 876                (cond
 877                 ((char-equal ?d (string-to-char (nth 1 x)))
 878                  (setcar x (concat (car x) "/")))
 879                 ((char-equal ?x (string-to-char (nth 1 x)))
 880                  (setcar x (concat (car x) "*"))))))
 881            entries))
 882
 883         ;; Print entries.
 884         (mapc
 885          (lambda (x)
 886            (when (not (zerop (length (nth 0 x))))
 887              (let ((attr
 888                     (when (tramp-smb-get-stat-capability v)
 889                       (ignore-errors
 890                         (file-attributes filename 'string)))))
 891                (insert
 892                 (format
 893                  "%10s %3d %-8s %-8s %8s %s "
 894                  (or (nth 8 attr) (nth 1 x)) ; mode
 895                  (or (nth 1 attr) 1) ; inode
 896                  (or (nth 2 attr) "nobody") ; uid
 897                  (or (nth 3 attr) "nogroup") ; gid
 898                  (or (nth 7 attr) (nth 2 x)) ; size
 899                  (format-time-string
 900                   (if (tramp-time-less-p
 901                        (tramp-time-subtract (current-time) (nth 3 x))
 902                        tramp-half-a-year)
 903                       "%b %e %R"
 904                     "%b %e  %Y")
 905                   (nth 3 x)))) ; date
 906                ;; We mark the file name.  The inserted name could be
 907                ;; from somewhere else, so we use the relative file
 908                ;; name of `default-directory'.
 909                (let ((start (point)))
 910                  (insert
 911                   (format
 912                    "%s\n"
 913                    (file-relative-name
 914                     (expand-file-name
 915                      (nth 0 x) (file-name-directory filename)))))
 916                  (put-text-property start (1- (point)) 'dired-filename t))
 917                (forward-line)
 918                (beginning-of-line))))
 919          entries)))))
 920
 921 (defun tramp-smb-handle-make-directory (dir &optional parents)
 922   "Like `make-directory' for Tramp files."
 923   (setq dir (directory-file-name (expand-file-name dir)))
 924   (unless (file-name-absolute-p dir)
 925     (setq dir (expand-file-name dir default-directory)))
 926   (with-parsed-tramp-file-name dir nil
 927     (save-match-data
 928       (let* ((ldir (file-name-directory dir)))
 929         ;; Make missing directory parts.
 930         (when (and parents
 931                    (tramp-smb-get-share v)
 932                    (not (file-directory-p ldir)))
 933           (make-directory ldir parents))
 934         ;; Just do it.
 935         (when (file-directory-p ldir)
 936           (make-directory-internal dir))
 937         (unless (file-directory-p dir)
 938           (tramp-error v 'file-error "Couldn't make directory %s" dir))))))
 939
 940 (defun tramp-smb-handle-make-directory-internal (directory)
 941   "Like `make-directory-internal' for Tramp files."
 942   (setq directory (directory-file-name (expand-file-name directory)))
 943   (unless (file-name-absolute-p directory)
 944     (setq directory (expand-file-name directory default-directory)))
 945   (with-parsed-tramp-file-name directory nil
 946     (save-match-data
 947       (let* ((file (tramp-smb-get-localname v)))
 948         (when (file-directory-p (file-name-directory directory))
 949           (tramp-smb-send-command
 950            v
 951            (if (tramp-smb-get-cifs-capabilities v)
 952                (format
 953                 "posix_mkdir \"%s\" %s"
 954                 file (tramp-compat-decimal-to-octal (default-file-modes)))
 955              (format "mkdir \"%s\"" file)))
 956           ;; We must also flush the cache of the directory, because
 957           ;; `file-attributes' reads the values from there.
 958           (tramp-flush-file-property v (file-name-directory localname))
 959           (tramp-flush-file-property v localname))
 960         (unless (file-directory-p directory)
 961           (tramp-error
 962            v 'file-error "Couldn't make directory %s" directory))))))
 963
 964 (defun tramp-smb-handle-make-symbolic-link
 965   (filename linkname &optional ok-if-already-exists)
 966   "Like `make-symbolic-link' for Tramp files.
 967 If LINKNAME is a non-Tramp file, it is used verbatim as the target of
 968 the symlink.  If LINKNAME is a Tramp file, only the localname component is
 969 used as the target of the symlink.
 970
 971 If LINKNAME is a Tramp file and the localname component is relative, then
 972 it is expanded first, before the localname component is taken.  Note that
 973 this can give surprising results if the user/host for the source and
 974 target of the symlink differ."
 975   (unless (tramp-equal-remote filename linkname)
 976     (with-parsed-tramp-file-name
 977         (if (tramp-tramp-file-p filename) filename linkname) nil
 978       (tramp-error
 979        v 'file-error
 980        "make-symbolic-link: %s"
 981        "only implemented for same method, same user, same host")))
 982   (with-parsed-tramp-file-name filename v1
 983     (with-parsed-tramp-file-name linkname v2
 984       (when (file-directory-p filename)
 985         (tramp-error
 986          v2 'file-error
 987          "make-symbolic-link: %s must not be a directory" filename))
 988       (when (and (not ok-if-already-exists)
 989                  (file-exists-p linkname)
 990                  (not (numberp ok-if-already-exists))
 991                  (y-or-n-p
 992                   (format
 993                    "File %s already exists; make it a new name anyway? "
 994                    linkname)))
 995         (tramp-error
 996          v2 'file-error
 997          "make-symbolic-link: file %s already exists" linkname))
 998       (unless (tramp-smb-get-cifs-capabilities v1)
 999         (tramp-error v2 'file-error "make-symbolic-link not supported"))
1000       ;; We must also flush the cache of the directory, because
1001       ;; `file-attributes' reads the values from there.
1002       (tramp-flush-file-property v2 (file-name-directory v2-localname))
1003       (tramp-flush-file-property v2 v2-localname)
1004       (unless
1005           (tramp-smb-send-command
1006            v1
1007            (format
1008             "symlink \"%s\" \"%s\""
1009             (tramp-smb-get-localname v1)
1010             (tramp-smb-get-localname v2)))
1011         (tramp-error
1012          v2 'file-error
1013          "error with make-symbolic-link, see buffer `%s' for details"
1014          (buffer-name))))))
1015
1016 (defun tramp-smb-handle-process-file
1017   (program &optional infile destination display &rest args)
1018   "Like `process-file' for Tramp files."
1019   ;; The implementation is not complete yet.
1020   (when (and (numberp destination) (zerop destination))
1021     (error "Implementation does not handle immediate return"))
1022
1023   (with-parsed-tramp-file-name default-directory nil
1024     (let* ((name (file-name-nondirectory program))
1025            (name1 name)
1026            (i 0)
1027            input tmpinput outbuf command ret)
1028
1029       ;; Determine input.
1030       (when infile
1031         (setq infile (expand-file-name infile))
1032         (if (tramp-equal-remote default-directory infile)
1033             ;; INFILE is on the same remote host.
1034             (setq input (with-parsed-tramp-file-name infile nil localname))
1035           ;; INFILE must be copied to remote host.
1036           (setq input (tramp-make-tramp-temp-file v)
1037                 tmpinput (tramp-make-tramp-file-name method user host input))
1038           (copy-file infile tmpinput t))
1039         ;; Transform input into a filename powershell does understand.
1040         (setq input (format "//%s%s" host input)))
1041
1042       ;; Determine output.
1043       (cond
1044        ;; Just a buffer.
1045        ((bufferp destination)
1046         (setq outbuf destination))
1047        ;; A buffer name.
1048        ((stringp destination)
1049         (setq outbuf (get-buffer-create destination)))
1050        ;; (REAL-DESTINATION ERROR-DESTINATION)
1051        ((consp destination)
1052         ;; output.
1053         (cond
1054          ((bufferp (car destination))
1055           (setq outbuf (car destination)))
1056          ((stringp (car destination))
1057           (setq outbuf (get-buffer-create (car destination))))
1058          ((car destination)
1059           (setq outbuf (current-buffer))))
1060         ;; stderr.
1061         (tramp-message v 2 "%s" "STDERR not supported"))
1062        ;; 't
1063        (destination
1064         (setq outbuf (current-buffer))))
1065
1066       ;; Construct command.
1067       (setq command (mapconcat 'identity (cons program args) " ")
1068             command (if input
1069                         (format
1070                          "get-content %s | & %s"
1071                          (tramp-smb-shell-quote-argument input) command)
1072                       (format "& %s" command)))
1073
1074       (while (get-process name1)
1075         ;; NAME must be unique as process name.
1076         (setq i (1+ i)
1077               name1 (format "%s<%d>" name i)))
1078
1079       ;; Set the new process properties.
1080       (tramp-set-connection-property v "process-name" name1)
1081       (tramp-set-connection-property
1082        v "process-buffer"
1083        (or outbuf (generate-new-buffer tramp-temp-buffer-name)))
1084
1085       ;; Call it.
1086       (condition-case nil
1087           (with-current-buffer (tramp-get-connection-buffer v)
1088             ;; Preserve buffer contents.
1089             (narrow-to-region (point-max) (point-max))
1090             (tramp-smb-call-winexe v)
1091             (when (tramp-smb-get-share v)
1092               (tramp-smb-send-command
1093                v (format "cd \"//%s%s\"" host (file-name-directory localname))))
1094             (tramp-smb-send-command v command)
1095             ;; Preserve command output.
1096             (narrow-to-region (point-max) (point-max))
1097             (let ((p (tramp-get-connection-process v)))
1098               (tramp-smb-send-command v "exit $lasterrorcode")
1099               (while (memq (process-status p) '(run open))
1100                 (sleep-for 0.1)
1101                 (setq ret (process-exit-status p))))
1102             (delete-region (point-min) (point-max))
1103             (widen))
1104
1105         ;; When the user did interrupt, we should do it also.  We use
1106         ;; return code -1 as marker.
1107         (quit
1108          (setq ret -1))
1109         ;; Handle errors.
1110         (error
1111          (setq ret 1)))
1112
1113       ;; We should show the output anyway.
1114       (when (and outbuf display) (display-buffer outbuf))
1115
1116       ;; Cleanup.  We remove all file cache values for the connection,
1117       ;; because the remote process could have changed them.
1118       (tramp-set-connection-property v "process-name" nil)
1119       (tramp-set-connection-property v "process-buffer" nil)
1120       (when tmpinput (delete-file tmpinput))
1121       (unless outbuf
1122         (kill-buffer (tramp-get-connection-property v "process-buffer" nil)))
1123
1124       ;; `process-file-side-effects' has been introduced with GNU
1125       ;; Emacs 23.2.  If set to `nil', no remote file will be changed
1126       ;; by `program'.  If it doesn't exist, we assume its default
1127       ;; value `t'.
1128       (unless (and (boundp 'process-file-side-effects)
1129                    (not (symbol-value 'process-file-side-effects)))
1130         (tramp-flush-directory-property v ""))
1131
1132       ;; Return exit status.
1133       (if (equal ret -1)
1134           (keyboard-quit)
1135         ret))))
1136
1137 (defun tramp-smb-handle-rename-file
1138   (filename newname &optional ok-if-already-exists)
1139   "Like `rename-file' for Tramp files."
1140   (setq filename (expand-file-name filename)
1141         newname (expand-file-name newname))
1142
1143   (when (and (not ok-if-already-exists)
1144              (file-exists-p newname))
1145     (tramp-error
1146      (tramp-dissect-file-name
1147       (if (file-remote-p filename) filename newname))
1148      'file-already-exists newname))
1149
1150   (with-tramp-progress-reporter
1151       (tramp-dissect-file-name (if (file-remote-p filename) filename newname))
1152       0 (format "Renaming %s to %s" filename newname)
1153
1154     (if (and (tramp-equal-remote filename newname)
1155              (string-equal
1156               (tramp-smb-get-share (tramp-dissect-file-name filename))
1157               (tramp-smb-get-share (tramp-dissect-file-name newname))))
1158         ;; We can rename directly.
1159         (with-parsed-tramp-file-name filename v1
1160           (with-parsed-tramp-file-name newname v2
1161
1162             ;; We must also flush the cache of the directory, because
1163             ;; `file-attributes' reads the values from there.
1164             (tramp-flush-file-property v2 (file-name-directory v2-localname))
1165             (tramp-flush-file-property v2 v2-localname)
1166             (unless (tramp-smb-get-share v2)
1167               (tramp-error
1168                v2 'file-error "Target `%s' must contain a share name" newname))
1169             (unless (tramp-smb-send-command
1170                      v2 (format "rename \"%s\" \"%s\""
1171                                 (tramp-smb-get-localname v1)
1172                                 (tramp-smb-get-localname v2)))
1173               (tramp-error v2 'file-error "Cannot rename `%s'" filename))))
1174
1175       ;; We must rename via copy.
1176       (tramp-compat-copy-file filename newname ok-if-already-exists t t t)
1177       (if (file-directory-p filename)
1178           (tramp-compat-delete-directory filename 'recursive)
1179         (delete-file filename)))))
1180
1181 (defun tramp-smb-handle-set-file-modes (filename mode)
1182   "Like `set-file-modes' for Tramp files."
1183   (with-parsed-tramp-file-name filename nil
1184     (when (tramp-smb-get-cifs-capabilities v)
1185       (tramp-flush-file-property v localname)
1186       (unless (tramp-smb-send-command
1187                v (format "chmod \"%s\" %s"
1188                          (tramp-smb-get-localname v)
1189                          (tramp-compat-decimal-to-octal mode)))
1190         (tramp-error
1191          v 'file-error "Error while changing file's mode %s" filename)))))
1192
1193 ;; We use BUFFER also as connection buffer during setup. Because of
1194 ;; this, its original contents must be saved, and restored once
1195 ;; connection has been setup.
1196 (defun tramp-smb-handle-start-file-process (name buffer program &rest args)
1197   "Like `start-file-process' for Tramp files."
1198   (with-parsed-tramp-file-name default-directory nil
1199     (let ((command (mapconcat 'identity (cons program args) " "))
1200           (bmp (and (buffer-live-p buffer) (buffer-modified-p buffer)))
1201           (name1 name)
1202           (i 0))
1203       (unwind-protect
1204           (save-excursion
1205             (save-restriction
1206               (unless buffer
1207                 ;; BUFFER can be nil.  We use a temporary buffer.
1208                 (setq buffer (generate-new-buffer tramp-temp-buffer-name)))
1209               (while (get-process name1)
1210                 ;; NAME must be unique as process name.
1211                 (setq i (1+ i)
1212                       name1 (format "%s<%d>" name i)))
1213               ;; Set the new process properties.
1214               (tramp-set-connection-property v "process-name" name1)
1215               (tramp-set-connection-property v "process-buffer" buffer)
1216               ;; Activate narrowing in order to save BUFFER contents.
1217               (with-current-buffer (tramp-get-connection-buffer v)
1218                 (let ((buffer-undo-list t))
1219                   (narrow-to-region (point-max) (point-max))
1220                   (tramp-smb-call-winexe v)
1221                   (when (tramp-smb-get-share v)
1222                     (tramp-smb-send-command
1223                      v (format
1224                         "cd \"//%s%s\""
1225                         host (file-name-directory localname))))
1226                   (tramp-message v 6 "(%s); exit" command)
1227                   (tramp-send-string v command)))
1228               ;; Return value.
1229               (tramp-get-connection-process v)))
1230
1231         ;; Save exit.
1232         (with-current-buffer (tramp-get-connection-buffer v)
1233           (if (string-match tramp-temp-buffer-name (buffer-name))
1234               (progn
1235                 (set-process-buffer (tramp-get-connection-process v) nil)
1236                 (kill-buffer (current-buffer)))
1237             (set-buffer-modified-p bmp)))
1238         (tramp-set-connection-property v "process-name" nil)
1239         (tramp-set-connection-property v "process-buffer" nil)))))
1240
1241 (defun tramp-smb-handle-substitute-in-file-name (filename)
1242   "Like `handle-substitute-in-file-name' for Tramp files.
1243 \"//\" substitutes only in the local filename part.  Catches
1244 errors for shares like \"C$/\", which are common in Microsoft Windows."
1245   (with-parsed-tramp-file-name filename nil
1246     ;; Ignore in LOCALNAME everything before "//".
1247     (when (and (stringp localname) (string-match ".+?/\\(/\\|~\\)" localname))
1248       (setq filename
1249             (concat (file-remote-p filename)
1250                     (replace-match "\\1" nil nil localname)))))
1251   (condition-case nil
1252       (tramp-run-real-handler 'substitute-in-file-name (list filename))
1253     (error filename)))
1254
1255 (defun tramp-smb-handle-write-region
1256   (start end filename &optional append visit lockname confirm)
1257   "Like `write-region' for Tramp files."
1258   (setq filename (expand-file-name filename))
1259   (with-parsed-tramp-file-name filename nil
1260     (unless (eq append nil)
1261       (tramp-error
1262          v 'file-error "Cannot append to file using Tramp (`%s')" filename))
1263     ;; XEmacs takes a coding system as the seventh argument, not `confirm'.
1264     (when (and (not (featurep 'xemacs))
1265                confirm (file-exists-p filename))
1266       (unless (y-or-n-p (format "File %s exists; overwrite anyway? "
1267                                 filename))
1268         (tramp-error v 'file-error "File not overwritten")))
1269     ;; We must also flush the cache of the directory, because
1270     ;; `file-attributes' reads the values from there.
1271     (tramp-flush-file-property v (file-name-directory localname))
1272     (tramp-flush-file-property v localname)
1273     (let ((curbuf (current-buffer))
1274           (tmpfile (tramp-compat-make-temp-file filename)))
1275       ;; We say `no-message' here because we don't want the visited file
1276       ;; modtime data to be clobbered from the temp file.  We call
1277       ;; `set-visited-file-modtime' ourselves later on.
1278       (tramp-run-real-handler
1279        'write-region
1280        (if confirm ; don't pass this arg unless defined for backward compat.
1281            (list start end tmpfile append 'no-message lockname confirm)
1282          (list start end tmpfile append 'no-message lockname)))
1283
1284       (with-tramp-progress-reporter
1285           v 3 (format "Moving tmp file %s to %s" tmpfile filename)
1286         (unwind-protect
1287             (unless (tramp-smb-send-command
1288                      v (format "put %s \"%s\""
1289                                tmpfile (tramp-smb-get-localname v)))
1290               (tramp-error v 'file-error "Cannot write `%s'" filename))
1291           (delete-file tmpfile)))
1292
1293       (unless (equal curbuf (current-buffer))
1294         (tramp-error
1295          v 'file-error
1296          "Buffer has changed from `%s' to `%s'" curbuf (current-buffer)))
1297       (when (eq visit t)
1298         (set-visited-file-modtime)))))
1299
1300
1301 ;; Internal file name functions.
1302
1303 (defun tramp-smb-get-share (vec)
1304   "Returns the share name of LOCALNAME."
1305   (save-match-data
1306     (let ((localname (tramp-file-name-localname vec)))
1307       (when (string-match "^/?\\([^/]+\\)/" localname)
1308         (match-string 1 localname)))))
1309
1310 (defun tramp-smb-get-localname (vec)
1311   "Returns the file name of LOCALNAME.
1312 If VEC has no cifs capabilities, exchange \"/\" by \"\\\\\"."
1313   (save-match-data
1314     (let ((localname (tramp-file-name-localname vec)))
1315       (setq
1316        localname
1317        (if (string-match "^/?[^/]+\\(/.*\\)" localname)
1318            ;; There is a share, separated by "/".
1319            (if (not (tramp-smb-get-cifs-capabilities vec))
1320                (mapconcat
1321                 (lambda (x) (if (equal x ?/) "\\" (char-to-string x)))
1322                 (match-string 1 localname) "")
1323              (match-string 1 localname))
1324          ;; There is just a share.
1325          (if (string-match "^/?\\([^/]+\\)$" localname)
1326              (match-string 1 localname)
1327            "")))
1328
1329       ;; Sometimes we have discarded `substitute-in-file-name'.
1330       (when (string-match "\\(\\$\\$\\)\\(/\\|$\\)" localname)
1331         (setq localname (replace-match "$" nil nil localname 1)))
1332
1333       localname)))
1334
1335 ;; Share names of a host are cached. It is very unlikely that the
1336 ;; shares do change during connection.
1337 (defun tramp-smb-get-file-entries (directory)
1338   "Read entries which match DIRECTORY.
1339 Either the shares are listed, or the `dir' command is executed.
1340 Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)."
1341   (with-parsed-tramp-file-name (file-name-as-directory directory) nil
1342     (setq localname (or localname "/"))
1343     (with-tramp-file-property v localname "file-entries"
1344       (with-current-buffer (tramp-get-connection-buffer v)
1345         (let* ((share (tramp-smb-get-share v))
1346                (cache (tramp-get-connection-property v "share-cache" nil))
1347                res entry)
1348
1349           (if (and (not share) cache)
1350               ;; Return cached shares.
1351               (setq res cache)
1352
1353             ;; Read entries.
1354             (if share
1355                 (tramp-smb-send-command
1356                  v (format "dir \"%s*\"" (tramp-smb-get-localname v)))
1357               ;; `tramp-smb-maybe-open-connection' lists also the share names.
1358               (tramp-smb-maybe-open-connection v))
1359
1360             ;; Loop the listing.
1361             (goto-char (point-min))
1362             (if (re-search-forward tramp-smb-errors nil t)
1363                 (tramp-error v 'file-error "%s `%s'" (match-string 0) directory)
1364               (while (not (eobp))
1365                 (setq entry (tramp-smb-read-file-entry share))
1366                 (forward-line)
1367                 (when entry (add-to-list 'res entry))))
1368
1369             ;; Cache share entries.
1370             (unless share
1371               (tramp-set-connection-property v "share-cache" res)))
1372
1373           ;; Add directory itself.
1374           (add-to-list 'res '("" "drwxrwxrwx" 0 (0 0)))
1375
1376           ;; There's a very strange error (debugged with XEmacs 21.4.14)
1377           ;; If there's no short delay, it returns nil.  No idea about.
1378           (when (featurep 'xemacs) (sleep-for 0.01))
1379
1380           ;; Return entries.
1381           (delq nil res))))))
1382
1383 ;; Return either a share name (if SHARE is nil), or a file name.
1384 ;;
1385 ;; If shares are listed, the following format is expected:
1386 ;;
1387 ;; Disk|                                  - leading spaces
1388 ;; [^|]+|                                 - share name, 14 char
1389 ;; .*                                     - comment
1390 ;;
1391 ;; Entries provided by smbclient DIR aren't fully regular.
1392 ;; They should have the format
1393 ;;
1394 ;; \s-\{2,2}                              - leading spaces
1395 ;; \S-\(.*\S-\)\s-*                       - file name, 30 chars, left bound
1396 ;; \s-+[ADHRSV]*                          - permissions, 7 chars, right bound
1397 ;; \s-                                    - space delimiter
1398 ;; \s-+[0-9]+                             - size, 8 chars, right bound
1399 ;; \s-\{2,2\}                             - space delimiter
1400 ;; \w\{3,3\}                              - weekday
1401 ;; \s-                                    - space delimiter
1402 ;; \w\{3,3\}                              - month
1403 ;; \s-                                    - space delimiter
1404 ;; [ 12][0-9]                             - day
1405 ;; \s-                                    - space delimiter
1406 ;; [0-9]\{2,2\}:[0-9]\{2,2\}:[0-9]\{2,2\} - time
1407 ;; \s-                                    - space delimiter
1408 ;; [0-9]\{4,4\}                           - year
1409 ;;
1410 ;; samba/src/client.c (http://samba.org/doxygen/samba/client_8c-source.html)
1411 ;; has function display_finfo:
1412 ;;
1413 ;;   d_printf("  %-30s%7.7s %8.0f  %s",
1414 ;;            finfo->name,
1415 ;;            attrib_string(finfo->mode),
1416 ;;            (double)finfo->size,
1417 ;;            asctime(LocalTime(&t)));
1418 ;;
1419 ;; in Samba 1.9, there's the following code:
1420 ;;
1421 ;;   DEBUG(0,("  %-30s%7.7s%10d  %s",
1422 ;;         CNV_LANG(finfo->name),
1423 ;;         attrib_string(finfo->mode),
1424 ;;         finfo->size,
1425 ;;         asctime(LocalTime(&t))));
1426 ;;
1427 ;; Problems:
1428 ;; * Modern regexp constructs, like spy groups and counted repetitions, aren't
1429 ;;   available in older Emacsen.
1430 ;; * The length of constructs (file name, size) might exceed the default.
1431 ;; * File names might contain spaces.
1432 ;; * Permissions might be empty.
1433 ;;
1434 ;; So we try to analyze backwards.
1435 (defun tramp-smb-read-file-entry (share)
1436   "Parse entry in SMB output buffer.
1437 If SHARE is result, entries are of type dir. Otherwise, shares are listed.
1438 Result is the list (LOCALNAME MODE SIZE MTIME)."
1439 ;; We are called from `tramp-smb-get-file-entries', which sets the
1440 ;; current buffer.
1441   (let ((line (buffer-substring (point) (point-at-eol)))
1442         localname mode size month day hour min sec year mtime)
1443
1444     (if (not share)
1445
1446         ;; Read share entries.
1447         (when (string-match "^Disk|\\([^|]+\\)|" line)
1448           (setq localname (match-string 1 line)
1449                 mode "dr-xr-xr-x"
1450                 size 0))
1451
1452       ;; Real listing.
1453       (block nil
1454
1455         ;; year.
1456         (if (string-match "\\([0-9]+\\)$" line)
1457             (setq year (string-to-number (match-string 1 line))
1458                   line (substring line 0 -5))
1459           (return))
1460
1461         ;; time.
1462         (if (string-match "\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)$" line)
1463             (setq hour (string-to-number (match-string 1 line))
1464                   min  (string-to-number (match-string 2 line))
1465                   sec  (string-to-number (match-string 3 line))
1466                   line (substring line 0 -9))
1467           (return))
1468
1469         ;; day.
1470         (if (string-match "\\([0-9]+\\)$" line)
1471             (setq day  (string-to-number (match-string 1 line))
1472                   line (substring line 0 -3))
1473           (return))
1474
1475         ;; month.
1476         (if (string-match "\\(\\w+\\)$" line)
1477             (setq month (match-string 1 line)
1478                   line  (substring line 0 -4))
1479           (return))
1480
1481         ;; weekday.
1482         (if (string-match "\\(\\w+\\)$" line)
1483             (setq line (substring line 0 -5))
1484           (return))
1485
1486         ;; size.
1487         (if (string-match "\\([0-9]+\\)$" line)
1488             (let ((length (- (max 10 (1+ (length (match-string 1 line)))))))
1489               (setq size (string-to-number (match-string 1 line)))
1490               (when (string-match "\\([ADHRSV]+\\)" (substring line length))
1491                 (setq length (+ length (match-end 0))))
1492               (setq line (substring line 0 length)))
1493           (return))
1494
1495         ;; mode: ARCH, DIR, HIDDEN, RONLY, SYSTEM, VOLID.
1496         (if (string-match "\\([ADHRSV]+\\)?$" line)
1497             (setq
1498              mode (or (match-string 1 line) "")
1499              mode (save-match-data (format
1500                     "%s%s"
1501                     (if (string-match "D" mode) "d" "-")
1502                     (mapconcat
1503                      (lambda (_x) "") "    "
1504                      (concat "r" (if (string-match "R" mode) "-" "w") "x"))))
1505              line (substring line 0 -6))
1506           (return))
1507
1508         ;; localname.
1509         (if (string-match "^\\s-+\\(\\S-\\(.*\\S-\\)?\\)\\s-*$" line)
1510             (setq localname (match-string 1 line))
1511           (return))))
1512
1513     (when (and localname mode size)
1514       (setq mtime
1515             (if (and sec min hour day month year)
1516                 (encode-time
1517                  sec min hour day
1518                  (cdr (assoc (downcase month) tramp-parse-time-months))
1519                  year)
1520               '(0 0)))
1521       (list localname mode size mtime))))
1522
1523 (defun tramp-smb-get-cifs-capabilities (vec)
1524   "Check, whether the SMB server supports POSIX commands."
1525   ;; When we are not logged in yet, we return nil.
1526   (if (let ((p (tramp-get-connection-process vec)))
1527         (and p (processp p) (memq (process-status p) '(run open))))
1528       (with-tramp-connection-property
1529           (tramp-get-connection-process vec) "cifs-capabilities"
1530         (save-match-data
1531           (when (tramp-smb-send-command vec "posix")
1532             (with-current-buffer (tramp-get-connection-buffer vec)
1533               (goto-char (point-min))
1534               (when
1535                   (re-search-forward "Server supports CIFS capabilities" nil t)
1536                 (member
1537                  "pathnames"
1538                  (split-string
1539                   (buffer-substring (point) (point-at-eol)) nil t)))))))))
1540
1541 (defun tramp-smb-get-stat-capability (vec)
1542   "Check, whether the SMB server supports the STAT command."
1543   ;; When we are not logged in yet, we return nil.
1544   (if (let ((p (tramp-get-connection-process vec)))
1545         (and p (processp p) (memq (process-status p) '(run open))))
1546       (with-tramp-connection-property
1547           (tramp-get-connection-process vec) "stat-capability"
1548         (tramp-smb-send-command vec "stat ."))))
1549
1550
1551 ;; Connection functions.
1552
1553 (defun tramp-smb-send-command (vec command)
1554   "Send the COMMAND to connection VEC.
1555 Returns nil if there has been an error message from smbclient."
1556   (tramp-smb-maybe-open-connection vec)
1557   (tramp-message vec 6 "%s" command)
1558   (tramp-send-string vec command)
1559   (tramp-smb-wait-for-output vec))
1560
1561 (defun tramp-smb-maybe-open-connection (vec &optional argument)
1562   "Maybe open a connection to HOST, log in as USER, using `tramp-smb-program'.
1563 Does not do anything if a connection is already open, but re-opens the
1564 connection if a previous connection has died for some reason.
1565 If ARGUMENT is non-nil, use it as argument for
1566 `tramp-smb-winexe-program', and suppress any checks."
1567   (let* ((share (tramp-smb-get-share vec))
1568          (buf (tramp-get-connection-buffer vec))
1569          (p (get-buffer-process buf)))
1570
1571     ;; Check whether we still have the same smbclient version.
1572     ;; Otherwise, we must delete the connection cache, because
1573     ;; capabilities migh have changed.
1574     (unless (or argument (processp p))
1575       (let ((default-directory (tramp-compat-temporary-file-directory))
1576             (command (concat tramp-smb-program " -V")))
1577
1578         (unless tramp-smb-version
1579           (unless (executable-find tramp-smb-program)
1580             (tramp-error
1581              vec 'file-error
1582              "Cannot find command %s in %s" tramp-smb-program exec-path))
1583           (setq tramp-smb-version (shell-command-to-string command))
1584           (tramp-message vec 6 command)
1585           (tramp-message vec 6 "\n%s" tramp-smb-version)
1586           (if (string-match "[ \t\n\r]+\\'" tramp-smb-version)
1587               (setq tramp-smb-version
1588                     (replace-match "" nil nil tramp-smb-version))))
1589
1590         (unless (string-equal
1591                  tramp-smb-version
1592                  (tramp-get-connection-property
1593                   vec "smbclient-version" tramp-smb-version))
1594           (tramp-flush-directory-property vec "")
1595           (tramp-flush-connection-property vec))
1596
1597         (tramp-set-connection-property
1598          vec "smbclient-version" tramp-smb-version)))
1599
1600     ;; If too much time has passed since last command was sent, look
1601     ;; whether there has been an error message; maybe due to
1602     ;; connection timeout.
1603     (with-current-buffer buf
1604       (goto-char (point-min))
1605       (when (and (> (tramp-time-diff
1606                      (current-time)
1607                      (tramp-get-connection-property
1608                       p "last-cmd-time" '(0 0 0)))
1609                     60)
1610                  p (processp p) (memq (process-status p) '(run open))
1611                  (re-search-forward tramp-smb-errors nil t))
1612         (delete-process p)
1613         (setq p nil)))
1614
1615     ;; Check whether it is still the same share.
1616     (unless
1617         (and p (processp p) (memq (process-status p) '(run open))
1618              (or argument
1619                  (string-equal
1620                   share
1621                   (tramp-get-connection-property p "smb-share" ""))))
1622
1623       (save-match-data
1624         ;; There might be unread output from checking for share names.
1625         (when buf (with-current-buffer buf (erase-buffer)))
1626         (when (and p (processp p)) (delete-process p))
1627
1628         (let* ((user      (tramp-file-name-user vec))
1629                (host      (tramp-file-name-host vec))
1630                (real-user (tramp-file-name-real-user vec))
1631                (real-host (tramp-file-name-real-host vec))
1632                (domain    (tramp-file-name-domain vec))
1633                (port      (tramp-file-name-port vec))
1634                args)
1635
1636           (cond
1637            (argument
1638             (setq args (list (concat "//" real-host))))
1639            (share
1640             (setq args (list (concat "//" real-host "/" share))))
1641            (t
1642             (setq args (list "-g" "-L" real-host ))))
1643
1644           (if (not (zerop (length real-user)))
1645               (setq args (append args (list "-U" real-user)))
1646             (setq args (append args (list "-N"))))
1647
1648           (when domain (setq args (append args (list "-W" domain))))
1649           (when port   (setq args (append args (list "-p" port))))
1650           (when tramp-smb-conf
1651             (setq args (append args (list "-s" tramp-smb-conf))))
1652           (when argument
1653             (setq args (append args (list argument))))
1654
1655           ;; OK, let's go.
1656           (with-tramp-progress-reporter
1657               vec 3
1658               (format "Opening connection for //%s%s/%s"
1659                       (if (not (zerop (length user))) (concat user "@") "")
1660                       host (or share ""))
1661
1662             (let* ((coding-system-for-read nil)
1663                    (process-connection-type tramp-process-connection-type)
1664                    (p (let ((default-directory
1665                               (tramp-compat-temporary-file-directory)))
1666                         (apply #'start-process
1667                                (tramp-get-connection-name vec)
1668                                (tramp-get-connection-buffer vec)
1669                                (if argument
1670                                    tramp-smb-winexe-program tramp-smb-program)
1671                                args))))
1672
1673               (tramp-message
1674                vec 6 "%s" (mapconcat 'identity (process-command p) " "))
1675               (tramp-compat-set-process-query-on-exit-flag p nil)
1676
1677               ;; Set variables for computing the prompt for reading password.
1678               (setq tramp-current-method tramp-smb-method
1679                     tramp-current-user user
1680                     tramp-current-host host)
1681
1682               (condition-case err
1683                   (let (tramp-message-show-message)
1684                     ;; Play login scenario.
1685                     (tramp-process-actions
1686                      p vec nil
1687                      (if (or argument share)
1688                          tramp-smb-actions-with-share
1689                        tramp-smb-actions-without-share))
1690
1691                     ;; Check server version.
1692                     (unless argument
1693                       (with-current-buffer (tramp-get-connection-buffer vec)
1694                         (goto-char (point-min))
1695                         (search-forward-regexp tramp-smb-server-version nil t)
1696                         (let ((smbserver-version (match-string 0)))
1697                           (unless
1698                               (string-equal
1699                                smbserver-version
1700                                (tramp-get-connection-property
1701                                 vec "smbserver-version" smbserver-version))
1702                             (tramp-flush-directory-property vec "")
1703                             (tramp-flush-connection-property vec))
1704                           (tramp-set-connection-property
1705                            vec "smbserver-version" smbserver-version))))
1706
1707                     ;; Set chunksize to 1.  smbclient reads its input
1708                     ;; character by character; if we send the string
1709                     ;; at once, it is read painfully slow.
1710                     (tramp-set-connection-property p "smb-share" share)
1711                     (tramp-set-connection-property p "chunksize" 1))
1712
1713                 ;; Check for the error reason.  If it was due to wrong
1714                 ;; password, reestablish the connection.  We cannot
1715                 ;; handle this in `tramp-process-actions', because
1716                 ;; smbclient does not ask for the password, again.
1717                 (error
1718                  (with-current-buffer (tramp-get-connection-buffer vec)
1719                    (goto-char (point-min))
1720                    (if (search-forward-regexp
1721                         tramp-smb-wrong-passwd-regexp nil t)
1722                        ;; Disable `auth-source' and `password-cache'.
1723                        (let (auth-sources)
1724                          (tramp-cleanup vec)
1725                          (tramp-smb-maybe-open-connection vec argument))
1726                      ;; Propagate the error.
1727                      (signal (car err) (cdr err)))))))))))))
1728
1729 ;; We don't use timeouts.  If needed, the caller shall wrap around.
1730 (defun tramp-smb-wait-for-output (vec)
1731   "Wait for output from smbclient command.
1732 Returns nil if an error message has appeared."
1733   (with-current-buffer (tramp-get-connection-buffer vec)
1734     (let ((p (get-buffer-process (current-buffer)))
1735           (found (progn (goto-char (point-min))
1736                         (re-search-forward tramp-smb-prompt nil t)))
1737           (err   (progn (goto-char (point-min))
1738                         (re-search-forward tramp-smb-errors nil t)))
1739           buffer-read-only)
1740
1741       ;; Algorithm: get waiting output.  See if last line contains
1742       ;; `tramp-smb-prompt' sentinel or `tramp-smb-errors' strings.
1743       ;; If not, wait a bit and again get waiting output.
1744       (while (and (not found) (not err) (memq (process-status p) '(run open)))
1745
1746         ;; Accept pending output.
1747         (tramp-accept-process-output p 0.1)
1748
1749         ;; Search for prompt.
1750         (goto-char (point-min))
1751         (setq found (re-search-forward tramp-smb-prompt nil t))
1752
1753         ;; Search for errors.
1754         (goto-char (point-min))
1755         (setq err (re-search-forward tramp-smb-errors nil t)))
1756
1757       ;; When the process is still alive, read pending output.
1758       (while (and (not found) (memq (process-status p) '(run open)))
1759
1760         ;; Accept pending output.
1761         (tramp-accept-process-output p 0.1)
1762
1763         ;; Search for prompt.
1764         (goto-char (point-min))
1765         (setq found (re-search-forward tramp-smb-prompt nil t)))
1766
1767       (tramp-message vec 6 "\n%s" (buffer-string))
1768
1769       ;; Remove prompt.
1770       (when found
1771         (goto-char (point-max))
1772         (re-search-backward tramp-smb-prompt nil t)
1773         (delete-region (point) (point-max)))
1774
1775       ;; Return value is whether no error message has appeared.
1776       (not err))))
1777
1778 (defun tramp-smb-kill-winexe-function ()
1779   "Send SIGKILL to the winexe process."
1780   (ignore-errors
1781     (let ((p (get-buffer-process (current-buffer))))
1782       (when (and p (processp p) (memq (process-status p) '(run open)))
1783         (signal-process (process-id p) 'SIGINT)))))
1784
1785 (defun tramp-smb-call-winexe (vec)
1786   "Apply a remote command, if possible, using `tramp-smb-winexe-program'."
1787
1788   ;; We call `tramp-get-buffer' in order to get a debug buffer for
1789   ;; messages.
1790   (tramp-get-buffer vec)
1791
1792   ;; Check for program.
1793   (unless (executable-find tramp-smb-winexe-program)
1794     (tramp-error
1795      vec 'file-error "Cannot find program: %s" tramp-smb-winexe-program))
1796
1797   ;; winexe does not supports ports.
1798   (when (tramp-file-name-port vec)
1799     (tramp-error vec 'file-error "Port not supported for remote processes"))
1800
1801   (tramp-smb-maybe-open-connection
1802    vec
1803    (format
1804     "%s %s"
1805     tramp-smb-winexe-shell-command tramp-smb-winexe-shell-command-switch))
1806
1807   (set (make-local-variable 'kill-buffer-hook)
1808        '(tramp-smb-kill-winexe-function))
1809
1810   ;; Suppress "^M".  Shouldn't we specify utf8?
1811   (set-process-coding-system (tramp-get-connection-process vec) 'raw-text-dos)
1812
1813   ;; Set width to 128.  This avoids mixing prompt and long error messages.
1814   (tramp-smb-send-command vec "$rawui = (Get-Host).UI.RawUI")
1815   (tramp-smb-send-command vec "$bufsize = $rawui.BufferSize")
1816   (tramp-smb-send-command vec "$winsize = $rawui.WindowSize")
1817   (tramp-smb-send-command vec "$bufsize.Width = 128")
1818   (tramp-smb-send-command vec "$winsize.Width = 128")
1819   (tramp-smb-send-command vec "$rawui.BufferSize = $bufsize")
1820   (tramp-smb-send-command vec "$rawui.WindowSize = $winsize"))
1821
1822 (defun tramp-smb-shell-quote-argument (s)
1823   "Similar to `shell-quote-argument', but uses windows cmd syntax."
1824   (let ((system-type 'ms-dos))
1825     (shell-quote-argument s)))
1826
1827 (add-hook 'tramp-unload-hook
1828           (lambda ()
1829             (unload-feature 'tramp-smb 'force)))
1830
1831 (provide 'tramp-smb)
1832
1833 ;;; TODO:
1834
1835 ;; * Return more comprehensive file permission string.
1836 ;; * Try to remove the inclusion of dummy "" directory.  Seems to be at
1837 ;;   several places, especially in `tramp-smb-handle-insert-directory'.
1838 ;; * Ignore case in file names.
1839
1840 ;;; tramp-smb.el ends here