1#!/usr/bin/perl 2#************************************************************** 3# 4# Licensed to the Apache Software Foundation (ASF) under one 5# or more contributor license agreements. See the NOTICE file 6# distributed with this work for additional information 7# regarding copyright ownership. The ASF licenses this file 8# to you under the Apache License, Version 2.0 (the 9# "License"); you may not use this file except in compliance 10# with the License. You may obtain a copy of the License at 11# 12# http://www.apache.org/licenses/LICENSE-2.0 13# 14# Unless required by applicable law or agreed to in writing, 15# software distributed under the License is distributed on an 16# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY 17# KIND, either express or implied. See the License for the 18# specific language governing permissions and limitations 19# under the License. 20# 21#************************************************************** 22 23use strict; 24use XML::LibXML; 25use open OUT => ":utf8"; 26use LWP::Simple; 27use Digest; 28use Digest::MD5; 29use Digest::SHA; 30use File::Temp; 31use File::Path; 32 33use Carp::always; 34 35=head1 NAME 36 37 build_release.pl - Tool for batch release builds and uploads and the creation of wiki pages that list install sets. 38 39=head1 SYNOPSIS 40 41 build_release.pl <command> {option} <release-description.xml> 42 43 comands: 44 build builds all install sets as requested by the XML file and supported by the platform. 45 build-missing 46 build only those install sets that have not been built earlier. 47 upload upload install sets to a local or remote (via ssh with public/private key) 48 directory structure. Uploads install sets that where build on other platforms. 49 wiki create a wiki (MediaWiki syntax) snippet that references all install sets at the upload 50 location. Includes install sets that where built and/or uploaded from other 51 platforms and machines. 52 options: 53 -j <count> maximum number of build processes 54 -k keep going if there are recoverable errors 55 -u <path> upload destination 56 -l check links on wiki page, write broken links as plain text 57 -ld check links on wiki page, mark broken links 58 -o <filename> filename of the output (wiki: wiki page, build: makefile) 59 -n <number> maximal number of upload tries, defaults to 5. 60 -d dry-run 61 62 Typical calls are: 63 build_release.pl build -j4 instsetoo_native/util/aoo-410-release.xml 64 for building the installation sets, language packs and patches for the 4.1 release. 65 66 build_release.pl upload -u me@server:path -n 3 instsetoo_native/util/aoo-410-release.xml 67 to upload the previously built installation sets etc. 68 69 build_release.pl wiki -o /tmp/wiki.txt instsetoo_native/util/aoo-410-release.xml 70 to create an updated wiki page with installation sets etc built at several 71 places and uploaded to several locations. 72 73 74=head1 XML file format 75 76The release description could look like this: 77 78<release 79 name="snapshot" 80 version="4.1.0"> 81 82 <language 83 id="ast" # As specified by 'configure --with-lang' 84 english-name="Asturian" 85 local-name="Asturianu" 86 /> 87 ... more languages 88 89 <platform 90 id="wntmsci12.pro" 91 display-name="Windows" 92 archive-platform="Win_x86" 93 word-size="32" 94 package-types="msi" 95 extension="exe" 96 /> 97 ... more platforms 98 99 <download 100 platform-id="wntmsci12.pro" 101 base-url="http://people.apache.org/~somebody/developer-snapshots/snapshot/win32" 102 /> 103 104 <package 105 id="openoffice" 106 target="openoffice" 107 display-name="Full Install" 108 archive-name="Apache_OpenOffice_%V_%P_install%T_%L.%E" 109 /> 110 111 <build 112 package-id="openoffice" 113 platform-list="all" 114 language-list="all" 115 /> 116 ... more build entries 117 118 <wiki> 119 <package-ref 120 package-id="openoffice" 121 language-list="all" 122 platform-list="all" 123 table="main" 124 /> 125 ... more packages 126 </wiki> 127 128</release> 129 130A single <release> tag contains any number of 131 132<language> id 133 The language id used internally by the build process, eg de, en-US 134 english-name 135 The english name of the language, eg german 136 local-name 137 The language name in that language, eg Deutsch 138 139 Each listed language is expected to have been passed to configure via --with-lang 140 The set of languages defines for which languages to 141 build installation sets, language packs etc. (build command) 142 upload installation sets, etc (upload command) 143 add rows in the wiki page (wiki command) 144 145<platform> id 146 The platform id that is used internally by the build process, eg wntmsci12.pro 147 Note that <p>.pro and <p> are treated as two different platforms. 148 display-name 149 Name which is printed in the wiki table. 150 archive-platform 151 Platform name as used in the name of the installation set, eg Win_x86 152 word-size 153 Bit size of the installation sets, etc, typically either 32 or 64 154 package-types 155 Semicolon separated list of package types, eg "msi" or "deb;rpm" 156 add-package-type-to-archive-name 157 For deb and rpm archives it is necessary to add the package type to the archive name. 158 extension 159 Extension of the archive name, eg "exe" or "tar.gz" 160 161 For the build command only those <platform> elements are used that match the platform on which this 162 script is run. 163 164<download> 165 platform-id 166 Reference to one of the <platform> elements and has to match the id attribute of that platform. 167 base-url 168 URL head to which the name of the downloadable installation set etc. is appended. 169 Eg. http://people.apache.org/~somebody/developer-snapshots/snapshot/win32 170 171 Defines one download source that is referenced in the wiki page. Multiple <download> elements 172 per platform are possible. Earlier entires are preferred over later ones. 173 174<package> 175 id 176 Internal name that is used to reference the package. 177 target 178 Target name recognized by instsetoo_native/util/makefile.mk, eg openoffice or oolanguagepack. 179 display-name 180 Name of the package that is shown in the wiki page, eg "Full Install" or "Langpack". 181 archive-name 182 Template of the archive name. 183 %V version 184 %P archive package name 185 %T package type 186 %L language 187 %E extension. 188 189 Defines a downloadable and distributable package, eg openoffice for the binary OpenOffice installation set. 190 191<build> target 192 platform-list 193 Semicolon separated list of platforms for which to build the target. 194 Ignores all platforms that don't match the platform on which this script is executed. 195 The special value 'all' is a shortcut for all platforms listed by <platform> elements. 196 language-list 197 Semicolon separated list of languages for which the build the target. 198 The special value 'all' is a shortcut for all languages listed by <language> elements. 199 200 Defines the sets of targets, plaforms and languages which are to be built. 201 202<wiki> 203 <package-ref> 204 package-id 205 The id of the referenced package. 206 platform-list 207 See <build> tag for explanation. 208 language-list 209 See <build> tag for explanation. 210 table 211 Specifies the wiki table into which to add the package lines. Can be "main" or "secondary". 212 213=cut 214 215 216 217my %EnUSBasedLanguages = ( 218 'ast' => 1 219 ); 220 221 222sub GetInstallationPackageName ($$$$$); 223 224sub ProcessCommandline (@) 225{ 226 my @arguments = @_; 227 228 my $command = undef; 229 my $description_filename = undef; 230 my $max_process_count = 1; 231 my $keep_going = 0; 232 my $upload_destination = undef; 233 my $check_links = 0; 234 my $mark_broken_links = 0; 235 my $output_filename = undef; 236 my $max_upload_count = 5; 237 my $build_only_missing = 0; 238 my $dry_run = 0; 239 240 my $error = 0; 241 while (scalar @arguments > 0) 242 { 243 my $argument = shift @arguments; 244 if ($argument =~ /^-/) 245 { 246 if ($argument eq "-j") 247 { 248 $max_process_count = shift @arguments; 249 } 250 elsif ($argument eq "-u") 251 { 252 $upload_destination = shift @arguments; 253 $upload_destination =~ s/(\\|\/)$//; 254 } 255 elsif ($argument eq "-k") 256 { 257 $keep_going = 1; 258 } 259 elsif ($argument eq "-l") 260 { 261 $check_links = 1; 262 } 263 elsif ($argument eq "-ld") 264 { 265 $check_links = 1; 266 $mark_broken_links = 1; 267 } 268 elsif ($argument eq "-o") 269 { 270 $output_filename = shift @arguments; 271 } 272 elsif ($argument eq "-n") 273 { 274 $max_upload_count = shift @arguments; 275 } 276 elsif ($argument eq "-d") 277 { 278 $dry_run = 1; 279 } 280 else 281 { 282 printf STDERR "unknown option $argument %s\n", $argument; 283 $error = 1; 284 } 285 } 286 elsif ( ! defined $command) 287 { 288 $command = $argument; 289 if ($command eq "build-missing") 290 { 291 $command = "build"; 292 $build_only_missing = 1; 293 } 294 elsif ($command !~ /^(build|build-missing|upload|wiki)$/) 295 { 296 printf STDERR "unknown command '%s'\n", $command; 297 $error = 1; 298 } 299 } 300 else 301 { 302 $description_filename = $argument; 303 if ( ! -f $description_filename) 304 { 305 print STDERR "can not open release description '%s'\n", $description_filename; 306 $error = 1; 307 } 308 } 309 } 310 311 if ( ! defined $description_filename) 312 { 313 $error = 1; 314 } 315 if ($command =~ /^(wiki)$/) 316 { 317 if ( ! defined $output_filename) 318 { 319 printf STDERR "ERROR: no output filename\n", 320 $error = 1; 321 } 322 } 323 324 if ($error) 325 { 326 PrintUsageAndExit(); 327 } 328 329 return { 330 'command' => $command, 331 'filename' => $description_filename, 332 'max-process-count' => $max_process_count, 333 'keep-going' => $keep_going, 334 'upload-destination' => $upload_destination, 335 'check-links' => $check_links, 336 'mark-broken-links' => $mark_broken_links, 337 'output-filename' => $output_filename, 338 'max-upload-count' => $max_upload_count, 339 'build-only-missing' => $build_only_missing, 340 'dry-run' => $dry_run 341 }; 342} 343 344 345 346 347sub PrintUsageAndExit () 348{ 349 print STDERR "usage: $0 <command> {option} <release-description.xml>\n"; 350 print STDERR " comands:\n"; 351 print STDERR " build\n"; 352 print STDERR " build-missing\n"; 353 print STDERR " upload\n"; 354 print STDERR " wiki create a download page in MediaWiki syntax\n"; 355 print STDERR " options:\n"; 356 print STDERR " -j <count> maximum number of build processes\n"; 357 print STDERR " -k keep going if there are recoverable errors\n"; 358 print STDERR " -u <path> upload destination\n"; 359 print STDERR " -l check links on wiki page, write broken links as plain text\n"; 360 print STDERR " -ld check links on wiki page, mark broken links\n"; 361 print STDERR " -o <filename> filename of the output (wiki: wiki page, build: makefile)\n"; 362 print STDERR " -n <number> maximal number of upload tries, defaults to 5.\n"; 363 print STDERR " -d dry run\n"; 364 exit(1); 365} 366 367 368 369 370=head2 Trim ($text) 371 372 Remove leading and trailing space from the given string. 373 374=cut 375sub Trim ($) 376{ 377 my ($text) = @_; 378 $text =~ s/^\s+|\s+$//g; 379 return $text; 380} 381 382 383 384 385=head2 ReadReleaseDescription ($$) 386 387 Read the release description from $filename. 388 389=cut 390sub ReadReleaseDescription ($$) 391{ 392 my ($filename, $context) = @_; 393 394 my $document = XML::LibXML->load_xml('location' => $filename); 395 my $root = $document->documentElement(); 396 397 # Initialize the release description. 398 my $release = { 399 'name' => $root->getAttribute("name"), 400 'version' => $root->getAttribute("version"), 401 'builds' => [], 402 'languages' => {}, 403 'language-ids' => [], 404 'platforms' => {}, 405 'downloads' => [], 406 'packages' => {}, 407 'platform-ids' => [], 408 'wiki-packages' => [] 409 }; 410 411 # Process the language descriptions. 412 for my $language_element ($root->getChildrenByTagName("language")) 413 { 414 my $language_descriptor = ProcessLanguageDescription($language_element, $context); 415 $release->{'languages'}->{$language_descriptor->{'id'}} = $language_descriptor; 416 push @{$release->{'language-ids'}}, $language_descriptor->{'id'}; 417 } 418 printf "%d languages\n", scalar keys %{$release->{'languages'}}; 419 420 # Process the platform descriptions. 421 for my $platform_element ($root->getChildrenByTagName("platform")) 422 { 423 my $platform_descriptor = ProcessPlatformDescription($platform_element, $context); 424 $release->{'platforms'}->{$platform_descriptor->{'id'}} = $platform_descriptor; 425 push @{$release->{'platform-ids'}}, $platform_descriptor->{'id'}; 426 } 427 printf "%d platforms\n", scalar keys %{$release->{'platforms'}}; 428 429 # Process the package descriptions. 430 for my $package_element ($root->getChildrenByTagName("package")) 431 { 432 my $package_descriptor = ProcessPackageDescription($package_element, $context); 433 $release->{'packages'}->{$package_descriptor->{'id'}} = $package_descriptor; 434 } 435 printf "%d packages\n", scalar keys %{$release->{'packages'}}; 436 437 # Process the download descriptions. 438 for my $download_element ($root->getChildrenByTagName("download")) 439 { 440 my $download_descriptor = ProcessDownloadDescription($download_element, $context); 441 push @{$release->{'downloads'}}, $download_descriptor; 442 } 443 printf "%d downloads\n", scalar @{$release->{'downloads'}}; 444 445 if ($context->{'command'} =~ /^(build|upload)$/) 446 { 447 # Process the build descriptions. 448 for my $build_element ($root->getChildrenByTagName("build")) 449 { 450 push @{$release->{'builds'}}, ProcessBuildDescription($build_element, $context, $release); 451 } 452 printf "%d build targets\n", scalar @{$release->{'builds'}}; 453 } 454 455 if ($context->{'command'} eq "wiki") 456 { 457 for my $wiki_element ($root->getChildrenByTagName("wiki")) 458 { 459 for my $wiki_package_element ($wiki_element->getChildrenByTagName("package-ref")) 460 { 461 my $wiki_package = ProcessWikiPackageDescription( 462 $wiki_package_element, 463 $context, 464 $release); 465 push @{$release->{'wiki-packages'}}, $wiki_package; 466 } 467 } 468 printf "%d wiki packages\n", scalar @{$release->{'wiki-packages'}}; 469 } 470 471 return $release; 472} 473 474 475 476 477=head ProcessBuildDescription ($build_element, $context, $release_descriptor) 478 479 Process one <build> element. 480 481 If its platform-list does not match the current platform then the <build> element is ignored. 482 483=cut 484sub ProcessBuildDescription ($$$) 485{ 486 my ($build_element, $context, $release_descriptor) = @_; 487 488 my $package_id = $build_element->getAttribute("package-id"); 489 my $languages = PostprocessLanguageList($build_element->getAttribute("language-list"), $release_descriptor); 490 my $platforms = PostprocessPlatformList($build_element->getAttribute("platform-list"), $release_descriptor); 491 492 # Check if the platform matches any for which the product shall be built. 493 my $current_platform = $ENV{'INPATH'}; 494 my $is_platform_match = 0; 495 foreach my $platform_id (@$platforms) 496 { 497 if ($platform_id eq $current_platform) 498 { 499 $is_platform_match=1; 500 last; 501 } 502 } 503 if ($is_platform_match) 504 { 505 printf "including build %s\n", $package_id; 506 } 507 else 508 { 509 printf "skipping build %s: no platform match\n", $package_id; 510 printf "none of the platforms %s matches %s\n", 511 join(", ", keys %{$release_descriptor->{'platforms'}}), 512 $current_platform; 513 return; 514 } 515 516 my @languages = CheckLanguageSet($context, @$languages); 517 518 return { 519 'package-id' => $package_id, 520 'platform-list' => $platforms, 521 'language-list' => \@languages 522 }; 523} 524 525 526 527 528 529=head2 ProcessPlatformDescription ($element, $context) 530 531 Process one <platform> element. 532 533 The corresponding platform descriptor is returned as a hash. 534 535=cut 536sub ProcessPlatformDescription ($$) 537{ 538 my ($element, $context) = @_; 539 540 my $descriptor = {}; 541 # Mandatory tags. 542 foreach my $id ("id", "display-name", "archive-platform", "word-size", "package-types") 543 { 544 $descriptor->{$id} = $element->getAttribute($id); 545 die "release/platform has no attribute $id" unless defined $descriptor->{$id}; 546 } 547 # Optional tags. 548 foreach my $id ("extension", "add-package-type-to-archive-name") 549 { 550 $descriptor->{$id} = $element->getAttribute($id); 551 } 552 553 $descriptor->{'package-types'} = [split(/;/, $descriptor->{'package-types'})]; 554 555 return $descriptor; 556} 557 558 559 560 561=head2 ProcessDownloadDescription ($element, $context) 562 563 Process one <download> element. 564 565 The corresponding download descriptor is returned as a hash. 566 567=cut 568sub ProcessDownloadDescription ($$) 569{ 570 my ($element, $context) = @_; 571 572 my $descriptor = {}; 573 574 # Mandatory tags. 575 foreach my $id ("platform-id", "base-url") 576 { 577 $descriptor->{$id} = $element->getAttribute($id); 578 die "release/download has no attribute $id" unless defined $descriptor->{$id}; 579 } 580 581 return $descriptor; 582} 583 584 585 586 587=head2 ProcessPackageDescription ($element, $context) 588 589 Process one <package> element. 590 591 The corresponding package descriptor is returned as a hash. 592 593=cut 594sub ProcessPackageDescription ($$$) 595{ 596 my ($element, $context, $release_descriptor) = @_; 597 598 my $descriptor = {}; 599 600 # Mandatory tags. 601 foreach my $id ("id", "target", "archive-name", "display-name") 602 { 603 $descriptor->{$id} = $element->getAttribute($id); 604 die "release/package has no attribute $id" unless defined $descriptor->{$id}; 605 die "release/package attribute $id is empty" unless $descriptor->{$id} !~ /^\s*$/; 606 } 607 # Optional tags. 608 foreach my $id ("link-tooltip", "link-URL", "download-extension") 609 { 610 $descriptor->{$id} = $element->getAttribute($id); 611 } 612 613 return $descriptor; 614} 615 616 617 618 619=head2 ProcessWikiPackageDescription ($element, $context) 620 621 Process one <wiki><package-ref> element. 622 623 The corresponding descriptor is returned as a hash. 624 625=cut 626sub ProcessWikiPackageDescription ($$$) 627{ 628 my ($element, $context, $release_descriptor) = @_; 629 630 my $descriptor = {}; 631 # Mandatory tags. 632 foreach my $id ("package-id", "table") 633 { 634 $descriptor->{$id} = $element->getAttribute($id); 635 die "wiki/package-ref has no attribute $id" unless defined $descriptor->{$id}; 636 die "wiki/package-ref attribute $id is empty" unless $descriptor->{$id} !~ /^\s*$/; 637 } 638 639 $descriptor->{'language-list'} = PostprocessLanguageList( 640 $element->getAttribute("language-list"), 641 $release_descriptor); 642 $descriptor->{'platform-list'} = PostprocessPlatformList( 643 $element->getAttribute("platform-list"), 644 $release_descriptor); 645 646 $descriptor->{'languages'} = {map{$_=>1} @{$descriptor->{'language-list'}}}; 647 $descriptor->{'platforms'} = {map{$_=>1} @{$descriptor->{'platform-list'}}}; 648 649 return $descriptor; 650} 651 652 653 654 655=head2 ProcessLanguageDescription ($element, $context) 656 657 Process one <language> element. 658 659 The corresponding language descriptor is returned as a hash. 660 661=cut 662sub ProcessLanguageDescription ($$) 663{ 664 my ($element, $context) = @_; 665 666 my $descriptor = {}; 667 foreach my $id ("id", "english-name", "local-name") 668 { 669 $descriptor->{$id} = $element->getAttribute($id); 670 die "wiki/language has no attribute $id" unless defined $descriptor->{$id}; 671 } 672 673 return $descriptor; 674} 675 676 677 678 679=head2 PostprocessLanguageList ($language_list, $release_descriptor) 680 681 Process a language list that is given as 'language-list' attribute to some tags. 682 683 If the attribute is missing, ie $language_list is undef, or its value is "all", 684 then the returned list of languages is set to all languages defined via <language> elements. 685 686=cut 687sub PostprocessLanguageList ($$) 688{ 689 my ($language_list, $release_descriptor) = @_; 690 691 my @matching_languages = (); 692 if ( ! defined $language_list 693 || $language_list eq "all") 694 { 695 @matching_languages = sort keys %{$release_descriptor->{'languages'}}; 696 } 697 else 698 { 699 @matching_languages = split(/;/, $language_list); 700 } 701 702 return \@matching_languages; 703} 704 705 706 707 708=head2 PostprocessPlatformList ($platform_list, $release_descriptor) 709 710 Process a platform list that is given as 'platform-list' attribute to some tags. 711 712 If the attribute is missing, ie $platform_list is undef, or its value is "all", 713 then the returned list of platforms is set to all platforms defined via <platform> elements. 714 715=cut 716sub PostprocessPlatformList ($$) 717{ 718 my ($platform_list, $release_descriptor) = @_; 719 720 my @matching_platforms = (); 721 if ( ! defined $platform_list 722 || $platform_list eq "all") 723 { 724 @matching_platforms = sort keys %{$release_descriptor->{'platforms'}}; 725 } 726 else 727 { 728 @matching_platforms = split(/;/, $platform_list); 729 } 730 731 return \@matching_platforms; 732} 733 734 735 736 737=head2 CheckLanguageSet ($context, @languages) 738 739 Compare the given list of languages with the one defined by the 'WITH_LANG' environment variable. 740 741 This is to ensure that configure --with-lang was called with the same set of languages that are 742 listed by the <language> elements. 743 744=cut 745sub CheckLanguageSet ($@) 746{ 747 my ($context, @languages) = @_; 748 my %configured_languages = map{$_=>1} split(/\s+/, $ENV{'WITH_LANG'}); 749 750 my @missing_languages = (); 751 my @present_languages = (); 752 for my $language (@languages) 753 { 754 if (defined $configured_languages{$language}) 755 { 756 push @present_languages, $language; 757 } 758 else 759 { 760 push @missing_languages, $language; 761 } 762 } 763 764 if (scalar @missing_languages > 0) 765 { 766 my $message_head = $context->{'keep-going'} ? "WARNING" : "ERROR"; 767 printf STDERR "%s: there are languages that where not configured via --with-lang:\n", $message_head; 768 printf STDERR "%s: %s\n", $message_head, join(", ", @missing_languages); 769 if ($context->{'keep-going'}) 770 { 771 printf " available languages:\n"; 772 printf " %s\n", join(", ", @present_languages); 773 } 774 else 775 { 776 printf STDERR "ERROR: please rerun configure with --with-lang=\"%s\"\n", join(" ", @languages); 777 exit(1); 778 } 779 } 780 781 return @present_languages; 782} 783 784 785 786 787=head2 WriteMakefile ($release_description, $context) 788 789 Write a makefile with all targets that match the <build> elements. 790 791 The use of a makefile allows us to use make to handle concurrent building. 792 793 When an output file was specified on the command line (option -o) then the 794 makefile is written to that file but make is not run. 795 796 When no output file was specified then the makefile is written to a temporary 797 file. Then make is run for this makefile. 798 799=cut 800sub WriteMakefile ($$) 801{ 802 my ($release_description, $context) = @_; 803 804 my $filename = $context->{'output-filename'}; 805 if ( ! defined $filename) 806 { 807 $filename = File::Temp->new(); 808 } 809 810 # Collect the targets to make. 811 my @targets = (); 812 foreach my $build (@{$release_description->{'builds'}}) 813 { 814 my $platform_descriptor = GetCurrentPlatformDescriptor($release_description); 815 my $package_descriptor = $release_description->{'packages'}->{$build->{'package-id'}}; 816 foreach my $language_id (@{$build->{'language-list'}}) 817 { 818 foreach my $package_format (@{$platform_descriptor->{'package-types'}}) 819 { 820 my $full_target = sprintf("%s_%s.%s", 821 $package_descriptor->{'target'}, 822 $language_id, 823 $package_format); 824 if ($context->{'build-only-missing'}) 825 { 826 my $source_path = GetInstallationPackagePath( 827 $platform_descriptor, 828 $package_format, 829 $language_id); 830 my $archive_name = GetInstallationPackageName( 831 $release_description, 832 $package_descriptor, 833 $package_format, 834 $platform_descriptor, 835 $language_id); 836 my $candidate = $source_path . "/" . $archive_name; 837 if (-f $candidate) 838 { 839 printf "download set for %s already exists, skipping\n", $full_target; 840 next; 841 } 842 } 843 push @targets, $full_target; 844 } 845 } 846 } 847 848 # Write the makefile. 849 open my $make, ">", $filename; 850 851 # Write dependencies of 'all' on the products in all languages. 852 print $make "all .PHONY : \\\n "; 853 printf $make "%s\n", join(" \\\n ", @targets); 854 printf $make "\n\n"; 855 856 if ($context->{'dry-run'}) 857 { 858 printf ("adding make fules for\n %s\n", join("\n ", @targets)); 859 } 860 861 # Write rules that chain dmake in instsetoo_native/util. 862 foreach my $target (@targets) 863 { 864 printf $make "%s :\n", $target; 865 printf $make "\tdmake \$@ release=t\n"; 866 } 867 close $make; 868 869 870 if ( ! defined $context->{'output-filename'}) 871 { 872 # Caller wants us to run make. 873 my $path = $ENV{'SRC_ROOT'} . "/instsetoo_native/util"; 874 my $command = sprintf("make -f \"%s\" -C \"%s\" -j%d", 875 $filename, 876 $path, 877 $context->{'max-process-count'}); 878 if ($context->{'dry-run'}) 879 { 880 printf "would run %s\n", $command; 881 } 882 else 883 { 884 printf "running %s\n", $command; 885 system($command); 886 } 887 } 888} 889 890 891 892 893sub Upload ($$) 894{ 895 my ($release_description, $context) = @_; 896 897 if ( ! defined $context->{'upload-destination'}) 898 { 899 printf STDERR "ERROR: upload destination is missing\n"; 900 PrintUsageAndExit(); 901 } 902 903 my @download_sets = CollectDownloadSets($release_description); 904 905 ProvideChecksums($context, @download_sets); 906 my $source_path = PrepareUploadArea($context, @download_sets); 907 if ( ! defined $source_path) 908 { 909 exit(1); 910 } 911 if ( ! UploadFilesViaRsync($context, $source_path, @download_sets)) 912 { 913 exit(1); 914 } 915} 916 917 918 919 920=head2 PrepareUploadArea ($context, @download_sets) 921 922 Create a temporary directory with the same sub directory strcuture that is requested in the upload location. 923 The files that are to be uploaded are not copied but linked into this temporary directory tree. 924 925 Returns the name of the temporary directory. 926 927=cut 928sub PrepareUploadArea ($@) 929{ 930 my ($context, @download_sets) = @_; 931 932 my $tmpdir = File::Temp->newdir(); 933 foreach my $download_set (@download_sets) 934 { 935 foreach my $extension ("", ".md5", ".sha256", ".asc") 936 { 937 my $basename = sprintf("%s%s", $download_set->{'archive-name'}, $extension); 938 my $source = sprintf("%s/%s", $download_set->{'source-path'}, $basename); 939 my $target_path = sprintf("%s/%s/%s", $tmpdir, $download_set->{'destination-path'}); 940 my $target = sprintf("%s/%s", $target_path, $basename); 941 if ($context->{'dry-run'}) 942 { 943 printf "would create link for %s\n", $basename; 944 } 945 else 946 { 947 mkpath($target_path); 948 unlink $target if ( -f $target); 949 my $result = symlink($source, $target); 950 if ($result != 1) 951 { 952 printf "ERROR: can not created symbolic link to %s\n", $basename; 953 printf " %s\n", $source; 954 printf " -> %s\n", $target; 955 return undef; 956 } 957 } 958 } 959 } 960 961 return $tmpdir; 962} 963 964 965 966 967sub UploadFilesViaRsync ($$@) 968{ 969 my ($context, $source_path, @download_sets) = @_; 970 971 972 # Collect the rsync flags. 973 my @rsync_options = ( 974 "-L", # Copy linked files 975 "-a", # Transfer the local attributes and modification times. 976 "-c", # Use checksums to compare source and destination files. 977 "--progress", # Show a progress indicator 978 "--partial", # Try to resume a previously failed upload 979 ); 980 981 # (Optional) Add flags for upload to ssh server 982 my $upload_destination = $context->{'upload-destination'}; 983 if ($upload_destination =~ /@/) 984 { 985 push @rsync_options, ("-e", "ssh"); 986 } 987 988 # Set up the rsync command. 989 my $command = sprintf("rsync %s \"%s/\" \"%s\"", 990 join(" ", @rsync_options), 991 $source_path, 992 $upload_destination); 993 printf "%s\n", $command; 994 995 if ($context->{'dry-run'}) 996 { 997 printf "would run %s up to %d times\n", $command, $context->{'max-upload-count'}; 998 } 999 else 1000 { 1001 # Run the command. If it fails, repeat a number of times. 1002 my $max_run_count = $context->{'max-upload-count'}; 1003 for (my $run_index=1; $run_index<=$max_run_count && scalar @download_sets>0; ++$run_index) 1004 { 1005 my $result = system($command); 1006 printf "%d %d\n", $result, $?; 1007 return 1 if $result == 0; 1008 } 1009 printf "ERROR: could not upload all files without error in %d runs\n", $max_run_count; 1010 return 0; 1011 } 1012} 1013 1014 1015 1016 1017sub CollectDownloadSets ($) 1018{ 1019 my ($release_description) = @_; 1020 1021 my @download_sets = (); 1022 1023 foreach my $platform_descriptor (values %{$release_description->{'platforms'}}) 1024 { 1025 my $platform_path = sprintf("%s/instsetoo_native/%s", 1026 $ENV{'SOLARSRC'}, 1027 $platform_descriptor->{'id'}); 1028 if ( ! -d $platform_path) 1029 { 1030 printf "ignoring missing %s\n", $platform_path; 1031 next; 1032 } 1033 for my $package_descriptor (values %{$release_description->{'packages'}}) 1034 { 1035 1036 my @package_formats = @{$platform_descriptor->{'package-types'}}; 1037 for my $package_format (@package_formats) 1038 { 1039 for my $language_id (@{$release_description->{'language-ids'}}) 1040 { 1041 my $source_path = GetInstallationPackagePath( 1042 $platform_descriptor, 1043 $package_format, 1044 $language_id); 1045 my $archive_name = GetInstallationPackageName( 1046 $release_description, 1047 $package_descriptor, 1048 $package_format, 1049 $platform_descriptor, 1050 $language_id); 1051 my $candidate = $source_path."/".$archive_name; 1052 if ( ! -f $candidate) 1053 { 1054# printf STDERR "ERROR: can not find download set '%s'\n", $candidate; 1055 next; 1056 } 1057 printf "adding %s\n", $archive_name; 1058 push @download_sets, { 1059 'source-path' => $source_path, 1060 'archive-name' => $archive_name, 1061 'platform' => $platform_descriptor->{'pack-platform'}, 1062 'destination-path' => sprintf("developer-snapshots/%s/%s", 1063 $release_description->{'name'}, 1064 $platform_descriptor->{'pack-platform'}) 1065 }; 1066 } 1067 } 1068 } 1069 } 1070 1071 return @download_sets; 1072} 1073 1074 1075 1076 1077=head2 ProvideChecksums ($context, @download_sets) 1078 1079 Create checksums in MD5 and SHA256 format and a gpg signature for the given download set. 1080 The checksums are not created when they already exists and are not older than the download set. 1081 1082=cut 1083sub ProvideChecksums ($@) 1084{ 1085 my ($context, @download_sets) = @_; 1086 1087 my @asc_requests = (); 1088 foreach my $download_set (@download_sets) 1089 { 1090 printf "%s\n", $download_set->{'archive-name'}; 1091 my $full_archive_name = $download_set->{'source-path'} . "/" . $download_set->{'archive-name'}; 1092 $full_archive_name = Trim(qx(cygpath -u "$full_archive_name")); 1093 1094 my $md5_filename = $full_archive_name . ".md5"; 1095 if ( ! -f $md5_filename || IsOlderThan($md5_filename, $full_archive_name)) 1096 { 1097 if ($context->{'dry-run'}) 1098 { 1099 printf " would create MD5\n"; 1100 } 1101 else 1102 { 1103 my $digest = Digest::MD5->new(); 1104 open my $in, $full_archive_name; 1105 $digest->addfile($in); 1106 my $checksum = $digest->hexdigest(); 1107 close $in; 1108 1109 open my $out, ">", $md5_filename; 1110 printf $out "%s *%s", $checksum, $download_set->{'archive-name'}; 1111 close $out; 1112 1113 printf " created MD5\n"; 1114 } 1115 } 1116 else 1117 { 1118 printf " MD5 already exists\n"; 1119 } 1120 1121 my $sha256_filename = $full_archive_name . ".sha256"; 1122 if ( ! -f $sha256_filename || IsOlderThan($sha256_filename, $full_archive_name)) 1123 { 1124 if ($context->{'dry-run'}) 1125 { 1126 printf " would create SHA256\n"; 1127 } 1128 else 1129 { 1130 my $digest = Digest::SHA->new("sha256"); 1131 open my $in, $full_archive_name; 1132 $digest->addfile($in); 1133 my $checksum = $digest->hexdigest(); 1134 close $in; 1135 1136 open my $out, ">", $sha256_filename; 1137 printf $out "%s *%s", $checksum, $download_set->{'archive-name'}; 1138 close $out; 1139 1140 printf " created SHA256\n"; 1141 } 1142 } 1143 else 1144 { 1145 printf " SHA256 already exists\n"; 1146 } 1147 1148 my $asc_filename = $full_archive_name . ".asc"; 1149 if ( ! -f $asc_filename || IsOlderThan($asc_filename, $full_archive_name)) 1150 { 1151 if ($context->{'dry-run'}) 1152 { 1153 printf " would create ASC\n"; 1154 } 1155 else 1156 { 1157 # gpg seems not to be able to sign more than one file at a time. 1158 # Password has to be provided every time. 1159 my $command = sprintf("gpg --armor --detach-sig \"%s\"", $full_archive_name); 1160 print $command; 1161 my $result = system($command); 1162 printf " created ASC\n"; 1163 } 1164 } 1165 else 1166 { 1167 printf " ASC already exists\n"; 1168 } 1169 } 1170} 1171 1172 1173 1174 1175=head2 IsOlderThan ($filename1, $filename2) 1176 1177 Return true (1) if the last modification date of $filename1 is older than (<) that of $filename2. 1178 1179=cut 1180sub IsOlderThan ($$) 1181{ 1182 my ($filename1, $filename2) = @_; 1183 1184 my @stat1 = stat $filename1; 1185 my @stat2 = stat $filename2; 1186 1187 return $stat1[9] < $stat2[9]; 1188} 1189 1190 1191 1192 1193sub GetInstallationPackageName ($$$$$) 1194{ 1195 my ($release_description, $package_descriptor, $package_format, $platform_descriptor, $language) = @_; 1196 1197 my $name = $package_descriptor->{'archive-name'}; 1198 1199 my $archive_package_type = ""; 1200 if ($platform_descriptor->{'add-package-type-to-archive-name'} =~ /^(1|true|yes)$/i) 1201 { 1202 $archive_package_type = "-".$package_format; 1203 } 1204 1205 $name =~ s/%V/$release_description->{'version'}/g; 1206 $name =~ s/%P/$platform_descriptor->{'archive-platform'}/g; 1207 $name =~ s/%T/$archive_package_type/g; 1208 $name =~ s/%L/$language/g; 1209 $name =~ s/%E/$platform_descriptor->{'extension'}/g; 1210 return $name; 1211} 1212 1213 1214 1215 1216sub GetInstallationPackagePath ($$$) 1217{ 1218 my ($product_descriptor, $package_format, $language) = @_; 1219 1220 my $full_language = $language; 1221 if ($EnUSBasedLanguages{$language}) 1222 { 1223 $full_language = "en-US_".$language; 1224 } 1225 1226 return sprintf("%s/instsetoo_native/%s/Apache_OpenOffice%s/%s/install/%s_download", 1227 $ENV{'SOLARSRC'}, 1228 $ENV{'INPATH'}, 1229 $product_descriptor->{'product-name-tail'}, 1230 $package_format, 1231 $full_language); 1232} 1233 1234 1235 1236 1237sub GetCurrentPlatformDescriptor ($) 1238{ 1239 my ($release_description) = @_; 1240 1241 my $platform_descriptor = $release_description->{'platforms'}->{$ENV{'INPATH'}}; 1242 if ( ! defined $platform_descriptor) 1243 { 1244 printf STDERR "ERROR: platform '%s' is not supported\n", $ENV{'INPATH'}; 1245 } 1246 return $platform_descriptor; 1247} 1248 1249 1250 1251 1252sub Wiki ($$) 1253{ 1254 my ($release_descriptor, $context) = @_; 1255 1256 open my $out, ">", $context->{'output-filename'}; 1257 1258 my @table_list = GetTableList($release_descriptor); 1259 foreach my $table_name (@table_list) 1260 { 1261 my @table_packages = GetPackagesForTable($release_descriptor, $table_name); 1262 my @table_languages = GetLanguagesForTable($release_descriptor, @table_packages); 1263 my @table_platforms = GetPlatformsForTable($release_descriptor, @table_packages); 1264 1265 printf "packages: %s\n", join(", ", map {$_->{'package'}->{'display-name'}} @table_packages); 1266 printf "languages: %s\n", join(", ", map {$_->{'english-name'}} @table_languages); 1267 printf "platforms: %s\n", join(", ", map {$_->{'id'}} @table_platforms); 1268 1269 print $out "{| class=\"wikitable\"\n"; 1270 1271 # Write the table head. 1272 print $out "|-\n"; 1273 print $out "! colspan=\"2\" | Language<br>The names do not refer to countries\n"; 1274 print $out "! Type\n"; 1275 foreach my $platform_descriptor (@table_platforms) 1276 { 1277 foreach my $package_type (@{$platform_descriptor->{'package-types'}}) 1278 { 1279 printf $out "! %s<br>%s bit<br>%s\n", 1280 $platform_descriptor->{'display-name'}, 1281 $platform_descriptor->{'word-size'}, 1282 uc($package_type); 1283 } 1284 } 1285 1286 foreach my $language_descriptor (@table_languages) 1287 { 1288 if ($context->{'check-links'}) 1289 { 1290 $| = 1; 1291 printf "%-5%s: ", $language_descriptor->{'id'}; 1292 } 1293 1294 print $out "|-\n"; 1295 printf $out "| rowspan=\"%d\" | %s\n", scalar @table_packages, $language_descriptor->{'english-name'}; 1296 printf $out "| rowspan=\"%d\" | %s\n", scalar @table_packages, $language_descriptor->{'local-name'}; 1297 1298 my $is_first = 1; 1299 foreach my $wiki_package_descriptor (@table_packages) 1300 { 1301 my $package_descriptor = $wiki_package_descriptor->{'package'}; 1302 1303 if ($is_first) 1304 { 1305 $is_first = 0; 1306 } 1307 else 1308 { 1309 printf $out "|-\n"; 1310 } 1311 1312 # Write the name of the package, e.g. Full Install or Langpack. 1313 if (defined $package_descriptor->{'link-URL'}) 1314 { 1315 printf $out "| [%s %s]\n", 1316 $package_descriptor->{'link-URL'}, 1317 $package_descriptor->{'display-name'}; 1318 } 1319 else 1320 { 1321 printf $out "| %s\n", $package_descriptor->{'display-name'}; 1322 } 1323 1324 foreach my $platform_descriptor (@table_platforms) 1325 { 1326 foreach my $package_type (@{$platform_descriptor->{'package-types'}}) 1327 { 1328 WriteDownloadLinks( 1329 $out, 1330 $release_descriptor, 1331 $context, 1332 $release_descriptor, 1333 $language_descriptor, 1334 $wiki_package_descriptor, 1335 $platform_descriptor, 1336 $package_type); 1337 } 1338 } 1339 } 1340 1341 if ($context->{'check-links'}) 1342 { 1343 printf "\n"; 1344 } 1345 } 1346 1347 print $out "|}\n"; 1348 } 1349 close $out; 1350} 1351 1352 1353 1354 1355sub GetTableList ($) 1356{ 1357 my ($release_descriptor) = @_; 1358 1359 my %seen_table_names = (); 1360 my @table_names = (); 1361 foreach my $wiki_package_descriptor (@{$release_descriptor->{'wiki-packages'}}) 1362 { 1363 my $table_name = $wiki_package_descriptor->{'table'}; 1364 if ( ! $seen_table_names{$table_name}) 1365 { 1366 push @table_names, $table_name; 1367 $seen_table_names{$table_name} = 1; 1368 } 1369 } 1370 return @table_names; 1371} 1372 1373 1374 1375 1376sub GetPackagesForTable ($$) 1377{ 1378 my ($release_descriptor, $table_name) = @_; 1379 1380 my @packages = (); 1381 foreach my $wiki_package_descriptor (@{$release_descriptor->{'wiki-packages'}}) 1382 { 1383 if ($wiki_package_descriptor->{'table'} eq $table_name) 1384 { 1385 my $package_descriptor = $release_descriptor->{'packages'}->{ 1386 $wiki_package_descriptor->{'package-id'}}; 1387 $wiki_package_descriptor->{'package'} = $package_descriptor; 1388 push @packages, $wiki_package_descriptor; 1389 } 1390 } 1391 return @packages; 1392} 1393 1394 1395 1396 1397sub GetLanguagesForTable ($@) 1398{ 1399 my ($release_descriptor, @packages) = @_; 1400 1401 # Find the languages that are reference by at least one package. 1402 my %matching_languages = (); 1403 foreach my $package_descriptor (@packages) 1404 { 1405 foreach my $language_id (@{$package_descriptor->{'language-list'}}) 1406 { 1407 $matching_languages{$language_id} = 1; 1408 } 1409 } 1410 1411 # Retrieve the language descriptors for the language ids. 1412 my @matching_language_descriptors = (); 1413 foreach my $language_id (@{$release_descriptor->{'language-ids'}}) 1414 { 1415 if (defined $matching_languages{$language_id}) 1416 { 1417 my $language_descriptor = $release_descriptor->{'languages'}->{$language_id}; 1418 if (defined $language_descriptor) 1419 { 1420 push @matching_language_descriptors, $language_descriptor; 1421 } 1422 } 1423 } 1424 1425 return @matching_language_descriptors; 1426} 1427 1428 1429 1430 1431sub GetPlatformsForTable ($@) 1432{ 1433 my ($release_descriptor, @packages) = @_; 1434 1435 # Find the platforms that are reference by at least one package. 1436 my %matching_platform_ids = (); 1437 foreach my $package_descriptor (@packages) 1438 { 1439 foreach my $platform_id (@{$package_descriptor->{'platform-list'}}) 1440 { 1441 $matching_platform_ids{$platform_id} = 1; 1442 } 1443 } 1444 1445 # Retrieve the platform descriptors for the plaform ids. 1446 my @matching_platform_descriptors = (); 1447 foreach my $platform_id (@{$release_descriptor->{'platform-ids'}}) 1448 { 1449 if ($matching_platform_ids{$platform_id}) 1450 { 1451 print $platform_id."\n"; 1452 push @matching_platform_descriptors, $release_descriptor->{'platforms'}->{$platform_id}; 1453 } 1454 } 1455 1456 return @matching_platform_descriptors; 1457} 1458 1459 1460 1461 1462my $bold_text_start = "<b>"; 1463my $bold_text_end = "</b>"; 1464my $small_text_start = "<span style=\"font-size:80%\">"; 1465my $small_text_end = "</span>"; 1466my $broken_link_start = "<span style=\"color:#FF0000\">"; 1467my $broken_link_end = "</span>"; 1468 1469 1470sub WriteDownloadLinks ($$$$$$$) 1471{ 1472 my ($out, 1473 $release_descriptor, 1474 $context, 1475 $release_descriptor, 1476 $language_descriptor, 1477 $wiki_package_descriptor, 1478 $platform_descriptor, 1479 $package_type) = @_; 1480 1481 my $package_descriptor = $wiki_package_descriptor->{'package'}; 1482 1483 # Check if the current language and platform match the package. 1484 if (defined $wiki_package_descriptor->{'platforms'}->{$platform_descriptor->{'id'}} 1485 && defined $wiki_package_descriptor->{'languages'}->{$language_descriptor->{'id'}}) 1486 { 1487 my $archive_package_name = ""; 1488 my $extension = $package_type; 1489 if (defined $platform_descriptor->{'extension'}) 1490 { 1491 $extension = $platform_descriptor->{'extension'}; 1492 } 1493 if (defined $package_descriptor->{'download-extension'}) 1494 { 1495 $extension = $package_descriptor->{'download-extension'}; 1496 } 1497 $archive_package_name = "-".$package_type if ($package_type =~ /deb|rpm/); 1498 1499 my $archive_name = GetInstallationPackageName( 1500 $release_descriptor, 1501 $package_descriptor, 1502 $package_type, 1503 $platform_descriptor, 1504 $language_descriptor->{'id'}); 1505 1506 printf $out "| align=\"center\" | "; 1507 my $download = FindDownload( 1508 $context, 1509 $release_descriptor, 1510 $platform_descriptor, 1511 $package_type, 1512 $archive_name); 1513 if (defined $download) 1514 { 1515 my $url = $download->{'base-url'} . "/". $archive_name; 1516 printf $out "%s%s%s<br><br>%s%s %s<br>%s%s", 1517 $bold_text_start, 1518 CreateLink($url, $extension, $context), 1519 $bold_text_end, 1520 $small_text_start, 1521 CreateLink($url.".asc", "ASC", $context), 1522 CreateLink($url.".md5", "MD5", $context), 1523 CreateLink($url.".sha256", "SHA256", $context), 1524 $small_text_end; 1525 } 1526 printf $out "\n"; 1527 } 1528 else 1529 { 1530 printf $out "|\n"; 1531 } 1532} 1533 1534 1535 1536 1537sub FindDownload ($$$$$) 1538{ 1539 my ($context, 1540 $release_descriptor, 1541 $platform_descriptor, 1542 $package_type, 1543 $archive_name) = @_; 1544 1545 foreach my $download (@{$release_descriptor->{'downloads'}}) 1546 { 1547 if ($download->{'platform-id'} eq $platform_descriptor->{'id'}) 1548 { 1549 my $url = $download->{'base-url'} . "/". $archive_name; 1550 if ($context->{'check-links'}) 1551 { 1552 if (CheckLink($url)) 1553 { 1554 # URL points to an existing file. 1555 printf "+"; 1556 return $download; 1557 } 1558 else 1559 { 1560 # URL is broken. 1561 # Try the next download area for the platform. 1562 next; 1563 } 1564 } 1565 else 1566 { 1567 # Use the URL unchecked. If there is more than one download area for the platform then only 1568 # the first is ever used. 1569 printf "."; 1570 return $download; 1571 } 1572 } 1573 } 1574 1575 if ($context->{'check-links'}) 1576 { 1577 printf "-"; 1578 } 1579 1580 return undef; 1581} 1582 1583 1584 1585 1586sub CreateLink ($$$) 1587{ 1588 my ($url, $text, $context) = @_; 1589 1590 my $is_link_broken = 0; 1591 if ($context->{'check-links'}) 1592 { 1593 if (CheckLink($url)) 1594 { 1595 $is_link_broken = 0; 1596 printf "+"; 1597 } 1598 else 1599 { 1600 $is_link_broken = 1; 1601 printf "-"; 1602 } 1603 } 1604 else 1605 { 1606 printf "."; 1607 } 1608 1609 if ( ! $is_link_broken) 1610 { 1611 return sprintf ("[%s %s]", $url, $text); 1612 } 1613 elsif ($context->{'mark-broken-links'}) 1614 { 1615 return sprintf ("%sbroken%s[%s %s]", $broken_link_start, $broken_link_end, $url, $text); 1616 } 1617 else 1618 { 1619 return sprintf ("%s", $text); 1620 } 1621} 1622 1623 1624 1625 1626=head2 CheckLink ($url) 1627 1628 Check if the file referenced by $url can be downloaded. 1629 This is determined by downloading only the header. 1630 1631=cut 1632my $LastCheckedURL = undef; 1633my $LastCheckedResult = undef; 1634sub CheckLink ($) 1635{ 1636 my ($url) = @_; 1637 1638 if ($url ne $LastCheckedURL) 1639 { 1640 my $head = LWP::Simple::head($url); 1641 $LastCheckedURL = $url; 1642 $LastCheckedResult = !!$head; 1643 } 1644 1645 return $LastCheckedResult; 1646} 1647 1648 1649 1650 1651sub SignFile ($$) 1652{ 1653 my ($signature, $filename) = @_; 1654 1655 my $command = sprintf( 1656 "gpg --armor --output %s.asc --detach-sig %s", 1657 $filename, 1658 $filename); 1659} 1660 1661 1662 1663 1664my $context = ProcessCommandline(@ARGV); 1665my $release_description = ReadReleaseDescription($context->{'filename'}, $context); 1666if ($context->{'command'} eq "build") 1667{ 1668 WriteMakefile($release_description, $context); 1669} 1670elsif ($context->{'command'} eq "upload") 1671{ 1672 Upload($release_description, $context); 1673} 1674elsif ($context->{'command'} eq "wiki") 1675{ 1676 Wiki($release_description, $context); 1677} 1678