Mercurial > emacs
comparison lisp/net/tramp-smb.el @ 48973:09acf3f65bb5
* net/tramp*.el: Sync with upstream version 2.0.28. Bugfixes.
* net/tramp-ftp.el: Glue code with Ange-FTP, broken out of
tramp.el. From Michael Albinus.
* net/tramp-smb.el: New file for using smbclient to access
Windows shares with Tramp. From Michael Albinus.
author | Kai Großjohann <kgrossjo@eu.uu.net> |
---|---|
date | Thu, 26 Dec 2002 20:47:51 +0000 |
parents | |
children | 0d8b17d428b5 |
comparison
equal
deleted
inserted
replaced
48972:2d4e1ccc9f01 | 48973:09acf3f65bb5 |
---|---|
1 ;;; tramp-smb.el --- Tramp access functions for SMB servers -*- coding: iso-8859-1; -*- | |
2 | |
3 ;; Copyright (C) 2002 Free Software Foundation, Inc. | |
4 | |
5 ;; Author: Michael Albinus <Michael.Albinus@alcatel.de> | |
6 ;; Keywords: comm, processes | |
7 | |
8 ;; This file is part of GNU Emacs. | |
9 | |
10 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
11 ;; it under the terms of the GNU General Public License as published by | |
12 ;; the Free Software Foundation; either version 2, or (at your option) | |
13 ;; any later version. | |
14 | |
15 ;; GNU Emacs is distributed in the hope that it will be useful, | |
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 ;; GNU General Public License for more details. | |
19 | |
20 ;; You should have received a copy of the GNU General Public License | |
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
23 ;; Boston, MA 02111-1307, USA. | |
24 | |
25 ;;; Commentary: | |
26 | |
27 ;; Access functions for SMB servers like SAMBA or M$ Windows from Tramp. | |
28 | |
29 ;;; Code: | |
30 | |
31 (require 'tramp) | |
32 | |
33 ;; Pacify byte-compiler | |
34 (eval-when-compile | |
35 (require 'cl) | |
36 (require 'custom) | |
37 ;; Emacs 19.34 compatibility hack -- is this needed? | |
38 (or (>= emacs-major-version 20) | |
39 (load "cl-seq"))) | |
40 | |
41 ;; Define SMB method ... | |
42 (defcustom tramp-smb-method "smb" | |
43 "*Method to connect SAMBA and M$ SMB servers." | |
44 :group 'tramp | |
45 :type 'string) | |
46 | |
47 ;; ... and add it to the method list. | |
48 (add-to-list 'tramp-methods (cons tramp-smb-method nil)) | |
49 | |
50 ;; Add a default for `tramp-default-method-alist'. Rule: If there is | |
51 ;; a domain in USER, it must be the SMB method. | |
52 (add-to-list 'tramp-default-method-alist | |
53 '("%" "" tramp-smb-method)) | |
54 | |
55 ;; Add completion function for SMB method. | |
56 (tramp-set-completion-function | |
57 tramp-smb-method | |
58 '((tramp-parse-netrc "~/.netrc"))) | |
59 | |
60 (defcustom tramp-smb-program "smbclient" | |
61 "*Name of SMB client to run." | |
62 :group 'tramp | |
63 :type 'string) | |
64 | |
65 (defconst tramp-smb-prompt "^smb: \\S-+> " | |
66 "Regexp used as prompt in smbclient.") | |
67 | |
68 (defconst tramp-smb-errors | |
69 (mapconcat | |
70 'identity | |
71 '(; Connection error | |
72 "Connection to \\S-+ failed" | |
73 ; Samba | |
74 "ERRSRV" | |
75 "ERRDOS" | |
76 "ERRbadfile" | |
77 "ERRbadpw" | |
78 "ERRfilexists" | |
79 "ERRnoaccess" | |
80 "ERRnomem" | |
81 "ERRnosuchshare" | |
82 ; Windows NT 4.0, Windows 5.0 (Windows 2000), Windows 5.1 (Windows XP) | |
83 "NT_STATUS_ACCESS_DENIED" | |
84 "NT_STATUS_BAD_NETWORK_NAME" | |
85 "NT_STATUS_CANNOT_DELETE" | |
86 "NT_STATUS_LOGON_FAILURE" | |
87 "NT_STATUS_NO_SUCH_FILE" | |
88 "NT_STATUS_OBJECT_NAME_INVALID" | |
89 "NT_STATUS_OBJECT_NAME_NOT_FOUND" | |
90 "NT_STATUS_SHARING_VIOLATION") | |
91 "\\|") | |
92 "Regexp for possible error strings of SMB servers. | |
93 Used instead of analyzing error codes of commands.") | |
94 | |
95 (defvar tramp-smb-share nil | |
96 "Holds the share name for the current buffer. | |
97 This variable is local to each buffer.") | |
98 (make-variable-buffer-local 'tramp-smb-share) | |
99 | |
100 (defvar tramp-smb-share-cache nil | |
101 "Caches the share names accessible to host related to the current buffer. | |
102 This variable is local to each buffer.") | |
103 (make-variable-buffer-local 'tramp-smb-share-cache) | |
104 | |
105 (defvar tramp-smb-process-running nil | |
106 "Flag whether a corresponding process is still running. | |
107 Will be changed by corresponding `process-sentinel'. | |
108 This variable is local to each buffer.") | |
109 (make-variable-buffer-local 'tramp-smb-process-running) | |
110 | |
111 ;; New handlers should be added here. | |
112 (defconst tramp-smb-file-name-handler-alist | |
113 '( | |
114 ;; `access-file' performed by default handler | |
115 (add-name-to-file . tramp-smb-handle-copy-file) ;; we're on Windows, honey. | |
116 ;; `byte-compiler-base-file-name' performed by default handler | |
117 (copy-file . tramp-smb-handle-copy-file) | |
118 (delete-directory . tramp-smb-handle-delete-directory) | |
119 (delete-file . tramp-smb-handle-delete-file) | |
120 ;; `diff-latest-backup-file' performed by default handler | |
121 ;; `directory-file-name' performed by default handler | |
122 (directory-files . tramp-smb-handle-directory-files) | |
123 (directory-files-and-attributes . tramp-smb-handle-directory-files-and-attributes) | |
124 (dired-call-process . tramp-smb-not-handled) | |
125 (dired-compress-file . tramp-smb-not-handled) | |
126 ;; `dired-uncache' performed by default handler | |
127 ;; `expand-file-name' not necessary because we cannot expand "~/" | |
128 (file-accessible-directory-p . tramp-smb-handle-file-directory-p) | |
129 (file-attributes . tramp-smb-handle-file-attributes) | |
130 (file-directory-p . tramp-smb-handle-file-directory-p) | |
131 (file-executable-p . tramp-smb-handle-file-exists-p) | |
132 (file-exists-p . tramp-smb-handle-file-exists-p) | |
133 (file-local-copy . tramp-smb-handle-file-local-copy) | |
134 (file-modes . tramp-handle-file-modes) | |
135 (file-name-all-completions . tramp-smb-handle-file-name-all-completions) | |
136 ;; `file-name-as-directory' performed by default handler | |
137 (file-name-completion . tramp-handle-file-name-completion) | |
138 (file-name-directory . tramp-handle-file-name-directory) | |
139 (file-name-nondirectory . tramp-handle-file-name-nondirectory) | |
140 ;; `file-name-sans-versions' performed by default handler | |
141 (file-newer-than-file-p . tramp-smb-handle-file-newer-than-file-p) | |
142 (file-ownership-preserved-p . tramp-smb-not-handled) | |
143 (file-readable-p . tramp-smb-handle-file-exists-p) | |
144 (file-regular-p . tramp-handle-file-regular-p) | |
145 (file-symlink-p . tramp-smb-not-handled) | |
146 ;; `file-truename' performed by default handler | |
147 (file-writable-p . tramp-smb-handle-file-writable-p) | |
148 ;; `find-backup-file-name' performed by default handler | |
149 ;; `find-file-noselect' performed by default handler | |
150 ;; `get-file-buffer' performed by default handler | |
151 (insert-directory . tramp-smb-handle-insert-directory) | |
152 (insert-file-contents . tramp-handle-insert-file-contents) | |
153 (load . tramp-handle-load) | |
154 (make-directory . tramp-smb-handle-make-directory) | |
155 (make-directory-internal . tramp-smb-handle-make-directory-internal) | |
156 (make-symbolic-link . tramp-smb-not-handled) | |
157 (rename-file . tramp-smb-handle-rename-file) | |
158 (set-file-modes . tramp-smb-not-handled) | |
159 (set-visited-file-modtime . tramp-smb-not-handled) | |
160 (shell-command . tramp-smb-not-handled) | |
161 ;; `substitute-in-file-name' performed by default handler | |
162 (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory) | |
163 (vc-registered . tramp-smb-not-handled) | |
164 (verify-visited-file-modtime . tramp-smb-not-handled) | |
165 (write-region . tramp-smb-handle-write-region) | |
166 ) | |
167 "Alist of handler functions for Tramp SMB method. | |
168 Operations not mentioned here will be handled by the default Emacs primitives.") | |
169 | |
170 (defun tramp-smb-file-name-p (filename) | |
171 "Check if it's a filename for SMB servers." | |
172 (let ((v (tramp-dissect-file-name filename))) | |
173 (string= | |
174 (tramp-find-method | |
175 (tramp-file-name-multi-method v) | |
176 (tramp-file-name-method v) | |
177 (tramp-file-name-user v) | |
178 (tramp-file-name-host v)) | |
179 tramp-smb-method))) | |
180 | |
181 (defun tramp-smb-file-name-handler (operation &rest args) | |
182 "Invoke the SMB related OPERATION. | |
183 First arg specifies the OPERATION, second arg is a list of arguments to | |
184 pass to the OPERATION." | |
185 (let ((fn (assoc operation tramp-smb-file-name-handler-alist))) | |
186 (if fn | |
187 (if (eq (cdr fn) 'tramp-smb-not-handled) | |
188 (apply (cdr fn) operation args) | |
189 (save-match-data (apply (cdr fn) args))) | |
190 (tramp-run-real-handler operation args)))) | |
191 | |
192 (add-to-list 'tramp-foreign-file-name-handler-alist | |
193 (cons 'tramp-smb-file-name-p 'tramp-smb-file-name-handler)) | |
194 | |
195 | |
196 ;; File name primitives | |
197 | |
198 (defun tramp-smb-not-handled (operation &rest args) | |
199 "Default handler for all functions which are disrecarded." | |
200 (tramp-message 10 "Won't be handled: %s %s" operation args) | |
201 nil) | |
202 | |
203 (defun tramp-smb-handle-copy-file | |
204 (filename newname &optional ok-if-already-exists keep-date) | |
205 "Like `copy-file' for tramp files. | |
206 KEEP-DATE is not handled in case NEWNAME resides on an SMB server." | |
207 (setq filename (expand-file-name filename) | |
208 newname (expand-file-name newname)) | |
209 | |
210 (let ((tmpfile (file-local-copy filename))) | |
211 | |
212 (if tmpfile | |
213 ;; remote filename | |
214 (rename-file tmpfile newname ok-if-already-exists) | |
215 | |
216 ;; remote newname | |
217 (when (file-directory-p newname) | |
218 (setq newname (expand-file-name | |
219 (file-name-nondirectory filename) newname))) | |
220 (when (and (not ok-if-already-exists) | |
221 (file-exists-p newname)) | |
222 (error "copy-file: file %s already exists" newname)) | |
223 | |
224 ; (with-parsed-tramp-file-name newname nil | |
225 (let (user host path) | |
226 (with-parsed-tramp-file-name newname l | |
227 (setq user l-user host l-host path l-path)) | |
228 (save-excursion | |
229 (let ((share (tramp-smb-get-share path)) | |
230 (file (tramp-smb-get-path path t))) | |
231 (unless share | |
232 (error "Target `%s' must contain a share name" filename)) | |
233 (tramp-smb-maybe-open-connection user host share) | |
234 (tramp-message-for-buffer | |
235 nil tramp-smb-method user host | |
236 5 "Copying file %s to file %s..." filename newname) | |
237 (if (tramp-smb-send-command | |
238 user host (format "put %s \"%s\"" filename file)) | |
239 (tramp-message-for-buffer | |
240 nil tramp-smb-method user host | |
241 5 "Copying file %s to file %s...done" filename newname) | |
242 (error "Cannot copy `%s'" filename)))))))) | |
243 | |
244 (defun tramp-smb-handle-delete-directory (directory) | |
245 "Like `delete-directory' for tramp files." | |
246 (setq directory (directory-file-name (expand-file-name directory))) | |
247 (unless (file-exists-p directory) | |
248 (error "Cannot delete non-existing directory `%s'" directory)) | |
249 ; (with-parsed-tramp-file-name directory nil | |
250 (let (user host path) | |
251 (with-parsed-tramp-file-name directory l | |
252 (setq user l-user host l-host path l-path)) | |
253 (save-excursion | |
254 (let ((share (tramp-smb-get-share path)) | |
255 (dir (tramp-smb-get-path (file-name-directory path) t)) | |
256 (file (file-name-nondirectory path))) | |
257 (tramp-smb-maybe-open-connection user host share) | |
258 (if (and | |
259 (tramp-smb-send-command user host (format "cd \"%s\"" dir)) | |
260 (tramp-smb-send-command user host (format "rmdir \"%s\"" file))) | |
261 ;; Go Home | |
262 (tramp-smb-send-command user host (format "cd \\")) | |
263 ;; Error | |
264 (tramp-smb-send-command user host (format "cd \\")) | |
265 (error "Cannot delete directory `%s'" directory)))))) | |
266 | |
267 (defun tramp-smb-handle-delete-file (filename) | |
268 "Like `delete-file' for tramp files." | |
269 (setq filename (expand-file-name filename)) | |
270 (unless (file-exists-p filename) | |
271 (error "Cannot delete non-existing file `%s'" filename)) | |
272 ; (with-parsed-tramp-file-name filename nil | |
273 (let (user host path) | |
274 (with-parsed-tramp-file-name filename l | |
275 (setq user l-user host l-host path l-path)) | |
276 (save-excursion | |
277 (let ((share (tramp-smb-get-share path)) | |
278 (dir (tramp-smb-get-path (file-name-directory path) t)) | |
279 (file (file-name-nondirectory path))) | |
280 (unless (file-exists-p filename) | |
281 (error "Cannot delete non-existing file `%s'" filename)) | |
282 (tramp-smb-maybe-open-connection user host share) | |
283 (if (and | |
284 (tramp-smb-send-command user host (format "cd \"%s\"" dir)) | |
285 (tramp-smb-send-command user host (format "rm \"%s\"" file))) | |
286 ;; Go Home | |
287 (tramp-smb-send-command user host (format "cd \\")) | |
288 ;; Error | |
289 (tramp-smb-send-command user host (format "cd \\")) | |
290 (error "Cannot delete file `%s'" directory)))))) | |
291 | |
292 (defun tramp-smb-handle-directory-files | |
293 (directory &optional full match nosort) | |
294 "Like `directory-files' for tramp files." | |
295 (setq directory (directory-file-name (expand-file-name directory))) | |
296 ; (with-parsed-tramp-file-name directory nil | |
297 (let (user host path) | |
298 (with-parsed-tramp-file-name directory l | |
299 (setq user l-user host l-host path l-path)) | |
300 (save-excursion | |
301 (let* ((share (tramp-smb-get-share path)) | |
302 (file (tramp-smb-get-path path nil)) | |
303 (entries (tramp-smb-get-file-entries user host share file))) | |
304 ;; Just the file names are needed | |
305 (setq entries (mapcar 'car entries)) | |
306 ;; Discriminate with regexp | |
307 (when match | |
308 (setq entries | |
309 (delete nil | |
310 (mapcar (lambda (x) (when (string-match match x) x)) | |
311 entries)))) | |
312 ;; Make absolute paths if necessary | |
313 (when full | |
314 (setq entries | |
315 (mapcar (lambda (x) | |
316 (concat (file-name-as-directory directory) x)) | |
317 entries))) | |
318 ;; Sort them if necessary | |
319 (unless nosort (setq entries (sort entries 'string-lessp))) | |
320 ;; That's it | |
321 entries)))) | |
322 | |
323 (defun tramp-smb-handle-directory-files-and-attributes | |
324 (directory &optional full match nosort) | |
325 "Like `directory-files-and-attributes' for tramp files." | |
326 (mapcar | |
327 (lambda (x) | |
328 (cons x (file-attributes | |
329 (if full x (concat (file-name-as-directory directory) x))))) | |
330 (directory-files directory full match nosort))) | |
331 | |
332 (defun tramp-smb-handle-file-attributes (filename &optional nonnumeric) | |
333 "Like `file-attributes' for tramp files. | |
334 Optional argument NONNUMERIC means return user and group name | |
335 rather than as numbers." | |
336 ; (with-parsed-tramp-file-name filename nil | |
337 (let (user host path) | |
338 (with-parsed-tramp-file-name filename l | |
339 (setq user l-user host l-host path l-path)) | |
340 (save-excursion | |
341 (let* ((share (tramp-smb-get-share path)) | |
342 (file (tramp-smb-get-path path nil)) | |
343 (entries (tramp-smb-get-file-entries user host share file)) | |
344 (entry (and entries | |
345 (assoc (file-name-nondirectory file) entries)))) | |
346 ; check result | |
347 (when entry | |
348 (list (and (string-match "d" (nth 1 entry)) | |
349 t) ;0 file type | |
350 -1 ;1 link count | |
351 -1 ;2 uid | |
352 -1 ;3 gid | |
353 (nth 3 entry) ;4 atime | |
354 (nth 3 entry) ;5 mtime | |
355 (nth 3 entry) ;6 ctime | |
356 (nth 2 entry) ;7 size | |
357 (nth 1 entry) ;8 mode | |
358 nil ;9 gid weird | |
359 -1 ;10 inode number | |
360 -1)))))) ;11 file system number | |
361 | |
362 (defun tramp-smb-handle-file-directory-p (filename) | |
363 "Like `file-directory-p' for tramp files." | |
364 ; (with-parsed-tramp-file-name filename nil | |
365 (let (user host path) | |
366 (with-parsed-tramp-file-name filename l | |
367 (setq user l-user host l-host path l-path)) | |
368 (save-excursion | |
369 (let* ((share (tramp-smb-get-share path)) | |
370 (file (tramp-smb-get-path path nil)) | |
371 (entries (tramp-smb-get-file-entries user host share file)) | |
372 (entry (and entries | |
373 (assoc (file-name-nondirectory file) entries)))) | |
374 (and entry | |
375 (string-match "d" (nth 1 entry)) | |
376 t))))) | |
377 | |
378 (defun tramp-smb-handle-file-exists-p (filename) | |
379 "Like `file-exists-p' for tramp files." | |
380 ; (with-parsed-tramp-file-name filename nil | |
381 (let (user host path) | |
382 (with-parsed-tramp-file-name filename l | |
383 (setq user l-user host l-host path l-path)) | |
384 (save-excursion | |
385 (let* ((share (tramp-smb-get-share path)) | |
386 (file (tramp-smb-get-path path nil)) | |
387 (entries (tramp-smb-get-file-entries user host share file))) | |
388 (and entries | |
389 (member (file-name-nondirectory file) (mapcar 'car entries)) | |
390 t))))) | |
391 | |
392 (defun tramp-smb-handle-file-local-copy (filename) | |
393 "Like `file-local-copy' for tramp files." | |
394 (with-parsed-tramp-file-name filename nil | |
395 (save-excursion | |
396 (let ((share (tramp-smb-get-share path)) | |
397 (file (tramp-smb-get-path path t)) | |
398 (tmpfil (tramp-make-temp-file))) | |
399 (unless (file-exists-p filename) | |
400 (error "Cannot make local copy of non-existing file `%s'" filename)) | |
401 (tramp-message-for-buffer | |
402 nil tramp-smb-method user host | |
403 5 "Fetching %s to tmp file %s..." filename tmpfil) | |
404 (tramp-smb-maybe-open-connection user host share) | |
405 (if (tramp-smb-send-command | |
406 user host (format "get \"%s\" %s" file tmpfil)) | |
407 (tramp-message-for-buffer | |
408 nil tramp-smb-method user host | |
409 5 "Fetching %s to tmp file %s...done" filename tmpfil) | |
410 (error "Cannot make local copy of file `%s'" filename)) | |
411 tmpfil)))) | |
412 | |
413 ;; This function should return "foo/" for directories and "bar" for | |
414 ;; files. | |
415 (defun tramp-smb-handle-file-name-all-completions (filename directory) | |
416 "Like `file-name-all-completions' for tramp files." | |
417 ; (with-parsed-tramp-file-name directory nil | |
418 (let (user host path) | |
419 (with-parsed-tramp-file-name directory l | |
420 (setq user l-user host l-host path l-path)) | |
421 (save-match-data | |
422 (save-excursion | |
423 (let* ((share (tramp-smb-get-share path)) | |
424 (file (tramp-smb-get-path path nil)) | |
425 (entries (tramp-smb-get-file-entries user host share file))) | |
426 | |
427 (all-completions | |
428 filename | |
429 (mapcar | |
430 (lambda (x) | |
431 (list | |
432 (if (string-match "d" (nth 1 x)) | |
433 (file-name-as-directory (nth 0 x)) | |
434 (nth 0 x)))) | |
435 entries))))))) | |
436 | |
437 (defun tramp-smb-handle-file-newer-than-file-p (file1 file2) | |
438 "Like `file-newer-than-file-p' for tramp files." | |
439 (cond | |
440 ((not (file-exists-p file1)) nil) | |
441 ((not (file-exists-p file2)) t) | |
442 (t (tramp-smb-time-less-p (file-attributes file2) | |
443 (file-attributes file1))))) | |
444 | |
445 (defun tramp-smb-handle-file-writable-p (filename) | |
446 "Like `file-writable-p' for tramp files." | |
447 ; (with-parsed-tramp-file-name filename nil | |
448 (let (user host path) | |
449 (with-parsed-tramp-file-name filename l | |
450 (setq user l-user host l-host path l-path)) | |
451 (save-excursion | |
452 (let* ((share (tramp-smb-get-share path)) | |
453 (file (tramp-smb-get-path path nil)) | |
454 (entries (tramp-smb-get-file-entries user host share file)) | |
455 (entry (and entries | |
456 (assoc (file-name-nondirectory file) entries)))) | |
457 (and entry | |
458 (string-match "w" (nth 1 entry)) | |
459 t))))) | |
460 | |
461 (defun tramp-smb-handle-insert-directory | |
462 (filename switches &optional wildcard full-directory-p) | |
463 "Like `insert-directory' for tramp files. | |
464 WILDCARD and FULL-DIRECTORY-P are not handled." | |
465 (setq filename (expand-file-name filename)) | |
466 (when (file-directory-p filename) | |
467 ;; This check is a little bit strange, but in `dired-add-entry' | |
468 ;; this function is called with a non-directory ... | |
469 (setq filename (file-name-as-directory filename))) | |
470 ; (with-parsed-tramp-file-name filename nil | |
471 (let (user host path) | |
472 (with-parsed-tramp-file-name filename l | |
473 (setq user l-user host l-host path l-path)) | |
474 (save-match-data | |
475 (let* ((share (tramp-smb-get-share path)) | |
476 (file (tramp-smb-get-path path nil)) | |
477 (entries (tramp-smb-get-file-entries user host share file))) | |
478 | |
479 ;; Delete dummy "" entry, useless entries | |
480 (setq entries | |
481 (if (file-directory-p filename) | |
482 (delq (assoc "" entries) entries) | |
483 ;; We just need the only and only entry FILENAME. | |
484 (list (assoc (file-name-nondirectory filename) entries)))) | |
485 | |
486 ;; Sort entries | |
487 (setq entries | |
488 (sort | |
489 entries | |
490 (lambda (x y) | |
491 (if (string-match "t" switches) | |
492 ; sort by date | |
493 (tramp-smb-time-less-p (nth 3 y) (nth 3 x)) | |
494 ; sort by name | |
495 (string-lessp (nth 0 x) (nth 0 y)))))) | |
496 | |
497 ;; Print entries | |
498 (mapcar | |
499 (lambda (x) | |
500 (insert | |
501 (format | |
502 "%10s %3d %-8s %-8s %8s %s %s\n" | |
503 (nth 1 x) ; mode | |
504 1 "nobody" "nogroup" | |
505 (nth 2 x) ; size | |
506 (format-time-string | |
507 (if (tramp-smb-time-less-p | |
508 (tramp-smb-time-subtract (current-time) (nth 3 x)) | |
509 tramp-smb-half-a-year) | |
510 "%b %e %R" | |
511 "%b %e %Y") | |
512 (nth 3 x)) ; date | |
513 (nth 0 x))) ; file name | |
514 (forward-line) | |
515 (beginning-of-line)) | |
516 entries))))) | |
517 | |
518 (defun tramp-smb-handle-make-directory (dir &optional parents) | |
519 "Like `make-directory' for tramp files." | |
520 (setq dir (directory-file-name (expand-file-name dir))) | |
521 (unless (file-name-absolute-p dir) | |
522 (setq dir (concat default-directory dir))) | |
523 ; (with-parsed-tramp-file-name dir nil | |
524 (let (user host path) | |
525 (with-parsed-tramp-file-name dir l | |
526 (setq user l-user host l-host path l-path)) | |
527 (save-match-data | |
528 (let* ((share (tramp-smb-get-share path)) | |
529 (ldir (file-name-directory dir))) | |
530 ;; Make missing directory parts | |
531 (when (and parents share (not (file-directory-p ldir))) | |
532 (make-directory ldir parents)) | |
533 ;; Just do it | |
534 (when (file-directory-p ldir) | |
535 (tramp-smb-handle-make-directory-internal dir)) | |
536 (unless (file-directory-p dir) | |
537 (error "Couldn't make directory %s" dir)))))) | |
538 | |
539 (defun tramp-smb-handle-make-directory-internal (directory) | |
540 "Like `make-directory-internal' for tramp files." | |
541 (setq directory (directory-file-name (expand-file-name directory))) | |
542 (unless (file-name-absolute-p directory) | |
543 (setq ldir (concat default-directory directory))) | |
544 ; (with-parsed-tramp-file-name directory nil | |
545 (let (user host path) | |
546 (with-parsed-tramp-file-name directory l | |
547 (setq user l-user host l-host path l-path)) | |
548 (save-match-data | |
549 (let* ((share (tramp-smb-get-share path)) | |
550 (file (tramp-smb-get-path path nil))) | |
551 (when (file-directory-p (file-name-directory directory)) | |
552 (tramp-smb-maybe-open-connection user host share) | |
553 (tramp-smb-send-command user host (format "mkdir \"%s\"" file))) | |
554 (unless (file-directory-p directory) | |
555 (error "Couldn't make directory %s" directory)))))) | |
556 | |
557 (defun tramp-smb-handle-rename-file | |
558 (filename newname &optional ok-if-already-exists) | |
559 "Like `rename-file' for tramp files." | |
560 (setq filename (expand-file-name filename) | |
561 newname (expand-file-name newname)) | |
562 | |
563 (let ((tmpfile (file-local-copy filename))) | |
564 | |
565 (if tmpfile | |
566 ;; remote filename | |
567 (rename-file tmpfile newname ok-if-already-exists) | |
568 | |
569 ;; remote newname | |
570 (when (file-directory-p newname) | |
571 (setq newname (expand-file-name | |
572 (file-name-nondirectory filename) newname))) | |
573 (when (and (not ok-if-already-exists) | |
574 (file-exists-p newname)) | |
575 (error "rename-file: file %s already exists" newname)) | |
576 | |
577 ; (with-parsed-tramp-file-name newname nil | |
578 (let (user host path) | |
579 (with-parsed-tramp-file-name newname l | |
580 (setq user l-user host l-host path l-path)) | |
581 (save-excursion | |
582 (let ((share (tramp-smb-get-share path)) | |
583 (file (tramp-smb-get-path path t))) | |
584 (tramp-smb-maybe-open-connection user host share) | |
585 (tramp-message-for-buffer | |
586 nil tramp-smb-method user host | |
587 5 "Copying file %s to file %s..." filename newname) | |
588 (if (tramp-smb-send-command | |
589 user host (format "put %s \"%s\"" filename file)) | |
590 (tramp-message-for-buffer | |
591 nil tramp-smb-method user host | |
592 5 "Copying file %s to file %s...done" filename newname) | |
593 (error "Cannot rename `%s'" filename))))))) | |
594 | |
595 (delete-file filename)) | |
596 | |
597 (defun tramp-smb-handle-write-region | |
598 (start end filename &optional append visit lockname confirm) | |
599 "Like `write-region' for tramp files." | |
600 (unless (eq append nil) | |
601 (error "Cannot append to file using tramp (`%s')" filename)) | |
602 (setq filename (expand-file-name filename)) | |
603 ;; XEmacs takes a coding system as the seventh argument, not `confirm' | |
604 (when (and (not (featurep 'xemacs)) | |
605 confirm (file-exists-p filename)) | |
606 (unless (y-or-n-p (format "File %s exists; overwrite anyway? " | |
607 filename)) | |
608 (error "File not overwritten"))) | |
609 ; (with-parsed-tramp-file-name filename nil | |
610 (let (user host path) | |
611 (with-parsed-tramp-file-name filename l | |
612 (setq user l-user host l-host path l-path)) | |
613 (save-excursion | |
614 (let ((share (tramp-smb-get-share path)) | |
615 (file (tramp-smb-get-path path t)) | |
616 (curbuf (current-buffer)) | |
617 ;; We use this to save the value of `last-coding-system-used' | |
618 ;; after writing the tmp file. At the end of the function, | |
619 ;; we set `last-coding-system-used' to this saved value. | |
620 ;; This way, any intermediary coding systems used while | |
621 ;; talking to the remote shell or suchlike won't hose this | |
622 ;; variable. This approach was snarfed from ange-ftp.el. | |
623 coding-system-used | |
624 tmpfil) | |
625 ;; Write region into a tmp file. | |
626 (setq tmpfil (tramp-make-temp-file)) | |
627 ;; We say `no-message' here because we don't want the visited file | |
628 ;; modtime data to be clobbered from the temp file. We call | |
629 ;; `set-visited-file-modtime' ourselves later on. | |
630 (tramp-run-real-handler | |
631 'write-region | |
632 (if confirm ; don't pass this arg unless defined for backward compat. | |
633 (list start end tmpfil append 'no-message lockname confirm) | |
634 (list start end tmpfil append 'no-message lockname))) | |
635 ;; Now, `last-coding-system-used' has the right value. Remember it. | |
636 (when (boundp 'last-coding-system-used) | |
637 (setq coding-system-used last-coding-system-used)) | |
638 | |
639 (tramp-smb-maybe-open-connection user host share) | |
640 (tramp-message-for-buffer | |
641 nil tramp-smb-method user host | |
642 5 "Writing tmp file %s to file %s..." tmpfil filename) | |
643 (if (tramp-smb-send-command | |
644 user host (format "put %s \"%s\"" tmpfil file)) | |
645 (tramp-message-for-buffer | |
646 nil tramp-smb-method user host | |
647 5 "Writing tmp file %s to file %s...done" tmpfil filename) | |
648 (error "Cannot write `%s'" filename)) | |
649 | |
650 (delete-file tmpfil) | |
651 (unless (equal curbuf (current-buffer)) | |
652 (error "Buffer has changed from `%s' to `%s'" | |
653 curbuf (current-buffer))) | |
654 (when (eq visit t) | |
655 (set-visited-file-modtime)) | |
656 ;; Make `last-coding-system-used' have the right value. | |
657 (when (boundp 'last-coding-system-used) | |
658 (setq last-coding-system-used coding-system-used)))))) | |
659 | |
660 | |
661 ;; Internal file name functions | |
662 | |
663 (defun tramp-smb-get-share (path) | |
664 "Returns the share name of PATH." | |
665 (save-match-data | |
666 (when (string-match "^/?\\([^/]+\\)/" path) | |
667 (match-string 1 path)))) | |
668 | |
669 (defun tramp-smb-get-path (path convert) | |
670 "Returns the file name of PATH. | |
671 If CONVERT is non-nil exchange \"/\" by \"\\\\\"." | |
672 (save-match-data | |
673 (let ((res path)) | |
674 | |
675 (setq | |
676 res (if (string-match "^/?[^/]+/\\(.*\\)" res) | |
677 (if convert | |
678 (mapconcat | |
679 (lambda (x) (if (equal x ?/) "\\" (char-to-string x))) | |
680 (match-string 1 res) "") | |
681 (match-string 1 res)) | |
682 (if (string-match "^/?\\([^/]+\\)$" res) | |
683 (match-string 1 res) | |
684 ""))) | |
685 | |
686 ;; Sometimes we have discarded `substitute-in-file-name' | |
687 (when (string-match "\\(\\$\\$\\)\\(/\\|$\\)" res) | |
688 (setq res (replace-match "$" nil nil res 1))) | |
689 | |
690 res))) | |
691 | |
692 ;; Share names of a host are cached. It is very unlikely that the | |
693 ;; shares do change during connection. | |
694 (defun tramp-smb-get-file-entries (user host share path) | |
695 "Read entries which match PATH. | |
696 Either the shares are listed, or the `dir' command is executed. | |
697 Only entries matching the path are returned. | |
698 Result is a list of (PATH MODE SIZE MONTH DAY TIME YEAR)." | |
699 (save-excursion | |
700 (save-match-data | |
701 (let ((base (or (and (> (length path) 0) | |
702 (string-match "\\([^/]+\\)$" path) | |
703 (regexp-quote (match-string 1 path))) | |
704 "")) | |
705 res entry) | |
706 (set-buffer (tramp-get-buffer nil tramp-smb-method user host)) | |
707 (if (and (not share) tramp-smb-share-cache) | |
708 ;; Return cached shares | |
709 (setq res tramp-smb-share-cache) | |
710 ;; Read entries | |
711 (tramp-smb-maybe-open-connection user host share) | |
712 (when share | |
713 (tramp-smb-send-command | |
714 user host | |
715 (format "dir %s" | |
716 (if (zerop (length path)) "" (concat "\"" path "*\""))))) | |
717 (goto-char (point-min)) | |
718 ;; Loop the listing | |
719 (unless (re-search-forward tramp-smb-errors nil t) | |
720 (while (not (eobp)) | |
721 (setq entry (tramp-smb-read-file-entry share)) | |
722 (forward-line) | |
723 (when entry (add-to-list 'res entry)))) | |
724 (unless share | |
725 ;; Cache share entries | |
726 (setq tramp-smb-share-cache res))) | |
727 | |
728 | |
729 ;; Add directory itself | |
730 (add-to-list 'res '("" "dr-xr-xr-x" 0 (0 0))) | |
731 | |
732 ;; Check for matching entries | |
733 (delq nil (mapcar | |
734 (lambda (x) (and (string-match base (nth 0 x)) x)) | |
735 res)))))) | |
736 | |
737 ;; Return either a share name (if SHARE is nil), or a file name | |
738 ;; | |
739 ;; If shares are listed, the following format is expected | |
740 ;; | |
741 ;; \s-\{8,8} - leading spaces | |
742 ;; \S-\(.*\S-\)\s-* - share name, 14 char | |
743 ;; \s- - space delimeter | |
744 ;; \S-+\s-* - type, 8 char, "Disk " expected | |
745 ;; \(\s-\{2,2\}.*\)? - space delimeter, comment | |
746 ;; | |
747 ;; Entries provided by smbclient DIR aren't fully regular. | |
748 ;; They should have the format | |
749 ;; | |
750 ;; \s-\{2,2} - leading spaces | |
751 ;; \S-\(.*\S-\)\s-* - file name, 32 chars, left bound | |
752 ;; \s- - space delimeter | |
753 ;; \s-*[ADHRS]* - permissions, 5 chars, right bound | |
754 ;; \s- - space delimeter | |
755 ;; \s-*[0-9]+ - size, 8 (Samba) or 7 (Windows) | |
756 ;; chars, right bound | |
757 ;; \s-\{2,2\} - space delimeter | |
758 ;; \w\{3,3\} - weekday | |
759 ;; \s- - space delimeter | |
760 ;; [ 19][0-9] - day | |
761 ;; \s- - space delimeter | |
762 ;; [0-9]\{2,2\}:[0-9]\{2,2\}:[0-9]\{2,2\} - time | |
763 ;; \s- - space delimeter | |
764 ;; [0-9]\{4,4\} - year | |
765 ;; | |
766 ;; Problems: | |
767 ;; * Modern regexp constructs, like spy groups and counted repetitions, aren't | |
768 ;; available in older Emacsen. | |
769 ;; * The length of constructs (file name, size) might exceed the default. | |
770 ;; * File names might contain spaces. | |
771 ;; * Permissions might be empty. | |
772 ;; | |
773 ;; So we try to analyze backwards. | |
774 (defun tramp-smb-read-file-entry (share) | |
775 "Parse entry in SMB output buffer. | |
776 If SHARE is result, entries are of type dir. Otherwise, shares are listed. | |
777 Result is the list (PATH MODE SIZE MTIME)." | |
778 (let ((line (buffer-substring (point) (tramp-point-at-eol))) | |
779 path mode size month day hour min sec year mtime) | |
780 | |
781 (if (not share) | |
782 | |
783 ; Read share entries | |
784 (when (string-match "^\\s-+\\(\\S-+\\)\\s-+Disk" line) | |
785 (setq path (match-string 1 line) | |
786 mode "dr-xr-xr-x" | |
787 size 0)) | |
788 | |
789 ; Real listing | |
790 (block nil | |
791 | |
792 ;; year | |
793 (if (string-match "\\([0-9]+\\)$" line) | |
794 (setq year (string-to-number (match-string 1 line)) | |
795 line (substring line 0 -5)) | |
796 (return)) | |
797 | |
798 ;; time | |
799 (if (string-match "\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)$" line) | |
800 (setq hour (string-to-number (match-string 1 line)) | |
801 min (string-to-number (match-string 2 line)) | |
802 sec (string-to-number (match-string 3 line)) | |
803 line (substring line 0 -9)) | |
804 (return)) | |
805 | |
806 ;; day | |
807 (if (string-match "\\([0-9]+\\)$" line) | |
808 (setq day (string-to-number (match-string 1 line)) | |
809 line (substring line 0 -3)) | |
810 (return)) | |
811 | |
812 ;; month | |
813 (if (string-match "\\(\\w+\\)$" line) | |
814 (setq month (match-string 1 line) | |
815 line (substring line 0 -4)) | |
816 (return)) | |
817 | |
818 ;; weekday | |
819 (if (string-match "\\(\\w+\\)$" line) | |
820 (setq line (substring line 0 -5)) | |
821 (return)) | |
822 | |
823 ;; size | |
824 (if (string-match "\\([0-9]+\\)$" line) | |
825 (setq size (match-string 1 line) | |
826 line (substring line 0 (- (max 8 (1+ (length size)))))) | |
827 (return)) | |
828 | |
829 ;; mode | |
830 (if (string-match "\\(\\([ADHRS]+\\)?\\s-?\\)$" line) | |
831 (setq | |
832 mode (or (match-string 2 line) "") | |
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")))) | |
839 line (substring line 0 (- (1+ (length (match-string 2 line)))))) | |
840 (return)) | |
841 | |
842 ;; path | |
843 (if (string-match "^\\s-+\\(\\S-\\(.*\\S-\\)?\\)\\s-+$" line) | |
844 (setq path (match-string 1 line)) | |
845 (return)))) | |
846 | |
847 (when (and path mode size) | |
848 (setq mtime | |
849 (if (and sec min hour day month year) | |
850 (encode-time | |
851 sec min hour day | |
852 (cdr (assoc (downcase month) tramp-smb-parse-time-months)) | |
853 year) | |
854 '(0 0))) | |
855 (list path mode size mtime)))) | |
856 | |
857 | |
858 ;; Connection functions | |
859 | |
860 (defun tramp-smb-send-command (user host command) | |
861 "Send the COMMAND to USER at HOST (logged into an SMB session). | |
862 Erases temporary buffer before sending the command. Returns nil if | |
863 there has been an error message from smbclient." | |
864 (save-excursion | |
865 (set-buffer (tramp-get-buffer nil tramp-smb-method user host)) | |
866 (erase-buffer) | |
867 (tramp-send-command nil tramp-smb-method user host command nil t) | |
868 (tramp-smb-wait-for-output user host))) | |
869 | |
870 (defun tramp-smb-maybe-open-connection (user host share) | |
871 "Maybe open a connection to HOST, logging in as USER, using `tramp-smb-program'. | |
872 Does not do anything if a connection is already open, but re-opens the | |
873 connection if a previous connection has died for some reason." | |
874 (let ((p (get-buffer-process | |
875 (tramp-get-buffer nil tramp-smb-method user host)))) | |
876 (save-excursion | |
877 (set-buffer (tramp-get-buffer nil tramp-smb-method user host)) | |
878 ;; Check whether it is still the same share | |
879 (unless (and p (processp p) (string-equal tramp-smb-share share)) | |
880 (when (and p (processp p)) | |
881 (delete-process p) | |
882 (setq p nil))) | |
883 ;; If too much time has passed since last command was sent, look | |
884 ;; whether process is still alive. If it isn't, kill it. | |
885 (when (and tramp-last-cmd-time | |
886 (> (tramp-time-diff (current-time) tramp-last-cmd-time) 60) | |
887 p (processp p) (memq (process-status p) '(run open))) | |
888 (unless (and p (processp p) (memq (process-status p) '(run open))) | |
889 (delete-process p) | |
890 (setq p nil)))) | |
891 (unless (and p (processp p) (memq (process-status p) '(run open))) | |
892 (when (and p (processp p)) | |
893 (delete-process p)) | |
894 (tramp-smb-open-connection user host share)))) | |
895 | |
896 (defun tramp-smb-open-connection (user host share) | |
897 "Open a connection using `tramp-smb-program'. | |
898 This starts the command `smbclient //HOST/SHARE -U USER', then waits | |
899 for a remote password prompt. It queries the user for the password, | |
900 then sends the password to the remote host. | |
901 | |
902 Domain names in USER and port numbers in HOST are acknowledged." | |
903 | |
904 (save-match-data | |
905 (let* ((buffer (tramp-get-buffer nil tramp-smb-method user host)) | |
906 (real-user user) | |
907 (real-host host) | |
908 domain port args) | |
909 | |
910 ; Check for domain ("user%domain") and port ("host#port") | |
911 (when (and user (string-match "\\(.+\\)%\\(.+\\)" user)) | |
912 (setq real-user (or (match-string 1 user) user) | |
913 domain (match-string 2 user))) | |
914 | |
915 (when (and host (string-match "\\(.+\\)#\\(.+\\)" host)) | |
916 (setq real-host (or (match-string 1 host) host) | |
917 port (match-string 2 host))) | |
918 | |
919 (if share | |
920 (setq args (list (concat "//" real-host "/" share))) | |
921 (setq args (list "-L" real-host ))) | |
922 | |
923 (if real-user | |
924 (setq args (append args (list "-U" real-user))) | |
925 (setq args (append args (list "-N")))) | |
926 | |
927 (when domain (setq args (append args (list "-W" domain)))) | |
928 (when port (setq args (append args (list "-p" port)))) | |
929 | |
930 ; OK, let's go | |
931 (tramp-pre-connection nil tramp-smb-method user host) | |
932 (tramp-message 7 "Opening connection for //%s@%s/%s..." | |
933 user host (or share "")) | |
934 | |
935 (let* ((default-directory (tramp-temporary-file-directory)) | |
936 ;; If we omit the conditional here, then we would use | |
937 ;; `undecided-dos' in some cases. With the conditional, | |
938 ;; we use nil in these cases. Which one is right? | |
939 (coding-system-for-read (unless (and (not (featurep 'xemacs)) | |
940 (> emacs-major-version 20)) | |
941 tramp-dos-coding-system)) | |
942 (p (apply #'start-process (buffer-name buffer) buffer | |
943 tramp-smb-program args))) | |
944 | |
945 (tramp-message 9 "Started process %s" (process-command p)) | |
946 (process-kill-without-query p) | |
947 (set-buffer buffer) | |
948 (set-process-sentinel | |
949 p (lambda (proc str) (setq tramp-smb-process-running nil))) | |
950 ; If no share is given, the process will terminate | |
951 (setq tramp-smb-process-running share | |
952 tramp-smb-share share) | |
953 | |
954 ; send password | |
955 (when real-user | |
956 (let ((pw-prompt "Password:")) | |
957 (tramp-message 9 "Sending password") | |
958 (tramp-enter-password p pw-prompt))) | |
959 | |
960 (unless (tramp-smb-wait-for-output user host) | |
961 (error "Cannot open connection //%s@%s/%s" | |
962 user host (or share ""))))))) | |
963 | |
964 ;; We don't use timeouts. If needed, the caller shall wrap around. | |
965 (defun tramp-smb-wait-for-output (user host) | |
966 "Wait for output from smbclient command. | |
967 Sets position to begin of buffer. | |
968 Returns nil if an error message has appeared." | |
969 (save-excursion | |
970 (let ((proc (get-buffer-process (current-buffer))) | |
971 (found (progn (goto-char (point-max)) | |
972 (beginning-of-line) | |
973 (looking-at tramp-smb-prompt))) | |
974 err) | |
975 (save-match-data | |
976 ;; Algorithm: get waiting output. See if last line contains | |
977 ;; tramp-smb-prompt sentinel, or process has exited. | |
978 ;; If not, wait a bit and again get waiting output. | |
979 (while (and (not found) tramp-smb-process-running) | |
980 (accept-process-output proc) | |
981 (goto-char (point-max)) | |
982 (beginning-of-line) | |
983 (setq found (looking-at tramp-smb-prompt))) | |
984 | |
985 ;; There might be pending output. If tramp-smb-prompt sentinel | |
986 ;; hasn't been found, the process has died already. We should | |
987 ;; give it a chance. | |
988 (when (not found) (accept-process-output nil 1)) | |
989 | |
990 ;; Search for errors. | |
991 (goto-char (point-min)) | |
992 (setq err (re-search-forward tramp-smb-errors nil t))) | |
993 | |
994 ;; Add output to debug buffer if appropriate. | |
995 (when tramp-debug-buffer | |
996 (append-to-buffer | |
997 (tramp-get-debug-buffer nil tramp-smb-method user host) | |
998 (point-min) (point-max)) | |
999 (when (and (not found) tramp-smb-process-running) | |
1000 (save-excursion | |
1001 (set-buffer | |
1002 (tramp-get-debug-buffer nil tramp-smb-method user host)) | |
1003 (goto-char (point-max)) | |
1004 (insert (format "[[Remote prompt `%s' not found]]\n" | |
1005 tramp-smb-prompt))))) | |
1006 (goto-char (point-min)) | |
1007 ;; Return value is whether no error message has appeared. | |
1008 (not err)))) | |
1009 | |
1010 | |
1011 ;; Snarfed code from time-date.el and parse-time.el | |
1012 | |
1013 (defconst tramp-smb-half-a-year '(241 17024) | |
1014 "Evaluated by \"(days-to-time 183)\".") | |
1015 | |
1016 (defconst tramp-smb-parse-time-months '(("jan" . 1) ("feb" . 2) ("mar" . 3) | |
1017 ("apr" . 4) ("may" . 5) ("jun" . 6) | |
1018 ("jul" . 7) ("aug" . 8) ("sep" . 9) | |
1019 ("oct" . 10) ("nov" . 11) ("dec" . 12)) | |
1020 "Alist mapping month names to integers.") | |
1021 | |
1022 (defun tramp-smb-time-less-p (t1 t2) | |
1023 "Say whether time value T1 is less than time value T2." | |
1024 (unless t1 (setq t1 '(0 0))) | |
1025 (unless t2 (setq t2 '(0 0))) | |
1026 (or (< (car t1) (car t2)) | |
1027 (and (= (car t1) (car t2)) | |
1028 (< (nth 1 t1) (nth 1 t2))))) | |
1029 | |
1030 (defun tramp-smb-time-subtract (t1 t2) | |
1031 "Subtract two time values. | |
1032 Return the difference in the format of a time value." | |
1033 (unless t1 (setq t1 '(0 0))) | |
1034 (unless t2 (setq t2 '(0 0))) | |
1035 (let ((borrow (< (cadr t1) (cadr t2)))) | |
1036 (list (- (car t1) (car t2) (if borrow 1 0)) | |
1037 (- (+ (if borrow 65536 0) (cadr t1)) (cadr t2))))) | |
1038 | |
1039 | |
1040 ;; `PC-do-completion' touches the returning "$$" by `substitute-in-file-name'. | |
1041 ;; Must be corrected. | |
1042 | |
1043 (defadvice PC-do-completion (around tramp-smb-advice-PC-do-completion activate) | |
1044 "Changes \"$\" back to \"$$\" in minibuffer." | |
1045 (if (funcall PC-completion-as-file-name-predicate) | |
1046 | |
1047 (progn | |
1048 ;; Substitute file names | |
1049 (let* ((beg (or (and (functionp 'minibuffer-prompt-end) ; Emacs 21 | |
1050 (funcall 'minibuffer-prompt-end)) | |
1051 (point-min))) | |
1052 (end (point-max)) | |
1053 (str (substitute-in-file-name (buffer-substring beg end)))) | |
1054 (delete-region beg end) | |
1055 (insert str) | |
1056 (ad-set-arg 2 (point))) | |
1057 | |
1058 ;; Do `PC-do-completion' without substitution | |
1059 (let* (save) | |
1060 (fset 'save (symbol-function 'substitute-in-file-name)) | |
1061 (fset 'substitute-in-file-name (symbol-function 'identity)) | |
1062 ad-do-it | |
1063 (fset 'substitute-in-file-name (symbol-function 'save))) | |
1064 | |
1065 ;; Expand "$" | |
1066 (let* ((beg (or (and (functionp 'minibuffer-prompt-end) ; Emacs 21 | |
1067 (funcall 'minibuffer-prompt-end)) | |
1068 (point-min))) | |
1069 (end (point-max)) | |
1070 (str (buffer-substring beg end))) | |
1071 (delete-region beg end) | |
1072 (insert (if (string-match "\\(\\$\\)\\(/\\|$\\)" str) | |
1073 (replace-match "$$" nil nil str 1) | |
1074 str)))) | |
1075 | |
1076 ;; No file names. Behave unchanged. | |
1077 ad-do-it)) | |
1078 | |
1079 (provide 'tramp-smb) | |
1080 | |
1081 ;;; TODO: | |
1082 | |
1083 ;; * Provide a local smb.conf. The default one might not be readable. | |
1084 ;; * Error handling in case password is wrong. | |
1085 ;; * Read password from "~/.netrc". | |
1086 ;; * Use different buffers for different shares. By this, the password | |
1087 ;; won't be requested again when changing shares on the same host. | |
1088 ;; * Return more comprehensive file permission string. Think whether it is | |
1089 ;; possible to implement `set-file-modes'. | |
1090 ;; * Handle WILDCARD and FULL-DIRECTORY-P in | |
1091 ;; `tramp-smb-handle-insert-directory'. | |
1092 ;; * Handle links (FILENAME.LNK). | |
1093 ;; * Maybe local tmp files should have the same extension like the original | |
1094 ;; files. Strange behaviour with jka-compr otherwise? | |
1095 ;; * Copy files in dired from SMB to another method doesn't work. | |
1096 ;; * Try to remove the inclusion of dummy "" directory. Seems to be at | |
1097 ;; several places, especially in `tramp-smb-handle-insert-directory'. | |
1098 ;; * Provide variables for debug. | |
1099 ;; * (RMS) Use unwind-protect to clean up the state so as to make the state | |
1100 ;; regular again. | |
1101 | |
1102 ;;; tramp-smb.el ends here |