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