From 4785e8690779a3df911d1c4d45f43c7fcd976492 Mon Sep 17 00:00:00 2001
From: Eli Barzilay <eli@racket-lang.org>
Date: Wed, 11 Jun 2008 19:17:02 +0000
Subject: [PATCH] =?UTF-8?q?*=20Updated=20`valid-version=3F'=20to=20restric?=
 =?UTF-8?q?t=20ranges=20of=20subparts=20*=20Added=20`version<=3D=3F'=20and?=
 =?UTF-8?q?=20`alpha-version=3F'=20*=20updated=20checker=20for=20new=20fil?=
 =?UTF-8?q?e=20location,=20update=20code?=

svn: r10224
---
 collects/version/check.ss | 26 ++++++++++++++------------
 collects/version/utils.ss | 17 +++++++++++++++--
 2 files changed, 29 insertions(+), 14 deletions(-)

diff --git a/collects/version/check.ss b/collects/version/check.ss
index ed88e4ff41..993bd41729 100644
--- a/collects/version/check.ss
+++ b/collects/version/check.ss
@@ -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
diff --git a/collects/version/utils.ss b/collects/version/utils.ss
index a36aba10dc..ec70db66fb 100644
--- a/collects/version/utils.ss
+++ b/collects/version/utils.ss
@@ -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))))