setup_native/scripts/admin.pl

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