Minor NEWS fix.
[emacs.git] / lisp / net / tramp-smb.el
blobe48a8b321fd20427ababcc8ada61e0f09d3d84c4
1 ;;; tramp-smb.el --- Tramp access functions for SMB servers
3 ;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008,
4 ;; 2009, 2010 Free Software Foundation, Inc.
6 ;; Author: Michael Albinus <michael.albinus@gmx.de>
7 ;; Keywords: comm, processes
8 ;; Package: tramp
10 ;; This file is part of GNU Emacs.
12 ;; GNU Emacs is free software: you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation, either version 3 of the License, or
15 ;; (at your option) any later version.
17 ;; GNU Emacs is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
25 ;;; Commentary:
27 ;; Access functions for SMB servers like SAMBA or M$ Windows from Tramp.
29 ;;; Code:
31 (eval-when-compile (require 'cl)) ; block, return
32 (require 'tramp)
34 ;; We call several `tramp-handle-*' functions directly. So we must
35 ;; reqire that package as well.
36 (require 'tramp-sh)
38 ;; Define SMB method ...
39 ;;;###tramp-autoload
40 (defconst tramp-smb-method "smb"
41 "*Method to connect SAMBA and M$ SMB servers.")
43 ;; ... and add it to the method list.
44 ;;;###tramp-autoload
45 (unless (memq system-type '(cygwin windows-nt))
46 (add-to-list 'tramp-methods (cons tramp-smb-method nil)))
48 ;; Add a default for `tramp-default-method-alist'. Rule: If there is
49 ;; a domain in USER, it must be the SMB method.
50 (add-to-list 'tramp-default-method-alist
51 `(nil ,tramp-prefix-domain-regexp ,tramp-smb-method))
53 ;; Add a default for `tramp-default-user-alist'. Rule: For the SMB method,
54 ;; the anonymous user is chosen.
55 (add-to-list 'tramp-default-user-alist
56 `(,tramp-smb-method nil ""))
58 ;; Add completion function for SMB method.
59 (tramp-set-completion-function
60 tramp-smb-method
61 '((tramp-parse-netrc "~/.netrc")))
63 (defcustom tramp-smb-program "smbclient"
64 "*Name of SMB client to run."
65 :group 'tramp
66 :type 'string)
68 (defcustom tramp-smb-conf "/dev/null"
69 "*Path of the smb.conf file.
70 If it is nil, no smb.conf will be added to the `tramp-smb-program'
71 call, letting the SMB client use the default one."
72 :group 'tramp
73 :type '(choice (const nil) (file :must-match t)))
75 (defvar tramp-smb-version nil
76 "*Version string of the SMB client.")
78 (defconst tramp-smb-prompt "^smb: .+> \\|^\\s-+Server\\s-+Comment$"
79 "Regexp used as prompt in smbclient.")
81 (defconst tramp-smb-errors
82 ;; `regexp-opt' not possible because of first string.
83 (mapconcat
84 'identity
85 '(;; Connection error / timeout / unknown command.
86 "Connection to \\S-+ failed"
87 "Read from server failed, maybe it closed the connection"
88 "Call timed out: server did not respond"
89 "\\S-+: command not found"
90 "Server doesn't support UNIX CIFS calls"
91 ;; Samba.
92 "ERRDOS"
93 "ERRHRD"
94 "ERRSRV"
95 "ERRbadfile"
96 "ERRbadpw"
97 "ERRfilexists"
98 "ERRnoaccess"
99 "ERRnomem"
100 "ERRnosuchshare"
101 ;; Windows 4.0 (Windows NT), Windows 5.0 (Windows 2000),
102 ;; Windows 5.1 (Windows XP), Windows 5.2 (Windows Server 2003).
103 "NT_STATUS_ACCESS_DENIED"
104 "NT_STATUS_ACCOUNT_LOCKED_OUT"
105 "NT_STATUS_BAD_NETWORK_NAME"
106 "NT_STATUS_CANNOT_DELETE"
107 "NT_STATUS_CONNECTION_REFUSED"
108 "NT_STATUS_DIRECTORY_NOT_EMPTY"
109 "NT_STATUS_DUPLICATE_NAME"
110 "NT_STATUS_FILE_IS_A_DIRECTORY"
111 "NT_STATUS_LOGON_FAILURE"
112 "NT_STATUS_NETWORK_ACCESS_DENIED"
113 "NT_STATUS_NOT_IMPLEMENTED"
114 "NT_STATUS_NO_SUCH_FILE"
115 "NT_STATUS_OBJECT_NAME_COLLISION"
116 "NT_STATUS_OBJECT_NAME_INVALID"
117 "NT_STATUS_OBJECT_NAME_NOT_FOUND"
118 "NT_STATUS_SHARING_VIOLATION"
119 "NT_STATUS_TRUSTED_RELATIONSHIP_FAILURE"
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-smb-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-smb-handle-file-exists-p)
169 (file-exists-p . tramp-smb-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-smb-handle-file-newer-than-file-p)
179 (file-ownership-preserved-p . ignore)
180 (file-readable-p . tramp-smb-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 is 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-directory-files-and-attributes
459 (directory &optional full match nosort id-format)
460 "Like `directory-files-and-attributes' for Tramp files."
461 (mapcar
462 (lambda (x)
463 (cons x (tramp-compat-file-attributes
464 (if full x (expand-file-name x directory)) id-format)))
465 (directory-files directory full match nosort)))
467 (defun tramp-smb-handle-expand-file-name (name &optional dir)
468 "Like `expand-file-name' for Tramp files."
469 ;; If DIR is not given, use DEFAULT-DIRECTORY or "/".
470 (setq dir (or dir default-directory "/"))
471 ;; Unless NAME is absolute, concat DIR and NAME.
472 (unless (file-name-absolute-p name)
473 (setq name (concat (file-name-as-directory dir) name)))
474 ;; If NAME is not a Tramp file, run the real handler.
475 (if (not (tramp-tramp-file-p name))
476 (tramp-run-real-handler 'expand-file-name (list name nil))
477 ;; Dissect NAME.
478 (with-parsed-tramp-file-name name nil
479 ;; Tilde expansion if necessary. We use the user name as share,
480 ;; which is offen the case in domains.
481 (when (string-match "\\`/?~\\([^/]*\\)" localname)
482 (setq localname
483 (replace-match
484 (if (zerop (length (match-string 1 localname)))
485 (tramp-file-name-real-user v)
486 (match-string 1 localname))
487 nil nil localname)))
488 ;; Make the file name absolute.
489 (unless (tramp-run-real-handler 'file-name-absolute-p (list localname))
490 (setq localname (concat "/" localname)))
491 ;; No tilde characters in file name, do normal
492 ;; `expand-file-name' (this does "/./" and "/../").
493 (tramp-make-tramp-file-name
494 method user host
495 (tramp-run-real-handler 'expand-file-name (list localname))))))
497 (defun tramp-smb-handle-file-attributes (filename &optional id-format)
498 "Like `file-attributes' for Tramp files."
499 (unless id-format (setq id-format 'integer))
500 (with-parsed-tramp-file-name filename nil
501 (with-file-property v localname (format "file-attributes-%s" id-format)
502 (if (and (tramp-smb-get-share v) (tramp-smb-get-stat-capability v))
503 (tramp-smb-do-file-attributes-with-stat v id-format)
504 ;; Reading just the filename entry via "dir localname" is not
505 ;; possible, because when filename is a directory, some
506 ;; smbclient versions return the content of the directory, and
507 ;; other versions don't. Therefore, the whole content of the
508 ;; upper directory is retrieved, and the entry of the filename
509 ;; is extracted from.
510 (let* ((entries (tramp-smb-get-file-entries
511 (file-name-directory filename)))
512 (entry (assoc (file-name-nondirectory filename) entries))
513 (uid (if (equal id-format 'string) "nobody" -1))
514 (gid (if (equal id-format 'string) "nogroup" -1))
515 (inode (tramp-get-inode v))
516 (device (tramp-get-device v)))
518 ;; Check result.
519 (when entry
520 (list (and (string-match "d" (nth 1 entry))
521 t) ;0 file type
522 -1 ;1 link count
523 uid ;2 uid
524 gid ;3 gid
525 '(0 0) ;4 atime
526 (nth 3 entry) ;5 mtime
527 '(0 0) ;6 ctime
528 (nth 2 entry) ;7 size
529 (nth 1 entry) ;8 mode
530 nil ;9 gid weird
531 inode ;10 inode number
532 device))))))) ;11 file system number
534 (defun tramp-smb-do-file-attributes-with-stat (vec &optional id-format)
535 "Implement `file-attributes' for Tramp files using stat command."
536 (tramp-message
537 vec 5 "file attributes with stat: %s" (tramp-file-name-localname vec))
538 (with-current-buffer (tramp-get-buffer vec)
539 (let* (size id link uid gid atime mtime ctime mode inode)
540 (when (tramp-smb-send-command
541 vec (format "stat \"%s\"" (tramp-smb-get-localname vec)))
543 ;; Loop the listing.
544 (goto-char (point-min))
545 (unless (re-search-forward tramp-smb-errors nil t)
546 (while (not (eobp))
547 (cond
548 ((looking-at
549 "Size:\\s-+\\([0-9]+\\)\\s-+Blocks:\\s-+[0-9]+\\s-+\\(\\w+\\)")
550 (setq size (string-to-number (match-string 1))
551 id (if (string-equal "directory" (match-string 2)) t
552 (if (string-equal "symbolic" (match-string 2)) ""))))
553 ((looking-at
554 "Inode:\\s-+\\([0-9]+\\)\\s-+Links:\\s-+\\([0-9]+\\)")
555 (setq inode (string-to-number (match-string 1))
556 link (string-to-number (match-string 2))))
557 ((looking-at
558 "Access:\\s-+([0-9]+/\\(\\S-+\\))\\s-+Uid:\\s-+\\([0-9]+\\)\\s-+Gid:\\s-+\\([0-9]+\\)")
559 (setq mode (match-string 1)
560 uid (if (equal id-format 'string) (match-string 2)
561 (string-to-number (match-string 2)))
562 gid (if (equal id-format 'string) (match-string 3)
563 (string-to-number (match-string 3)))))
564 ((looking-at
565 "Access:\\s-+\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)\\s-+\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)")
566 (setq atime
567 (encode-time
568 (string-to-number (match-string 6)) ;; sec
569 (string-to-number (match-string 5)) ;; min
570 (string-to-number (match-string 4)) ;; hour
571 (string-to-number (match-string 3)) ;; day
572 (string-to-number (match-string 2)) ;; month
573 (string-to-number (match-string 1))))) ;; year
574 ((looking-at
575 "Modify:\\s-+\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)\\s-+\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)")
576 (setq mtime
577 (encode-time
578 (string-to-number (match-string 6)) ;; sec
579 (string-to-number (match-string 5)) ;; min
580 (string-to-number (match-string 4)) ;; hour
581 (string-to-number (match-string 3)) ;; day
582 (string-to-number (match-string 2)) ;; month
583 (string-to-number (match-string 1))))) ;; year
584 ((looking-at
585 "Change:\\s-+\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)\\s-+\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)")
586 (setq ctime
587 (encode-time
588 (string-to-number (match-string 6)) ;; sec
589 (string-to-number (match-string 5)) ;; min
590 (string-to-number (match-string 4)) ;; hour
591 (string-to-number (match-string 3)) ;; day
592 (string-to-number (match-string 2)) ;; month
593 (string-to-number (match-string 1)))))) ;; year
594 (forward-line))
595 ;; Return the result.
596 (list id link uid gid atime mtime ctime size mode nil inode
597 (tramp-get-device vec)))))))
599 (defun tramp-smb-handle-file-directory-p (filename)
600 "Like `file-directory-p' for Tramp files."
601 (and (file-exists-p filename)
602 (eq ?d (aref (nth 8 (file-attributes filename)) 0))))
604 (defun tramp-smb-handle-file-exists-p (filename)
605 "Like `file-exists-p' for Tramp files."
606 (not (null (file-attributes filename))))
608 (defun tramp-smb-handle-file-local-copy (filename)
609 "Like `file-local-copy' for Tramp files."
610 (with-parsed-tramp-file-name filename nil
611 (unless (file-exists-p filename)
612 (tramp-error
613 v 'file-error
614 "Cannot make local copy of non-existing file `%s'" filename))
615 (let ((tmpfile (tramp-compat-make-temp-file filename)))
616 (with-progress-reporter
617 v 3 (format "Fetching %s to tmp file %s" filename tmpfile)
618 (unless (tramp-smb-send-command
619 v (format "get \"%s\" \"%s\""
620 (tramp-smb-get-localname v) tmpfile))
621 ;; Oops, an error. We shall cleanup.
622 (delete-file tmpfile)
623 (tramp-error
624 v 'file-error "Cannot make local copy of file `%s'" filename)))
625 tmpfile)))
627 ;; This function should return "foo/" for directories and "bar" for
628 ;; files.
629 (defun tramp-smb-handle-file-name-all-completions (filename directory)
630 "Like `file-name-all-completions' for Tramp files."
631 (all-completions
632 filename
633 (with-parsed-tramp-file-name directory nil
634 (with-file-property v localname "file-name-all-completions"
635 (save-match-data
636 (let ((entries (tramp-smb-get-file-entries directory)))
637 (mapcar
638 (lambda (x)
639 (list
640 (if (string-match "d" (nth 1 x))
641 (file-name-as-directory (nth 0 x))
642 (nth 0 x))))
643 entries)))))))
645 (defun tramp-smb-handle-file-newer-than-file-p (file1 file2)
646 "Like `file-newer-than-file-p' for Tramp files."
647 (cond
648 ((not (file-exists-p file1)) nil)
649 ((not (file-exists-p file2)) t)
650 (t (tramp-time-less-p (nth 5 (file-attributes file2))
651 (nth 5 (file-attributes file1))))))
653 (defun tramp-smb-handle-file-writable-p (filename)
654 "Like `file-writable-p' for Tramp files."
655 (if (file-exists-p filename)
656 (string-match "w" (or (nth 8 (file-attributes filename)) ""))
657 (let ((dir (file-name-directory filename)))
658 (and (file-exists-p dir)
659 (file-writable-p dir)))))
661 (defun tramp-smb-handle-insert-directory
662 (filename switches &optional wildcard full-directory-p)
663 "Like `insert-directory' for Tramp files."
664 (setq filename (expand-file-name filename))
665 (if full-directory-p
666 ;; Called from `dired-add-entry'.
667 (setq filename (file-name-as-directory filename))
668 (setq filename (directory-file-name filename)))
669 (with-parsed-tramp-file-name filename nil
670 (save-match-data
671 (let ((base (file-name-nondirectory filename))
672 ;; We should not destroy the cache entry.
673 (entries (copy-sequence
674 (tramp-smb-get-file-entries
675 (file-name-directory filename)))))
677 (when wildcard
678 (string-match "\\." base)
679 (setq base (replace-match "\\\\." nil nil base))
680 (string-match "\\*" base)
681 (setq base (replace-match ".*" nil nil base))
682 (string-match "\\?" base)
683 (setq base (replace-match ".?" nil nil base)))
685 ;; Filter entries.
686 (setq entries
687 (delq
689 (if (or wildcard (zerop (length base)))
690 ;; Check for matching entries.
691 (mapcar
692 (lambda (x)
693 (when (string-match
694 (format "^%s" base) (nth 0 x))
696 entries)
697 ;; We just need the only and only entry FILENAME.
698 (list (assoc base entries)))))
700 ;; Sort entries.
701 (setq entries
702 (sort
703 entries
704 (lambda (x y)
705 (if (string-match "t" switches)
706 ;; Sort by date.
707 (tramp-time-less-p (nth 3 y) (nth 3 x))
708 ;; Sort by name.
709 (string-lessp (nth 0 x) (nth 0 y))))))
711 ;; Handle "-F" switch.
712 (when (string-match "F" switches)
713 (mapc
714 (lambda (x)
715 (when (not (zerop (length (car x))))
716 (cond
717 ((char-equal ?d (string-to-char (nth 1 x)))
718 (setcar x (concat (car x) "/")))
719 ((char-equal ?x (string-to-char (nth 1 x)))
720 (setcar x (concat (car x) "*"))))))
721 entries))
723 ;; Print entries.
724 (mapc
725 (lambda (x)
726 (when (not (zerop (length (nth 0 x))))
727 (let ((attr
728 (when (tramp-smb-get-stat-capability v)
729 (ignore-errors
730 (file-attributes filename 'string)))))
731 (insert
732 (format
733 "%10s %3d %-8s %-8s %8s %s "
734 (or (nth 8 attr) (nth 1 x)) ; mode
735 (or (nth 1 attr) 1) ; inode
736 (or (nth 2 attr) "nobody") ; uid
737 (or (nth 3 attr) "nogroup") ; gid
738 (or (nth 7 attr) (nth 2 x)) ; size
739 (format-time-string
740 (if (tramp-time-less-p
741 (tramp-time-subtract (current-time) (nth 3 x))
742 tramp-half-a-year)
743 "%b %e %R"
744 "%b %e %Y")
745 (nth 3 x)))) ; date
746 ;; We mark the file name. The inserted name could be
747 ;; from somewhere else, so we use the relative file
748 ;; name of `default-directory'.
749 (let ((start (point)))
750 (insert
751 (format
752 "%s\n"
753 (file-relative-name
754 (expand-file-name
755 (nth 0 x) (file-name-directory filename)))))
756 (put-text-property start (1- (point)) 'dired-filename t))
757 (forward-line)
758 (beginning-of-line))))
759 entries)))))
761 (defun tramp-smb-handle-make-directory (dir &optional parents)
762 "Like `make-directory' for Tramp files."
763 (setq dir (directory-file-name (expand-file-name dir)))
764 (unless (file-name-absolute-p dir)
765 (setq dir (expand-file-name dir default-directory)))
766 (with-parsed-tramp-file-name dir nil
767 (save-match-data
768 (let* ((ldir (file-name-directory dir)))
769 ;; Make missing directory parts.
770 (when (and parents
771 (tramp-smb-get-share v)
772 (not (file-directory-p ldir)))
773 (make-directory ldir parents))
774 ;; Just do it.
775 (when (file-directory-p ldir)
776 (make-directory-internal dir))
777 (unless (file-directory-p dir)
778 (tramp-error v 'file-error "Couldn't make directory %s" dir))))))
780 (defun tramp-smb-handle-make-directory-internal (directory)
781 "Like `make-directory-internal' for Tramp files."
782 (setq directory (directory-file-name (expand-file-name directory)))
783 (unless (file-name-absolute-p directory)
784 (setq directory (expand-file-name directory default-directory)))
785 (with-parsed-tramp-file-name directory nil
786 (save-match-data
787 (let* ((file (tramp-smb-get-localname v)))
788 (when (file-directory-p (file-name-directory directory))
789 (tramp-smb-send-command
791 (if (tramp-smb-get-cifs-capabilities v)
792 (format
793 "posix_mkdir \"%s\" %s"
794 file (tramp-compat-decimal-to-octal (default-file-modes)))
795 (format "mkdir \"%s\"" file)))
796 ;; We must also flush the cache of the directory, because
797 ;; `file-attributes' reads the values from there.
798 (tramp-flush-file-property v (file-name-directory localname))
799 (tramp-flush-file-property v localname))
800 (unless (file-directory-p directory)
801 (tramp-error
802 v 'file-error "Couldn't make directory %s" directory))))))
804 (defun tramp-smb-handle-make-symbolic-link
805 (filename linkname &optional ok-if-already-exists)
806 "Like `make-symbolic-link' for Tramp files.
807 If LINKNAME is a non-Tramp file, it is used verbatim as the target of
808 the symlink. If LINKNAME is a Tramp file, only the localname component is
809 used as the target of the symlink.
811 If LINKNAME is a Tramp file and the localname component is relative, then
812 it is expanded first, before the localname component is taken. Note that
813 this can give surprising results if the user/host for the source and
814 target of the symlink differ."
815 (unless (tramp-equal-remote filename linkname)
816 (with-parsed-tramp-file-name
817 (if (tramp-tramp-file-p filename) filename linkname) nil
818 (tramp-error
819 v 'file-error
820 "make-symbolic-link: %s"
821 "only implemented for same method, same user, same host")))
822 (with-parsed-tramp-file-name filename v1
823 (with-parsed-tramp-file-name linkname v2
824 (when (file-directory-p filename)
825 (tramp-error
826 v2 'file-error
827 "make-symbolic-link: %s must not be a directory" filename))
828 (when (and (not ok-if-already-exists)
829 (file-exists-p linkname)
830 (not (numberp ok-if-already-exists))
831 (y-or-n-p
832 (format
833 "File %s already exists; make it a new name anyway? "
834 linkname)))
835 (tramp-error
836 v2 'file-error
837 "make-symbolic-link: file %s already exists" linkname))
838 (unless (tramp-smb-get-cifs-capabilities v1)
839 (tramp-error v2 'file-error "make-symbolic-link not supported"))
840 ;; We must also flush the cache of the directory, because
841 ;; `file-attributes' reads the values from there.
842 (tramp-flush-file-property v2 (file-name-directory v2-localname))
843 (tramp-flush-file-property v2 v2-localname)
844 (unless
845 (tramp-smb-send-command
847 (format
848 "symlink \"%s\" \"%s\""
849 (tramp-smb-get-localname v1)
850 (tramp-smb-get-localname v2)))
851 (tramp-error
852 v2 'file-error
853 "error with make-symbolic-link, see buffer `%s' for details"
854 (buffer-name))))))
856 (defun tramp-smb-handle-rename-file
857 (filename newname &optional ok-if-already-exists)
858 "Like `rename-file' for Tramp files."
859 (setq filename (expand-file-name filename)
860 newname (expand-file-name newname))
861 (with-progress-reporter
862 (tramp-dissect-file-name (if (file-remote-p filename) filename newname))
863 0 (format "Renaming %s to %s" filename newname)
865 (let ((tmpfile (file-local-copy filename)))
867 (if tmpfile
868 ;; Remote filename.
869 (condition-case err
870 (rename-file tmpfile newname ok-if-already-exists)
871 ((error quit)
872 (delete-file tmpfile)
873 (signal (car err) (cdr err))))
875 ;; Remote newname.
876 (when (file-directory-p newname)
877 (setq newname (expand-file-name
878 (file-name-nondirectory filename) newname)))
880 (with-parsed-tramp-file-name newname nil
881 (when (and (not ok-if-already-exists)
882 (file-exists-p newname))
883 (tramp-error v 'file-already-exists newname))
884 ;; We must also flush the cache of the directory, because
885 ;; `file-attributes' reads the values from there.
886 (tramp-flush-file-property v (file-name-directory localname))
887 (tramp-flush-file-property v localname)
888 (unless (tramp-smb-send-command
889 v (format "put %s \"%s\""
890 filename (tramp-smb-get-localname v)))
891 (tramp-error v 'file-error "Cannot rename `%s'" filename)))))
893 (delete-file filename)))
895 (defun tramp-smb-handle-set-file-modes (filename mode)
896 "Like `set-file-modes' for Tramp files."
897 (with-parsed-tramp-file-name filename nil
898 (when (tramp-smb-get-cifs-capabilities v)
899 (tramp-flush-file-property v localname)
900 (unless (tramp-smb-send-command
901 v (format "chmod \"%s\" %s"
902 (tramp-smb-get-localname v)
903 (tramp-compat-decimal-to-octal mode)))
904 (tramp-error
905 v 'file-error "Error while changing file's mode %s" filename)))))
907 (defun tramp-smb-handle-substitute-in-file-name (filename)
908 "Like `handle-substitute-in-file-name' for Tramp files.
909 \"//\" substitutes only in the local filename part. Catches
910 errors for shares like \"C$/\", which are common in Microsoft Windows."
911 (with-parsed-tramp-file-name filename nil
912 ;; Ignore in LOCALNAME everything before "//".
913 (when (and (stringp localname) (string-match ".+?/\\(/\\|~\\)" localname))
914 (setq filename
915 (concat (file-remote-p filename)
916 (replace-match "\\1" nil nil localname)))))
917 (condition-case nil
918 (tramp-run-real-handler 'substitute-in-file-name (list filename))
919 (error filename)))
921 (defun tramp-smb-handle-write-region
922 (start end filename &optional append visit lockname confirm)
923 "Like `write-region' for Tramp files."
924 (setq filename (expand-file-name filename))
925 (with-parsed-tramp-file-name filename nil
926 (unless (eq append nil)
927 (tramp-error
928 v 'file-error "Cannot append to file using Tramp (`%s')" filename))
929 ;; XEmacs takes a coding system as the seventh argument, not `confirm'.
930 (when (and (not (featurep 'xemacs))
931 confirm (file-exists-p filename))
932 (unless (y-or-n-p (format "File %s exists; overwrite anyway? "
933 filename))
934 (tramp-error v 'file-error "File not overwritten")))
935 ;; We must also flush the cache of the directory, because
936 ;; `file-attributes' reads the values from there.
937 (tramp-flush-file-property v (file-name-directory localname))
938 (tramp-flush-file-property v localname)
939 (let ((curbuf (current-buffer))
940 (tmpfile (tramp-compat-make-temp-file filename)))
941 ;; We say `no-message' here because we don't want the visited file
942 ;; modtime data to be clobbered from the temp file. We call
943 ;; `set-visited-file-modtime' ourselves later on.
944 (tramp-run-real-handler
945 'write-region
946 (if confirm ; don't pass this arg unless defined for backward compat.
947 (list start end tmpfile append 'no-message lockname confirm)
948 (list start end tmpfile append 'no-message lockname)))
950 (with-progress-reporter
951 v 3 (format "Moving tmp file %s to %s" tmpfile filename)
952 (unwind-protect
953 (unless (tramp-smb-send-command
954 v (format "put %s \"%s\""
955 tmpfile (tramp-smb-get-localname v)))
956 (tramp-error v 'file-error "Cannot write `%s'" filename))
957 (delete-file tmpfile)))
959 (unless (equal curbuf (current-buffer))
960 (tramp-error
961 v 'file-error
962 "Buffer has changed from `%s' to `%s'" curbuf (current-buffer)))
963 (when (eq visit t)
964 (set-visited-file-modtime)))))
967 ;; Internal file name functions.
969 (defun tramp-smb-get-share (vec)
970 "Returns the share name of LOCALNAME."
971 (save-match-data
972 (let ((localname (tramp-file-name-localname vec)))
973 (when (string-match "^/?\\([^/]+\\)/" localname)
974 (match-string 1 localname)))))
976 (defun tramp-smb-get-localname (vec)
977 "Returns the file name of LOCALNAME.
978 If VEC has no cifs capabilities, exchange \"/\" by \"\\\\\"."
979 (save-match-data
980 (let ((localname (tramp-file-name-localname vec)))
981 (setq
982 localname
983 (if (string-match "^/?[^/]+\\(/.*\\)" localname)
984 ;; There is a share, sparated by "/".
985 (if (not (tramp-smb-get-cifs-capabilities vec))
986 (mapconcat
987 (lambda (x) (if (equal x ?/) "\\" (char-to-string x)))
988 (match-string 1 localname) "")
989 (match-string 1 localname))
990 ;; There is just a share.
991 (if (string-match "^/?\\([^/]+\\)$" localname)
992 (match-string 1 localname)
993 "")))
995 ;; Sometimes we have discarded `substitute-in-file-name'.
996 (when (string-match "\\(\\$\\$\\)\\(/\\|$\\)" localname)
997 (setq localname (replace-match "$" nil nil localname 1)))
999 localname)))
1001 ;; Share names of a host are cached. It is very unlikely that the
1002 ;; shares do change during connection.
1003 (defun tramp-smb-get-file-entries (directory)
1004 "Read entries which match DIRECTORY.
1005 Either the shares are listed, or the `dir' command is executed.
1006 Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)."
1007 (with-parsed-tramp-file-name (file-name-as-directory directory) nil
1008 (setq localname (or localname "/"))
1009 (with-file-property v localname "file-entries"
1010 (with-current-buffer (tramp-get-buffer v)
1011 (let* ((share (tramp-smb-get-share v))
1012 (cache (tramp-get-connection-property v "share-cache" nil))
1013 res entry)
1015 (if (and (not share) cache)
1016 ;; Return cached shares.
1017 (setq res cache)
1019 ;; Read entries.
1020 (if share
1021 (tramp-smb-send-command
1022 v (format "dir \"%s*\"" (tramp-smb-get-localname v)))
1023 ;; `tramp-smb-maybe-open-connection' lists also the share names.
1024 (tramp-smb-maybe-open-connection v))
1026 ;; Loop the listing.
1027 (goto-char (point-min))
1028 (if (re-search-forward tramp-smb-errors nil t)
1029 (tramp-error v 'file-error "%s `%s'" (match-string 0) directory)
1030 (while (not (eobp))
1031 (setq entry (tramp-smb-read-file-entry share))
1032 (forward-line)
1033 (when entry (add-to-list 'res entry))))
1035 ;; Cache share entries.
1036 (unless share
1037 (tramp-set-connection-property v "share-cache" res)))
1039 ;; Add directory itself.
1040 (add-to-list 'res '("" "drwxrwxrwx" 0 (0 0)))
1042 ;; There's a very strange error (debugged with XEmacs 21.4.14)
1043 ;; If there's no short delay, it returns nil. No idea about.
1044 (when (featurep 'xemacs) (sleep-for 0.01))
1046 ;; Return entries.
1047 (delq nil res))))))
1049 ;; Return either a share name (if SHARE is nil), or a file name.
1051 ;; If shares are listed, the following format is expected:
1053 ;; Disk| - leading spaces
1054 ;; [^|]+| - share name, 14 char
1055 ;; .* - comment
1057 ;; Entries provided by smbclient DIR aren't fully regular.
1058 ;; They should have the format
1060 ;; \s-\{2,2} - leading spaces
1061 ;; \S-\(.*\S-\)\s-* - file name, 30 chars, left bound
1062 ;; \s-+[ADHRSV]* - permissions, 7 chars, right bound
1063 ;; \s- - space delimeter
1064 ;; \s-+[0-9]+ - size, 8 chars, right bound
1065 ;; \s-\{2,2\} - space delimeter
1066 ;; \w\{3,3\} - weekday
1067 ;; \s- - space delimeter
1068 ;; \w\{3,3\} - month
1069 ;; \s- - space delimeter
1070 ;; [ 12][0-9] - day
1071 ;; \s- - space delimeter
1072 ;; [0-9]\{2,2\}:[0-9]\{2,2\}:[0-9]\{2,2\} - time
1073 ;; \s- - space delimeter
1074 ;; [0-9]\{4,4\} - year
1076 ;; samba/src/client.c (http://samba.org/doxygen/samba/client_8c-source.html)
1077 ;; has function display_finfo:
1079 ;; d_printf(" %-30s%7.7s %8.0f %s",
1080 ;; finfo->name,
1081 ;; attrib_string(finfo->mode),
1082 ;; (double)finfo->size,
1083 ;; asctime(LocalTime(&t)));
1085 ;; in Samba 1.9, there's the following code:
1087 ;; DEBUG(0,(" %-30s%7.7s%10d %s",
1088 ;; CNV_LANG(finfo->name),
1089 ;; attrib_string(finfo->mode),
1090 ;; finfo->size,
1091 ;; asctime(LocalTime(&t))));
1093 ;; Problems:
1094 ;; * Modern regexp constructs, like spy groups and counted repetitions, aren't
1095 ;; available in older Emacsen.
1096 ;; * The length of constructs (file name, size) might exceed the default.
1097 ;; * File names might contain spaces.
1098 ;; * Permissions might be empty.
1100 ;; So we try to analyze backwards.
1101 (defun tramp-smb-read-file-entry (share)
1102 "Parse entry in SMB output buffer.
1103 If SHARE is result, entries are of type dir. Otherwise, shares are listed.
1104 Result is the list (LOCALNAME MODE SIZE MTIME)."
1105 ;; We are called from `tramp-smb-get-file-entries', which sets the
1106 ;; current buffer.
1107 (let ((line (buffer-substring (point) (tramp-compat-line-end-position)))
1108 localname mode size month day hour min sec year mtime)
1110 (if (not share)
1112 ;; Read share entries.
1113 (when (string-match "^Disk|\\([^|]+\\)|" line)
1114 (setq localname (match-string 1 line)
1115 mode "dr-xr-xr-x"
1116 size 0))
1118 ;; Real listing.
1119 (block nil
1121 ;; year.
1122 (if (string-match "\\([0-9]+\\)$" line)
1123 (setq year (string-to-number (match-string 1 line))
1124 line (substring line 0 -5))
1125 (return))
1127 ;; time.
1128 (if (string-match "\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)$" line)
1129 (setq hour (string-to-number (match-string 1 line))
1130 min (string-to-number (match-string 2 line))
1131 sec (string-to-number (match-string 3 line))
1132 line (substring line 0 -9))
1133 (return))
1135 ;; day.
1136 (if (string-match "\\([0-9]+\\)$" line)
1137 (setq day (string-to-number (match-string 1 line))
1138 line (substring line 0 -3))
1139 (return))
1141 ;; month.
1142 (if (string-match "\\(\\w+\\)$" line)
1143 (setq month (match-string 1 line)
1144 line (substring line 0 -4))
1145 (return))
1147 ;; weekday.
1148 (if (string-match "\\(\\w+\\)$" line)
1149 (setq line (substring line 0 -5))
1150 (return))
1152 ;; size.
1153 (if (string-match "\\([0-9]+\\)$" line)
1154 (let ((length (- (max 10 (1+ (length (match-string 1 line)))))))
1155 (setq size (string-to-number (match-string 1 line)))
1156 (when (string-match "\\([ADHRSV]+\\)" (substring line length))
1157 (setq length (+ length (match-end 0))))
1158 (setq line (substring line 0 length)))
1159 (return))
1161 ;; mode: ARCH, DIR, HIDDEN, RONLY, SYSTEM, VOLID.
1162 (if (string-match "\\([ADHRSV]+\\)?$" line)
1163 (setq
1164 mode (or (match-string 1 line) "")
1165 mode (save-match-data (format
1166 "%s%s"
1167 (if (string-match "D" mode) "d" "-")
1168 (mapconcat
1169 (lambda (x) "") " "
1170 (concat "r" (if (string-match "R" mode) "-" "w") "x"))))
1171 line (substring line 0 -6))
1172 (return))
1174 ;; localname.
1175 (if (string-match "^\\s-+\\(\\S-\\(.*\\S-\\)?\\)\\s-*$" line)
1176 (setq localname (match-string 1 line))
1177 (return))))
1179 (when (and localname mode size)
1180 (setq mtime
1181 (if (and sec min hour day month year)
1182 (encode-time
1183 sec min hour day
1184 (cdr (assoc (downcase month) tramp-parse-time-months))
1185 year)
1186 '(0 0)))
1187 (list localname mode size mtime))))
1189 (defun tramp-smb-get-cifs-capabilities (vec)
1190 "Check, whether the SMB server supports POSIX commands."
1191 ;; When we are not logged in yet, we return nil.
1192 (if (let ((p (tramp-get-connection-process vec)))
1193 (and p (processp p) (memq (process-status p) '(run open))))
1194 (with-connection-property
1195 (tramp-get-connection-process vec) "cifs-capabilities"
1196 (save-match-data
1197 (when (tramp-smb-send-command vec "posix")
1198 (with-current-buffer (tramp-get-buffer vec)
1199 (goto-char (point-min))
1200 (when
1201 (re-search-forward "Server supports CIFS capabilities" nil t)
1202 (member
1203 "pathnames"
1204 (split-string
1205 (buffer-substring
1206 (point) (tramp-compat-line-end-position)) nil t)))))))))
1208 (defun tramp-smb-get-stat-capability (vec)
1209 "Check, whether the SMB server supports the STAT command."
1210 ;; When we are not logged in yet, we return nil.
1211 (if (let ((p (tramp-get-connection-process vec)))
1212 (and p (processp p) (memq (process-status p) '(run open))))
1213 (with-connection-property
1214 (tramp-get-connection-process vec) "stat-capability"
1215 (tramp-smb-send-command vec "stat ."))))
1218 ;; Connection functions.
1220 (defun tramp-smb-send-command (vec command)
1221 "Send the COMMAND to connection VEC.
1222 Returns nil if there has been an error message from smbclient."
1223 (tramp-smb-maybe-open-connection vec)
1224 (tramp-message vec 6 "%s" command)
1225 (tramp-send-string vec command)
1226 (tramp-smb-wait-for-output vec))
1228 (defun tramp-smb-maybe-open-connection (vec)
1229 "Maybe open a connection to HOST, log in as USER, using `tramp-smb-program'.
1230 Does not do anything if a connection is already open, but re-opens the
1231 connection if a previous connection has died for some reason."
1232 (let* ((share (tramp-smb-get-share vec))
1233 (buf (tramp-get-buffer vec))
1234 (p (get-buffer-process buf)))
1236 ;; Check whether we still have the same smbclient version.
1237 ;; Otherwise, we must delete the connection cache, because
1238 ;; capabilities migh have changed.
1239 (unless (processp p)
1240 (let ((default-directory (tramp-compat-temporary-file-directory))
1241 (command (concat tramp-smb-program " -V")))
1243 (unless tramp-smb-version
1244 (unless (executable-find tramp-smb-program)
1245 (tramp-error
1246 vec 'file-error
1247 "Cannot find command %s in %s" tramp-smb-program exec-path))
1248 (setq tramp-smb-version (shell-command-to-string command))
1249 (tramp-message vec 6 command)
1250 (tramp-message vec 6 "\n%s" tramp-smb-version)
1251 (if (string-match "[ \t\n\r]+\\'" tramp-smb-version)
1252 (setq tramp-smb-version
1253 (replace-match "" nil nil tramp-smb-version))))
1255 (unless (string-equal
1256 tramp-smb-version
1257 (tramp-get-connection-property
1258 vec "smbclient-version" tramp-smb-version))
1259 (tramp-flush-directory-property vec "")
1260 (tramp-flush-connection-property vec))
1262 (tramp-set-connection-property
1263 vec "smbclient-version" tramp-smb-version)))
1265 ;; If too much time has passed since last command was sent, look
1266 ;; whether there has been an error message; maybe due to
1267 ;; connection timeout.
1268 (with-current-buffer buf
1269 (goto-char (point-min))
1270 (when (and (> (tramp-time-diff
1271 (current-time)
1272 (tramp-get-connection-property
1273 p "last-cmd-time" '(0 0 0)))
1275 p (processp p) (memq (process-status p) '(run open))
1276 (re-search-forward tramp-smb-errors nil t))
1277 (delete-process p)
1278 (setq p nil)))
1280 ;; Check whether it is still the same share.
1281 (unless
1282 (and p (processp p) (memq (process-status p) '(run open))
1283 (string-equal
1284 share
1285 (tramp-get-connection-property p "smb-share" "")))
1287 (save-match-data
1288 ;; There might be unread output from checking for share names.
1289 (when buf (with-current-buffer buf (erase-buffer)))
1290 (when (and p (processp p)) (delete-process p))
1292 (let* ((user (tramp-file-name-user vec))
1293 (host (tramp-file-name-host vec))
1294 (real-user (tramp-file-name-real-user vec))
1295 (real-host (tramp-file-name-real-host vec))
1296 (domain (tramp-file-name-domain vec))
1297 (port (tramp-file-name-port vec))
1298 args)
1300 (if share
1301 (setq args (list (concat "//" real-host "/" share)))
1302 (setq args (list "-g" "-L" real-host )))
1304 (if (not (zerop (length real-user)))
1305 (setq args (append args (list "-U" real-user)))
1306 (setq args (append args (list "-N"))))
1308 (when domain (setq args (append args (list "-W" domain))))
1309 (when port (setq args (append args (list "-p" port))))
1310 (when tramp-smb-conf
1311 (setq args (append args (list "-s" tramp-smb-conf))))
1313 ;; OK, let's go.
1314 (with-progress-reporter
1315 vec 3
1316 (format "Opening connection for //%s%s/%s"
1317 (if (not (zerop (length user))) (concat user "@") "")
1318 host (or share ""))
1320 (let* ((coding-system-for-read nil)
1321 (process-connection-type tramp-process-connection-type)
1322 (p (let ((default-directory
1323 (tramp-compat-temporary-file-directory)))
1324 (apply #'start-process
1325 (tramp-buffer-name vec) (tramp-get-buffer vec)
1326 tramp-smb-program args))))
1328 (tramp-message
1329 vec 6 "%s" (mapconcat 'identity (process-command p) " "))
1330 (tramp-set-process-query-on-exit-flag p nil)
1332 ;; Set variables for computing the prompt for reading password.
1333 (setq tramp-current-method tramp-smb-method
1334 tramp-current-user user
1335 tramp-current-host host)
1337 ;; Play login scenario.
1338 (tramp-process-actions
1339 p vec
1340 (if share
1341 tramp-smb-actions-with-share
1342 tramp-smb-actions-without-share))
1344 ;; Check server version.
1345 (with-current-buffer (tramp-get-connection-buffer vec)
1346 (goto-char (point-min))
1347 (search-forward-regexp
1348 "Domain=\\[[^]]*\\] OS=\\[[^]]*\\] Server=\\[[^]]*\\]" nil t)
1349 (let ((smbserver-version (match-string 0)))
1350 (unless
1351 (string-equal
1352 smbserver-version
1353 (tramp-get-connection-property
1354 vec "smbserver-version" smbserver-version))
1355 (tramp-flush-directory-property vec "")
1356 (tramp-flush-connection-property vec))
1357 (tramp-set-connection-property
1358 vec "smbserver-version" smbserver-version)))
1360 ;; Set chunksize. Otherwise, `tramp-send-string' might
1361 ;; try it itself.
1362 (tramp-set-connection-property p "smb-share" share)
1363 (tramp-set-connection-property
1364 p "chunksize" tramp-chunksize))))))))
1366 ;; We don't use timeouts. If needed, the caller shall wrap around.
1367 (defun tramp-smb-wait-for-output (vec)
1368 "Wait for output from smbclient command.
1369 Returns nil if an error message has appeared."
1370 (with-current-buffer (tramp-get-buffer vec)
1371 (let ((p (get-buffer-process (current-buffer)))
1372 (found (progn (goto-char (point-min))
1373 (re-search-forward tramp-smb-prompt nil t)))
1374 (err (progn (goto-char (point-min))
1375 (re-search-forward tramp-smb-errors nil t))))
1377 ;; Algorithm: get waiting output. See if last line contains
1378 ;; tramp-smb-prompt sentinel or tramp-smb-errors strings.
1379 ;; If not, wait a bit and again get waiting output.
1380 (while (and (not found) (not err))
1382 ;; Accept pending output.
1383 (tramp-accept-process-output p)
1385 ;; Search for prompt.
1386 (goto-char (point-min))
1387 (setq found (re-search-forward tramp-smb-prompt nil t))
1389 ;; Search for errors.
1390 (goto-char (point-min))
1391 (setq err (re-search-forward tramp-smb-errors nil t)))
1393 ;; When the process is still alive, read pending output.
1394 (while (and (not found) (memq (process-status p) '(run open)))
1396 ;; Accept pending output.
1397 (tramp-accept-process-output p)
1399 ;; Search for prompt.
1400 (goto-char (point-min))
1401 (setq found (re-search-forward tramp-smb-prompt nil t)))
1403 ;; Return value is whether no error message has appeared.
1404 (tramp-message vec 6 "\n%s" (buffer-string))
1405 (not err))))
1407 (add-hook 'tramp-unload-hook
1408 (lambda ()
1409 (unload-feature 'tramp-smb 'force)))
1411 (provide 'tramp-smb)
1413 ;;; TODO:
1415 ;; * Error handling in case password is wrong.
1416 ;; * Read password from "~/.netrc".
1417 ;; * Return more comprehensive file permission string.
1418 ;; * Try to remove the inclusion of dummy "" directory. Seems to be at
1419 ;; several places, especially in `tramp-smb-handle-insert-directory'.
1420 ;; * (RMS) Use unwind-protect to clean up the state so as to make the state
1421 ;; regular again.
1422 ;; * Make it multi-hop capable.
1424 ;; arch-tag: fcc9dbec-7503-4d73-b638-3c8aa59575f5
1425 ;;; tramp-smb.el ends here