| Index: magit-rietveld.el |
| diff --git a/magit-rietveld.el b/magit-rietveld.el |
| new file mode 100644 |
| index 0000000000000000000000000000000000000000..cf4ad7c730513f8c3d152f9ed47bd78990dd37f4 |
| --- /dev/null |
| +++ b/magit-rietveld.el |
| @@ -0,0 +1,254 @@ |
| +;; -*- lexical-binding: t -*- |
| +;;; magit-rietveld.el --- Magit plugin for the Rietveld Code Review system |
| + |
| +;; Copyright (C) 2015 Dave Barker |
| + |
| +;; Author: Dave Barker <kzar@kzar.co.uk> |
| + |
| +;; Package-Requires: ((magit "2.1.0") (oauth2 "0.10")) |
| +;; Keywords: git tools vc rietveld upload.py |
| +;; Homepage: https://github.com/kzar/magit-rietveld |
| + |
| +;; 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, or (at your option) any |
| +;; later version. |
| +;; |
| +;; It 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 it. If not, see http://www.gnu.org/licenses. |
| + |
| +;;; Commentary: |
| + |
| +;; magit-rietveld.el is an interface for interacting with the Rietveld |
| +;; code review system. The code is a elisp port of a small subset of the |
| +;; upload.py script included with Rietveld, which will allow for more |
| +;; convenient magit integration. Parts of this file are also derived from |
| +;; the magit-gerrit code. |
| + |
| +;;; Usage: |
| + |
| +;; FIXME - write usage instructions! |
| + |
| +;;; Code: |
| + |
| +(require 'magit) |
| + |
| +; FIXME - this should not be the default |
| +(defvar-local magit-rietveld-server "https://codereview.adblockplus.org") |
| + |
| +(setq auth-token nil) |
| +(setq redirect-response "\ |
| +HTTP/1.1 200 OK\r |
| +\r |
| +<html> |
| + <head> |
| + <script>window.onload = function () { window.close(); };</script> |
| + </head> |
| + <body> |
| + <p>Rietveld access token obtained, you can close this page.</p> |
| + </body> |
| +</html>") |
| + |
| +(defun oauth-redirect-filter (connection string) |
| + (with-temp-buffer |
| + (insert string) |
| + (setq auth-token |
| + (and |
| + (search-backward-regexp "access_token=\\([^&[:space:]]+\\)" nil t) |
| + (match-string 1))) |
| + (process-send-string connection redirect-response) |
| + (delete-process connection) |
| + (delete-process "oauth-redirect"))) |
| + |
| +(defun get-auth-token () |
| + (make-network-process :name "oauth-redirect" :server t |
| + :service 8001 :family 'ipv4 |
| + :filter 'oauth-redirect-filter) |
| + (browse-url (concat magit-rietveld-server "/get-access-token?port=8001")) |
| + (run-at-time 10 nil (lambda () |
| + (when (process-status "oauth-redirect") |
| + (minibuffer-message |
| + "Timed out waiting for Rietveld oauth2 access token") |
| + (delete-process "oauth-redirect"))))) |
| +; FIXME - block waiting for this to finish, return the code or nil on timeout |
| +; (Perhaps we should prompt for the auth code if the redirect flow fails?) |
| +(get-auth-token) |
| + |
| +(defun encode-multipart-form-data (boundary fields files) |
| + (with-temp-buffer |
| + (dolist (field fields) |
| + (insert "--" boundary "\r\n") |
| + (insert "Content-Disposition: form-data; name=\"" |
| + (car field) "\"" "\r\n" "\r\n") |
| + (insert (cdr field) "\r\n")) |
| + (dolist (file files) |
| + (insert "--" boundary "\r\n") |
| + (insert "Content-Disposition: form-data; name=\"" (car file) "\"; " |
| + "filename=\"" (cadr file) "\"\r\n") |
| + (insert "Content-Type: " (caddr file) "\r\n" "\r\n") |
| + (insert (cadddr file))) |
| + (insert "--" boundary "--\r\n\r\n") |
| + (buffer-string))) |
| + |
| +(defun get-first-root-hash () |
| + (with-temp-buffer |
| + (magit-git-insert "rev-list" "--parents" "HEAD") |
| + (and (search-backward-regexp "\\W\\([[:alnum:]]+\\)" nil t) |
| + (match-string 1)))) |
| + |
| +(defun guess-rev () |
| + (let* ((selected (magit-region-values)) |
| + (branch (magit-get-current-branch)) |
| + (current (magit-current-section))) |
| + (if (and current (eq (magit-section-type current) 'commit)) |
| + (let ((current-rev (magit-section-value current))) |
| + (if (> (length selected) 1) |
| + (concat (car (last selected)) ":" (first selected)) |
| + (concat current-rev "~:" current-rev))) |
| + ; FIXME - Check Branch / HEAD is after Master! |
| + ; (If not just suggest HEAD~:HEAD?) |
| + (concat "master:" (or branch "HEAD"))))) |
| +; FIXME - We need to check that they've chosen a valid range |
| +; split by ":", (magit-rev-verify ...) on both |
| + |
| +(defun strip-null-hash (hash) |
| + (let ((null-hash "0000000000000000000000000000000000000000")) |
| + (and (not (string= hash null-hash)) hash))) |
| + |
| +; FIXME - Is there no way to avoid all this global state? :( |
| +(setq filenames ()) |
| +(setq statuses (make-hash-table :test 'equal)) |
| +(setq hashes (make-hash-table :test 'equal)) |
| +(setq renames (make-hash-table :test 'equal)) |
| +(setq base-contents (make-hash-table :test 'equal)) |
| +(setq new-contents (make-hash-table :test 'equal)) |
| +(setq binary-ps (make-hash-table :test 'equal)) |
| + |
| +(defun reset-diff () |
| + (setq filenames ()) |
| + (mapc 'clrhash `(,statuses ,hashes ,renames ,base-contents |
| + ,new-contents ,binary-ps))) |
| + |
| +(defun is-image? (filename) |
| + (and (string-match |
| + (rx "." (or "bmp" "gif" "ief" "jpe" "jpeg" "jpg" "pbm" "pgm" "png" "pnm" |
| + "ppm" "ras" "rgb" "tif" "tiff" "xbm" "xpm" "xwd" "jpg" "pct" |
| + "pic" "pict") |
| + eos) |
| + filename) |
| + t)) |
| + |
| +(defun is-binary? (contents) |
| + (and (search "\0" contents) t)) |
| + |
| +(defun get-file-content (hash) |
| + (with-temp-buffer |
| + (magit-git-insert "git" "show" hash) |
| + (buffer-string))) |
| + |
| +(defun diff (rev-start rev-end) |
| + (reset-diff) |
| + (with-temp-buffer |
| + ; Insert the Git diff |
| + (let ((args '("diff" "--no-color" "--no-ext-diff" "--full-index" |
| + "--ignore-submodules" "--src-prefix=a/" "--dst-prefix=b/"))) |
| + (apply 'magit-git-insert (append args '("--no-renames" "--diff-filter=D") |
| + `(,rev-start ,rev-end))) |
| + (apply 'magit-git-insert (append args '("--diff-filter=AMCRT" "-M50%") |
| + `(,rev-start ,rev-end)))) |
| + ; Add Index: ... lines |
| + (beginning-of-buffer) |
| + (while (search-forward-regexp "^diff --git a/\\(.*\\) b/\\(.*\\)$" nil t) |
| + (let ((filename-before (match-string 1)) |
| + (filename (match-string 2))) |
| + (push filename filenames) |
| + ; Keep track of weather or not this file has been renamed |
| + (let ((renamed (not (string= filename-before filename)))) |
| + (when renamed |
| + (puthash filename filename-before renames)) |
| + (move-beginning-of-line 1) |
| + (insert (concat "Index: ") filename "\n") |
| + (move-end-of-line 2) |
| + ; Keep track of before & after hashes + statuses for this file |
| + (search-forward-regexp "^index \\(\\w+\\)\\.\\.\\(\\w+\\)$") |
| + (let ((hash-before (match-string 1)) |
| + (hash-after (match-string 2))) |
| + (puthash filename `(,(strip-null-hash hash-before) . |
| + ,(strip-null-hash hash-after)) |
| + hashes) |
| + (puthash filename (cond (renamed "A +") |
| + ((not hash-before) "A") |
| + ((not hash-after) "D") |
| + (t "M")) |
| + statuses) |
| + ; Keep track of base contents for the file |
| + (let* ((base (cond (renamed (get-file-content |
| + (concat "HEAD:" filename))) |
| + ((not hash-before) "") |
| + (t (get-file-content filename)))) |
| + (base-binary (or (is-image? filename) |
| + (is-binary? base)))) |
| + (puthash filename base base-contents) |
| + ; Keep track of new content if required |
| + (when hash-after |
| + (let* ((new (get-file-content hash-after)) |
| + (binary-p (or base-binary (is-binary? new)))) |
| + (when binary-p |
| + (puthash filename t binary-ps) |
| + (puthash filename new new-contents))))))))) |
| + ; Finally return the diff itself! |
| + (buffer-string))) |
| +; FIXME - Test all this: renames, permission changes, deletions, additions |
| +; modifications, binary files, image files, svg files |
| +; huge patch sets |
| +; FIXME - Port the logic to split up huge patch sets from upload.py |
| + |
| +(defun base-hashes () |
| + (let ((hashes ())) |
| + (dolist (filename filenames) |
| + (let ((contents (gethash filename base-contents))) |
| + (when contents |
| + (push (concat filename ":" (md5 contents)) hashes)))) |
| + (string-join hashes "|"))) |
| + |
| +(defun magit-rietveld-submit-review () |
| + (interactive) |
| + (let* ((rev (read-from-minibuffer "Revision: " (guess-rev))) |
| + (subject (read-from-minibuffer "Subject: ")) |
| + (diff-output (apply 'diff (split-string rev ":"))) |
| + ; Set up the web request |
| + (url-request-method "POST") |
| + (boundary "--M-A-G-I-T--R-I-E-T-V-E-L-D--") |
| + (url-request-extra-headers |
| + `(("Content-Type" . ,(concat "multipart/form-data; boundary=" |
| + boundary)) |
| + ("Authorization" . ,(concat "OAuth " auth-token)))) |
| + (fields `(("repo_guid" . ,(get-first-root-hash)) |
| + ("subject" . ,subject) |
| + ("description" . ,subject) |
| + ("base_hashes" . ,(base-hashes)) |
| + ("content_upload" . "1") |
| + ("base" . "FIXME: reponame @ base-rev"))) |
| + (files `(("data" "data.diff" "text/x-diff" ,diff-output))) |
| + (url-request-data (encode-multipart-form-data boundary fields files))) |
| + (url-retrieve-synchronously (concat magit-rietveld-server "/upload")))) |
| +; FIXME - Make use of (magit-diff "rev..rev") to display a diff before |
| +; submitting? |
| + |
| +(magit-define-popup magit-rietveld-popup |
| + "Popup console for magit rietveld commands." |
| + 'magit-rietveld |
| + :actions '((?r "Submit code review" magit-rietveld-submit-review)) |
| + :options '()) |
| +; FIXME - Add options for some of upload.py features: |
| +; specifying issue number, private, ... |
| + |
| +(magit-define-popup-action 'magit-dispatch-popup [?\C-c ?r] "Rietveld" |
| + 'magit-rietveld-popup) |
| + |
| +(define-key magit-mode-map [?\C-c ?r] 'magit-rietveld-popup) |