Commit | Line | Data |
---|---|---|
bce04fee | 1 | ;;; tramp-smb.el --- Tramp access functions for SMB servers |
4007ba5b | 2 | |
47e02af4 MA |
3 | ;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, |
4 | ;; 2008 Free Software Foundation, Inc. | |
4007ba5b | 5 | |
340b8d4f | 6 | ;; Author: Michael Albinus <michael.albinus@gmx.de> |
4007ba5b KG |
7 | ;; Keywords: comm, processes |
8 | ||
9 | ;; This file is part of GNU Emacs. | |
10 | ||
11 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
12 | ;; it under the terms of the GNU General Public License as published by | |
ceaeecb0 | 13 | ;; the Free Software Foundation; either version 3, or (at your option) |
4007ba5b KG |
14 | ;; any later version. |
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 | |
00d6fd04 MA |
22 | ;; along with GNU Emacs; see the file COPYING. If not, see |
23 | ;; <http://www.gnu.org/licenses/>. | |
4007ba5b KG |
24 | |
25 | ;;; Commentary: | |
26 | ||
27 | ;; Access functions for SMB servers like SAMBA or M$ Windows from Tramp. | |
28 | ||
29 | ;;; Code: | |
30 | ||
31 | (require 'tramp) | |
00d6fd04 | 32 | (require 'tramp-cache) |
9e6ab520 | 33 | (require 'tramp-compat) |
4007ba5b | 34 | |
4007ba5b KG |
35 | ;; Define SMB method ... |
36 | (defcustom tramp-smb-method "smb" | |
37 | "*Method to connect SAMBA and M$ SMB servers." | |
38 | :group 'tramp | |
39 | :type 'string) | |
40 | ||
41 | ;; ... and add it to the method list. | |
42 | (add-to-list 'tramp-methods (cons tramp-smb-method nil)) | |
43 | ||
44 | ;; Add a default for `tramp-default-method-alist'. Rule: If there is | |
45 | ;; a domain in USER, it must be the SMB method. | |
46 | (add-to-list 'tramp-default-method-alist | |
00d6fd04 MA |
47 | `(nil "%" ,tramp-smb-method)) |
48 | ||
49 | ;; Add a default for `tramp-default-user-alist'. Rule: For the SMB method, | |
50 | ;; the anonymous user is chosen. | |
51 | (add-to-list 'tramp-default-user-alist | |
52 | `(,tramp-smb-method nil "")) | |
4007ba5b KG |
53 | |
54 | ;; Add completion function for SMB method. | |
55 | (tramp-set-completion-function | |
56 | tramp-smb-method | |
57 | '((tramp-parse-netrc "~/.netrc"))) | |
58 | ||
59 | (defcustom tramp-smb-program "smbclient" | |
60 | "*Name of SMB client to run." | |
61 | :group 'tramp | |
62 | :type 'string) | |
63 | ||
340b8d4f | 64 | (defconst tramp-smb-prompt "^smb: .+> \\|^\\s-+Server\\s-+Comment$" |
4007ba5b KG |
65 | "Regexp used as prompt in smbclient.") |
66 | ||
67 | (defconst tramp-smb-errors | |
00d6fd04 | 68 | ;; `regexp-opt' not possible because of first string. |
4007ba5b KG |
69 | (mapconcat |
70 | 'identity | |
00d6fd04 | 71 | '(;; Connection error / timeout |
4007ba5b | 72 | "Connection to \\S-+ failed" |
00d6fd04 | 73 | "Read from server failed, maybe it closed the connection" |
d037d501 | 74 | "Call timed out: server did not respond" |
00d6fd04 | 75 | ;; Samba |
4007ba5b | 76 | "ERRDOS" |
5ec2cc41 | 77 | "ERRSRV" |
4007ba5b KG |
78 | "ERRbadfile" |
79 | "ERRbadpw" | |
80 | "ERRfilexists" | |
81 | "ERRnoaccess" | |
82 | "ERRnomem" | |
83 | "ERRnosuchshare" | |
00d6fd04 MA |
84 | ;; Windows 4.0 (Windows NT), Windows 5.0 (Windows 2000), |
85 | ;; Windows 5.1 (Windows XP), Windows 5.2 (Windows Server 2003) | |
4007ba5b | 86 | "NT_STATUS_ACCESS_DENIED" |
5ec2cc41 | 87 | "NT_STATUS_ACCOUNT_LOCKED_OUT" |
4007ba5b KG |
88 | "NT_STATUS_BAD_NETWORK_NAME" |
89 | "NT_STATUS_CANNOT_DELETE" | |
00d6fd04 MA |
90 | "NT_STATUS_DIRECTORY_NOT_EMPTY" |
91 | "NT_STATUS_DUPLICATE_NAME" | |
92 | "NT_STATUS_FILE_IS_A_DIRECTORY" | |
4007ba5b | 93 | "NT_STATUS_LOGON_FAILURE" |
5ec2cc41 | 94 | "NT_STATUS_NETWORK_ACCESS_DENIED" |
4007ba5b | 95 | "NT_STATUS_NO_SUCH_FILE" |
00d6fd04 | 96 | "NT_STATUS_OBJECT_NAME_COLLISION" |
4007ba5b KG |
97 | "NT_STATUS_OBJECT_NAME_INVALID" |
98 | "NT_STATUS_OBJECT_NAME_NOT_FOUND" | |
5ec2cc41 | 99 | "NT_STATUS_SHARING_VIOLATION" |
00d6fd04 | 100 | "NT_STATUS_TRUSTED_RELATIONSHIP_FAILURE" |
5ec2cc41 | 101 | "NT_STATUS_WRONG_PASSWORD") |
4007ba5b KG |
102 | "\\|") |
103 | "Regexp for possible error strings of SMB servers. | |
104 | Used instead of analyzing error codes of commands.") | |
105 | ||
00d6fd04 MA |
106 | (defconst tramp-smb-actions-with-share |
107 | '((tramp-smb-prompt tramp-action-succeed) | |
108 | (tramp-password-prompt-regexp tramp-action-password) | |
109 | (tramp-wrong-passwd-regexp tramp-action-permission-denied) | |
110 | (tramp-smb-errors tramp-action-permission-denied) | |
111 | (tramp-process-alive-regexp tramp-action-process-alive)) | |
112 | "List of pattern/action pairs. | |
113 | This list is used for login to SMB servers. | |
114 | ||
115 | See `tramp-actions-before-shell' for more info.") | |
4007ba5b | 116 | |
00d6fd04 MA |
117 | (defconst tramp-smb-actions-without-share |
118 | '((tramp-password-prompt-regexp tramp-action-password) | |
119 | (tramp-wrong-passwd-regexp tramp-action-permission-denied) | |
120 | (tramp-smb-errors tramp-action-permission-denied) | |
121 | (tramp-process-alive-regexp tramp-action-out-of-band)) | |
122 | "List of pattern/action pairs. | |
123 | This list is used for login to SMB servers. | |
4007ba5b | 124 | |
00d6fd04 | 125 | See `tramp-actions-before-shell' for more info.") |
8daea7fc | 126 | |
4007ba5b KG |
127 | ;; New handlers should be added here. |
128 | (defconst tramp-smb-file-name-handler-alist | |
129 | '( | |
130 | ;; `access-file' performed by default handler | |
131 | (add-name-to-file . tramp-smb-handle-copy-file) ;; we're on Windows, honey. | |
132 | ;; `byte-compiler-base-file-name' performed by default handler | |
133 | (copy-file . tramp-smb-handle-copy-file) | |
134 | (delete-directory . tramp-smb-handle-delete-directory) | |
135 | (delete-file . tramp-smb-handle-delete-file) | |
136 | ;; `diff-latest-backup-file' performed by default handler | |
8daea7fc | 137 | (directory-file-name . tramp-handle-directory-file-name) |
4007ba5b KG |
138 | (directory-files . tramp-smb-handle-directory-files) |
139 | (directory-files-and-attributes . tramp-smb-handle-directory-files-and-attributes) | |
00d6fd04 MA |
140 | (dired-call-process . ignore) |
141 | (dired-compress-file . ignore) | |
4007ba5b KG |
142 | ;; `dired-uncache' performed by default handler |
143 | ;; `expand-file-name' not necessary because we cannot expand "~/" | |
144 | (file-accessible-directory-p . tramp-smb-handle-file-directory-p) | |
145 | (file-attributes . tramp-smb-handle-file-attributes) | |
146 | (file-directory-p . tramp-smb-handle-file-directory-p) | |
147 | (file-executable-p . tramp-smb-handle-file-exists-p) | |
148 | (file-exists-p . tramp-smb-handle-file-exists-p) | |
149 | (file-local-copy . tramp-smb-handle-file-local-copy) | |
19a87064 | 150 | (file-remote-p . tramp-handle-file-remote-p) |
4007ba5b KG |
151 | (file-modes . tramp-handle-file-modes) |
152 | (file-name-all-completions . tramp-smb-handle-file-name-all-completions) | |
153 | ;; `file-name-as-directory' performed by default handler | |
154 | (file-name-completion . tramp-handle-file-name-completion) | |
155 | (file-name-directory . tramp-handle-file-name-directory) | |
156 | (file-name-nondirectory . tramp-handle-file-name-nondirectory) | |
157 | ;; `file-name-sans-versions' performed by default handler | |
158 | (file-newer-than-file-p . tramp-smb-handle-file-newer-than-file-p) | |
00d6fd04 | 159 | (file-ownership-preserved-p . ignore) |
4007ba5b KG |
160 | (file-readable-p . tramp-smb-handle-file-exists-p) |
161 | (file-regular-p . tramp-handle-file-regular-p) | |
00d6fd04 | 162 | (file-symlink-p . tramp-handle-file-symlink-p) |
4007ba5b KG |
163 | ;; `file-truename' performed by default handler |
164 | (file-writable-p . tramp-smb-handle-file-writable-p) | |
38c65fca | 165 | (find-backup-file-name . tramp-handle-find-backup-file-name) |
4007ba5b KG |
166 | ;; `find-file-noselect' performed by default handler |
167 | ;; `get-file-buffer' performed by default handler | |
168 | (insert-directory . tramp-smb-handle-insert-directory) | |
169 | (insert-file-contents . tramp-handle-insert-file-contents) | |
170 | (load . tramp-handle-load) | |
171 | (make-directory . tramp-smb-handle-make-directory) | |
172 | (make-directory-internal . tramp-smb-handle-make-directory-internal) | |
00d6fd04 | 173 | (make-symbolic-link . ignore) |
4007ba5b | 174 | (rename-file . tramp-smb-handle-rename-file) |
00d6fd04 MA |
175 | (set-file-modes . ignore) |
176 | (set-visited-file-modtime . ignore) | |
177 | (shell-command . ignore) | |
01917a18 | 178 | (substitute-in-file-name . tramp-smb-handle-substitute-in-file-name) |
4007ba5b | 179 | (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory) |
00d6fd04 MA |
180 | (vc-registered . ignore) |
181 | (verify-visited-file-modtime . ignore) | |
4007ba5b KG |
182 | (write-region . tramp-smb-handle-write-region) |
183 | ) | |
184 | "Alist of handler functions for Tramp SMB method. | |
185 | Operations not mentioned here will be handled by the default Emacs primitives.") | |
186 | ||
187 | (defun tramp-smb-file-name-p (filename) | |
188 | "Check if it's a filename for SMB servers." | |
189 | (let ((v (tramp-dissect-file-name filename))) | |
00d6fd04 | 190 | (string= (tramp-file-name-method v) tramp-smb-method))) |
4007ba5b KG |
191 | |
192 | (defun tramp-smb-file-name-handler (operation &rest args) | |
193 | "Invoke the SMB related OPERATION. | |
194 | First arg specifies the OPERATION, second arg is a list of arguments to | |
195 | pass to the OPERATION." | |
196 | (let ((fn (assoc operation tramp-smb-file-name-handler-alist))) | |
197 | (if fn | |
00d6fd04 | 198 | (save-match-data (apply (cdr fn) args)) |
4007ba5b KG |
199 | (tramp-run-real-handler operation args)))) |
200 | ||
201 | (add-to-list 'tramp-foreign-file-name-handler-alist | |
202 | (cons 'tramp-smb-file-name-p 'tramp-smb-file-name-handler)) | |
203 | ||
204 | ||
205 | ;; File name primitives | |
206 | ||
4007ba5b | 207 | (defun tramp-smb-handle-copy-file |
a4aeb9a4 | 208 | (filename newname &optional ok-if-already-exists keep-date preserve-uid-gid) |
00d6fd04 | 209 | "Like `copy-file' for Tramp files. |
a4aeb9a4 MA |
210 | KEEP-DATE is not handled in case NEWNAME resides on an SMB server. |
211 | PRESERVE-UID-GID is completely ignored." | |
4007ba5b KG |
212 | (setq filename (expand-file-name filename) |
213 | newname (expand-file-name newname)) | |
214 | ||
215 | (let ((tmpfile (file-local-copy filename))) | |
216 | ||
217 | (if tmpfile | |
00d6fd04 | 218 | ;; Remote filename. |
4007ba5b KG |
219 | (rename-file tmpfile newname ok-if-already-exists) |
220 | ||
00d6fd04 | 221 | ;; Remote newname. |
4007ba5b KG |
222 | (when (file-directory-p newname) |
223 | (setq newname (expand-file-name | |
224 | (file-name-nondirectory filename) newname))) | |
4007ba5b | 225 | |
340b8d4f | 226 | (with-parsed-tramp-file-name newname nil |
00d6fd04 MA |
227 | (when (and (not ok-if-already-exists) |
228 | (file-exists-p newname)) | |
229 | (tramp-error v 'file-already-exists newname)) | |
230 | ||
231 | ;; We must also flush the cache of the directory, because | |
232 | ;; file-attributes reads the values from there. | |
233 | (tramp-flush-file-property v (file-name-directory localname)) | |
234 | (tramp-flush-file-property v localname) | |
235 | (let ((share (tramp-smb-get-share localname)) | |
236 | (file (tramp-smb-get-localname localname t))) | |
237 | (unless share | |
238 | (tramp-error | |
239 | v 'file-error "Target `%s' must contain a share name" newname)) | |
240 | (tramp-message v 0 "Copying file %s to file %s..." filename newname) | |
241 | (if (tramp-smb-send-command | |
242 | v (format "put %s \"%s\"" filename file)) | |
243 | (tramp-message | |
244 | v 0 "Copying file %s to file %s...done" filename newname) | |
245 | (tramp-error v 'file-error "Cannot copy `%s'" filename))))))) | |
4007ba5b KG |
246 | |
247 | (defun tramp-smb-handle-delete-directory (directory) | |
00d6fd04 | 248 | "Like `delete-directory' for Tramp files." |
4007ba5b | 249 | (setq directory (directory-file-name (expand-file-name directory))) |
340b8d4f MA |
250 | (when (file-exists-p directory) |
251 | (with-parsed-tramp-file-name directory nil | |
00d6fd04 MA |
252 | ;; We must also flush the cache of the directory, because |
253 | ;; file-attributes reads the values from there. | |
254 | (tramp-flush-file-property v (file-name-directory localname)) | |
255 | (tramp-flush-directory-property v localname) | |
256 | (let ((dir (tramp-smb-get-localname (file-name-directory localname) t)) | |
257 | (file (file-name-nondirectory localname))) | |
258 | (unwind-protect | |
259 | (unless (and | |
260 | (tramp-smb-send-command v (format "cd \"%s\"" dir)) | |
261 | (tramp-smb-send-command v (format "rmdir \"%s\"" file))) | |
262 | ;; Error | |
263 | (with-current-buffer (tramp-get-connection-buffer v) | |
264 | (goto-char (point-min)) | |
265 | (search-forward-regexp tramp-smb-errors nil t) | |
266 | (tramp-error | |
267 | v 'file-error "%s `%s'" (match-string 0) directory))) | |
268 | ;; Always go home | |
269 | (tramp-smb-send-command v (format "cd \\"))))))) | |
4007ba5b KG |
270 | |
271 | (defun tramp-smb-handle-delete-file (filename) | |
00d6fd04 | 272 | "Like `delete-file' for Tramp files." |
4007ba5b | 273 | (setq filename (expand-file-name filename)) |
340b8d4f MA |
274 | (when (file-exists-p filename) |
275 | (with-parsed-tramp-file-name filename nil | |
00d6fd04 MA |
276 | ;; We must also flush the cache of the directory, because |
277 | ;; file-attributes reads the values from there. | |
278 | (tramp-flush-file-property v (file-name-directory localname)) | |
279 | (tramp-flush-file-property v localname) | |
280 | (let ((dir (tramp-smb-get-localname (file-name-directory localname) t)) | |
281 | (file (file-name-nondirectory localname))) | |
282 | (unwind-protect | |
283 | (unless (and | |
284 | (tramp-smb-send-command v (format "cd \"%s\"" dir)) | |
285 | (tramp-smb-send-command v (format "rm \"%s\"" file))) | |
286 | ;; Error | |
287 | (with-current-buffer (tramp-get-connection-buffer v) | |
288 | (goto-char (point-min)) | |
289 | (search-forward-regexp tramp-smb-errors nil t) | |
290 | (tramp-error | |
291 | v 'file-error "%s `%s'" (match-string 0) filename))) | |
292 | ;; Always go home | |
293 | (tramp-smb-send-command v (format "cd \\"))))))) | |
4007ba5b KG |
294 | |
295 | (defun tramp-smb-handle-directory-files | |
296 | (directory &optional full match nosort) | |
00d6fd04 MA |
297 | "Like `directory-files' for Tramp files." |
298 | (let ((result (mapcar 'directory-file-name | |
299 | (file-name-all-completions "" directory)))) | |
300 | ;; Discriminate with regexp | |
301 | (when match | |
302 | (setq result | |
303 | (delete nil | |
304 | (mapcar (lambda (x) (when (string-match match x) x)) | |
305 | result)))) | |
306 | ;; Append directory | |
307 | (when full | |
308 | (setq result | |
309 | (mapcar | |
310 | (lambda (x) (expand-file-name x directory)) | |
311 | result))) | |
312 | ;; Sort them if necessary | |
313 | (unless nosort (setq result (sort result 'string-lessp))) | |
314 | ;; That's it | |
315 | result)) | |
4007ba5b KG |
316 | |
317 | (defun tramp-smb-handle-directory-files-and-attributes | |
c951aecb | 318 | (directory &optional full match nosort id-format) |
00d6fd04 | 319 | "Like `directory-files-and-attributes' for Tramp files." |
4007ba5b KG |
320 | (mapcar |
321 | (lambda (x) | |
c951aecb | 322 | ;; We cannot call `file-attributes' for backward compatibility reasons. |
340b8d4f | 323 | ;; Its optional parameter ID-FORMAT is introduced with Emacs 22. |
c951aecb | 324 | (cons x (tramp-smb-handle-file-attributes |
00d6fd04 | 325 | (if full x (expand-file-name x directory)) id-format))) |
4007ba5b | 326 | (directory-files directory full match nosort))) |
bf247b6e | 327 | |
c951aecb | 328 | (defun tramp-smb-handle-file-attributes (filename &optional id-format) |
00d6fd04 MA |
329 | "Like `file-attributes' for Tramp files." |
330 | ;; Reading just the filename entry via "dir localname" is not | |
331 | ;; possible, because when filename is a directory, some smbclient | |
332 | ;; versions return the content of the directory, and other versions | |
333 | ;; don't. Therefore, the whole content of the upper directory is | |
334 | ;; retrieved, and the entry of the filename is extracted from. | |
340b8d4f | 335 | (with-parsed-tramp-file-name filename nil |
00d6fd04 MA |
336 | (with-file-property v localname (format "file-attributes-%s" id-format) |
337 | (let* ((entries (tramp-smb-get-file-entries | |
338 | (file-name-directory filename))) | |
4007ba5b | 339 | (entry (and entries |
00d6fd04 | 340 | (assoc (file-name-nondirectory filename) entries))) |
c951aecb KG |
341 | (uid (if (and id-format (equal id-format 'string)) "nobody" -1)) |
342 | (gid (if (and id-format (equal id-format 'string)) "nogroup" -1)) | |
ce3f516f | 343 | (inode (tramp-get-inode v)) |
00d6fd04 | 344 | (device (tramp-get-device v))) |
8daea7fc | 345 | |
00d6fd04 | 346 | ;; Check result. |
4007ba5b KG |
347 | (when entry |
348 | (list (and (string-match "d" (nth 1 entry)) | |
00d6fd04 MA |
349 | t) ;0 file type |
350 | -1 ;1 link count | |
351 | uid ;2 uid | |
352 | gid ;3 gid | |
353 | '(0 0) ;4 atime | |
354 | (nth 3 entry) ;5 mtime | |
355 | '(0 0) ;6 ctime | |
356 | (nth 2 entry) ;7 size | |
357 | (nth 1 entry) ;8 mode | |
358 | nil ;9 gid weird | |
359 | inode ;10 inode number | |
360 | device)))))) ;11 file system number | |
4007ba5b KG |
361 | |
362 | (defun tramp-smb-handle-file-directory-p (filename) | |
00d6fd04 MA |
363 | "Like `file-directory-p' for Tramp files." |
364 | (and (file-exists-p filename) | |
365 | (eq ?d (aref (nth 8 (file-attributes filename)) 0)))) | |
4007ba5b KG |
366 | |
367 | (defun tramp-smb-handle-file-exists-p (filename) | |
00d6fd04 MA |
368 | "Like `file-exists-p' for Tramp files." |
369 | (not (null (file-attributes filename)))) | |
4007ba5b KG |
370 | |
371 | (defun tramp-smb-handle-file-local-copy (filename) | |
00d6fd04 | 372 | "Like `file-local-copy' for Tramp files." |
4007ba5b | 373 | (with-parsed-tramp-file-name filename nil |
00d6fd04 | 374 | (let ((file (tramp-smb-get-localname localname t)) |
258800f8 | 375 | (tmpfile (tramp-compat-make-temp-file filename))) |
00d6fd04 MA |
376 | (unless (file-exists-p filename) |
377 | (tramp-error | |
378 | v 'file-error | |
379 | "Cannot make local copy of non-existing file `%s'" filename)) | |
94be87e8 MA |
380 | (tramp-message v 4 "Fetching %s to tmp file %s..." filename tmpfile) |
381 | (if (tramp-smb-send-command v (format "get \"%s\" %s" file tmpfile)) | |
00d6fd04 | 382 | (tramp-message |
94be87e8 | 383 | v 4 "Fetching %s to tmp file %s...done" filename tmpfile) |
00d6fd04 MA |
384 | (tramp-error |
385 | v 'file-error | |
386 | "Cannot make local copy of file `%s'" filename)) | |
94be87e8 | 387 | tmpfile))) |
4007ba5b KG |
388 | |
389 | ;; This function should return "foo/" for directories and "bar" for | |
390 | ;; files. | |
391 | (defun tramp-smb-handle-file-name-all-completions (filename directory) | |
00d6fd04 MA |
392 | "Like `file-name-all-completions' for Tramp files." |
393 | (all-completions | |
394 | filename | |
395 | (with-parsed-tramp-file-name directory nil | |
396 | (with-file-property v localname "file-name-all-completions" | |
397 | (save-match-data | |
398 | (let ((entries (tramp-smb-get-file-entries directory))) | |
4007ba5b KG |
399 | (mapcar |
400 | (lambda (x) | |
401 | (list | |
402 | (if (string-match "d" (nth 1 x)) | |
403 | (file-name-as-directory (nth 0 x)) | |
404 | (nth 0 x)))) | |
405 | entries))))))) | |
406 | ||
407 | (defun tramp-smb-handle-file-newer-than-file-p (file1 file2) | |
00d6fd04 | 408 | "Like `file-newer-than-file-p' for Tramp files." |
4007ba5b KG |
409 | (cond |
410 | ((not (file-exists-p file1)) nil) | |
411 | ((not (file-exists-p file2)) t) | |
00d6fd04 MA |
412 | (t (tramp-time-less-p (nth 5 (file-attributes file2)) |
413 | (nth 5 (file-attributes file1)))))) | |
4007ba5b KG |
414 | |
415 | (defun tramp-smb-handle-file-writable-p (filename) | |
00d6fd04 MA |
416 | "Like `file-writable-p' for Tramp files." |
417 | (if (file-exists-p filename) | |
418 | (string-match "w" (or (nth 8 (file-attributes filename)) "")) | |
419 | (let ((dir (file-name-directory filename))) | |
420 | (and (file-exists-p dir) | |
421 | (file-writable-p dir))))) | |
4007ba5b KG |
422 | |
423 | (defun tramp-smb-handle-insert-directory | |
424 | (filename switches &optional wildcard full-directory-p) | |
00d6fd04 | 425 | "Like `insert-directory' for Tramp files." |
4007ba5b | 426 | (setq filename (expand-file-name filename)) |
00d6fd04 MA |
427 | (when full-directory-p |
428 | ;; Called from `dired-add-entry'. | |
4007ba5b | 429 | (setq filename (file-name-as-directory filename))) |
340b8d4f | 430 | (with-parsed-tramp-file-name filename nil |
00d6fd04 | 431 | (tramp-flush-file-property v (file-name-directory localname)) |
4007ba5b | 432 | (save-match-data |
00d6fd04 MA |
433 | (let ((base (file-name-nondirectory filename)) |
434 | ;; We should not destroy the cache entry. | |
435 | (entries (copy-sequence | |
436 | (tramp-smb-get-file-entries | |
437 | (file-name-directory filename))))) | |
438 | ||
439 | (when wildcard | |
440 | (string-match "\\." base) | |
441 | (setq base (replace-match "\\\\." nil nil base)) | |
442 | (string-match "\\*" base) | |
443 | (setq base (replace-match ".*" nil nil base)) | |
444 | (string-match "\\?" base) | |
445 | (setq base (replace-match ".?" nil nil base))) | |
446 | ||
447 | ;; Filter entries. | |
bf247b6e | 448 | (setq entries |
00d6fd04 MA |
449 | (delq |
450 | nil | |
451 | (if (or wildcard (zerop (length base))) | |
452 | ;; Check for matching entries. | |
453 | (mapcar | |
454 | (lambda (x) | |
455 | (when (string-match | |
456 | (format "^%s" base) (nth 0 x)) | |
457 | x)) | |
458 | entries) | |
459 | ;; We just need the only and only entry FILENAME. | |
460 | (list (assoc base entries))))) | |
4007ba5b | 461 | |
adb67129 | 462 | ;; Sort entries. |
4007ba5b KG |
463 | (setq entries |
464 | (sort | |
465 | entries | |
466 | (lambda (x y) | |
467 | (if (string-match "t" switches) | |
00d6fd04 MA |
468 | ;; Sort by date. |
469 | (tramp-time-less-p (nth 3 y) (nth 3 x)) | |
470 | ;; Sort by name. | |
4007ba5b KG |
471 | (string-lessp (nth 0 x) (nth 0 y)))))) |
472 | ||
adb67129 MA |
473 | ;; Handle "-F" switch. |
474 | (when (string-match "F" switches) | |
e61aad2f | 475 | (mapc |
adb67129 MA |
476 | (lambda (x) |
477 | (when (not (zerop (length (car x)))) | |
478 | (cond | |
479 | ((char-equal ?d (string-to-char (nth 1 x))) | |
480 | (setcar x (concat (car x) "/"))) | |
481 | ((char-equal ?x (string-to-char (nth 1 x))) | |
482 | (setcar x (concat (car x) "*")))))) | |
483 | entries)) | |
484 | ||
00d6fd04 | 485 | ;; Print entries. |
4007ba5b KG |
486 | (mapcar |
487 | (lambda (x) | |
00d6fd04 MA |
488 | (when (not (zerop (length (nth 0 x)))) |
489 | (insert | |
490 | (format | |
491 | "%10s %3d %-8s %-8s %8s %s %s\n" | |
492 | (nth 1 x) ; mode | |
493 | 1 "nobody" "nogroup" | |
494 | (nth 2 x) ; size | |
495 | (format-time-string | |
496 | (if (tramp-time-less-p | |
497 | (tramp-time-subtract (current-time) (nth 3 x)) | |
498 | tramp-half-a-year) | |
499 | "%b %e %R" | |
500 | "%b %e %Y") | |
501 | (nth 3 x)) ; date | |
502 | (nth 0 x))) ; file name | |
503 | (forward-line) | |
504 | (beginning-of-line))) | |
505 | entries))))) | |
4007ba5b KG |
506 | |
507 | (defun tramp-smb-handle-make-directory (dir &optional parents) | |
00d6fd04 | 508 | "Like `make-directory' for Tramp files." |
4007ba5b KG |
509 | (setq dir (directory-file-name (expand-file-name dir))) |
510 | (unless (file-name-absolute-p dir) | |
00d6fd04 | 511 | (setq dir (expand-file-name dir default-directory))) |
340b8d4f | 512 | (with-parsed-tramp-file-name dir nil |
4007ba5b | 513 | (save-match-data |
7432277c | 514 | (let* ((share (tramp-smb-get-share localname)) |
4007ba5b KG |
515 | (ldir (file-name-directory dir))) |
516 | ;; Make missing directory parts | |
517 | (when (and parents share (not (file-directory-p ldir))) | |
518 | (make-directory ldir parents)) | |
519 | ;; Just do it | |
520 | (when (file-directory-p ldir) | |
8daea7fc | 521 | (make-directory-internal dir)) |
4007ba5b | 522 | (unless (file-directory-p dir) |
00d6fd04 | 523 | (tramp-error v 'file-error "Couldn't make directory %s" dir)))))) |
4007ba5b KG |
524 | |
525 | (defun tramp-smb-handle-make-directory-internal (directory) | |
00d6fd04 | 526 | "Like `make-directory-internal' for Tramp files." |
4007ba5b KG |
527 | (setq directory (directory-file-name (expand-file-name directory))) |
528 | (unless (file-name-absolute-p directory) | |
00d6fd04 | 529 | (setq directory (expand-file-name directory default-directory))) |
340b8d4f | 530 | (with-parsed-tramp-file-name directory nil |
4007ba5b | 531 | (save-match-data |
00d6fd04 | 532 | (let* ((file (tramp-smb-get-localname localname t))) |
4007ba5b | 533 | (when (file-directory-p (file-name-directory directory)) |
00d6fd04 MA |
534 | (tramp-smb-send-command v (format "mkdir \"%s\"" file)) |
535 | ;; We must also flush the cache of the directory, because | |
536 | ;; file-attributes reads the values from there. | |
537 | (tramp-flush-file-property v (file-name-directory localname))) | |
4007ba5b | 538 | (unless (file-directory-p directory) |
00d6fd04 MA |
539 | (tramp-error |
540 | v 'file-error "Couldn't make directory %s" directory)))))) | |
4007ba5b KG |
541 | |
542 | (defun tramp-smb-handle-rename-file | |
543 | (filename newname &optional ok-if-already-exists) | |
00d6fd04 | 544 | "Like `rename-file' for Tramp files." |
4007ba5b KG |
545 | (setq filename (expand-file-name filename) |
546 | newname (expand-file-name newname)) | |
547 | ||
548 | (let ((tmpfile (file-local-copy filename))) | |
549 | ||
550 | (if tmpfile | |
551 | ;; remote filename | |
552 | (rename-file tmpfile newname ok-if-already-exists) | |
553 | ||
554 | ;; remote newname | |
555 | (when (file-directory-p newname) | |
556 | (setq newname (expand-file-name | |
557 | (file-name-nondirectory filename) newname))) | |
4007ba5b | 558 | |
340b8d4f | 559 | (with-parsed-tramp-file-name newname nil |
00d6fd04 MA |
560 | (when (and (not ok-if-already-exists) |
561 | (file-exists-p newname)) | |
562 | (tramp-error v 'file-already-exists newname)) | |
563 | ;; We must also flush the cache of the directory, because | |
564 | ;; file-attributes reads the values from there. | |
565 | (tramp-flush-file-property v (file-name-directory localname)) | |
566 | (tramp-flush-file-property v localname) | |
567 | (let ((file (tramp-smb-get-localname localname t))) | |
568 | (tramp-message v 0 "Copying file %s to file %s..." filename newname) | |
569 | (if (tramp-smb-send-command v (format "put %s \"%s\"" filename file)) | |
570 | (tramp-message | |
571 | v 0 "Copying file %s to file %s...done" filename newname) | |
572 | (tramp-error v 'file-error "Cannot rename `%s'" filename)))))) | |
4007ba5b KG |
573 | |
574 | (delete-file filename)) | |
575 | ||
01917a18 | 576 | (defun tramp-smb-handle-substitute-in-file-name (filename) |
00d6fd04 | 577 | "Like `handle-substitute-in-file-name' for Tramp files. |
b08104a0 MA |
578 | \"//\" substitutes only in the local filename part. Catches |
579 | errors for shares like \"C$/\", which are common in Microsoft Windows." | |
580 | (with-parsed-tramp-file-name filename nil | |
581 | ;; Ignore in LOCALNAME everything before "//". | |
582 | (when (and (stringp localname) (string-match ".+?/\\(/\\|~\\)" localname)) | |
583 | (setq filename | |
584 | (concat (file-remote-p filename) | |
585 | (replace-match "\\1" nil nil localname))))) | |
01917a18 MA |
586 | (condition-case nil |
587 | (tramp-run-real-handler 'substitute-in-file-name (list filename)) | |
588 | (error filename))) | |
589 | ||
4007ba5b KG |
590 | (defun tramp-smb-handle-write-region |
591 | (start end filename &optional append visit lockname confirm) | |
00d6fd04 | 592 | "Like `write-region' for Tramp files." |
4007ba5b | 593 | (setq filename (expand-file-name filename)) |
340b8d4f | 594 | (with-parsed-tramp-file-name filename nil |
00d6fd04 MA |
595 | (unless (eq append nil) |
596 | (tramp-error | |
a4aeb9a4 | 597 | v 'file-error "Cannot append to file using Tramp (`%s')" filename)) |
94be87e8 | 598 | ;; XEmacs takes a coding system as the seventh argument, not `confirm'. |
00d6fd04 MA |
599 | (when (and (not (featurep 'xemacs)) |
600 | confirm (file-exists-p filename)) | |
601 | (unless (y-or-n-p (format "File %s exists; overwrite anyway? " | |
602 | filename)) | |
603 | (tramp-error v 'file-error "File not overwritten"))) | |
604 | ;; We must also flush the cache of the directory, because | |
b08104a0 | 605 | ;; `file-attributes' reads the values from there. |
00d6fd04 MA |
606 | (tramp-flush-file-property v (file-name-directory localname)) |
607 | (tramp-flush-file-property v localname) | |
608 | (let ((file (tramp-smb-get-localname localname t)) | |
609 | (curbuf (current-buffer)) | |
258800f8 | 610 | (tmpfile (tramp-compat-make-temp-file filename))) |
00d6fd04 MA |
611 | ;; We say `no-message' here because we don't want the visited file |
612 | ;; modtime data to be clobbered from the temp file. We call | |
613 | ;; `set-visited-file-modtime' ourselves later on. | |
614 | (tramp-run-real-handler | |
615 | 'write-region | |
616 | (if confirm ; don't pass this arg unless defined for backward compat. | |
94be87e8 MA |
617 | (list start end tmpfile append 'no-message lockname confirm) |
618 | (list start end tmpfile append 'no-message lockname))) | |
00d6fd04 | 619 | |
94be87e8 MA |
620 | (tramp-message v 5 "Writing tmp file %s to file %s..." tmpfile filename) |
621 | (if (tramp-smb-send-command v (format "put %s \"%s\"" tmpfile file)) | |
00d6fd04 | 622 | (tramp-message |
94be87e8 | 623 | v 5 "Writing tmp file %s to file %s...done" tmpfile filename) |
00d6fd04 MA |
624 | (tramp-error v 'file-error "Cannot write `%s'" filename)) |
625 | ||
94be87e8 | 626 | (delete-file tmpfile) |
00d6fd04 MA |
627 | (unless (equal curbuf (current-buffer)) |
628 | (tramp-error | |
629 | v 'file-error | |
630 | "Buffer has changed from `%s' to `%s'" curbuf (current-buffer))) | |
631 | (when (eq visit t) | |
632 | (set-visited-file-modtime))))) | |
4007ba5b KG |
633 | |
634 | ||
635 | ;; Internal file name functions | |
636 | ||
7432277c KG |
637 | (defun tramp-smb-get-share (localname) |
638 | "Returns the share name of LOCALNAME." | |
4007ba5b | 639 | (save-match-data |
7432277c KG |
640 | (when (string-match "^/?\\([^/]+\\)/" localname) |
641 | (match-string 1 localname)))) | |
4007ba5b | 642 | |
7432277c KG |
643 | (defun tramp-smb-get-localname (localname convert) |
644 | "Returns the file name of LOCALNAME. | |
4007ba5b KG |
645 | If CONVERT is non-nil exchange \"/\" by \"\\\\\"." |
646 | (save-match-data | |
7432277c | 647 | (let ((res localname)) |
4007ba5b KG |
648 | |
649 | (setq | |
650 | res (if (string-match "^/?[^/]+/\\(.*\\)" res) | |
651 | (if convert | |
652 | (mapconcat | |
653 | (lambda (x) (if (equal x ?/) "\\" (char-to-string x))) | |
654 | (match-string 1 res) "") | |
655 | (match-string 1 res)) | |
656 | (if (string-match "^/?\\([^/]+\\)$" res) | |
657 | (match-string 1 res) | |
658 | ""))) | |
659 | ||
660 | ;; Sometimes we have discarded `substitute-in-file-name' | |
661 | (when (string-match "\\(\\$\\$\\)\\(/\\|$\\)" res) | |
662 | (setq res (replace-match "$" nil nil res 1))) | |
663 | ||
664 | res))) | |
665 | ||
666 | ;; Share names of a host are cached. It is very unlikely that the | |
667 | ;; shares do change during connection. | |
00d6fd04 MA |
668 | (defun tramp-smb-get-file-entries (directory) |
669 | "Read entries which match DIRECTORY. | |
4007ba5b | 670 | Either the shares are listed, or the `dir' command is executed. |
7432277c | 671 | Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)." |
00d6fd04 MA |
672 | (with-parsed-tramp-file-name directory nil |
673 | (setq localname (or localname "/")) | |
674 | (with-file-property v localname "file-entries" | |
675 | (with-current-buffer (tramp-get-buffer v) | |
676 | (let* ((share (tramp-smb-get-share localname)) | |
677 | (file (tramp-smb-get-localname localname nil)) | |
678 | (cache (tramp-get-connection-property v "share-cache" nil)) | |
679 | res entry) | |
680 | ||
681 | (if (and (not share) cache) | |
682 | ;; Return cached shares | |
683 | (setq res cache) | |
684 | ||
685 | ;; Read entries | |
686 | (setq file (file-name-as-directory file)) | |
687 | (when (string-match "^\\./" file) | |
688 | (setq file (substring file 1))) | |
689 | (if share | |
690 | (tramp-smb-send-command v (format "dir \"%s*\"" file)) | |
691 | ;; `tramp-smb-maybe-open-connection' lists also the share names | |
692 | (tramp-smb-maybe-open-connection v)) | |
693 | ||
694 | ;; Loop the listing | |
695 | (goto-char (point-min)) | |
696 | (unless (re-search-forward tramp-smb-errors nil t) | |
697 | (while (not (eobp)) | |
698 | (setq entry (tramp-smb-read-file-entry share)) | |
699 | (forward-line) | |
700 | (when entry (add-to-list 'res entry)))) | |
701 | ||
4007ba5b | 702 | ;; Cache share entries |
00d6fd04 MA |
703 | (unless share |
704 | (tramp-set-connection-property v "share-cache" res))) | |
4007ba5b | 705 | |
00d6fd04 MA |
706 | ;; Add directory itself |
707 | (add-to-list 'res '("" "drwxrwxrwx" 0 (0 0))) | |
5ec2cc41 | 708 | |
00d6fd04 MA |
709 | ;; There's a very strange error (debugged with XEmacs 21.4.14) |
710 | ;; If there's no short delay, it returns nil. No idea about. | |
711 | (when (featurep 'xemacs) (sleep-for 0.01)) | |
4007ba5b | 712 | |
00d6fd04 MA |
713 | ;; Return entries |
714 | (delq nil res)))))) | |
4007ba5b KG |
715 | |
716 | ;; Return either a share name (if SHARE is nil), or a file name | |
717 | ;; | |
718 | ;; If shares are listed, the following format is expected | |
719 | ;; | |
720 | ;; \s-\{8,8} - leading spaces | |
721 | ;; \S-\(.*\S-\)\s-* - share name, 14 char | |
722 | ;; \s- - space delimeter | |
723 | ;; \S-+\s-* - type, 8 char, "Disk " expected | |
724 | ;; \(\s-\{2,2\}.*\)? - space delimeter, comment | |
725 | ;; | |
726 | ;; Entries provided by smbclient DIR aren't fully regular. | |
727 | ;; They should have the format | |
728 | ;; | |
729 | ;; \s-\{2,2} - leading spaces | |
b1a2b924 KG |
730 | ;; \S-\(.*\S-\)\s-* - file name, 30 chars, left bound |
731 | ;; \s-+[ADHRSV]* - permissions, 7 chars, right bound | |
4007ba5b | 732 | ;; \s- - space delimeter |
b1a2b924 | 733 | ;; \s-+[0-9]+ - size, 8 chars, right bound |
4007ba5b KG |
734 | ;; \s-\{2,2\} - space delimeter |
735 | ;; \w\{3,3\} - weekday | |
736 | ;; \s- - space delimeter | |
b1a2b924 KG |
737 | ;; \w\{3,3\} - month |
738 | ;; \s- - space delimeter | |
00d6fd04 | 739 | ;; [ 12][0-9] - day |
4007ba5b KG |
740 | ;; \s- - space delimeter |
741 | ;; [0-9]\{2,2\}:[0-9]\{2,2\}:[0-9]\{2,2\} - time | |
742 | ;; \s- - space delimeter | |
743 | ;; [0-9]\{4,4\} - year | |
744 | ;; | |
b1a2b924 KG |
745 | ;; samba/src/client.c (http://samba.org/doxygen/samba/client_8c-source.html) |
746 | ;; has function display_finfo: | |
747 | ;; | |
748 | ;; d_printf(" %-30s%7.7s %8.0f %s", | |
749 | ;; finfo->name, | |
750 | ;; attrib_string(finfo->mode), | |
751 | ;; (double)finfo->size, | |
752 | ;; asctime(LocalTime(&t))); | |
753 | ;; | |
754 | ;; in Samba 1.9, there's the following code: | |
755 | ;; | |
756 | ;; DEBUG(0,(" %-30s%7.7s%10d %s", | |
757 | ;; CNV_LANG(finfo->name), | |
758 | ;; attrib_string(finfo->mode), | |
759 | ;; finfo->size, | |
760 | ;; asctime(LocalTime(&t)))); | |
761 | ;; | |
4007ba5b KG |
762 | ;; Problems: |
763 | ;; * Modern regexp constructs, like spy groups and counted repetitions, aren't | |
764 | ;; available in older Emacsen. | |
765 | ;; * The length of constructs (file name, size) might exceed the default. | |
766 | ;; * File names might contain spaces. | |
767 | ;; * Permissions might be empty. | |
768 | ;; | |
769 | ;; So we try to analyze backwards. | |
770 | (defun tramp-smb-read-file-entry (share) | |
771 | "Parse entry in SMB output buffer. | |
772 | If SHARE is result, entries are of type dir. Otherwise, shares are listed. | |
7432277c | 773 | Result is the list (LOCALNAME MODE SIZE MTIME)." |
00d6fd04 MA |
774 | ;; We are called from `tramp-smb-get-file-entries', which sets the |
775 | ;; current buffer. | |
9e6ab520 | 776 | (let ((line (buffer-substring (point) (tramp-compat-line-end-position))) |
7432277c | 777 | localname mode size month day hour min sec year mtime) |
4007ba5b KG |
778 | |
779 | (if (not share) | |
780 | ||
00d6fd04 MA |
781 | ;; Read share entries. |
782 | (when (string-match "^\\s-+\\(\\S-\\(.*\\S-\\)?\\)\\s-+Disk" line) | |
7432277c | 783 | (setq localname (match-string 1 line) |
4007ba5b KG |
784 | mode "dr-xr-xr-x" |
785 | size 0)) | |
786 | ||
00d6fd04 | 787 | ;; Real listing. |
4007ba5b KG |
788 | (block nil |
789 | ||
790 | ;; year | |
791 | (if (string-match "\\([0-9]+\\)$" line) | |
792 | (setq year (string-to-number (match-string 1 line)) | |
793 | line (substring line 0 -5)) | |
794 | (return)) | |
795 | ||
796 | ;; time | |
797 | (if (string-match "\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)$" line) | |
798 | (setq hour (string-to-number (match-string 1 line)) | |
799 | min (string-to-number (match-string 2 line)) | |
800 | sec (string-to-number (match-string 3 line)) | |
801 | line (substring line 0 -9)) | |
802 | (return)) | |
803 | ||
804 | ;; day | |
805 | (if (string-match "\\([0-9]+\\)$" line) | |
806 | (setq day (string-to-number (match-string 1 line)) | |
807 | line (substring line 0 -3)) | |
808 | (return)) | |
809 | ||
810 | ;; month | |
811 | (if (string-match "\\(\\w+\\)$" line) | |
812 | (setq month (match-string 1 line) | |
813 | line (substring line 0 -4)) | |
814 | (return)) | |
815 | ||
816 | ;; weekday | |
817 | (if (string-match "\\(\\w+\\)$" line) | |
818 | (setq line (substring line 0 -5)) | |
819 | (return)) | |
820 | ||
821 | ;; size | |
822 | (if (string-match "\\([0-9]+\\)$" line) | |
b1a2b924 KG |
823 | (let ((length (- (max 10 (1+ (length (match-string 1 line))))))) |
824 | (setq size (string-to-number (match-string 1 line))) | |
825 | (when (string-match "\\([ADHRSV]+\\)" (substring line length)) | |
826 | (setq length (+ length (match-end 0)))) | |
827 | (setq line (substring line 0 length))) | |
4007ba5b KG |
828 | (return)) |
829 | ||
b1a2b924 KG |
830 | ;; mode: ARCH, DIR, HIDDEN, RONLY, SYSTEM, VOLID |
831 | (if (string-match "\\([ADHRSV]+\\)?$" line) | |
4007ba5b | 832 | (setq |
b1a2b924 | 833 | mode (or (match-string 1 line) "") |
4007ba5b KG |
834 | mode (save-match-data (format |
835 | "%s%s" | |
836 | (if (string-match "D" mode) "d" "-") | |
837 | (mapconcat | |
838 | (lambda (x) "") " " | |
839 | (concat "r" (if (string-match "R" mode) "-" "w") "x")))) | |
b1a2b924 | 840 | line (substring line 0 -7)) |
4007ba5b KG |
841 | (return)) |
842 | ||
7432277c | 843 | ;; localname |
b1a2b924 | 844 | (if (string-match "^\\s-+\\(\\S-\\(.*\\S-\\)?\\)\\s-*$" line) |
7432277c | 845 | (setq localname (match-string 1 line)) |
4007ba5b KG |
846 | (return)))) |
847 | ||
7432277c | 848 | (when (and localname mode size) |
4007ba5b KG |
849 | (setq mtime |
850 | (if (and sec min hour day month year) | |
851 | (encode-time | |
852 | sec min hour day | |
00d6fd04 | 853 | (cdr (assoc (downcase month) tramp-parse-time-months)) |
4007ba5b KG |
854 | year) |
855 | '(0 0))) | |
7432277c | 856 | (list localname mode size mtime)))) |
4007ba5b KG |
857 | |
858 | ||
859 | ;; Connection functions | |
860 | ||
00d6fd04 MA |
861 | (defun tramp-smb-send-command (vec command) |
862 | "Send the COMMAND to connection VEC. | |
863 | Returns nil if there has been an error message from smbclient." | |
864 | (tramp-smb-maybe-open-connection vec) | |
865 | (tramp-message vec 6 "%s" command) | |
866 | (tramp-send-string vec command) | |
867 | (tramp-smb-wait-for-output vec)) | |
868 | ||
869 | (defun tramp-smb-maybe-open-connection (vec) | |
870 | "Maybe open a connection to HOST, log in as USER, using `tramp-smb-program'. | |
4007ba5b KG |
871 | Does not do anything if a connection is already open, but re-opens the |
872 | connection if a previous connection has died for some reason." | |
00d6fd04 MA |
873 | (let* ((share (tramp-smb-get-share (tramp-file-name-localname vec))) |
874 | (buf (tramp-get-buffer vec)) | |
875 | (p (get-buffer-process buf))) | |
340b8d4f | 876 | |
00d6fd04 MA |
877 | ;; If too much time has passed since last command was sent, look |
878 | ;; whether has been an error message; maybe due to connection timeout. | |
879 | (with-current-buffer buf | |
880 | (goto-char (point-min)) | |
881 | (when (and (> (tramp-time-diff | |
882 | (current-time) | |
883 | (tramp-get-connection-property | |
884 | p "last-cmd-time" '(0 0 0))) | |
885 | 60) | |
886 | p (processp p) (memq (process-status p) '(run open)) | |
887 | (re-search-forward tramp-smb-errors nil t)) | |
888 | (delete-process p) | |
889 | (setq p nil))) | |
890 | ||
891 | ;; Check whether it is still the same share. | |
892 | (unless | |
893 | (and p (processp p) (memq (process-status p) '(run open)) | |
894 | (string-equal | |
895 | share | |
896 | (tramp-get-connection-property p "smb-share" ""))) | |
897 | ||
898 | (save-match-data | |
899 | ;; There might be unread output from checking for share names. | |
900 | (when buf (with-current-buffer buf (erase-buffer))) | |
901 | (when (and p (processp p)) (delete-process p)) | |
902 | ||
903 | (unless (let ((default-directory | |
9e6ab520 | 904 | (tramp-compat-temporary-file-directory))) |
00d6fd04 MA |
905 | (executable-find tramp-smb-program)) |
906 | (error "Cannot find command %s in %s" tramp-smb-program exec-path)) | |
907 | ||
908 | (let* ((user (tramp-file-name-user vec)) | |
909 | (host (tramp-file-name-host vec)) | |
910 | (real-user user) | |
911 | (real-host host) | |
912 | domain port args) | |
913 | ||
914 | ;; Check for domain ("user%domain") and port ("host#port"). | |
915 | (when (and user (string-match "\\(.+\\)%\\(.+\\)" user)) | |
916 | (setq real-user (or (match-string 1 user) user) | |
917 | domain (match-string 2 user))) | |
918 | ||
919 | (when (and host (string-match "\\(.+\\)#\\(.+\\)" host)) | |
920 | (setq real-host (or (match-string 1 host) host) | |
921 | port (match-string 2 host))) | |
922 | ||
923 | (if share | |
924 | (setq args (list (concat "//" real-host "/" share))) | |
925 | (setq args (list "-L" real-host ))) | |
926 | ||
927 | (if (not (zerop (length real-user))) | |
928 | (setq args (append args (list "-U" real-user))) | |
929 | (setq args (append args (list "-N")))) | |
930 | ||
931 | (when domain (setq args (append args (list "-W" domain)))) | |
932 | (when port (setq args (append args (list "-p" port)))) | |
933 | (setq args (append args (list "-s" "/dev/null"))) | |
934 | ||
935 | ;; OK, let's go. | |
936 | (tramp-message | |
937 | vec 3 "Opening connection for //%s%s/%s..." | |
938 | (if (not (zerop (length user))) (concat user "@") "") | |
939 | host (or share "")) | |
940 | ||
941 | (let* ((coding-system-for-read nil) | |
942 | (process-connection-type tramp-process-connection-type) | |
9e6ab520 MA |
943 | (p (let ((default-directory |
944 | (tramp-compat-temporary-file-directory))) | |
00d6fd04 MA |
945 | (apply #'start-process |
946 | (tramp-buffer-name vec) (tramp-get-buffer vec) | |
947 | tramp-smb-program args)))) | |
948 | ||
949 | (tramp-message | |
950 | vec 6 "%s" (mapconcat 'identity (process-command p) " ")) | |
47e02af4 | 951 | (set-process-sentinel p 'tramp-process-sentinel) |
00d6fd04 MA |
952 | (tramp-set-process-query-on-exit-flag p nil) |
953 | (tramp-set-connection-property p "smb-share" share) | |
954 | ||
955 | ;; Set variables for computing the prompt for reading password. | |
956 | (setq tramp-current-method tramp-smb-method | |
957 | tramp-current-user user | |
958 | tramp-current-host host) | |
959 | ||
960 | ;; Set chunksize. Otherwise, `tramp-send-string' might | |
961 | ;; try it itself. | |
962 | (tramp-set-connection-property p "chunksize" tramp-chunksize) | |
963 | ||
964 | ;; Play login scenario. | |
965 | (tramp-process-actions | |
966 | p vec | |
967 | (if share | |
968 | tramp-smb-actions-with-share | |
969 | tramp-smb-actions-without-share)) | |
970 | ||
971 | (tramp-message | |
972 | vec 3 "Opening connection for //%s%s/%s...done" | |
973 | (if (not (zerop (length user))) (concat user "@") "") | |
974 | host (or share "")))))))) | |
4007ba5b KG |
975 | |
976 | ;; We don't use timeouts. If needed, the caller shall wrap around. | |
00d6fd04 | 977 | (defun tramp-smb-wait-for-output (vec) |
4007ba5b | 978 | "Wait for output from smbclient command. |
4007ba5b | 979 | Returns nil if an error message has appeared." |
00d6fd04 MA |
980 | (with-current-buffer (tramp-get-buffer vec) |
981 | (let ((p (get-buffer-process (current-buffer))) | |
982 | (found (progn (goto-char (point-min)) | |
983 | (re-search-forward tramp-smb-prompt nil t))) | |
984 | (err (progn (goto-char (point-min)) | |
985 | (re-search-forward tramp-smb-errors nil t)))) | |
5ec2cc41 | 986 | |
00d6fd04 MA |
987 | ;; Algorithm: get waiting output. See if last line contains |
988 | ;; tramp-smb-prompt sentinel or tramp-smb-errors strings. | |
989 | ;; If not, wait a bit and again get waiting output. | |
990 | (while (and (not found) (not err)) | |
5ec2cc41 | 991 | |
00d6fd04 MA |
992 | ;; Accept pending output. |
993 | (tramp-accept-process-output p) | |
4007ba5b | 994 | |
00d6fd04 MA |
995 | ;; Search for prompt. |
996 | (goto-char (point-min)) | |
997 | (setq found (re-search-forward tramp-smb-prompt nil t)) | |
4007ba5b | 998 | |
00d6fd04 MA |
999 | ;; Search for errors. |
1000 | (goto-char (point-min)) | |
1001 | (setq err (re-search-forward tramp-smb-errors nil t))) | |
4007ba5b | 1002 | |
00d6fd04 MA |
1003 | ;; When the process is still alive, read pending output. |
1004 | (while (and (not found) (memq (process-status p) '(run open))) | |
4007ba5b | 1005 | |
00d6fd04 MA |
1006 | ;; Accept pending output. |
1007 | (tramp-accept-process-output p) | |
4007ba5b | 1008 | |
00d6fd04 MA |
1009 | ;; Search for prompt. |
1010 | (goto-char (point-min)) | |
1011 | (setq found (re-search-forward tramp-smb-prompt nil t))) | |
4007ba5b | 1012 | |
00d6fd04 MA |
1013 | ;; Return value is whether no error message has appeared. |
1014 | (tramp-message vec 6 "\n%s" (buffer-string)) | |
1015 | (not err)))) | |
4007ba5b KG |
1016 | |
1017 | ||
4007ba5b KG |
1018 | (provide 'tramp-smb) |
1019 | ||
1020 | ;;; TODO: | |
1021 | ||
4007ba5b KG |
1022 | ;; * Error handling in case password is wrong. |
1023 | ;; * Read password from "~/.netrc". | |
4007ba5b KG |
1024 | ;; * Return more comprehensive file permission string. Think whether it is |
1025 | ;; possible to implement `set-file-modes'. | |
4007ba5b | 1026 | ;; * Handle links (FILENAME.LNK). |
4007ba5b KG |
1027 | ;; * Try to remove the inclusion of dummy "" directory. Seems to be at |
1028 | ;; several places, especially in `tramp-smb-handle-insert-directory'. | |
4007ba5b KG |
1029 | ;; * (RMS) Use unwind-protect to clean up the state so as to make the state |
1030 | ;; regular again. | |
00d6fd04 | 1031 | ;; * Make it multi-hop capable. |
4007ba5b | 1032 | |
cbee283d | 1033 | ;; arch-tag: fcc9dbec-7503-4d73-b638-3c8aa59575f5 |
4007ba5b | 1034 | ;;; tramp-smb.el ends here |