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

* Updated `valid-version?' to restrict ranges of subparts

Browse Source 
* Added `version<=?' and `alpha-version?'
* updated checker for new file location, update code

svn: r10224
This commit is contained in:
Eli Barzilay 2008-06-11 19:17:02 +00:00
parent cb9dc018a7
commit 4785e86907
2 changed files with 29 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
collects/version/check.ss
View File

@ -1,8 +1,10 @@
#lang scheme/base
(define version-url "http://download.plt-scheme.org/version")
(define version-url "http://download.plt-scheme.org/version.txt")
(define timeout 30)
(require "utils.ss")
;; This file can be invoked from an installer, and in case it's
;; without zo files using net/url.ss is extremely slow. Instead, do
;; things directly.
@ -57,6 +59,11 @@
(define (get key)
(cond [(assq key version-info) => cadr]
[else (err (format "no `~s' in response" key) version-info)]))
(define (getver key)
(let ([ver (get key)])
(if (valid-version? ver)
ver
(err "bad version string from server" key))))
(unless (and (list? version-info)
(andmap (lambda (x)
(and (list? x)
@ -67,24 +74,19 @@
(err "bad response from server" version-info))
;; Make a decision
(let ([current (version)]
[stable (get 'stable)]
[recent (get 'recent)])
[stable (getver 'stable)]
[recent (getver 'recent)])
(cond
;; temporary hack, until v4 comes out
[(regexp-match? #rx"372" recent)
`(error "the download pages were not ported to v4 yet")]
;; we have the newest version (can be > if we have an svn build)
[(string>=? current recent) 'ok]
[(version<=? recent current) 'ok]
;; we're stable, but there's a newer version
[(string>=? current stable)
`(ok-but ,recent)]
[(version<=? stable current) `(ok-but ,recent)]
;; new version out -- no alphas or we have an alpha => show recent
;; (also for svn builds of a stable version -- anything with ".")
[(or (equal? recent stable)
(and (regexp-match #rx"[.]" current)
(and (alpha-version? current)
;; but if we have an alpha that is older then the current
;; stable then go to the next case
(string>=? current stable)))
(version<=? stable current)))
`(newer ,recent)]
;; new version out, we have an outdated stable, there is also an alpha
;; (alternatively, we have an alpha that is older than the current

17
collects/version/utils.ss
View File

@ -1,9 +1,13 @@
#lang scheme/base
(provide valid-version? version->list version<?)
(provide valid-version? version->list version<? version<=? alpha-version?)
(define rx:version
#px"^(0|[1-9][0-9]*)[.](0|(0|[1-9][0-9]*)([.](0|[1-9][0-9]*)){0,2}(?<![.]0))$")
;; (this restricts the last component to be below 999 too, which is
;; not really proper according to the spec in schvers.h)
(pregexp (string-append "^(0|[1-9][0-9]*)[.]"
"(0|(0|[1-9][0-9]{0,1})([.](0|[1-9][0-9]{0,2})){0,2}"
"(?<![.]0))$")))
(define (valid-version? s)
(and (string? s) (regexp-match? rx:version s)))
@ -17,6 +21,8 @@
[(4) ver]
[else (error 'version->list "bad version: ~e" str)])))
;; the following functions assume valid version string inputs
(define (version<? a b)
(let loop ([a (version->list a)]
[b (version->list b)])
@ -24,3 +30,10 @@
[(< (car a) (car b)) #t]
[(> (car a) (car b)) #f]
[else (loop (cdr a) (cdr b))])))
(define (version<=? a b)
(or (equal? a b) (version<? a b)))
(define (alpha-version? v)
(let ([l (version->list v)])
(or ((list-ref l 1) . >= . 90) ((list-ref l 2) . >= . 900))))