Commit 4007ba5b authored by Kai Großjohann's avatar Kai Großjohann
Browse files

* net/tramp*.el: Sync with upstream version 2.0.28. Bugfixes.

* net/tramp-ftp.el: Glue code with Ange-FTP, broken out of
tramp.el.  From Michael Albinus.
* net/tramp-smb.el: New file for using smbclient to access
Windows shares with Tramp.  From Michael Albinus.
parent 9ddf362e
2002-12-26 Kai Gro,A_(Bjohann <kai.grossjohann@uni-duisburg.de>
* net/tramp*.el: Sync with upstream version 2.0.28. Bugfixes.
* net/tramp-ftp.el: Glue code with Ange-FTP, broken out of
tramp.el. From Michael Albinus.
* net/tramp-smb.el: New file for using smbclient to access
Windows shares with Tramp. From Michael Albinus.
2002-12-26 Andreas Schwab <schwab@suse.de>
* international/mule-cmds.el (select-safe-coding-system): Fix
......
;;; tramp-ftp.el --- Tramp convenience functions for Ange-FTP and EFS -*- coding: iso-8859-1; -*-
;; Copyright (C) 2002 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:
;; Convenience functions for calling Ange-FTP (and maybe EFS, later on)
;; from Tramp. Most of them are displaced from tramp.el
;;; Code:
(require 'tramp)
(eval-when-compile
(require 'cl)
(require 'custom)
;; Emacs 19.34 compatibility hack -- is this needed?
(or (>= emacs-major-version 20)
(load "cl-seq")))
;; Disable Ange-FTP from file-name-handler-alist.
;; To handle EFS, the following functions need to be dealt with:
;;
;; * dired-before-readin-hook contains efs-dired-before-readin
;; * file-name-handler-alist contains efs-file-handler-function
;; and efs-root-handler-function and efs-sifn-handler-function
;; * find-file-hooks contains efs-set-buffer-mode
;;
;; But it won't happen for EFS since the XEmacs maintainers
;; don't want to use a unified filename syntax.
(defun tramp-disable-ange-ftp ()
"Turn Ange-FTP off.
This is useful for unified remoting. See
`tramp-file-name-structure-unified' and
`tramp-file-name-structure-separate' for details. Requests suitable
for Ange-FTP will be forwarded to Ange-FTP. Also see the variables
`tramp-ftp-method', `tramp-default-method', and
`tramp-default-method-alist'.
This function is not needed in Emacsen which include Tramp, but is
present for backward compatibility."
(let ((a1 (rassq 'ange-ftp-hook-function file-name-handler-alist))
(a2 (rassq 'ange-ftp-completion-hook-function file-name-handler-alist)))
(setq file-name-handler-alist
(delete a1 (delete a2 file-name-handler-alist)))))
(tramp-disable-ange-ftp)
;; Define FTP method ...
(defcustom tramp-ftp-method "ftp"
"*When this method name is used, forward all calls to Ange-FTP."
:group 'tramp
:type 'string)
;; ... and add it to the method list.
(add-to-list 'tramp-methods (cons tramp-ftp-method nil))
;; Add some defaults for `tramp-default-method-alist'
(add-to-list 'tramp-default-method-alist
'("\\`ftp\\." "" tramp-ftp-method))
(add-to-list 'tramp-default-method-alist
'("" "\\`\\(anonymous\\|ftp\\)\\'" tramp-ftp-method))
;; Add completion function for FTP method.
(unless (memq system-type '(windows-nt))
(tramp-set-completion-function
tramp-ftp-method
'((tramp-parse-netrc "~/.netrc"))))
(defun tramp-ftp-file-name-handler (operation &rest args)
"Invoke the Ange-FTP handler for OPERATION.
First arg specifies the OPERATION, second arg is a list of arguments to
pass to the OPERATION."
(save-match-data
(or (boundp 'ange-ftp-name-format)
(and (require 'ange-ftp)
(tramp-disable-ange-ftp)))
(let* ((ange-ftp-name-format
(list (nth 0 tramp-file-name-structure)
(nth 3 tramp-file-name-structure)
(nth 2 tramp-file-name-structure)
(nth 4 tramp-file-name-structure)))
(inhibit-file-name-handlers
(list 'tramp-file-name-handler
'tramp-completion-file-name-handler
(and (eq inhibit-file-name-operation operation)
inhibit-file-name-handlers)))
(inhibit-file-name-operation operation))
(apply 'ange-ftp-hook-function operation args))))
(defun tramp-ftp-file-name-p (filename)
"Check if it's a filename that should be forwarded to Ange-FTP."
(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-ftp-method)))
(add-to-list 'tramp-foreign-file-name-handler-alist
(cons 'tramp-ftp-file-name-p 'tramp-ftp-file-name-handler))
(provide 'tramp-ftp)
;;; TODO:
;; * In case of "/ftp:host:file" this works only for functions which
;; are defined in `tramp-file-name-handler-alist'. Call has to be
;; pretended in `tramp-file-name-handler' otherwise. Looks like
;; `ange-ftp-completion-hook-function' and `ange-ftp-hook-function'
;; are active temporarily in `file-name-handler-alist'.
;; Furthermore, there are no backup files on FTP hosts this case.
;; Worth further investigations.
;;; tramp-ftp.el ends here
;;; tramp-smb.el --- Tramp access functions for SMB servers -*- coding: iso-8859-1; -*-
;; Copyright (C) 2002 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")))
;; 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
'("%" "" 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-+> "
"Regexp used as prompt in smbclient.")
(defconst tramp-smb-errors
(mapconcat
'identity
'(; Connection error
"Connection to \\S-+ failed"
; Samba
"ERRSRV"
"ERRDOS"
"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_BAD_NETWORK_NAME"
"NT_STATUS_CANNOT_DELETE"
"NT_STATUS_LOGON_FAILURE"
"NT_STATUS_NO_SUCH_FILE"
"NT_STATUS_OBJECT_NAME_INVALID"
"NT_STATUS_OBJECT_NAME_NOT_FOUND"
"NT_STATUS_SHARING_VIOLATION")
"\\|")
"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-process-running nil
"Flag whether a corresponding process is still running.
Will be changed by corresponding `process-sentinel'.
This variable is local to each buffer.")
(make-variable-buffer-local 'tramp-smb-process-running)
;; 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' performed by default handler
(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' performed by default handler
;; `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 path)
(with-parsed-tramp-file-name newname l
(setq user l-user host l-host path l-path))
(save-excursion
(let ((share (tramp-smb-get-share path))
(file (tramp-smb-get-path path 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 path)
(with-parsed-tramp-file-name directory l
(setq user l-user host l-host path l-path))
(save-excursion
(let ((share (tramp-smb-get-share path))
(dir (tramp-smb-get-path (file-name-directory path) t))
(file (file-name-nondirectory path)))
(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 path)
(with-parsed-tramp-file-name filename l
(setq user l-user host l-host path l-path))
(save-excursion
(let ((share (tramp-smb-get-share path))
(dir (tramp-smb-get-path (file-name-directory path) t))
(file (file-name-nondirectory path)))
(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'" directory))))))
(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 path)
(with-parsed-tramp-file-name directory l
(setq user l-user host l-host path l-path))
(save-excursion
(let* ((share (tramp-smb-get-share path))
(file (tramp-smb-get-path path 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 paths 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)
"Like `directory-files-and-attributes' for tramp files."
(mapcar
(lambda (x)
(cons x (file-attributes
(if full x (concat (file-name-as-directory directory) x)))))
(directory-files directory full match nosort)))
(defun tramp-smb-handle-file-attributes (filename &optional nonnumeric)
"Like `file-attributes' for tramp files.
Optional argument NONNUMERIC means return user and group name
rather than as numbers."
; (with-parsed-tramp-file-name filename nil
(let (user host path)
(with-parsed-tramp-file-name filename l
(setq user l-user host l-host path l-path))
(save-excursion
(let* ((share (tramp-smb-get-share path))
(file (tramp-smb-get-path path nil))
(entries (tramp-smb-get-file-entries user host share file))
(entry (and entries
(assoc (file-name-nondirectory file) entries))))
; check result
(when entry
(list (and (string-match "d" (nth 1 entry))
t) ;0 file type
-1 ;1 link count
-1 ;2 uid
-1 ;3 gid
(nth 3 entry) ;4 atime
(nth 3 entry) ;5 mtime
(nth 3 entry) ;6 ctime
(nth 2 entry) ;7 size
(nth 1 entry) ;8 mode
nil ;9 gid weird
-1 ;10 inode number
-1)))))) ;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 path)
(with-parsed-tramp-file-name filename l
(setq user l-user host l-host path l-path))
(save-excursion
(let* ((share (tramp-smb-get-share path))
(file (tramp-smb-get-path path 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 path)
(with-parsed-tramp-file-name filename l
(setq user l-user host l-host path l-path))
(save-excursion
(let* ((share (tramp-smb-get-share path))
(file (tramp-smb-get-path path 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 path))
(file (tramp-smb-get-path path 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 path)
(with-parsed-tramp-file-name directory l
(setq user l-user host l-host path l-path))
(save-match-data
(save-excursion
(let* ((share (tramp-smb-get-share path))
(file (tramp-smb-get-path path 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."
; (with-parsed-tramp-file-name filename nil
(let (user host path)
(with-parsed-tramp-file-name filename l
(setq user l-user host l-host path l-path))
(save-excursion
(let* ((share (tramp-smb-get-share path))
(file (tramp-smb-get-path path nil))
(entries (tramp-smb-get-file-entries user host share file))
(entry (and entries
(assoc (file-name-nondirectory file) entries))))
(and 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 path)
(with-parsed-tramp-file-name filename l
(setq user l-user host l-host path l-path))
(save-match-data