1 ;;; tramp-smb.el --- Tramp access functions for SMB servers -*- coding: iso-8859-1; -*-
3 ;; Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
5 ;; Author: Michael Albinus <michael.albinus@gmx.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., 51 Franklin Street, Fifth Floor,
23 ;; Boston, MA 02110-1301, 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 ;; Avoid byte-compiler warnings if the byte-compiler supports this.
42 ;; Currently, XEmacs supports this.
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
))))))
49 ;; Define SMB method ...
50 (defcustom tramp-smb-method
"smb"
51 "*Method to connect SAMBA and M$ SMB servers."
55 ;; ... and add it to the method list.
56 (add-to-list 'tramp-methods
(cons tramp-smb-method nil
))
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
))
63 ;; Add completion function for SMB method.
64 (tramp-set-completion-function
66 '((tramp-parse-netrc "~/.netrc")))
68 (defcustom tramp-smb-program
"smbclient"
69 "*Name of SMB client to run."
73 (defconst tramp-smb-prompt
"^smb: .+> \\|^\\s-+Server\\s-+Comment$"
74 "Regexp used as prompt in smbclient.")
76 (defconst tramp-smb-errors
80 "Connection to \\S-+ failed"
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")
103 "Regexp for possible error strings of SMB servers.
104 Used instead of analyzing error codes of commands.")
106 (defvar tramp-smb-share nil
107 "Holds the share name for the current buffer.
108 This variable is local to each buffer.")
109 (make-variable-buffer-local 'tramp-smb-share
)
111 (defvar tramp-smb-share-cache nil
112 "Caches the share names accessible to host related to the current buffer.
113 This variable is local to each buffer.")
114 (make-variable-buffer-local 'tramp-smb-share-cache
)
116 (defvar tramp-smb-inodes nil
117 "Keeps virtual inodes numbers for SMB files.")
119 ;; New handlers should be added here.
120 (defconst tramp-smb-file-name-handler-alist
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
)
176 "Alist of handler functions for Tramp SMB method.
177 Operations not mentioned here will be handled by the default Emacs primitives.")
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
)))
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
))
190 (defun tramp-smb-file-name-handler (operation &rest args
)
191 "Invoke the SMB related OPERATION.
192 First arg specifies the OPERATION, second arg is a list of arguments to
193 pass to the OPERATION."
194 (let ((fn (assoc operation tramp-smb-file-name-handler-alist
)))
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
))))
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-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
)
212 (defun tramp-smb-handle-copy-file
213 (filename newname
&optional ok-if-already-exists keep-date
)
214 "Like `copy-file' for tramp files.
215 KEEP-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
))
219 (let ((tmpfile (file-local-copy filename
)))
223 (rename-file tmpfile newname ok-if-already-exists
)
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
))
233 (with-parsed-tramp-file-name newname nil
235 (let ((share (tramp-smb-get-share localname
))
236 (file (tramp-smb-get-localname localname t
)))
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
))))))))
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
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
)
261 (tramp-smb-send-command user host
(format "cd \"%s\"" dir
))
262 (tramp-smb-send-command user host
(format "rmdir \"%s\"" file
)))
264 (tramp-smb-send-command user host
(format "cd \\"))
266 (tramp-smb-send-command user host
(format "cd \\"))
267 (error "Cannot delete directory `%s'" directory
)))))))
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
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
)
280 (tramp-smb-send-command user host
(format "cd \"%s\"" dir
))
281 (tramp-smb-send-command user host
(format "rm \"%s\"" file
)))
283 (tramp-smb-send-command user host
(format "cd \\"))
285 (tramp-smb-send-command user host
(format "cd \\"))
286 (error "Cannot delete file `%s'" filename
)))))))
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
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
303 (mapcar (lambda (x) (when (string-match match x
) x
))
305 ;; Make absolute localnames if necessary
309 (concat (file-name-as-directory directory
) x
))
311 ;; Sort them if necessary
312 (unless nosort
(setq entries
(sort entries
'string-lessp
)))
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."
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
)))
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
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
))
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
)))
343 (list (and (string-match "d" (nth 1 entry
))
349 (nth 3 entry
) ;5 mtime
351 (nth 2 entry
) ;7 size
352 (nth 1 entry
) ;8 mode
354 inode
;10 inode number
355 device
)))))) ;11 file system number
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
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
))
365 (assoc (file-name-nondirectory file
) entries
))))
367 (string-match "d" (nth 1 entry
))
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
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
)))
378 (member (file-name-nondirectory file
) (mapcar 'car entries
))
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
385 (let ((share (tramp-smb-get-share localname
))
386 (file (tramp-smb-get-localname localname t
))
387 (tmpfil (tramp-make-temp-file)))
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
))
402 ;; This function should return "foo/" for directories and "bar" for
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
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
)))
418 (if (string-match "d" (nth 1 x
))
419 (file-name-as-directory (nth 0 x
))
423 (defun tramp-smb-handle-file-newer-than-file-p (file1 file2
)
424 "Like `file-newer-than-file-p' for tramp files."
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
)))))
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
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
))
443 (assoc (file-name-nondirectory file
) entries
))))
445 (string-match "w" (nth 1 entry
))
448 (defun tramp-smb-handle-insert-directory
449 (filename switches
&optional wildcard full-directory-p
)
450 "Like `insert-directory' for tramp files.
451 WILDCARD 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
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
)))
463 ;; Delete dummy "" entry, useless 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
))))
475 (if (string-match "t" switches
)
477 (tramp-smb-time-less-p (nth 3 y
) (nth 3 x
))
479 (string-lessp (nth 0 x
) (nth 0 y
))))))
486 "%10s %3d %-8s %-8s %8s %s %s\n"
491 (if (tramp-smb-time-less-p
492 (tramp-smb-time-subtract (current-time) (nth 3 x
))
493 tramp-smb-half-a-year
)
497 (nth 0 x
))) ; file name
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
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
))
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
))))))
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
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
))))))
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
))
541 (let ((tmpfile (file-local-copy filename
)))
545 (rename-file tmpfile newname ok-if-already-exists
)
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
))
555 (with-parsed-tramp-file-name newname nil
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
)))))))
570 (delete-file filename
))
572 (defun tramp-smb-handle-substitute-in-file-name (filename)
573 "Like `handle-substitute-in-file-name' for tramp files.
574 Catches errors for shares like \"C$/\", which are common in Microsoft Windows."
576 (tramp-run-real-handler 'substitute-in-file-name
(list filename
))
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? "
590 (error "File not overwritten")))
591 (with-parsed-tramp-file-name filename nil
593 (let ((share (tramp-smb-get-share localname
))
594 (file (tramp-smb-get-localname localname t
))
595 (curbuf (current-buffer))
597 ;; Write region into a tmp file.
598 (setq tmpfil
(tramp-make-temp-file))
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
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
)))
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
))
620 (unless (equal curbuf
(current-buffer))
621 (error "Buffer has changed from `%s' to `%s'"
622 curbuf
(current-buffer)))
624 (set-visited-file-modtime))))))
627 ;; Internal file name functions
629 (defun tramp-smb-get-share (localname)
630 "Returns the share name of LOCALNAME."
632 (when (string-match "^/?\\([^/]+\\)/" localname
)
633 (match-string 1 localname
))))
635 (defun tramp-smb-get-localname (localname convert
)
636 "Returns the file name of LOCALNAME.
637 If CONVERT is non-nil exchange \"/\" by \"\\\\\"."
639 (let ((res localname
))
642 res
(if (string-match "^/?[^/]+/\\(.*\\)" res
)
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
)
652 ;; Sometimes we have discarded `substitute-in-file-name'
653 (when (string-match "\\(\\$\\$\\)\\(/\\|$\\)" res
)
654 (setq res
(replace-match "$" nil nil res
1)))
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.
662 Either the shares are listed, or the `dir' command is executed.
663 Only entries matching the localname are returned.
664 Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)."
667 (let ((base (or (and (> (length localname
) 0)
668 (string-match "\\([^/]+\\)$" localname
)
669 (regexp-quote (match-string 1 localname
)))
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
)
677 (tramp-smb-maybe-open-connection user host share
)
679 (tramp-smb-send-command
682 (if (zerop (length localname
)) "" (concat "\"" localname
"*\"")))))
683 (goto-char (point-min))
685 (unless (re-search-forward tramp-smb-errors nil t
)
687 (setq entry
(tramp-smb-read-file-entry share
))
689 (when entry
(add-to-list 'res entry
))))
691 ;; Cache share entries
692 (setq tramp-smb-share-cache res
)))
694 ;; Add directory itself
695 (add-to-list 'res
'("" "drwxrwxrwx" 0 (0 0)))
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))
701 ;; Check for matching entries
703 (lambda (x) (and (string-match base
(nth 0 x
)) x
))
706 ;; Return either a share name (if SHARE is nil), or a file name
708 ;; If shares are listed, the following format is expected
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
716 ;; Entries provided by smbclient DIR aren't fully regular.
717 ;; They should have the format
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
728 ;; \s- - space delimeter
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
735 ;; samba/src/client.c (http://samba.org/doxygen/samba/client_8c-source.html)
736 ;; has function display_finfo:
738 ;; d_printf(" %-30s%7.7s %8.0f %s",
740 ;; attrib_string(finfo->mode),
741 ;; (double)finfo->size,
742 ;; asctime(LocalTime(&t)));
744 ;; in Samba 1.9, there's the following code:
746 ;; DEBUG(0,(" %-30s%7.7s%10d %s",
747 ;; CNV_LANG(finfo->name),
748 ;; attrib_string(finfo->mode),
750 ;; asctime(LocalTime(&t))));
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.
759 ;; So we try to analyze backwards.
760 (defun tramp-smb-read-file-entry (share)
761 "Parse entry in SMB output buffer.
762 If SHARE is result, entries are of type dir. Otherwise, shares are listed.
763 Result 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
)
770 (when (string-match "^\\s-+\\(\\S-+\\)\\s-+Disk" line
)
771 (setq localname
(match-string 1 line
)
779 (if (string-match "\\([0-9]+\\)$" line
)
780 (setq year
(string-to-number (match-string 1 line
))
781 line
(substring line
0 -
5))
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))
793 (if (string-match "\\([0-9]+\\)$" line
)
794 (setq day
(string-to-number (match-string 1 line
))
795 line
(substring line
0 -
3))
799 (if (string-match "\\(\\w+\\)$" line
)
800 (setq month
(match-string 1 line
)
801 line
(substring line
0 -
4))
805 (if (string-match "\\(\\w+\\)$" line
)
806 (setq line
(substring line
0 -
5))
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
)))
818 ;; mode: ARCH, DIR, HIDDEN, RONLY, SYSTEM, VOLID
819 (if (string-match "\\([ADHRSV]+\\)?$" line
)
821 mode
(or (match-string 1 line
) "")
822 mode
(save-match-data (format
824 (if (string-match "D" mode
) "d" "-")
827 (concat "r" (if (string-match "R" mode
) "-" "w") "x"))))
828 line
(substring line
0 -
7))
832 (if (string-match "^\\s-+\\(\\S-\\(.*\\S-\\)?\\)\\s-*$" line
)
833 (setq localname
(match-string 1 line
))
836 (when (and localname mode size
)
838 (if (and sec min hour day month year
)
841 (cdr (assoc (downcase month
) tramp-smb-parse-time-months
))
844 (list localname mode size mtime
))))
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.
851 (defun tramp-smb-get-inode (share file
)
852 "Returns the virtual inode number.
853 If 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
))))
861 ;; Connection functions
863 (defun tramp-smb-send-command (user host command
)
864 "Send the COMMAND to USER at HOST (logged into an SMB session).
865 Erases temporary buffer before sending the command. Returns nil if
866 there has been an error message from smbclient."
868 (set-buffer (tramp-get-buffer nil tramp-smb-method user host
))
870 (tramp-send-command nil tramp-smb-method user host command nil t
)
871 (tramp-smb-wait-for-output user host
)))
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'.
875 Does not do anything if a connection is already open, but re-opens the
876 connection 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
))))
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
))
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
)))
895 (unless (and p
(processp p
) (memq (process-status p
) '(run open
)))
896 (when (and p
(processp p
))
898 (tramp-smb-open-connection user host share
))))
900 (defun tramp-smb-open-connection (user host share
)
901 "Open a connection using `tramp-smb-program'.
902 This starts the command `smbclient //HOST/SHARE -U USER', then waits
903 for a remote password prompt. It queries the user for the password,
904 then sends the password to the remote host.
906 Domain names in USER and port numbers in HOST are acknowledged."
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
))
913 (let* ((buffer (tramp-get-buffer nil tramp-smb-method user host
))
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
)))
923 (when (and host
(string-match "\\(.+\\)#\\(.+\\)" host
))
924 (setq real-host
(or (match-string 1 host
) host
)
925 port
(match-string 2 host
)))
928 (setq args
(list (concat "//" real-host
"/" share
)))
929 (setq args
(list "-L" real-host
)))
932 (setq args
(append args
(list "-U" real-user
)))
933 (setq args
(append args
(list "-N"))))
935 (when domain
(setq args
(append args
(list "-W" domain
))))
936 (when port
(setq args
(append args
(list "-p" port
))))
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
""))
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
)))
953 (tramp-message 9 "Started process %s" (process-command p
))
954 (tramp-set-process-query-on-exit-flag p nil
)
956 (setq tramp-smb-share share
)
960 (let ((pw-prompt "Password:"))
961 (tramp-message 9 "Sending password")
962 (tramp-enter-password p pw-prompt user host
)))
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
"")))))))
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.
972 Returns 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
))))
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 (and (not found
) (not err
))
984 ;; Accept pending output.
985 (tramp-accept-process-output proc
)
987 ;; Search for prompt.
988 (goto-char (point-min))
989 (setq found
(re-search-forward tramp-smb-prompt nil t
))
991 ;; Search for errors.
992 (goto-char (point-min))
993 (setq err
(re-search-forward tramp-smb-errors nil t
)))
995 ;; Add output to debug buffer if appropriate.
996 (when tramp-debug-buffer
998 (tramp-get-debug-buffer nil tramp-smb-method user host
)
999 (point-min) (point-max)))
1001 ;; Return value is whether no error message has appeared.
1005 ;; Snarfed code from time-date.el and parse-time.el
1007 (defconst tramp-smb-half-a-year
'(241 17024)
1008 "Evaluated by \"(days-to-time 183)\".")
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.")
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
)))))
1024 (defun tramp-smb-time-subtract (t1 t2
)
1025 "Subtract two time values.
1026 Return 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
)))))
1034 (provide 'tramp-smb
)
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
1055 ;;; arch-tag: fcc9dbec-7503-4d73-b638-3c8aa59575f5
1056 ;;; tramp-smb.el ends here