From e45cd87511eb9dda379a9b460b2dbc71aacff320 Mon Sep 17 00:00:00 2001 From: Philip McGrath Date: Fri, 5 Mar 2021 02:30:47 -0500 Subject: [PATCH] version/check: use https; actually enforce timeout; guard reading params Also, add an environment variable for testing purposes and document the fact that `check-version` may block. --- pkgs/racket-doc/version/version.scrbl | 23 +++++--- racket/collects/version/check.rkt | 83 ++++++++++++++++++++++----- 2 files changed, 84 insertions(+), 22 deletions(-) diff --git a/pkgs/racket-doc/version/version.scrbl b/pkgs/racket-doc/version/version.scrbl index 96b9a87234..d69587915c 100644 --- a/pkgs/racket-doc/version/version.scrbl +++ b/pkgs/racket-doc/version/version.scrbl @@ -1,6 +1,5 @@ -#lang scribble/doc -@(require scribble/manual - scribble/bnf +#lang scribble/manual +@(require scribble/bnf (for-label version/patchlevel version/check version/utils @@ -34,9 +33,9 @@ but may be updated by patches to DrRacket.} @defproc[(check-version) (or/c symbol? list?)]{ -Checks the currently available version on the PLT website -(@selflink["http://download.racket-lang.org"]) and returns a value that -indicates the current state of the current installation: +Checks the currently available version on the Racket website +(@selflink["https://download.racket-lang.org"]) and returns a value that +indicates the state of the current installation: @itemize[ @@ -65,7 +64,17 @@ indicates the current state of the current installation: @racket[(string-append message " " additional-info)] is a verbose one.} -]} +] + Note that, depending on network conditions, @racket[check-version] + may keep trying for a long time (currently 30 seconds) + before returning @racket['(error "timeout")]. + For testing purposes, when the environment variable + @indexed-envvar{PLT_CHECK_VERSION_SIMULATE_TIMEOUT} + is set, @racket[check-version] will simulate such network conditions, + @seclink["logging" #:doc '(lib "scribblings/reference/reference.scrbl")]{logging} + a @racket['warning]-level message with the topic @racket['version/check] + and then sleeping until the timeout. +} @; ---------------------------------------------------------------------- diff --git a/racket/collects/version/check.rkt b/racket/collects/version/check.rkt index 7bb9cbbb9d..065460503a 100644 --- a/racket/collects/version/check.rkt +++ b/racket/collects/version/check.rkt @@ -1,15 +1,20 @@ #lang racket/base (require net/url - racket/tcp + net/url-connect "utils.rkt") -(define version-url "http://download.racket-lang.org/version.txt") +(module+ test) ;; see below + +(define version-url "https://download.racket-lang.org/version.txt") (define timeout 30) +(define-logger version/check) + (define (url->port url) - (get-pure-port (string->url url) - #:redirections 5)) + (parameterize ([current-https-protocol 'secure]) + (get-pure-port (string->url url) + #:redirections 5))) (define error-value (case-lambda @@ -20,15 +25,22 @@ [else (format "(~a)" more)]))])) (define (with-timeout timeout thunk) - (define result #f) - (define r (sync/timeout timeout - (thread (λ () - (set! result - (with-handlers - ([void (λ (e) - (error-value "internal error" e))]) - (thunk))))))) - (if r result (error-value "timeout"))) + (define cust (make-custodian)) + (define ch (make-channel)) + (parameterize ([current-custodian cust]) + (thread + (λ () + (define result + (with-handlers ([void (λ (e) + (error-value "internal error" e))]) + (thunk))) + (channel-put ch result)))) + (cond + [(sync/timeout timeout ch)] + [else + (custodian-shutdown-all cust) + (log-version/check-info "killed thread due to timeout") + (error-value "timeout")])) (define (check-version-raw) (let/ec escape @@ -40,7 +52,14 @@ (parameterize ([current-input-port (try (url->port (format "~a?~a" version-url (version))) "could not connect to website")]) - (try (read) "unexpected response from server"))) + (when (simulate-timeout-for-testing?) + (log-version/check-warning + "starting to sleep due to PLT_CHECK_VERSION_SIMULATE_TIMEOUT") + (sleep (+ 5 timeout)) + (log-version/check-error + "internal error: thread was not killed after simulated timeout")) + (try (call-with-default-reading-parameterization read) + "unexpected response from server"))) (define (get key) (cond [(assq key version-info) => cadr] [else (err (format "no `~s' in response" key) version-info)])) @@ -93,7 +112,41 @@ (define (check-version) (with-timeout timeout check-version-raw)) +(define (simulate-timeout-for-testing?) + (getenv "PLT_CHECK_VERSION_SIMULATE_TIMEOUT")) + (module+ test (let ([result (check-version)]) (unless (eq? result 'ok) - (error 'check-version "failed due to non-ok result: ~v" result)))) + (error 'check-version "failed due to non-ok result: ~v" result))) + (parameterize ([current-environment-variables + (make-environment-variables + #"PLT_CHECK_VERSION_SIMULATE_TIMEOUT" #"1")]) + (define receiver + (make-log-receiver version/check-logger 'warning)) + (define result + (check-version)) + (define warning-message + (sync/timeout 0 receiver)) + (unless (equal? result '(error "timeout")) + (raise-arguments-error 'check-version "failed to simulate timeout" + "result" result + "logged message" warning-message)) + (unless warning-message + (error 'check-version "failed to log a message before simulating timeout")) + (unless (and (vector? warning-message) + (eq? 'warning (vector-ref warning-message 0)) + (eq? 'version/check (vector-ref warning-message 3))) + (raise-arguments-error + 'check-version + "unexpected log message while simulating timeout" + "expected" (unquoted-printing-string + "topic 'version/check at level 'warning") + "received" warning-message)) + (cond + [(sync/timeout 7 receiver) + => (λ (msg) + (error 'check-version "~a;\n ~a\n ~a: ~e" + "unexpected log message" + "may have failed to kill thread after simulated timeout" + "message" msg))])))