1 ;;; tramp-smb.el --- Tramp access functions for SMB servers -*- coding: iso-8859-1; -*-
3 ;; Copyright (C) 2002, 2003 Free Software Foundation, Inc.
5 ;; Author: Michael Albinus <Michael.Albinus@alcatel.de>
6 ;; Keywords: comm, processes
8 ;; This file is part of GNU Emacs.
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)
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.
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., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
27 ;; Access functions for SMB servers like SAMBA or M$ Windows from Tramp.
33 ;; Pacify byte-compiler
37 ;; Emacs 19.34 compatibility hack -- is this needed?
38 (or (>= emacs-major-version
20)
41 ;; Define SMB method ...
42 (defcustom tramp-smb-method
"smb"
43 "*Method to connect SAMBA and M$ SMB servers."
47 ;; ... and add it to the method list.
48 (add-to-list 'tramp-methods
(cons tramp-smb-method nil
))
50 ;; Add a default for `tramp-default-method-alist'. Rule: If there is
51 ;; a domain in USER, it must be the SMB method.
52 (add-to-list 'tramp-default-method-alist
53 (list "%" "" tramp-smb-method
))
55 ;; Add completion function for SMB method.
56 (tramp-set-completion-function
58 '((tramp-parse-netrc "~/.netrc")))
60 (defcustom tramp-smb-program
"smbclient"
61 "*Name of SMB client to run."
65 (defconst tramp-smb-prompt
"^smb: \\S-+> "
66 "Regexp used as prompt in smbclient.")
68 (defconst tramp-smb-errors
72 "Connection to \\S-+ failed"
82 ; Windows NT 4.0, Windows 5.0 (Windows 2000), Windows 5.1 (Windows XP)
83 "NT_STATUS_ACCESS_DENIED"
84 "NT_STATUS_BAD_NETWORK_NAME"
85 "NT_STATUS_CANNOT_DELETE"
86 "NT_STATUS_LOGON_FAILURE"
87 "NT_STATUS_NO_SUCH_FILE"
88 "NT_STATUS_OBJECT_NAME_INVALID"
89 "NT_STATUS_OBJECT_NAME_NOT_FOUND"
90 "NT_STATUS_SHARING_VIOLATION")
92 "Regexp for possible error strings of SMB servers.
93 Used instead of analyzing error codes of commands.")
95 (defvar tramp-smb-share nil
96 "Holds the share name for the current buffer.
97 This variable is local to each buffer.")
98 (make-variable-buffer-local 'tramp-smb-share
)
100 (defvar tramp-smb-share-cache nil
101 "Caches the share names accessible to host related to the current buffer.
102 This variable is local to each buffer.")
103 (make-variable-buffer-local 'tramp-smb-share-cache
)
105 (defvar tramp-smb-process-running nil
106 "Flag whether a corresponding process is still running.
107 Will be changed by corresponding `process-sentinel'.
108 This variable is local to each buffer.")
109 (make-variable-buffer-local 'tramp-smb-process-running
)
111 (defvar tramp-smb-inodes nil
112 "Keeps virtual inodes numbers for SMB files.")
114 ;; New handlers should be added here.
115 (defconst tramp-smb-file-name-handler-alist
117 ;; `access-file' performed by default handler
118 (add-name-to-file . tramp-smb-handle-copy-file
) ;; we're on Windows, honey.
119 ;; `byte-compiler-base-file-name' performed by default handler
120 (copy-file . tramp-smb-handle-copy-file
)
121 (delete-directory . tramp-smb-handle-delete-directory
)
122 (delete-file . tramp-smb-handle-delete-file
)
123 ;; `diff-latest-backup-file' performed by default handler
124 (directory-file-name . tramp-handle-directory-file-name
)
125 (directory-files . tramp-smb-handle-directory-files
)
126 (directory-files-and-attributes . tramp-smb-handle-directory-files-and-attributes
)
127 (dired-call-process . tramp-smb-not-handled
)
128 (dired-compress-file . tramp-smb-not-handled
)
129 ;; `dired-uncache' performed by default handler
130 ;; `expand-file-name' not necessary because we cannot expand "~/"
131 (file-accessible-directory-p . tramp-smb-handle-file-directory-p
)
132 (file-attributes . tramp-smb-handle-file-attributes
)
133 (file-directory-p . tramp-smb-handle-file-directory-p
)
134 (file-executable-p . tramp-smb-handle-file-exists-p
)
135 (file-exists-p . tramp-smb-handle-file-exists-p
)
136 (file-local-copy . tramp-smb-handle-file-local-copy
)
137 (file-modes . tramp-handle-file-modes
)
138 (file-name-all-completions . tramp-smb-handle-file-name-all-completions
)
139 ;; `file-name-as-directory' performed by default handler
140 (file-name-completion . tramp-handle-file-name-completion
)
141 (file-name-directory . tramp-handle-file-name-directory
)
142 (file-name-nondirectory . tramp-handle-file-name-nondirectory
)
143 ;; `file-name-sans-versions' performed by default handler
144 (file-newer-than-file-p . tramp-smb-handle-file-newer-than-file-p
)
145 (file-ownership-preserved-p . tramp-smb-not-handled
)
146 (file-readable-p . tramp-smb-handle-file-exists-p
)
147 (file-regular-p . tramp-handle-file-regular-p
)
148 (file-symlink-p . tramp-smb-not-handled
)
149 ;; `file-truename' performed by default handler
150 (file-writable-p . tramp-smb-handle-file-writable-p
)
151 ;; `find-backup-file-name' performed by default handler
152 ;; `find-file-noselect' performed by default handler
153 ;; `get-file-buffer' performed by default handler
154 (insert-directory . tramp-smb-handle-insert-directory
)
155 (insert-file-contents . tramp-handle-insert-file-contents
)
156 (load . tramp-handle-load
)
157 (make-directory . tramp-smb-handle-make-directory
)
158 (make-directory-internal . tramp-smb-handle-make-directory-internal
)
159 (make-symbolic-link . tramp-smb-not-handled
)
160 (rename-file . tramp-smb-handle-rename-file
)
161 (set-file-modes . tramp-smb-not-handled
)
162 (set-visited-file-modtime . tramp-smb-not-handled
)
163 (shell-command . tramp-smb-not-handled
)
164 ;; `substitute-in-file-name' performed by default handler
165 (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory
)
166 (vc-registered . tramp-smb-not-handled
)
167 (verify-visited-file-modtime . tramp-smb-not-handled
)
168 (write-region . tramp-smb-handle-write-region
)
170 "Alist of handler functions for Tramp SMB method.
171 Operations not mentioned here will be handled by the default Emacs primitives.")
173 (defun tramp-smb-file-name-p (filename)
174 "Check if it's a filename for SMB servers."
175 (let ((v (tramp-dissect-file-name filename
)))
178 (tramp-file-name-multi-method v
)
179 (tramp-file-name-method v
)
180 (tramp-file-name-user v
)
181 (tramp-file-name-host v
))
184 (defun tramp-smb-file-name-handler (operation &rest args
)
185 "Invoke the SMB related OPERATION.
186 First arg specifies the OPERATION, second arg is a list of arguments to
187 pass to the OPERATION."
188 (let ((fn (assoc operation tramp-smb-file-name-handler-alist
)))
190 (if (eq (cdr fn
) 'tramp-smb-not-handled
)
191 (apply (cdr fn
) operation args
)
192 (save-match-data (apply (cdr fn
) args
)))
193 (tramp-run-real-handler operation args
))))
195 (add-to-list 'tramp-foreign-file-name-handler-alist
196 (cons 'tramp-smb-file-name-p
'tramp-smb-file-name-handler
))
199 ;; File name primitives
201 (defun tramp-smb-not-handled (operation &rest args
)
202 "Default handler for all functions which are disrecarded."
203 (tramp-message 10 "Won't be handled: %s %s" operation args
)
206 (defun tramp-smb-handle-copy-file
207 (filename newname
&optional ok-if-already-exists keep-date
)
208 "Like `copy-file' for tramp files.
209 KEEP-DATE is not handled in case NEWNAME resides on an SMB server."
210 (setq filename
(expand-file-name filename
)
211 newname
(expand-file-name newname
))
213 (let ((tmpfile (file-local-copy filename
)))
217 (rename-file tmpfile newname ok-if-already-exists
)
220 (when (file-directory-p newname
)
221 (setq newname
(expand-file-name
222 (file-name-nondirectory filename
) newname
)))
223 (when (and (not ok-if-already-exists
)
224 (file-exists-p newname
))
225 (error "copy-file: file %s already exists" newname
))
227 ; (with-parsed-tramp-file-name newname nil
228 (let (user host path
)
229 (with-parsed-tramp-file-name newname l
230 (setq user l-user host l-host path l-path
))
232 (let ((share (tramp-smb-get-share path
))
233 (file (tramp-smb-get-path path t
)))
235 (error "Target `%s' must contain a share name" filename
))
236 (tramp-smb-maybe-open-connection user host share
)
237 (tramp-message-for-buffer
238 nil tramp-smb-method user host
239 5 "Copying file %s to file %s..." filename newname
)
240 (if (tramp-smb-send-command
241 user host
(format "put %s \"%s\"" filename file
))
242 (tramp-message-for-buffer
243 nil tramp-smb-method user host
244 5 "Copying file %s to file %s...done" filename newname
)
245 (error "Cannot copy `%s'" filename
))))))))
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 (unless (file-exists-p directory
)
251 (error "Cannot delete non-existing directory `%s'" directory
))
252 ; (with-parsed-tramp-file-name directory nil
253 (let (user host path
)
254 (with-parsed-tramp-file-name directory l
255 (setq user l-user host l-host path l-path
))
257 (let ((share (tramp-smb-get-share path
))
258 (dir (tramp-smb-get-path (file-name-directory path
) t
))
259 (file (file-name-nondirectory path
)))
260 (tramp-smb-maybe-open-connection user host share
)
262 (tramp-smb-send-command user host
(format "cd \"%s\"" dir
))
263 (tramp-smb-send-command user host
(format "rmdir \"%s\"" file
)))
265 (tramp-smb-send-command user host
(format "cd \\"))
267 (tramp-smb-send-command user host
(format "cd \\"))
268 (error "Cannot delete directory `%s'" directory
))))))
270 (defun tramp-smb-handle-delete-file (filename)
271 "Like `delete-file' for tramp files."
272 (setq filename
(expand-file-name filename
))
273 (unless (file-exists-p filename
)
274 (error "Cannot delete non-existing file `%s'" filename
))
275 ; (with-parsed-tramp-file-name filename nil
276 (let (user host path
)
277 (with-parsed-tramp-file-name filename l
278 (setq user l-user host l-host path l-path
))
280 (let ((share (tramp-smb-get-share path
))
281 (dir (tramp-smb-get-path (file-name-directory path
) t
))
282 (file (file-name-nondirectory path
)))
283 (unless (file-exists-p filename
)
284 (error "Cannot delete non-existing file `%s'" filename
))
285 (tramp-smb-maybe-open-connection user host share
)
287 (tramp-smb-send-command user host
(format "cd \"%s\"" dir
))
288 (tramp-smb-send-command user host
(format "rm \"%s\"" file
)))
290 (tramp-smb-send-command user host
(format "cd \\"))
292 (tramp-smb-send-command user host
(format "cd \\"))
293 (error "Cannot delete file `%s'" directory
))))))
295 (defun tramp-smb-handle-directory-files
296 (directory &optional full match nosort
)
297 "Like `directory-files' for tramp files."
298 (setq directory
(directory-file-name (expand-file-name directory
)))
299 ; (with-parsed-tramp-file-name directory nil
300 (let (user host path
)
301 (with-parsed-tramp-file-name directory l
302 (setq user l-user host l-host path l-path
))
304 (let* ((share (tramp-smb-get-share path
))
305 (file (tramp-smb-get-path path nil
))
306 (entries (tramp-smb-get-file-entries user host share file
)))
307 ;; Just the file names are needed
308 (setq entries
(mapcar 'car entries
))
309 ;; Discriminate with regexp
313 (mapcar (lambda (x) (when (string-match match x
) x
))
315 ;; Make absolute paths if necessary
319 (concat (file-name-as-directory directory
) x
))
321 ;; Sort them if necessary
322 (unless nosort
(setq entries
(sort entries
'string-lessp
)))
326 (defun tramp-smb-handle-directory-files-and-attributes
327 (directory &optional full match nosort
)
328 "Like `directory-files-and-attributes' for tramp files."
331 (cons x
(file-attributes
332 (if full x
(concat (file-name-as-directory directory
) x
)))))
333 (directory-files directory full match nosort
)))
335 (defun tramp-smb-handle-file-attributes (filename &optional nonnumeric
)
336 "Like `file-attributes' for tramp files.
337 Optional argument NONNUMERIC means return user and group name
338 rather than as numbers."
339 ; (with-parsed-tramp-file-name filename nil
340 (let (user host path
)
341 (with-parsed-tramp-file-name filename l
342 (setq user l-user host l-host path l-path
))
344 (let* ((share (tramp-smb-get-share path
))
345 (file (tramp-smb-get-path path nil
))
346 (entries (tramp-smb-get-file-entries user host share file
))
348 (assoc (file-name-nondirectory file
) entries
)))
349 (inode (tramp-smb-get-inode share file
))
350 (device (tramp-get-device nil tramp-smb-method user host
)))
354 (list (and (string-match "d" (nth 1 entry
))
360 (nth 3 entry
) ;5 mtime
362 (nth 2 entry
) ;7 size
363 (nth 1 entry
) ;8 mode
365 inode
;10 inode number
366 device
)))))) ;11 file system number
368 (defun tramp-smb-handle-file-directory-p (filename)
369 "Like `file-directory-p' for tramp files."
370 ; (with-parsed-tramp-file-name filename nil
371 (let (user host path
)
372 (with-parsed-tramp-file-name filename l
373 (setq user l-user host l-host path l-path
))
375 (let* ((share (tramp-smb-get-share path
))
376 (file (tramp-smb-get-path path nil
))
377 (entries (tramp-smb-get-file-entries user host share file
))
379 (assoc (file-name-nondirectory file
) entries
))))
381 (string-match "d" (nth 1 entry
))
384 (defun tramp-smb-handle-file-exists-p (filename)
385 "Like `file-exists-p' for tramp files."
386 ; (with-parsed-tramp-file-name filename nil
387 (let (user host path
)
388 (with-parsed-tramp-file-name filename l
389 (setq user l-user host l-host path l-path
))
391 (let* ((share (tramp-smb-get-share path
))
392 (file (tramp-smb-get-path path nil
))
393 (entries (tramp-smb-get-file-entries user host share file
)))
395 (member (file-name-nondirectory file
) (mapcar 'car entries
))
398 (defun tramp-smb-handle-file-local-copy (filename)
399 "Like `file-local-copy' for tramp files."
400 (with-parsed-tramp-file-name filename nil
402 (let ((share (tramp-smb-get-share path
))
403 (file (tramp-smb-get-path path t
))
404 (tmpfil (tramp-make-temp-file)))
405 (unless (file-exists-p filename
)
406 (error "Cannot make local copy of non-existing file `%s'" filename
))
407 (tramp-message-for-buffer
408 nil tramp-smb-method user host
409 5 "Fetching %s to tmp file %s..." filename tmpfil
)
410 (tramp-smb-maybe-open-connection user host share
)
411 (if (tramp-smb-send-command
412 user host
(format "get \"%s\" %s" file tmpfil
))
413 (tramp-message-for-buffer
414 nil tramp-smb-method user host
415 5 "Fetching %s to tmp file %s...done" filename tmpfil
)
416 (error "Cannot make local copy of file `%s'" filename
))
419 ;; This function should return "foo/" for directories and "bar" for
421 (defun tramp-smb-handle-file-name-all-completions (filename directory
)
422 "Like `file-name-all-completions' for tramp files."
423 ; (with-parsed-tramp-file-name directory nil
424 (let (user host path
)
425 (with-parsed-tramp-file-name directory l
426 (setq user l-user host l-host path l-path
))
429 (let* ((share (tramp-smb-get-share path
))
430 (file (tramp-smb-get-path path nil
))
431 (entries (tramp-smb-get-file-entries user host share file
)))
438 (if (string-match "d" (nth 1 x
))
439 (file-name-as-directory (nth 0 x
))
443 (defun tramp-smb-handle-file-newer-than-file-p (file1 file2
)
444 "Like `file-newer-than-file-p' for tramp files."
446 ((not (file-exists-p file1
)) nil
)
447 ((not (file-exists-p file2
)) t
)
448 (t (tramp-smb-time-less-p (file-attributes file2
)
449 (file-attributes file1
)))))
451 (defun tramp-smb-handle-file-writable-p (filename)
452 "Like `file-writable-p' for tramp files."
453 ; (with-parsed-tramp-file-name filename nil
454 (let (user host path
)
455 (with-parsed-tramp-file-name filename l
456 (setq user l-user host l-host path l-path
))
458 (let* ((share (tramp-smb-get-share path
))
459 (file (tramp-smb-get-path path nil
))
460 (entries (tramp-smb-get-file-entries user host share file
))
462 (assoc (file-name-nondirectory file
) entries
))))
464 (string-match "w" (nth 1 entry
))
467 (defun tramp-smb-handle-insert-directory
468 (filename switches
&optional wildcard full-directory-p
)
469 "Like `insert-directory' for tramp files.
470 WILDCARD and FULL-DIRECTORY-P are not handled."
471 (setq filename
(expand-file-name filename
))
472 (when (file-directory-p filename
)
473 ;; This check is a little bit strange, but in `dired-add-entry'
474 ;; this function is called with a non-directory ...
475 (setq filename
(file-name-as-directory filename
)))
476 ; (with-parsed-tramp-file-name filename nil
477 (let (user host path
)
478 (with-parsed-tramp-file-name filename l
479 (setq user l-user host l-host path l-path
))
481 (let* ((share (tramp-smb-get-share path
))
482 (file (tramp-smb-get-path path nil
))
483 (entries (tramp-smb-get-file-entries user host share file
)))
485 ;; Delete dummy "" entry, useless entries
487 (if (file-directory-p filename
)
488 (delq (assoc "" entries
) entries
)
489 ;; We just need the only and only entry FILENAME.
490 (list (assoc (file-name-nondirectory filename
) entries
))))
497 (if (string-match "t" switches
)
499 (tramp-smb-time-less-p (nth 3 y
) (nth 3 x
))
501 (string-lessp (nth 0 x
) (nth 0 y
))))))
508 "%10s %3d %-8s %-8s %8s %s %s\n"
513 (if (tramp-smb-time-less-p
514 (tramp-smb-time-subtract (current-time) (nth 3 x
))
515 tramp-smb-half-a-year
)
519 (nth 0 x
))) ; file name
524 (defun tramp-smb-handle-make-directory (dir &optional parents
)
525 "Like `make-directory' for tramp files."
526 (setq dir
(directory-file-name (expand-file-name dir
)))
527 (unless (file-name-absolute-p dir
)
528 (setq dir
(concat default-directory dir
)))
529 ; (with-parsed-tramp-file-name dir nil
530 (let (user host path
)
531 (with-parsed-tramp-file-name dir l
532 (setq user l-user host l-host path l-path
))
534 (let* ((share (tramp-smb-get-share path
))
535 (ldir (file-name-directory dir
)))
536 ;; Make missing directory parts
537 (when (and parents share
(not (file-directory-p ldir
)))
538 (make-directory ldir parents
))
540 (when (file-directory-p ldir
)
541 (make-directory-internal dir
))
542 (unless (file-directory-p dir
)
543 (error "Couldn't make directory %s" dir
))))))
545 (defun tramp-smb-handle-make-directory-internal (directory)
546 "Like `make-directory-internal' for tramp files."
547 (setq directory
(directory-file-name (expand-file-name directory
)))
548 (unless (file-name-absolute-p directory
)
549 (setq ldir
(concat default-directory directory
)))
550 ; (with-parsed-tramp-file-name directory nil
551 (let (user host path
)
552 (with-parsed-tramp-file-name directory l
553 (setq user l-user host l-host path l-path
))
555 (let* ((share (tramp-smb-get-share path
))
556 (file (tramp-smb-get-path path nil
)))
557 (when (file-directory-p (file-name-directory directory
))
558 (tramp-smb-maybe-open-connection user host share
)
559 (tramp-smb-send-command user host
(format "mkdir \"%s\"" file
)))
560 (unless (file-directory-p directory
)
561 (error "Couldn't make directory %s" directory
))))))
563 (defun tramp-smb-handle-rename-file
564 (filename newname
&optional ok-if-already-exists
)
565 "Like `rename-file' for tramp files."
566 (setq filename
(expand-file-name filename
)
567 newname
(expand-file-name newname
))
569 (let ((tmpfile (file-local-copy filename
)))
573 (rename-file tmpfile newname ok-if-already-exists
)
576 (when (file-directory-p newname
)
577 (setq newname
(expand-file-name
578 (file-name-nondirectory filename
) newname
)))
579 (when (and (not ok-if-already-exists
)
580 (file-exists-p newname
))
581 (error "rename-file: file %s already exists" newname
))
583 ; (with-parsed-tramp-file-name newname nil
584 (let (user host path
)
585 (with-parsed-tramp-file-name newname l
586 (setq user l-user host l-host path l-path
))
588 (let ((share (tramp-smb-get-share path
))
589 (file (tramp-smb-get-path path t
)))
590 (tramp-smb-maybe-open-connection user host share
)
591 (tramp-message-for-buffer
592 nil tramp-smb-method user host
593 5 "Copying file %s to file %s..." filename newname
)
594 (if (tramp-smb-send-command
595 user host
(format "put %s \"%s\"" filename file
))
596 (tramp-message-for-buffer
597 nil tramp-smb-method user host
598 5 "Copying file %s to file %s...done" filename newname
)
599 (error "Cannot rename `%s'" filename
)))))))
601 (delete-file filename
))
603 (defun tramp-smb-handle-write-region
604 (start end filename
&optional append visit lockname confirm
)
605 "Like `write-region' for tramp files."
606 (unless (eq append nil
)
607 (error "Cannot append to file using tramp (`%s')" filename
))
608 (setq filename
(expand-file-name filename
))
609 ;; XEmacs takes a coding system as the seventh argument, not `confirm'
610 (when (and (not (featurep 'xemacs
))
611 confirm
(file-exists-p filename
))
612 (unless (y-or-n-p (format "File %s exists; overwrite anyway? "
614 (error "File not overwritten")))
615 ; (with-parsed-tramp-file-name filename nil
616 (let (user host path
)
617 (with-parsed-tramp-file-name filename l
618 (setq user l-user host l-host path l-path
))
620 (let ((share (tramp-smb-get-share path
))
621 (file (tramp-smb-get-path path t
))
622 (curbuf (current-buffer))
623 ;; We use this to save the value of `last-coding-system-used'
624 ;; after writing the tmp file. At the end of the function,
625 ;; we set `last-coding-system-used' to this saved value.
626 ;; This way, any intermediary coding systems used while
627 ;; talking to the remote shell or suchlike won't hose this
628 ;; variable. This approach was snarfed from ange-ftp.el.
631 ;; Write region into a tmp file.
632 (setq tmpfil
(tramp-make-temp-file))
633 ;; We say `no-message' here because we don't want the visited file
634 ;; modtime data to be clobbered from the temp file. We call
635 ;; `set-visited-file-modtime' ourselves later on.
636 (tramp-run-real-handler
638 (if confirm
; don't pass this arg unless defined for backward compat.
639 (list start end tmpfil append
'no-message lockname confirm
)
640 (list start end tmpfil append
'no-message lockname
)))
641 ;; Now, `last-coding-system-used' has the right value. Remember it.
642 (when (boundp 'last-coding-system-used
)
643 (setq coding-system-used last-coding-system-used
))
645 (tramp-smb-maybe-open-connection user host share
)
646 (tramp-message-for-buffer
647 nil tramp-smb-method user host
648 5 "Writing tmp file %s to file %s..." tmpfil filename
)
649 (if (tramp-smb-send-command
650 user host
(format "put %s \"%s\"" tmpfil file
))
651 (tramp-message-for-buffer
652 nil tramp-smb-method user host
653 5 "Writing tmp file %s to file %s...done" tmpfil filename
)
654 (error "Cannot write `%s'" filename
))
657 (unless (equal curbuf
(current-buffer))
658 (error "Buffer has changed from `%s' to `%s'"
659 curbuf
(current-buffer)))
661 (set-visited-file-modtime))
662 ;; Make `last-coding-system-used' have the right value.
663 (when (boundp 'last-coding-system-used
)
664 (setq last-coding-system-used coding-system-used
))))))
667 ;; Internal file name functions
669 (defun tramp-smb-get-share (path)
670 "Returns the share name of PATH."
672 (when (string-match "^/?\\([^/]+\\)/" path
)
673 (match-string 1 path
))))
675 (defun tramp-smb-get-path (path convert
)
676 "Returns the file name of PATH.
677 If CONVERT is non-nil exchange \"/\" by \"\\\\\"."
682 res
(if (string-match "^/?[^/]+/\\(.*\\)" res
)
685 (lambda (x) (if (equal x ?
/) "\\" (char-to-string x
)))
686 (match-string 1 res
) "")
687 (match-string 1 res
))
688 (if (string-match "^/?\\([^/]+\\)$" res
)
692 ;; Sometimes we have discarded `substitute-in-file-name'
693 (when (string-match "\\(\\$\\$\\)\\(/\\|$\\)" res
)
694 (setq res
(replace-match "$" nil nil res
1)))
698 ;; Share names of a host are cached. It is very unlikely that the
699 ;; shares do change during connection.
700 (defun tramp-smb-get-file-entries (user host share path
)
701 "Read entries which match PATH.
702 Either the shares are listed, or the `dir' command is executed.
703 Only entries matching the path are returned.
704 Result is a list of (PATH MODE SIZE MONTH DAY TIME YEAR)."
707 (let ((base (or (and (> (length path
) 0)
708 (string-match "\\([^/]+\\)$" path
)
709 (regexp-quote (match-string 1 path
)))
712 (set-buffer (tramp-get-buffer nil tramp-smb-method user host
))
713 (if (and (not share
) tramp-smb-share-cache
)
714 ;; Return cached shares
715 (setq res tramp-smb-share-cache
)
717 (tramp-smb-maybe-open-connection user host share
)
719 (tramp-smb-send-command
722 (if (zerop (length path
)) "" (concat "\"" path
"*\"")))))
723 (goto-char (point-min))
725 (unless (re-search-forward tramp-smb-errors nil t
)
727 (setq entry
(tramp-smb-read-file-entry share
))
729 (when entry
(add-to-list 'res entry
))))
731 ;; Cache share entries
732 (setq tramp-smb-share-cache res
)))
735 ;; Add directory itself
736 (add-to-list 'res
'("" "dr-xr-xr-x" 0 (0 0)))
738 ;; Check for matching entries
740 (lambda (x) (and (string-match base
(nth 0 x
)) x
))
743 ;; Return either a share name (if SHARE is nil), or a file name
745 ;; If shares are listed, the following format is expected
747 ;; \s-\{8,8} - leading spaces
748 ;; \S-\(.*\S-\)\s-* - share name, 14 char
749 ;; \s- - space delimeter
750 ;; \S-+\s-* - type, 8 char, "Disk " expected
751 ;; \(\s-\{2,2\}.*\)? - space delimeter, comment
753 ;; Entries provided by smbclient DIR aren't fully regular.
754 ;; They should have the format
756 ;; \s-\{2,2} - leading spaces
757 ;; \S-\(.*\S-\)\s-* - file name, 32 chars, left bound
758 ;; \s- - space delimeter
759 ;; \s-*[ADHRS]* - permissions, 5 chars, right bound
760 ;; \s- - space delimeter
761 ;; \s-*[0-9]+ - size, 8 (Samba) or 7 (Windows)
762 ;; chars, right bound
763 ;; \s-\{2,2\} - space delimeter
764 ;; \w\{3,3\} - weekday
765 ;; \s- - space delimeter
767 ;; \s- - space delimeter
768 ;; [0-9]\{2,2\}:[0-9]\{2,2\}:[0-9]\{2,2\} - time
769 ;; \s- - space delimeter
770 ;; [0-9]\{4,4\} - year
773 ;; * Modern regexp constructs, like spy groups and counted repetitions, aren't
774 ;; available in older Emacsen.
775 ;; * The length of constructs (file name, size) might exceed the default.
776 ;; * File names might contain spaces.
777 ;; * Permissions might be empty.
779 ;; So we try to analyze backwards.
780 (defun tramp-smb-read-file-entry (share)
781 "Parse entry in SMB output buffer.
782 If SHARE is result, entries are of type dir. Otherwise, shares are listed.
783 Result is the list (PATH MODE SIZE MTIME)."
784 (let ((line (buffer-substring (point) (tramp-point-at-eol)))
785 path mode size month day hour min sec year mtime
)
790 (when (string-match "^\\s-+\\(\\S-+\\)\\s-+Disk" line
)
791 (setq path
(match-string 1 line
)
799 (if (string-match "\\([0-9]+\\)$" line
)
800 (setq year
(string-to-number (match-string 1 line
))
801 line
(substring line
0 -
5))
805 (if (string-match "\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)$" line
)
806 (setq hour
(string-to-number (match-string 1 line
))
807 min
(string-to-number (match-string 2 line
))
808 sec
(string-to-number (match-string 3 line
))
809 line
(substring line
0 -
9))
813 (if (string-match "\\([0-9]+\\)$" line
)
814 (setq day
(string-to-number (match-string 1 line
))
815 line
(substring line
0 -
3))
819 (if (string-match "\\(\\w+\\)$" line
)
820 (setq month
(match-string 1 line
)
821 line
(substring line
0 -
4))
825 (if (string-match "\\(\\w+\\)$" line
)
826 (setq line
(substring line
0 -
5))
830 (if (string-match "\\([0-9]+\\)$" line
)
832 size
(string-to-number (match-string 1 line
))
834 line
0 (- (max 8 (1+ (length (match-string 1 line
)))))))
838 (if (string-match "\\(\\([ADHRS]+\\)?\\s-?\\)$" line
)
840 mode
(or (match-string 2 line
) "")
841 mode
(save-match-data (format
843 (if (string-match "D" mode
) "d" "-")
846 (concat "r" (if (string-match "R" mode
) "-" "w") "x"))))
847 line
(substring line
0 (- (1+ (length (match-string 2 line
))))))
851 (if (string-match "^\\s-+\\(\\S-\\(.*\\S-\\)?\\)\\s-+$" line
)
852 (setq path
(match-string 1 line
))
855 (when (and path mode size
)
857 (if (and sec min hour day month year
)
860 (cdr (assoc (downcase month
) tramp-smb-parse-time-months
))
863 (list path mode size mtime
))))
865 ;; Inodes don't exist for SMB files. Therefore we must generate virtual ones.
866 ;; Used in `find-buffer-visiting'.
867 ;; The method applied might be not so efficient (Ange-FTP uses hashes). But
868 ;; performance isn't the major issue given that file transfer will take time.
870 (defun tramp-smb-get-inode (share file
)
871 "Returns the virtual inode number.
872 If it doesn't exist, generate a new one."
873 (let ((string (concat share
"/" (directory-file-name file
))))
874 (unless (assoc string tramp-smb-inodes
)
875 (add-to-list 'tramp-smb-inodes
876 (list string
(length tramp-smb-inodes
))))
877 (nth 1 (assoc string tramp-smb-inodes
))))
880 ;; Connection functions
882 (defun tramp-smb-send-command (user host command
)
883 "Send the COMMAND to USER at HOST (logged into an SMB session).
884 Erases temporary buffer before sending the command. Returns nil if
885 there has been an error message from smbclient."
887 (set-buffer (tramp-get-buffer nil tramp-smb-method user host
))
889 (tramp-send-command nil tramp-smb-method user host command nil t
)
890 (tramp-smb-wait-for-output user host
)))
892 (defun tramp-smb-maybe-open-connection (user host share
)
893 "Maybe open a connection to HOST, logging in as USER, using `tramp-smb-program'.
894 Does not do anything if a connection is already open, but re-opens the
895 connection if a previous connection has died for some reason."
896 (let ((p (get-buffer-process
897 (tramp-get-buffer nil tramp-smb-method user host
))))
899 (set-buffer (tramp-get-buffer nil tramp-smb-method user host
))
900 ;; Check whether it is still the same share
901 (unless (and p
(processp p
) (string-equal tramp-smb-share share
))
902 (when (and p
(processp p
))
905 ;; If too much time has passed since last command was sent, look
906 ;; whether process is still alive. If it isn't, kill it.
907 (when (and tramp-last-cmd-time
908 (> (tramp-time-diff (current-time) tramp-last-cmd-time
) 60)
909 p
(processp p
) (memq (process-status p
) '(run open
)))
910 (unless (and p
(processp p
) (memq (process-status p
) '(run open
)))
913 (unless (and p
(processp p
) (memq (process-status p
) '(run open
)))
914 (when (and p
(processp p
))
916 (tramp-smb-open-connection user host share
))))
918 (defun tramp-smb-open-connection (user host share
)
919 "Open a connection using `tramp-smb-program'.
920 This starts the command `smbclient //HOST/SHARE -U USER', then waits
921 for a remote password prompt. It queries the user for the password,
922 then sends the password to the remote host.
924 Domain names in USER and port numbers in HOST are acknowledged."
927 (let* ((buffer (tramp-get-buffer nil tramp-smb-method user host
))
932 ; Check for domain ("user%domain") and port ("host#port")
933 (when (and user
(string-match "\\(.+\\)%\\(.+\\)" user
))
934 (setq real-user
(or (match-string 1 user
) user
)
935 domain
(match-string 2 user
)))
937 (when (and host
(string-match "\\(.+\\)#\\(.+\\)" host
))
938 (setq real-host
(or (match-string 1 host
) host
)
939 port
(match-string 2 host
)))
942 (setq args
(list (concat "//" real-host
"/" share
)))
943 (setq args
(list "-L" real-host
)))
946 (setq args
(append args
(list "-U" real-user
)))
947 (setq args
(append args
(list "-N"))))
949 (when domain
(setq args
(append args
(list "-W" domain
))))
950 (when port
(setq args
(append args
(list "-p" port
))))
953 (tramp-pre-connection nil tramp-smb-method user host
)
954 (tramp-message 7 "Opening connection for //%s@%s/%s..."
955 user host
(or share
""))
957 (let* ((default-directory (tramp-temporary-file-directory))
958 ;; If we omit the conditional here, then we would use
959 ;; `undecided-dos' in some cases. With the conditional,
960 ;; we use nil in these cases. Which one is right?
961 (coding-system-for-read (unless (and (not (featurep 'xemacs
))
962 (> emacs-major-version
20))
963 tramp-dos-coding-system
))
964 (p (apply #'start-process
(buffer-name buffer
) buffer
965 tramp-smb-program args
)))
967 (tramp-message 9 "Started process %s" (process-command p
))
968 (process-kill-without-query p
)
970 (set-process-sentinel
971 p
(lambda (proc str
) (setq tramp-smb-process-running nil
)))
972 ; If no share is given, the process will terminate
973 (setq tramp-smb-process-running share
974 tramp-smb-share share
)
978 (let ((pw-prompt "Password:"))
979 (tramp-message 9 "Sending password")
980 (tramp-enter-password p pw-prompt
)))
982 (unless (tramp-smb-wait-for-output user host
)
983 (error "Cannot open connection //%s@%s/%s"
984 user host
(or share
"")))))))
986 ;; We don't use timeouts. If needed, the caller shall wrap around.
987 (defun tramp-smb-wait-for-output (user host
)
988 "Wait for output from smbclient command.
989 Sets position to begin of buffer.
990 Returns nil if an error message has appeared."
992 (let ((proc (get-buffer-process (current-buffer)))
993 (found (progn (goto-char (point-max))
995 (looking-at tramp-smb-prompt
)))
998 ;; Algorithm: get waiting output. See if last line contains
999 ;; tramp-smb-prompt sentinel, or process has exited.
1000 ;; If not, wait a bit and again get waiting output.
1001 (while (and (not found
) tramp-smb-process-running
)
1002 (accept-process-output proc
)
1003 (goto-char (point-max))
1005 (setq found
(looking-at tramp-smb-prompt
)))
1007 ;; There might be pending output. If tramp-smb-prompt sentinel
1008 ;; hasn't been found, the process has died already. We should
1009 ;; give it a chance.
1010 (when (not found
) (accept-process-output nil
1))
1012 ;; Search for errors.
1013 (goto-char (point-min))
1014 (setq err
(re-search-forward tramp-smb-errors nil t
)))
1016 ;; Add output to debug buffer if appropriate.
1017 (when tramp-debug-buffer
1019 (tramp-get-debug-buffer nil tramp-smb-method user host
)
1020 (point-min) (point-max))
1021 (when (and (not found
) tramp-smb-process-running
)
1024 (tramp-get-debug-buffer nil tramp-smb-method user host
))
1025 (goto-char (point-max))
1026 (insert (format "[[Remote prompt `%s' not found]]\n"
1027 tramp-smb-prompt
)))))
1028 (goto-char (point-min))
1029 ;; Return value is whether no error message has appeared.
1033 ;; Snarfed code from time-date.el and parse-time.el
1035 (defconst tramp-smb-half-a-year
'(241 17024)
1036 "Evaluated by \"(days-to-time 183)\".")
1038 (defconst tramp-smb-parse-time-months
'(("jan" .
1) ("feb" .
2) ("mar" .
3)
1039 ("apr" .
4) ("may" .
5) ("jun" .
6)
1040 ("jul" .
7) ("aug" .
8) ("sep" .
9)
1041 ("oct" .
10) ("nov" .
11) ("dec" .
12))
1042 "Alist mapping month names to integers.")
1044 (defun tramp-smb-time-less-p (t1 t2
)
1045 "Say whether time value T1 is less than time value T2."
1046 (unless t1
(setq t1
'(0 0)))
1047 (unless t2
(setq t2
'(0 0)))
1048 (or (< (car t1
) (car t2
))
1049 (and (= (car t1
) (car t2
))
1050 (< (nth 1 t1
) (nth 1 t2
)))))
1052 (defun tramp-smb-time-subtract (t1 t2
)
1053 "Subtract two time values.
1054 Return the difference in the format of a time value."
1055 (unless t1
(setq t1
'(0 0)))
1056 (unless t2
(setq t2
'(0 0)))
1057 (let ((borrow (< (cadr t1
) (cadr t2
))))
1058 (list (- (car t1
) (car t2
) (if borrow
1 0))
1059 (- (+ (if borrow
65536 0) (cadr t1
)) (cadr t2
)))))
1062 ;; `PC-do-completion' touches the returning "$$" by `substitute-in-file-name'.
1063 ;; Must be corrected.
1065 (defadvice PC-do-completion
(around tramp-smb-advice-PC-do-completion activate
)
1066 "Changes \"$\" back to \"$$\" in minibuffer."
1067 (if (funcall PC-completion-as-file-name-predicate
)
1070 ;; Substitute file names
1071 (let* ((beg (or (and (functionp 'minibuffer-prompt-end
) ; Emacs 21
1072 (funcall 'minibuffer-prompt-end
))
1075 (str (substitute-in-file-name (buffer-substring beg end
))))
1076 (delete-region beg end
)
1078 (ad-set-arg 2 (point)))
1080 ;; Do `PC-do-completion' without substitution
1082 (fset 'save
(symbol-function 'substitute-in-file-name
))
1083 (fset 'substitute-in-file-name
(symbol-function 'identity
))
1085 (fset 'substitute-in-file-name
(symbol-function 'save
)))
1088 (let* ((beg (or (and (functionp 'minibuffer-prompt-end
) ; Emacs 21
1089 (funcall 'minibuffer-prompt-end
))
1092 (str (buffer-substring beg end
)))
1093 (delete-region beg end
)
1094 (insert (if (string-match "\\(\\$\\)\\(/\\|$\\)" str
)
1095 (replace-match "$$" nil nil str
1)
1098 ;; No file names. Behave unchanged.
1101 (provide 'tramp-smb
)
1105 ;; * Provide a local smb.conf. The default one might not be readable.
1106 ;; * Error handling in case password is wrong.
1107 ;; * Read password from "~/.netrc".
1108 ;; * Use different buffers for different shares. By this, the password
1109 ;; won't be requested again when changing shares on the same host.
1110 ;; * Return more comprehensive file permission string. Think whether it is
1111 ;; possible to implement `set-file-modes'.
1112 ;; * Handle WILDCARD and FULL-DIRECTORY-P in
1113 ;; `tramp-smb-handle-insert-directory'.
1114 ;; * Handle links (FILENAME.LNK).
1115 ;; * Maybe local tmp files should have the same extension like the original
1116 ;; files. Strange behaviour with jka-compr otherwise?
1117 ;; * Copy files in dired from SMB to another method doesn't work.
1118 ;; * Try to remove the inclusion of dummy "" directory. Seems to be at
1119 ;; several places, especially in `tramp-smb-handle-insert-directory'.
1120 ;; * Provide variables for debug.
1121 ;; * (RMS) Use unwind-protect to clean up the state so as to make the state
1124 ;;; tramp-smb.el ends here