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