;;; magit-tramp.el --- git method for TRAMP ;; Copyright (C) 2013 Yann Hodique ;; Copyright (C) 1998-2013 Free Software Foundation, Inc. ;; Author: Yann Hodique ;; Keywords: ;; Version: 0.1.0 ;; Package-Requires: ((magit "1.2.0")) ;; URL: https://github.com/sigma/magit-tramp ;; 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 3 of the License, 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. If not, see . ;;; Code: (require 'magit) (require 'tramp) (defgroup magit-tramp nil "git method for TRAMP" :link '(url-link "https://github.com/sigma/magit-tramp") :prefix "magit-tramp" :group 'magit) ;;;###autoload (defconst magit-tramp-method "git" "TRAMP method for browsing git repositories.") ;;;###autoload (defsubst magit-tramp-file-name-p (filename) (let ((v (tramp-dissect-file-name filename))) (string= (tramp-file-name-method v) magit-tramp-method))) (defsubst magit-tramp-filerev (user localname) (format "%s:%s" user (substring localname 1))) (defcustom magit-tramp-hosts-alist nil "Alist of host -> directory." :group 'magit-tramp :type '(alist :key-type string :value-type directory)) (defun magit-tramp-handle-file-writable-p (filename) nil) (defun magit-tramp-handle-file-exists-p (filename) (with-parsed-tramp-file-name filename target (let ((default-directory (magit-tramp-resolve-host target-host))) (= (magit-git-exit-code "cat-file" "-t" (magit-tramp-filerev target-user target-localname)) 0)))) (defun magit-tramp-handle-expand-file-name (name &optional dir) ;; If DIR is not given, use DEFAULT-DIRECTORY or "/". (setq dir (or dir default-directory "/")) ;; Unless NAME is absolute, concat DIR and NAME. (unless (file-name-absolute-p name) (setq name (concat (file-name-as-directory dir) name))) ;; If NAME is not a Tramp file, run the real handler. (if (not (tramp-connectable-p name)) (tramp-run-real-handler 'expand-file-name (list name nil)) ;; Dissect NAME. (with-parsed-tramp-file-name name nil (unless (tramp-run-real-handler 'file-name-absolute-p (list localname)) (setq localname (concat "~/" localname))) (while (string-match "//" localname) (setq localname (replace-match "/" t t localname))) (let ((directory-sep-char ?/) (default-directory (tramp-compat-temporary-file-directory))) (tramp-make-tramp-file-name method user host (tramp-drop-volume-letter (tramp-run-real-handler 'expand-file-name (list localname))) hop))))) (defun magit-tramp-resolve-host (host) (let ((elem (assoc host magit-tramp-hosts-alist))) (or (and elem (cdr elem)) (and (string-prefix-p "_" host) (ignore-errors (base64-decode-string (substring host 1))))))) (defun magit-tramp-gen-host (dirname) (let ((elem (rassoc dirname magit-tramp-hosts-alist))) (if elem (car elem) (format "_%s" (base64-encode-string dirname))))) (defun magit-tramp-file-size (filename) (string-to-number (with-parsed-tramp-file-name filename target (let ((default-directory (magit-tramp-resolve-host target-host))) (magit-git-string "cat-file" "-s" (magit-tramp-filerev target-user target-localname)))))) (defun magit-tramp-handle-file-directory-p (filename) (with-parsed-tramp-file-name filename target (let ((default-directory (magit-tramp-resolve-host target-host))) (string= "tree" (magit-git-string "cat-file" "-t" (magit-tramp-filerev target-user target-localname)))))) (defun magit-tramp-handle-file-newer-than-file-p (file1 file2) ;; bare minimum to make this consistent (magit-tramp-handle-file-exists-p file1)) (defun magit-tramp-handle-file-attributes (filename &optional id-format) (unless id-format (setq id-format 'integer)) (ignore-errors (with-parsed-tramp-file-name filename nil (with-tramp-file-property v localname (format "file-attributes-%s" id-format) ;; Reading just the filename entry via "dir localname" is not ;; possible, because when filename is a directory, some ;; smbclient versions return the content of the directory, and ;; other versions don't. Therefore, the whole content of the ;; upper directory is retrieved, and the entry of the filename ;; is extracted from. (let* ((uid (if (equal id-format 'string) "nobody" -1)) (gid (if (equal id-format 'string) "nogroup" -1)) (inode (tramp-get-inode v)) (device (tramp-get-device v)) (size (magit-tramp-file-size filename)) (dir (magit-tramp-handle-file-directory-p filename))) ;; Check result. (list dir ;0 file type -1 ;1 link count uid ;2 uid gid ;3 gid '(0 0) ;4 atime '(0 0) ;5 mtime '(0 0) ;6 ctime size ;7 size (if dir "dr-xr-xr-x" "-r--r--r--") ;8 mode nil ;9 gid weird inode ;10 inode number device ;11 file system number )))))) (defun magit-tramp-handle-insert-file-contents (filename &optional visit beg end replace) (if replace (list filename 0) (when visit (setq buffer-file-name filename)) (insert (substring (with-parsed-tramp-file-name filename target (string-as-multibyte (let ((default-directory (magit-tramp-resolve-host target-host))) (magit-git-output (list "cat-file" "-p" (magit-tramp-filerev target-user target-localname)))))) (or beg 0) end)) (list filename (magit-tramp-file-size filename)))) (defun magit-tramp-handle-file-name-all-completions (file directory) (with-parsed-tramp-file-name directory target (let ((default-directory (magit-tramp-resolve-host target-host))) (delete nil (mapcar (lambda (name) (and (string-prefix-p file name) name)) (magit-git-lines "ls-tree" "--name-only" (magit-tramp-filerev target-user target-localname))))))) (defun magit-tramp-handle-directory-files-and-attributes (directory &optional full match nosort id-format) (mapcar (lambda (filename) (cons filename (magit-tramp-handle-file-attributes (expand-file-name filename directory) id-format))) (tramp-handle-directory-files directory))) (defun magit-tramp-handle-insert-directory (filename switches &optional wildcard full-directory-p) (setq filename (expand-file-name filename)) (if full-directory-p ;; Called from `dired-add-entry'. (setq filename (file-name-as-directory filename)) (setq filename (directory-file-name filename))) (with-parsed-tramp-file-name filename nil (save-match-data (let ((base (file-name-nondirectory filename)) (entries (magit-tramp-handle-directory-files-and-attributes (file-name-directory filename) nil nil nil 'string))) (when wildcard ;; (string-match "\\." base) ;; (setq base (replace-match "\\\\." nil nil base)) ;; (string-match "\\*" base) ;; (setq base (replace-match ".*" nil nil base)) ;; (string-match "\\?" base) ;; (setq base (replace-match ".?" nil nil base)) ) ;; Filter entries. (setq entries (delq nil (if (or wildcard (zerop (length base))) ;; Check for matching entries. (mapcar (lambda (x) (when (string-match (format "^%s" base) (nth 0 x)) x)) entries) ;; We just need the only and only entry FILENAME. (list (assoc base entries))))) ;; Sort entries. (setq entries (sort entries (lambda (x y) (if (string-match "t" switches) ;; Sort by date. (tramp-time-less-p (nth 3 y) (nth 3 x)) ;; Sort by name. (string-lessp (nth 0 x) (nth 0 y)))))) ;; Handle "-F" switch. (when (string-match "F" switches) (mapc (lambda (x) (when (not (zerop (length (car x)))) (cond ((char-equal ?d (string-to-char (nth 1 x))) (setcar x (concat (car x) "/"))) ((char-equal ?x (string-to-char (nth 1 x))) (setcar x (concat (car x) "*")))))) entries)) ;; Print entries. (mapc (lambda (x) (when (not (zerop (length (nth 0 x)))) (let ((attr (ignore-errors (cdr x)))) (insert (format "%10s %3d %-8s %-8s %8s %s " (or (nth 8 attr)) ; mode (or (nth 1 attr)) ; inode (or (nth 2 attr)) ; uid (or (nth 3 attr)) ; gid (or (nth 7 attr)) ; size (format-time-string (if (tramp-time-less-p (tramp-time-subtract (current-time) (nth 5 attr)) tramp-half-a-year) "%b %e %R" "%b %e %Y") (nth 5 attr)))) ; date ;; We mark the file name. The inserted name could be ;; from somewhere else, so we use the relative file ;; name of `default-directory'. (let ((start (point))) (insert (format "%s\n" (file-relative-name (expand-file-name (nth 0 x) (file-name-directory filename))))) (put-text-property start (1- (point)) 'dired-filename t)) (forward-line) (beginning-of-line)))) entries))))) (defun magit-tramp-handle-file-local-copy (filename) (with-parsed-tramp-file-name filename nil (unless (magit-tramp-handle-file-exists-p filename) (tramp-error v 'file-error "Cannot make local copy of non-existing file `%s'" filename)) (let* ((tmpfile (tramp-compat-make-temp-file filename))) (condition-case err (save-excursion (with-temp-buffer (set-buffer-multibyte nil) (insert-file-contents filename) ;; Unset `file-name-handler-alist'. Otherwise, ;; epa-file gets confused. (let (file-name-handler-alist (coding-system-for-write 'binary)) (write-region (point-min) (point-max) tmpfile))) ;; Set proper permissions. (set-file-modes tmpfile (tramp-default-file-modes filename)) ;; Set local user ownership. (tramp-set-file-uid-gid tmpfile)) ;; Error handling. ((error quit) (delete-file tmpfile) (signal (car err) (cdr err)))) (run-hooks 'tramp-handle-file-local-copy-hook) tmpfile))) (defconst magit-tramp-file-name-handler-alist '( (load . tramp-handle-load) (file-name-as-directory . tramp-handle-file-name-as-directory) (file-name-directory . tramp-handle-file-name-directory) (file-name-nondirectory . tramp-handle-file-name-nondirectory) (file-truename . identity) (file-exists-p . magit-tramp-handle-file-exists-p) (file-directory-p . magit-tramp-handle-file-directory-p) ;; executable iff directory (file-executable-p . magit-tramp-handle-file-directory-p) ;; readable iff exists (file-readable-p . magit-tramp-handle-file-exists-p) (file-regular-p . tramp-handle-file-regular-p) ;; TODO: support symlinks (file-symlink-p . ignore) (file-writable-p . magit-tramp-handle-file-writable-p) (file-ownership-preserved-p . ignore) (file-newer-than-file-p . magit-tramp-handle-file-newer-than-file-p) (file-attributes . magit-tramp-handle-file-attributes) (file-modes . tramp-handle-file-modes) (directory-files . tramp-handle-directory-files) (directory-files-and-attributes . magit-tramp-handle-directory-files-and-attributes) (file-name-all-completions . magit-tramp-handle-file-name-all-completions) (file-name-completion . tramp-handle-file-name-completion) (add-name-to-file . ignore) (copy-file . ignore) (copy-directory . ignore) (rename-file . ignore) (set-file-modes . ignore) (set-file-times . ignore) (make-directory . ignore) (delete-directory . ignore) (delete-file . ignore) (directory-file-name . tramp-handle-directory-file-name) ;; `executable-find' is not official yet. (executable-find . ignore) (start-file-process . ignore) (process-file . ignore) (shell-command . ignore) (insert-directory . magit-tramp-handle-insert-directory) (expand-file-name . magit-tramp-handle-expand-file-name) (substitute-in-file-name . tramp-handle-substitute-in-file-name) (file-local-copy . magit-tramp-handle-file-local-copy) (file-remote-p . tramp-handle-file-remote-p) (insert-file-contents . magit-tramp-handle-insert-file-contents) ;; TODO: do we need more logic here ? (insert-file-contents-literally . magit-tramp-handle-insert-file-contents) (write-region . ignore) (find-backup-file-name . tramp-handle-find-backup-file-name) (make-auto-save-file-name . ignore) (unhandled-file-name-directory . ignore) (dired-compress-file . ignore) (dired-recursive-delete-directory . ignore) (dired-uncache . tramp-handle-dired-uncache) (set-visited-file-modtime . ignore) (verify-visited-file-modtime . (lambda (&rest args) t)) (file-selinux-context . (lambda (&rest args) '(nil nil nil nil))) (set-file-selinux-context . ignore) (vc-registered . ignore))) ;;;###autoload (defun magit-tramp-file-name-handler (operation &rest args) (when (and tramp-locked (not tramp-locker)) (setq tramp-locked nil) (signal 'file-error (list "Forbidden reentrant call of Tramp"))) (let ((tl tramp-locked)) (unwind-protect (progn (setq tramp-locked t) (let ((tramp-locker t)) (save-match-data (let ((fn (assoc operation magit-tramp-file-name-handler-alist))) (if fn (apply (cdr fn) args) (tramp-run-real-handler operation args)))))) (setq tramp-locked tl)))) ;;;###autoload (eval-after-load 'tramp '(progn (add-to-list 'tramp-methods (cons magit-tramp-method nil)) (add-to-list 'tramp-foreign-file-name-handler-alist '(magit-tramp-file-name-p . magit-tramp-file-name-handler)))) (provide 'magit-tramp) ;;; magit-tramp.el ends here