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:
34*10e20387SAndre Fischer    - MD5 is the expected MD5 checksum of the library tarball.
35*10e20387SAndre 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.
37*10e20387SAndre 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;
66*10e20387SAndre 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');
160*10e20387SAndre Fischer        my $checksum = GetChecksum();
16137e6b05aSAndre Fischer
162*10e20387SAndre Fischer        if ( ! defined $checksum)
16337e6b05aSAndre Fischer        {
164*10e20387SAndre Fischer            die "no checksum given for $name";
165*10e20387SAndre Fischer        }
166*10e20387SAndre Fischer        elsif ( ! IsPresent($name, $checksum))
167*10e20387SAndre Fischer        {
168*10e20387SAndre Fischer            AddDownloadRequest($name, $checksum);
16937e6b05aSAndre Fischer        }
17037e6b05aSAndre Fischer    }
17137e6b05aSAndre Fischer}
17237e6b05aSAndre Fischer
17337e6b05aSAndre Fischer
17437e6b05aSAndre Fischer
17537e6b05aSAndre Fischer
176*10e20387SAndre Fischer=head3 AddDownloadRequest($name, $checksum)
17737e6b05aSAndre Fischer
17837e6b05aSAndre Fischer    Add a request for downloading the library $name to @Missing.
17937e6b05aSAndre Fischer    Collect all available URL[1-9] variables as source URLs.
1806a22bca6SAndre Fischer
18137e6b05aSAndre Fischer=cut
182*10e20387SAndre Fischersub AddDownloadRequest ($$)
18337e6b05aSAndre Fischer{
184*10e20387SAndre Fischer    my ($name, $checksum) = @_;
18537e6b05aSAndre Fischer
18637e6b05aSAndre Fischer    print "adding download request for $name\n";
18737e6b05aSAndre Fischer
18837e6b05aSAndre Fischer    my $urls = [];
18937e6b05aSAndre Fischer    my $url = GetValue('URL');
19037e6b05aSAndre Fischer    push @$urls, SubstituteVariables($url) if (defined $url);
19137e6b05aSAndre Fischer    for (my $i=1; $i<10; ++$i)
19237e6b05aSAndre Fischer    {
19337e6b05aSAndre Fischer        $url = GetValue('URL'.$i);
19437e6b05aSAndre Fischer        next if ! defined $url;
19537e6b05aSAndre Fischer        push @$urls, SubstituteVariables($url);
19637e6b05aSAndre Fischer    }
19737e6b05aSAndre Fischer
198*10e20387SAndre Fischer    push @Missing, [$name, $checksum, $urls];
199*10e20387SAndre Fischer}
200*10e20387SAndre Fischer
201*10e20387SAndre Fischer
202*10e20387SAndre Fischer
203*10e20387SAndre Fischer
204*10e20387SAndre Fischer=head3 GetChecksum()
205*10e20387SAndre Fischer
206*10e20387SAndre Fischer    When either MD5 or SHA1 are variables in the current scope then return
207*10e20387SAndre Fischer    a reference to a hash with two entries:
208*10e20387SAndre Fischer        'type' is either 'MD5' or 'SHA1', the type or algorithm of the checksum,
209*10e20387SAndre Fischer        'value' is the actual checksum
210*10e20387SAndre Fischer    Otherwise undef is returned.
211*10e20387SAndre Fischer
212*10e20387SAndre Fischer=cut
213*10e20387SAndre Fischersub GetChecksum()
214*10e20387SAndre Fischer{
215*10e20387SAndre Fischer    my $checksum = GetValue("MD5");
216*10e20387SAndre Fischer    if (defined $checksum && $checksum ne "")
217*10e20387SAndre Fischer    {
218*10e20387SAndre Fischer        return { 'type' => 'MD5', 'value' => $checksum };
219*10e20387SAndre Fischer    }
220*10e20387SAndre Fischer    elsif (defined ($checksum=GetValue("SHA1")) && $checksum ne "")
221*10e20387SAndre Fischer    {
222*10e20387SAndre Fischer        return { 'type' => 'SHA1', 'value' => $checksum };
223*10e20387SAndre Fischer    }
224*10e20387SAndre Fischer    else
225*10e20387SAndre Fischer    {
226*10e20387SAndre Fischer        return undef;
227*10e20387SAndre Fischer    }
22837e6b05aSAndre Fischer}
22937e6b05aSAndre Fischer
23037e6b05aSAndre Fischer
23137e6b05aSAndre Fischer
23237e6b05aSAndre Fischer
23337e6b05aSAndre Fischer=head3 GetValue($variable_name)
23437e6b05aSAndre Fischer
23537e6b05aSAndre Fischer    Return the value of the variable with name $variable_name from the local
23637e6b05aSAndre Fischer    environment or, if not defined there, the global environment.
23737e6b05aSAndre Fischer
23837e6b05aSAndre Fischer=cut
23937e6b05aSAndre Fischersub GetValue ($)
24037e6b05aSAndre Fischer{
24137e6b05aSAndre Fischer    my $variable_name = shift;
24237e6b05aSAndre Fischer
24337e6b05aSAndre Fischer    my $candidate = $LocalEnvironment->{$variable_name};
24437e6b05aSAndre Fischer    return $candidate if defined $candidate;
24537e6b05aSAndre Fischer
24637e6b05aSAndre Fischer    return $GlobalEnvironment->{$variable_name};
24737e6b05aSAndre Fischer}
24837e6b05aSAndre Fischer
24937e6b05aSAndre Fischer
25037e6b05aSAndre Fischer
25137e6b05aSAndre Fischer=head3 SubstituteVariables($text)
25237e6b05aSAndre Fischer
25337e6b05aSAndre Fischer    Replace all references to variables in $text with the respective variable values.
25437e6b05aSAndre Fischer    This is done repeatedly until no variable reference remains.
2556a22bca6SAndre Fischer
25637e6b05aSAndre Fischer=cut
25737e6b05aSAndre Fischersub SubstituteVariables ($)
25837e6b05aSAndre Fischer{
25937e6b05aSAndre Fischer    my $text = shift;
26037e6b05aSAndre Fischer
26137e6b05aSAndre Fischer    my $infinite_recursion_guard = 100;
26237e6b05aSAndre Fischer    while ($text =~ /^(.*?)\$\(([^)]+)\)(.*)$/)
26337e6b05aSAndre Fischer    {
26437e6b05aSAndre Fischer        my ($head,$name,$tail) = ($1,$2,$3);
26537e6b05aSAndre Fischer        my $value = GetValue($name);
26637e6b05aSAndre Fischer        die "can evaluate variable $name" if ! defined $value;
26737e6b05aSAndre Fischer        $text = $head.$value.$tail;
26837e6b05aSAndre Fischer
26937e6b05aSAndre Fischer        die "(probably) detected an infinite recursion in variable definitions" if --$infinite_recursion_guard<=0;
27037e6b05aSAndre Fischer    }
27137e6b05aSAndre Fischer
27237e6b05aSAndre Fischer    return $text;
27337e6b05aSAndre Fischer}
27437e6b05aSAndre Fischer
27537e6b05aSAndre Fischer
27637e6b05aSAndre Fischer
27737e6b05aSAndre Fischer
27837e6b05aSAndre Fischer=head3 EvaluateExpression($expression)
27937e6b05aSAndre Fischer
28037e6b05aSAndre Fischer    Evaluate the $expression of an "if" statement to either 0 or 1.  It can
28137e6b05aSAndre Fischer    be a single term (see EvaluateTerm for a description), or several terms
2826a22bca6SAndre Fischer    separated by either all ||s or &&s.  A term can also be an expression
2836a22bca6SAndre Fischer    enclosed in parantheses.
2846a22bca6SAndre Fischer
28537e6b05aSAndre Fischer=cut
28637e6b05aSAndre Fischersub EvaluateExpression ($)
28737e6b05aSAndre Fischer{
28837e6b05aSAndre Fischer    my $expression = shift;
28937e6b05aSAndre Fischer
2906a22bca6SAndre Fischer    # Evaluate sub expressions enclosed in parantheses.
2916a22bca6SAndre Fischer    while ($expression =~ /^(.*)\(([^\(\)]+)\)(.*)$/)
2926a22bca6SAndre Fischer    {
2936a22bca6SAndre Fischer        $expression = $1 . (EvaluateExpression($2) ? " true " : " false ") . $3;
2946a22bca6SAndre Fischer    }
2956a22bca6SAndre Fischer
29637e6b05aSAndre Fischer    if ($expression =~ /&&/ && $expression =~ /\|\|/)
29737e6b05aSAndre Fischer    {
2986a22bca6SAndre Fischer        die "expression can contain either && or || but not both at the same time";
29937e6b05aSAndre Fischer    }
30037e6b05aSAndre Fischer    elsif ($expression =~ /&&/)
30137e6b05aSAndre Fischer    {
30237e6b05aSAndre Fischer        foreach my $term (split (/\s*&&\s*/,$expression))
30337e6b05aSAndre Fischer        {
30437e6b05aSAndre Fischer            return 0 if ! EvaluateTerm($term);
30537e6b05aSAndre Fischer        }
30637e6b05aSAndre Fischer        return 1;
30737e6b05aSAndre Fischer    }
30837e6b05aSAndre Fischer    elsif ($expression =~ /\|\|/)
30937e6b05aSAndre Fischer    {
31037e6b05aSAndre Fischer        foreach my $term (split (/\s*\|\|\s*/,$expression))
31137e6b05aSAndre Fischer        {
31237e6b05aSAndre Fischer            return 1 if EvaluateTerm($term);
31337e6b05aSAndre Fischer        }
31437e6b05aSAndre Fischer        return 0;
31537e6b05aSAndre Fischer    }
31637e6b05aSAndre Fischer    else
31737e6b05aSAndre Fischer    {
31837e6b05aSAndre Fischer        return EvaluateTerm($expression);
31937e6b05aSAndre Fischer    }
32037e6b05aSAndre Fischer}
32137e6b05aSAndre Fischer
32237e6b05aSAndre Fischer
32337e6b05aSAndre Fischer
32437e6b05aSAndre Fischer
32537e6b05aSAndre Fischer=head3 EvaluateTerm($term)
32637e6b05aSAndre Fischer
32737e6b05aSAndre Fischer    Evaluate the $term to either 0 or 1.
32837e6b05aSAndre Fischer    A term is either the literal "true", which evaluates to 1, or an expression
32937e6b05aSAndre Fischer    of the form NAME=VALUE or NAME!=VALUE.  NAME is the name of an environment
33037e6b05aSAndre Fischer    variable and VALUE any string.  VALUE may be empty.
3316a22bca6SAndre Fischer
33237e6b05aSAndre Fischer=cut
33337e6b05aSAndre Fischersub EvaluateTerm ($)
33437e6b05aSAndre Fischer{
33537e6b05aSAndre Fischer    my $term = shift;
33637e6b05aSAndre Fischer
3376a22bca6SAndre Fischer    if ($term =~ /^\s*([a-zA-Z_0-9]+)\s*(==|!=)\s*(.*)\s*$/)
33837e6b05aSAndre Fischer    {
33937e6b05aSAndre Fischer        my ($variable_name, $operator, $given_value) = ($1,$2,$3);
34037e6b05aSAndre Fischer        my $variable_value = $ENV{$variable_name};
3416a22bca6SAndre Fischer        $variable_value = "" if ! defined $variable_value;
34237e6b05aSAndre Fischer
3436a22bca6SAndre Fischer        if ($operator eq "==")
34437e6b05aSAndre Fischer        {
34537e6b05aSAndre Fischer            return $variable_value eq $given_value;
34637e6b05aSAndre Fischer        }
34737e6b05aSAndre Fischer        elsif ($operator eq "!=")
34837e6b05aSAndre Fischer        {
34937e6b05aSAndre Fischer            return $variable_value ne $given_value;
35037e6b05aSAndre Fischer        }
35137e6b05aSAndre Fischer        else
35237e6b05aSAndre Fischer        {
35337e6b05aSAndre Fischer            die "unknown operator in term $term";
35437e6b05aSAndre Fischer        }
35537e6b05aSAndre Fischer    }
35637e6b05aSAndre Fischer    elsif ($term =~ /^\s*true\s*$/i)
35737e6b05aSAndre Fischer    {
35837e6b05aSAndre Fischer        return 1;
35937e6b05aSAndre Fischer    }
3606a22bca6SAndre Fischer    elsif ($term =~ /^\s*false\s*$/i)
3616a22bca6SAndre Fischer    {
3626a22bca6SAndre Fischer        return 0;
3636a22bca6SAndre Fischer    }
36437e6b05aSAndre Fischer    else
36537e6b05aSAndre Fischer    {
36637e6b05aSAndre Fischer        die "term $term is not of the form <environment-variable> (=|==) <value>";
36737e6b05aSAndre Fischer    }
36837e6b05aSAndre Fischer}
36937e6b05aSAndre Fischer
37037e6b05aSAndre Fischer
37137e6b05aSAndre Fischer
37237e6b05aSAndre Fischer
373*10e20387SAndre Fischer=head IsPresent($name, $given_checksum)
37437e6b05aSAndre Fischer
37537e6b05aSAndre Fischer    Check if an external library tar ball with the basename $name already
37637e6b05aSAndre Fischer    exists in the target directory TARFILE_LOCATION.  The basename is
377*10e20387SAndre Fischer    prefixed with the MD5 or SHA1 checksum.
378*10e20387SAndre Fischer    If the file exists then its checksum is compared to the given one.
3796a22bca6SAndre Fischer
38037e6b05aSAndre Fischer=cut
38137e6b05aSAndre Fischersub IsPresent ($$)
38237e6b05aSAndre Fischer{
383*10e20387SAndre Fischer    my ($name, $given_checksum) = @_;
3846a22bca6SAndre Fischer
385*10e20387SAndre Fischer    my $filename = File::Spec->catfile($ENV{'TARFILE_LOCATION'}, $given_checksum->{'value'}."-".$name);
386*10e20387SAndre Fischer    return 0 unless -f $filename;
38737e6b05aSAndre Fischer
388*10e20387SAndre Fischer    # File exists.  Check if its checksum is correct.
389*10e20387SAndre Fischer    my $checksum;
390*10e20387SAndre Fischer    if ($given_checksum->{'type'} eq "MD5")
391*10e20387SAndre Fischer    {
392*10e20387SAndre Fischer        my $md5 = Digest::MD5->new();
393*10e20387SAndre Fischer        open my $in, $filename;
394*10e20387SAndre Fischer        $md5->addfile($in);
395*10e20387SAndre Fischer        $checksum = $md5->hexdigest();
396*10e20387SAndre Fischer    }
397*10e20387SAndre Fischer    elsif ($given_checksum->{'type'} eq "SHA1")
398*10e20387SAndre Fischer    {
399*10e20387SAndre Fischer        my $sha1 = Digest::SHA->new("1");
400*10e20387SAndre Fischer        open my $in, $filename;
401*10e20387SAndre Fischer        $sha1->addfile($in);
402*10e20387SAndre Fischer        $checksum = $sha1->hexdigest();
403*10e20387SAndre Fischer    }
404*10e20387SAndre Fischer    else
405*10e20387SAndre Fischer    {
406*10e20387SAndre Fischer        die "unsupported checksum type (not MD5 or SHA1)";
407*10e20387SAndre Fischer    }
40837e6b05aSAndre Fischer
409*10e20387SAndre Fischer    if ($given_checksum->{'value'} ne $checksum)
41037e6b05aSAndre Fischer    {
411*10e20387SAndre Fischer        # Checksum does not match.  Delete the file.
412*10e20387SAndre Fischer        print "$name exists, but checksum does not match => deleting\n";
41337e6b05aSAndre Fischer        #unlink($filename);
41437e6b05aSAndre Fischer        return 0;
41537e6b05aSAndre Fischer    }
41637e6b05aSAndre Fischer    else
41737e6b05aSAndre Fischer    {
418*10e20387SAndre Fischer        printf("%s exists, %s checksum is OK\n", $name, $given_checksum->{'type'});
41937e6b05aSAndre Fischer        return 1;
42037e6b05aSAndre Fischer    }
42137e6b05aSAndre Fischer}
42237e6b05aSAndre Fischer
42337e6b05aSAndre Fischer
42437e6b05aSAndre Fischer
42537e6b05aSAndre Fischer
42637e6b05aSAndre Fischer=head3 Download
42737e6b05aSAndre Fischer
42837e6b05aSAndre Fischer    Download a set of files specified by @Missing.
42937e6b05aSAndre Fischer
430*10e20387SAndre Fischer    For http URLs there may be an optional checksum.  If it is present then downloaded
431*10e20387SAndre Fischer    files that do not match that checksum lead to abortion of the current process.
43237e6b05aSAndre Fischer    Files that have already been downloaded are not downloaded again.
4336a22bca6SAndre Fischer
43437e6b05aSAndre Fischer=cut
43537e6b05aSAndre Fischersub Download ()
43637e6b05aSAndre Fischer{
43737e6b05aSAndre Fischer    my $download_path = $ENV{'TARFILE_LOCATION'};
4386a22bca6SAndre Fischer
43937e6b05aSAndre Fischer    if (scalar @Missing > 0)
44037e6b05aSAndre Fischer    {
44137e6b05aSAndre Fischer        printf("downloading %d missing tar ball%s to %s\n",
44237e6b05aSAndre Fischer               scalar @Missing, scalar @Missing>0 ? "s" : "",
44337e6b05aSAndre Fischer               $download_path);
44437e6b05aSAndre Fischer    }
44537e6b05aSAndre Fischer    else
44637e6b05aSAndre Fischer    {
44737e6b05aSAndre Fischer        print "all external libraries present\n";
44837e6b05aSAndre Fischer        return;
44937e6b05aSAndre Fischer    }
4506a22bca6SAndre Fischer
45137e6b05aSAndre Fischer    # Download the missing files.
45237e6b05aSAndre Fischer    for my $item (@Missing)
45337e6b05aSAndre Fischer    {
454*10e20387SAndre Fischer        my ($name, $checksum, $urls) = @$item;
4556a22bca6SAndre Fischer
45637e6b05aSAndre Fischer        foreach my $url (@$urls)
45737e6b05aSAndre Fischer        {
458*10e20387SAndre Fischer            last if DownloadFile($checksum->{'value'}."-".$name, $url, $checksum);
45937e6b05aSAndre Fischer        }
46037e6b05aSAndre Fischer    }
46137e6b05aSAndre Fischer}
46237e6b05aSAndre Fischer
46337e6b05aSAndre Fischer
46437e6b05aSAndre Fischer
46537e6b05aSAndre Fischer
466*10e20387SAndre Fischer=head3 DownloadFile($name,$URL,$checksum)
46737e6b05aSAndre Fischer
46837e6b05aSAndre Fischer    Download a single external library tarball.  It origin is given by $URL.
469*10e20387SAndre Fischer    Its destination is $(TARFILE_LOCATION)/$checksum-$name.
4706a22bca6SAndre Fischer
47137e6b05aSAndre Fischer=cut
47237e6b05aSAndre Fischersub DownloadFile ($$$)
47337e6b05aSAndre Fischer{
47437e6b05aSAndre Fischer    my $name = shift;
47537e6b05aSAndre Fischer    my $URL = shift;
476*10e20387SAndre Fischer    my $checksum = shift;
47737e6b05aSAndre Fischer
47837e6b05aSAndre Fischer    my $filename = File::Spec->catfile($ENV{'TARFILE_LOCATION'}, $name);
47937e6b05aSAndre Fischer
48037e6b05aSAndre Fischer    my $temporary_filename = $filename . ".part";
48137e6b05aSAndre Fischer
48237e6b05aSAndre Fischer    print "downloading to $temporary_filename\n";
48337e6b05aSAndre Fischer    open my $out, ">$temporary_filename";
48437e6b05aSAndre Fischer    binmode($out);
48537e6b05aSAndre Fischer
486*10e20387SAndre Fischer    # Prepare checksum
487*10e20387SAndre Fischer    my $digest;
488*10e20387SAndre Fischer    if (defined $checksum && $checksum->{'type'} eq "SHA1")
489*10e20387SAndre Fischer    {
490*10e20387SAndre Fischer        # Use SHA1 only when explicitly requested (by the presence of a "SHA1=..." line.)
491*10e20387SAndre Fischer        $digest = Digest::SHA->new("1");
492*10e20387SAndre Fischer    }
493*10e20387SAndre Fischer    elsif ( ! defined $checksum || $checksum->{'type'} eq "MD5")
494*10e20387SAndre Fischer    {
495*10e20387SAndre Fischer        # Use MD5 when explicitly requested or when no checksum type is given.
496*10e20387SAndre Fischer        $digest = Digest::MD5->new();
497*10e20387SAndre Fischer    }
498*10e20387SAndre Fischer    else
499*10e20387SAndre Fischer    {
500*10e20387SAndre Fischer        die "checksum type ".$checksum->{'type'}." is not supported";
501*10e20387SAndre Fischer    }
5026a22bca6SAndre Fischer
50337e6b05aSAndre Fischer    # Download the extension.
50437e6b05aSAndre Fischer    my $agent = LWP::UserAgent->new();
50537e6b05aSAndre Fischer    $agent->timeout(120);
50637e6b05aSAndre Fischer    $agent->show_progress(1);
50737e6b05aSAndre Fischer    my $last_was_redirect = 0;
50837e6b05aSAndre Fischer    $agent->add_handler('response_redirect'
50937e6b05aSAndre Fischer                        => sub{
51037e6b05aSAndre Fischer                            $last_was_redirect = 1;
51137e6b05aSAndre Fischer                            return;
51237e6b05aSAndre Fischer                        });
51337e6b05aSAndre Fischer    $agent->add_handler('response_data'
51437e6b05aSAndre Fischer                        => sub{
51537e6b05aSAndre Fischer                            if ($last_was_redirect)
51637e6b05aSAndre Fischer                            {
51737e6b05aSAndre Fischer                                $last_was_redirect = 0;
51837e6b05aSAndre Fischer                                # Throw away the data we got so far.
519*10e20387SAndre Fischer                                $checksum->reset();
52037e6b05aSAndre Fischer                                close $out;
52137e6b05aSAndre Fischer                                open $out, ">$temporary_filename";
52237e6b05aSAndre Fischer                                binmode($out);
52337e6b05aSAndre Fischer                            }
52437e6b05aSAndre Fischer                            my($response,$agent,$h,$data)=@_;
52537e6b05aSAndre Fischer                            print $out $data;
526*10e20387SAndre Fischer                            $digest->add($data);
52737e6b05aSAndre Fischer                        });
52837e6b05aSAndre Fischer
52937e6b05aSAndre Fischer    my $response = $agent->get($URL);
53037e6b05aSAndre Fischer    close $out;
53137e6b05aSAndre Fischer
532*10e20387SAndre Fischer    # When download was successfull then check the checksum and rename the .part file
53337e6b05aSAndre Fischer    # into the actual extension name.
53437e6b05aSAndre Fischer    if ($response->is_success())
53537e6b05aSAndre Fischer    {
536*10e20387SAndre Fischer        my $file_checksum = $digest->hexdigest();
537*10e20387SAndre Fischer        if (defined $checksum)
53837e6b05aSAndre Fischer        {
539*10e20387SAndre Fischer            if ($checksum->{'value'} eq $file_checksum)
54037e6b05aSAndre Fischer            {
541*10e20387SAndre Fischer                printf("%s checksum is OK\n", $checksum->{'type'});
54237e6b05aSAndre Fischer            }
54337e6b05aSAndre Fischer            else
54437e6b05aSAndre Fischer            {
54537e6b05aSAndre Fischer                unlink($temporary_filename);
546*10e20387SAndre Fischer                printf("    %s checksum does not match (%s instead of %s)\n",
547*10e20387SAndre Fischer                       $file_checksum,
548*10e20387SAndre Fischer                       $checksum->{'value'},
549*10e20387SAndre Fischer                       $checksum->{'type'});
55037e6b05aSAndre Fischer                return 0;
55137e6b05aSAndre Fischer            }
55237e6b05aSAndre Fischer        }
55337e6b05aSAndre Fischer        else
55437e6b05aSAndre Fischer        {
555*10e20387SAndre Fischer            # The datafile does not contain a checksum to match against.
556*10e20387SAndre Fischer            # Display the one that was calculated for the downloaded file so that
557*10e20387SAndre Fischer            # it can be integrated manually into the data file.
558*10e20387SAndre Fischer            printf("checksum not given, md5 of file is %s\n", $file_checksum);
559*10e20387SAndre Fischer            $filename = File::Spec->catfile($ENV{'TARFILE_LOCATION'}, $file_checksum . "-" . $name);
56037e6b05aSAndre Fischer        }
5616a22bca6SAndre Fischer
56237e6b05aSAndre Fischer        rename($temporary_filename, $filename) || die "can not rename $temporary_filename to $filename";
56337e6b05aSAndre Fischer        return 1;
56437e6b05aSAndre Fischer    }
56537e6b05aSAndre Fischer    else
56637e6b05aSAndre Fischer    {
56737e6b05aSAndre Fischer        unlink($temporary_filename);
56837e6b05aSAndre Fischer        print "    download failed\n";
56937e6b05aSAndre Fischer        return 0;
57037e6b05aSAndre Fischer    }
57137e6b05aSAndre Fischer}
57237e6b05aSAndre Fischer
57337e6b05aSAndre Fischer
57437e6b05aSAndre Fischer
57537e6b05aSAndre Fischer
57637e6b05aSAndre Fischer=head3 CheckDownloadDestination ()
57737e6b05aSAndre Fischer
57837e6b05aSAndre Fischer    Make sure that the download destination $TARFILE_LOCATION does exist.  If
57937e6b05aSAndre Fischer    not, then the directory is created.
5806a22bca6SAndre Fischer
58137e6b05aSAndre Fischer=cut
58237e6b05aSAndre Fischersub CheckDownloadDestination ()
58337e6b05aSAndre Fischer{
58437e6b05aSAndre Fischer    my $destination = $ENV{'TARFILE_LOCATION'};
58537e6b05aSAndre Fischer    die "ERROR: no destination defined! please set TARFILE_LOCATION!" if ($destination eq "");
58637e6b05aSAndre Fischer
58737e6b05aSAndre Fischer    if ( ! -d $destination)
58837e6b05aSAndre Fischer    {
58937e6b05aSAndre Fischer        File::Path::make_path($destination);
59037e6b05aSAndre Fischer        die "ERROR: can't create \$TARFILE_LOCATION" if  ! -d $destination;
59137e6b05aSAndre Fischer    }
59237e6b05aSAndre Fischer}
59337e6b05aSAndre Fischer
59437e6b05aSAndre Fischer
59537e6b05aSAndre Fischer
59637e6b05aSAndre Fischer
59737e6b05aSAndre Fischer=head3 ProvideSpecialTarball ($url,$name,$name_converter)
59837e6b05aSAndre Fischer
59937e6b05aSAndre Fischer    A few tarballs need special handling.  That is done here.
6006a22bca6SAndre Fischer
60137e6b05aSAndre Fischer=cut
60237e6b05aSAndre Fischersub ProvideSpecialTarball ($$$)
60337e6b05aSAndre Fischer{
60437e6b05aSAndre Fischer    my $url = shift;
60537e6b05aSAndre Fischer    my $name = shift;
60637e6b05aSAndre Fischer    my $name_converter = shift;
60737e6b05aSAndre Fischer
60837e6b05aSAndre Fischer    return unless defined $url && $url ne "";
60937e6b05aSAndre Fischer
61037e6b05aSAndre Fischer    # See if we can find the executable.
61137e6b05aSAndre Fischer    my ($SOLARENV,$OUTPATH,$EXEEXT) =  ($ENV{'SOLARENV'},$ENV{'OUTPATH'},$ENV{'EXEEXT'});
61237e6b05aSAndre Fischer    $SOLARENV = "" unless defined $SOLARENV;
61337e6b05aSAndre Fischer    $OUTPATH = "" unless defined $OUTPATH;
61437e6b05aSAndre Fischer    $EXEEXT = "" unless defined $EXEEXT;
61537e6b05aSAndre Fischer    if (-x File::Spec->catfile($SOLARENV, $OUTPATH, "bin", $name.$EXEEXT))
61637e6b05aSAndre Fischer    {
61737e6b05aSAndre Fischer        print "found $name executable\n";
61837e6b05aSAndre Fischer        return;
61937e6b05aSAndre Fischer    }
62037e6b05aSAndre Fischer
62137e6b05aSAndre Fischer    # Download the source from the URL.
62237e6b05aSAndre Fischer    my $basename = basename(URI->new($url)->path());
62337e6b05aSAndre Fischer    die unless defined $basename;
62437e6b05aSAndre Fischer
62537e6b05aSAndre Fischer    if (defined $name_converter)
62637e6b05aSAndre Fischer    {
62737e6b05aSAndre Fischer        $basename = &{$name_converter}($basename);
62837e6b05aSAndre Fischer    }
6296a22bca6SAndre Fischer
63037e6b05aSAndre Fischer    # Has the source tar ball already been downloaded?
63137e6b05aSAndre Fischer    my @candidates = glob(File::Spec->catfile($ENV{'TARFILE_LOCATION'}, "*-" . $basename));
63237e6b05aSAndre Fischer    if (scalar @candidates > 0)
63337e6b05aSAndre Fischer    {
63437e6b05aSAndre Fischer        # Yes.
63537e6b05aSAndre Fischer        print "$basename exists\n";
63637e6b05aSAndre Fischer        return;
63737e6b05aSAndre Fischer    }
63837e6b05aSAndre Fischer    else
63937e6b05aSAndre Fischer    {
64037e6b05aSAndre Fischer        # No, download it.
64137e6b05aSAndre Fischer        print "downloading $basename\n";
64237e6b05aSAndre Fischer        DownloadFile($basename, $url, undef);
64337e6b05aSAndre Fischer    }
64437e6b05aSAndre Fischer}
64537e6b05aSAndre Fischer
64637e6b05aSAndre Fischer
64737e6b05aSAndre Fischer
64837e6b05aSAndre Fischer
64937e6b05aSAndre Fischer
65037e6b05aSAndre Fischer# The main() functionality.
65137e6b05aSAndre Fischer
65237e6b05aSAndre Fischerdie "usage: $0 <data-file-name>" if scalar @ARGV != 1;
65337e6b05aSAndre Fischermy $data_file = $ARGV[0];
65437e6b05aSAndre FischerCheckDownloadDestination();
65537e6b05aSAndre FischerProcessDataFile($data_file);
65637e6b05aSAndre FischerProvideSpecialTarball($ENV{'DMAKE_URL'}, "dmake", undef);
65737e6b05aSAndre FischerProvideSpecialTarball(
65837e6b05aSAndre Fischer    $ENV{'EPM_URL'},
65937e6b05aSAndre Fischer    "epm",
66037e6b05aSAndre Fischer    sub{$_[0]=~s/-source//; return $_[0]});
661