setup_native/scripts/admin.pl

   1 #
   2 # This file is part of the LibreOffice project.
   3 #
   4 # This Source Code Form is subject to the terms of the Mozilla Public
   5 # License, v. 2.0. If a copy of the MPL was not distributed with this
   6 # file, You can obtain one at http://mozilla.org/MPL/2.0/.
   7 #
   8 # This file incorporates work covered by the following license notice:
   9 #
  10 #   Licensed to the Apache Software Foundation (ASF) under one or more
  11 #   contributor license agreements. See the NOTICE file distributed
  12 #   with this work for additional information regarding copyright
  13 #   ownership. The ASF licenses this file to you under the Apache
  14 #   License, Version 2.0 (the "License"); you may not use this file
  15 #   except in compliance with the License. You may obtain a copy of
  16 #   the License at http://www.apache.org/licenses/LICENSE-2.0 .
  17 #
  18
  19 use Cwd;
  20 use File::Copy;
  21 use File::Temp qw/ :mktemp /;
  22
  23 #################################################################################
  24 # Global settings
  25 #################################################################################
  26
  27 BEGIN
  28 {
  29     $prog = "msi installer";
  30     $targetdir = "";
  31     $databasepath = "";
  32     $starttime = "";
  33     $globaltempdirname = "ooopackagingXXXXXX";
  34     $savetemppath = "";
  35     $msiinfo_available = 0;
  36     $path_displayed = 0;
  37     $localmsidbpath = "";
  38
  39     $plat = $^O;
  40
  41     if ( $plat =~ /cygwin/i )
  42     {
  43         $separator = "/";
  44         $pathseparator = "\:";
  45     }
  46     else
  47     {
  48         $separator = "\\";
  49         $pathseparator = "\;";
  50     }
  51 }
  52
  53 #################################################################################
  54 # Program information
  55 #################################################################################
  56
  57 sub usage
  58 {
  59     print <<Ende;
  60 ----------------------------------------------------------------------
  61 This program installs a Windows Installer installation set
  62 without using msiexec.exe. The installation is comparable
  63 with an administrative installation using the Windows Installer
  64 service.
  65 Required parameter:
  66 -d Path to installation set or msi database
  67 -t Target directory
  68 ---------------------------------------------------------------------
  69 Ende
  70     exit(-1);
  71 }
  72
  73 #################################################################################
  74 # Collecting parameter
  75 #################################################################################
  76
  77 sub getparameter
  78 {
  79     if (( $#ARGV < 3 ) || ( $#ARGV > 3 )) { usage(); }
  80
  81     while ( $#ARGV >= 0 )
  82     {
  83         my $param = shift(@ARGV);
  84
  85         if ($param eq "-t") { $targetdir = shift(@ARGV); }
  86         elsif ($param eq "-d") { $databasepath = shift(@ARGV); }
  87         else
  88         {
  89             print "\n**********************************************\n";
  90             print "Error: Unknown parameter: $param";
  91             print "\n**********************************************\n";
  92             usage();
  93             exit(-1);
  94         }
  95     }
  96 }
  97
  98 #################################################################################
  99 # Checking content of parameter
 100 #################################################################################
 101
 102 sub controlparameter
 103 {
 104     if ( $targetdir eq "" )
 105     {
 106         print "\n******************************************************\n";
 107         print "Error: Target directory not defined (parameter -t)!";
 108         print "\n******************************************************\n";
 109         usage();
 110         exit(-1);
 111     }
 112
 113     if ( $databasepath eq "" )
 114     {
 115         print "\n******************************************************\n";
 116         print "Error: Path to msi database not defined (parameter -d)!";
 117         print "\n******************************************************\n";
 118         usage();
 119         exit(-1);
 120     }
 121
 122     if ( -d $databasepath )
 123     {
 124         $databasepath =~ s/\\\s*$//;
 125         $databasepath =~ s/\/\s*$//;
 126
 127         my $msifiles = find_file_with_file_extension("msi", $databasepath);
 128
 129         if ( $#{$msifiles} < 0 ) { exit_program("ERROR: Did not find msi database in directory $installationdir"); }
 130         if ( $#{$msifiles} > 0 ) { exit_program("ERROR: Did find more than one msi database in directory $installationdir"); }
 131
 132         $databasepath = $databasepath . $separator . ${$msifiles}[0];
 133     }
 134
 135     if ( ! -f $databasepath ) { exit_program("ERROR: Did not find msi database in directory $databasepath."); }
 136
 137     if ( ! -d $targetdir ) { create_directories($targetdir); }
 138 }
 139
 140 #############################################################################
 141 # The program msidb.exe can be located next to the Perl program. Then it is
 142 # not necessary to find it in the PATH variable.
 143 #############################################################################
 144
 145 sub check_local_msidb
 146 {
 147     my $msidbname = "msidb.exe";
 148     my $perlprogramm = $0;
 149     my $path = $perlprogramm;
 150
 151     get_path_from_fullqualifiedname(\$path);
 152
 153     $path =~ s/\\\s*$//;
 154     $path =~ s/\/\s*$//;
 155
 156     my $msidbpath = "";
 157     if ( $path =~ /^\s*$/ ) { $msidbpath = $msidbname; }
 158     else { $msidbpath = $path . $separator . $msidbname; }
 159
 160     if ( -f $msidbpath )
 161     {
 162         $localmsidbpath = $msidbpath;
 163         print "Using $msidbpath (next to \"admin.pl\")\n";
 164     }
 165 }
 166
 167 #############################################################################
 168 # Converting a string list with separator $listseparator
 169 # into an array
 170 #############################################################################
 171
 172 sub convert_stringlist_into_array
 173 {
 174     my ( $includestringref, $listseparator ) = @_;
 175
 176     my @newarray = ();
 177     my $first;
 178     my $last = ${$includestringref};
 179
 180     while ( $last =~ /^\s*(.+?)\Q$listseparator\E(.+)\s*$/) # "$" for minimal matching
 181     {
 182         $first = $1;
 183         $last = $2;
 184         # Problem with two directly following listseparators. For example a path with two ";;" directly behind each other
 185         $first =~ s/^$listseparator//;
 186         push(@newarray, "$first\n");
 187     }
 188
 189     push(@newarray, "$last\n");
 190
 191     return \@newarray;
 192 }
 193
 194 #########################################################
 195 # Checking the local system
 196 # Checking existence of needed files in include path
 197 #########################################################
 198
 199 sub check_system_path
 200 {
 201     my $onefile;
 202     my $error = 0;
 203     my $pathvariable = $ENV{'PATH'};
 204     my $local_pathseparator = $pathseparator;
 205
 206     if( $^O =~ /cygwin/i )
 207     {   # When using cygwin's perl the PATH variable is POSIX style and ...
 208         $pathvariable = qx{cygpath -mp "$pathvariable"} ;
 209         # has to be converted to DOS style for further use.
 210         $local_pathseparator = ';';
 211     }
 212     my $patharrayref = convert_stringlist_into_array(\$pathvariable, $local_pathseparator);
 213
 214     my @needed_files_in_path = ("expand.exe");
 215     if ( $localmsidbpath eq "" ) { push(@needed_files_in_path, "msidb.exe"); } # not found locally -> search in path
 216     my @optional_files_in_path = ("msiinfo.exe");
 217
 218     print("\nChecking required files:\n");
 219
 220     foreach $onefile ( @needed_files_in_path )
 221     {
 222         print("... searching $onefile ...");
 223
 224         my $fileref = get_sourcepath_from_filename_and_includepath(\$onefile, $patharrayref);
 225
 226         if ( $$fileref eq "" )
 227         {
 228             $error = 1;
 229             print( "$onefile not found\n" );
 230         }
 231         else
 232         {
 233             print( "\tFound: $$fileref\n" );
 234         }
 235     }
 236
 237     if ( $error ) { exit_program("ERROR: Could not find all needed files in path (using setsolar should help)!"); }
 238
 239     print("\nChecking optional files:\n");
 240
 241     foreach $onefile ( @optional_files_in_path )
 242     {
 243         print("... searching $onefile ...");
 244
 245         my $fileref = get_sourcepath_from_filename_and_includepath(\$onefile, $patharrayref);
 246
 247         if ( $$fileref eq "" )
 248         {
 249             print( "$onefile not found\n" );
 250             if ( $onefile eq "msiinfo.exe" ) { $msiinfo_available = 0; }
 251         }
 252         else
 253         {
 254             print( "\tFound: $$fileref\n" );
 255             if ( $onefile eq "msiinfo.exe" ) { $msiinfo_available = 1; }
 256         }
 257     }
 258
 259 }
 260
 261 ##########################################################################
 262 # Searching a file in a list of paths
 263 ##########################################################################
 264
 265 sub get_sourcepath_from_filename_and_includepath
 266 {
 267     my ($searchfilenameref, $includepatharrayref) = @_;
 268
 269     my $onefile = "";
 270     my $foundsourcefile = 0;
 271
 272     for ( my $j = 0; $j <= $#{$includepatharrayref}; $j++ )
 273     {
 274         my $includepath = ${$includepatharrayref}[$j];
 275         $includepath =~ s/^\s*//;
 276         $includepath =~ s/\s*$//;
 277
 278         $onefile = $includepath . $separator . $$searchfilenameref;
 279
 280         if ( -f $onefile )
 281         {
 282             $foundsourcefile = 1;
 283             last;
 284         }
 285     }
 286
 287     if (!($foundsourcefile)) { $onefile = ""; }
 288
 289     return \$onefile;
 290 }
 291
 292 ########################################################
 293 # Finding all files with a specified file extension
 294 # in a specified directory.
 295 ########################################################
 296
 297 sub find_file_with_file_extension
 298 {
 299     my ($extension, $dir) = @_;
 300
 301     my @allfiles = ();
 302     my @sourcefiles = ();
 303
 304     $dir =~ s/\Q$separator\E\s*$//;
 305
 306     opendir(DIR, $dir);
 307     @sourcefiles = readdir(DIR);
 308     closedir(DIR);
 309
 310     my $onefile;
 311
 312     foreach $onefile (@sourcefiles)
 313     {
 314         if ((!($onefile eq ".")) && (!($onefile eq "..")))
 315         {
 316             if ( $onefile =~ /^\s*(\S.*?)\.$extension\s*$/ )
 317             {
 318                 push(@allfiles, $onefile)
 319             }
 320         }
 321     }
 322
 323     return \@allfiles;
 324 }
 325
 326 ##############################################################
 327 # Creating a directory with all parent directories
 328 ##############################################################
 329
 330 sub create_directories
 331 {
 332     my ($directory) = @_;
 333
 334     if ( ! try_to_create_directory($directory) )
 335     {
 336         my $parentdir = $directory;
 337         get_path_from_fullqualifiedname(\$parentdir);
 338         create_directories($parentdir);   # recursive
 339     }
 340
 341     create_directory($directory);   # now it has to succeed
 342 }
 343
 344 ##############################################################
 345 # Creating one directory
 346 ##############################################################
 347
 348 sub create_directory
 349 {
 350     my ($directory) = @_;
 351
 352     if ( ! -d $directory ) { mkdir($directory, 0775); }
 353 }
 354
 355 ##############################################################
 356 # Trying to create a directory, no error if this fails
 357 ##############################################################
 358
 359 sub try_to_create_directory
 360 {
 361     my ($directory) = @_;
 362
 363     my $returnvalue = 1;
 364     my $created_directory = 0;
 365
 366     if (!(-d $directory))
 367     {
 368         $returnvalue = mkdir($directory, 0775);
 369
 370         if ($returnvalue)
 371         {
 372             $created_directory = 1;
 373
 374             my $localcall = "chmod 775 $directory \>\/dev\/null 2\>\&1";
 375             system($localcall);
 376         }
 377         else
 378         {
 379             $created_directory = 0;
 380         }
 381     }
 382     else
 383     {
 384         $created_directory = 1;
 385     }
 386
 387     return $created_directory;
 388 }
 389
 390 ###########################################
 391 # Getting path from full file name
 392 ###########################################
 393
 394 sub get_path_from_fullqualifiedname
 395 {
 396     my ($longfilenameref) = @_;
 397
 398     if ( $$longfilenameref =~ /\Q$separator\E/ )    # Is there a separator in the path? Otherwise the path is empty.
 399     {
 400         if ( $$longfilenameref =~ /^\s*(\S.*\Q$separator\E)(\S.+\S?)/ )
 401         {
 402             $$longfilenameref = $1;
 403         }
 404     }
 405     else
 406     {
 407         $$longfilenameref = ""; # there is no path
 408     }
 409 }
 410
 411 ##############################################################
 412 # Getting file name from full file name
 413 ##############################################################
 414
 415 sub make_absolute_filename_to_relative_filename
 416 {
 417     my ($longfilenameref) = @_;
 418
 419     # Either '/' or '\'.
 420     if ( $$longfilenameref =~ /^.*[\/\\](\S.+\S?)/ )
 421     {
 422         $$longfilenameref = $1;
 423     }
 424 }
 425
 426 ############################################
 427 # Exiting the program with an error
 428 # This function is used instead of "die"
 429 ############################################
 430
 431 sub exit_program
 432 {
 433     my ($message) = @_;
 434
 435     print "\n***************************************************************\n";
 436     print "$message\n";
 437     print "***************************************************************\n";
 438     remove_complete_directory($savetemppath, 1);
 439     print "\n" . get_time_string();
 440     exit(-1);
 441 }
 442
 443 #################################################################################
 444 # Unpacking cabinet files with expand
 445 #################################################################################
 446
 447 sub unpack_cabinet_file
 448 {
 449     my ($cabfilename, $unpackdir) = @_;
 450
 451     my $expandfile = "expand.exe"; # has to be in the PATH
 452
 453     # expand.exe has to be located in the system directory.
 454     # Cygwin has another tool expand.exe, that converts tabs to spaces. This cannot be used of course.
 455     # But this wrong expand.exe is typically in the PATH before this expand.exe, to unpack
 456     # cabinet files.
 457
 458     if ( $^O =~ /cygwin/i )
 459     {
 460         $expandfile = $ENV{'SYSTEMROOT'} . "/system32/expand.exe"; # Has to be located in the systemdirectory
 461         $expandfile =~ s/\\/\//;
 462         if ( ! -f $expandfile ) { exit_program("ERROR: Did not find file $expandfile in the Windows system folder!"); }
 463     }
 464
 465     my $expandlogfile = $unpackdir . $separator . "expand.log";
 466
 467     # exclude cabinet file
 468     # my $systemcall = $cabarc . " -o X " . $mergemodulehash->{'cabinetfile'};
 469
 470     my $systemcall = "";
 471     if ( $^O =~ /cygwin/i ) {
 472         my $localunpackdir = qx{cygpath -w "$unpackdir"};
 473         $localunpackdir =~ s/\\/\\\\/g;
 474
 475         my $localcabfilename = qx{cygpath -w "$cabfilename"};
 476         $localcabfilename =~ s/\\/\\\\/g;
 477         $localcabfilename =~ s/\s*$//g;
 478
 479         $systemcall = $expandfile . " " . $localcabfilename . " -F:\* " . $localunpackdir . " \>\/dev\/null 2\>\&1";
 480     }
 481     else
 482     {
 483         $systemcall = $expandfile . " " . $cabfilename . " -F:\* " . $unpackdir . " \> " . $expandlogfile;
 484     }
 485
 486     my $returnvalue = system($systemcall);
 487
 488     if ($returnvalue) { exit_program("ERROR: Could not execute $systemcall !"); }
 489 }
 490
 491 #################################################################################
 492 # Extracting tables from msi database
 493 #################################################################################
 494
 495 sub extract_tables_from_database
 496 {
 497     my ($fullmsidatabasepath, $workdir, $tablelist) = @_;
 498
 499     my $msidb = "msidb.exe";    # Has to be in the path
 500     if ( $localmsidbpath ) { $msidb = $localmsidbpath; }
 501     my $infoline = "";
 502     my $systemcall = "";
 503     my $returnvalue = "";
 504
 505     if ( $^O =~ /cygwin/i ) {
 506         chomp( $fullmsidatabasepath = qx{cygpath -w "$fullmsidatabasepath"} );
 507         # msidb.exe really wants backslashes. (And double escaping because system() expands the string.)
 508         $fullmsidatabasepath =~ s/\\/\\\\/g;
 509         $workdir =~ s/\\/\\\\/g;
 510         # and if there are still slashes, they also need to be double backslash
 511         $fullmsidatabasepath =~ s/\//\\\\/g;
 512         $workdir =~ s/\//\\\\/g;
 513     }
 514
 515     # Export of all tables by using "*"
 516
 517     $systemcall = $msidb . " -d " . $fullmsidatabasepath . " -f " . $workdir . " -e $tablelist";
 518     print "\nAnalyzing msi database\n";
 519     $returnvalue = system($systemcall);
 520
 521     if ($returnvalue)
 522     {
 523         $infoline = "ERROR: Could not execute $systemcall !\n";
 524         exit_program($infoline);
 525     }
 526 }
 527
 528 ########################################################
 529 # Check, if this installation set contains
 530 # internal cabinet files included into the msi
 531 # database.
 532 ########################################################
 533
 534 sub check_for_internal_cabfiles
 535 {
 536     my ($cabfilehash) = @_;
 537
 538     my $contains_internal_cabfiles = 0;
 539     my %allcabfileshash = ();
 540
 541     foreach my $filename ( keys %{$cabfilehash} )
 542     {
 543         if ( $filename =~ /^\s*\#/ )     # starting with a hash
 544         {
 545             $contains_internal_cabfiles = 1;
 546             # setting real filename without hash as key and name with hash as value
 547             my $realfilename = $filename;
 548             $realfilename =~ s/^\s*\#//;
 549             $allcabfileshash{$realfilename} = $filename;
 550         }
 551     }
 552
 553     return ( $contains_internal_cabfiles, \%allcabfileshash );
 554 }
 555
 556 #################################################################
 557 # Exclude all cab files from the msi database.
 558 #################################################################
 559
 560 sub extract_cabs_from_database
 561 {
 562     my ($msidatabase, $allcabfiles) = @_;
 563
 564     my $infoline = "";
 565     my $fullsuccess = 1;
 566     my $msidb = "msidb.exe";    # Has to be in the path
 567     if ( $localmsidbpath ) { $msidb = $localmsidbpath; }
 568
 569     my @all_excluded_cabfiles = ();
 570
 571     if( $^O =~ /cygwin/i )
 572     {
 573         $msidatabase = qx{cygpath -w "$msidatabase"};
 574         $msidatabase =~ s/\\/\\\\/g;
 575         $msidatabase =~ s/\s*$//g;
 576     }
 577     else
 578     {
 579         # msidb.exe really wants backslashes. (And double escaping because system() expands the string.)
 580         $msidatabase =~ s/\//\\\\/g;
 581     }
 582
 583     foreach my $onefile ( keys %{$allcabfiles} )
 584     {
 585         my $systemcall = $msidb . " -d " . $msidatabase . " -x " . $onefile;
 586          system($systemcall);
 587          push(@all_excluded_cabfiles, $onefile);
 588     }
 589
 590     \@all_excluded_cabfiles;
 591 }
 592
 593 ################################################################################
 594 # Collect all DiskIds to the corresponding cabinet files from Media.idt.
 595 ################################################################################
 596
 597 sub analyze_media_file
 598 {
 599     my ($filecontent) = @_;
 600
 601     my %diskidhash = ();
 602
 603     for ( my $i = 0; $i <= $#{$filecontent}; $i++ )
 604     {
 605         if ( $i < 3 ) { next; }
 606
 607         if ( ${$filecontent}[$i] =~ /^\s*(.*?)\t(.*?)\t(.*?)\t(.*?)\t(.*?)\t(.*?)\s*$/ )
 608         {
 609             my $diskid = $1;
 610             my $cabfile = $4;
 611
 612             $diskidhash{$cabfile} = $diskid;
 613         }
 614     }
 615
 616     return \%diskidhash;
 617 }
 618
 619 ################################################################################
 620 # Analyzing the content of Directory.idt
 621 #################################################################################
 622
 623 sub analyze_directory_file
 624 {
 625     my ($filecontent) = @_;
 626
 627     my %table = ();
 628
 629     for ( my $i = 0; $i <= $#{$filecontent}; $i++ )
 630     {
 631         if (( $i == 0 ) || ( $i == 1 ) || ( $i == 2 )) { next; }
 632
 633         if ( ${$filecontent}[$i] =~ /^\s*(.*?)\t(.*?)\t(.*?)\s*$/ )
 634         {
 635             my $dir = $1;
 636             my $parent = $2;
 637             my $name = $3;
 638
 639             if ( $name =~ /^\s*(.*?)\s*\:\s*(.*?)\s*$/ ) { $name = $2; }
 640             if ( $name =~ /^\s*(.*?)\s*\|\s*(.*?)\s*$/ ) { $name = $2; }
 641
 642             my %helphash = ();
 643             $helphash{'Directory_Parent'} = $parent;
 644             $helphash{'DefaultDir'} = $name;
 645             $table{$dir} = \%helphash;
 646         }
 647     }
 648
 649     return \%table;
 650 }
 651
 652 #################################################################################
 653 # Analyzing the content of Component.idt
 654 #################################################################################
 655
 656 sub analyze_component_file
 657 {
 658     my ($filecontent) = @_;
 659
 660     my %table = ();
 661
 662     for ( my $i = 0; $i <= $#{$filecontent}; $i++ )
 663     {
 664         if (( $i == 0 ) || ( $i == 1 ) || ( $i == 2 )) { next; }
 665
 666         if ( ${$filecontent}[$i] =~ /^\s*(.*?)\t(.*?)\t(.*?)\t(.*?)\t(.*?)\t(.*?)\s*$/ )
 667         {
 668             my $component = $1;
 669             my $dir = $3;
 670
 671             $table{$component} = $dir;
 672         }
 673     }
 674
 675     return \%table;
 676 }
 677
 678 #################################################################################
 679 # Analyzing the content of File.idt
 680 #################################################################################
 681
 682 sub analyze_file_file
 683 {
 684     my ($filecontent) = @_;
 685
 686     my %table = ();
 687     my %fileorder = ();
 688     my $maxsequence = 0;
 689
 690     for ( my $i = 0; $i <= $#{$filecontent}; $i++ )
 691     {
 692         if (( $i == 0 ) || ( $i == 1 ) || ( $i == 2 )) { next; }
 693
 694         if ( ${$filecontent}[$i] =~ /^\s*(.*?)\t(.*?)\t(.*?)\t(.*?)\t(.*?)\t(.*?)\t(.*?)\t(.*?)\s*$/ )
 695         {
 696             my $file = $1;
 697             my $comp = $2;
 698             my $filename = $3;
 699             my $sequence = $8;
 700
 701             if ( $filename =~ /^\s*(.*?)\s*\|\s*(.*?)\s*$/ ) { $filename = $2; }
 702
 703             my %helphash = ();
 704             $helphash{'Component'} = $comp;
 705             $helphash{'FileName'} = $filename;
 706             $helphash{'Sequence'} = $sequence;
 707
 708             $table{$file} = \%helphash;
 709
 710             $fileorder{$sequence} = $file;
 711
 712             if ( $sequence > $maxsequence ) { $maxsequence = $sequence; }
 713         }
 714     }
 715
 716     return (\%table, \%fileorder, $maxsequence);
 717 }
 718
 719 ####################################################################################
 720 # Recursively creating the directory tree
 721 ####################################################################################
 722
 723 sub create_directory_tree
 724 {
 725     my ($parent, $pathcollector, $fulldir, $dirhash) = @_;
 726
 727     foreach my $dir ( keys %{$dirhash} )
 728     {
 729         if (( $dirhash->{$dir}->{'Directory_Parent'} eq $parent ) && ( $dirhash->{$dir}->{'DefaultDir'} ne "." ))
 730         {
 731             my $dirname = $dirhash->{$dir}->{'DefaultDir'};
 732             # Create the directory
 733             my $newdir = $fulldir . $separator . $dirname;
 734             if ( ! -f $newdir ) { mkdir $newdir; }
 735             # Saving in collector
 736             $pathcollector->{$dir} = $newdir;
 737             # Iteration
 738             create_directory_tree($dir, $pathcollector, $newdir, $dirhash);
 739         }
 740     }
 741 }
 742
 743 ####################################################################################
 744 # Creating the directory tree
 745 ####################################################################################
 746
 747 sub create_directory_structure
 748 {
 749     my ($dirhash, $targetdir) = @_;
 750
 751     print "Creating directories\n";
 752
 753     my %fullpathhash = ();
 754
 755     my @startparents = ("TARGETDIR", "INSTALLLOCATION");
 756
 757     foreach $dir (@startparents) { create_directory_tree($dir, \%fullpathhash, $targetdir, $dirhash); }
 758
 759     # Also adding the paths of the startparents
 760     foreach $dir (@startparents)
 761     {
 762         if ( ! exists($fullpathhash{$dir}) ) { $fullpathhash{$dir} = $targetdir; }
 763     }
 764
 765     return \%fullpathhash;
 766 }
 767
 768 ####################################################################################
 769 # Cygwin: Setting privileges for files
 770 ####################################################################################
 771
 772 sub change_privileges
 773 {
 774     my ($destfile, $privileges) = @_;
 775
 776     my $localcall = "chmod $privileges " . "\"" . $destfile . "\"";
 777     system($localcall);
 778 }
 779
 780 ####################################################################################
 781 # Cygwin: Setting privileges for files recursively
 782 ####################################################################################
 783
 784 sub change_privileges_full
 785 {
 786     my ($target) = @_;
 787
 788     print "Changing privileges\n";
 789
 790     my $localcall = "chmod -R 755 " . "\"" . $target . "\"";
 791     system($localcall);
 792 }
 793
 794 ######################################################
 795 # Creating a new directory with defined privileges
 796 ######################################################
 797
 798 sub create_directory_with_privileges
 799 {
 800     my ($directory, $privileges) = @_;
 801
 802     my $returnvalue = 1;
 803     my $infoline = "";
 804
 805     if (!(-d $directory))
 806     {
 807         my $localprivileges = oct("0".$privileges); # changes "777" to 0777
 808         $returnvalue = mkdir($directory, $localprivileges);
 809
 810         if ($returnvalue)
 811         {
 812             my $localcall = "chmod $privileges $directory \>\/dev\/null 2\>\&1";
 813             system($localcall);
 814         }
 815     }
 816     else
 817     {
 818         my $localcall = "chmod $privileges $directory \>\/dev\/null 2\>\&1";
 819         system($localcall);
 820     }
 821 }
 822
 823 ######################################################
 824 # Creating a unique directory with pid extension
 825 ######################################################
 826
 827 sub create_pid_directory
 828 {
 829     my ($directory) = @_;
 830
 831     $directory =~ s/\Q$separator\E\s*$//;
 832     my $pid = $$;           # process id
 833     my $time = time();      # time
 834
 835     $directory = $directory . "_" . $pid . $time;
 836
 837     if ( ! -d $directory ) { create_directory($directory); }
 838     else { exit_program("ERROR: Directory $directory already exists!"); }
 839
 840     return $directory;
 841 }
 842
 843 ####################################################################################
 844 # Copying files into installation set
 845 ####################################################################################
 846
 847 sub copy_files_into_directory_structure
 848 {
 849     my ($fileorder, $filehash, $componenthash, $fullpathhash, $maxsequence, $unpackdir, $installdir, $dirhash) = @_;
 850
 851     print "Copying files\n";
 852
 853     for ( my $i = 1; $i <= $maxsequence; $i++ )
 854     {
 855         if ( exists($fileorder->{$i}) )
 856         {
 857             my $file = $fileorder->{$i};
 858             if ( ! exists($filehash->{$file}->{'Component'}) ) { exit_program("ERROR: Did not find component for file: \"$file\"."); }
 859             my $component = $filehash->{$file}->{'Component'};
 860             if ( ! exists($componenthash->{$component}) ) { exit_program("ERROR: Did not find directory for component: \"$component\"."); }
 861             my $dirname = $componenthash->{$component};
 862             if ( ! exists($fullpathhash->{$dirname}) ) { exit_program("ERROR: Did not find full directory path for dir: \"$dirname\"."); }
 863             my $destdir = $fullpathhash->{$dirname};
 864             if ( ! exists($filehash->{$file}->{'FileName'}) ) { exit_program("ERROR: Did not find \"FileName\" for file: \"$file\"."); }
 865             my $destfile = $filehash->{$file}->{'FileName'};
 866
 867             $destfile = $destdir . $separator . $destfile;
 868             my $sourcefile = $unpackdir . $separator . $file;
 869
 870             if ( ! -f $sourcefile )
 871             {
 872                 # It is possible, that this was an unpacked file
 873                 # Looking in the dirhash, to find the subdirectory in the installation set (the id is $dirname)
 874                 # subdir is not recursively analyzed, only one directory.
 875
 876                 my $oldsourcefile = $sourcefile;
 877                 my $subdir = "";
 878                 if ( exists($dirhash->{$dirname}->{'DefaultDir'}) ) { $subdir = $dirhash->{$dirname}->{'DefaultDir'} . $separator; }
 879                 my $realfilename = $filehash->{$file}->{'FileName'};
 880                 my $localinstalldir = $installdir;
 881
 882                 $localinstalldir =~ s/\\\s*$//;
 883                 $localinstalldir =~ s/\/\s*$//;
 884
 885                 $sourcefile = $localinstalldir . $separator . $subdir . $realfilename;
 886
 887                 if ( ! -f $sourcefile ) { exit_program("ERROR: File not found: \"$oldsourcefile\" (or \"$sourcefile\")."); }
 888             }
 889
 890             my $copyreturn = copy($sourcefile, $destfile);
 891
 892             if ( ! $copyreturn) { exit_program("ERROR: Could not copy $source to $dest\n"); }
 893
 894             # if (( $^O =~ /cygwin/i ) && ( $destfile =~ /\.exe\s*$/ )) { change_privileges($destfile, "775"); }
 895         }
 896         # else  # allowing missing sequence numbers ?
 897         # {
 898         #   exit_program("ERROR: No file assigned to sequence $i");
 899         # }
 900     }
 901 }
 902
 903 ######################################################
 904 # Removing a complete directory with subdirectories
 905 ######################################################
 906
 907 sub remove_complete_directory
 908 {
 909     my ($directory, $start) = @_;
 910
 911     my @content = ();
 912     my $infoline = "";
 913
 914     $directory =~ s/\Q$separator\E\s*$//;
 915
 916     if ( -d $directory )
 917     {
 918         if ( $start ) { print "Removing directory $directory\n"; }
 919
 920         opendir(DIR, $directory);
 921         @content = readdir(DIR);
 922         closedir(DIR);
 923
 924         my $oneitem;
 925
 926         foreach $oneitem (@content)
 927         {
 928             if ((!($oneitem eq ".")) && (!($oneitem eq "..")))
 929             {
 930                 my $item = $directory . $separator . $oneitem;
 931
 932                 if ( -f $item || -l $item )     # deleting files or links
 933                 {
 934                     unlink($item);
 935                 }
 936
 937                 if ( -d $item )     # recursive
 938                 {
 939                     remove_complete_directory($item, 0);
 940                 }
 941             }
 942         }
 943
 944         # try to remove empty directory
 945         my $returnvalue = rmdir $directory;
 946         if ( ! $returnvalue ) { print "Warning: Problem with removing empty dir $directory\n"; }
 947     }
 948 }
 949
 950 ####################################################################################
 951 # Defining a temporary path
 952 ####################################################################################
 953
 954 sub get_temppath
 955 {
 956     my $temppath = "";
 957
 958     if (( $ENV{'TMP'} ) || ( $ENV{'TEMP'} ))
 959     {
 960         if ( $ENV{'TMP'} ) { $temppath = $ENV{'TMP'}; }
 961         elsif ( $ENV{'TEMP'} )  { $temppath = $ENV{'TEMP'}; }
 962
 963         $temppath =~ s/\Q$separator\E\s*$//;    # removing ending slashes and backslashes
 964         $temppath = $temppath . $separator . $globaltempdirname;
 965         $temppath = mkdtemp($temppath);
 966
 967         my $dirsave = $temppath;
 968
 969         $temppath = $temppath . $separator . "a";
 970         $temppath = create_pid_directory($temppath);
 971
 972         if ( ! -d $temppath ) { exit_program("ERROR: Failed to create directory $temppath ! Possible reason: Wrong privileges in directory $dirsave."); }
 973
 974         if ( $^O =~ /cygwin/i )
 975         {
 976             $temppath =~ s/\\/\\\\/g;
 977             chomp( $temppath = qx{cygpath -w "$temppath"} );
 978         }
 979
 980         $savetemppath = $temppath;
 981     }
 982     else
 983     {
 984         exit_program("ERROR: Could not set temporary directory (TMP and TEMP not set!).");
 985     }
 986
 987     return $temppath;
 988 }
 989
 990 ####################################################################################
 991 # Reading one file
 992 ####################################################################################
 993
 994 sub read_file
 995 {
 996     my ($localfile) = @_;
 997
 998     my @localfile = ();
 999
1000     open( IN, "<$localfile" ) || exit_program("ERROR: Cannot open file $localfile for reading");
1001
1002     #   Don't use "my @localfile = <IN>" here, because
1003     #   perl has a problem with the internal "large_and_huge_malloc" function
1004     #   when calling perl using MacOS 10.5 with a perl built with MacOS 10.4
1005     while ( $line = <IN> ) {
1006         push @localfile, $line;
1007     }
1008
1009     close( IN );
1010
1011     return \@localfile;
1012 }
1013
1014 ###############################################################
1015 # Setting the time string for the
1016 # Summary Information stream in the
1017 # msi database of the admin installations.
1018 ###############################################################
1019
1020 sub get_sis_time_string
1021 {
1022     # Syntax: <yyyy/mm/dd hh:mm:ss>
1023     my $second = (localtime())[0];
1024     my $minute = (localtime())[1];
1025     my $hour = (localtime())[2];
1026     my $day = (localtime())[3];
1027     my $month = (localtime())[4];
1028     my $year = 1900 + (localtime())[5];
1029     $month++;
1030
1031     if ( $second < 10 ) { $second = "0" . $second; }
1032     if ( $minute < 10 ) { $minute = "0" . $minute; }
1033     if ( $hour < 10 ) { $hour = "0" . $hour; }
1034     if ( $day < 10 ) { $day = "0" . $day; }
1035     if ( $month < 10 ) { $month = "0" . $month; }
1036
1037     my $timestring = $year . "/" . $month . "/" . $day . " " . $hour . ":" . $minute . ":" . $second;
1038
1039     return $timestring;
1040 }
1041
1042 ###############################################################
1043 # Writing content of administrative installations into
1044 # Summary Information Stream of msi database.
1045 # This is required for example for following
1046 # patch processes using Windows Installer service.
1047 ###############################################################
1048
1049 sub write_sis_info
1050 {
1051     my ($msidatabase) = @_;
1052
1053     print "Setting SIS in msi database\n";
1054
1055     if ( ! -f $msidatabase ) { exit_program("ERROR: Cannot find file $msidatabase"); }
1056
1057     my $msiinfo = "msiinfo.exe";    # Has to be in the path
1058     my $infoline = "";
1059     my $systemcall = "";
1060     my $returnvalue = "";
1061
1062     # Required setting for administrative installations:
1063     # -w 4   (source files are unpacked),  wordcount
1064     # -s <date of admin installation>, LastPrinted, Syntax: <yyyy/mm/dd hh:mm:ss>
1065     # -l <person_making_admin_installation>, LastSavedBy
1066
1067     my $wordcount = 4;  # Unpacked files
1068     my $lastprinted = get_sis_time_string();
1069     my $lastsavedby = "Installer";
1070
1071     my $localmsidatabase = $msidatabase;
1072
1073     if( $^O =~ /cygwin/i )
1074     {
1075         $localmsidatabase = qx{cygpath -w "$localmsidatabase"};
1076         $localmsidatabase =~ s/\\/\\\\/g;
1077         $localmsidatabase =~ s/\s*$//g;
1078     }
1079
1080     $systemcall = $msiinfo . " " . "\"" . $localmsidatabase . "\"" . " -w " . $wordcount . " -s " . "\"" . $lastprinted . "\"" . " -l $lastsavedby";
1081
1082     $returnvalue = system($systemcall);
1083
1084     if ($returnvalue)
1085     {
1086         $infoline = "ERROR: Could not execute $systemcall !\n";
1087         exit_program($infoline);
1088     }
1089 }
1090
1091 ###############################################################
1092 # Convert time string
1093 ###############################################################
1094
1095 sub convert_timestring
1096 {
1097     my ($secondstring) = @_;
1098
1099     my $timestring = "";
1100
1101     if ( $secondstring < 60 )    # less than a minute
1102     {
1103         if ( $secondstring < 10 ) { $secondstring = "0" . $secondstring; }
1104         $timestring = "00\:$secondstring min\.";
1105     }
1106     elsif ( $secondstring < 3600 )
1107     {
1108         my $minutes = $secondstring / 60;
1109         my $seconds = $secondstring % 60;
1110         if ( $minutes =~ /(\d*)\.\d*/ ) { $minutes = $1; }
1111         if ( $minutes < 10 ) { $minutes = "0" . $minutes; }
1112         if ( $seconds < 10 ) { $seconds = "0" . $seconds; }
1113         $timestring = "$minutes\:$seconds min\.";
1114     }
1115     else    # more than one hour
1116     {
1117         my $hours = $secondstring / 3600;
1118         my $secondstring = $secondstring % 3600;
1119         my $minutes = $secondstring / 60;
1120         my $seconds = $secondstring % 60;
1121         if ( $hours =~ /(\d*)\.\d*/ ) { $hours = $1; }
1122         if ( $minutes =~ /(\d*)\.\d*/ ) { $minutes = $1; }
1123         if ( $hours < 10 ) { $hours = "0" . $hours; }
1124         if ( $minutes < 10 ) { $minutes = "0" . $minutes; }
1125         if ( $seconds < 10 ) { $seconds = "0" . $seconds; }
1126         $timestring = "$hours\:$minutes\:$seconds hours";
1127     }
1128
1129     return $timestring;
1130 }
1131
1132 ###############################################################
1133 # Returning time string for logging
1134 ###############################################################
1135
1136 sub get_time_string
1137 {
1138     my $currenttime = time();
1139     $currenttime = $currenttime - $starttime;
1140     $currenttime = convert_timestring($currenttime);
1141     $currenttime = localtime() . " \(" . $currenttime . "\)\n";
1142     return $currenttime;
1143 }
1144
1145 ####################################################################################
1146 # Simulating an administrative installation
1147 ####################################################################################
1148
1149 $starttime = time();
1150
1151 getparameter();
1152 controlparameter();
1153 check_local_msidb();
1154 check_system_path();
1155 my $temppath = get_temppath();
1156
1157 print("\nmsi database: $databasepath\n");
1158 print("Destination directory: $targetdir\n" );
1159
1160 my $helperdir = $temppath . $separator . "installhelper";
1161 create_directory($helperdir);
1162
1163 # Get File.idt, Component.idt and Directory.idt from database
1164
1165 my $tablelist = "File Directory Component Media CustomAction";
1166 extract_tables_from_database($databasepath, $helperdir, $tablelist);
1167
1168 # Set unpackdir
1169 my $unpackdir = $helperdir . $separator . "unpack";
1170 create_directory($unpackdir);
1171
1172 # Reading media table to check for internal cabinet files
1173 my $filename = $helperdir . $separator . "Media.idt";
1174 if ( ! -f $filename ) { exit_program("ERROR: Could not find required file: $filename !"); }
1175 my $filecontent = read_file($filename);
1176 my $cabfilehash = analyze_media_file($filecontent);
1177
1178 # Check, if there are internal cab files
1179 my ( $contains_internal_cabfiles, $all_internal_cab_files) = check_for_internal_cabfiles($cabfilehash);
1180
1181 if ( $contains_internal_cabfiles )
1182 {
1183     # Set unpackdir
1184     my $cabdir = $helperdir . $separator . "internal_cabs";
1185     create_directory($cabdir);
1186     my $from = cwd();
1187     chdir($cabdir);
1188     # Exclude all cabinet files from database
1189     my $all_excluded_cabs = extract_cabs_from_database($databasepath, $all_internal_cab_files);
1190     print "Unpacking files from internal cabinet file(s)\n";
1191     foreach my $cabfile ( @{$all_excluded_cabs} ) { unpack_cabinet_file($cabfile, $unpackdir); }
1192     chdir($from);
1193 }
1194
1195 # Unpack all cab files into $helperdir, cab files must be located next to msi database
1196 my $installdir = $databasepath;
1197
1198 get_path_from_fullqualifiedname(\$installdir);
1199
1200 my $databasefilename = $databasepath;
1201 make_absolute_filename_to_relative_filename(\$databasefilename);
1202
1203 my $cabfiles = find_file_with_file_extension("cab", $installdir);
1204
1205 if (( $#{$cabfiles} < 0 ) && ( ! $contains_internal_cabfiles )) { exit_program("ERROR: Did not find any cab file in directory $installdir"); }
1206
1207 print "Unpacking files from cabinet file(s)\n";
1208 for ( my $i = 0; $i <= $#{$cabfiles}; $i++ )
1209 {
1210     my $cabfile = $installdir . $separator . ${$cabfiles}[$i];
1211     unpack_cabinet_file($cabfile, $unpackdir);
1212 }
1213
1214 # Reading tables
1215 $filename = $helperdir . $separator . "Directory.idt";
1216 $filecontent = read_file($filename);
1217 my $dirhash = analyze_directory_file($filecontent);
1218
1219 $filename = $helperdir . $separator . "Component.idt";
1220 $filecontent = read_file($filename);
1221 my $componenthash = analyze_component_file($filecontent);
1222
1223 $filename = $helperdir . $separator . "File.idt";
1224 $filecontent = read_file($filename);
1225 my ( $filehash, $fileorder, $maxsequence ) = analyze_file_file($filecontent);
1226
1227 # Creating the directory structure
1228 my $fullpathhash = create_directory_structure($dirhash, $targetdir);
1229
1230 # Copying files
1231 copy_files_into_directory_structure($fileorder, $filehash, $componenthash, $fullpathhash, $maxsequence, $unpackdir, $installdir, $dirhash);
1232 if ( $^O =~ /cygwin/i ) { change_privileges_full($targetdir); }
1233
1234 my $msidatabase = $targetdir . $separator . $databasefilename;
1235 my $copyreturn = copy($databasepath, $msidatabase);
1236 if ( ! $copyreturn) { exit_program("ERROR: Could not copy $source to $dest\n"); }
1237
1238 # Saving info in Summary Information Stream of msi database (required for following patches)
1239 if ( $msiinfo_available ) { write_sis_info($msidatabase); }
1240
1241 # Removing the helper directory
1242 remove_complete_directory($temppath, 1);
1243
1244 print "\nSuccessful installation: " . get_time_string();