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