(gnus-blocked-images): Clarify privacy implications
[emacs.git] / lisp / net / tramp-smb.el
bloba4d0d53bf70792a12f24eabf9cb913e6a02c11a9
1 ;;; tramp-smb.el --- Tramp access functions for SMB servers -*- lexical-binding:t -*-
3 ;; Copyright (C) 2002-2018 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 <https://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-lib))
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
42 `(,tramp-smb-method
43 ;; We define an empty command, because `tramp-smb-call-winexe'
44 ;; opens already the powershell. Used in `tramp-handle-shell-command'.
45 (tramp-remote-shell "")
46 ;; This is just a guess. We don't know whether the share "C$"
47 ;; is available for public use, and whether the user has write
48 ;; access.
49 (tramp-tmpdir "/C$/Temp")
50 ;; Another guess. We might implement a better check later on.
51 (tramp-case-insensitive t))))
53 ;; Add a default for `tramp-default-user-alist'. Rule: For the SMB method,
54 ;; the anonymous user is chosen.
55 ;;;###tramp-autoload
56 (add-to-list 'tramp-default-user-alist
57 `(,(concat "\\`" tramp-smb-method "\\'") nil nil))
59 ;; Add completion function for SMB method.
60 ;;;###tramp-autoload
61 (eval-after-load 'tramp
62 '(tramp-set-completion-function
63 tramp-smb-method
64 '((tramp-parse-netrc "~/.netrc"))))
66 ;;;###tramp-autoload
67 (defcustom tramp-smb-program "smbclient"
68 "Name of SMB client to run."
69 :group 'tramp
70 :type 'string
71 :require 'tramp)
73 ;;;###tramp-autoload
74 (defcustom tramp-smb-acl-program "smbcacls"
75 "Name of SMB acls to run."
76 :group 'tramp
77 :type 'string
78 :version "24.4"
79 :require 'tramp)
81 ;;;###tramp-autoload
82 (defcustom tramp-smb-conf "/dev/null"
83 "Path of the smb.conf file.
84 If it is nil, no smb.conf will be added to the `tramp-smb-program'
85 call, letting the SMB client use the default one."
86 :group 'tramp
87 :type '(choice (const nil) (file :must-match t))
88 :require 'tramp)
90 (defvar tramp-smb-version nil
91 "Version string of the SMB client.")
93 (defconst tramp-smb-server-version
94 "Domain=\\[[^]]*\\] OS=\\[[^]]*\\] Server=\\[[^]]*\\]"
95 "Regexp of SMB server identification.")
97 (defconst tramp-smb-prompt "^\\(smb:\\|PS\\) .+> \\|^\\s-+Server\\s-+Comment$"
98 "Regexp used as prompt in smbclient or powershell.")
100 (defconst tramp-smb-wrong-passwd-regexp
101 (regexp-opt
102 '("NT_STATUS_LOGON_FAILURE"
103 "NT_STATUS_WRONG_PASSWORD"))
104 "Regexp for login error strings of SMB servers.")
106 (defconst tramp-smb-errors
107 (mapconcat
108 'identity
109 `(;; Connection error / timeout / unknown command.
110 "Connection\\( to \\S-+\\)? failed"
111 "Read from server failed, maybe it closed the connection"
112 "Call timed out: server did not respond"
113 "\\S-+: command not found"
114 "Server doesn't support UNIX CIFS calls"
115 ,(regexp-opt
116 '(;; Samba.
117 "ERRDOS"
118 "ERRHRD"
119 "ERRSRV"
120 "ERRbadfile"
121 "ERRbadpw"
122 "ERRfilexists"
123 "ERRnoaccess"
124 "ERRnomem"
125 "ERRnosuchshare"
126 ;; See /usr/include/samba-4.0/core/ntstatus.h.
127 ;; Windows 4.0 (Windows NT), Windows 5.0 (Windows 2000),
128 ;; Windows 5.1 (Windows XP), Windows 5.2 (Windows Server 2003),
129 ;; Windows 6.0 (Windows Vista), Windows 6.1 (Windows 7),
130 ;; Windows 6.3 (Windows Server 2012, Windows 10).
131 "NT_STATUS_ACCESS_DENIED"
132 "NT_STATUS_ACCOUNT_LOCKED_OUT"
133 "NT_STATUS_BAD_NETWORK_NAME"
134 "NT_STATUS_CANNOT_DELETE"
135 "NT_STATUS_CONNECTION_DISCONNECTED"
136 "NT_STATUS_CONNECTION_REFUSED"
137 "NT_STATUS_CONNECTION_RESET"
138 "NT_STATUS_DIRECTORY_NOT_EMPTY"
139 "NT_STATUS_DUPLICATE_NAME"
140 "NT_STATUS_FILE_IS_A_DIRECTORY"
141 "NT_STATUS_HOST_UNREACHABLE"
142 "NT_STATUS_IMAGE_ALREADY_LOADED"
143 "NT_STATUS_INVALID_LEVEL"
144 "NT_STATUS_INVALID_PARAMETER_MIX"
145 "NT_STATUS_IO_TIMEOUT"
146 "NT_STATUS_LOGON_FAILURE"
147 "NT_STATUS_NETWORK_ACCESS_DENIED"
148 "NT_STATUS_NOT_IMPLEMENTED"
149 "NT_STATUS_NO_LOGON_SERVERS"
150 "NT_STATUS_NO_SUCH_FILE"
151 "NT_STATUS_NO_SUCH_USER"
152 "NT_STATUS_OBJECT_NAME_COLLISION"
153 "NT_STATUS_OBJECT_NAME_INVALID"
154 "NT_STATUS_OBJECT_NAME_NOT_FOUND"
155 "NT_STATUS_OBJECT_PATH_SYNTAX_BAD"
156 "NT_STATUS_PASSWORD_MUST_CHANGE"
157 "NT_STATUS_RESOURCE_NAME_NOT_FOUND"
158 "NT_STATUS_REVISION_MISMATCH"
159 "NT_STATUS_SHARING_VIOLATION"
160 "NT_STATUS_TRUSTED_RELATIONSHIP_FAILURE"
161 "NT_STATUS_UNSUCCESSFUL"
162 "NT_STATUS_WRONG_PASSWORD")))
163 "\\|")
164 "Regexp for possible error strings of SMB servers.
165 Used instead of analyzing error codes of commands.")
167 (defconst tramp-smb-actions-with-share
168 '((tramp-smb-prompt tramp-action-succeed)
169 (tramp-password-prompt-regexp tramp-action-password)
170 (tramp-wrong-passwd-regexp tramp-action-permission-denied)
171 (tramp-smb-errors tramp-action-permission-denied)
172 (tramp-process-alive-regexp tramp-action-process-alive))
173 "List of pattern/action pairs.
174 This list is used for login to SMB servers.
176 See `tramp-actions-before-shell' for more info.")
178 (defconst tramp-smb-actions-without-share
179 '((tramp-password-prompt-regexp tramp-action-password)
180 (tramp-wrong-passwd-regexp tramp-action-permission-denied)
181 (tramp-smb-errors tramp-action-permission-denied)
182 (tramp-process-alive-regexp tramp-action-out-of-band))
183 "List of pattern/action pairs.
184 This list is used for login to SMB servers.
186 See `tramp-actions-before-shell' for more info.")
188 (defconst tramp-smb-actions-with-tar
189 '((tramp-password-prompt-regexp tramp-action-password)
190 (tramp-wrong-passwd-regexp tramp-action-permission-denied)
191 (tramp-smb-errors tramp-action-permission-denied)
192 (tramp-process-alive-regexp tramp-smb-action-with-tar))
193 "List of pattern/action pairs.
194 This list is used for tar-like copy of directories.
196 See `tramp-actions-before-shell' for more info.")
198 (defconst tramp-smb-actions-get-acl
199 '((tramp-password-prompt-regexp tramp-action-password)
200 (tramp-wrong-passwd-regexp tramp-action-permission-denied)
201 (tramp-smb-errors tramp-action-permission-denied)
202 (tramp-process-alive-regexp tramp-smb-action-get-acl))
203 "List of pattern/action pairs.
204 This list is used for smbcacls actions.
206 See `tramp-actions-before-shell' for more info.")
208 (defconst tramp-smb-actions-set-acl
209 '((tramp-password-prompt-regexp tramp-action-password)
210 (tramp-wrong-passwd-regexp tramp-action-permission-denied)
211 (tramp-smb-errors tramp-action-permission-denied)
212 (tramp-process-alive-regexp tramp-smb-action-set-acl))
213 "List of pattern/action pairs.
214 This list is used for smbcacls actions.
216 See `tramp-actions-before-shell' for more info.")
218 ;; New handlers should be added here.
219 ;;;###tramp-autoload
220 (defconst tramp-smb-file-name-handler-alist
221 '(;; `access-file' performed by default handler.
222 (add-name-to-file . tramp-smb-handle-add-name-to-file)
223 ;; `byte-compiler-base-file-name' performed by default handler.
224 (copy-directory . tramp-smb-handle-copy-directory)
225 (copy-file . tramp-smb-handle-copy-file)
226 (delete-directory . tramp-smb-handle-delete-directory)
227 (delete-file . tramp-smb-handle-delete-file)
228 ;; `diff-latest-backup-file' performed by default handler.
229 (directory-file-name . tramp-handle-directory-file-name)
230 (directory-files . tramp-smb-handle-directory-files)
231 (directory-files-and-attributes
232 . tramp-handle-directory-files-and-attributes)
233 (dired-compress-file . ignore)
234 (dired-uncache . tramp-handle-dired-uncache)
235 (expand-file-name . tramp-smb-handle-expand-file-name)
236 (file-accessible-directory-p . tramp-handle-file-accessible-directory-p)
237 (file-acl . tramp-smb-handle-file-acl)
238 (file-attributes . tramp-smb-handle-file-attributes)
239 (file-directory-p . tramp-handle-file-directory-p)
240 (file-file-equal-p . tramp-handle-file-equal-p)
241 (file-executable-p . tramp-handle-file-exists-p)
242 (file-exists-p . tramp-handle-file-exists-p)
243 (file-in-directory-p . tramp-handle-file-in-directory-p)
244 (file-local-copy . tramp-smb-handle-file-local-copy)
245 (file-modes . tramp-handle-file-modes)
246 (file-name-all-completions . tramp-smb-handle-file-name-all-completions)
247 (file-name-as-directory . tramp-handle-file-name-as-directory)
248 (file-name-case-insensitive-p . tramp-handle-file-name-case-insensitive-p)
249 (file-name-completion . tramp-handle-file-name-completion)
250 (file-name-directory . tramp-handle-file-name-directory)
251 (file-name-nondirectory . tramp-handle-file-name-nondirectory)
252 ;; `file-name-sans-versions' performed by default handler.
253 (file-newer-than-file-p . tramp-handle-file-newer-than-file-p)
254 (file-notify-add-watch . tramp-handle-file-notify-add-watch)
255 (file-notify-rm-watch . tramp-handle-file-notify-rm-watch)
256 (file-notify-valid-p . tramp-handle-file-notify-valid-p)
257 (file-ownership-preserved-p . ignore)
258 (file-readable-p . tramp-handle-file-exists-p)
259 (file-regular-p . tramp-handle-file-regular-p)
260 (file-remote-p . tramp-handle-file-remote-p)
261 (file-selinux-context . tramp-handle-file-selinux-context)
262 (file-symlink-p . tramp-handle-file-symlink-p)
263 (file-system-info . tramp-smb-handle-file-system-info)
264 (file-truename . tramp-handle-file-truename)
265 (file-writable-p . tramp-smb-handle-file-writable-p)
266 (find-backup-file-name . tramp-handle-find-backup-file-name)
267 ;; `find-file-noselect' performed by default handler.
268 ;; `get-file-buffer' performed by default handler.
269 (insert-directory . tramp-smb-handle-insert-directory)
270 (insert-file-contents . tramp-handle-insert-file-contents)
271 (load . tramp-handle-load)
272 (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
273 (make-directory . tramp-smb-handle-make-directory)
274 (make-directory-internal . tramp-smb-handle-make-directory-internal)
275 (make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
276 (make-symbolic-link . tramp-smb-handle-make-symbolic-link)
277 (process-file . tramp-smb-handle-process-file)
278 (rename-file . tramp-smb-handle-rename-file)
279 (set-file-acl . tramp-smb-handle-set-file-acl)
280 (set-file-modes . tramp-smb-handle-set-file-modes)
281 (set-file-selinux-context . ignore)
282 (set-file-times . ignore)
283 (set-visited-file-modtime . tramp-handle-set-visited-file-modtime)
284 (shell-command . tramp-handle-shell-command)
285 (start-file-process . tramp-smb-handle-start-file-process)
286 (substitute-in-file-name . tramp-smb-handle-substitute-in-file-name)
287 (temporary-file-directory . tramp-handle-temporary-file-directory)
288 (unhandled-file-name-directory . ignore)
289 (vc-registered . ignore)
290 (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
291 (write-region . tramp-smb-handle-write-region))
292 "Alist of handler functions for Tramp SMB method.
293 Operations not mentioned here will be handled by the default Emacs primitives.")
295 ;; Options for remote processes via winexe.
296 ;;;###tramp-autoload
297 (defcustom tramp-smb-winexe-program "winexe"
298 "Name of winexe client to run.
299 If it isn't found in the local $PATH, the absolute path of winexe
300 shall be given. This is needed for remote processes."
301 :group 'tramp
302 :type 'string
303 :version "24.3"
304 :require 'tramp)
306 ;;;###tramp-autoload
307 (defcustom tramp-smb-winexe-shell-command "powershell.exe"
308 "Shell to be used for processes on remote machines.
309 This must be Powershell V2 compatible."
310 :group 'tramp
311 :type 'string
312 :version "24.3"
313 :require 'tramp)
315 ;;;###tramp-autoload
316 (defcustom tramp-smb-winexe-shell-command-switch "-file -"
317 "Command switch used together with `tramp-smb-winexe-shell-command'.
318 This can be used to disable echo etc."
319 :group 'tramp
320 :type 'string
321 :version "24.3"
322 :require 'tramp)
324 ;; It must be a `defsubst' in order to push the whole code into
325 ;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading.
326 ;;;###tramp-autoload
327 (defsubst tramp-smb-file-name-p (filename)
328 "Check if it's a filename for SMB servers."
329 (string= (tramp-file-name-method (tramp-dissect-file-name filename))
330 tramp-smb-method))
332 ;;;###tramp-autoload
333 (defun tramp-smb-file-name-handler (operation &rest args)
334 "Invoke the SMB related OPERATION.
335 First arg specifies the OPERATION, second arg is a list of arguments to
336 pass to the OPERATION."
337 (let ((fn (assoc operation tramp-smb-file-name-handler-alist)))
338 (if fn
339 (save-match-data (apply (cdr fn) args))
340 (tramp-run-real-handler operation args))))
342 ;;;###tramp-autoload
343 (unless (memq system-type '(cygwin windows-nt))
344 (tramp-register-foreign-file-name-handler
345 'tramp-smb-file-name-p 'tramp-smb-file-name-handler))
347 ;; File name primitives.
349 (defun tramp-smb-handle-add-name-to-file
350 (filename newname &optional ok-if-already-exists)
351 "Like `add-name-to-file' for Tramp files."
352 (unless (tramp-equal-remote filename newname)
353 (with-parsed-tramp-file-name
354 (if (tramp-tramp-file-p filename) filename newname) nil
355 (tramp-error
356 v 'file-error
357 "add-name-to-file: %s"
358 "only implemented for same method, same user, same host")))
359 (with-parsed-tramp-file-name filename v1
360 (with-parsed-tramp-file-name newname v2
361 (when (file-directory-p filename)
362 (tramp-error
363 v2 'file-error
364 "add-name-to-file: %s must not be a directory" filename))
365 ;; Do the 'confirm if exists' thing.
366 (when (file-exists-p newname)
367 ;; What to do?
368 (if (or (null ok-if-already-exists) ; not allowed to exist
369 (and (numberp ok-if-already-exists)
370 (not (yes-or-no-p
371 (format
372 "File %s already exists; make it a link anyway? "
373 v2-localname)))))
374 (tramp-error v2 'file-already-exists newname)
375 (delete-file newname)))
376 ;; We must also flush the cache of the directory, because
377 ;; `file-attributes' reads the values from there.
378 (tramp-flush-file-properties v2 (file-name-directory v2-localname))
379 (tramp-flush-file-properties v2 v2-localname)
380 (unless
381 (tramp-smb-send-command
383 (format
384 "%s \"%s\" \"%s\""
385 (if (tramp-smb-get-cifs-capabilities v1) "link" "hardlink")
386 (tramp-smb-get-localname v1)
387 (tramp-smb-get-localname v2)))
388 (tramp-error
389 v2 'file-error
390 "error with add-name-to-file, see buffer `%s' for details"
391 (buffer-name))))))
393 (defun tramp-smb-action-with-tar (proc vec)
394 "Untar from connection buffer."
395 (if (not (process-live-p proc))
396 (throw 'tramp-action 'process-died)
398 (with-current-buffer (tramp-get-connection-buffer vec)
399 (goto-char (point-min))
400 (when (search-forward-regexp tramp-smb-server-version nil t)
401 ;; There might be a hidden password prompt.
402 (widen)
403 (forward-line)
404 (tramp-message vec 6 (buffer-substring (point-min) (point)))
405 (delete-region (point-min) (point))
406 (throw 'tramp-action 'ok)))))
408 (defun tramp-smb-handle-copy-directory
409 (dirname newname &optional keep-date parents copy-contents)
410 "Like `copy-directory' for Tramp files."
411 (if copy-contents
412 ;; We must do it file-wise.
413 (tramp-run-real-handler
414 'copy-directory (list dirname newname keep-date parents copy-contents))
416 (setq dirname (expand-file-name dirname)
417 newname (expand-file-name newname))
418 (let ((t1 (tramp-tramp-file-p dirname))
419 (t2 (tramp-tramp-file-p newname)))
420 (with-parsed-tramp-file-name (if t1 dirname newname) nil
421 (with-tramp-progress-reporter
422 v 0 (format "Copying %s to %s" dirname newname)
423 (when (and (file-directory-p newname)
424 (not (tramp-compat-directory-name-p newname)))
425 (tramp-error v 'file-already-exists newname))
426 (cond
427 ;; We must use a local temporary directory.
428 ((and t1 t2)
429 (let ((tmpdir
430 (make-temp-name
431 (expand-file-name
432 tramp-temp-name-prefix
433 (tramp-compat-temporary-file-directory)))))
434 (unwind-protect
435 (progn
436 (make-directory tmpdir)
437 (copy-directory
438 dirname (file-name-as-directory tmpdir) keep-date 'parents)
439 (copy-directory
440 (expand-file-name (file-name-nondirectory dirname) tmpdir)
441 newname keep-date parents))
442 (delete-directory tmpdir 'recursive))))
444 ;; We can copy recursively.
445 ;; TODO: Does not work reliably.
446 (nil ;(and (or t1 t2) (tramp-smb-get-cifs-capabilities v))
447 (when (and (file-directory-p newname)
448 (not (string-equal (file-name-nondirectory dirname)
449 (file-name-nondirectory newname))))
450 (setq newname
451 (expand-file-name
452 (file-name-nondirectory dirname) newname))
453 (if t2 (setq v (tramp-dissect-file-name newname))))
454 (if (not (file-directory-p newname))
455 (make-directory newname parents))
457 (let* ((share (tramp-smb-get-share v))
458 (localname (file-name-as-directory
459 (replace-regexp-in-string
460 "\\\\" "/" (tramp-smb-get-localname v))))
461 (tmpdir (make-temp-name
462 (expand-file-name
463 tramp-temp-name-prefix
464 (tramp-compat-temporary-file-directory))))
465 (args (list (concat "//" host "/" share) "-E"))
466 ;; We do not want to run timers.
467 timer-list timer-idle-list)
469 (if (not (zerop (length user)))
470 (setq args (append args (list "-U" user)))
471 (setq args (append args (list "-N"))))
473 (when domain (setq args (append args (list "-W" domain))))
474 (when port (setq args (append args (list "-p" port))))
475 (when tramp-smb-conf
476 (setq args (append args (list "-s" tramp-smb-conf))))
477 (setq args
478 (if t1
479 ;; Source is remote.
480 (append args
481 (list "-D" (tramp-unquote-shell-quote-argument
482 localname)
483 "-c" (shell-quote-argument "tar qc - *")
484 "|" "tar" "xfC" "-"
485 (tramp-unquote-shell-quote-argument
486 tmpdir)))
487 ;; Target is remote.
488 (append (list "tar" "cfC" "-"
489 (tramp-unquote-shell-quote-argument dirname)
490 "." "|")
491 args
492 (list "-D" (tramp-unquote-shell-quote-argument
493 localname)
494 "-c" (shell-quote-argument "tar qx -")))))
496 (unwind-protect
497 (with-temp-buffer
498 ;; Set the transfer process properties.
499 (tramp-set-connection-property
500 v "process-name" (buffer-name (current-buffer)))
501 (tramp-set-connection-property
502 v "process-buffer" (current-buffer))
504 (when t1
505 ;; The smbclient tar command creates always
506 ;; complete paths. We must emulate the
507 ;; directory structure, and symlink to the real
508 ;; target.
509 (make-directory
510 (expand-file-name
511 ".." (concat tmpdir localname))
512 'parents)
513 (make-symbolic-link
514 newname (directory-file-name (concat tmpdir localname))))
516 ;; Use an asynchronous processes. By this,
517 ;; password can be handled.
518 (let* ((default-directory tmpdir)
519 (p (apply
520 'start-process
521 (tramp-get-connection-name v)
522 (tramp-get-connection-buffer v)
523 tramp-smb-program args)))
525 (tramp-message
526 v 6 "%s" (mapconcat 'identity (process-command p) " "))
527 (process-put p 'vector v)
528 (process-put p 'adjust-window-size-function 'ignore)
529 (set-process-query-on-exit-flag p nil)
530 (tramp-process-actions p v nil tramp-smb-actions-with-tar)
532 (while (process-live-p p)
533 (sit-for 0.1))
534 (tramp-message v 6 "\n%s" (buffer-string))))
536 ;; Reset the transfer process properties.
537 (tramp-flush-connection-property v "process-name")
538 (tramp-flush-connection-property v "process-buffer")
539 (when t1 (delete-directory tmpdir 'recursive))))
541 ;; Handle KEEP-DATE argument.
542 (when keep-date
543 (set-file-times
544 newname
545 (tramp-compat-file-attribute-modification-time
546 (file-attributes dirname))))
548 ;; Set the mode.
549 (unless keep-date
550 (set-file-modes newname (tramp-default-file-modes dirname)))
552 ;; When newname did exist, we have wrong cached values.
553 (when t2
554 (with-parsed-tramp-file-name newname nil
555 (tramp-flush-file-properties v (file-name-directory localname))
556 (tramp-flush-file-properties v localname))))
558 ;; We must do it file-wise.
560 (tramp-run-real-handler
561 'copy-directory (list dirname newname keep-date parents)))))))))
563 (defun tramp-smb-handle-copy-file
564 (filename newname &optional ok-if-already-exists keep-date
565 _preserve-uid-gid _preserve-extended-attributes)
566 "Like `copy-file' for Tramp files.
567 KEEP-DATE has no effect in case NEWNAME resides on an SMB server.
568 PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
569 (setq filename (expand-file-name filename)
570 newname (expand-file-name newname))
571 (with-tramp-progress-reporter
572 (tramp-dissect-file-name
573 (if (tramp-tramp-file-p filename) filename newname))
574 0 (format "Copying %s to %s" filename newname)
576 (if (file-directory-p filename)
577 (copy-directory filename newname keep-date 'parents 'copy-contents)
579 (let ((tmpfile (file-local-copy filename)))
580 (if tmpfile
581 ;; Remote filename.
582 (condition-case err
583 (rename-file tmpfile newname ok-if-already-exists)
584 ((error quit)
585 (delete-file tmpfile)
586 (signal (car err) (cdr err))))
588 ;; Remote newname.
589 (when (and (file-directory-p newname)
590 (tramp-compat-directory-name-p newname))
591 (setq newname
592 (expand-file-name (file-name-nondirectory filename) newname)))
594 (with-parsed-tramp-file-name newname nil
595 (when (and (not ok-if-already-exists)
596 (file-exists-p newname))
597 (tramp-error v 'file-already-exists newname))
599 ;; We must also flush the cache of the directory, because
600 ;; `file-attributes' reads the values from there.
601 (tramp-flush-file-properties v (file-name-directory localname))
602 (tramp-flush-file-properties v localname)
603 (unless (tramp-smb-get-share v)
604 (tramp-error
605 v 'file-error "Target `%s' must contain a share name" newname))
606 (unless (tramp-smb-send-command
607 v (format "put \"%s\" \"%s\""
608 (tramp-compat-file-name-unquote filename)
609 (tramp-smb-get-localname v)))
610 (tramp-error
611 v 'file-error "Cannot copy `%s' to `%s'" filename newname))))))
613 ;; KEEP-DATE handling.
614 (when keep-date
615 (set-file-times
616 newname
617 (tramp-compat-file-attribute-modification-time
618 (file-attributes filename))))))
620 (defun tramp-smb-handle-delete-directory (directory &optional recursive _trash)
621 "Like `delete-directory' for Tramp files."
622 (setq directory (directory-file-name (expand-file-name directory)))
623 (when (file-exists-p directory)
624 (when recursive
625 (mapc
626 (lambda (file)
627 (if (file-directory-p file)
628 (delete-directory file recursive)
629 (delete-file file)))
630 ;; We do not want to delete "." and "..".
631 (directory-files directory 'full directory-files-no-dot-files-regexp)))
633 (with-parsed-tramp-file-name directory nil
634 ;; We must also flush the cache of the directory, because
635 ;; `file-attributes' reads the values from there.
636 (tramp-flush-file-properties v (file-name-directory localname))
637 (tramp-flush-directory-properties v localname)
638 (unless (tramp-smb-send-command
639 v (format
640 "%s \"%s\""
641 (if (tramp-smb-get-cifs-capabilities v) "posix_rmdir" "rmdir")
642 (tramp-smb-get-localname v)))
643 ;; Error.
644 (with-current-buffer (tramp-get-connection-buffer v)
645 (goto-char (point-min))
646 (search-forward-regexp tramp-smb-errors nil t)
647 (tramp-error
648 v 'file-error "%s `%s'" (match-string 0) directory)))
650 ;; "rmdir" does not report an error. So we check ourselves.
651 (when (file-exists-p directory)
652 (tramp-error
653 v 'file-error "`%s' not removed." directory)))))
655 (defun tramp-smb-handle-delete-file (filename &optional _trash)
656 "Like `delete-file' for Tramp files."
657 (setq filename (expand-file-name filename))
658 (when (file-exists-p filename)
659 (with-parsed-tramp-file-name filename nil
660 ;; We must also flush the cache of the directory, because
661 ;; `file-attributes' reads the values from there.
662 (tramp-flush-file-properties v (file-name-directory localname))
663 (tramp-flush-file-properties v localname)
664 (unless (tramp-smb-send-command
665 v (format
666 "%s \"%s\""
667 (if (tramp-smb-get-cifs-capabilities v) "posix_unlink" "rm")
668 (tramp-smb-get-localname v)))
669 ;; Error.
670 (with-current-buffer (tramp-get-connection-buffer v)
671 (goto-char (point-min))
672 (search-forward-regexp tramp-smb-errors nil t)
673 (tramp-error
674 v 'file-error "%s `%s'" (match-string 0) filename))))))
676 (defun tramp-smb-handle-directory-files
677 (directory &optional full match nosort)
678 "Like `directory-files' for Tramp files."
679 (let ((result (mapcar 'directory-file-name
680 (file-name-all-completions "" directory))))
681 ;; Discriminate with regexp.
682 (when match
683 (setq result
684 (delete nil
685 (mapcar (lambda (x) (when (string-match match x) x))
686 result))))
687 ;; Append directory.
688 (when full
689 (setq result
690 (mapcar
691 (lambda (x) (format "%s/%s" directory x))
692 result)))
693 ;; Sort them if necessary.
694 (unless nosort (setq result (sort result 'string-lessp)))
695 result))
697 (defun tramp-smb-handle-expand-file-name (name &optional dir)
698 "Like `expand-file-name' for Tramp files."
699 ;; If DIR is not given, use DEFAULT-DIRECTORY or "/".
700 (setq dir (or dir default-directory "/"))
701 ;; Unless NAME is absolute, concat DIR and NAME.
702 (unless (file-name-absolute-p name)
703 (setq name (concat (file-name-as-directory dir) name)))
704 ;; If NAME is not a Tramp file, run the real handler.
705 (if (not (tramp-tramp-file-p name))
706 (tramp-run-real-handler 'expand-file-name (list name nil))
707 ;; Dissect NAME.
708 (with-parsed-tramp-file-name name nil
709 ;; Tilde expansion if necessary. We use the user name as share,
710 ;; which is often the case in domains.
711 (when (string-match "\\`/?~\\([^/]*\\)" localname)
712 (setq localname
713 (replace-match
714 (if (zerop (length (match-string 1 localname)))
715 user
716 (match-string 1 localname))
717 nil nil localname)))
718 ;; Make the file name absolute.
719 (unless (tramp-run-real-handler 'file-name-absolute-p (list localname))
720 (setq localname (concat "/" localname)))
721 ;; No tilde characters in file name, do normal
722 ;; `expand-file-name' (this does "/./" and "/../").
723 (tramp-make-tramp-file-name
724 method user domain host port
725 (tramp-run-real-handler 'expand-file-name (list localname))))))
727 (defun tramp-smb-action-get-acl (proc vec)
728 "Read ACL data from connection buffer."
729 (unless (process-live-p proc)
730 ;; Accept pending output.
731 (while (tramp-accept-process-output proc 0.1))
732 (with-current-buffer (tramp-get-connection-buffer vec)
733 ;; There might be a hidden password prompt.
734 (widen)
735 (tramp-message vec 10 "\n%s" (buffer-string))
736 (goto-char (point-min))
737 (while (and (not (eobp)) (not (looking-at "^REVISION:")))
738 (forward-line)
739 (delete-region (point-min) (point)))
740 (while (and (not (eobp)) (looking-at "^.+:.+"))
741 (forward-line))
742 (delete-region (point) (point-max))
743 (throw 'tramp-action 'ok))))
745 (defun tramp-smb-handle-file-acl (filename)
746 "Like `file-acl' for Tramp files."
747 (ignore-errors
748 (with-parsed-tramp-file-name filename nil
749 (with-tramp-file-property v localname "file-acl"
750 (when (executable-find tramp-smb-acl-program)
751 (let* ((share (tramp-smb-get-share v))
752 (localname (replace-regexp-in-string
753 "\\\\" "/" (tramp-smb-get-localname v)))
754 (args (list (concat "//" host "/" share) "-E"))
755 ;; We do not want to run timers.
756 timer-list timer-idle-list)
758 (if (not (zerop (length user)))
759 (setq args (append args (list "-U" user)))
760 (setq args (append args (list "-N"))))
762 (when domain (setq args (append args (list "-W" domain))))
763 (when port (setq args (append args (list "-p" port))))
764 (when tramp-smb-conf
765 (setq args (append args (list "-s" tramp-smb-conf))))
766 (setq
767 args
768 (append args (list (tramp-unquote-shell-quote-argument localname)
769 "2>/dev/null")))
771 (unwind-protect
772 (with-temp-buffer
773 ;; Set the transfer process properties.
774 (tramp-set-connection-property
775 v "process-name" (buffer-name (current-buffer)))
776 (tramp-set-connection-property
777 v "process-buffer" (current-buffer))
779 ;; Use an asynchronous process. By this, password can
780 ;; be handled.
781 (let ((p (apply
782 'start-process
783 (tramp-get-connection-name v)
784 (tramp-get-connection-buffer v)
785 tramp-smb-acl-program args)))
787 (tramp-message
788 v 6 "%s" (mapconcat 'identity (process-command p) " "))
789 (process-put p 'vector v)
790 (process-put p 'adjust-window-size-function 'ignore)
791 (set-process-query-on-exit-flag p nil)
792 (tramp-process-actions p v nil tramp-smb-actions-get-acl)
793 (when (> (point-max) (point-min))
794 (substring-no-properties (buffer-string)))))
796 ;; Reset the transfer process properties.
797 (tramp-flush-connection-property v "process-name")
798 (tramp-flush-connection-property v "process-buffer"))))))))
800 (defun tramp-smb-handle-file-attributes (filename &optional id-format)
801 "Like `file-attributes' for Tramp files."
802 (unless id-format (setq id-format 'integer))
803 (ignore-errors
804 (with-parsed-tramp-file-name filename nil
805 (with-tramp-file-property
806 v localname (format "file-attributes-%s" id-format)
807 (if (tramp-smb-get-stat-capability v)
808 (tramp-smb-do-file-attributes-with-stat v id-format)
809 ;; Reading just the filename entry via "dir localname" is not
810 ;; possible, because when filename is a directory, some
811 ;; smbclient versions return the content of the directory, and
812 ;; other versions don't. Therefore, the whole content of the
813 ;; upper directory is retrieved, and the entry of the filename
814 ;; is extracted from.
815 (let* ((entries (tramp-smb-get-file-entries
816 (file-name-directory filename)))
817 (entry (assoc (file-name-nondirectory filename) entries))
818 (uid (if (equal id-format 'string) "nobody" -1))
819 (gid (if (equal id-format 'string) "nogroup" -1))
820 (inode (tramp-get-inode v))
821 (device (tramp-get-device v)))
823 ;; Check result.
824 (when entry
825 (list (and (string-match "d" (nth 1 entry))
826 t) ;0 file type
827 -1 ;1 link count
828 uid ;2 uid
829 gid ;3 gid
830 '(0 0) ;4 atime
831 (nth 3 entry) ;5 mtime
832 '(0 0) ;6 ctime
833 (nth 2 entry) ;7 size
834 (nth 1 entry) ;8 mode
835 nil ;9 gid weird
836 inode ;10 inode number
837 device)))))))) ;11 file system number
839 (defun tramp-smb-do-file-attributes-with-stat (vec &optional id-format)
840 "Implement `file-attributes' for Tramp files using stat command."
841 (tramp-message
842 vec 5 "file attributes with stat: %s" (tramp-file-name-localname vec))
843 (with-current-buffer (tramp-get-connection-buffer vec)
844 (let* (size id link uid gid atime mtime ctime mode inode)
845 (when (tramp-smb-send-command
846 vec (format "stat \"%s\"" (tramp-smb-get-localname vec)))
848 ;; Loop the listing.
849 (goto-char (point-min))
850 (unless (re-search-forward tramp-smb-errors nil t)
851 (while (not (eobp))
852 (cond
853 ((looking-at
854 "Size:\\s-+\\([0-9]+\\)\\s-+Blocks:\\s-+[0-9]+\\s-+\\(\\w+\\)")
855 (setq size (string-to-number (match-string 1))
856 id (if (string-equal "directory" (match-string 2)) t
857 (if (string-equal "symbolic" (match-string 2)) ""))))
858 ((looking-at
859 "Inode:\\s-+\\([0-9]+\\)\\s-+Links:\\s-+\\([0-9]+\\)")
860 (setq inode (string-to-number (match-string 1))
861 link (string-to-number (match-string 2))))
862 ((looking-at
863 "Access:\\s-+([0-9]+/\\(\\S-+\\))\\s-+Uid:\\s-+\\([0-9]+\\)\\s-+Gid:\\s-+\\([0-9]+\\)")
864 (setq mode (match-string 1)
865 uid (if (equal id-format 'string) (match-string 2)
866 (string-to-number (match-string 2)))
867 gid (if (equal id-format 'string) (match-string 3)
868 (string-to-number (match-string 3)))))
869 ((looking-at
870 "Access:\\s-+\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)\\s-+\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)")
871 (setq atime
872 (encode-time
873 (string-to-number (match-string 6)) ;; sec
874 (string-to-number (match-string 5)) ;; min
875 (string-to-number (match-string 4)) ;; hour
876 (string-to-number (match-string 3)) ;; day
877 (string-to-number (match-string 2)) ;; month
878 (string-to-number (match-string 1))))) ;; year
879 ((looking-at
880 "Modify:\\s-+\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)\\s-+\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)")
881 (setq mtime
882 (encode-time
883 (string-to-number (match-string 6)) ;; sec
884 (string-to-number (match-string 5)) ;; min
885 (string-to-number (match-string 4)) ;; hour
886 (string-to-number (match-string 3)) ;; day
887 (string-to-number (match-string 2)) ;; month
888 (string-to-number (match-string 1))))) ;; year
889 ((looking-at
890 "Change:\\s-+\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)\\s-+\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)")
891 (setq ctime
892 (encode-time
893 (string-to-number (match-string 6)) ;; sec
894 (string-to-number (match-string 5)) ;; min
895 (string-to-number (match-string 4)) ;; hour
896 (string-to-number (match-string 3)) ;; day
897 (string-to-number (match-string 2)) ;; month
898 (string-to-number (match-string 1)))))) ;; year
899 (forward-line))
901 ;; Resolve symlink.
902 (when (and (stringp id)
903 (tramp-smb-send-command
905 (format "readlink \"%s\"" (tramp-smb-get-localname vec))))
906 (goto-char (point-min))
907 (and (looking-at ".+ -> \\(.+\\)")
908 (setq id (match-string 1))))
910 ;; Return the result.
911 (when (or id link uid gid atime mtime ctime size mode inode)
912 (list id link uid gid atime mtime ctime size mode nil inode
913 (tramp-get-device vec))))))))
915 (defun tramp-smb-handle-file-local-copy (filename)
916 "Like `file-local-copy' for Tramp files."
917 (with-parsed-tramp-file-name (file-truename filename) nil
918 (unless (file-exists-p (file-truename filename))
919 (tramp-error
920 v tramp-file-missing
921 "Cannot make local copy of non-existing file `%s'" filename))
922 (let ((tmpfile (tramp-compat-make-temp-file filename)))
923 (with-tramp-progress-reporter
924 v 3 (format "Fetching %s to tmp file %s" filename tmpfile)
925 (unless (tramp-smb-send-command
926 v (format "get \"%s\" \"%s\""
927 (tramp-smb-get-localname v) tmpfile))
928 ;; Oops, an error. We shall cleanup.
929 (delete-file tmpfile)
930 (tramp-error
931 v 'file-error "Cannot make local copy of file `%s'" filename)))
932 tmpfile)))
934 ;; This function should return "foo/" for directories and "bar" for
935 ;; files.
936 (defun tramp-smb-handle-file-name-all-completions (filename directory)
937 "Like `file-name-all-completions' for Tramp files."
938 (all-completions
939 filename
940 (with-parsed-tramp-file-name (expand-file-name directory) nil
941 (with-tramp-file-property v localname "file-name-all-completions"
942 (save-match-data
943 (delete-dups
944 (mapcar
945 (lambda (x)
946 (list
947 (if (string-match "d" (nth 1 x))
948 (file-name-as-directory (nth 0 x))
949 (nth 0 x))))
950 (tramp-smb-get-file-entries directory))))))))
952 (defun tramp-smb-handle-file-system-info (filename)
953 "Like `file-system-info' for Tramp files."
954 (ignore-errors
955 (unless (file-directory-p filename)
956 (setq filename (file-name-directory filename)))
957 (with-parsed-tramp-file-name (expand-file-name filename) nil
958 (tramp-message v 5 "file system info: %s" localname)
959 (tramp-smb-send-command v (format "du %s/*" (tramp-smb-get-localname v)))
960 (with-current-buffer (tramp-get-connection-buffer v)
961 (let (total avail blocksize)
962 (goto-char (point-min))
963 (forward-line)
964 (when (looking-at
965 (concat "[[:space:]]*\\([[:digit:]]+\\)"
966 " blocks of size \\([[:digit:]]+\\)"
967 "\\. \\([[:digit:]]+\\) blocks available"))
968 (setq blocksize (string-to-number (concat (match-string 2) "e0"))
969 total (* blocksize
970 (string-to-number (concat (match-string 1) "e0")))
971 avail (* blocksize
972 (string-to-number (concat (match-string 3) "e0")))))
973 (forward-line)
974 (when (looking-at "Total number of bytes: \\([[:digit:]]+\\)")
975 ;; The used number of bytes is not part of the result. As
976 ;; side effect, we store it as file property.
977 (tramp-set-file-property
978 v localname "used-bytes"
979 (string-to-number (concat (match-string 1) "e0"))))
980 ;; Result.
981 (when (and total avail)
982 (list total (- total avail) avail)))))))
984 (defun tramp-smb-handle-file-writable-p (filename)
985 "Like `file-writable-p' for Tramp files."
986 (if (file-exists-p filename)
987 (string-match
989 (or (tramp-compat-file-attribute-modes (file-attributes filename)) ""))
990 (let ((dir (file-name-directory filename)))
991 (and (file-exists-p dir)
992 (file-writable-p dir)))))
994 (defun tramp-smb-handle-insert-directory
995 (filename switches &optional wildcard full-directory-p)
996 "Like `insert-directory' for Tramp files."
997 (setq filename (expand-file-name filename))
998 (unless switches (setq switches ""))
999 ;; Mark trailing "/".
1000 (when (and (zerop (length (file-name-nondirectory filename)))
1001 (not full-directory-p))
1002 (setq switches (concat switches "F")))
1003 (if full-directory-p
1004 ;; Called from `dired-add-entry'.
1005 (setq filename (file-name-as-directory filename))
1006 (setq filename (directory-file-name filename)))
1007 (with-parsed-tramp-file-name filename nil
1008 (with-tramp-progress-reporter v 0 (format "Opening directory %s" filename)
1009 (save-match-data
1010 (let ((base (file-name-nondirectory filename))
1011 ;; We should not destroy the cache entry.
1012 (entries (copy-tree
1013 (tramp-smb-get-file-entries
1014 (file-name-directory filename))))
1015 (avail (get-free-disk-space filename))
1016 ;; `get-free-disk-space' calls `file-system-info', which
1017 ;; sets file property "used-bytes" as side effect.
1018 (used
1019 (format
1020 "%.0f"
1021 (/ (tramp-get-file-property v localname "used-bytes" 0) 1024))))
1023 (when wildcard
1024 (string-match "\\." base)
1025 (setq base (replace-match "\\\\." nil nil base))
1026 (string-match "\\*" base)
1027 (setq base (replace-match ".*" nil nil base))
1028 (string-match "\\?" base)
1029 (setq base (replace-match ".?" nil nil base)))
1031 ;; Filter entries.
1032 (setq entries
1033 (delq
1035 (if (or wildcard (zerop (length base)))
1036 ;; Check for matching entries.
1037 (mapcar
1038 (lambda (x)
1039 (when (string-match
1040 (format "^%s" base) (nth 0 x))
1042 entries)
1043 ;; We just need the only and only entry FILENAME.
1044 (list (assoc base entries)))))
1046 ;; Sort entries.
1047 (setq entries
1048 (sort
1049 entries
1050 (lambda (x y)
1051 (if (string-match "t" switches)
1052 ;; Sort by date.
1053 (time-less-p (nth 3 y) (nth 3 x))
1054 ;; Sort by name.
1055 (string-lessp (nth 0 x) (nth 0 y))))))
1057 ;; Handle "-F" switch.
1058 (when (string-match "F" switches)
1059 (mapc
1060 (lambda (x)
1061 (when (not (zerop (length (car x))))
1062 (cond
1063 ((char-equal ?d (string-to-char (nth 1 x)))
1064 (setcar x (concat (car x) "/")))
1065 ((char-equal ?x (string-to-char (nth 1 x)))
1066 (setcar x (concat (car x) "*"))))))
1067 entries))
1069 ;; Insert size information.
1070 (when full-directory-p
1071 (insert
1072 (if avail
1073 (format "total used in directory %s available %s\n" used avail)
1074 (format "total %s\n" used))))
1076 ;; Print entries.
1077 (mapc
1078 (lambda (x)
1079 (when (not (zerop (length (nth 0 x))))
1080 (let ((attr
1081 (when (tramp-smb-get-stat-capability v)
1082 (ignore-errors
1083 (file-attributes
1084 (expand-file-name
1085 (nth 0 x) (file-name-directory filename))
1086 'string)))))
1087 (when (string-match "l" switches)
1088 (insert
1089 (format
1090 "%10s %3d %-8s %-8s %8s %s "
1091 (or (tramp-compat-file-attribute-modes attr) (nth 1 x))
1092 (or (tramp-compat-file-attribute-link-number attr) 1)
1093 (or (tramp-compat-file-attribute-user-id attr) "nobody")
1094 (or (tramp-compat-file-attribute-group-id attr) "nogroup")
1095 (or (tramp-compat-file-attribute-size attr) (nth 2 x))
1096 (format-time-string
1097 (if (time-less-p (time-subtract (current-time) (nth 3 x))
1098 tramp-half-a-year)
1099 "%b %e %R"
1100 "%b %e %Y")
1101 (nth 3 x))))) ; date
1103 ;; We mark the file name. The inserted name could be
1104 ;; from somewhere else, so we use the relative file name
1105 ;; of `default-directory'.
1106 (let ((start (point)))
1107 (insert
1108 (format
1109 "%s"
1110 (file-relative-name
1111 (expand-file-name
1112 (nth 0 x) (file-name-directory filename))
1113 (when full-directory-p (file-name-directory filename)))))
1114 (put-text-property start (point) 'dired-filename t))
1116 ;; Insert symlink.
1117 (when (and (string-match "l" switches)
1118 (stringp (tramp-compat-file-attribute-type attr)))
1119 (insert " -> " (tramp-compat-file-attribute-type attr))))
1121 (insert "\n")
1122 (forward-line)
1123 (beginning-of-line)))
1124 entries))))))
1126 (defun tramp-smb-handle-make-directory (dir &optional parents)
1127 "Like `make-directory' for Tramp files."
1128 (setq dir (directory-file-name (expand-file-name dir)))
1129 (unless (file-name-absolute-p dir)
1130 (setq dir (expand-file-name dir default-directory)))
1131 (with-parsed-tramp-file-name dir nil
1132 (save-match-data
1133 (let* ((ldir (file-name-directory dir)))
1134 ;; Make missing directory parts.
1135 (when (and parents
1136 (tramp-smb-get-share v)
1137 (not (file-directory-p ldir)))
1138 (make-directory ldir parents))
1139 ;; Just do it.
1140 (when (file-directory-p ldir)
1141 (make-directory-internal dir))
1142 (unless (file-directory-p dir)
1143 (tramp-error v 'file-error "Couldn't make directory %s" dir))))))
1145 (defun tramp-smb-handle-make-directory-internal (directory)
1146 "Like `make-directory-internal' for Tramp files."
1147 (setq directory (directory-file-name (expand-file-name directory)))
1148 (unless (file-name-absolute-p directory)
1149 (setq directory (expand-file-name directory default-directory)))
1150 (with-parsed-tramp-file-name directory nil
1151 (save-match-data
1152 (let* ((file (tramp-smb-get-localname v)))
1153 (when (file-directory-p (file-name-directory directory))
1154 (tramp-smb-send-command
1156 (if (tramp-smb-get-cifs-capabilities v)
1157 (format "posix_mkdir \"%s\" %o" file (default-file-modes))
1158 (format "mkdir \"%s\"" file)))
1159 ;; We must also flush the cache of the directory, because
1160 ;; `file-attributes' reads the values from there.
1161 (tramp-flush-file-properties v (file-name-directory localname))
1162 (tramp-flush-file-properties v localname))
1163 (unless (file-directory-p directory)
1164 (tramp-error
1165 v 'file-error "Couldn't make directory %s" directory))))))
1167 (defun tramp-smb-handle-make-symbolic-link
1168 (target linkname &optional ok-if-already-exists)
1169 "Like `make-symbolic-link' for Tramp files.
1170 If TARGET is a non-Tramp file, it is used verbatim as the target
1171 of the symlink. If TARGET is a Tramp file, only the localname
1172 component is used as the target of the symlink."
1173 (if (not (tramp-tramp-file-p (expand-file-name linkname)))
1174 (tramp-run-real-handler
1175 'make-symbolic-link (list target linkname ok-if-already-exists))
1177 (with-parsed-tramp-file-name linkname nil
1178 ;; If TARGET is a Tramp name, use just the localname component.
1179 (when (and (tramp-tramp-file-p target)
1180 (tramp-file-name-equal-p v (tramp-dissect-file-name target)))
1181 (setq target
1182 (tramp-file-name-localname
1183 (tramp-dissect-file-name (expand-file-name target)))))
1185 ;; If TARGET is still remote, quote it.
1186 (if (tramp-tramp-file-p target)
1187 (make-symbolic-link
1188 (let (file-name-handler-alist) (tramp-compat-file-name-quote target))
1189 linkname ok-if-already-exists)
1191 ;; Do the 'confirm if exists' thing.
1192 (when (file-exists-p linkname)
1193 ;; What to do?
1194 (if (or (null ok-if-already-exists) ; not allowed to exist
1195 (and (numberp ok-if-already-exists)
1196 (not (yes-or-no-p
1197 (format
1198 "File %s already exists; make it a link anyway? "
1199 localname)))))
1200 (tramp-error v 'file-already-exists localname)
1201 (delete-file linkname)))
1203 (unless (tramp-smb-get-cifs-capabilities v)
1204 (tramp-error v 'file-error "make-symbolic-link not supported"))
1206 ;; We must also flush the cache of the directory, because
1207 ;; `file-attributes' reads the values from there.
1208 (tramp-flush-file-properties v (file-name-directory localname))
1209 (tramp-flush-file-properties v localname)
1211 (unless
1212 (tramp-smb-send-command
1213 v (format "symlink \"%s\" \"%s\""
1214 (tramp-compat-file-name-unquote target)
1215 (tramp-smb-get-localname v)))
1216 (tramp-error
1217 v 'file-error
1218 "error with make-symbolic-link, see buffer `%s' for details"
1219 (tramp-get-connection-buffer v)))))))
1221 (defun tramp-smb-handle-process-file
1222 (program &optional infile destination display &rest args)
1223 "Like `process-file' for Tramp files."
1224 ;; The implementation is not complete yet.
1225 (when (and (numberp destination) (zerop destination))
1226 (error "Implementation does not handle immediate return"))
1228 (with-parsed-tramp-file-name default-directory nil
1229 (let* ((name (file-name-nondirectory program))
1230 (name1 name)
1231 (i 0)
1232 ;; We do not want to run timers.
1233 timer-list timer-idle-list
1234 input tmpinput outbuf command ret)
1236 ;; Determine input.
1237 (when infile
1238 (setq infile (expand-file-name infile))
1239 (if (tramp-equal-remote default-directory infile)
1240 ;; INFILE is on the same remote host.
1241 (setq input (with-parsed-tramp-file-name infile nil localname))
1242 ;; INFILE must be copied to remote host.
1243 (setq input (tramp-make-tramp-temp-file v)
1244 tmpinput
1245 (tramp-make-tramp-file-name method user domain host port input))
1246 (copy-file infile tmpinput t))
1247 ;; Transform input into a filename powershell does understand.
1248 (setq input (format "//%s%s" host input)))
1250 ;; Determine output.
1251 (cond
1252 ;; Just a buffer.
1253 ((bufferp destination)
1254 (setq outbuf destination))
1255 ;; A buffer name.
1256 ((stringp destination)
1257 (setq outbuf (get-buffer-create destination)))
1258 ;; (REAL-DESTINATION ERROR-DESTINATION)
1259 ((consp destination)
1260 ;; output.
1261 (cond
1262 ((bufferp (car destination))
1263 (setq outbuf (car destination)))
1264 ((stringp (car destination))
1265 (setq outbuf (get-buffer-create (car destination))))
1266 ((car destination)
1267 (setq outbuf (current-buffer))))
1268 ;; stderr.
1269 (tramp-message v 2 "%s" "STDERR not supported"))
1270 ;; 't
1271 (destination
1272 (setq outbuf (current-buffer))))
1274 ;; Construct command.
1275 (setq command (mapconcat 'identity (cons program args) " ")
1276 command (if input
1277 (format
1278 "get-content %s | & %s"
1279 (tramp-smb-shell-quote-argument input) command)
1280 (format "& %s" command)))
1282 (while (get-process name1)
1283 ;; NAME must be unique as process name.
1284 (setq i (1+ i)
1285 name1 (format "%s<%d>" name i)))
1287 ;; Set the new process properties.
1288 (tramp-set-connection-property v "process-name" name1)
1289 (tramp-set-connection-property
1290 v "process-buffer"
1291 (or outbuf (generate-new-buffer tramp-temp-buffer-name)))
1293 ;; Call it.
1294 (condition-case nil
1295 (with-current-buffer (tramp-get-connection-buffer v)
1296 ;; Preserve buffer contents.
1297 (narrow-to-region (point-max) (point-max))
1298 (tramp-smb-call-winexe v)
1299 (when (tramp-smb-get-share v)
1300 (tramp-smb-send-command
1301 v (format "cd \"//%s%s\"" host (file-name-directory localname))))
1302 (tramp-smb-send-command v command)
1303 ;; Preserve command output.
1304 (narrow-to-region (point-max) (point-max))
1305 (let ((p (tramp-get-connection-process v)))
1306 (tramp-smb-send-command v "exit $lasterrorcode")
1307 (while (process-live-p p)
1308 (sleep-for 0.1)
1309 (setq ret (process-exit-status p))))
1310 (delete-region (point-min) (point-max))
1311 (widen))
1313 ;; When the user did interrupt, we should do it also. We use
1314 ;; return code -1 as marker.
1315 (quit
1316 (setq ret -1))
1317 ;; Handle errors.
1318 (error
1319 (setq ret 1)))
1321 ;; We should redisplay the output.
1322 (when (and display outbuf (get-buffer-window outbuf t)) (redisplay))
1324 ;; Cleanup. We remove all file cache values for the connection,
1325 ;; because the remote process could have changed them.
1326 (tramp-flush-connection-property v "process-name")
1327 (tramp-flush-connection-property v "process-buffer")
1328 (when tmpinput (delete-file tmpinput))
1329 (unless outbuf
1330 (kill-buffer (tramp-get-connection-property v "process-buffer" nil)))
1332 (unless process-file-side-effects
1333 (tramp-flush-directory-properties v ""))
1335 ;; Return exit status.
1336 (if (equal ret -1)
1337 (keyboard-quit)
1338 ret))))
1340 (defun tramp-smb-handle-rename-file
1341 (filename newname &optional ok-if-already-exists)
1342 "Like `rename-file' for Tramp files."
1343 (setq filename (expand-file-name filename)
1344 newname (expand-file-name newname))
1346 (when (and (not ok-if-already-exists)
1347 (file-exists-p newname))
1348 (tramp-error
1349 (tramp-dissect-file-name
1350 (if (tramp-tramp-file-p filename) filename newname))
1351 'file-already-exists newname))
1353 (with-tramp-progress-reporter
1354 (tramp-dissect-file-name
1355 (if (tramp-tramp-file-p filename) filename newname))
1356 0 (format "Renaming %s to %s" filename newname)
1358 (if (and (not (file-exists-p newname))
1359 (tramp-equal-remote filename newname)
1360 (string-equal
1361 (tramp-smb-get-share (tramp-dissect-file-name filename))
1362 (tramp-smb-get-share (tramp-dissect-file-name newname))))
1363 ;; We can rename directly.
1364 (with-parsed-tramp-file-name filename v1
1365 (with-parsed-tramp-file-name newname v2
1367 ;; We must also flush the cache of the directory, because
1368 ;; `file-attributes' reads the values from there.
1369 (tramp-flush-file-properties v1 (file-name-directory v1-localname))
1370 (tramp-flush-file-properties v1 v1-localname)
1371 (tramp-flush-file-properties v2 (file-name-directory v2-localname))
1372 (tramp-flush-file-properties v2 v2-localname)
1373 (unless (tramp-smb-get-share v2)
1374 (tramp-error
1375 v2 'file-error "Target `%s' must contain a share name" newname))
1376 (unless (tramp-smb-send-command
1377 v2 (format "rename \"%s\" \"%s\""
1378 (tramp-smb-get-localname v1)
1379 (tramp-smb-get-localname v2)))
1380 (tramp-error v2 'file-error "Cannot rename `%s'" filename))))
1382 ;; We must rename via copy.
1383 (copy-file
1384 filename newname ok-if-already-exists 'keep-time 'preserve-uid-gid)
1385 (if (file-directory-p filename)
1386 (delete-directory filename 'recursive)
1387 (delete-file filename)))))
1389 (defun tramp-smb-action-set-acl (proc vec)
1390 "Read ACL data from connection buffer."
1391 (unless (process-live-p proc)
1392 ;; Accept pending output.
1393 (while (tramp-accept-process-output proc 0.1))
1394 (with-current-buffer (tramp-get-connection-buffer vec)
1395 (tramp-message vec 10 "\n%s" (buffer-string))
1396 (throw 'tramp-action 'ok))))
1398 (defun tramp-smb-handle-set-file-acl (filename acl-string)
1399 "Like `set-file-acl' for Tramp files."
1400 (ignore-errors
1401 (with-parsed-tramp-file-name filename nil
1402 (tramp-flush-file-property v localname "file-acl")
1404 (when (and (stringp acl-string) (executable-find tramp-smb-acl-program))
1405 (let* ((share (tramp-smb-get-share v))
1406 (localname (replace-regexp-in-string
1407 "\\\\" "/" (tramp-smb-get-localname v)))
1408 (args (list (concat "//" host "/" share) "-E" "-S"
1409 (replace-regexp-in-string
1410 "\n" "," acl-string)))
1411 ;; We do not want to run timers.
1412 timer-list timer-idle-list)
1414 (if (not (zerop (length user)))
1415 (setq args (append args (list "-U" user)))
1416 (setq args (append args (list "-N"))))
1418 (when domain (setq args (append args (list "-W" domain))))
1419 (when port (setq args (append args (list "-p" port))))
1420 (when tramp-smb-conf
1421 (setq args (append args (list "-s" tramp-smb-conf))))
1422 (setq
1423 args
1424 (append args (list (tramp-unquote-shell-quote-argument localname)
1425 "&&" "echo" "tramp_exit_status" "0"
1426 "||" "echo" "tramp_exit_status" "1")))
1428 (unwind-protect
1429 (with-temp-buffer
1430 ;; Set the transfer process properties.
1431 (tramp-set-connection-property
1432 v "process-name" (buffer-name (current-buffer)))
1433 (tramp-set-connection-property
1434 v "process-buffer" (current-buffer))
1436 ;; Use an asynchronous process. By this, password can
1437 ;; be handled.
1438 (let ((p (apply
1439 'start-process
1440 (tramp-get-connection-name v)
1441 (tramp-get-connection-buffer v)
1442 tramp-smb-acl-program args)))
1444 (tramp-message
1445 v 6 "%s" (mapconcat 'identity (process-command p) " "))
1446 (process-put p 'vector v)
1447 (process-put p 'adjust-window-size-function 'ignore)
1448 (set-process-query-on-exit-flag p nil)
1449 (tramp-process-actions p v nil tramp-smb-actions-set-acl)
1450 (goto-char (point-max))
1451 ;; This is meant for traces, and returning from the
1452 ;; function. No error is propagated outside, due to
1453 ;; the `ignore-errors' closure.
1454 (unless (re-search-backward "tramp_exit_status [0-9]+" nil t)
1455 (tramp-error
1456 v 'file-error
1457 "Couldn't find exit status of `%s'" tramp-smb-acl-program))
1458 (skip-chars-forward "^ ")
1459 (when (zerop (read (current-buffer)))
1460 ;; Success.
1461 (tramp-set-file-property v localname "file-acl" acl-string)
1462 t)))
1464 ;; Reset the transfer process properties.
1465 (tramp-flush-connection-property v "process-name")
1466 (tramp-flush-connection-property v "process-buffer")))))))
1468 (defun tramp-smb-handle-set-file-modes (filename mode)
1469 "Like `set-file-modes' for Tramp files."
1470 (with-parsed-tramp-file-name filename nil
1471 (when (tramp-smb-get-cifs-capabilities v)
1472 (tramp-flush-file-properties v localname)
1473 (unless (tramp-smb-send-command
1474 v (format "chmod \"%s\" %o" (tramp-smb-get-localname v) mode))
1475 (tramp-error
1476 v 'file-error "Error while changing file's mode %s" filename)))))
1478 ;; We use BUFFER also as connection buffer during setup. Because of
1479 ;; this, its original contents must be saved, and restored once
1480 ;; connection has been setup.
1481 (defun tramp-smb-handle-start-file-process (name buffer program &rest args)
1482 "Like `start-file-process' for Tramp files."
1483 (with-parsed-tramp-file-name default-directory nil
1484 (let* ((buffer
1485 (if buffer
1486 (get-buffer-create buffer)
1487 ;; BUFFER can be nil. We use a temporary buffer.
1488 (generate-new-buffer tramp-temp-buffer-name)))
1489 (command (mapconcat 'identity (cons program args) " "))
1490 (bmp (and (buffer-live-p buffer) (buffer-modified-p buffer)))
1491 (name1 name)
1492 (i 0)
1493 ;; We do not want to run timers.
1494 timer-list timer-idle-list)
1495 (unwind-protect
1496 (save-excursion
1497 (save-restriction
1498 (while (get-process name1)
1499 ;; NAME must be unique as process name.
1500 (setq i (1+ i)
1501 name1 (format "%s<%d>" name i)))
1502 ;; Set the new process properties.
1503 (tramp-set-connection-property v "process-name" name1)
1504 (tramp-set-connection-property v "process-buffer" buffer)
1505 ;; Activate narrowing in order to save BUFFER contents.
1506 (with-current-buffer (tramp-get-connection-buffer v)
1507 (let ((buffer-undo-list t))
1508 (narrow-to-region (point-max) (point-max))
1509 (tramp-smb-call-winexe v)
1510 (when (tramp-smb-get-share v)
1511 (tramp-smb-send-command
1512 v (format
1513 "cd \"//%s%s\""
1514 host (file-name-directory localname))))
1515 (tramp-message v 6 "(%s); exit" command)
1516 (tramp-send-string v command)))
1517 ;; Return value.
1518 (tramp-get-connection-process v)))
1520 ;; Save exit.
1521 (with-current-buffer (tramp-get-connection-buffer v)
1522 (if (string-match tramp-temp-buffer-name (buffer-name))
1523 (progn
1524 (set-process-buffer (tramp-get-connection-process v) nil)
1525 (kill-buffer (current-buffer)))
1526 (set-buffer-modified-p bmp)))
1527 (tramp-flush-connection-property v "process-name")
1528 (tramp-flush-connection-property v "process-buffer")))))
1530 (defun tramp-smb-handle-substitute-in-file-name (filename)
1531 "Like `handle-substitute-in-file-name' for Tramp files.
1532 \"//\" substitutes only in the local filename part. Catches
1533 errors for shares like \"C$/\", which are common in Microsoft Windows."
1534 ;; Check, whether the local part is a quoted file name.
1535 (if (tramp-compat-file-name-quoted-p filename)
1536 filename
1537 (with-parsed-tramp-file-name filename nil
1538 ;; Ignore in LOCALNAME everything before "//".
1539 (when (and (stringp localname) (string-match ".+?/\\(/\\|~\\)" localname))
1540 (setq filename
1541 (concat (file-remote-p filename)
1542 (replace-match "\\1" nil nil localname)))))
1543 (condition-case nil
1544 (tramp-run-real-handler 'substitute-in-file-name (list filename))
1545 (error filename))))
1547 (defun tramp-smb-handle-write-region
1548 (start end filename &optional append visit lockname mustbenew)
1549 "Like `write-region' for Tramp files."
1550 (setq filename (expand-file-name filename))
1551 (with-parsed-tramp-file-name filename nil
1552 (when (and mustbenew (file-exists-p filename)
1553 (or (eq mustbenew 'excl)
1554 (not
1555 (y-or-n-p
1556 (format "File %s exists; overwrite anyway? " filename)))))
1557 (tramp-error v 'file-already-exists filename))
1559 ;; We must also flush the cache of the directory, because
1560 ;; `file-attributes' reads the values from there.
1561 (tramp-flush-file-properties v (file-name-directory localname))
1562 (tramp-flush-file-properties v localname)
1563 (let ((curbuf (current-buffer))
1564 (tmpfile (tramp-compat-make-temp-file filename)))
1565 (when (and append (file-exists-p filename))
1566 (copy-file filename tmpfile 'ok))
1567 ;; We say `no-message' here because we don't want the visited file
1568 ;; modtime data to be clobbered from the temp file. We call
1569 ;; `set-visited-file-modtime' ourselves later on.
1570 (tramp-run-real-handler
1571 'write-region (list start end tmpfile append 'no-message lockname))
1573 (with-tramp-progress-reporter
1574 v 3 (format "Moving tmp file %s to %s" tmpfile filename)
1575 (unwind-protect
1576 (unless (tramp-smb-send-command
1577 v (format "put %s \"%s\""
1578 tmpfile (tramp-smb-get-localname v)))
1579 (tramp-error v 'file-error "Cannot write `%s'" filename))
1580 (delete-file tmpfile)))
1582 (unless (equal curbuf (current-buffer))
1583 (tramp-error
1584 v 'file-error
1585 "Buffer has changed from `%s' to `%s'" curbuf (current-buffer)))
1587 ;; Set file modification time.
1588 (when (or (eq visit t) (stringp visit))
1589 (set-visited-file-modtime
1590 (tramp-compat-file-attribute-modification-time
1591 (file-attributes filename))))
1593 ;; The end.
1594 (when (and (null noninteractive)
1595 (or (eq visit t) (null visit) (stringp visit)))
1596 (tramp-message v 0 "Wrote %s" filename))
1597 (run-hooks 'tramp-handle-write-region-hook))))
1599 ;; Internal file name functions.
1601 (defun tramp-smb-get-share (vec)
1602 "Returns the share name of LOCALNAME."
1603 (save-match-data
1604 (let ((localname (tramp-file-name-unquote-localname vec)))
1605 (when (string-match "^/?\\([^/]+\\)/" localname)
1606 (match-string 1 localname)))))
1608 (defun tramp-smb-get-localname (vec)
1609 "Returns the file name of LOCALNAME.
1610 If VEC has no cifs capabilities, exchange \"/\" by \"\\\\\"."
1611 (save-match-data
1612 (let ((localname (tramp-file-name-unquote-localname vec)))
1613 (setq
1614 localname
1615 (if (string-match "^/?[^/]+\\(/.*\\)" localname)
1616 ;; There is a share, separated by "/".
1617 (if (not (tramp-smb-get-cifs-capabilities vec))
1618 (mapconcat
1619 (lambda (x) (if (equal x ?/) "\\" (char-to-string x)))
1620 (match-string 1 localname) "")
1621 (match-string 1 localname))
1622 ;; There is just a share.
1623 (if (string-match "^/?\\([^/]+\\)$" localname)
1624 (match-string 1 localname)
1625 "")))
1627 ;; Sometimes we have discarded `substitute-in-file-name'.
1628 (when (string-match "\\(\\$\\$\\)\\(/\\|$\\)" localname)
1629 (setq localname (replace-match "$" nil nil localname 1)))
1631 ;; A period followed by a space, or trailing periods and spaces,
1632 ;; are not supported.
1633 (when (string-match "\\. \\|\\.$\\| $" localname)
1634 (tramp-error
1635 vec 'file-error
1636 "Invalid file name %s" (tramp-make-tramp-file-name vec localname)))
1638 localname)))
1640 ;; Share names of a host are cached. It is very unlikely that the
1641 ;; shares do change during connection.
1642 (defun tramp-smb-get-file-entries (directory)
1643 "Read entries which match DIRECTORY.
1644 Either the shares are listed, or the `dir' command is executed.
1645 Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)."
1646 ;; If CIFS capabilities are enabled, symlinks are not listed
1647 ;; by `dir'. This is a consequence of
1648 ;; <https://www.samba.org/samba/news/symlink_attack.html>. See also
1649 ;; <https://bugzilla.samba.org/show_bug.cgi?id=5116>.
1650 (with-parsed-tramp-file-name (file-name-as-directory directory) nil
1651 (setq localname (or localname "/"))
1652 (with-tramp-file-property v localname "file-entries"
1653 (with-current-buffer (tramp-get-connection-buffer v)
1654 (let* ((share (tramp-smb-get-share v))
1655 (cache (tramp-get-connection-property v "share-cache" nil))
1656 res entry)
1658 (if (and (not share) cache)
1659 ;; Return cached shares.
1660 (setq res cache)
1662 ;; Read entries.
1663 (if share
1664 (tramp-smb-send-command
1665 v (format "dir \"%s*\"" (tramp-smb-get-localname v)))
1666 ;; `tramp-smb-maybe-open-connection' lists also the share names.
1667 (tramp-smb-maybe-open-connection v))
1669 ;; Loop the listing.
1670 (goto-char (point-min))
1671 (if (re-search-forward tramp-smb-errors nil t)
1672 (tramp-error v 'file-error "%s `%s'" (match-string 0) directory)
1673 (while (not (eobp))
1674 (setq entry (tramp-smb-read-file-entry share))
1675 (forward-line)
1676 (when entry (push entry res))))
1678 ;; Cache share entries.
1679 (unless share
1680 (tramp-set-connection-property v "share-cache" res)))
1682 ;; Add directory itself.
1683 (push '("" "drwxrwxrwx" 0 (0 0)) res)
1685 ;; Return entries.
1686 (delq nil res))))))
1688 ;; Return either a share name (if SHARE is nil), or a file name.
1690 ;; If shares are listed, the following format is expected:
1692 ;; Disk| - leading spaces
1693 ;; [^|]+| - share name, 14 char
1694 ;; .* - comment
1696 ;; Entries provided by smbclient DIR aren't fully regular.
1697 ;; They should have the format
1699 ;; \s-\{2,2} - leading spaces
1700 ;; \S-\(.*\S-\)\s-* - file name, 30 chars, left bound
1701 ;; \s-+[ADHRSV]* - permissions, 7 chars, right bound
1702 ;; \s- - space delimiter
1703 ;; \s-+[0-9]+ - size, 8 chars, right bound
1704 ;; \s-\{2,2\} - space delimiter
1705 ;; \w\{3,3\} - weekday
1706 ;; \s- - space delimiter
1707 ;; \w\{3,3\} - month
1708 ;; \s- - space delimiter
1709 ;; [ 12][0-9] - day
1710 ;; \s- - space delimiter
1711 ;; [0-9]\{2,2\}:[0-9]\{2,2\}:[0-9]\{2,2\} - time
1712 ;; \s- - space delimiter
1713 ;; [0-9]\{4,4\} - year
1715 ;; samba/src/client.c (http://samba.org/doxygen/samba/client_8c-source.html)
1716 ;; has function display_finfo:
1718 ;; d_printf(" %-30s%7.7s %8.0f %s",
1719 ;; finfo->name,
1720 ;; attrib_string(finfo->mode),
1721 ;; (double)finfo->size,
1722 ;; asctime(LocalTime(&t)));
1724 ;; in Samba 1.9, there's the following code:
1726 ;; DEBUG(0,(" %-30s%7.7s%10d %s",
1727 ;; CNV_LANG(finfo->name),
1728 ;; attrib_string(finfo->mode),
1729 ;; finfo->size,
1730 ;; asctime(LocalTime(&t))));
1732 ;; Problems:
1733 ;; * Modern regexp constructs, like spy groups and counted repetitions, aren't
1734 ;; available in older Emacsen.
1735 ;; * The length of constructs (file name, size) might exceed the default.
1736 ;; * File names might contain spaces.
1737 ;; * Permissions might be empty.
1739 ;; So we try to analyze backwards.
1740 (defun tramp-smb-read-file-entry (share)
1741 "Parse entry in SMB output buffer.
1742 If SHARE is result, entries are of type dir. Otherwise, shares are listed.
1743 Result is the list (LOCALNAME MODE SIZE MTIME)."
1744 ;; We are called from `tramp-smb-get-file-entries', which sets the
1745 ;; current buffer.
1746 (let ((line (buffer-substring (point) (point-at-eol)))
1747 localname mode size month day hour min sec year mtime)
1749 (if (not share)
1751 ;; Read share entries.
1752 (when (string-match "^Disk|\\([^|]+\\)|" line)
1753 (setq localname (match-string 1 line)
1754 mode "dr-xr-xr-x"
1755 size 0))
1757 ;; Real listing.
1758 (cl-block nil
1760 ;; year.
1761 (if (string-match "\\([0-9]+\\)$" line)
1762 (setq year (string-to-number (match-string 1 line))
1763 line (substring line 0 -5))
1764 (cl-return))
1766 ;; time.
1767 (if (string-match "\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)$" line)
1768 (setq hour (string-to-number (match-string 1 line))
1769 min (string-to-number (match-string 2 line))
1770 sec (string-to-number (match-string 3 line))
1771 line (substring line 0 -9))
1772 (cl-return))
1774 ;; day.
1775 (if (string-match "\\([0-9]+\\)$" line)
1776 (setq day (string-to-number (match-string 1 line))
1777 line (substring line 0 -3))
1778 (cl-return))
1780 ;; month.
1781 (if (string-match "\\(\\w+\\)$" line)
1782 (setq month (match-string 1 line)
1783 line (substring line 0 -4))
1784 (cl-return))
1786 ;; weekday.
1787 (if (string-match "\\(\\w+\\)$" line)
1788 (setq line (substring line 0 -5))
1789 (cl-return))
1791 ;; size.
1792 (if (string-match "\\([0-9]+\\)$" line)
1793 (let ((length (- (max 10 (1+ (length (match-string 1 line)))))))
1794 (setq size (string-to-number (match-string 1 line)))
1795 (when (string-match
1796 "\\([ACDEHNORrsSTV]+\\)" (substring line length))
1797 (setq length (+ length (match-end 0))))
1798 (setq line (substring line 0 length)))
1799 (cl-return))
1801 ;; mode: ARCHIVE, COMPRESSED, DIRECTORY, ENCRYPTED, HIDDEN,
1802 ;; NONINDEXED, NORMAL, OFFLINE, READONLY,
1803 ;; REPARSE_POINT, SPARSE, SYSTEM, TEMPORARY, VOLID.
1805 (if (string-match "\\([ACDEHNORrsSTV]+\\)?$" line)
1806 (setq
1807 mode (or (match-string 1 line) "")
1808 mode (save-match-data (format
1809 "%s%s"
1810 (if (string-match "D" mode) "d" "-")
1811 (mapconcat
1812 (lambda (_x) "") " "
1813 (concat "r" (if (string-match "R" mode) "-" "w") "x"))))
1814 line (substring line 0 -6))
1815 (cl-return))
1817 ;; localname.
1818 (if (string-match "^\\s-+\\(\\S-\\(.*\\S-\\)?\\)\\s-*$" line)
1819 (setq localname (match-string 1 line))
1820 (cl-return))))
1822 (when (and localname mode size)
1823 (setq mtime
1824 (if (and sec min hour day month year)
1825 (encode-time
1826 sec min hour day
1827 (cdr (assoc (downcase month) parse-time-months))
1828 year)
1829 '(0 0)))
1830 (list localname mode size mtime))))
1832 (defun tramp-smb-get-cifs-capabilities (vec)
1833 "Check, whether the SMB server supports POSIX commands."
1834 ;; When we are not logged in yet, we return nil.
1835 (if (process-live-p (tramp-get-connection-process vec))
1836 (with-tramp-connection-property
1837 (tramp-get-connection-process vec) "cifs-capabilities"
1838 (save-match-data
1839 (when (tramp-smb-send-command vec "posix")
1840 (with-current-buffer (tramp-get-connection-buffer vec)
1841 (goto-char (point-min))
1842 (when
1843 (re-search-forward "Server supports CIFS capabilities" nil t)
1844 (member
1845 "pathnames"
1846 (split-string
1847 (buffer-substring (point) (point-at-eol)) nil 'omit)))))))))
1849 (defun tramp-smb-get-stat-capability (vec)
1850 "Check, whether the SMB server supports the STAT command."
1851 ;; When we are not logged in yet, we return nil.
1852 (if (and (tramp-smb-get-share vec)
1853 (process-live-p (tramp-get-connection-process vec)))
1854 (with-tramp-connection-property
1855 (tramp-get-connection-process vec) "stat-capability"
1856 (tramp-smb-send-command vec "stat \"/\""))))
1859 ;; Connection functions.
1861 (defun tramp-smb-send-command (vec command)
1862 "Send the COMMAND to connection VEC.
1863 Returns nil if there has been an error message from smbclient."
1864 (tramp-smb-maybe-open-connection vec)
1865 (tramp-message vec 6 "%s" command)
1866 (tramp-send-string vec command)
1867 (tramp-smb-wait-for-output vec))
1869 (defun tramp-smb-maybe-open-connection (vec &optional argument)
1870 "Maybe open a connection to HOST, log in as USER, using `tramp-smb-program'.
1871 Does not do anything if a connection is already open, but re-opens the
1872 connection if a previous connection has died for some reason.
1873 If ARGUMENT is non-nil, use it as argument for
1874 `tramp-smb-winexe-program', and suppress any checks."
1875 (let* ((share (tramp-smb-get-share vec))
1876 (buf (tramp-get-connection-buffer vec))
1877 (p (get-buffer-process buf)))
1879 ;; Check whether we still have the same smbclient version.
1880 ;; Otherwise, we must delete the connection cache, because
1881 ;; capabilities migh have changed.
1882 (unless (or argument (processp p))
1883 (let ((default-directory (tramp-compat-temporary-file-directory))
1884 (command (concat tramp-smb-program " -V")))
1886 (unless tramp-smb-version
1887 (unless (executable-find tramp-smb-program)
1888 (tramp-error
1889 vec 'file-error
1890 "Cannot find command %s in %s" tramp-smb-program exec-path))
1891 (setq tramp-smb-version (shell-command-to-string command))
1892 (tramp-message vec 6 command)
1893 (tramp-message vec 6 "\n%s" tramp-smb-version)
1894 (if (string-match "[ \t\n\r]+\\'" tramp-smb-version)
1895 (setq tramp-smb-version
1896 (replace-match "" nil nil tramp-smb-version))))
1898 (unless (string-equal
1899 tramp-smb-version
1900 (tramp-get-connection-property
1901 vec "smbclient-version" tramp-smb-version))
1902 (tramp-flush-directory-properties vec "")
1903 (tramp-flush-connection-properties vec))
1905 (tramp-set-connection-property
1906 vec "smbclient-version" tramp-smb-version)))
1908 ;; If too much time has passed since last command was sent, look
1909 ;; whether there has been an error message; maybe due to
1910 ;; connection timeout.
1911 (with-current-buffer buf
1912 (goto-char (point-min))
1913 (when (and (> (tramp-time-diff
1914 (current-time)
1915 (tramp-get-connection-property
1916 p "last-cmd-time" '(0 0 0)))
1918 (process-live-p p)
1919 (re-search-forward tramp-smb-errors nil t))
1920 (delete-process p)
1921 (setq p nil)))
1923 ;; Check whether it is still the same share.
1924 (unless (and (process-live-p p)
1925 (or argument
1926 (string-equal
1927 share
1928 (tramp-get-connection-property p "smb-share" ""))))
1930 (save-match-data
1931 ;; There might be unread output from checking for share names.
1932 (when buf (with-current-buffer buf (erase-buffer)))
1933 (when (and p (processp p)) (delete-process p))
1935 (let* ((user (tramp-file-name-user vec))
1936 (host (tramp-file-name-host vec))
1937 (domain (tramp-file-name-domain vec))
1938 (port (tramp-file-name-port vec))
1939 args)
1941 (cond
1942 (argument
1943 (setq args (list (concat "//" host))))
1944 (share
1945 (setq args (list (concat "//" host "/" share))))
1947 (setq args (list "-g" "-L" host ))))
1949 (if (not (zerop (length user)))
1950 (setq args (append args (list "-U" user)))
1951 (setq args (append args (list "-N"))))
1953 (when domain (setq args (append args (list "-W" domain))))
1954 (when port (setq args (append args (list "-p" port))))
1955 (when tramp-smb-conf
1956 (setq args (append args (list "-s" tramp-smb-conf))))
1957 (when argument
1958 (setq args (append args (list argument))))
1960 ;; OK, let's go.
1961 (with-tramp-progress-reporter
1962 vec 3
1963 (format "Opening connection for //%s%s/%s"
1964 (if (not (zerop (length user))) (concat user "@") "")
1965 host (or share ""))
1967 (let* ((coding-system-for-read nil)
1968 (process-connection-type tramp-process-connection-type)
1969 (p (let ((default-directory
1970 (tramp-compat-temporary-file-directory)))
1971 (apply #'start-process
1972 (tramp-get-connection-name vec)
1973 (tramp-get-connection-buffer vec)
1974 (if argument
1975 tramp-smb-winexe-program tramp-smb-program)
1976 args))))
1978 (tramp-message
1979 vec 6 "%s" (mapconcat 'identity (process-command p) " "))
1980 (process-put p 'vector vec)
1981 (process-put p 'adjust-window-size-function 'ignore)
1982 (set-process-query-on-exit-flag p nil)
1984 (condition-case err
1985 (let (tramp-message-show-message)
1986 ;; Play login scenario.
1987 (tramp-process-actions
1988 p vec nil
1989 (if (or argument share)
1990 tramp-smb-actions-with-share
1991 tramp-smb-actions-without-share))
1993 ;; Check server version.
1994 (unless argument
1995 (with-current-buffer (tramp-get-connection-buffer vec)
1996 (goto-char (point-min))
1997 (search-forward-regexp tramp-smb-server-version nil t)
1998 (let ((smbserver-version (match-string 0)))
1999 (unless
2000 (string-equal
2001 smbserver-version
2002 (tramp-get-connection-property
2003 vec "smbserver-version" smbserver-version))
2004 (tramp-flush-directory-properties vec "")
2005 (tramp-flush-connection-properties vec))
2006 (tramp-set-connection-property
2007 vec "smbserver-version" smbserver-version))))
2009 ;; Set chunksize to 1. smbclient reads its input
2010 ;; character by character; if we send the string
2011 ;; at once, it is read painfully slow.
2012 (tramp-set-connection-property p "smb-share" share)
2013 (tramp-set-connection-property p "chunksize" 1)
2015 ;; Set connection-local variables.
2016 (tramp-set-connection-local-variables vec)
2018 ;; Mark it as connected.
2019 (tramp-set-connection-property p "connected" t))
2021 ;; Check for the error reason. If it was due to wrong
2022 ;; password, reestablish the connection. We cannot
2023 ;; handle this in `tramp-process-actions', because
2024 ;; smbclient does not ask for the password, again.
2025 (error
2026 (with-current-buffer (tramp-get-connection-buffer vec)
2027 (goto-char (point-min))
2028 (if (and (bound-and-true-p auth-sources)
2029 (search-forward-regexp
2030 tramp-smb-wrong-passwd-regexp nil t))
2031 ;; Disable `auth-source' and `password-cache'.
2032 (let (auth-sources)
2033 (tramp-message
2034 vec 3 "Retry connection with new password")
2035 (tramp-cleanup-connection vec t)
2036 (tramp-smb-maybe-open-connection vec argument))
2037 ;; Propagate the error.
2038 (signal (car err) (cdr err)))))))))))))
2040 ;; We don't use timeouts. If needed, the caller shall wrap around.
2041 (defun tramp-smb-wait-for-output (vec)
2042 "Wait for output from smbclient command.
2043 Returns nil if an error message has appeared."
2044 (with-current-buffer (tramp-get-connection-buffer vec)
2045 (let ((p (get-buffer-process (current-buffer)))
2046 (found (progn (goto-char (point-min))
2047 (re-search-forward tramp-smb-prompt nil t)))
2048 (err (progn (goto-char (point-min))
2049 (re-search-forward tramp-smb-errors nil t)))
2050 buffer-read-only)
2052 ;; Algorithm: get waiting output. See if last line contains
2053 ;; `tramp-smb-prompt' sentinel or `tramp-smb-errors' strings.
2054 ;; If not, wait a bit and again get waiting output.
2055 (while (and (not found) (not err) (process-live-p p))
2057 ;; Accept pending output.
2058 (tramp-accept-process-output p 0.1)
2060 ;; Search for prompt.
2061 (goto-char (point-min))
2062 (setq found (re-search-forward tramp-smb-prompt nil t))
2064 ;; Search for errors.
2065 (goto-char (point-min))
2066 (setq err (re-search-forward tramp-smb-errors nil t)))
2068 ;; When the process is still alive, read pending output.
2069 (while (and (not found) (process-live-p p))
2071 ;; Accept pending output.
2072 (tramp-accept-process-output p 0.1)
2074 ;; Search for prompt.
2075 (goto-char (point-min))
2076 (setq found (re-search-forward tramp-smb-prompt nil t)))
2078 (tramp-message vec 6 "\n%s" (buffer-string))
2080 ;; Remove prompt.
2081 (when found
2082 (goto-char (point-max))
2083 (re-search-backward tramp-smb-prompt nil t)
2084 (delete-region (point) (point-max)))
2086 ;; Return value is whether no error message has appeared.
2087 (not err))))
2089 (defun tramp-smb-kill-winexe-function ()
2090 "Send SIGKILL to the winexe process."
2091 (ignore-errors
2092 (let ((p (get-buffer-process (current-buffer))))
2093 (when (process-live-p p)
2094 (signal-process (process-id p) 'SIGINT)))))
2096 (defun tramp-smb-call-winexe (vec)
2097 "Apply a remote command, if possible, using `tramp-smb-winexe-program'."
2099 ;; Check for program.
2100 (unless (executable-find tramp-smb-winexe-program)
2101 (tramp-error
2102 vec 'file-error "Cannot find program: %s" tramp-smb-winexe-program))
2104 ;; winexe does not supports ports.
2105 (when (tramp-file-name-port vec)
2106 (tramp-error vec 'file-error "Port not supported for remote processes"))
2108 (tramp-smb-maybe-open-connection
2110 (format
2111 "%s %s"
2112 tramp-smb-winexe-shell-command tramp-smb-winexe-shell-command-switch))
2114 (set (make-local-variable 'kill-buffer-hook)
2115 '(tramp-smb-kill-winexe-function))
2117 ;; Suppress "^M". Shouldn't we specify utf8?
2118 (set-process-coding-system (tramp-get-connection-process vec) 'raw-text-dos)
2120 ;; Set width to 128. This avoids mixing prompt and long error messages.
2121 (tramp-smb-send-command vec "$rawui = (Get-Host).UI.RawUI")
2122 (tramp-smb-send-command vec "$bufsize = $rawui.BufferSize")
2123 (tramp-smb-send-command vec "$winsize = $rawui.WindowSize")
2124 (tramp-smb-send-command vec "$bufsize.Width = 128")
2125 (tramp-smb-send-command vec "$winsize.Width = 128")
2126 (tramp-smb-send-command vec "$rawui.BufferSize = $bufsize")
2127 (tramp-smb-send-command vec "$rawui.WindowSize = $winsize"))
2129 (defun tramp-smb-shell-quote-argument (s)
2130 "Similar to `shell-quote-argument', but uses windows cmd syntax."
2131 (let ((system-type 'ms-dos))
2132 (tramp-unquote-shell-quote-argument s)))
2134 (add-hook 'tramp-unload-hook
2135 (lambda ()
2136 (unload-feature 'tramp-smb 'force)))
2138 (provide 'tramp-smb)
2140 ;;; TODO:
2142 ;; * Return more comprehensive file permission string.
2144 ;; * Try to remove the inclusion of dummy "" directory. Seems to be at
2145 ;; several places, especially in `tramp-smb-handle-insert-directory'.
2147 ;; * Ignore case in file names.
2149 ;;; tramp-smb.el ends here