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