1c6dedb65SAndre Fischer#************************************************************** 2c6dedb65SAndre Fischer# 3c6dedb65SAndre Fischer# Licensed to the Apache Software Foundation (ASF) under one 4c6dedb65SAndre Fischer# or more contributor license agreements. See the NOTICE file 5c6dedb65SAndre Fischer# distributed with this work for additional information 6c6dedb65SAndre Fischer# regarding copyright ownership. The ASF licenses this file 7c6dedb65SAndre Fischer# to you under the Apache License, Version 2.0 (the 8c6dedb65SAndre Fischer# "License"); you may not use this file except in compliance 9c6dedb65SAndre Fischer# with the License. You may obtain a copy of the License at 10c6dedb65SAndre Fischer# 11c6dedb65SAndre Fischer# http://www.apache.org/licenses/LICENSE-2.0 12c6dedb65SAndre Fischer# 13c6dedb65SAndre Fischer# Unless required by applicable law or agreed to in writing, 14c6dedb65SAndre Fischer# software distributed under the License is distributed on an 15c6dedb65SAndre Fischer# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY 16c6dedb65SAndre Fischer# KIND, either express or implied. See the License for the 17c6dedb65SAndre Fischer# specific language governing permissions and limitations 18c6dedb65SAndre Fischer# under the License. 19c6dedb65SAndre Fischer# 20c6dedb65SAndre Fischer#************************************************************** 21c6dedb65SAndre Fischer 22c6dedb65SAndre Fischerpackage ExtensionsLst; 23c6dedb65SAndre Fischer 24c6dedb65SAndre Fischeruse File::Spec; 25c6dedb65SAndre Fischeruse LWP::UserAgent; 26c6dedb65SAndre Fischeruse Digest::MD5; 27c6dedb65SAndre Fischer 28c6dedb65SAndre Fischeruse base 'Exporter'; 29c6dedb65SAndre Fischerour @EXPORT = qw(DownloadExtensions GetExtensionList); 30c6dedb65SAndre Fischer 31c6dedb65SAndre Fischer 32c6dedb65SAndre Fischer=head1 NAME 33c6dedb65SAndre Fischer 34c6dedb65SAndre Fischer ExtensionLst.pm - Functionality for the interpretation of the main/extensions.lst file. 35c6dedb65SAndre Fischer 36c6dedb65SAndre Fischer=head1 SYNOPSIS 37c6dedb65SAndre Fischer 38c6dedb65SAndre Fischer For downloading extensions during build setup: 39c6dedb65SAndre Fischer 40c6dedb65SAndre Fischer use ExtensionsLst; 41c6dedb65SAndre Fischer ExtensionsLst::DownloadExtensions(); 42c6dedb65SAndre Fischer 43c6dedb65SAndre Fischer For including extensions into the pack set: 44c6dedb65SAndre Fischer 45c6dedb65SAndre Fischer use ExtensionsLst; 46c6dedb65SAndre Fischer ExtensionsLst::GetExtensionList(@language_list); 47c6dedb65SAndre Fischer 48c6dedb65SAndre Fischer=head1 DESCRIPTION 49c6dedb65SAndre Fischer 50c6dedb65SAndre Fischer The contents of the extensions.lst file are used at two times in 51c6dedb65SAndre Fischer the process of building pack sets. 52c6dedb65SAndre Fischer 53c6dedb65SAndre Fischer Once at the beginning right after configure is run the 54c6dedb65SAndre Fischer DownloadExtensions() function determines the list of extensions 55c6dedb65SAndre Fischer that are not present locally and downloads them. 56c6dedb65SAndre Fischer 57c6dedb65SAndre Fischer The second time is after all modules are built (and the locally 58c6dedb65SAndre Fischer built extensions are present) and the pack sets are created. For 59c6dedb65SAndre Fischer every language (or sets of lanugages) a set of extensions is 60c6dedb65SAndre Fischer collected and included into the pack set. 61c6dedb65SAndre Fischer 62c6dedb65SAndre Fischer The content of the extensions.lst file is ignored when the --with-extensions option is given to configure. 63c6dedb65SAndre Fischer 64c6dedb65SAndre Fischer=cut 65c6dedb65SAndre Fischer 66c6dedb65SAndre Fischer 67c6dedb65SAndre Fischer# Number of the line in extensions.lst that is currently being processed. 68c6dedb65SAndre Fischermy $LineNo = 0; 69c6dedb65SAndre Fischer 70c6dedb65SAndre Fischer 71c6dedb65SAndre Fischer=head3 Prepare 72c6dedb65SAndre Fischer Check that some environment variables are properly set and then return the file name 73c6dedb65SAndre Fischer of the 'extensions.lst' file, typically located in main/ beside 'ooo.lst'. 74c6dedb65SAndre Fischer=cut 75c6dedb65SAndre Fischersub Prepare () 76c6dedb65SAndre Fischer{ 77c6dedb65SAndre Fischer die "can not access environment varianle SRC_ROOT" if ! defined $ENV{'SRC_ROOT'}; 78c6dedb65SAndre Fischer die "can not determine the platform: INPATH is not set" if ! defined $ENV{'INPATH'}; 79c6dedb65SAndre Fischer die "can not determine solver directory: OUTDIR is not set" if ! defined $ENV{'OUTDIR'}; 80c6dedb65SAndre Fischer die "can not determine download directory: TARFILE_LOCATION is not set" if ! defined $ENV{'TARFILE_LOCATION'}; 81c6dedb65SAndre Fischer 82c6dedb65SAndre Fischer my $candidate = File::Spec->catfile($ENV{SRC_ROOT}, "extensions.lst"); 83c6dedb65SAndre Fischer die "can not read file $candidate" if ! -r $candidate; 84c6dedb65SAndre Fischer return $candidate; 85c6dedb65SAndre Fischer} 86c6dedb65SAndre Fischer 87c6dedb65SAndre Fischer 88c6dedb65SAndre Fischer 89c6dedb65SAndre Fischer=head 3 EvaluateOperator 90c6dedb65SAndre Fischer Evaluate a single test statement like 'language = en.*'. 91c6dedb65SAndre Fischer Special handling for operators '=', '==', and 'eq' which are all mapped to '=~'. 92c6dedb65SAndre Fischer Therefore the right hand side may be a perl regexp. It is prefixed with '^'. 93c6dedb65SAndre Fischer 94c6dedb65SAndre Fischer Other operators are at the moment only supported in the way that they are evaluated via eval(). 95c6dedb65SAndre Fischer=cut 96c6dedb65SAndre Fischersub EvaluateOperator ($$$) 97c6dedb65SAndre Fischer{ 98c6dedb65SAndre Fischer my ($left,$operator,$right) = @_; 99c6dedb65SAndre Fischer 100c6dedb65SAndre Fischer my $result; 101c6dedb65SAndre Fischer 102c6dedb65SAndre Fischer if ($operator =~ /^(=|==|eq)$/) 103c6dedb65SAndre Fischer { 104c6dedb65SAndre Fischer if ($left =~ /^$right$/) 105c6dedb65SAndre Fischer { 106c6dedb65SAndre Fischer $result = 1; 107c6dedb65SAndre Fischer } 108c6dedb65SAndre Fischer else 109c6dedb65SAndre Fischer { 110c6dedb65SAndre Fischer $result = 0; 111c6dedb65SAndre Fischer } 112c6dedb65SAndre Fischer } 113c6dedb65SAndre Fischer elsif (eval($left.$operator.$right)) 114c6dedb65SAndre Fischer { 115c6dedb65SAndre Fischer $result = 1; 116c6dedb65SAndre Fischer } 117c6dedb65SAndre Fischer else 118c6dedb65SAndre Fischer { 119c6dedb65SAndre Fischer $result = 0; 120c6dedb65SAndre Fischer } 121c6dedb65SAndre Fischer 122c6dedb65SAndre Fischer return $result; 123c6dedb65SAndre Fischer} 124c6dedb65SAndre Fischer 125c6dedb65SAndre Fischer 126c6dedb65SAndre Fischer 127c6dedb65SAndre Fischer 128c6dedb65SAndre Fischer=head EvaluateTerm 129c6dedb65SAndre Fischer Evaluate a string that contains a simple test term of the form 130c6dedb65SAndre Fischer left operator right 131c6dedb65SAndre Fischer with arbitrary spacing allowed around and between the three parts. 132c6dedb65SAndre Fischer 133c6dedb65SAndre Fischer The left hand side is specially handled: 134c6dedb65SAndre Fischer 135c6dedb65SAndre Fischer - When the left hand side is 'language' then it is replaced by 136c6dedb65SAndre Fischer any of the given languages in turn. When the term evaluates to true for any of the languages then 137c6dedb65SAndre Fischer true is returned. False is returned only when none of the given languages matches. 138c6dedb65SAndre Fischer 139c6dedb65SAndre Fischer - When the left hand side consists only of upper case letters, digits, and '_' then it is 140c6dedb65SAndre Fischer interpreted as the name of a environment variable. It is replaced by its value before the term 141c6dedb65SAndre Fischer is evaluated. 142c6dedb65SAndre Fischer 143c6dedb65SAndre Fischer - Any other left hand side is an error (at the moment.) 144c6dedb65SAndre Fischer=cut 145c6dedb65SAndre Fischersub EvaluateTerm ($$) 146c6dedb65SAndre Fischer{ 147c6dedb65SAndre Fischer my $term = shift; 148c6dedb65SAndre Fischer my $languages = shift; 149c6dedb65SAndre Fischer 150c6dedb65SAndre Fischer my $result; 151c6dedb65SAndre Fischer 152c6dedb65SAndre Fischer if ($term =~ /^\s*(\w+)\s*(\W+)\s*(.*?)\s*$/) 153c6dedb65SAndre Fischer { 154c6dedb65SAndre Fischer my ($left,$operator,$right) = ($1,$2,$3); 155c6dedb65SAndre Fischer 156c6dedb65SAndre Fischer if ($operator !~ /^=|==|eq$/) 157c6dedb65SAndre Fischer { 158c6dedb65SAndre Fischer die "unsupported operator $operator on line $LineNo"; 159c6dedb65SAndre Fischer } 160c6dedb65SAndre Fischer 161c6dedb65SAndre Fischer die "no right side in condition on line $LineNo ($term)" if ! defined $right; 162c6dedb65SAndre Fischer 163c6dedb65SAndre Fischer if ($left =~ /^[A-Z_0-9]+$/) 164c6dedb65SAndre Fischer { 165c6dedb65SAndre Fischer # Uppercase words are interpreted as environment variables. 166c6dedb65SAndre Fischer my $left_value = $ENV{$left}; 167c6dedb65SAndre Fischer $left_value = "" if ! defined $left_value; 168c6dedb65SAndre Fischer 169c6dedb65SAndre Fischer # We can check whether the condition is fullfilled right now. 170c6dedb65SAndre Fischer $result = EvaluateOperator($left_value, $operator, $right); 171c6dedb65SAndre Fischer } 172c6dedb65SAndre Fischer elsif ($left eq "language") 173c6dedb65SAndre Fischer { 174c6dedb65SAndre Fischer if ($right eq "all") 175c6dedb65SAndre Fischer { 176c6dedb65SAndre Fischer $result = 1; 177c6dedb65SAndre Fischer } 178c6dedb65SAndre Fischer elsif ($#$languages>=0) 179c6dedb65SAndre Fischer { 180c6dedb65SAndre Fischer $result = 0; 181c6dedb65SAndre Fischer for my $language (@$languages) 182c6dedb65SAndre Fischer { 183c6dedb65SAndre Fischer # Unify naming schemes. 184c6dedb65SAndre Fischer $language =~ s/_/-/g; 185c6dedb65SAndre Fischer $right =~ s/_/-/g; 186c6dedb65SAndre Fischer 187c6dedb65SAndre Fischer # Evaluate language regexp. 188c6dedb65SAndre Fischer $result = EvaluateOperator($language, $operator, $right) ? 1 : 0; 189c6dedb65SAndre Fischer last if $result; 190c6dedb65SAndre Fischer } 191c6dedb65SAndre Fischer } 192c6dedb65SAndre Fischer else 193c6dedb65SAndre Fischer { 194c6dedb65SAndre Fischer # The set of languages is not yet known. Return true 195c6dedb65SAndre Fischer # to include the following entries. 196c6dedb65SAndre Fischer $result = 1; 197c6dedb65SAndre Fischer } 198c6dedb65SAndre Fischer } 199c6dedb65SAndre Fischer elsif ($left eq "platform") 200c6dedb65SAndre Fischer { 201c6dedb65SAndre Fischer if ($right eq "all") 202c6dedb65SAndre Fischer { 203c6dedb65SAndre Fischer $result = 1; 204c6dedb65SAndre Fischer } 205c6dedb65SAndre Fischer else 206c6dedb65SAndre Fischer { 207c6dedb65SAndre Fischer # Evaluate platform regexp. 208c6dedb65SAndre Fischer $result = EvaluateOperator($ENV{'INPATH'}, $operator, $right) ? 1 : 0; 209c6dedb65SAndre Fischer } 210c6dedb65SAndre Fischer } 211c6dedb65SAndre Fischer else 212c6dedb65SAndre Fischer { 213c6dedb65SAndre Fischer die "can not handle left hand side $left on line $LineNo"; 214c6dedb65SAndre Fischer } 215c6dedb65SAndre Fischer } 216c6dedb65SAndre Fischer else 217c6dedb65SAndre Fischer { 218c6dedb65SAndre Fischer die "syntax error in expression on line $LineNo"; 219c6dedb65SAndre Fischer } 220c6dedb65SAndre Fischer 221c6dedb65SAndre Fischer return $result; 222c6dedb65SAndre Fischer} 223c6dedb65SAndre Fischer 224c6dedb65SAndre Fischer 225c6dedb65SAndre Fischer 226c6dedb65SAndre Fischer 227c6dedb65SAndre Fischer=head3 EvaluateSelector 228c6dedb65SAndre Fischer Evaluate the given expression that is expected to be list of terms of the form 229c6dedb65SAndre Fischer left-hand-side operator right-hand-side 230c6dedb65SAndre Fischer that are separated by logical operators 231c6dedb65SAndre Fischer && || 232c6dedb65SAndre Fischer The expression is lazy evaluated left to right. 233c6dedb65SAndre Fischer=cut 234c6dedb65SAndre Fischersub EvaluateSelector($$); 235c6dedb65SAndre Fischersub EvaluateSelector($$) 236c6dedb65SAndre Fischer{ 237c6dedb65SAndre Fischer my $expression = shift; 238c6dedb65SAndre Fischer my $languages = shift; 239c6dedb65SAndre Fischer 240c6dedb65SAndre Fischer my $result = ""; 241c6dedb65SAndre Fischer 242c6dedb65SAndre Fischer if ($expression =~ /^\s*$/) 243c6dedb65SAndre Fischer { 244c6dedb65SAndre Fischer # Empty selector is always true. 245c6dedb65SAndre Fischer return 1; 246c6dedb65SAndre Fischer } 247c6dedb65SAndre Fischer elsif ($expression =~ /^\s*(.*?)(&&|\|\|)\s*(.*)$/) 248c6dedb65SAndre Fischer { 249c6dedb65SAndre Fischer my ($term, $operator) = ($1,$2); 250c6dedb65SAndre Fischer $expression = $3; 251c6dedb65SAndre Fischer 252c6dedb65SAndre Fischer my $left_result = EvaluateTerm($term, $languages); 253c6dedb65SAndre Fischer # Lazy evaluation of && 254c6dedb65SAndre Fischer return 0 if ($operator eq "&&" && !$left_result); 255c6dedb65SAndre Fischer # Lazy evaluation of || 256c6dedb65SAndre Fischer return 1 if ($operator eq "||" && $left_result); 257c6dedb65SAndre Fischer my $right_result = EvaluateSelector($expression, $languages); 258c6dedb65SAndre Fischer 259c6dedb65SAndre Fischer if ($operator eq "&&") 260c6dedb65SAndre Fischer { 261c6dedb65SAndre Fischer return $left_result && $right_result; 262c6dedb65SAndre Fischer } 263c6dedb65SAndre Fischer else 264c6dedb65SAndre Fischer { 265c6dedb65SAndre Fischer return $left_result || $right_result; 266c6dedb65SAndre Fischer } 267c6dedb65SAndre Fischer } 268c6dedb65SAndre Fischer elsif ($expression =~ /^\s*(.+?)\s$/) 269c6dedb65SAndre Fischer { 270c6dedb65SAndre Fischer return EvaluateTerm($1, $languages); 271c6dedb65SAndre Fischer } 272c6dedb65SAndre Fischer else 273c6dedb65SAndre Fischer { 274c6dedb65SAndre Fischer die "invalid expression syntax on line $LineNo ($expression)"; 275c6dedb65SAndre Fischer } 276c6dedb65SAndre Fischer} 277c6dedb65SAndre Fischer 278c6dedb65SAndre Fischer 279c6dedb65SAndre Fischer 280c6dedb65SAndre Fischer 281c6dedb65SAndre Fischer=head3 ProcessURL 282c6dedb65SAndre Fischer Check that the given line contains an optional MD5 sum followed by 283201b78c7SAndre Fischer a URL for one of the protocols file, http, https, 284201b78c7SAndre Fischer followed by an optional file name (which is necessary when it is not the last part of the URL.) 285c6dedb65SAndre Fischer Return an array that contains the protocol, the name, the original 286c6dedb65SAndre Fischer URL, and the MD5 sum from the beginning of the line. 287c6dedb65SAndre Fischer The name of the URL depends on its protocol: 288c6dedb65SAndre Fischer - for http(s) the part of the URL after the last '/'. 289c6dedb65SAndre Fischer - for file URLS it is everything after the protocol:// 290c6dedb65SAndre Fischer=cut 291c6dedb65SAndre Fischersub ProcessURL ($) 292c6dedb65SAndre Fischer{ 293c6dedb65SAndre Fischer my $line = shift; 294c6dedb65SAndre Fischer 295c6dedb65SAndre Fischer # Check that we are looking at a valid URL. 296201b78c7SAndre Fischer if ($line =~ /^\s*((\w{32})\s+)?([a-zA-Z]+)(:\/\/.*?\/)([^\/ \t]+)(\s+\"[^\"]+\")?\s*$/) 297c6dedb65SAndre Fischer { 298201b78c7SAndre Fischer my ($md5, $protocol, $url_name, $optional_name) = ($2,$3,$5,$6); 299201b78c7SAndre Fischer my $URL = $3.$4.$5; 300c6dedb65SAndre Fischer 301c6dedb65SAndre Fischer die "invalid URL protocol on line $LineNo:\n$line\n" if $protocol !~ /(file|http|https)/; 302c6dedb65SAndre Fischer 303201b78c7SAndre Fischer # Determine the name. If an optional name is given then use that. 304201b78c7SAndre Fischer if (defined $optional_name) 305c6dedb65SAndre Fischer { 306201b78c7SAndre Fischer die if $optional_name !~ /^\s+\"([^\"]+)\"$/; 307c6dedb65SAndre Fischer $name = $1; 308c6dedb65SAndre Fischer } 309201b78c7SAndre Fischer else 310201b78c7SAndre Fischer { 311201b78c7SAndre Fischer if ($protocol eq "file") 312201b78c7SAndre Fischer { 313201b78c7SAndre Fischer # For file URLs we use everything after :// as name, or the . 314201b78c7SAndre Fischer $URL =~ /:\/\/(.*)$/; 315201b78c7SAndre Fischer $name = $1; 316201b78c7SAndre Fischer } 317201b78c7SAndre Fischer else 318201b78c7SAndre Fischer { 319201b78c7SAndre Fischer # For http and https use the last part of the URL. 320201b78c7SAndre Fischer $name = $url_name; 321201b78c7SAndre Fischer } 322201b78c7SAndre Fischer } 323c6dedb65SAndre Fischer 324c6dedb65SAndre Fischer return [$protocol, $name, $URL, $md5]; 325c6dedb65SAndre Fischer } 326c6dedb65SAndre Fischer else 327c6dedb65SAndre Fischer { 328c6dedb65SAndre Fischer die "invalid URL at line $LineNo:\n$line\n"; 329c6dedb65SAndre Fischer } 330c6dedb65SAndre Fischer} 331c6dedb65SAndre Fischer 332c6dedb65SAndre Fischer 333c6dedb65SAndre Fischer 334c6dedb65SAndre Fischer 335c6dedb65SAndre Fischer=head3 ParseExtensionsLst 336c6dedb65SAndre Fischer Parse the extensions.lst file. 337c6dedb65SAndre Fischer 338c6dedb65SAndre Fischer Lines that contain only spaces or comments or are empty are 339c6dedb65SAndre Fischer ignored. 340c6dedb65SAndre Fischer 341c6dedb65SAndre Fischer Lines that contain a selector, ie a test enclosed in brackets, are 342c6dedb65SAndre Fischer evaluated. The following lines, until the next selector, are 343c6dedb65SAndre Fischer ignored when the selector evaluates to false. When an empty list 344c6dedb65SAndre Fischer of languages is given then any 'language=...' test is evaluated as 345c6dedb65SAndre Fischer true. 346c6dedb65SAndre Fischer 347c6dedb65SAndre Fischer All other lines are expected to contain a URL optionally preceded 348c6dedb65SAndre Fischer by an MD5 sum. 349c6dedb65SAndre Fischer=cut 350c6dedb65SAndre Fischersub ParseExtensionsLst ($$) 351c6dedb65SAndre Fischer{ 352c6dedb65SAndre Fischer my $file_name = shift; 353c6dedb65SAndre Fischer my $languages = shift; 354c6dedb65SAndre Fischer 355c6dedb65SAndre Fischer open my $in, "$file_name"; 356c6dedb65SAndre Fischer 357c6dedb65SAndre Fischer my $current_selector_value = 1; 358c6dedb65SAndre Fischer my @URLs = (); 359c6dedb65SAndre Fischer 360c6dedb65SAndre Fischer while (<$in>) 361c6dedb65SAndre Fischer { 362c6dedb65SAndre Fischer my $line = $_; 363c6dedb65SAndre Fischer $line =~ s/[\r\n]+//g; 364c6dedb65SAndre Fischer ++$LineNo; 365c6dedb65SAndre Fischer 366c6dedb65SAndre Fischer # Strip away comments. 367c6dedb65SAndre Fischer next if $line =~ /^\s*#/; 368c6dedb65SAndre Fischer 369c6dedb65SAndre Fischer # Ignore empty lines. 370c6dedb65SAndre Fischer next if $line =~ /^\s*$/; 371c6dedb65SAndre Fischer 372c6dedb65SAndre Fischer # Process selectors 373c6dedb65SAndre Fischer if ($line =~ /^\s*\[\s*(.*)\s*\]\s*$/) 374c6dedb65SAndre Fischer { 375c6dedb65SAndre Fischer $current_selector_value = EvaluateSelector($1, $languages); 376c6dedb65SAndre Fischer } 377c6dedb65SAndre Fischer else 378c6dedb65SAndre Fischer { 379c6dedb65SAndre Fischer if ($current_selector_value) 380c6dedb65SAndre Fischer { 381c6dedb65SAndre Fischer push @URLs, ProcessURL($line); 382c6dedb65SAndre Fischer } 383c6dedb65SAndre Fischer } 384c6dedb65SAndre Fischer } 385c6dedb65SAndre Fischer 386c6dedb65SAndre Fischer close $in; 387c6dedb65SAndre Fischer 388c6dedb65SAndre Fischer return @URLs; 389c6dedb65SAndre Fischer} 390c6dedb65SAndre Fischer 391c6dedb65SAndre Fischer 392c6dedb65SAndre Fischer 393c6dedb65SAndre Fischer 394c6dedb65SAndre Fischer=head3 Download 395c6dedb65SAndre Fischer Download a set of files that are specified via URLs. 396c6dedb65SAndre Fischer 397c6dedb65SAndre Fischer File URLs are ignored here because they point to extensions that have not yet been built. 398c6dedb65SAndre Fischer 399c6dedb65SAndre Fischer For http URLs there may be an optional MD5 checksum. If it is present then downloaded 400c6dedb65SAndre Fischer files that do not match that checksum are an error and lead to abortion of the current process. 401c6dedb65SAndre Fischer Files that have already been downloaded are not downloaded again. 402c6dedb65SAndre Fischer=cut 403c6dedb65SAndre Fischersub Download (@) 404c6dedb65SAndre Fischer{ 405c6dedb65SAndre Fischer my @urls = @_; 406c6dedb65SAndre Fischer 407c6dedb65SAndre Fischer my @missing = (); 408c6dedb65SAndre Fischer my $download_path = $ENV{'TARFILE_LOCATION'}; 409c6dedb65SAndre Fischer 410c6dedb65SAndre Fischer # First check which (if any) extensions have already been downloaded. 411c6dedb65SAndre Fischer for my $entry (@urls) 412c6dedb65SAndre Fischer { 413c6dedb65SAndre Fischer my ($protocol, $name, $URL, $md5sum) = @{$entry}; 414c6dedb65SAndre Fischer 415c6dedb65SAndre Fischer # We can not check the existence of file URLs because they point to extensions that 416c6dedb65SAndre Fischer # have yet to be built. 417c6dedb65SAndre Fischer 418c6dedb65SAndre Fischer next if $protocol ne "http"; 419c6dedb65SAndre Fischer my $candidate = File::Spec->catfile($download_path, $name); 420c6dedb65SAndre Fischer if ( ! -f $candidate) 421c6dedb65SAndre Fischer { 422c6dedb65SAndre Fischer push @missing, $entry; 423c6dedb65SAndre Fischer } 424c6dedb65SAndre Fischer } 425c6dedb65SAndre Fischer if ($#missing >= 0) 426c6dedb65SAndre Fischer { 427c6dedb65SAndre Fischer printf "downloading %d missing extension%s\n", $#missing+1, $#missing>0 ? "s" : ""; 428c6dedb65SAndre Fischer if ( ! -d $download_path) 429c6dedb65SAndre Fischer { 430c6dedb65SAndre Fischer mkdir File::Spec->catpath($download_path, "tmp") 431c6dedb65SAndre Fischer || die "can not create tmp subdirectory of $download_path"; 432c6dedb65SAndre Fischer } 433c6dedb65SAndre Fischer } 434c6dedb65SAndre Fischer else 435c6dedb65SAndre Fischer { 436c6dedb65SAndre Fischer print "all downloadable extensions present\n"; 437c6dedb65SAndre Fischer return; 438c6dedb65SAndre Fischer } 439c6dedb65SAndre Fischer 440c6dedb65SAndre Fischer # Download the missing files. 441c6dedb65SAndre Fischer for my $entry (@missing) 442c6dedb65SAndre Fischer { 443c6dedb65SAndre Fischer my ($protocol, $name, $URL, $md5sum) = @{$entry}; 444c6dedb65SAndre Fischer 445c6dedb65SAndre Fischer # Open a .part file for writing. 446c6dedb65SAndre Fischer my $filename = File::Spec->catfile($download_path, $name); 447c6dedb65SAndre Fischer my $temporary_filename = $filename . ".part"; 448201b78c7SAndre Fischer print "downloading to $temporary_filename\n"; 449c6dedb65SAndre Fischer open my $out, ">$temporary_filename"; 450c6dedb65SAndre Fischer binmode($out); 451c6dedb65SAndre Fischer 452c6dedb65SAndre Fischer # Prepare md5 453c6dedb65SAndre Fischer my $md5 = Digest::MD5->new(); 454c6dedb65SAndre Fischer 455c6dedb65SAndre Fischer # Download the extension. 456c6dedb65SAndre Fischer my $agent = LWP::UserAgent->new(); 457*c0bb9eccSHerbert Dürr $agent->timeout(120); 458c6dedb65SAndre Fischer $agent->show_progress(1); 459201b78c7SAndre Fischer my $last_was_redirect = 0; 460201b78c7SAndre Fischer $agent->add_handler('response_redirect' 461201b78c7SAndre Fischer => sub{ 462201b78c7SAndre Fischer $last_was_redirect = 1; 463201b78c7SAndre Fischer return; 464201b78c7SAndre Fischer }); 465c6dedb65SAndre Fischer $agent->add_handler('response_data' 466c6dedb65SAndre Fischer => sub{ 467201b78c7SAndre Fischer if ($last_was_redirect) 468201b78c7SAndre Fischer { 469201b78c7SAndre Fischer $last_was_redirect = 0; 470201b78c7SAndre Fischer # Throw away the data we got so far. 471201b78c7SAndre Fischer $md5->reset(); 472201b78c7SAndre Fischer close $out; 473201b78c7SAndre Fischer open $out, ">$temporary_filename"; 474201b78c7SAndre Fischer binmode($out); 475201b78c7SAndre Fischer } 476c6dedb65SAndre Fischer my($response,$agent,$h,$data)=@_; 477c6dedb65SAndre Fischer print $out $data; 478c6dedb65SAndre Fischer $md5->add($data); 479c6dedb65SAndre Fischer }); 480c6dedb65SAndre Fischer my $response = $agent->get($URL); 481c6dedb65SAndre Fischer close $out; 482c6dedb65SAndre Fischer 483c6dedb65SAndre Fischer # When download was successfull then check the md5 checksum and rename the .part file 484c6dedb65SAndre Fischer # into the actual extension name. 485c6dedb65SAndre Fischer if ($response->is_success()) 486c6dedb65SAndre Fischer { 487c6dedb65SAndre Fischer if (defined $md5sum && length($md5sum)==32) 488c6dedb65SAndre Fischer { 489201b78c7SAndre Fischer my $file_md5 = $md5->hexdigest(); 490201b78c7SAndre Fischer if ($md5sum eq $file_md5) 491c6dedb65SAndre Fischer { 492c6dedb65SAndre Fischer print "md5 is OK\n"; 493c6dedb65SAndre Fischer } 494c6dedb65SAndre Fischer else 495c6dedb65SAndre Fischer { 496c6dedb65SAndre Fischer unlink($temporary_filename); 497201b78c7SAndre Fischer die "downloaded file has the wrong md5 checksum: $file_md5 instead of $md5sum"; 498c6dedb65SAndre Fischer } 499c6dedb65SAndre Fischer } 500201b78c7SAndre Fischer else 501201b78c7SAndre Fischer { 502201b78c7SAndre Fischer print "md5 is not present\n"; 503201b78c7SAndre Fischer printf " is %s, length is %d\n", $md5sum, length(md5sum); 504201b78c7SAndre Fischer } 505c6dedb65SAndre Fischer 506c6dedb65SAndre Fischer rename($temporary_filename, $filename) || die "can not rename $temporary_filename to $filename"; 507c6dedb65SAndre Fischer } 508c6dedb65SAndre Fischer else 509c6dedb65SAndre Fischer { 510c6dedb65SAndre Fischer die "failed to download $URL"; 511c6dedb65SAndre Fischer } 512c6dedb65SAndre Fischer } 513c6dedb65SAndre Fischer} 514c6dedb65SAndre Fischer 515c6dedb65SAndre Fischer 516c6dedb65SAndre Fischer 517c6dedb65SAndre Fischer 518c6dedb65SAndre Fischer=head3 DownloadExtensions 519c6dedb65SAndre Fischer This function is intended to be called during bootstrapping. It extracts the set of extensions 520c6dedb65SAndre Fischer that will be used later, when the installation sets are built. 521c6dedb65SAndre Fischer=cut 522c6dedb65SAndre Fischersub DownloadExtensions () 523c6dedb65SAndre Fischer{ 524c6dedb65SAndre Fischer my $full_file_name = Prepare(); 525c6dedb65SAndre Fischer my @urls = ParseExtensionsLst($full_file_name, []); 526c6dedb65SAndre Fischer Download(@urls); 527c6dedb65SAndre Fischer} 528c6dedb65SAndre Fischer 529c6dedb65SAndre Fischer 530c6dedb65SAndre Fischer 531c6dedb65SAndre Fischer 532c6dedb65SAndre Fischer=head3 GetExtensionList 533c6dedb65SAndre Fischer This function is intended to be called when installation sets are built. 534c6dedb65SAndre Fischer It expects two arguments: 535c6dedb65SAndre Fischer - A protocol selector. Http URLs reference remotely located 536c6dedb65SAndre Fischer extensions that will be bundled as-is into the installation 537c6dedb65SAndre Fischer sets due to legal reasons. They are installed on first start 538c6dedb65SAndre Fischer of the office. 539c6dedb65SAndre Fischer File URLs reference extensions whose source code is part of 540c6dedb65SAndre Fischer the repository. They are pre-registered when installation 541c6dedb65SAndre Fischer sets are created. Their installation is finished when the 542c6dedb65SAndre Fischer office is first started. 543c6dedb65SAndre Fischer - A set of languages. This set determines which extensions 544c6dedb65SAndre Fischer are returned and then included in an installation set. 545c6dedb65SAndre Fischer=cut 546c6dedb65SAndre Fischersub GetExtensionList ($@) 547c6dedb65SAndre Fischer{ 548c6dedb65SAndre Fischer my $protocol_selector = shift; 549c6dedb65SAndre Fischer my @language_list = @_; 550c6dedb65SAndre Fischer 551c6dedb65SAndre Fischer my $full_file_name = Prepare(); 552c6dedb65SAndre Fischer my @urls = ParseExtensionsLst($full_file_name, \@language_list); 553c6dedb65SAndre Fischer 554c6dedb65SAndre Fischer my @result = (); 555c6dedb65SAndre Fischer for my $entry (@urls) 556c6dedb65SAndre Fischer { 557c6dedb65SAndre Fischer my ($protocol, $name, $URL, $md5sum) = @{$entry}; 558c6dedb65SAndre Fischer if ($protocol =~ /^$protocol_selector$/) 559c6dedb65SAndre Fischer { 560c6dedb65SAndre Fischer push @result, $name; 561c6dedb65SAndre Fischer } 562c6dedb65SAndre Fischer } 563c6dedb65SAndre Fischer 564c6dedb65SAndre Fischer return @result; 565c6dedb65SAndre Fischer} 566c6dedb65SAndre Fischer 567c6dedb65SAndre Fischer 568c6dedb65SAndre Fischer1; 569