ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 21:38:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

import: github: Gracefully handle rate limit exhaustion.

Browse source 
Previously, 'guix refresh' would literally crash when the rate limit was
reached due to the call to 'error'.  With this change, the updater
notices when the rate limit is reached and it turns itself into a no-op
until the rate limit has been reset.

When running "guix refresh" (with no arguments), the 'github' updater
gets used until the rate limit has been reached, after which "guix
refresh" automatically picks up the next valid updater, typically
'generic-git'.

* guix/import/github.scm (fetch-releases-or-tags): Use 'http-fetch'
directly instead of 'json-fetch' to let 'http-get-error?' exceptions
through.  Handle 403 errors with an 'X-RateLimit-Remaining' header.
(%rate-limit-reset-time): New variable.
(update-rate-limit-reset-time!, request-rate-limit-reached?): New
procedures.
(latest-released-version): Remove calls to 'error'.
This commit is contained in:
Ludovic Courtès 2022-03-03 17:35:21 +01:00
parent ecad9b2213
commit 55e8e283ae
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 83 additions and 33 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

116
guix/import/github.scm
View file

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com> ;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com>
;;; Copyright © 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2017-2020, 2022 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2018 Eric Bavier <bavier@member.fsf.org> ;;; Copyright © 2018 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2019 Arun Isaac <arunisaac@systemreboot.net> ;;; Copyright © 2019 Arun Isaac <arunisaac@systemreboot.net>
;;; Copyright © 2019 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2019 Efraim Flashner <efraim@flashner.co.il>
@ -30,15 +30,16 @@ (define-module (guix import github)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix i18n) #:use-module (guix i18n)
#:use-module (guix diagnostics) #:use-module (guix diagnostics)
#:use-module ((guix ui) #:select (display-hint))
#:use-module ((guix download) #:prefix download:) #:use-module ((guix download) #:prefix download:)
#:use-module ((guix git-download) #:prefix download:) #:use-module ((guix git-download) #:prefix download:)
#:use-module (guix import utils) #:use-module (guix import utils)
#:use-module (guix import json)
#:use-module (json) #:use-module (json)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix upstream) #:use-module (guix upstream)
#:use-module (guix http-client) #:use-module (guix http-client)
#:use-module (web uri) #:use-module (web uri)
#:use-module (web response)
#:export (%github-api %github-updater)) #:export (%github-api %github-updater))
;; For tests. ;; For tests.
@ -140,6 +141,33 @@ (define %github-token
;; limit, or #f. ;; limit, or #f.
(make-parameter (getenv "GUIX_GITHUB_TOKEN"))) (make-parameter (getenv "GUIX_GITHUB_TOKEN")))
(define %rate-limit-reset-time
;; Time (seconds since the Epoch, UTC) when the rate limit for GitHub
;; requests will be reset, or #f if the rate limit hasn't been reached.
#f)
(define (update-rate-limit-reset-time! headers)
"Update the rate limit reset time based on HEADERS, the HTTP response
headers."
(match (assq-ref headers 'x-ratelimit-reset)
((= string->number (? number? reset))
(set! %rate-limit-reset-time reset)
reset)
(_
;; This shouldn't happen.
(warning
(G_ "GitHub HTTP response lacks 'X-RateLimit-Reset' header~%"))
0)))
(define (request-rate-limit-reached?)
"Return true if the rate limit has been reached."
(and %rate-limit-reset-time
(match (< (car (gettimeofday)) %rate-limit-reset-time)
(#t #t)
(#f
(set! %rate-limit-reset-time #f)
#f))))
(define (fetch-releases-or-tags url) (define (fetch-releases-or-tags url)
"Fetch the list of \"releases\" or, if it's empty, the list of tags for the "Fetch the list of \"releases\" or, if it's empty, the list of tags for the
repository at URL. Return the corresponding JSON dictionaries (alists), repository at URL. Return the corresponding JSON dictionaries (alists),
@ -170,20 +198,49 @@ (define headers
`((Authorization . ,(string-append "token " (%github-token)))) `((Authorization . ,(string-append "token " (%github-token))))
'()))) '())))
(guard (c ((and (http-get-error? c) (and (not (request-rate-limit-reached?))
(= 404 (http-get-error-code c))) (guard (c ((and (http-get-error? c)
(warning (G_ "~a is unreachable (~a)~%") (= 404 (http-get-error-code c)))
release-url (http-get-error-code c)) (warning (G_ "~a is unreachable (~a)~%")
'#())) ;return an empty release set (uri->string (http-get-error-uri c))
(let* ((port (http-fetch release-url #:headers headers)) (http-get-error-code c))
(result (json->scm port))) '#()) ;return an empty release set
(close-port port) ((and (http-get-error? c)
(match result (= 403 (http-get-error-code c)))
(#() ;; See
;; We got the empty list, presumably because the user didn't use GitHub's ;; <https://docs.github.com/en/rest/overview/resources-in-the-rest-api#rate-limiting>.
;; "release" mechanism, but hopefully they did use Git tags. (match (assq-ref (http-get-error-headers c)
(json-fetch tag-url #:headers headers)) 'x-ratelimit-remaining)
(x x))))) (#f
(raise c))
((? (compose zero? string->number))
(let ((reset (update-rate-limit-reset-time!
(http-get-error-headers c))))
(warning (G_ "GitHub rate limit exceeded; \
disallowing requests for ~a seconds~%")
(- reset (car (gettimeofday))))
(display-hint (G_ "You can raise the rate limit by
setting the @env{GUIX_GITHUB_TOKEN} environment variable to a token obtained
from @url{https://github.com/settings/tokens} with your GitHub account.
Alternatively, you can wait until your rate limit is reset, or use the
@code{generic-git} updater instead."))
#f)) ;bail out
(_
(raise c)))))
(let* ((port (http-fetch release-url #:headers headers))
(result (json->scm port)))
(close-port port)
(match result
(#()
;; We got the empty list, presumably because the user didn't use GitHub's
;; "release" mechanism, but hopefully they did use Git tags.
(let* ((port (http-fetch tag-url #:headers headers))
(json (json->scm port)))
(close-port port)
json))
(x x))))))
(define (latest-released-version url package-name) (define (latest-released-version url package-name)
"Return the newest released version and its tag given a string URL like "Return the newest released version and its tag given a string URL like
@ -223,23 +280,16 @@ (define (release->version release)
(cons tag tag)) (cons tag tag))
(else #f)))) (else #f))))
(let* ((json (and=> (fetch-releases-or-tags url) (match (and=> (fetch-releases-or-tags url) vector->list)
vector->list))) (#f (values #f #f))
(if (eq? json #f) (json
(if (%github-token) (match (sort (filter-map release->version
(error "Error downloading release information through the GitHub (match (remove pre-release? json)
API when using a GitHub token") (() json) ; keep everything
(error "Error downloading release information through the GitHub (releases releases)))
API. This may be fixed by using an access token and setting the environment (lambda (x y) (version>? (car x) (car y))))
variable GUIX_GITHUB_TOKEN, for instance one procured from (((latest-version . tag) . _) (values latest-version tag))
https://github.com/settings/tokens")) (() (values #f #f))))))
(match (sort (filter-map release->version
(match (remove pre-release? json)
(() json) ; keep everything
(releases releases)))
(lambda (x y) (version>? (car x) (car y))))
(((latest-version . tag) . _) (values latest-version tag))
(() (values #f #f))))))
(define (latest-release pkg) (define (latest-release pkg)
"Return an <upstream-source> for the latest release of PKG." "Return an <upstream-source> for the latest release of PKG."