├── .gitignore ├── README.md ├── audit.el └── screenshots ├── audit-status.png └── file-review.png /.gitignore: -------------------------------------------------------------------------------- 1 | *.elc 2 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | audit 2 | ===== 3 | 4 | Code auditing mode. 5 | 6 | ## Reviewing files 7 | 8 | Workflow: 9 | 10 | 1. Look at some code. If it's fine, run `M-x audit-ok`. This makes it 11 | go green. 12 | 2. If there is a problem with some code, run `M-x 13 | audit-comment`. Write a comment in the minibuffer and then you'll 14 | see an overlay of that comment in the file. 15 | 16 | A populated file, with both comments and good code looks like: 17 | 18 | ![file-review](screenshots/file-review.png) 19 | 20 | You can delete any audit section by going to it and running `M-x 21 | audit-delete`. 22 | 23 | Run `audit-refresh` if you open a file and you don't see audit 24 | overlays. 25 | 26 | ## Status buffer 27 | 28 | Switch to your project root directory and run `M-x audit-status`. You 29 | will get a buffer `*audit-status*`. Here is an example: 30 | 31 | ![audit-status](screenshots/audit-status.png) 32 | 33 | You can edit audit comments by going to the comment and hitting `e`. 34 | -------------------------------------------------------------------------------- /audit.el: -------------------------------------------------------------------------------- 1 | ;;; audit.el --- Audit codebases. 2 | 3 | ;; Copyright (c) 2018 Chris Done. All rights reserved. 4 | 5 | ;; This file is free software; you can redistribute it and/or modify 6 | ;; it under the terms of the GNU General Public License as published by 7 | ;; the Free Software Foundation; either version 3, or (at your option) 8 | ;; any later version. 9 | 10 | ;; This file is distributed in the hope that it will be useful, 11 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | ;; GNU General Public License for more details. 14 | 15 | ;; You should have received a copy of the GNU General Public License 16 | ;; along with this program. If not, see . 17 | 18 | ;;; Code: 19 | 20 | (require 'cl-lib) 21 | 22 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 23 | ;; Reviewing mode 24 | 25 | (defcustom audit-file-pattern "^[^.]" 26 | "Include only files that match this pattern. Applies to relative paths." 27 | :group 'audit) 28 | 29 | (defface audit-ok-face 30 | '((t :foreground "#a9b290" 31 | :background "#f8ffe5" 32 | :strike-through t 33 | :weight normal 34 | :underline nil)) 35 | "Face for code that is OK." 36 | :group 'audit) 37 | 38 | (defface audit-comment-face 39 | '((t :background "#fffae5")) 40 | "Face for code that has a comment." 41 | :group 'audit) 42 | 43 | (defface audit-heading-face 44 | '((t :background "#fcf0bf" 45 | :weight bold)) 46 | "Face for code that has a comment." 47 | :group 'audit) 48 | 49 | (defvar audit-mode-map (make-sparse-keymap) 50 | "Keymap for reviewing mode.") 51 | 52 | (defvar audit-cache (list) 53 | "Cache for all audit selections and comments.") 54 | 55 | (defvar audit-db-path "~/.emacs.d/audit-db.el" 56 | "Where to write the audit database.") 57 | 58 | (define-minor-mode audit-mode "Auditing global minor mode." 59 | :lighter " Audit" 60 | :keymap audit-mode-map 61 | :global t 62 | (if (bound-and-true-p audit-mode) 63 | (add-hook 'after-load-functions 'audit-refresh) 64 | (remove-hook 'after-load-functions 'audit-refresh))) 65 | 66 | (defun audit-cache () 67 | "Get the audit-cache, from disk if it's empty." 68 | (unless audit-cache (audit-load)) 69 | audit-cache) 70 | 71 | (defun audit-save () 72 | "Save the audit database." 73 | (interactive) 74 | (with-temp-file audit-db-path 75 | (insert (format "%S" (audit-cache))))) 76 | 77 | (defun audit-load () 78 | "Load the audit database." 79 | (interactive) 80 | (when (file-exists-p audit-db-path) 81 | (setq audit-cache 82 | (with-temp-buffer 83 | (insert-file-contents audit-db-path) 84 | (read (current-buffer)))))) 85 | 86 | (defun audit-comment (beg end) 87 | "Make a comment on a region." 88 | (interactive "r") 89 | (add-to-list 90 | 'audit-cache 91 | (list :file (buffer-file-name) 92 | :start beg 93 | :end end 94 | :commit (audit-git-commit) 95 | :type 'comment 96 | :comment (read-from-minibuffer "Comment: "))) 97 | (audit-save) 98 | (audit-refresh)) 99 | 100 | (defun audit-ok (beg end) 101 | "Mark a region OK." 102 | (interactive "r") 103 | (add-to-list 104 | 'audit-cache 105 | (list :file (buffer-file-name) 106 | :start beg 107 | :end end 108 | :commit (audit-git-commit) 109 | :type 'ok)) 110 | (audit-save) 111 | (audit-refresh)) 112 | 113 | (defun audit-delete () 114 | (interactive) 115 | (setq audit-cache 116 | (let ((overlays 117 | (mapcar 118 | (lambda (o) (overlay-get o 'audit-item)) 119 | (overlays-in (point) (1+ (point)))))) 120 | (cl-remove-if 121 | (lambda (item) 122 | (member item overlays)) 123 | audit-cache))) 124 | (audit-save) 125 | (audit-refresh)) 126 | 127 | (defun audit-refresh (&optional n) 128 | "Refresh the overlays in the current buffer." 129 | (interactive) 130 | (remove-overlays (point-min) (point-max) 'audit-overlay t) 131 | (mapc (lambda (note) 132 | (when (string= (plist-get note :file) (buffer-file-name)) 133 | (let ((o (make-overlay 134 | (save-excursion 135 | (goto-char (plist-get note :start)) 136 | (line-beginning-position)) 137 | (save-excursion 138 | (goto-char (plist-get note :end)) 139 | (1+ (line-end-position)))))) 140 | (overlay-put o 'audit-overlay t) 141 | (overlay-put o 'audit-item note) 142 | (overlay-put o 'priority 999999) 143 | (overlay-put o 'face 144 | (cl-case (plist-get note :type) 145 | (comment 'audit-comment-face) 146 | (ok 'audit-ok-face))) 147 | (when (plist-get note :comment) 148 | (overlay-put o 'before-string 149 | (propertize 150 | (with-temp-buffer 151 | (insert (plist-get note :comment)) 152 | (fill-paragraph) 153 | (insert "\n") 154 | (buffer-string)) 155 | 'face 156 | 'audit-heading-face)))))) 157 | (audit-cache))) 158 | 159 | (defun audit-git-commit () 160 | "Get the current commit." 161 | (let* ((cmd "git rev-parse HEAD") 162 | (branch (audit-git-shell-line cmd))) 163 | (if (not branch) 164 | (error "Failed: %s" cmd) 165 | (replace-regexp-in-string "\\`refs/heads/" "" branch)))) 166 | 167 | (defun audit-git-shell-line (cmd) 168 | "Run a command on the shell and return the first line." 169 | (car (split-string 170 | (shell-command-to-string cmd) 171 | "\n"))) 172 | 173 | (defun audit-export-markdown () 174 | "Export to markdown." 175 | (interactive) 176 | (let ((root default-directory) 177 | (pkg (read-from-minibuffer "Package: ")) 178 | (ver (read-from-minibuffer "Version: "))) 179 | (switch-to-buffer-other-window (get-buffer-create "*audit-report*")) 180 | (erase-buffer) 181 | (let* ((inhibit-read-only t) 182 | (items (cl-remove-if 183 | (lambda (item) 184 | (or (eq 'ok (plist-get item :type)) 185 | (string-match "^\\.\\." (file-relative-name (plist-get item :file) root)))) 186 | (audit-cache))) 187 | (files (audit-status-calculate-files root))) 188 | (erase-buffer) 189 | (insert "# Audit\n\n" 190 | "Package: " pkg "\n\n" 191 | "Version: " ver "\n\n" 192 | "SHA256: " (replace-regexp-in-string 193 | "[ ]+-" "" 194 | (shell-command-to-string "find . -type f | xargs sha256sum | sha256sum")) "\n" 195 | "Date-Completed: " (format-time-string "%Y-%m-%d") "\n\n" 196 | "Comments: " (number-to-string (length items)) "\n\n" 197 | ) 198 | (insert (format "## Verify this audit 199 | 200 | Verify the document: 201 | 202 | $ git clone https://github.com/chrisdone/audits 203 | $ cd audits 204 | $ keybase pgp verify -i haskell/%s/%s.md -d haskell/%s/%s.sig 205 | 206 | Verify the SHA256 of the package contents: 207 | 208 | $ stack unpack %s-%s 209 | $ cd %s-%s 210 | $ find . -type f | xargs sha256sum | sha256sum 211 | " 212 | pkg ver pkg ver pkg ver pkg ver)) 213 | (insert "\n##Summary\n\n") 214 | (insert "## Files\n\n") 215 | (audit-status-list-files files) 216 | (insert "\n## Comments\n\n")) 217 | (let ((comments nil)) 218 | (mapc (lambda (item) 219 | (let ((absolute-file (plist-get item :file))) 220 | (let ((relative-file (file-relative-name absolute-file root))) 221 | (when (and (not (string-match "^\\.\\.[\\/]" relative-file)) 222 | (string-match audit-file-pattern relative-file)) 223 | (when absolute-file 224 | (let* ((file (plist-get item :file)) 225 | (start (plist-get item :start)) 226 | (end (plist-get item :end)) 227 | (type (plist-get item :type)) 228 | (buffer (find-file-noselect file)) 229 | (line-start 230 | (with-current-buffer buffer 231 | (goto-char start) 232 | (line-number-at-pos))) 233 | (line-end 234 | (with-current-buffer buffer 235 | (goto-char end) 236 | (line-number-at-pos))) 237 | ;; (url 238 | ;; (with-current-buffer buffer 239 | ;; (set-mark start) 240 | ;; (goto-char end) 241 | ;; (github-urls-current-file-url))) 242 | (sample 243 | (with-current-buffer buffer 244 | (buffer-substring start end))) 245 | (comment (plist-get item :comment)) 246 | (relative-file (file-relative-name file root))) 247 | (when (string-match audit-file-pattern relative-file) 248 | (unless (eq type 'ok) 249 | (setq comments t) 250 | (insert (format "### L%d\n\n@%s:%d\n\n%s\n\n```haskell\n%s\n```\n" 251 | line-start 252 | relative-file 253 | line-start 254 | ;; url 255 | comment 256 | sample)))))))))) 257 | (audit-cache)) 258 | (unless comments 259 | (insert "No comments."))))) 260 | 261 | (defun audit-sha256-files (files) 262 | "Get the SHA256 of all the files and then SHA256 that." 263 | (with-temp-buffer 264 | (cl-case (apply #'call-process 265 | "sha256sum" 266 | nil 267 | (list (current-buffer) nil) 268 | (mapcar (lambda (p) (plist-get p :relative-file)) files)) 269 | (0 (goto-char (point-min)) 270 | (shell-command-on-region 271 | (point-min) 272 | (point-max) 273 | "sha256sum" 274 | nil 275 | t) 276 | (replace-regexp-in-string "[ ]*-" "" (buffer-string))) 277 | (1 nil)))) 278 | 279 | (define-derived-mode audit-status-mode 280 | help-mode "Audit-Status" 281 | "Major mode for audit-status. 282 | \\{audit-status-mode-map}" 283 | (setq buffer-read-only t)) 284 | 285 | (define-key audit-status-mode-map (kbd "g") 'audit-status) 286 | (define-key audit-status-mode-map (kbd "e") 'audit-status-edit) 287 | (define-key audit-status-mode-map (kbd "k") 'audit-status-ok) 288 | 289 | (define-derived-mode audit-list-mode 290 | help-mode "Audit-List" 291 | "Major mode for audit-list. 292 | \\{audit-list-mode-map}" 293 | (setq buffer-read-only t)) 294 | 295 | (define-key audit-list-mode-map (kbd "g") 'audit-list) 296 | (define-key audit-list-mode-map (kbd "e") 'audit-list-edit) 297 | (define-key audit-list-mode-map (kbd "k") 'audit-list-ok) 298 | 299 | (defun audit-status-edit () 300 | (interactive) 301 | (let ((item (get-text-property (point) 'audit-status-item))) 302 | (setq audit-cache 303 | (mapcar (lambda (this) 304 | (when (equal this item) 305 | (plist-put 306 | this 307 | :comment 308 | (read-from-minibuffer 309 | "Comment: " 310 | (plist-get this :comment)))) 311 | this) 312 | audit-cache)) 313 | (audit-save) 314 | (audit-status))) 315 | 316 | (defun audit-list-edit () 317 | (interactive) 318 | (let ((item (get-text-property (point) 'audit-status-item))) 319 | (setq audit-cache 320 | (mapcar (lambda (this) 321 | (when (equal this item) 322 | (plist-put 323 | this 324 | :comment 325 | (read-from-minibuffer 326 | "Comment: " 327 | (plist-get this :comment)))) 328 | this) 329 | audit-cache)) 330 | (audit-save) 331 | (audit-list))) 332 | 333 | (defun audit-status-ok () 334 | (interactive) 335 | (let ((item (get-text-property (point) 'audit-status-item))) 336 | (setq audit-cache 337 | (mapcar (lambda (this) 338 | (when (equal this item) 339 | (plist-put this :type 'ok) 340 | (plist-put this :comment nil)) 341 | this) 342 | audit-cache)) 343 | (audit-save) 344 | (audit-status))) 345 | 346 | (defun audit-list-ok () 347 | (interactive) 348 | (let ((item (get-text-property (point) 'audit-status-item))) 349 | (setq audit-cache 350 | (mapcar (lambda (this) 351 | (when (equal this item) 352 | (plist-put this :type 'ok) 353 | (plist-put this :comment nil)) 354 | this) 355 | audit-cache)) 356 | (audit-save) 357 | (audit-list))) 358 | 359 | (defun audit-status () 360 | "Display a status buffer of all non-OK review comments." 361 | (interactive) 362 | (let ((root default-directory)) 363 | (unless (string= (buffer-name) 364 | "*audit-status*") 365 | (switch-to-buffer-other-window (get-buffer-create "*audit-status*"))) 366 | (setq default-directory root) 367 | (audit-status-mode) 368 | (let* ((inhibit-read-only t) 369 | (items (cl-remove-if 370 | (lambda (item) 371 | (or (eq 'ok (plist-get item :type)) 372 | (string-match "^\\.\\." (file-relative-name (plist-get item :file) root)))) 373 | (audit-cache))) 374 | (files (audit-status-calculate-files root))) 375 | (erase-buffer) 376 | (insert "Audit for directory: " root "\n" 377 | "Comments: " 378 | (number-to-string (length items)) 379 | "\n" 380 | "Progress: " 381 | (if files 382 | (format "%2.1f%%" 383 | (min 100 384 | (/ (cl-reduce '+ 385 | (mapcar (lambda (x) (plist-get x :percent)) files) 386 | :initial-value 0.0) 387 | (length files)))) 388 | "No files") 389 | "\n\n") 390 | (insert "Recent items:\n\n") 391 | (audit-status-list-items root items 3) 392 | (insert "Files:\n\n") 393 | (audit-status-list-files files) 394 | (goto-char (point-min))) 395 | (message "Audit refreshed."))) 396 | 397 | (defun audit-list () 398 | "Display all non-OK review comments." 399 | (interactive) 400 | (let ((root default-directory)) 401 | (unless (string= (buffer-name) 402 | "*audit-list*") 403 | (switch-to-buffer-other-window (get-buffer-create "*audit-list*"))) 404 | (setq default-directory root) 405 | (audit-list-mode) 406 | (let* ((inhibit-read-only t) 407 | (items (cl-remove-if 408 | (lambda (item) 409 | (or (eq 'ok (plist-get item :type)) 410 | (string-match "^\\.\\." (file-relative-name (plist-get item :file) root)))) 411 | (audit-cache))) 412 | (files (audit-status-calculate-files root))) 413 | (let ((line (line-number-at-pos))) 414 | (erase-buffer) 415 | (insert "Audit for directory: " root "\n" 416 | "Comments: " 417 | (number-to-string (length items)) 418 | "\n\n") 419 | (audit-status-list-items root items (length items)) 420 | (goto-char (point-min)) 421 | (forward-line (1- line)))) 422 | (message "Audit refreshed."))) 423 | 424 | (defun audit-status-list-files (files) 425 | "Insert the list of files." 426 | (mapc 427 | (lambda (stats) 428 | (insert (format " %4.0f%% %4d / %4d " 429 | (min 100 (plist-get stats :percent)) 430 | (plist-get stats :inspected-lines) 431 | (plist-get stats :file-lines))) 432 | (let ((button (insert-button (plist-get stats :relative-file)))) 433 | (button-put button 'path (plist-get stats :absolute-file)) 434 | (button-put 435 | button 'action 436 | (lambda (button) 437 | (let ((file (button-get button 'path))) 438 | (find-file-other-window file) 439 | (audit-refresh))))) 440 | (insert "\n")) 441 | (sort files 442 | (lambda (x y) 443 | (let ((p1 (plist-get x :percent)) 444 | (p2 (plist-get y :percent))) 445 | (or (< p1 p2) 446 | (when (= p1 p2) 447 | (< (plist-get x :file-lines) 448 | (plist-get y :file-lines))))))))) 449 | 450 | (defun audit-status-list-items (root items count) 451 | "List N items." 452 | (mapc (lambda (item) 453 | (when (plist-get item :file) 454 | (let* ((file (plist-get item :file)) 455 | (start (plist-get item :start)) 456 | (end (plist-get item :end)) 457 | (type (plist-get item :type)) 458 | (buffer (find-file-noselect file)) 459 | (line-start 460 | (with-current-buffer buffer 461 | (goto-char start) 462 | (line-number-at-pos))) 463 | (line-end 464 | (with-current-buffer buffer 465 | (goto-char end) 466 | (line-number-at-pos))) 467 | (sample 468 | (with-current-buffer buffer 469 | (buffer-substring start end))) 470 | (comment (plist-get item :comment))) 471 | (unless (eq type 'ok) 472 | (let ((button (insert-button (file-relative-name file root)))) 473 | (button-put button 'path (cons (file-relative-name file root) line-start)) 474 | (button-put button 'action 475 | (lambda (button) 476 | (let ((file-line (button-get button 'path))) 477 | (find-file-other-window (car file-line)) 478 | (goto-char (point-min)) 479 | (forward-line (1- (cdr file-line))))))) 480 | (insert (format ":%d" line-start) 481 | "\n" 482 | (with-temp-buffer 483 | (insert (propertize 484 | (concat (or comment "No comment.") "\n") 485 | 'audit-status-item item 486 | 'face 'audit-heading-face)) 487 | (fill-paragraph) 488 | (buffer-string)) 489 | (with-temp-buffer 490 | (insert sample) 491 | (delete-trailing-whitespace (point-min) (point-max)) 492 | (buffer-substring (point-min) (min (point-max) 128))) 493 | "\n\n"))))) 494 | (let ((list (cl-remove-if (lambda (item) (eq 'ok (plist-get item :type))) items))) 495 | (cl-subseq 496 | list 497 | 0 498 | (min (length list) count))))) 499 | 500 | (defun audit-status-calculate-files (root) 501 | (cl-remove-if-not 502 | #'identity 503 | (mapcar 504 | (lambda (absolute-file) 505 | (let ((relative-file (file-relative-name absolute-file root))) 506 | (when (string-match audit-file-pattern relative-file) 507 | (when absolute-file 508 | (with-current-buffer (find-file-noselect absolute-file) 509 | (save-excursion 510 | (let* ((file-lines 511 | (progn 512 | (goto-char (point-max)) 513 | (setq lines (line-number-at-pos)))) 514 | (inspected-lines 515 | (cl-reduce 516 | '+ 517 | (mapcar 518 | (lambda (item) 519 | (let* ((start (plist-get item :start)) 520 | (end (plist-get item :end)) 521 | (type (plist-get item :type)) 522 | (line-start 523 | (progn 524 | (goto-char start) 525 | (line-number-at-pos))) 526 | (line-end 527 | (progn 528 | (goto-char end) 529 | (line-number-at-pos)))) 530 | (1+ (- line-end line-start)))) 531 | (cl-remove-if-not 532 | (lambda (item) 533 | (string= (plist-get item :file) (buffer-file-name))) 534 | (audit-cache))) 535 | :initial-value 0))) 536 | (list 537 | :percent (* 100.0 (/ (float inspected-lines) (float file-lines))) 538 | :relative-file relative-file 539 | :absolute-file absolute-file 540 | :file-lines file-lines 541 | :inspected-lines (min file-lines inspected-lines))))))))) 542 | (directory-files-recursively root ".*")))) 543 | 544 | ;;;;;;;;;;;;;;;;;;;;; 545 | ;; Introduced in 25.1 546 | 547 | (when (not (fboundp 'directory-files-recursively)) 548 | (defun directory-files-recursively (dir match &optional include-directories) 549 | "Return all files under DIR that have file names matching MATCH (a regexp). 550 | This function works recursively. Files are returned in \"depth first\" 551 | and alphabetical order. 552 | If INCLUDE-DIRECTORIES, also include directories that have matching names." 553 | (let ((result nil) 554 | (files nil) 555 | ;; When DIR is "/", remote file names like "/method:" could 556 | ;; also be offered. We shall suppress them. 557 | (tramp-mode (and tramp-mode (file-remote-p dir)))) 558 | (dolist (file (sort (file-name-all-completions "" dir) 559 | 'string<)) 560 | (unless (member file '("./" "../")) 561 | (if (directory-name-p file) 562 | (let* ((leaf (substring file 0 (1- (length file)))) 563 | (full-file (expand-file-name leaf dir))) 564 | ;; Don't follow symlinks to other directories. 565 | (unless (file-symlink-p full-file) 566 | (setq result 567 | (nconc result (directory-files-recursively 568 | full-file match include-directories)))) 569 | (when (and include-directories 570 | (string-match match leaf)) 571 | (setq result (nconc result (list full-file))))) 572 | (when (string-match match file) 573 | (push (expand-file-name file dir) files))))) 574 | (nconc result (nreverse files))))) 575 | 576 | (when (not (fboundp 'directory-name-p)) 577 | (defsubst directory-name-p (name) 578 | "Return non-nil if NAME ends with a slash character." 579 | (and (> (length name) 0) 580 | (char-equal (aref name (1- (length name))) ?/)))) 581 | 582 | (provide 'audit) 583 | -------------------------------------------------------------------------------- /screenshots/audit-status.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/chrisdone-archive/audit/628e4ea041318fca328c2a8f6c03666adc251ea0/screenshots/audit-status.png -------------------------------------------------------------------------------- /screenshots/file-review.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/chrisdone-archive/audit/628e4ea041318fca328c2a8f6c03666adc251ea0/screenshots/file-review.png --------------------------------------------------------------------------------