;;; tramp-smb.el --- Tramp access functions for SMB servers
-;; Copyright (C) 2002, 2003, 2004, 2005, 2006,
-;; 2007 Free Software Foundation, Inc.
+;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008,
+;; 2009 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, see
-;; <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
+(eval-when-compile (require 'cl)) ; block, return
(require 'tramp)
(require 'tramp-cache)
-
-;; Pacify byte-compiler
-(eval-when-compile (require 'custom))
-
-;; Avoid byte-compiler warnings if the byte-compiler supports this.
-;; Currently, XEmacs supports this.
-(eval-when-compile
- (when (featurep 'xemacs)
- (byte-compiler-options (warnings (- unused-vars)))))
+(require 'tramp-compat)
;; Define SMB method ...
(defcustom tramp-smb-method "smb"
;; Add a default for `tramp-default-method-alist'. Rule: If there is
;; a domain in USER, it must be the SMB method.
(add-to-list 'tramp-default-method-alist
- `(nil "%" ,tramp-smb-method))
+ `(nil ,tramp-prefix-domain-regexp ,tramp-smb-method))
;; Add a default for `tramp-default-user-alist'. Rule: For the SMB method,
;; the anonymous user is chosen.
'(;; Connection error / timeout
"Connection to \\S-+ failed"
"Read from server failed, maybe it closed the connection"
+ "Call timed out: server did not respond"
;; Samba
"ERRDOS"
"ERRSRV"
(file-remote-p . tramp-handle-file-remote-p)
(file-modes . tramp-handle-file-modes)
(file-name-all-completions . tramp-smb-handle-file-name-all-completions)
- ;; `file-name-as-directory' performed by default handler
+ (file-name-as-directory . tramp-handle-file-name-as-directory)
(file-name-completion . tramp-handle-file-name-completion)
(file-name-directory . tramp-handle-file-name-directory)
(file-name-nondirectory . tramp-handle-file-name-nondirectory)
;; File name primitives
(defun tramp-smb-handle-copy-file
- (filename newname &optional ok-if-already-exists keep-date)
+ (filename newname &optional ok-if-already-exists keep-date preserve-uid-gid)
"Like `copy-file' for Tramp files.
-KEEP-DATE is not handled in case NEWNAME resides on an SMB server."
+KEEP-DATE is not handled in case NEWNAME resides on an SMB server.
+PRESERVE-UID-GID is completely ignored."
(setq filename (expand-file-name filename)
newname (expand-file-name newname))
(if tmpfile
;; Remote filename.
- (rename-file tmpfile newname ok-if-already-exists)
+ (condition-case err
+ (rename-file tmpfile newname ok-if-already-exists)
+ ((error quit)
+ (delete-file tmpfile)
+ (signal (car err) (cdr err))))
;; Remote newname.
(when (file-directory-p newname)
"Like `file-local-copy' for Tramp files."
(with-parsed-tramp-file-name filename nil
(let ((file (tramp-smb-get-localname localname t))
- (tmpfil (tramp-make-temp-file filename)))
+ (tmpfile (tramp-compat-make-temp-file filename)))
(unless (file-exists-p filename)
(tramp-error
v 'file-error
"Cannot make local copy of non-existing file `%s'" filename))
- (tramp-message v 4 "Fetching %s to tmp file %s..." filename tmpfil)
- (if (tramp-smb-send-command v (format "get \"%s\" %s" file tmpfil))
+ (tramp-message v 4 "Fetching %s to tmp file %s..." filename tmpfile)
+ (if (tramp-smb-send-command v (format "get \"%s\" %s" file tmpfile))
(tramp-message
- v 4 "Fetching %s to tmp file %s...done" filename tmpfil)
+ v 4 "Fetching %s to tmp file %s...done" filename tmpfile)
(tramp-error
v 'file-error
"Cannot make local copy of file `%s'" filename))
- tmpfil)))
+ tmpfile)))
;; This function should return "foo/" for directories and "bar" for
;; files.
;; We just need the only and only entry FILENAME.
(list (assoc base entries)))))
- ;; Sort entries
+ ;; Sort entries.
(setq entries
(sort
entries
;; Sort by name.
(string-lessp (nth 0 x) (nth 0 y))))))
+ ;; Handle "-F" switch.
+ (when (string-match "F" switches)
+ (mapc
+ (lambda (x)
+ (when (not (zerop (length (car x))))
+ (cond
+ ((char-equal ?d (string-to-char (nth 1 x)))
+ (setcar x (concat (car x) "/")))
+ ((char-equal ?x (string-to-char (nth 1 x)))
+ (setcar x (concat (car x) "*"))))))
+ entries))
+
;; Print entries.
(mapcar
(lambda (x)
(let ((tmpfile (file-local-copy filename)))
(if tmpfile
- ;; remote filename
- (rename-file tmpfile newname ok-if-already-exists)
+ ;; Remote filename.
+ (condition-case err
+ (rename-file tmpfile newname ok-if-already-exists)
+ ((error quit)
+ (delete-file tmpfile)
+ (signal (car err) (cdr err))))
- ;; remote newname
+ ;; Remote newname.
(when (file-directory-p newname)
(setq newname (expand-file-name
(file-name-nondirectory filename) newname)))
(defun tramp-smb-handle-substitute-in-file-name (filename)
"Like `handle-substitute-in-file-name' for Tramp files.
-Catches errors for shares like \"C$/\", which are common in Microsoft Windows."
+\"//\" substitutes only in the local filename part. Catches
+errors for shares like \"C$/\", which are common in Microsoft Windows."
+ (with-parsed-tramp-file-name filename nil
+ ;; Ignore in LOCALNAME everything before "//".
+ (when (and (stringp localname) (string-match ".+?/\\(/\\|~\\)" localname))
+ (setq filename
+ (concat (file-remote-p filename)
+ (replace-match "\\1" nil nil localname)))))
(condition-case nil
(tramp-run-real-handler 'substitute-in-file-name (list filename))
(error filename)))
(with-parsed-tramp-file-name filename nil
(unless (eq append nil)
(tramp-error
- v 'file-error "Cannot append to file using tramp (`%s')" filename))
- ;; XEmacs takes a coding system as the seventh argument, not `confirm'
+ v 'file-error "Cannot append to file using Tramp (`%s')" filename))
+ ;; XEmacs takes a coding system as the seventh argument, not `confirm'.
(when (and (not (featurep 'xemacs))
confirm (file-exists-p filename))
(unless (y-or-n-p (format "File %s exists; overwrite anyway? "
filename))
(tramp-error v 'file-error "File not overwritten")))
;; We must also flush the cache of the directory, because
- ;; file-attributes reads the values from there.
+ ;; `file-attributes' reads the values from there.
(tramp-flush-file-property v (file-name-directory localname))
(tramp-flush-file-property v localname)
(let ((file (tramp-smb-get-localname localname t))
(curbuf (current-buffer))
- tmpfil)
- ;; Write region into a tmp file.
- (setq tmpfil (tramp-make-temp-file filename))
+ (tmpfile (tramp-compat-make-temp-file filename)))
;; We say `no-message' here because we don't want the visited file
;; modtime data to be clobbered from the temp file. We call
;; `set-visited-file-modtime' ourselves later on.
(tramp-run-real-handler
'write-region
(if confirm ; don't pass this arg unless defined for backward compat.
- (list start end tmpfil append 'no-message lockname confirm)
- (list start end tmpfil append 'no-message lockname)))
+ (list start end tmpfile append 'no-message lockname confirm)
+ (list start end tmpfile append 'no-message lockname)))
- (tramp-message v 5 "Writing tmp file %s to file %s..." tmpfil filename)
- (if (tramp-smb-send-command v (format "put %s \"%s\"" tmpfil file))
- (tramp-message
- v 5 "Writing tmp file %s to file %s...done" tmpfil filename)
- (tramp-error v 'file-error "Cannot write `%s'" filename))
+ (tramp-message v 5 "Writing tmp file %s to file %s..." tmpfile filename)
+ (unwind-protect
+ (if (tramp-smb-send-command v (format "put %s \"%s\"" tmpfile file))
+ (tramp-message
+ v 5 "Writing tmp file %s to file %s...done" tmpfile filename)
+ (tramp-error v 'file-error "Cannot write `%s'" filename))
+ (delete-file tmpfile))
- (delete-file tmpfil)
(unless (equal curbuf (current-buffer))
(tramp-error
v 'file-error
Result is the list (LOCALNAME MODE SIZE MTIME)."
;; We are called from `tramp-smb-get-file-entries', which sets the
;; current buffer.
- (let ((line (buffer-substring (point) (tramp-line-end-position)))
+ (let ((line (buffer-substring (point) (tramp-compat-line-end-position)))
localname mode size month day hour min sec year mtime)
(if (not share)
(when (and p (processp p)) (delete-process p))
(unless (let ((default-directory
- (tramp-temporary-file-directory)))
+ (tramp-compat-temporary-file-directory)))
(executable-find tramp-smb-program))
(error "Cannot find command %s in %s" tramp-smb-program exec-path))
- (let* ((user (tramp-file-name-user vec))
- (host (tramp-file-name-host vec))
- (real-user user)
- (real-host host)
- domain port args)
-
- ;; Check for domain ("user%domain") and port ("host#port").
- (when (and user (string-match "\\(.+\\)%\\(.+\\)" user))
- (setq real-user (or (match-string 1 user) user)
- domain (match-string 2 user)))
-
- (when (and host (string-match "\\(.+\\)#\\(.+\\)" host))
- (setq real-host (or (match-string 1 host) host)
- port (match-string 2 host)))
+ (let* ((user (tramp-file-name-user vec))
+ (host (tramp-file-name-host vec))
+ (real-user (tramp-file-name-real-user vec))
+ (real-host (tramp-file-name-real-host vec))
+ (domain (tramp-file-name-domain vec))
+ (port (tramp-file-name-port vec))
+ args)
(if share
(setq args (list (concat "//" real-host "/" share)))
(let* ((coding-system-for-read nil)
(process-connection-type tramp-process-connection-type)
- (p (let ((default-directory (tramp-temporary-file-directory)))
+ (p (let ((default-directory
+ (tramp-compat-temporary-file-directory)))
(apply #'start-process
(tramp-buffer-name vec) (tramp-get-buffer vec)
tramp-smb-program args))))
(tramp-message
vec 6 "%s" (mapconcat 'identity (process-command p) " "))
- (set-process-sentinel p 'tramp-flush-connection-property)
(tramp-set-process-query-on-exit-flag p nil)
(tramp-set-connection-property p "smb-share" share)
;; * Return more comprehensive file permission string. Think whether it is
;; possible to implement `set-file-modes'.
;; * Handle links (FILENAME.LNK).
-;; * Maybe local tmp files should have the same extension like the original
-;; files. Strange behaviour with jka-compr otherwise?
;; * Try to remove the inclusion of dummy "" directory. Seems to be at
;; several places, especially in `tramp-smb-handle-insert-directory'.
;; * (RMS) Use unwind-protect to clean up the state so as to make the state
;; regular again.
;; * Make it multi-hop capable.
-;;; arch-tag: fcc9dbec-7503-4d73-b638-3c8aa59575f5
+;; arch-tag: fcc9dbec-7503-4d73-b638-3c8aa59575f5
;;; tramp-smb.el ends here