lisp/net/tramp-smb.el

   1 ;;; tramp-smb.el --- Tramp access functions for SMB servers
   2
   3 ;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008,
   4 ;;   2009, 2010 Free Software Foundation, Inc.
   5
   6 ;; Author: Michael Albinus <michael.albinus@gmx.de>
   7 ;; Keywords: comm, processes
   8 ;; Package: tramp
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software: you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation, either version 3 of the License, or
  15 ;; (at your option) any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  24
  25 ;;; Commentary:
  26
  27 ;; Access functions for SMB servers like SAMBA or M$ Windows from Tramp.
  28
  29 ;;; Code:
  30
  31 (eval-when-compile (require 'cl))       ; block, return
  32 (require 'tramp)
  33
  34 ;; Define SMB method ...
  35 ;;;###tramp-autoload
  36 (defconst tramp-smb-method "smb"
  37   "*Method to connect SAMBA and M$ SMB servers.")
  38
  39 ;; ... and add it to the method list.
  40 ;;;###tramp-autoload
  41 (unless (memq system-type '(cygwin windows-nt))
  42   (add-to-list 'tramp-methods (cons tramp-smb-method nil)))
  43
  44 ;; Add a default for `tramp-default-method-alist'. Rule: If there is
  45 ;; a domain in USER, it must be the SMB method.
  46 (add-to-list 'tramp-default-method-alist
  47              `(nil ,tramp-prefix-domain-regexp ,tramp-smb-method))
  48
  49 ;; Add a default for `tramp-default-user-alist'. Rule: For the SMB method,
  50 ;; the anonymous user is chosen.
  51 (add-to-list 'tramp-default-user-alist
  52              `(,tramp-smb-method nil ""))
  53
  54 ;; Add completion function for SMB method.
  55 (tramp-set-completion-function
  56  tramp-smb-method
  57  '((tramp-parse-netrc "~/.netrc")))
  58
  59 (defcustom tramp-smb-program "smbclient"
  60   "*Name of SMB client to run."
  61   :group 'tramp
  62   :type 'string)
  63
  64 (defcustom tramp-smb-conf "/dev/null"
  65   "*Path of the smb.conf file.
  66 If it is nil, no smb.conf will be added to the `tramp-smb-program'
  67 call, letting the SMB client use the default one."
  68   :group 'tramp
  69   :type '(choice (const nil) (file :must-match t)))
  70
  71 (defvar tramp-smb-version nil
  72   "*Version string of the SMB client.")
  73
  74 (defconst tramp-smb-prompt "^smb: .+> \\|^\\s-+Server\\s-+Comment$"
  75   "Regexp used as prompt in smbclient.")
  76
  77 (defconst tramp-smb-errors
  78   ;; `regexp-opt' not possible because of first string.
  79   (mapconcat
  80    'identity
  81    '(;; Connection error / timeout / unknown command.
  82      "Connection to \\S-+ failed"
  83      "Read from server failed, maybe it closed the connection"
  84      "Call timed out: server did not respond"
  85      "\\S-+: command not found"
  86      "Server doesn't support UNIX CIFS calls"
  87      ;; Samba.
  88      "ERRDOS"
  89      "ERRHRD"
  90      "ERRSRV"
  91      "ERRbadfile"
  92      "ERRbadpw"
  93      "ERRfilexists"
  94      "ERRnoaccess"
  95      "ERRnomem"
  96      "ERRnosuchshare"
  97      ;; Windows 4.0 (Windows NT), Windows 5.0 (Windows 2000),
  98      ;; Windows 5.1 (Windows XP), Windows 5.2 (Windows Server 2003).
  99      "NT_STATUS_ACCESS_DENIED"
 100      "NT_STATUS_ACCOUNT_LOCKED_OUT"
 101      "NT_STATUS_BAD_NETWORK_NAME"
 102      "NT_STATUS_CANNOT_DELETE"
 103      "NT_STATUS_CONNECTION_REFUSED"
 104      "NT_STATUS_DIRECTORY_NOT_EMPTY"
 105      "NT_STATUS_DUPLICATE_NAME"
 106      "NT_STATUS_FILE_IS_A_DIRECTORY"
 107      "NT_STATUS_LOGON_FAILURE"
 108      "NT_STATUS_NETWORK_ACCESS_DENIED"
 109      "NT_STATUS_NOT_IMPLEMENTED"
 110      "NT_STATUS_NO_SUCH_FILE"
 111      "NT_STATUS_OBJECT_NAME_COLLISION"
 112      "NT_STATUS_OBJECT_NAME_INVALID"
 113      "NT_STATUS_OBJECT_NAME_NOT_FOUND"
 114      "NT_STATUS_SHARING_VIOLATION"
 115      "NT_STATUS_TRUSTED_RELATIONSHIP_FAILURE"
 116      "NT_STATUS_WRONG_PASSWORD")
 117    "\\|")
 118   "Regexp for possible error strings of SMB servers.
 119 Used instead of analyzing error codes of commands.")
 120
 121 (defconst tramp-smb-actions-with-share
 122   '((tramp-smb-prompt tramp-action-succeed)
 123     (tramp-password-prompt-regexp tramp-action-password)
 124     (tramp-wrong-passwd-regexp tramp-action-permission-denied)
 125     (tramp-smb-errors tramp-action-permission-denied)
 126     (tramp-process-alive-regexp tramp-action-process-alive))
 127   "List of pattern/action pairs.
 128 This list is used for login to SMB servers.
 129
 130 See `tramp-actions-before-shell' for more info.")
 131
 132 (defconst tramp-smb-actions-without-share
 133   '((tramp-password-prompt-regexp tramp-action-password)
 134     (tramp-wrong-passwd-regexp tramp-action-permission-denied)
 135     (tramp-smb-errors tramp-action-permission-denied)
 136     (tramp-process-alive-regexp tramp-action-out-of-band))
 137   "List of pattern/action pairs.
 138 This list is used for login to SMB servers.
 139
 140 See `tramp-actions-before-shell' for more info.")
 141
 142 ;; New handlers should be added here.
 143 (defconst tramp-smb-file-name-handler-alist
 144   '(
 145     ;; `access-file' performed by default handler.
 146     (add-name-to-file . tramp-smb-handle-add-name-to-file)
 147     ;; `byte-compiler-base-file-name' performed by default handler.
 148     (copy-directory . tramp-smb-handle-copy-directory)
 149     (copy-file . tramp-smb-handle-copy-file)
 150     (delete-directory . tramp-smb-handle-delete-directory)
 151     (delete-file . tramp-smb-handle-delete-file)
 152     ;; `diff-latest-backup-file' performed by default handler.
 153     (directory-file-name . tramp-handle-directory-file-name)
 154     (directory-files . tramp-smb-handle-directory-files)
 155     (directory-files-and-attributes
 156      . tramp-handle-directory-files-and-attributes)
 157     (dired-call-process . ignore)
 158     (dired-compress-file . ignore)
 159     (dired-uncache . tramp-handle-dired-uncache)
 160     (expand-file-name . tramp-smb-handle-expand-file-name)
 161     (file-accessible-directory-p . tramp-smb-handle-file-directory-p)
 162     (file-attributes . tramp-smb-handle-file-attributes)
 163     (file-directory-p .  tramp-smb-handle-file-directory-p)
 164     (file-executable-p . tramp-handle-file-exists-p)
 165     (file-exists-p . tramp-handle-file-exists-p)
 166     (file-local-copy . tramp-smb-handle-file-local-copy)
 167     (file-modes . tramp-handle-file-modes)
 168     (file-name-all-completions . tramp-smb-handle-file-name-all-completions)
 169     (file-name-as-directory . tramp-handle-file-name-as-directory)
 170     (file-name-completion . tramp-handle-file-name-completion)
 171     (file-name-directory . tramp-handle-file-name-directory)
 172     (file-name-nondirectory . tramp-handle-file-name-nondirectory)
 173     ;; `file-name-sans-versions' performed by default handler.
 174     (file-newer-than-file-p . tramp-handle-file-newer-than-file-p)
 175     (file-ownership-preserved-p . ignore)
 176     (file-readable-p . tramp-handle-file-exists-p)
 177     (file-regular-p . tramp-handle-file-regular-p)
 178     (file-remote-p . tramp-handle-file-remote-p)
 179     ;; `file-selinux-context' performed by default handler.
 180     (file-symlink-p . tramp-handle-file-symlink-p)
 181     ;; `file-truename' performed by default handler.
 182     (file-writable-p . tramp-smb-handle-file-writable-p)
 183     (find-backup-file-name . tramp-handle-find-backup-file-name)
 184     ;; `find-file-noselect' performed by default handler.
 185     ;; `get-file-buffer' performed by default handler.
 186     (insert-directory . tramp-smb-handle-insert-directory)
 187     (insert-file-contents . tramp-handle-insert-file-contents)
 188     (load . tramp-handle-load)
 189     (make-directory . tramp-smb-handle-make-directory)
 190     (make-directory-internal . tramp-smb-handle-make-directory-internal)
 191     (make-symbolic-link . tramp-smb-handle-make-symbolic-link)
 192     (rename-file . tramp-smb-handle-rename-file)
 193     (set-file-modes . tramp-smb-handle-set-file-modes)
 194     ;; `set-file-selinux-context' performed by default handler.
 195     (set-file-times . ignore)
 196     (set-visited-file-modtime . ignore)
 197     (shell-command . ignore)
 198     (substitute-in-file-name . tramp-smb-handle-substitute-in-file-name)
 199     (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory)
 200     (vc-registered . ignore)
 201     (verify-visited-file-modtime . ignore)
 202     (write-region . tramp-smb-handle-write-region)
 203 )
 204   "Alist of handler functions for Tramp SMB method.
 205 Operations not mentioned here will be handled by the default Emacs primitives.")
 206
 207 ;;;###tramp-autoload
 208 (defsubst tramp-smb-file-name-p (filename)
 209   "Check if it's a filename for SMB servers."
 210   (let ((v (tramp-dissect-file-name filename)))
 211     (string= (tramp-file-name-method v) tramp-smb-method)))
 212
 213 ;;;###tramp-autoload
 214 (defun tramp-smb-file-name-handler (operation &rest args)
 215   "Invoke the SMB related OPERATION.
 216 First arg specifies the OPERATION, second arg is a list of arguments to
 217 pass to the OPERATION."
 218   (let ((fn (assoc operation tramp-smb-file-name-handler-alist)))
 219     (if fn
 220         (save-match-data (apply (cdr fn) args))
 221       (tramp-run-real-handler operation args))))
 222
 223 ;;;###tramp-autoload
 224 (unless (memq system-type '(cygwin windows-nt))
 225   (add-to-list 'tramp-foreign-file-name-handler-alist
 226                (cons 'tramp-smb-file-name-p 'tramp-smb-file-name-handler)))
 227
 228
 229 ;; File name primitives.
 230
 231 (defun tramp-smb-handle-add-name-to-file
 232   (filename newname &optional ok-if-already-exists)
 233   "Like `add-name-to-file' for Tramp files."
 234   (unless (tramp-equal-remote filename newname)
 235     (with-parsed-tramp-file-name
 236         (if (tramp-tramp-file-p filename) filename newname) nil
 237       (tramp-error
 238        v 'file-error
 239        "add-name-to-file: %s"
 240        "only implemented for same method, same user, same host")))
 241   (with-parsed-tramp-file-name filename v1
 242     (with-parsed-tramp-file-name newname v2
 243       (when (file-directory-p filename)
 244         (tramp-error
 245          v2 'file-error
 246          "add-name-to-file: %s must not be a directory" filename))
 247       (when (and (not ok-if-already-exists)
 248                  (file-exists-p newname)
 249                  (not (numberp ok-if-already-exists))
 250                  (y-or-n-p
 251                   (format
 252                    "File %s already exists; make it a new name anyway? "
 253                    newname)))
 254         (tramp-error
 255          v2 'file-error
 256          "add-name-to-file: file %s already exists" newname))
 257       ;; We must also flush the cache of the directory, because
 258       ;; `file-attributes' reads the values from there.
 259       (tramp-flush-file-property v2 (file-name-directory v2-localname))
 260       (tramp-flush-file-property v2 v2-localname)
 261       (unless
 262           (tramp-smb-send-command
 263            v1
 264            (format
 265             "%s \"%s\" \"%s\""
 266             (if (tramp-smb-get-cifs-capabilities v1) "link" "hardlink")
 267             (tramp-smb-get-localname v1)
 268             (tramp-smb-get-localname v2)))
 269         (tramp-error
 270          v2 'file-error
 271          "error with add-name-to-file, see buffer `%s' for details"
 272          (buffer-name))))))
 273
 274 (defun tramp-smb-handle-copy-directory
 275   (dirname newname &optional keep-date parents)
 276   "Like `copy-directory' for Tramp files.  KEEP-DATE is not handled."
 277   (setq dirname (expand-file-name dirname)
 278         newname (expand-file-name newname))
 279   (let ((t1 (tramp-tramp-file-p dirname))
 280         (t2 (tramp-tramp-file-p newname)))
 281     (with-parsed-tramp-file-name (if t1 dirname newname) nil
 282       (cond
 283        ;; We must use a local temporary directory.
 284        ((and t1 t2)
 285         (let ((tmpdir
 286                (make-temp-name
 287                 (expand-file-name
 288                  tramp-temp-name-prefix
 289                  (tramp-compat-temporary-file-directory)))))
 290           (unwind-protect
 291               (progn
 292                 (tramp-compat-copy-directory dirname tmpdir keep-date parents)
 293                 (tramp-compat-copy-directory tmpdir newname keep-date parents))
 294             (tramp-compat-delete-directory tmpdir 'recursive))))
 295
 296        ;; We can copy recursively.
 297        ((or t1 t2)
 298         (let ((prompt (tramp-smb-send-command v "prompt"))
 299               (recurse (tramp-smb-send-command v "recurse")))
 300           (unless (file-directory-p newname)
 301             (make-directory newname parents))
 302           (unwind-protect
 303               (unless
 304                   (and
 305                    prompt recurse
 306                    (tramp-smb-send-command
 307                     v (format "cd \"%s\"" (tramp-smb-get-localname v)))
 308                    (tramp-smb-send-command
 309                     v (format "lcd \"%s\"" (if t1 newname dirname)))
 310                    (if t1
 311                        (tramp-smb-send-command v "mget *")
 312                      (tramp-smb-send-command v "mput *")))
 313                 ;; Error.
 314                 (with-current-buffer (tramp-get-connection-buffer v)
 315                   (goto-char (point-min))
 316                   (search-forward-regexp tramp-smb-errors nil t)
 317                   (tramp-error
 318                    v 'file-error
 319                    "%s `%s'" (match-string 0) (if t1 dirname newname))))
 320             ;; Go home.
 321             (tramp-smb-send-command
 322              v (format
 323                 "cd %s" (if (tramp-smb-get-cifs-capabilities v) "/" "\\")))
 324             ;; Toggle prompt and recurse OFF.
 325             (if prompt (tramp-smb-send-command v "prompt"))
 326             (if recurse (tramp-smb-send-command v "recurse")))))
 327
 328        ;; We must do it file-wise.
 329        (t
 330         (tramp-run-real-handler
 331          'copy-directory (list dirname newname keep-date parents)))))))
 332
 333 (defun tramp-smb-handle-copy-file
 334   (filename newname &optional ok-if-already-exists keep-date
 335             preserve-uid-gid preserve-selinux-context)
 336   "Like `copy-file' for Tramp files.
 337 KEEP-DATE is not handled in case NEWNAME resides on an SMB server.
 338 PRESERVE-UID-GID is completely ignored."
 339   (setq filename (expand-file-name filename)
 340         newname (expand-file-name newname))
 341   (with-progress-reporter
 342       (tramp-dissect-file-name (if (file-remote-p filename) filename newname))
 343       0 (format "Copying %s to %s" filename newname)
 344
 345     (let ((tmpfile (file-local-copy filename)))
 346
 347       (if tmpfile
 348           ;; Remote filename.
 349           (condition-case err
 350               (rename-file tmpfile newname ok-if-already-exists)
 351             ((error quit)
 352              (delete-file tmpfile)
 353              (signal (car err) (cdr err))))
 354
 355         ;; Remote newname.
 356         (when (file-directory-p newname)
 357           (setq newname
 358                 (expand-file-name (file-name-nondirectory filename) newname)))
 359
 360         (with-parsed-tramp-file-name newname nil
 361           (when (and (not ok-if-already-exists)
 362                      (file-exists-p newname))
 363             (tramp-error v 'file-already-exists newname))
 364
 365           ;; We must also flush the cache of the directory, because
 366           ;; `file-attributes' reads the values from there.
 367           (tramp-flush-file-property v (file-name-directory localname))
 368           (tramp-flush-file-property v localname)
 369           (unless (tramp-smb-get-share v)
 370             (tramp-error
 371              v 'file-error "Target `%s' must contain a share name" newname))
 372           (unless (tramp-smb-send-command
 373                    v (format "put \"%s\" \"%s\""
 374                              filename (tramp-smb-get-localname v)))
 375             (tramp-error v 'file-error "Cannot copy `%s'" filename))))))
 376
 377   ;; KEEP-DATE handling.
 378   (when keep-date (set-file-times newname (nth 5 (file-attributes filename)))))
 379
 380 (defun tramp-smb-handle-delete-directory (directory &optional recursive)
 381   "Like `delete-directory' for Tramp files."
 382   (setq directory (directory-file-name (expand-file-name directory)))
 383   (when (file-exists-p directory)
 384     (if recursive
 385         (mapc
 386          (lambda (file)
 387            (if (file-directory-p file)
 388                (tramp-compat-delete-directory file recursive)
 389              (delete-file file)))
 390          ;; We do not want to delete "." and "..".
 391          (directory-files
 392           directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")))
 393
 394     (with-parsed-tramp-file-name directory nil
 395       ;; We must also flush the cache of the directory, because
 396       ;; `file-attributes' reads the values from there.
 397       (tramp-flush-file-property v (file-name-directory localname))
 398       (tramp-flush-directory-property v localname)
 399       (unless (tramp-smb-send-command
 400                v (format
 401                   "%s \"%s\""
 402                   (if (tramp-smb-get-cifs-capabilities v) "posix_rmdir" "rmdir")
 403                   (tramp-smb-get-localname v)))
 404         ;; Error.
 405         (with-current-buffer (tramp-get-connection-buffer v)
 406           (goto-char (point-min))
 407           (search-forward-regexp tramp-smb-errors nil t)
 408           (tramp-error
 409            v 'file-error "%s `%s'" (match-string 0) directory))))))
 410
 411 (defun tramp-smb-handle-delete-file (filename &optional trash)
 412   "Like `delete-file' for Tramp files."
 413   (setq filename (expand-file-name filename))
 414   (when (file-exists-p filename)
 415     (with-parsed-tramp-file-name filename nil
 416       ;; We must also flush the cache of the directory, because
 417       ;; `file-attributes' reads the values from there.
 418       (tramp-flush-file-property v (file-name-directory localname))
 419       (tramp-flush-file-property v localname)
 420       (unless (tramp-smb-send-command
 421                v (format
 422                   "%s \"%s\""
 423                   (if (tramp-smb-get-cifs-capabilities v) "posix_unlink" "rm")
 424                   (tramp-smb-get-localname v)))
 425         ;; Error.
 426         (with-current-buffer (tramp-get-connection-buffer v)
 427           (goto-char (point-min))
 428           (search-forward-regexp tramp-smb-errors nil t)
 429           (tramp-error
 430            v 'file-error "%s `%s'" (match-string 0) filename))))))
 431
 432 (defun tramp-smb-handle-directory-files
 433   (directory &optional full match nosort)
 434   "Like `directory-files' for Tramp files."
 435   (let ((result (mapcar 'directory-file-name
 436                         (file-name-all-completions "" directory))))
 437     ;; Discriminate with regexp.
 438     (when match
 439       (setq result
 440             (delete nil
 441                     (mapcar (lambda (x) (when (string-match match x) x))
 442                             result))))
 443     ;; Append directory.
 444     (when full
 445       (setq result
 446             (mapcar
 447              (lambda (x) (expand-file-name x directory))
 448              result)))
 449     ;; Sort them if necessary.
 450     (unless nosort (setq result (sort result 'string-lessp)))
 451     ;; That's it.
 452     result))
 453
 454 (defun tramp-smb-handle-expand-file-name (name &optional dir)
 455   "Like `expand-file-name' for Tramp files."
 456   ;; If DIR is not given, use DEFAULT-DIRECTORY or "/".
 457   (setq dir (or dir default-directory "/"))
 458   ;; Unless NAME is absolute, concat DIR and NAME.
 459   (unless (file-name-absolute-p name)
 460     (setq name (concat (file-name-as-directory dir) name)))
 461   ;; If NAME is not a Tramp file, run the real handler.
 462   (if (not (tramp-tramp-file-p name))
 463       (tramp-run-real-handler 'expand-file-name (list name nil))
 464     ;; Dissect NAME.
 465     (with-parsed-tramp-file-name name nil
 466       ;; Tilde expansion if necessary.  We use the user name as share,
 467       ;; which is offen the case in domains.
 468       (when (string-match "\\`/?~\\([^/]*\\)" localname)
 469         (setq localname
 470               (replace-match
 471                (if (zerop (length (match-string 1 localname)))
 472                    (tramp-file-name-real-user v)
 473                  (match-string 1 localname))
 474                nil nil localname)))
 475       ;; Make the file name absolute.
 476       (unless (tramp-run-real-handler 'file-name-absolute-p (list localname))
 477         (setq localname (concat "/" localname)))
 478       ;; No tilde characters in file name, do normal
 479       ;; `expand-file-name' (this does "/./" and "/../").
 480       (tramp-make-tramp-file-name
 481        method user host
 482        (tramp-run-real-handler 'expand-file-name (list localname))))))
 483
 484 (defun tramp-smb-handle-file-attributes (filename &optional id-format)
 485   "Like `file-attributes' for Tramp files."
 486   (unless id-format (setq id-format 'integer))
 487   (with-parsed-tramp-file-name filename nil
 488     (with-file-property v localname (format "file-attributes-%s" id-format)
 489       (if (and (tramp-smb-get-share v) (tramp-smb-get-stat-capability v))
 490           (tramp-smb-do-file-attributes-with-stat v id-format)
 491         ;; Reading just the filename entry via "dir localname" is not
 492         ;; possible, because when filename is a directory, some
 493         ;; smbclient versions return the content of the directory, and
 494         ;; other versions don't.  Therefore, the whole content of the
 495         ;; upper directory is retrieved, and the entry of the filename
 496         ;; is extracted from.
 497         (let* ((entries (tramp-smb-get-file-entries
 498                          (file-name-directory filename)))
 499                (entry (assoc (file-name-nondirectory filename) entries))
 500                (uid (if (equal id-format 'string) "nobody" -1))
 501                (gid (if (equal id-format 'string) "nogroup" -1))
 502                (inode (tramp-get-inode v))
 503                (device (tramp-get-device v)))
 504
 505           ;; Check result.
 506           (when entry
 507             (list (and (string-match "d" (nth 1 entry))
 508                        t)       ;0 file type
 509                   -1            ;1 link count
 510                   uid           ;2 uid
 511                   gid           ;3 gid
 512                   '(0 0)        ;4 atime
 513                   (nth 3 entry) ;5 mtime
 514                   '(0 0)        ;6 ctime
 515                   (nth 2 entry) ;7 size
 516                   (nth 1 entry) ;8 mode
 517                   nil           ;9 gid weird
 518                   inode         ;10 inode number
 519                   device))))))) ;11 file system number
 520
 521 (defun tramp-smb-do-file-attributes-with-stat (vec &optional id-format)
 522   "Implement `file-attributes' for Tramp files using stat command."
 523   (tramp-message
 524    vec 5 "file attributes with stat: %s" (tramp-file-name-localname vec))
 525   (with-current-buffer (tramp-get-buffer vec)
 526     (let* (size id link uid gid atime mtime ctime mode inode)
 527       (when (tramp-smb-send-command
 528              vec (format "stat \"%s\"" (tramp-smb-get-localname vec)))
 529
 530         ;; Loop the listing.
 531         (goto-char (point-min))
 532         (unless (re-search-forward tramp-smb-errors nil t)
 533           (while (not (eobp))
 534             (cond
 535              ((looking-at
 536                "Size:\\s-+\\([0-9]+\\)\\s-+Blocks:\\s-+[0-9]+\\s-+\\(\\w+\\)")
 537               (setq size (string-to-number (match-string 1))
 538                     id (if (string-equal "directory" (match-string 2)) t
 539                          (if (string-equal "symbolic" (match-string 2)) ""))))
 540              ((looking-at
 541                "Inode:\\s-+\\([0-9]+\\)\\s-+Links:\\s-+\\([0-9]+\\)")
 542               (setq inode (string-to-number (match-string 1))
 543                     link (string-to-number (match-string 2))))
 544              ((looking-at
 545                "Access:\\s-+([0-9]+/\\(\\S-+\\))\\s-+Uid:\\s-+\\([0-9]+\\)\\s-+Gid:\\s-+\\([0-9]+\\)")
 546               (setq mode (match-string 1)
 547                     uid (if (equal id-format 'string) (match-string 2)
 548                           (string-to-number (match-string 2)))
 549                     gid (if (equal id-format 'string) (match-string 3)
 550                           (string-to-number (match-string 3)))))
 551              ((looking-at
 552                "Access:\\s-+\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)\\s-+\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)")
 553               (setq atime
 554                     (encode-time
 555                      (string-to-number (match-string 6)) ;; sec
 556                      (string-to-number (match-string 5)) ;; min
 557                      (string-to-number (match-string 4)) ;; hour
 558                      (string-to-number (match-string 3)) ;; day
 559                      (string-to-number (match-string 2)) ;; month
 560                      (string-to-number (match-string 1))))) ;; year
 561              ((looking-at
 562                "Modify:\\s-+\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)\\s-+\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)")
 563               (setq mtime
 564                     (encode-time
 565                      (string-to-number (match-string 6)) ;; sec
 566                      (string-to-number (match-string 5)) ;; min
 567                      (string-to-number (match-string 4)) ;; hour
 568                      (string-to-number (match-string 3)) ;; day
 569                      (string-to-number (match-string 2)) ;; month
 570                      (string-to-number (match-string 1))))) ;; year
 571              ((looking-at
 572                "Change:\\s-+\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)\\s-+\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)")
 573               (setq ctime
 574                     (encode-time
 575                      (string-to-number (match-string 6)) ;; sec
 576                      (string-to-number (match-string 5)) ;; min
 577                      (string-to-number (match-string 4)) ;; hour
 578                      (string-to-number (match-string 3)) ;; day
 579                      (string-to-number (match-string 2)) ;; month
 580                      (string-to-number (match-string 1)))))) ;; year
 581             (forward-line))
 582           ;; Return the result.
 583           (list id link uid gid atime mtime ctime size mode nil inode
 584                 (tramp-get-device vec)))))))
 585
 586 (defun tramp-smb-handle-file-directory-p (filename)
 587   "Like `file-directory-p' for Tramp files."
 588   (and (file-exists-p filename)
 589        (eq ?d (aref (nth 8 (file-attributes filename)) 0))))
 590
 591 (defun tramp-smb-handle-file-local-copy (filename)
 592   "Like `file-local-copy' for Tramp files."
 593   (with-parsed-tramp-file-name filename nil
 594     (unless (file-exists-p filename)
 595       (tramp-error
 596        v 'file-error
 597        "Cannot make local copy of non-existing file `%s'" filename))
 598     (let ((tmpfile (tramp-compat-make-temp-file filename)))
 599       (with-progress-reporter
 600           v 3 (format "Fetching %s to tmp file %s" filename tmpfile)
 601         (unless (tramp-smb-send-command
 602                  v (format "get \"%s\" \"%s\""
 603                            (tramp-smb-get-localname v) tmpfile))
 604           ;; Oops, an error.  We shall cleanup.
 605           (delete-file tmpfile)
 606           (tramp-error
 607            v 'file-error "Cannot make local copy of file `%s'" filename)))
 608       tmpfile)))
 609
 610 ;; This function should return "foo/" for directories and "bar" for
 611 ;; files.
 612 (defun tramp-smb-handle-file-name-all-completions (filename directory)
 613   "Like `file-name-all-completions' for Tramp files."
 614   (all-completions
 615    filename
 616    (with-parsed-tramp-file-name directory nil
 617      (with-file-property v localname "file-name-all-completions"
 618        (save-match-data
 619          (let ((entries (tramp-smb-get-file-entries directory)))
 620            (mapcar
 621             (lambda (x)
 622               (list
 623                (if (string-match "d" (nth 1 x))
 624                    (file-name-as-directory (nth 0 x))
 625                  (nth 0 x))))
 626             entries)))))))
 627
 628 (defun tramp-smb-handle-file-writable-p (filename)
 629   "Like `file-writable-p' for Tramp files."
 630   (if (file-exists-p filename)
 631       (string-match "w" (or (nth 8 (file-attributes filename)) ""))
 632     (let ((dir (file-name-directory filename)))
 633       (and (file-exists-p dir)
 634            (file-writable-p dir)))))
 635
 636 (defun tramp-smb-handle-insert-directory
 637   (filename switches &optional wildcard full-directory-p)
 638   "Like `insert-directory' for Tramp files."
 639   (setq filename (expand-file-name filename))
 640   (if full-directory-p
 641       ;; Called from `dired-add-entry'.
 642       (setq filename (file-name-as-directory filename))
 643     (setq filename (directory-file-name filename)))
 644   (with-parsed-tramp-file-name filename nil
 645     (save-match-data
 646       (let ((base (file-name-nondirectory filename))
 647             ;; We should not destroy the cache entry.
 648             (entries (copy-sequence
 649                       (tramp-smb-get-file-entries
 650                        (file-name-directory filename)))))
 651
 652         (when wildcard
 653           (string-match "\\." base)
 654           (setq base (replace-match "\\\\." nil nil base))
 655           (string-match "\\*" base)
 656           (setq base (replace-match ".*" nil nil base))
 657           (string-match "\\?" base)
 658           (setq base (replace-match ".?" nil nil base)))
 659
 660         ;; Filter entries.
 661         (setq entries
 662               (delq
 663                nil
 664                (if (or wildcard (zerop (length base)))
 665                    ;; Check for matching entries.
 666                    (mapcar
 667                     (lambda (x)
 668                       (when (string-match
 669                              (format "^%s" base) (nth 0 x))
 670                         x))
 671                     entries)
 672                  ;; We just need the only and only entry FILENAME.
 673                  (list (assoc base entries)))))
 674
 675         ;; Sort entries.
 676         (setq entries
 677               (sort
 678                entries
 679                (lambda (x y)
 680                  (if (string-match "t" switches)
 681                      ;; Sort by date.
 682                      (tramp-time-less-p (nth 3 y) (nth 3 x))
 683                    ;; Sort by name.
 684                    (string-lessp (nth 0 x) (nth 0 y))))))
 685
 686         ;; Handle "-F" switch.
 687         (when (string-match "F" switches)
 688           (mapc
 689            (lambda (x)
 690              (when (not (zerop (length (car x))))
 691                (cond
 692                 ((char-equal ?d (string-to-char (nth 1 x)))
 693                  (setcar x (concat (car x) "/")))
 694                 ((char-equal ?x (string-to-char (nth 1 x)))
 695                  (setcar x (concat (car x) "*"))))))
 696            entries))
 697
 698         ;; Print entries.
 699         (mapc
 700          (lambda (x)
 701            (when (not (zerop (length (nth 0 x))))
 702              (let ((attr
 703                     (when (tramp-smb-get-stat-capability v)
 704                       (ignore-errors
 705                         (file-attributes filename 'string)))))
 706                (insert
 707                 (format
 708                  "%10s %3d %-8s %-8s %8s %s "
 709                  (or (nth 8 attr) (nth 1 x)) ; mode
 710                  (or (nth 1 attr) 1) ; inode
 711                  (or (nth 2 attr) "nobody") ; uid
 712                  (or (nth 3 attr) "nogroup") ; gid
 713                  (or (nth 7 attr) (nth 2 x)) ; size
 714                  (format-time-string
 715                   (if (tramp-time-less-p
 716                        (tramp-time-subtract (current-time) (nth 3 x))
 717                        tramp-half-a-year)
 718                       "%b %e %R"
 719                     "%b %e  %Y")
 720                   (nth 3 x)))) ; date
 721                ;; We mark the file name.  The inserted name could be
 722                ;; from somewhere else, so we use the relative file
 723                ;; name of `default-directory'.
 724                (let ((start (point)))
 725                  (insert
 726                   (format
 727                    "%s\n"
 728                    (file-relative-name
 729                     (expand-file-name
 730                      (nth 0 x) (file-name-directory filename)))))
 731                  (put-text-property start (1- (point)) 'dired-filename t))
 732                (forward-line)
 733                (beginning-of-line))))
 734          entries)))))
 735
 736 (defun tramp-smb-handle-make-directory (dir &optional parents)
 737   "Like `make-directory' for Tramp files."
 738   (setq dir (directory-file-name (expand-file-name dir)))
 739   (unless (file-name-absolute-p dir)
 740     (setq dir (expand-file-name dir default-directory)))
 741   (with-parsed-tramp-file-name dir nil
 742     (save-match-data
 743       (let* ((ldir (file-name-directory dir)))
 744         ;; Make missing directory parts.
 745         (when (and parents
 746                    (tramp-smb-get-share v)
 747                    (not (file-directory-p ldir)))
 748           (make-directory ldir parents))
 749         ;; Just do it.
 750         (when (file-directory-p ldir)
 751           (make-directory-internal dir))
 752         (unless (file-directory-p dir)
 753           (tramp-error v 'file-error "Couldn't make directory %s" dir))))))
 754
 755 (defun tramp-smb-handle-make-directory-internal (directory)
 756   "Like `make-directory-internal' for Tramp files."
 757   (setq directory (directory-file-name (expand-file-name directory)))
 758   (unless (file-name-absolute-p directory)
 759     (setq directory (expand-file-name directory default-directory)))
 760   (with-parsed-tramp-file-name directory nil
 761     (save-match-data
 762       (let* ((file (tramp-smb-get-localname v)))
 763         (when (file-directory-p (file-name-directory directory))
 764           (tramp-smb-send-command
 765            v
 766            (if (tramp-smb-get-cifs-capabilities v)
 767                (format
 768                 "posix_mkdir \"%s\" %s"
 769                 file (tramp-compat-decimal-to-octal (default-file-modes)))
 770              (format "mkdir \"%s\"" file)))
 771           ;; We must also flush the cache of the directory, because
 772           ;; `file-attributes' reads the values from there.
 773           (tramp-flush-file-property v (file-name-directory localname))
 774           (tramp-flush-file-property v localname))
 775         (unless (file-directory-p directory)
 776           (tramp-error
 777            v 'file-error "Couldn't make directory %s" directory))))))
 778
 779 (defun tramp-smb-handle-make-symbolic-link
 780   (filename linkname &optional ok-if-already-exists)
 781   "Like `make-symbolic-link' for Tramp files.
 782 If LINKNAME is a non-Tramp file, it is used verbatim as the target of
 783 the symlink.  If LINKNAME is a Tramp file, only the localname component is
 784 used as the target of the symlink.
 785
 786 If LINKNAME is a Tramp file and the localname component is relative, then
 787 it is expanded first, before the localname component is taken.  Note that
 788 this can give surprising results if the user/host for the source and
 789 target of the symlink differ."
 790   (unless (tramp-equal-remote filename linkname)
 791     (with-parsed-tramp-file-name
 792         (if (tramp-tramp-file-p filename) filename linkname) nil
 793       (tramp-error
 794        v 'file-error
 795        "make-symbolic-link: %s"
 796        "only implemented for same method, same user, same host")))
 797   (with-parsed-tramp-file-name filename v1
 798     (with-parsed-tramp-file-name linkname v2
 799       (when (file-directory-p filename)
 800         (tramp-error
 801          v2 'file-error
 802          "make-symbolic-link: %s must not be a directory" filename))
 803       (when (and (not ok-if-already-exists)
 804                  (file-exists-p linkname)
 805                  (not (numberp ok-if-already-exists))
 806                  (y-or-n-p
 807                   (format
 808                    "File %s already exists; make it a new name anyway? "
 809                    linkname)))
 810         (tramp-error
 811          v2 'file-error
 812          "make-symbolic-link: file %s already exists" linkname))
 813       (unless (tramp-smb-get-cifs-capabilities v1)
 814         (tramp-error v2 'file-error "make-symbolic-link not supported"))
 815       ;; We must also flush the cache of the directory, because
 816       ;; `file-attributes' reads the values from there.
 817       (tramp-flush-file-property v2 (file-name-directory v2-localname))
 818       (tramp-flush-file-property v2 v2-localname)
 819       (unless
 820           (tramp-smb-send-command
 821            v1
 822            (format
 823             "symlink \"%s\" \"%s\""
 824             (tramp-smb-get-localname v1)
 825             (tramp-smb-get-localname v2)))
 826         (tramp-error
 827          v2 'file-error
 828          "error with make-symbolic-link, see buffer `%s' for details"
 829          (buffer-name))))))
 830
 831 (defun tramp-smb-handle-rename-file
 832   (filename newname &optional ok-if-already-exists)
 833   "Like `rename-file' for Tramp files."
 834   (setq filename (expand-file-name filename)
 835         newname (expand-file-name newname))
 836   (with-progress-reporter
 837       (tramp-dissect-file-name (if (file-remote-p filename) filename newname))
 838       0 (format "Renaming %s to %s" filename newname)
 839
 840     (let ((tmpfile (file-local-copy filename)))
 841
 842       (if tmpfile
 843           ;; Remote filename.
 844           (condition-case err
 845               (rename-file tmpfile newname ok-if-already-exists)
 846             ((error quit)
 847              (delete-file tmpfile)
 848              (signal (car err) (cdr err))))
 849
 850         ;; Remote newname.
 851         (when (file-directory-p newname)
 852           (setq newname (expand-file-name
 853                          (file-name-nondirectory filename) newname)))
 854
 855         (with-parsed-tramp-file-name newname nil
 856           (when (and (not ok-if-already-exists)
 857                      (file-exists-p newname))
 858             (tramp-error v 'file-already-exists newname))
 859           ;; We must also flush the cache of the directory, because
 860           ;; `file-attributes' reads the values from there.
 861           (tramp-flush-file-property v (file-name-directory localname))
 862           (tramp-flush-file-property v localname)
 863           (unless (tramp-smb-send-command
 864                    v (format "put %s \"%s\""
 865                              filename (tramp-smb-get-localname v)))
 866             (tramp-error v 'file-error "Cannot rename `%s'" filename)))))
 867
 868     (delete-file filename)))
 869
 870 (defun tramp-smb-handle-set-file-modes (filename mode)
 871   "Like `set-file-modes' for Tramp files."
 872   (with-parsed-tramp-file-name filename nil
 873     (when (tramp-smb-get-cifs-capabilities v)
 874       (tramp-flush-file-property v localname)
 875       (unless (tramp-smb-send-command
 876                v (format "chmod \"%s\" %s"
 877                          (tramp-smb-get-localname v)
 878                          (tramp-compat-decimal-to-octal mode)))
 879         (tramp-error
 880          v 'file-error "Error while changing file's mode %s" filename)))))
 881
 882 (defun tramp-smb-handle-substitute-in-file-name (filename)
 883   "Like `handle-substitute-in-file-name' for Tramp files.
 884 \"//\" substitutes only in the local filename part.  Catches
 885 errors for shares like \"C$/\", which are common in Microsoft Windows."
 886   (with-parsed-tramp-file-name filename nil
 887     ;; Ignore in LOCALNAME everything before "//".
 888     (when (and (stringp localname) (string-match ".+?/\\(/\\|~\\)" localname))
 889       (setq filename
 890             (concat (file-remote-p filename)
 891                     (replace-match "\\1" nil nil localname)))))
 892   (condition-case nil
 893       (tramp-run-real-handler 'substitute-in-file-name (list filename))
 894     (error filename)))
 895
 896 (defun tramp-smb-handle-write-region
 897   (start end filename &optional append visit lockname confirm)
 898   "Like `write-region' for Tramp files."
 899   (setq filename (expand-file-name filename))
 900   (with-parsed-tramp-file-name filename nil
 901     (unless (eq append nil)
 902       (tramp-error
 903          v 'file-error "Cannot append to file using Tramp (`%s')" filename))
 904     ;; XEmacs takes a coding system as the seventh argument, not `confirm'.
 905     (when (and (not (featurep 'xemacs))
 906                confirm (file-exists-p filename))
 907       (unless (y-or-n-p (format "File %s exists; overwrite anyway? "
 908                                 filename))
 909         (tramp-error v 'file-error "File not overwritten")))
 910     ;; We must also flush the cache of the directory, because
 911     ;; `file-attributes' reads the values from there.
 912     (tramp-flush-file-property v (file-name-directory localname))
 913     (tramp-flush-file-property v localname)
 914     (let ((curbuf (current-buffer))
 915           (tmpfile (tramp-compat-make-temp-file filename)))
 916       ;; We say `no-message' here because we don't want the visited file
 917       ;; modtime data to be clobbered from the temp file.  We call
 918       ;; `set-visited-file-modtime' ourselves later on.
 919       (tramp-run-real-handler
 920        'write-region
 921        (if confirm ; don't pass this arg unless defined for backward compat.
 922            (list start end tmpfile append 'no-message lockname confirm)
 923          (list start end tmpfile append 'no-message lockname)))
 924
 925       (with-progress-reporter
 926           v 3 (format "Moving tmp file %s to %s" tmpfile filename)
 927         (unwind-protect
 928             (unless (tramp-smb-send-command
 929                      v (format "put %s \"%s\""
 930                                tmpfile (tramp-smb-get-localname v)))
 931               (tramp-error v 'file-error "Cannot write `%s'" filename))
 932           (delete-file tmpfile)))
 933
 934       (unless (equal curbuf (current-buffer))
 935         (tramp-error
 936          v 'file-error
 937          "Buffer has changed from `%s' to `%s'" curbuf (current-buffer)))
 938       (when (eq visit t)
 939         (set-visited-file-modtime)))))
 940
 941
 942 ;; Internal file name functions.
 943
 944 (defun tramp-smb-get-share (vec)
 945   "Returns the share name of LOCALNAME."
 946   (save-match-data
 947     (let ((localname (tramp-file-name-localname vec)))
 948       (when (string-match "^/?\\([^/]+\\)/" localname)
 949         (match-string 1 localname)))))
 950
 951 (defun tramp-smb-get-localname (vec)
 952   "Returns the file name of LOCALNAME.
 953 If VEC has no cifs capabilities, exchange \"/\" by \"\\\\\"."
 954   (save-match-data
 955     (let ((localname (tramp-file-name-localname vec)))
 956       (setq
 957        localname
 958        (if (string-match "^/?[^/]+\\(/.*\\)" localname)
 959            ;; There is a share, sparated by "/".
 960            (if (not (tramp-smb-get-cifs-capabilities vec))
 961                (mapconcat
 962                 (lambda (x) (if (equal x ?/) "\\" (char-to-string x)))
 963                 (match-string 1 localname) "")
 964              (match-string 1 localname))
 965          ;; There is just a share.
 966          (if (string-match "^/?\\([^/]+\\)$" localname)
 967              (match-string 1 localname)
 968            "")))
 969
 970       ;; Sometimes we have discarded `substitute-in-file-name'.
 971       (when (string-match "\\(\\$\\$\\)\\(/\\|$\\)" localname)
 972         (setq localname (replace-match "$" nil nil localname 1)))
 973
 974       localname)))
 975
 976 ;; Share names of a host are cached. It is very unlikely that the
 977 ;; shares do change during connection.
 978 (defun tramp-smb-get-file-entries (directory)
 979   "Read entries which match DIRECTORY.
 980 Either the shares are listed, or the `dir' command is executed.
 981 Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)."
 982   (with-parsed-tramp-file-name (file-name-as-directory directory) nil
 983     (setq localname (or localname "/"))
 984     (with-file-property v localname "file-entries"
 985       (with-current-buffer (tramp-get-buffer v)
 986         (let* ((share (tramp-smb-get-share v))
 987                (cache (tramp-get-connection-property v "share-cache" nil))
 988                res entry)
 989
 990           (if (and (not share) cache)
 991               ;; Return cached shares.
 992               (setq res cache)
 993
 994             ;; Read entries.
 995             (if share
 996                 (tramp-smb-send-command
 997                  v (format "dir \"%s*\"" (tramp-smb-get-localname v)))
 998               ;; `tramp-smb-maybe-open-connection' lists also the share names.
 999               (tramp-smb-maybe-open-connection v))
1000
1001             ;; Loop the listing.
1002             (goto-char (point-min))
1003             (if (re-search-forward tramp-smb-errors nil t)
1004                 (tramp-error v 'file-error "%s `%s'" (match-string 0) directory)
1005               (while (not (eobp))
1006                 (setq entry (tramp-smb-read-file-entry share))
1007                 (forward-line)
1008                 (when entry (add-to-list 'res entry))))
1009
1010             ;; Cache share entries.
1011             (unless share
1012               (tramp-set-connection-property v "share-cache" res)))
1013
1014           ;; Add directory itself.
1015           (add-to-list 'res '("" "drwxrwxrwx" 0 (0 0)))
1016
1017           ;; There's a very strange error (debugged with XEmacs 21.4.14)
1018           ;; If there's no short delay, it returns nil.  No idea about.
1019           (when (featurep 'xemacs) (sleep-for 0.01))
1020
1021           ;; Return entries.
1022           (delq nil res))))))
1023
1024 ;; Return either a share name (if SHARE is nil), or a file name.
1025 ;;
1026 ;; If shares are listed, the following format is expected:
1027 ;;
1028 ;; Disk|                                  - leading spaces
1029 ;; [^|]+|                                 - share name, 14 char
1030 ;; .*                                     - comment
1031 ;;
1032 ;; Entries provided by smbclient DIR aren't fully regular.
1033 ;; They should have the format
1034 ;;
1035 ;; \s-\{2,2}                              - leading spaces
1036 ;; \S-\(.*\S-\)\s-*                       - file name, 30 chars, left bound
1037 ;; \s-+[ADHRSV]*                          - permissions, 7 chars, right bound
1038 ;; \s-                                    - space delimeter
1039 ;; \s-+[0-9]+                             - size, 8 chars, right bound
1040 ;; \s-\{2,2\}                             - space delimeter
1041 ;; \w\{3,3\}                              - weekday
1042 ;; \s-                                    - space delimeter
1043 ;; \w\{3,3\}                              - month
1044 ;; \s-                                    - space delimeter
1045 ;; [ 12][0-9]                             - day
1046 ;; \s-                                    - space delimeter
1047 ;; [0-9]\{2,2\}:[0-9]\{2,2\}:[0-9]\{2,2\} - time
1048 ;; \s-                                    - space delimeter
1049 ;; [0-9]\{4,4\}                           - year
1050 ;;
1051 ;; samba/src/client.c (http://samba.org/doxygen/samba/client_8c-source.html)
1052 ;; has function display_finfo:
1053 ;;
1054 ;;   d_printf("  %-30s%7.7s %8.0f  %s",
1055 ;;            finfo->name,
1056 ;;            attrib_string(finfo->mode),
1057 ;;            (double)finfo->size,
1058 ;;            asctime(LocalTime(&t)));
1059 ;;
1060 ;; in Samba 1.9, there's the following code:
1061 ;;
1062 ;;   DEBUG(0,("  %-30s%7.7s%10d  %s",
1063 ;;         CNV_LANG(finfo->name),
1064 ;;         attrib_string(finfo->mode),
1065 ;;         finfo->size,
1066 ;;         asctime(LocalTime(&t))));
1067 ;;
1068 ;; Problems:
1069 ;; * Modern regexp constructs, like spy groups and counted repetitions, aren't
1070 ;;   available in older Emacsen.
1071 ;; * The length of constructs (file name, size) might exceed the default.
1072 ;; * File names might contain spaces.
1073 ;; * Permissions might be empty.
1074 ;;
1075 ;; So we try to analyze backwards.
1076 (defun tramp-smb-read-file-entry (share)
1077   "Parse entry in SMB output buffer.
1078 If SHARE is result, entries are of type dir. Otherwise, shares are listed.
1079 Result is the list (LOCALNAME MODE SIZE MTIME)."
1080 ;; We are called from `tramp-smb-get-file-entries', which sets the
1081 ;; current buffer.
1082   (let ((line (buffer-substring (point) (tramp-compat-line-end-position)))
1083         localname mode size month day hour min sec year mtime)
1084
1085     (if (not share)
1086
1087         ;; Read share entries.
1088         (when (string-match "^Disk|\\([^|]+\\)|" line)
1089           (setq localname (match-string 1 line)
1090                 mode "dr-xr-xr-x"
1091                 size 0))
1092
1093       ;; Real listing.
1094       (block nil
1095
1096         ;; year.
1097         (if (string-match "\\([0-9]+\\)$" line)
1098             (setq year (string-to-number (match-string 1 line))
1099                   line (substring line 0 -5))
1100           (return))
1101
1102         ;; time.
1103         (if (string-match "\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)$" line)
1104             (setq hour (string-to-number (match-string 1 line))
1105                   min  (string-to-number (match-string 2 line))
1106                   sec  (string-to-number (match-string 3 line))
1107                   line (substring line 0 -9))
1108           (return))
1109
1110         ;; day.
1111         (if (string-match "\\([0-9]+\\)$" line)
1112             (setq day  (string-to-number (match-string 1 line))
1113                   line (substring line 0 -3))
1114           (return))
1115
1116         ;; month.
1117         (if (string-match "\\(\\w+\\)$" line)
1118             (setq month (match-string 1 line)
1119                   line  (substring line 0 -4))
1120           (return))
1121
1122         ;; weekday.
1123         (if (string-match "\\(\\w+\\)$" line)
1124             (setq line (substring line 0 -5))
1125           (return))
1126
1127         ;; size.
1128         (if (string-match "\\([0-9]+\\)$" line)
1129             (let ((length (- (max 10 (1+ (length (match-string 1 line)))))))
1130               (setq size (string-to-number (match-string 1 line)))
1131               (when (string-match "\\([ADHRSV]+\\)" (substring line length))
1132                 (setq length (+ length (match-end 0))))
1133               (setq line (substring line 0 length)))
1134           (return))
1135
1136         ;; mode: ARCH, DIR, HIDDEN, RONLY, SYSTEM, VOLID.
1137         (if (string-match "\\([ADHRSV]+\\)?$" line)
1138             (setq
1139              mode (or (match-string 1 line) "")
1140              mode (save-match-data (format
1141                     "%s%s"
1142                     (if (string-match "D" mode) "d" "-")
1143                     (mapconcat
1144                      (lambda (x) "") "    "
1145                      (concat "r" (if (string-match "R" mode) "-" "w") "x"))))
1146              line (substring line 0 -6))
1147           (return))
1148
1149         ;; localname.
1150         (if (string-match "^\\s-+\\(\\S-\\(.*\\S-\\)?\\)\\s-*$" line)
1151             (setq localname (match-string 1 line))
1152           (return))))
1153
1154     (when (and localname mode size)
1155       (setq mtime
1156             (if (and sec min hour day month year)
1157                 (encode-time
1158                  sec min hour day
1159                  (cdr (assoc (downcase month) tramp-parse-time-months))
1160                  year)
1161               '(0 0)))
1162       (list localname mode size mtime))))
1163
1164 (defun tramp-smb-get-cifs-capabilities (vec)
1165   "Check, whether the SMB server supports POSIX commands."
1166   ;; When we are not logged in yet, we return nil.
1167   (if (let ((p (tramp-get-connection-process vec)))
1168         (and p (processp p) (memq (process-status p) '(run open))))
1169       (with-connection-property
1170           (tramp-get-connection-process vec) "cifs-capabilities"
1171         (save-match-data
1172           (when (tramp-smb-send-command vec "posix")
1173             (with-current-buffer (tramp-get-buffer vec)
1174               (goto-char (point-min))
1175               (when
1176                   (re-search-forward "Server supports CIFS capabilities" nil t)
1177                 (member
1178                  "pathnames"
1179                  (split-string
1180                   (buffer-substring
1181                    (point) (tramp-compat-line-end-position)) nil t)))))))))
1182
1183 (defun tramp-smb-get-stat-capability (vec)
1184   "Check, whether the SMB server supports the STAT command."
1185   ;; When we are not logged in yet, we return nil.
1186   (if (let ((p (tramp-get-connection-process vec)))
1187         (and p (processp p) (memq (process-status p) '(run open))))
1188       (with-connection-property
1189           (tramp-get-connection-process vec) "stat-capability"
1190         (tramp-smb-send-command vec "stat ."))))
1191
1192
1193 ;; Connection functions.
1194
1195 (defun tramp-smb-send-command (vec command)
1196   "Send the COMMAND to connection VEC.
1197 Returns nil if there has been an error message from smbclient."
1198   (tramp-smb-maybe-open-connection vec)
1199   (tramp-message vec 6 "%s" command)
1200   (tramp-send-string vec command)
1201   (tramp-smb-wait-for-output vec))
1202
1203 (defun tramp-smb-maybe-open-connection (vec)
1204   "Maybe open a connection to HOST, log in as USER, using `tramp-smb-program'.
1205 Does not do anything if a connection is already open, but re-opens the
1206 connection if a previous connection has died for some reason."
1207   (let* ((share (tramp-smb-get-share vec))
1208          (buf (tramp-get-buffer vec))
1209          (p (get-buffer-process buf)))
1210
1211     ;; Check whether we still have the same smbclient version.
1212     ;; Otherwise, we must delete the connection cache, because
1213     ;; capabilities migh have changed.
1214     (unless (processp p)
1215       (let ((default-directory (tramp-compat-temporary-file-directory))
1216             (command (concat tramp-smb-program " -V")))
1217
1218         (unless tramp-smb-version
1219           (unless (executable-find tramp-smb-program)
1220             (tramp-error
1221              vec 'file-error
1222              "Cannot find command %s in %s" tramp-smb-program exec-path))
1223           (setq tramp-smb-version (shell-command-to-string command))
1224           (tramp-message vec 6 command)
1225           (tramp-message vec 6 "\n%s" tramp-smb-version)
1226           (if (string-match "[ \t\n\r]+\\'" tramp-smb-version)
1227               (setq tramp-smb-version
1228                     (replace-match "" nil nil tramp-smb-version))))
1229
1230         (unless (string-equal
1231                  tramp-smb-version
1232                  (tramp-get-connection-property
1233                   vec "smbclient-version" tramp-smb-version))
1234           (tramp-flush-directory-property vec "")
1235           (tramp-flush-connection-property vec))
1236
1237         (tramp-set-connection-property
1238          vec "smbclient-version" tramp-smb-version)))
1239
1240     ;; If too much time has passed since last command was sent, look
1241     ;; whether there has been an error message; maybe due to
1242     ;; connection timeout.
1243     (with-current-buffer buf
1244       (goto-char (point-min))
1245       (when (and (> (tramp-time-diff
1246                      (current-time)
1247                      (tramp-get-connection-property
1248                       p "last-cmd-time" '(0 0 0)))
1249                     60)
1250                  p (processp p) (memq (process-status p) '(run open))
1251                  (re-search-forward tramp-smb-errors nil t))
1252         (delete-process p)
1253         (setq p nil)))
1254
1255     ;; Check whether it is still the same share.
1256     (unless
1257         (and p (processp p) (memq (process-status p) '(run open))
1258              (string-equal
1259               share
1260               (tramp-get-connection-property p "smb-share" "")))
1261
1262       (save-match-data
1263         ;; There might be unread output from checking for share names.
1264         (when buf (with-current-buffer buf (erase-buffer)))
1265         (when (and p (processp p)) (delete-process p))
1266
1267         (let* ((user      (tramp-file-name-user vec))
1268                (host      (tramp-file-name-host vec))
1269                (real-user (tramp-file-name-real-user vec))
1270                (real-host (tramp-file-name-real-host vec))
1271                (domain    (tramp-file-name-domain vec))
1272                (port      (tramp-file-name-port vec))
1273                args)
1274
1275           (if share
1276               (setq args (list (concat "//" real-host "/" share)))
1277             (setq args (list "-g" "-L" real-host )))
1278
1279           (if (not (zerop (length real-user)))
1280               (setq args (append args (list "-U" real-user)))
1281             (setq args (append args (list "-N"))))
1282
1283           (when domain (setq args (append args (list "-W" domain))))
1284           (when port   (setq args (append args (list "-p" port))))
1285           (when tramp-smb-conf
1286             (setq args (append args (list "-s" tramp-smb-conf))))
1287
1288           ;; OK, let's go.
1289           (with-progress-reporter
1290               vec 3
1291               (format "Opening connection for //%s%s/%s"
1292                       (if (not (zerop (length user))) (concat user "@") "")
1293                       host (or share ""))
1294
1295             (let* ((coding-system-for-read nil)
1296                    (process-connection-type tramp-process-connection-type)
1297                    (p (let ((default-directory
1298                               (tramp-compat-temporary-file-directory)))
1299                         (apply #'start-process
1300                                (tramp-buffer-name vec) (tramp-get-buffer vec)
1301                                tramp-smb-program args))))
1302
1303               (tramp-message
1304                vec 6 "%s" (mapconcat 'identity (process-command p) " "))
1305               (tramp-compat-set-process-query-on-exit-flag p nil)
1306
1307               ;; Set variables for computing the prompt for reading password.
1308               (setq tramp-current-method tramp-smb-method
1309                     tramp-current-user user
1310                     tramp-current-host host)
1311
1312               ;; Play login scenario.
1313               (tramp-process-actions
1314                p vec
1315                (if share
1316                    tramp-smb-actions-with-share
1317                  tramp-smb-actions-without-share))
1318
1319               ;; Check server version.
1320               (with-current-buffer (tramp-get-connection-buffer vec)
1321                 (goto-char (point-min))
1322                 (search-forward-regexp
1323                  "Domain=\\[[^]]*\\] OS=\\[[^]]*\\] Server=\\[[^]]*\\]" nil t)
1324                 (let ((smbserver-version (match-string 0)))
1325                   (unless
1326                       (string-equal
1327                        smbserver-version
1328                        (tramp-get-connection-property
1329                         vec "smbserver-version" smbserver-version))
1330                     (tramp-flush-directory-property vec "")
1331                     (tramp-flush-connection-property vec))
1332                   (tramp-set-connection-property
1333                    vec "smbserver-version" smbserver-version)))
1334
1335               ;; Set chunksize.  Otherwise, `tramp-send-string' might
1336               ;; try it itself.
1337               (tramp-set-connection-property p "smb-share" share)
1338               (tramp-set-connection-property
1339                p "chunksize" tramp-chunksize))))))))
1340
1341 ;; We don't use timeouts.  If needed, the caller shall wrap around.
1342 (defun tramp-smb-wait-for-output (vec)
1343   "Wait for output from smbclient command.
1344 Returns nil if an error message has appeared."
1345   (with-current-buffer (tramp-get-buffer vec)
1346     (let ((p (get-buffer-process (current-buffer)))
1347           (found (progn (goto-char (point-min))
1348                         (re-search-forward tramp-smb-prompt nil t)))
1349           (err   (progn (goto-char (point-min))
1350                         (re-search-forward tramp-smb-errors nil t))))
1351
1352       ;; Algorithm: get waiting output.  See if last line contains
1353       ;; tramp-smb-prompt sentinel or tramp-smb-errors strings.
1354       ;; If not, wait a bit and again get waiting output.
1355       (while (and (not found) (not err))
1356
1357         ;; Accept pending output.
1358         (tramp-accept-process-output p)
1359
1360         ;; Search for prompt.
1361         (goto-char (point-min))
1362         (setq found (re-search-forward tramp-smb-prompt nil t))
1363
1364         ;; Search for errors.
1365         (goto-char (point-min))
1366         (setq err (re-search-forward tramp-smb-errors nil t)))
1367
1368       ;; When the process is still alive, read pending output.
1369       (while (and (not found) (memq (process-status p) '(run open)))
1370
1371         ;; Accept pending output.
1372         (tramp-accept-process-output p)
1373
1374         ;; Search for prompt.
1375         (goto-char (point-min))
1376         (setq found (re-search-forward tramp-smb-prompt nil t)))
1377
1378       ;; Return value is whether no error message has appeared.
1379       (tramp-message vec 6 "\n%s" (buffer-string))
1380       (not err))))
1381
1382 (add-hook 'tramp-unload-hook
1383           (lambda ()
1384             (unload-feature 'tramp-smb 'force)))
1385
1386 (provide 'tramp-smb)
1387
1388 ;;; TODO:
1389
1390 ;; * Error handling in case password is wrong.
1391 ;; * Read password from "~/.netrc".
1392 ;; * Return more comprehensive file permission string.
1393 ;; * Try to remove the inclusion of dummy "" directory.  Seems to be at
1394 ;;   several places, especially in `tramp-smb-handle-insert-directory'.
1395 ;; * (RMS) Use unwind-protect to clean up the state so as to make the state
1396 ;;   regular again.
1397 ;; * Make it multi-hop capable.
1398
1399 ;; arch-tag: fcc9dbec-7503-4d73-b638-3c8aa59575f5
1400 ;;; tramp-smb.el ends here