1 ;;; tramp-smb.el --- Tramp access functions for SMB servers
3 ;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007,
4 ;; 2008 Free Software Foundation, Inc.
6 ;; Author: Michael Albinus <michael.albinus@gmx.de>
7 ;; Keywords: comm, processes
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software: you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
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.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
26 ;; Access functions for SMB servers like SAMBA or M$ Windows from Tramp.
30 (eval-when-compile (require 'cl
)) ; block, return
32 (require 'tramp-cache
)
33 (require 'tramp-compat
)
35 ;; Define SMB method ...
36 (defcustom tramp-smb-method
"smb"
37 "*Method to connect SAMBA and M$ SMB servers."
41 ;; ... and add it to the method list.
42 (add-to-list 'tramp-methods
(cons tramp-smb-method nil
))
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
))
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
""))
54 ;; Add completion function for SMB method.
55 (tramp-set-completion-function
57 '((tramp-parse-netrc "~/.netrc")))
59 (defcustom tramp-smb-program
"smbclient"
60 "*Name of SMB client to run."
64 (defconst tramp-smb-prompt
"^smb: .+> \\|^\\s-+Server\\s-+Comment$"
65 "Regexp used as prompt in smbclient.")
67 (defconst tramp-smb-errors
68 ;; `regexp-opt' not possible because of first string.
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"
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")
103 "Regexp for possible error strings of SMB servers.
104 Used instead of analyzing error codes of commands.")
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.
115 See `tramp-actions-before-shell' for more info.")
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.
125 See `tramp-actions-before-shell' for more info.")
127 ;; New handlers should be added here.
128 (defconst tramp-smb-file-name-handler-alist
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
)
184 "Alist of handler functions for Tramp SMB method.
185 Operations not mentioned here will be handled by the default Emacs primitives.")
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
)))
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
)))
198 (save-match-data (apply (cdr fn
) args
))
199 (tramp-run-real-handler operation args
))))
201 (add-to-list 'tramp-foreign-file-name-handler-alist
202 (cons 'tramp-smb-file-name-p
'tramp-smb-file-name-handler
))
205 ;; File name primitives
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
))
215 (let ((tmpfile (file-local-copy filename
)))
219 (rename-file tmpfile newname ok-if-already-exists
)
222 (when (file-directory-p newname
)
223 (setq newname
(expand-file-name
224 (file-name-nondirectory filename
) newname
)))
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
))
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
)))
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
))
244 v
0 "Copying file %s to file %s...done" filename newname
)
245 (tramp-error v
'file-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 (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
)))
260 (tramp-smb-send-command v
(format "cd \"%s\"" dir
))
261 (tramp-smb-send-command v
(format "rmdir \"%s\"" file
)))
263 (with-current-buffer (tramp-get-connection-buffer v
)
264 (goto-char (point-min))
265 (search-forward-regexp tramp-smb-errors nil t
)
267 v
'file-error
"%s `%s'" (match-string 0) directory
)))
269 (tramp-smb-send-command v
(format "cd \\")))))))
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
)))
284 (tramp-smb-send-command v
(format "cd \"%s\"" dir
))
285 (tramp-smb-send-command v
(format "rm \"%s\"" file
)))
287 (with-current-buffer (tramp-get-connection-buffer v
)
288 (goto-char (point-min))
289 (search-forward-regexp tramp-smb-errors nil t
)
291 v
'file-error
"%s `%s'" (match-string 0) filename
)))
293 (tramp-smb-send-command v
(format "cd \\")))))))
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
304 (mapcar (lambda (x) (when (string-match match x
) x
))
310 (lambda (x) (expand-file-name x directory
))
312 ;; Sort them if necessary
313 (unless nosort
(setq result
(sort result
'string-lessp
)))
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."
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
)))
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
)))
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
)))
348 (list (and (string-match "d" (nth 1 entry
))
354 (nth 3 entry
) ;5 mtime
356 (nth 2 entry
) ;7 size
357 (nth 1 entry
) ;8 mode
359 inode
;10 inode number
360 device
)))))) ;11 file system number
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))))
367 (defun tramp-smb-handle-file-exists-p (filename)
368 "Like `file-exists-p' for Tramp files."
369 (not (null (file-attributes filename
))))
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
)
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
))
383 v
4 "Fetching %s to tmp file %s...done" filename tmpfile
)
386 "Cannot make local copy of file `%s'" filename
))
389 ;; This function should return "foo/" for directories and "bar" for
391 (defun tramp-smb-handle-file-name-all-completions (filename directory
)
392 "Like `file-name-all-completions' for Tramp files."
395 (with-parsed-tramp-file-name directory nil
396 (with-file-property v localname
"file-name-all-completions"
398 (let ((entries (tramp-smb-get-file-entries directory
)))
402 (if (string-match "d" (nth 1 x
))
403 (file-name-as-directory (nth 0 x
))
407 (defun tramp-smb-handle-file-newer-than-file-p (file1 file2
)
408 "Like `file-newer-than-file-p' for Tramp files."
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
))))))
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
)))))
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
))
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
)))))
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
)))
451 (if (or wildcard
(zerop (length base
)))
452 ;; Check for matching entries.
456 (format "^%s" base
) (nth 0 x
))
459 ;; We just need the only and only entry FILENAME.
460 (list (assoc base entries
)))))
467 (if (string-match "t" switches
)
469 (tramp-time-less-p (nth 3 y
) (nth 3 x
))
471 (string-lessp (nth 0 x
) (nth 0 y
))))))
473 ;; Handle "-F" switch.
474 (when (string-match "F" switches
)
477 (when (not (zerop (length (car x
))))
479 ((char-equal ?d
(string-to-char (nth 1 x
)))
480 (setcar x
(concat (car x
) "/")))
481 ((char-equal ?x
(string-to-char (nth 1 x
)))
482 (setcar x
(concat (car x
) "*"))))))
488 (when (not (zerop (length (nth 0 x
))))
491 "%10s %3d %-8s %-8s %8s %s %s\n"
496 (if (tramp-time-less-p
497 (tramp-time-subtract (current-time) (nth 3 x
))
502 (nth 0 x
))) ; file name
504 (beginning-of-line)))
507 (defun tramp-smb-handle-make-directory (dir &optional parents
)
508 "Like `make-directory' for Tramp files."
509 (setq dir
(directory-file-name (expand-file-name dir
)))
510 (unless (file-name-absolute-p dir
)
511 (setq dir
(expand-file-name dir default-directory
)))
512 (with-parsed-tramp-file-name dir nil
514 (let* ((share (tramp-smb-get-share localname
))
515 (ldir (file-name-directory dir
)))
516 ;; Make missing directory parts
517 (when (and parents share
(not (file-directory-p ldir
)))
518 (make-directory ldir parents
))
520 (when (file-directory-p ldir
)
521 (make-directory-internal dir
))
522 (unless (file-directory-p dir
)
523 (tramp-error v
'file-error
"Couldn't make directory %s" dir
))))))
525 (defun tramp-smb-handle-make-directory-internal (directory)
526 "Like `make-directory-internal' for Tramp files."
527 (setq directory
(directory-file-name (expand-file-name directory
)))
528 (unless (file-name-absolute-p directory
)
529 (setq directory
(expand-file-name directory default-directory
)))
530 (with-parsed-tramp-file-name directory nil
532 (let* ((file (tramp-smb-get-localname localname t
)))
533 (when (file-directory-p (file-name-directory directory
))
534 (tramp-smb-send-command v
(format "mkdir \"%s\"" file
))
535 ;; We must also flush the cache of the directory, because
536 ;; file-attributes reads the values from there.
537 (tramp-flush-file-property v
(file-name-directory localname
)))
538 (unless (file-directory-p directory
)
540 v
'file-error
"Couldn't make directory %s" directory
))))))
542 (defun tramp-smb-handle-rename-file
543 (filename newname
&optional ok-if-already-exists
)
544 "Like `rename-file' for Tramp files."
545 (setq filename
(expand-file-name filename
)
546 newname
(expand-file-name newname
))
548 (let ((tmpfile (file-local-copy filename
)))
552 (rename-file tmpfile newname ok-if-already-exists
)
555 (when (file-directory-p newname
)
556 (setq newname
(expand-file-name
557 (file-name-nondirectory filename
) newname
)))
559 (with-parsed-tramp-file-name newname nil
560 (when (and (not ok-if-already-exists
)
561 (file-exists-p newname
))
562 (tramp-error v
'file-already-exists newname
))
563 ;; We must also flush the cache of the directory, because
564 ;; file-attributes reads the values from there.
565 (tramp-flush-file-property v
(file-name-directory localname
))
566 (tramp-flush-file-property v localname
)
567 (let ((file (tramp-smb-get-localname localname t
)))
568 (tramp-message v
0 "Copying file %s to file %s..." filename newname
)
569 (if (tramp-smb-send-command v
(format "put %s \"%s\"" filename file
))
571 v
0 "Copying file %s to file %s...done" filename newname
)
572 (tramp-error v
'file-error
"Cannot rename `%s'" filename
))))))
574 (delete-file filename
))
576 (defun tramp-smb-handle-substitute-in-file-name (filename)
577 "Like `handle-substitute-in-file-name' for Tramp files.
578 \"//\" substitutes only in the local filename part. Catches
579 errors for shares like \"C$/\", which are common in Microsoft Windows."
580 (with-parsed-tramp-file-name filename nil
581 ;; Ignore in LOCALNAME everything before "//".
582 (when (and (stringp localname
) (string-match ".+?/\\(/\\|~\\)" localname
))
584 (concat (file-remote-p filename
)
585 (replace-match "\\1" nil nil localname
)))))
587 (tramp-run-real-handler 'substitute-in-file-name
(list filename
))
590 (defun tramp-smb-handle-write-region
591 (start end filename
&optional append visit lockname confirm
)
592 "Like `write-region' for Tramp files."
593 (setq filename
(expand-file-name filename
))
594 (with-parsed-tramp-file-name filename nil
595 (unless (eq append nil
)
597 v
'file-error
"Cannot append to file using Tramp (`%s')" filename
))
598 ;; XEmacs takes a coding system as the seventh argument, not `confirm'.
599 (when (and (not (featurep 'xemacs
))
600 confirm
(file-exists-p filename
))
601 (unless (y-or-n-p (format "File %s exists; overwrite anyway? "
603 (tramp-error v
'file-error
"File not overwritten")))
604 ;; We must also flush the cache of the directory, because
605 ;; `file-attributes' reads the values from there.
606 (tramp-flush-file-property v
(file-name-directory localname
))
607 (tramp-flush-file-property v localname
)
608 (let ((file (tramp-smb-get-localname localname t
))
609 (curbuf (current-buffer))
610 (tmpfile (tramp-compat-make-temp-file filename
)))
611 ;; We say `no-message' here because we don't want the visited file
612 ;; modtime data to be clobbered from the temp file. We call
613 ;; `set-visited-file-modtime' ourselves later on.
614 (tramp-run-real-handler
616 (if confirm
; don't pass this arg unless defined for backward compat.
617 (list start end tmpfile append
'no-message lockname confirm
)
618 (list start end tmpfile append
'no-message lockname
)))
620 (tramp-message v
5 "Writing tmp file %s to file %s..." tmpfile filename
)
621 (if (tramp-smb-send-command v
(format "put %s \"%s\"" tmpfile file
))
623 v
5 "Writing tmp file %s to file %s...done" tmpfile filename
)
624 (tramp-error v
'file-error
"Cannot write `%s'" filename
))
626 (delete-file tmpfile
)
627 (unless (equal curbuf
(current-buffer))
630 "Buffer has changed from `%s' to `%s'" curbuf
(current-buffer)))
632 (set-visited-file-modtime)))))
635 ;; Internal file name functions
637 (defun tramp-smb-get-share (localname)
638 "Returns the share name of LOCALNAME."
640 (when (string-match "^/?\\([^/]+\\)/" localname
)
641 (match-string 1 localname
))))
643 (defun tramp-smb-get-localname (localname convert
)
644 "Returns the file name of LOCALNAME.
645 If CONVERT is non-nil exchange \"/\" by \"\\\\\"."
647 (let ((res localname
))
650 res
(if (string-match "^/?[^/]+/\\(.*\\)" res
)
653 (lambda (x) (if (equal x ?
/) "\\" (char-to-string x
)))
654 (match-string 1 res
) "")
655 (match-string 1 res
))
656 (if (string-match "^/?\\([^/]+\\)$" res
)
660 ;; Sometimes we have discarded `substitute-in-file-name'
661 (when (string-match "\\(\\$\\$\\)\\(/\\|$\\)" res
)
662 (setq res
(replace-match "$" nil nil res
1)))
666 ;; Share names of a host are cached. It is very unlikely that the
667 ;; shares do change during connection.
668 (defun tramp-smb-get-file-entries (directory)
669 "Read entries which match DIRECTORY.
670 Either the shares are listed, or the `dir' command is executed.
671 Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)."
672 (with-parsed-tramp-file-name directory nil
673 (setq localname
(or localname
"/"))
674 (with-file-property v localname
"file-entries"
675 (with-current-buffer (tramp-get-buffer v
)
676 (let* ((share (tramp-smb-get-share localname
))
677 (file (tramp-smb-get-localname localname nil
))
678 (cache (tramp-get-connection-property v
"share-cache" nil
))
681 (if (and (not share
) cache
)
682 ;; Return cached shares
686 (setq file
(file-name-as-directory file
))
687 (when (string-match "^\\./" file
)
688 (setq file
(substring file
1)))
690 (tramp-smb-send-command v
(format "dir \"%s*\"" file
))
691 ;; `tramp-smb-maybe-open-connection' lists also the share names
692 (tramp-smb-maybe-open-connection v
))
695 (goto-char (point-min))
696 (unless (re-search-forward tramp-smb-errors nil t
)
698 (setq entry
(tramp-smb-read-file-entry share
))
700 (when entry
(add-to-list 'res entry
))))
702 ;; Cache share entries
704 (tramp-set-connection-property v
"share-cache" res
)))
706 ;; Add directory itself
707 (add-to-list 'res
'("" "drwxrwxrwx" 0 (0 0)))
709 ;; There's a very strange error (debugged with XEmacs 21.4.14)
710 ;; If there's no short delay, it returns nil. No idea about.
711 (when (featurep 'xemacs
) (sleep-for 0.01))
716 ;; Return either a share name (if SHARE is nil), or a file name
718 ;; If shares are listed, the following format is expected
720 ;; \s-\{8,8} - leading spaces
721 ;; \S-\(.*\S-\)\s-* - share name, 14 char
722 ;; \s- - space delimeter
723 ;; \S-+\s-* - type, 8 char, "Disk " expected
724 ;; \(\s-\{2,2\}.*\)? - space delimeter, comment
726 ;; Entries provided by smbclient DIR aren't fully regular.
727 ;; They should have the format
729 ;; \s-\{2,2} - leading spaces
730 ;; \S-\(.*\S-\)\s-* - file name, 30 chars, left bound
731 ;; \s-+[ADHRSV]* - permissions, 7 chars, right bound
732 ;; \s- - space delimeter
733 ;; \s-+[0-9]+ - size, 8 chars, right bound
734 ;; \s-\{2,2\} - space delimeter
735 ;; \w\{3,3\} - weekday
736 ;; \s- - space delimeter
738 ;; \s- - space delimeter
740 ;; \s- - space delimeter
741 ;; [0-9]\{2,2\}:[0-9]\{2,2\}:[0-9]\{2,2\} - time
742 ;; \s- - space delimeter
743 ;; [0-9]\{4,4\} - year
745 ;; samba/src/client.c (http://samba.org/doxygen/samba/client_8c-source.html)
746 ;; has function display_finfo:
748 ;; d_printf(" %-30s%7.7s %8.0f %s",
750 ;; attrib_string(finfo->mode),
751 ;; (double)finfo->size,
752 ;; asctime(LocalTime(&t)));
754 ;; in Samba 1.9, there's the following code:
756 ;; DEBUG(0,(" %-30s%7.7s%10d %s",
757 ;; CNV_LANG(finfo->name),
758 ;; attrib_string(finfo->mode),
760 ;; asctime(LocalTime(&t))));
763 ;; * Modern regexp constructs, like spy groups and counted repetitions, aren't
764 ;; available in older Emacsen.
765 ;; * The length of constructs (file name, size) might exceed the default.
766 ;; * File names might contain spaces.
767 ;; * Permissions might be empty.
769 ;; So we try to analyze backwards.
770 (defun tramp-smb-read-file-entry (share)
771 "Parse entry in SMB output buffer.
772 If SHARE is result, entries are of type dir. Otherwise, shares are listed.
773 Result is the list (LOCALNAME MODE SIZE MTIME)."
774 ;; We are called from `tramp-smb-get-file-entries', which sets the
776 (let ((line (buffer-substring (point) (tramp-compat-line-end-position)))
777 localname mode size month day hour min sec year mtime
)
781 ;; Read share entries.
782 (when (string-match "^\\s-+\\(\\S-\\(.*\\S-\\)?\\)\\s-+Disk" line
)
783 (setq localname
(match-string 1 line
)
791 (if (string-match "\\([0-9]+\\)$" line
)
792 (setq year
(string-to-number (match-string 1 line
))
793 line
(substring line
0 -
5))
797 (if (string-match "\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)$" line
)
798 (setq hour
(string-to-number (match-string 1 line
))
799 min
(string-to-number (match-string 2 line
))
800 sec
(string-to-number (match-string 3 line
))
801 line
(substring line
0 -
9))
805 (if (string-match "\\([0-9]+\\)$" line
)
806 (setq day
(string-to-number (match-string 1 line
))
807 line
(substring line
0 -
3))
811 (if (string-match "\\(\\w+\\)$" line
)
812 (setq month
(match-string 1 line
)
813 line
(substring line
0 -
4))
817 (if (string-match "\\(\\w+\\)$" line
)
818 (setq line
(substring line
0 -
5))
822 (if (string-match "\\([0-9]+\\)$" line
)
823 (let ((length (- (max 10 (1+ (length (match-string 1 line
)))))))
824 (setq size
(string-to-number (match-string 1 line
)))
825 (when (string-match "\\([ADHRSV]+\\)" (substring line length
))
826 (setq length
(+ length
(match-end 0))))
827 (setq line
(substring line
0 length
)))
830 ;; mode: ARCH, DIR, HIDDEN, RONLY, SYSTEM, VOLID
831 (if (string-match "\\([ADHRSV]+\\)?$" line
)
833 mode
(or (match-string 1 line
) "")
834 mode
(save-match-data (format
836 (if (string-match "D" mode
) "d" "-")
839 (concat "r" (if (string-match "R" mode
) "-" "w") "x"))))
840 line
(substring line
0 -
7))
844 (if (string-match "^\\s-+\\(\\S-\\(.*\\S-\\)?\\)\\s-*$" line
)
845 (setq localname
(match-string 1 line
))
848 (when (and localname mode size
)
850 (if (and sec min hour day month year
)
853 (cdr (assoc (downcase month
) tramp-parse-time-months
))
856 (list localname mode size mtime
))))
859 ;; Connection functions
861 (defun tramp-smb-send-command (vec command
)
862 "Send the COMMAND to connection VEC.
863 Returns nil if there has been an error message from smbclient."
864 (tramp-smb-maybe-open-connection vec
)
865 (tramp-message vec
6 "%s" command
)
866 (tramp-send-string vec command
)
867 (tramp-smb-wait-for-output vec
))
869 (defun tramp-smb-maybe-open-connection (vec)
870 "Maybe open a connection to HOST, log in as USER, using `tramp-smb-program'.
871 Does not do anything if a connection is already open, but re-opens the
872 connection if a previous connection has died for some reason."
873 (let* ((share (tramp-smb-get-share (tramp-file-name-localname vec
)))
874 (buf (tramp-get-buffer vec
))
875 (p (get-buffer-process buf
)))
877 ;; If too much time has passed since last command was sent, look
878 ;; whether has been an error message; maybe due to connection timeout.
879 (with-current-buffer buf
880 (goto-char (point-min))
881 (when (and (> (tramp-time-diff
883 (tramp-get-connection-property
884 p
"last-cmd-time" '(0 0 0)))
886 p
(processp p
) (memq (process-status p
) '(run open
))
887 (re-search-forward tramp-smb-errors nil t
))
891 ;; Check whether it is still the same share.
893 (and p
(processp p
) (memq (process-status p
) '(run open
))
896 (tramp-get-connection-property p
"smb-share" "")))
899 ;; There might be unread output from checking for share names.
900 (when buf
(with-current-buffer buf
(erase-buffer)))
901 (when (and p
(processp p
)) (delete-process p
))
903 (unless (let ((default-directory
904 (tramp-compat-temporary-file-directory)))
905 (executable-find tramp-smb-program
))
906 (error "Cannot find command %s in %s" tramp-smb-program exec-path
))
908 (let* ((user (tramp-file-name-user vec
))
909 (host (tramp-file-name-host vec
))
914 ;; Check for domain ("user%domain") and port ("host#port").
915 (when (and user
(string-match "\\(.+\\)%\\(.+\\)" user
))
916 (setq real-user
(or (match-string 1 user
) user
)
917 domain
(match-string 2 user
)))
919 (when (and host
(string-match "\\(.+\\)#\\(.+\\)" host
))
920 (setq real-host
(or (match-string 1 host
) host
)
921 port
(match-string 2 host
)))
924 (setq args
(list (concat "//" real-host
"/" share
)))
925 (setq args
(list "-L" real-host
)))
927 (if (not (zerop (length real-user
)))
928 (setq args
(append args
(list "-U" real-user
)))
929 (setq args
(append args
(list "-N"))))
931 (when domain
(setq args
(append args
(list "-W" domain
))))
932 (when port
(setq args
(append args
(list "-p" port
))))
933 (setq args
(append args
(list "-s" "/dev/null")))
937 vec
3 "Opening connection for //%s%s/%s..."
938 (if (not (zerop (length user
))) (concat user
"@") "")
941 (let* ((coding-system-for-read nil
)
942 (process-connection-type tramp-process-connection-type
)
943 (p (let ((default-directory
944 (tramp-compat-temporary-file-directory)))
945 (apply #'start-process
946 (tramp-buffer-name vec
) (tramp-get-buffer vec
)
947 tramp-smb-program args
))))
950 vec
6 "%s" (mapconcat 'identity
(process-command p
) " "))
951 (set-process-sentinel p
'tramp-process-sentinel
)
952 (tramp-set-process-query-on-exit-flag p nil
)
953 (tramp-set-connection-property p
"smb-share" share
)
955 ;; Set variables for computing the prompt for reading password.
956 (setq tramp-current-method tramp-smb-method
957 tramp-current-user user
958 tramp-current-host host
)
960 ;; Set chunksize. Otherwise, `tramp-send-string' might
962 (tramp-set-connection-property p
"chunksize" tramp-chunksize
)
964 ;; Play login scenario.
965 (tramp-process-actions
968 tramp-smb-actions-with-share
969 tramp-smb-actions-without-share
))
972 vec
3 "Opening connection for //%s%s/%s...done"
973 (if (not (zerop (length user
))) (concat user
"@") "")
974 host
(or share
""))))))))
976 ;; We don't use timeouts. If needed, the caller shall wrap around.
977 (defun tramp-smb-wait-for-output (vec)
978 "Wait for output from smbclient command.
979 Returns nil if an error message has appeared."
980 (with-current-buffer (tramp-get-buffer vec
)
981 (let ((p (get-buffer-process (current-buffer)))
982 (found (progn (goto-char (point-min))
983 (re-search-forward tramp-smb-prompt nil t
)))
984 (err (progn (goto-char (point-min))
985 (re-search-forward tramp-smb-errors nil t
))))
987 ;; Algorithm: get waiting output. See if last line contains
988 ;; tramp-smb-prompt sentinel or tramp-smb-errors strings.
989 ;; If not, wait a bit and again get waiting output.
990 (while (and (not found
) (not err
))
992 ;; Accept pending output.
993 (tramp-accept-process-output p
)
995 ;; Search for prompt.
996 (goto-char (point-min))
997 (setq found
(re-search-forward tramp-smb-prompt nil t
))
999 ;; Search for errors.
1000 (goto-char (point-min))
1001 (setq err
(re-search-forward tramp-smb-errors nil t
)))
1003 ;; When the process is still alive, read pending output.
1004 (while (and (not found
) (memq (process-status p
) '(run open
)))
1006 ;; Accept pending output.
1007 (tramp-accept-process-output p
)
1009 ;; Search for prompt.
1010 (goto-char (point-min))
1011 (setq found
(re-search-forward tramp-smb-prompt nil t
)))
1013 ;; Return value is whether no error message has appeared.
1014 (tramp-message vec
6 "\n%s" (buffer-string))
1018 (provide 'tramp-smb
)
1022 ;; * Error handling in case password is wrong.
1023 ;; * Read password from "~/.netrc".
1024 ;; * Return more comprehensive file permission string. Think whether it is
1025 ;; possible to implement `set-file-modes'.
1026 ;; * Handle links (FILENAME.LNK).
1027 ;; * Try to remove the inclusion of dummy "" directory. Seems to be at
1028 ;; several places, especially in `tramp-smb-handle-insert-directory'.
1029 ;; * (RMS) Use unwind-protect to clean up the state so as to make the state
1031 ;; * Make it multi-hop capable.
1033 ;; arch-tag: fcc9dbec-7503-4d73-b638-3c8aa59575f5
1034 ;;; tramp-smb.el ends here