dynwind fixes
[bpt/emacs.git] / lisp / net / tramp-smb.el
CommitLineData
bce04fee 1;;; tramp-smb.el --- Tramp access functions for SMB servers
4007ba5b 2
ba318903 3;; Copyright (C) 2002-2014 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))))
493ce45c 450 (args (list (concat "//" real-host "/" share) "-E")))
4efc33f0
MA
451
452 (if (not (zerop (length real-user)))
453 (setq args (append args (list "-U" real-user)))
454 (setq args (append args (list "-N"))))
455
456 (when domain (setq args (append args (list "-W" domain))))
457 (when port (setq args (append args (list "-p" port))))
458 (when tramp-smb-conf
459 (setq args (append args (list "-s" tramp-smb-conf))))
460 (setq args
461 (if t1
462 ;; Source is remote.
463 (append args
464 (list "-D" (shell-quote-argument localname)
465 "-c" (shell-quote-argument "tar qc - *")
466 "|" "tar" "xfC" "-"
467 (shell-quote-argument tmpdir)))
468 ;; Target is remote.
469 (append (list "tar" "cfC" "-"
470 (shell-quote-argument dirname) "." "|")
471 args
472 (list "-D" (shell-quote-argument localname)
473 "-c" (shell-quote-argument "tar qx -")))))
474
475 (unwind-protect
476 (with-temp-buffer
477 ;; Set the transfer process properties.
478 (tramp-set-connection-property
479 v "process-name" (buffer-name (current-buffer)))
480 (tramp-set-connection-property
481 v "process-buffer" (current-buffer))
482
483 (when t1
484 ;; The smbclient tar command creates always
485 ;; complete paths. We must emulate the
486 ;; directory structure, and symlink to the real
487 ;; target.
488 (make-directory
489 (expand-file-name
490 ".." (concat tmpdir localname)) 'parents)
491 (make-symbolic-link
492 newname (directory-file-name (concat tmpdir localname))))
493
494 ;; Use an asynchronous processes. By this,
495 ;; password can be handled.
496 (let* ((default-directory tmpdir)
493ce45c
MA
497 (p (apply
498 'start-process
4efc33f0
MA
499 (tramp-get-connection-name v)
500 (tramp-get-connection-buffer v)
493ce45c 501 tramp-smb-program args)))
4efc33f0
MA
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 ""))
50bfdd5d
MA
932 ;; Mark trailing "/".
933 (when (and (zerop (length (file-name-nondirectory filename)))
934 (not full-directory-p))
935 (setq switches (concat switches "F")))
d9320986
MA
936 (if full-directory-p
937 ;; Called from `dired-add-entry'.
938 (setq filename (file-name-as-directory filename))
939 (setq filename (directory-file-name filename)))
340b8d4f 940 (with-parsed-tramp-file-name filename nil
493ce45c
MA
941 (with-tramp-progress-reporter v 0 (format "Opening directory %s" filename)
942 (save-match-data
943 (let ((base (file-name-nondirectory filename))
944 ;; We should not destroy the cache entry.
945 (entries (copy-sequence
946 (tramp-smb-get-file-entries
947 (file-name-directory filename)))))
948
949 (when wildcard
950 (string-match "\\." base)
951 (setq base (replace-match "\\\\." nil nil base))
952 (string-match "\\*" base)
953 (setq base (replace-match ".*" nil nil base))
954 (string-match "\\?" base)
955 (setq base (replace-match ".?" nil nil base)))
956
957 ;; Filter entries.
958 (setq entries
959 (delq
960 nil
961 (if (or wildcard (zerop (length base)))
962 ;; Check for matching entries.
963 (mapcar
964 (lambda (x)
965 (when (string-match
966 (format "^%s" base) (nth 0 x))
967 x))
968 entries)
969 ;; We just need the only and only entry FILENAME.
970 (list (assoc base entries)))))
971
972 ;; Sort entries.
973 (setq entries
974 (sort
975 entries
976 (lambda (x y)
977 (if (string-match "t" switches)
978 ;; Sort by date.
979 (tramp-time-less-p (nth 3 y) (nth 3 x))
980 ;; Sort by name.
981 (string-lessp (nth 0 x) (nth 0 y))))))
982
983 ;; Handle "-F" switch.
984 (when (string-match "F" switches)
985 (mapc
986 (lambda (x)
987 (when (not (zerop (length (car x))))
988 (cond
989 ((char-equal ?d (string-to-char (nth 1 x)))
990 (setcar x (concat (car x) "/")))
991 ((char-equal ?x (string-to-char (nth 1 x)))
992 (setcar x (concat (car x) "*"))))))
993 entries))
994
995 ;; Print entries.
e61aad2f 996 (mapc
adb67129 997 (lambda (x)
493ce45c
MA
998 (when (not (zerop (length (nth 0 x))))
999 (when (string-match "l" switches)
1000 (let ((attr
1001 (when (tramp-smb-get-stat-capability v)
1002 (ignore-errors
1003 (file-attributes filename 'string)))))
1004 (insert
1005 (format
1006 "%10s %3d %-8s %-8s %8s %s "
1007 (or (nth 8 attr) (nth 1 x)) ; mode
1008 (or (nth 1 attr) 1) ; inode
1009 (or (nth 2 attr) "nobody") ; uid
1010 (or (nth 3 attr) "nogroup") ; gid
1011 (or (nth 7 attr) (nth 2 x)) ; size
1012 (format-time-string
1013 (if (tramp-time-less-p
1014 (tramp-time-subtract (current-time) (nth 3 x))
1015 tramp-half-a-year)
1016 "%b %e %R"
1017 "%b %e %Y")
1018 (nth 3 x)))))) ; date
1019
1020 ;; We mark the file name. The inserted name could be
1021 ;; from somewhere else, so we use the relative file name
1022 ;; of `default-directory'.
1023 (let ((start (point)))
d5b3979c
MA
1024 (insert
1025 (format
493ce45c
MA
1026 "%s\n"
1027 (file-relative-name
1028 (expand-file-name
1029 (nth 0 x) (file-name-directory filename))
1030 (when full-directory-p (file-name-directory filename)))))
1031 (put-text-property start (1- (point)) 'dired-filename t))
1032 (forward-line)
1033 (beginning-of-line)))
1034 entries))))))
4007ba5b
KG
1035
1036(defun tramp-smb-handle-make-directory (dir &optional parents)
00d6fd04 1037 "Like `make-directory' for Tramp files."
4007ba5b
KG
1038 (setq dir (directory-file-name (expand-file-name dir)))
1039 (unless (file-name-absolute-p dir)
00d6fd04 1040 (setq dir (expand-file-name dir default-directory)))
340b8d4f 1041 (with-parsed-tramp-file-name dir nil
4007ba5b 1042 (save-match-data
4260b402 1043 (let* ((ldir (file-name-directory dir)))
c2dc9732 1044 ;; Make missing directory parts.
4260b402
MA
1045 (when (and parents
1046 (tramp-smb-get-share v)
1047 (not (file-directory-p ldir)))
4007ba5b 1048 (make-directory ldir parents))
c2dc9732 1049 ;; Just do it.
4007ba5b 1050 (when (file-directory-p ldir)
8daea7fc 1051 (make-directory-internal dir))
4007ba5b 1052 (unless (file-directory-p dir)
00d6fd04 1053 (tramp-error v 'file-error "Couldn't make directory %s" dir))))))
4007ba5b
KG
1054
1055(defun tramp-smb-handle-make-directory-internal (directory)
00d6fd04 1056 "Like `make-directory-internal' for Tramp files."
4007ba5b
KG
1057 (setq directory (directory-file-name (expand-file-name directory)))
1058 (unless (file-name-absolute-p directory)
00d6fd04 1059 (setq directory (expand-file-name directory default-directory)))
340b8d4f 1060 (with-parsed-tramp-file-name directory nil
4007ba5b 1061 (save-match-data
4260b402 1062 (let* ((file (tramp-smb-get-localname v)))
4007ba5b 1063 (when (file-directory-p (file-name-directory directory))
f6f7e059
MA
1064 (tramp-smb-send-command
1065 v
4260b402 1066 (if (tramp-smb-get-cifs-capabilities v)
f6f7e059
MA
1067 (format
1068 "posix_mkdir \"%s\" %s"
0f34aa77 1069 file (tramp-compat-decimal-to-octal (default-file-modes)))
f6f7e059 1070 (format "mkdir \"%s\"" file)))
00d6fd04 1071 ;; We must also flush the cache of the directory, because
f6f7e059
MA
1072 ;; `file-attributes' reads the values from there.
1073 (tramp-flush-file-property v (file-name-directory localname))
1074 (tramp-flush-file-property v localname))
4007ba5b 1075 (unless (file-directory-p directory)
00d6fd04
MA
1076 (tramp-error
1077 v 'file-error "Couldn't make directory %s" directory))))))
4007ba5b 1078
f6f7e059
MA
1079(defun tramp-smb-handle-make-symbolic-link
1080 (filename linkname &optional ok-if-already-exists)
1081 "Like `make-symbolic-link' for Tramp files.
1082If LINKNAME is a non-Tramp file, it is used verbatim as the target of
1083the symlink. If LINKNAME is a Tramp file, only the localname component is
1084used as the target of the symlink.
1085
1086If LINKNAME is a Tramp file and the localname component is relative, then
1087it is expanded first, before the localname component is taken. Note that
1088this can give surprising results if the user/host for the source and
1089target of the symlink differ."
1090 (unless (tramp-equal-remote filename linkname)
1091 (with-parsed-tramp-file-name
1092 (if (tramp-tramp-file-p filename) filename linkname) nil
1093 (tramp-error
1094 v 'file-error
1095 "make-symbolic-link: %s"
1096 "only implemented for same method, same user, same host")))
1097 (with-parsed-tramp-file-name filename v1
1098 (with-parsed-tramp-file-name linkname v2
1099 (when (file-directory-p filename)
1100 (tramp-error
1101 v2 'file-error
1102 "make-symbolic-link: %s must not be a directory" filename))
1103 (when (and (not ok-if-already-exists)
1104 (file-exists-p linkname)
1105 (not (numberp ok-if-already-exists))
1106 (y-or-n-p
1107 (format
1108 "File %s already exists; make it a new name anyway? "
1109 linkname)))
1110 (tramp-error
1111 v2 'file-error
1112 "make-symbolic-link: file %s already exists" linkname))
1113 (unless (tramp-smb-get-cifs-capabilities v1)
1114 (tramp-error v2 'file-error "make-symbolic-link not supported"))
1115 ;; We must also flush the cache of the directory, because
1116 ;; `file-attributes' reads the values from there.
1117 (tramp-flush-file-property v2 (file-name-directory v2-localname))
1118 (tramp-flush-file-property v2 v2-localname)
1119 (unless
1120 (tramp-smb-send-command
1121 v1
1122 (format
1123 "symlink \"%s\" \"%s\""
4260b402
MA
1124 (tramp-smb-get-localname v1)
1125 (tramp-smb-get-localname v2)))
f6f7e059
MA
1126 (tramp-error
1127 v2 'file-error
1128 "error with make-symbolic-link, see buffer `%s' for details"
1129 (buffer-name))))))
1130
2fe4b125
MA
1131(defun tramp-smb-handle-process-file
1132 (program &optional infile destination display &rest args)
1133 "Like `process-file' for Tramp files."
1134 ;; The implementation is not complete yet.
1135 (when (and (numberp destination) (zerop destination))
1136 (error "Implementation does not handle immediate return"))
1137
1138 (with-parsed-tramp-file-name default-directory nil
1139 (let* ((name (file-name-nondirectory program))
1140 (name1 name)
1141 (i 0)
1142 input tmpinput outbuf command ret)
1143
1144 ;; Determine input.
1145 (when infile
1146 (setq infile (expand-file-name infile))
1147 (if (tramp-equal-remote default-directory infile)
1148 ;; INFILE is on the same remote host.
1149 (setq input (with-parsed-tramp-file-name infile nil localname))
1150 ;; INFILE must be copied to remote host.
1151 (setq input (tramp-make-tramp-temp-file v)
1152 tmpinput (tramp-make-tramp-file-name method user host input))
1153 (copy-file infile tmpinput t))
1154 ;; Transform input into a filename powershell does understand.
1155 (setq input (format "//%s%s" host input)))
1156
1157 ;; Determine output.
1158 (cond
1159 ;; Just a buffer.
1160 ((bufferp destination)
1161 (setq outbuf destination))
1162 ;; A buffer name.
1163 ((stringp destination)
1164 (setq outbuf (get-buffer-create destination)))
1165 ;; (REAL-DESTINATION ERROR-DESTINATION)
1166 ((consp destination)
1167 ;; output.
1168 (cond
1169 ((bufferp (car destination))
1170 (setq outbuf (car destination)))
1171 ((stringp (car destination))
1172 (setq outbuf (get-buffer-create (car destination))))
1173 ((car destination)
1174 (setq outbuf (current-buffer))))
1175 ;; stderr.
1176 (tramp-message v 2 "%s" "STDERR not supported"))
1177 ;; 't
1178 (destination
1179 (setq outbuf (current-buffer))))
1180
1181 ;; Construct command.
1182 (setq command (mapconcat 'identity (cons program args) " ")
1183 command (if input
1184 (format
1185 "get-content %s | & %s"
1186 (tramp-smb-shell-quote-argument input) command)
1187 (format "& %s" command)))
1188
1189 (while (get-process name1)
1190 ;; NAME must be unique as process name.
1191 (setq i (1+ i)
1192 name1 (format "%s<%d>" name i)))
1193
1194 ;; Set the new process properties.
1195 (tramp-set-connection-property v "process-name" name1)
1196 (tramp-set-connection-property
1197 v "process-buffer"
1198 (or outbuf (generate-new-buffer tramp-temp-buffer-name)))
1199
1200 ;; Call it.
1201 (condition-case nil
1202 (with-current-buffer (tramp-get-connection-buffer v)
1203 ;; Preserve buffer contents.
1204 (narrow-to-region (point-max) (point-max))
1205 (tramp-smb-call-winexe v)
1206 (when (tramp-smb-get-share v)
1207 (tramp-smb-send-command
1208 v (format "cd \"//%s%s\"" host (file-name-directory localname))))
1209 (tramp-smb-send-command v command)
1210 ;; Preserve command output.
1211 (narrow-to-region (point-max) (point-max))
1212 (let ((p (tramp-get-connection-process v)))
1213 (tramp-smb-send-command v "exit $lasterrorcode")
1214 (while (memq (process-status p) '(run open))
1215 (sleep-for 0.1)
1216 (setq ret (process-exit-status p))))
1217 (delete-region (point-min) (point-max))
1218 (widen))
1219
1220 ;; When the user did interrupt, we should do it also. We use
1221 ;; return code -1 as marker.
1222 (quit
1223 (setq ret -1))
1224 ;; Handle errors.
1225 (error
1226 (setq ret 1)))
1227
6692a64c
MA
1228 ;; We should redisplay the output.
1229 (when (and display outbuf (get-buffer-window outbuf t)) (redisplay))
2fe4b125
MA
1230
1231 ;; Cleanup. We remove all file cache values for the connection,
1232 ;; because the remote process could have changed them.
1233 (tramp-set-connection-property v "process-name" nil)
1234 (tramp-set-connection-property v "process-buffer" nil)
1235 (when tmpinput (delete-file tmpinput))
1236 (unless outbuf
1237 (kill-buffer (tramp-get-connection-property v "process-buffer" nil)))
1238
1239 ;; `process-file-side-effects' has been introduced with GNU
1240 ;; Emacs 23.2. If set to `nil', no remote file will be changed
1241 ;; by `program'. If it doesn't exist, we assume its default
1242 ;; value `t'.
1243 (unless (and (boundp 'process-file-side-effects)
1244 (not (symbol-value 'process-file-side-effects)))
1245 (tramp-flush-directory-property v ""))
1246
1247 ;; Return exit status.
1248 (if (equal ret -1)
1249 (keyboard-quit)
1250 ret))))
1251
4007ba5b
KG
1252(defun tramp-smb-handle-rename-file
1253 (filename newname &optional ok-if-already-exists)
00d6fd04 1254 "Like `rename-file' for Tramp files."
4007ba5b
KG
1255 (setq filename (expand-file-name filename)
1256 newname (expand-file-name newname))
2fe4b125
MA
1257
1258 (when (and (not ok-if-already-exists)
1259 (file-exists-p newname))
1260 (tramp-error
1261 (tramp-dissect-file-name
4c1f03ef 1262 (if (tramp-tramp-file-p filename) filename newname))
2fe4b125
MA
1263 'file-already-exists newname))
1264
1d51f99c 1265 (with-tramp-progress-reporter
4c1f03ef
MA
1266 (tramp-dissect-file-name
1267 (if (tramp-tramp-file-p filename) filename newname))
3b30ccda
MA
1268 0 (format "Renaming %s to %s" filename newname)
1269
af9ff9e8
MA
1270 (if (and (not (file-exists-p newname))
1271 (tramp-equal-remote filename newname)
2fe4b125
MA
1272 (string-equal
1273 (tramp-smb-get-share (tramp-dissect-file-name filename))
1274 (tramp-smb-get-share (tramp-dissect-file-name newname))))
1275 ;; We can rename directly.
1276 (with-parsed-tramp-file-name filename v1
1277 (with-parsed-tramp-file-name newname v2
1278
1279 ;; We must also flush the cache of the directory, because
1280 ;; `file-attributes' reads the values from there.
493ce45c
MA
1281 (tramp-flush-file-property v1 (file-name-directory v1-localname))
1282 (tramp-flush-file-property v1 v1-localname)
2fe4b125
MA
1283 (tramp-flush-file-property v2 (file-name-directory v2-localname))
1284 (tramp-flush-file-property v2 v2-localname)
1285 (unless (tramp-smb-get-share v2)
1286 (tramp-error
1287 v2 'file-error "Target `%s' must contain a share name" newname))
1288 (unless (tramp-smb-send-command
1289 v2 (format "rename \"%s\" \"%s\""
1290 (tramp-smb-get-localname v1)
1291 (tramp-smb-get-localname v2)))
1292 (tramp-error v2 'file-error "Cannot rename `%s'" filename))))
4007ba5b 1293
2fe4b125
MA
1294 ;; We must rename via copy.
1295 (tramp-compat-copy-file filename newname ok-if-already-exists t t t)
1296 (if (file-directory-p filename)
1297 (tramp-compat-delete-directory filename 'recursive)
1298 (delete-file filename)))))
4007ba5b 1299
4c1f03ef
MA
1300(defun tramp-smb-action-set-acl (proc vec)
1301 "Read ACL data from connection buffer."
1302 (when (not (memq (process-status proc) '(run open)))
1303 ;; Accept pending output.
1304 (while (tramp-accept-process-output proc 0.1))
1305 (with-current-buffer (tramp-get-connection-buffer vec)
1306 (tramp-message vec 10 "\n%s" (buffer-string))
1307 (throw 'tramp-action 'ok))))
1308
f19da8ad
MA
1309(defun tramp-smb-handle-set-file-acl (filename acl-string)
1310 "Like `set-file-acl' for Tramp files."
4c1f03ef
MA
1311 (ignore-errors
1312 (with-parsed-tramp-file-name filename nil
1313 (when (and (stringp acl-string) (executable-find tramp-smb-acl-program))
1314 (setq tramp-current-method (tramp-file-name-method v)
1315 tramp-current-user (tramp-file-name-user v)
1316 tramp-current-host (tramp-file-name-real-host v))
1317 (tramp-set-file-property v localname "file-acl" 'undef)
f19da8ad 1318
4c1f03ef
MA
1319 (let* ((real-user (tramp-file-name-real-user v))
1320 (real-host (tramp-file-name-real-host v))
1321 (domain (tramp-file-name-domain v))
1322 (port (tramp-file-name-port v))
1323 (share (tramp-smb-get-share v))
1324 (localname (tramp-compat-replace-regexp-in-string
1325 "\\\\" "/" (tramp-smb-get-localname v)))
1326 (args (list (concat "//" real-host "/" share) "-E" "-S"
1327 (tramp-compat-replace-regexp-in-string
1328 "\n" "," acl-string))))
1329
1330 (if (not (zerop (length real-user)))
1331 (setq args (append args (list "-U" real-user)))
1332 (setq args (append args (list "-N"))))
1333
1334 (when domain (setq args (append args (list "-W" domain))))
1335 (when port (setq args (append args (list "-p" port))))
1336 (when tramp-smb-conf
1337 (setq args (append args (list "-s" tramp-smb-conf))))
1338 (setq
1339 args
1340 (append args (list (shell-quote-argument localname)
1341 "&&" "echo" "tramp_exit_status" "0"
1342 "||" "echo" "tramp_exit_status" "1")))
1343
1344 (unwind-protect
1345 (with-temp-buffer
1346 ;; Set the transfer process properties.
1347 (tramp-set-connection-property
1348 v "process-name" (buffer-name (current-buffer)))
1349 (tramp-set-connection-property
1350 v "process-buffer" (current-buffer))
1351
1352 ;; Use an asynchronous processes. By this, password can
1353 ;; be handled.
1354 (let ((p (apply
493ce45c 1355 'start-process
4c1f03ef
MA
1356 (tramp-get-connection-name v)
1357 (tramp-get-connection-buffer v)
1358 tramp-smb-acl-program args)))
1359
1360 (tramp-message
1361 v 6 "%s" (mapconcat 'identity (process-command p) " "))
1362 (tramp-set-connection-property p "vector" v)
1363 (tramp-compat-set-process-query-on-exit-flag p nil)
1364 (tramp-process-actions p v nil tramp-smb-actions-set-acl)
1365 (goto-char (point-max))
1366 (unless (re-search-backward "tramp_exit_status [0-9]+" nil t)
1367 (tramp-error
1368 v 'file-error
1369 "Couldn't find exit status of `%s'" tramp-smb-acl-program))
1370 (skip-chars-forward "^ ")
1371 (when (zerop (read (current-buffer)))
1372 ;; Success.
1373 (tramp-set-file-property v localname "file-acl" acl-string)
1374 t)))
1375
1376 ;; Reset the transfer process properties.
1377 (tramp-set-connection-property v "process-name" nil)
1378 (tramp-set-connection-property v "process-buffer" nil)))))))
f19da8ad 1379
c2dc9732
MA
1380(defun tramp-smb-handle-set-file-modes (filename mode)
1381 "Like `set-file-modes' for Tramp files."
1382 (with-parsed-tramp-file-name filename nil
f6f7e059
MA
1383 (when (tramp-smb-get-cifs-capabilities v)
1384 (tramp-flush-file-property v localname)
1385 (unless (tramp-smb-send-command
1386 v (format "chmod \"%s\" %s"
4260b402 1387 (tramp-smb-get-localname v)
0f34aa77 1388 (tramp-compat-decimal-to-octal mode)))
f6f7e059
MA
1389 (tramp-error
1390 v 'file-error "Error while changing file's mode %s" filename)))))
c2dc9732 1391
2fe4b125
MA
1392;; We use BUFFER also as connection buffer during setup. Because of
1393;; this, its original contents must be saved, and restored once
1394;; connection has been setup.
1395(defun tramp-smb-handle-start-file-process (name buffer program &rest args)
1396 "Like `start-file-process' for Tramp files."
1397 (with-parsed-tramp-file-name default-directory nil
1398 (let ((command (mapconcat 'identity (cons program args) " "))
1399 (bmp (and (buffer-live-p buffer) (buffer-modified-p buffer)))
1400 (name1 name)
1401 (i 0))
1402 (unwind-protect
1403 (save-excursion
1404 (save-restriction
1405 (unless buffer
1406 ;; BUFFER can be nil. We use a temporary buffer.
1407 (setq buffer (generate-new-buffer tramp-temp-buffer-name)))
1408 (while (get-process name1)
1409 ;; NAME must be unique as process name.
1410 (setq i (1+ i)
1411 name1 (format "%s<%d>" name i)))
1412 ;; Set the new process properties.
1413 (tramp-set-connection-property v "process-name" name1)
1414 (tramp-set-connection-property v "process-buffer" buffer)
1415 ;; Activate narrowing in order to save BUFFER contents.
1416 (with-current-buffer (tramp-get-connection-buffer v)
1417 (let ((buffer-undo-list t))
1418 (narrow-to-region (point-max) (point-max))
1419 (tramp-smb-call-winexe v)
1420 (when (tramp-smb-get-share v)
1421 (tramp-smb-send-command
1422 v (format
1423 "cd \"//%s%s\""
1424 host (file-name-directory localname))))
1425 (tramp-message v 6 "(%s); exit" command)
1426 (tramp-send-string v command)))
1427 ;; Return value.
1428 (tramp-get-connection-process v)))
1429
1430 ;; Save exit.
1431 (with-current-buffer (tramp-get-connection-buffer v)
1432 (if (string-match tramp-temp-buffer-name (buffer-name))
1433 (progn
1434 (set-process-buffer (tramp-get-connection-process v) nil)
1435 (kill-buffer (current-buffer)))
1436 (set-buffer-modified-p bmp)))
1437 (tramp-set-connection-property v "process-name" nil)
1438 (tramp-set-connection-property v "process-buffer" nil)))))
1439
01917a18 1440(defun tramp-smb-handle-substitute-in-file-name (filename)
00d6fd04 1441 "Like `handle-substitute-in-file-name' for Tramp files.
b08104a0
MA
1442\"//\" substitutes only in the local filename part. Catches
1443errors for shares like \"C$/\", which are common in Microsoft Windows."
1444 (with-parsed-tramp-file-name filename nil
1445 ;; Ignore in LOCALNAME everything before "//".
1446 (when (and (stringp localname) (string-match ".+?/\\(/\\|~\\)" localname))
1447 (setq filename
1448 (concat (file-remote-p filename)
1449 (replace-match "\\1" nil nil localname)))))
01917a18
MA
1450 (condition-case nil
1451 (tramp-run-real-handler 'substitute-in-file-name (list filename))
1452 (error filename)))
1453
4007ba5b
KG
1454(defun tramp-smb-handle-write-region
1455 (start end filename &optional append visit lockname confirm)
00d6fd04 1456 "Like `write-region' for Tramp files."
4007ba5b 1457 (setq filename (expand-file-name filename))
340b8d4f 1458 (with-parsed-tramp-file-name filename nil
94be87e8 1459 ;; XEmacs takes a coding system as the seventh argument, not `confirm'.
00d6fd04
MA
1460 (when (and (not (featurep 'xemacs))
1461 confirm (file-exists-p filename))
1462 (unless (y-or-n-p (format "File %s exists; overwrite anyway? "
1463 filename))
1464 (tramp-error v 'file-error "File not overwritten")))
1465 ;; We must also flush the cache of the directory, because
b08104a0 1466 ;; `file-attributes' reads the values from there.
00d6fd04
MA
1467 (tramp-flush-file-property v (file-name-directory localname))
1468 (tramp-flush-file-property v localname)
4260b402 1469 (let ((curbuf (current-buffer))
258800f8 1470 (tmpfile (tramp-compat-make-temp-file filename)))
7ce8fcc3
MA
1471 (when (and append (file-exists-p filename))
1472 (copy-file filename tmpfile 'ok))
00d6fd04
MA
1473 ;; We say `no-message' here because we don't want the visited file
1474 ;; modtime data to be clobbered from the temp file. We call
1475 ;; `set-visited-file-modtime' ourselves later on.
1476 (tramp-run-real-handler
1477 'write-region
1478 (if confirm ; don't pass this arg unless defined for backward compat.
94be87e8
MA
1479 (list start end tmpfile append 'no-message lockname confirm)
1480 (list start end tmpfile append 'no-message lockname)))
00d6fd04 1481
1d51f99c 1482 (with-tramp-progress-reporter
3b30ccda
MA
1483 v 3 (format "Moving tmp file %s to %s" tmpfile filename)
1484 (unwind-protect
1485 (unless (tramp-smb-send-command
1486 v (format "put %s \"%s\""
1487 tmpfile (tramp-smb-get-localname v)))
1488 (tramp-error v 'file-error "Cannot write `%s'" filename))
eba082a2 1489 (delete-file tmpfile)))
00d6fd04 1490
00d6fd04
MA
1491 (unless (equal curbuf (current-buffer))
1492 (tramp-error
1493 v 'file-error
1494 "Buffer has changed from `%s' to `%s'" curbuf (current-buffer)))
1495 (when (eq visit t)
1496 (set-visited-file-modtime)))))
4007ba5b
KG
1497
1498
c2dc9732 1499;; Internal file name functions.
4007ba5b 1500
4260b402 1501(defun tramp-smb-get-share (vec)
7432277c 1502 "Returns the share name of LOCALNAME."
4007ba5b 1503 (save-match-data
4260b402
MA
1504 (let ((localname (tramp-file-name-localname vec)))
1505 (when (string-match "^/?\\([^/]+\\)/" localname)
1506 (match-string 1 localname)))))
4007ba5b 1507
4260b402 1508(defun tramp-smb-get-localname (vec)
7432277c 1509 "Returns the file name of LOCALNAME.
4260b402 1510If VEC has no cifs capabilities, exchange \"/\" by \"\\\\\"."
4007ba5b 1511 (save-match-data
4260b402 1512 (let ((localname (tramp-file-name-localname vec)))
4007ba5b 1513 (setq
4260b402
MA
1514 localname
1515 (if (string-match "^/?[^/]+\\(/.*\\)" localname)
22bcf204 1516 ;; There is a share, separated by "/".
4260b402
MA
1517 (if (not (tramp-smb-get-cifs-capabilities vec))
1518 (mapconcat
1519 (lambda (x) (if (equal x ?/) "\\" (char-to-string x)))
1520 (match-string 1 localname) "")
1521 (match-string 1 localname))
1522 ;; There is just a share.
1523 (if (string-match "^/?\\([^/]+\\)$" localname)
1524 (match-string 1 localname)
1525 "")))
4007ba5b 1526
c2dc9732 1527 ;; Sometimes we have discarded `substitute-in-file-name'.
4260b402
MA
1528 (when (string-match "\\(\\$\\$\\)\\(/\\|$\\)" localname)
1529 (setq localname (replace-match "$" nil nil localname 1)))
4007ba5b 1530
4260b402 1531 localname)))
4007ba5b
KG
1532
1533;; Share names of a host are cached. It is very unlikely that the
1534;; shares do change during connection.
00d6fd04
MA
1535(defun tramp-smb-get-file-entries (directory)
1536 "Read entries which match DIRECTORY.
4007ba5b 1537Either the shares are listed, or the `dir' command is executed.
7432277c 1538Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)."
4260b402 1539 (with-parsed-tramp-file-name (file-name-as-directory directory) nil
00d6fd04 1540 (setq localname (or localname "/"))
1d51f99c 1541 (with-tramp-file-property v localname "file-entries"
2fe4b125 1542 (with-current-buffer (tramp-get-connection-buffer v)
4260b402 1543 (let* ((share (tramp-smb-get-share v))
00d6fd04
MA
1544 (cache (tramp-get-connection-property v "share-cache" nil))
1545 res entry)
1546
1547 (if (and (not share) cache)
c2dc9732 1548 ;; Return cached shares.
00d6fd04
MA
1549 (setq res cache)
1550
c2dc9732 1551 ;; Read entries.
00d6fd04 1552 (if share
4260b402
MA
1553 (tramp-smb-send-command
1554 v (format "dir \"%s*\"" (tramp-smb-get-localname v)))
c2dc9732 1555 ;; `tramp-smb-maybe-open-connection' lists also the share names.
00d6fd04
MA
1556 (tramp-smb-maybe-open-connection v))
1557
c2dc9732 1558 ;; Loop the listing.
00d6fd04 1559 (goto-char (point-min))
4260b402
MA
1560 (if (re-search-forward tramp-smb-errors nil t)
1561 (tramp-error v 'file-error "%s `%s'" (match-string 0) directory)
00d6fd04
MA
1562 (while (not (eobp))
1563 (setq entry (tramp-smb-read-file-entry share))
1564 (forward-line)
af9ff9e8 1565 (when entry (push entry res))))
00d6fd04 1566
c2dc9732 1567 ;; Cache share entries.
00d6fd04
MA
1568 (unless share
1569 (tramp-set-connection-property v "share-cache" res)))
4007ba5b 1570
c2dc9732 1571 ;; Add directory itself.
af9ff9e8 1572 (push '("" "drwxrwxrwx" 0 (0 0)) res)
5ec2cc41 1573
00d6fd04
MA
1574 ;; There's a very strange error (debugged with XEmacs 21.4.14)
1575 ;; If there's no short delay, it returns nil. No idea about.
1576 (when (featurep 'xemacs) (sleep-for 0.01))
4007ba5b 1577
c2dc9732 1578 ;; Return entries.
00d6fd04 1579 (delq nil res))))))
4007ba5b 1580
c2dc9732 1581;; Return either a share name (if SHARE is nil), or a file name.
4007ba5b 1582;;
c2dc9732 1583;; If shares are listed, the following format is expected:
4007ba5b 1584;;
4260b402
MA
1585;; Disk| - leading spaces
1586;; [^|]+| - share name, 14 char
1587;; .* - comment
4007ba5b
KG
1588;;
1589;; Entries provided by smbclient DIR aren't fully regular.
1590;; They should have the format
1591;;
1592;; \s-\{2,2} - leading spaces
b1a2b924
KG
1593;; \S-\(.*\S-\)\s-* - file name, 30 chars, left bound
1594;; \s-+[ADHRSV]* - permissions, 7 chars, right bound
39b20f56 1595;; \s- - space delimiter
b1a2b924 1596;; \s-+[0-9]+ - size, 8 chars, right bound
39b20f56 1597;; \s-\{2,2\} - space delimiter
4007ba5b 1598;; \w\{3,3\} - weekday
39b20f56 1599;; \s- - space delimiter
b1a2b924 1600;; \w\{3,3\} - month
39b20f56 1601;; \s- - space delimiter
00d6fd04 1602;; [ 12][0-9] - day
39b20f56 1603;; \s- - space delimiter
4007ba5b 1604;; [0-9]\{2,2\}:[0-9]\{2,2\}:[0-9]\{2,2\} - time
39b20f56 1605;; \s- - space delimiter
4007ba5b
KG
1606;; [0-9]\{4,4\} - year
1607;;
b1a2b924
KG
1608;; samba/src/client.c (http://samba.org/doxygen/samba/client_8c-source.html)
1609;; has function display_finfo:
1610;;
1611;; d_printf(" %-30s%7.7s %8.0f %s",
1612;; finfo->name,
1613;; attrib_string(finfo->mode),
1614;; (double)finfo->size,
1615;; asctime(LocalTime(&t)));
1616;;
1617;; in Samba 1.9, there's the following code:
1618;;
1619;; DEBUG(0,(" %-30s%7.7s%10d %s",
1620;; CNV_LANG(finfo->name),
1621;; attrib_string(finfo->mode),
1622;; finfo->size,
1623;; asctime(LocalTime(&t))));
1624;;
4007ba5b
KG
1625;; Problems:
1626;; * Modern regexp constructs, like spy groups and counted repetitions, aren't
1627;; available in older Emacsen.
1628;; * The length of constructs (file name, size) might exceed the default.
1629;; * File names might contain spaces.
1630;; * Permissions might be empty.
1631;;
1632;; So we try to analyze backwards.
1633(defun tramp-smb-read-file-entry (share)
1634 "Parse entry in SMB output buffer.
1635If SHARE is result, entries are of type dir. Otherwise, shares are listed.
7432277c 1636Result is the list (LOCALNAME MODE SIZE MTIME)."
00d6fd04
MA
1637;; We are called from `tramp-smb-get-file-entries', which sets the
1638;; current buffer.
6e060cee 1639 (let ((line (buffer-substring (point) (point-at-eol)))
7432277c 1640 localname mode size month day hour min sec year mtime)
4007ba5b
KG
1641
1642 (if (not share)
1643
00d6fd04 1644 ;; Read share entries.
4260b402 1645 (when (string-match "^Disk|\\([^|]+\\)|" line)
7432277c 1646 (setq localname (match-string 1 line)
4007ba5b
KG
1647 mode "dr-xr-xr-x"
1648 size 0))
1649
00d6fd04 1650 ;; Real listing.
4007ba5b
KG
1651 (block nil
1652
c2dc9732 1653 ;; year.
4007ba5b
KG
1654 (if (string-match "\\([0-9]+\\)$" line)
1655 (setq year (string-to-number (match-string 1 line))
1656 line (substring line 0 -5))
1657 (return))
1658
c2dc9732 1659 ;; time.
4007ba5b
KG
1660 (if (string-match "\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)$" line)
1661 (setq hour (string-to-number (match-string 1 line))
1662 min (string-to-number (match-string 2 line))
1663 sec (string-to-number (match-string 3 line))
1664 line (substring line 0 -9))
1665 (return))
1666
c2dc9732 1667 ;; day.
4007ba5b
KG
1668 (if (string-match "\\([0-9]+\\)$" line)
1669 (setq day (string-to-number (match-string 1 line))
1670 line (substring line 0 -3))
1671 (return))
1672
c2dc9732 1673 ;; month.
4007ba5b
KG
1674 (if (string-match "\\(\\w+\\)$" line)
1675 (setq month (match-string 1 line)
1676 line (substring line 0 -4))
1677 (return))
1678
c2dc9732 1679 ;; weekday.
4007ba5b
KG
1680 (if (string-match "\\(\\w+\\)$" line)
1681 (setq line (substring line 0 -5))
1682 (return))
1683
c2dc9732 1684 ;; size.
4007ba5b 1685 (if (string-match "\\([0-9]+\\)$" line)
b1a2b924
KG
1686 (let ((length (- (max 10 (1+ (length (match-string 1 line)))))))
1687 (setq size (string-to-number (match-string 1 line)))
1688 (when (string-match "\\([ADHRSV]+\\)" (substring line length))
1689 (setq length (+ length (match-end 0))))
1690 (setq line (substring line 0 length)))
4007ba5b
KG
1691 (return))
1692
c2dc9732 1693 ;; mode: ARCH, DIR, HIDDEN, RONLY, SYSTEM, VOLID.
b1a2b924 1694 (if (string-match "\\([ADHRSV]+\\)?$" line)
4007ba5b 1695 (setq
b1a2b924 1696 mode (or (match-string 1 line) "")
4007ba5b
KG
1697 mode (save-match-data (format
1698 "%s%s"
1699 (if (string-match "D" mode) "d" "-")
1700 (mapconcat
5d89d9d2 1701 (lambda (_x) "") " "
4007ba5b 1702 (concat "r" (if (string-match "R" mode) "-" "w") "x"))))
4260b402 1703 line (substring line 0 -6))
4007ba5b
KG
1704 (return))
1705
c2dc9732 1706 ;; localname.
b1a2b924 1707 (if (string-match "^\\s-+\\(\\S-\\(.*\\S-\\)?\\)\\s-*$" line)
7432277c 1708 (setq localname (match-string 1 line))
4007ba5b
KG
1709 (return))))
1710
7432277c 1711 (when (and localname mode size)
4007ba5b
KG
1712 (setq mtime
1713 (if (and sec min hour day month year)
1714 (encode-time
1715 sec min hour day
00d6fd04 1716 (cdr (assoc (downcase month) tramp-parse-time-months))
4007ba5b
KG
1717 year)
1718 '(0 0)))
7432277c 1719 (list localname mode size mtime))))
4007ba5b 1720
f6f7e059
MA
1721(defun tramp-smb-get-cifs-capabilities (vec)
1722 "Check, whether the SMB server supports POSIX commands."
4260b402
MA
1723 ;; When we are not logged in yet, we return nil.
1724 (if (let ((p (tramp-get-connection-process vec)))
1725 (and p (processp p) (memq (process-status p) '(run open))))
1d51f99c 1726 (with-tramp-connection-property
4260b402 1727 (tramp-get-connection-process vec) "cifs-capabilities"
fc754ea1
MA
1728 (save-match-data
1729 (when (tramp-smb-send-command vec "posix")
2fe4b125 1730 (with-current-buffer (tramp-get-connection-buffer vec)
fc754ea1
MA
1731 (goto-char (point-min))
1732 (when
1733 (re-search-forward "Server supports CIFS capabilities" nil t)
1734 (member
1735 "pathnames"
1736 (split-string
6e060cee 1737 (buffer-substring (point) (point-at-eol)) nil t)))))))))
fc754ea1
MA
1738
1739(defun tramp-smb-get-stat-capability (vec)
1740 "Check, whether the SMB server supports the STAT command."
1741 ;; When we are not logged in yet, we return nil.
f19da8ad
MA
1742 (if (and (tramp-smb-get-share vec)
1743 (let ((p (tramp-get-connection-process vec)))
7ce8fcc3 1744 (and p (processp p) (memq (process-status p) '(run open)))))
1d51f99c 1745 (with-tramp-connection-property
fc754ea1 1746 (tramp-get-connection-process vec) "stat-capability"
f19da8ad 1747 (tramp-smb-send-command vec "stat \"/\""))))
f6f7e059 1748
4007ba5b 1749
c2dc9732 1750;; Connection functions.
4007ba5b 1751
00d6fd04
MA
1752(defun tramp-smb-send-command (vec command)
1753 "Send the COMMAND to connection VEC.
1754Returns nil if there has been an error message from smbclient."
1755 (tramp-smb-maybe-open-connection vec)
1756 (tramp-message vec 6 "%s" command)
1757 (tramp-send-string vec command)
1758 (tramp-smb-wait-for-output vec))
1759
2fe4b125 1760(defun tramp-smb-maybe-open-connection (vec &optional argument)
00d6fd04 1761 "Maybe open a connection to HOST, log in as USER, using `tramp-smb-program'.
4007ba5b 1762Does not do anything if a connection is already open, but re-opens the
2fe4b125
MA
1763connection if a previous connection has died for some reason.
1764If ARGUMENT is non-nil, use it as argument for
1765`tramp-smb-winexe-program', and suppress any checks."
35c3d36e 1766 (tramp-check-proper-method-and-host vec)
78fc2530 1767
4260b402 1768 (let* ((share (tramp-smb-get-share vec))
2fe4b125 1769 (buf (tramp-get-connection-buffer vec))
00d6fd04 1770 (p (get-buffer-process buf)))
340b8d4f 1771
c2dc9732
MA
1772 ;; Check whether we still have the same smbclient version.
1773 ;; Otherwise, we must delete the connection cache, because
1774 ;; capabilities migh have changed.
2fe4b125 1775 (unless (or argument (processp p))
fc754ea1
MA
1776 (let ((default-directory (tramp-compat-temporary-file-directory))
1777 (command (concat tramp-smb-program " -V")))
1778
1779 (unless tramp-smb-version
1780 (unless (executable-find tramp-smb-program)
1781 (tramp-error
1782 vec 'file-error
1783 "Cannot find command %s in %s" tramp-smb-program exec-path))
1784 (setq tramp-smb-version (shell-command-to-string command))
1785 (tramp-message vec 6 command)
1786 (tramp-message vec 6 "\n%s" tramp-smb-version)
1787 (if (string-match "[ \t\n\r]+\\'" tramp-smb-version)
1788 (setq tramp-smb-version
1789 (replace-match "" nil nil tramp-smb-version))))
1790
1791 (unless (string-equal
1792 tramp-smb-version
1793 (tramp-get-connection-property
1794 vec "smbclient-version" tramp-smb-version))
4260b402
MA
1795 (tramp-flush-directory-property vec "")
1796 (tramp-flush-connection-property vec))
fc754ea1
MA
1797
1798 (tramp-set-connection-property
1799 vec "smbclient-version" tramp-smb-version)))
c2dc9732 1800
00d6fd04 1801 ;; If too much time has passed since last command was sent, look
c2dc9732
MA
1802 ;; whether there has been an error message; maybe due to
1803 ;; connection timeout.
00d6fd04
MA
1804 (with-current-buffer buf
1805 (goto-char (point-min))
1806 (when (and (> (tramp-time-diff
1807 (current-time)
1808 (tramp-get-connection-property
1809 p "last-cmd-time" '(0 0 0)))
1810 60)
1811 p (processp p) (memq (process-status p) '(run open))
1812 (re-search-forward tramp-smb-errors nil t))
1813 (delete-process p)
1814 (setq p nil)))
1815
1816 ;; Check whether it is still the same share.
1817 (unless
1818 (and p (processp p) (memq (process-status p) '(run open))
2fe4b125
MA
1819 (or argument
1820 (string-equal
1821 share
1822 (tramp-get-connection-property p "smb-share" ""))))
00d6fd04
MA
1823
1824 (save-match-data
1825 ;; There might be unread output from checking for share names.
1826 (when buf (with-current-buffer buf (erase-buffer)))
1827 (when (and p (processp p)) (delete-process p))
1828
36a3859f
MA
1829 (let* ((user (tramp-file-name-user vec))
1830 (host (tramp-file-name-host vec))
1831 (real-user (tramp-file-name-real-user vec))
1832 (real-host (tramp-file-name-real-host vec))
1833 (domain (tramp-file-name-domain vec))
1834 (port (tramp-file-name-port vec))
1835 args)
00d6fd04 1836
2fe4b125
MA
1837 (cond
1838 (argument
1839 (setq args (list (concat "//" real-host))))
1840 (share
1841 (setq args (list (concat "//" real-host "/" share))))
1842 (t
1843 (setq args (list "-g" "-L" real-host ))))
00d6fd04
MA
1844
1845 (if (not (zerop (length real-user)))
1846 (setq args (append args (list "-U" real-user)))
1847 (setq args (append args (list "-N"))))
1848
1849 (when domain (setq args (append args (list "-W" domain))))
1850 (when port (setq args (append args (list "-p" port))))
0536254e
MA
1851 (when tramp-smb-conf
1852 (setq args (append args (list "-s" tramp-smb-conf))))
2fe4b125
MA
1853 (when argument
1854 (setq args (append args (list argument))))
00d6fd04
MA
1855
1856 ;; OK, let's go.
1d51f99c 1857 (with-tramp-progress-reporter
3b30ccda
MA
1858 vec 3
1859 (format "Opening connection for //%s%s/%s"
1860 (if (not (zerop (length user))) (concat user "@") "")
1861 host (or share ""))
1862
1863 (let* ((coding-system-for-read nil)
1864 (process-connection-type tramp-process-connection-type)
1865 (p (let ((default-directory
1866 (tramp-compat-temporary-file-directory)))
1867 (apply #'start-process
2fe4b125
MA
1868 (tramp-get-connection-name vec)
1869 (tramp-get-connection-buffer vec)
1870 (if argument
1871 tramp-smb-winexe-program tramp-smb-program)
1872 args))))
3b30ccda
MA
1873
1874 (tramp-message
1875 vec 6 "%s" (mapconcat 'identity (process-command p) " "))
4c1f03ef 1876 (tramp-set-connection-property p "vector" vec)
bd8fadca 1877 (tramp-compat-set-process-query-on-exit-flag p nil)
3b30ccda
MA
1878
1879 ;; Set variables for computing the prompt for reading password.
1880 (setq tramp-current-method tramp-smb-method
1881 tramp-current-user user
1882 tramp-current-host host)
1883
2fe4b125
MA
1884 (condition-case err
1885 (let (tramp-message-show-message)
1886 ;; Play login scenario.
1887 (tramp-process-actions
1888 p vec nil
1889 (if (or argument share)
1890 tramp-smb-actions-with-share
1891 tramp-smb-actions-without-share))
1892
1893 ;; Check server version.
1894 (unless argument
1895 (with-current-buffer (tramp-get-connection-buffer vec)
1896 (goto-char (point-min))
1897 (search-forward-regexp tramp-smb-server-version nil t)
1898 (let ((smbserver-version (match-string 0)))
1899 (unless
1900 (string-equal
1901 smbserver-version
1902 (tramp-get-connection-property
1903 vec "smbserver-version" smbserver-version))
1904 (tramp-flush-directory-property vec "")
1905 (tramp-flush-connection-property vec))
1906 (tramp-set-connection-property
1907 vec "smbserver-version" smbserver-version))))
1908
f7eac6d8
MA
1909 ;; Set chunksize to 1. smbclient reads its input
1910 ;; character by character; if we send the string
1911 ;; at once, it is read painfully slow.
2fe4b125 1912 (tramp-set-connection-property p "smb-share" share)
f7eac6d8 1913 (tramp-set-connection-property p "chunksize" 1))
2fe4b125
MA
1914
1915 ;; Check for the error reason. If it was due to wrong
1916 ;; password, reestablish the connection. We cannot
1917 ;; handle this in `tramp-process-actions', because
1918 ;; smbclient does not ask for the password, again.
1919 (error
1920 (with-current-buffer (tramp-get-connection-buffer vec)
1921 (goto-char (point-min))
af9ff9e8
MA
1922 (if (and (boundp 'auth-sources)
1923 (symbol-value 'auth-sources)
1924 (search-forward-regexp
1925 tramp-smb-wrong-passwd-regexp nil t))
2fe4b125
MA
1926 ;; Disable `auth-source' and `password-cache'.
1927 (let (auth-sources)
f0ff1cd5
MA
1928 (tramp-message
1929 vec 3 "Retry connection with new password")
6480194c 1930 (tramp-cleanup-connection vec t)
2fe4b125
MA
1931 (tramp-smb-maybe-open-connection vec argument))
1932 ;; Propagate the error.
1933 (signal (car err) (cdr err)))))))))))))
4007ba5b
KG
1934
1935;; We don't use timeouts. If needed, the caller shall wrap around.
00d6fd04 1936(defun tramp-smb-wait-for-output (vec)
4007ba5b 1937 "Wait for output from smbclient command.
4007ba5b 1938Returns nil if an error message has appeared."
2fe4b125 1939 (with-current-buffer (tramp-get-connection-buffer vec)
00d6fd04
MA
1940 (let ((p (get-buffer-process (current-buffer)))
1941 (found (progn (goto-char (point-min))
1942 (re-search-forward tramp-smb-prompt nil t)))
1943 (err (progn (goto-char (point-min))
710dec63
MA
1944 (re-search-forward tramp-smb-errors nil t)))
1945 buffer-read-only)
5ec2cc41 1946
00d6fd04 1947 ;; Algorithm: get waiting output. See if last line contains
710dec63 1948 ;; `tramp-smb-prompt' sentinel or `tramp-smb-errors' strings.
00d6fd04 1949 ;; If not, wait a bit and again get waiting output.
710dec63 1950 (while (and (not found) (not err) (memq (process-status p) '(run open)))
5ec2cc41 1951
00d6fd04 1952 ;; Accept pending output.
f7eac6d8 1953 (tramp-accept-process-output p 0.1)
4007ba5b 1954
00d6fd04
MA
1955 ;; Search for prompt.
1956 (goto-char (point-min))
1957 (setq found (re-search-forward tramp-smb-prompt nil t))
4007ba5b 1958
00d6fd04
MA
1959 ;; Search for errors.
1960 (goto-char (point-min))
1961 (setq err (re-search-forward tramp-smb-errors nil t)))
4007ba5b 1962
00d6fd04
MA
1963 ;; When the process is still alive, read pending output.
1964 (while (and (not found) (memq (process-status p) '(run open)))
4007ba5b 1965
00d6fd04 1966 ;; Accept pending output.
f7eac6d8 1967 (tramp-accept-process-output p 0.1)
4007ba5b 1968
00d6fd04
MA
1969 ;; Search for prompt.
1970 (goto-char (point-min))
1971 (setq found (re-search-forward tramp-smb-prompt nil t)))
4007ba5b 1972
00d6fd04 1973 (tramp-message vec 6 "\n%s" (buffer-string))
2fe4b125
MA
1974
1975 ;; Remove prompt.
1976 (when found
1977 (goto-char (point-max))
1978 (re-search-backward tramp-smb-prompt nil t)
1979 (delete-region (point) (point-max)))
1980
1981 ;; Return value is whether no error message has appeared.
00d6fd04 1982 (not err))))
4007ba5b 1983
2fe4b125
MA
1984(defun tramp-smb-kill-winexe-function ()
1985 "Send SIGKILL to the winexe process."
1986 (ignore-errors
1987 (let ((p (get-buffer-process (current-buffer))))
1988 (when (and p (processp p) (memq (process-status p) '(run open)))
1989 (signal-process (process-id p) 'SIGINT)))))
1990
1991(defun tramp-smb-call-winexe (vec)
1992 "Apply a remote command, if possible, using `tramp-smb-winexe-program'."
1993
2fe4b125 1994 ;; Check for program.
a43dc424 1995 (unless (executable-find tramp-smb-winexe-program)
2fe4b125
MA
1996 (tramp-error
1997 vec 'file-error "Cannot find program: %s" tramp-smb-winexe-program))
1998
1999 ;; winexe does not supports ports.
2000 (when (tramp-file-name-port vec)
2001 (tramp-error vec 'file-error "Port not supported for remote processes"))
2002
2003 (tramp-smb-maybe-open-connection
2004 vec
2005 (format
2006 "%s %s"
2007 tramp-smb-winexe-shell-command tramp-smb-winexe-shell-command-switch))
2008
2009 (set (make-local-variable 'kill-buffer-hook)
2010 '(tramp-smb-kill-winexe-function))
2011
2012 ;; Suppress "^M". Shouldn't we specify utf8?
2013 (set-process-coding-system (tramp-get-connection-process vec) 'raw-text-dos)
2014
2015 ;; Set width to 128. This avoids mixing prompt and long error messages.
2016 (tramp-smb-send-command vec "$rawui = (Get-Host).UI.RawUI")
2017 (tramp-smb-send-command vec "$bufsize = $rawui.BufferSize")
2018 (tramp-smb-send-command vec "$winsize = $rawui.WindowSize")
2019 (tramp-smb-send-command vec "$bufsize.Width = 128")
2020 (tramp-smb-send-command vec "$winsize.Width = 128")
2021 (tramp-smb-send-command vec "$rawui.BufferSize = $bufsize")
2022 (tramp-smb-send-command vec "$rawui.WindowSize = $winsize"))
2023
2024(defun tramp-smb-shell-quote-argument (s)
2025 "Similar to `shell-quote-argument', but uses windows cmd syntax."
2026 (let ((system-type 'ms-dos))
2027 (shell-quote-argument s)))
2028
0f34aa77
MA
2029(add-hook 'tramp-unload-hook
2030 (lambda ()
2031 (unload-feature 'tramp-smb 'force)))
4007ba5b 2032
4007ba5b
KG
2033(provide 'tramp-smb)
2034
2035;;; TODO:
2036
c2dc9732 2037;; * Return more comprehensive file permission string.
4007ba5b
KG
2038;; * Try to remove the inclusion of dummy "" directory. Seems to be at
2039;; several places, especially in `tramp-smb-handle-insert-directory'.
710dec63 2040;; * Ignore case in file names.
4007ba5b
KG
2041
2042;;; tramp-smb.el ends here