setup_native/scripts/admin.pl

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