magit-rietveld.el - Issue 29331816: Hello world

Side by Side Diff: magit-rietveld.el

Issue 29331816: Hello world Base URL: FIXME: reponame @ base-rev

Patch Set: Second patchset Created Dec. 5, 2015, 5:22 p.m.

Left:
Right:

Use n/p to move between diff chunks; N/P to move between comments.

Jump to:

View unified diff | Download patch

OLD	NEW
(Empty)
	1 ;; -- lexical-binding: t --

	2 ;;; magit-rietveld.el --- Magit plugin for the Rietveld Code Review system

	3

	4 ;; Copyright (C) 2015 Dave Barker

	5

	6 ;; Author: Dave Barker <kzar@kzar.co.uk>

	7

	8 ;; Package-Requires: ((magit "2.1.0") (oauth2 "0.10"))

	9 ;; Keywords: git tools vc rietveld upload.py

	10 ;; Homepage: https://github.com/kzar/magit-rietveld

	11

	12 ;; This file is free software; you can redistribute it and/or modify it

	13 ;; under the terms of the GNU General Public License as published by the

	14 ;; Free Software Foundation; either version 3, or (at your option) any

	15 ;; later version.

	16 ;;

	17 ;; It is distributed in the hope that it will be useful, but WITHOUT

	18 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY

	19 ;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public

	20 ;; License for more details.

	21 ;;

	22 ;; You should have received a copy of the GNU General Public License

	23 ;; along with it. If not, see http://www.gnu.org/licenses.

	24

	25 ;;; Commentary:

	26

	27 ;; magit-rietveld.el is an interface for interacting with the Rietveld

	28 ;; code review system. The code is a elisp port of a small subset of the

	29 ;; upload.py script included with Rietveld, which will allow for more

	30 ;; convenient magit integration. Parts of this file are also derived from

	31 ;; the magit-gerrit code.

	32

	33 ;;; Usage:

	34

	35 ;; FIXME - write usage instructions!

	36

	37 ;;; Code:

	38

	39 (require 'magit)

	40

	41 ; FIXME - this should not be the default

	42 (defvar-local magit-rietveld-server "https://codereview.adblockplus.org")

	43

	44 (setq auth-token nil)

	45 (setq redirect-response "\

	46 HTTP/1.1 200 OK\r

	47 \r

	48 <html>

	49 <head>

	50 <script>window.onload = function () { window.close(); };</script>

	51 </head>

	52 <body>

	53 <p>Rietveld access token obtained, you can close this page.</p>

	54 </body>

	55 </html>")

	56

	57 (defun oauth-redirect-filter (connection string)

	58 (with-temp-buffer

	59 (insert string)

	60 (setq auth-token

	61 (and

	62 (search-backward-regexp "access_token=\$[^&[:space:]]+\$" nil t)

	63 (match-string 1)))

	64 (process-send-string connection redirect-response)

	65 (delete-process connection)

	66 (delete-process "oauth-redirect")))

	67

	68 (defun get-auth-token ()

	69 (make-network-process :name "oauth-redirect" :server t

	70 :service 8001 :family 'ipv4

	71 :filter 'oauth-redirect-filter)

	72 (browse-url (concat magit-rietveld-server "/get-access-token?port=8001"))

	73 (run-at-time 10 nil (lambda ()

	74 (when (process-status "oauth-redirect")

	75 (minibuffer-message

	76 "Timed out waiting for Rietveld oauth2 access token")

	77 (delete-process "oauth-redirect")))))

	78 ; FIXME - block waiting for this to finish, return the code or nil on timeout

	79 ; (Perhaps we should prompt for the auth code if the redirect flow fails?)

	80 (get-auth-token)

	81

	82 (defun encode-multipart-form-data (boundary fields files)

	83 (with-temp-buffer

	84 (dolist (field fields)

	85 (insert "--" boundary "\r\n")

	86 (insert "Content-Disposition: form-data; name=\""

	87 (car field) "\"" "\r\n" "\r\n")

	88 (insert (cdr field) "\r\n"))

	89 (dolist (file files)

	90 (insert "--" boundary "\r\n")

	91 (insert "Content-Disposition: form-data; name=\"" (car file) "\"; "

	92 "filename=\"" (cadr file) "\"\r\n")

	93 (insert "Content-Type: " (caddr file) "\r\n" "\r\n")

	94 (insert (cadddr file)))

	95 (insert "--" boundary "--\r\n\r\n")

	96 (buffer-string)))

	97

	98 (defun get-first-root-hash ()

	99 (with-temp-buffer

	100 (magit-git-insert "rev-list" "--parents" "HEAD")

	101 (and (search-backward-regexp "\\W\$[[:alnum:]]+\$" nil t)

	102 (match-string 1))))

	103

	104 (defun guess-rev ()

	105 (let* ((selected (magit-region-values))

	106 (branch (magit-get-current-branch))

	107 (current (magit-current-section)))

	108 (if (and current (eq (magit-section-type current) 'commit))

	109 (let ((current-rev (magit-section-value current)))

	110 (if (> (length selected) 1)

	111 (concat (car (last selected)) ":" (first selected))

	112 (concat current-rev "~:" current-rev)))

	113 ; FIXME - Check Branch / HEAD is after Master!

	114 ; (If not just suggest HEAD~:HEAD?)

	115 (concat "master:" (or branch "HEAD")))))

	116 ; FIXME - We need to check that they've chosen a valid range

	117 ; split by ":", (magit-rev-verify ...) on both

	118

	119 (defun strip-null-hash (hash)

	120 (let ((null-hash "0000000000000000000000000000000000000000"))

	121 (and (not (string= hash null-hash)) hash)))

	122

	123 ; FIXME - Is there no way to avoid all this global state? :(

	124 (setq filenames ())

	125 (setq statuses (make-hash-table :test 'equal))

	126 (setq hashes (make-hash-table :test 'equal))

	127 (setq renames (make-hash-table :test 'equal))

	128 (setq base-contents (make-hash-table :test 'equal))

	129 (setq new-contents (make-hash-table :test 'equal))

	130 (setq binary-ps (make-hash-table :test 'equal))

	131

	132 (defun reset-diff ()

	133 (setq filenames ())

	134 (mapc 'clrhash `(,statuses ,hashes ,renames ,base-contents

	135 ,new-contents ,binary-ps)))

	136

	137 (defun is-image? (filename)

	138 (and (string-match

	139 (rx "." (or "bmp" "gif" "ief" "jpe" "jpeg" "jpg" "pbm" "pgm" "png" "pnm"

	140 "ppm" "ras" "rgb" "tif" "tiff" "xbm" "xpm" "xwd" "jpg" "pct"

	141 "pic" "pict")

	142 eos)

	143 filename)

	144 t))

	145

	146 (defun is-binary? (contents)

	147 (and (search "\0" contents) t))

	148

	149 (defun get-file-content (hash)

	150 (with-temp-buffer

	151 (magit-git-insert "git" "show" hash)

	152 (buffer-string)))

	153

	154 (defun diff (rev-start rev-end)

	155 (reset-diff)

	156 (with-temp-buffer

	157 ; Insert the Git diff

	158 (let ((args '("diff" "--no-color" "--no-ext-diff" "--full-index"

	159 "--ignore-submodules" "--src-prefix=a/" "--dst-prefix=b/")))

	160 (apply 'magit-git-insert (append args '("--no-renames" "--diff-filter=D")

	161 `(,rev-start ,rev-end)))

	162 (apply 'magit-git-insert (append args '("--diff-filter=AMCRT" "-M50%")

	163 `(,rev-start ,rev-end))))

	164 ; Add Index: ... lines

	165 (beginning-of-buffer)

	166 (while (search-forward-regexp "^diff --git a/\$.\$ b/\$.\$$" nil t)

	167 (let ((filename-before (match-string 1))

	168 (filename (match-string 2)))

	169 (push filename filenames)

	170 ; Keep track of weather or not this file has been renamed

	171 (let ((renamed (not (string= filename-before filename))))

	172 (when renamed

	173 (puthash filename filename-before renames))

	174 (move-beginning-of-line 1)

	175 (insert (concat "Index: ") filename "\n")

	176 (move-end-of-line 2)

	177 ; Keep track of before & after hashes + statuses for this file

	178 (search-forward-regexp "^index \$\\w+\$\\.\\.\$\\w+\$$")

	179 (let ((hash-before (match-string 1))

	180 (hash-after (match-string 2)))

	181 (puthash filename `(,(strip-null-hash hash-before) .

	182 ,(strip-null-hash hash-after))

	183 hashes)

	184 (puthash filename (cond (renamed "A +")

	185 ((not hash-before) "A")

	186 ((not hash-after) "D")

	187 (t "M"))

	188 statuses)

	189 ; Keep track of base contents for the file

	190 (let* ((base (cond (renamed (get-file-content

	191 (concat "HEAD:" filename)))

	192 ((not hash-before) "")

	193 (t (get-file-content filename))))

	194 (base-binary (or (is-image? filename)

	195 (is-binary? base))))

	196 (puthash filename base base-contents)

	197 ; Keep track of new content if required

	198 (when hash-after

	199 (let* ((new (get-file-content hash-after))

	200 (binary-p (or base-binary (is-binary? new))))

	201 (when binary-p

	202 (puthash filename t binary-ps)

	203 (puthash filename new new-contents)))))))))

	204 ; Finally return the diff itself!

	205 (buffer-string)))

	206 ; FIXME - Test all this: renames, permission changes, deletions, additions

	207 ; modifications, binary files, image files, svg files

	208 ; huge patch sets

	209 ; FIXME - Port the logic to split up huge patch sets from upload.py

	210

	211 (defun base-hashes ()

	212 (let ((hashes ()))

	213 (dolist (filename filenames)

	214 (let ((contents (gethash filename base-contents)))

	215 (when contents

	216 (push (concat filename ":" (md5 contents)) hashes))))

	217 (string-join hashes "\|")))

	218

	219 (defun magit-rietveld-submit-review ()

	220 (interactive)

	221 (let* ((rev (read-from-minibuffer "Revision: " (guess-rev)))

	222 (subject (read-from-minibuffer "Subject: "))

	223 (diff-output (apply 'diff (split-string rev ":")))

	224 ; Set up the web request

	225 (url-request-method "POST")

	226 (boundary "--M-A-G-I-T--R-I-E-T-V-E-L-D--")

	227 (url-request-extra-headers

	228 `(("Content-Type" . ,(concat "multipart/form-data; boundary="

	229 boundary))

	230 ("Authorization" . ,(concat "OAuth " auth-token))))

	231 (fields `(("repo_guid" . ,(get-first-root-hash))

	232 ("subject" . ,subject)

	233 ("description" . ,subject)

	234 ("base_hashes" . ,(base-hashes))

	235 ("content_upload" . "1")

	236 ("base" . "FIXME: reponame @ base-rev")))

	237 (files `(("data" "data.diff" "text/x-diff" ,diff-output)))

	238 (url-request-data (encode-multipart-form-data boundary fields files)))

	239 (url-retrieve-synchronously (concat magit-rietveld-server "/upload"))))

	240 ; FIXME - Make use of (magit-diff "rev..rev") to display a diff before

	241 ; submitting?

	242

	243 (magit-define-popup magit-rietveld-popup

	244 "Popup console for magit rietveld commands."

	245 'magit-rietveld

	246 :actions '((?r "Submit code review" magit-rietveld-submit-review))

	247 :options '())

	248 ; FIXME - Add options for some of upload.py features:

	249 ; specifying issue number, private, ...

	250

	251 (magit-define-popup-action 'magit-dispatch-popup [?\C-c ?r] "Rietveld"

	252 'magit-rietveld-popup)

	253

	254 (define-key magit-mode-map [?\C-c ?r] 'magit-rietveld-popup)

OLD	NEW

« no previous file with comments | « no previous file | no next file » | no next file with comments »