| 1 | ;;; GNU Guix --- Functional package management for GNU |
| 2 | ;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org> |
| 3 | ;;; |
| 4 | ;;; This file is part of GNU Guix. |
| 5 | ;;; |
| 6 | ;;; GNU Guix is free software; you can redistribute it and/or modify it |
| 7 | ;;; under the terms of the GNU General Public License as published by |
| 8 | ;;; the Free Software Foundation; either version 3 of the License, or (at |
| 9 | ;;; your option) any later version. |
| 10 | ;;; |
| 11 | ;;; GNU Guix is distributed in the hope that it will be useful, but |
| 12 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of |
| 13 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 14 | ;;; GNU General Public License for more details. |
| 15 | ;;; |
| 16 | ;;; You should have received a copy of the GNU General Public License |
| 17 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. |
| 18 | |
| 19 | ;;; |
| 20 | ;;; Authenticate a range of commits. |
| 21 | ;;; |
| 22 | |
| 23 | (use-modules (git) |
| 24 | (guix git) |
| 25 | (guix gnupg) |
| 26 | (guix utils) |
| 27 | ((guix build utils) #:select (mkdir-p)) |
| 28 | (guix i18n) |
| 29 | (guix progress) |
| 30 | (srfi srfi-1) |
| 31 | (srfi srfi-11) |
| 32 | (srfi srfi-26) |
| 33 | (srfi srfi-34) |
| 34 | (srfi srfi-35) |
| 35 | (rnrs io ports) |
| 36 | (ice-9 match) |
| 37 | (ice-9 format) |
| 38 | (ice-9 pretty-print)) |
| 39 | |
| 40 | \f |
| 41 | (define %committers |
| 42 | ;; List of committers. These are the user names found on |
| 43 | ;; <https://savannah.gnu.org/project/memberlist.php?group=guix> along with |
| 44 | ;; the fingerprint of the signing (sub)key. |
| 45 | ;; |
| 46 | ;; TODO: Replace this statically-defined list by an in-repo list. |
| 47 | '(("andreas" |
| 48 | "AD17 A21E F8AE D8F1 CC02 DBD9 F7D5 C9BF 765C 61E3") |
| 49 | ("ajgrf" |
| 50 | "2A39 3FFF 68F4 EF7A 3D29 12AF 6F51 20A0 22FB B2D5") |
| 51 | ("alexvong1995" |
| 52 | "306F CB8F 2C01 C25D 29D3 0556 61EF 502E F602 52F2") |
| 53 | ("alezost" |
| 54 | "4FB9 9F49 2B12 A365 7997 E664 8246 0C08 2A0E E98F") |
| 55 | ("ambrevar" |
| 56 | "50F3 3E2E 5B0C 3D90 0424 ABE8 9BDC F497 A4BB CC7F") |
| 57 | ("apteryx" |
| 58 | "27D5 86A4 F890 0854 329F F09F 1260 E464 82E6 3562") |
| 59 | ("arunisaac" |
| 60 | "7F73 0343 F2F0 9F3C 77BF 79D3 2E25 EE8B 6180 2BB3") |
| 61 | ("atheia" |
| 62 | ;; primary: "3B12 9196 AE30 0C3C 0E90 A26F A715 5567 3271 9948" |
| 63 | "9A2B 401E D001 0650 1584 BAAC 8BC4 F447 6E8A 8E00") |
| 64 | ("bandali" |
| 65 | ;; primary: "BE62 7373 8E61 6D6D 1B3A 08E8 A21A 0202 4881 6103" |
| 66 | "39B3 3C8D 9448 0D2D DCC2 A498 8B44 A0CD C7B9 56F2") |
| 67 | ("bavier" |
| 68 | ;; primary: "34FF 38BC D151 25A6 E340 A0B5 3453 2F9F AFCA 8B8E" |
| 69 | "A0C5 E352 2EF8 EF5C 64CD B7F0 FD73 CAC7 19D3 2566") |
| 70 | ("beffa" |
| 71 | "3774 8024 880F D3FF DCA2 C9AB 5893 6E0E 2F1B 5A4C") |
| 72 | ("benwoodcroft" |
| 73 | "BCF8 F737 2CED 080A 67EB 592D 2A6A D9F4 AAC2 0DF6") |
| 74 | ("biscuolo" |
| 75 | "45CC 63B8 5258 C9D5 5F34 B239 D37D 0EA7 CECC 3912") |
| 76 | ("boskovits" |
| 77 | "7988 3B9F 7D6A 4DBF 3719 0367 2506 A96C CF63 0B21") |
| 78 | ("brettgilio" |
| 79 | "DFC0 C7F7 9EE6 0CA7 AE55 5E19 6722 43C4 A03F 0EEE") |
| 80 | ("carl" |
| 81 | ;; primary: "0401 7A2A 6D9A 0CCD C81D 8EC2 96AB 007F 1A7E D999" |
| 82 | "09CD D25B 5244 A376 78F6 EEA8 0CC5 2153 1979 91A5") |
| 83 | ("cbaines" |
| 84 | "3E89 EEE7 458E 720D 9754 E0B2 5E28 A33B 0B84 F577") |
| 85 | ("civodul" |
| 86 | "3CE4 6455 8A84 FDC6 9DB4 0CFB 090B 1199 3D9A EBB5") |
| 87 | ("cwebber" |
| 88 | "510A 8628 E2A7 7678 8F8C 709C 4BC0 2592 5FF8 F4D3") |
| 89 | ("dannym" |
| 90 | ;; primary: "295A F991 6F46 F8A1 34B0 29DA 8086 3842 F0FE D83B" |
| 91 | "76CE C6B1 7274 B465 C02D B3D9 E71A 3554 2C30 BAA5") |
| 92 | ("davexunit" |
| 93 | "B3C0 DB4D AD73 BA5D 285E 19AE 5143 0234 CEFD 87C3") |
| 94 | ("davexunit (2nd)" ;FIXME: to be confirmed! |
| 95 | "8CCB A7F5 52B9 CBEA E1FB 2915 8328 C747 0FF1 D807") |
| 96 | ("daviwil" |
| 97 | "53C4 1E6E 41AA FE55 335A CA5E 446A 2ED4 D940 BF14") |
| 98 | ("dvc" |
| 99 | "6909 6DFD D702 8BED ACC5 884B C5E0 51C7 9C0B ECDB") |
| 100 | ("dvc (old)" |
| 101 | "5F43 B681 0437 2F4B A898 A64B 33B9 E9FD E28D 2C23") |
| 102 | ("efraim" |
| 103 | "A28B F40C 3E55 1372 662D 14F7 41AA E7DC CA3D 8351") |
| 104 | ("efraim (old)" |
| 105 | "9157 41FE B22F A4E3 3B6E 8F8D F4C1 D391 7EAC EE93") |
| 106 | ("glv" |
| 107 | ;; primary: "2453 02B1 BAB1 F867 FDCA 96BC 8F3F 861F 82EB 7A9A" |
| 108 | "CBC5 9C66 EC27 B971 7940 6B3E 6BE8 208A DF21 FE3F") |
| 109 | ("hoebjo" |
| 110 | "2219 43F4 9E9F 276F 9499 3382 BF28 6CB6 593E 5FFD") |
| 111 | ("htgoebel" |
| 112 | "B943 509D 633E 80DD 27FC 4EED 634A 8DFF D3F6 31DF") |
| 113 | ("ipetkov" |
| 114 | "7440 26BA 7CA3 C668 E940 1D53 0B43 1E98 3705 6942") |
| 115 | ("iyzsong" |
| 116 | ;; primary: "66A5 6D9C 9A98 BE7F 719A B401 2652 5665 AE72 7D37" |
| 117 | "0325 78A6 8298 94E7 2AA2 66F5 D415 BF25 3B51 5976") |
| 118 | |
| 119 | ;; https://lists.gnu.org/archive/html/guix-devel/2018-04/msg00229.html |
| 120 | ("janneke (old)" |
| 121 | "DB34 CB51 D25C 9408 156F CDD6 A12F 8797 8D70 1B99") |
| 122 | ("janneke" |
| 123 | "1A85 8392 E331 EAFD B8C2 7FFB F3C1 A0D9 C1D6 5273") |
| 124 | |
| 125 | ("jlicht" |
| 126 | ;; primary: "1BA4 08C5 8BF2 0EA7 3179 635A 865D C0A3 DED9 B5D0" |
| 127 | "E31D 9DDE EBA5 4A14 8A20 4550 DA45 97F9 47B4 1025") |
| 128 | ("jmd" |
| 129 | "8797 A26D 0854 2EAB 0285 A290 8A67 719C 2DE8 27B3") |
| 130 | ("kkebreau" |
| 131 | "83B6 703A DCCA 3B69 4BCE 2DA6 E6A5 EE3C 1946 7A0D") |
| 132 | ("leungbk" |
| 133 | "45E5 75FA 53EA 8BD6 1BCE 0B4E 3ADC 75F0 13D6 78F9") |
| 134 | ("lfam" |
| 135 | ;; primary: "4F71 6F9A 8FA2 C80E F1B5 E1BA 5E35 F231 DE1A C5E0" |
| 136 | "B051 5948 F1E7 D3C1 B980 38A0 2646 FA30 BACA 7F08") |
| 137 | ("lsl88" |
| 138 | "2AE3 1395 932B E642 FC0E D99C 9BED 6EDA 32E5 B0BC") |
| 139 | ("marusich" |
| 140 | "CBF5 9755 CBE7 E7EF EF18 3FB1 DD40 9A15 D822 469D") |
| 141 | ("mbakke" |
| 142 | "BBB0 2DDF 2CEA F6A8 0D1D E643 A2A0 6DF2 A33A 54FA") |
| 143 | ("mhw" |
| 144 | "D919 0965 CE03 199E AF28 B3BE 7CEF 2984 7562 C516") |
| 145 | ("mothacehe" |
| 146 | "4008 6A7E 0252 9B60 31FB 8607 8354 7635 3176 9CA6") |
| 147 | ("mthl" |
| 148 | "F2A3 8D7E EB2B 6640 5761 070D 0ADE E100 9460 4D37") |
| 149 | ("nckx" |
| 150 | ;; primary: "F5BC 5534 C36F 0087 B39D 36EF 1C9D C4FE B9DB 7C4B" |
| 151 | "7E8F AED0 0944 78EF 72E6 4D16 D889 B0F0 18C5 493C") |
| 152 | ("nckx (2nd)" |
| 153 | ;; primary: "F5BC 5534 C36F 0087 B39D 36EF 1C9D C4FE B9DB 7C4B" |
| 154 | "F5DA 2032 4B87 3D0B 7A38 7672 0DB0 FF88 4F55 6D79") |
| 155 | ("niedzejkob" |
| 156 | "E576 BFB2 CF6E B13D F571 33B9 E315 A758 4613 1564") |
| 157 | ("ngz" |
| 158 | "ED0E F1C8 E126 BA83 1B48 5FE9 DA00 B4F0 48E9 2F2D") |
| 159 | ("pelzflorian" |
| 160 | "CEF4 CB91 4856 BA38 0A20 A7E2 3008 88CB 39C6 3817") |
| 161 | ("pgarlick" |
| 162 | ;; primary: "B68B DF22 73F9 DA0E 63C1 8A32 515B F416 9242 D600" |
| 163 | "C699 ED09 E51B CE89 FD1D A078 AAC7 E891 896B 568A") |
| 164 | ("phant0mas" |
| 165 | "3A86 380E 58A8 B942 8D39 60E1 327C 1EF3 8DF5 4C32") |
| 166 | ("reepca" |
| 167 | "74D6 A930 F44B 9B84 9EA5 5606 C166 AA49 5F7F 189C") |
| 168 | ("rekado" |
| 169 | "BCA6 89B6 3655 3801 C3C6 2150 197A 5888 235F ACAC") |
| 170 | ("rhelling" |
| 171 | "0154 E1B9 1CC9 D9EF 7764 8DE7 F3A7 27DB 44FC CA36") |
| 172 | ("roelj (old)" |
| 173 | "17CB 2812 EB63 3DFF 2C7F 0452 C3EC 1DCA 8430 72E1") |
| 174 | ("roelj" |
| 175 | ;; From commit cc51c03ff867d4633505354819c6d88af88bf919 (March 2020). |
| 176 | ;; See <https://lists.gnu.org/archive/html/guix-devel/2020-03/msg00070.html>. |
| 177 | "F556 FD94 FB8F 8B87 79E3 6832 CBD0 CD51 38C1 9AFC") |
| 178 | ("roptat (old)" |
| 179 | "B5FA E628 5B41 3728 B2A0 FAED 4311 1F45 2008 6A0C") |
| 180 | ("roptat" |
| 181 | ;; From commit 2cbede5935eb6a40173bbdf30a9ad22bf7574c22 (Jan. 2020). See |
| 182 | ;; <https://lists.gnu.org/archive/html/guix-devel/2020-01/msg00499.html>. |
| 183 | "1EFB 0909 1F17 D28C CBF9 B13A 53D4 57B2 D636 EE82") |
| 184 | ("samplet" |
| 185 | ;; primary: "D6B0 C593 DA8C 5EDC A44C 7A58 C336 91F7 1188 B004" |
| 186 | "A02C 2D82 0EF4 B25B A6B5 1D90 2AC6 A5EC 1C35 7C59") |
| 187 | ("sleep_walker" |
| 188 | "77DD AD2D 97F5 31BB C0F3 C7FD DFB5 EB09 AA62 5423") |
| 189 | ("snape" |
| 190 | "F494 72F4 7A59 00D5 C235 F212 89F9 6D48 08F3 59C7") |
| 191 | ("steap" |
| 192 | "4E26 CCE9 578E 0828 9855 BDD4 1C79 95D2 D5A3 8336") |
| 193 | ("taylanub" |
| 194 | "9ADE 9ECF 2B19 C180 9C99 5CEA A1F4 CFCC 5283 6BAC") |
| 195 | |
| 196 | ;; https://lists.gnu.org/archive/html/guix-devel/2017-03/msg00826.html |
| 197 | ("thomasd" |
| 198 | ;; primary: "1DD1 681F E285 E07F 11DC 0C59 2E15 A6BC D77D 54FD" |
| 199 | "3D2C DA58 819C 08C2 A649 D43D 5C3B 064C 724A 5726") |
| 200 | ("thomasd (old)" |
| 201 | "A5C5 92EA 606E 7106 A6A3 BC08 98B2 1575 91E1 2B08") |
| 202 | |
| 203 | ("toothbrush" |
| 204 | "D712 1D73 A40A 7264 9E43 ED7D F284 6B1A 0D32 C442") |
| 205 | ("vagrantc" |
| 206 | "6580 7361 3BFC C5C7 E2E4 5D45 DC51 8FC8 7F97 16AA") |
| 207 | ("wigust" |
| 208 | ;; primary: "C955 CC5D C048 7FB1 7966 40A9 199A F6A3 67E9 4ABB" |
| 209 | "7238 7123 8EAC EB63 4548 5857 167F 8EA5 001A FA9C") |
| 210 | ("wingo" |
| 211 | "FF47 8FB2 64DE 32EC 2967 25A3 DDC0 F535 8812 F8F2"))) |
| 212 | |
| 213 | (define %authorized-signing-keys |
| 214 | ;; Fingerprint of authorized signing keys. |
| 215 | (map (match-lambda |
| 216 | ((name fingerprint) |
| 217 | (string-filter char-set:graphic fingerprint))) |
| 218 | %committers)) |
| 219 | |
| 220 | (define %commits-with-bad-signature |
| 221 | ;; Commits with a known-bad signature. |
| 222 | '("6a34f4ccc8a5d4a48e25ad3c9c512f8634928b91")) ;2016-12-29 |
| 223 | |
| 224 | (define %unsigned-commits |
| 225 | ;; Commits lacking a signature. |
| 226 | '()) |
| 227 | |
| 228 | (define-syntax-rule (with-temporary-files file1 file2 exp ...) |
| 229 | (call-with-temporary-output-file |
| 230 | (lambda (file1 port1) |
| 231 | (call-with-temporary-output-file |
| 232 | (lambda (file2 port2) |
| 233 | exp ...))))) |
| 234 | |
| 235 | (define (commit-signing-key repo commit-id) |
| 236 | "Return the OpenPGP key ID that signed COMMIT-ID (an OID). Raise an |
| 237 | exception if the commit is unsigned or has an invalid signature." |
| 238 | (let-values (((signature signed-data) |
| 239 | (catch 'git-error |
| 240 | (lambda () |
| 241 | (commit-extract-signature repo commit-id)) |
| 242 | (lambda _ |
| 243 | (values #f #f))))) |
| 244 | (if (not signature) |
| 245 | (raise (condition |
| 246 | (&message |
| 247 | (message (format #f (G_ "commit ~a lacks a signature") |
| 248 | commit-id))))) |
| 249 | (begin |
| 250 | (with-fluids ((%default-port-encoding "UTF-8")) |
| 251 | (with-temporary-files data-file signature-file |
| 252 | (call-with-output-file data-file |
| 253 | (cut display signed-data <>)) |
| 254 | (call-with-output-file signature-file |
| 255 | (cut display signature <>)) |
| 256 | |
| 257 | (let-values (((status data) |
| 258 | (with-error-to-port (%make-void-port "w") |
| 259 | (lambda () |
| 260 | (gnupg-verify* signature-file data-file |
| 261 | #:key-download 'always))))) |
| 262 | (match status |
| 263 | ('invalid-signature |
| 264 | ;; There's a signature but it's invalid. |
| 265 | (raise (condition |
| 266 | (&message |
| 267 | (message (format #f (G_ "signature verification failed \ |
| 268 | for commit ~a") |
| 269 | (oid->string commit-id))))))) |
| 270 | ('missing-key |
| 271 | (raise (condition |
| 272 | (&message |
| 273 | (message (format #f (G_ "could not authenticate \ |
| 274 | commit ~a: key ~a is missing") |
| 275 | (oid->string commit-id) |
| 276 | data)))))) |
| 277 | ('valid-signature |
| 278 | (match data |
| 279 | ((fingerprint . user) |
| 280 | fingerprint))))))))))) |
| 281 | |
| 282 | (define (authenticate-commit repository commit) |
| 283 | "Authenticate COMMIT from REPOSITORY and return the signing key fingerprint. |
| 284 | Raise an error when authentication fails." |
| 285 | (define id |
| 286 | (commit-id commit)) |
| 287 | |
| 288 | (define signing-key |
| 289 | (commit-signing-key repository id)) |
| 290 | |
| 291 | (unless (member signing-key %authorized-signing-keys) |
| 292 | (raise (condition |
| 293 | (&message |
| 294 | (message (format #f (G_ "commit ~a not signed by an authorized \ |
| 295 | key: ~a") |
| 296 | (oid->string id) signing-key)))))) |
| 297 | |
| 298 | signing-key) |
| 299 | |
| 300 | (define* (authenticate-commits repository commits |
| 301 | #:key (report-progress (const #t))) |
| 302 | "Authenticate COMMITS, a list of commit objects, calling REPORT-PROGRESS for |
| 303 | each of them. Return an alist showing the number of occurrences of each key." |
| 304 | (parameterize ((current-keyring (string-append (config-directory) |
| 305 | "/keyrings/channels/guix.kbx"))) |
| 306 | (fold (lambda (commit stats) |
| 307 | (report-progress) |
| 308 | (let ((signer (authenticate-commit repository commit))) |
| 309 | (match (assoc signer stats) |
| 310 | (#f (cons `(,signer . 1) stats)) |
| 311 | ((_ . count) (cons `(,signer . ,(+ count 1)) |
| 312 | (alist-delete signer stats)))))) |
| 313 | '() |
| 314 | commits))) |
| 315 | |
| 316 | (define commit-short-id |
| 317 | (compose (cut string-take <> 7) oid->string commit-id)) |
| 318 | |
| 319 | \f |
| 320 | ;;; |
| 321 | ;;; Caching. |
| 322 | ;;; |
| 323 | |
| 324 | (define (authenticated-commit-cache-file) |
| 325 | "Return the name of the file that contains the cache of |
| 326 | previously-authenticated commits." |
| 327 | (string-append (cache-directory) "/authentication/channels/guix")) |
| 328 | |
| 329 | (define (previously-authenticated-commits) |
| 330 | "Return the previously-authenticated commits as a list of commit IDs (hex |
| 331 | strings)." |
| 332 | (catch 'system-error |
| 333 | (lambda () |
| 334 | (call-with-input-file (authenticated-commit-cache-file) |
| 335 | read)) |
| 336 | (lambda args |
| 337 | (if (= ENOENT (system-error-errno args)) |
| 338 | '() |
| 339 | (apply throw args))))) |
| 340 | |
| 341 | (define (cache-authenticated-commit commit-id) |
| 342 | "Record in ~/.cache COMMIT-ID and its closure as authenticated (only |
| 343 | COMMIT-ID is written to cache, though)." |
| 344 | (define %max-cache-length |
| 345 | ;; Maximum number of commits in cache. |
| 346 | 200) |
| 347 | |
| 348 | (let ((lst (delete-duplicates |
| 349 | (cons commit-id (previously-authenticated-commits)))) |
| 350 | (file (authenticated-commit-cache-file))) |
| 351 | (mkdir-p (dirname file)) |
| 352 | (with-atomic-file-output file |
| 353 | (lambda (port) |
| 354 | (let ((lst (if (> (length lst) %max-cache-length) |
| 355 | (take lst %max-cache-length) ;truncate |
| 356 | lst))) |
| 357 | (chmod port #o600) |
| 358 | (display ";; List of previously-authenticated commits.\n\n" |
| 359 | port) |
| 360 | (pretty-print lst port)))))) |
| 361 | |
| 362 | \f |
| 363 | ;;; |
| 364 | ;;; Entry point. |
| 365 | ;;; |
| 366 | |
| 367 | (define (git-authenticate args) |
| 368 | (define repository |
| 369 | (repository-open ".")) |
| 370 | |
| 371 | (let loop ((args args)) |
| 372 | (match args |
| 373 | ((_ start end) |
| 374 | (define start-commit |
| 375 | (commit-lookup repository (string->oid start))) |
| 376 | (define end-commit |
| 377 | (commit-lookup repository (string->oid end))) |
| 378 | |
| 379 | (define authenticated-commits |
| 380 | ;; Previously-authenticated commits that don't need to be checked |
| 381 | ;; again. |
| 382 | (filter-map (lambda (id) |
| 383 | (false-if-exception |
| 384 | (commit-lookup repository (string->oid id)))) |
| 385 | (previously-authenticated-commits))) |
| 386 | |
| 387 | (define commits |
| 388 | ;; Commits to authenticate, excluding the closure of |
| 389 | ;; AUTHENTICATED-COMMITS. |
| 390 | (commit-difference end-commit start-commit |
| 391 | authenticated-commits)) |
| 392 | |
| 393 | (define reporter |
| 394 | (progress-reporter/bar (length commits))) |
| 395 | |
| 396 | (format #t (G_ "Authenticating ~a to ~a (~a commits)...~%") |
| 397 | (commit-short-id start-commit) |
| 398 | (commit-short-id end-commit) |
| 399 | (length commits)) |
| 400 | |
| 401 | (let ((stats (call-with-progress-reporter reporter |
| 402 | (lambda (report) |
| 403 | (authenticate-commits repository commits |
| 404 | #:report-progress report))))) |
| 405 | (cache-authenticated-commit (oid->string (commit-id end-commit))) |
| 406 | |
| 407 | (unless (null? stats) |
| 408 | (format #t (G_ "Signing statistics:~%")) |
| 409 | (for-each (match-lambda |
| 410 | ((signer . count) |
| 411 | (format #t " ~a ~10d~%" signer count))) |
| 412 | (sort stats |
| 413 | (match-lambda* |
| 414 | (((_ . count1) (_ . count2)) |
| 415 | (> count1 count2)))))))) |
| 416 | ((command start) |
| 417 | (let* ((head (repository-head repository)) |
| 418 | (end (reference-target head))) |
| 419 | (loop (list command start (oid->string end))))) |
| 420 | (_ |
| 421 | (format (current-error-port) |
| 422 | (G_ "Usage: git-authenticate START [END] |
| 423 | |
| 424 | Authenticate commits START to END or the current head.\n")))))) |
| 425 | |
| 426 | ;;; Local Variables: |
| 427 | ;;; eval: (put 'with-temporary-files 'scheme-indent-function 2) |
| 428 | ;;; End: |