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