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