solenv/bin/modules/installer/windows/file.pm

   1 #
   2 # This file is part of the LibreOffice project.
   3 #
   4 # This Source Code Form is subject to the terms of the Mozilla Public
   5 # License, v. 2.0. If a copy of the MPL was not distributed with this
   6 # file, You can obtain one at http://mozilla.org/MPL/2.0/.
   7 #
   8 # This file incorporates work covered by the following license notice:
   9 #
  10 #   Licensed to the Apache Software Foundation (ASF) under one or more
  11 #   contributor license agreements. See the NOTICE file distributed
  12 #   with this work for additional information regarding copyright
  13 #   ownership. The ASF licenses this file to you under the Apache
  14 #   License, Version 2.0 (the "License"); you may not use this file
  15 #   except in compliance with the License. You may obtain a copy of
  16 #   the License at http://www.apache.org/licenses/LICENSE-2.0 .
  17 #
  18
  19 package installer::windows::file;
  20
  21 use strict;
  22 use warnings;
  23
  24 use Digest::MD5;
  25 use installer::exiter;
  26 use installer::files;
  27 use installer::globals;
  28 use installer::logger;
  29 use installer::pathanalyzer;
  30 use installer::worker;
  31 use installer::windows::font;
  32 use installer::windows::idtglobal;
  33 use installer::windows::msiglobal;
  34 use installer::windows::language;
  35 use installer::windows::component;
  36
  37 ##########################################################################
  38 # Assigning one cabinet file to each file. This is required,
  39 # if cabinet files shall be equivalent to packages.
  40 ##########################################################################
  41
  42 sub assign_cab_to_files
  43 {
  44     my ( $filesref ) = @_;
  45
  46     my $infoline = "";
  47
  48     for ( my $i = 0; $i <= $#{$filesref}; $i++ )
  49     {
  50         if ( ! exists(${$filesref}[$i]->{'modules'}) ) { installer::exiter::exit_program("ERROR: No module assignment found for ${$filesref}[$i]->{'gid'} !", "assign_cab_to_files"); }
  51         my $module = ${$filesref}[$i]->{'modules'};
  52         # If modules contains a list of modules, only taking the first one.
  53         if ( $module =~ /^\s*(.*?)\,/ ) { $module = $1; }
  54
  55         if ( ! exists($installer::globals::allcabinetassigns{$module}) ) { installer::exiter::exit_program("ERROR: No cabinet file assigned to module \"$module\" (${$filesref}[$i]->{'gid'}) !", "assign_cab_to_files"); }
  56         ${$filesref}[$i]->{'assignedcabinetfile'} = $installer::globals::allcabinetassigns{$module};
  57
  58         # Counting the files in each cabinet file
  59         if ( ! exists($installer::globals::cabfilecounter{${$filesref}[$i]->{'assignedcabinetfile'}}) )
  60         {
  61             $installer::globals::cabfilecounter{${$filesref}[$i]->{'assignedcabinetfile'}} = 1;
  62         }
  63         else
  64         {
  65             $installer::globals::cabfilecounter{${$filesref}[$i]->{'assignedcabinetfile'}}++;
  66         }
  67     }
  68
  69     # logging the number of files in each cabinet file
  70
  71     $infoline = "\nCabinet file content:\n";
  72     push(@installer::globals::logfileinfo, $infoline);
  73     my $cabfile;
  74     foreach $cabfile ( sort keys %installer::globals::cabfilecounter )
  75     {
  76         $infoline = "$cabfile : $installer::globals::cabfilecounter{$cabfile} files\n";
  77         push(@installer::globals::logfileinfo, $infoline);
  78     }
  79
  80     # assigning startsequencenumbers for each cab file
  81
  82     my $offset = 1;
  83     foreach $cabfile ( sort keys %installer::globals::cabfilecounter )
  84     {
  85         my $filecount = $installer::globals::cabfilecounter{$cabfile};
  86         $installer::globals::cabfilecounter{$cabfile} = $offset;
  87         $offset = $offset + $filecount;
  88
  89         $installer::globals::lastsequence{$cabfile} = $offset - 1;
  90     }
  91
  92     # logging the start sequence numbers
  93
  94     $infoline = "\nCabinet file start sequences:\n";
  95     push(@installer::globals::logfileinfo, $infoline);
  96     foreach $cabfile ( sort keys %installer::globals::cabfilecounter )
  97     {
  98         $infoline = "$cabfile : $installer::globals::cabfilecounter{$cabfile}\n";
  99         push(@installer::globals::logfileinfo, $infoline);
 100     }
 101
 102     # logging the last sequence numbers
 103
 104     $infoline = "\nCabinet file last sequences:\n";
 105     push(@installer::globals::logfileinfo, $infoline);
 106     foreach $cabfile ( sort keys %installer::globals::lastsequence )
 107     {
 108         $infoline = "$cabfile : $installer::globals::lastsequence{$cabfile}\n";
 109         push(@installer::globals::logfileinfo, $infoline);
 110     }
 111 }
 112
 113 ##########################################################################
 114 # Assigning sequencenumbers to files. This is required,
 115 # if cabinet files shall be equivalent to packages.
 116 ##########################################################################
 117
 118 sub assign_sequencenumbers_to_files
 119 {
 120     my ( $filesref ) = @_;
 121
 122     my %directaccess = ();
 123     my %allassigns = ();
 124
 125     for ( my $i = 0; $i <= $#{$filesref}; $i++ )
 126     {
 127         my $onefile = ${$filesref}[$i];
 128
 129         # Keeping order in cabinet files
 130         # -> collecting all files in one cabinet file
 131         # -> sorting files and assigning numbers
 132
 133         # Saving counter $i for direct access into files array
 134         # "destination" of the file is a unique identifier ('Name' is not unique!)
 135         if ( exists($directaccess{$onefile->{'destination'}}) ) { installer::exiter::exit_program("ERROR: 'destination' at file not unique: $onefile->{'destination'}", "assign_sequencenumbers_to_files"); }
 136         $directaccess{$onefile->{'destination'}} = $i;
 137
 138         my $cabfilename = $onefile->{'assignedcabinetfile'};
 139         # collecting files in cabinet files
 140         if ( ! exists($allassigns{$cabfilename}) )
 141         {
 142             my %onecabfile = ();
 143             $onecabfile{$onefile->{'destination'}} = 1;
 144             $allassigns{$cabfilename} = \%onecabfile;
 145         }
 146         else
 147         {
 148             $allassigns{$cabfilename}->{$onefile->{'destination'}} = 1;
 149         }
 150     }
 151
 152     # Sorting each hash and assigning numbers
 153     # The destination of the file determines the sort order, not the filename!
 154     my $cabfile;
 155     foreach $cabfile ( sort keys %allassigns )
 156     {
 157         my $counter = $installer::globals::cabfilecounter{$cabfile};
 158         my $dest;
 159         foreach $dest ( sort keys %{$allassigns{$cabfile}} ) # <- sorting the destination!
 160         {
 161             my $directaccessnumber = $directaccess{$dest};
 162             ${$filesref}[$directaccessnumber]->{'assignedsequencenumber'} = $counter;
 163             $counter++;
 164         }
 165     }
 166 }
 167
 168 #########################################################
 169 # Create a shorter version of a long component name,
 170 # because maximum length in msi database is 72.
 171 # Attention: In multi msi installation sets, the short
 172 # names have to be unique over all packages, because
 173 # this string is used to create the globally unique id
 174 # -> no resetting of
 175 # %installer::globals::allshortcomponents
 176 # after a package was created.
 177 # Using no counter because of reproducibility.
 178 #########################################################
 179
 180 sub generate_new_short_componentname
 181 {
 182     my ($componentname) = @_;
 183
 184     my $startversion = substr($componentname, 0, 60); # taking only the first 60 characters
 185     my $subid = installer::windows::msiglobal::calculate_id($componentname, 9); # taking only the first 9 digits
 186     my $shortcomponentname = $startversion . "_" . $subid;
 187
 188     if ( exists($installer::globals::allshortcomponents{$shortcomponentname}) ) { installer::exiter::exit_program("Failed to create unique component name: \"$shortcomponentname\"", "generate_new_short_componentname"); }
 189
 190     $installer::globals::allshortcomponents{$shortcomponentname} = 1;
 191
 192     return $shortcomponentname;
 193 }
 194
 195 ###############################################
 196 # Generating the component name from a file
 197 ###############################################
 198
 199 sub get_file_component_name
 200 {
 201     my ($fileref, $filesref) = @_;
 202
 203     my $componentname = "";
 204
 205     # Special handling for files with ASSIGNCOMPONENT
 206
 207     my $styles = "";
 208     if ( $fileref->{'Styles'} ) { $styles = $fileref->{'Styles'}; }
 209     if ( $styles =~ /\bASSIGNCOMPONENT\b/ )
 210     {
 211         $componentname = get_component_from_assigned_file($fileref->{'AssignComponent'}, $filesref);
 212     }
 213     else
 214     {
 215         # In this function exists the rule to create components from files
 216         # Rule:
 217         # Two files get the same componentid, if:
 218         # both have the same destination directory.
 219         # both have the same "gid" -> both were packed in the same zip file
 220         # All other files are included into different components!
 221
 222         # my $componentname = $fileref->{'gid'} . "_" . $fileref->{'Dir'};
 223
 224         # $fileref->{'Dir'} is not sufficient! All files in a zip file have the same $fileref->{'Dir'},
 225         # but can be in different subdirectories.
 226         # Solution: destination=share\Scripts\beanshell\Capitalise\capitalise.bsh
 227         # in which the filename (capitalise.bsh) has to be removed and all backslashes (slashes) are
 228         # converted into underline.
 229
 230         my $destination = $fileref->{'destination'};
 231         installer::pathanalyzer::get_path_from_fullqualifiedname(\$destination);
 232         $destination =~ s/\s//g;
 233         $destination =~ s/\\/\_/g;
 234         $destination =~ s/\//\_/g;
 235         $destination =~ s/\_\s*$//g;    # removing ending underline
 236
 237         $componentname = $fileref->{'gid'} . "__" . $destination;
 238
 239         # Files with different languages, need to be packed into different components.
 240         # Then the installation of the language specific component is determined by a language condition.
 241
 242         if ( $fileref->{'ismultilingual'} )
 243         {
 244             my $officelanguage = $fileref->{'specificlanguage'};
 245             $componentname = $componentname . "_" . $officelanguage;
 246         }
 247
 248         $componentname = lc($componentname);    # componentnames always lowercase
 249
 250         $componentname =~ s/\-/\_/g;            # converting "-" to "_"
 251         $componentname =~ s/\./\_/g;            # converting "." to "_"
 252         $componentname =~ s/\@/\_/g;            # converting "@" to "_"
 253
 254         # Attention: Maximum length for the componentname is 72
 255         # %installer::globals::allcomponents_in_this_database : reset for each database
 256         # %installer::globals::allcomponents : not reset for each database
 257         # Component strings must be unique for the complete product, because they are used for
 258         # the creation of the globally unique identifier.
 259
 260         my $fullname = $componentname;  # This can be longer than 72
 261
 262         if (( exists($installer::globals::allcomponents{$fullname}) ) && ( ! exists($installer::globals::allcomponents_in_this_database{$fullname}) ))
 263         {
 264             # This is not allowed: One component cannot be installed with different packages.
 265             installer::exiter::exit_program("ERROR: Component \"$fullname\" is already included into another package. This is not allowed.", "get_file_component_name");
 266         }
 267
 268         if ( exists($installer::globals::allcomponents{$fullname}) )
 269         {
 270             $componentname = $installer::globals::allcomponents{$fullname};
 271         }
 272         else
 273         {
 274             if ( length($componentname) > 70 )
 275             {
 276                 $componentname = generate_new_short_componentname($componentname); # This has to be unique for the complete product, not only one package
 277             }
 278
 279             $installer::globals::allcomponents{$fullname} = $componentname;
 280             $installer::globals::allcomponents_in_this_database{$fullname} = 1;
 281         }
 282
 283         # $componentname =~ s/gid_file_/g_f_/g;
 284         # $componentname =~ s/_extra_/_e_/g;
 285         # $componentname =~ s/_config_/_c_/g;
 286         # $componentname =~ s/_org_openoffice_/_o_o_/g;
 287         # $componentname =~ s/_program_/_p_/g;
 288         # $componentname =~ s/_typedetection_/_td_/g;
 289         # $componentname =~ s/_linguistic_/_l_/g;
 290         # $componentname =~ s/_module_/_m_/g;
 291         # $componentname =~ s/_optional_/_opt_/g;
 292         # $componentname =~ s/_packages/_pack/g;
 293         # $componentname =~ s/_menubar/_mb/g;
 294         # $componentname =~ s/_common_/_cm_/g;
 295         # $componentname =~ s/_export_/_exp_/g;
 296         # $componentname =~ s/_table_/_tb_/g;
 297         # $componentname =~ s/_sofficecfg_/_sc_/g;
 298         # $componentname =~ s/_soffice_cfg_/_sc_/g;
 299         # $componentname =~ s/_startmodulecommands_/_smc_/g;
 300         # $componentname =~ s/_drawimpresscommands_/_dic_/g;
 301         # $componentname =~ s/_basiccommands_/_bac_/g;
 302         # $componentname =~ s/_basicidecommands_/_baic_/g;
 303         # $componentname =~ s/_genericcommands_/_genc_/g;
 304         # $componentname =~ s/_bibliographycommands_/_bibc_/g;
 305         # $componentname =~ s/_gentiumbookbasicbolditalic_/_gbbbi_/g;
 306         # $componentname =~ s/_share_/_s_/g;
 307         # $componentname =~ s/_extension_/_ext_/g;
 308         # $componentname =~ s/_extensions_/_exs_/g;
 309         # $componentname =~ s/_modules_/_ms_/g;
 310         # $componentname =~ s/_uiconfig_zip_/_ucz_/g;
 311         # $componentname =~ s/_productivity_/_pr_/g;
 312         # $componentname =~ s/_wizard_/_wz_/g;
 313         # $componentname =~ s/_import_/_im_/g;
 314         # $componentname =~ s/_javascript_/_js_/g;
 315         # $componentname =~ s/_template_/_tpl_/g;
 316         # $componentname =~ s/_tplwizletter_/_twl_/g;
 317         # $componentname =~ s/_beanshell_/_bs_/g;
 318         # $componentname =~ s/_presentation_/_bs_/g;
 319         # $componentname =~ s/_columns_/_cls_/g;
 320         # $componentname =~ s/_python_/_py_/g;
 321
 322         # $componentname =~ s/_tools/_ts/g;
 323         # $componentname =~ s/_transitions/_trs/g;
 324         # $componentname =~ s/_scriptbinding/_scrb/g;
 325         # $componentname =~ s/_spreadsheet/_ssh/g;
 326         # $componentname =~ s/_publisher/_pub/g;
 327         # $componentname =~ s/_presenter/_pre/g;
 328         # $componentname =~ s/_registry/_reg/g;
 329
 330         # $componentname =~ s/screen/sc/g;
 331         # $componentname =~ s/wordml/wm/g;
 332         # $componentname =~ s/openoffice/oo/g;
 333     }
 334
 335     return $componentname;
 336 }
 337
 338 ####################################################################
 339 # Returning the component name for a defined file gid.
 340 # This is necessary for files with flag ASSIGNCOMPONENT
 341 ####################################################################
 342
 343 sub get_component_from_assigned_file
 344 {
 345     my ($gid, $filesref) = @_;
 346
 347     my ($onefile) = grep {$_->{gid} eq $gid} @{$filesref};
 348     if (! defined $onefile) {
 349         installer::exiter::exit_program("ERROR: Could not find file $gid in list of files!", "get_component_from_assigned_file");
 350     }
 351
 352     my $componentname = "";
 353     if ( $onefile->{'componentname'} ) { $componentname = $onefile->{'componentname'}; }
 354     else { installer::exiter::exit_program("ERROR: No component defined for file: $gid", "get_component_from_assigned_file"); }
 355
 356     return $componentname;
 357 }
 358
 359 ####################################################################
 360 # Generating the special filename for the database file File.idt
 361 # Sample: CONTEXTS, CONTEXTS1
 362 # This name has to be unique.
 363 # In most cases this is simply the filename.
 364 ####################################################################
 365
 366 sub generate_unique_filename_for_filetable
 367 {
 368     my ($fileref, $component, $uniquefilenamehashref) = @_;
 369
 370     # This new filename has to be saved into $fileref, because this is needed to find the source.
 371     # The filename sbasic.idx/OFFSETS is changed to OFFSETS, but OFFSETS is not unique.
 372     # In this procedure names like OFFSETS5 are produced. And exactly this string has to be added to
 373     # the array of all files.
 374
 375     my $uniquefilename = "";
 376     my $counter = 0;
 377
 378     if ( $fileref->{'Name'} ) { $uniquefilename = $fileref->{'Name'}; }
 379
 380     installer::pathanalyzer::make_absolute_filename_to_relative_filename(\$uniquefilename); # making /registry/schema/org/openoffice/VCL.xcs to VCL.xcs
 381
 382     # Reading unique filename with help of "Component_" in File table from old database
 383     if (( $installer::globals::updatedatabase ) && ( exists($uniquefilenamehashref->{"$component/$uniquefilename"}) ))
 384     {
 385         $uniquefilename = $uniquefilenamehashref->{"$component/$uniquefilename"};  # syntax of $value: ($uniquename;$shortname)
 386         if ( $uniquefilename =~ /^\s*(.*?)\;\s*(.*?)\s*$/ ) { $uniquefilename = $1; }
 387         my $lcuniquefilename = lc($uniquefilename);
 388         $installer::globals::alluniquefilenames{$uniquefilename} = 1;
 389         $installer::globals::alllcuniquefilenames{$lcuniquefilename} = 1;
 390         return $uniquefilename;
 391     }
 392     elsif (( $installer::globals::prepare_winpatch ) && ( exists($installer::globals::savedmapping{"$component/$uniquefilename"}) ))
 393     {
 394         # If we have a FTK mapping for this component/file, use it.
 395         $installer::globals::savedmapping{"$component/$uniquefilename"} =~ m/^(.*);/;
 396         $uniquefilename = $1;
 397         my $lcuniquefilename = lc($uniquefilename);
 398         $installer::globals::alluniquefilenames{$uniquefilename} = 1;
 399         $installer::globals::alllcuniquefilenames{$lcuniquefilename} = 1;
 400         return $uniquefilename;
 401     }
 402
 403     $uniquefilename =~ s/\-/\_/g;       # no "-" allowed
 404     $uniquefilename =~ s/\@/\_/g;       # no "@" allowed
 405     $uniquefilename =~ s/\$/\_/g;       # no "$" allowed
 406     $uniquefilename =~ s/^\s*\./\_/g;       # no "." at the beginning allowed
 407     $uniquefilename =~ s/^\s*\d/\_d/g;      # no number at the beginning allowed (even file "0.gif", replacing to "_d.gif")
 408     $uniquefilename =~ s/org_openoffice_/ooo_/g;    # shorten the unique file name
 409
 410     my $lcuniquefilename = lc($uniquefilename); # only lowercase names
 411
 412     my $newname = 0;
 413
 414     if ( ! exists($installer::globals::alllcuniquefilenames{$lcuniquefilename}) &&
 415          ! exists($installer::globals::savedrevmapping{$lcuniquefilename}) )
 416     {
 417         $installer::globals::alluniquefilenames{$uniquefilename} = 1;
 418         $installer::globals::alllcuniquefilenames{$lcuniquefilename} = 1;
 419         $newname = 1;
 420     }
 421
 422     if ( ! $newname )
 423     {
 424         # adding a number until the name is really unique: OFFSETS, OFFSETS1, OFFSETS2, ...
 425         # But attention: Making "abc.xcu" to "abc1.xcu"
 426
 427         my $uniquefilenamebase = $uniquefilename;
 428
 429         do
 430         {
 431             $counter++;
 432
 433             if ( $uniquefilenamebase =~ /\./ )
 434             {
 435                 $uniquefilename = $uniquefilenamebase;
 436                 $uniquefilename =~ s/\./$counter\./;
 437             }
 438             else
 439             {
 440                 $uniquefilename = $uniquefilenamebase . $counter;
 441             }
 442
 443             $newname = 0;
 444             $lcuniquefilename = lc($uniquefilename);    # only lowercase names
 445
 446             if ( ! exists($installer::globals::alllcuniquefilenames{$lcuniquefilename}) &&
 447                  ! exists($installer::globals::savedrevmapping{$lcuniquefilename}) )
 448             {
 449                 $installer::globals::alluniquefilenames{$uniquefilename} = 1;
 450                 $installer::globals::alllcuniquefilenames{$lcuniquefilename} = 1;
 451                 $newname = 1;
 452             }
 453         }
 454         until ( $newname )
 455     }
 456
 457     return $uniquefilename;
 458 }
 459
 460 ####################################################################
 461 # Generating the special file column for the database file File.idt
 462 # Sample: NAMETR~1.TAB|.nametranslation.table
 463 # The first part has to be 8.3 conform.
 464 ####################################################################
 465
 466 sub generate_filename_for_filetable
 467 {
 468     my ($fileref, $shortnamesref, $uniquefilenamehashref) = @_;
 469
 470     my $returnstring = "";
 471
 472     my $filename = $fileref->{'Name'};
 473
 474     installer::pathanalyzer::make_absolute_filename_to_relative_filename(\$filename);   # making /registry/schema/org/openoffice/VCL.xcs to VCL.xcs
 475
 476     my $shortstring;
 477
 478     # Reading short string with help of "FileName" in File table from old database
 479     if (( $installer::globals::updatedatabase ) && ( exists($uniquefilenamehashref->{"$fileref->{'componentname'}/$filename"}) ))
 480     {
 481         my $value = $uniquefilenamehashref->{"$fileref->{'componentname'}/$filename"};  # syntax of $value: ($uniquename;$shortname)
 482         if ( $value =~ /^\s*(.*?)\;\s*(.*?)\s*$/ ) { $shortstring = $2; } # already collected in function "collect_shortnames_from_old_database"
 483         else { $shortstring = $filename; }
 484     }
 485     elsif (( $installer::globals::prepare_winpatch ) && ( exists($installer::globals::savedmapping{"$fileref->{'componentname'}/$filename"}) ))
 486     {
 487         $installer::globals::savedmapping{"$fileref->{'componentname'}/$filename"} =~ m/.*;(.*)/;
 488         if ($1 ne '')
 489         {
 490             $shortstring = $1;
 491         }
 492         else
 493         {
 494             $shortstring = installer::windows::idtglobal::make_eight_three_conform_with_hash($filename, "file", $shortnamesref);
 495         }
 496     }
 497     else
 498     {
 499         $shortstring = installer::windows::idtglobal::make_eight_three_conform_with_hash($filename, "file", $shortnamesref);
 500     }
 501
 502     if ( $shortstring eq $filename ) { $returnstring = $filename; } # nothing changed
 503     else {$returnstring = $shortstring . "\|" . $filename; }
 504
 505     return $returnstring;
 506 }
 507
 508 #########################################
 509 # Returning the filesize of a file
 510 #########################################
 511
 512 sub get_filesize
 513 {
 514     my ($fileref) = @_;
 515
 516     my $file = $fileref->{'sourcepath'};
 517
 518     my $filesize;
 519
 520     if ( -f $file ) # test of existence. For instance services.rdb does not always exist
 521     {
 522         $filesize = ( -s $file );   # file size can be "0"
 523     }
 524     else
 525     {
 526         $filesize = -1;
 527     }
 528
 529     return $filesize;
 530 }
 531
 532 #############################################
 533 # Returning the file version, if required
 534 # Sample: "8.0.1.8976";
 535 #############################################
 536
 537 sub get_fileversion
 538 {
 539     my ($onefile, $allvariables, $styles) = @_;
 540
 541     my $fileversion = "";
 542
 543     if ( $onefile->{'Name'} =~ /\.bin$|\.com$|\.dll$|\.exe$|\.pyd$/ )
 544     {
 545         open (EXE, "<$onefile->{'sourcepath'}");
 546         binmode EXE;
 547         my $exedata;
 548         {local $/ = undef; $exedata = <EXE>;}
 549         close EXE;
 550
 551         my $binaryfileversion = "(V\x00S\x00_\x00V\x00E\x00R\x00S\x00I\x00O\x00N\x00_\x00I\x00N\x00F\x00O\x00\x00\x00\x00\x00\xbd\x04\xef\xfe\x00\x00\x01\x00)(........)";
 552
 553         if ($exedata =~ /$binaryfileversion/ms)
 554         {
 555             my ($header, $subversion, $version, $vervariant, $microversion) = ($1,unpack( "vvvv", $2));
 556             $fileversion = $version . "." . $subversion . "." . $microversion . "." . $vervariant;
 557         }
 558     }
 559     # file version for font files (tdf#76239)
 560     if ( $onefile->{'Name'} =~ /\.(otf|ttf|ttc)$/i )
 561     {
 562         require Font::TTF::Font;
 563         Font::TTF::Font->import;
 564         my $fnt = Font::TTF::Font->open("<$onefile->{'sourcepath'}");
 565         # 5 is pre-defined name ID for version string - see
 566         # https://docs.microsoft.com/en-us/typography/opentype/spec/name
 567         my $ttfdata = $fnt->{'name'}->read->find_name(5);
 568         $fnt->release;
 569
 570         if ($ttfdata =~ /(Version )?([0-9]+(\.[0-9]+)*)/i)
 571         {
 572             my ($version, $subversion, $microversion, $vervariant) = split(/\./,$2);
 573             $subversion = 0 if not defined $subversion;
 574             $microversion = 0 if not defined $microversion;
 575             $vervariant = 0 if not defined $vervariant;
 576             $fileversion = int($version) . "." . int($subversion) . "." . int($microversion) . "." . int($vervariant);
 577         }
 578         else
 579         {
 580             $fileversion = "1.0.0.0";
 581         }
 582     }
 583
 584     return $fileversion;
 585 }
 586
 587 #############################################
 588 # Returning the sequence for a file
 589 #############################################
 590
 591 sub get_sequence_for_file
 592 {
 593     my ($number, $onefile, $fileentry, $allupdatesequenceshashref, $allupdatecomponentshashref, $allupdatefileorderhashref, $allfilecomponents) = @_;
 594
 595     my $sequence = "";
 596     my $infoline = "";
 597     my $pffcomponentname = $onefile->{'componentname'} . "_pff";
 598
 599     if ( $installer::globals::updatedatabase )
 600     {
 601         if (( exists($allupdatesequenceshashref->{$onefile->{'uniquename'}}) ) &&
 602             (( $onefile->{'componentname'} eq $allupdatecomponentshashref->{$onefile->{'uniquename'}} ) ||
 603              ( $pffcomponentname eq $allupdatecomponentshashref->{$onefile->{'uniquename'}} )))
 604         {
 605             # The second condition is necessary to find shifted files, that have same "uniquename", but are now
 606             # located in another directory. This can be seen at the component name.
 607             $sequence = $allupdatesequenceshashref->{$onefile->{'uniquename'}};
 608             $onefile->{'assignedsequencenumber'} = $sequence;
 609             # Collecting all used sequences, to guarantee, that no number is unused
 610             $installer::globals::allusedupdatesequences{$sequence} = 1;
 611             # Special help for files, that already have a "pff" component name (for example after ServicePack 1)
 612             if ( $pffcomponentname eq $allupdatecomponentshashref->{$onefile->{'uniquename'}} )
 613             {
 614                 $infoline = "Warning: Special handling for component \"$pffcomponentname\". This file was added after the final, but before this ServicePack.\n";
 615                 push(@installer::globals::logfileinfo, $infoline);
 616                 $onefile->{'componentname'} = $pffcomponentname; # pff for "post final file"
 617                 $fileentry->{'Component_'} = $onefile->{'componentname'};
 618                 if ( ! exists($allfilecomponents->{$fileentry->{'Component_'}}) ) { $allfilecomponents->{$fileentry->{'Component_'}} = 1; }
 619             }
 620         }
 621         else
 622         {
 623             $installer::globals::updatesequencecounter++;
 624             $sequence = $installer::globals::updatesequencecounter;
 625             $onefile->{'assignedsequencenumber'} = $sequence;
 626             # $onefile->{'assignedcabinetfile'} = $installer::globals::pffcabfilename; # assigning to cabinet file for "post final files"
 627             # Collecting all new files
 628             $installer::globals::newupdatefiles{$sequence} = $onefile;
 629             # Saving in sequence hash
 630             $allupdatefileorderhashref->{$sequence} = $onefile->{'uniquename'};
 631
 632             # If the new file is part of an existing component, this must be changed now. All files
 633             # of one component have to be included in one cabinet file. But because the order must
 634             # not change, all new files have to be added to new components.
 635             # $onefile->{'componentname'} = $file{'Component_'};
 636
 637             $onefile->{'componentname'} = $onefile->{'componentname'} . "_pff"; # pff for "post final file"
 638             $fileentry->{'Component_'} = $onefile->{'componentname'};
 639             if ( ! exists($allfilecomponents->{$fileentry->{'Component_'}}) ) { $allfilecomponents->{$fileentry->{'Component_'}} = 1; }
 640             $onefile->{'PostFinalFile'} = 1;
 641             # The sequence for this file has changed. It has to be inserted at the end of the files collector.
 642             $installer::globals::insert_file_at_end = 1;
 643             $installer::globals::newfilescollector{$sequence} = $onefile; # Adding new files to the end of the filescollector
 644             $installer::globals::newfilesexist = 1;
 645         }
 646     }
 647     else
 648     {
 649         $sequence = $number;
 650         # my $sequence = $number + 1;
 651
 652         # Idea: Each component is packed into a cab file.
 653         # This requires that all files in one cab file have sequences directly following each other,
 654         # for instance from 1456 to 1466. Then in the media table the LastSequence for this cab file
 655         # is 1466.
 656         # Because all files belonging to one component are directly behind each other in the file
 657         # collector, it is possible to use simply an increasing number as sequence value.
 658         # If files belonging to one component are not directly behind each other in the files collector
 659         # this mechanism will no longer work.
 660     }
 661
 662     return $sequence;
 663 }
 664
 665 #############################################
 666 # Returning the Windows language of a file
 667 #############################################
 668
 669 sub get_language_for_file
 670 {
 671     my ($fileref) = @_;
 672
 673     my $language = "";
 674
 675     if ( $fileref->{'specificlanguage'} ) { $language = $fileref->{'specificlanguage'}; }
 676
 677     if ( $language eq "" )
 678     {
 679         $language = 0;  # language independent
 680         # If this is not a font, the return value should be "0" (Check ICE 60)
 681         my $styles = "";
 682         if ( $fileref->{'Styles'} ) { $styles = $fileref->{'Styles'}; }
 683         if ( $styles =~ /\bFONT\b/ ) { $language = ""; }
 684     }
 685     else
 686     {
 687         $language = installer::windows::language::get_windows_language($language);
 688     }
 689
 690     return $language;
 691 }
 692
 693 ####################################################################
 694 # Creating a new KeyPath for components in TemplatesFolder.
 695 ####################################################################
 696
 697 sub generate_registry_keypath
 698 {
 699     my ($onefile) = @_;
 700
 701     my $keypath = $onefile->{'Name'};
 702     $keypath =~ s/\.//g;
 703     $keypath = lc($keypath);
 704     $keypath = "userreg_" . $keypath;
 705
 706     return $keypath;
 707 }
 708
 709 ####################################################################
 710 # Check, if in an update process files are missing. No removal
 711 # of files allowed for Windows Patch creation.
 712 # Also logging all new files, that have to be included in extra
 713 # components and cab files.
 714 ####################################################################
 715
 716 sub check_file_sequences
 717 {
 718     my ($allupdatefileorderhashref, $allupdatecomponentorderhashref) = @_;
 719
 720     # All used sequences stored in %installer::globals::allusedupdatesequences
 721     # Maximum sequence number of old database stored in $installer::globals::updatelastsequence
 722     # All new files stored in %installer::globals::newupdatefiles
 723
 724     my $infoline = "";
 725
 726     my @missing_sequences = ();
 727     my @really_missing_sequences = ();
 728
 729     for ( my $i = 1; $i <= $installer::globals::updatelastsequence; $i++ )
 730     {
 731         if ( ! exists($installer::globals::allusedupdatesequences{$i}) ) { push(@missing_sequences, $i); }
 732     }
 733
 734     if ( $#missing_sequences > -1 )
 735     {
 736         # Missing sequences can also be caused by files included in merge modules. This files are added later into the file table.
 737         # Therefore now it is time to check the content of the merge modules.
 738
 739         for ( my $j = 0; $j <= $#missing_sequences; $j++ )
 740         {
 741             my $filename = $allupdatefileorderhashref->{$missing_sequences[$j]};
 742
 743             # Is this a file from a merge module? Then this is no error.
 744             if ( ! exists($installer::globals::mergemodulefiles{$filename}) )
 745             {
 746                 push(@really_missing_sequences, $missing_sequences[$j]);
 747             }
 748         }
 749     }
 750
 751     if ( $#really_missing_sequences > -1 )
 752     {
 753         my $errorstring = "";
 754         for ( my $j = 0; $j <= $#really_missing_sequences; $j++ )
 755         {
 756             my $filename = $allupdatefileorderhashref->{$really_missing_sequences[$j]};
 757             my $comp = $allupdatecomponentorderhashref->{$really_missing_sequences[$j]};
 758             $errorstring = "$errorstring$filename (Sequence: $really_missing_sequences[$j], Component: \"$comp\")\n";
 759         }
 760
 761         $infoline = "ERROR: Files are removed compared with update database.\nThe following files are missing:\n$errorstring";
 762         push(@installer::globals::logfileinfo, $infoline);
 763         installer::exiter::exit_program($infoline, "check_file_sequences");
 764     }
 765
 766     # Searching for new files
 767
 768     my $counter = 0;
 769
 770     foreach my $key ( keys %installer::globals::newupdatefiles )
 771     {
 772         my $onefile = $installer::globals::newupdatefiles{$key};
 773         $counter++;
 774         if ( $counter == 1 )
 775         {
 776             $infoline = "\nNew files compared to the update database:\n";
 777             push(@installer::globals::logfileinfo, $infoline);
 778         }
 779
 780         $infoline = "$onefile->{'Name'} ($onefile->{'gid'}) Sequence: $onefile->{'assignedsequencenumber'}\n";
 781         push(@installer::globals::logfileinfo, $infoline);
 782     }
 783
 784     if ( $counter == 0 )
 785     {
 786         $infoline = "Info: No new file compared with update database!\n";
 787         push(@installer::globals::logfileinfo, $infoline);
 788     }
 789
 790 }
 791
 792 ###################################################################
 793 # Collecting further conditions for the component table.
 794 # This is used by multilayer products, to enable installation
 795 # of separate layers.
 796 ###################################################################
 797
 798 sub get_tree_condition_for_component
 799 {
 800     my ($onefile, $componentname) = @_;
 801
 802     if ( $onefile->{'destination'} )
 803     {
 804         my $dest = $onefile->{'destination'};
 805
 806         # Comparing the destination path with
 807         # $installer::globals::hostnametreestyles{$hostname} = $treestyle;
 808         # (-> hostname is the key, the style the value!)
 809
 810         foreach my $hostname ( keys %installer::globals::hostnametreestyles )
 811         {
 812             if (( $dest eq $hostname ) || ( $dest =~ /^\s*\Q$hostname\E\\/ ))
 813             {
 814                 # the value is the style
 815                 my $style = $installer::globals::hostnametreestyles{$hostname};
 816                 # the condition is saved in %installer::globals::treestyles
 817                 my $condition = $installer::globals::treestyles{$style};
 818                 # Saving condition to be added in table Property
 819                 $installer::globals::usedtreeconditions{$condition} = 1;
 820                 $condition = $condition . "=1";
 821                 # saving this condition
 822                 $installer::globals::treeconditions{$componentname} = $condition;
 823
 824                 # saving also at the file, for usage in fileinfo
 825                 $onefile->{'layer'} = $installer::globals::treelayername{$style};
 826             }
 827         }
 828     }
 829 }
 830
 831 ############################################
 832 # Collecting all short names, that are
 833 # already used by the old database
 834 ############################################
 835
 836 sub collect_shortnames_from_old_database
 837 {
 838     my ($uniquefilenamehashref, $shortnameshashref) = @_;
 839
 840     foreach my $key ( keys %{$uniquefilenamehashref} )
 841     {
 842         my $value = $uniquefilenamehashref->{$key};  # syntax of $value: ($uniquename;$shortname)
 843
 844         if ( $value =~ /^\s*(.*?)\;\s*(.*?)\s*$/ )
 845         {
 846             my $shortstring = $2;
 847             $shortnameshashref->{$shortstring} = 1; # adding the shortname to the array of all shortnames
 848         }
 849     }
 850 }
 851
 852 ############################################
 853 # Creating the file File.idt dynamically
 854 ############################################
 855
 856 sub create_files_table
 857 {
 858     my ($filesref, $dirref, $allfilecomponentsref, $basedir, $allvariables, $uniquefilenamehashref, $allupdatesequenceshashref, $allupdatecomponentshashref, $allupdatefileorderhashref) = @_;
 859
 860     installer::logger::include_timestamp_into_logfile("Performance Info: File Table start");
 861
 862     # Structure of the files table:
 863     # File Component_ FileName FileSize Version Language Attributes Sequence
 864     # In this function, all components are created.
 865     #
 866     # $allfilecomponentsref is empty at the beginning
 867
 868     my $infoline;
 869
 870     my @allfiles = ();
 871     my @filetable = ();
 872     my @filehashtable = ();
 873     my %allfilecomponents = ();
 874     my $counter = 0;
 875
 876     if ( $^O =~ /cygwin/i ) { installer::worker::generate_cygwin_paths($filesref); }
 877
 878     # The filenames must be collected because of uniqueness
 879     # 01-44-~1.DAT, 01-44-~2.DAT, ...
 880     my %shortnames = ();
 881
 882     if ( $installer::globals::updatedatabase ) { collect_shortnames_from_old_database($uniquefilenamehashref, \%shortnames); }
 883
 884     installer::windows::idtglobal::write_idt_header(\@filetable, "file");
 885     installer::windows::idtglobal::write_idt_header(\@filehashtable, "filehash");
 886     installer::windows::idtglobal::write_idt_header(\@installer::globals::removefiletable, "removefile");
 887
 888     for ( my $i = 0; $i <= $#{$filesref}; $i++ )
 889     {
 890         my %file = ();
 891
 892         my $onefile = ${$filesref}[$i];
 893
 894         my $styles = "";
 895         if ( $onefile->{'Styles'} ) { $styles = $onefile->{'Styles'}; }
 896
 897         $file{'Component_'} = get_file_component_name($onefile, $filesref);
 898         $file{'File'} = generate_unique_filename_for_filetable($onefile, $file{'Component_'}, $uniquefilenamehashref);
 899
 900         $onefile->{'uniquename'} = $file{'File'};
 901         $onefile->{'componentname'} = $file{'Component_'};
 902
 903         # Collecting all components
 904
 905         if ( ! exists($allfilecomponents{$file{'Component_'}}) ) { $allfilecomponents{$file{'Component_'}} = 1; }
 906
 907         $file{'FileName'} = generate_filename_for_filetable($onefile, \%shortnames, $uniquefilenamehashref);
 908
 909         $file{'FileSize'} = get_filesize($onefile);
 910
 911         $file{'Version'} = get_fileversion($onefile, $allvariables, $styles);
 912
 913         $file{'Language'} = get_language_for_file($onefile);
 914
 915         if ( $styles =~ /\bDONT_PACK\b/ ) { $file{'Attributes'} = "8192"; }
 916         else { $file{'Attributes'} = "16384"; }
 917
 918         # $file{'Attributes'} = "16384";    # Sourcefile is packed
 919         # $file{'Attributes'} = "8192";     # Sourcefile is unpacked
 920
 921         $installer::globals::insert_file_at_end = 0;
 922         $counter++;
 923         $file{'Sequence'} = get_sequence_for_file($counter, $onefile, \%file, $allupdatesequenceshashref, $allupdatecomponentshashref, $allupdatefileorderhashref, \%allfilecomponents);
 924
 925         $onefile->{'sequencenumber'} = $file{'Sequence'};
 926
 927         my $oneline = $file{'File'} . "\t" . $file{'Component_'} . "\t" . $file{'FileName'} . "\t"
 928                 . $file{'FileSize'} . "\t" . $file{'Version'} . "\t" . $file{'Language'} . "\t"
 929                 . $file{'Attributes'} . "\t" . $file{'Sequence'} . "\n";
 930
 931         push(@filetable, $oneline);
 932
 933         if ( $file{'File'} =~ /\.py$/ )
 934         {
 935             my %removefile = ();
 936
 937             $removefile{'FileKey'} = "remove_" . $file{'File'} . "c";
 938             $removefile{'Component_'} = $file{'Component_'};
 939             $removefile{'FileName'} = $file{'FileName'};
 940             $removefile{'FileName'} =~ s/\.py$/.pyc/;
 941             $removefile{'FileName'} =~ s/\.PY\|/.PYC|/;
 942             $removefile{'DirProperty'} = installer::windows::component::get_file_component_directory($file{'Component_'}, $filesref, $dirref);
 943             $removefile{'InstallMode'} = 2; # msiInstallStateAbsent
 944             $oneline = $removefile{'FileKey'} . "\t" . $removefile{'Component_'} . "\t" . $removefile{'FileName'} . "\t"
 945                         . $removefile{'DirProperty'} . "\t" . $removefile{'InstallMode'} . "\n";
 946
 947             push(@installer::globals::removefiletable, $oneline);
 948         }
 949
 950         if ( ! $installer::globals::insert_file_at_end ) { push(@allfiles, $onefile); }
 951
 952         # Collecting all component conditions
 953         if ( $onefile->{'ComponentCondition'} )
 954         {
 955             if ( ! exists($installer::globals::componentcondition{$file{'Component_'}}))
 956             {
 957                 $installer::globals::componentcondition{$file{'Component_'}} = $onefile->{'ComponentCondition'};
 958             }
 959         }
 960
 961         # Collecting also all tree conditions for multilayer products
 962         get_tree_condition_for_component($onefile, $file{'Component_'});
 963
 964         unless ( $file{'Version'} )
 965         {
 966             my $path = $onefile->{'sourcepath'};
 967             if ( $^O =~ /cygwin/i ) { $path = $onefile->{'cyg_sourcepath'}; }
 968
 969             open(FILE, $path) or die "ERROR: Can't open $path for creating file hash";
 970             binmode(FILE);
 971             my $hashinfo = pack("l", 20);
 972             $hashinfo .= Digest::MD5->new->addfile(*FILE)->digest;
 973
 974             my @i = unpack ('x[l]l4', $hashinfo);
 975             $oneline = $file{'File'} . "\t" .
 976                 "0" . "\t" .
 977                 $i[0] . "\t" .
 978                 $i[1] . "\t" .
 979                 $i[2] . "\t" .
 980                 $i[3] . "\n";
 981             push (@filehashtable, $oneline);
 982         }
 983
 984         # Saving the sequence number in a hash with uniquefilename as key.
 985         # This is used for better performance in "save_packorder"
 986         $installer::globals::uniquefilenamesequence{$onefile->{'uniquename'}} = $onefile->{'sequencenumber'};
 987
 988         my $destdir = "";
 989         if ( $onefile->{'Dir'} ) { $destdir = $onefile->{'Dir'}; }
 990
 991         if ( $onefile->{'needs_user_registry_key'} )
 992         {
 993             my $keypath = generate_registry_keypath($onefile);
 994             $onefile->{'userregkeypath'} = $keypath;
 995             push(@installer::globals::userregistrycollector, $onefile);
 996             $installer::globals::addeduserregitrykeys = 1;
 997         }
 998     }
 999
1000     # putting content from %allfilecomponents to $allfilecomponentsref for later usage
1001     foreach my $localkey (keys %allfilecomponents ) { push( @{$allfilecomponentsref}, $localkey); }
1002
1003     my $filetablename = $basedir . $installer::globals::separator . "File.idt";
1004     installer::files::save_file($filetablename ,\@filetable);
1005     $infoline = "\nCreated idt file: $filetablename\n";
1006     push(@installer::globals::logfileinfo, $infoline);
1007
1008     installer::logger::include_timestamp_into_logfile("Performance Info: File Table end");
1009
1010     my $filehashtablename = $basedir . $installer::globals::separator . "MsiFileHash.idt";
1011     installer::files::save_file($filehashtablename ,\@filehashtable);
1012     $infoline = "\nCreated idt file: $filehashtablename\n";
1013     push(@installer::globals::logfileinfo, $infoline);
1014
1015     # Now the new files can be added to the files collector (only in update packaging processes)
1016     if ( $installer::globals::newfilesexist )
1017     {
1018         foreach my $seq (sort keys %installer::globals::newfilescollector) { push(@allfiles, $installer::globals::newfilescollector{$seq}) }
1019     }
1020
1021     return \@allfiles;
1022 }
1023
1024 1;