#************************************************************** # # Licensed to the Apache Software Foundation (ASF) under one # or more contributor license agreements. See the NOTICE file # distributed with this work for additional information # regarding copyright ownership. The ASF licenses this file # to you under the Apache License, Version 2.0 (the # "License"); you may not use this file except in compliance # with the License. You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, # software distributed under the License is distributed on an # "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY # KIND, either express or implied. See the License for the # specific language governing permissions and limitations # under the License. # #************************************************************** use Cwd; use File::Copy; ################################################################################# # Global settings ################################################################################# BEGIN { $prog = "msi installer"; $targetdir = ""; $databasepath = ""; $starttime = ""; $globaltempdirname = "ooopackaging"; $savetemppath = ""; $msiinfo_available = 0; $path_displayed = 0; $localmsidbpath = ""; $plat = $^O; if ( $plat =~ /cygwin/i ) { $separator = "/"; $pathseparator = "\:"; } else { $separator = "\\"; $pathseparator = "\;"; } } ################################################################################# # Program information ################################################################################# sub usage { print < 3 )) { usage(); } while ( $#ARGV >= 0 ) { my $param = shift(@ARGV); if ($param eq "-t") { $targetdir = shift(@ARGV); } elsif ($param eq "-d") { $databasepath = shift(@ARGV); } else { print "\n**********************************************\n"; print "Error: Unknows parameter: $param"; print "\n**********************************************\n"; usage(); exit(-1); } } } ################################################################################# # Checking content of parameter ################################################################################# sub controlparameter { if ( $targetdir eq "" ) { print "\n******************************************************\n"; print "Error: Target directory not defined (parameter -t)!"; print "\n******************************************************\n"; usage(); exit(-1); } if ( $databasepath eq "" ) { print "\n******************************************************\n"; print "Error: Path to msi database not defined (parameter -d)!"; print "\n******************************************************\n"; usage(); exit(-1); } if ( -d $databasepath ) { $databasepath =~ s/\\\s*$//; $databasepath =~ s/\/\s*$//; my $msifiles = find_file_with_file_extension("msi", $databasepath); if ( $#{$msifiles} < 0 ) { exit_program("ERROR: Did not find msi database in directory $installationdir"); } if ( $#{$msifiles} > 0 ) { exit_program("ERROR: Did find more than one msi database in directory $installationdir"); } $databasepath = $databasepath . $separator . ${$msifiles}[0]; } if ( ! -f $databasepath ) { exit_program("ERROR: Did not find msi database in directory $databasepath."); } if ( ! -d $targetdir ) { create_directories($targetdir); } } ############################################################################# # The program msidb.exe can be located next to the Perl program. Then it is # not necessary to find it in the PATH variable. ############################################################################# sub check_local_msidb { my $msidbname = "msidb.exe"; my $perlprogramm = $0; my $path = $perlprogramm; get_path_from_fullqualifiedname(\$path); $path =~ s/\\\s*$//; $path =~ s/\/\s*$//; my $msidbpath = ""; if ( $path =~ /^\s*$/ ) { $msidbpath = $msidbname; } else { $msidbpath = $path . $separator . $msidbname; } if ( -f $msidbpath ) { $localmsidbpath = $msidbpath; print "Using $msidbpath (next to \"admin.pl\")\n"; } } ############################################################################# # Converting a string list with separator $listseparator # into an array ############################################################################# sub convert_stringlist_into_array { my ( $includestringref, $listseparator ) = @_; my @newarray = (); my $first; my $last = ${$includestringref}; while ( $last =~ /^\s*(.+?)\Q$listseparator\E(.+)\s*$/) # "$" for minimal matching { $first = $1; $last = $2; # Problem with two directly following listseparators. For example a path with two ";;" directly behind each other $first =~ s/^$listseparator//; push(@newarray, "$first\n"); } push(@newarray, "$last\n"); return \@newarray; } ######################################################### # Checking the local system # Checking existence of needed files in include path ######################################################### sub check_system_path { my $onefile; my $error = 0; my $pathvariable = $ENV{'PATH'}; my $local_pathseparator = $pathseparator; if( $^O =~ /cygwin/i ) { # When using cygwin's perl the PATH variable is POSIX style and ... $pathvariable = qx{cygpath -mp "$pathvariable"} ; # has to be converted to DOS style for further use. $local_pathseparator = ';'; } my $patharrayref = convert_stringlist_into_array(\$pathvariable, $local_pathseparator); my @needed_files_in_path = ("expand.exe"); if ( $localmsidbpath eq "" ) { push(@needed_files_in_path, "msidb.exe"); } # not found locally -> search in path my @optional_files_in_path = ("msiinfo.exe"); print("\nChecking required files:\n"); foreach $onefile ( @needed_files_in_path ) { print("...... searching $onefile ..."); my $fileref = get_sourcepath_from_filename_and_includepath(\$onefile, $patharrayref); if ( $$fileref eq "" ) { $error = 1; print( "$onefile not found\n" ); } else { print( "\tFound: $$fileref\n" ); } } if ( $error ) { exit_program("ERROR: Could not find all needed files in path (using setsolar should help)!"); } print("\nChecking optional files:\n"); foreach $onefile ( @optional_files_in_path ) { print("...... searching $onefile ..."); my $fileref = get_sourcepath_from_filename_and_includepath(\$onefile, $patharrayref); if ( $$fileref eq "" ) { print( "$onefile not found\n" ); if ( $onefile eq "msiinfo.exe" ) { $msiinfo_available = 0; } } else { print( "\tFound: $$fileref\n" ); if ( $onefile eq "msiinfo.exe" ) { $msiinfo_available = 1; } } } } ########################################################################## # Searching a file in a list of paths ########################################################################## sub get_sourcepath_from_filename_and_includepath { my ($searchfilenameref, $includepatharrayref) = @_; my $onefile = ""; my $foundsourcefile = 0; for ( my $j = 0; $j <= $#{$includepatharrayref}; $j++ ) { my $includepath = ${$includepatharrayref}[$j]; $includepath =~ s/^\s*//; $includepath =~ s/\s*$//; $onefile = $includepath . $separator . $$searchfilenameref; if ( -f $onefile ) { $foundsourcefile = 1; last; } } if (!($foundsourcefile)) { $onefile = ""; } return \$onefile; } ############################################################## # Removing all empty directories below a specified directory ############################################################## sub remove_empty_dirs_in_folder { my ( $dir, $firstrun ) = @_; if ( $firstrun ) { print "Removing superfluous directories\n"; } my @content = (); $dir =~ s/\Q$separator\E\s*$//; if ( -d $dir ) { opendir(DIR, $dir); @content = readdir(DIR); closedir(DIR); my $oneitem; foreach $oneitem (@content) { if ((!($oneitem eq ".")) && (!($oneitem eq ".."))) { my $item = $dir . $separator . $oneitem; if ( -d $item ) # recursive { remove_empty_dirs_in_folder($item, 0); } } } # try to remove empty directory my $returnvalue = rmdir $dir; # if ( $returnvalue ) { print "Successfully removed empty dir $dir\n"; } } } #################################################### # Detecting the directory with extensions #################################################### sub get_extensions_dir { my ( $unopkgfile ) = @_; my $localbranddir = $unopkgfile; get_path_from_fullqualifiedname(\$localbranddir); # "program" dir in brand layer get_path_from_fullqualifiedname(\$localbranddir); # root dir in brand layer $localbranddir =~ s/\Q$separator\E\s*$//; my $extensiondir = $localbranddir . $separator . "share" . $separator . "extensions"; my $preregdir = $localbranddir . $separator . "share" . $separator . "prereg" . $separator . "bundled"; return ($extensiondir, $preregdir); } ######################################################## # Finding all files with a specified file extension # in a specified directory. ######################################################## sub find_file_with_file_extension { my ($extension, $dir) = @_; my @allfiles = (); my @sourcefiles = (); $dir =~ s/\Q$separator\E\s*$//; opendir(DIR, $dir); @sourcefiles = readdir(DIR); closedir(DIR); my $onefile; foreach $onefile (@sourcefiles) { if ((!($onefile eq ".")) && (!($onefile eq ".."))) { if ( $onefile =~ /^\s*(\S.*?)\.$extension\s*$/ ) { push(@allfiles, $onefile) } } } return \@allfiles; } ############################################################## # Creating a directory with all parent directories ############################################################## sub create_directories { my ($directory) = @_; if ( ! try_to_create_directory($directory) ) { my $parentdir = $directory; get_path_from_fullqualifiedname(\$parentdir); create_directories($parentdir); # recursive } create_directory($directory); # now it has to succeed } ############################################################## # Creating one directory ############################################################## sub create_directory { my ($directory) = @_; if ( ! -d $directory ) { mkdir($directory, 0775); } } ############################################################## # Trying to create a directory, no error if this fails ############################################################## sub try_to_create_directory { my ($directory) = @_; my $returnvalue = 1; my $created_directory = 0; if (!(-d $directory)) { $returnvalue = mkdir($directory, 0775); if ($returnvalue) { $created_directory = 1; my $localcall = "chmod 775 $directory \>\/dev\/null 2\>\&1"; system($localcall); } else { $created_directory = 0; } } else { $created_directory = 1; } return $created_directory; } ########################################### # Getting path from full file name ########################################### sub get_path_from_fullqualifiedname { my ($longfilenameref) = @_; if ( $$longfilenameref =~ /\Q$separator\E/ ) # Is there a separator in the path? Otherwise the path is empty. { if ( $$longfilenameref =~ /^\s*(\S.*\Q$separator\E)(\S.+\S?)/ ) { $$longfilenameref = $1; } } else { $$longfilenameref = ""; # there is no path } } ############################################################## # Getting file name from full file name ############################################################## sub make_absolute_filename_to_relative_filename { my ($longfilenameref) = @_; # Either '/' or '\'. if ( $$longfilenameref =~ /^.*[\/\\](\S.+\S?)/ ) { $$longfilenameref = $1; } } ############################################ # Exiting the program with an error # This function is used instead of "die" ############################################ sub exit_program { my ($message) = @_; print "\n***************************************************************\n"; print "$message\n"; print "***************************************************************\n"; remove_complete_directory($savetemppath, 1); print "\n" . get_time_string(); exit(-1); } ################################################################################# # Unpacking cabinet files with expand ################################################################################# sub unpack_cabinet_file { my ($cabfilename, $unpackdir) = @_; my $expandfile = "expand.exe"; # has to be in the PATH # expand.exe has to be located in the system directory. # Cygwin has another tool expand.exe, that converts tabs to spaces. This cannot be used of course. # But this wrong expand.exe is typically in the PATH before this expand.exe, to unpack # cabinet files. if ( $^O =~ /cygwin/i ) { $expandfile = $ENV{'SYSTEMROOT'} . "/system32/expand.exe"; # Has to be located in the systemdirectory $expandfile =~ s/\\/\//; if ( ! -f $expandfile ) { exit_program("ERROR: Did not find file $expandfile in the Windows system folder!"); } } my $expandlogfile = $unpackdir . $separator . "expand.log"; # exclude cabinet file # my $systemcall = $cabarc . " -o X " . $mergemodulehash->{'cabinetfile'}; my $systemcall = ""; if ( $^O =~ /cygwin/i ) { my $localunpackdir = qx{cygpath -w "$unpackdir"}; $localunpackdir =~ s/\\/\\\\/g; my $localcabfilename = qx{cygpath -w "$cabfilename"}; $localcabfilename =~ s/\\/\\\\/g; $localcabfilename =~ s/\s*$//g; $systemcall = $expandfile . " " . $localcabfilename . " -F:\* " . $localunpackdir . " \>\/dev\/null 2\>\&1"; } else { $systemcall = $expandfile . " " . $cabfilename . " -F:\* " . $unpackdir . " \> " . $expandlogfile; } my $returnvalue = system($systemcall); if ($returnvalue) { exit_program("ERROR: Could not execute $systemcall !"); } } ################################################################################# # Extracting tables from msi database ################################################################################# sub extract_tables_from_database { my ($fullmsidatabasepath, $workdir, $tablelist) = @_; my $msidb = "msidb.exe"; # Has to be in the path if ( $localmsidbpath ) { $msidb = $localmsidbpath; } my $infoline = ""; my $systemcall = ""; my $returnvalue = ""; if ( $^O =~ /cygwin/i ) { chomp( $fullmsidatabasepath = qx{cygpath -w "$fullmsidatabasepath"} ); # msidb.exe really wants backslashes. (And double escaping because system() expands the string.) $fullmsidatabasepath =~ s/\\/\\\\/g; $workdir =~ s/\\/\\\\/g; # and if there are still slashes, they also need to be double backslash $fullmsidatabasepath =~ s/\//\\\\/g; $workdir =~ s/\//\\\\/g; } # Export of all tables by using "*" $systemcall = $msidb . " -d " . $fullmsidatabasepath . " -f " . $workdir . " -e $tablelist"; print "\nAnalyzing msi database\n"; $returnvalue = system($systemcall); if ($returnvalue) { $infoline = "ERROR: Could not execute $systemcall !\n"; exit_program($infoline); } } ######################################################## # Check, if this installation set contains # internal cabinet files included into the msi # database. ######################################################## sub check_for_internal_cabfiles { my ($cabfilehash) = @_; my $contains_internal_cabfiles = 0; my %allcabfileshash = (); foreach my $filename ( keys %{$cabfilehash} ) { if ( $filename =~ /^\s*\#/ ) # starting with a hash { $contains_internal_cabfiles = 1; # setting real filename without hash as key and name with hash as value my $realfilename = $filename; $realfilename =~ s/^\s*\#//; $allcabfileshash{$realfilename} = $filename; } } return ( $contains_internal_cabfiles, \%allcabfileshash ); } ################################################################# # Exclude all cab files from the msi database. ################################################################# sub extract_cabs_from_database { my ($msidatabase, $allcabfiles) = @_; my $infoline = ""; my $fullsuccess = 1; my $msidb = "msidb.exe"; # Has to be in the path if ( $localmsidbpath ) { $msidb = $localmsidbpath; } my @all_excluded_cabfiles = (); if( $^O =~ /cygwin/i ) { $msidatabase = qx{cygpath -w "$msidatabase"}; $msidatabase =~ s/\\/\\\\/g; $msidatabase =~ s/\s*$//g; } else { # msidb.exe really wants backslashes. (And double escaping because system() expands the string.) $msidatabase =~ s/\//\\\\/g; } foreach my $onefile ( keys %{$allcabfiles} ) { my $systemcall = $msidb . " -d " . $msidatabase . " -x " . $onefile; system($systemcall); push(@all_excluded_cabfiles, $onefile); } \@all_excluded_cabfiles; } ################################################################################ # Collect all DiskIds to the corresponding cabinet files from Media.idt. ################################################################################ sub analyze_media_file { my ($filecontent) = @_; my %diskidhash = (); for ( my $i = 0; $i <= $#{$filecontent}; $i++ ) { if ( $i < 3 ) { next; } if ( ${$filecontent}[$i] =~ /^\s*(.*?)\t(.*?)\t(.*?)\t(.*?)\t(.*?)\t(.*?)\s*$/ ) { my $diskid = $1; my $cabfile = $4; $diskidhash{$cabfile} = $diskid; } } return \%diskidhash; } sub analyze_customaction_file { my ($filecontent) = @_; my $register_extensions_exists = 0; my %table = (); for ( my $i = 0; $i <= $#{$filecontent}; $i++ ) { if ( ${$filecontent}[$i] =~ /^\s*RegisterExtensions\s+/ ) { $register_extensions_exists = 1; last; } } return $register_extensions_exists; } ################################################################################ # Analyzing the content of Directory.idt ################################################################################# sub analyze_directory_file { my ($filecontent) = @_; my %table = (); for ( my $i = 0; $i <= $#{$filecontent}; $i++ ) { if (( $i == 0 ) || ( $i == 1 ) || ( $i == 2 )) { next; } if ( ${$filecontent}[$i] =~ /^\s*(.*?)\t(.*?)\t(.*?)\s*$/ ) { my $dir = $1; my $parent = $2; my $name = $3; if ( $name =~ /^\s*(.*?)\s*\:\s*(.*?)\s*$/ ) { $name = $2; } if ( $name =~ /^\s*(.*?)\s*\|\s*(.*?)\s*$/ ) { $name = $2; } my %helphash = (); $helphash{'Directory_Parent'} = $parent; $helphash{'DefaultDir'} = $name; $table{$dir} = \%helphash; } } return \%table; } ################################################################################# # Analyzing the content of Component.idt ################################################################################# sub analyze_component_file { my ($filecontent) = @_; my %table = (); for ( my $i = 0; $i <= $#{$filecontent}; $i++ ) { if (( $i == 0 ) || ( $i == 1 ) || ( $i == 2 )) { next; } if ( ${$filecontent}[$i] =~ /^\s*(.*?)\t(.*?)\t(.*?)\t(.*?)\t(.*?)\t(.*?)\s*$/ ) { my $component = $1; my $dir = $3; $table{$component} = $dir; } } return \%table; } ################################################################################# # Analyzing the content of File.idt ################################################################################# sub analyze_file_file { my ($filecontent) = @_; my %table = (); my %fileorder = (); my $maxsequence = 0; for ( my $i = 0; $i <= $#{$filecontent}; $i++ ) { if (( $i == 0 ) || ( $i == 1 ) || ( $i == 2 )) { next; } if ( ${$filecontent}[$i] =~ /^\s*(.*?)\t(.*?)\t(.*?)\t(.*?)\t(.*?)\t(.*?)\t(.*?)\t(.*?)\s*$/ ) { my $file = $1; my $comp = $2; my $filename = $3; my $sequence = $8; if ( $filename =~ /^\s*(.*?)\s*\|\s*(.*?)\s*$/ ) { $filename = $2; } my %helphash = (); $helphash{'Component'} = $comp; $helphash{'FileName'} = $filename; $helphash{'Sequence'} = $sequence; $table{$file} = \%helphash; $fileorder{$sequence} = $file; if ( $sequence > $maxsequence ) { $maxsequence = $sequence; } } } return (\%table, \%fileorder, $maxsequence); } #################################################################################### # Recursively creating the directory tree #################################################################################### sub create_directory_tree { my ($parent, $pathcollector, $fulldir, $dirhash) = @_; foreach my $dir ( keys %{$dirhash} ) { if (( $dirhash->{$dir}->{'Directory_Parent'} eq $parent ) && ( $dirhash->{$dir}->{'DefaultDir'} ne "." )) { my $dirname = $dirhash->{$dir}->{'DefaultDir'}; # Create the directory my $newdir = $fulldir . $separator . $dirname; if ( ! -f $newdir ) { mkdir $newdir; } # Saving in collector $pathcollector->{$dir} = $newdir; # Iteration create_directory_tree($dir, $pathcollector, $newdir, $dirhash); } } } #################################################################################### # Creating the directory tree #################################################################################### sub create_directory_structure { my ($dirhash, $targetdir) = @_; print "Creating directories\n"; my %fullpathhash = (); my @startparents = ("TARGETDIR", "INSTALLLOCATION"); foreach $dir (@startparents) { create_directory_tree($dir, \%fullpathhash, $targetdir, $dirhash); } # Also adding the paths of the startparents foreach $dir (@startparents) { if ( ! exists($fullpathhash{$dir}) ) { $fullpathhash{$dir} = $targetdir; } } return \%fullpathhash; } #################################################################################### # Cygwin: Setting privileges for files #################################################################################### sub change_privileges { my ($destfile, $privileges) = @_; my $localcall = "chmod $privileges " . "\"" . $destfile . "\""; system($localcall); } #################################################################################### # Cygwin: Setting privileges for files recursively #################################################################################### sub change_privileges_full { my ($target) = @_; print "Changing privileges\n"; my $localcall = "chmod -R 755 " . "\"" . $target . "\""; system($localcall); } ###################################################### # Creating a new directory with defined privileges ###################################################### sub create_directory_with_privileges { my ($directory, $privileges) = @_; my $returnvalue = 1; my $infoline = ""; if (!(-d $directory)) { my $localprivileges = oct("0".$privileges); # changes "777" to 0777 $returnvalue = mkdir($directory, $localprivileges); if ($returnvalue) { my $localcall = "chmod $privileges $directory \>\/dev\/null 2\>\&1"; system($localcall); } } else { my $localcall = "chmod $privileges $directory \>\/dev\/null 2\>\&1"; system($localcall); } } ###################################################### # Creating a unique directory with pid extension ###################################################### sub create_pid_directory { my ($directory) = @_; $directory =~ s/\Q$separator\E\s*$//; my $pid = $$; # process id my $time = time(); # time $directory = $directory . "_" . $pid . $time; if ( ! -d $directory ) { create_directory($directory); } else { exit_program("ERROR: Directory $directory already exists!"); } return $directory; } #################################################################################### # Copying files into installation set #################################################################################### sub copy_files_into_directory_structure { my ($fileorder, $filehash, $componenthash, $fullpathhash, $maxsequence, $unpackdir, $installdir, $dirhash) = @_; print "Copying files\n"; my $unopkgfile = ""; for ( my $i = 1; $i <= $maxsequence; $i++ ) { if ( exists($fileorder->{$i}) ) { my $file = $fileorder->{$i}; if ( ! exists($filehash->{$file}->{'Component'}) ) { exit_program("ERROR: Did not find component for file: \"$file\"."); } my $component = $filehash->{$file}->{'Component'}; if ( ! exists($componenthash->{$component}) ) { exit_program("ERROR: Did not find directory for component: \"$component\"."); } my $dirname = $componenthash->{$component}; if ( ! exists($fullpathhash->{$dirname}) ) { exit_program("ERROR: Did not find full directory path for dir: \"$dirname\"."); } my $destdir = $fullpathhash->{$dirname}; if ( ! exists($filehash->{$file}->{'FileName'}) ) { exit_program("ERROR: Did not find \"FileName\" for file: \"$file\"."); } my $destfile = $filehash->{$file}->{'FileName'}; $destfile = $destdir . $separator . $destfile; my $sourcefile = $unpackdir . $separator . $file; if ( ! -f $sourcefile ) { # It is possible, that this was an unpacked file # Looking in the dirhash, to find the subdirectory in the installation set (the id is $dirname) # subdir is not recursively analyzed, only one directory. my $oldsourcefile = $sourcefile; my $subdir = ""; if ( exists($dirhash->{$dirname}->{'DefaultDir'}) ) { $subdir = $dirhash->{$dirname}->{'DefaultDir'} . $separator; } my $realfilename = $filehash->{$file}->{'FileName'}; my $localinstalldir = $installdir; $localinstalldir =~ s/\\\s*$//; $localinstalldir =~ s/\/\s*$//; $sourcefile = $localinstalldir . $separator . $subdir . $realfilename; if ( ! -f $sourcefile ) { exit_program("ERROR: File not found: \"$oldsourcefile\" (or \"$sourcefile\")."); } } my $copyreturn = copy($sourcefile, $destfile); if ( ! $copyreturn) { exit_program("ERROR: Could not copy $source to $dest\n"); } # Searching unopkg.exe if ( $destfile =~ /unopkg\.exe\s*$/ ) { $unopkgfile = $destfile; } # if (( $^O =~ /cygwin/i ) && ( $destfile =~ /\.exe\s*$/ )) { change_privileges($destfile, "775"); } } # else # allowing missing sequence numbers ? # { # exit_program("ERROR: No file assigned to sequence $i"); # } } return ($unopkgfile); } ###################################################### # Removing a complete directory with subdirectories ###################################################### sub remove_complete_directory { my ($directory, $start) = @_; my @content = (); my $infoline = ""; $directory =~ s/\Q$separator\E\s*$//; if ( -d $directory ) { if ( $start ) { print "Removing directory $directory\n"; } opendir(DIR, $directory); @content = readdir(DIR); closedir(DIR); my $oneitem; foreach $oneitem (@content) { if ((!($oneitem eq ".")) && (!($oneitem eq ".."))) { my $item = $directory . $separator . $oneitem; if ( -f $item || -l $item ) # deleting files or links { unlink($item); } if ( -d $item ) # recursive { remove_complete_directory($item, 0); } } } # try to remove empty directory my $returnvalue = rmdir $directory; if ( ! $returnvalue ) { print "Warning: Problem with removing empty dir $directory\n"; } } } #################################################################################### # Defining a temporary path #################################################################################### sub get_temppath { my $temppath = ""; if (( $ENV{'TMP'} ) || ( $ENV{'TEMP'} )) { if ( $ENV{'TMP'} ) { $temppath = $ENV{'TMP'}; } elsif ( $ENV{'TEMP'} ) { $temppath = $ENV{'TEMP'}; } $temppath =~ s/\Q$separator\E\s*$//; # removing ending slashes and backslashes $temppath = $temppath . $separator . $globaltempdirname; create_directory_with_privileges($temppath, "777"); my $dirsave = $temppath; $temppath = $temppath . $separator . "a"; $temppath = create_pid_directory($temppath); if ( ! -d $temppath ) { exit_program("ERROR: Failed to create directory $temppath ! Possible reason: Wrong privileges in directory $dirsave."); } if ( $^O =~ /cygwin/i ) { $temppath =~ s/\\/\\\\/g; chomp( $temppath = qx{cygpath -w "$temppath"} ); } $savetemppath = $temppath; } else { exit_program("ERROR: Could not set temporary directory (TMP and TEMP not set!)."); } return $temppath; } #################################################################################### # Registering extensions #################################################################################### sub register_extensions_sync { my ($unopkgfile, $localtemppath, $preregdir) = @_; if ( $preregdir eq "" ) { my $logtext = "ERROR: Failed to determine \"prereg\" folder for extension registration! Please check your installation set."; print $logtext . "\n"; exit_program($logtext); } my $from = cwd(); my $path = $unopkgfile; get_path_from_fullqualifiedname(\$path); $path =~ s/\\\s*$//; $path =~ s/\/\s*$//; my $executable = $unopkgfile; make_absolute_filename_to_relative_filename(\$executable); chdir($path); if ( ! $path_displayed ) { print "... current dir: $path ...\n"; $path_displayed = 1; } $localtemppath =~ s/\\/\//g; if ( $^O =~ /cygwin/i ) { $executable = "./" . $executable; $preregdir = qx{cygpath -m "$preregdir"}; chomp($preregdir); } $preregdir =~ s/\/\s*$//g; my $systemcall = $executable . " sync --verbose 2\>\&1 |"; print "... $systemcall\n"; my @unopkgoutput = (); open (UNOPKG, $systemcall); while () {push(@unopkgoutput, $_); } close (UNOPKG); my $returnvalue = $?; # $? contains the return value of the systemcall if ($returnvalue) { print "ERROR: Could not execute \"$systemcall\"!\nExitcode: '$returnvalue'\n"; for ( my $j = 0; $j <= $#unopkgoutput; $j++ ) { print "$unopkgoutput[$j]"; } exit_program("ERROR: $systemcall failed!"); } chdir($from); } #################################################################################### # Registering all extensions located in /share/extension/install #################################################################################### sub register_extensions { my ($unopkgfile, $temppath, $preregdir) = @_; print "Registering extensions:\n"; if (( ! -f $unopkgfile ) || ( $unopkgfile eq "" )) { print("WARNING: Could not find unopkg.exe (Language Pack?)!\n"); } else { register_extensions_sync($unopkgfile, $temppath, $preregdir); remove_complete_directory($temppath, 1); } } #################################################################################### # Reading one file #################################################################################### sub read_file { my ($localfile) = @_; my @localfile = (); open( IN, "<$localfile" ) || exit_program("ERROR: Cannot open file $localfile for reading"); # Don't use "my @localfile = " here, because # perl has a problem with the internal "large_and_huge_malloc" function # when calling perl using MacOS 10.5 with a perl built with MacOS 10.4 while ( $line = ) { push @localfile, $line; } close( IN ); return \@localfile; } ############################################################### # Setting the time string for the # Summary Information stream in the # msi database of the admin installations. ############################################################### sub get_sis_time_string { # Syntax: my $second = (localtime())[0]; my $minute = (localtime())[1]; my $hour = (localtime())[2]; my $day = (localtime())[3]; my $month = (localtime())[4]; my $year = 1900 + (localtime())[5]; $month++; if ( $second < 10 ) { $second = "0" . $second; } if ( $minute < 10 ) { $minute = "0" . $minute; } if ( $hour < 10 ) { $hour = "0" . $hour; } if ( $day < 10 ) { $day = "0" . $day; } if ( $month < 10 ) { $month = "0" . $month; } my $timestring = $year . "/" . $month . "/" . $day . " " . $hour . ":" . $minute . ":" . $second; return $timestring; } ############################################################### # Writing content of administrative installations into # Summary Information Stream of msi database. # This is required for example for following # patch processes using Windows Installer service. ############################################################### sub write_sis_info { my ($msidatabase) = @_; print "Setting SIS in msi database\n"; if ( ! -f $msidatabase ) { exit_program("ERROR: Cannot find file $msidatabase"); } my $msiinfo = "msiinfo.exe"; # Has to be in the path my $infoline = ""; my $systemcall = ""; my $returnvalue = ""; # Required setting for administrative installations: # -w 4 (source files are unpacked), wordcount # -s , LastPrinted, Syntax: # -l , LastSavedBy my $wordcount = 4; # Unpacked files my $lastprinted = get_sis_time_string(); my $lastsavedby = "Installer"; my $localmsidatabase = $msidatabase; if( $^O =~ /cygwin/i ) { $localmsidatabase = qx{cygpath -w "$localmsidatabase"}; $localmsidatabase =~ s/\\/\\\\/g; $localmsidatabase =~ s/\s*$//g; } $systemcall = $msiinfo . " " . "\"" . $localmsidatabase . "\"" . " -w " . $wordcount . " -s " . "\"" . $lastprinted . "\"" . " -l $lastsavedby"; $returnvalue = system($systemcall); if ($returnvalue) { $infoline = "ERROR: Could not execute $systemcall !\n"; exit_program($infoline); } } ############################################################### # Convert time string ############################################################### sub convert_timestring { my ($secondstring) = @_; my $timestring = ""; if ( $secondstring < 60 ) # less than a minute { if ( $secondstring < 10 ) { $secondstring = "0" . $secondstring; } $timestring = "00\:$secondstring min\."; } elsif ( $secondstring < 3600 ) { my $minutes = $secondstring / 60; my $seconds = $secondstring % 60; if ( $minutes =~ /(\d*)\.\d*/ ) { $minutes = $1; } if ( $minutes < 10 ) { $minutes = "0" . $minutes; } if ( $seconds < 10 ) { $seconds = "0" . $seconds; } $timestring = "$minutes\:$seconds min\."; } else # more than one hour { my $hours = $secondstring / 3600; my $secondstring = $secondstring % 3600; my $minutes = $secondstring / 60; my $seconds = $secondstring % 60; if ( $hours =~ /(\d*)\.\d*/ ) { $hours = $1; } if ( $minutes =~ /(\d*)\.\d*/ ) { $minutes = $1; } if ( $hours < 10 ) { $hours = "0" . $hours; } if ( $minutes < 10 ) { $minutes = "0" . $minutes; } if ( $seconds < 10 ) { $seconds = "0" . $seconds; } $timestring = "$hours\:$minutes\:$seconds hours"; } return $timestring; } ############################################################### # Returning time string for logging ############################################################### sub get_time_string { my $currenttime = time(); $currenttime = $currenttime - $starttime; $currenttime = convert_timestring($currenttime); $currenttime = localtime() . " \(" . $currenttime . "\)\n"; return $currenttime; } #################################################################################### # Simulating an administrative installation #################################################################################### $starttime = time(); getparameter(); controlparameter(); check_local_msidb(); check_system_path(); my $temppath = get_temppath(); print("\nmsi database: $databasepath\n"); print("Destination directory: $targetdir\n" ); my $helperdir = $temppath . $separator . "installhelper"; create_directory($helperdir); # Get File.idt, Component.idt and Directory.idt from database my $tablelist = "File Directory Component Media CustomAction"; extract_tables_from_database($databasepath, $helperdir, $tablelist); # Set unpackdir my $unpackdir = $helperdir . $separator . "unpack"; create_directory($unpackdir); # Reading media table to check for internal cabinet files my $filename = $helperdir . $separator . "Media.idt"; if ( ! -f $filename ) { exit_program("ERROR: Could not find required file: $filename !"); } my $filecontent = read_file($filename); my $cabfilehash = analyze_media_file($filecontent); # Check, if there are internal cab files my ( $contains_internal_cabfiles, $all_internal_cab_files) = check_for_internal_cabfiles($cabfilehash); if ( $contains_internal_cabfiles ) { # Set unpackdir my $cabdir = $helperdir . $separator . "internal_cabs"; create_directory($cabdir); my $from = cwd(); chdir($cabdir); # Exclude all cabinet files from database my $all_excluded_cabs = extract_cabs_from_database($databasepath, $all_internal_cab_files); print "Unpacking files from internal cabinet file(s)\n"; foreach my $cabfile ( @{$all_excluded_cabs} ) { unpack_cabinet_file($cabfile, $unpackdir); } chdir($from); } # Unpack all cab files into $helperdir, cab files must be located next to msi database my $installdir = $databasepath; get_path_from_fullqualifiedname(\$installdir); my $databasefilename = $databasepath; make_absolute_filename_to_relative_filename(\$databasefilename); my $cabfiles = find_file_with_file_extension("cab", $installdir); if (( $#{$cabfiles} < 0 ) && ( ! $contains_internal_cabfiles )) { exit_program("ERROR: Did not find any cab file in directory $installdir"); } print "Unpacking files from cabinet file(s)\n"; for ( my $i = 0; $i <= $#{$cabfiles}; $i++ ) { my $cabfile = $installdir . $separator . ${$cabfiles}[$i]; unpack_cabinet_file($cabfile, $unpackdir); } # Reading tables $filename = $helperdir . $separator . "Directory.idt"; $filecontent = read_file($filename); my $dirhash = analyze_directory_file($filecontent); $filename = $helperdir . $separator . "Component.idt"; $filecontent = read_file($filename); my $componenthash = analyze_component_file($filecontent); $filename = $helperdir . $separator . "File.idt"; $filecontent = read_file($filename); my ( $filehash, $fileorder, $maxsequence ) = analyze_file_file($filecontent); # Creating the directory structure my $fullpathhash = create_directory_structure($dirhash, $targetdir); # Copying files my ($unopkgfile) = copy_files_into_directory_structure($fileorder, $filehash, $componenthash, $fullpathhash, $maxsequence, $unpackdir, $installdir, $dirhash); if ( $^O =~ /cygwin/i ) { change_privileges_full($targetdir); } my $msidatabase = $targetdir . $separator . $databasefilename; my $copyreturn = copy($databasepath, $msidatabase); if ( ! $copyreturn) { exit_program("ERROR: Could not copy $source to $dest\n"); } # Reading tables $filename = $helperdir . $separator . "CustomAction.idt"; $filecontent = read_file($filename); my $register_extensions_exists = analyze_customaction_file($filecontent); # Removing empty dirs in extension folder my ( $extensionfolder, $preregdir ) = get_extensions_dir($unopkgfile); if ( -d $extensionfolder ) { remove_empty_dirs_in_folder($extensionfolder, 1); } if ( $register_extensions_exists ) { # Registering extensions register_extensions($unopkgfile, $temppath, $preregdir); } # Saving info in Summary Information Stream of msi database (required for following patches) if ( $msiinfo_available ) { write_sis_info($msidatabase); } # Removing the helper directory remove_complete_directory($temppath, 1); print "\nSuccessful installation: " . get_time_string();