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

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