From 1ef1d256f7a8bfc5922891325458591d2ae73a62 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 26 Apr 2013 11:14:50 -0600 Subject: [PATCH] raco pkg: don't consult GitHub if checksum is given Also, more consistently propagate a given checksum, which can happen more through the `pkg-install' export from `pkg/lib' than through `raco pkg'. Also, report to the user when consulting GitHub or downloading a checksum. --- collects/pkg/lib.rkt | 28 +++++++++++++++++----------- collects/pkg/util.rkt | 9 +++++++-- collects/tests/pkg/tests-update.rkt | 6 +++--- 3 files changed, 27 insertions(+), 16 deletions(-) diff --git a/collects/pkg/lib.rkt b/collects/pkg/lib.rkt index f5ab4749fb..492508d821 100644 --- a/collects/pkg/lib.rkt +++ b/collects/pkg/lib.rkt @@ -350,12 +350,13 @@ (hash 'source (db:pkg-source pkg) 'checksum (db:pkg-source pkg)))) -(define (remote-package-checksum pkg) +(define (remote-package-checksum pkg download-printf) (match pkg [`(catalog ,pkg-name) (hash-ref (package-catalog-lookup pkg-name #f) 'checksum)] [`(url ,pkg-url-str) - (package-url->checksum pkg-url-str)])) + (package-url->checksum pkg-url-str + #:download-printf download-printf)])) (define (read-file-hash file) (define the-db @@ -633,20 +634,20 @@ (not (regexp-match? #rx"^github://" pkg))) ;; Add "github://github.com/" (stage-package/info (string-append "github://github.com/" pkg) type - pkg-name #:given-checksum given-checksum + pkg-name + #:given-checksum given-checksum check-sums? download-printf)] [(or (eq? type 'file-url) (eq? type 'dir-url) (eq? type 'github)) (define pkg-url (string->url pkg)) (define scheme (url-scheme pkg-url)) (define orig-pkg `(url ,pkg)) - (define checksum (remote-package-checksum orig-pkg)) + (define checksum (or given-checksum + (remote-package-checksum orig-pkg download-printf))) (define info (update-install-info-orig-pkg (match type ['github - (when given-checksum - (set! checksum given-checksum)) (unless checksum (pkg-error (~a "could not find checksum for github package source, which implies it doesn't exist\n" @@ -688,6 +689,7 @@ (stage-package/info (path->string package-path) 'dir pkg-name + #:given-checksum checksum check-sums? download-printf)) (λ () @@ -760,6 +762,7 @@ (stage-package/info package-path download-type pkg-name + #:given-checksum checksum check-sums? download-printf)) (λ () @@ -839,6 +842,7 @@ (stage-package/info pkg-dir 'dir pkg-name + #:given-checksum checksum check-sums? download-printf) `(file ,(simple-form-path* pkg))) @@ -910,6 +914,7 @@ #:force? [force? #f] #:quiet? [quiet? #f] descs) + (define download-printf (if quiet? void printf)) (define check-sums? (not ignore-checksums?)) (define db (read-pkg-db)) (define db+with-dbs @@ -1119,7 +1124,7 @@ ;; Try updates: (define update-pkgs (map car update-deps)) (define (make-pre-succeed) - (let ([to-update (filter-map update-package update-pkgs)]) + (let ([to-update (filter-map (update-package download-printf) update-pkgs)]) (λ () (for-each (compose (remove-package quiet?) pkg-desc-name) to-update)))) (match (or dep-behavior (if name? @@ -1175,7 +1180,7 @@ (define infos (for/list ([v (in-list descs)]) (stage-package/info (pkg-desc-source v) (pkg-desc-type v) (pkg-desc-name v) - check-sums? (if quiet? void printf)))) + check-sums? download-printf))) (define setup-collects (get-setup-collects (map install-info-directory (append old-infos infos)) metadata-ns)) @@ -1244,7 +1249,7 @@ (define ty (first orig-pkg)) (not (member ty '(link dir file)))) -(define (update-package pkg-name) +(define ((update-package download-printf) pkg-name) (match-define (pkg-info orig-pkg checksum auto?) (package-info pkg-name)) (match orig-pkg @@ -1266,7 +1271,7 @@ pkg-name)] [`(,_ ,orig-pkg-source) (define new-checksum - (remote-package-checksum orig-pkg)) + (remote-package-checksum orig-pkg download-printf)) (and new-checksum (not (equal? checksum new-checksum)) ;; FIXME: the type shouldn't be #f here; it should be @@ -1283,6 +1288,7 @@ #:dep-behavior [dep-behavior #f] #:deps? [deps? #f] #:quiet? [quiet? #f]) + (define download-printf (if quiet? void printf)) (define metadata-ns (make-metadata-namespace)) (define pkgs (cond @@ -1294,7 +1300,7 @@ in-pkgs)] [else in-pkgs])) - (define to-update (filter-map update-package pkgs)) + (define to-update (filter-map (update-package download-printf) pkgs)) (cond [(empty? to-update) (printf "No updates available\n") diff --git a/collects/pkg/util.rkt b/collects/pkg/util.rkt index f1f25df72d..5087b3216e 100644 --- a/collects/pkg/util.rkt +++ b/collects/pkg/util.rkt @@ -48,7 +48,8 @@ rest] [_ rp]))) -(define (package-url->checksum pkg-url-str [query empty]) +(define (package-url->checksum pkg-url-str [query empty] + #:download-printf [download-printf void]) (define pkg-url (string->url pkg-url-str)) (match (url-scheme pkg-url) @@ -61,6 +62,7 @@ (list "repos" user repo "branches")) query #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 @@ -81,7 +83,10 @@ (and (equal? (hash-ref b 'name) branch) (hash-ref (hash-ref b 'commit) 'sha)))] [_ - (call/input-url+200 (string->url (string-append pkg-url-str ".CHECKSUM")) + (define u (string-append pkg-url-str ".CHECKSUM")) + (download-printf "Downloading checksum\n") + (log-pkg-debug "Downloading checksum as ~a" u) + (call/input-url+200 (string->url u) port->string)])) ;; uses a custodian to avoid leaks: diff --git a/collects/tests/pkg/tests-update.rkt b/collects/tests/pkg/tests-update.rkt index 66a7712a7e..1b53a431c2 100644 --- a/collects/tests/pkg/tests-update.rkt +++ b/collects/tests/pkg/tests-update.rkt @@ -32,7 +32,7 @@ (shelly-install* "remote packages can be updated" "http://localhost:9999/update-test/pkg-test1.zip" "pkg-test1" - $ "raco pkg update pkg-test1" =exit> 0 =stdout> "No updates available\n" + $ "raco pkg update pkg-test1" =exit> 0 =stdout> "Downloading checksum\nNo updates available\n" $ "racket -e '(require pkg-test1/update)'" =exit> 42 $ "cp -f test-pkgs/pkg-test1-v2.zip test-pkgs/update-test/pkg-test1.zip" $ "cp -f test-pkgs/pkg-test1-v2.zip.CHECKSUM test-pkgs/update-test/pkg-test1.zip.CHECKSUM" @@ -50,7 +50,7 @@ "http://localhost:9999/update-test/pkg-test1.zip" "pkg-test1" $ "raco pkg install test-pkgs/pkg-test2.zip" - $ "raco pkg update --update-deps pkg-test2" =exit> 0 =stdout> "No updates available\n" + $ "raco pkg update --update-deps pkg-test2" =exit> 0 =stdout> "Downloading checksum\nNo updates available\n" $ "racket -e '(require pkg-test1/update)'" =exit> 42 $ "cp -f test-pkgs/pkg-test1-v2.zip test-pkgs/update-test/pkg-test1.zip" $ "cp -f test-pkgs/pkg-test1-v2.zip.CHECKSUM test-pkgs/update-test/pkg-test1.zip.CHECKSUM" @@ -69,7 +69,7 @@ "http://localhost:9999/update-test/pkg-test1.zip" "pkg-test1" $ "raco pkg install test-pkgs/pkg-test2.zip" - $ "raco pkg update -a" =exit> 0 =stdout> "No updates available\n" + $ "raco pkg update -a" =exit> 0 =stdout> "Downloading checksum\nNo updates available\n" $ "racket -e '(require pkg-test1/update)'" =exit> 42 $ "cp -f test-pkgs/pkg-test1-v2.zip test-pkgs/update-test/pkg-test1.zip" $ "cp -f test-pkgs/pkg-test1-v2.zip.CHECKSUM test-pkgs/update-test/pkg-test1.zip.CHECKSUM"