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