TakeV/guix
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

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
;;; 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 © 2019 Arun Isaac <arunisaac@systemreboot.net>
;;; Copyright © 2019 Efraim Flashner <efraim@flashner.co.il>
@ -30,15 +30,16 @@ (define-module (guix import github)
#:use-module (guix utils)
#:use-module (guix i18n)
#:use-module (guix diagnostics)
#:use-module ((guix ui) #:select (display-hint))
#:use-module ((guix download) #:prefix download:)
#:use-module ((guix git-download) #:prefix download:)
#:use-module (guix import utils)
#:use-module (guix import json)
#:use-module (json)
#:use-module (guix packages)
#:use-module (guix upstream)
#:use-module (guix http-client)
#:use-module (web uri)
#:use-module (web response)
#:export (%github-api %github-updater))
;; For tests.
@ -140,6 +141,33 @@ (define %github-token
;; limit, or #f.
(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)
"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),
@ -170,20 +198,49 @@ (define headers
`((Authorization . ,(string-append "token " (%github-token))))
'())))
(guard (c ((and (http-get-error? c)
(= 404 (http-get-error-code c)))
(warning (G_ "~a is unreachable (~a)~%")
release-url (http-get-error-code c))
'#())) ;return an empty release set
(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.
(json-fetch tag-url #:headers headers))
(x x)))))
(and (not (request-rate-limit-reached?))
(guard (c ((and (http-get-error? c)
(= 404 (http-get-error-code c)))
(warning (G_ "~a is unreachable (~a)~%")
(uri->string (http-get-error-uri c))
(http-get-error-code c))
'#()) ;return an empty release set
((and (http-get-error? c)
(= 403 (http-get-error-code c)))
;; See
;; <https://docs.github.com/en/rest/overview/resources-in-the-rest-api#rate-limiting>.
(match (assq-ref (http-get-error-headers c)
'x-ratelimit-remaining)
(#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)
"Return the newest released version and its tag given a string URL like
@ -223,23 +280,16 @@ (define (release->version release)
(cons tag tag))
(else #f))))
(let* ((json (and=> (fetch-releases-or-tags url)
vector->list)))
(if (eq? json #f)
(if (%github-token)
(error "Error downloading release information through the GitHub
API when using a GitHub token")
(error "Error downloading release information through the GitHub
API. This may be fixed by using an access token and setting the environment
variable GUIX_GITHUB_TOKEN, for instance one procured from
https://github.com/settings/tokens"))
(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))))))
(match (and=> (fetch-releases-or-tags url) vector->list)
(#f (values #f #f))
(json
(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)
"Return an <upstream-source> for the latest release of PKG."