137e6b05aSAndre Fischer#!/usr/bin/perl
237e6b05aSAndre Fischer
337e6b05aSAndre Fischer=head1 NAME
437e6b05aSAndre Fischer
537e6b05aSAndre Fischer    download_external_libraries.pl - Load missing tarballs specified in main/external_libs.lst.
637e6b05aSAndre Fischer
737e6b05aSAndre Fischer=head1 SYNOPSIS
837e6b05aSAndre Fischer
937e6b05aSAndre Fischer    For downloading external libraries (typically from the main/bootstrap script):
10*6a22bca6SAndre Fischer
1137e6b05aSAndre Fischer    download_external_libraries(<data-file-name>);
1237e6b05aSAndre Fischer
1337e6b05aSAndre Fischer=head1 DESCRIPTION
1437e6b05aSAndre Fischer
1537e6b05aSAndre Fischer    The contents of the main/external_libs.lst file are used to determine the
1637e6b05aSAndre Fischer    external library tarballs that are missing from ext_sources/.
1737e6b05aSAndre Fischer
1837e6b05aSAndre Fischer    Individual libraries can be ignored depending on the values of environment variables.
1937e6b05aSAndre Fischer
2037e6b05aSAndre Fischer    Format of the main/external_libs.lst file:
2137e6b05aSAndre Fischer
2237e6b05aSAndre Fischer    The file is line based.
2337e6b05aSAndre Fischer    Comments start with a # and go to the end of the line and are ignored.
2437e6b05aSAndre Fischer    Lines that are empty or contain only spaces and/or comments are ignored.
2537e6b05aSAndre Fischer
2637e6b05aSAndre Fischer    All other lines can have one of two forms:
2737e6b05aSAndre Fischer    - A variable definition of the form <name>=<value>.
2837e6b05aSAndre Fischer    - A conditional block start in the form "if (<expression>)"
2937e6b05aSAndre Fischer
3037e6b05aSAndre Fischer    Variables defined in a conditional block are only visible in this block and
3137e6b05aSAndre Fischer    replace the definition of global variables and variables earlier in the same
3237e6b05aSAndre Fischer    block.
3337e6b05aSAndre Fischer    Some variables have special names:
3437e6b05aSAndre Fischer    - MD5 is the expected MD5 sum of the library tarball.
3537e6b05aSAndre Fischer    - URL1 to URL9 specify from where to download the tarball.  The urls are tried in order.
3637e6b05aSAndre Fischer      The first successful download (download completed and MD5 sum match) stops the iteration.
3737e6b05aSAndre Fischer
3837e6b05aSAndre Fischer    Expressions are explained below in the comment of EvaluateExpression().
3937e6b05aSAndre Fischer
4037e6b05aSAndre Fischer    A library is only regarded if its conditional expression evaluates to 1.
4137e6b05aSAndre Fischer
4237e6b05aSAndre Fischer    Example:
4337e6b05aSAndre Fischer
4437e6b05aSAndre Fischer    DefaultSite=http://some-internet-site.org
4537e6b05aSAndre Fischer    if ( true )
4637e6b05aSAndre Fischer        MD5 = 0123456789abcdef0123456789abcdef
4737e6b05aSAndre Fischer        name = library-1.0.tar.gz
4837e6b05aSAndre Fischer        URL1 = http://some-other-internet-site.org/another-name.tgz
4937e6b05aSAndre Fischer        URL2 = $(DefaultSite)$(MD5)-$(name)
5037e6b05aSAndre Fischer
5137e6b05aSAndre Fischer    This tries to load a library first from some-other-internet-site.org and if
5237e6b05aSAndre Fischer    that fails from some-internet-site.org.  The library is stored as $(MD5)-$(name)
5337e6b05aSAndre Fischer    even when it is loaded as another-name.tgz.
5437e6b05aSAndre Fischer
5537e6b05aSAndre Fischer=cut
5637e6b05aSAndre Fischer
5737e6b05aSAndre Fischer
5837e6b05aSAndre Fischeruse strict;
5937e6b05aSAndre Fischer
6037e6b05aSAndre Fischeruse File::Spec;
6137e6b05aSAndre Fischeruse File::Path;
6237e6b05aSAndre Fischeruse File::Basename;
6337e6b05aSAndre Fischeruse LWP::UserAgent;
6437e6b05aSAndre Fischeruse Digest::MD5;
6537e6b05aSAndre Fischeruse URI;
6637e6b05aSAndre Fischer
6737e6b05aSAndre Fischermy $Debug = 1;
6837e6b05aSAndre Fischer
6937e6b05aSAndre Fischermy $LocalEnvironment = undef;
7037e6b05aSAndre Fischermy $GlobalEnvironment = {};
7137e6b05aSAndre Fischermy @Missing = ();
7237e6b05aSAndre Fischer
7337e6b05aSAndre Fischer
7437e6b05aSAndre Fischer
7537e6b05aSAndre Fischer
7637e6b05aSAndre Fischer=head3 ProcessDataFile
77*6a22bca6SAndre Fischer
7837e6b05aSAndre Fischer    Read the data file, typically named main/external_libs.lst, find the external
7937e6b05aSAndre Fischer    library tarballs that are not yet present in ext_sources/ and download them.
8037e6b05aSAndre Fischer
8137e6b05aSAndre Fischer=cut
8237e6b05aSAndre Fischersub ProcessDataFile ($)
8337e6b05aSAndre Fischer{
8437e6b05aSAndre Fischer    my $filename = shift;
8537e6b05aSAndre Fischer
8637e6b05aSAndre Fischer    my $destination = $ENV{'TARFILE_LOCATION'};
8737e6b05aSAndre Fischer
8837e6b05aSAndre Fischer    die "can not open data file $filename" if ! -e $filename;
8937e6b05aSAndre Fischer
9037e6b05aSAndre Fischer    my $current_selector_value = 1;
9137e6b05aSAndre Fischer    my @URLHeads = ();
9237e6b05aSAndre Fischer    my @download_requests = ();
9337e6b05aSAndre Fischer
9437e6b05aSAndre Fischer    open my $in, $filename;
9537e6b05aSAndre Fischer    while (my $line = <$in>)
9637e6b05aSAndre Fischer    {
9737e6b05aSAndre Fischer        # Remove leading and trailing space and comments
9837e6b05aSAndre Fischer        $line =~ s/^\s+//;
9937e6b05aSAndre Fischer        $line =~ s/\s+$//;
10037e6b05aSAndre Fischer        $line =~ s/\s*#.*$//;
10137e6b05aSAndre Fischer
10237e6b05aSAndre Fischer        # Ignore empty lines.
10337e6b05aSAndre Fischer        next if $line eq "";
10437e6b05aSAndre Fischer
10537e6b05aSAndre Fischer        # An "if" statement starts a new block.
10637e6b05aSAndre Fischer        if ($line =~ /^\s*if\s*\(\s*(.*?)\s*\)\s*$/)
10737e6b05aSAndre Fischer        {
10837e6b05aSAndre Fischer            ProcessLastBlock();
109*6a22bca6SAndre Fischer
11037e6b05aSAndre Fischer            $LocalEnvironment = { 'selector' => $1 };
11137e6b05aSAndre Fischer        }
11237e6b05aSAndre Fischer
11337e6b05aSAndre Fischer        # Lines of the form name = value define a local variable.
11437e6b05aSAndre Fischer        elsif ($line =~ /^\s*(\S+)\s*=\s*(.*?)\s*$/)
11537e6b05aSAndre Fischer        {
11637e6b05aSAndre Fischer            if (defined $LocalEnvironment)
11737e6b05aSAndre Fischer            {
11837e6b05aSAndre Fischer                $LocalEnvironment->{$1} = $2;
11937e6b05aSAndre Fischer            }
12037e6b05aSAndre Fischer            else
12137e6b05aSAndre Fischer            {
12237e6b05aSAndre Fischer                $GlobalEnvironment->{$1} = $2;
12337e6b05aSAndre Fischer            }
12437e6b05aSAndre Fischer        }
12537e6b05aSAndre Fischer        else
12637e6b05aSAndre Fischer        {
12737e6b05aSAndre Fischer            die "can not parse line $line\n";
12837e6b05aSAndre Fischer        }
12937e6b05aSAndre Fischer    }
13037e6b05aSAndre Fischer
13137e6b05aSAndre Fischer    ProcessLastBlock();
132*6a22bca6SAndre Fischer
13337e6b05aSAndre Fischer    Download(\@download_requests, \@URLHeads);
13437e6b05aSAndre Fischer}
13537e6b05aSAndre Fischer
13637e6b05aSAndre Fischer
13737e6b05aSAndre Fischer
13837e6b05aSAndre Fischer
13937e6b05aSAndre Fischer=head3 ProcessLastBlock
14037e6b05aSAndre Fischer
14137e6b05aSAndre Fischer    Process the last definition of an external library.
14237e6b05aSAndre Fischer    If there is not last block, true for the first "if" statement, then the call is ignored.
14337e6b05aSAndre Fischer
14437e6b05aSAndre Fischer=cut
14537e6b05aSAndre Fischersub ProcessLastBlock ()
14637e6b05aSAndre Fischer{
14737e6b05aSAndre Fischer    # Return if no block is defined.
14837e6b05aSAndre Fischer    return if ! defined $LocalEnvironment;
149*6a22bca6SAndre Fischer
15037e6b05aSAndre Fischer    # Ignore the block if the selector does not match.
15137e6b05aSAndre Fischer    if ( ! EvaluateExpression(SubstituteVariables($LocalEnvironment->{'selector'})))
15237e6b05aSAndre Fischer    {
153*6a22bca6SAndre Fischer        printf("ignoring %s because its prerequisites are not fulfilled\n", GetValue('name'));
15437e6b05aSAndre Fischer    }
15537e6b05aSAndre Fischer    else
15637e6b05aSAndre Fischer    {
15737e6b05aSAndre Fischer        my $name = GetValue('name');
15837e6b05aSAndre Fischer
15937e6b05aSAndre Fischer        if ( ! IsPresent($name, GetValue('MD5')))
16037e6b05aSAndre Fischer        {
16137e6b05aSAndre Fischer            AddDownloadRequest($name);
16237e6b05aSAndre Fischer        }
16337e6b05aSAndre Fischer    }
16437e6b05aSAndre Fischer}
16537e6b05aSAndre Fischer
16637e6b05aSAndre Fischer
16737e6b05aSAndre Fischer
16837e6b05aSAndre Fischer
16937e6b05aSAndre Fischer=head3 AddDownloadRequest($name)
17037e6b05aSAndre Fischer
17137e6b05aSAndre Fischer    Add a request for downloading the library $name to @Missing.
17237e6b05aSAndre Fischer    Collect all available URL[1-9] variables as source URLs.
173*6a22bca6SAndre Fischer
17437e6b05aSAndre Fischer=cut
17537e6b05aSAndre Fischersub AddDownloadRequest ($)
17637e6b05aSAndre Fischer{
17737e6b05aSAndre Fischer    my $name = shift;
17837e6b05aSAndre Fischer
17937e6b05aSAndre Fischer    print "adding download request for $name\n";
18037e6b05aSAndre Fischer
18137e6b05aSAndre Fischer    my $urls = [];
18237e6b05aSAndre Fischer    my $url = GetValue('URL');
18337e6b05aSAndre Fischer    push @$urls, SubstituteVariables($url) if (defined $url);
18437e6b05aSAndre Fischer    for (my $i=1; $i<10; ++$i)
18537e6b05aSAndre Fischer    {
18637e6b05aSAndre Fischer        $url = GetValue('URL'.$i);
18737e6b05aSAndre Fischer        next if ! defined $url;
18837e6b05aSAndre Fischer        push @$urls, SubstituteVariables($url);
18937e6b05aSAndre Fischer    }
19037e6b05aSAndre Fischer
19137e6b05aSAndre Fischer    push @Missing, [$name, GetValue('MD5'), $urls];
19237e6b05aSAndre Fischer}
19337e6b05aSAndre Fischer
19437e6b05aSAndre Fischer
19537e6b05aSAndre Fischer
19637e6b05aSAndre Fischer
19737e6b05aSAndre Fischer=head3 GetValue($variable_name)
19837e6b05aSAndre Fischer
19937e6b05aSAndre Fischer    Return the value of the variable with name $variable_name from the local
20037e6b05aSAndre Fischer    environment or, if not defined there, the global environment.
20137e6b05aSAndre Fischer
20237e6b05aSAndre Fischer=cut
20337e6b05aSAndre Fischersub GetValue ($)
20437e6b05aSAndre Fischer{
20537e6b05aSAndre Fischer    my $variable_name = shift;
20637e6b05aSAndre Fischer
20737e6b05aSAndre Fischer    my $candidate = $LocalEnvironment->{$variable_name};
20837e6b05aSAndre Fischer    return $candidate if defined $candidate;
20937e6b05aSAndre Fischer
21037e6b05aSAndre Fischer    return $GlobalEnvironment->{$variable_name};
21137e6b05aSAndre Fischer}
21237e6b05aSAndre Fischer
21337e6b05aSAndre Fischer
21437e6b05aSAndre Fischer
21537e6b05aSAndre Fischer=head3 SubstituteVariables($text)
21637e6b05aSAndre Fischer
21737e6b05aSAndre Fischer    Replace all references to variables in $text with the respective variable values.
21837e6b05aSAndre Fischer    This is done repeatedly until no variable reference remains.
219*6a22bca6SAndre Fischer
22037e6b05aSAndre Fischer=cut
22137e6b05aSAndre Fischersub SubstituteVariables ($)
22237e6b05aSAndre Fischer{
22337e6b05aSAndre Fischer    my $text = shift;
22437e6b05aSAndre Fischer
22537e6b05aSAndre Fischer    my $infinite_recursion_guard = 100;
22637e6b05aSAndre Fischer    while ($text =~ /^(.*?)\$\(([^)]+)\)(.*)$/)
22737e6b05aSAndre Fischer    {
22837e6b05aSAndre Fischer        my ($head,$name,$tail) = ($1,$2,$3);
22937e6b05aSAndre Fischer        my $value = GetValue($name);
23037e6b05aSAndre Fischer        die "can evaluate variable $name" if ! defined $value;
23137e6b05aSAndre Fischer        $text = $head.$value.$tail;
23237e6b05aSAndre Fischer
23337e6b05aSAndre Fischer        die "(probably) detected an infinite recursion in variable definitions" if --$infinite_recursion_guard<=0;
23437e6b05aSAndre Fischer    }
23537e6b05aSAndre Fischer
23637e6b05aSAndre Fischer    return $text;
23737e6b05aSAndre Fischer}
23837e6b05aSAndre Fischer
23937e6b05aSAndre Fischer
24037e6b05aSAndre Fischer
24137e6b05aSAndre Fischer
24237e6b05aSAndre Fischer=head3 EvaluateExpression($expression)
24337e6b05aSAndre Fischer
24437e6b05aSAndre Fischer    Evaluate the $expression of an "if" statement to either 0 or 1.  It can
24537e6b05aSAndre Fischer    be a single term (see EvaluateTerm for a description), or several terms
246*6a22bca6SAndre Fischer    separated by either all ||s or &&s.  A term can also be an expression
247*6a22bca6SAndre Fischer    enclosed in parantheses.
248*6a22bca6SAndre Fischer
24937e6b05aSAndre Fischer=cut
25037e6b05aSAndre Fischersub EvaluateExpression ($)
25137e6b05aSAndre Fischer{
25237e6b05aSAndre Fischer    my $expression = shift;
25337e6b05aSAndre Fischer
254*6a22bca6SAndre Fischer    # Evaluate sub expressions enclosed in parantheses.
255*6a22bca6SAndre Fischer    while ($expression =~ /^(.*)\(([^\(\)]+)\)(.*)$/)
256*6a22bca6SAndre Fischer    {
257*6a22bca6SAndre Fischer        $expression = $1 . (EvaluateExpression($2) ? " true " : " false ") . $3;
258*6a22bca6SAndre Fischer    }
259*6a22bca6SAndre Fischer
26037e6b05aSAndre Fischer    if ($expression =~ /&&/ && $expression =~ /\|\|/)
26137e6b05aSAndre Fischer    {
262*6a22bca6SAndre Fischer        die "expression can contain either && or || but not both at the same time";
26337e6b05aSAndre Fischer    }
26437e6b05aSAndre Fischer    elsif ($expression =~ /&&/)
26537e6b05aSAndre Fischer    {
26637e6b05aSAndre Fischer        foreach my $term (split (/\s*&&\s*/,$expression))
26737e6b05aSAndre Fischer        {
26837e6b05aSAndre Fischer            return 0 if ! EvaluateTerm($term);
26937e6b05aSAndre Fischer        }
27037e6b05aSAndre Fischer        return 1;
27137e6b05aSAndre Fischer    }
27237e6b05aSAndre Fischer    elsif ($expression =~ /\|\|/)
27337e6b05aSAndre Fischer    {
27437e6b05aSAndre Fischer        foreach my $term (split (/\s*\|\|\s*/,$expression))
27537e6b05aSAndre Fischer        {
27637e6b05aSAndre Fischer            return 1 if EvaluateTerm($term);
27737e6b05aSAndre Fischer        }
27837e6b05aSAndre Fischer        return 0;
27937e6b05aSAndre Fischer    }
28037e6b05aSAndre Fischer    else
28137e6b05aSAndre Fischer    {
28237e6b05aSAndre Fischer        return EvaluateTerm($expression);
28337e6b05aSAndre Fischer    }
28437e6b05aSAndre Fischer}
28537e6b05aSAndre Fischer
28637e6b05aSAndre Fischer
28737e6b05aSAndre Fischer
28837e6b05aSAndre Fischer
28937e6b05aSAndre Fischer=head3 EvaluateTerm($term)
29037e6b05aSAndre Fischer
29137e6b05aSAndre Fischer    Evaluate the $term to either 0 or 1.
29237e6b05aSAndre Fischer    A term is either the literal "true", which evaluates to 1, or an expression
29337e6b05aSAndre Fischer    of the form NAME=VALUE or NAME!=VALUE.  NAME is the name of an environment
29437e6b05aSAndre Fischer    variable and VALUE any string.  VALUE may be empty.
295*6a22bca6SAndre Fischer
29637e6b05aSAndre Fischer=cut
29737e6b05aSAndre Fischersub EvaluateTerm ($)
29837e6b05aSAndre Fischer{
29937e6b05aSAndre Fischer    my $term = shift;
30037e6b05aSAndre Fischer
301*6a22bca6SAndre Fischer    if ($term =~ /^\s*([a-zA-Z_0-9]+)\s*(==|!=)\s*(.*)\s*$/)
30237e6b05aSAndre Fischer    {
30337e6b05aSAndre Fischer        my ($variable_name, $operator, $given_value) = ($1,$2,$3);
30437e6b05aSAndre Fischer        my $variable_value = $ENV{$variable_name};
305*6a22bca6SAndre Fischer        $variable_value = "" if ! defined $variable_value;
30637e6b05aSAndre Fischer
307*6a22bca6SAndre Fischer        if ($operator eq "==")
30837e6b05aSAndre Fischer        {
30937e6b05aSAndre Fischer            return $variable_value eq $given_value;
31037e6b05aSAndre Fischer        }
31137e6b05aSAndre Fischer        elsif ($operator eq "!=")
31237e6b05aSAndre Fischer        {
31337e6b05aSAndre Fischer            return $variable_value ne $given_value;
31437e6b05aSAndre Fischer        }
31537e6b05aSAndre Fischer        else
31637e6b05aSAndre Fischer        {
31737e6b05aSAndre Fischer            die "unknown operator in term $term";
31837e6b05aSAndre Fischer        }
31937e6b05aSAndre Fischer    }
32037e6b05aSAndre Fischer    elsif ($term =~ /^\s*true\s*$/i)
32137e6b05aSAndre Fischer    {
32237e6b05aSAndre Fischer        return 1;
32337e6b05aSAndre Fischer    }
324*6a22bca6SAndre Fischer    elsif ($term =~ /^\s*false\s*$/i)
325*6a22bca6SAndre Fischer    {
326*6a22bca6SAndre Fischer        return 0;
327*6a22bca6SAndre Fischer    }
32837e6b05aSAndre Fischer    else
32937e6b05aSAndre Fischer    {
33037e6b05aSAndre Fischer        die "term $term is not of the form <environment-variable> (=|==) <value>";
33137e6b05aSAndre Fischer    }
33237e6b05aSAndre Fischer}
33337e6b05aSAndre Fischer
33437e6b05aSAndre Fischer
33537e6b05aSAndre Fischer
33637e6b05aSAndre Fischer
33737e6b05aSAndre Fischer=head IsPresent($name,$given_md5)
33837e6b05aSAndre Fischer
33937e6b05aSAndre Fischer    Check if an external library tar ball with the basename $name already
34037e6b05aSAndre Fischer    exists in the target directory TARFILE_LOCATION.  The basename is
34137e6b05aSAndre Fischer    prefixed with the given MD5 sum.
34237e6b05aSAndre Fischer    If the file exists then its MD5 sum is compare with the given MD5 sum.
343*6a22bca6SAndre Fischer
34437e6b05aSAndre Fischer=cut
34537e6b05aSAndre Fischersub IsPresent ($$)
34637e6b05aSAndre Fischer{
34737e6b05aSAndre Fischer    my $name = shift;
34837e6b05aSAndre Fischer    my $given_md5 = shift;
34937e6b05aSAndre Fischer
35037e6b05aSAndre Fischer    my $filename = File::Spec->catfile($ENV{'TARFILE_LOCATION'}, $given_md5."-".$name);
351*6a22bca6SAndre Fischer
35237e6b05aSAndre Fischer    return 0 if ! -f $filename;
35337e6b05aSAndre Fischer
35437e6b05aSAndre Fischer    # File exists.  Check if its md5 sum is correct.
35537e6b05aSAndre Fischer    my $md5 = Digest::MD5->new();
35637e6b05aSAndre Fischer    open my $in, $filename;
35737e6b05aSAndre Fischer    $md5->addfile($in);
35837e6b05aSAndre Fischer
35937e6b05aSAndre Fischer    if ($given_md5 ne $md5->hexdigest())
36037e6b05aSAndre Fischer    {
36137e6b05aSAndre Fischer        # MD5 check sum does not match.  Delete the file.
36237e6b05aSAndre Fischer        print "$name exists, but md5 does not match => deleting\n";
36337e6b05aSAndre Fischer        #unlink($filename);
36437e6b05aSAndre Fischer        return 0;
36537e6b05aSAndre Fischer    }
36637e6b05aSAndre Fischer    else
36737e6b05aSAndre Fischer    {
36837e6b05aSAndre Fischer        print "$name exists, md5 is OK\n";
36937e6b05aSAndre Fischer        return 1;
37037e6b05aSAndre Fischer    }
37137e6b05aSAndre Fischer}
37237e6b05aSAndre Fischer
37337e6b05aSAndre Fischer
37437e6b05aSAndre Fischer
37537e6b05aSAndre Fischer
37637e6b05aSAndre Fischer=head3 Download
37737e6b05aSAndre Fischer
37837e6b05aSAndre Fischer    Download a set of files specified by @Missing.
37937e6b05aSAndre Fischer
38037e6b05aSAndre Fischer    For http URLs there may be an optional MD5 checksum.  If it is present then downloaded
38137e6b05aSAndre Fischer    files that do not match that checksum are an error and lead to abortion of the current process.
38237e6b05aSAndre Fischer    Files that have already been downloaded are not downloaded again.
383*6a22bca6SAndre Fischer
38437e6b05aSAndre Fischer=cut
38537e6b05aSAndre Fischersub Download ()
38637e6b05aSAndre Fischer{
38737e6b05aSAndre Fischer    my $download_path = $ENV{'TARFILE_LOCATION'};
388*6a22bca6SAndre Fischer
38937e6b05aSAndre Fischer    if (scalar @Missing > 0)
39037e6b05aSAndre Fischer    {
39137e6b05aSAndre Fischer        printf("downloading %d missing tar ball%s to %s\n",
39237e6b05aSAndre Fischer               scalar @Missing, scalar @Missing>0 ? "s" : "",
39337e6b05aSAndre Fischer               $download_path);
39437e6b05aSAndre Fischer    }
39537e6b05aSAndre Fischer    else
39637e6b05aSAndre Fischer    {
39737e6b05aSAndre Fischer        print "all external libraries present\n";
39837e6b05aSAndre Fischer        return;
39937e6b05aSAndre Fischer    }
400*6a22bca6SAndre Fischer
40137e6b05aSAndre Fischer    # Download the missing files.
40237e6b05aSAndre Fischer    for my $item (@Missing)
40337e6b05aSAndre Fischer    {
40437e6b05aSAndre Fischer        my ($name, $given_md5, $urls) = @$item;
405*6a22bca6SAndre Fischer
40637e6b05aSAndre Fischer        foreach my $url (@$urls)
40737e6b05aSAndre Fischer        {
40837e6b05aSAndre Fischer            last if DownloadFile($given_md5."-".$name, $url, $given_md5);
40937e6b05aSAndre Fischer        }
41037e6b05aSAndre Fischer    }
41137e6b05aSAndre Fischer}
41237e6b05aSAndre Fischer
41337e6b05aSAndre Fischer
41437e6b05aSAndre Fischer
41537e6b05aSAndre Fischer
41637e6b05aSAndre Fischer=head3 DownloadFile($name,$URL,$md5sum)
41737e6b05aSAndre Fischer
41837e6b05aSAndre Fischer    Download a single external library tarball.  It origin is given by $URL.
41937e6b05aSAndre Fischer    Its destination is $(TARFILE_LOCATION)/$md5sum-$name.
420*6a22bca6SAndre Fischer
42137e6b05aSAndre Fischer=cut
42237e6b05aSAndre Fischersub DownloadFile ($$$)
42337e6b05aSAndre Fischer{
42437e6b05aSAndre Fischer    my $name = shift;
42537e6b05aSAndre Fischer    my $URL = shift;
42637e6b05aSAndre Fischer    my $md5sum = shift;
42737e6b05aSAndre Fischer
42837e6b05aSAndre Fischer    my $filename = File::Spec->catfile($ENV{'TARFILE_LOCATION'}, $name);
42937e6b05aSAndre Fischer
43037e6b05aSAndre Fischer    my $temporary_filename = $filename . ".part";
43137e6b05aSAndre Fischer
43237e6b05aSAndre Fischer    print "downloading to $temporary_filename\n";
43337e6b05aSAndre Fischer    open my $out, ">$temporary_filename";
43437e6b05aSAndre Fischer    binmode($out);
43537e6b05aSAndre Fischer
43637e6b05aSAndre Fischer    # Prepare md5
43737e6b05aSAndre Fischer    my $md5 = Digest::MD5->new();
438*6a22bca6SAndre Fischer
43937e6b05aSAndre Fischer    # Download the extension.
44037e6b05aSAndre Fischer    my $agent = LWP::UserAgent->new();
44137e6b05aSAndre Fischer    $agent->timeout(120);
44237e6b05aSAndre Fischer    $agent->show_progress(1);
44337e6b05aSAndre Fischer    my $last_was_redirect = 0;
44437e6b05aSAndre Fischer    $agent->add_handler('response_redirect'
44537e6b05aSAndre Fischer                        => sub{
44637e6b05aSAndre Fischer                            $last_was_redirect = 1;
44737e6b05aSAndre Fischer                            return;
44837e6b05aSAndre Fischer                        });
44937e6b05aSAndre Fischer    $agent->add_handler('response_data'
45037e6b05aSAndre Fischer                        => sub{
45137e6b05aSAndre Fischer                            if ($last_was_redirect)
45237e6b05aSAndre Fischer                            {
45337e6b05aSAndre Fischer                                $last_was_redirect = 0;
45437e6b05aSAndre Fischer                                # Throw away the data we got so far.
45537e6b05aSAndre Fischer                                $md5->reset();
45637e6b05aSAndre Fischer                                close $out;
45737e6b05aSAndre Fischer                                open $out, ">$temporary_filename";
45837e6b05aSAndre Fischer                                binmode($out);
45937e6b05aSAndre Fischer                            }
46037e6b05aSAndre Fischer                            my($response,$agent,$h,$data)=@_;
46137e6b05aSAndre Fischer                            print $out $data;
46237e6b05aSAndre Fischer                            $md5->add($data);
46337e6b05aSAndre Fischer                        });
46437e6b05aSAndre Fischer
46537e6b05aSAndre Fischer    my $response = $agent->get($URL);
46637e6b05aSAndre Fischer    close $out;
46737e6b05aSAndre Fischer
46837e6b05aSAndre Fischer    # When download was successfull then check the md5 checksum and rename the .part file
46937e6b05aSAndre Fischer    # into the actual extension name.
47037e6b05aSAndre Fischer    if ($response->is_success())
47137e6b05aSAndre Fischer    {
47237e6b05aSAndre Fischer        my $file_md5 = $md5->hexdigest();
47337e6b05aSAndre Fischer        if (defined $md5sum && length($md5sum)==32)
47437e6b05aSAndre Fischer        {
47537e6b05aSAndre Fischer            if ($md5sum eq $file_md5)
47637e6b05aSAndre Fischer            {
47737e6b05aSAndre Fischer                print "md5 is OK\n";
47837e6b05aSAndre Fischer            }
47937e6b05aSAndre Fischer            else
48037e6b05aSAndre Fischer            {
48137e6b05aSAndre Fischer                unlink($temporary_filename);
48237e6b05aSAndre Fischer                print "    md5 does not match ($file_md5 instead of $md5sum)\n";
48337e6b05aSAndre Fischer                return 0;
48437e6b05aSAndre Fischer            }
48537e6b05aSAndre Fischer        }
48637e6b05aSAndre Fischer        else
48737e6b05aSAndre Fischer        {
48837e6b05aSAndre Fischer            printf("md5 not given, md5 of file is %s\n", $file_md5);
48937e6b05aSAndre Fischer            $filename = File::Spec->catfile($ENV{'TARFILE_LOCATION'}, $file_md5 . "-" . $name);
49037e6b05aSAndre Fischer        }
491*6a22bca6SAndre Fischer
49237e6b05aSAndre Fischer        rename($temporary_filename, $filename) || die "can not rename $temporary_filename to $filename";
49337e6b05aSAndre Fischer        return 1;
49437e6b05aSAndre Fischer    }
49537e6b05aSAndre Fischer    else
49637e6b05aSAndre Fischer    {
49737e6b05aSAndre Fischer        unlink($temporary_filename);
49837e6b05aSAndre Fischer        print "    download failed\n";
49937e6b05aSAndre Fischer        return 0;
50037e6b05aSAndre Fischer    }
50137e6b05aSAndre Fischer}
50237e6b05aSAndre Fischer
50337e6b05aSAndre Fischer
50437e6b05aSAndre Fischer
50537e6b05aSAndre Fischer
50637e6b05aSAndre Fischer=head3 CheckDownloadDestination ()
50737e6b05aSAndre Fischer
50837e6b05aSAndre Fischer    Make sure that the download destination $TARFILE_LOCATION does exist.  If
50937e6b05aSAndre Fischer    not, then the directory is created.
510*6a22bca6SAndre Fischer
51137e6b05aSAndre Fischer=cut
51237e6b05aSAndre Fischersub CheckDownloadDestination ()
51337e6b05aSAndre Fischer{
51437e6b05aSAndre Fischer    my $destination = $ENV{'TARFILE_LOCATION'};
51537e6b05aSAndre Fischer    die "ERROR: no destination defined! please set TARFILE_LOCATION!" if ($destination eq "");
51637e6b05aSAndre Fischer
51737e6b05aSAndre Fischer    if ( ! -d $destination)
51837e6b05aSAndre Fischer    {
51937e6b05aSAndre Fischer        File::Path::make_path($destination);
52037e6b05aSAndre Fischer        die "ERROR: can't create \$TARFILE_LOCATION" if  ! -d $destination;
52137e6b05aSAndre Fischer    }
52237e6b05aSAndre Fischer}
52337e6b05aSAndre Fischer
52437e6b05aSAndre Fischer
52537e6b05aSAndre Fischer
52637e6b05aSAndre Fischer
52737e6b05aSAndre Fischer=head3 ProvideSpecialTarball ($url,$name,$name_converter)
52837e6b05aSAndre Fischer
52937e6b05aSAndre Fischer    A few tarballs need special handling.  That is done here.
530*6a22bca6SAndre Fischer
53137e6b05aSAndre Fischer=cut
53237e6b05aSAndre Fischersub ProvideSpecialTarball ($$$)
53337e6b05aSAndre Fischer{
53437e6b05aSAndre Fischer    my $url = shift;
53537e6b05aSAndre Fischer    my $name = shift;
53637e6b05aSAndre Fischer    my $name_converter = shift;
53737e6b05aSAndre Fischer
53837e6b05aSAndre Fischer    return unless defined $url && $url ne "";
53937e6b05aSAndre Fischer
54037e6b05aSAndre Fischer    # See if we can find the executable.
54137e6b05aSAndre Fischer    my ($SOLARENV,$OUTPATH,$EXEEXT) =  ($ENV{'SOLARENV'},$ENV{'OUTPATH'},$ENV{'EXEEXT'});
54237e6b05aSAndre Fischer    $SOLARENV = "" unless defined $SOLARENV;
54337e6b05aSAndre Fischer    $OUTPATH = "" unless defined $OUTPATH;
54437e6b05aSAndre Fischer    $EXEEXT = "" unless defined $EXEEXT;
54537e6b05aSAndre Fischer    if (-x File::Spec->catfile($SOLARENV, $OUTPATH, "bin", $name.$EXEEXT))
54637e6b05aSAndre Fischer    {
54737e6b05aSAndre Fischer        print "found $name executable\n";
54837e6b05aSAndre Fischer        return;
54937e6b05aSAndre Fischer    }
55037e6b05aSAndre Fischer
55137e6b05aSAndre Fischer    # Download the source from the URL.
55237e6b05aSAndre Fischer    my $basename = basename(URI->new($url)->path());
55337e6b05aSAndre Fischer    die unless defined $basename;
55437e6b05aSAndre Fischer
55537e6b05aSAndre Fischer    if (defined $name_converter)
55637e6b05aSAndre Fischer    {
55737e6b05aSAndre Fischer        $basename = &{$name_converter}($basename);
55837e6b05aSAndre Fischer    }
559*6a22bca6SAndre Fischer
56037e6b05aSAndre Fischer    # Has the source tar ball already been downloaded?
56137e6b05aSAndre Fischer    my @candidates = glob(File::Spec->catfile($ENV{'TARFILE_LOCATION'}, "*-" . $basename));
56237e6b05aSAndre Fischer    if (scalar @candidates > 0)
56337e6b05aSAndre Fischer    {
56437e6b05aSAndre Fischer        # Yes.
56537e6b05aSAndre Fischer        print "$basename exists\n";
56637e6b05aSAndre Fischer        return;
56737e6b05aSAndre Fischer    }
56837e6b05aSAndre Fischer    else
56937e6b05aSAndre Fischer    {
57037e6b05aSAndre Fischer        # No, download it.
57137e6b05aSAndre Fischer        print "downloading $basename\n";
57237e6b05aSAndre Fischer        DownloadFile($basename, $url, undef);
57337e6b05aSAndre Fischer    }
57437e6b05aSAndre Fischer}
57537e6b05aSAndre Fischer
57637e6b05aSAndre Fischer
57737e6b05aSAndre Fischer
57837e6b05aSAndre Fischer
57937e6b05aSAndre Fischer
58037e6b05aSAndre Fischer# The main() functionality.
58137e6b05aSAndre Fischer
58237e6b05aSAndre Fischerdie "usage: $0 <data-file-name>" if scalar @ARGV != 1;
58337e6b05aSAndre Fischermy $data_file = $ARGV[0];
58437e6b05aSAndre FischerCheckDownloadDestination();
58537e6b05aSAndre FischerProcessDataFile($data_file);
58637e6b05aSAndre FischerProvideSpecialTarball($ENV{'DMAKE_URL'}, "dmake", undef);
58737e6b05aSAndre FischerProvideSpecialTarball(
58837e6b05aSAndre Fischer    $ENV{'EPM_URL'},
58937e6b05aSAndre Fischer    "epm",
59037e6b05aSAndre Fischer    sub{$_[0]=~s/-source//; return $_[0]});
591