git-authenticate: Keep a local cache of previously-authenticated commits.

A list of already-authenticated commits is kept in
~/.cache/guix/authentication.  This speeds up subsequent "make
authenticate" invocations.

* build-aux/git-authenticate.scm (authenticated-commit-cache-file)
(previously-authenticated-commits, cache-authenticated-commit): New
procedures.
(git-authenticate): Define 'authenticated-commits' and pass it as a
third argument to 'commit-difference'.  Add call to
'cache-authenticated-commit'.  Don't display signing stats when STATS is
null.
This commit is contained in:
Ludovic Courtès 2019-12-27 13:20:15 +01:00
parent 785af04a75
commit 787766ed1e
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5

View file

@ -24,6 +24,7 @@
(guix git) (guix git)
(guix gnupg) (guix gnupg)
(guix utils) (guix utils)
((guix build utils) #:select (mkdir-p))
(guix i18n) (guix i18n)
(guix progress) (guix progress)
(srfi srfi-1) (srfi srfi-1)
@ -31,8 +32,10 @@
(srfi srfi-26) (srfi srfi-26)
(srfi srfi-34) (srfi srfi-34)
(srfi srfi-35) (srfi srfi-35)
(rnrs io ports)
(ice-9 match) (ice-9 match)
(ice-9 format)) (ice-9 format)
(ice-9 pretty-print))
(define %committers (define %committers
@ -295,6 +298,49 @@ (define* (authenticate-commits repository commits
(define commit-short-id (define commit-short-id
(compose (cut string-take <> 7) oid->string commit-id)) (compose (cut string-take <> 7) oid->string commit-id))
;;;
;;; Caching.
;;;
(define (authenticated-commit-cache-file)
"Return the name of the file that contains the cache of
previously-authenticated commits."
(string-append (cache-directory) "/authentication/channels/guix"))
(define (previously-authenticated-commits)
"Return the previously-authenticated commits as a list of commit IDs (hex
strings)."
(catch 'system-error
(lambda ()
(call-with-input-file (authenticated-commit-cache-file)
read))
(lambda args
(if (= ENOENT (system-error-errno args))
'()
(apply throw args)))))
(define (cache-authenticated-commit commit-id)
"Record in ~/.cache COMMIT-ID and its closure as authenticated (only
COMMIT-ID is written to cache, though)."
(define %max-cache-length
;; Maximum number of commits in cache.
200)
(let ((lst (delete-duplicates
(cons commit-id (previously-authenticated-commits))))
(file (authenticated-commit-cache-file)))
(mkdir-p (dirname file))
(with-atomic-file-output file
(lambda (port)
(let ((lst (if (> (length lst) %max-cache-length)
(take lst %max-cache-length) ;truncate
lst)))
(chmod port #o600)
(display ";; List of previously-authenticated commits.\n\n"
port)
(pretty-print lst port))))))
;;; ;;;
;;; Entry point. ;;; Entry point.
@ -312,8 +358,19 @@ (define start-commit
(define end-commit (define end-commit
(commit-lookup repository (string->oid end))) (commit-lookup repository (string->oid end)))
(define authenticated-commits
;; Previously-authenticated commits that don't need to be checked
;; again.
(filter-map (lambda (id)
(false-if-exception
(commit-lookup repository (string->oid id))))
(previously-authenticated-commits)))
(define commits (define commits
(commit-difference end-commit start-commit)) ;; Commits to authenticate, excluding the closure of
;; AUTHENTICATED-COMMITS.
(commit-difference end-commit start-commit
authenticated-commits))
(define reporter (define reporter
(progress-reporter/bar (length commits))) (progress-reporter/bar (length commits)))
@ -327,14 +384,17 @@ (define reporter
(lambda (report) (lambda (report)
(authenticate-commits repository commits (authenticate-commits repository commits
#:report-progress report))))) #:report-progress report)))))
(format #t (G_ "Signing statistics:~%")) (cache-authenticated-commit (oid->string (commit-id end-commit)))
(for-each (match-lambda
((signer . count) (unless (null? stats)
(format #t " ~a ~10d~%" signer count))) (format #t (G_ "Signing statistics:~%"))
(sort stats (for-each (match-lambda
(match-lambda* ((signer . count)
(((_ . count1) (_ . count2)) (format #t " ~a ~10d~%" signer count)))
(> count1 count2))))))) (sort stats
(match-lambda*
(((_ . count1) (_ . count2))
(> count1 count2))))))))
((command start) ((command start)
(let* ((head (repository-head repository)) (let* ((head (repository-head repository))
(end (reference-target head))) (end (reference-target head)))