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

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