HCoop / bpt / emacs.git / blame
| Commit | Line | Data |
|---|---|---|
| bce04fee | 1 | ;;; tramp-smb.el --- Tramp access functions for SMB servers |
| 4007ba5b | 2 | |
| 73b0cd50 | 3 | ;; Copyright (C) 2002-2011 Free Software Foundation, Inc. |
| 4007ba5b | 4 | |
| 340b8d4f | 5 | ;; Author: Michael Albinus <michael.albinus@gmx.de> |
| 4007ba5b | 6 | ;; Keywords: comm, processes |
| bd78fa1d | 7 | ;; Package: tramp |
| 4007ba5b KG |
8 | |
| 9 | ;; This file is part of GNU Emacs. | |
| 10 | ||
| 874a927a | 11 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
| 4007ba5b | 12 | ;; it under the terms of the GNU General Public License as published by |
| 874a927a GM |
13 | ;; the Free Software Foundation, either version 3 of the License, or |
| 14 | ;; (at your option) any later version. | |
| 4007ba5b KG |
15 | |
| 16 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
| 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
| 19 | ;; GNU General Public License for more details. | |
| 20 | ||
| 21 | ;; You should have received a copy of the GNU General Public License | |
| 874a927a | 22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
| 4007ba5b KG |
23 | |
| 24 | ;;; Commentary: | |
| 25 | ||
| 26 | ;; Access functions for SMB servers like SAMBA or M$ Windows from Tramp. | |
| 27 | ||
| 28 | ;;; Code: | |
| 29 | ||
| e8f28744 | 30 | (eval-when-compile (require 'cl)) ; block, return |
| 4007ba5b KG |
31 | (require 'tramp) |
| 32 | ||
| 4007ba5b | 33 | ;; Define SMB method ... |
| 0f34aa77 MA |
34 | ;;;###tramp-autoload |
| 35 | (defconst tramp-smb-method "smb" | |
| 36 | "*Method to connect SAMBA and M$ SMB servers.") | |
| 4007ba5b KG |
37 | |
| 38 | ;; ... and add it to the method list. | |
| 0f34aa77 MA |
39 | ;;;###tramp-autoload |
| 40 | (unless (memq system-type '(cygwin windows-nt)) | |
| 41 | (add-to-list 'tramp-methods (cons tramp-smb-method nil))) | |
| 4007ba5b KG |
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. | |
| b191c9d9 | 45 | ;;;###tramp-autoload |
| 4007ba5b | 46 | (add-to-list 'tramp-default-method-alist |
| 36a3859f | 47 | `(nil ,tramp-prefix-domain-regexp ,tramp-smb-method)) |
| 00d6fd04 MA |
48 | |
| 49 | ;; Add a default for `tramp-default-user-alist'. Rule: For the SMB method, | |
| 50 | ;; the anonymous user is chosen. | |
| b191c9d9 | 51 | ;;;###tramp-autoload |
| 00d6fd04 | 52 | (add-to-list 'tramp-default-user-alist |
| 66feec8b | 53 | `(,(concat "\\`" tramp-smb-method "\\'") nil nil)) |
| 4007ba5b KG |
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 | ||
| 0536254e MA |
65 | (defcustom tramp-smb-conf "/dev/null" |
| 66 | "*Path of the smb.conf file. | |
| 67 | If it is nil, no smb.conf will be added to the `tramp-smb-program' | |
| 68 | call, letting the SMB client use the default one." | |
| 69 | :group 'tramp | |
| 70 | :type '(choice (const nil) (file :must-match t))) | |
| 71 | ||
| 0c6f436e MA |
72 | (defvar tramp-smb-version nil |
| 73 | "*Version string of the SMB client.") | |
| 74 | ||
| 340b8d4f | 75 | (defconst tramp-smb-prompt "^smb: .+> \\|^\\s-+Server\\s-+Comment$" |
| 4007ba5b KG |
76 | "Regexp used as prompt in smbclient.") |
| 77 | ||
| 78 | (defconst tramp-smb-errors | |
| 00d6fd04 | 79 | ;; `regexp-opt' not possible because of first string. |
| 4007ba5b KG |
80 | (mapconcat |
| 81 | 'identity | |
| c2dc9732 | 82 | '(;; Connection error / timeout / unknown command. |
| 4007ba5b | 83 | "Connection to \\S-+ failed" |
| 00d6fd04 | 84 | "Read from server failed, maybe it closed the connection" |
| d037d501 | 85 | "Call timed out: server did not respond" |
| c2dc9732 MA |
86 | "\\S-+: command not found" |
| 87 | "Server doesn't support UNIX CIFS calls" | |
| 88 | ;; Samba. | |
| 4007ba5b | 89 | "ERRDOS" |
| 4260b402 | 90 | "ERRHRD" |
| 5ec2cc41 | 91 | "ERRSRV" |
| 4007ba5b KG |
92 | "ERRbadfile" |
| 93 | "ERRbadpw" | |
| 94 | "ERRfilexists" | |
| 95 | "ERRnoaccess" | |
| 96 | "ERRnomem" | |
| 97 | "ERRnosuchshare" | |
| 00d6fd04 | 98 | ;; Windows 4.0 (Windows NT), Windows 5.0 (Windows 2000), |
| c2dc9732 | 99 | ;; Windows 5.1 (Windows XP), Windows 5.2 (Windows Server 2003). |
| 4007ba5b | 100 | "NT_STATUS_ACCESS_DENIED" |
| 5ec2cc41 | 101 | "NT_STATUS_ACCOUNT_LOCKED_OUT" |
| 4007ba5b KG |
102 | "NT_STATUS_BAD_NETWORK_NAME" |
| 103 | "NT_STATUS_CANNOT_DELETE" | |
| cc3dda16 | 104 | "NT_STATUS_CONNECTION_REFUSED" |
| 00d6fd04 MA |
105 | "NT_STATUS_DIRECTORY_NOT_EMPTY" |
| 106 | "NT_STATUS_DUPLICATE_NAME" | |
| 107 | "NT_STATUS_FILE_IS_A_DIRECTORY" | |
| 4007ba5b | 108 | "NT_STATUS_LOGON_FAILURE" |
| 5ec2cc41 | 109 | "NT_STATUS_NETWORK_ACCESS_DENIED" |
| f6f7e059 | 110 | "NT_STATUS_NOT_IMPLEMENTED" |
| 4007ba5b | 111 | "NT_STATUS_NO_SUCH_FILE" |
| 00d6fd04 | 112 | "NT_STATUS_OBJECT_NAME_COLLISION" |
| 4007ba5b KG |
113 | "NT_STATUS_OBJECT_NAME_INVALID" |
| 114 | "NT_STATUS_OBJECT_NAME_NOT_FOUND" | |
| 5ec2cc41 | 115 | "NT_STATUS_SHARING_VIOLATION" |
| 00d6fd04 | 116 | "NT_STATUS_TRUSTED_RELATIONSHIP_FAILURE" |
| 5ec2cc41 | 117 | "NT_STATUS_WRONG_PASSWORD") |
| 4007ba5b KG |
118 | "\\|") |
| 119 | "Regexp for possible error strings of SMB servers. | |
| 120 | Used instead of analyzing error codes of commands.") | |
| 121 | ||
| 00d6fd04 MA |
122 | (defconst tramp-smb-actions-with-share |
| 123 | '((tramp-smb-prompt tramp-action-succeed) | |
| 124 | (tramp-password-prompt-regexp tramp-action-password) | |
| 125 | (tramp-wrong-passwd-regexp tramp-action-permission-denied) | |
| 126 | (tramp-smb-errors tramp-action-permission-denied) | |
| 127 | (tramp-process-alive-regexp tramp-action-process-alive)) | |
| 128 | "List of pattern/action pairs. | |
| 129 | This list is used for login to SMB servers. | |
| 130 | ||
| 131 | See `tramp-actions-before-shell' for more info.") | |
| 4007ba5b | 132 | |
| 00d6fd04 MA |
133 | (defconst tramp-smb-actions-without-share |
| 134 | '((tramp-password-prompt-regexp tramp-action-password) | |
| 135 | (tramp-wrong-passwd-regexp tramp-action-permission-denied) | |
| 136 | (tramp-smb-errors tramp-action-permission-denied) | |
| 137 | (tramp-process-alive-regexp tramp-action-out-of-band)) | |
| 138 | "List of pattern/action pairs. | |
| 139 | This list is used for login to SMB servers. | |
| 4007ba5b | 140 | |
| 00d6fd04 | 141 | See `tramp-actions-before-shell' for more info.") |
| 8daea7fc | 142 | |
| 4007ba5b KG |
143 | ;; New handlers should be added here. |
| 144 | (defconst tramp-smb-file-name-handler-alist | |
| 145 | '( | |
| c2dc9732 | 146 | ;; `access-file' performed by default handler. |
| f6f7e059 | 147 | (add-name-to-file . tramp-smb-handle-add-name-to-file) |
| c2dc9732 MA |
148 | ;; `byte-compiler-base-file-name' performed by default handler. |
| 149 | (copy-directory . tramp-smb-handle-copy-directory) | |
| 4007ba5b KG |
150 | (copy-file . tramp-smb-handle-copy-file) |
| 151 | (delete-directory . tramp-smb-handle-delete-directory) | |
| 152 | (delete-file . tramp-smb-handle-delete-file) | |
| c2dc9732 | 153 | ;; `diff-latest-backup-file' performed by default handler. |
| 8daea7fc | 154 | (directory-file-name . tramp-handle-directory-file-name) |
| 4007ba5b | 155 | (directory-files . tramp-smb-handle-directory-files) |
| c2dc9732 | 156 | (directory-files-and-attributes |
| bd8fadca | 157 | . tramp-handle-directory-files-and-attributes) |
| 00d6fd04 MA |
158 | (dired-call-process . ignore) |
| 159 | (dired-compress-file . ignore) | |
| fffba733 | 160 | (dired-uncache . tramp-handle-dired-uncache) |
| c2dc9732 | 161 | (expand-file-name . tramp-smb-handle-expand-file-name) |
| 4007ba5b KG |
162 | (file-accessible-directory-p . tramp-smb-handle-file-directory-p) |
| 163 | (file-attributes . tramp-smb-handle-file-attributes) | |
| 164 | (file-directory-p . tramp-smb-handle-file-directory-p) | |
| bd8fadca MA |
165 | (file-executable-p . tramp-handle-file-exists-p) |
| 166 | (file-exists-p . tramp-handle-file-exists-p) | |
| 4007ba5b KG |
167 | (file-local-copy . tramp-smb-handle-file-local-copy) |
| 168 | (file-modes . tramp-handle-file-modes) | |
| 169 | (file-name-all-completions . tramp-smb-handle-file-name-all-completions) | |
| 2c5b3bdd | 170 | (file-name-as-directory . tramp-handle-file-name-as-directory) |
| 4007ba5b KG |
171 | (file-name-completion . tramp-handle-file-name-completion) |
| 172 | (file-name-directory . tramp-handle-file-name-directory) | |
| 173 | (file-name-nondirectory . tramp-handle-file-name-nondirectory) | |
| c2dc9732 | 174 | ;; `file-name-sans-versions' performed by default handler. |
| bd8fadca | 175 | (file-newer-than-file-p . tramp-handle-file-newer-than-file-p) |
| 00d6fd04 | 176 | (file-ownership-preserved-p . ignore) |
| bd8fadca | 177 | (file-readable-p . tramp-handle-file-exists-p) |
| 4007ba5b | 178 | (file-regular-p . tramp-handle-file-regular-p) |
| 632c5478 MA |
179 | (file-remote-p . tramp-handle-file-remote-p) |
| 180 | ;; `file-selinux-context' performed by default handler. | |
| 00d6fd04 | 181 | (file-symlink-p . tramp-handle-file-symlink-p) |
| c2dc9732 | 182 | ;; `file-truename' performed by default handler. |
| 4007ba5b | 183 | (file-writable-p . tramp-smb-handle-file-writable-p) |
| 38c65fca | 184 | (find-backup-file-name . tramp-handle-find-backup-file-name) |
| c2dc9732 MA |
185 | ;; `find-file-noselect' performed by default handler. |
| 186 | ;; `get-file-buffer' performed by default handler. | |
| 4007ba5b KG |
187 | (insert-directory . tramp-smb-handle-insert-directory) |
| 188 | (insert-file-contents . tramp-handle-insert-file-contents) | |
| 189 | (load . tramp-handle-load) | |
| 190 | (make-directory . tramp-smb-handle-make-directory) | |
| 191 | (make-directory-internal . tramp-smb-handle-make-directory-internal) | |
| f6f7e059 | 192 | (make-symbolic-link . tramp-smb-handle-make-symbolic-link) |
| 4007ba5b | 193 | (rename-file . tramp-smb-handle-rename-file) |
| c2dc9732 | 194 | (set-file-modes . tramp-smb-handle-set-file-modes) |
| 632c5478 | 195 | ;; `set-file-selinux-context' performed by default handler. |
| c2dc9732 | 196 | (set-file-times . ignore) |
| 00d6fd04 MA |
197 | (set-visited-file-modtime . ignore) |
| 198 | (shell-command . ignore) | |
| 01917a18 | 199 | (substitute-in-file-name . tramp-smb-handle-substitute-in-file-name) |
| 4007ba5b | 200 | (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory) |
| 00d6fd04 MA |
201 | (vc-registered . ignore) |
| 202 | (verify-visited-file-modtime . ignore) | |
| 4007ba5b KG |
203 | (write-region . tramp-smb-handle-write-region) |
| 204 | ) | |
| 205 | "Alist of handler functions for Tramp SMB method. | |
| 206 | Operations not mentioned here will be handled by the default Emacs primitives.") | |
| 207 | ||
| 0f34aa77 MA |
208 | ;;;###tramp-autoload |
| 209 | (defsubst tramp-smb-file-name-p (filename) | |
| 4007ba5b KG |
210 | "Check if it's a filename for SMB servers." |
| 211 | (let ((v (tramp-dissect-file-name filename))) | |
| 00d6fd04 | 212 | (string= (tramp-file-name-method v) tramp-smb-method))) |
| 4007ba5b | 213 | |
| 0f34aa77 | 214 | ;;;###tramp-autoload |
| 4007ba5b KG |
215 | (defun tramp-smb-file-name-handler (operation &rest args) |
| 216 | "Invoke the SMB related OPERATION. | |
| 217 | First arg specifies the OPERATION, second arg is a list of arguments to | |
| 218 | pass to the OPERATION." | |
| 219 | (let ((fn (assoc operation tramp-smb-file-name-handler-alist))) | |
| 220 | (if fn | |
| 00d6fd04 | 221 | (save-match-data (apply (cdr fn) args)) |
| 4007ba5b KG |
222 | (tramp-run-real-handler operation args)))) |
| 223 | ||
| 0f34aa77 MA |
224 | ;;;###tramp-autoload |
| 225 | (unless (memq system-type '(cygwin windows-nt)) | |
| 226 | (add-to-list 'tramp-foreign-file-name-handler-alist | |
| 227 | (cons 'tramp-smb-file-name-p 'tramp-smb-file-name-handler))) | |
| 4007ba5b KG |
228 | |
| 229 | ||
| c2dc9732 MA |
230 | ;; File name primitives. |
| 231 | ||
| f6f7e059 MA |
232 | (defun tramp-smb-handle-add-name-to-file |
| 233 | (filename newname &optional ok-if-already-exists) | |
| 234 | "Like `add-name-to-file' for Tramp files." | |
| 235 | (unless (tramp-equal-remote filename newname) | |
| 236 | (with-parsed-tramp-file-name | |
| 237 | (if (tramp-tramp-file-p filename) filename newname) nil | |
| 238 | (tramp-error | |
| 239 | v 'file-error | |
| 240 | "add-name-to-file: %s" | |
| 241 | "only implemented for same method, same user, same host"))) | |
| 242 | (with-parsed-tramp-file-name filename v1 | |
| 243 | (with-parsed-tramp-file-name newname v2 | |
| 244 | (when (file-directory-p filename) | |
| 245 | (tramp-error | |
| 246 | v2 'file-error | |
| 247 | "add-name-to-file: %s must not be a directory" filename)) | |
| 248 | (when (and (not ok-if-already-exists) | |
| 249 | (file-exists-p newname) | |
| 250 | (not (numberp ok-if-already-exists)) | |
| 251 | (y-or-n-p | |
| 252 | (format | |
| 253 | "File %s already exists; make it a new name anyway? " | |
| 254 | newname))) | |
| 255 | (tramp-error | |
| 256 | v2 'file-error | |
| 257 | "add-name-to-file: file %s already exists" newname)) | |
| 258 | ;; We must also flush the cache of the directory, because | |
| 259 | ;; `file-attributes' reads the values from there. | |
| 260 | (tramp-flush-file-property v2 (file-name-directory v2-localname)) | |
| 261 | (tramp-flush-file-property v2 v2-localname) | |
| 4260b402 MA |
262 | (unless |
| 263 | (tramp-smb-send-command | |
| 264 | v1 | |
| 265 | (format | |
| 266 | "%s \"%s\" \"%s\"" | |
| 267 | (if (tramp-smb-get-cifs-capabilities v1) "link" "hardlink") | |
| 268 | (tramp-smb-get-localname v1) | |
| 269 | (tramp-smb-get-localname v2))) | |
| 270 | (tramp-error | |
| 271 | v2 'file-error | |
| 272 | "error with add-name-to-file, see buffer `%s' for details" | |
| 273 | (buffer-name)))))) | |
| f6f7e059 | 274 | |
| c2dc9732 MA |
275 | (defun tramp-smb-handle-copy-directory |
| 276 | (dirname newname &optional keep-date parents) | |
| 4260b402 | 277 | "Like `copy-directory' for Tramp files. KEEP-DATE is not handled." |
| c2dc9732 MA |
278 | (setq dirname (expand-file-name dirname) |
| 279 | newname (expand-file-name newname)) | |
| 280 | (let ((t1 (tramp-tramp-file-p dirname)) | |
| 281 | (t2 (tramp-tramp-file-p newname))) | |
| 282 | (with-parsed-tramp-file-name (if t1 dirname newname) nil | |
| 288f783b | 283 | (cond |
| 4260b402 | 284 | ;; We must use a local temporary directory. |
| 288f783b | 285 | ((and t1 t2) |
| 288f783b MA |
286 | (let ((tmpdir |
| 287 | (make-temp-name | |
| 288 | (expand-file-name | |
| 289 | tramp-temp-name-prefix | |
| 290 | (tramp-compat-temporary-file-directory))))) | |
| 291 | (unwind-protect | |
| 292 | (progn | |
| ede9503b MA |
293 | (tramp-compat-copy-directory dirname tmpdir keep-date parents) |
| 294 | (tramp-compat-copy-directory tmpdir newname keep-date parents)) | |
| 295 | (tramp-compat-delete-directory tmpdir 'recursive)))) | |
| 4260b402 MA |
296 | |
| 297 | ;; We can copy recursively. | |
| 288f783b | 298 | ((or t1 t2) |
| 288f783b | 299 | (let ((prompt (tramp-smb-send-command v "prompt")) |
| 4260b402 | 300 | (recurse (tramp-smb-send-command v "recurse"))) |
| 288f783b MA |
301 | (unless (file-directory-p newname) |
| 302 | (make-directory newname parents)) | |
| 303 | (unwind-protect | |
| 304 | (unless | |
| 305 | (and | |
| 306 | prompt recurse | |
| 307 | (tramp-smb-send-command | |
| 4260b402 | 308 | v (format "cd \"%s\"" (tramp-smb-get-localname v))) |
| 288f783b MA |
309 | (tramp-smb-send-command |
| 310 | v (format "lcd \"%s\"" (if t1 newname dirname))) | |
| 311 | (if t1 | |
| 312 | (tramp-smb-send-command v "mget *") | |
| 313 | (tramp-smb-send-command v "mput *"))) | |
| 314 | ;; Error. | |
| 315 | (with-current-buffer (tramp-get-connection-buffer v) | |
| 316 | (goto-char (point-min)) | |
| 317 | (search-forward-regexp tramp-smb-errors nil t) | |
| 318 | (tramp-error | |
| 319 | v 'file-error | |
| 320 | "%s `%s'" (match-string 0) (if t1 dirname newname)))) | |
| f6f7e059 | 321 | ;; Go home. |
| 4260b402 MA |
322 | (tramp-smb-send-command |
| 323 | v (format | |
| 324 | "cd %s" (if (tramp-smb-get-cifs-capabilities v) "/" "\\"))) | |
| 288f783b MA |
325 | ;; Toggle prompt and recurse OFF. |
| 326 | (if prompt (tramp-smb-send-command v "prompt")) | |
| 327 | (if recurse (tramp-smb-send-command v "recurse"))))) | |
| 4260b402 MA |
328 | |
| 329 | ;; We must do it file-wise. | |
| 288f783b | 330 | (t |
| c2dc9732 | 331 | (tramp-run-real-handler |
| 288f783b | 332 | 'copy-directory (list dirname newname keep-date parents))))))) |
| 4007ba5b | 333 | |
| 4007ba5b | 334 | (defun tramp-smb-handle-copy-file |
| 632c5478 MA |
335 | (filename newname &optional ok-if-already-exists keep-date |
| 336 | preserve-uid-gid preserve-selinux-context) | |
| 00d6fd04 | 337 | "Like `copy-file' for Tramp files. |
| a4aeb9a4 MA |
338 | KEEP-DATE is not handled in case NEWNAME resides on an SMB server. |
| 339 | PRESERVE-UID-GID is completely ignored." | |
| 4007ba5b KG |
340 | (setq filename (expand-file-name filename) |
| 341 | newname (expand-file-name newname)) | |
| 3b30ccda MA |
342 | (with-progress-reporter |
| 343 | (tramp-dissect-file-name (if (file-remote-p filename) filename newname)) | |
| 344 | 0 (format "Copying %s to %s" filename newname) | |
| 345 | ||
| 346 | (let ((tmpfile (file-local-copy filename))) | |
| 347 | ||
| 348 | (if tmpfile | |
| 349 | ;; Remote filename. | |
| 350 | (condition-case err | |
| 351 | (rename-file tmpfile newname ok-if-already-exists) | |
| 352 | ((error quit) | |
| eba082a2 | 353 | (delete-file tmpfile) |
| 3b30ccda MA |
354 | (signal (car err) (cdr err)))) |
| 355 | ||
| 356 | ;; Remote newname. | |
| 357 | (when (file-directory-p newname) | |
| 358 | (setq newname | |
| 359 | (expand-file-name (file-name-nondirectory filename) newname))) | |
| 360 | ||
| 361 | (with-parsed-tramp-file-name newname nil | |
| 362 | (when (and (not ok-if-already-exists) | |
| 363 | (file-exists-p newname)) | |
| 364 | (tramp-error v 'file-already-exists newname)) | |
| 4007ba5b | 365 | |
| 3b30ccda MA |
366 | ;; We must also flush the cache of the directory, because |
| 367 | ;; `file-attributes' reads the values from there. | |
| 368 | (tramp-flush-file-property v (file-name-directory localname)) | |
| 369 | (tramp-flush-file-property v localname) | |
| 370 | (unless (tramp-smb-get-share v) | |
| 371 | (tramp-error | |
| 372 | v 'file-error "Target `%s' must contain a share name" newname)) | |
| 373 | (unless (tramp-smb-send-command | |
| 374 | v (format "put \"%s\" \"%s\"" | |
| 375 | filename (tramp-smb-get-localname v))) | |
| 376 | (tramp-error v 'file-error "Cannot copy `%s'" filename)))))) | |
| c2dc9732 MA |
377 | |
| 378 | ;; KEEP-DATE handling. | |
| 379 | (when keep-date (set-file-times newname (nth 5 (file-attributes filename))))) | |
| 4007ba5b | 380 | |
| cc3dda16 | 381 | (defun tramp-smb-handle-delete-directory (directory &optional recursive) |
| 00d6fd04 | 382 | "Like `delete-directory' for Tramp files." |
| 4007ba5b | 383 | (setq directory (directory-file-name (expand-file-name directory))) |
| 340b8d4f | 384 | (when (file-exists-p directory) |
| cc3dda16 MA |
385 | (if recursive |
| 386 | (mapc | |
| 387 | (lambda (file) | |
| 388 | (if (file-directory-p file) | |
| ede9503b | 389 | (tramp-compat-delete-directory file recursive) |
| 4f201088 | 390 | (delete-file file))) |
| cc3dda16 MA |
391 | ;; We do not want to delete "." and "..". |
| 392 | (directory-files | |
| 393 | directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"))) | |
| 4260b402 | 394 | |
| 340b8d4f | 395 | (with-parsed-tramp-file-name directory nil |
| 00d6fd04 | 396 | ;; We must also flush the cache of the directory, because |
| f6f7e059 | 397 | ;; `file-attributes' reads the values from there. |
| 00d6fd04 MA |
398 | (tramp-flush-file-property v (file-name-directory localname)) |
| 399 | (tramp-flush-directory-property v localname) | |
| 4260b402 MA |
400 | (unless (tramp-smb-send-command |
| 401 | v (format | |
| 402 | "%s \"%s\"" | |
| 403 | (if (tramp-smb-get-cifs-capabilities v) "posix_rmdir" "rmdir") | |
| 404 | (tramp-smb-get-localname v))) | |
| 405 | ;; Error. | |
| 406 | (with-current-buffer (tramp-get-connection-buffer v) | |
| 407 | (goto-char (point-min)) | |
| 408 | (search-forward-regexp tramp-smb-errors nil t) | |
| 409 | (tramp-error | |
| 410 | v 'file-error "%s `%s'" (match-string 0) directory)))))) | |
| 4007ba5b | 411 | |
| f1a5d776 | 412 | (defun tramp-smb-handle-delete-file (filename &optional trash) |
| 00d6fd04 | 413 | "Like `delete-file' for Tramp files." |
| 4007ba5b | 414 | (setq filename (expand-file-name filename)) |
| 340b8d4f MA |
415 | (when (file-exists-p filename) |
| 416 | (with-parsed-tramp-file-name filename nil | |
| 00d6fd04 | 417 | ;; We must also flush the cache of the directory, because |
| f6f7e059 | 418 | ;; `file-attributes' reads the values from there. |
| 00d6fd04 MA |
419 | (tramp-flush-file-property v (file-name-directory localname)) |
| 420 | (tramp-flush-file-property v localname) | |
| 4260b402 MA |
421 | (unless (tramp-smb-send-command |
| 422 | v (format | |
| 423 | "%s \"%s\"" | |
| 424 | (if (tramp-smb-get-cifs-capabilities v) "posix_unlink" "rm") | |
| 425 | (tramp-smb-get-localname v))) | |
| 426 | ;; Error. | |
| 427 | (with-current-buffer (tramp-get-connection-buffer v) | |
| 428 | (goto-char (point-min)) | |
| 429 | (search-forward-regexp tramp-smb-errors nil t) | |
| 430 | (tramp-error | |
| 431 | v 'file-error "%s `%s'" (match-string 0) filename)))))) | |
| 4007ba5b KG |
432 | |
| 433 | (defun tramp-smb-handle-directory-files | |
| 434 | (directory &optional full match nosort) | |
| 00d6fd04 MA |
435 | "Like `directory-files' for Tramp files." |
| 436 | (let ((result (mapcar 'directory-file-name | |
| 437 | (file-name-all-completions "" directory)))) | |
| c2dc9732 | 438 | ;; Discriminate with regexp. |
| 00d6fd04 MA |
439 | (when match |
| 440 | (setq result | |
| 441 | (delete nil | |
| 442 | (mapcar (lambda (x) (when (string-match match x) x)) | |
| 443 | result)))) | |
| c2dc9732 | 444 | ;; Append directory. |
| 00d6fd04 MA |
445 | (when full |
| 446 | (setq result | |
| 447 | (mapcar | |
| 448 | (lambda (x) (expand-file-name x directory)) | |
| 449 | result))) | |
| c2dc9732 | 450 | ;; Sort them if necessary. |
| 00d6fd04 | 451 | (unless nosort (setq result (sort result 'string-lessp))) |
| c2dc9732 | 452 | ;; That's it. |
| 00d6fd04 | 453 | result)) |
| 4007ba5b | 454 | |
| c2dc9732 MA |
455 | (defun tramp-smb-handle-expand-file-name (name &optional dir) |
| 456 | "Like `expand-file-name' for Tramp files." | |
| 457 | ;; If DIR is not given, use DEFAULT-DIRECTORY or "/". | |
| 458 | (setq dir (or dir default-directory "/")) | |
| 459 | ;; Unless NAME is absolute, concat DIR and NAME. | |
| 460 | (unless (file-name-absolute-p name) | |
| 461 | (setq name (concat (file-name-as-directory dir) name))) | |
| 462 | ;; If NAME is not a Tramp file, run the real handler. | |
| 463 | (if (not (tramp-tramp-file-p name)) | |
| 464 | (tramp-run-real-handler 'expand-file-name (list name nil)) | |
| 465 | ;; Dissect NAME. | |
| 466 | (with-parsed-tramp-file-name name nil | |
| c2dc9732 | 467 | ;; Tilde expansion if necessary. We use the user name as share, |
| 288f783b MA |
468 | ;; which is offen the case in domains. |
| 469 | (when (string-match "\\`/?~\\([^/]*\\)" localname) | |
| c2dc9732 MA |
470 | (setq localname |
| 471 | (replace-match | |
| 288f783b | 472 | (if (zerop (length (match-string 1 localname))) |
| c2dc9732 | 473 | (tramp-file-name-real-user v) |
| 288f783b | 474 | (match-string 1 localname)) |
| c2dc9732 | 475 | nil nil localname))) |
| 288f783b MA |
476 | ;; Make the file name absolute. |
| 477 | (unless (tramp-run-real-handler 'file-name-absolute-p (list localname)) | |
| 478 | (setq localname (concat "/" localname))) | |
| c2dc9732 MA |
479 | ;; No tilde characters in file name, do normal |
| 480 | ;; `expand-file-name' (this does "/./" and "/../"). | |
| 481 | (tramp-make-tramp-file-name | |
| 482 | method user host | |
| 483 | (tramp-run-real-handler 'expand-file-name (list localname)))))) | |
| 484 | ||
| c951aecb | 485 | (defun tramp-smb-handle-file-attributes (filename &optional id-format) |
| 00d6fd04 | 486 | "Like `file-attributes' for Tramp files." |
| f6f7e059 | 487 | (unless id-format (setq id-format 'integer)) |
| 340b8d4f | 488 | (with-parsed-tramp-file-name filename nil |
| 00d6fd04 | 489 | (with-file-property v localname (format "file-attributes-%s" id-format) |
| fc754ea1 | 490 | (if (and (tramp-smb-get-share v) (tramp-smb-get-stat-capability v)) |
| 4260b402 | 491 | (tramp-smb-do-file-attributes-with-stat v id-format) |
| f6f7e059 MA |
492 | ;; Reading just the filename entry via "dir localname" is not |
| 493 | ;; possible, because when filename is a directory, some | |
| 494 | ;; smbclient versions return the content of the directory, and | |
| 495 | ;; other versions don't. Therefore, the whole content of the | |
| 496 | ;; upper directory is retrieved, and the entry of the filename | |
| 497 | ;; is extracted from. | |
| 498 | (let* ((entries (tramp-smb-get-file-entries | |
| 499 | (file-name-directory filename))) | |
| 500 | (entry (assoc (file-name-nondirectory filename) entries)) | |
| 501 | (uid (if (equal id-format 'string) "nobody" -1)) | |
| 502 | (gid (if (equal id-format 'string) "nogroup" -1)) | |
| 503 | (inode (tramp-get-inode v)) | |
| 504 | (device (tramp-get-device v))) | |
| 505 | ||
| 506 | ;; Check result. | |
| 507 | (when entry | |
| 508 | (list (and (string-match "d" (nth 1 entry)) | |
| 509 | t) ;0 file type | |
| 510 | -1 ;1 link count | |
| 511 | uid ;2 uid | |
| 512 | gid ;3 gid | |
| 513 | '(0 0) ;4 atime | |
| 514 | (nth 3 entry) ;5 mtime | |
| 515 | '(0 0) ;6 ctime | |
| 516 | (nth 2 entry) ;7 size | |
| 517 | (nth 1 entry) ;8 mode | |
| 518 | nil ;9 gid weird | |
| 519 | inode ;10 inode number | |
| 520 | device))))))) ;11 file system number | |
| 521 | ||
| 4260b402 | 522 | (defun tramp-smb-do-file-attributes-with-stat (vec &optional id-format) |
| f6f7e059 | 523 | "Implement `file-attributes' for Tramp files using stat command." |
| 4260b402 MA |
524 | (tramp-message |
| 525 | vec 5 "file attributes with stat: %s" (tramp-file-name-localname vec)) | |
| f6f7e059 | 526 | (with-current-buffer (tramp-get-buffer vec) |
| 4260b402 | 527 | (let* (size id link uid gid atime mtime ctime mode inode) |
| fc754ea1 MA |
528 | (when (tramp-smb-send-command |
| 529 | vec (format "stat \"%s\"" (tramp-smb-get-localname vec))) | |
| 530 | ||
| 531 | ;; Loop the listing. | |
| 532 | (goto-char (point-min)) | |
| 533 | (unless (re-search-forward tramp-smb-errors nil t) | |
| 534 | (while (not (eobp)) | |
| 535 | (cond | |
| 536 | ((looking-at | |
| 537 | "Size:\\s-+\\([0-9]+\\)\\s-+Blocks:\\s-+[0-9]+\\s-+\\(\\w+\\)") | |
| 538 | (setq size (string-to-number (match-string 1)) | |
| 539 | id (if (string-equal "directory" (match-string 2)) t | |
| 540 | (if (string-equal "symbolic" (match-string 2)) "")))) | |
| 541 | ((looking-at | |
| 542 | "Inode:\\s-+\\([0-9]+\\)\\s-+Links:\\s-+\\([0-9]+\\)") | |
| 543 | (setq inode (string-to-number (match-string 1)) | |
| 544 | link (string-to-number (match-string 2)))) | |
| 545 | ((looking-at | |
| 546 | "Access:\\s-+([0-9]+/\\(\\S-+\\))\\s-+Uid:\\s-+\\([0-9]+\\)\\s-+Gid:\\s-+\\([0-9]+\\)") | |
| 547 | (setq mode (match-string 1) | |
| 548 | uid (if (equal id-format 'string) (match-string 2) | |
| 549 | (string-to-number (match-string 2))) | |
| 550 | gid (if (equal id-format 'string) (match-string 3) | |
| 551 | (string-to-number (match-string 3))))) | |
| 552 | ((looking-at | |
| 553 | "Access:\\s-+\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)\\s-+\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)") | |
| 554 | (setq atime | |
| 555 | (encode-time | |
| 556 | (string-to-number (match-string 6)) ;; sec | |
| 557 | (string-to-number (match-string 5)) ;; min | |
| 558 | (string-to-number (match-string 4)) ;; hour | |
| 559 | (string-to-number (match-string 3)) ;; day | |
| 560 | (string-to-number (match-string 2)) ;; month | |
| 561 | (string-to-number (match-string 1))))) ;; year | |
| 562 | ((looking-at | |
| 563 | "Modify:\\s-+\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)\\s-+\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)") | |
| 564 | (setq mtime | |
| 565 | (encode-time | |
| 566 | (string-to-number (match-string 6)) ;; sec | |
| 567 | (string-to-number (match-string 5)) ;; min | |
| 568 | (string-to-number (match-string 4)) ;; hour | |
| 569 | (string-to-number (match-string 3)) ;; day | |
| 570 | (string-to-number (match-string 2)) ;; month | |
| 571 | (string-to-number (match-string 1))))) ;; year | |
| 572 | ((looking-at | |
| 573 | "Change:\\s-+\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)\\s-+\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)") | |
| 574 | (setq ctime | |
| 575 | (encode-time | |
| 576 | (string-to-number (match-string 6)) ;; sec | |
| 577 | (string-to-number (match-string 5)) ;; min | |
| 578 | (string-to-number (match-string 4)) ;; hour | |
| 579 | (string-to-number (match-string 3)) ;; day | |
| 580 | (string-to-number (match-string 2)) ;; month | |
| 581 | (string-to-number (match-string 1)))))) ;; year | |
| 582 | (forward-line)) | |
| 583 | ;; Return the result. | |
| 584 | (list id link uid gid atime mtime ctime size mode nil inode | |
| 585 | (tramp-get-device vec))))))) | |
| 4007ba5b KG |
586 | |
| 587 | (defun tramp-smb-handle-file-directory-p (filename) | |
| 00d6fd04 MA |
588 | "Like `file-directory-p' for Tramp files." |
| 589 | (and (file-exists-p filename) | |
| 590 | (eq ?d (aref (nth 8 (file-attributes filename)) 0)))) | |
| 4007ba5b | 591 | |
| 4007ba5b | 592 | (defun tramp-smb-handle-file-local-copy (filename) |
| 00d6fd04 | 593 | "Like `file-local-copy' for Tramp files." |
| 4007ba5b | 594 | (with-parsed-tramp-file-name filename nil |
| fffba733 MA |
595 | (unless (file-exists-p filename) |
| 596 | (tramp-error | |
| 597 | v 'file-error | |
| 598 | "Cannot make local copy of non-existing file `%s'" filename)) | |
| 4260b402 | 599 | (let ((tmpfile (tramp-compat-make-temp-file filename))) |
| 3b30ccda MA |
600 | (with-progress-reporter |
| 601 | v 3 (format "Fetching %s to tmp file %s" filename tmpfile) | |
| 602 | (unless (tramp-smb-send-command | |
| 603 | v (format "get \"%s\" \"%s\"" | |
| 604 | (tramp-smb-get-localname v) tmpfile)) | |
| 605 | ;; Oops, an error. We shall cleanup. | |
| eba082a2 | 606 | (delete-file tmpfile) |
| 3b30ccda MA |
607 | (tramp-error |
| 608 | v 'file-error "Cannot make local copy of file `%s'" filename))) | |
| 94be87e8 | 609 | tmpfile))) |
| 4007ba5b KG |
610 | |
| 611 | ;; This function should return "foo/" for directories and "bar" for | |
| 612 | ;; files. | |
| 613 | (defun tramp-smb-handle-file-name-all-completions (filename directory) | |
| 00d6fd04 MA |
614 | "Like `file-name-all-completions' for Tramp files." |
| 615 | (all-completions | |
| 616 | filename | |
| 617 | (with-parsed-tramp-file-name directory nil | |
| 618 | (with-file-property v localname "file-name-all-completions" | |
| 619 | (save-match-data | |
| 620 | (let ((entries (tramp-smb-get-file-entries directory))) | |
| 4007ba5b KG |
621 | (mapcar |
| 622 | (lambda (x) | |
| 623 | (list | |
| 624 | (if (string-match "d" (nth 1 x)) | |
| 625 | (file-name-as-directory (nth 0 x)) | |
| 626 | (nth 0 x)))) | |
| 627 | entries))))))) | |
| 628 | ||
| 4007ba5b | 629 | (defun tramp-smb-handle-file-writable-p (filename) |
| 00d6fd04 MA |
630 | "Like `file-writable-p' for Tramp files." |
| 631 | (if (file-exists-p filename) | |
| 632 | (string-match "w" (or (nth 8 (file-attributes filename)) "")) | |
| 633 | (let ((dir (file-name-directory filename))) | |
| 634 | (and (file-exists-p dir) | |
| 635 | (file-writable-p dir))))) | |
| 4007ba5b KG |
636 | |
| 637 | (defun tramp-smb-handle-insert-directory | |
| 638 | (filename switches &optional wildcard full-directory-p) | |
| 00d6fd04 | 639 | "Like `insert-directory' for Tramp files." |
| 4007ba5b | 640 | (setq filename (expand-file-name filename)) |
| d9320986 MA |
641 | (if full-directory-p |
| 642 | ;; Called from `dired-add-entry'. | |
| 643 | (setq filename (file-name-as-directory filename)) | |
| 644 | (setq filename (directory-file-name filename))) | |
| 340b8d4f | 645 | (with-parsed-tramp-file-name filename nil |
| 4007ba5b | 646 | (save-match-data |
| 4260b402 | 647 | (let ((base (file-name-nondirectory filename)) |
| 00d6fd04 MA |
648 | ;; We should not destroy the cache entry. |
| 649 | (entries (copy-sequence | |
| 650 | (tramp-smb-get-file-entries | |
| 651 | (file-name-directory filename))))) | |
| 652 | ||
| 653 | (when wildcard | |
| 654 | (string-match "\\." base) | |
| 655 | (setq base (replace-match "\\\\." nil nil base)) | |
| 656 | (string-match "\\*" base) | |
| 657 | (setq base (replace-match ".*" nil nil base)) | |
| 658 | (string-match "\\?" base) | |
| 659 | (setq base (replace-match ".?" nil nil base))) | |
| 660 | ||
| 661 | ;; Filter entries. | |
| bf247b6e | 662 | (setq entries |
| 00d6fd04 MA |
663 | (delq |
| 664 | nil | |
| 665 | (if (or wildcard (zerop (length base))) | |
| 666 | ;; Check for matching entries. | |
| 667 | (mapcar | |
| 668 | (lambda (x) | |
| 669 | (when (string-match | |
| 670 | (format "^%s" base) (nth 0 x)) | |
| 671 | x)) | |
| 672 | entries) | |
| 673 | ;; We just need the only and only entry FILENAME. | |
| 674 | (list (assoc base entries))))) | |
| 4007ba5b | 675 | |
| adb67129 | 676 | ;; Sort entries. |
| 4007ba5b KG |
677 | (setq entries |
| 678 | (sort | |
| 679 | entries | |
| 680 | (lambda (x y) | |
| 681 | (if (string-match "t" switches) | |
| 00d6fd04 MA |
682 | ;; Sort by date. |
| 683 | (tramp-time-less-p (nth 3 y) (nth 3 x)) | |
| 684 | ;; Sort by name. | |
| 4007ba5b KG |
685 | (string-lessp (nth 0 x) (nth 0 y)))))) |
| 686 | ||
| adb67129 MA |
687 | ;; Handle "-F" switch. |
| 688 | (when (string-match "F" switches) | |
| e61aad2f | 689 | (mapc |
| adb67129 MA |
690 | (lambda (x) |
| 691 | (when (not (zerop (length (car x)))) | |
| 692 | (cond | |
| 693 | ((char-equal ?d (string-to-char (nth 1 x))) | |
| 694 | (setcar x (concat (car x) "/"))) | |
| 695 | ((char-equal ?x (string-to-char (nth 1 x))) | |
| 696 | (setcar x (concat (car x) "*")))))) | |
| 697 | entries)) | |
| 698 | ||
| 00d6fd04 | 699 | ;; Print entries. |
| fc754ea1 | 700 | (mapc |
| 4007ba5b | 701 | (lambda (x) |
| 00d6fd04 | 702 | (when (not (zerop (length (nth 0 x)))) |
| f6f7e059 | 703 | (let ((attr |
| fc754ea1 | 704 | (when (tramp-smb-get-stat-capability v) |
| 4260b402 | 705 | (ignore-errors |
| d9320986 | 706 | (file-attributes filename 'string))))) |
| f6f7e059 MA |
707 | (insert |
| 708 | (format | |
| fc754ea1 | 709 | "%10s %3d %-8s %-8s %8s %s " |
| f6f7e059 | 710 | (or (nth 8 attr) (nth 1 x)) ; mode |
| fc754ea1 | 711 | (or (nth 1 attr) 1) ; inode |
| f6f7e059 MA |
712 | (or (nth 2 attr) "nobody") ; uid |
| 713 | (or (nth 3 attr) "nogroup") ; gid | |
| fc754ea1 | 714 | (or (nth 7 attr) (nth 2 x)) ; size |
| f6f7e059 MA |
715 | (format-time-string |
| 716 | (if (tramp-time-less-p | |
| 717 | (tramp-time-subtract (current-time) (nth 3 x)) | |
| 718 | tramp-half-a-year) | |
| 719 | "%b %e %R" | |
| 720 | "%b %e %Y") | |
| fc754ea1 | 721 | (nth 3 x)))) ; date |
| d5b3979c MA |
722 | ;; We mark the file name. The inserted name could be |
| 723 | ;; from somewhere else, so we use the relative file | |
| 724 | ;; name of `default-directory'. | |
| fc754ea1 | 725 | (let ((start (point))) |
| d5b3979c MA |
726 | (insert |
| 727 | (format | |
| 728 | "%s\n" | |
| d9320986 MA |
729 | (file-relative-name |
| 730 | (expand-file-name | |
| 731 | (nth 0 x) (file-name-directory filename))))) | |
| fc754ea1 | 732 | (put-text-property start (1- (point)) 'dired-filename t)) |
| f6f7e059 MA |
733 | (forward-line) |
| 734 | (beginning-of-line)))) | |
| 735 | entries))))) | |
| 4007ba5b KG |
736 | |
| 737 | (defun tramp-smb-handle-make-directory (dir &optional parents) | |
| 00d6fd04 | 738 | "Like `make-directory' for Tramp files." |
| 4007ba5b KG |
739 | (setq dir (directory-file-name (expand-file-name dir))) |
| 740 | (unless (file-name-absolute-p dir) | |
| 00d6fd04 | 741 | (setq dir (expand-file-name dir default-directory))) |
| 340b8d4f | 742 | (with-parsed-tramp-file-name dir nil |
| 4007ba5b | 743 | (save-match-data |
| 4260b402 | 744 | (let* ((ldir (file-name-directory dir))) |
| c2dc9732 | 745 | ;; Make missing directory parts. |
| 4260b402 MA |
746 | (when (and parents |
| 747 | (tramp-smb-get-share v) | |
| 748 | (not (file-directory-p ldir))) | |
| 4007ba5b | 749 | (make-directory ldir parents)) |
| c2dc9732 | 750 | ;; Just do it. |
| 4007ba5b | 751 | (when (file-directory-p ldir) |
| 8daea7fc | 752 | (make-directory-internal dir)) |
| 4007ba5b | 753 | (unless (file-directory-p dir) |
| 00d6fd04 | 754 | (tramp-error v 'file-error "Couldn't make directory %s" dir)))))) |
| 4007ba5b KG |
755 | |
| 756 | (defun tramp-smb-handle-make-directory-internal (directory) | |
| 00d6fd04 | 757 | "Like `make-directory-internal' for Tramp files." |
| 4007ba5b KG |
758 | (setq directory (directory-file-name (expand-file-name directory))) |
| 759 | (unless (file-name-absolute-p directory) | |
| 00d6fd04 | 760 | (setq directory (expand-file-name directory default-directory))) |
| 340b8d4f | 761 | (with-parsed-tramp-file-name directory nil |
| 4007ba5b | 762 | (save-match-data |
| 4260b402 | 763 | (let* ((file (tramp-smb-get-localname v))) |
| 4007ba5b | 764 | (when (file-directory-p (file-name-directory directory)) |
| f6f7e059 MA |
765 | (tramp-smb-send-command |
| 766 | v | |
| 4260b402 | 767 | (if (tramp-smb-get-cifs-capabilities v) |
| f6f7e059 MA |
768 | (format |
| 769 | "posix_mkdir \"%s\" %s" | |
| 0f34aa77 | 770 | file (tramp-compat-decimal-to-octal (default-file-modes))) |
| f6f7e059 | 771 | (format "mkdir \"%s\"" file))) |
| 00d6fd04 | 772 | ;; We must also flush the cache of the directory, because |
| f6f7e059 MA |
773 | ;; `file-attributes' reads the values from there. |
| 774 | (tramp-flush-file-property v (file-name-directory localname)) | |
| 775 | (tramp-flush-file-property v localname)) | |
| 4007ba5b | 776 | (unless (file-directory-p directory) |
| 00d6fd04 MA |
777 | (tramp-error |
| 778 | v 'file-error "Couldn't make directory %s" directory)))))) | |
| 4007ba5b | 779 | |
| f6f7e059 MA |
780 | (defun tramp-smb-handle-make-symbolic-link |
| 781 | (filename linkname &optional ok-if-already-exists) | |
| 782 | "Like `make-symbolic-link' for Tramp files. | |
| 783 | If LINKNAME is a non-Tramp file, it is used verbatim as the target of | |
| 784 | the symlink. If LINKNAME is a Tramp file, only the localname component is | |
| 785 | used as the target of the symlink. | |
| 786 | ||
| 787 | If LINKNAME is a Tramp file and the localname component is relative, then | |
| 788 | it is expanded first, before the localname component is taken. Note that | |
| 789 | this can give surprising results if the user/host for the source and | |
| 790 | target of the symlink differ." | |
| 791 | (unless (tramp-equal-remote filename linkname) | |
| 792 | (with-parsed-tramp-file-name | |
| 793 | (if (tramp-tramp-file-p filename) filename linkname) nil | |
| 794 | (tramp-error | |
| 795 | v 'file-error | |
| 796 | "make-symbolic-link: %s" | |
| 797 | "only implemented for same method, same user, same host"))) | |
| 798 | (with-parsed-tramp-file-name filename v1 | |
| 799 | (with-parsed-tramp-file-name linkname v2 | |
| 800 | (when (file-directory-p filename) | |
| 801 | (tramp-error | |
| 802 | v2 'file-error | |
| 803 | "make-symbolic-link: %s must not be a directory" filename)) | |
| 804 | (when (and (not ok-if-already-exists) | |
| 805 | (file-exists-p linkname) | |
| 806 | (not (numberp ok-if-already-exists)) | |
| 807 | (y-or-n-p | |
| 808 | (format | |
| 809 | "File %s already exists; make it a new name anyway? " | |
| 810 | linkname))) | |
| 811 | (tramp-error | |
| 812 | v2 'file-error | |
| 813 | "make-symbolic-link: file %s already exists" linkname)) | |
| 814 | (unless (tramp-smb-get-cifs-capabilities v1) | |
| 815 | (tramp-error v2 'file-error "make-symbolic-link not supported")) | |
| 816 | ;; We must also flush the cache of the directory, because | |
| 817 | ;; `file-attributes' reads the values from there. | |
| 818 | (tramp-flush-file-property v2 (file-name-directory v2-localname)) | |
| 819 | (tramp-flush-file-property v2 v2-localname) | |
| 820 | (unless | |
| 821 | (tramp-smb-send-command | |
| 822 | v1 | |
| 823 | (format | |
| 824 | "symlink \"%s\" \"%s\"" | |
| 4260b402 MA |
825 | (tramp-smb-get-localname v1) |
| 826 | (tramp-smb-get-localname v2))) | |
| f6f7e059 MA |
827 | (tramp-error |
| 828 | v2 'file-error | |
| 829 | "error with make-symbolic-link, see buffer `%s' for details" | |
| 830 | (buffer-name)))))) | |
| 831 | ||
| 4007ba5b KG |
832 | (defun tramp-smb-handle-rename-file |
| 833 | (filename newname &optional ok-if-already-exists) | |
| 00d6fd04 | 834 | "Like `rename-file' for Tramp files." |
| 4007ba5b KG |
835 | (setq filename (expand-file-name filename) |
| 836 | newname (expand-file-name newname)) | |
| 3b30ccda MA |
837 | (with-progress-reporter |
| 838 | (tramp-dissect-file-name (if (file-remote-p filename) filename newname)) | |
| 839 | 0 (format "Renaming %s to %s" filename newname) | |
| 840 | ||
| 841 | (let ((tmpfile (file-local-copy filename))) | |
| 842 | ||
| 843 | (if tmpfile | |
| 844 | ;; Remote filename. | |
| 845 | (condition-case err | |
| 846 | (rename-file tmpfile newname ok-if-already-exists) | |
| 847 | ((error quit) | |
| eba082a2 | 848 | (delete-file tmpfile) |
| 3b30ccda MA |
849 | (signal (car err) (cdr err)))) |
| 850 | ||
| 851 | ;; Remote newname. | |
| 852 | (when (file-directory-p newname) | |
| 853 | (setq newname (expand-file-name | |
| 854 | (file-name-nondirectory filename) newname))) | |
| 855 | ||
| 856 | (with-parsed-tramp-file-name newname nil | |
| 857 | (when (and (not ok-if-already-exists) | |
| 858 | (file-exists-p newname)) | |
| 859 | (tramp-error v 'file-already-exists newname)) | |
| 860 | ;; We must also flush the cache of the directory, because | |
| 861 | ;; `file-attributes' reads the values from there. | |
| 862 | (tramp-flush-file-property v (file-name-directory localname)) | |
| 863 | (tramp-flush-file-property v localname) | |
| 864 | (unless (tramp-smb-send-command | |
| 865 | v (format "put %s \"%s\"" | |
| 866 | filename (tramp-smb-get-localname v))) | |
| 867 | (tramp-error v 'file-error "Cannot rename `%s'" filename))))) | |
| 4007ba5b | 868 | |
| eba082a2 | 869 | (delete-file filename))) |
| 4007ba5b | 870 | |
| c2dc9732 MA |
871 | (defun tramp-smb-handle-set-file-modes (filename mode) |
| 872 | "Like `set-file-modes' for Tramp files." | |
| 873 | (with-parsed-tramp-file-name filename nil | |
| f6f7e059 MA |
874 | (when (tramp-smb-get-cifs-capabilities v) |
| 875 | (tramp-flush-file-property v localname) | |
| 876 | (unless (tramp-smb-send-command | |
| 877 | v (format "chmod \"%s\" %s" | |
| 4260b402 | 878 | (tramp-smb-get-localname v) |
| 0f34aa77 | 879 | (tramp-compat-decimal-to-octal mode))) |
| f6f7e059 MA |
880 | (tramp-error |
| 881 | v 'file-error "Error while changing file's mode %s" filename))))) | |
| c2dc9732 | 882 | |
| 01917a18 | 883 | (defun tramp-smb-handle-substitute-in-file-name (filename) |
| 00d6fd04 | 884 | "Like `handle-substitute-in-file-name' for Tramp files. |
| b08104a0 MA |
885 | \"//\" substitutes only in the local filename part. Catches |
| 886 | errors for shares like \"C$/\", which are common in Microsoft Windows." | |
| 887 | (with-parsed-tramp-file-name filename nil | |
| 888 | ;; Ignore in LOCALNAME everything before "//". | |
| 889 | (when (and (stringp localname) (string-match ".+?/\\(/\\|~\\)" localname)) | |
| 890 | (setq filename | |
| 891 | (concat (file-remote-p filename) | |
| 892 | (replace-match "\\1" nil nil localname))))) | |
| 01917a18 MA |
893 | (condition-case nil |
| 894 | (tramp-run-real-handler 'substitute-in-file-name (list filename)) | |
| 895 | (error filename))) | |
| 896 | ||
| 4007ba5b KG |
897 | (defun tramp-smb-handle-write-region |
| 898 | (start end filename &optional append visit lockname confirm) | |
| 00d6fd04 | 899 | "Like `write-region' for Tramp files." |
| 4007ba5b | 900 | (setq filename (expand-file-name filename)) |
| 340b8d4f | 901 | (with-parsed-tramp-file-name filename nil |
| 00d6fd04 MA |
902 | (unless (eq append nil) |
| 903 | (tramp-error | |
| a4aeb9a4 | 904 | v 'file-error "Cannot append to file using Tramp (`%s')" filename)) |
| 94be87e8 | 905 | ;; XEmacs takes a coding system as the seventh argument, not `confirm'. |
| 00d6fd04 MA |
906 | (when (and (not (featurep 'xemacs)) |
| 907 | confirm (file-exists-p filename)) | |
| 908 | (unless (y-or-n-p (format "File %s exists; overwrite anyway? " | |
| 909 | filename)) | |
| 910 | (tramp-error v 'file-error "File not overwritten"))) | |
| 911 | ;; We must also flush the cache of the directory, because | |
| b08104a0 | 912 | ;; `file-attributes' reads the values from there. |
| 00d6fd04 MA |
913 | (tramp-flush-file-property v (file-name-directory localname)) |
| 914 | (tramp-flush-file-property v localname) | |
| 4260b402 | 915 | (let ((curbuf (current-buffer)) |
| 258800f8 | 916 | (tmpfile (tramp-compat-make-temp-file filename))) |
| 00d6fd04 MA |
917 | ;; We say `no-message' here because we don't want the visited file |
| 918 | ;; modtime data to be clobbered from the temp file. We call | |
| 919 | ;; `set-visited-file-modtime' ourselves later on. | |
| 920 | (tramp-run-real-handler | |
| 921 | 'write-region | |
| 922 | (if confirm ; don't pass this arg unless defined for backward compat. | |
| 94be87e8 MA |
923 | (list start end tmpfile append 'no-message lockname confirm) |
| 924 | (list start end tmpfile append 'no-message lockname))) | |
| 00d6fd04 | 925 | |
| 3b30ccda MA |
926 | (with-progress-reporter |
| 927 | v 3 (format "Moving tmp file %s to %s" tmpfile filename) | |
| 928 | (unwind-protect | |
| 929 | (unless (tramp-smb-send-command | |
| 930 | v (format "put %s \"%s\"" | |
| 931 | tmpfile (tramp-smb-get-localname v))) | |
| 932 | (tramp-error v 'file-error "Cannot write `%s'" filename)) | |
| eba082a2 | 933 | (delete-file tmpfile))) |
| 00d6fd04 | 934 | |
| 00d6fd04 MA |
935 | (unless (equal curbuf (current-buffer)) |
| 936 | (tramp-error | |
| 937 | v 'file-error | |
| 938 | "Buffer has changed from `%s' to `%s'" curbuf (current-buffer))) | |
| 939 | (when (eq visit t) | |
| 940 | (set-visited-file-modtime))))) | |
| 4007ba5b KG |
941 | |
| 942 | ||
| c2dc9732 | 943 | ;; Internal file name functions. |
| 4007ba5b | 944 | |
| 4260b402 | 945 | (defun tramp-smb-get-share (vec) |
| 7432277c | 946 | "Returns the share name of LOCALNAME." |
| 4007ba5b | 947 | (save-match-data |
| 4260b402 MA |
948 | (let ((localname (tramp-file-name-localname vec))) |
| 949 | (when (string-match "^/?\\([^/]+\\)/" localname) | |
| 950 | (match-string 1 localname))))) | |
| 4007ba5b | 951 | |
| 4260b402 | 952 | (defun tramp-smb-get-localname (vec) |
| 7432277c | 953 | "Returns the file name of LOCALNAME. |
| 4260b402 | 954 | If VEC has no cifs capabilities, exchange \"/\" by \"\\\\\"." |
| 4007ba5b | 955 | (save-match-data |
| 4260b402 | 956 | (let ((localname (tramp-file-name-localname vec))) |
| 4007ba5b | 957 | (setq |
| 4260b402 MA |
958 | localname |
| 959 | (if (string-match "^/?[^/]+\\(/.*\\)" localname) | |
| 960 | ;; There is a share, sparated by "/". | |
| 961 | (if (not (tramp-smb-get-cifs-capabilities vec)) | |
| 962 | (mapconcat | |
| 963 | (lambda (x) (if (equal x ?/) "\\" (char-to-string x))) | |
| 964 | (match-string 1 localname) "") | |
| 965 | (match-string 1 localname)) | |
| 966 | ;; There is just a share. | |
| 967 | (if (string-match "^/?\\([^/]+\\)$" localname) | |
| 968 | (match-string 1 localname) | |
| 969 | ""))) | |
| 4007ba5b | 970 | |
| c2dc9732 | 971 | ;; Sometimes we have discarded `substitute-in-file-name'. |
| 4260b402 MA |
972 | (when (string-match "\\(\\$\\$\\)\\(/\\|$\\)" localname) |
| 973 | (setq localname (replace-match "$" nil nil localname 1))) | |
| 4007ba5b | 974 | |
| 4260b402 | 975 | localname))) |
| 4007ba5b KG |
976 | |
| 977 | ;; Share names of a host are cached. It is very unlikely that the | |
| 978 | ;; shares do change during connection. | |
| 00d6fd04 MA |
979 | (defun tramp-smb-get-file-entries (directory) |
| 980 | "Read entries which match DIRECTORY. | |
| 4007ba5b | 981 | Either the shares are listed, or the `dir' command is executed. |
| 7432277c | 982 | Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)." |
| 4260b402 | 983 | (with-parsed-tramp-file-name (file-name-as-directory directory) nil |
| 00d6fd04 MA |
984 | (setq localname (or localname "/")) |
| 985 | (with-file-property v localname "file-entries" | |
| 986 | (with-current-buffer (tramp-get-buffer v) | |
| 4260b402 | 987 | (let* ((share (tramp-smb-get-share v)) |
| 00d6fd04 MA |
988 | (cache (tramp-get-connection-property v "share-cache" nil)) |
| 989 | res entry) | |
| 990 | ||
| 991 | (if (and (not share) cache) | |
| c2dc9732 | 992 | ;; Return cached shares. |
| 00d6fd04 MA |
993 | (setq res cache) |
| 994 | ||
| c2dc9732 | 995 | ;; Read entries. |
| 00d6fd04 | 996 | (if share |
| 4260b402 MA |
997 | (tramp-smb-send-command |
| 998 | v (format "dir \"%s*\"" (tramp-smb-get-localname v))) | |
| c2dc9732 | 999 | ;; `tramp-smb-maybe-open-connection' lists also the share names. |
| 00d6fd04 MA |
1000 | (tramp-smb-maybe-open-connection v)) |
| 1001 | ||
| c2dc9732 | 1002 | ;; Loop the listing. |
| 00d6fd04 | 1003 | (goto-char (point-min)) |
| 4260b402 MA |
1004 | (if (re-search-forward tramp-smb-errors nil t) |
| 1005 | (tramp-error v 'file-error "%s `%s'" (match-string 0) directory) | |
| 00d6fd04 MA |
1006 | (while (not (eobp)) |
| 1007 | (setq entry (tramp-smb-read-file-entry share)) | |
| 1008 | (forward-line) | |
| 1009 | (when entry (add-to-list 'res entry)))) | |
| 1010 | ||
| c2dc9732 | 1011 | ;; Cache share entries. |
| 00d6fd04 MA |
1012 | (unless share |
| 1013 | (tramp-set-connection-property v "share-cache" res))) | |
| 4007ba5b | 1014 | |
| c2dc9732 | 1015 | ;; Add directory itself. |
| 00d6fd04 | 1016 | (add-to-list 'res '("" "drwxrwxrwx" 0 (0 0))) |
| 5ec2cc41 | 1017 | |
| 00d6fd04 MA |
1018 | ;; There's a very strange error (debugged with XEmacs 21.4.14) |
| 1019 | ;; If there's no short delay, it returns nil. No idea about. | |
| 1020 | (when (featurep 'xemacs) (sleep-for 0.01)) | |
| 4007ba5b | 1021 | |
| c2dc9732 | 1022 | ;; Return entries. |
| 00d6fd04 | 1023 | (delq nil res)))))) |
| 4007ba5b | 1024 | |
| c2dc9732 | 1025 | ;; Return either a share name (if SHARE is nil), or a file name. |
| 4007ba5b | 1026 | ;; |
| c2dc9732 | 1027 | ;; If shares are listed, the following format is expected: |
| 4007ba5b | 1028 | ;; |
| 4260b402 MA |
1029 | ;; Disk| - leading spaces |
| 1030 | ;; [^|]+| - share name, 14 char | |
| 1031 | ;; .* - comment | |
| 4007ba5b KG |
1032 | ;; |
| 1033 | ;; Entries provided by smbclient DIR aren't fully regular. | |
| 1034 | ;; They should have the format | |
| 1035 | ;; | |
| 1036 | ;; \s-\{2,2} - leading spaces | |
| b1a2b924 KG |
1037 | ;; \S-\(.*\S-\)\s-* - file name, 30 chars, left bound |
| 1038 | ;; \s-+[ADHRSV]* - permissions, 7 chars, right bound | |
| 4007ba5b | 1039 | ;; \s- - space delimeter |
| b1a2b924 | 1040 | ;; \s-+[0-9]+ - size, 8 chars, right bound |
| 4007ba5b KG |
1041 | ;; \s-\{2,2\} - space delimeter |
| 1042 | ;; \w\{3,3\} - weekday | |
| 1043 | ;; \s- - space delimeter | |
| b1a2b924 KG |
1044 | ;; \w\{3,3\} - month |
| 1045 | ;; \s- - space delimeter | |
| 00d6fd04 | 1046 | ;; [ 12][0-9] - day |
| 4007ba5b KG |
1047 | ;; \s- - space delimeter |
| 1048 | ;; [0-9]\{2,2\}:[0-9]\{2,2\}:[0-9]\{2,2\} - time | |
| 1049 | ;; \s- - space delimeter | |
| 1050 | ;; [0-9]\{4,4\} - year | |
| 1051 | ;; | |
| b1a2b924 KG |
1052 | ;; samba/src/client.c (http://samba.org/doxygen/samba/client_8c-source.html) |
| 1053 | ;; has function display_finfo: | |
| 1054 | ;; | |
| 1055 | ;; d_printf(" %-30s%7.7s %8.0f %s", | |
| 1056 | ;; finfo->name, | |
| 1057 | ;; attrib_string(finfo->mode), | |
| 1058 | ;; (double)finfo->size, | |
| 1059 | ;; asctime(LocalTime(&t))); | |
| 1060 | ;; | |
| 1061 | ;; in Samba 1.9, there's the following code: | |
| 1062 | ;; | |
| 1063 | ;; DEBUG(0,(" %-30s%7.7s%10d %s", | |
| 1064 | ;; CNV_LANG(finfo->name), | |
| 1065 | ;; attrib_string(finfo->mode), | |
| 1066 | ;; finfo->size, | |
| 1067 | ;; asctime(LocalTime(&t)))); | |
| 1068 | ;; | |
| 4007ba5b KG |
1069 | ;; Problems: |
| 1070 | ;; * Modern regexp constructs, like spy groups and counted repetitions, aren't | |
| 1071 | ;; available in older Emacsen. | |
| 1072 | ;; * The length of constructs (file name, size) might exceed the default. | |
| 1073 | ;; * File names might contain spaces. | |
| 1074 | ;; * Permissions might be empty. | |
| 1075 | ;; | |
| 1076 | ;; So we try to analyze backwards. | |
| 1077 | (defun tramp-smb-read-file-entry (share) | |
| 1078 | "Parse entry in SMB output buffer. | |
| 1079 | If SHARE is result, entries are of type dir. Otherwise, shares are listed. | |
| 7432277c | 1080 | Result is the list (LOCALNAME MODE SIZE MTIME)." |
| 00d6fd04 MA |
1081 | ;; We are called from `tramp-smb-get-file-entries', which sets the |
| 1082 | ;; current buffer. | |
| 6e060cee | 1083 | (let ((line (buffer-substring (point) (point-at-eol))) |
| 7432277c | 1084 | localname mode size month day hour min sec year mtime) |
| 4007ba5b KG |
1085 | |
| 1086 | (if (not share) | |
| 1087 | ||
| 00d6fd04 | 1088 | ;; Read share entries. |
| 4260b402 | 1089 | (when (string-match "^Disk|\\([^|]+\\)|" line) |
| 7432277c | 1090 | (setq localname (match-string 1 line) |
| 4007ba5b KG |
1091 | mode "dr-xr-xr-x" |
| 1092 | size 0)) | |
| 1093 | ||
| 00d6fd04 | 1094 | ;; Real listing. |
| 4007ba5b KG |
1095 | (block nil |
| 1096 | ||
| c2dc9732 | 1097 | ;; year. |
| 4007ba5b KG |
1098 | (if (string-match "\\([0-9]+\\)$" line) |
| 1099 | (setq year (string-to-number (match-string 1 line)) | |
| 1100 | line (substring line 0 -5)) | |
| 1101 | (return)) | |
| 1102 | ||
| c2dc9732 | 1103 | ;; time. |
| 4007ba5b KG |
1104 | (if (string-match "\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)$" line) |
| 1105 | (setq hour (string-to-number (match-string 1 line)) | |
| 1106 | min (string-to-number (match-string 2 line)) | |
| 1107 | sec (string-to-number (match-string 3 line)) | |
| 1108 | line (substring line 0 -9)) | |
| 1109 | (return)) | |
| 1110 | ||
| c2dc9732 | 1111 | ;; day. |
| 4007ba5b KG |
1112 | (if (string-match "\\([0-9]+\\)$" line) |
| 1113 | (setq day (string-to-number (match-string 1 line)) | |
| 1114 | line (substring line 0 -3)) | |
| 1115 | (return)) | |
| 1116 | ||
| c2dc9732 | 1117 | ;; month. |
| 4007ba5b KG |
1118 | (if (string-match "\\(\\w+\\)$" line) |
| 1119 | (setq month (match-string 1 line) | |
| 1120 | line (substring line 0 -4)) | |
| 1121 | (return)) | |
| 1122 | ||
| c2dc9732 | 1123 | ;; weekday. |
| 4007ba5b KG |
1124 | (if (string-match "\\(\\w+\\)$" line) |
| 1125 | (setq line (substring line 0 -5)) | |
| 1126 | (return)) | |
| 1127 | ||
| c2dc9732 | 1128 | ;; size. |
| 4007ba5b | 1129 | (if (string-match "\\([0-9]+\\)$" line) |
| b1a2b924 KG |
1130 | (let ((length (- (max 10 (1+ (length (match-string 1 line))))))) |
| 1131 | (setq size (string-to-number (match-string 1 line))) | |
| 1132 | (when (string-match "\\([ADHRSV]+\\)" (substring line length)) | |
| 1133 | (setq length (+ length (match-end 0)))) | |
| 1134 | (setq line (substring line 0 length))) | |
| 4007ba5b KG |
1135 | (return)) |
| 1136 | ||
| c2dc9732 | 1137 | ;; mode: ARCH, DIR, HIDDEN, RONLY, SYSTEM, VOLID. |
| b1a2b924 | 1138 | (if (string-match "\\([ADHRSV]+\\)?$" line) |
| 4007ba5b | 1139 | (setq |
| b1a2b924 | 1140 | mode (or (match-string 1 line) "") |
| 4007ba5b KG |
1141 | mode (save-match-data (format |
| 1142 | "%s%s" | |
| 1143 | (if (string-match "D" mode) "d" "-") | |
| 1144 | (mapconcat | |
| 1145 | (lambda (x) "") " " | |
| 1146 | (concat "r" (if (string-match "R" mode) "-" "w") "x")))) | |
| 4260b402 | 1147 | line (substring line 0 -6)) |
| 4007ba5b KG |
1148 | (return)) |
| 1149 | ||
| c2dc9732 | 1150 | ;; localname. |
| b1a2b924 | 1151 | (if (string-match "^\\s-+\\(\\S-\\(.*\\S-\\)?\\)\\s-*$" line) |
| 7432277c | 1152 | (setq localname (match-string 1 line)) |
| 4007ba5b KG |
1153 | (return)))) |
| 1154 | ||
| 7432277c | 1155 | (when (and localname mode size) |
| 4007ba5b KG |
1156 | (setq mtime |
| 1157 | (if (and sec min hour day month year) | |
| 1158 | (encode-time | |
| 1159 | sec min hour day | |
| 00d6fd04 | 1160 | (cdr (assoc (downcase month) tramp-parse-time-months)) |
| 4007ba5b KG |
1161 | year) |
| 1162 | '(0 0))) | |
| 7432277c | 1163 | (list localname mode size mtime)))) |
| 4007ba5b | 1164 | |
| f6f7e059 MA |
1165 | (defun tramp-smb-get-cifs-capabilities (vec) |
| 1166 | "Check, whether the SMB server supports POSIX commands." | |
| 4260b402 MA |
1167 | ;; When we are not logged in yet, we return nil. |
| 1168 | (if (let ((p (tramp-get-connection-process vec))) | |
| 1169 | (and p (processp p) (memq (process-status p) '(run open)))) | |
| 1170 | (with-connection-property | |
| 1171 | (tramp-get-connection-process vec) "cifs-capabilities" | |
| fc754ea1 MA |
1172 | (save-match-data |
| 1173 | (when (tramp-smb-send-command vec "posix") | |
| 1174 | (with-current-buffer (tramp-get-buffer vec) | |
| 1175 | (goto-char (point-min)) | |
| 1176 | (when | |
| 1177 | (re-search-forward "Server supports CIFS capabilities" nil t) | |
| 1178 | (member | |
| 1179 | "pathnames" | |
| 1180 | (split-string | |
| 6e060cee | 1181 | (buffer-substring (point) (point-at-eol)) nil t))))))))) |
| fc754ea1 MA |
1182 | |
| 1183 | (defun tramp-smb-get-stat-capability (vec) | |
| 1184 | "Check, whether the SMB server supports the STAT command." | |
| 1185 | ;; When we are not logged in yet, we return nil. | |
| 1186 | (if (let ((p (tramp-get-connection-process vec))) | |
| 1187 | (and p (processp p) (memq (process-status p) '(run open)))) | |
| 1188 | (with-connection-property | |
| 1189 | (tramp-get-connection-process vec) "stat-capability" | |
| 1190 | (tramp-smb-send-command vec "stat .")))) | |
| f6f7e059 | 1191 | |
| 4007ba5b | 1192 | |
| c2dc9732 | 1193 | ;; Connection functions. |
| 4007ba5b | 1194 | |
| 00d6fd04 MA |
1195 | (defun tramp-smb-send-command (vec command) |
| 1196 | "Send the COMMAND to connection VEC. | |
| 1197 | Returns nil if there has been an error message from smbclient." | |
| 1198 | (tramp-smb-maybe-open-connection vec) | |
| 1199 | (tramp-message vec 6 "%s" command) | |
| 1200 | (tramp-send-string vec command) | |
| 1201 | (tramp-smb-wait-for-output vec)) | |
| 1202 | ||
| 1203 | (defun tramp-smb-maybe-open-connection (vec) | |
| 1204 | "Maybe open a connection to HOST, log in as USER, using `tramp-smb-program'. | |
| 4007ba5b KG |
1205 | Does not do anything if a connection is already open, but re-opens the |
| 1206 | connection if a previous connection has died for some reason." | |
| 4260b402 | 1207 | (let* ((share (tramp-smb-get-share vec)) |
| 00d6fd04 MA |
1208 | (buf (tramp-get-buffer vec)) |
| 1209 | (p (get-buffer-process buf))) | |
| 340b8d4f | 1210 | |
| c2dc9732 MA |
1211 | ;; Check whether we still have the same smbclient version. |
| 1212 | ;; Otherwise, we must delete the connection cache, because | |
| 1213 | ;; capabilities migh have changed. | |
| 1214 | (unless (processp p) | |
| fc754ea1 MA |
1215 | (let ((default-directory (tramp-compat-temporary-file-directory)) |
| 1216 | (command (concat tramp-smb-program " -V"))) | |
| 1217 | ||
| 1218 | (unless tramp-smb-version | |
| 1219 | (unless (executable-find tramp-smb-program) | |
| 1220 | (tramp-error | |
| 1221 | vec 'file-error | |
| 1222 | "Cannot find command %s in %s" tramp-smb-program exec-path)) | |
| 1223 | (setq tramp-smb-version (shell-command-to-string command)) | |
| 1224 | (tramp-message vec 6 command) | |
| 1225 | (tramp-message vec 6 "\n%s" tramp-smb-version) | |
| 1226 | (if (string-match "[ \t\n\r]+\\'" tramp-smb-version) | |
| 1227 | (setq tramp-smb-version | |
| 1228 | (replace-match "" nil nil tramp-smb-version)))) | |
| 1229 | ||
| 1230 | (unless (string-equal | |
| 1231 | tramp-smb-version | |
| 1232 | (tramp-get-connection-property | |
| 1233 | vec "smbclient-version" tramp-smb-version)) | |
| 4260b402 MA |
1234 | (tramp-flush-directory-property vec "") |
| 1235 | (tramp-flush-connection-property vec)) | |
| fc754ea1 MA |
1236 | |
| 1237 | (tramp-set-connection-property | |
| 1238 | vec "smbclient-version" tramp-smb-version))) | |
| c2dc9732 | 1239 | |
| 00d6fd04 | 1240 | ;; If too much time has passed since last command was sent, look |
| c2dc9732 MA |
1241 | ;; whether there has been an error message; maybe due to |
| 1242 | ;; connection timeout. | |
| 00d6fd04 MA |
1243 | (with-current-buffer buf |
| 1244 | (goto-char (point-min)) | |
| 1245 | (when (and (> (tramp-time-diff | |
| 1246 | (current-time) | |
| 1247 | (tramp-get-connection-property | |
| 1248 | p "last-cmd-time" '(0 0 0))) | |
| 1249 | 60) | |
| 1250 | p (processp p) (memq (process-status p) '(run open)) | |
| 1251 | (re-search-forward tramp-smb-errors nil t)) | |
| 1252 | (delete-process p) | |
| 1253 | (setq p nil))) | |
| 1254 | ||
| 1255 | ;; Check whether it is still the same share. | |
| 1256 | (unless | |
| 1257 | (and p (processp p) (memq (process-status p) '(run open)) | |
| 1258 | (string-equal | |
| 1259 | share | |
| 1260 | (tramp-get-connection-property p "smb-share" ""))) | |
| 1261 | ||
| 1262 | (save-match-data | |
| 1263 | ;; There might be unread output from checking for share names. | |
| 1264 | (when buf (with-current-buffer buf (erase-buffer))) | |
| 1265 | (when (and p (processp p)) (delete-process p)) | |
| 1266 | ||
| 36a3859f MA |
1267 | (let* ((user (tramp-file-name-user vec)) |
| 1268 | (host (tramp-file-name-host vec)) | |
| 1269 | (real-user (tramp-file-name-real-user vec)) | |
| 1270 | (real-host (tramp-file-name-real-host vec)) | |
| 1271 | (domain (tramp-file-name-domain vec)) | |
| 1272 | (port (tramp-file-name-port vec)) | |
| 1273 | args) | |
| 00d6fd04 MA |
1274 | |
| 1275 | (if share | |
| 1276 | (setq args (list (concat "//" real-host "/" share))) | |
| 4260b402 | 1277 | (setq args (list "-g" "-L" real-host ))) |
| 00d6fd04 MA |
1278 | |
| 1279 | (if (not (zerop (length real-user))) | |
| 1280 | (setq args (append args (list "-U" real-user))) | |
| 1281 | (setq args (append args (list "-N")))) | |
| 1282 | ||
| 1283 | (when domain (setq args (append args (list "-W" domain)))) | |
| 1284 | (when port (setq args (append args (list "-p" port)))) | |
| 0536254e MA |
1285 | (when tramp-smb-conf |
| 1286 | (setq args (append args (list "-s" tramp-smb-conf)))) | |
| 00d6fd04 MA |
1287 | |
| 1288 | ;; OK, let's go. | |
| 3b30ccda MA |
1289 | (with-progress-reporter |
| 1290 | vec 3 | |
| 1291 | (format "Opening connection for //%s%s/%s" | |
| 1292 | (if (not (zerop (length user))) (concat user "@") "") | |
| 1293 | host (or share "")) | |
| 1294 | ||
| 1295 | (let* ((coding-system-for-read nil) | |
| 1296 | (process-connection-type tramp-process-connection-type) | |
| 1297 | (p (let ((default-directory | |
| 1298 | (tramp-compat-temporary-file-directory))) | |
| 1299 | (apply #'start-process | |
| 1300 | (tramp-buffer-name vec) (tramp-get-buffer vec) | |
| 1301 | tramp-smb-program args)))) | |
| 1302 | ||
| 1303 | (tramp-message | |
| 1304 | vec 6 "%s" (mapconcat 'identity (process-command p) " ")) | |
| bd8fadca | 1305 | (tramp-compat-set-process-query-on-exit-flag p nil) |
| 3b30ccda MA |
1306 | |
| 1307 | ;; Set variables for computing the prompt for reading password. | |
| 1308 | (setq tramp-current-method tramp-smb-method | |
| 1309 | tramp-current-user user | |
| 1310 | tramp-current-host host) | |
| 1311 | ||
| 1312 | ;; Play login scenario. | |
| 1313 | (tramp-process-actions | |
| 1314 | p vec | |
| 1315 | (if share | |
| 1316 | tramp-smb-actions-with-share | |
| 1317 | tramp-smb-actions-without-share)) | |
| 1318 | ||
| 1319 | ;; Check server version. | |
| 1320 | (with-current-buffer (tramp-get-connection-buffer vec) | |
| 1321 | (goto-char (point-min)) | |
| 1322 | (search-forward-regexp | |
| 1323 | "Domain=\\[[^]]*\\] OS=\\[[^]]*\\] Server=\\[[^]]*\\]" nil t) | |
| 1324 | (let ((smbserver-version (match-string 0))) | |
| 1325 | (unless | |
| 1326 | (string-equal | |
| 1327 | smbserver-version | |
| 1328 | (tramp-get-connection-property | |
| 1329 | vec "smbserver-version" smbserver-version)) | |
| 1330 | (tramp-flush-directory-property vec "") | |
| 1331 | (tramp-flush-connection-property vec)) | |
| 1332 | (tramp-set-connection-property | |
| 1333 | vec "smbserver-version" smbserver-version))) | |
| 1334 | ||
| 1335 | ;; Set chunksize. Otherwise, `tramp-send-string' might | |
| 1336 | ;; try it itself. | |
| 1337 | (tramp-set-connection-property p "smb-share" share) | |
| 1338 | (tramp-set-connection-property | |
| 1339 | p "chunksize" tramp-chunksize)))))))) | |
| 4007ba5b KG |
1340 | |
| 1341 | ;; We don't use timeouts. If needed, the caller shall wrap around. | |
| 00d6fd04 | 1342 | (defun tramp-smb-wait-for-output (vec) |
| 4007ba5b | 1343 | "Wait for output from smbclient command. |
| 4007ba5b | 1344 | Returns nil if an error message has appeared." |
| 00d6fd04 MA |
1345 | (with-current-buffer (tramp-get-buffer vec) |
| 1346 | (let ((p (get-buffer-process (current-buffer))) | |
| 1347 | (found (progn (goto-char (point-min)) | |
| 1348 | (re-search-forward tramp-smb-prompt nil t))) | |
| 1349 | (err (progn (goto-char (point-min)) | |
| 1350 | (re-search-forward tramp-smb-errors nil t)))) | |
| 5ec2cc41 | 1351 | |
| 00d6fd04 MA |
1352 | ;; Algorithm: get waiting output. See if last line contains |
| 1353 | ;; tramp-smb-prompt sentinel or tramp-smb-errors strings. | |
| 1354 | ;; If not, wait a bit and again get waiting output. | |
| 1355 | (while (and (not found) (not err)) | |
| 5ec2cc41 | 1356 | |
| 00d6fd04 MA |
1357 | ;; Accept pending output. |
| 1358 | (tramp-accept-process-output p) | |
| 4007ba5b | 1359 | |
| 00d6fd04 MA |
1360 | ;; Search for prompt. |
| 1361 | (goto-char (point-min)) | |
| 1362 | (setq found (re-search-forward tramp-smb-prompt nil t)) | |
| 4007ba5b | 1363 | |
| 00d6fd04 MA |
1364 | ;; Search for errors. |
| 1365 | (goto-char (point-min)) | |
| 1366 | (setq err (re-search-forward tramp-smb-errors nil t))) | |
| 4007ba5b | 1367 | |
| 00d6fd04 MA |
1368 | ;; When the process is still alive, read pending output. |
| 1369 | (while (and (not found) (memq (process-status p) '(run open))) | |
| 4007ba5b | 1370 | |
| 00d6fd04 MA |
1371 | ;; Accept pending output. |
| 1372 | (tramp-accept-process-output p) | |
| 4007ba5b | 1373 | |
| 00d6fd04 MA |
1374 | ;; Search for prompt. |
| 1375 | (goto-char (point-min)) | |
| 1376 | (setq found (re-search-forward tramp-smb-prompt nil t))) | |
| 4007ba5b | 1377 | |
| 00d6fd04 MA |
1378 | ;; Return value is whether no error message has appeared. |
| 1379 | (tramp-message vec 6 "\n%s" (buffer-string)) | |
| 1380 | (not err)))) | |
| 4007ba5b | 1381 | |
| 0f34aa77 MA |
1382 | (add-hook 'tramp-unload-hook |
| 1383 | (lambda () | |
| 1384 | (unload-feature 'tramp-smb 'force))) | |
| 4007ba5b | 1385 | |
| 4007ba5b KG |
1386 | (provide 'tramp-smb) |
| 1387 | ||
| 1388 | ;;; TODO: | |
| 1389 | ||
| 4007ba5b KG |
1390 | ;; * Error handling in case password is wrong. |
| 1391 | ;; * Read password from "~/.netrc". | |
| c2dc9732 | 1392 | ;; * Return more comprehensive file permission string. |
| 4007ba5b KG |
1393 | ;; * Try to remove the inclusion of dummy "" directory. Seems to be at |
| 1394 | ;; several places, especially in `tramp-smb-handle-insert-directory'. | |
| 4007ba5b KG |
1395 | ;; * (RMS) Use unwind-protect to clean up the state so as to make the state |
| 1396 | ;; regular again. | |
| 00d6fd04 | 1397 | ;; * Make it multi-hop capable. |
| 4007ba5b KG |
1398 | |
| 1399 | ;;; tramp-smb.el ends here |