lisp/net/tramp-smb.el

   1 ;;; tramp-smb.el --- Tramp access functions for SMB servers
   2
   3 ;; Copyright (C) 2002, 2003, 2004, 2005, 2006,
   4 ;;   2007 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, or (at your option)
  14 ;; 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; see the file COPYING.  If not, see
  23 ;; <http://www.gnu.org/licenses/>.
  24
  25 ;;; Commentary:
  26
  27 ;; Access functions for SMB servers like SAMBA or M$ Windows from Tramp.
  28
  29 ;;; Code:
  30
  31 (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-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 (defconst tramp-smb-prompt "^smb: .+> \\|^\\s-+Server\\s-+Comment$"
  65   "Regexp used as prompt in smbclient.")
  66
  67 (defconst tramp-smb-errors
  68   ;; `regexp-opt' not possible because of first string.
  69   (mapconcat
  70    'identity
  71    '(;; Connection error / timeout
  72      "Connection to \\S-+ failed"
  73      "Read from server failed, maybe it closed the connection"
  74      "Call timed out: server did not respond"
  75      ;; Samba
  76      "ERRDOS"
  77      "ERRSRV"
  78      "ERRbadfile"
  79      "ERRbadpw"
  80      "ERRfilexists"
  81      "ERRnoaccess"
  82      "ERRnomem"
  83      "ERRnosuchshare"
  84      ;; Windows 4.0 (Windows NT), Windows 5.0 (Windows 2000),
  85      ;; Windows 5.1 (Windows XP), Windows 5.2 (Windows Server 2003)
  86      "NT_STATUS_ACCESS_DENIED"
  87      "NT_STATUS_ACCOUNT_LOCKED_OUT"
  88      "NT_STATUS_BAD_NETWORK_NAME"
  89      "NT_STATUS_CANNOT_DELETE"
  90      "NT_STATUS_DIRECTORY_NOT_EMPTY"
  91      "NT_STATUS_DUPLICATE_NAME"
  92      "NT_STATUS_FILE_IS_A_DIRECTORY"
  93      "NT_STATUS_LOGON_FAILURE"
  94      "NT_STATUS_NETWORK_ACCESS_DENIED"
  95      "NT_STATUS_NO_SUCH_FILE"
  96      "NT_STATUS_OBJECT_NAME_COLLISION"
  97      "NT_STATUS_OBJECT_NAME_INVALID"
  98      "NT_STATUS_OBJECT_NAME_NOT_FOUND"
  99      "NT_STATUS_SHARING_VIOLATION"
 100      "NT_STATUS_TRUSTED_RELATIONSHIP_FAILURE"
 101      "NT_STATUS_WRONG_PASSWORD")
 102    "\\|")
 103   "Regexp for possible error strings of SMB servers.
 104 Used instead of analyzing error codes of commands.")
 105
 106 (defconst tramp-smb-actions-with-share
 107   '((tramp-smb-prompt tramp-action-succeed)
 108     (tramp-password-prompt-regexp tramp-action-password)
 109     (tramp-wrong-passwd-regexp tramp-action-permission-denied)
 110     (tramp-smb-errors tramp-action-permission-denied)
 111     (tramp-process-alive-regexp tramp-action-process-alive))
 112   "List of pattern/action pairs.
 113 This list is used for login to SMB servers.
 114
 115 See `tramp-actions-before-shell' for more info.")
 116
 117 (defconst tramp-smb-actions-without-share
 118   '((tramp-password-prompt-regexp tramp-action-password)
 119     (tramp-wrong-passwd-regexp tramp-action-permission-denied)
 120     (tramp-smb-errors tramp-action-permission-denied)
 121     (tramp-process-alive-regexp tramp-action-out-of-band))
 122   "List of pattern/action pairs.
 123 This list is used for login to SMB servers.
 124
 125 See `tramp-actions-before-shell' for more info.")
 126
 127 ;; New handlers should be added here.
 128 (defconst tramp-smb-file-name-handler-alist
 129   '(
 130     ;; `access-file' performed by default handler
 131     (add-name-to-file . tramp-smb-handle-copy-file) ;; we're on Windows, honey.
 132     ;; `byte-compiler-base-file-name' performed by default handler
 133     (copy-file . tramp-smb-handle-copy-file)
 134     (delete-directory . tramp-smb-handle-delete-directory)
 135     (delete-file . tramp-smb-handle-delete-file)
 136     ;; `diff-latest-backup-file' performed by default handler
 137     (directory-file-name . tramp-handle-directory-file-name)
 138     (directory-files . tramp-smb-handle-directory-files)
 139     (directory-files-and-attributes . tramp-smb-handle-directory-files-and-attributes)
 140     (dired-call-process . ignore)
 141     (dired-compress-file . ignore)
 142     ;; `dired-uncache' performed by default handler
 143     ;; `expand-file-name' not necessary because we cannot expand "~/"
 144     (file-accessible-directory-p . tramp-smb-handle-file-directory-p)
 145     (file-attributes . tramp-smb-handle-file-attributes)
 146     (file-directory-p .  tramp-smb-handle-file-directory-p)
 147     (file-executable-p . tramp-smb-handle-file-exists-p)
 148     (file-exists-p . tramp-smb-handle-file-exists-p)
 149     (file-local-copy . tramp-smb-handle-file-local-copy)
 150     (file-remote-p . tramp-handle-file-remote-p)
 151     (file-modes . tramp-handle-file-modes)
 152     (file-name-all-completions . tramp-smb-handle-file-name-all-completions)
 153     ;; `file-name-as-directory' performed by default handler
 154     (file-name-completion . tramp-handle-file-name-completion)
 155     (file-name-directory . tramp-handle-file-name-directory)
 156     (file-name-nondirectory . tramp-handle-file-name-nondirectory)
 157     ;; `file-name-sans-versions' performed by default handler
 158     (file-newer-than-file-p . tramp-smb-handle-file-newer-than-file-p)
 159     (file-ownership-preserved-p . ignore)
 160     (file-readable-p . tramp-smb-handle-file-exists-p)
 161     (file-regular-p . tramp-handle-file-regular-p)
 162     (file-symlink-p . tramp-handle-file-symlink-p)
 163     ;; `file-truename' performed by default handler
 164     (file-writable-p . tramp-smb-handle-file-writable-p)
 165     (find-backup-file-name . tramp-handle-find-backup-file-name)
 166     ;; `find-file-noselect' performed by default handler
 167     ;; `get-file-buffer' performed by default handler
 168     (insert-directory . tramp-smb-handle-insert-directory)
 169     (insert-file-contents . tramp-handle-insert-file-contents)
 170     (load . tramp-handle-load)
 171     (make-directory . tramp-smb-handle-make-directory)
 172     (make-directory-internal . tramp-smb-handle-make-directory-internal)
 173     (make-symbolic-link . ignore)
 174     (rename-file . tramp-smb-handle-rename-file)
 175     (set-file-modes . ignore)
 176     (set-visited-file-modtime . ignore)
 177     (shell-command . ignore)
 178     (substitute-in-file-name . tramp-smb-handle-substitute-in-file-name)
 179     (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory)
 180     (vc-registered . ignore)
 181     (verify-visited-file-modtime . ignore)
 182     (write-region . tramp-smb-handle-write-region)
 183 )
 184   "Alist of handler functions for Tramp SMB method.
 185 Operations not mentioned here will be handled by the default Emacs primitives.")
 186
 187 (defun tramp-smb-file-name-p (filename)
 188   "Check if it's a filename for SMB servers."
 189   (let ((v (tramp-dissect-file-name filename)))
 190     (string= (tramp-file-name-method v) tramp-smb-method)))
 191
 192 (defun tramp-smb-file-name-handler (operation &rest args)
 193   "Invoke the SMB related OPERATION.
 194 First arg specifies the OPERATION, second arg is a list of arguments to
 195 pass to the OPERATION."
 196   (let ((fn (assoc operation tramp-smb-file-name-handler-alist)))
 197     (if fn
 198         (save-match-data (apply (cdr fn) args))
 199       (tramp-run-real-handler operation args))))
 200
 201 (add-to-list 'tramp-foreign-file-name-handler-alist
 202              (cons 'tramp-smb-file-name-p 'tramp-smb-file-name-handler))
 203
 204
 205 ;; File name primitives
 206
 207 (defun tramp-smb-handle-copy-file
 208   (filename newname &optional ok-if-already-exists keep-date preserve-uid-gid)
 209   "Like `copy-file' for Tramp files.
 210 KEEP-DATE is not handled in case NEWNAME resides on an SMB server.
 211 PRESERVE-UID-GID is completely ignored."
 212   (setq filename (expand-file-name filename)
 213         newname (expand-file-name newname))
 214
 215   (let ((tmpfile (file-local-copy filename)))
 216
 217     (if tmpfile
 218         ;; Remote filename.
 219         (rename-file tmpfile newname ok-if-already-exists)
 220
 221       ;; Remote newname.
 222       (when (file-directory-p newname)
 223         (setq newname (expand-file-name
 224                        (file-name-nondirectory filename) newname)))
 225
 226       (with-parsed-tramp-file-name newname nil
 227         (when (and (not ok-if-already-exists)
 228                    (file-exists-p newname))
 229           (tramp-error v 'file-already-exists newname))
 230
 231         ;; We must also flush the cache of the directory, because
 232         ;; file-attributes reads the values from there.
 233         (tramp-flush-file-property v (file-name-directory localname))
 234         (tramp-flush-file-property v localname)
 235         (let ((share (tramp-smb-get-share localname))
 236               (file (tramp-smb-get-localname localname t)))
 237           (unless share
 238             (tramp-error
 239              v 'file-error "Target `%s' must contain a share name" newname))
 240           (tramp-message v 0 "Copying file %s to file %s..." filename newname)
 241           (if (tramp-smb-send-command
 242                v (format "put %s \"%s\"" filename file))
 243               (tramp-message
 244                v 0 "Copying file %s to file %s...done" filename newname)
 245             (tramp-error v 'file-error "Cannot copy `%s'" filename)))))))
 246
 247 (defun tramp-smb-handle-delete-directory (directory)
 248   "Like `delete-directory' for Tramp files."
 249   (setq directory (directory-file-name (expand-file-name directory)))
 250   (when (file-exists-p directory)
 251     (with-parsed-tramp-file-name directory nil
 252       ;; We must also flush the cache of the directory, because
 253       ;; file-attributes reads the values from there.
 254       (tramp-flush-file-property v (file-name-directory localname))
 255       (tramp-flush-directory-property v localname)
 256       (let ((dir (tramp-smb-get-localname (file-name-directory localname) t))
 257             (file (file-name-nondirectory localname)))
 258         (unwind-protect
 259             (unless (and
 260                      (tramp-smb-send-command v (format "cd \"%s\"" dir))
 261                      (tramp-smb-send-command v (format "rmdir \"%s\"" file)))
 262               ;; Error
 263               (with-current-buffer (tramp-get-connection-buffer v)
 264                 (goto-char (point-min))
 265                 (search-forward-regexp tramp-smb-errors nil t)
 266                 (tramp-error
 267                  v 'file-error "%s `%s'" (match-string 0) directory)))
 268           ;; Always go home
 269           (tramp-smb-send-command v (format "cd \\")))))))
 270
 271 (defun tramp-smb-handle-delete-file (filename)
 272   "Like `delete-file' for Tramp files."
 273   (setq filename (expand-file-name filename))
 274   (when (file-exists-p filename)
 275     (with-parsed-tramp-file-name filename nil
 276       ;; We must also flush the cache of the directory, because
 277       ;; file-attributes reads the values from there.
 278       (tramp-flush-file-property v (file-name-directory localname))
 279       (tramp-flush-file-property v localname)
 280       (let ((dir (tramp-smb-get-localname (file-name-directory localname) t))
 281             (file (file-name-nondirectory localname)))
 282         (unwind-protect
 283             (unless (and
 284                      (tramp-smb-send-command v (format "cd \"%s\"" dir))
 285                      (tramp-smb-send-command v (format "rm \"%s\"" file)))
 286               ;; Error
 287               (with-current-buffer (tramp-get-connection-buffer v)
 288                 (goto-char (point-min))
 289                 (search-forward-regexp tramp-smb-errors nil t)
 290                 (tramp-error
 291                  v 'file-error "%s `%s'" (match-string 0) filename)))
 292           ;; Always go home
 293           (tramp-smb-send-command v (format "cd \\")))))))
 294
 295 (defun tramp-smb-handle-directory-files
 296   (directory &optional full match nosort)
 297   "Like `directory-files' for Tramp files."
 298   (let ((result (mapcar 'directory-file-name
 299                         (file-name-all-completions "" directory))))
 300     ;; Discriminate with regexp
 301     (when match
 302       (setq result
 303             (delete nil
 304                     (mapcar (lambda (x) (when (string-match match x) x))
 305                             result))))
 306     ;; Append directory
 307     (when full
 308       (setq result
 309             (mapcar
 310              (lambda (x) (expand-file-name x directory))
 311              result)))
 312     ;; Sort them if necessary
 313     (unless nosort (setq result (sort result 'string-lessp)))
 314     ;; That's it
 315     result))
 316
 317 (defun tramp-smb-handle-directory-files-and-attributes
 318   (directory &optional full match nosort id-format)
 319   "Like `directory-files-and-attributes' for Tramp files."
 320   (mapcar
 321    (lambda (x)
 322      ;; We cannot call `file-attributes' for backward compatibility reasons.
 323      ;; Its optional parameter ID-FORMAT is introduced with Emacs 22.
 324      (cons x (tramp-smb-handle-file-attributes
 325         (if full x (expand-file-name x directory)) id-format)))
 326    (directory-files directory full match nosort)))
 327
 328 (defun tramp-smb-handle-file-attributes (filename &optional id-format)
 329   "Like `file-attributes' for Tramp files."
 330   ;; Reading just the filename entry via "dir localname" is not
 331   ;; possible, because when filename is a directory, some smbclient
 332   ;; versions return the content of the directory, and other versions
 333   ;; don't.  Therefore, the whole content of the upper directory is
 334   ;; retrieved, and the entry of the filename is extracted from.
 335   (with-parsed-tramp-file-name filename nil
 336     (with-file-property v localname (format "file-attributes-%s" id-format)
 337       (let* ((entries (tramp-smb-get-file-entries
 338                        (file-name-directory filename)))
 339              (entry (and entries
 340                          (assoc (file-name-nondirectory filename) entries)))
 341              (uid (if (and id-format (equal id-format 'string)) "nobody" -1))
 342              (gid (if (and id-format (equal id-format 'string)) "nogroup" -1))
 343              (inode (tramp-get-inode v))
 344              (device (tramp-get-device v)))
 345
 346         ;; Check result.
 347         (when entry
 348           (list (and (string-match "d" (nth 1 entry))
 349                      t)       ;0 file type
 350                 -1            ;1 link count
 351                 uid           ;2 uid
 352                 gid           ;3 gid
 353                 '(0 0)        ;4 atime
 354                 (nth 3 entry) ;5 mtime
 355                 '(0 0)        ;6 ctime
 356                 (nth 2 entry) ;7 size
 357                 (nth 1 entry) ;8 mode
 358                 nil           ;9 gid weird
 359                 inode         ;10 inode number
 360                 device))))))  ;11 file system number
 361
 362 (defun tramp-smb-handle-file-directory-p (filename)
 363   "Like `file-directory-p' for Tramp files."
 364   (and (file-exists-p filename)
 365        (eq ?d (aref (nth 8 (file-attributes filename)) 0))))
 366
 367 (defun tramp-smb-handle-file-exists-p (filename)
 368   "Like `file-exists-p' for Tramp files."
 369   (not (null (file-attributes filename))))
 370
 371 (defun tramp-smb-handle-file-local-copy (filename)
 372   "Like `file-local-copy' for Tramp files."
 373   (with-parsed-tramp-file-name filename nil
 374     (let ((file (tramp-smb-get-localname localname t))
 375           (tmpfile (tramp-compat-make-temp-file filename)))
 376       (unless (file-exists-p filename)
 377         (tramp-error
 378          v 'file-error
 379          "Cannot make local copy of non-existing file `%s'" filename))
 380       (tramp-message v 4 "Fetching %s to tmp file %s..." filename tmpfile)
 381       (if (tramp-smb-send-command v (format "get \"%s\" %s" file tmpfile))
 382           (tramp-message
 383            v 4 "Fetching %s to tmp file %s...done" filename tmpfile)
 384         (tramp-error
 385          v 'file-error
 386          "Cannot make local copy of file `%s'" filename))
 387       tmpfile)))
 388
 389 ;; This function should return "foo/" for directories and "bar" for
 390 ;; files.
 391 (defun tramp-smb-handle-file-name-all-completions (filename directory)
 392   "Like `file-name-all-completions' for Tramp files."
 393   (all-completions
 394    filename
 395    (with-parsed-tramp-file-name directory nil
 396      (with-file-property v localname "file-name-all-completions"
 397        (save-match-data
 398          (let ((entries (tramp-smb-get-file-entries directory)))
 399            (mapcar
 400             (lambda (x)
 401               (list
 402                (if (string-match "d" (nth 1 x))
 403                    (file-name-as-directory (nth 0 x))
 404                  (nth 0 x))))
 405             entries)))))))
 406
 407 (defun tramp-smb-handle-file-newer-than-file-p (file1 file2)
 408   "Like `file-newer-than-file-p' for Tramp files."
 409   (cond
 410    ((not (file-exists-p file1)) nil)
 411    ((not (file-exists-p file2)) t)
 412    (t (tramp-time-less-p (nth 5 (file-attributes file2))
 413                          (nth 5 (file-attributes file1))))))
 414
 415 (defun tramp-smb-handle-file-writable-p (filename)
 416   "Like `file-writable-p' for Tramp files."
 417   (if (file-exists-p filename)
 418       (string-match "w" (or (nth 8 (file-attributes filename)) ""))
 419     (let ((dir (file-name-directory filename)))
 420       (and (file-exists-p dir)
 421            (file-writable-p dir)))))
 422
 423 (defun tramp-smb-handle-insert-directory
 424   (filename switches &optional wildcard full-directory-p)
 425   "Like `insert-directory' for Tramp files."
 426   (setq filename (expand-file-name filename))
 427   (when full-directory-p
 428     ;; Called from `dired-add-entry'.
 429     (setq filename (file-name-as-directory filename)))
 430   (with-parsed-tramp-file-name filename nil
 431     (tramp-flush-file-property v (file-name-directory localname))
 432     (save-match-data
 433       (let ((base (file-name-nondirectory filename))
 434             ;; We should not destroy the cache entry.
 435             (entries (copy-sequence
 436                       (tramp-smb-get-file-entries
 437                        (file-name-directory filename)))))
 438
 439         (when wildcard
 440           (string-match "\\." base)
 441           (setq base (replace-match "\\\\." nil nil base))
 442           (string-match "\\*" base)
 443           (setq base (replace-match ".*" nil nil base))
 444           (string-match "\\?" base)
 445           (setq base (replace-match ".?" nil nil base)))
 446
 447         ;; Filter entries.
 448         (setq entries
 449               (delq
 450                nil
 451                (if (or wildcard (zerop (length base)))
 452                    ;; Check for matching entries.
 453                    (mapcar
 454                     (lambda (x)
 455                       (when (string-match
 456                              (format "^%s" base) (nth 0 x))
 457                         x))
 458                     entries)
 459                  ;; We just need the only and only entry FILENAME.
 460                  (list (assoc base entries)))))
 461
 462         ;; Sort entries
 463         (setq entries
 464               (sort
 465                entries
 466                (lambda (x y)
 467                  (if (string-match "t" switches)
 468                      ;; Sort by date.
 469                      (tramp-time-less-p (nth 3 y) (nth 3 x))
 470                    ;; Sort by name.
 471                    (string-lessp (nth 0 x) (nth 0 y))))))
 472
 473         ;; Print entries.
 474         (mapcar
 475          (lambda (x)
 476            (when (not (zerop (length (nth 0 x))))
 477              (insert
 478               (format
 479                "%10s %3d %-8s %-8s %8s %s %s\n"
 480                (nth 1 x) ; mode
 481                1 "nobody" "nogroup"
 482                (nth 2 x) ; size
 483                (format-time-string
 484                 (if (tramp-time-less-p
 485                      (tramp-time-subtract (current-time) (nth 3 x))
 486                      tramp-half-a-year)
 487                     "%b %e %R"
 488                   "%b %e  %Y")
 489                 (nth 3 x)) ; date
 490                (nth 0 x))) ; file name
 491              (forward-line)
 492              (beginning-of-line)))
 493            entries)))))
 494
 495 (defun tramp-smb-handle-make-directory (dir &optional parents)
 496   "Like `make-directory' for Tramp files."
 497   (setq dir (directory-file-name (expand-file-name dir)))
 498   (unless (file-name-absolute-p dir)
 499     (setq dir (expand-file-name dir default-directory)))
 500   (with-parsed-tramp-file-name dir nil
 501     (save-match-data
 502       (let* ((share (tramp-smb-get-share localname))
 503              (ldir (file-name-directory dir)))
 504         ;; Make missing directory parts
 505         (when (and parents share (not (file-directory-p ldir)))
 506           (make-directory ldir parents))
 507         ;; Just do it
 508         (when (file-directory-p ldir)
 509           (make-directory-internal dir))
 510         (unless (file-directory-p dir)
 511           (tramp-error v 'file-error "Couldn't make directory %s" dir))))))
 512
 513 (defun tramp-smb-handle-make-directory-internal (directory)
 514   "Like `make-directory-internal' for Tramp files."
 515   (setq directory (directory-file-name (expand-file-name directory)))
 516   (unless (file-name-absolute-p directory)
 517     (setq directory (expand-file-name directory default-directory)))
 518   (with-parsed-tramp-file-name directory nil
 519     (save-match-data
 520       (let* ((file (tramp-smb-get-localname localname t)))
 521         (when (file-directory-p (file-name-directory directory))
 522           (tramp-smb-send-command v (format "mkdir \"%s\"" file))
 523           ;; We must also flush the cache of the directory, because
 524           ;; file-attributes reads the values from there.
 525           (tramp-flush-file-property v (file-name-directory localname)))
 526         (unless (file-directory-p directory)
 527           (tramp-error
 528            v 'file-error "Couldn't make directory %s" directory))))))
 529
 530 (defun tramp-smb-handle-rename-file
 531   (filename newname &optional ok-if-already-exists)
 532   "Like `rename-file' for Tramp files."
 533   (setq filename (expand-file-name filename)
 534         newname (expand-file-name newname))
 535
 536   (let ((tmpfile (file-local-copy filename)))
 537
 538     (if tmpfile
 539         ;; remote filename
 540         (rename-file tmpfile newname ok-if-already-exists)
 541
 542       ;; remote newname
 543       (when (file-directory-p newname)
 544         (setq newname (expand-file-name
 545                       (file-name-nondirectory filename) newname)))
 546
 547       (with-parsed-tramp-file-name newname nil
 548         (when (and (not ok-if-already-exists)
 549                    (file-exists-p newname))
 550           (tramp-error v 'file-already-exists newname))
 551         ;; We must also flush the cache of the directory, because
 552         ;; file-attributes reads the values from there.
 553         (tramp-flush-file-property v (file-name-directory localname))
 554         (tramp-flush-file-property v localname)
 555         (let ((file (tramp-smb-get-localname localname t)))
 556           (tramp-message v 0 "Copying file %s to file %s..." filename newname)
 557           (if (tramp-smb-send-command v (format "put %s \"%s\"" filename file))
 558               (tramp-message
 559                v 0 "Copying file %s to file %s...done" filename newname)
 560             (tramp-error v 'file-error "Cannot rename `%s'" filename))))))
 561
 562   (delete-file filename))
 563
 564 (defun tramp-smb-handle-substitute-in-file-name (filename)
 565   "Like `handle-substitute-in-file-name' for Tramp files.
 566 \"//\" substitutes only in the local filename part.  Catches
 567 errors for shares like \"C$/\", which are common in Microsoft Windows."
 568   (with-parsed-tramp-file-name filename nil
 569     ;; Ignore in LOCALNAME everything before "//".
 570     (when (and (stringp localname) (string-match ".+?/\\(/\\|~\\)" localname))
 571       (setq filename
 572             (concat (file-remote-p filename)
 573                     (replace-match "\\1" nil nil localname)))))
 574   (condition-case nil
 575       (tramp-run-real-handler 'substitute-in-file-name (list filename))
 576     (error filename)))
 577
 578 (defun tramp-smb-handle-write-region
 579   (start end filename &optional append visit lockname confirm)
 580   "Like `write-region' for Tramp files."
 581   (setq filename (expand-file-name filename))
 582   (with-parsed-tramp-file-name filename nil
 583     (unless (eq append nil)
 584       (tramp-error
 585          v 'file-error "Cannot append to file using Tramp (`%s')" filename))
 586     ;; XEmacs takes a coding system as the seventh argument, not `confirm'.
 587     (when (and (not (featurep 'xemacs))
 588                confirm (file-exists-p filename))
 589       (unless (y-or-n-p (format "File %s exists; overwrite anyway? "
 590                                 filename))
 591         (tramp-error v 'file-error "File not overwritten")))
 592     ;; We must also flush the cache of the directory, because
 593     ;; `file-attributes' reads the values from there.
 594     (tramp-flush-file-property v (file-name-directory localname))
 595     (tramp-flush-file-property v localname)
 596     (let ((file (tramp-smb-get-localname localname t))
 597           (curbuf (current-buffer))
 598           (tmpfile (tramp-compat-make-temp-file filename)))
 599       ;; We say `no-message' here because we don't want the visited file
 600       ;; modtime data to be clobbered from the temp file.  We call
 601       ;; `set-visited-file-modtime' ourselves later on.
 602       (tramp-run-real-handler
 603        'write-region
 604        (if confirm ; don't pass this arg unless defined for backward compat.
 605            (list start end tmpfile append 'no-message lockname confirm)
 606          (list start end tmpfile append 'no-message lockname)))
 607
 608       (tramp-message v 5 "Writing tmp file %s to file %s..." tmpfile filename)
 609       (if (tramp-smb-send-command v (format "put %s \"%s\"" tmpfile file))
 610           (tramp-message
 611            v 5 "Writing tmp file %s to file %s...done" tmpfile filename)
 612         (tramp-error v 'file-error "Cannot write `%s'" filename))
 613
 614       (delete-file tmpfile)
 615       (unless (equal curbuf (current-buffer))
 616         (tramp-error
 617          v 'file-error
 618          "Buffer has changed from `%s' to `%s'" curbuf (current-buffer)))
 619       (when (eq visit t)
 620         (set-visited-file-modtime)))))
 621
 622
 623 ;; Internal file name functions
 624
 625 (defun tramp-smb-get-share (localname)
 626   "Returns the share name of LOCALNAME."
 627   (save-match-data
 628     (when (string-match "^/?\\([^/]+\\)/" localname)
 629       (match-string 1 localname))))
 630
 631 (defun tramp-smb-get-localname (localname convert)
 632   "Returns the file name of LOCALNAME.
 633 If CONVERT is non-nil exchange \"/\" by \"\\\\\"."
 634   (save-match-data
 635     (let ((res localname))
 636
 637       (setq
 638        res (if (string-match "^/?[^/]+/\\(.*\\)" res)
 639                (if convert
 640                    (mapconcat
 641                     (lambda (x) (if (equal x ?/) "\\" (char-to-string x)))
 642                     (match-string 1 res) "")
 643                  (match-string 1 res))
 644              (if (string-match "^/?\\([^/]+\\)$" res)
 645                  (match-string 1 res)
 646                "")))
 647
 648       ;; Sometimes we have discarded `substitute-in-file-name'
 649       (when (string-match "\\(\\$\\$\\)\\(/\\|$\\)" res)
 650         (setq res (replace-match "$" nil nil res 1)))
 651
 652       res)))
 653
 654 ;; Share names of a host are cached. It is very unlikely that the
 655 ;; shares do change during connection.
 656 (defun tramp-smb-get-file-entries (directory)
 657   "Read entries which match DIRECTORY.
 658 Either the shares are listed, or the `dir' command is executed.
 659 Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)."
 660   (with-parsed-tramp-file-name directory nil
 661     (setq localname (or localname "/"))
 662     (with-file-property v localname "file-entries"
 663       (with-current-buffer (tramp-get-buffer v)
 664         (let* ((share (tramp-smb-get-share localname))
 665                (file (tramp-smb-get-localname localname nil))
 666                (cache (tramp-get-connection-property v "share-cache" nil))
 667                res entry)
 668
 669           (if (and (not share) cache)
 670               ;; Return cached shares
 671               (setq res cache)
 672
 673             ;; Read entries
 674             (setq file (file-name-as-directory file))
 675             (when (string-match "^\\./" file)
 676               (setq file (substring file 1)))
 677             (if share
 678                 (tramp-smb-send-command v (format "dir \"%s*\"" file))
 679               ;; `tramp-smb-maybe-open-connection' lists also the share names
 680               (tramp-smb-maybe-open-connection v))
 681
 682             ;; Loop the listing
 683             (goto-char (point-min))
 684             (unless (re-search-forward tramp-smb-errors nil t)
 685               (while (not (eobp))
 686                 (setq entry (tramp-smb-read-file-entry share))
 687                 (forward-line)
 688                 (when entry (add-to-list 'res entry))))
 689
 690             ;; Cache share entries
 691             (unless share
 692               (tramp-set-connection-property v "share-cache" res)))
 693
 694           ;; Add directory itself
 695           (add-to-list 'res '("" "drwxrwxrwx" 0 (0 0)))
 696
 697           ;; There's a very strange error (debugged with XEmacs 21.4.14)
 698           ;; If there's no short delay, it returns nil.  No idea about.
 699           (when (featurep 'xemacs) (sleep-for 0.01))
 700
 701           ;; Return entries
 702           (delq nil res))))))
 703
 704 ;; Return either a share name (if SHARE is nil), or a file name
 705 ;;
 706 ;; If shares are listed, the following format is expected
 707 ;;
 708 ;; \s-\{8,8}                              - leading spaces
 709 ;; \S-\(.*\S-\)\s-*                       - share name, 14 char
 710 ;; \s-                                    - space delimeter
 711 ;; \S-+\s-*                               - type, 8 char, "Disk    " expected
 712 ;; \(\s-\{2,2\}.*\)?                      - space delimeter, comment
 713 ;;
 714 ;; Entries provided by smbclient DIR aren't fully regular.
 715 ;; They should have the format
 716 ;;
 717 ;; \s-\{2,2}                              - leading spaces
 718 ;; \S-\(.*\S-\)\s-*                       - file name, 30 chars, left bound
 719 ;; \s-+[ADHRSV]*                          - permissions, 7 chars, right bound
 720 ;; \s-                                    - space delimeter
 721 ;; \s-+[0-9]+                             - size, 8 chars, right bound
 722 ;; \s-\{2,2\}                             - space delimeter
 723 ;; \w\{3,3\}                              - weekday
 724 ;; \s-                                    - space delimeter
 725 ;; \w\{3,3\}                              - month
 726 ;; \s-                                    - space delimeter
 727 ;; [ 12][0-9]                             - day
 728 ;; \s-                                    - space delimeter
 729 ;; [0-9]\{2,2\}:[0-9]\{2,2\}:[0-9]\{2,2\} - time
 730 ;; \s-                                    - space delimeter
 731 ;; [0-9]\{4,4\}                           - year
 732 ;;
 733 ;; samba/src/client.c (http://samba.org/doxygen/samba/client_8c-source.html)
 734 ;; has function display_finfo:
 735 ;;
 736 ;;   d_printf("  %-30s%7.7s %8.0f  %s",
 737 ;;            finfo->name,
 738 ;;            attrib_string(finfo->mode),
 739 ;;            (double)finfo->size,
 740 ;;            asctime(LocalTime(&t)));
 741 ;;
 742 ;; in Samba 1.9, there's the following code:
 743 ;;
 744 ;;   DEBUG(0,("  %-30s%7.7s%10d  %s",
 745 ;;         CNV_LANG(finfo->name),
 746 ;;         attrib_string(finfo->mode),
 747 ;;         finfo->size,
 748 ;;         asctime(LocalTime(&t))));
 749 ;;
 750 ;; Problems:
 751 ;; * Modern regexp constructs, like spy groups and counted repetitions, aren't
 752 ;;   available in older Emacsen.
 753 ;; * The length of constructs (file name, size) might exceed the default.
 754 ;; * File names might contain spaces.
 755 ;; * Permissions might be empty.
 756 ;;
 757 ;; So we try to analyze backwards.
 758 (defun tramp-smb-read-file-entry (share)
 759   "Parse entry in SMB output buffer.
 760 If SHARE is result, entries are of type dir. Otherwise, shares are listed.
 761 Result is the list (LOCALNAME MODE SIZE MTIME)."
 762 ;; We are called from `tramp-smb-get-file-entries', which sets the
 763 ;; current buffer.
 764   (let ((line (buffer-substring (point) (tramp-compat-line-end-position)))
 765         localname mode size month day hour min sec year mtime)
 766
 767     (if (not share)
 768
 769         ;; Read share entries.
 770         (when (string-match "^\\s-+\\(\\S-\\(.*\\S-\\)?\\)\\s-+Disk" line)
 771           (setq localname (match-string 1 line)
 772                 mode "dr-xr-xr-x"
 773                 size 0))
 774
 775       ;; Real listing.
 776       (block nil
 777
 778         ;; year
 779         (if (string-match "\\([0-9]+\\)$" line)
 780             (setq year (string-to-number (match-string 1 line))
 781                   line (substring line 0 -5))
 782           (return))
 783
 784         ;; time
 785         (if (string-match "\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)$" line)
 786             (setq hour (string-to-number (match-string 1 line))
 787                   min  (string-to-number (match-string 2 line))
 788                   sec  (string-to-number (match-string 3 line))
 789                   line (substring line 0 -9))
 790           (return))
 791
 792         ;; day
 793         (if (string-match "\\([0-9]+\\)$" line)
 794             (setq day  (string-to-number (match-string 1 line))
 795                   line (substring line 0 -3))
 796           (return))
 797
 798         ;; month
 799         (if (string-match "\\(\\w+\\)$" line)
 800             (setq month (match-string 1 line)
 801                   line  (substring line 0 -4))
 802           (return))
 803
 804         ;; weekday
 805         (if (string-match "\\(\\w+\\)$" line)
 806             (setq line (substring line 0 -5))
 807           (return))
 808
 809         ;; size
 810         (if (string-match "\\([0-9]+\\)$" line)
 811             (let ((length (- (max 10 (1+ (length (match-string 1 line)))))))
 812               (setq size (string-to-number (match-string 1 line)))
 813               (when (string-match "\\([ADHRSV]+\\)" (substring line length))
 814                 (setq length (+ length (match-end 0))))
 815               (setq line (substring line 0 length)))
 816           (return))
 817
 818         ;; mode: ARCH, DIR, HIDDEN, RONLY, SYSTEM, VOLID
 819         (if (string-match "\\([ADHRSV]+\\)?$" line)
 820             (setq
 821              mode (or (match-string 1 line) "")
 822              mode (save-match-data (format
 823                     "%s%s"
 824                     (if (string-match "D" mode) "d" "-")
 825                     (mapconcat
 826                      (lambda (x) "") "    "
 827                      (concat "r" (if (string-match "R" mode) "-" "w") "x"))))
 828              line (substring line 0 -7))
 829           (return))
 830
 831         ;; localname
 832         (if (string-match "^\\s-+\\(\\S-\\(.*\\S-\\)?\\)\\s-*$" line)
 833             (setq localname (match-string 1 line))
 834           (return))))
 835
 836     (when (and localname mode size)
 837       (setq mtime
 838             (if (and sec min hour day month year)
 839                 (encode-time
 840                  sec min hour day
 841                  (cdr (assoc (downcase month) tramp-parse-time-months))
 842                  year)
 843               '(0 0)))
 844       (list localname mode size mtime))))
 845
 846
 847 ;; Connection functions
 848
 849 (defun tramp-smb-send-command (vec command)
 850   "Send the COMMAND to connection VEC.
 851 Returns nil if there has been an error message from smbclient."
 852   (tramp-smb-maybe-open-connection vec)
 853   (tramp-message vec 6 "%s" command)
 854   (tramp-send-string vec command)
 855   (tramp-smb-wait-for-output vec))
 856
 857 (defun tramp-smb-maybe-open-connection (vec)
 858   "Maybe open a connection to HOST, log in as USER, using `tramp-smb-program'.
 859 Does not do anything if a connection is already open, but re-opens the
 860 connection if a previous connection has died for some reason."
 861   (let* ((share (tramp-smb-get-share (tramp-file-name-localname vec)))
 862          (buf (tramp-get-buffer vec))
 863          (p (get-buffer-process buf)))
 864
 865     ;; If too much time has passed since last command was sent, look
 866     ;; whether has been an error message; maybe due to connection timeout.
 867     (with-current-buffer buf
 868       (goto-char (point-min))
 869       (when (and (> (tramp-time-diff
 870                      (current-time)
 871                      (tramp-get-connection-property
 872                       p "last-cmd-time" '(0 0 0)))
 873                     60)
 874                  p (processp p) (memq (process-status p) '(run open))
 875                  (re-search-forward tramp-smb-errors nil t))
 876         (delete-process p)
 877         (setq p nil)))
 878
 879     ;; Check whether it is still the same share.
 880     (unless
 881         (and p (processp p) (memq (process-status p) '(run open))
 882              (string-equal
 883               share
 884               (tramp-get-connection-property p "smb-share" "")))
 885
 886       (save-match-data
 887         ;; There might be unread output from checking for share names.
 888         (when buf (with-current-buffer buf (erase-buffer)))
 889         (when (and p (processp p)) (delete-process p))
 890
 891         (unless (let ((default-directory
 892                         (tramp-compat-temporary-file-directory)))
 893                   (executable-find tramp-smb-program))
 894           (error "Cannot find command %s in %s" tramp-smb-program exec-path))
 895
 896         (let* ((user (tramp-file-name-user vec))
 897                (host (tramp-file-name-host vec))
 898                (real-user user)
 899                (real-host host)
 900                domain port args)
 901
 902           ;; Check for domain ("user%domain") and port ("host#port").
 903           (when (and user (string-match "\\(.+\\)%\\(.+\\)" user))
 904             (setq real-user (or (match-string 1 user) user)
 905                   domain (match-string 2 user)))
 906
 907           (when (and host (string-match "\\(.+\\)#\\(.+\\)" host))
 908             (setq real-host (or (match-string 1 host) host)
 909                   port (match-string 2 host)))
 910
 911           (if share
 912               (setq args (list (concat "//" real-host "/" share)))
 913             (setq args (list "-L" real-host )))
 914
 915           (if (not (zerop (length real-user)))
 916               (setq args (append args (list "-U" real-user)))
 917             (setq args (append args (list "-N"))))
 918
 919           (when domain (setq args (append args (list "-W" domain))))
 920           (when port   (setq args (append args (list "-p" port))))
 921           (setq args (append args (list "-s" "/dev/null")))
 922
 923           ;; OK, let's go.
 924           (tramp-message
 925            vec 3 "Opening connection for //%s%s/%s..."
 926            (if (not (zerop (length user))) (concat user "@") "")
 927            host (or share ""))
 928
 929           (let* ((coding-system-for-read nil)
 930                  (process-connection-type tramp-process-connection-type)
 931                  (p (let ((default-directory
 932                             (tramp-compat-temporary-file-directory)))
 933                       (apply #'start-process
 934                              (tramp-buffer-name vec) (tramp-get-buffer vec)
 935                              tramp-smb-program args))))
 936
 937             (tramp-message
 938              vec 6 "%s" (mapconcat 'identity (process-command p) " "))
 939             (set-process-sentinel p 'tramp-flush-connection-property)
 940             (tramp-set-process-query-on-exit-flag p nil)
 941             (tramp-set-connection-property p "smb-share" share)
 942
 943             ;; Set variables for computing the prompt for reading password.
 944             (setq tramp-current-method tramp-smb-method
 945                   tramp-current-user user
 946                   tramp-current-host host)
 947
 948             ;; Set chunksize.  Otherwise, `tramp-send-string' might
 949             ;; try it itself.
 950             (tramp-set-connection-property p "chunksize" tramp-chunksize)
 951
 952             ;; Play login scenario.
 953             (tramp-process-actions
 954              p vec
 955              (if share
 956                  tramp-smb-actions-with-share
 957                tramp-smb-actions-without-share))
 958
 959             (tramp-message
 960              vec 3 "Opening connection for //%s%s/%s...done"
 961              (if (not (zerop (length user))) (concat user "@") "")
 962              host (or share ""))))))))
 963
 964 ;; We don't use timeouts.  If needed, the caller shall wrap around.
 965 (defun tramp-smb-wait-for-output (vec)
 966   "Wait for output from smbclient command.
 967 Returns nil if an error message has appeared."
 968   (with-current-buffer (tramp-get-buffer vec)
 969     (let ((p (get-buffer-process (current-buffer)))
 970           (found (progn (goto-char (point-min))
 971                         (re-search-forward tramp-smb-prompt nil t)))
 972           (err   (progn (goto-char (point-min))
 973                         (re-search-forward tramp-smb-errors nil t))))
 974
 975       ;; Algorithm: get waiting output.  See if last line contains
 976       ;; tramp-smb-prompt sentinel or tramp-smb-errors strings.
 977       ;; If not, wait a bit and again get waiting output.
 978       (while (and (not found) (not err))
 979
 980         ;; Accept pending output.
 981         (tramp-accept-process-output p)
 982
 983         ;; Search for prompt.
 984         (goto-char (point-min))
 985         (setq found (re-search-forward tramp-smb-prompt nil t))
 986
 987         ;; Search for errors.
 988         (goto-char (point-min))
 989         (setq err (re-search-forward tramp-smb-errors nil t)))
 990
 991       ;; When the process is still alive, read pending output.
 992       (while (and (not found) (memq (process-status p) '(run open)))
 993
 994         ;; Accept pending output.
 995         (tramp-accept-process-output p)
 996
 997         ;; Search for prompt.
 998         (goto-char (point-min))
 999         (setq found (re-search-forward tramp-smb-prompt nil t)))
1000
1001       ;; Return value is whether no error message has appeared.
1002       (tramp-message vec 6 "\n%s" (buffer-string))
1003       (not err))))
1004
1005
1006 (provide 'tramp-smb)
1007
1008 ;;; TODO:
1009
1010 ;; * Error handling in case password is wrong.
1011 ;; * Read password from "~/.netrc".
1012 ;; * Return more comprehensive file permission string.  Think whether it is
1013 ;;   possible to implement `set-file-modes'.
1014 ;; * Handle links (FILENAME.LNK).
1015 ;; * Try to remove the inclusion of dummy "" directory.  Seems to be at
1016 ;;   several places, especially in `tramp-smb-handle-insert-directory'.
1017 ;; * (RMS) Use unwind-protect to clean up the state so as to make the state
1018 ;;   regular again.
1019 ;; * Make it multi-hop capable.
1020
1021 ;;; arch-tag: fcc9dbec-7503-4d73-b638-3c8aa59575f5
1022 ;;; tramp-smb.el ends here