From bbd24edb547f3230ebbe34e1a8c2d92d00d938fb Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Sun, 28 Apr 2013 07:18:53 -0600 Subject: [PATCH] Making github API keys part of the remote-package-checksum API so that the official catalog won't be blocked during routine updates --- collects/meta/pkg-index/official/main.rkt | 37 ++++++++++++------- collects/meta/pkg-index/sync.sh | 2 +- collects/pkg/util.rkt | 44 ++++++++++++++--------- 3 files changed, 53 insertions(+), 30 deletions(-) diff --git a/collects/meta/pkg-index/official/main.rkt b/collects/meta/pkg-index/official/main.rkt index 2c60ad2a19..2867756c35 100644 --- a/collects/meta/pkg-index/official/main.rkt +++ b/collects/meta/pkg-index/official/main.rkt @@ -48,10 +48,8 @@ (define users.new-path (build-path root "users.new")) (make-directory* users.new-path) -(define (client_id) - (file->string (build-path root "client_id"))) -(define (client_secret) - (file->string (build-path root "client_secret"))) +(github-client_id (file->string (build-path root "client_id"))) +(github-client_secret (file->string (build-path root "client_secret"))) (define pkgs-path (build-path root "pkgs")) (make-directory* pkgs-path) @@ -708,9 +706,7 @@ (printf "\tupdating ~a\n" pkg-name) (define new-checksum (package-url->checksum - (package-ref i 'source) - (list (cons 'client_id (client_id)) - (cons 'client_secret (client_secret))))) + (package-ref i 'source))) (package-begin (define* i (hash-set i 'checksum @@ -763,7 +759,7 @@ (and (with-handlers ([exn:fail? (λ (x) #f)]) (begin - (download-package-source! + (download-package-source! (package-ref (package-info pkg) 'source) pd) #t)) @@ -852,10 +848,27 @@ (λ () (while true (printf "updating checksums\n") - (with-handlers ([exn:fail? void]) - (update-checksums #f (package-list))) - ;; update once per day based on whenever the server started - (sleep (* 24 60 60))))) + (let loop ([pkg*ts + (for/list ([pkg (in-list (package-list))]) + (cons pkg (thread (λ () (update-checksum #f pkg)))))] + [the-alarm + (alarm-evt (+ (current-inexact-milliseconds) + (* 1000 (* 24 60 60))))]) + (apply + sync + (handle-evt the-alarm + (λ _ + (for ([pkg*t (in-list pkg*ts)]) + (match-define (cons pkg t) pkg*t) + (when (thread-running? t) + (printf "~a checksum thread stalled\n" pkg) + (kill-thread t))))) + (for/list ([pkg*t (in-list pkg*ts)]) + (match-define (cons pkg t) pkg*t) + (handle-evt t + (λ _ + (printf "~a thread finished\n" pkg) + (loop (remove pkg*t pkg*ts) the-alarm))))))))) (serve/servlet main-dispatch #:command-line? #t diff --git a/collects/meta/pkg-index/sync.sh b/collects/meta/pkg-index/sync.sh index 2564e0cb74..6f3c4ff5f6 100755 --- a/collects/meta/pkg-index/sync.sh +++ b/collects/meta/pkg-index/sync.sh @@ -8,6 +8,6 @@ for i in official planet-compat ; do rsync -a --progress -h --delete plt-etc:local/galaxy/meta/pkg-index/$i/root/ $i/root/ done -rsync -a --progress -h --delete --exclude root --exclude compiled --exclude doc ../../pkg/ plt-etc:local/plt/collects/$i/ +rsync -a --progress -h --delete --exclude root --exclude compiled --exclude doc ../../pkg/ plt-etc:local/plt/collects/pkg/ rsync -a --progress -h --delete --exclude compiled ../../web-server ../../net plt-etc:local/plt/collects/ diff --git a/collects/pkg/util.rkt b/collects/pkg/util.rkt index 5087b3216e..1b43b9a7a2 100644 --- a/collects/pkg/util.rkt +++ b/collects/pkg/util.rkt @@ -48,6 +48,9 @@ rest] [_ rp]))) +(define github-client_id (make-parameter #f)) +(define github-client_secret (make-parameter #f)) + (define (package-url->checksum pkg-url-str [query empty] #:download-printf [download-printf void]) (define pkg-url @@ -60,23 +63,30 @@ (url "https" #f "api.github.com" #f #t (map (λ (x) (path/param x empty)) (list "repos" user repo "branches")) - query + (append query + (if (and (github-client_id) + (github-client_secret)) + (list (cons 'client_id (github-client_id)) + (cons 'client_secret (github-client_secret))) + empty)) #f)) (download-printf "Querying GitHub\n") (log-pkg-debug "Querying GitHub at ~a" (url->string api-u)) (define api-bs - (call/input-url+200 api-u port->bytes - #:headers (list (format "User-Agent: raco-pkg/~a" (version))))) + (call/input-url+200 + api-u port->bytes + #:headers (list (format "User-Agent: raco-pkg/~a" (version))))) (unless api-bs (error 'package-url->checksum - "Could not connect to GitHub")) + "Could not connect to GitHub" + (url->string api-u))) (define branches (read-json (open-input-bytes api-bs))) (unless (and (list? branches) (andmap hash? branches) (andmap (λ (b) (hash-has-key? b 'name)) branches) (andmap (λ (b) (hash-has-key? b 'commit)) branches)) - (error 'package-url->checksum + (error 'package-url->checksum "Invalid response from Github: ~e" api-bs)) (for/or ([b (in-list branches)]) @@ -99,14 +109,14 @@ (parameterize ([current-custodian c]) (get-pure-port/headers url #:redirections 25 #:status? #t))) (begin0 - (and (string=? "200" (substring hs 9 12)) - (handler p)) - (close-input-port p))) + (and (string=? "200" (substring hs 9 12)) + (handler p)) + (close-input-port p))) (lambda () (custodian-shutdown-all c)))) (define (read-from-server who url pred - [failure + [failure (lambda (s) (error who (~a "bad response from server\n" @@ -116,13 +126,13 @@ s))]) (define bytes (call-with-url url port->bytes)) ((if bytes - (with-handlers ([exn:fail:read? (lambda (exn) - (lambda () (failure bytes)))]) - (define v (read (open-input-bytes bytes))) - (lambda () - (if (pred v) - v - (failure bytes)))) - (lambda () (failure #f))))) + (with-handlers ([exn:fail:read? (lambda (exn) + (lambda () (failure bytes)))]) + (define v (read (open-input-bytes bytes))) + (lambda () + (if (pred v) + v + (failure bytes)))) + (lambda () (failure #f))))) (provide (all-defined-out))