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):
106a22bca6SAndre 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:
3410e20387SAndre Fischer    - MD5 is the expected MD5 checksum of the library tarball.
3510e20387SAndre Fischer    - SHA1 is the expected SHA1 checksum of the library tarball.
3637e6b05aSAndre Fischer    - URL1 to URL9 specify from where to download the tarball.  The urls are tried in order.
3710e20387SAndre Fischer      The first successful download (download completed and checksum match) stops the iteration.
3837e6b05aSAndre Fischer
3937e6b05aSAndre Fischer    Expressions are explained below in the comment of EvaluateExpression().
4037e6b05aSAndre Fischer
4137e6b05aSAndre Fischer    A library is only regarded if its conditional expression evaluates to 1.
4237e6b05aSAndre Fischer
4337e6b05aSAndre Fischer    Example:
4437e6b05aSAndre Fischer
4537e6b05aSAndre Fischer    DefaultSite=http://some-internet-site.org
4637e6b05aSAndre Fischer    if ( true )
4737e6b05aSAndre Fischer        MD5 = 0123456789abcdef0123456789abcdef
4837e6b05aSAndre Fischer        name = library-1.0.tar.gz
4937e6b05aSAndre Fischer        URL1 = http://some-other-internet-site.org/another-name.tgz
5037e6b05aSAndre Fischer        URL2 = $(DefaultSite)$(MD5)-$(name)
5137e6b05aSAndre Fischer
5237e6b05aSAndre Fischer    This tries to load a library first from some-other-internet-site.org and if
5337e6b05aSAndre Fischer    that fails from some-internet-site.org.  The library is stored as $(MD5)-$(name)
5437e6b05aSAndre Fischer    even when it is loaded as another-name.tgz.
5537e6b05aSAndre Fischer
5637e6b05aSAndre Fischer=cut
5737e6b05aSAndre Fischer
5837e6b05aSAndre Fischer
5937e6b05aSAndre Fischeruse strict;
6037e6b05aSAndre Fischer
6137e6b05aSAndre Fischeruse File::Spec;
6237e6b05aSAndre Fischeruse File::Path;
6337e6b05aSAndre Fischeruse File::Basename;
6437e6b05aSAndre Fischeruse LWP::UserAgent;
6537e6b05aSAndre Fischeruse Digest::MD5;
6610e20387SAndre Fischeruse Digest::SHA;
6737e6b05aSAndre Fischeruse URI;
6837e6b05aSAndre Fischer
6937e6b05aSAndre Fischermy $Debug = 1;
7037e6b05aSAndre Fischer
7137e6b05aSAndre Fischermy $LocalEnvironment = undef;
7237e6b05aSAndre Fischermy $GlobalEnvironment = {};
7337e6b05aSAndre Fischermy @Missing = ();
7437e6b05aSAndre Fischer
7537e6b05aSAndre Fischer
7637e6b05aSAndre Fischer
7737e6b05aSAndre Fischer
7837e6b05aSAndre Fischer=head3 ProcessDataFile
796a22bca6SAndre Fischer
8037e6b05aSAndre Fischer    Read the data file, typically named main/external_libs.lst, find the external
8137e6b05aSAndre Fischer    library tarballs that are not yet present in ext_sources/ and download them.
8237e6b05aSAndre Fischer
8337e6b05aSAndre Fischer=cut
8437e6b05aSAndre Fischersub ProcessDataFile ($)
8537e6b05aSAndre Fischer{
8637e6b05aSAndre Fischer    my $filename = shift;
8737e6b05aSAndre Fischer
8837e6b05aSAndre Fischer    my $destination = $ENV{'TARFILE_LOCATION'};
8937e6b05aSAndre Fischer
9037e6b05aSAndre Fischer    die "can not open data file $filename" if ! -e $filename;
9137e6b05aSAndre Fischer
9237e6b05aSAndre Fischer    my $current_selector_value = 1;
9337e6b05aSAndre Fischer    my @URLHeads = ();
9437e6b05aSAndre Fischer    my @download_requests = ();
9537e6b05aSAndre Fischer
9637e6b05aSAndre Fischer    open my $in, $filename;
9737e6b05aSAndre Fischer    while (my $line = <$in>)
9837e6b05aSAndre Fischer    {
9937e6b05aSAndre Fischer        # Remove leading and trailing space and comments
10037e6b05aSAndre Fischer        $line =~ s/^\s+//;
10137e6b05aSAndre Fischer        $line =~ s/\s+$//;
10237e6b05aSAndre Fischer        $line =~ s/\s*#.*$//;
10337e6b05aSAndre Fischer
10437e6b05aSAndre Fischer        # Ignore empty lines.
10537e6b05aSAndre Fischer        next if $line eq "";
10637e6b05aSAndre Fischer
10737e6b05aSAndre Fischer        # An "if" statement starts a new block.
10837e6b05aSAndre Fischer        if ($line =~ /^\s*if\s*\(\s*(.*?)\s*\)\s*$/)
10937e6b05aSAndre Fischer        {
11037e6b05aSAndre Fischer            ProcessLastBlock();
1116a22bca6SAndre Fischer
11237e6b05aSAndre Fischer            $LocalEnvironment = { 'selector' => $1 };
11337e6b05aSAndre Fischer        }
11437e6b05aSAndre Fischer
11537e6b05aSAndre Fischer        # Lines of the form name = value define a local variable.
11637e6b05aSAndre Fischer        elsif ($line =~ /^\s*(\S+)\s*=\s*(.*?)\s*$/)
11737e6b05aSAndre Fischer        {
11837e6b05aSAndre Fischer            if (defined $LocalEnvironment)
11937e6b05aSAndre Fischer            {
12037e6b05aSAndre Fischer                $LocalEnvironment->{$1} = $2;
12137e6b05aSAndre Fischer            }
12237e6b05aSAndre Fischer            else
12337e6b05aSAndre Fischer            {
12437e6b05aSAndre Fischer                $GlobalEnvironment->{$1} = $2;
12537e6b05aSAndre Fischer            }
12637e6b05aSAndre Fischer        }
12737e6b05aSAndre Fischer        else
12837e6b05aSAndre Fischer        {
12937e6b05aSAndre Fischer            die "can not parse line $line\n";
13037e6b05aSAndre Fischer        }
13137e6b05aSAndre Fischer    }
13237e6b05aSAndre Fischer
13337e6b05aSAndre Fischer    ProcessLastBlock();
1346a22bca6SAndre Fischer
13537e6b05aSAndre Fischer    Download(\@download_requests, \@URLHeads);
13637e6b05aSAndre Fischer}
13737e6b05aSAndre Fischer
13837e6b05aSAndre Fischer
13937e6b05aSAndre Fischer
14037e6b05aSAndre Fischer
14137e6b05aSAndre Fischer=head3 ProcessLastBlock
14237e6b05aSAndre Fischer
14337e6b05aSAndre Fischer    Process the last definition of an external library.
14437e6b05aSAndre Fischer    If there is not last block, true for the first "if" statement, then the call is ignored.
14537e6b05aSAndre Fischer
14637e6b05aSAndre Fischer=cut
14737e6b05aSAndre Fischersub ProcessLastBlock ()
14837e6b05aSAndre Fischer{
14937e6b05aSAndre Fischer    # Return if no block is defined.
15037e6b05aSAndre Fischer    return if ! defined $LocalEnvironment;
1516a22bca6SAndre Fischer
15237e6b05aSAndre Fischer    # Ignore the block if the selector does not match.
15337e6b05aSAndre Fischer    if ( ! EvaluateExpression(SubstituteVariables($LocalEnvironment->{'selector'})))
15437e6b05aSAndre Fischer    {
1556a22bca6SAndre Fischer        printf("ignoring %s because its prerequisites are not fulfilled\n", GetValue('name'));
15637e6b05aSAndre Fischer    }
15737e6b05aSAndre Fischer    else
15837e6b05aSAndre Fischer    {
15937e6b05aSAndre Fischer        my $name = GetValue('name');
16010e20387SAndre Fischer        my $checksum = GetChecksum();
16137e6b05aSAndre Fischer
162*0aabba3aSAndre Fischer        if ( ! IsPresent($name, $checksum))
16310e20387SAndre Fischer        {
16410e20387SAndre Fischer            AddDownloadRequest($name, $checksum);
16537e6b05aSAndre Fischer        }
16637e6b05aSAndre Fischer    }
16737e6b05aSAndre Fischer}
16837e6b05aSAndre Fischer
16937e6b05aSAndre Fischer
17037e6b05aSAndre Fischer
17137e6b05aSAndre Fischer
17210e20387SAndre Fischer=head3 AddDownloadRequest($name, $checksum)
17337e6b05aSAndre Fischer
17437e6b05aSAndre Fischer    Add a request for downloading the library $name to @Missing.
17537e6b05aSAndre Fischer    Collect all available URL[1-9] variables as source URLs.
1766a22bca6SAndre Fischer
17737e6b05aSAndre Fischer=cut
17810e20387SAndre Fischersub AddDownloadRequest ($$)
17937e6b05aSAndre Fischer{
18010e20387SAndre Fischer    my ($name, $checksum) = @_;
18137e6b05aSAndre Fischer
18237e6b05aSAndre Fischer    print "adding download request for $name\n";
18337e6b05aSAndre Fischer
18437e6b05aSAndre Fischer    my $urls = [];
18537e6b05aSAndre Fischer    my $url = GetValue('URL');
18637e6b05aSAndre Fischer    push @$urls, SubstituteVariables($url) if (defined $url);
18737e6b05aSAndre Fischer    for (my $i=1; $i<10; ++$i)
18837e6b05aSAndre Fischer    {
18937e6b05aSAndre Fischer        $url = GetValue('URL'.$i);
19037e6b05aSAndre Fischer        next if ! defined $url;
19137e6b05aSAndre Fischer        push @$urls, SubstituteVariables($url);
19237e6b05aSAndre Fischer    }
19337e6b05aSAndre Fischer
19410e20387SAndre Fischer    push @Missing, [$name, $checksum, $urls];
19510e20387SAndre Fischer}
19610e20387SAndre Fischer
19710e20387SAndre Fischer
19810e20387SAndre Fischer
19910e20387SAndre Fischer
20010e20387SAndre Fischer=head3 GetChecksum()
20110e20387SAndre Fischer
20210e20387SAndre Fischer    When either MD5 or SHA1 are variables in the current scope then return
20310e20387SAndre Fischer    a reference to a hash with two entries:
20410e20387SAndre Fischer        'type' is either 'MD5' or 'SHA1', the type or algorithm of the checksum,
20510e20387SAndre Fischer        'value' is the actual checksum
20610e20387SAndre Fischer    Otherwise undef is returned.
20710e20387SAndre Fischer
20810e20387SAndre Fischer=cut
20910e20387SAndre Fischersub GetChecksum()
21010e20387SAndre Fischer{
21110e20387SAndre Fischer    my $checksum = GetValue("MD5");
21210e20387SAndre Fischer    if (defined $checksum && $checksum ne "")
21310e20387SAndre Fischer    {
21410e20387SAndre Fischer        return { 'type' => 'MD5', 'value' => $checksum };
21510e20387SAndre Fischer    }
21610e20387SAndre Fischer    elsif (defined ($checksum=GetValue("SHA1")) && $checksum ne "")
21710e20387SAndre Fischer    {
21810e20387SAndre Fischer        return { 'type' => 'SHA1', 'value' => $checksum };
21910e20387SAndre Fischer    }
22010e20387SAndre Fischer    else
22110e20387SAndre Fischer    {
22210e20387SAndre Fischer        return undef;
22310e20387SAndre Fischer    }
22437e6b05aSAndre Fischer}
22537e6b05aSAndre Fischer
22637e6b05aSAndre Fischer
22737e6b05aSAndre Fischer
22837e6b05aSAndre Fischer
22937e6b05aSAndre Fischer=head3 GetValue($variable_name)
23037e6b05aSAndre Fischer
23137e6b05aSAndre Fischer    Return the value of the variable with name $variable_name from the local
23237e6b05aSAndre Fischer    environment or, if not defined there, the global environment.
23337e6b05aSAndre Fischer
23437e6b05aSAndre Fischer=cut
23537e6b05aSAndre Fischersub GetValue ($)
23637e6b05aSAndre Fischer{
23737e6b05aSAndre Fischer    my $variable_name = shift;
23837e6b05aSAndre Fischer
23937e6b05aSAndre Fischer    my $candidate = $LocalEnvironment->{$variable_name};
24037e6b05aSAndre Fischer    return $candidate if defined $candidate;
24137e6b05aSAndre Fischer
24237e6b05aSAndre Fischer    return $GlobalEnvironment->{$variable_name};
24337e6b05aSAndre Fischer}
24437e6b05aSAndre Fischer
24537e6b05aSAndre Fischer
24637e6b05aSAndre Fischer
24737e6b05aSAndre Fischer=head3 SubstituteVariables($text)
24837e6b05aSAndre Fischer
24937e6b05aSAndre Fischer    Replace all references to variables in $text with the respective variable values.
25037e6b05aSAndre Fischer    This is done repeatedly until no variable reference remains.
2516a22bca6SAndre Fischer
25237e6b05aSAndre Fischer=cut
25337e6b05aSAndre Fischersub SubstituteVariables ($)
25437e6b05aSAndre Fischer{
25537e6b05aSAndre Fischer    my $text = shift;
25637e6b05aSAndre Fischer
25737e6b05aSAndre Fischer    my $infinite_recursion_guard = 100;
25837e6b05aSAndre Fischer    while ($text =~ /^(.*?)\$\(([^)]+)\)(.*)$/)
25937e6b05aSAndre Fischer    {
26037e6b05aSAndre Fischer        my ($head,$name,$tail) = ($1,$2,$3);
26137e6b05aSAndre Fischer        my $value = GetValue($name);
262*0aabba3aSAndre Fischer        die "can not evaluate variable $name" if ! defined $value;
26337e6b05aSAndre Fischer        $text = $head.$value.$tail;
26437e6b05aSAndre Fischer
26537e6b05aSAndre Fischer        die "(probably) detected an infinite recursion in variable definitions" if --$infinite_recursion_guard<=0;
26637e6b05aSAndre Fischer    }
26737e6b05aSAndre Fischer
26837e6b05aSAndre Fischer    return $text;
26937e6b05aSAndre Fischer}
27037e6b05aSAndre Fischer
27137e6b05aSAndre Fischer
27237e6b05aSAndre Fischer
27337e6b05aSAndre Fischer
27437e6b05aSAndre Fischer=head3 EvaluateExpression($expression)
27537e6b05aSAndre Fischer
27637e6b05aSAndre Fischer    Evaluate the $expression of an "if" statement to either 0 or 1.  It can
27737e6b05aSAndre Fischer    be a single term (see EvaluateTerm for a description), or several terms
2786a22bca6SAndre Fischer    separated by either all ||s or &&s.  A term can also be an expression
2796a22bca6SAndre Fischer    enclosed in parantheses.
2806a22bca6SAndre Fischer
28137e6b05aSAndre Fischer=cut
28237e6b05aSAndre Fischersub EvaluateExpression ($)
28337e6b05aSAndre Fischer{
28437e6b05aSAndre Fischer    my $expression = shift;
28537e6b05aSAndre Fischer
2866a22bca6SAndre Fischer    # Evaluate sub expressions enclosed in parantheses.
2876a22bca6SAndre Fischer    while ($expression =~ /^(.*)\(([^\(\)]+)\)(.*)$/)
2886a22bca6SAndre Fischer    {
2896a22bca6SAndre Fischer        $expression = $1 . (EvaluateExpression($2) ? " true " : " false ") . $3;
2906a22bca6SAndre Fischer    }
2916a22bca6SAndre Fischer
29237e6b05aSAndre Fischer    if ($expression =~ /&&/ && $expression =~ /\|\|/)
29337e6b05aSAndre Fischer    {
2946a22bca6SAndre Fischer        die "expression can contain either && or || but not both at the same time";
29537e6b05aSAndre Fischer    }
29637e6b05aSAndre Fischer    elsif ($expression =~ /&&/)
29737e6b05aSAndre Fischer    {
29837e6b05aSAndre Fischer        foreach my $term (split (/\s*&&\s*/,$expression))
29937e6b05aSAndre Fischer        {
30037e6b05aSAndre Fischer            return 0 if ! EvaluateTerm($term);
30137e6b05aSAndre Fischer        }
30237e6b05aSAndre Fischer        return 1;
30337e6b05aSAndre Fischer    }
30437e6b05aSAndre Fischer    elsif ($expression =~ /\|\|/)
30537e6b05aSAndre Fischer    {
30637e6b05aSAndre Fischer        foreach my $term (split (/\s*\|\|\s*/,$expression))
30737e6b05aSAndre Fischer        {
30837e6b05aSAndre Fischer            return 1 if EvaluateTerm($term);
30937e6b05aSAndre Fischer        }
31037e6b05aSAndre Fischer        return 0;
31137e6b05aSAndre Fischer    }
31237e6b05aSAndre Fischer    else
31337e6b05aSAndre Fischer    {
31437e6b05aSAndre Fischer        return EvaluateTerm($expression);
31537e6b05aSAndre Fischer    }
31637e6b05aSAndre Fischer}
31737e6b05aSAndre Fischer
31837e6b05aSAndre Fischer
31937e6b05aSAndre Fischer
32037e6b05aSAndre Fischer
32137e6b05aSAndre Fischer=head3 EvaluateTerm($term)
32237e6b05aSAndre Fischer
32337e6b05aSAndre Fischer    Evaluate the $term to either 0 or 1.
32437e6b05aSAndre Fischer    A term is either the literal "true", which evaluates to 1, or an expression
32537e6b05aSAndre Fischer    of the form NAME=VALUE or NAME!=VALUE.  NAME is the name of an environment
32637e6b05aSAndre Fischer    variable and VALUE any string.  VALUE may be empty.
3276a22bca6SAndre Fischer
32837e6b05aSAndre Fischer=cut
32937e6b05aSAndre Fischersub EvaluateTerm ($)
33037e6b05aSAndre Fischer{
33137e6b05aSAndre Fischer    my $term = shift;
33237e6b05aSAndre Fischer
3336a22bca6SAndre Fischer    if ($term =~ /^\s*([a-zA-Z_0-9]+)\s*(==|!=)\s*(.*)\s*$/)
33437e6b05aSAndre Fischer    {
33537e6b05aSAndre Fischer        my ($variable_name, $operator, $given_value) = ($1,$2,$3);
33637e6b05aSAndre Fischer        my $variable_value = $ENV{$variable_name};
3376a22bca6SAndre Fischer        $variable_value = "" if ! defined $variable_value;
33837e6b05aSAndre Fischer
3396a22bca6SAndre Fischer        if ($operator eq "==")
34037e6b05aSAndre Fischer        {
34137e6b05aSAndre Fischer            return $variable_value eq $given_value;
34237e6b05aSAndre Fischer        }
34337e6b05aSAndre Fischer        elsif ($operator eq "!=")
34437e6b05aSAndre Fischer        {
34537e6b05aSAndre Fischer            return $variable_value ne $given_value;
34637e6b05aSAndre Fischer        }
34737e6b05aSAndre Fischer        else
34837e6b05aSAndre Fischer        {
34937e6b05aSAndre Fischer            die "unknown operator in term $term";
35037e6b05aSAndre Fischer        }
35137e6b05aSAndre Fischer    }
35237e6b05aSAndre Fischer    elsif ($term =~ /^\s*true\s*$/i)
35337e6b05aSAndre Fischer    {
35437e6b05aSAndre Fischer        return 1;
35537e6b05aSAndre Fischer    }
3566a22bca6SAndre Fischer    elsif ($term =~ /^\s*false\s*$/i)
3576a22bca6SAndre Fischer    {
3586a22bca6SAndre Fischer        return 0;
3596a22bca6SAndre Fischer    }
36037e6b05aSAndre Fischer    else
36137e6b05aSAndre Fischer    {
36237e6b05aSAndre Fischer        die "term $term is not of the form <environment-variable> (=|==) <value>";
36337e6b05aSAndre Fischer    }
36437e6b05aSAndre Fischer}
36537e6b05aSAndre Fischer
36637e6b05aSAndre Fischer
36737e6b05aSAndre Fischer
36837e6b05aSAndre Fischer
36910e20387SAndre Fischer=head IsPresent($name, $given_checksum)
37037e6b05aSAndre Fischer
37137e6b05aSAndre Fischer    Check if an external library tar ball with the basename $name already
37237e6b05aSAndre Fischer    exists in the target directory TARFILE_LOCATION.  The basename is
37310e20387SAndre Fischer    prefixed with the MD5 or SHA1 checksum.
37410e20387SAndre Fischer    If the file exists then its checksum is compared to the given one.
3756a22bca6SAndre Fischer
37637e6b05aSAndre Fischer=cut
37737e6b05aSAndre Fischersub IsPresent ($$)
37837e6b05aSAndre Fischer{
37910e20387SAndre Fischer    my ($name, $given_checksum) = @_;
3806a22bca6SAndre Fischer
38110e20387SAndre Fischer    my $filename = File::Spec->catfile($ENV{'TARFILE_LOCATION'}, $given_checksum->{'value'}."-".$name);
38210e20387SAndre Fischer    return 0 unless -f $filename;
38337e6b05aSAndre Fischer
38410e20387SAndre Fischer    # File exists.  Check if its checksum is correct.
38510e20387SAndre Fischer    my $checksum;
386*0aabba3aSAndre Fischer    if ( ! defined $given_checksum)
387*0aabba3aSAndre Fischer    {
388*0aabba3aSAndre Fischer        print "no checksum given, can not verify\n";
389*0aabba3aSAndre Fischer        return 1;
390*0aabba3aSAndre Fischer    }
391*0aabba3aSAndre Fischer    elsif ($given_checksum->{'type'} eq "MD5")
39210e20387SAndre Fischer    {
39310e20387SAndre Fischer        my $md5 = Digest::MD5->new();
39410e20387SAndre Fischer        open my $in, $filename;
39510e20387SAndre Fischer        $md5->addfile($in);
39610e20387SAndre Fischer        $checksum = $md5->hexdigest();
39710e20387SAndre Fischer    }
39810e20387SAndre Fischer    elsif ($given_checksum->{'type'} eq "SHA1")
39910e20387SAndre Fischer    {
40010e20387SAndre Fischer        my $sha1 = Digest::SHA->new("1");
40110e20387SAndre Fischer        open my $in, $filename;
40210e20387SAndre Fischer        $sha1->addfile($in);
40310e20387SAndre Fischer        $checksum = $sha1->hexdigest();
40410e20387SAndre Fischer    }
40510e20387SAndre Fischer    else
40610e20387SAndre Fischer    {
40710e20387SAndre Fischer        die "unsupported checksum type (not MD5 or SHA1)";
40810e20387SAndre Fischer    }
40937e6b05aSAndre Fischer
41010e20387SAndre Fischer    if ($given_checksum->{'value'} ne $checksum)
41137e6b05aSAndre Fischer    {
41210e20387SAndre Fischer        # Checksum does not match.  Delete the file.
41310e20387SAndre Fischer        print "$name exists, but checksum does not match => deleting\n";
414*0aabba3aSAndre Fischer        unlink($filename);
41537e6b05aSAndre Fischer        return 0;
41637e6b05aSAndre Fischer    }
41737e6b05aSAndre Fischer    else
41837e6b05aSAndre Fischer    {
41910e20387SAndre Fischer        printf("%s exists, %s checksum is OK\n", $name, $given_checksum->{'type'});
42037e6b05aSAndre Fischer        return 1;
42137e6b05aSAndre Fischer    }
42237e6b05aSAndre Fischer}
42337e6b05aSAndre Fischer
42437e6b05aSAndre Fischer
42537e6b05aSAndre Fischer
42637e6b05aSAndre Fischer
42737e6b05aSAndre Fischer=head3 Download
42837e6b05aSAndre Fischer
42937e6b05aSAndre Fischer    Download a set of files specified by @Missing.
43037e6b05aSAndre Fischer
43110e20387SAndre Fischer    For http URLs there may be an optional checksum.  If it is present then downloaded
43210e20387SAndre Fischer    files that do not match that checksum lead to abortion of the current process.
43337e6b05aSAndre Fischer    Files that have already been downloaded are not downloaded again.
4346a22bca6SAndre Fischer
43537e6b05aSAndre Fischer=cut
43637e6b05aSAndre Fischersub Download ()
43737e6b05aSAndre Fischer{
43837e6b05aSAndre Fischer    my $download_path = $ENV{'TARFILE_LOCATION'};
4396a22bca6SAndre Fischer
44037e6b05aSAndre Fischer    if (scalar @Missing > 0)
44137e6b05aSAndre Fischer    {
44237e6b05aSAndre Fischer        printf("downloading %d missing tar ball%s to %s\n",
44337e6b05aSAndre Fischer               scalar @Missing, scalar @Missing>0 ? "s" : "",
44437e6b05aSAndre Fischer               $download_path);
44537e6b05aSAndre Fischer    }
44637e6b05aSAndre Fischer    else
44737e6b05aSAndre Fischer    {
44837e6b05aSAndre Fischer        print "all external libraries present\n";
44937e6b05aSAndre Fischer        return;
45037e6b05aSAndre Fischer    }
4516a22bca6SAndre Fischer
45237e6b05aSAndre Fischer    # Download the missing files.
45337e6b05aSAndre Fischer    for my $item (@Missing)
45437e6b05aSAndre Fischer    {
45510e20387SAndre Fischer        my ($name, $checksum, $urls) = @$item;
4566a22bca6SAndre Fischer
45737e6b05aSAndre Fischer        foreach my $url (@$urls)
45837e6b05aSAndre Fischer        {
459*0aabba3aSAndre Fischer            last if DownloadFile(
460*0aabba3aSAndre Fischer                defined $checksum
461*0aabba3aSAndre Fischer                    ? $checksum->{'value'}."-".$name
462*0aabba3aSAndre Fischer                    : $name,
463*0aabba3aSAndre Fischer                $url,
464*0aabba3aSAndre Fischer                $checksum);
46537e6b05aSAndre Fischer        }
46637e6b05aSAndre Fischer    }
46737e6b05aSAndre Fischer}
46837e6b05aSAndre Fischer
46937e6b05aSAndre Fischer
47037e6b05aSAndre Fischer
47137e6b05aSAndre Fischer
47210e20387SAndre Fischer=head3 DownloadFile($name,$URL,$checksum)
47337e6b05aSAndre Fischer
47437e6b05aSAndre Fischer    Download a single external library tarball.  It origin is given by $URL.
47510e20387SAndre Fischer    Its destination is $(TARFILE_LOCATION)/$checksum-$name.
4766a22bca6SAndre Fischer
47737e6b05aSAndre Fischer=cut
47837e6b05aSAndre Fischersub DownloadFile ($$$)
47937e6b05aSAndre Fischer{
48037e6b05aSAndre Fischer    my $name = shift;
48137e6b05aSAndre Fischer    my $URL = shift;
48210e20387SAndre Fischer    my $checksum = shift;
48337e6b05aSAndre Fischer
48437e6b05aSAndre Fischer    my $filename = File::Spec->catfile($ENV{'TARFILE_LOCATION'}, $name);
48537e6b05aSAndre Fischer
48637e6b05aSAndre Fischer    my $temporary_filename = $filename . ".part";
48737e6b05aSAndre Fischer
48837e6b05aSAndre Fischer    print "downloading to $temporary_filename\n";
489*0aabba3aSAndre Fischer    my $out;
490*0aabba3aSAndre Fischer    open $out, ">$temporary_filename";
49137e6b05aSAndre Fischer    binmode($out);
49237e6b05aSAndre Fischer
49310e20387SAndre Fischer    # Prepare checksum
49410e20387SAndre Fischer    my $digest;
49510e20387SAndre Fischer    if (defined $checksum && $checksum->{'type'} eq "SHA1")
49610e20387SAndre Fischer    {
49710e20387SAndre Fischer        # Use SHA1 only when explicitly requested (by the presence of a "SHA1=..." line.)
49810e20387SAndre Fischer        $digest = Digest::SHA->new("1");
49910e20387SAndre Fischer    }
50010e20387SAndre Fischer    elsif ( ! defined $checksum || $checksum->{'type'} eq "MD5")
50110e20387SAndre Fischer    {
50210e20387SAndre Fischer        # Use MD5 when explicitly requested or when no checksum type is given.
50310e20387SAndre Fischer        $digest = Digest::MD5->new();
50410e20387SAndre Fischer    }
50510e20387SAndre Fischer    else
50610e20387SAndre Fischer    {
50710e20387SAndre Fischer        die "checksum type ".$checksum->{'type'}." is not supported";
50810e20387SAndre Fischer    }
5096a22bca6SAndre Fischer
51037e6b05aSAndre Fischer    # Download the extension.
51137e6b05aSAndre Fischer    my $agent = LWP::UserAgent->new();
51237e6b05aSAndre Fischer    $agent->timeout(120);
51337e6b05aSAndre Fischer    $agent->show_progress(1);
51437e6b05aSAndre Fischer    my $last_was_redirect = 0;
51537e6b05aSAndre Fischer    $agent->add_handler('response_redirect'
51637e6b05aSAndre Fischer                        => sub{
51737e6b05aSAndre Fischer                            $last_was_redirect = 1;
51837e6b05aSAndre Fischer                            return;
51937e6b05aSAndre Fischer                        });
52037e6b05aSAndre Fischer    $agent->add_handler('response_data'
52137e6b05aSAndre Fischer                        => sub{
52237e6b05aSAndre Fischer                            if ($last_was_redirect)
52337e6b05aSAndre Fischer                            {
52437e6b05aSAndre Fischer                                $last_was_redirect = 0;
52537e6b05aSAndre Fischer                                # Throw away the data we got so far.
526*0aabba3aSAndre Fischer                                $digest->reset();
52737e6b05aSAndre Fischer                                close $out;
52837e6b05aSAndre Fischer                                open $out, ">$temporary_filename";
52937e6b05aSAndre Fischer                                binmode($out);
53037e6b05aSAndre Fischer                            }
53137e6b05aSAndre Fischer                            my($response,$agent,$h,$data)=@_;
53237e6b05aSAndre Fischer                            print $out $data;
53310e20387SAndre Fischer                            $digest->add($data);
53437e6b05aSAndre Fischer                        });
53537e6b05aSAndre Fischer
53637e6b05aSAndre Fischer    my $response = $agent->get($URL);
53737e6b05aSAndre Fischer    close $out;
53837e6b05aSAndre Fischer
53910e20387SAndre Fischer    # When download was successfull then check the checksum and rename the .part file
54037e6b05aSAndre Fischer    # into the actual extension name.
54137e6b05aSAndre Fischer    if ($response->is_success())
54237e6b05aSAndre Fischer    {
54310e20387SAndre Fischer        my $file_checksum = $digest->hexdigest();
54410e20387SAndre Fischer        if (defined $checksum)
54537e6b05aSAndre Fischer        {
54610e20387SAndre Fischer            if ($checksum->{'value'} eq $file_checksum)
54737e6b05aSAndre Fischer            {
54810e20387SAndre Fischer                printf("%s checksum is OK\n", $checksum->{'type'});
54937e6b05aSAndre Fischer            }
55037e6b05aSAndre Fischer            else
55137e6b05aSAndre Fischer            {
55237e6b05aSAndre Fischer                unlink($temporary_filename);
55310e20387SAndre Fischer                printf("    %s checksum does not match (%s instead of %s)\n",
55410e20387SAndre Fischer                       $file_checksum,
55510e20387SAndre Fischer                       $checksum->{'value'},
55610e20387SAndre Fischer                       $checksum->{'type'});
55737e6b05aSAndre Fischer                return 0;
55837e6b05aSAndre Fischer            }
55937e6b05aSAndre Fischer        }
56037e6b05aSAndre Fischer        else
56137e6b05aSAndre Fischer        {
56210e20387SAndre Fischer            # The datafile does not contain a checksum to match against.
56310e20387SAndre Fischer            # Display the one that was calculated for the downloaded file so that
56410e20387SAndre Fischer            # it can be integrated manually into the data file.
56510e20387SAndre Fischer            printf("checksum not given, md5 of file is %s\n", $file_checksum);
56610e20387SAndre Fischer            $filename = File::Spec->catfile($ENV{'TARFILE_LOCATION'}, $file_checksum . "-" . $name);
56737e6b05aSAndre Fischer        }
5686a22bca6SAndre Fischer
56937e6b05aSAndre Fischer        rename($temporary_filename, $filename) || die "can not rename $temporary_filename to $filename";
57037e6b05aSAndre Fischer        return 1;
57137e6b05aSAndre Fischer    }
57237e6b05aSAndre Fischer    else
57337e6b05aSAndre Fischer    {
57437e6b05aSAndre Fischer        unlink($temporary_filename);
57537e6b05aSAndre Fischer        print "    download failed\n";
57637e6b05aSAndre Fischer        return 0;
57737e6b05aSAndre Fischer    }
57837e6b05aSAndre Fischer}
57937e6b05aSAndre Fischer
58037e6b05aSAndre Fischer
58137e6b05aSAndre Fischer
58237e6b05aSAndre Fischer
58337e6b05aSAndre Fischer=head3 CheckDownloadDestination ()
58437e6b05aSAndre Fischer
58537e6b05aSAndre Fischer    Make sure that the download destination $TARFILE_LOCATION does exist.  If
58637e6b05aSAndre Fischer    not, then the directory is created.
5876a22bca6SAndre Fischer
58837e6b05aSAndre Fischer=cut
58937e6b05aSAndre Fischersub CheckDownloadDestination ()
59037e6b05aSAndre Fischer{
59137e6b05aSAndre Fischer    my $destination = $ENV{'TARFILE_LOCATION'};
59237e6b05aSAndre Fischer    die "ERROR: no destination defined! please set TARFILE_LOCATION!" if ($destination eq "");
59337e6b05aSAndre Fischer
59437e6b05aSAndre Fischer    if ( ! -d $destination)
59537e6b05aSAndre Fischer    {
59637e6b05aSAndre Fischer        File::Path::make_path($destination);
59737e6b05aSAndre Fischer        die "ERROR: can't create \$TARFILE_LOCATION" if  ! -d $destination;
59837e6b05aSAndre Fischer    }
59937e6b05aSAndre Fischer}
60037e6b05aSAndre Fischer
60137e6b05aSAndre Fischer
60237e6b05aSAndre Fischer
60337e6b05aSAndre Fischer
60437e6b05aSAndre Fischer=head3 ProvideSpecialTarball ($url,$name,$name_converter)
60537e6b05aSAndre Fischer
60637e6b05aSAndre Fischer    A few tarballs need special handling.  That is done here.
6076a22bca6SAndre Fischer
60837e6b05aSAndre Fischer=cut
60937e6b05aSAndre Fischersub ProvideSpecialTarball ($$$)
61037e6b05aSAndre Fischer{
61137e6b05aSAndre Fischer    my $url = shift;
61237e6b05aSAndre Fischer    my $name = shift;
61337e6b05aSAndre Fischer    my $name_converter = shift;
61437e6b05aSAndre Fischer
61537e6b05aSAndre Fischer    return unless defined $url && $url ne "";
61637e6b05aSAndre Fischer
61737e6b05aSAndre Fischer    # See if we can find the executable.
61837e6b05aSAndre Fischer    my ($SOLARENV,$OUTPATH,$EXEEXT) =  ($ENV{'SOLARENV'},$ENV{'OUTPATH'},$ENV{'EXEEXT'});
61937e6b05aSAndre Fischer    $SOLARENV = "" unless defined $SOLARENV;
62037e6b05aSAndre Fischer    $OUTPATH = "" unless defined $OUTPATH;
62137e6b05aSAndre Fischer    $EXEEXT = "" unless defined $EXEEXT;
62237e6b05aSAndre Fischer    if (-x File::Spec->catfile($SOLARENV, $OUTPATH, "bin", $name.$EXEEXT))
62337e6b05aSAndre Fischer    {
62437e6b05aSAndre Fischer        print "found $name executable\n";
62537e6b05aSAndre Fischer        return;
62637e6b05aSAndre Fischer    }
62737e6b05aSAndre Fischer
62837e6b05aSAndre Fischer    # Download the source from the URL.
62937e6b05aSAndre Fischer    my $basename = basename(URI->new($url)->path());
63037e6b05aSAndre Fischer    die unless defined $basename;
63137e6b05aSAndre Fischer
63237e6b05aSAndre Fischer    if (defined $name_converter)
63337e6b05aSAndre Fischer    {
63437e6b05aSAndre Fischer        $basename = &{$name_converter}($basename);
63537e6b05aSAndre Fischer    }
6366a22bca6SAndre Fischer
63737e6b05aSAndre Fischer    # Has the source tar ball already been downloaded?
63837e6b05aSAndre Fischer    my @candidates = glob(File::Spec->catfile($ENV{'TARFILE_LOCATION'}, "*-" . $basename));
63937e6b05aSAndre Fischer    if (scalar @candidates > 0)
64037e6b05aSAndre Fischer    {
64137e6b05aSAndre Fischer        # Yes.
64237e6b05aSAndre Fischer        print "$basename exists\n";
64337e6b05aSAndre Fischer        return;
64437e6b05aSAndre Fischer    }
64537e6b05aSAndre Fischer    else
64637e6b05aSAndre Fischer    {
64737e6b05aSAndre Fischer        # No, download it.
64837e6b05aSAndre Fischer        print "downloading $basename\n";
64937e6b05aSAndre Fischer        DownloadFile($basename, $url, undef);
65037e6b05aSAndre Fischer    }
65137e6b05aSAndre Fischer}
65237e6b05aSAndre Fischer
65337e6b05aSAndre Fischer
65437e6b05aSAndre Fischer
65537e6b05aSAndre Fischer
65637e6b05aSAndre Fischer
65737e6b05aSAndre Fischer# The main() functionality.
65837e6b05aSAndre Fischer
65937e6b05aSAndre Fischerdie "usage: $0 <data-file-name>" if scalar @ARGV != 1;
66037e6b05aSAndre Fischermy $data_file = $ARGV[0];
66137e6b05aSAndre FischerCheckDownloadDestination();
66237e6b05aSAndre FischerProcessDataFile($data_file);
66337e6b05aSAndre FischerProvideSpecialTarball($ENV{'DMAKE_URL'}, "dmake", undef);
66437e6b05aSAndre FischerProvideSpecialTarball(
66537e6b05aSAndre Fischer    $ENV{'EPM_URL'},
66637e6b05aSAndre Fischer    "epm",
66737e6b05aSAndre Fischer    sub{$_[0]=~s/-source//; return $_[0]});
668