2010-02-14 07:03:15 -05:00
|
|
|
! Copyright (C) 2008, 2010 Slava Pestov.
|
2008-02-07 18:55:31 -05:00
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
2014-11-15 19:20:02 -05:00
|
|
|
USING: assocs bootstrap.image checksums checksums.md5
|
|
|
|
http.client io.files kernel splitting urls ;
|
2008-06-30 20:16:33 -04:00
|
|
|
IN: bootstrap.image.download
|
2008-02-07 18:55:31 -05:00
|
|
|
|
2010-09-27 23:29:09 -04:00
|
|
|
CONSTANT: url URL" http://downloads.factorcode.org/images/latest/"
|
2008-02-07 18:55:31 -05:00
|
|
|
|
|
|
|
: download-checksums ( -- alist )
|
2014-03-12 22:29:35 -04:00
|
|
|
url "checksums.txt" >url derive-url http-get nip
|
2008-02-07 18:55:31 -05:00
|
|
|
string-lines [ " " split1 ] { } map>assoc ;
|
|
|
|
|
2010-09-04 19:58:10 -04:00
|
|
|
: file-checksum ( image -- checksum )
|
|
|
|
md5 checksum-file hex-string ;
|
|
|
|
|
|
|
|
: download-checksum ( image -- checksum )
|
|
|
|
download-checksums at ;
|
|
|
|
|
2008-02-07 18:55:31 -05:00
|
|
|
: need-new-image? ( image -- ? )
|
|
|
|
dup exists?
|
2010-09-04 19:58:10 -04:00
|
|
|
[ [ file-checksum ] [ download-checksum ] bi = not ]
|
|
|
|
[ drop t ]
|
|
|
|
if ;
|
2008-02-07 18:55:31 -05:00
|
|
|
|
2010-05-25 17:15:55 -04:00
|
|
|
: verify-image ( image -- )
|
|
|
|
need-new-image? [ "Boot image corrupt" throw ] when ;
|
|
|
|
|
|
|
|
: download-image ( image -- )
|
|
|
|
[ url swap >url derive-url download ]
|
|
|
|
[ verify-image ]
|
|
|
|
bi ;
|
|
|
|
|
|
|
|
: maybe-download-image ( image -- ? )
|
2014-11-15 19:20:02 -05:00
|
|
|
dup need-new-image? [ download-image t ] [ drop f ] if ;
|
2010-05-25 17:15:55 -04:00
|
|
|
|
|
|
|
: download-my-image ( -- )
|
2014-11-15 19:20:02 -05:00
|
|
|
my-boot-image-name maybe-download-image drop ;
|
2008-02-09 01:16:24 -05:00
|
|
|
|
|
|
|
MAIN: download-my-image
|