1#!/usr/bin/perl
2
3=head1 NAME
4
5    download_external_libraries.pl - Load missing tarballs specified in main/external_libs.lst.
6
7=head1 SYNOPSIS
8
9    For downloading external libraries (typically from the main/bootstrap script):
10
11    download_external_libraries(<data-file-name>);
12
13=head1 DESCRIPTION
14
15    The contents of the main/external_libs.lst file are used to determine the
16    external library tarballs that are missing from ext_sources/.
17
18    Individual libraries can be ignored depending on the values of environment variables.
19
20    Format of the main/external_libs.lst file:
21
22    The file is line based.
23    Comments start with a # and go to the end of the line and are ignored.
24    Lines that are empty or contain only spaces and/or comments are ignored.
25
26    All other lines can have one of two forms:
27    - A variable definition of the form <name>=<value>.
28    - A conditional block start in the form "if (<expression>)"
29
30    Variables defined in a conditional block are only visible in this block and
31    replace the definition of global variables and variables earlier in the same
32    block.
33    Some variables have special names:
34    - MD5 is the expected MD5 sum of the library tarball.
35    - URL1 to URL9 specify from where to download the tarball.  The urls are tried in order.
36      The first successful download (download completed and MD5 sum match) stops the iteration.
37
38    Expressions are explained below in the comment of EvaluateExpression().
39
40    A library is only regarded if its conditional expression evaluates to 1.
41
42    Example:
43
44    DefaultSite=http://some-internet-site.org
45    if ( true )
46        MD5 = 0123456789abcdef0123456789abcdef
47        name = library-1.0.tar.gz
48        URL1 = http://some-other-internet-site.org/another-name.tgz
49        URL2 = $(DefaultSite)$(MD5)-$(name)
50
51    This tries to load a library first from some-other-internet-site.org and if
52    that fails from some-internet-site.org.  The library is stored as $(MD5)-$(name)
53    even when it is loaded as another-name.tgz.
54
55=cut
56
57
58use strict;
59
60use File::Spec;
61use File::Path;
62use File::Basename;
63use LWP::UserAgent;
64use Digest::MD5;
65use URI;
66
67my $Debug = 1;
68
69my $LocalEnvironment = undef;
70my $GlobalEnvironment = {};
71my @Missing = ();
72
73
74
75
76=head3 ProcessDataFile
77
78    Read the data file, typically named main/external_libs.lst, find the external
79    library tarballs that are not yet present in ext_sources/ and download them.
80
81=cut
82sub ProcessDataFile ($)
83{
84    my $filename = shift;
85
86    my $destination = $ENV{'TARFILE_LOCATION'};
87
88    die "can not open data file $filename" if ! -e $filename;
89
90    my $current_selector_value = 1;
91    my @URLHeads = ();
92    my @download_requests = ();
93
94    open my $in, $filename;
95    while (my $line = <$in>)
96    {
97        # Remove leading and trailing space and comments
98        $line =~ s/^\s+//;
99        $line =~ s/\s+$//;
100        $line =~ s/\s*#.*$//;
101
102        # Ignore empty lines.
103        next if $line eq "";
104
105        # An "if" statement starts a new block.
106        if ($line =~ /^\s*if\s*\(\s*(.*?)\s*\)\s*$/)
107        {
108            ProcessLastBlock();
109
110            $LocalEnvironment = { 'selector' => $1 };
111        }
112
113        # Lines of the form name = value define a local variable.
114        elsif ($line =~ /^\s*(\S+)\s*=\s*(.*?)\s*$/)
115        {
116            if (defined $LocalEnvironment)
117            {
118                $LocalEnvironment->{$1} = $2;
119            }
120            else
121            {
122                $GlobalEnvironment->{$1} = $2;
123            }
124        }
125        else
126        {
127            die "can not parse line $line\n";
128        }
129    }
130
131    ProcessLastBlock();
132
133    Download(\@download_requests, \@URLHeads);
134}
135
136
137
138
139=head3 ProcessLastBlock
140
141    Process the last definition of an external library.
142    If there is not last block, true for the first "if" statement, then the call is ignored.
143
144=cut
145sub ProcessLastBlock ()
146{
147    # Return if no block is defined.
148    return if ! defined $LocalEnvironment;
149
150    # Ignore the block if the selector does not match.
151    if ( ! EvaluateExpression(SubstituteVariables($LocalEnvironment->{'selector'})))
152    {
153        printf("ignoring %s because its prerequisites are not fulfilled\n", GetValue('name'));
154    }
155    else
156    {
157        my $name = GetValue('name');
158
159        if ( ! IsPresent($name, GetValue('MD5')))
160        {
161            AddDownloadRequest($name);
162        }
163    }
164}
165
166
167
168
169=head3 AddDownloadRequest($name)
170
171    Add a request for downloading the library $name to @Missing.
172    Collect all available URL[1-9] variables as source URLs.
173
174=cut
175sub AddDownloadRequest ($)
176{
177    my $name = shift;
178
179    print "adding download request for $name\n";
180
181    my $urls = [];
182    my $url = GetValue('URL');
183    push @$urls, SubstituteVariables($url) if (defined $url);
184    for (my $i=1; $i<10; ++$i)
185    {
186        $url = GetValue('URL'.$i);
187        next if ! defined $url;
188        push @$urls, SubstituteVariables($url);
189    }
190
191    push @Missing, [$name, GetValue('MD5'), $urls];
192}
193
194
195
196
197=head3 GetValue($variable_name)
198
199    Return the value of the variable with name $variable_name from the local
200    environment or, if not defined there, the global environment.
201
202=cut
203sub GetValue ($)
204{
205    my $variable_name = shift;
206
207    my $candidate = $LocalEnvironment->{$variable_name};
208    return $candidate if defined $candidate;
209
210    return $GlobalEnvironment->{$variable_name};
211}
212
213
214
215=head3 SubstituteVariables($text)
216
217    Replace all references to variables in $text with the respective variable values.
218    This is done repeatedly until no variable reference remains.
219
220=cut
221sub SubstituteVariables ($)
222{
223    my $text = shift;
224
225    my $infinite_recursion_guard = 100;
226    while ($text =~ /^(.*?)\$\(([^)]+)\)(.*)$/)
227    {
228        my ($head,$name,$tail) = ($1,$2,$3);
229        my $value = GetValue($name);
230        die "can evaluate variable $name" if ! defined $value;
231        $text = $head.$value.$tail;
232
233        die "(probably) detected an infinite recursion in variable definitions" if --$infinite_recursion_guard<=0;
234    }
235
236    return $text;
237}
238
239
240
241
242=head3 EvaluateExpression($expression)
243
244    Evaluate the $expression of an "if" statement to either 0 or 1.  It can
245    be a single term (see EvaluateTerm for a description), or several terms
246    separated by either all ||s or &&s.  A term can also be an expression
247    enclosed in parantheses.
248
249=cut
250sub EvaluateExpression ($)
251{
252    my $expression = shift;
253
254    # Evaluate sub expressions enclosed in parantheses.
255    while ($expression =~ /^(.*)\(([^\(\)]+)\)(.*)$/)
256    {
257        $expression = $1 . (EvaluateExpression($2) ? " true " : " false ") . $3;
258    }
259
260    if ($expression =~ /&&/ && $expression =~ /\|\|/)
261    {
262        die "expression can contain either && or || but not both at the same time";
263    }
264    elsif ($expression =~ /&&/)
265    {
266        foreach my $term (split (/\s*&&\s*/,$expression))
267        {
268            return 0 if ! EvaluateTerm($term);
269        }
270        return 1;
271    }
272    elsif ($expression =~ /\|\|/)
273    {
274        foreach my $term (split (/\s*\|\|\s*/,$expression))
275        {
276            return 1 if EvaluateTerm($term);
277        }
278        return 0;
279    }
280    else
281    {
282        return EvaluateTerm($expression);
283    }
284}
285
286
287
288
289=head3 EvaluateTerm($term)
290
291    Evaluate the $term to either 0 or 1.
292    A term is either the literal "true", which evaluates to 1, or an expression
293    of the form NAME=VALUE or NAME!=VALUE.  NAME is the name of an environment
294    variable and VALUE any string.  VALUE may be empty.
295
296=cut
297sub EvaluateTerm ($)
298{
299    my $term = shift;
300
301    if ($term =~ /^\s*([a-zA-Z_0-9]+)\s*(==|!=)\s*(.*)\s*$/)
302    {
303        my ($variable_name, $operator, $given_value) = ($1,$2,$3);
304        my $variable_value = $ENV{$variable_name};
305        $variable_value = "" if ! defined $variable_value;
306
307        if ($operator eq "==")
308        {
309            return $variable_value eq $given_value;
310        }
311        elsif ($operator eq "!=")
312        {
313            return $variable_value ne $given_value;
314        }
315        else
316        {
317            die "unknown operator in term $term";
318        }
319    }
320    elsif ($term =~ /^\s*true\s*$/i)
321    {
322        return 1;
323    }
324    elsif ($term =~ /^\s*false\s*$/i)
325    {
326        return 0;
327    }
328    else
329    {
330        die "term $term is not of the form <environment-variable> (=|==) <value>";
331    }
332}
333
334
335
336
337=head IsPresent($name,$given_md5)
338
339    Check if an external library tar ball with the basename $name already
340    exists in the target directory TARFILE_LOCATION.  The basename is
341    prefixed with the given MD5 sum.
342    If the file exists then its MD5 sum is compare with the given MD5 sum.
343
344=cut
345sub IsPresent ($$)
346{
347    my $name = shift;
348    my $given_md5 = shift;
349
350    my $filename = File::Spec->catfile($ENV{'TARFILE_LOCATION'}, $given_md5."-".$name);
351
352    return 0 if ! -f $filename;
353
354    # File exists.  Check if its md5 sum is correct.
355    my $md5 = Digest::MD5->new();
356    open my $in, $filename;
357    $md5->addfile($in);
358
359    if ($given_md5 ne $md5->hexdigest())
360    {
361        # MD5 check sum does not match.  Delete the file.
362        print "$name exists, but md5 does not match => deleting\n";
363        #unlink($filename);
364        return 0;
365    }
366    else
367    {
368        print "$name exists, md5 is OK\n";
369        return 1;
370    }
371}
372
373
374
375
376=head3 Download
377
378    Download a set of files specified by @Missing.
379
380    For http URLs there may be an optional MD5 checksum.  If it is present then downloaded
381    files that do not match that checksum are an error and lead to abortion of the current process.
382    Files that have already been downloaded are not downloaded again.
383
384=cut
385sub Download ()
386{
387    my $download_path = $ENV{'TARFILE_LOCATION'};
388
389    if (scalar @Missing > 0)
390    {
391        printf("downloading %d missing tar ball%s to %s\n",
392               scalar @Missing, scalar @Missing>0 ? "s" : "",
393               $download_path);
394    }
395    else
396    {
397        print "all external libraries present\n";
398        return;
399    }
400
401    # Download the missing files.
402    for my $item (@Missing)
403    {
404        my ($name, $given_md5, $urls) = @$item;
405
406        foreach my $url (@$urls)
407        {
408            last if DownloadFile($given_md5."-".$name, $url, $given_md5);
409        }
410    }
411}
412
413
414
415
416=head3 DownloadFile($name,$URL,$md5sum)
417
418    Download a single external library tarball.  It origin is given by $URL.
419    Its destination is $(TARFILE_LOCATION)/$md5sum-$name.
420
421=cut
422sub DownloadFile ($$$)
423{
424    my $name = shift;
425    my $URL = shift;
426    my $md5sum = shift;
427
428    my $filename = File::Spec->catfile($ENV{'TARFILE_LOCATION'}, $name);
429
430    my $temporary_filename = $filename . ".part";
431
432    print "downloading to $temporary_filename\n";
433    open my $out, ">$temporary_filename";
434    binmode($out);
435
436    # Prepare md5
437    my $md5 = Digest::MD5->new();
438
439    # Download the extension.
440    my $agent = LWP::UserAgent->new();
441    $agent->timeout(120);
442    $agent->show_progress(1);
443    my $last_was_redirect = 0;
444    $agent->add_handler('response_redirect'
445                        => sub{
446                            $last_was_redirect = 1;
447                            return;
448                        });
449    $agent->add_handler('response_data'
450                        => sub{
451                            if ($last_was_redirect)
452                            {
453                                $last_was_redirect = 0;
454                                # Throw away the data we got so far.
455                                $md5->reset();
456                                close $out;
457                                open $out, ">$temporary_filename";
458                                binmode($out);
459                            }
460                            my($response,$agent,$h,$data)=@_;
461                            print $out $data;
462                            $md5->add($data);
463                        });
464
465    my $response = $agent->get($URL);
466    close $out;
467
468    # When download was successfull then check the md5 checksum and rename the .part file
469    # into the actual extension name.
470    if ($response->is_success())
471    {
472        my $file_md5 = $md5->hexdigest();
473        if (defined $md5sum && length($md5sum)==32)
474        {
475            if ($md5sum eq $file_md5)
476            {
477                print "md5 is OK\n";
478            }
479            else
480            {
481                unlink($temporary_filename);
482                print "    md5 does not match ($file_md5 instead of $md5sum)\n";
483                return 0;
484            }
485        }
486        else
487        {
488            printf("md5 not given, md5 of file is %s\n", $file_md5);
489            $filename = File::Spec->catfile($ENV{'TARFILE_LOCATION'}, $file_md5 . "-" . $name);
490        }
491
492        rename($temporary_filename, $filename) || die "can not rename $temporary_filename to $filename";
493        return 1;
494    }
495    else
496    {
497        unlink($temporary_filename);
498        print "    download failed\n";
499        return 0;
500    }
501}
502
503
504
505
506=head3 CheckDownloadDestination ()
507
508    Make sure that the download destination $TARFILE_LOCATION does exist.  If
509    not, then the directory is created.
510
511=cut
512sub CheckDownloadDestination ()
513{
514    my $destination = $ENV{'TARFILE_LOCATION'};
515    die "ERROR: no destination defined! please set TARFILE_LOCATION!" if ($destination eq "");
516
517    if ( ! -d $destination)
518    {
519        File::Path::make_path($destination);
520        die "ERROR: can't create \$TARFILE_LOCATION" if  ! -d $destination;
521    }
522}
523
524
525
526
527=head3 ProvideSpecialTarball ($url,$name,$name_converter)
528
529    A few tarballs need special handling.  That is done here.
530
531=cut
532sub ProvideSpecialTarball ($$$)
533{
534    my $url = shift;
535    my $name = shift;
536    my $name_converter = shift;
537
538    return unless defined $url && $url ne "";
539
540    # See if we can find the executable.
541    my ($SOLARENV,$OUTPATH,$EXEEXT) =  ($ENV{'SOLARENV'},$ENV{'OUTPATH'},$ENV{'EXEEXT'});
542    $SOLARENV = "" unless defined $SOLARENV;
543    $OUTPATH = "" unless defined $OUTPATH;
544    $EXEEXT = "" unless defined $EXEEXT;
545    if (-x File::Spec->catfile($SOLARENV, $OUTPATH, "bin", $name.$EXEEXT))
546    {
547        print "found $name executable\n";
548        return;
549    }
550
551    # Download the source from the URL.
552    my $basename = basename(URI->new($url)->path());
553    die unless defined $basename;
554
555    if (defined $name_converter)
556    {
557        $basename = &{$name_converter}($basename);
558    }
559
560    # Has the source tar ball already been downloaded?
561    my @candidates = glob(File::Spec->catfile($ENV{'TARFILE_LOCATION'}, "*-" . $basename));
562    if (scalar @candidates > 0)
563    {
564        # Yes.
565        print "$basename exists\n";
566        return;
567    }
568    else
569    {
570        # No, download it.
571        print "downloading $basename\n";
572        DownloadFile($basename, $url, undef);
573    }
574}
575
576
577
578
579
580# The main() functionality.
581
582die "usage: $0 <data-file-name>" if scalar @ARGV != 1;
583my $data_file = $ARGV[0];
584CheckDownloadDestination();
585ProcessDataFile($data_file);
586ProvideSpecialTarball($ENV{'DMAKE_URL'}, "dmake", undef);
587ProvideSpecialTarball(
588    $ENV{'EPM_URL'},
589    "epm",
590    sub{$_[0]=~s/-source//; return $_[0]});
591