Mercurial > emacs
changeset 48973:09acf3f65bb5
* net/tramp*.el: Sync with upstream version 2.0.28. Bugfixes.
* net/tramp-ftp.el: Glue code with Ange-FTP, broken out of
tramp.el. From Michael Albinus.
* net/tramp-smb.el: New file for using smbclient to access
Windows shares with Tramp. From Michael Albinus.
| author | Kai Großjohann <kgrossjo@eu.uu.net> |
|---|---|
| date | Thu, 26 Dec 2002 20:47:51 +0000 |
| parents | 2d4e1ccc9f01 |
| children | d29e4e3d4f5d |
| files | lisp/ChangeLog lisp/net/tramp-ftp.el lisp/net/tramp-smb.el lisp/net/tramp-util.el lisp/net/tramp-uu.el lisp/net/tramp-vc.el lisp/net/tramp.el |
| diffstat | 7 files changed, 1562 insertions(+), 339 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ChangeLog Thu Dec 26 17:29:06 2002 +0000 +++ b/lisp/ChangeLog Thu Dec 26 20:47:51 2002 +0000 @@ -1,3 +1,11 @@ +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
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/net/tramp-ftp.el Thu Dec 26 20:47:51 2002 +0000 @@ -0,0 +1,136 @@ +;;; 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
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/net/tramp-smb.el Thu Dec 26 20:47:51 2002 +0000 @@ -0,0 +1,1102 @@ +;;; 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 + (let* ((share (tramp-smb-get-share path)) + (file (tramp-smb-get-path path 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 path) + (with-parsed-tramp-file-name dir l + (setq user l-user host l-host path l-path)) + (save-match-data + (let* ((share (tramp-smb-get-share path)) + (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) + (tramp-smb-handle-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 ldir (concat default-directory 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-match-data + (let* ((share (tramp-smb-get-share path)) + (file (tramp-smb-get-path path 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 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))) + (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 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 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 (path) + "Returns the share name of PATH." + (save-match-data + (when (string-match "^/?\\([^/]+\\)/" path) + (match-string 1 path)))) + +(defun tramp-smb-get-path (path convert) + "Returns the file name of PATH. +If CONVERT is non-nil exchange \"/\" by \"\\\\\"." + (save-match-data + (let ((res path)) + + (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 path) + "Read entries which match PATH. +Either the shares are listed, or the `dir' command is executed. +Only entries matching the path are returned. +Result is a list of (PATH MODE SIZE MONTH DAY TIME YEAR)." + (save-excursion + (save-match-data + (let ((base (or (and (> (length path) 0) + (string-match "\\([^/]+\\)$" path) + (regexp-quote (match-string 1 path))) + "")) + 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 path)) "" (concat "\"" path "*\""))))) + (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 '("" "dr-xr-xr-x" 0 (0 0))) + + ;; 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, 32 chars, left bound +;; \s- - space delimeter +;; \s-*[ADHRS]* - permissions, 5 chars, right bound +;; \s- - space delimeter +;; \s-*[0-9]+ - size, 8 (Samba) or 7 (Windows) +;; chars, right bound +;; \s-\{2,2\} - space delimeter +;; \w\{3,3\} - weekday +;; \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 +;; +;; 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 (PATH MODE SIZE MTIME)." + (let ((line (buffer-substring (point) (tramp-point-at-eol))) + path mode size month day hour min sec year mtime) + + (if (not share) + + ; Read share entries + (when (string-match "^\\s-+\\(\\S-+\\)\\s-+Disk" line) + (setq path (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) + (setq size (match-string 1 line) + line (substring line 0 (- (max 8 (1+ (length size)))))) + (return)) + + ;; mode + (if (string-match "\\(\\([ADHRS]+\\)?\\s-?\\)$" line) + (setq + mode (or (match-string 2 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 (- (1+ (length (match-string 2 line)))))) + (return)) + + ;; path + (if (string-match "^\\s-+\\(\\S-\\(.*\\S-\\)?\\)\\s-+$" line) + (setq path (match-string 1 line)) + (return)))) + + (when (and path 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 path mode size mtime)))) + + +;; 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 ((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) + (set-process-sentinel + p (lambda (proc str) (setq tramp-smb-process-running nil))) + ; If no share is given, the process will terminate + (setq tramp-smb-process-running share + 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) + (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. +Sets position to begin of buffer. +Returns nil if an error message has appeared." + (save-excursion + (let ((proc (get-buffer-process (current-buffer))) + (found (progn (goto-char (point-max)) + (beginning-of-line) + (looking-at tramp-smb-prompt))) + err) + (save-match-data + ;; Algorithm: get waiting output. See if last line contains + ;; tramp-smb-prompt sentinel, or process has exited. + ;; If not, wait a bit and again get waiting output. + (while (and (not found) tramp-smb-process-running) + (accept-process-output proc) + (goto-char (point-max)) + (beginning-of-line) + (setq found (looking-at tramp-smb-prompt))) + + ;; There might be pending output. If tramp-smb-prompt sentinel + ;; hasn't been found, the process has died already. We should + ;; give it a chance. + (when (not found) (accept-process-output nil 1)) + + ;; 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)) + (when (and (not found) tramp-smb-process-running) + (save-excursion + (set-buffer + (tramp-get-debug-buffer nil tramp-smb-method user host)) + (goto-char (point-max)) + (insert (format "[[Remote prompt `%s' not found]]\n" + tramp-smb-prompt))))) + (goto-char (point-min)) + ;; 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". +;; * Use different buffers for different shares. By this, the password +;; won't be requested again when changing shares on the same host. +;; * 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. + +;;; tramp-smb.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/net/tramp-util.el Thu Dec 26 20:47:51 2002 +0000 @@ -0,0 +1,54 @@ +;;; tramp-util.el --- Misc utility functions to use with Tramp + +;; Copyright (C) 2001 Free Software Foundation, Inc. + +;; Author: Kai Großjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE> +;; Keywords: comm, extensions, processes + +;; This file 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. + +;; This file 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: + +;; Some misc. utility functions that might go nicely with Tramp. +;; Mostly, these are kluges awaiting real solutions later on. + +;;; Code: + +(eval-when-compile (require 'cl)) +(require 'compile) +(require 'tramp) + +(defun tramp-compile (command) + "Compile on remote host." + (interactive + (if (or compilation-read-command current-prefix-arg) + (list (read-from-minibuffer "Compile command: " + compile-command nil nil + '(compile-history . 1))) + (list compile-command))) + (setq compile-command command) + (save-some-buffers (not compilation-ask-about-save) nil) + (let ((d default-directory)) + (save-excursion + (pop-to-buffer (get-buffer-create "*Compilation*") t) + (erase-buffer) + (setq default-directory d))) + (tramp-handle-shell-command command (get-buffer "*Compilation*")) + (pop-to-buffer (get-buffer "*Compilation*")) + (compilation-minor-mode 1)) + +(provide 'tramp-util) +;;; tramp-util.el ends here
--- a/lisp/net/tramp-uu.el Thu Dec 26 17:29:06 2002 +0000 +++ b/lisp/net/tramp-uu.el Thu Dec 26 20:47:51 2002 +0000 @@ -36,7 +36,7 @@ (mapcar (lambda (c) (prog1 (cons c i) - (incf i))) + (setq i (1+ i)))) tramp-uu-b64-alphabet)) "Alist of mapping from base64 character to its byte.") @@ -65,7 +65,7 @@ ;; "=" means padding. Insert "`" instead. (insert "`") (insert (tramp-uu-byte-to-uu-char (tramp-uu-b64-char-to-byte c)))) - (incf i) + (setq i (1+ i)) ;; Every 60 characters, add "M" at beginning of line (as ;; length byte) and insert a newline. (when (zerop (% i 60))
--- a/lisp/net/tramp-vc.el Thu Dec 26 17:29:06 2002 +0000 +++ b/lisp/net/tramp-vc.el Thu Dec 26 20:47:51 2002 +0000 @@ -136,7 +136,8 @@ (goto-char (point-max)) (set-buffer-modified-p nil) (forward-line -1) - (if (or (not (integerp status)) (and okstatus (< okstatus status))) + (if (or (not (integerp status)) + (and (integerp okstatus) (< okstatus status))) (progn (pop-to-buffer buffer) (goto-char (point-min)) @@ -174,14 +175,16 @@ (path (when file (tramp-file-name-path v)))) (setq squeezed (delq nil (copy-sequence flags))) (when file - (setq squeezed (append squeezed (list path)))) + (setq squeezed (append squeezed (list (file-relative-name + file default-directory))))) (let ((w32-quote-process-args t)) (when (eq okstatus 'async) (message "Tramp doesn't do async commands, running synchronously.")) (setq status (tramp-handle-shell-command (mapconcat 'tramp-shell-quote-argument (cons command squeezed) " ") t)) - (when (or (not (integerp status)) (and okstatus (< okstatus status))) + (when (or (not (integerp status)) + (and (integerp okstatus) (< okstatus status))) (pop-to-buffer (current-buffer)) (goto-char (point-min)) (shrink-window-if-larger-than-buffer) @@ -281,6 +284,9 @@ (setq exec-status (read (current-buffer))) (message "Command %s returned status %d." command exec-status))) + ;; Maybe okstatus can be `async' here. But then, maybe the + ;; async thing is new in Emacs 21, but this function is only + ;; used in Emacs 20. (cond ((> exec-status okstatus) (switch-to-buffer (get-file-buffer file)) (shrink-window-if-larger-than-buffer
--- a/lisp/net/tramp.el Thu Dec 26 17:29:06 2002 +0000 +++ b/lisp/net/tramp.el Thu Dec 26 20:47:51 2002 +0000 @@ -1,6 +1,6 @@ ;;; tramp.el --- Transparent Remote Access, Multiple Protocol -*- coding: iso-8859-1; -*- -;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc. ;; Author: Kai.Grossjohann@CS.Uni-Dortmund.DE ;; Keywords: comm, processes @@ -72,7 +72,7 @@ ;; In the Tramp CVS repository, the version numer is auto-frobbed from ;; the Makefile, so you should edit the top-level Makefile to change ;; the version number. -(defconst tramp-version "2.0.25" +(defconst tramp-version "2.0.28" "This version of tramp.") (defconst tramp-bug-report-address "tramp-devel@mail.freesoftware.fsf.org" @@ -99,6 +99,22 @@ ;; (when (fboundp 'efs-file-handler-function) ;; (require 'efs)) +;; Load foreign methods. Because they do require Tramp internally, this +;; must be done with the `eval-after-load' trick. + +;; tramp-ftp supports Ange-FTP only. Not suited for XEmacs therefore. +(unless (featurep 'xemacs) + (eval-after-load "tramp" + '(require 'tramp-ftp))) + +;; tramp-smb uses "smbclient" from Samba. +;; Not available under Cygwin and Windows, because they don't offer +;; "smbclient". And even not necessary there, because Emacs supports +;; UNC file names like "//host/share/path". +(unless (memq system-type '(cygwin windows-nt)) + (eval-after-load "tramp" + '(require 'tramp-smb))) + (eval-when-compile (require 'cl) (require 'custom) @@ -618,20 +634,12 @@ (defcustom tramp-default-method "ssh" "*Default method to use for transferring files. See `tramp-methods' for possibilities. -Also see `tramp-default-method-alist'. - -Emacs uses a unified filename syntax for Tramp and Ange-FTP. -For backward compatibility, the default value of this variable -is \"ftp\" on Emacs. But XEmacs uses a separate filename syntax -for Tramp and EFS, so there the default method is \"sm\"." +Also see `tramp-default-method-alist'." :group 'tramp :type 'string) (defcustom tramp-default-method-alist - (when tramp-unified-filenames - '(("\\`ftp\\." "" "ftp") - ("" "\\`\\(anonymous\\|ftp\\)\\'" "ftp") - ("\\`localhost\\'" "\\`root\\'" "su"))) + '(("\\`localhost\\'" "\\`root\\'" "su")) "*Default method to use for specific user/host pairs. This is an alist of items (HOST USER METHOD). The first matching item specifies the method to use for a file name which does not specify a @@ -648,11 +656,6 @@ (regexp :tag "User regexp") (string :tag "Method")))) -(defcustom tramp-ftp-method "ftp" - "*When this method name is used, forward all calls to Ange-FTP." - :group 'tramp - :type 'string) - ;; Default values for non-Unices seeked (defconst tramp-completion-function-alist-rsh (unless (memq system-type '(windows-nt)) @@ -687,13 +690,6 @@ "Default list of (FUNCTION FILE) pairs to be examined for su methods." ) -;; Default values for non-Unices seeked -(defconst tramp-completion-function-alist-ftp - (unless (memq system-type '(windows-nt)) - '((tramp-parse-netrc "~/.netrc"))) - "Default list of (FUNCTION FILE) pairs to be examined for ftp methods." -) - (defcustom tramp-completion-function-alist (list (cons "rcp" tramp-completion-function-alist-rsh) (cons "scp" tramp-completion-function-alist-ssh) @@ -718,7 +714,6 @@ (cons "plink" tramp-completion-function-alist-ssh) (cons "pscp" tramp-completion-function-alist-ssh) (cons "fcp" tramp-completion-function-alist-ssh) - (cons "ftp" tramp-completion-function-alist-ftp) ) "*Alist of methods for remote files. This is a list of entries of the form (NAME PAIR1 PAIR2 ...). @@ -730,7 +725,7 @@ * `tramp-parse-shosts' for \"ssh_known_hosts\" like files, * `tramp-parse-hosts' for \"/etc/hosts\" like files, and * `tramp-parse-passwd' for \"/etc/passwd\" like files. - * `tramp-parse-netrc ' for \".netrc\" like files. + * `tramp-parse-netrc' for \".netrc\" like files. FUNCTION can also see a customer defined function. For more details see the info pages." @@ -870,7 +865,7 @@ :group 'tramp :type 'boolean) -(defcustom tramp-sh-extra-args '(("/bash\\'" . "--norc")) +(defcustom tramp-sh-extra-args '(("/bash\\'" . "-norc -noprofile")) "*Alist specifying extra arguments to pass to the remote shell. Entries are (REGEXP . ARGS) where REGEXP is a regular expression matching the shell file name and ARGS is a string specifying the @@ -1254,7 +1249,30 @@ the visited file modtime.") (make-variable-buffer-local 'tramp-buffer-file-attributes) -(defvar tramp-end-of-output "/////" +(defvar tramp-md5-function + (cond ((fboundp 'md5) 'md5) + ((and (require 'md5) (fboundp 'md5-encode)) 'md5-encode) + (t (error "Coulnd't find an `md5' function"))) + "Function to call for running the MD5 algorithm.") + +(defvar tramp-end-of-output + (concat "///" + (funcall tramp-md5-function + (concat + (prin1-to-string process-environment) + (current-time-string) +;; (prin1-to-string +;; (if (fboundp 'directory-files-and-attributes) +;; (funcall 'directory-files-and-attributes +;; (or (getenv "HOME") +;; (tramp-temporary-file-directory))) +;; (mapcar +;; (lambda (x) +;; (cons x (file-attributes x))) +;; (directory-files (or (getenv "HOME") +;; (tramp-temporary-file-directory)) +;; t)))) + ))) "String used to recognize end of output.") (defvar tramp-connection-function nil @@ -1622,6 +1640,12 @@ mentioned here will be handled by `tramp-file-name-handler-alist' or the normal Emacs functions.") +;; Handlers for foreign methods, like FTP or SMB, shall be plugged here. +(defvar tramp-foreign-file-name-handler-alist nil + "Alist of elements (FUNCTION . HANDLER) for foreign methods handled specially. +If (FUNCTION FILENAME) returns non-nil, then all I/O on that file is done by +calling HANDLER.") + ;;; Internal functions which must come first. (defsubst tramp-message (level fmt-string &rest args) @@ -1711,7 +1735,9 @@ (tramp-parse-shosts \"~/.ssh/known_hosts\")))" (let ((v (cdr (assoc method tramp-completion-function-alist)))) - (when v (setcdr v function-list)))) + (if v (setcdr v function-list) + (add-to-list 'tramp-completion-function-alist + (cons method function-list))))) (defun tramp-get-completion-function (method) "Returns list of completion functions for METHOD. @@ -1732,9 +1758,6 @@ this can give surprising results if the user/host for the source and target of the symlink differ." (with-parsed-tramp-file-name linkname l - (when (tramp-ange-ftp-file-name-p l-multi-method l-method l-user l-host) - (tramp-invoke-ange-ftp 'make-symbolic-link - filename linkname ok-if-already-exists)) (let ((ln (tramp-get-remote-ln l-multi-method l-method l-user l-host)) (cwd (file-name-directory l-path))) (unless ln @@ -1778,9 +1801,6 @@ (unless (file-name-absolute-p file) (error "Tramp cannot `load' files without absolute path name")) (with-parsed-tramp-file-name file nil - (when (tramp-ange-ftp-file-name-p multi-method method user host) - (tramp-invoke-ange-ftp 'load - file noerror nomessage nosuffix must-suffix)) (unless nosuffix (cond ((file-exists-p (concat file ".elc")) (setq file (concat file ".elc"))) @@ -1813,8 +1833,6 @@ "Like `file-name-directory' but aware of TRAMP files." ;; everything except the last filename thing is the directory (with-parsed-tramp-file-name file nil - (when (tramp-ange-ftp-file-name-p multi-method method user host) - (tramp-invoke-ange-ftp 'file-name-directory file)) ;; For the following condition, two possibilities should be tried: ;; (1) (string= path "") ;; (2) (or (string= path "") (string= path "/")) @@ -1839,18 +1857,11 @@ (defun tramp-handle-file-name-nondirectory (file) "Like `file-name-nondirectory' but aware of TRAMP files." (with-parsed-tramp-file-name file nil - (when (tramp-ange-ftp-file-name-p multi-method method user host) - (tramp-invoke-ange-ftp 'file-name-nondirectory file)) (file-name-nondirectory path))) (defun tramp-handle-file-truename (filename &optional counter prev-dirs) "Like `file-truename' for tramp files." (with-parsed-tramp-file-name filename nil - ;; Ange-FTP does not support truename processing, but for - ;; convenience we pretend it did and forward the call to Ange-FTP - ;; anyway. Ange-FTP then just invokes `identity'. - (when (tramp-ange-ftp-file-name-p multi-method method user host) - (tramp-invoke-ange-ftp 'file-truename filename)) (let* ((steps (tramp-split-string path "/")) (pathdir (let ((directory-sep-char ?/)) (file-name-as-directory path))) @@ -1926,8 +1937,6 @@ (defun tramp-handle-file-exists-p (filename) "Like `file-exists-p' for tramp files." (with-parsed-tramp-file-name filename nil - (when (tramp-ange-ftp-file-name-p multi-method method user host) - (tramp-invoke-ange-ftp 'file-exists-p filename)) (save-excursion (zerop (tramp-send-command-and-check multi-method method user host @@ -1944,8 +1953,6 @@ rather than as numbers." (let (result) (with-parsed-tramp-file-name filename nil - (when (tramp-ange-ftp-file-name-p multi-method method user host) - (tramp-invoke-ange-ftp 'file-attributes filename)) (when (tramp-handle-file-exists-p filename) ;; file exists, find out stuff (save-excursion @@ -2074,15 +2081,6 @@ (let ((f (buffer-file-name)) (coding-system-used nil)) (with-parsed-tramp-file-name f nil - ;; This operation is not handled by Ange-FTP! Compare this - ;; behavior with `file-truename' which Ange-FTP does not really - ;; handle, either, but at least it pretends to. I wonder if - ;; Ange-FTP should also pretend to grok - ;; `set-visited-file-modtime', for consistency? - (when (tramp-ange-ftp-file-name-p multi-method method user host) - (throw 'tramp-forward-to-ange-ftp - (tramp-run-real-handler 'set-visited-file-modtime - (list time-list)))) (let* ((attr (file-attributes f)) (modtime (nth 5 attr))) ;; We use '(0 0) as a don't-know value. See also @@ -2114,12 +2112,6 @@ (with-current-buffer buf (let ((f (buffer-file-name))) (with-parsed-tramp-file-name f nil - (when (tramp-ange-ftp-file-name-p multi-method method user host) - ;; This one requires a hack since the file name is not passed - ;; on the arg list. - (let ((buffer-file-name (tramp-make-ange-ftp-file-name - user host path))) - (tramp-invoke-ange-ftp 'verify-visited-file-modtime buf))) (let* ((attr (file-attributes f)) (modtime (nth 5 attr))) (cond ((and attr (not (equal modtime '(0 0)))) @@ -2153,8 +2145,6 @@ (defun tramp-handle-set-file-modes (filename mode) "Like `set-file-modes' for tramp files." (with-parsed-tramp-file-name filename nil - (when (tramp-ange-ftp-file-name-p multi-method method user host) - (tramp-invoke-ange-ftp 'set-file-modes mode filename)) (save-excursion (unless (zerop (tramp-send-command-and-check multi-method method user host @@ -2172,22 +2162,16 @@ (defun tramp-handle-file-executable-p (filename) "Like `file-executable-p' for tramp files." (with-parsed-tramp-file-name filename nil - (when (tramp-ange-ftp-file-name-p multi-method method user host) - (tramp-invoke-ange-ftp 'file-executable-p filename)) (zerop (tramp-run-test "-x" filename)))) (defun tramp-handle-file-readable-p (filename) "Like `file-readable-p' for tramp files." (with-parsed-tramp-file-name filename nil - (when (tramp-ange-ftp-file-name-p multi-method method user host) - (tramp-invoke-ange-ftp 'file-readable-p filename)) (zerop (tramp-run-test "-r" filename)))) (defun tramp-handle-file-accessible-directory-p (filename) "Like `file-accessible-directory-p' for tramp files." (with-parsed-tramp-file-name filename nil - (when (tramp-ange-ftp-file-name-p multi-method method user host) - (tramp-invoke-ange-ftp 'file-accessible-directory-p filename)) (and (zerop (tramp-run-test "-d" filename)) (zerop (tramp-run-test "-r" filename)) (zerop (tramp-run-test "-x" filename))))) @@ -2213,7 +2197,7 @@ (fa2 (file-attributes file2))) (if (and (not (equal (nth 5 fa1) '(0 0))) (not (equal (nth 5 fa2) '(0 0)))) - (> 0 (car (subtract-time (nth 5 fa1) (nth 5 fa2)))) + (> 0 (car (tramp-time-diff (nth 5 fa1) (nth 5 fa2)))) ;; If one of them is the dont-know value, then we can ;; still try to run a shell command on the remote host. ;; However, this only works if both files are Tramp @@ -2228,12 +2212,6 @@ file1 file2))) (with-parsed-tramp-file-name file1 v1 (with-parsed-tramp-file-name file2 v2 - (when (and (tramp-ange-ftp-file-name-p - v1-multi-method v1-method v1-user v1-host) - (tramp-ange-ftp-file-name-p - v2-multi-method v2-method v2-user v2-host)) - (tramp-invoke-ange-ftp 'file-newer-than-file-p - file1 file2)) (unless (and (equal v1-multi-method v2-multi-method) (equal v1-method v2-method) (equal v1-user v2-user) @@ -2257,11 +2235,9 @@ (defun tramp-handle-file-modes (filename) "Like `file-modes' for tramp files." (with-parsed-tramp-file-name filename nil - (when (tramp-ange-ftp-file-name-p multi-method method user host) - (tramp-invoke-ange-ftp 'file-modes filename)) (when (file-exists-p filename) (tramp-mode-string-to-int - (nth 8 (tramp-handle-file-attributes filename)))))) + (nth 8 (file-attributes filename)))))) (defun tramp-handle-file-directory-p (filename) "Like `file-directory-p' for tramp files." @@ -2274,8 +2250,6 @@ ;; ;; Alternatives: `cd %s', `test -d %s' (with-parsed-tramp-file-name filename nil - (when (tramp-ange-ftp-file-name-p multi-method method user host) - (tramp-invoke-ange-ftp 'file-directory-p filename)) (save-excursion (zerop (tramp-send-command-and-check @@ -2287,24 +2261,18 @@ (defun tramp-handle-file-regular-p (filename) "Like `file-regular-p' for tramp files." (with-parsed-tramp-file-name filename nil - (when (tramp-ange-ftp-file-name-p multi-method method user host) - (tramp-invoke-ange-ftp 'file-regular-p filename)) (and (tramp-handle-file-exists-p filename) (eq ?- (aref (nth 8 (tramp-handle-file-attributes filename)) 0))))) (defun tramp-handle-file-symlink-p (filename) "Like `file-symlink-p' for tramp files." (with-parsed-tramp-file-name filename nil - (when (tramp-ange-ftp-file-name-p multi-method method user host) - (tramp-invoke-ange-ftp 'file-symlink-p filename)) (let ((x (car (tramp-handle-file-attributes filename)))) (when (stringp x) x)))) (defun tramp-handle-file-writable-p (filename) "Like `file-writable-p' for tramp files." (with-parsed-tramp-file-name filename nil - (when (tramp-ange-ftp-file-name-p multi-method method user host) - (tramp-invoke-ange-ftp 'file-writable-p filename)) (if (tramp-handle-file-exists-p filename) ;; Existing files must be writable. (zerop (tramp-run-test "-w" filename)) @@ -2317,8 +2285,6 @@ (defun tramp-handle-file-ownership-preserved-p (filename) "Like `file-ownership-preserved-p' for tramp files." (with-parsed-tramp-file-name filename nil - (when (tramp-ange-ftp-file-name-p multi-method method user host) - (tramp-invoke-ange-ftp 'file-ownership-preserved-p filename)) (or (not (tramp-handle-file-exists-p filename)) ;; Existing files must be writable. (zerop (tramp-run-test "-O" filename))))) @@ -2337,8 +2303,6 @@ (defun tramp-handle-directory-file-name (directory) "Like `directory-file-name' for tramp files." (with-parsed-tramp-file-name directory nil - (when (tramp-ange-ftp-file-name-p multi-method method user host) - (tramp-invoke-ange-ftp 'directory-file-name directory)) (let ((directory-length-1 (1- (length directory)))) (save-match-data (if (and (eq (aref directory directory-length-1) ?/) @@ -2353,9 +2317,6 @@ &optional full match nosort files-only) "Like `directory-files' for tramp files." (with-parsed-tramp-file-name directory nil - (when (tramp-ange-ftp-file-name-p multi-method method user host) - (tramp-invoke-ange-ftp 'directory-files - directory full match nosort files-only)) (let (result x) (save-excursion (tramp-barf-unless-okay @@ -2410,9 +2371,6 @@ (defun tramp-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for tramp files." (with-parsed-tramp-file-name directory nil - (when (tramp-ange-ftp-file-name-p multi-method method user host) - (tramp-invoke-ange-ftp 'file-name-all-completions - filename directory)) (unless (save-match-data (string-match "/" filename)) (let* ((nowild tramp-completion-without-shell-p) result) @@ -2463,13 +2421,10 @@ "tramp-handle-file-name-completion invoked on non-tramp directory `%s'" directory)) (with-parsed-tramp-file-name directory nil - (when (tramp-ange-ftp-file-name-p multi-method method user host) - (tramp-invoke-ange-ftp 'file-name-completion - filename directory)) (try-completion filename (mapcar (lambda (x) (cons x nil)) - (tramp-handle-file-name-all-completions filename directory))))) + (file-name-all-completions filename directory))))) ;; cp, mv and ln @@ -2487,16 +2442,6 @@ (equal v1-host v2-host)) (error "add-name-to-file: %s" "only implemented for same method, same user, same host")) - (when (and (tramp-ange-ftp-file-name-p v1-multi-method v1-method v1-user v1-host) - (tramp-ange-ftp-file-name-p v2-multi-method v2-method v2-user v2-host)) - (tramp-invoke-ange-ftp 'add-name-to-file - filename newname ok-if-already-exists)) - (when (tramp-ange-ftp-file-name-p v1-multi-method v1-method v1-user v1-host) - (tramp-invoke-ange-ftp 'add-name-to-file - filename newname ok-if-already-exists)) - (when (tramp-ange-ftp-file-name-p v2-multi-method v2-method v2-user v2-host) - (tramp-invoke-ange-ftp 'add-name-to-file - filename newname ok-if-already-exists)) (when (and (not ok-if-already-exists) (file-exists-p newname) (not (numberp ok-if-already-exists)) @@ -2571,14 +2516,6 @@ ;; Both are Tramp files. (with-parsed-tramp-file-name filename v1 (with-parsed-tramp-file-name newname v2 - ;; Possibly invoke Ange-FTP. - (when (and (tramp-ange-ftp-file-name-p v1-multi-method v1-method v1-user v1-host) - (tramp-ange-ftp-file-name-p v2-multi-method v2-method v2-user v2-host)) - (if (eq op 'copy) - (tramp-invoke-ange-ftp - 'copy-file filename newname ok-if-already-exists keep-date) - (tramp-invoke-ange-ftp - 'rename-file filename newname ok-if-already-exists))) ;; Check if we can use a shortcut. (if (and (equal v1-multi-method v2-multi-method) (equal v1-method v2-method) @@ -2663,8 +2600,6 @@ "Like `make-directory' for tramp files." (setq dir (expand-file-name dir)) (with-parsed-tramp-file-name dir nil - (when (tramp-ange-ftp-file-name-p multi-method method user host) - (tramp-invoke-ange-ftp 'make-directory dir parents)) (save-excursion (tramp-barf-unless-okay multi-method method user host @@ -2679,8 +2614,6 @@ "Like `delete-directory' for tramp files." (setq directory (expand-file-name directory)) (with-parsed-tramp-file-name directory nil - (when (tramp-ange-ftp-file-name-p multi-method method user host) - (tramp-invoke-ange-ftp 'delete-directory directory)) (save-excursion (tramp-send-command multi-method method user host @@ -2692,8 +2625,6 @@ "Like `delete-file' for tramp files." (setq filename (expand-file-name filename)) (with-parsed-tramp-file-name filename nil - (when (tramp-ange-ftp-file-name-p multi-method method user host) - (tramp-invoke-ange-ftp 'delete-file filename)) (save-excursion (unless (zerop (tramp-send-command-and-check multi-method method user host @@ -2709,9 +2640,6 @@ "Recursively delete the directory given. This is like `dired-recursive-delete-directory' for tramp files." (with-parsed-tramp-file-name filename nil - (when (tramp-ange-ftp-file-name-p multi-method method user host) - (tramp-invoke-ange-ftp 'dired-recursive-delete-directory - filename)) ;; run a shell command 'rm -r <path>' ;; Code shamelessly stolen for the dired implementation and, um, hacked :) (or (tramp-handle-file-exists-p filename) @@ -2732,11 +2660,6 @@ (defun tramp-handle-dired-call-process (program discard &rest arguments) "Like `dired-call-process' for tramp files." (with-parsed-tramp-file-name default-directory nil - (when (tramp-ange-ftp-file-name-p multi-method method user host) - (let ((default-directory - (tramp-make-ange-ftp-file-name user host path))) - (tramp-invoke-ange-ftp 'dired-call-process - program discard arguments))) (save-excursion (tramp-barf-unless-okay multi-method method user host @@ -2779,9 +2702,6 @@ (setq switches (replace-match "" nil t switches))) (setq filename (expand-file-name filename)) (with-parsed-tramp-file-name filename nil - (when (tramp-ange-ftp-file-name-p multi-method method user host) - (tramp-invoke-ange-ftp 'insert-directory - filename switches wildcard full-directory-p)) (tramp-message-for-buffer multi-method method user host 10 "Inserting directory `ls %s %s', wildcard %s, fulldir %s" @@ -2857,9 +2777,6 @@ (defun tramp-handle-unhandled-file-name-directory (filename) "Like `unhandled-file-name-directory' for tramp files." (with-parsed-tramp-file-name filename nil - (when (tramp-ange-ftp-file-name-p multi-method method user host) - (tramp-invoke-ange-ftp 'unhandled-file-name-directory - filename)) (expand-file-name "~/"))) ;; Canonicalization of file names. @@ -2893,8 +2810,6 @@ (list name nil)) ;; Dissect NAME. (with-parsed-tramp-file-name name nil - (when (tramp-ange-ftp-file-name-p multi-method method user host) - (tramp-invoke-ange-ftp 'expand-file-name name nil)) (unless (file-name-absolute-p path) (setq path (concat "~/" path))) (save-excursion @@ -2935,11 +2850,6 @@ `tramp-end-of-output', followed by another newline." (if (tramp-tramp-file-p default-directory) (with-parsed-tramp-file-name default-directory nil - (when (tramp-ange-ftp-file-name-p multi-method method user host) - (let ((default-directory (tramp-make-ange-ftp-file-name - user host path))) - (tramp-invoke-ange-ftp 'shell-command - command output-buffer error-buffer))) (let (status) (when (string-match "&[ \t]*\\'" command) (error "Tramp doesn't grok asynchronous shell commands, yet")) @@ -2979,7 +2889,7 @@ (skip-chars-forward "^ ") (setq status (read (current-buffer)))) (unless (zerop (buffer-size)) - (pop-to-buffer output-buffer)) + (display-buffer output-buffer)) status)) ;; The following is only executed if something strange was ;; happening. Emit a helpful message and do it anyway. @@ -2998,8 +2908,6 @@ (defun tramp-handle-file-local-copy (filename) "Like `file-local-copy' for tramp files." (with-parsed-tramp-file-name filename nil - (when (tramp-ange-ftp-file-name-p multi-method method user host) - (tramp-invoke-ange-ftp 'file-local-copy filename)) (let ((output-buf (get-buffer-create "*tramp output*")) (tramp-buf (tramp-get-buffer multi-method method user host)) (rcp-program (tramp-get-rcp-program @@ -3114,10 +3022,7 @@ (barf-if-buffer-read-only) (setq filename (expand-file-name filename)) (with-parsed-tramp-file-name filename nil - (when (tramp-ange-ftp-file-name-p multi-method method user host) - (tramp-invoke-ange-ftp 'insert-file-contents - filename visit beg end replace)) - (if (not (tramp-handle-file-exists-p filename)) + (if (not (file-exists-p filename)) (progn (when visit (setq buffer-file-name filename) @@ -3125,8 +3030,8 @@ (set-buffer-modified-p nil)) (signal 'file-error (format "File `%s' not found on remote host" filename)) - (list (tramp-handle-expand-file-name filename) 0)) - (let ((local-copy (tramp-handle-file-local-copy filename)) + (list (expand-file-name filename) 0)) + (let ((local-copy (file-local-copy filename)) (coding-system-used nil) (result nil)) (when visit @@ -3136,9 +3041,7 @@ (tramp-message-for-buffer multi-method method user host 9 "Inserting local temp file `%s'..." local-copy) - (setq result - (tramp-run-real-handler 'insert-file-contents - (list local-copy nil beg end replace))) + (setq result (insert-file-contents local-copy nil beg end replace)) ;; Now `last-coding-system-used' has right value. Remember it. (when (boundp 'last-coding-system-used) (setq coding-system-used last-coding-system-used)) @@ -3174,9 +3077,6 @@ filename)) (error "File not overwritten"))) (with-parsed-tramp-file-name filename nil - (when (tramp-ange-ftp-file-name-p multi-method method user host) - (tramp-invoke-ange-ftp 'write-region - start end filename append visit)) (let ((curbuf (current-buffer)) (rcp-program (tramp-get-rcp-program multi-method (tramp-find-method multi-method method user host) @@ -3380,15 +3280,15 @@ "Invoke normal file name handler for OPERATION. First arg specifies the OPERATION, second arg is a list of arguments to pass to the OPERATION." - (let* ((op (if (eq operation 'ange-ftp-hook-function) - (car args) - operation)) - (inhibit-file-name-handlers - (list 'tramp-file-name-handler - 'tramp-completion-file-name-handler - (and (eq inhibit-file-name-operation op) - inhibit-file-name-handlers))) - (inhibit-file-name-operation op)) + (let* ((inhibit-file-name-handlers + `(tramp-file-name-handler + tramp-completion-file-name-handler + cygwin-mount-name-hook-function + cygwin-mount-map-drive-hook-function + . + ,(and (eq inhibit-file-name-operation operation) + inhibit-file-name-handlers))) + (inhibit-file-name-operation operation)) (apply operation args))) ;; This function is used from `tramp-completion-file-name-handler' functions @@ -3399,26 +3299,106 @@ "Invoke `tramp-file-name-handler' for OPERATION. First arg specifies the OPERATION, second arg is a list of arguments to pass to the OPERATION." - (let* ((op (if (eq operation 'ange-ftp-hook-function) - (car args) - operation)) - (inhibit-file-name-handlers - (list 'tramp-completion-file-name-handler - (and (eq inhibit-file-name-operation op) - inhibit-file-name-handlers))) - (inhibit-file-name-operation op)) + (let* ((inhibit-file-name-handlers + `(tramp-completion-file-name-handler + cygwin-mount-name-hook-function + cygwin-mount-map-drive-hook-function + . + ,(and (eq inhibit-file-name-operation operation) + inhibit-file-name-handlers))) + (inhibit-file-name-operation operation)) (apply operation args))) +;; We handle here all file primitives. Most of them have the file +;; name as first parameter; nevertheless we check for them explicitly +;; in order to be be signalled if a new primitive appears. This +;; scenario is needed because there isn't a way to decide by +;; syntactical means whether a foreign method must be called. It would +;; ease the live if `file-name-handler-alist' would support a decision +;; function as well but regexp only. +(defun tramp-file-name-for-operation (operation &rest args) + "Return file name related to OPERATION file primitive. +ARGS are the arguments OPERATION has been called with." + (cond + ; FILE resp DIRECTORY + ((member operation + (list 'access-file 'byte-compiler-base-file-name 'delete-directory + 'delete-file 'diff-latest-backup-file 'directory-file-name + 'directory-files 'directory-files-and-attributes + 'dired-compress-file 'dired-uncache + 'file-accessible-directory-p 'file-attributes + 'file-directory-p 'file-executable-p 'file-exists-p + 'file-local-copy 'file-modes 'file-name-as-directory + 'file-name-directory 'file-name-nondirectory + 'file-name-sans-versions 'file-ownership-preserved-p + 'file-readable-p 'file-regular-p 'file-symlink-p + 'file-truename 'file-writable-p 'find-backup-file-name + 'find-file-noselect 'get-file-buffer 'insert-directory + 'insert-file-contents 'load 'make-directory + 'make-directory-internal 'set-file-modes + 'substitute-in-file-name 'unhandled-file-name-directory + 'vc-registered + ; XEmacs only + 'abbreviate-file-name 'create-file-buffer + 'dired-file-modtime 'dired-make-compressed-filename + 'dired-recursive-delete-directory 'dired-set-file-modtime + 'dired-shell-unhandle-file-name 'dired-uucode-file + 'insert-file-contents-literally 'recover-file + 'vm-imap-check-mail 'vm-pop-check-mail 'vm-spool-check-mail)) + (expand-file-name (nth 0 args))) + ; FILE DIRECTORY resp FILE1 FILE2 + ((member operation + (list 'add-name-to-file 'copy-file 'expand-file-name + 'file-name-all-completions 'file-name-completion + 'file-newer-than-file-p 'make-symbolic-link 'rename-file + ; XEmacs only + 'dired-make-relative-symlink + 'vm-imap-move-mail 'vm-pop-move-mail 'vm-spool-move-mail)) + (save-match-data + (cond + ((string-match tramp-file-name-regexp (nth 0 args)) (nth 0 args)) + ((string-match tramp-file-name-regexp (nth 1 args)) (nth 1 args)) + (t (buffer-file-name (current-buffer)))))) + ; START END FILE + ((eq operation 'write-region) + (nth 2 args)) + ; BUF + ((member operation + (list 'set-visited-file-modtime 'verify-visited-file-modtime + ; XEmacs only + 'backup-buffer)) + (buffer-file-name + (if (bufferp (nth 0 args)) (nth 0 args) (current-buffer)))) + ; COMMAND + ((member operation + (list 'dired-call-process 'shell-command + ; XEmacs only + 'dired-print-file 'dired-shell-call-process)) + default-directory) + ; unknown file primitive + (t (error "unknown file I/O primitive: %s" operation)))) + +(defun tramp-find-foreign-file-name-handler (filename) + "Return foreign file name handler if exists." + (let (elt res) + (dolist (elt tramp-foreign-file-name-handler-alist res) + (when (funcall (car elt) filename) + (setq res (cdr elt)))) + res)) + ;; Main function. ;;;###autoload (defun tramp-file-name-handler (operation &rest args) "Invoke tramp file name handler. Falls back to normal file name handler if no tramp file name handler exists." - (let ((fn (assoc operation tramp-file-name-handler-alist))) - (if fn - (catch 'tramp-forward-to-ange-ftp - (save-match-data (apply (cdr fn) args))) - (tramp-run-real-handler operation args)))) + (save-match-data + (let* ((fn (assoc operation tramp-file-name-handler-alist)) + (filename (apply 'tramp-file-name-for-operation operation args)) + (foreign (tramp-find-foreign-file-name-handler filename))) + (cond + (foreign (apply foreign operation args)) + (fn (apply (cdr fn) args)) + (t (tramp-run-real-handler operation args)))))) (put 'tramp-file-name-handler 'file-remote-p t) ;for file-remote-p @@ -3432,8 +3412,7 @@ ;; operation args (with-output-to-string (backtrace))) (let ((fn (assoc operation tramp-completion-file-name-handler-alist))) (if fn - (catch 'tramp-forward-to-ange-ftp - (save-match-data (apply (cdr fn) args))) + (save-match-data (apply (cdr fn) args)) (tramp-completion-run-real-handler operation args)))) ;; Register in file name handler alist @@ -3444,32 +3423,6 @@ (cons tramp-completion-file-name-regexp 'tramp-completion-file-name-handler)) -;; 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) - (defun tramp-repair-jka-compr () "If jka-compr is already loaded, move it to the front of `file-name-handler-alist'. On Emacs 21.4 or so this will not be @@ -3480,40 +3433,6 @@ (cons jka (delete jka file-name-handler-alist)))))) (tramp-repair-jka-compr) -(defun tramp-flatten-list (arg) - "Expands all lists inside ARG to a sequential list. -Return (nil) if arg is nil." - (let ((car (car arg)) - (cdr (cdr arg))) - (cond - ((eq arg nil) '(nil)) - ((listp car) - (if (null cdr) - (tramp-flatten-list car) - (append (tramp-flatten-list car) (tramp-flatten-list cdr)))) - ((null cdr) (list car)) - (t (cons car (tramp-flatten-list cdr)))))) - -(defun tramp-invoke-ange-ftp (operation &rest args) - "Invoke the Ange-FTP handler function and throw." - (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)))) - (throw 'tramp-forward-to-ange-ftp - (tramp-run-real-handler 'ange-ftp-hook-function - (cons operation args))))) - -(defun tramp-ange-ftp-file-name-p (multi-method method user host) - "Check if it's a filename that should be forwarded to Ange-FTP." - (and tramp-unified-filenames - (null multi-method) - (string= (tramp-find-method multi-method method user host) tramp-ftp-method))) - ;;; Interactions with other packages: @@ -3523,8 +3442,6 @@ (defun tramp-handle-expand-many-files (name) "Like `PC-expand-many-files' for tramp files." (with-parsed-tramp-file-name name nil - (when (tramp-ange-ftp-file-name-p multi-method method user host) - (tramp-invoke-ange-ftp 'expand-many-files name)) (save-match-data (if (or (string-match "\\*" name) (string-match "\\?" name) @@ -3604,8 +3521,7 @@ (concat tramp-prefix-regexp "\\(" tramp-method-regexp "\\)" tramp-postfix-single-method-regexp "$") file) - (member (match-string 1 file) - (cons tramp-ftp-method (mapcar 'car tramp-methods)))) + (member (match-string 1 file) (mapcar 'car tramp-methods))) ((or (equal last-input-event 'tab) (and (not (event-modifiers last-input-event)) (integerp last-input-event) @@ -3672,17 +3588,17 @@ ;; Method dependent user / host combinations (progn (mapcar - '(lambda (x) - (setq all-user-hosts - (append all-user-hosts - (funcall (nth 0 x) (nth 1 x))))) + (lambda (x) + (setq all-user-hosts + (append all-user-hosts + (funcall (nth 0 x) (nth 1 x))))) (tramp-get-completion-function m)) (setq result (append result (mapcar - '(lambda (x) - (tramp-get-completion-user-host - method user host (nth 0 x) (nth 1 x))) + (lambda (x) + (tramp-get-completion-user-host + method user host (nth 0 x) (nth 1 x))) (delq nil all-user-hosts))))) ;; Possible methods @@ -3734,47 +3650,46 @@ They are collected by `tramp-completion-dissect-file-name1'." (let* ((result) - (x-nil "\\|\\(\\)")) - - ;; "/method" "/[method" - (defconst tramp-completion-file-name-structure1 - (list (concat tramp-prefix-regexp "\\(" tramp-method-regexp x-nil "\\)$") - 1 9 9 9)) - ;; "/user" "/[user" - (defconst tramp-completion-file-name-structure2 - (list (concat tramp-prefix-regexp "\\(" tramp-user-regexp x-nil "\\)$") - 9 1 9 9)) - ;; "/host" "/[host" - (defconst tramp-completion-file-name-structure3 - (list (concat tramp-prefix-regexp "\\(" tramp-host-regexp x-nil "\\)$") - 9 9 1 9)) - ;; "/user@host" "/[user@host" - (defconst tramp-completion-file-name-structure4 - (list (concat tramp-prefix-regexp - "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp - "\\(" tramp-host-regexp x-nil "\\)$") - 9 1 2 9)) - ;; "/method:user" "/[method/user" - (defconst tramp-completion-file-name-structure5 - (list (concat tramp-prefix-regexp - "\\(" tramp-method-regexp "\\)" tramp-postfix-single-method-regexp - "\\(" tramp-user-regexp x-nil "\\)$") - 1 2 9 9)) - ;; "/method:host" "/[method/host" - (defconst tramp-completion-file-name-structure6 - (list (concat tramp-prefix-regexp - "\\(" tramp-method-regexp "\\)" tramp-postfix-single-method-regexp - "\\(" tramp-host-regexp x-nil "\\)$") - 1 9 2 9)) - ;; "/method:user@host" "/[method/user@host" - (defconst tramp-completion-file-name-structure7 - (list (concat tramp-prefix-regexp - "\\(" tramp-method-regexp "\\)" tramp-postfix-single-method-regexp - "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp - "\\(" tramp-host-regexp x-nil "\\)$") - 1 2 3 9)) - - (mapcar '(lambda (regexp) + (x-nil "\\|\\(\\)") + ;; "/method" "/[method" + (tramp-completion-file-name-structure1 + (list (concat tramp-prefix-regexp "\\(" tramp-method-regexp x-nil "\\)$") + 1 nil nil nil)) + ;; "/user" "/[user" + (tramp-completion-file-name-structure2 + (list (concat tramp-prefix-regexp "\\(" tramp-user-regexp x-nil "\\)$") + nil 1 nil nil)) + ;; "/host" "/[host" + (tramp-completion-file-name-structure3 + (list (concat tramp-prefix-regexp "\\(" tramp-host-regexp x-nil "\\)$") + nil nil 1 nil)) + ;; "/user@host" "/[user@host" + (tramp-completion-file-name-structure4 + (list (concat tramp-prefix-regexp + "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp + "\\(" tramp-host-regexp x-nil "\\)$") + nil 1 2 nil)) + ;; "/method:user" "/[method/user" + (tramp-completion-file-name-structure5 + (list (concat tramp-prefix-regexp + "\\(" tramp-method-regexp "\\)" tramp-postfix-single-method-regexp + "\\(" tramp-user-regexp x-nil "\\)$") + 1 2 nil nil)) + ;; "/method:host" "/[method/host" + (tramp-completion-file-name-structure6 + (list (concat tramp-prefix-regexp + "\\(" tramp-method-regexp "\\)" tramp-postfix-single-method-regexp + "\\(" tramp-host-regexp x-nil "\\)$") + 1 nil 2 nil)) + ;; "/method:user@host" "/[method/user@host" + (tramp-completion-file-name-structure7 + (list (concat tramp-prefix-regexp + "\\(" tramp-method-regexp "\\)" tramp-postfix-single-method-regexp + "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp + "\\(" tramp-host-regexp x-nil "\\)$") + 1 2 3 nil))) + + (mapcar (lambda (regexp) (add-to-list 'result (tramp-completion-dissect-file-name1 regexp name))) (list @@ -3797,7 +3712,8 @@ (let (method) (save-match-data (when (string-match (nth 0 structure) name) - (setq method (match-string (nth 1 structure) name)) + (setq method (and (nth 1 structure) + (match-string (nth 1 structure) name))) (if (and method (member method tramp-multi-methods)) ;; Not handled (yet). (make-tramp-file-name @@ -3806,9 +3722,12 @@ :user nil :host nil :path nil) - (let ((user (match-string (nth 2 structure) name)) - (host (match-string (nth 3 structure) name)) - (path (match-string (nth 4 structure) name))) + (let ((user (and (nth 2 structure) + (match-string (nth 2 structure) name))) + (host (and (nth 3 structure) + (match-string (nth 3 structure) name))) + (path (and (nth 4 structure) + (match-string (nth 4 structure) name)))) (make-tramp-file-name :multi-method nil :method method @@ -3818,21 +3737,15 @@ ;; This function returns all possible method completions, adding the ;; trailing method delimeter. -;; In case of Emacs, `tramp-ftp-method' is handled as well because it doesn't -;; belong to `tramp-methods'. (defun tramp-get-completion-methods (partial-method) "Returns all method completions for PARTIAL-METHOD." - (let ((all-methods (delete "multi" (mapcar 'car tramp-methods)))) - - (mapcar - '(lambda (method) - (and method - (string-match (concat "^" (regexp-quote partial-method)) method) - ;; we must remove leading "/". - (substring (tramp-make-tramp-file-name nil method nil nil nil) 1))) - - (add-to-list 'all-methods - (when tramp-unified-filenames tramp-ftp-method))))) + (mapcar + (lambda (method) + (and method + (string-match (concat "^" (regexp-quote partial-method)) method) + ;; we must remove leading "/". + (substring (tramp-make-tramp-file-name nil method nil nil nil) 1))) + (delete "multi" (mapcar 'car tramp-methods)))) ;; Compares partial user and host names with possible completions. (defun tramp-get-completion-user-host (method partial-user partial-host user host) @@ -4401,8 +4314,8 @@ (pop-to-buffer (tramp-get-buffer multi-method method user host)) (unless (y-or-n-p (match-string 0)) (kill-process p) - (erase-buffer) (throw 'tramp-action 'permission-denied)) + (erase-buffer) (process-send-string p (concat "y" tramp-rsh-end-of-line)))) (defun tramp-action-terminal (p multi-method method user host) @@ -4692,8 +4605,8 @@ (tramp-find-method multi-method method user host) user host) (mapcar - '(lambda (x) - (format-spec x `((?u . ,(or user "root"))))) + (lambda (x) + (format-spec x `((?u . ,(or user "root"))))) (tramp-get-su-args multi-method (tramp-find-method multi-method method user host) @@ -5808,16 +5721,22 @@ "Return an `tramp-file-name' structure. The structure consists of remote method, remote user, remote host and remote path name." - (let (method) - (save-match-data - (unless (string-match (nth 0 tramp-file-name-structure) name) - (error "Not a tramp file name: %s" name)) - (setq method (match-string (nth 1 tramp-file-name-structure) name)) + (save-match-data + (let* ((match (string-match (nth 0 tramp-file-name-structure) name)) + (method + ; single-hop + (if match (match-string (nth 1 tramp-file-name-structure) name) + ; maybe multi-hop + (string-match + (format (nth 0 tramp-multi-file-name-structure) + (nth 0 tramp-multi-file-name-hop-structure)) name) + (match-string (nth 1 tramp-multi-file-name-structure) name)))) (if (and method (member method tramp-multi-methods)) ;; If it's a multi method, the file name structure contains ;; arrays of method, user and host. (tramp-dissect-multi-file-name name) ;; Normal method. First, find out default method. + (unless match (error "Not a tramp file name: %s" name)) (let ((user (match-string (nth 2 tramp-file-name-structure) name)) (host (match-string (nth 3 tramp-file-name-structure) name)) (path (match-string (nth 4 tramp-file-name-structure) name))) @@ -5923,12 +5842,6 @@ (format "%s@%s:%s" user host path) (format "%s:%s" host path))) -(defun tramp-make-ange-ftp-file-name (user host path) - "Given user, host, and path, return an Ange-FTP filename." - (if user - (format "/%s@%s:%s" user host path) - (format "/%s:%s" host path))) - (defun tramp-method-out-of-band-p (multi-method method user host) "Return t if this is an out-of-band method, nil otherwise. It is important to check for this condition, since it is not possible @@ -6412,6 +6325,14 @@ ;;; TODO: +;; * Allow putting passwords in the filename. +;; This should be implemented via a general mechanism to add +;; parameters in filenames. There is currently a kludge for +;; putting the port number into the filename for ssh and ftp +;; files. This could be subsumed by the new mechanism as well. +;; Another approach is to read a netrc file like ~/.authinfo +;; from Gnus. +;; * Handle nonlocal exits such as C-g. ;; * Autodetect if remote `ls' groks the "--dired" switch. ;; * Add fallback for inline encodings. This should be used ;; if the remote end doesn't support mimencode or a similar program. @@ -6517,10 +6438,6 @@ ;; connect to host "blabla" already if that host is unique. No idea ;; how to suppress. Maybe not an essential problem. ;; ** Try to avoid usage of `last-input-event' in `tramp-completion-mode'. -;; ** Handle quoted file names, starting with "/:". Problem is that -;; `file-name-non-special' calls later on `file-name-all-completions' -;; without ":". Hmm. Worth a bug report? -;; ** Acknowledge port numbers. ;; ** Extend `tramp-get-completion-su' for NIS and shadow passwords. ;; ** Unify `tramp-parse-{rhosts,shosts,hosts,passwd,netrc}'. ;; Code is nearly identical.