1;;; tramp-smb.el --- Tramp access functions for SMB servers -*- coding: iso-8859-1; -*- 2 3;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. 4 5;; Author: Michael Albinus <michael.albinus@gmx.de> 6;; Keywords: comm, processes 7 8;; This file is part of GNU Emacs. 9 10;; GNU Emacs is free software; you can redistribute it and/or modify 11;; it under the terms of the GNU General Public License as published by 12;; the Free Software Foundation; either version 2, or (at your option) 13;; any later version. 14 15;; GNU Emacs is distributed in the hope that it will be useful, 16;; but WITHOUT ANY WARRANTY; without even the implied warranty of 17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18;; GNU General Public License for more details. 19 20;; You should have received a copy of the GNU General Public License 21;; along with GNU Emacs; see the file COPYING. If not, write to the 22;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 23;; Boston, MA 02110-1301, USA. 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 33;; Pacify byte-compiler 34(eval-when-compile 35 (require 'cl) 36 (require 'custom) 37 ;; Emacs 19.34 compatibility hack -- is this needed? 38 (or (>= emacs-major-version 20) 39 (load "cl-seq"))) 40 41;; Avoid byte-compiler warnings if the byte-compiler supports this. 42;; Currently, XEmacs supports this. 43(eval-when-compile 44 (when (fboundp 'byte-compiler-options) 45 (let (unused-vars) ; Pacify Emacs byte-compiler 46 (defalias 'warnings 'identity) ; Pacify Emacs byte-compiler 47 (byte-compiler-options (warnings (- unused-vars)))))) 48 49;; Define SMB method ... 50(defcustom tramp-smb-method "smb" 51 "*Method to connect SAMBA and M$ SMB servers." 52 :group 'tramp 53 :type 'string) 54 55;; ... and add it to the method list. 56(add-to-list 'tramp-methods (cons tramp-smb-method nil)) 57 58;; Add a default for `tramp-default-method-alist'. Rule: If there is 59;; a domain in USER, it must be the SMB method. 60(add-to-list 'tramp-default-method-alist 61 (list "" "%" tramp-smb-method)) 62 63;; Add completion function for SMB method. 64(tramp-set-completion-function 65 tramp-smb-method 66 '((tramp-parse-netrc "~/.netrc"))) 67 68(defcustom tramp-smb-program "smbclient" 69 "*Name of SMB client to run." 70 :group 'tramp 71 :type 'string) 72 73(defconst tramp-smb-prompt "^smb: .+> \\|^\\s-+Server\\s-+Comment$" 74 "Regexp used as prompt in smbclient.") 75 76(defconst tramp-smb-errors 77 (mapconcat 78 'identity 79 '(; Connection error 80 "Connection to \\S-+ failed" 81 ; Samba 82 "ERRDOS" 83 "ERRSRV" 84 "ERRbadfile" 85 "ERRbadpw" 86 "ERRfilexists" 87 "ERRnoaccess" 88 "ERRnomem" 89 "ERRnosuchshare" 90 ; Windows NT 4.0, Windows 5.0 (Windows 2000), Windows 5.1 (Windows XP) 91 "NT_STATUS_ACCESS_DENIED" 92 "NT_STATUS_ACCOUNT_LOCKED_OUT" 93 "NT_STATUS_BAD_NETWORK_NAME" 94 "NT_STATUS_CANNOT_DELETE" 95 "NT_STATUS_LOGON_FAILURE" 96 "NT_STATUS_NETWORK_ACCESS_DENIED" 97 "NT_STATUS_NO_SUCH_FILE" 98 "NT_STATUS_OBJECT_NAME_INVALID" 99 "NT_STATUS_OBJECT_NAME_NOT_FOUND" 100 "NT_STATUS_SHARING_VIOLATION" 101 "NT_STATUS_WRONG_PASSWORD") 102 "\\|") 103 "Regexp for possible error strings of SMB servers. 104Used instead of analyzing error codes of commands.") 105 106(defvar tramp-smb-share nil 107 "Holds the share name for the current buffer. 108This variable is local to each buffer.") 109(make-variable-buffer-local 'tramp-smb-share) 110 111(defvar tramp-smb-share-cache nil 112 "Caches the share names accessible to host related to the current buffer. 113This variable is local to each buffer.") 114(make-variable-buffer-local 'tramp-smb-share-cache) 115 116(defvar tramp-smb-inodes nil 117 "Keeps virtual inodes numbers for SMB files.") 118 119;; New handlers should be added here. 120(defconst tramp-smb-file-name-handler-alist 121 '( 122 ;; `access-file' performed by default handler 123 (add-name-to-file . tramp-smb-handle-copy-file) ;; we're on Windows, honey. 124 ;; `byte-compiler-base-file-name' performed by default handler 125 (copy-file . tramp-smb-handle-copy-file) 126 (delete-directory . tramp-smb-handle-delete-directory) 127 (delete-file . tramp-smb-handle-delete-file) 128 ;; `diff-latest-backup-file' performed by default handler 129 (directory-file-name . tramp-handle-directory-file-name) 130 (directory-files . tramp-smb-handle-directory-files) 131 (directory-files-and-attributes . tramp-smb-handle-directory-files-and-attributes) 132 (dired-call-process . tramp-smb-not-handled) 133 (dired-compress-file . tramp-smb-not-handled) 134 ;; `dired-uncache' performed by default handler 135 ;; `expand-file-name' not necessary because we cannot expand "~/" 136 (file-accessible-directory-p . tramp-smb-handle-file-directory-p) 137 (file-attributes . tramp-smb-handle-file-attributes) 138 (file-directory-p . tramp-smb-handle-file-directory-p) 139 (file-executable-p . tramp-smb-handle-file-exists-p) 140 (file-exists-p . tramp-smb-handle-file-exists-p) 141 (file-local-copy . tramp-smb-handle-file-local-copy) 142 (file-remote-p . tramp-handle-file-remote-p) 143 (file-modes . tramp-handle-file-modes) 144 (file-name-all-completions . tramp-smb-handle-file-name-all-completions) 145 ;; `file-name-as-directory' performed by default handler 146 (file-name-completion . tramp-handle-file-name-completion) 147 (file-name-directory . tramp-handle-file-name-directory) 148 (file-name-nondirectory . tramp-handle-file-name-nondirectory) 149 ;; `file-name-sans-versions' performed by default handler 150 (file-newer-than-file-p . tramp-smb-handle-file-newer-than-file-p) 151 (file-ownership-preserved-p . tramp-smb-not-handled) 152 (file-readable-p . tramp-smb-handle-file-exists-p) 153 (file-regular-p . tramp-handle-file-regular-p) 154 (file-symlink-p . tramp-smb-not-handled) 155 ;; `file-truename' performed by default handler 156 (file-writable-p . tramp-smb-handle-file-writable-p) 157 (find-backup-file-name . tramp-handle-find-backup-file-name) 158 ;; `find-file-noselect' performed by default handler 159 ;; `get-file-buffer' performed by default handler 160 (insert-directory . tramp-smb-handle-insert-directory) 161 (insert-file-contents . tramp-handle-insert-file-contents) 162 (load . tramp-handle-load) 163 (make-directory . tramp-smb-handle-make-directory) 164 (make-directory-internal . tramp-smb-handle-make-directory-internal) 165 (make-symbolic-link . tramp-smb-not-handled) 166 (rename-file . tramp-smb-handle-rename-file) 167 (set-file-modes . tramp-smb-not-handled) 168 (set-visited-file-modtime . tramp-smb-not-handled) 169 (shell-command . tramp-smb-not-handled) 170 (substitute-in-file-name . tramp-smb-handle-substitute-in-file-name) 171 (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory) 172 (vc-registered . tramp-smb-not-handled) 173 (verify-visited-file-modtime . tramp-smb-not-handled) 174 (write-region . tramp-smb-handle-write-region) 175) 176 "Alist of handler functions for Tramp SMB method. 177Operations not mentioned here will be handled by the default Emacs primitives.") 178 179(defun tramp-smb-file-name-p (filename) 180 "Check if it's a filename for SMB servers." 181 (let ((v (tramp-dissect-file-name filename))) 182 (string= 183 (tramp-find-method 184 (tramp-file-name-multi-method v) 185 (tramp-file-name-method v) 186 (tramp-file-name-user v) 187 (tramp-file-name-host v)) 188 tramp-smb-method))) 189 190(defun tramp-smb-file-name-handler (operation &rest args) 191 "Invoke the SMB related OPERATION. 192First arg specifies the OPERATION, second arg is a list of arguments to 193pass to the OPERATION." 194 (let ((fn (assoc operation tramp-smb-file-name-handler-alist))) 195 (if fn 196 (if (eq (cdr fn) 'tramp-smb-not-handled) 197 (apply (cdr fn) operation args) 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-not-handled (operation &rest args) 208 "Default handler for all functions which are disrecarded." 209 (tramp-message 10 "Won't be handled: %s %s" operation args) 210 nil) 211 212(defun tramp-smb-handle-copy-file 213 (filename newname &optional ok-if-already-exists keep-date) 214 "Like `copy-file' for tramp files. 215KEEP-DATE is not handled in case NEWNAME resides on an SMB server." 216 (setq filename (expand-file-name filename) 217 newname (expand-file-name newname)) 218 219 (let ((tmpfile (file-local-copy filename))) 220 221 (if tmpfile 222 ;; remote filename 223 (rename-file tmpfile newname ok-if-already-exists) 224 225 ;; remote newname 226 (when (file-directory-p newname) 227 (setq newname (expand-file-name 228 (file-name-nondirectory filename) newname))) 229 (when (and (not ok-if-already-exists) 230 (file-exists-p newname)) 231 (error "copy-file: file %s already exists" newname)) 232 233 (with-parsed-tramp-file-name newname nil 234 (save-excursion 235 (let ((share (tramp-smb-get-share localname)) 236 (file (tramp-smb-get-localname localname t))) 237 (unless share 238 (error "Target `%s' must contain a share name" filename)) 239 (tramp-smb-maybe-open-connection user host share) 240 (tramp-message-for-buffer 241 nil tramp-smb-method user host 242 5 "Copying file %s to file %s..." filename newname) 243 (if (tramp-smb-send-command 244 user host (format "put %s \"%s\"" filename file)) 245 (tramp-message-for-buffer 246 nil tramp-smb-method user host 247 5 "Copying file %s to file %s...done" filename newname) 248 (error "Cannot copy `%s'" filename)))))))) 249 250(defun tramp-smb-handle-delete-directory (directory) 251 "Like `delete-directory' for tramp files." 252 (setq directory (directory-file-name (expand-file-name directory))) 253 (when (file-exists-p directory) 254 (with-parsed-tramp-file-name directory nil 255 (save-excursion 256 (let ((share (tramp-smb-get-share localname)) 257 (dir (tramp-smb-get-localname (file-name-directory localname) t)) 258 (file (file-name-nondirectory localname))) 259 (tramp-smb-maybe-open-connection user host share) 260 (if (and 261 (tramp-smb-send-command user host (format "cd \"%s\"" dir)) 262 (tramp-smb-send-command user host (format "rmdir \"%s\"" file))) 263 ;; Go Home 264 (tramp-smb-send-command user host (format "cd \\")) 265 ;; Error 266 (tramp-smb-send-command user host (format "cd \\")) 267 (error "Cannot delete directory `%s'" directory))))))) 268 269(defun tramp-smb-handle-delete-file (filename) 270 "Like `delete-file' for tramp files." 271 (setq filename (expand-file-name filename)) 272 (when (file-exists-p filename) 273 (with-parsed-tramp-file-name filename nil 274 (save-excursion 275 (let ((share (tramp-smb-get-share localname)) 276 (dir (tramp-smb-get-localname (file-name-directory localname) t)) 277 (file (file-name-nondirectory localname))) 278 (tramp-smb-maybe-open-connection user host share) 279 (if (and 280 (tramp-smb-send-command user host (format "cd \"%s\"" dir)) 281 (tramp-smb-send-command user host (format "rm \"%s\"" file))) 282 ;; Go Home 283 (tramp-smb-send-command user host (format "cd \\")) 284 ;; Error 285 (tramp-smb-send-command user host (format "cd \\")) 286 (error "Cannot delete file `%s'" filename))))))) 287 288(defun tramp-smb-handle-directory-files 289 (directory &optional full match nosort) 290 "Like `directory-files' for tramp files." 291 (setq directory (directory-file-name (expand-file-name directory))) 292 (with-parsed-tramp-file-name directory nil 293 (save-excursion 294 (let* ((share (tramp-smb-get-share localname)) 295 (file (tramp-smb-get-localname localname nil)) 296 (entries (tramp-smb-get-file-entries user host share file))) 297 ;; Just the file names are needed 298 (setq entries (mapcar 'car entries)) 299 ;; Discriminate with regexp 300 (when match 301 (setq entries 302 (delete nil 303 (mapcar (lambda (x) (when (string-match match x) x)) 304 entries)))) 305 ;; Make absolute localnames if necessary 306 (when full 307 (setq entries 308 (mapcar (lambda (x) 309 (concat (file-name-as-directory directory) x)) 310 entries))) 311 ;; Sort them if necessary 312 (unless nosort (setq entries (sort entries 'string-lessp))) 313 ;; That's it 314 entries)))) 315 316(defun tramp-smb-handle-directory-files-and-attributes 317 (directory &optional full match nosort id-format) 318 "Like `directory-files-and-attributes' for tramp files." 319 (mapcar 320 (lambda (x) 321 ;; We cannot call `file-attributes' for backward compatibility reasons. 322 ;; Its optional parameter ID-FORMAT is introduced with Emacs 22. 323 (cons x (tramp-smb-handle-file-attributes 324 (if full x (concat (file-name-as-directory directory) x)) id-format))) 325 (directory-files directory full match nosort))) 326 327(defun tramp-smb-handle-file-attributes (filename &optional id-format) 328 "Like `file-attributes' for tramp files." 329 (with-parsed-tramp-file-name filename nil 330 (save-excursion 331 (let* ((share (tramp-smb-get-share localname)) 332 (file (tramp-smb-get-localname localname nil)) 333 (entries (tramp-smb-get-file-entries user host share file)) 334 (entry (and entries 335 (assoc (file-name-nondirectory file) entries))) 336 (uid (if (and id-format (equal id-format 'string)) "nobody" -1)) 337 (gid (if (and id-format (equal id-format 'string)) "nogroup" -1)) 338 (inode (tramp-smb-get-inode share file)) 339 (device (tramp-get-device nil tramp-smb-method user host))) 340 341 ; check result 342 (when entry 343 (list (and (string-match "d" (nth 1 entry)) 344 t) ;0 file type 345 -1 ;1 link count 346 uid ;2 uid 347 gid ;3 gid 348 '(0 0) ;4 atime 349 (nth 3 entry) ;5 mtime 350 '(0 0) ;6 ctime 351 (nth 2 entry) ;7 size 352 (nth 1 entry) ;8 mode 353 nil ;9 gid weird 354 inode ;10 inode number 355 device)))))) ;11 file system number 356 357(defun tramp-smb-handle-file-directory-p (filename) 358 "Like `file-directory-p' for tramp files." 359 (with-parsed-tramp-file-name filename nil 360 (save-excursion 361 (let* ((share (tramp-smb-get-share localname)) 362 (file (tramp-smb-get-localname localname nil)) 363 (entries (tramp-smb-get-file-entries user host share file)) 364 (entry (and entries 365 (assoc (file-name-nondirectory file) entries)))) 366 (and entry 367 (string-match "d" (nth 1 entry)) 368 t))))) 369 370(defun tramp-smb-handle-file-exists-p (filename) 371 "Like `file-exists-p' for tramp files." 372 (with-parsed-tramp-file-name filename nil 373 (save-excursion 374 (let* ((share (tramp-smb-get-share localname)) 375 (file (tramp-smb-get-localname localname nil)) 376 (entries (tramp-smb-get-file-entries user host share file))) 377 (and entries 378 (member (file-name-nondirectory file) (mapcar 'car entries)) 379 t))))) 380 381(defun tramp-smb-handle-file-local-copy (filename) 382 "Like `file-local-copy' for tramp files." 383 (with-parsed-tramp-file-name filename nil 384 (save-excursion 385 (let ((share (tramp-smb-get-share localname)) 386 (file (tramp-smb-get-localname localname t)) 387 (tmpfil (tramp-make-temp-file filename))) 388 (unless (file-exists-p filename) 389 (error "Cannot make local copy of non-existing file `%s'" filename)) 390 (tramp-message-for-buffer 391 nil tramp-smb-method user host 392 5 "Fetching %s to tmp file %s..." filename tmpfil) 393 (tramp-smb-maybe-open-connection user host share) 394 (if (tramp-smb-send-command 395 user host (format "get \"%s\" %s" file tmpfil)) 396 (tramp-message-for-buffer 397 nil tramp-smb-method user host 398 5 "Fetching %s to tmp file %s...done" filename tmpfil) 399 (error "Cannot make local copy of file `%s'" filename)) 400 tmpfil)))) 401 402;; This function should return "foo/" for directories and "bar" for 403;; files. 404(defun tramp-smb-handle-file-name-all-completions (filename directory) 405 "Like `file-name-all-completions' for tramp files." 406 (with-parsed-tramp-file-name directory nil 407 (save-match-data 408 (save-excursion 409 (let* ((share (tramp-smb-get-share localname)) 410 (file (tramp-smb-get-localname localname nil)) 411 (entries (tramp-smb-get-file-entries user host share file))) 412 413 (all-completions 414 filename 415 (mapcar 416 (lambda (x) 417 (list 418 (if (string-match "d" (nth 1 x)) 419 (file-name-as-directory (nth 0 x)) 420 (nth 0 x)))) 421 entries))))))) 422 423(defun tramp-smb-handle-file-newer-than-file-p (file1 file2) 424 "Like `file-newer-than-file-p' for tramp files." 425 (cond 426 ((not (file-exists-p file1)) nil) 427 ((not (file-exists-p file2)) t) 428 (t (tramp-smb-time-less-p (file-attributes file2) 429 (file-attributes file1))))) 430 431(defun tramp-smb-handle-file-writable-p (filename) 432 "Like `file-writable-p' for tramp files." 433 (if (not (file-exists-p filename)) 434 (let ((dir (file-name-directory filename))) 435 (and (file-exists-p dir) 436 (file-writable-p dir))) 437 (with-parsed-tramp-file-name filename nil 438 (save-excursion 439 (let* ((share (tramp-smb-get-share localname)) 440 (file (tramp-smb-get-localname localname nil)) 441 (entries (tramp-smb-get-file-entries user host share file)) 442 (entry (and entries 443 (assoc (file-name-nondirectory file) entries)))) 444 (and share entry 445 (string-match "w" (nth 1 entry)) 446 t)))))) 447 448(defun tramp-smb-handle-insert-directory 449 (filename switches &optional wildcard full-directory-p) 450 "Like `insert-directory' for tramp files. 451WILDCARD and FULL-DIRECTORY-P are not handled." 452 (setq filename (expand-file-name filename)) 453 (when (file-directory-p filename) 454 ;; This check is a little bit strange, but in `dired-add-entry' 455 ;; this function is called with a non-directory ... 456 (setq filename (file-name-as-directory filename))) 457 (with-parsed-tramp-file-name filename nil 458 (save-match-data 459 (let* ((share (tramp-smb-get-share localname)) 460 (file (tramp-smb-get-localname localname nil)) 461 (entries (tramp-smb-get-file-entries user host share file))) 462 463 ;; Delete dummy "" entry, useless entries 464 (setq entries 465 (if (file-directory-p filename) 466 (delq (assoc "" entries) entries) 467 ;; We just need the only and only entry FILENAME. 468 (list (assoc (file-name-nondirectory filename) entries)))) 469 470 ;; Sort entries 471 (setq entries 472 (sort 473 entries 474 (lambda (x y) 475 (if (string-match "t" switches) 476 ; sort by date 477 (tramp-smb-time-less-p (nth 3 y) (nth 3 x)) 478 ; sort by name 479 (string-lessp (nth 0 x) (nth 0 y)))))) 480 481 ;; Print entries 482 (mapcar 483 (lambda (x) 484 (insert 485 (format 486 "%10s %3d %-8s %-8s %8s %s %s\n" 487 (nth 1 x) ; mode 488 1 "nobody" "nogroup" 489 (nth 2 x) ; size 490 (format-time-string 491 (if (tramp-smb-time-less-p 492 (tramp-smb-time-subtract (current-time) (nth 3 x)) 493 tramp-smb-half-a-year) 494 "%b %e %R" 495 "%b %e %Y") 496 (nth 3 x)) ; date 497 (nth 0 x))) ; file name 498 (forward-line) 499 (beginning-of-line)) 500 entries))))) 501 502(defun tramp-smb-handle-make-directory (dir &optional parents) 503 "Like `make-directory' for tramp files." 504 (setq dir (directory-file-name (expand-file-name dir))) 505 (unless (file-name-absolute-p dir) 506 (setq dir (concat default-directory dir))) 507 (with-parsed-tramp-file-name dir nil 508 (save-match-data 509 (let* ((share (tramp-smb-get-share localname)) 510 (ldir (file-name-directory dir))) 511 ;; Make missing directory parts 512 (when (and parents share (not (file-directory-p ldir))) 513 (make-directory ldir parents)) 514 ;; Just do it 515 (when (file-directory-p ldir) 516 (make-directory-internal dir)) 517 (unless (file-directory-p dir) 518 (error "Couldn't make directory %s" dir)))))) 519 520(defun tramp-smb-handle-make-directory-internal (directory) 521 "Like `make-directory-internal' for tramp files." 522 (setq directory (directory-file-name (expand-file-name directory))) 523 (unless (file-name-absolute-p directory) 524 (setq directory (concat default-directory directory))) 525 (with-parsed-tramp-file-name directory nil 526 (save-match-data 527 (let* ((share (tramp-smb-get-share localname)) 528 (file (tramp-smb-get-localname localname nil))) 529 (when (file-directory-p (file-name-directory directory)) 530 (tramp-smb-maybe-open-connection user host share) 531 (tramp-smb-send-command user host (format "mkdir \"%s\"" file))) 532 (unless (file-directory-p directory) 533 (error "Couldn't make directory %s" directory)))))) 534 535(defun tramp-smb-handle-rename-file 536 (filename newname &optional ok-if-already-exists) 537 "Like `rename-file' for tramp files." 538 (setq filename (expand-file-name filename) 539 newname (expand-file-name newname)) 540 541 (let ((tmpfile (file-local-copy filename))) 542 543 (if tmpfile 544 ;; remote filename 545 (rename-file tmpfile newname ok-if-already-exists) 546 547 ;; remote newname 548 (when (file-directory-p newname) 549 (setq newname (expand-file-name 550 (file-name-nondirectory filename) newname))) 551 (when (and (not ok-if-already-exists) 552 (file-exists-p newname)) 553 (error "rename-file: file %s already exists" newname)) 554 555 (with-parsed-tramp-file-name newname nil 556 (save-excursion 557 (let ((share (tramp-smb-get-share localname)) 558 (file (tramp-smb-get-localname localname t))) 559 (tramp-smb-maybe-open-connection user host share) 560 (tramp-message-for-buffer 561 nil tramp-smb-method user host 562 5 "Copying file %s to file %s..." filename newname) 563 (if (tramp-smb-send-command 564 user host (format "put %s \"%s\"" filename file)) 565 (tramp-message-for-buffer 566 nil tramp-smb-method user host 567 5 "Copying file %s to file %s...done" filename newname) 568 (error "Cannot rename `%s'" filename))))))) 569 570 (delete-file filename)) 571 572(defun tramp-smb-handle-substitute-in-file-name (filename) 573 "Like `handle-substitute-in-file-name' for tramp files. 574Catches errors for shares like \"C$/\", which are common in Microsoft Windows." 575 (condition-case nil 576 (tramp-run-real-handler 'substitute-in-file-name (list filename)) 577 (error filename))) 578 579(defun tramp-smb-handle-write-region 580 (start end filename &optional append visit lockname confirm) 581 "Like `write-region' for tramp files." 582 (unless (eq append nil) 583 (error "Cannot append to file using tramp (`%s')" filename)) 584 (setq filename (expand-file-name filename)) 585 ;; XEmacs takes a coding system as the seventh argument, not `confirm' 586 (when (and (not (featurep 'xemacs)) 587 confirm (file-exists-p filename)) 588 (unless (y-or-n-p (format "File %s exists; overwrite anyway? " 589 filename)) 590 (error "File not overwritten"))) 591 (with-parsed-tramp-file-name filename nil 592 (save-excursion 593 (let ((share (tramp-smb-get-share localname)) 594 (file (tramp-smb-get-localname localname t)) 595 (curbuf (current-buffer)) 596 tmpfil) 597 ;; Write region into a tmp file. 598 (setq tmpfil (tramp-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 tmpfil append 'no-message lockname confirm) 606 (list start end tmpfil append 'no-message lockname))) 607 608 (tramp-smb-maybe-open-connection user host share) 609 (tramp-message-for-buffer 610 nil tramp-smb-method user host 611 5 "Writing tmp file %s to file %s..." tmpfil filename) 612 (if (tramp-smb-send-command 613 user host (format "put %s \"%s\"" tmpfil file)) 614 (tramp-message-for-buffer 615 nil tramp-smb-method user host 616 5 "Writing tmp file %s to file %s...done" tmpfil filename) 617 (error "Cannot write `%s'" filename)) 618 619 (delete-file tmpfil) 620 (unless (equal curbuf (current-buffer)) 621 (error "Buffer has changed from `%s' to `%s'" 622 curbuf (current-buffer))) 623 (when (eq visit t) 624 (set-visited-file-modtime)))))) 625 626 627;; Internal file name functions 628 629(defun tramp-smb-get-share (localname) 630 "Returns the share name of LOCALNAME." 631 (save-match-data 632 (when (string-match "^/?\\([^/]+\\)/" localname) 633 (match-string 1 localname)))) 634 635(defun tramp-smb-get-localname (localname convert) 636 "Returns the file name of LOCALNAME. 637If CONVERT is non-nil exchange \"/\" by \"\\\\\"." 638 (save-match-data 639 (let ((res localname)) 640 641 (setq 642 res (if (string-match "^/?[^/]+/\\(.*\\)" res) 643 (if convert 644 (mapconcat 645 (lambda (x) (if (equal x ?/) "\\" (char-to-string x))) 646 (match-string 1 res) "") 647 (match-string 1 res)) 648 (if (string-match "^/?\\([^/]+\\)$" res) 649 (match-string 1 res) 650 ""))) 651 652 ;; Sometimes we have discarded `substitute-in-file-name' 653 (when (string-match "\\(\\$\\$\\)\\(/\\|$\\)" res) 654 (setq res (replace-match "$" nil nil res 1))) 655 656 res))) 657 658;; Share names of a host are cached. It is very unlikely that the 659;; shares do change during connection. 660(defun tramp-smb-get-file-entries (user host share localname) 661 "Read entries which match LOCALNAME. 662Either the shares are listed, or the `dir' command is executed. 663Only entries matching the localname are returned. 664Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)." 665 (save-excursion 666 (save-match-data 667 (let ((base (or (and (> (length localname) 0) 668 (string-match "\\([^/]+\\)$" localname) 669 (regexp-quote (match-string 1 localname))) 670 "")) 671 res entry) 672 (set-buffer (tramp-get-buffer nil tramp-smb-method user host)) 673 (if (and (not share) tramp-smb-share-cache) 674 ;; Return cached shares 675 (setq res tramp-smb-share-cache) 676 ;; Read entries 677 (tramp-smb-maybe-open-connection user host share) 678 (when share 679 (tramp-smb-send-command 680 user host 681 (format "dir %s" 682 (if (zerop (length localname)) "" (concat "\"" localname "*\""))))) 683 (goto-char (point-min)) 684 ;; Loop the listing 685 (unless (re-search-forward tramp-smb-errors nil t) 686 (while (not (eobp)) 687 (setq entry (tramp-smb-read-file-entry share)) 688 (forward-line) 689 (when entry (add-to-list 'res entry)))) 690 (unless share 691 ;; Cache share entries 692 (setq tramp-smb-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 ;; Check for matching entries 702 (delq nil (mapcar 703 (lambda (x) (and (string-match base (nth 0 x)) x)) 704 res)))))) 705 706;; Return either a share name (if SHARE is nil), or a file name 707;; 708;; If shares are listed, the following format is expected 709;; 710;; \s-\{8,8} - leading spaces 711;; \S-\(.*\S-\)\s-* - share name, 14 char 712;; \s- - space delimeter 713;; \S-+\s-* - type, 8 char, "Disk " expected 714;; \(\s-\{2,2\}.*\)? - space delimeter, comment 715;; 716;; Entries provided by smbclient DIR aren't fully regular. 717;; They should have the format 718;; 719;; \s-\{2,2} - leading spaces 720;; \S-\(.*\S-\)\s-* - file name, 30 chars, left bound 721;; \s-+[ADHRSV]* - permissions, 7 chars, right bound 722;; \s- - space delimeter 723;; \s-+[0-9]+ - size, 8 chars, right bound 724;; \s-\{2,2\} - space delimeter 725;; \w\{3,3\} - weekday 726;; \s- - space delimeter 727;; \w\{3,3\} - month 728;; \s- - space delimeter 729;; [ 19][0-9] - day 730;; \s- - space delimeter 731;; [0-9]\{2,2\}:[0-9]\{2,2\}:[0-9]\{2,2\} - time 732;; \s- - space delimeter 733;; [0-9]\{4,4\} - year 734;; 735;; samba/src/client.c (http://samba.org/doxygen/samba/client_8c-source.html) 736;; has function display_finfo: 737;; 738;; d_printf(" %-30s%7.7s %8.0f %s", 739;; finfo->name, 740;; attrib_string(finfo->mode), 741;; (double)finfo->size, 742;; asctime(LocalTime(&t))); 743;; 744;; in Samba 1.9, there's the following code: 745;; 746;; DEBUG(0,(" %-30s%7.7s%10d %s", 747;; CNV_LANG(finfo->name), 748;; attrib_string(finfo->mode), 749;; finfo->size, 750;; asctime(LocalTime(&t)))); 751;; 752;; Problems: 753;; * Modern regexp constructs, like spy groups and counted repetitions, aren't 754;; available in older Emacsen. 755;; * The length of constructs (file name, size) might exceed the default. 756;; * File names might contain spaces. 757;; * Permissions might be empty. 758;; 759;; So we try to analyze backwards. 760(defun tramp-smb-read-file-entry (share) 761 "Parse entry in SMB output buffer. 762If SHARE is result, entries are of type dir. Otherwise, shares are listed. 763Result is the list (LOCALNAME MODE SIZE MTIME)." 764 (let ((line (buffer-substring (point) (tramp-point-at-eol))) 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-+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-smb-parse-time-months)) 842 year) 843 '(0 0))) 844 (list localname mode size mtime)))) 845 846;; Inodes don't exist for SMB files. Therefore we must generate virtual ones. 847;; Used in `find-buffer-visiting'. 848;; The method applied might be not so efficient (Ange-FTP uses hashes). But 849;; performance isn't the major issue given that file transfer will take time. 850 851(defun tramp-smb-get-inode (share file) 852 "Returns the virtual inode number. 853If it doesn't exist, generate a new one." 854 (let ((string (concat share "/" (directory-file-name file)))) 855 (unless (assoc string tramp-smb-inodes) 856 (add-to-list 'tramp-smb-inodes 857 (list string (length tramp-smb-inodes)))) 858 (nth 1 (assoc string tramp-smb-inodes)))) 859 860 861;; Connection functions 862 863(defun tramp-smb-send-command (user host command) 864 "Send the COMMAND to USER at HOST (logged into an SMB session). 865Erases temporary buffer before sending the command. Returns nil if 866there has been an error message from smbclient." 867 (save-excursion 868 (set-buffer (tramp-get-buffer nil tramp-smb-method user host)) 869 (erase-buffer) 870 (tramp-send-command nil tramp-smb-method user host command nil t) 871 (tramp-smb-wait-for-output user host))) 872 873(defun tramp-smb-maybe-open-connection (user host share) 874 "Maybe open a connection to HOST, logging in as USER, using `tramp-smb-program'. 875Does not do anything if a connection is already open, but re-opens the 876connection if a previous connection has died for some reason." 877 (let ((process-connection-type tramp-process-connection-type) 878 (p (get-buffer-process 879 (tramp-get-buffer nil tramp-smb-method user host)))) 880 (save-excursion 881 (set-buffer (tramp-get-buffer nil tramp-smb-method user host)) 882 ;; Check whether it is still the same share 883 (unless (and p (processp p) (string-equal tramp-smb-share share)) 884 (when (and p (processp p)) 885 (delete-process p) 886 (setq p nil))) 887 ;; If too much time has passed since last command was sent, look 888 ;; whether process is still alive. If it isn't, kill it. 889 (when (and tramp-last-cmd-time 890 (> (tramp-time-diff (current-time) tramp-last-cmd-time) 60) 891 p (processp p) (memq (process-status p) '(run open))) 892 (unless (and p (processp p) (memq (process-status p) '(run open))) 893 (delete-process p) 894 (setq p nil)))) 895 (unless (and p (processp p) (memq (process-status p) '(run open))) 896 (when (and p (processp p)) 897 (delete-process p)) 898 (tramp-smb-open-connection user host share)))) 899 900(defun tramp-smb-open-connection (user host share) 901 "Open a connection using `tramp-smb-program'. 902This starts the command `smbclient //HOST/SHARE -U USER', then waits 903for a remote password prompt. It queries the user for the password, 904then sends the password to the remote host. 905 906Domain names in USER and port numbers in HOST are acknowledged." 907 908 (when (and (fboundp 'executable-find) 909 (not (funcall 'executable-find tramp-smb-program))) 910 (error "Cannot find command %s in %s" tramp-smb-program exec-path)) 911 912 (save-match-data 913 (let* ((buffer (tramp-get-buffer nil tramp-smb-method user host)) 914 (real-user user) 915 (real-host host) 916 domain port args) 917 918 ; Check for domain ("user%domain") and port ("host#port") 919 (when (and user (string-match "\\(.+\\)%\\(.+\\)" user)) 920 (setq real-user (or (match-string 1 user) user) 921 domain (match-string 2 user))) 922 923 (when (and host (string-match "\\(.+\\)#\\(.+\\)" host)) 924 (setq real-host (or (match-string 1 host) host) 925 port (match-string 2 host))) 926 927 (if share 928 (setq args (list (concat "//" real-host "/" share))) 929 (setq args (list "-L" real-host ))) 930 931 (if real-user 932 (setq args (append args (list "-U" real-user))) 933 (setq args (append args (list "-N")))) 934 935 (when domain (setq args (append args (list "-W" domain)))) 936 (when port (setq args (append args (list "-p" port)))) 937 938 ; OK, let's go 939 (tramp-pre-connection nil tramp-smb-method user host tramp-chunksize) 940 (tramp-message 7 "Opening connection for //%s@%s/%s..." 941 user host (or share "")) 942 943 (let* ((default-directory (tramp-temporary-file-directory)) 944 ;; If we omit the conditional here, then we would use 945 ;; `undecided-dos' in some cases. With the conditional, 946 ;; we use nil in these cases. Which one is right? 947 (coding-system-for-read (unless (and (not (featurep 'xemacs)) 948 (> emacs-major-version 20)) 949 tramp-dos-coding-system)) 950 (p (apply #'start-process (buffer-name buffer) buffer 951 tramp-smb-program args))) 952 953 (tramp-message 9 "Started process %s" (process-command p)) 954 (tramp-set-process-query-on-exit-flag p nil) 955 (set-buffer buffer) 956 (setq tramp-smb-share share) 957 958 ; send password 959 (when real-user 960 (let ((pw-prompt "Password:")) 961 (tramp-message 9 "Sending password") 962 (tramp-enter-password p pw-prompt user host))) 963 964 (unless (tramp-smb-wait-for-output user host) 965 (tramp-clear-passwd user host) 966 (error "Cannot open connection //%s@%s/%s" 967 user host (or share ""))))))) 968 969;; We don't use timeouts. If needed, the caller shall wrap around. 970(defun tramp-smb-wait-for-output (user host) 971 "Wait for output from smbclient command. 972Returns nil if an error message has appeared." 973 (let ((proc (get-buffer-process (current-buffer))) 974 (found (progn (goto-char (point-min)) 975 (re-search-forward tramp-smb-prompt nil t))) 976 (err (progn (goto-char (point-min)) 977 (re-search-forward tramp-smb-errors nil t)))) 978 979 ;; Algorithm: get waiting output. See if last line contains 980 ;; tramp-smb-prompt sentinel or tramp-smb-errors strings. 981 ;; If not, wait a bit and again get waiting output. 982 (while (not found) 983 984 ;; Accept pending output. 985 (tramp-accept-process-output proc) 986 987 ;; Search for prompt. 988 (goto-char (point-min)) 989 (setq found (re-search-forward tramp-smb-prompt nil t)) 990 991 ;; Search for errors. 992 (goto-char (point-min)) 993 (setq err (re-search-forward tramp-smb-errors nil t))) 994 995 ;; Add output to debug buffer if appropriate. 996 (when tramp-debug-buffer 997 (append-to-buffer 998 (tramp-get-debug-buffer nil tramp-smb-method user host) 999 (point-min) (point-max))) 1000 1001 ;; Return value is whether no error message has appeared. 1002 (not err))) 1003 1004 1005;; Snarfed code from time-date.el and parse-time.el 1006 1007(defconst tramp-smb-half-a-year '(241 17024) 1008"Evaluated by \"(days-to-time 183)\".") 1009 1010(defconst tramp-smb-parse-time-months '(("jan" . 1) ("feb" . 2) ("mar" . 3) 1011 ("apr" . 4) ("may" . 5) ("jun" . 6) 1012 ("jul" . 7) ("aug" . 8) ("sep" . 9) 1013 ("oct" . 10) ("nov" . 11) ("dec" . 12)) 1014"Alist mapping month names to integers.") 1015 1016(defun tramp-smb-time-less-p (t1 t2) 1017 "Say whether time value T1 is less than time value T2." 1018 (unless t1 (setq t1 '(0 0))) 1019 (unless t2 (setq t2 '(0 0))) 1020 (or (< (car t1) (car t2)) 1021 (and (= (car t1) (car t2)) 1022 (< (nth 1 t1) (nth 1 t2))))) 1023 1024(defun tramp-smb-time-subtract (t1 t2) 1025 "Subtract two time values. 1026Return the difference in the format of a time value." 1027 (unless t1 (setq t1 '(0 0))) 1028 (unless t2 (setq t2 '(0 0))) 1029 (let ((borrow (< (cadr t1) (cadr t2)))) 1030 (list (- (car t1) (car t2) (if borrow 1 0)) 1031 (- (+ (if borrow 65536 0) (cadr t1)) (cadr t2))))) 1032 1033 1034(provide 'tramp-smb) 1035 1036;;; TODO: 1037 1038;; * Provide a local smb.conf. The default one might not be readable. 1039;; * Error handling in case password is wrong. 1040;; * Read password from "~/.netrc". 1041;; * Return more comprehensive file permission string. Think whether it is 1042;; possible to implement `set-file-modes'. 1043;; * Handle WILDCARD and FULL-DIRECTORY-P in 1044;; `tramp-smb-handle-insert-directory'. 1045;; * Handle links (FILENAME.LNK). 1046;; * Maybe local tmp files should have the same extension like the original 1047;; files. Strange behaviour with jka-compr otherwise? 1048;; * Copy files in dired from SMB to another method doesn't work. 1049;; * Try to remove the inclusion of dummy "" directory. Seems to be at 1050;; several places, especially in `tramp-smb-handle-insert-directory'. 1051;; * Provide variables for debug. 1052;; * (RMS) Use unwind-protect to clean up the state so as to make the state 1053;; regular again. 1054 1055;;; arch-tag: fcc9dbec-7503-4d73-b638-3c8aa59575f5 1056;;; tramp-smb.el ends here 1057