mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-11-24 07:20:37 +00:00
38c65fca8d
Version 2.0.40 of Tramp released.
* net/tramp.el (tramp-completion-mode, tramp-md5-function): Use
symbol-function to invoke functions only known on some Emacs
flavors. This avoids byte-compiler warnings. Reported by Kevin
Scaldeferri <kevin@scaldeferri.com>.
(tramp-do-copy-or-rename-file-via-buffer): Renamed from
tramp-do-copy-or-rename-via-buffer (without `file'), to make it
consistent with the other tramp-do-* functions.
(tramp-do-copy-or-rename-file): Calls adjusted.
(tramp-process-initial-commands): Avoid liveness check on shell --
we know that it must be alive since we're opening a connection at
this moment.
(tramp-last-cmd): New internal variable.
(tramp-process-echoes): New tunable.
(tramp-send-command): Set tramp-last-cmd.
(tramp-wait-for-output): Delete echo, if applicable.
(tramp-read-passwd): Construct the key for the password cache in a
way that works for multi methods, too.
(tramp-bug): Add backup-directory-alist and
bkup-backup-directory-info to bug reports, with Tramp
counterparts.
2004-05-01 Michael Albinus <michael.albinus@gmx.de>
* net/tramp*.el: Suppress byte-compiler warnings where possible.
* net/tramp.el (tramp-out-of-band-prompt-regexp)
(tramp-actions-copy-out-of-band): New defcustoms.
(tramp-do-copy-or-rename-file-out-of-band): Asynchronous process
used instead of a synchronous one. Allows password entering.
(tramp-action-out-of-band): New defun.
(tramp-open-connection-rsh, tramp-method-out-of-band-p): Remove
restriction with password from doc string.
(tramp-bug): Add variables `tramp-terminal-prompt-regexp',
`tramp-out-of-band-prompt-regexp',
`tramp-actions-copy-out-of-band', `password-cache' and
`password-cache-expiry'.
(toplevel): Remove todo item wrt ssh-agent. Obsolete due to
password caching.
(tramp-touch): FILE can be a local file, too.
(TODO): Remove items done.
(tramp-handle-insert-directory): Properly quote file name also if
not full-directory-p. Handle wildcard case. Reported by Andreas
Schwab <schwab@suse.de>.
(tramp-do-copy-or-rename-file-via-buffer): Set permissions of the
new file.
(tramp-handle-file-local-copy, tramp-handle-write-region): The
permissions of the temporary file are set if filename exists.
Reported by Ted Stern <stern@cray.com>.
(tramp-backup-directory-alist)
(tramp-bkup-backup-directory-info): New defcustoms.
(tramp-file-name-handler-alist): Add entry for
`find-backup-file-name'.
(tramp-handle-find-backup-file-name): New function. Implements
Tramp's find-backup-file-name.
* net/tramp-smb.el (tramp-smb-file-name-handler-alist): Add entry
for `find-backup-file-name'.
* net/tramp-vc.el (tramp-vc-workfile-unchanged-p): Correct typo
("file" -> "filename"). Reported by Kim F. Storm <storm@cua.dk>.
1148 lines
42 KiB
EmacsLisp
1148 lines
42 KiB
EmacsLisp
;;; tramp-smb.el --- Tramp access functions for SMB servers -*- coding: iso-8859-1; -*-
|
|
|
|
;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
|
|
|
|
;; Author: Michael Albinus <Michael.Albinus@alcatel.de>
|
|
;; Keywords: comm, processes
|
|
|
|
;; This file is part of GNU Emacs.
|
|
|
|
;; 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 2, 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
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; 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, write to the
|
|
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
;; Boston, MA 02111-1307, USA.
|
|
|
|
;;; Commentary:
|
|
|
|
;; Access functions for SMB servers like SAMBA or M$ Windows from Tramp.
|
|
|
|
;;; Code:
|
|
|
|
(require 'tramp)
|
|
|
|
;; Pacify byte-compiler
|
|
(eval-when-compile
|
|
(require 'cl)
|
|
(require 'custom)
|
|
;; Emacs 19.34 compatibility hack -- is this needed?
|
|
(or (>= emacs-major-version 20)
|
|
(load "cl-seq")))
|
|
|
|
;; Avoid byte-compiler warnings if the byte-compiler supports this.
|
|
;; Currently, XEmacs supports this.
|
|
(eval-when-compile
|
|
(when (fboundp 'byte-compiler-options)
|
|
(let (unused-vars) ; Pacify Emacs byte-compiler
|
|
(defalias 'warnings 'identity) ; Pacify Emacs byte-compiler
|
|
(byte-compiler-options (warnings (- unused-vars))))))
|
|
|
|
;; XEmacs byte-compiler raises warning abouts `last-coding-system-used'.
|
|
(eval-when-compile
|
|
(unless (boundp 'last-coding-system-used)
|
|
(defvar last-coding-system-used nil)))
|
|
|
|
;; Define SMB method ...
|
|
(defcustom tramp-smb-method "smb"
|
|
"*Method to connect SAMBA and M$ SMB servers."
|
|
:group 'tramp
|
|
:type 'string)
|
|
|
|
;; ... and add it to the method list.
|
|
(add-to-list 'tramp-methods (cons tramp-smb-method nil))
|
|
|
|
;; 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
|
|
(list "" "%" tramp-smb-method))
|
|
|
|
;; Add completion function for SMB method.
|
|
(tramp-set-completion-function
|
|
tramp-smb-method
|
|
'((tramp-parse-netrc "~/.netrc")))
|
|
|
|
(defcustom tramp-smb-program "smbclient"
|
|
"*Name of SMB client to run."
|
|
:group 'tramp
|
|
:type 'string)
|
|
|
|
(defconst tramp-smb-prompt "^smb: \\S-+> \\|^\\s-+Server\\s-+Comment$"
|
|
"Regexp used as prompt in smbclient.")
|
|
|
|
(defconst tramp-smb-errors
|
|
(mapconcat
|
|
'identity
|
|
'(; Connection error
|
|
"Connection to \\S-+ failed"
|
|
; Samba
|
|
"ERRDOS"
|
|
"ERRSRV"
|
|
"ERRbadfile"
|
|
"ERRbadpw"
|
|
"ERRfilexists"
|
|
"ERRnoaccess"
|
|
"ERRnomem"
|
|
"ERRnosuchshare"
|
|
; Windows NT 4.0, Windows 5.0 (Windows 2000), Windows 5.1 (Windows XP)
|
|
"NT_STATUS_ACCESS_DENIED"
|
|
"NT_STATUS_ACCOUNT_LOCKED_OUT"
|
|
"NT_STATUS_BAD_NETWORK_NAME"
|
|
"NT_STATUS_CANNOT_DELETE"
|
|
"NT_STATUS_LOGON_FAILURE"
|
|
"NT_STATUS_NETWORK_ACCESS_DENIED"
|
|
"NT_STATUS_NO_SUCH_FILE"
|
|
"NT_STATUS_OBJECT_NAME_INVALID"
|
|
"NT_STATUS_OBJECT_NAME_NOT_FOUND"
|
|
"NT_STATUS_SHARING_VIOLATION"
|
|
"NT_STATUS_WRONG_PASSWORD")
|
|
"\\|")
|
|
"Regexp for possible error strings of SMB servers.
|
|
Used instead of analyzing error codes of commands.")
|
|
|
|
(defvar tramp-smb-share nil
|
|
"Holds the share name for the current buffer.
|
|
This variable is local to each buffer.")
|
|
(make-variable-buffer-local 'tramp-smb-share)
|
|
|
|
(defvar tramp-smb-share-cache nil
|
|
"Caches the share names accessible to host related to the current buffer.
|
|
This variable is local to each buffer.")
|
|
(make-variable-buffer-local 'tramp-smb-share-cache)
|
|
|
|
(defvar tramp-smb-inodes nil
|
|
"Keeps virtual inodes numbers for SMB files.")
|
|
|
|
;; New handlers should be added here.
|
|
(defconst tramp-smb-file-name-handler-alist
|
|
'(
|
|
;; `access-file' performed by default handler
|
|
(add-name-to-file . tramp-smb-handle-copy-file) ;; we're on Windows, honey.
|
|
;; `byte-compiler-base-file-name' performed by default handler
|
|
(copy-file . tramp-smb-handle-copy-file)
|
|
(delete-directory . tramp-smb-handle-delete-directory)
|
|
(delete-file . tramp-smb-handle-delete-file)
|
|
;; `diff-latest-backup-file' performed by default handler
|
|
(directory-file-name . tramp-handle-directory-file-name)
|
|
(directory-files . tramp-smb-handle-directory-files)
|
|
(directory-files-and-attributes . tramp-smb-handle-directory-files-and-attributes)
|
|
(dired-call-process . tramp-smb-not-handled)
|
|
(dired-compress-file . tramp-smb-not-handled)
|
|
;; `dired-uncache' performed by default handler
|
|
;; `expand-file-name' not necessary because we cannot expand "~/"
|
|
(file-accessible-directory-p . tramp-smb-handle-file-directory-p)
|
|
(file-attributes . tramp-smb-handle-file-attributes)
|
|
(file-directory-p . tramp-smb-handle-file-directory-p)
|
|
(file-executable-p . tramp-smb-handle-file-exists-p)
|
|
(file-exists-p . tramp-smb-handle-file-exists-p)
|
|
(file-local-copy . tramp-smb-handle-file-local-copy)
|
|
(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-completion . tramp-handle-file-name-completion)
|
|
(file-name-directory . tramp-handle-file-name-directory)
|
|
(file-name-nondirectory . tramp-handle-file-name-nondirectory)
|
|
;; `file-name-sans-versions' performed by default handler
|
|
(file-newer-than-file-p . tramp-smb-handle-file-newer-than-file-p)
|
|
(file-ownership-preserved-p . tramp-smb-not-handled)
|
|
(file-readable-p . tramp-smb-handle-file-exists-p)
|
|
(file-regular-p . tramp-handle-file-regular-p)
|
|
(file-symlink-p . tramp-smb-not-handled)
|
|
;; `file-truename' performed by default handler
|
|
(file-writable-p . tramp-smb-handle-file-writable-p)
|
|
(find-backup-file-name . tramp-handle-find-backup-file-name)
|
|
;; `find-file-noselect' performed by default handler
|
|
;; `get-file-buffer' performed by default handler
|
|
(insert-directory . tramp-smb-handle-insert-directory)
|
|
(insert-file-contents . tramp-handle-insert-file-contents)
|
|
(load . tramp-handle-load)
|
|
(make-directory . tramp-smb-handle-make-directory)
|
|
(make-directory-internal . tramp-smb-handle-make-directory-internal)
|
|
(make-symbolic-link . tramp-smb-not-handled)
|
|
(rename-file . tramp-smb-handle-rename-file)
|
|
(set-file-modes . tramp-smb-not-handled)
|
|
(set-visited-file-modtime . tramp-smb-not-handled)
|
|
(shell-command . tramp-smb-not-handled)
|
|
;; `substitute-in-file-name' performed by default handler
|
|
(unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory)
|
|
(vc-registered . tramp-smb-not-handled)
|
|
(verify-visited-file-modtime . tramp-smb-not-handled)
|
|
(write-region . tramp-smb-handle-write-region)
|
|
)
|
|
"Alist of handler functions for Tramp SMB method.
|
|
Operations not mentioned here will be handled by the default Emacs primitives.")
|
|
|
|
(defun tramp-smb-file-name-p (filename)
|
|
"Check if it's a filename for SMB servers."
|
|
(let ((v (tramp-dissect-file-name filename)))
|
|
(string=
|
|
(tramp-find-method
|
|
(tramp-file-name-multi-method v)
|
|
(tramp-file-name-method v)
|
|
(tramp-file-name-user v)
|
|
(tramp-file-name-host v))
|
|
tramp-smb-method)))
|
|
|
|
(defun tramp-smb-file-name-handler (operation &rest args)
|
|
"Invoke the SMB related OPERATION.
|
|
First arg specifies the OPERATION, second arg is a list of arguments to
|
|
pass to the OPERATION."
|
|
(let ((fn (assoc operation tramp-smb-file-name-handler-alist)))
|
|
(if fn
|
|
(if (eq (cdr fn) 'tramp-smb-not-handled)
|
|
(apply (cdr fn) operation args)
|
|
(save-match-data (apply (cdr fn) args)))
|
|
(tramp-run-real-handler operation args))))
|
|
|
|
(add-to-list 'tramp-foreign-file-name-handler-alist
|
|
(cons 'tramp-smb-file-name-p 'tramp-smb-file-name-handler))
|
|
|
|
|
|
;; File name primitives
|
|
|
|
(defun tramp-smb-not-handled (operation &rest args)
|
|
"Default handler for all functions which are disrecarded."
|
|
(tramp-message 10 "Won't be handled: %s %s" operation args)
|
|
nil)
|
|
|
|
(defun tramp-smb-handle-copy-file
|
|
(filename newname &optional ok-if-already-exists keep-date)
|
|
"Like `copy-file' for tramp files.
|
|
KEEP-DATE is not handled in case NEWNAME resides on an SMB server."
|
|
(setq filename (expand-file-name filename)
|
|
newname (expand-file-name newname))
|
|
|
|
(let ((tmpfile (file-local-copy filename)))
|
|
|
|
(if tmpfile
|
|
;; remote filename
|
|
(rename-file tmpfile newname ok-if-already-exists)
|
|
|
|
;; remote newname
|
|
(when (file-directory-p newname)
|
|
(setq newname (expand-file-name
|
|
(file-name-nondirectory filename) newname)))
|
|
(when (and (not ok-if-already-exists)
|
|
(file-exists-p newname))
|
|
(error "copy-file: file %s already exists" newname))
|
|
|
|
; (with-parsed-tramp-file-name newname nil
|
|
(let (user host localname)
|
|
(with-parsed-tramp-file-name newname l
|
|
(setq user l-user host l-host localname l-localname))
|
|
(save-excursion
|
|
(let ((share (tramp-smb-get-share localname))
|
|
(file (tramp-smb-get-localname localname t)))
|
|
(unless share
|
|
(error "Target `%s' must contain a share name" filename))
|
|
(tramp-smb-maybe-open-connection user host share)
|
|
(tramp-message-for-buffer
|
|
nil tramp-smb-method user host
|
|
5 "Copying file %s to file %s..." filename newname)
|
|
(if (tramp-smb-send-command
|
|
user host (format "put %s \"%s\"" filename file))
|
|
(tramp-message-for-buffer
|
|
nil tramp-smb-method user host
|
|
5 "Copying file %s to file %s...done" filename newname)
|
|
(error "Cannot copy `%s'" filename))))))))
|
|
|
|
(defun tramp-smb-handle-delete-directory (directory)
|
|
"Like `delete-directory' for tramp files."
|
|
(setq directory (directory-file-name (expand-file-name directory)))
|
|
(unless (file-exists-p directory)
|
|
(error "Cannot delete non-existing directory `%s'" directory))
|
|
; (with-parsed-tramp-file-name directory nil
|
|
(let (user host localname)
|
|
(with-parsed-tramp-file-name directory l
|
|
(setq user l-user host l-host localname l-localname))
|
|
(save-excursion
|
|
(let ((share (tramp-smb-get-share localname))
|
|
(dir (tramp-smb-get-localname (file-name-directory localname) t))
|
|
(file (file-name-nondirectory localname)))
|
|
(tramp-smb-maybe-open-connection user host share)
|
|
(if (and
|
|
(tramp-smb-send-command user host (format "cd \"%s\"" dir))
|
|
(tramp-smb-send-command user host (format "rmdir \"%s\"" file)))
|
|
;; Go Home
|
|
(tramp-smb-send-command user host (format "cd \\"))
|
|
;; Error
|
|
(tramp-smb-send-command user host (format "cd \\"))
|
|
(error "Cannot delete directory `%s'" directory))))))
|
|
|
|
(defun tramp-smb-handle-delete-file (filename)
|
|
"Like `delete-file' for tramp files."
|
|
(setq filename (expand-file-name filename))
|
|
(unless (file-exists-p filename)
|
|
(error "Cannot delete non-existing file `%s'" filename))
|
|
; (with-parsed-tramp-file-name filename nil
|
|
(let (user host localname)
|
|
(with-parsed-tramp-file-name filename l
|
|
(setq user l-user host l-host localname l-localname))
|
|
(save-excursion
|
|
(let ((share (tramp-smb-get-share localname))
|
|
(dir (tramp-smb-get-localname (file-name-directory localname) t))
|
|
(file (file-name-nondirectory localname)))
|
|
(unless (file-exists-p filename)
|
|
(error "Cannot delete non-existing file `%s'" filename))
|
|
(tramp-smb-maybe-open-connection user host share)
|
|
(if (and
|
|
(tramp-smb-send-command user host (format "cd \"%s\"" dir))
|
|
(tramp-smb-send-command user host (format "rm \"%s\"" file)))
|
|
;; Go Home
|
|
(tramp-smb-send-command user host (format "cd \\"))
|
|
;; Error
|
|
(tramp-smb-send-command user host (format "cd \\"))
|
|
(error "Cannot delete file `%s'" filename))))))
|
|
|
|
(defun tramp-smb-handle-directory-files
|
|
(directory &optional full match nosort)
|
|
"Like `directory-files' for tramp files."
|
|
(setq directory (directory-file-name (expand-file-name directory)))
|
|
; (with-parsed-tramp-file-name directory nil
|
|
(let (user host localname)
|
|
(with-parsed-tramp-file-name directory l
|
|
(setq user l-user host l-host localname l-localname))
|
|
(save-excursion
|
|
(let* ((share (tramp-smb-get-share localname))
|
|
(file (tramp-smb-get-localname localname nil))
|
|
(entries (tramp-smb-get-file-entries user host share file)))
|
|
;; Just the file names are needed
|
|
(setq entries (mapcar 'car entries))
|
|
;; Discriminate with regexp
|
|
(when match
|
|
(setq entries
|
|
(delete nil
|
|
(mapcar (lambda (x) (when (string-match match x) x))
|
|
entries))))
|
|
;; Make absolute localnames if necessary
|
|
(when full
|
|
(setq entries
|
|
(mapcar (lambda (x)
|
|
(concat (file-name-as-directory directory) x))
|
|
entries)))
|
|
;; Sort them if necessary
|
|
(unless nosort (setq entries (sort entries 'string-lessp)))
|
|
;; That's it
|
|
entries))))
|
|
|
|
(defun tramp-smb-handle-directory-files-and-attributes
|
|
(directory &optional full match nosort id-format)
|
|
"Like `directory-files-and-attributes' for tramp files."
|
|
(mapcar
|
|
(lambda (x)
|
|
;; We cannot call `file-attributes' for backward compatibility reasons.
|
|
;; Its optional parameter ID-FORMAT is introduced with Emacs 21.4.
|
|
(cons x (tramp-smb-handle-file-attributes
|
|
(if full x (concat (file-name-as-directory directory) x)) id-format)))
|
|
(directory-files directory full match nosort)))
|
|
|
|
(defun tramp-smb-handle-file-attributes (filename &optional id-format)
|
|
"Like `file-attributes' for tramp files."
|
|
; (with-parsed-tramp-file-name filename nil
|
|
(let (user host localname)
|
|
(with-parsed-tramp-file-name filename l
|
|
(setq user l-user host l-host localname l-localname))
|
|
(save-excursion
|
|
(let* ((share (tramp-smb-get-share localname))
|
|
(file (tramp-smb-get-localname localname nil))
|
|
(entries (tramp-smb-get-file-entries user host share file))
|
|
(entry (and entries
|
|
(assoc (file-name-nondirectory file) entries)))
|
|
(uid (if (and id-format (equal id-format 'string)) "nobody" -1))
|
|
(gid (if (and id-format (equal id-format 'string)) "nogroup" -1))
|
|
(inode (tramp-smb-get-inode share file))
|
|
(device (tramp-get-device nil tramp-smb-method user host)))
|
|
|
|
; check result
|
|
(when entry
|
|
(list (and (string-match "d" (nth 1 entry))
|
|
t) ;0 file type
|
|
-1 ;1 link count
|
|
uid ;2 uid
|
|
gid ;3 gid
|
|
'(0 0) ;4 atime
|
|
(nth 3 entry) ;5 mtime
|
|
'(0 0) ;6 ctime
|
|
(nth 2 entry) ;7 size
|
|
(nth 1 entry) ;8 mode
|
|
nil ;9 gid weird
|
|
inode ;10 inode number
|
|
device)))))) ;11 file system number
|
|
|
|
(defun tramp-smb-handle-file-directory-p (filename)
|
|
"Like `file-directory-p' for tramp files."
|
|
; (with-parsed-tramp-file-name filename nil
|
|
(let (user host localname)
|
|
(with-parsed-tramp-file-name filename l
|
|
(setq user l-user host l-host localname l-localname))
|
|
(save-excursion
|
|
(let* ((share (tramp-smb-get-share localname))
|
|
(file (tramp-smb-get-localname localname nil))
|
|
(entries (tramp-smb-get-file-entries user host share file))
|
|
(entry (and entries
|
|
(assoc (file-name-nondirectory file) entries))))
|
|
(and entry
|
|
(string-match "d" (nth 1 entry))
|
|
t)))))
|
|
|
|
(defun tramp-smb-handle-file-exists-p (filename)
|
|
"Like `file-exists-p' for tramp files."
|
|
; (with-parsed-tramp-file-name filename nil
|
|
(let (user host localname)
|
|
(with-parsed-tramp-file-name filename l
|
|
(setq user l-user host l-host localname l-localname))
|
|
(save-excursion
|
|
(let* ((share (tramp-smb-get-share localname))
|
|
(file (tramp-smb-get-localname localname nil))
|
|
(entries (tramp-smb-get-file-entries user host share file)))
|
|
(and entries
|
|
(member (file-name-nondirectory file) (mapcar 'car entries))
|
|
t)))))
|
|
|
|
(defun tramp-smb-handle-file-local-copy (filename)
|
|
"Like `file-local-copy' for tramp files."
|
|
(with-parsed-tramp-file-name filename nil
|
|
(save-excursion
|
|
(let ((share (tramp-smb-get-share localname))
|
|
(file (tramp-smb-get-localname localname t))
|
|
(tmpfil (tramp-make-temp-file)))
|
|
(unless (file-exists-p filename)
|
|
(error "Cannot make local copy of non-existing file `%s'" filename))
|
|
(tramp-message-for-buffer
|
|
nil tramp-smb-method user host
|
|
5 "Fetching %s to tmp file %s..." filename tmpfil)
|
|
(tramp-smb-maybe-open-connection user host share)
|
|
(if (tramp-smb-send-command
|
|
user host (format "get \"%s\" %s" file tmpfil))
|
|
(tramp-message-for-buffer
|
|
nil tramp-smb-method user host
|
|
5 "Fetching %s to tmp file %s...done" filename tmpfil)
|
|
(error "Cannot make local copy of file `%s'" filename))
|
|
tmpfil))))
|
|
|
|
;; This function should return "foo/" for directories and "bar" for
|
|
;; files.
|
|
(defun tramp-smb-handle-file-name-all-completions (filename directory)
|
|
"Like `file-name-all-completions' for tramp files."
|
|
; (with-parsed-tramp-file-name directory nil
|
|
(let (user host localname)
|
|
(with-parsed-tramp-file-name directory l
|
|
(setq user l-user host l-host localname l-localname))
|
|
(save-match-data
|
|
(save-excursion
|
|
(let* ((share (tramp-smb-get-share localname))
|
|
(file (tramp-smb-get-localname localname nil))
|
|
(entries (tramp-smb-get-file-entries user host share file)))
|
|
|
|
(all-completions
|
|
filename
|
|
(mapcar
|
|
(lambda (x)
|
|
(list
|
|
(if (string-match "d" (nth 1 x))
|
|
(file-name-as-directory (nth 0 x))
|
|
(nth 0 x))))
|
|
entries)))))))
|
|
|
|
(defun tramp-smb-handle-file-newer-than-file-p (file1 file2)
|
|
"Like `file-newer-than-file-p' for tramp files."
|
|
(cond
|
|
((not (file-exists-p file1)) nil)
|
|
((not (file-exists-p file2)) t)
|
|
(t (tramp-smb-time-less-p (file-attributes file2)
|
|
(file-attributes file1)))))
|
|
|
|
(defun tramp-smb-handle-file-writable-p (filename)
|
|
"Like `file-writable-p' for tramp files."
|
|
(if (not (file-exists-p filename))
|
|
(let ((dir (file-name-directory filename)))
|
|
(and (file-exists-p dir)
|
|
(file-writable-p dir)))
|
|
; (with-parsed-tramp-file-name filename nil
|
|
(let (user host localname)
|
|
(with-parsed-tramp-file-name filename l
|
|
(setq user l-user host l-host localname l-localname))
|
|
(save-excursion
|
|
(let* ((share (tramp-smb-get-share localname))
|
|
(file (tramp-smb-get-localname localname nil))
|
|
(entries (tramp-smb-get-file-entries user host share file))
|
|
(entry (and entries
|
|
(assoc (file-name-nondirectory file) entries))))
|
|
(and share entry
|
|
(string-match "w" (nth 1 entry))
|
|
t))))))
|
|
|
|
(defun tramp-smb-handle-insert-directory
|
|
(filename switches &optional wildcard full-directory-p)
|
|
"Like `insert-directory' for tramp files.
|
|
WILDCARD and FULL-DIRECTORY-P are not handled."
|
|
(setq filename (expand-file-name filename))
|
|
(when (file-directory-p filename)
|
|
;; This check is a little bit strange, but in `dired-add-entry'
|
|
;; this function is called with a non-directory ...
|
|
(setq filename (file-name-as-directory filename)))
|
|
; (with-parsed-tramp-file-name filename nil
|
|
(let (user host localname)
|
|
(with-parsed-tramp-file-name filename l
|
|
(setq user l-user host l-host localname l-localname))
|
|
(save-match-data
|
|
(let* ((share (tramp-smb-get-share localname))
|
|
(file (tramp-smb-get-localname localname nil))
|
|
(entries (tramp-smb-get-file-entries user host share file)))
|
|
|
|
;; Delete dummy "" entry, useless entries
|
|
(setq entries
|
|
(if (file-directory-p filename)
|
|
(delq (assoc "" entries) entries)
|
|
;; We just need the only and only entry FILENAME.
|
|
(list (assoc (file-name-nondirectory filename) entries))))
|
|
|
|
;; Sort entries
|
|
(setq entries
|
|
(sort
|
|
entries
|
|
(lambda (x y)
|
|
(if (string-match "t" switches)
|
|
; sort by date
|
|
(tramp-smb-time-less-p (nth 3 y) (nth 3 x))
|
|
; sort by name
|
|
(string-lessp (nth 0 x) (nth 0 y))))))
|
|
|
|
;; Print entries
|
|
(mapcar
|
|
(lambda (x)
|
|
(insert
|
|
(format
|
|
"%10s %3d %-8s %-8s %8s %s %s\n"
|
|
(nth 1 x) ; mode
|
|
1 "nobody" "nogroup"
|
|
(nth 2 x) ; size
|
|
(format-time-string
|
|
(if (tramp-smb-time-less-p
|
|
(tramp-smb-time-subtract (current-time) (nth 3 x))
|
|
tramp-smb-half-a-year)
|
|
"%b %e %R"
|
|
"%b %e %Y")
|
|
(nth 3 x)) ; date
|
|
(nth 0 x))) ; file name
|
|
(forward-line)
|
|
(beginning-of-line))
|
|
entries)))))
|
|
|
|
(defun tramp-smb-handle-make-directory (dir &optional parents)
|
|
"Like `make-directory' for tramp files."
|
|
(setq dir (directory-file-name (expand-file-name dir)))
|
|
(unless (file-name-absolute-p dir)
|
|
(setq dir (concat default-directory dir)))
|
|
; (with-parsed-tramp-file-name dir nil
|
|
(let (user host localname)
|
|
(with-parsed-tramp-file-name dir l
|
|
(setq user l-user host l-host localname l-localname))
|
|
(save-match-data
|
|
(let* ((share (tramp-smb-get-share localname))
|
|
(ldir (file-name-directory dir)))
|
|
;; Make missing directory parts
|
|
(when (and parents share (not (file-directory-p ldir)))
|
|
(make-directory ldir parents))
|
|
;; Just do it
|
|
(when (file-directory-p ldir)
|
|
(make-directory-internal dir))
|
|
(unless (file-directory-p dir)
|
|
(error "Couldn't make directory %s" dir))))))
|
|
|
|
(defun tramp-smb-handle-make-directory-internal (directory)
|
|
"Like `make-directory-internal' for tramp files."
|
|
(setq directory (directory-file-name (expand-file-name directory)))
|
|
(unless (file-name-absolute-p directory)
|
|
(setq directory (concat default-directory directory)))
|
|
; (with-parsed-tramp-file-name directory nil
|
|
(let (user host localname)
|
|
(with-parsed-tramp-file-name directory l
|
|
(setq user l-user host l-host localname l-localname))
|
|
(save-match-data
|
|
(let* ((share (tramp-smb-get-share localname))
|
|
(file (tramp-smb-get-localname localname nil)))
|
|
(when (file-directory-p (file-name-directory directory))
|
|
(tramp-smb-maybe-open-connection user host share)
|
|
(tramp-smb-send-command user host (format "mkdir \"%s\"" file)))
|
|
(unless (file-directory-p directory)
|
|
(error "Couldn't make directory %s" directory))))))
|
|
|
|
(defun tramp-smb-handle-rename-file
|
|
(filename newname &optional ok-if-already-exists)
|
|
"Like `rename-file' for tramp files."
|
|
(setq filename (expand-file-name filename)
|
|
newname (expand-file-name newname))
|
|
|
|
(let ((tmpfile (file-local-copy filename)))
|
|
|
|
(if tmpfile
|
|
;; remote filename
|
|
(rename-file tmpfile newname ok-if-already-exists)
|
|
|
|
;; remote newname
|
|
(when (file-directory-p newname)
|
|
(setq newname (expand-file-name
|
|
(file-name-nondirectory filename) newname)))
|
|
(when (and (not ok-if-already-exists)
|
|
(file-exists-p newname))
|
|
(error "rename-file: file %s already exists" newname))
|
|
|
|
; (with-parsed-tramp-file-name newname nil
|
|
(let (user host localname)
|
|
(with-parsed-tramp-file-name newname l
|
|
(setq user l-user host l-host localname l-localname))
|
|
(save-excursion
|
|
(let ((share (tramp-smb-get-share localname))
|
|
(file (tramp-smb-get-localname localname t)))
|
|
(tramp-smb-maybe-open-connection user host share)
|
|
(tramp-message-for-buffer
|
|
nil tramp-smb-method user host
|
|
5 "Copying file %s to file %s..." filename newname)
|
|
(if (tramp-smb-send-command
|
|
user host (format "put %s \"%s\"" filename file))
|
|
(tramp-message-for-buffer
|
|
nil tramp-smb-method user host
|
|
5 "Copying file %s to file %s...done" filename newname)
|
|
(error "Cannot rename `%s'" filename)))))))
|
|
|
|
(delete-file filename))
|
|
|
|
(defun tramp-smb-handle-write-region
|
|
(start end filename &optional append visit lockname confirm)
|
|
"Like `write-region' for tramp files."
|
|
(unless (eq append nil)
|
|
(error "Cannot append to file using tramp (`%s')" filename))
|
|
(setq filename (expand-file-name 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))
|
|
(error "File not overwritten")))
|
|
; (with-parsed-tramp-file-name filename nil
|
|
(let (user host localname)
|
|
(with-parsed-tramp-file-name filename l
|
|
(setq user l-user host l-host localname l-localname))
|
|
(save-excursion
|
|
(let ((share (tramp-smb-get-share localname))
|
|
(file (tramp-smb-get-localname localname t))
|
|
(curbuf (current-buffer))
|
|
;; We use this to save the value of `last-coding-system-used'
|
|
;; after writing the tmp file. At the end of the function,
|
|
;; we set `last-coding-system-used' to this saved value.
|
|
;; This way, any intermediary coding systems used while
|
|
;; talking to the remote shell or suchlike won't hose this
|
|
;; variable. This approach was snarfed from ange-ftp.el.
|
|
coding-system-used
|
|
tmpfil)
|
|
;; Write region into a tmp file.
|
|
(setq tmpfil (tramp-make-temp-file))
|
|
;; 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)))
|
|
;; Now, `last-coding-system-used' has the right value. Remember it.
|
|
(when (boundp 'last-coding-system-used)
|
|
(setq coding-system-used last-coding-system-used))
|
|
|
|
(tramp-smb-maybe-open-connection user host share)
|
|
(tramp-message-for-buffer
|
|
nil tramp-smb-method user host
|
|
5 "Writing tmp file %s to file %s..." tmpfil filename)
|
|
(if (tramp-smb-send-command
|
|
user host (format "put %s \"%s\"" tmpfil file))
|
|
(tramp-message-for-buffer
|
|
nil tramp-smb-method user host
|
|
5 "Writing tmp file %s to file %s...done" tmpfil filename)
|
|
(error "Cannot write `%s'" filename))
|
|
|
|
(delete-file tmpfil)
|
|
(unless (equal curbuf (current-buffer))
|
|
(error "Buffer has changed from `%s' to `%s'"
|
|
curbuf (current-buffer)))
|
|
(when (eq visit t)
|
|
(set-visited-file-modtime))
|
|
;; Make `last-coding-system-used' have the right value.
|
|
(when (boundp 'last-coding-system-used)
|
|
(setq last-coding-system-used coding-system-used))))))
|
|
|
|
|
|
;; Internal file name functions
|
|
|
|
(defun tramp-smb-get-share (localname)
|
|
"Returns the share name of LOCALNAME."
|
|
(save-match-data
|
|
(when (string-match "^/?\\([^/]+\\)/" localname)
|
|
(match-string 1 localname))))
|
|
|
|
(defun tramp-smb-get-localname (localname convert)
|
|
"Returns the file name of LOCALNAME.
|
|
If CONVERT is non-nil exchange \"/\" by \"\\\\\"."
|
|
(save-match-data
|
|
(let ((res localname))
|
|
|
|
(setq
|
|
res (if (string-match "^/?[^/]+/\\(.*\\)" res)
|
|
(if convert
|
|
(mapconcat
|
|
(lambda (x) (if (equal x ?/) "\\" (char-to-string x)))
|
|
(match-string 1 res) "")
|
|
(match-string 1 res))
|
|
(if (string-match "^/?\\([^/]+\\)$" res)
|
|
(match-string 1 res)
|
|
"")))
|
|
|
|
;; Sometimes we have discarded `substitute-in-file-name'
|
|
(when (string-match "\\(\\$\\$\\)\\(/\\|$\\)" res)
|
|
(setq res (replace-match "$" nil nil res 1)))
|
|
|
|
res)))
|
|
|
|
;; Share names of a host are cached. It is very unlikely that the
|
|
;; shares do change during connection.
|
|
(defun tramp-smb-get-file-entries (user host share localname)
|
|
"Read entries which match LOCALNAME.
|
|
Either the shares are listed, or the `dir' command is executed.
|
|
Only entries matching the localname are returned.
|
|
Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)."
|
|
(save-excursion
|
|
(save-match-data
|
|
(let ((base (or (and (> (length localname) 0)
|
|
(string-match "\\([^/]+\\)$" localname)
|
|
(regexp-quote (match-string 1 localname)))
|
|
""))
|
|
res entry)
|
|
(set-buffer (tramp-get-buffer nil tramp-smb-method user host))
|
|
(if (and (not share) tramp-smb-share-cache)
|
|
;; Return cached shares
|
|
(setq res tramp-smb-share-cache)
|
|
;; Read entries
|
|
(tramp-smb-maybe-open-connection user host share)
|
|
(when share
|
|
(tramp-smb-send-command
|
|
user host
|
|
(format "dir %s"
|
|
(if (zerop (length localname)) "" (concat "\"" localname "*\"")))))
|
|
(goto-char (point-min))
|
|
;; Loop the listing
|
|
(unless (re-search-forward tramp-smb-errors nil t)
|
|
(while (not (eobp))
|
|
(setq entry (tramp-smb-read-file-entry share))
|
|
(forward-line)
|
|
(when entry (add-to-list 'res entry))))
|
|
(unless share
|
|
;; Cache share entries
|
|
(setq tramp-smb-share-cache res)))
|
|
|
|
;; Add directory itself
|
|
(add-to-list 'res '("" "drwxrwxrwx" 0 (0 0)))
|
|
|
|
;; There's a very strange error (debugged with XEmacs 21.4.14)
|
|
;; If there's no short delay, it returns nil. No idea about
|
|
(when (featurep 'xemacs) (sleep-for 0.01))
|
|
|
|
;; Check for matching entries
|
|
(delq nil (mapcar
|
|
(lambda (x) (and (string-match base (nth 0 x)) x))
|
|
res))))))
|
|
|
|
;; Return either a share name (if SHARE is nil), or a file name
|
|
;;
|
|
;; If shares are listed, the following format is expected
|
|
;;
|
|
;; \s-\{8,8} - leading spaces
|
|
;; \S-\(.*\S-\)\s-* - share name, 14 char
|
|
;; \s- - space delimeter
|
|
;; \S-+\s-* - type, 8 char, "Disk " expected
|
|
;; \(\s-\{2,2\}.*\)? - space delimeter, comment
|
|
;;
|
|
;; Entries provided by smbclient DIR aren't fully regular.
|
|
;; They should have the format
|
|
;;
|
|
;; \s-\{2,2} - leading spaces
|
|
;; \S-\(.*\S-\)\s-* - file name, 30 chars, left bound
|
|
;; \s-+[ADHRSV]* - permissions, 7 chars, right bound
|
|
;; \s- - space delimeter
|
|
;; \s-+[0-9]+ - size, 8 chars, right bound
|
|
;; \s-\{2,2\} - space delimeter
|
|
;; \w\{3,3\} - weekday
|
|
;; \s- - space delimeter
|
|
;; \w\{3,3\} - month
|
|
;; \s- - space delimeter
|
|
;; [ 19][0-9] - day
|
|
;; \s- - space delimeter
|
|
;; [0-9]\{2,2\}:[0-9]\{2,2\}:[0-9]\{2,2\} - time
|
|
;; \s- - space delimeter
|
|
;; [0-9]\{4,4\} - year
|
|
;;
|
|
;; samba/src/client.c (http://samba.org/doxygen/samba/client_8c-source.html)
|
|
;; has function display_finfo:
|
|
;;
|
|
;; d_printf(" %-30s%7.7s %8.0f %s",
|
|
;; finfo->name,
|
|
;; attrib_string(finfo->mode),
|
|
;; (double)finfo->size,
|
|
;; asctime(LocalTime(&t)));
|
|
;;
|
|
;; in Samba 1.9, there's the following code:
|
|
;;
|
|
;; DEBUG(0,(" %-30s%7.7s%10d %s",
|
|
;; CNV_LANG(finfo->name),
|
|
;; attrib_string(finfo->mode),
|
|
;; finfo->size,
|
|
;; asctime(LocalTime(&t))));
|
|
;;
|
|
;; Problems:
|
|
;; * Modern regexp constructs, like spy groups and counted repetitions, aren't
|
|
;; available in older Emacsen.
|
|
;; * The length of constructs (file name, size) might exceed the default.
|
|
;; * File names might contain spaces.
|
|
;; * Permissions might be empty.
|
|
;;
|
|
;; So we try to analyze backwards.
|
|
(defun tramp-smb-read-file-entry (share)
|
|
"Parse entry in SMB output buffer.
|
|
If SHARE is result, entries are of type dir. Otherwise, shares are listed.
|
|
Result is the list (LOCALNAME MODE SIZE MTIME)."
|
|
(let ((line (buffer-substring (point) (tramp-point-at-eol)))
|
|
localname mode size month day hour min sec year mtime)
|
|
|
|
(if (not share)
|
|
|
|
; Read share entries
|
|
(when (string-match "^\\s-+\\(\\S-+\\)\\s-+Disk" line)
|
|
(setq localname (match-string 1 line)
|
|
mode "dr-xr-xr-x"
|
|
size 0))
|
|
|
|
; Real listing
|
|
(block nil
|
|
|
|
;; year
|
|
(if (string-match "\\([0-9]+\\)$" line)
|
|
(setq year (string-to-number (match-string 1 line))
|
|
line (substring line 0 -5))
|
|
(return))
|
|
|
|
;; time
|
|
(if (string-match "\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)$" line)
|
|
(setq hour (string-to-number (match-string 1 line))
|
|
min (string-to-number (match-string 2 line))
|
|
sec (string-to-number (match-string 3 line))
|
|
line (substring line 0 -9))
|
|
(return))
|
|
|
|
;; day
|
|
(if (string-match "\\([0-9]+\\)$" line)
|
|
(setq day (string-to-number (match-string 1 line))
|
|
line (substring line 0 -3))
|
|
(return))
|
|
|
|
;; month
|
|
(if (string-match "\\(\\w+\\)$" line)
|
|
(setq month (match-string 1 line)
|
|
line (substring line 0 -4))
|
|
(return))
|
|
|
|
;; weekday
|
|
(if (string-match "\\(\\w+\\)$" line)
|
|
(setq line (substring line 0 -5))
|
|
(return))
|
|
|
|
;; size
|
|
(if (string-match "\\([0-9]+\\)$" line)
|
|
(let ((length (- (max 10 (1+ (length (match-string 1 line)))))))
|
|
(setq size (string-to-number (match-string 1 line)))
|
|
(when (string-match "\\([ADHRSV]+\\)" (substring line length))
|
|
(setq length (+ length (match-end 0))))
|
|
(setq line (substring line 0 length)))
|
|
(return))
|
|
|
|
;; mode: ARCH, DIR, HIDDEN, RONLY, SYSTEM, VOLID
|
|
(if (string-match "\\([ADHRSV]+\\)?$" line)
|
|
(setq
|
|
mode (or (match-string 1 line) "")
|
|
mode (save-match-data (format
|
|
"%s%s"
|
|
(if (string-match "D" mode) "d" "-")
|
|
(mapconcat
|
|
(lambda (x) "") " "
|
|
(concat "r" (if (string-match "R" mode) "-" "w") "x"))))
|
|
line (substring line 0 -7))
|
|
(return))
|
|
|
|
;; localname
|
|
(if (string-match "^\\s-+\\(\\S-\\(.*\\S-\\)?\\)\\s-*$" line)
|
|
(setq localname (match-string 1 line))
|
|
(return))))
|
|
|
|
(when (and localname mode size)
|
|
(setq mtime
|
|
(if (and sec min hour day month year)
|
|
(encode-time
|
|
sec min hour day
|
|
(cdr (assoc (downcase month) tramp-smb-parse-time-months))
|
|
year)
|
|
'(0 0)))
|
|
(list localname mode size mtime))))
|
|
|
|
;; Inodes don't exist for SMB files. Therefore we must generate virtual ones.
|
|
;; Used in `find-buffer-visiting'.
|
|
;; The method applied might be not so efficient (Ange-FTP uses hashes). But
|
|
;; performance isn't the major issue given that file transfer will take time.
|
|
|
|
(defun tramp-smb-get-inode (share file)
|
|
"Returns the virtual inode number.
|
|
If it doesn't exist, generate a new one."
|
|
(let ((string (concat share "/" (directory-file-name file))))
|
|
(unless (assoc string tramp-smb-inodes)
|
|
(add-to-list 'tramp-smb-inodes
|
|
(list string (length tramp-smb-inodes))))
|
|
(nth 1 (assoc string tramp-smb-inodes))))
|
|
|
|
|
|
;; Connection functions
|
|
|
|
(defun tramp-smb-send-command (user host command)
|
|
"Send the COMMAND to USER at HOST (logged into an SMB session).
|
|
Erases temporary buffer before sending the command. Returns nil if
|
|
there has been an error message from smbclient."
|
|
(save-excursion
|
|
(set-buffer (tramp-get-buffer nil tramp-smb-method user host))
|
|
(erase-buffer)
|
|
(tramp-send-command nil tramp-smb-method user host command nil t)
|
|
(tramp-smb-wait-for-output user host)))
|
|
|
|
(defun tramp-smb-maybe-open-connection (user host share)
|
|
"Maybe open a connection to HOST, logging in as USER, using `tramp-smb-program'.
|
|
Does not do anything if a connection is already open, but re-opens the
|
|
connection if a previous connection has died for some reason."
|
|
(let ((process-connection-type tramp-process-connection-type)
|
|
(p (get-buffer-process
|
|
(tramp-get-buffer nil tramp-smb-method user host))))
|
|
(save-excursion
|
|
(set-buffer (tramp-get-buffer nil tramp-smb-method user host))
|
|
;; Check whether it is still the same share
|
|
(unless (and p (processp p) (string-equal tramp-smb-share share))
|
|
(when (and p (processp p))
|
|
(delete-process p)
|
|
(setq p nil)))
|
|
;; If too much time has passed since last command was sent, look
|
|
;; whether process is still alive. If it isn't, kill it.
|
|
(when (and tramp-last-cmd-time
|
|
(> (tramp-time-diff (current-time) tramp-last-cmd-time) 60)
|
|
p (processp p) (memq (process-status p) '(run open)))
|
|
(unless (and p (processp p) (memq (process-status p) '(run open)))
|
|
(delete-process p)
|
|
(setq p nil))))
|
|
(unless (and p (processp p) (memq (process-status p) '(run open)))
|
|
(when (and p (processp p))
|
|
(delete-process p))
|
|
(tramp-smb-open-connection user host share))))
|
|
|
|
(defun tramp-smb-open-connection (user host share)
|
|
"Open a connection using `tramp-smb-program'.
|
|
This starts the command `smbclient //HOST/SHARE -U USER', then waits
|
|
for a remote password prompt. It queries the user for the password,
|
|
then sends the password to the remote host.
|
|
|
|
Domain names in USER and port numbers in HOST are acknowledged."
|
|
|
|
(save-match-data
|
|
(let* ((buffer (tramp-get-buffer nil tramp-smb-method user host))
|
|
(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)))
|
|
|
|
(if share
|
|
(setq args (list (concat "//" real-host "/" share)))
|
|
(setq args (list "-L" real-host )))
|
|
|
|
(if real-user
|
|
(setq args (append args (list "-U" real-user)))
|
|
(setq args (append args (list "-N"))))
|
|
|
|
(when domain (setq args (append args (list "-W" domain))))
|
|
(when port (setq args (append args (list "-p" port))))
|
|
|
|
; OK, let's go
|
|
(tramp-pre-connection nil tramp-smb-method user host)
|
|
(tramp-message 7 "Opening connection for //%s@%s/%s..."
|
|
user host (or share ""))
|
|
|
|
(let* ((default-directory (tramp-temporary-file-directory))
|
|
;; If we omit the conditional here, then we would use
|
|
;; `undecided-dos' in some cases. With the conditional,
|
|
;; we use nil in these cases. Which one is right?
|
|
(coding-system-for-read (unless (and (not (featurep 'xemacs))
|
|
(> emacs-major-version 20))
|
|
tramp-dos-coding-system))
|
|
(p (apply #'start-process (buffer-name buffer) buffer
|
|
tramp-smb-program args)))
|
|
|
|
(tramp-message 9 "Started process %s" (process-command p))
|
|
(process-kill-without-query p)
|
|
(set-buffer buffer)
|
|
(setq tramp-smb-share share)
|
|
|
|
; send password
|
|
(when real-user
|
|
(let ((pw-prompt "Password:"))
|
|
(tramp-message 9 "Sending password")
|
|
(tramp-enter-password p pw-prompt)))
|
|
|
|
(unless (tramp-smb-wait-for-output user host)
|
|
(tramp-clear-passwd user host)
|
|
(error "Cannot open connection //%s@%s/%s"
|
|
user host (or share "")))))))
|
|
|
|
;; We don't use timeouts. If needed, the caller shall wrap around.
|
|
(defun tramp-smb-wait-for-output (user host)
|
|
"Wait for output from smbclient command.
|
|
Returns nil if an error message has appeared."
|
|
(let ((proc (get-buffer-process (current-buffer)))
|
|
(found (progn (goto-char (point-min))
|
|
(re-search-forward tramp-smb-prompt nil t)))
|
|
(err (progn (goto-char (point-min))
|
|
(re-search-forward tramp-smb-errors nil t))))
|
|
|
|
;; Algorithm: get waiting output. See if last line contains
|
|
;; tramp-smb-prompt sentinel or tramp-smb-errors strings.
|
|
;; If not, wait a bit and again get waiting output.
|
|
(while (and (not found) (not err))
|
|
|
|
;; Accept pending output.
|
|
(accept-process-output proc)
|
|
|
|
;; Search for prompt.
|
|
(goto-char (point-min))
|
|
(setq found (re-search-forward tramp-smb-prompt nil t))
|
|
|
|
;; Search for errors.
|
|
(goto-char (point-min))
|
|
(setq err (re-search-forward tramp-smb-errors nil t)))
|
|
|
|
;; Add output to debug buffer if appropriate.
|
|
(when tramp-debug-buffer
|
|
(append-to-buffer
|
|
(tramp-get-debug-buffer nil tramp-smb-method user host)
|
|
(point-min) (point-max)))
|
|
|
|
;; Return value is whether no error message has appeared.
|
|
(not err)))
|
|
|
|
|
|
;; Snarfed code from time-date.el and parse-time.el
|
|
|
|
(defconst tramp-smb-half-a-year '(241 17024)
|
|
"Evaluated by \"(days-to-time 183)\".")
|
|
|
|
(defconst tramp-smb-parse-time-months '(("jan" . 1) ("feb" . 2) ("mar" . 3)
|
|
("apr" . 4) ("may" . 5) ("jun" . 6)
|
|
("jul" . 7) ("aug" . 8) ("sep" . 9)
|
|
("oct" . 10) ("nov" . 11) ("dec" . 12))
|
|
"Alist mapping month names to integers.")
|
|
|
|
(defun tramp-smb-time-less-p (t1 t2)
|
|
"Say whether time value T1 is less than time value T2."
|
|
(unless t1 (setq t1 '(0 0)))
|
|
(unless t2 (setq t2 '(0 0)))
|
|
(or (< (car t1) (car t2))
|
|
(and (= (car t1) (car t2))
|
|
(< (nth 1 t1) (nth 1 t2)))))
|
|
|
|
(defun tramp-smb-time-subtract (t1 t2)
|
|
"Subtract two time values.
|
|
Return the difference in the format of a time value."
|
|
(unless t1 (setq t1 '(0 0)))
|
|
(unless t2 (setq t2 '(0 0)))
|
|
(let ((borrow (< (cadr t1) (cadr t2))))
|
|
(list (- (car t1) (car t2) (if borrow 1 0))
|
|
(- (+ (if borrow 65536 0) (cadr t1)) (cadr t2)))))
|
|
|
|
|
|
;; `PC-do-completion' touches the returning "$$" by `substitute-in-file-name'.
|
|
;; Must be corrected.
|
|
|
|
(defadvice PC-do-completion (around tramp-smb-advice-PC-do-completion activate)
|
|
"Changes \"$\" back to \"$$\" in minibuffer."
|
|
(if (funcall PC-completion-as-file-name-predicate)
|
|
|
|
(progn
|
|
;; Substitute file names
|
|
(let* ((beg (or (and (functionp 'minibuffer-prompt-end) ; Emacs 21
|
|
(funcall 'minibuffer-prompt-end))
|
|
(point-min)))
|
|
(end (point-max))
|
|
(str (substitute-in-file-name (buffer-substring beg end))))
|
|
(delete-region beg end)
|
|
(insert str)
|
|
(ad-set-arg 2 (point)))
|
|
|
|
;; Do `PC-do-completion' without substitution
|
|
(let* (save)
|
|
(fset 'save (symbol-function 'substitute-in-file-name))
|
|
(fset 'substitute-in-file-name (symbol-function 'identity))
|
|
ad-do-it
|
|
(fset 'substitute-in-file-name (symbol-function 'save)))
|
|
|
|
;; Expand "$"
|
|
(let* ((beg (or (and (functionp 'minibuffer-prompt-end) ; Emacs 21
|
|
(funcall 'minibuffer-prompt-end))
|
|
(point-min)))
|
|
(end (point-max))
|
|
(str (buffer-substring beg end)))
|
|
(delete-region beg end)
|
|
(insert (if (string-match "\\(\\$\\)\\(/\\|$\\)" str)
|
|
(replace-match "$$" nil nil str 1)
|
|
str))))
|
|
|
|
;; No file names. Behave unchanged.
|
|
ad-do-it))
|
|
|
|
(provide 'tramp-smb)
|
|
|
|
;;; TODO:
|
|
|
|
;; * Provide a local smb.conf. The default one might not be readable.
|
|
;; * Error handling in case password is wrong.
|
|
;; * Read password from "~/.netrc".
|
|
;; * Return more comprehensive file permission string. Think whether it is
|
|
;; possible to implement `set-file-modes'.
|
|
;; * Handle WILDCARD and FULL-DIRECTORY-P in
|
|
;; `tramp-smb-handle-insert-directory'.
|
|
;; * Handle links (FILENAME.LNK).
|
|
;; * Maybe local tmp files should have the same extension like the original
|
|
;; files. Strange behaviour with jka-compr otherwise?
|
|
;; * Copy files in dired from SMB to another method doesn't work.
|
|
;; * Try to remove the inclusion of dummy "" directory. Seems to be at
|
|
;; several places, especially in `tramp-smb-handle-insert-directory'.
|
|
;; * Provide variables for debug.
|
|
;; * (RMS) Use unwind-protect to clean up the state so as to make the state
|
|
;; regular again.
|
|
|
|
;;; arch-tag: fcc9dbec-7503-4d73-b638-3c8aa59575f5
|
|
;;; tramp-smb.el ends here
|