From dcfb9cb972e543b76021b9674a794971e11f9d98 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 11 Sep 2015 14:46:37 -0600 Subject: [PATCH] raco pkg: make `network-retries` configurable --- pkgs/racket-doc/pkg/scribblings/lib.scrbl | 12 ++++++++++ pkgs/racket-doc/pkg/scribblings/pkg.scrbl | 5 ++++- racket/collects/pkg/lib.rkt | 2 ++ racket/collects/pkg/private/config.rkt | 20 ++++++++++++----- racket/collects/pkg/private/network.rkt | 27 ++++++++++++----------- racket/collects/pkg/private/params.rkt | 2 ++ 6 files changed, 49 insertions(+), 19 deletions(-) diff --git a/pkgs/racket-doc/pkg/scribblings/lib.scrbl b/pkgs/racket-doc/pkg/scribblings/lib.scrbl index 13cf6f6444..b32916016b 100644 --- a/pkgs/racket-doc/pkg/scribblings/lib.scrbl +++ b/pkgs/racket-doc/pkg/scribblings/lib.scrbl @@ -103,6 +103,18 @@ used. @history[#:added "6.1.1.6"]} +@deftogether[( +@defparam[current-pkg-network-retries max-retries (or/c #f real?)] +)]{ + +A parameter that determines the number of times to retry a network communication +that fails due to a connection error. If +a parameter's value is @racket[#f], then the user's configuration is +used. + +@history[#:added "6.2.900.17"]} + + @defproc[(pkg-directory [name string?] [#:cache cache (or/c #f (and/c hash? (not/c immutable?))) #f]) (or/c path-string? #f)]{ diff --git a/pkgs/racket-doc/pkg/scribblings/pkg.scrbl b/pkgs/racket-doc/pkg/scribblings/pkg.scrbl index c580f061d3..a44ec11f21 100644 --- a/pkgs/racket-doc/pkg/scribblings/pkg.scrbl +++ b/pkgs/racket-doc/pkg/scribblings/pkg.scrbl @@ -940,9 +940,12 @@ for @nonterm{key}. updated that its implementation is kept in the trash folder. Package implementations are removed from a trash folder only when another package is potentially added to the trash folder or @command-ref{empty-trash} is used.} + @item{@exec{network-retries} --- The number of times to retry a network communication that + fails due to a connection error.} ] -@history[#:changed "6.1.1.6" @elem{Added @exec{trash-max-packages} and @exec{trash-max-seconds}.}]} +@history[#:changed "6.1.1.6" @elem{Added @exec{trash-max-packages} and @exec{trash-max-seconds}.} + #:changed "6.2.900.17" @elem{Added @exec{network-retries}.}]} @subcommand{@command/toc{catalog-show} @nonterm{option} ... @nonterm{package-name} ... diff --git a/racket/collects/pkg/lib.rkt b/racket/collects/pkg/lib.rkt index f5589d499b..a4a51c8795 100644 --- a/racket/collects/pkg/lib.rkt +++ b/racket/collects/pkg/lib.rkt @@ -67,6 +67,8 @@ (parameter/c (or/c #f real?))] [current-pkg-trash-max-seconds (parameter/c (or/c #f real?))] + [current-pkg-network-retries + (parameter/c (or/c #f real?))] [pkg-directory (->* (string?) (#:cache (or/c #f (and/c hash? (not/c immutable?)))) diff --git a/racket/collects/pkg/private/config.rkt b/racket/collects/pkg/private/config.rkt index fc1c024af8..73e0feb3ce 100644 --- a/racket/collects/pkg/private/config.rkt +++ b/racket/collects/pkg/private/config.rkt @@ -33,6 +33,10 @@ (or (current-pkg-trash-max-seconds) (read-pkg-cfg/def 'trash-max-seconds))) +(define (get-network-retries) + (or (current-pkg-network-retries) + (read-pkg-cfg/def 'network-retries))) + (define (read-pkg-cfg/def k) ;; Lock is held for the current scope, but if ;; the key is not found in the current scope, @@ -51,6 +55,7 @@ ['download-cache-max-bytes (* 64 1024 1024)] ['trash-max-packages 512] ['trash-max-seconds (* 60 60 24 2)] ; 2 days + ['network-retries 5] [_ #f])) (define c (read-pkg-file-hash (pkg-config-file))) (define v (hash-ref c k 'none)) @@ -122,7 +127,8 @@ "download-cache-dir" "doc-open-url" "trash-max-packages" - "trash-max-seconds"))) + "trash-max-seconds" + "network-retries"))) (pkg-error (~a "missing value for config key\n" " config key: ~a") key)] @@ -134,7 +140,8 @@ "download-cache-dir" "doc-open-url" "trash-max-packages" - "trash-max-seconds")) + "trash-max-seconds" + "network-retries")) val another-val more-vals) @@ -173,7 +180,8 @@ [(list (and key (or "download-cache-max-files" "download-cache-max-bytes" "trash-max-packages" - "trash-max-seconds")) + "trash-max-seconds" + "network-retries")) val) (unless (real? (string->number val)) (pkg-error (~a "invalid value for config key\n" @@ -207,7 +215,8 @@ "download-cache-max-files" "download-cache-max-bytes" "trash-max-packages" - "trash-max-seconds") + "trash-max-seconds" + "network-retries") (printf "~a~a\n" indent (read-pkg-cfg/def (string->symbol key)))] ["doc-open-url" (printf "~a~a\n" indent (or (read-pkg-cfg/def 'doc-open-url) ""))] @@ -229,7 +238,8 @@ "download-cache-max-files" "download-cache-max-bytes" "trash-max-packages" - "trash-max-seconds"))]) + "trash-max-seconds" + "network-retries"))]) (printf "~a:\n" key) (show (list key) " "))] [_ (show key+vals "")])])) diff --git a/racket/collects/pkg/private/network.rkt b/racket/collects/pkg/private/network.rkt index 2415f5cbe1..7ee8ae3f8f 100644 --- a/racket/collects/pkg/private/network.rkt +++ b/racket/collects/pkg/private/network.rkt @@ -1,11 +1,11 @@ #lang racket/base (require net/url - "print.rkt") + "print.rkt" + "config.rkt") (provide call-with-network-retries call/input-url+200) -(define NETWORK-RETRY-COUNT 5) (define NETWORK-INITIAL-PAUSE 0.1) ;; Retry `thunk` on any `exn:fail:network` exception. A fresh @@ -13,17 +13,18 @@ ;; are reliably cleaned up (and cannt be allocated and returned ;; by `thunk`, except by using a different custodian). (define (call-with-network-retries thunk) - (let loop ([retries NETWORK-RETRY-COUNT] [pause-time NETWORK-INITIAL-PAUSE]) - (with-handlers ([exn:fail:network? (lambda (exn) - (cond - [(zero? retries) - (raise exn)] - [else - ;; Pause, then try again - (log-pkg-info "Network error; retrying after ~as" - pause-time) - (sleep pause-time) - (loop (sub1 retries) (* 2 pause-time))]))]) + (define retry-count (get-network-retries)) + (let loop ([retries 0] [pause-time NETWORK-INITIAL-PAUSE]) + (with-handlers* ([exn:fail:network? (lambda (exn) + (cond + [(retries . >= . retry-count) + (raise exn)] + [else + ;; Pause, then try again + (log-pkg-info "Network error; retrying after ~as" + pause-time) + (sleep pause-time) + (loop (add1 retries) (* 2 pause-time))]))]) (define c (make-custodian)) (parameterize ([current-custodian c]) (dynamic-wind diff --git a/racket/collects/pkg/private/params.rkt b/racket/collects/pkg/private/params.rkt index 541979f441..e99d25bef2 100644 --- a/racket/collects/pkg/private/params.rkt +++ b/racket/collects/pkg/private/params.rkt @@ -32,3 +32,5 @@ (define current-pkg-trash-max-seconds (make-parameter #f)) +(define current-pkg-network-retries + (make-parameter #f))