#************************************************************** # # Licensed to the Apache Software Foundation (ASF) under one # or more contributor license agreements. See the NOTICE file # distributed with this work for additional information # regarding copyright ownership. The ASF licenses this file # to you under the Apache License, Version 2.0 (the # "License"); you may not use this file except in compliance # with the License. You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, # software distributed under the License is distributed on an # "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY # KIND, either express or implied. See the License for the # specific language governing permissions and limitations # under the License. # #************************************************************** package ExtensionsLst; use File::Spec; use LWP::UserAgent; use Digest::MD5; use base 'Exporter'; our @EXPORT = qw(DownloadExtensions GetExtensionList); =head1 NAME ExtensionLst.pm - Functionality for the interpretation of the main/extensions.lst file. =head1 SYNOPSIS For downloading extensions during build setup: use ExtensionsLst; ExtensionsLst::DownloadExtensions(); For including extensions into the pack set: use ExtensionsLst; ExtensionsLst::GetExtensionList(@language_list); =head1 DESCRIPTION The contents of the extensions.lst file are used at two times in the process of building pack sets. Once at the beginning right after configure is run the DownloadExtensions() function determines the list of extensions that are not present locally and downloads them. The second time is after all modules are built (and the locally built extensions are present) and the pack sets are created. For every language (or sets of lanugages) a set of extensions is collected and included into the pack set. The content of the extensions.lst file is ignored when the --with-extensions option is given to configure. =cut # Number of the line in extensions.lst that is currently being processed. my $LineNo = 0; # Set to 1 to get a more verbose output, the default is 0. my $Debug = 0; =head3 Prepare Check that some environment variables are properly set and then return the file name of the 'extensions.lst' file, typically located in main/ beside 'ooo.lst'. =cut sub Prepare () { die "can not access environment varianle SRC_ROOT" if ! defined $ENV{'SRC_ROOT'}; die "can not determine the platform: INPATH is not set" if ! defined $ENV{'INPATH'}; die "can not determine solver directory: OUTDIR is not set" if ! defined $ENV{'OUTDIR'}; die "can not determine download directory: TARFILE_LOCATION is not set" if ! defined $ENV{'TARFILE_LOCATION'}; my $candidate = File::Spec->catfile($ENV{SRC_ROOT}, "extensions.lst"); die "can not read file $candidate" if ! -r $candidate; return $candidate; } =head 3 EvaluateOperator Evaluate a single test statement like 'language = en.*'. Special handling for operators '=', '==', and 'eq' which are all mapped to '=~'. Therefore the right hand side may be a perl regexp. It is prefixed with '^'. Other operators are at the moment only supported in the way that they are evaluated via eval(). =cut sub EvaluateOperator ($$$) { my ($left,$operator,$right) = @_; my $result; if ($operator =~ /^(=|==|eq)$/) { if ($left =~ /^$right$/) { $result = 1; } else { $result = 0; } } elsif (eval($left.$operator.$right)) { $result = 1; } else { $result = 0; } return $result; } =head EvaluateTerm Evaluate a string that contains a simple test term of the form left operator right with arbitrary spacing allowed around and between the three parts. The left hand side is specially handled: - When the left hand side is 'language' then it is replaced by any of the given languages in turn. When the term evaluates to true for any of the languages then true is returned. False is returned only when none of the given languages matches. - When the left hand side consists only of upper case letters, digits, and '_' then it is interpreted as the name of a environment variable. It is replaced by its value before the term is evaluated. - Any other left hand side is an error (at the moment.) =cut sub EvaluateTerm ($$) { my $term = shift; my $languages = shift; my $result; if ($term =~ /^\s*(\w+)\s*(\W+)\s*(.*?)\s*$/) { my ($left,$operator,$right) = ($1,$2,$3); if ($operator !~ /^=|==|eq$/) { die "unsupported operator $operator on line $LineNo"; } die "no right side in condition on line $LineNo ($term)" if ! defined $right; if ($left =~ /^[A-Z_0-9]+$/) { # Uppercase words are interpreted as environment variables. my $left_value = $ENV{$left}; $left_value = "" if ! defined $left_value; # We can check whether the condition is fullfilled right now. $result = EvaluateOperator($left_value, $operator, $right); } elsif ($left eq "language") { if ($right eq "all") { $result = 1; } elsif ($#$languages>=0) { $result = 0; for my $language (@$languages) { # Unify naming schemes. $language =~ s/_/-/g; $right =~ s/_/-/g; # Evaluate language regexp. $result = EvaluateOperator($language, $operator, $right) ? 1 : 0; last if $result; } } else { # The set of languages is not yet known. Return true # to include the following entries. $result = 1; } } elsif ($left eq "platform") { if ($right eq "all") { $result = 1; } else { # Evaluate platform regexp. $result = EvaluateOperator($ENV{'INPATH'}, $operator, $right) ? 1 : 0; } } else { die "can not handle left hand side $left on line $LineNo"; } } else { die "syntax error in expression on line $LineNo"; } return $result; } =head3 EvaluateSelector Evaluate the given expression that is expected to be list of terms of the form left-hand-side operator right-hand-side that are separated by logical operators && || The expression is lazy evaluated left to right. =cut sub EvaluateSelector($$); sub EvaluateSelector($$) { my $expression = shift; my $languages = shift; my $result = ""; if ($expression =~ /^\s*$/) { # Empty selector is always true. return 1; } elsif ($expression =~ /^\s*(.*?)(&&|\|\|)\s*(.*)$/) { my ($term, $operator) = ($1,$2); $expression = $3; my $left_result = EvaluateTerm($term, $languages); # Lazy evaluation of && return 0 if ($operator eq "&&" && !$left_result); # Lazy evaluation of || return 1 if ($operator eq "||" && $left_result); my $right_result = EvaluateSelector($expression, $languages); if ($operator eq "&&") { return $left_result && $right_result; } else { return $left_result || $right_result; } } elsif ($expression =~ /^\s*(.+?)\s$/) { return EvaluateTerm($1, $languages); } else { die "invalid expression syntax on line $LineNo ($expression)"; } } =head3 ProcessURL Check that the given line contains an optional MD5 sum followed by a URL for one of the protocols file, http, https, followed by an optional file name (which is necessary when it is not the last part of the URL.) Return an array that contains the protocol, the name, the original URL, and the MD5 sum from the beginning of the line. The name of the URL depends on its protocol: - for http(s) the part of the URL after the last '/'. - for file URLS it is everything after the protocol:// =cut sub ProcessURL ($) { my $line = shift; # Check that we are looking at a valid URL. if ($line =~ /^\s*((\w{32})\s+)?([a-zA-Z]+)(:\/\/.*?\/)([^\/ \t]+)(\s+\"[^\"]+\")?\s*$/) { my ($md5, $protocol, $url_name, $optional_name) = ($2,$3,$5,$6); my $URL = $3.$4.$5; die "invalid URL protocol on line $LineNo:\n$line\n" if $protocol !~ /(file|http|https)/; # Determine the name. If an optional name is given then use that. if (defined $optional_name) { die if $optional_name !~ /^\s+\"([^\"]+)\"$/; $name = $1; } else { if ($protocol eq "file") { # For file URLs we use everything after :// as name, or the . $URL =~ /:\/\/(.*)$/; $name = $1; } else { # For http and https use the last part of the URL. $name = $url_name; } } return [$protocol, $name, $URL, $md5]; } else { die "invalid URL at line $LineNo:\n$line\n"; } } =head3 ParseExtensionsLst Parse the extensions.lst file. Lines that contain only spaces or comments or are empty are ignored. Lines that contain a selector, ie a test enclosed in brackets, are evaluated. The following lines, until the next selector, are ignored when the selector evaluates to false. When an empty list of languages is given then any 'language=...' test is evaluated as true. All other lines are expected to contain a URL optionally preceded by an MD5 sum. =cut sub ParseExtensionsLst ($$) { my $file_name = shift; my $languages = shift; open my $in, "$file_name"; my $current_selector_value = 1; my @URLs = (); while (<$in>) { my $line = $_; $line =~ s/[\r\n]+//g; ++$LineNo; # Strip away comments. next if $line =~ /^\s*#/; # Ignore empty lines. next if $line =~ /^\s*$/; # Process selectors if ($line =~ /^\s*\[\s*(.*)\s*\]\s*$/) { $current_selector_value = EvaluateSelector($1, $languages); } else { if ($current_selector_value) { push @URLs, ProcessURL($line); } } } close $in; return @URLs; } =head3 Download Download a set of files that are specified via URLs. File URLs are ignored here because they point to extensions that have not yet been built. For http URLs there may be an optional MD5 checksum. If it is present then downloaded files that do not match that checksum are an error and lead to abortion of the current process. Files that have already been downloaded are not downloaded again. =cut sub Download (@) { my @urls = @_; my @missing = (); my $download_path = $ENV{'TARFILE_LOCATION'}; # First check which (if any) extensions have already been downloaded. for my $entry (@urls) { my ($protocol, $name, $URL, $md5sum) = @{$entry}; # We can not check the existence of file URLs because they point to extensions that # have yet to be built. next if $protocol ne "http"; my $candidate = File::Spec->catfile($download_path, $name); if ( ! -f $candidate) { push @missing, $entry; } } if ($#missing >= 0) { printf "downloading %d missing extension%s\n", $#missing+1, $#missing>0 ? "s" : ""; if ( ! -d $download_path) { mkdir File::Spec->catpath($download_path, "tmp") || die "can not create tmp subdirectory of $download_path"; } } else { print "all downloadable extensions present\n"; return; } # Download the missing files. for my $entry (@missing) { my ($protocol, $name, $URL, $md5sum) = @{$entry}; # Open a .part file for writing. my $filename = File::Spec->catfile($download_path, $name); my $temporary_filename = $filename . ".part"; print "downloading to $temporary_filename\n"; open my $out, ">$temporary_filename"; binmode($out); # Prepare md5 my $md5 = Digest::MD5->new(); # Download the extension. my $agent = LWP::UserAgent->new(); $agent->timeout(120); $agent->show_progress(1); my $last_was_redirect = 0; $agent->add_handler('response_redirect' => sub{ $last_was_redirect = 1; return; }); $agent->add_handler('response_data' => sub{ if ($last_was_redirect) { $last_was_redirect = 0; # Throw away the data we got so far. $md5->reset(); close $out; open $out, ">$temporary_filename"; binmode($out); } my($response,$agent,$h,$data)=@_; print $out $data; $md5->add($data); }); my $response = $agent->get($URL); close $out; # When download was successfull then check the md5 checksum and rename the .part file # into the actual extension name. if ($response->is_success()) { if (defined $md5sum && length($md5sum)==32) { my $file_md5 = $md5->hexdigest(); if ($md5sum eq $file_md5) { print "md5 is OK\n"; } else { unlink($temporary_filename) if ! $Debug; die "downloaded file has the wrong md5 checksum: $file_md5 instead of $md5sum"; } } else { print "md5 is not present\n"; printf " is %s, length is %d\n", $md5sum, length(md5sum); } rename($temporary_filename, $filename) || die "can not rename $temporary_filename to $filename"; } else { die "failed to download $URL"; } } } =head3 DownloadExtensions This function is intended to be called during bootstrapping. It extracts the set of extensions that will be used later, when the installation sets are built. The set of languages is taken from the WITH_LANG environment variable. =cut sub DownloadExtensions () { if (defined $ENV{'ENABLE_BUNDLED_DICTIONARIES'} && $ENV{'ENABLE_BUNDLED_DICTIONARIES'} eq "YES") { my $full_file_name = Prepare(); my $languages = [ "en_US" ]; if (defined $ENV{'WITH_LANG'}) { @$languages = split(/\s+/, $ENV{'WITH_LANG'}); foreach my $l (@$languages) { print "$l\n"; } } my @urls = ParseExtensionsLst($full_file_name, $languages); Download(@urls); } else { print "bundling of dictionaries is disabled.\n"; } } =head3 GetExtensionList This function is intended to be called when installation sets are built. It expects two arguments: - A protocol selector. Http URLs reference remotely located extensions that will be bundled as-is into the installation sets due to legal reasons. They are installed on first start of the office. File URLs reference extensions whose source code is part of the repository. They are pre-registered when installation sets are created. Their installation is finished when the office is first started. - A set of languages. This set determines which extensions are returned and then included in an installation set. =cut sub GetExtensionList ($@) { my $protocol_selector = shift; my @language_list = @_; if (defined $ENV{'ENABLE_BUNDLED_DICTIONARIES'} && $ENV{'ENABLE_BUNDLED_DICTIONARIES'} eq "YES") { my $full_file_name = Prepare(); my @urls = ParseExtensionsLst($full_file_name, \@language_list); my @result = (); for my $entry (@urls) { my ($protocol, $name, $URL, $md5sum) = @{$entry}; if ($protocol =~ /^$protocol_selector$/) { push @result, $name; } } return @result; } else { # Bundling of dictionaires is disabled. } return (); } 1;