+2002-12-26 Kai Gro\e,A_\e(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
+;;; 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
+;;; 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
+;;; 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
(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.")
;; "=" 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))
(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))
(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)
(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
;;; 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
;; 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"
;; (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)
(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
(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))
"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)
(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 ...).
* `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."
: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
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
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)
(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.
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
(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")))
"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 "/"))
(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)))
(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
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
(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
(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))))
(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
(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)))))
(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
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)
(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."
;;
;; 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
(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))
(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)))))
(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) ?/)
&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
(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)
"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
(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))
;; 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)
"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
"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
"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
"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)
(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
(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"
(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.
(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
`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"))
(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.
(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
(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)
(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
(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))
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)
"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
"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
;; 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
(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
(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:
(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)
(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)
;; 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
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
(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
: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
;; 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)
(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)
(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)
"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)))
(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
;;; 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.
;; 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.
projects / emacs.git / commitdiff