suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

raco pkg: make network-retries configurable

Browse Source
This commit is contained in:
Matthew Flatt 2015-09-11 14:46:37 -06:00
parent 29223aaed7
commit dcfb9cb972
6 changed files with 49 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
pkgs/racket-doc/pkg/scribblings/lib.scrbl
View File

@ -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)]{

5
pkgs/racket-doc/pkg/scribblings/pkg.scrbl
View File

@ -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} ...

2
racket/collects/pkg/lib.rkt
View File

@ -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?))))

20
racket/collects/pkg/private/config.rkt
View File

@ -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 "")])]))

27
racket/collects/pkg/private/network.rkt
View File

@ -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

2
racket/collects/pkg/private/params.rkt
View File

@ -32,3 +32,5 @@
(define current-pkg-trash-max-seconds
(make-parameter #f))
(define current-pkg-network-retries
(make-parameter #f))