Merge from trunk
[emacs.git] / lisp / net / tramp-smb.el
blob5a62b71bda1d464aa60142e494f648c86e227032
1 ;;; tramp-smb.el --- Tramp access functions for SMB servers
3 ;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
5 ;; Author: Michael Albinus <michael.albinus@gmx.de>
6 ;; Keywords: comm, processes
7 ;; Package: tramp
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/>.
24 ;;; Commentary:
26 ;; Access functions for SMB servers like SAMBA or M$ Windows from Tramp.
28 ;;; Code:
30 (eval-when-compile (require 'cl)) ; block, return
31 (require 'tramp)
33 ;; Define SMB method ...
34 ;;;###tramp-autoload
35 (defconst tramp-smb-method "smb"
36 "*Method to connect SAMBA and M$ SMB servers.")
38 ;; ... and add it to the method list.
39 ;;;###tramp-autoload
40 (unless (memq system-type '(cygwin windows-nt))
41 (add-to-list 'tramp-methods (cons tramp-smb-method nil)))
43 ;; Add a default for `tramp-default-method-alist'. Rule: If there is
44 ;; a domain in USER, it must be the SMB method.
45 ;;;###tramp-autoload
46 (add-to-list 'tramp-default-method-alist
47 `(nil ,tramp-prefix-domain-regexp ,tramp-smb-method))
49 ;; Add a default for `tramp-default-user-alist'. Rule: For the SMB method,
50 ;; the anonymous user is chosen.
51 ;;;###tramp-autoload
52 (add-to-list 'tramp-default-user-alist
53 `(,(concat "\\`" tramp-smb-method "\\'") nil nil))
55 ;; Add completion function for SMB method.
56 (tramp-set-completion-function
57 tramp-smb-method
58 '((tramp-parse-netrc "~/.netrc")))
60 (defcustom tramp-smb-program "smbclient"
61 "*Name of SMB client to run."
62 :group 'tramp
63 :type 'string)
65 (defcustom tramp-smb-conf "/dev/null"
66 "*Path of the smb.conf file.
67 If it is nil, no smb.conf will be added to the `tramp-smb-program'
68 call, letting the SMB client use the default one."
69 :group 'tramp
70 :type '(choice (const nil) (file :must-match t)))
72 (defvar tramp-smb-version nil
73 "*Version string of the SMB client.")
75 (defconst tramp-smb-prompt "^smb: .+> \\|^\\s-+Server\\s-+Comment$"
76 "Regexp used as prompt in smbclient.")
78 (defconst tramp-smb-errors
79 (mapconcat
80 'identity
81 `(;; Connection error / timeout / unknown command.
82 "Connection\\( to \\S-+\\)? failed"
83 "Read from server failed, maybe it closed the connection"
84 "Call timed out: server did not respond"
85 "\\S-+: command not found"
86 "Server doesn't support UNIX CIFS calls"
87 ,(regexp-opt
88 '(;; Samba.
89 "ERRDOS"
90 "ERRHRD"
91 "ERRSRV"
92 "ERRbadfile"
93 "ERRbadpw"
94 "ERRfilexists"
95 "ERRnoaccess"
96 "ERRnomem"
97 "ERRnosuchshare"
98 ;; Windows 4.0 (Windows NT), Windows 5.0 (Windows 2000),
99 ;; Windows 5.1 (Windows XP), Windows 5.2 (Windows Server 2003).
100 "NT_STATUS_ACCESS_DENIED"
101 "NT_STATUS_ACCOUNT_LOCKED_OUT"
102 "NT_STATUS_BAD_NETWORK_NAME"
103 "NT_STATUS_CANNOT_DELETE"
104 "NT_STATUS_CONNECTION_REFUSED"
105 "NT_STATUS_DIRECTORY_NOT_EMPTY"
106 "NT_STATUS_DUPLICATE_NAME"
107 "NT_STATUS_FILE_IS_A_DIRECTORY"
108 "NT_STATUS_IO_TIMEOUT"
109 "NT_STATUS_LOGON_FAILURE"
110 "NT_STATUS_NETWORK_ACCESS_DENIED"
111 "NT_STATUS_NOT_IMPLEMENTED"
112 "NT_STATUS_NO_SUCH_FILE"
113 "NT_STATUS_NO_SUCH_USER"
114 "NT_STATUS_OBJECT_NAME_COLLISION"
115 "NT_STATUS_OBJECT_NAME_INVALID"
116 "NT_STATUS_OBJECT_NAME_NOT_FOUND"
117 "NT_STATUS_SHARING_VIOLATION"
118 "NT_STATUS_TRUSTED_RELATIONSHIP_FAILURE"
119 "NT_STATUS_UNSUCCESSFUL"
120 "NT_STATUS_WRONG_PASSWORD")))
121 "\\|")
122 "Regexp for possible error strings of SMB servers.
123 Used instead of analyzing error codes of commands.")
125 (defconst tramp-smb-actions-with-share
126 '((tramp-smb-prompt tramp-action-succeed)
127 (tramp-password-prompt-regexp tramp-action-password)
128 (tramp-wrong-passwd-regexp tramp-action-permission-denied)
129 (tramp-smb-errors tramp-action-permission-denied)
130 (tramp-process-alive-regexp tramp-action-process-alive))
131 "List of pattern/action pairs.
132 This list is used for login to SMB servers.
134 See `tramp-actions-before-shell' for more info.")
136 (defconst tramp-smb-actions-without-share
137 '((tramp-password-prompt-regexp tramp-action-password)
138 (tramp-wrong-passwd-regexp tramp-action-permission-denied)
139 (tramp-smb-errors tramp-action-permission-denied)
140 (tramp-process-alive-regexp tramp-action-out-of-band))
141 "List of pattern/action pairs.
142 This list is used for login to SMB servers.
144 See `tramp-actions-before-shell' for more info.")
146 ;; New handlers should be added here.
147 (defconst tramp-smb-file-name-handler-alist
149 ;; `access-file' performed by default handler.
150 (add-name-to-file . tramp-smb-handle-add-name-to-file)
151 ;; `byte-compiler-base-file-name' performed by default handler.
152 (copy-directory . tramp-smb-handle-copy-directory)
153 (copy-file . tramp-smb-handle-copy-file)
154 (delete-directory . tramp-smb-handle-delete-directory)
155 (delete-file . tramp-smb-handle-delete-file)
156 ;; `diff-latest-backup-file' performed by default handler.
157 (directory-file-name . tramp-handle-directory-file-name)
158 (directory-files . tramp-smb-handle-directory-files)
159 (directory-files-and-attributes
160 . tramp-handle-directory-files-and-attributes)
161 (dired-call-process . ignore)
162 (dired-compress-file . ignore)
163 (dired-uncache . tramp-handle-dired-uncache)
164 (expand-file-name . tramp-smb-handle-expand-file-name)
165 (file-accessible-directory-p . tramp-smb-handle-file-directory-p)
166 (file-attributes . tramp-smb-handle-file-attributes)
167 (file-directory-p . tramp-smb-handle-file-directory-p)
168 (file-executable-p . tramp-handle-file-exists-p)
169 (file-exists-p . tramp-handle-file-exists-p)
170 (file-local-copy . tramp-smb-handle-file-local-copy)
171 (file-modes . tramp-handle-file-modes)
172 (file-name-all-completions . tramp-smb-handle-file-name-all-completions)
173 (file-name-as-directory . tramp-handle-file-name-as-directory)
174 (file-name-completion . tramp-handle-file-name-completion)
175 (file-name-directory . tramp-handle-file-name-directory)
176 (file-name-nondirectory . tramp-handle-file-name-nondirectory)
177 ;; `file-name-sans-versions' performed by default handler.
178 (file-newer-than-file-p . tramp-handle-file-newer-than-file-p)
179 (file-ownership-preserved-p . ignore)
180 (file-readable-p . tramp-handle-file-exists-p)
181 (file-regular-p . tramp-handle-file-regular-p)
182 (file-remote-p . tramp-handle-file-remote-p)
183 ;; `file-selinux-context' performed by default handler.
184 (file-symlink-p . tramp-handle-file-symlink-p)
185 ;; `file-truename' performed by default handler.
186 (file-writable-p . tramp-smb-handle-file-writable-p)
187 (find-backup-file-name . tramp-handle-find-backup-file-name)
188 ;; `find-file-noselect' performed by default handler.
189 ;; `get-file-buffer' performed by default handler.
190 (insert-directory . tramp-smb-handle-insert-directory)
191 (insert-file-contents . tramp-handle-insert-file-contents)
192 (load . tramp-handle-load)
193 (make-directory . tramp-smb-handle-make-directory)
194 (make-directory-internal . tramp-smb-handle-make-directory-internal)
195 (make-symbolic-link . tramp-smb-handle-make-symbolic-link)
196 (rename-file . tramp-smb-handle-rename-file)
197 (set-file-modes . tramp-smb-handle-set-file-modes)
198 ;; `set-file-selinux-context' performed by default handler.
199 (set-file-times . ignore)
200 (set-visited-file-modtime . ignore)
201 (shell-command . ignore)
202 (substitute-in-file-name . tramp-smb-handle-substitute-in-file-name)
203 (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory)
204 (vc-registered . ignore)
205 (verify-visited-file-modtime . ignore)
206 (write-region . tramp-smb-handle-write-region)
208 "Alist of handler functions for Tramp SMB method.
209 Operations not mentioned here will be handled by the default Emacs primitives.")
211 ;;;###tramp-autoload
212 (defsubst tramp-smb-file-name-p (filename)
213 "Check if it's a filename for SMB servers."
214 (let ((v (tramp-dissect-file-name filename)))
215 (string= (tramp-file-name-method v) tramp-smb-method)))
217 ;;;###tramp-autoload
218 (defun tramp-smb-file-name-handler (operation &rest args)
219 "Invoke the SMB related OPERATION.
220 First arg specifies the OPERATION, second arg is a list of arguments to
221 pass to the OPERATION."
222 (let ((fn (assoc operation tramp-smb-file-name-handler-alist)))
223 (if fn
224 (save-match-data (apply (cdr fn) args))
225 (tramp-run-real-handler operation args))))
227 ;;;###tramp-autoload
228 (unless (memq system-type '(cygwin windows-nt))
229 (add-to-list 'tramp-foreign-file-name-handler-alist
230 (cons 'tramp-smb-file-name-p 'tramp-smb-file-name-handler)))
233 ;; File name primitives.
235 (defun tramp-smb-handle-add-name-to-file
236 (filename newname &optional ok-if-already-exists)
237 "Like `add-name-to-file' for Tramp files."
238 (unless (tramp-equal-remote filename newname)
239 (with-parsed-tramp-file-name
240 (if (tramp-tramp-file-p filename) filename newname) nil
241 (tramp-error
242 v 'file-error
243 "add-name-to-file: %s"
244 "only implemented for same method, same user, same host")))
245 (with-parsed-tramp-file-name filename v1
246 (with-parsed-tramp-file-name newname v2
247 (when (file-directory-p filename)
248 (tramp-error
249 v2 'file-error
250 "add-name-to-file: %s must not be a directory" filename))
251 (when (and (not ok-if-already-exists)
252 (file-exists-p newname)
253 (not (numberp ok-if-already-exists))
254 (y-or-n-p
255 (format
256 "File %s already exists; make it a new name anyway? "
257 newname)))
258 (tramp-error
259 v2 'file-error
260 "add-name-to-file: file %s already exists" newname))
261 ;; We must also flush the cache of the directory, because
262 ;; `file-attributes' reads the values from there.
263 (tramp-flush-file-property v2 (file-name-directory v2-localname))
264 (tramp-flush-file-property v2 v2-localname)
265 (unless
266 (tramp-smb-send-command
268 (format
269 "%s \"%s\" \"%s\""
270 (if (tramp-smb-get-cifs-capabilities v1) "link" "hardlink")
271 (tramp-smb-get-localname v1)
272 (tramp-smb-get-localname v2)))
273 (tramp-error
274 v2 'file-error
275 "error with add-name-to-file, see buffer `%s' for details"
276 (buffer-name))))))
278 (defun tramp-smb-handle-copy-directory
279 (dirname newname &optional keep-date parents)
280 "Like `copy-directory' for Tramp files. KEEP-DATE is not handled."
281 (setq dirname (expand-file-name dirname)
282 newname (expand-file-name newname))
283 (let ((t1 (tramp-tramp-file-p dirname))
284 (t2 (tramp-tramp-file-p newname)))
285 (with-parsed-tramp-file-name (if t1 dirname newname) nil
286 (cond
287 ;; We must use a local temporary directory.
288 ((and t1 t2)
289 (let ((tmpdir
290 (make-temp-name
291 (expand-file-name
292 tramp-temp-name-prefix
293 (tramp-compat-temporary-file-directory)))))
294 (unwind-protect
295 (progn
296 (tramp-compat-copy-directory dirname tmpdir keep-date parents)
297 (tramp-compat-copy-directory tmpdir newname keep-date parents))
298 (tramp-compat-delete-directory tmpdir 'recursive))))
300 ;; We can copy recursively.
301 ((or t1 t2)
302 (let ((prompt (tramp-smb-send-command v "prompt"))
303 (recurse (tramp-smb-send-command v "recurse")))
304 (unless (file-directory-p newname)
305 (make-directory newname parents))
306 (unwind-protect
307 (unless
308 (and
309 prompt recurse
310 (tramp-smb-send-command
311 v (format "cd \"%s\"" (tramp-smb-get-localname v)))
312 (tramp-smb-send-command
313 v (format "lcd \"%s\"" (if t1 newname dirname)))
314 (if t1
315 (tramp-smb-send-command v "mget *")
316 (tramp-smb-send-command v "mput *")))
317 ;; Error.
318 (with-current-buffer (tramp-get-connection-buffer v)
319 (goto-char (point-min))
320 (search-forward-regexp tramp-smb-errors nil t)
321 (tramp-error
322 v 'file-error
323 "%s `%s'" (match-string 0) (if t1 dirname newname))))
324 ;; Go home.
325 (tramp-smb-send-command
326 v (format
327 "cd %s" (if (tramp-smb-get-cifs-capabilities v) "/" "\\")))
328 ;; Toggle prompt and recurse OFF.
329 (if prompt (tramp-smb-send-command v "prompt"))
330 (if recurse (tramp-smb-send-command v "recurse")))))
332 ;; We must do it file-wise.
334 (tramp-run-real-handler
335 'copy-directory (list dirname newname keep-date parents)))))))
337 (defun tramp-smb-handle-copy-file
338 (filename newname &optional ok-if-already-exists keep-date
339 preserve-uid-gid preserve-selinux-context)
340 "Like `copy-file' for Tramp files.
341 KEEP-DATE is not handled in case NEWNAME resides on an SMB server.
342 PRESERVE-UID-GID and PRESERVE-SELINUX-CONTEXT are completely ignored."
343 (setq filename (expand-file-name filename)
344 newname (expand-file-name newname))
345 (with-progress-reporter
346 (tramp-dissect-file-name (if (file-remote-p filename) filename newname))
347 0 (format "Copying %s to %s" filename newname)
349 (let ((tmpfile (file-local-copy filename)))
351 (if tmpfile
352 ;; Remote filename.
353 (condition-case err
354 (rename-file tmpfile newname ok-if-already-exists)
355 ((error quit)
356 (delete-file tmpfile)
357 (signal (car err) (cdr err))))
359 ;; Remote newname.
360 (when (file-directory-p newname)
361 (setq newname
362 (expand-file-name (file-name-nondirectory filename) newname)))
364 (with-parsed-tramp-file-name newname nil
365 (when (and (not ok-if-already-exists)
366 (file-exists-p newname))
367 (tramp-error v 'file-already-exists newname))
369 ;; We must also flush the cache of the directory, because
370 ;; `file-attributes' reads the values from there.
371 (tramp-flush-file-property v (file-name-directory localname))
372 (tramp-flush-file-property v localname)
373 (unless (tramp-smb-get-share v)
374 (tramp-error
375 v 'file-error "Target `%s' must contain a share name" newname))
376 (unless (tramp-smb-send-command
377 v (format "put \"%s\" \"%s\""
378 filename (tramp-smb-get-localname v)))
379 (tramp-error v 'file-error "Cannot copy `%s'" filename))))))
381 ;; KEEP-DATE handling.
382 (when keep-date (set-file-times newname (nth 5 (file-attributes filename)))))
384 (defun tramp-smb-handle-delete-directory (directory &optional recursive)
385 "Like `delete-directory' for Tramp files."
386 (setq directory (directory-file-name (expand-file-name directory)))
387 (when (file-exists-p directory)
388 (if recursive
389 (mapc
390 (lambda (file)
391 (if (file-directory-p file)
392 (tramp-compat-delete-directory file recursive)
393 (delete-file file)))
394 ;; We do not want to delete "." and "..".
395 (directory-files
396 directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")))
398 (with-parsed-tramp-file-name directory nil
399 ;; We must also flush the cache of the directory, because
400 ;; `file-attributes' reads the values from there.
401 (tramp-flush-file-property v (file-name-directory localname))
402 (tramp-flush-directory-property v localname)
403 (unless (tramp-smb-send-command
404 v (format
405 "%s \"%s\""
406 (if (tramp-smb-get-cifs-capabilities v) "posix_rmdir" "rmdir")
407 (tramp-smb-get-localname v)))
408 ;; Error.
409 (with-current-buffer (tramp-get-connection-buffer v)
410 (goto-char (point-min))
411 (search-forward-regexp tramp-smb-errors nil t)
412 (tramp-error
413 v 'file-error "%s `%s'" (match-string 0) directory))))))
415 (defun tramp-smb-handle-delete-file (filename &optional trash)
416 "Like `delete-file' for Tramp files."
417 (setq filename (expand-file-name filename))
418 (when (file-exists-p filename)
419 (with-parsed-tramp-file-name filename nil
420 ;; We must also flush the cache of the directory, because
421 ;; `file-attributes' reads the values from there.
422 (tramp-flush-file-property v (file-name-directory localname))
423 (tramp-flush-file-property v localname)
424 (unless (tramp-smb-send-command
425 v (format
426 "%s \"%s\""
427 (if (tramp-smb-get-cifs-capabilities v) "posix_unlink" "rm")
428 (tramp-smb-get-localname v)))
429 ;; Error.
430 (with-current-buffer (tramp-get-connection-buffer v)
431 (goto-char (point-min))
432 (search-forward-regexp tramp-smb-errors nil t)
433 (tramp-error
434 v 'file-error "%s `%s'" (match-string 0) filename))))))
436 (defun tramp-smb-handle-directory-files
437 (directory &optional full match nosort)
438 "Like `directory-files' for Tramp files."
439 (let ((result (mapcar 'directory-file-name
440 (file-name-all-completions "" directory))))
441 ;; Discriminate with regexp.
442 (when match
443 (setq result
444 (delete nil
445 (mapcar (lambda (x) (when (string-match match x) x))
446 result))))
447 ;; Append directory.
448 (when full
449 (setq result
450 (mapcar
451 (lambda (x) (expand-file-name x directory))
452 result)))
453 ;; Sort them if necessary.
454 (unless nosort (setq result (sort result 'string-lessp)))
455 ;; That's it.
456 result))
458 (defun tramp-smb-handle-expand-file-name (name &optional dir)
459 "Like `expand-file-name' for Tramp files."
460 ;; If DIR is not given, use DEFAULT-DIRECTORY or "/".
461 (setq dir (or dir default-directory "/"))
462 ;; Unless NAME is absolute, concat DIR and NAME.
463 (unless (file-name-absolute-p name)
464 (setq name (concat (file-name-as-directory dir) name)))
465 ;; If NAME is not a Tramp file, run the real handler.
466 (if (not (tramp-tramp-file-p name))
467 (tramp-run-real-handler 'expand-file-name (list name nil))
468 ;; Dissect NAME.
469 (with-parsed-tramp-file-name name nil
470 ;; Tilde expansion if necessary. We use the user name as share,
471 ;; which is offen the case in domains.
472 (when (string-match "\\`/?~\\([^/]*\\)" localname)
473 (setq localname
474 (replace-match
475 (if (zerop (length (match-string 1 localname)))
476 (tramp-file-name-real-user v)
477 (match-string 1 localname))
478 nil nil localname)))
479 ;; Make the file name absolute.
480 (unless (tramp-run-real-handler 'file-name-absolute-p (list localname))
481 (setq localname (concat "/" localname)))
482 ;; No tilde characters in file name, do normal
483 ;; `expand-file-name' (this does "/./" and "/../").
484 (tramp-make-tramp-file-name
485 method user host
486 (tramp-run-real-handler 'expand-file-name (list localname))))))
488 (defun tramp-smb-handle-file-attributes (filename &optional id-format)
489 "Like `file-attributes' for Tramp files."
490 (unless id-format (setq id-format 'integer))
491 (with-parsed-tramp-file-name filename nil
492 (with-file-property v localname (format "file-attributes-%s" id-format)
493 (if (and (tramp-smb-get-share v) (tramp-smb-get-stat-capability v))
494 (tramp-smb-do-file-attributes-with-stat v id-format)
495 ;; Reading just the filename entry via "dir localname" is not
496 ;; possible, because when filename is a directory, some
497 ;; smbclient versions return the content of the directory, and
498 ;; other versions don't. Therefore, the whole content of the
499 ;; upper directory is retrieved, and the entry of the filename
500 ;; is extracted from.
501 (let* ((entries (tramp-smb-get-file-entries
502 (file-name-directory filename)))
503 (entry (assoc (file-name-nondirectory filename) entries))
504 (uid (if (equal id-format 'string) "nobody" -1))
505 (gid (if (equal id-format 'string) "nogroup" -1))
506 (inode (tramp-get-inode v))
507 (device (tramp-get-device v)))
509 ;; Check result.
510 (when entry
511 (list (and (string-match "d" (nth 1 entry))
512 t) ;0 file type
513 -1 ;1 link count
514 uid ;2 uid
515 gid ;3 gid
516 '(0 0) ;4 atime
517 (nth 3 entry) ;5 mtime
518 '(0 0) ;6 ctime
519 (nth 2 entry) ;7 size
520 (nth 1 entry) ;8 mode
521 nil ;9 gid weird
522 inode ;10 inode number
523 device))))))) ;11 file system number
525 (defun tramp-smb-do-file-attributes-with-stat (vec &optional id-format)
526 "Implement `file-attributes' for Tramp files using stat command."
527 (tramp-message
528 vec 5 "file attributes with stat: %s" (tramp-file-name-localname vec))
529 (with-current-buffer (tramp-get-buffer vec)
530 (let* (size id link uid gid atime mtime ctime mode inode)
531 (when (tramp-smb-send-command
532 vec (format "stat \"%s\"" (tramp-smb-get-localname vec)))
534 ;; Loop the listing.
535 (goto-char (point-min))
536 (unless (re-search-forward tramp-smb-errors nil t)
537 (while (not (eobp))
538 (cond
539 ((looking-at
540 "Size:\\s-+\\([0-9]+\\)\\s-+Blocks:\\s-+[0-9]+\\s-+\\(\\w+\\)")
541 (setq size (string-to-number (match-string 1))
542 id (if (string-equal "directory" (match-string 2)) t
543 (if (string-equal "symbolic" (match-string 2)) ""))))
544 ((looking-at
545 "Inode:\\s-+\\([0-9]+\\)\\s-+Links:\\s-+\\([0-9]+\\)")
546 (setq inode (string-to-number (match-string 1))
547 link (string-to-number (match-string 2))))
548 ((looking-at
549 "Access:\\s-+([0-9]+/\\(\\S-+\\))\\s-+Uid:\\s-+\\([0-9]+\\)\\s-+Gid:\\s-+\\([0-9]+\\)")
550 (setq mode (match-string 1)
551 uid (if (equal id-format 'string) (match-string 2)
552 (string-to-number (match-string 2)))
553 gid (if (equal id-format 'string) (match-string 3)
554 (string-to-number (match-string 3)))))
555 ((looking-at
556 "Access:\\s-+\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)\\s-+\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)")
557 (setq atime
558 (encode-time
559 (string-to-number (match-string 6)) ;; sec
560 (string-to-number (match-string 5)) ;; min
561 (string-to-number (match-string 4)) ;; hour
562 (string-to-number (match-string 3)) ;; day
563 (string-to-number (match-string 2)) ;; month
564 (string-to-number (match-string 1))))) ;; year
565 ((looking-at
566 "Modify:\\s-+\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)\\s-+\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)")
567 (setq mtime
568 (encode-time
569 (string-to-number (match-string 6)) ;; sec
570 (string-to-number (match-string 5)) ;; min
571 (string-to-number (match-string 4)) ;; hour
572 (string-to-number (match-string 3)) ;; day
573 (string-to-number (match-string 2)) ;; month
574 (string-to-number (match-string 1))))) ;; year
575 ((looking-at
576 "Change:\\s-+\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)\\s-+\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)")
577 (setq ctime
578 (encode-time
579 (string-to-number (match-string 6)) ;; sec
580 (string-to-number (match-string 5)) ;; min
581 (string-to-number (match-string 4)) ;; hour
582 (string-to-number (match-string 3)) ;; day
583 (string-to-number (match-string 2)) ;; month
584 (string-to-number (match-string 1)))))) ;; year
585 (forward-line))
586 ;; Return the result.
587 (list id link uid gid atime mtime ctime size mode nil inode
588 (tramp-get-device vec)))))))
590 (defun tramp-smb-handle-file-directory-p (filename)
591 "Like `file-directory-p' for Tramp files."
592 (and (file-exists-p filename)
593 (eq ?d (aref (nth 8 (file-attributes filename)) 0))))
595 (defun tramp-smb-handle-file-local-copy (filename)
596 "Like `file-local-copy' for Tramp files."
597 (with-parsed-tramp-file-name filename nil
598 (unless (file-exists-p filename)
599 (tramp-error
600 v 'file-error
601 "Cannot make local copy of non-existing file `%s'" filename))
602 (let ((tmpfile (tramp-compat-make-temp-file filename)))
603 (with-progress-reporter
604 v 3 (format "Fetching %s to tmp file %s" filename tmpfile)
605 (unless (tramp-smb-send-command
606 v (format "get \"%s\" \"%s\""
607 (tramp-smb-get-localname v) tmpfile))
608 ;; Oops, an error. We shall cleanup.
609 (delete-file tmpfile)
610 (tramp-error
611 v 'file-error "Cannot make local copy of file `%s'" filename)))
612 tmpfile)))
614 ;; This function should return "foo/" for directories and "bar" for
615 ;; files.
616 (defun tramp-smb-handle-file-name-all-completions (filename directory)
617 "Like `file-name-all-completions' for Tramp files."
618 (all-completions
619 filename
620 (with-parsed-tramp-file-name directory nil
621 (with-file-property v localname "file-name-all-completions"
622 (save-match-data
623 (let ((entries (tramp-smb-get-file-entries directory)))
624 (mapcar
625 (lambda (x)
626 (list
627 (if (string-match "d" (nth 1 x))
628 (file-name-as-directory (nth 0 x))
629 (nth 0 x))))
630 entries)))))))
632 (defun tramp-smb-handle-file-writable-p (filename)
633 "Like `file-writable-p' for Tramp files."
634 (if (file-exists-p filename)
635 (string-match "w" (or (nth 8 (file-attributes filename)) ""))
636 (let ((dir (file-name-directory filename)))
637 (and (file-exists-p dir)
638 (file-writable-p dir)))))
640 (defun tramp-smb-handle-insert-directory
641 (filename switches &optional wildcard full-directory-p)
642 "Like `insert-directory' for Tramp files."
643 (setq filename (expand-file-name filename))
644 (if full-directory-p
645 ;; Called from `dired-add-entry'.
646 (setq filename (file-name-as-directory filename))
647 (setq filename (directory-file-name filename)))
648 (with-parsed-tramp-file-name filename nil
649 (save-match-data
650 (let ((base (file-name-nondirectory filename))
651 ;; We should not destroy the cache entry.
652 (entries (copy-sequence
653 (tramp-smb-get-file-entries
654 (file-name-directory filename)))))
656 (when wildcard
657 (string-match "\\." base)
658 (setq base (replace-match "\\\\." nil nil base))
659 (string-match "\\*" base)
660 (setq base (replace-match ".*" nil nil base))
661 (string-match "\\?" base)
662 (setq base (replace-match ".?" nil nil base)))
664 ;; Filter entries.
665 (setq entries
666 (delq
668 (if (or wildcard (zerop (length base)))
669 ;; Check for matching entries.
670 (mapcar
671 (lambda (x)
672 (when (string-match
673 (format "^%s" base) (nth 0 x))
675 entries)
676 ;; We just need the only and only entry FILENAME.
677 (list (assoc base entries)))))
679 ;; Sort entries.
680 (setq entries
681 (sort
682 entries
683 (lambda (x y)
684 (if (string-match "t" switches)
685 ;; Sort by date.
686 (tramp-time-less-p (nth 3 y) (nth 3 x))
687 ;; Sort by name.
688 (string-lessp (nth 0 x) (nth 0 y))))))
690 ;; Handle "-F" switch.
691 (when (string-match "F" switches)
692 (mapc
693 (lambda (x)
694 (when (not (zerop (length (car x))))
695 (cond
696 ((char-equal ?d (string-to-char (nth 1 x)))
697 (setcar x (concat (car x) "/")))
698 ((char-equal ?x (string-to-char (nth 1 x)))
699 (setcar x (concat (car x) "*"))))))
700 entries))
702 ;; Print entries.
703 (mapc
704 (lambda (x)
705 (when (not (zerop (length (nth 0 x))))
706 (let ((attr
707 (when (tramp-smb-get-stat-capability v)
708 (ignore-errors
709 (file-attributes filename 'string)))))
710 (insert
711 (format
712 "%10s %3d %-8s %-8s %8s %s "
713 (or (nth 8 attr) (nth 1 x)) ; mode
714 (or (nth 1 attr) 1) ; inode
715 (or (nth 2 attr) "nobody") ; uid
716 (or (nth 3 attr) "nogroup") ; gid
717 (or (nth 7 attr) (nth 2 x)) ; size
718 (format-time-string
719 (if (tramp-time-less-p
720 (tramp-time-subtract (current-time) (nth 3 x))
721 tramp-half-a-year)
722 "%b %e %R"
723 "%b %e %Y")
724 (nth 3 x)))) ; date
725 ;; We mark the file name. The inserted name could be
726 ;; from somewhere else, so we use the relative file
727 ;; name of `default-directory'.
728 (let ((start (point)))
729 (insert
730 (format
731 "%s\n"
732 (file-relative-name
733 (expand-file-name
734 (nth 0 x) (file-name-directory filename)))))
735 (put-text-property start (1- (point)) 'dired-filename t))
736 (forward-line)
737 (beginning-of-line))))
738 entries)))))
740 (defun tramp-smb-handle-make-directory (dir &optional parents)
741 "Like `make-directory' for Tramp files."
742 (setq dir (directory-file-name (expand-file-name dir)))
743 (unless (file-name-absolute-p dir)
744 (setq dir (expand-file-name dir default-directory)))
745 (with-parsed-tramp-file-name dir nil
746 (save-match-data
747 (let* ((ldir (file-name-directory dir)))
748 ;; Make missing directory parts.
749 (when (and parents
750 (tramp-smb-get-share v)
751 (not (file-directory-p ldir)))
752 (make-directory ldir parents))
753 ;; Just do it.
754 (when (file-directory-p ldir)
755 (make-directory-internal dir))
756 (unless (file-directory-p dir)
757 (tramp-error v 'file-error "Couldn't make directory %s" dir))))))
759 (defun tramp-smb-handle-make-directory-internal (directory)
760 "Like `make-directory-internal' for Tramp files."
761 (setq directory (directory-file-name (expand-file-name directory)))
762 (unless (file-name-absolute-p directory)
763 (setq directory (expand-file-name directory default-directory)))
764 (with-parsed-tramp-file-name directory nil
765 (save-match-data
766 (let* ((file (tramp-smb-get-localname v)))
767 (when (file-directory-p (file-name-directory directory))
768 (tramp-smb-send-command
770 (if (tramp-smb-get-cifs-capabilities v)
771 (format
772 "posix_mkdir \"%s\" %s"
773 file (tramp-compat-decimal-to-octal (default-file-modes)))
774 (format "mkdir \"%s\"" file)))
775 ;; We must also flush the cache of the directory, because
776 ;; `file-attributes' reads the values from there.
777 (tramp-flush-file-property v (file-name-directory localname))
778 (tramp-flush-file-property v localname))
779 (unless (file-directory-p directory)
780 (tramp-error
781 v 'file-error "Couldn't make directory %s" directory))))))
783 (defun tramp-smb-handle-make-symbolic-link
784 (filename linkname &optional ok-if-already-exists)
785 "Like `make-symbolic-link' for Tramp files.
786 If LINKNAME is a non-Tramp file, it is used verbatim as the target of
787 the symlink. If LINKNAME is a Tramp file, only the localname component is
788 used as the target of the symlink.
790 If LINKNAME is a Tramp file and the localname component is relative, then
791 it is expanded first, before the localname component is taken. Note that
792 this can give surprising results if the user/host for the source and
793 target of the symlink differ."
794 (unless (tramp-equal-remote filename linkname)
795 (with-parsed-tramp-file-name
796 (if (tramp-tramp-file-p filename) filename linkname) nil
797 (tramp-error
798 v 'file-error
799 "make-symbolic-link: %s"
800 "only implemented for same method, same user, same host")))
801 (with-parsed-tramp-file-name filename v1
802 (with-parsed-tramp-file-name linkname v2
803 (when (file-directory-p filename)
804 (tramp-error
805 v2 'file-error
806 "make-symbolic-link: %s must not be a directory" filename))
807 (when (and (not ok-if-already-exists)
808 (file-exists-p linkname)
809 (not (numberp ok-if-already-exists))
810 (y-or-n-p
811 (format
812 "File %s already exists; make it a new name anyway? "
813 linkname)))
814 (tramp-error
815 v2 'file-error
816 "make-symbolic-link: file %s already exists" linkname))
817 (unless (tramp-smb-get-cifs-capabilities v1)
818 (tramp-error v2 'file-error "make-symbolic-link not supported"))
819 ;; We must also flush the cache of the directory, because
820 ;; `file-attributes' reads the values from there.
821 (tramp-flush-file-property v2 (file-name-directory v2-localname))
822 (tramp-flush-file-property v2 v2-localname)
823 (unless
824 (tramp-smb-send-command
826 (format
827 "symlink \"%s\" \"%s\""
828 (tramp-smb-get-localname v1)
829 (tramp-smb-get-localname v2)))
830 (tramp-error
831 v2 'file-error
832 "error with make-symbolic-link, see buffer `%s' for details"
833 (buffer-name))))))
835 (defun tramp-smb-handle-rename-file
836 (filename newname &optional ok-if-already-exists)
837 "Like `rename-file' for Tramp files."
838 (setq filename (expand-file-name filename)
839 newname (expand-file-name newname))
840 (with-progress-reporter
841 (tramp-dissect-file-name (if (file-remote-p filename) filename newname))
842 0 (format "Renaming %s to %s" filename newname)
844 (let ((tmpfile (file-local-copy filename)))
846 (if tmpfile
847 ;; Remote filename.
848 (condition-case err
849 (rename-file tmpfile newname ok-if-already-exists)
850 ((error quit)
851 (delete-file tmpfile)
852 (signal (car err) (cdr err))))
854 ;; Remote newname.
855 (when (file-directory-p newname)
856 (setq newname (expand-file-name
857 (file-name-nondirectory filename) newname)))
859 (with-parsed-tramp-file-name newname nil
860 (when (and (not ok-if-already-exists)
861 (file-exists-p newname))
862 (tramp-error v 'file-already-exists newname))
863 ;; We must also flush the cache of the directory, because
864 ;; `file-attributes' reads the values from there.
865 (tramp-flush-file-property v (file-name-directory localname))
866 (tramp-flush-file-property v localname)
867 (unless (tramp-smb-send-command
868 v (format "put %s \"%s\""
869 filename (tramp-smb-get-localname v)))
870 (tramp-error v 'file-error "Cannot rename `%s'" filename)))))
872 (delete-file filename)))
874 (defun tramp-smb-handle-set-file-modes (filename mode)
875 "Like `set-file-modes' for Tramp files."
876 (with-parsed-tramp-file-name filename nil
877 (when (tramp-smb-get-cifs-capabilities v)
878 (tramp-flush-file-property v localname)
879 (unless (tramp-smb-send-command
880 v (format "chmod \"%s\" %s"
881 (tramp-smb-get-localname v)
882 (tramp-compat-decimal-to-octal mode)))
883 (tramp-error
884 v 'file-error "Error while changing file's mode %s" filename)))))
886 (defun tramp-smb-handle-substitute-in-file-name (filename)
887 "Like `handle-substitute-in-file-name' for Tramp files.
888 \"//\" substitutes only in the local filename part. Catches
889 errors for shares like \"C$/\", which are common in Microsoft Windows."
890 (with-parsed-tramp-file-name filename nil
891 ;; Ignore in LOCALNAME everything before "//".
892 (when (and (stringp localname) (string-match ".+?/\\(/\\|~\\)" localname))
893 (setq filename
894 (concat (file-remote-p filename)
895 (replace-match "\\1" nil nil localname)))))
896 (condition-case nil
897 (tramp-run-real-handler 'substitute-in-file-name (list filename))
898 (error filename)))
900 (defun tramp-smb-handle-write-region
901 (start end filename &optional append visit lockname confirm)
902 "Like `write-region' for Tramp files."
903 (setq filename (expand-file-name filename))
904 (with-parsed-tramp-file-name filename nil
905 (unless (eq append nil)
906 (tramp-error
907 v 'file-error "Cannot append to file using Tramp (`%s')" filename))
908 ;; XEmacs takes a coding system as the seventh argument, not `confirm'.
909 (when (and (not (featurep 'xemacs))
910 confirm (file-exists-p filename))
911 (unless (y-or-n-p (format "File %s exists; overwrite anyway? "
912 filename))
913 (tramp-error v 'file-error "File not overwritten")))
914 ;; We must also flush the cache of the directory, because
915 ;; `file-attributes' reads the values from there.
916 (tramp-flush-file-property v (file-name-directory localname))
917 (tramp-flush-file-property v localname)
918 (let ((curbuf (current-buffer))
919 (tmpfile (tramp-compat-make-temp-file filename)))
920 ;; We say `no-message' here because we don't want the visited file
921 ;; modtime data to be clobbered from the temp file. We call
922 ;; `set-visited-file-modtime' ourselves later on.
923 (tramp-run-real-handler
924 'write-region
925 (if confirm ; don't pass this arg unless defined for backward compat.
926 (list start end tmpfile append 'no-message lockname confirm)
927 (list start end tmpfile append 'no-message lockname)))
929 (with-progress-reporter
930 v 3 (format "Moving tmp file %s to %s" tmpfile filename)
931 (unwind-protect
932 (unless (tramp-smb-send-command
933 v (format "put %s \"%s\""
934 tmpfile (tramp-smb-get-localname v)))
935 (tramp-error v 'file-error "Cannot write `%s'" filename))
936 (delete-file tmpfile)))
938 (unless (equal curbuf (current-buffer))
939 (tramp-error
940 v 'file-error
941 "Buffer has changed from `%s' to `%s'" curbuf (current-buffer)))
942 (when (eq visit t)
943 (set-visited-file-modtime)))))
946 ;; Internal file name functions.
948 (defun tramp-smb-get-share (vec)
949 "Returns the share name of LOCALNAME."
950 (save-match-data
951 (let ((localname (tramp-file-name-localname vec)))
952 (when (string-match "^/?\\([^/]+\\)/" localname)
953 (match-string 1 localname)))))
955 (defun tramp-smb-get-localname (vec)
956 "Returns the file name of LOCALNAME.
957 If VEC has no cifs capabilities, exchange \"/\" by \"\\\\\"."
958 (save-match-data
959 (let ((localname (tramp-file-name-localname vec)))
960 (setq
961 localname
962 (if (string-match "^/?[^/]+\\(/.*\\)" localname)
963 ;; There is a share, sparated by "/".
964 (if (not (tramp-smb-get-cifs-capabilities vec))
965 (mapconcat
966 (lambda (x) (if (equal x ?/) "\\" (char-to-string x)))
967 (match-string 1 localname) "")
968 (match-string 1 localname))
969 ;; There is just a share.
970 (if (string-match "^/?\\([^/]+\\)$" localname)
971 (match-string 1 localname)
972 "")))
974 ;; Sometimes we have discarded `substitute-in-file-name'.
975 (when (string-match "\\(\\$\\$\\)\\(/\\|$\\)" localname)
976 (setq localname (replace-match "$" nil nil localname 1)))
978 localname)))
980 ;; Share names of a host are cached. It is very unlikely that the
981 ;; shares do change during connection.
982 (defun tramp-smb-get-file-entries (directory)
983 "Read entries which match DIRECTORY.
984 Either the shares are listed, or the `dir' command is executed.
985 Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)."
986 (with-parsed-tramp-file-name (file-name-as-directory directory) nil
987 (setq localname (or localname "/"))
988 (with-file-property v localname "file-entries"
989 (with-current-buffer (tramp-get-buffer v)
990 (let* ((share (tramp-smb-get-share v))
991 (cache (tramp-get-connection-property v "share-cache" nil))
992 res entry)
994 (if (and (not share) cache)
995 ;; Return cached shares.
996 (setq res cache)
998 ;; Read entries.
999 (if share
1000 (tramp-smb-send-command
1001 v (format "dir \"%s*\"" (tramp-smb-get-localname v)))
1002 ;; `tramp-smb-maybe-open-connection' lists also the share names.
1003 (tramp-smb-maybe-open-connection v))
1005 ;; Loop the listing.
1006 (goto-char (point-min))
1007 (if (re-search-forward tramp-smb-errors nil t)
1008 (tramp-error v 'file-error "%s `%s'" (match-string 0) directory)
1009 (while (not (eobp))
1010 (setq entry (tramp-smb-read-file-entry share))
1011 (forward-line)
1012 (when entry (add-to-list 'res entry))))
1014 ;; Cache share entries.
1015 (unless share
1016 (tramp-set-connection-property v "share-cache" res)))
1018 ;; Add directory itself.
1019 (add-to-list 'res '("" "drwxrwxrwx" 0 (0 0)))
1021 ;; There's a very strange error (debugged with XEmacs 21.4.14)
1022 ;; If there's no short delay, it returns nil. No idea about.
1023 (when (featurep 'xemacs) (sleep-for 0.01))
1025 ;; Return entries.
1026 (delq nil res))))))
1028 ;; Return either a share name (if SHARE is nil), or a file name.
1030 ;; If shares are listed, the following format is expected:
1032 ;; Disk| - leading spaces
1033 ;; [^|]+| - share name, 14 char
1034 ;; .* - comment
1036 ;; Entries provided by smbclient DIR aren't fully regular.
1037 ;; They should have the format
1039 ;; \s-\{2,2} - leading spaces
1040 ;; \S-\(.*\S-\)\s-* - file name, 30 chars, left bound
1041 ;; \s-+[ADHRSV]* - permissions, 7 chars, right bound
1042 ;; \s- - space delimiter
1043 ;; \s-+[0-9]+ - size, 8 chars, right bound
1044 ;; \s-\{2,2\} - space delimiter
1045 ;; \w\{3,3\} - weekday
1046 ;; \s- - space delimiter
1047 ;; \w\{3,3\} - month
1048 ;; \s- - space delimiter
1049 ;; [ 12][0-9] - day
1050 ;; \s- - space delimiter
1051 ;; [0-9]\{2,2\}:[0-9]\{2,2\}:[0-9]\{2,2\} - time
1052 ;; \s- - space delimiter
1053 ;; [0-9]\{4,4\} - year
1055 ;; samba/src/client.c (http://samba.org/doxygen/samba/client_8c-source.html)
1056 ;; has function display_finfo:
1058 ;; d_printf(" %-30s%7.7s %8.0f %s",
1059 ;; finfo->name,
1060 ;; attrib_string(finfo->mode),
1061 ;; (double)finfo->size,
1062 ;; asctime(LocalTime(&t)));
1064 ;; in Samba 1.9, there's the following code:
1066 ;; DEBUG(0,(" %-30s%7.7s%10d %s",
1067 ;; CNV_LANG(finfo->name),
1068 ;; attrib_string(finfo->mode),
1069 ;; finfo->size,
1070 ;; asctime(LocalTime(&t))));
1072 ;; Problems:
1073 ;; * Modern regexp constructs, like spy groups and counted repetitions, aren't
1074 ;; available in older Emacsen.
1075 ;; * The length of constructs (file name, size) might exceed the default.
1076 ;; * File names might contain spaces.
1077 ;; * Permissions might be empty.
1079 ;; So we try to analyze backwards.
1080 (defun tramp-smb-read-file-entry (share)
1081 "Parse entry in SMB output buffer.
1082 If SHARE is result, entries are of type dir. Otherwise, shares are listed.
1083 Result is the list (LOCALNAME MODE SIZE MTIME)."
1084 ;; We are called from `tramp-smb-get-file-entries', which sets the
1085 ;; current buffer.
1086 (let ((line (buffer-substring (point) (point-at-eol)))
1087 localname mode size month day hour min sec year mtime)
1089 (if (not share)
1091 ;; Read share entries.
1092 (when (string-match "^Disk|\\([^|]+\\)|" line)
1093 (setq localname (match-string 1 line)
1094 mode "dr-xr-xr-x"
1095 size 0))
1097 ;; Real listing.
1098 (block nil
1100 ;; year.
1101 (if (string-match "\\([0-9]+\\)$" line)
1102 (setq year (string-to-number (match-string 1 line))
1103 line (substring line 0 -5))
1104 (return))
1106 ;; time.
1107 (if (string-match "\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)$" line)
1108 (setq hour (string-to-number (match-string 1 line))
1109 min (string-to-number (match-string 2 line))
1110 sec (string-to-number (match-string 3 line))
1111 line (substring line 0 -9))
1112 (return))
1114 ;; day.
1115 (if (string-match "\\([0-9]+\\)$" line)
1116 (setq day (string-to-number (match-string 1 line))
1117 line (substring line 0 -3))
1118 (return))
1120 ;; month.
1121 (if (string-match "\\(\\w+\\)$" line)
1122 (setq month (match-string 1 line)
1123 line (substring line 0 -4))
1124 (return))
1126 ;; weekday.
1127 (if (string-match "\\(\\w+\\)$" line)
1128 (setq line (substring line 0 -5))
1129 (return))
1131 ;; size.
1132 (if (string-match "\\([0-9]+\\)$" line)
1133 (let ((length (- (max 10 (1+ (length (match-string 1 line)))))))
1134 (setq size (string-to-number (match-string 1 line)))
1135 (when (string-match "\\([ADHRSV]+\\)" (substring line length))
1136 (setq length (+ length (match-end 0))))
1137 (setq line (substring line 0 length)))
1138 (return))
1140 ;; mode: ARCH, DIR, HIDDEN, RONLY, SYSTEM, VOLID.
1141 (if (string-match "\\([ADHRSV]+\\)?$" line)
1142 (setq
1143 mode (or (match-string 1 line) "")
1144 mode (save-match-data (format
1145 "%s%s"
1146 (if (string-match "D" mode) "d" "-")
1147 (mapconcat
1148 (lambda (x) "") " "
1149 (concat "r" (if (string-match "R" mode) "-" "w") "x"))))
1150 line (substring line 0 -6))
1151 (return))
1153 ;; localname.
1154 (if (string-match "^\\s-+\\(\\S-\\(.*\\S-\\)?\\)\\s-*$" line)
1155 (setq localname (match-string 1 line))
1156 (return))))
1158 (when (and localname mode size)
1159 (setq mtime
1160 (if (and sec min hour day month year)
1161 (encode-time
1162 sec min hour day
1163 (cdr (assoc (downcase month) tramp-parse-time-months))
1164 year)
1165 '(0 0)))
1166 (list localname mode size mtime))))
1168 (defun tramp-smb-get-cifs-capabilities (vec)
1169 "Check, whether the SMB server supports POSIX commands."
1170 ;; When we are not logged in yet, we return nil.
1171 (if (let ((p (tramp-get-connection-process vec)))
1172 (and p (processp p) (memq (process-status p) '(run open))))
1173 (with-connection-property
1174 (tramp-get-connection-process vec) "cifs-capabilities"
1175 (save-match-data
1176 (when (tramp-smb-send-command vec "posix")
1177 (with-current-buffer (tramp-get-buffer vec)
1178 (goto-char (point-min))
1179 (when
1180 (re-search-forward "Server supports CIFS capabilities" nil t)
1181 (member
1182 "pathnames"
1183 (split-string
1184 (buffer-substring (point) (point-at-eol)) nil t)))))))))
1186 (defun tramp-smb-get-stat-capability (vec)
1187 "Check, whether the SMB server supports the STAT command."
1188 ;; When we are not logged in yet, we return nil.
1189 (if (let ((p (tramp-get-connection-process vec)))
1190 (and p (processp p) (memq (process-status p) '(run open))))
1191 (with-connection-property
1192 (tramp-get-connection-process vec) "stat-capability"
1193 (tramp-smb-send-command vec "stat ."))))
1196 ;; Connection functions.
1198 (defun tramp-smb-send-command (vec command)
1199 "Send the COMMAND to connection VEC.
1200 Returns nil if there has been an error message from smbclient."
1201 (tramp-smb-maybe-open-connection vec)
1202 (tramp-message vec 6 "%s" command)
1203 (tramp-send-string vec command)
1204 (tramp-smb-wait-for-output vec))
1206 (defun tramp-smb-maybe-open-connection (vec)
1207 "Maybe open a connection to HOST, log in as USER, using `tramp-smb-program'.
1208 Does not do anything if a connection is already open, but re-opens the
1209 connection if a previous connection has died for some reason."
1210 (let* ((share (tramp-smb-get-share vec))
1211 (buf (tramp-get-buffer vec))
1212 (p (get-buffer-process buf)))
1214 ;; Check whether we still have the same smbclient version.
1215 ;; Otherwise, we must delete the connection cache, because
1216 ;; capabilities migh have changed.
1217 (unless (processp p)
1218 (let ((default-directory (tramp-compat-temporary-file-directory))
1219 (command (concat tramp-smb-program " -V")))
1221 (unless tramp-smb-version
1222 (unless (executable-find tramp-smb-program)
1223 (tramp-error
1224 vec 'file-error
1225 "Cannot find command %s in %s" tramp-smb-program exec-path))
1226 (setq tramp-smb-version (shell-command-to-string command))
1227 (tramp-message vec 6 command)
1228 (tramp-message vec 6 "\n%s" tramp-smb-version)
1229 (if (string-match "[ \t\n\r]+\\'" tramp-smb-version)
1230 (setq tramp-smb-version
1231 (replace-match "" nil nil tramp-smb-version))))
1233 (unless (string-equal
1234 tramp-smb-version
1235 (tramp-get-connection-property
1236 vec "smbclient-version" tramp-smb-version))
1237 (tramp-flush-directory-property vec "")
1238 (tramp-flush-connection-property vec))
1240 (tramp-set-connection-property
1241 vec "smbclient-version" tramp-smb-version)))
1243 ;; If too much time has passed since last command was sent, look
1244 ;; whether there has been an error message; maybe due to
1245 ;; connection timeout.
1246 (with-current-buffer buf
1247 (goto-char (point-min))
1248 (when (and (> (tramp-time-diff
1249 (current-time)
1250 (tramp-get-connection-property
1251 p "last-cmd-time" '(0 0 0)))
1253 p (processp p) (memq (process-status p) '(run open))
1254 (re-search-forward tramp-smb-errors nil t))
1255 (delete-process p)
1256 (setq p nil)))
1258 ;; Check whether it is still the same share.
1259 (unless
1260 (and p (processp p) (memq (process-status p) '(run open))
1261 (string-equal
1262 share
1263 (tramp-get-connection-property p "smb-share" "")))
1265 (save-match-data
1266 ;; There might be unread output from checking for share names.
1267 (when buf (with-current-buffer buf (erase-buffer)))
1268 (when (and p (processp p)) (delete-process p))
1270 (let* ((user (tramp-file-name-user vec))
1271 (host (tramp-file-name-host vec))
1272 (real-user (tramp-file-name-real-user vec))
1273 (real-host (tramp-file-name-real-host vec))
1274 (domain (tramp-file-name-domain vec))
1275 (port (tramp-file-name-port vec))
1276 args)
1278 (if share
1279 (setq args (list (concat "//" real-host "/" share)))
1280 (setq args (list "-g" "-L" real-host )))
1282 (if (not (zerop (length real-user)))
1283 (setq args (append args (list "-U" real-user)))
1284 (setq args (append args (list "-N"))))
1286 (when domain (setq args (append args (list "-W" domain))))
1287 (when port (setq args (append args (list "-p" port))))
1288 (when tramp-smb-conf
1289 (setq args (append args (list "-s" tramp-smb-conf))))
1291 ;; OK, let's go.
1292 (with-progress-reporter
1293 vec 3
1294 (format "Opening connection for //%s%s/%s"
1295 (if (not (zerop (length user))) (concat user "@") "")
1296 host (or share ""))
1298 (let* ((coding-system-for-read nil)
1299 (process-connection-type tramp-process-connection-type)
1300 (p (let ((default-directory
1301 (tramp-compat-temporary-file-directory)))
1302 (apply #'start-process
1303 (tramp-buffer-name vec) (tramp-get-buffer vec)
1304 tramp-smb-program args))))
1306 (tramp-message
1307 vec 6 "%s" (mapconcat 'identity (process-command p) " "))
1308 (tramp-compat-set-process-query-on-exit-flag p nil)
1310 ;; Set variables for computing the prompt for reading password.
1311 (setq tramp-current-method tramp-smb-method
1312 tramp-current-user user
1313 tramp-current-host host)
1315 ;; Play login scenario.
1316 (tramp-process-actions
1317 p vec nil
1318 (if share
1319 tramp-smb-actions-with-share
1320 tramp-smb-actions-without-share))
1322 ;; Check server version.
1323 (with-current-buffer (tramp-get-connection-buffer vec)
1324 (goto-char (point-min))
1325 (search-forward-regexp
1326 "Domain=\\[[^]]*\\] OS=\\[[^]]*\\] Server=\\[[^]]*\\]" nil t)
1327 (let ((smbserver-version (match-string 0)))
1328 (unless
1329 (string-equal
1330 smbserver-version
1331 (tramp-get-connection-property
1332 vec "smbserver-version" smbserver-version))
1333 (tramp-flush-directory-property vec "")
1334 (tramp-flush-connection-property vec))
1335 (tramp-set-connection-property
1336 vec "smbserver-version" smbserver-version)))
1338 ;; Set chunksize. Otherwise, `tramp-send-string' might
1339 ;; try it itself.
1340 (tramp-set-connection-property p "smb-share" share)
1341 (tramp-set-connection-property
1342 p "chunksize" tramp-chunksize))))))))
1344 ;; We don't use timeouts. If needed, the caller shall wrap around.
1345 (defun tramp-smb-wait-for-output (vec)
1346 "Wait for output from smbclient command.
1347 Returns nil if an error message has appeared."
1348 (with-current-buffer (tramp-get-buffer vec)
1349 (let ((p (get-buffer-process (current-buffer)))
1350 (found (progn (goto-char (point-min))
1351 (re-search-forward tramp-smb-prompt nil t)))
1352 (err (progn (goto-char (point-min))
1353 (re-search-forward tramp-smb-errors nil t))))
1355 ;; Algorithm: get waiting output. See if last line contains
1356 ;; tramp-smb-prompt sentinel or tramp-smb-errors strings.
1357 ;; If not, wait a bit and again get waiting output.
1358 (while (and (not found) (not err))
1360 ;; Accept pending output.
1361 (tramp-accept-process-output p)
1363 ;; Search for prompt.
1364 (goto-char (point-min))
1365 (setq found (re-search-forward tramp-smb-prompt nil t))
1367 ;; Search for errors.
1368 (goto-char (point-min))
1369 (setq err (re-search-forward tramp-smb-errors nil t)))
1371 ;; When the process is still alive, read pending output.
1372 (while (and (not found) (memq (process-status p) '(run open)))
1374 ;; Accept pending output.
1375 (tramp-accept-process-output p)
1377 ;; Search for prompt.
1378 (goto-char (point-min))
1379 (setq found (re-search-forward tramp-smb-prompt nil t)))
1381 ;; Return value is whether no error message has appeared.
1382 (tramp-message vec 6 "\n%s" (buffer-string))
1383 (not err))))
1385 (add-hook 'tramp-unload-hook
1386 (lambda ()
1387 (unload-feature 'tramp-smb 'force)))
1389 (provide 'tramp-smb)
1391 ;;; TODO:
1393 ;; * Error handling in case password is wrong.
1394 ;; * Read password from "~/.netrc".
1395 ;; * Return more comprehensive file permission string.
1396 ;; * Try to remove the inclusion of dummy "" directory. Seems to be at
1397 ;; several places, especially in `tramp-smb-handle-insert-directory'.
1398 ;; * (RMS) Use unwind-protect to clean up the state so as to make the state
1399 ;; regular again.
1400 ;; * Make it multi-hop capable.
1402 ;;; tramp-smb.el ends here