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