solenv/bin/modules/installer/packagepool.pm

   1 #*************************************************************************
   2 #
   3 #   OpenOffice.org - a multi-platform office productivity suite
   4 #
   5 #   $RCSfile: copyproject.pm,v $
   6 #
   7 #   $Revision: 1.8 $
   8 #
   9 #   last change: $Author: obo $ $Date: 2007/07/19 07:16:23 $
  10 #
  11 #   The Contents of this file are made available subject to
  12 #   the terms of GNU Lesser General Public License Version 2.1.
  13 #
  14 #
  15 #     GNU Lesser General Public License Version 2.1
  16 #     =============================================
  17 #     Copyright 2005 by Sun Microsystems, Inc.
  18 #     901 San Antonio Road, Palo Alto, CA 94303, USA
  19 #
  20 #     This library is free software; you can redistribute it and/or
  21 #     modify it under the terms of the GNU Lesser General Public
  22 #     License version 2.1, as published by the Free Software Foundation.
  23 #
  24 #     This library is distributed in the hope that it will be useful,
  25 #     but WITHOUT ANY WARRANTY; without even the implied warranty of
  26 #     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  27 #     Lesser General Public License for more details.
  28 #
  29 #     You should have received a copy of the GNU Lesser General Public
  30 #     License along with this library; if not, write to the Free Software
  31 #     Foundation, Inc., 59 Temple Place, Suite 330, Boston,
  32 #     MA  02111-1307  USA
  33 #
  34 #*************************************************************************
  35
  36 package installer::packagepool;
  37
  38 use Digest::MD5;
  39 use installer::exiter;
  40 use installer::globals;
  41 use installer::logger;
  42 use installer::pathanalyzer;
  43 use installer::worker;
  44
  45 ######################################################
  46 # Checking the md5sum of a file
  47 ######################################################
  48
  49 sub get_md5sum
  50 {
  51     my ($filename) = @_;
  52
  53     open(FILE, "<$filename") or die "ERROR: Can't open $filename for creating file hash";
  54     binmode(FILE);
  55     my $digest = Digest::MD5->new->addfile(*FILE)->hexdigest;
  56     close(FILE);
  57
  58     return $digest;
  59 }
  60
  61 ####################################################
  62 # Setting a unique sessionid to identify this
  63 # packaging process.
  64 ####################################################
  65
  66 sub set_sessionid
  67 {
  68     my $pid = $$;               # process id
  69     my $timer = time(); # time
  70     $installer::globals::sessionid = $pid . $timer;
  71     $installer::globals::sessionidset = 1;
  72     my $infoline = "\nPool: Setting session id: $installer::globals::sessionid.\n";
  73     push( @installer::globals::logfileinfo, $infoline);
  74 }
  75
  76 ####################################################
  77 # Setting and creating pool path.
  78 ####################################################
  79
  80 sub set_pool_path
  81 {
  82     $installer::globals::unpackpath =~ s/\Q$installer::globals::separator\E\s*$//;      # removing ending slashes and backslashes
  83     $installer::globals::poolpath = $installer::globals::unpackpath . $installer::globals::separator . "pool_" . $installer::globals::packageformat;
  84     installer::systemactions::create_directory($installer::globals::poolpath);
  85     $installer::globals::poolpathset = 1;
  86 }
  87
  88 ####################################################
  89 # Comparing the content of two epm files.
  90 ####################################################
  91
  92 sub compare_epm_content
  93 {
  94     my ($oldcontent, $newcontent) = @_;
  95
  96     my $identical = 1;
  97     my $diffinfo = "";
  98
  99     # Removing empty lines and files from $newcontent
 100
 101     my @newlocalcontent = ();
 102     for ( my $i = 0; $i <= $#{$newcontent}; $i++ )
 103     {
 104         if ( ${$newcontent}[$i] =~ /^\s*$/ ) { next; } # Removing empty lines from $newcontent. Empty lines are also not included into pcf file, from where $oldcontent was read.
 105         if ( ${$newcontent}[$i] =~ /^\s*f\s+/ ) { next; } # Ignoring files, they can contain temporary pathes
 106         if (( ${$newcontent}[$i] =~ /^\s*%readme\s+/ ) || ( ${$newcontent}[$i] =~ /^\s*%license\s+/ )) { next; } # ignoring license and readme (language specific!)
 107         my $oneline = ${$newcontent}[$i];
 108         $oneline =~ s/\s*$//; # Removing line ends. Also not included in old epm file, that is read from pcf file.
 109         push(@newlocalcontent, $oneline);
 110     }
 111
 112     my $oldmember = $#{$oldcontent} + 1;
 113     my $newmember = $#newlocalcontent + 1;
 114
 115     # comparing the count
 116     if ( $oldmember != $newmember )
 117     {
 118         $identical = 0;
 119         installer::logger::print_message("\n...... changed length of EPM file\n");
 120         $diffinfo = "Pool: EPM, different line count: old epm file: $oldmember, new epm file: $newmember\n";
 121         push(@installer::globals::epmdifflist, $diffinfo);
 122     }
 123
 124     # comparing the content line for line, so the order must not change
 125
 126     if ( $identical )
 127     {
 128         for ( my $i = 0; $i <= $#{$oldcontent}; $i++ )
 129         {
 130             if ( ${$oldcontent}[$i] ne $newlocalcontent[$i] )
 131             {
 132                 $identical = 0;
 133                 my $line = $i + 1;
 134                 installer::logger::print_message("\n...... different content in EPM file\n");
 135                 $diffinfo = "Pool: EPM, line $line changed from \"${$oldcontent}[$i]\" to \"$newlocalcontent[$i]\".\n";
 136                 push(@installer::globals::epmdifflist, $diffinfo);
 137                 last;
 138             }
 139         }
 140     }
 141
 142     return $identical;
 143 }
 144
 145 ####################################################
 146 # Comparing the content of two pcf files.
 147 ####################################################
 148
 149 sub compare_package_content
 150 {
 151     my ($oldcontent, $newcontent) = @_;
 152
 153     my $identical = 1;
 154     my $infoline = "";
 155
 156     my $oldmember = scalar keys %{$oldcontent};
 157     my $newmember = scalar keys %{$newcontent};
 158
 159     # comparing the count
 160
 161     if ( $oldmember != $newmember )
 162     {
 163         # Logging the difference
 164         $identical = 0;
 165         installer::logger::print_message("\n...... different number of files in packages. New number: $newmember, old number: $oldmember\n");
 166         $infoline = "Different number of files in packages. New number: $newmember, old number: $oldmember\n";
 167         push(@installer::globals::pcfdiffcomment, $infoline);
 168     }
 169
 170     # comparing the keys
 171
 172     if ( $identical )
 173     {
 174         my $first = 1;
 175         my $start = "\n";
 176         foreach my $dest ( keys %{$newcontent} )
 177         {
 178             if ( ! exists($oldcontent->{$dest}) )
 179             {
 180                 $identical = 0;
 181                 installer::logger::print_message("$start...... file only in one package (A): $dest\n");
 182                 $infoline = "File only in existing pool package: $dest\n";
 183                 push(@installer::globals::pcfdiffcomment, $infoline);
 184                 if ( $first ) { $start = ""; }
 185                 $first = 0;
 186             }
 187         }
 188
 189         # collecting all differences
 190         if ( ! $identical )
 191         {
 192             foreach my $dest ( keys %{$oldcontent} )
 193             {
 194                 if ( ! exists($newcontent->{$dest}) )
 195                 {
 196                     $identical = 0;
 197                     installer::logger::print_message("$start...... file only in one package (B): $dest\n");
 198                     $infoline = "File only in new package: $dest\n";
 199                     push(@installer::globals::pcfdiffcomment, $infoline);
 200                     if ( $first ) { $start = ""; }
 201                     $first = 0;
 202                 }
 203             }
 204         }
 205     }
 206
 207     # comparing the checksum
 208
 209     if ( $identical )
 210     {
 211         my $first = 1;
 212
 213         foreach my $dest ( keys %{$newcontent} )
 214         {
 215             if ( $newcontent->{$dest}->{'md5sum'} ne $oldcontent->{$dest}->{'md5sum'} )
 216             {
 217                 $identical = 0;
 218                 if ( $first == 1 )
 219                 {
 220                     installer::logger::print_message("\n");
 221                     $first = 0;
 222                 }
 223                 $installer::globals::pcfdifflist{$dest} = 1;
 224                 installer::logger::print_message("...... different file: $dest\n");
 225                 # last;
 226             }
 227
 228             if ( $installer::globals::iswindowsbuild )
 229             {
 230                 if ( $newcontent->{$dest}->{'uniquename'} ne $oldcontent->{$dest}->{'uniquename'} )
 231                 {
 232                     $identical = 0;
 233                     $installer::globals::pcfdifflist{$dest} = 1;
 234                     installer::logger::print_message("\n...... different file: $dest");
 235                     # last;
 236                 }
 237             }
 238         }
 239     }
 240
 241     return $identical;
 242 }
 243
 244 ####################################################
 245 # Calculating content of pcf file.
 246 ####################################################
 247
 248 sub calculate_current_content
 249 {
 250     my ($filesarray, $packagename) = @_;
 251
 252     installer::logger::include_timestamp_into_logfile("\nCalculating content for package content file ($packagename), start");
 253
 254     my %globalcontent = ();
 255
 256     for ( my $i = 0; $i <= $#{$filesarray}; $i++ )
 257     {
 258         my %onefilehash = ();
 259
 260         my $onefile = ${$filesarray}[$i];
 261         if ( ! $onefile->{'sourcepath'} ) { installer::exiter::exit_program("ERROR: No sourcepath found for file $onefile->{'gid'}", "calculate_current_content");  }
 262         my $source = $onefile->{'sourcepath'};
 263         if ( $onefile->{'zipfilesource'} ) { $source = $onefile->{'zipfilesource'}; }
 264         if ( ! -f $source ) { installer::exiter::exit_program("ERROR: Sourcefile not found: $source ($onefile->{'gid'})", "calculate_current_content"); }
 265
 266         # For Windows the unique name inside the cabinet file also has to be saved
 267         my $uniquename = "";
 268         if ( $installer::globals::iswindowsbuild ) { $uniquename = $onefile->{'uniquename'};}
 269
 270         my $destination = $onefile->{'destination'};
 271         my $checksum = get_md5sum($source);
 272
 273         $onefilehash{'md5sum'} = $checksum;
 274         $onefilehash{'uniquename'} = $uniquename;
 275
 276         if ( exists($globalcontent{$destination}) ) { installer::exiter::exit_program("ERROR: Destination not unique: $destination ($onefile->{'gid'})", "calculate_current_content"); }
 277         $globalcontent{$destination} = \%onefilehash;
 278     }
 279
 280     installer::logger::include_timestamp_into_logfile("\nCalculating content for package content file ($packagename), start");
 281
 282     return \%globalcontent;
 283 }
 284
 285 ####################################################
 286 # Writing pcf file.
 287 ####################################################
 288
 289 sub create_pcfcontent_file
 290 {
 291     my ($realpackagename, $md5sum, $filesize, $fullpackagename, $pkgversion, $epmfilecontent, $pcffilename) = @_;
 292
 293     my @content = ();
 294     my $oneline = "PackageName: $realpackagename\n";
 295     push(@content, $oneline);
 296
 297     $oneline = "md5sum: $md5sum\n";
 298     push(@content, $oneline);
 299
 300     $oneline = "FileSize: $filesize\n";
 301     push(@content, $oneline);
 302
 303     $oneline = "FullPackageName: $fullpackagename\n";
 304     push(@content, $oneline);
 305
 306     $oneline = "PkgVersion: $pkgversion\n";
 307     push(@content, $oneline);
 308
 309     foreach my $dest (keys %{$installer::globals::newpcfcontent} )
 310     {
 311         $oneline = "Files:\t$dest\t$installer::globals::newpcfcontent->{$dest}->{'md5sum'}\t$installer::globals::newpcfcontent->{$dest}->{'uniquename'}\n";
 312         push(@content, $oneline);
 313     }
 314
 315     for ( my $i = 0; $i <= $#{$epmfilecontent}; $i++ )
 316     {
 317         if ( ${$epmfilecontent}[$i] =~ /^\s*$/ ) { next; } # avoiding empty lines
 318         if ( ${$epmfilecontent}[$i] =~ /^\s*f\s+/ ) { next; } # ignoring files, because they can contain temporary pathes
 319         if (( ${$epmfilecontent}[$i] =~ /^\s*%readme\s+/ ) || ( ${$epmfilecontent}[$i] =~ /^\s*%license\s+/ )) { next; } # ignoring license and readme (language specific!)
 320         $oneline = "EPM:\t${$epmfilecontent}[$i]";
 321         push(@content, $oneline);
 322     }
 323
 324     installer::files::save_file($pcffilename, \@content);
 325 }
 326
 327 #######################################################
 328 # Reading the content of the package content file.
 329 #######################################################
 330
 331 sub read_pcf_content
 332 {
 333     my ($pcffilename) = @_;
 334
 335     my %allcontent = ();
 336     my @epmfile = ();
 337     my $realpackagename = "";
 338
 339     my $content = installer::files::read_file($pcffilename);
 340
 341     for ( my $i = 0; $i <= $#{$content}; $i++ )
 342     {
 343         my $line = ${$content}[$i];
 344
 345         if ( $line =~ /^\s*PackageName\:\s*(.*?)\s*$/ )
 346         {
 347             $realpackagename = $1;
 348             $installer::globals::xpdpackageinfo{'RealPackageName'} = $realpackagename;
 349             next;
 350         }
 351
 352         if ( $line =~ /^\s*FullPackageName\:\s*(.*?)\s*$/ )
 353         {
 354             $installer::globals::xpdpackageinfo{'FullPackageName'} = $1;
 355             next;
 356         }
 357
 358         if ( $line =~ /^\s*FileSize\:\s*(.*?)\s*$/ )
 359         {
 360             $installer::globals::xpdpackageinfo{'FileSize'} = $1;
 361             next;
 362         }
 363
 364         if ( $line =~ /^\s*PkgVersion\:\s*(.*?)\s*$/ )
 365         {
 366             $installer::globals::xpdpackageinfo{'PkgVersion'} = $1;
 367             next;
 368         }
 369
 370         if ( $line =~ /^\s*md5sum\:\s*(.*?)\s*$/ )
 371         {
 372             $installer::globals::xpdpackageinfo{'md5sum'} = $1;
 373             next;
 374         }
 375
 376         if ( $line =~ /^\s*Files:\t(.+?)\t(.+?)\t(.*?)\s*$/ )
 377         {
 378             my $destination = $1;
 379             my $checksum = $2;
 380             my $uniquename = $3;
 381
 382             my %onefilehash = ();
 383             $onefilehash{'md5sum'} = $checksum;
 384             $onefilehash{'uniquename'} = $uniquename;
 385
 386             $allcontent{$destination} = \%onefilehash;
 387             next;
 388         }
 389
 390         if ( $line =~ /^\s*EPM:\t(.*?)\s*$/ )    # A line can be empty in epm file
 391         {
 392             my $epmcontent = $1;
 393             push(@epmfile, $epmcontent);
 394             next;
 395         }
 396     }
 397
 398     if ( $realpackagename eq "" ) { installer::exiter::exit_program("ERROR: Real package name not found in pcf file: \"$pcffilename\"", "read_pcf_content"); }
 399
 400     return ($realpackagename, \%allcontent, \@epmfile);
 401 }
 402
 403 ####################################################
 404 # Checking, if a specific package can be
 405 # created at the moment.
 406 ####################################################
 407
 408 sub check_package_availability
 409 {
 410     my ($packagename) = @_;
 411
 412     my $package_is_available = 1;
 413
 414     my $checkfilename = $installer::globals::poolpath . $installer::globals::separator . $packagename . ".pcf.check";
 415     my $lockfilename = $installer::globals::poolpath . $installer::globals::separator . $packagename . ".pcf.lock";
 416
 417     if (( -f $checkfilename ) || ( -f $lockfilename )) { $package_is_available = 0; }
 418
 419     return $package_is_available;
 420 }
 421
 422 ####################################################
 423 # Check, if the existence of the check or lock
 424 # file requires an exit of packaging process.
 425 ####################################################
 426
 427 sub check_pool_exit
 428 {
 429     my ( $lockfilename, $timecounter ) = @_;
 430
 431     # How old is this lock file?
 432     my $timeage = installer::logger::get_file_age($lockfilename);
 433
 434     # if ( $timeage > 1800 ) # file is older than half an hour
 435     if ( $timeage > 3600 ) # file is older than an hour
 436     {
 437         my $timestring = installer::logger::convert_timestring($timeage);
 438         my $infoline = "\nPool: Attention: \"$lockfilename\" is too old ($timestring). Removing file!\n";
 439         installer::logger::print_message( "... $infoline" );
 440         push( @installer::globals::logfileinfo, $infoline);
 441         unlink $lockfilename;
 442         # installer::exiter::exit_program("ERROR: Waiting too long for removal of lock file \"$lockfilename\"", "check_pool_exit (packagepool)");
 443     }
 444     else
 445     {
 446         my $filecontent = installer::files::read_file($lockfilename);
 447         my $waittime = $timecounter * 10;
 448         $waittime = installer::logger::convert_timestring($waittime);
 449         my $infoline = "\nPool: Warning: \"$lockfilename\" blocks this process for $waittime. Lock content: \"${$filecontent}[0]\"\n";
 450         installer::logger::print_message( "... $infoline" );
 451         push( @installer::globals::logfileinfo, $infoline);
 452     }
 453 }
 454
 455 ############################################################################
 456 # This function logs some information, that can be used to find
 457 # pool problems.
 458 ############################################################################
 459
 460 sub log_pool_info
 461 {
 462     my ( $file_exists ) = @_;
 463
 464     my $infoline = "";
 465
 466     # Content saved in
 467     # $installer::globals::savelockfilecontent = installer::files::read_file($filename);
 468     # $installer::globals::savelockfilename = $filename;
 469
 470     if ( $file_exists )
 471     {
 472         $infoline = "\nPool Problem: Lock file \"$installer::globals::savelockfilename\" belongs to another process. This process has session id: $installer::globals::sessionid .\n";
 473         push( @installer::globals::logfileinfo, $infoline);
 474         $infoline = "Content of Lock file:\n";
 475         push( @installer::globals::logfileinfo, $infoline);
 476         foreach my $line ( @{$installer::globals::savelockfilecontent} ) { push( @installer::globals::logfileinfo, $line); }
 477     }
 478     else
 479     {
 480         $infoline = "\nPool Problem: Lock file \"$installer::globals::savelockfilename\" does not exist anymore (this process has session id: $installer::globals::sessionid) .\n";
 481         push( @installer::globals::logfileinfo, $infoline);
 482     }
 483 }
 484
 485 ############################################################################
 486 # Checking, if this process is the owner of the lock file in the pool.
 487 # This can be determined by the Process ID, that is written at the
 488 # beginning of the first line into the lock file.
 489 ############################################################################
 490
 491 sub process_is_owner
 492 {
 493     my ( $filename ) = @_;
 494
 495     my $process_is_owner = 0;
 496
 497     $installer::globals::savelockfilecontent = installer::files::read_file($filename);
 498     $installer::globals::savelockfilename = $filename;
 499
 500     if ( ${$installer::globals::savelockfilecontent}[0] =~ /^\s*\Q$installer::globals::sessionid\E\s+/ ) { $process_is_owner = 1; }
 501
 502     return $process_is_owner;
 503 }
 504
 505 ####################################################
 506 # Removing a package from installation set, if
 507 # there were pooling problems.
 508 ####################################################
 509
 510 sub remove_package_from_installset
 511 {
 512     my ($newpackagepath) = @_;
 513
 514     my $infoline = "Pool problem: Removing package \"$newpackagepath\" from installation set!\n";
 515     push(@installer::globals::logfileinfo, $infoline);
 516
 517     if ( -f $newpackagepath ) { unlink $newpackagepath; }
 518     if ( -d $newpackagepath ) { installer::systemactions::remove_complete_directory($newpackagepath, 1); }
 519
 520     # Keeping the content of @installer::globals::installsetcontent up to date. Removing the last package.
 521     pop(@installer::globals::installsetcontent);
 522 }
 523
 524 ####################################################
 525 # Check, if the package is in the pool and if
 526 # there are no changes in the package.
 527 ####################################################
 528
 529 sub package_is_up_to_date
 530 {
 531     my ($allvariables, $onepackage, $packagename, $newepmcontent, $filesinpackage, $installdir, $subdir, $languagestringref) = @_;
 532
 533     installer::logger::print_message_without_newline( "... checking pool package $packagename ..." );
 534
 535     installer::logger::include_header_into_logfile("Checking package in pool: $packagename");
 536
 537     if ( ! $installer::globals::poolpathset ) { installer::packagepool::set_pool_path(); }
 538     if ( ! $installer::globals::sessionidset ) { installer::packagepool::set_sessionid(); }
 539
 540     my $infoline = "";
 541     # Resetting some variables for this package
 542     my $package_is_up_to_date = 0;
 543     my $realpackagename = "";
 544     my $oldepmcontent = "";
 545     my $waited_for_check = 0;
 546     my $waited_for_lock = 0;
 547     $installer::globals::newpcfcontentcalculated = 0;
 548     %installer::globals::pcfdifflist = ();
 549     @installer::globals::pcfdiffcomment = ();
 550     @installer::globals::epmdifflist = ();
 551
 552     # Reading the package content file, if this file exists (extension *.pcf)
 553     my $filename = $installer::globals::poolpath . $installer::globals::separator . $packagename . ".pcf";
 554     my $checkfilename = $installer::globals::poolpath . $installer::globals::separator . $packagename . ".pcf.check";
 555     my $lockfilename = $installer::globals::poolpath . $installer::globals::separator . $packagename . ".pcf.lock";
 556     # Saving name in global variable, so that this file can be removed somewhere else (at the end of "put_content_into_pool").
 557     $installer::globals::poolcheckfilename = $checkfilename;
 558     $installer::globals::poollockfilename = $lockfilename;
 559
 560     my @checkfilecontent = ("$installer::globals::sessionid $installer::globals::product $$languagestringref $checkfilename");  # $$ is the process id
 561     my @lockfilecontent = ("$installer::globals::sessionid $installer::globals::product $$languagestringref $lockfilename");    # $$ is the process id
 562
 563     # Waiting, step 1
 564     # Checking, if another process checks this package at the moment
 565     my $timecounter = 0;
 566     while ( -f $checkfilename )
 567     {
 568         $timecounter++;
 569
 570         # including an exit to enable creation of other packages
 571         if (( $timecounter == 1 ) && ( ! exists($installer::globals::poolshiftedpackages{$packagename}) ))
 572         {
 573             $package_is_up_to_date = 3; # repeat this package later
 574             return $package_is_up_to_date;
 575         }
 576
 577         $infoline = "Pool: $checkfilename exists. WAITING 10 seconds ($timecounter).\n";
 578         if ( $timecounter == 1 ) { installer::logger::print_message( "\n" ); }
 579         installer::logger::print_message( "... $infoline" );
 580         push( @installer::globals::logfileinfo, $infoline);
 581         # if ( $timecounter % 50 == 0 ) { check_pool_exit($checkfilename, $timecounter); }
 582         if ( $timecounter % 100 == 0 ) { check_pool_exit($checkfilename, $timecounter); }
 583         sleep 10; # process sleeps 10 seconds
 584         $waited_for_check = 1;
 585     }
 586
 587     # Creating file, showing that this package is checked at the moment by this process. No other process can reach this.
 588     installer::files::save_file($checkfilename, \@checkfilecontent);    # Creating the Lock, to check this package. This blocks all other processes.
 589     $installer::globals::processhaspoolcheckfile = 1;
 590
 591     # Check, if the Lock file creation was really successful
 592     if ( ! -f $checkfilename )
 593     {
 594         $infoline = "Pool problem: Pool lock file \"$checkfilename\" could not be created successfully or was removed by another process (A)!\n";
 595         push( @installer::globals::logfileinfo, $infoline);
 596         log_pool_info(0);
 597         $package_is_up_to_date = 4;     # repeat this package
 598         return $package_is_up_to_date;
 599     }
 600
 601     if ( ! process_is_owner($checkfilename) )
 602     {
 603         $infoline = "Pool problem: Pool lock file \"$checkfilename\" belongs to another process (A)!\n";
 604         push( @installer::globals::logfileinfo, $infoline);
 605         log_pool_info(1);
 606         $package_is_up_to_date = 4;     # repeat this package
 607         return $package_is_up_to_date;
 608     }
 609
 610     $infoline = "Pool: Created file: $checkfilename\n";
 611     push( @installer::globals::logfileinfo, $infoline);
 612     if ( $waited_for_check ) { installer::logger::print_message( "... $infoline" ); }
 613
 614     # Waiting, step 2
 615     # Checking, if another process creates this package at the moment
 616     $timecounter = 0;
 617     while ( -f $lockfilename )
 618     {
 619         $timecounter++;
 620         $infoline = "Pool: $lockfilename exists. WAITING 10 seconds ($timecounter).\n";
 621         if ( $timecounter == 1 ) { installer::logger::print_message( "\n" ); }
 622         installer::logger::print_message( "... $infoline" );
 623         push( @installer::globals::logfileinfo, $infoline);
 624         # if ( $timecounter % 50 == 0 ) { check_pool_exit($lockfilename, $timecounter); }
 625         if ( $timecounter % 100 == 0 ) { check_pool_exit($lockfilename, $timecounter); }
 626         sleep 10; # process sleeps 10 seconds
 627         $waited_for_lock = 1;
 628     }
 629
 630     # No lock file exists, therefore no process creates this package at the moment. Check can be done now.
 631     if ( $waited_for_lock ) { installer::logger::print_message( "... Pool: Proceeding, $lockfilename was removed.\n" ); }
 632
 633     my $package_already_exists = 0;
 634
 635     if ( -f $filename )
 636     {
 637         # Calculating content for pcf file
 638         $installer::globals::newpcfcontent = calculate_current_content($filesinpackage, $packagename);
 639         $installer::globals::newpcfcontentcalculated = 1;
 640
 641         # reading the existing pcf file
 642         ($realpackagename, $oldpcfcontent, $oldepmcontent) = read_pcf_content($filename);
 643
 644         # First check: Package has to exist in pool (directories on Solaris)
 645         my $fullpackage = $installer::globals::poolpath . $installer::globals::separator . $realpackagename;
 646         if ( $installer::globals::issolarisbuild ) { $fullpackage = $fullpackage . ".tar"; }
 647         if ( -f $fullpackage )
 648         {
 649             $package_already_exists = 1;
 650             # Second check: Only files
 651             my $content_is_identical = compare_package_content($oldpcfcontent, $installer::globals::newpcfcontent);
 652
 653             # Third check for Unix: Changes in the epm file?
 654             if (( $content_is_identical ) && ( ! $installer::globals::iswindowsbuild ))
 655             {
 656                 $content_is_identical = compare_epm_content($oldepmcontent, $newepmcontent);
 657             }
 658
 659             if ( $content_is_identical ) { $package_is_up_to_date = 1; }
 660         }
 661     }
 662
 663     if ( $package_is_up_to_date )
 664     {
 665         $infoline = "Pool: $packagename: No new content, using existing package\n";
 666         push( @installer::globals::logfileinfo, $infoline);
 667         installer::logger::print_message( "... using package from pool\n" );
 668     }
 669     else
 670     {
 671         if ( $package_already_exists )
 672         {
 673             $infoline = "Pool: $packagename: Contains new content, creating new package. Differences:\n";
 674             push( @installer::globals::logfileinfo, $infoline);
 675             foreach my $dest ( sort keys %installer::globals::pcfdifflist ) { push( @installer::globals::logfileinfo, "$dest\n"); }
 676             foreach my $dest ( @installer::globals::pcfdiffcomment ) { push( @installer::globals::logfileinfo, "$dest"); }
 677             foreach my $dest ( @installer::globals::epmdifflist ) { push( @installer::globals::logfileinfo, "$dest"); }
 678         }
 679         else
 680         {
 681             $infoline = "Pool: $packagename: Does not exist in pool.\n";
 682             push( @installer::globals::logfileinfo, $infoline);
 683         }
 684
 685         installer::logger::print_message( "... packaging required\n" );
 686         %installer::globals::xpdpackageinfo = (); # reset the filled hash, because the package cannot be used.
 687
 688         # Creating lock mechanism, so that other processes do not create this package, too.
 689         installer::files::save_file($lockfilename, \@lockfilecontent);          # Creating the Lock, to create this package (Lock for check still exists).
 690         $installer::globals::processhaspoollockfile = 1;
 691
 692         # Check if creation of Lock file was really successful
 693
 694         if ( ! -f $lockfilename )
 695         {
 696             $infoline = "Pool problem: Pool lock file \"$lockfilename\" could not be created successfully or was removed by another process (D)!\n";
 697             push( @installer::globals::logfileinfo, $infoline);
 698             log_pool_info(0);
 699             $package_is_up_to_date = 4; # repeat this package
 700             return $package_is_up_to_date;
 701         }
 702
 703         if ( ! process_is_owner($lockfilename) )
 704         {
 705             $infoline = "Pool problem: Pool lock file \"$lockfilename\" belongs to another process (D)!\n";
 706             push( @installer::globals::logfileinfo, $infoline);
 707             log_pool_info(1);
 708             $package_is_up_to_date = 4; # repeat this package
 709             return $package_is_up_to_date;
 710         }
 711
 712         $infoline = "Pool: Created file: $lockfilename\n";
 713         push( @installer::globals::logfileinfo, $infoline);
 714     }
 715
 716     my $newpackagepath = "";
 717
 718     if ( $package_is_up_to_date )
 719     {
 720         # Before the package is copied into the installation set, it has to be checked, if this process is really the owner of this lock file..
 721         # Check, if lock file still exists and if this process is the owner.
 722
 723         if ( ! -f $checkfilename )
 724         {
 725             $infoline = "Pool problem: Pool lock file \"$checkfilename\" was removed by another process (B)!\n";
 726             push( @installer::globals::logfileinfo, $infoline);
 727             log_pool_info(0);
 728             $package_is_up_to_date = 4; # repeat this package
 729             return $package_is_up_to_date;
 730         }
 731
 732         if ( ! process_is_owner($checkfilename) )
 733         {
 734             $infoline = "Pool problem: Pool lock file \"$checkfilename\" belongs to another process (B)!\n";
 735             push( @installer::globals::logfileinfo, $infoline);
 736             log_pool_info(1);
 737             $package_is_up_to_date = 4; # repeat this package
 738             return $package_is_up_to_date;
 739         }
 740
 741         # Copying the package from the pool into the installation set
 742         $newpackagepath = copy_package_from_pool($installdir, $subdir, $realpackagename);
 743     }
 744
 745     # Before the lock file in the pool can be removed, it has to be checked, if this process is still the owner of this lock file.
 746     # Check, if lock file still exists and if this process is the owner.
 747     if ( ! -f $checkfilename )
 748     {
 749         $infoline = "Pool problem: Pool lock file \"$checkfilename\" was removed by another process (C)!\n";
 750         push( @installer::globals::logfileinfo, $infoline);
 751         log_pool_info(0);
 752
 753         # removing new package from installation set
 754         if ( $newpackagepath ne "" ) { remove_package_from_installset($newpackagepath); }       # A file was copied and a problem occured with pooling
 755
 756         $package_is_up_to_date = 4;     # repeat this package
 757         return $package_is_up_to_date;
 758     }
 759
 760     if ( ! process_is_owner($checkfilename) )
 761     {
 762         $infoline = "Pool problem: Pool lock file \"$checkfilename\" belongs to another process (C)!\n";
 763         push( @installer::globals::logfileinfo, $infoline);
 764         log_pool_info(1);
 765
 766         # removing new package from installation set
 767         if ( $newpackagepath ne "" ) { remove_package_from_installset($newpackagepath); }       # A file was copied and a problem occured with pooling
 768
 769         $package_is_up_to_date = 4;     # repeat this package
 770         return $package_is_up_to_date;
 771     }
 772
 773     # Removing the check file, releasing this package for the next process.
 774     # The Lock to create this package still exists, if required.
 775     unlink $checkfilename;
 776     $installer::globals::processhaspoolcheckfile = 0;
 777     $infoline = "Pool: Removing file: $checkfilename\n";
 778     push( @installer::globals::logfileinfo, $infoline);
 779
 780     # Last chance before packaging starts, to check, if this process is really still owner
 781     # of the packaging lock file. If not, this packaging process can be repeated.
 782     if ( $installer::globals::processhaspoollockfile )
 783     {
 784         if ( ! -f $lockfilename )
 785         {
 786             $infoline = "Pool problem: Pool lock file \"$lockfilename\" was removed by another process (E)!\n";
 787             push( @installer::globals::logfileinfo, $infoline);
 788             log_pool_info(0);
 789             $package_is_up_to_date = 4; # repeat this package
 790             return $package_is_up_to_date;
 791         }
 792
 793         if ( ! process_is_owner($lockfilename) )
 794         {
 795             $infoline = "Pool problem: Pool lock file \"$lockfilename\" belongs to another process (E)!\n";
 796             push( @installer::globals::logfileinfo, $infoline);
 797             log_pool_info(1);
 798             $package_is_up_to_date = 4; # repeat this package
 799             return $package_is_up_to_date;
 800         }
 801     }
 802
 803     # Collecting log information
 804     if ( $package_is_up_to_date == 1 ) { $installer::globals::poolpackages{$packagename} = 1; }
 805     if ( $package_is_up_to_date == 0 )
 806     {
 807         my @packreasons = ();
 808         if ( $package_already_exists )
 809         {
 810             $infoline = "\t\tPool: $packagename: Contains new content, creating new package. Differences:\n";
 811             push( @packreasons, $infoline);
 812             foreach my $dest ( sort keys %installer::globals::pcfdifflist ) { push( @packreasons, "\t\t$dest\n"); }
 813             foreach my $dest ( @installer::globals::pcfdiffcomment ) { push( @packreasons, "\t\t$dest"); }
 814             foreach my $dest ( @installer::globals::epmdifflist ) { push( @packreasons, "\t\t$dest"); }
 815         }
 816         else
 817         {
 818             $infoline = "\t\tPool: $packagename: Does not exist in pool.\n";
 819             push( @packreasons, $infoline);
 820         }
 821
 822         $installer::globals::createpackages{$packagename} = \@packreasons;
 823     }
 824
 825     return $package_is_up_to_date;
 826 }
 827
 828 ###################################################
 829 # Determine, which package was created newly
 830 ###################################################
 831
 832 sub determine_new_packagename
 833 {
 834     my ( $dir ) = @_;
 835
 836     my ($newcontent, $allcontent) = installer::systemactions::find_new_content_in_directory($dir, \@installer::globals::installsetcontent);
 837     @installer::globals::installsetcontent = ();
 838     foreach my $element ( @{$allcontent} ) { push(@installer::globals::installsetcontent, $element); }
 839
 840     my $newentriesnumber = $#{$newcontent} + 1;
 841     if ( $newentriesnumber > 1 )
 842     {
 843         my $newpackages = "";
 844         foreach my $onepackage ( @{$newcontent} ) { $newpackages = $newpackages . " " . $onepackage; }
 845         installer::exiter::exit_program("ERROR: More than one new package in directory $dir ($newpackages)", "determine_new_packagename (packagepool)");
 846     }
 847     elsif ( $newentriesnumber < 1 )
 848     {
 849         installer::exiter::exit_program("ERROR: No new package in directory $dir", "determine_new_packagename (packagepool)");
 850     }
 851     my $newpackage = ${$newcontent}[0];
 852
 853     return $newpackage;
 854 }
 855
 856 ####################################################
 857 # Including content into the package pool
 858 ####################################################
 859
 860 sub put_content_into_pool
 861 {
 862     my ($packagename, $installdir, $subdir, $filesinpackage, $epmfilecontent) = @_;
 863
 864     my $infoline = "";
 865
 866     my $fullinstalldir = $installdir . $installer::globals::separator . $subdir;
 867     my $fullrealpackagename = determine_new_packagename($fullinstalldir);
 868     my $realpackagename = $fullrealpackagename;
 869     installer::pathanalyzer::make_absolute_filename_to_relative_filename(\$realpackagename);
 870
 871     installer::logger::include_header_into_logfile("Adding content into the package pool: $realpackagename (PackageName: $packagename)");
 872
 873     # Calculating content for pcf file, if not already done in "package_is_up_to_date"
 874     if ( ! $installer::globals::newpcfcontentcalculated )
 875     {
 876         $installer::globals::newpcfcontent = calculate_current_content($filesinpackage, $packagename);
 877         $installer::globals::newpcfcontentcalculated = 1;
 878     }
 879
 880     # Determining md5sum and FileSize for the new package and saving in pcf file
 881     my $md5sum = installer::xpdinstaller::get_md5_value($fullrealpackagename);
 882     my $filesize = installer::xpdinstaller::get_size_value($fullrealpackagename);
 883     my $fullpackagename = installer::xpdinstaller::get_fullpkgname_value($fullrealpackagename);
 884     my $pkgversion = installer::xpdinstaller::get_pkgversion_value($fullrealpackagename);
 885
 886     # Put package content file (pcf) into pool
 887     my $pcffilename = $installer::globals::poolpath . $installer::globals::separator . $packagename . ".pcf";
 888     create_pcfcontent_file($realpackagename, $md5sum, $filesize, $fullpackagename, $pkgversion, $epmfilecontent, $pcffilename);
 889
 890     # Creating xpd info
 891     $installer::globals::xpdpackageinfo{'FileSize'} = $filesize;
 892     $installer::globals::xpdpackageinfo{'FullPackageName'} = $fullpackagename;
 893     $installer::globals::xpdpackageinfo{'md5sum'} = $md5sum;
 894     $installer::globals::xpdpackageinfo{'RealPackageName'} = $realpackagename;
 895     $installer::globals::xpdpackageinfo{'PkgVersion'} = $pkgversion;
 896
 897     # Put package into pool
 898     $infoline = "Pool: Adding package \"$packagename\" into pool.\n";
 899     push( @installer::globals::logfileinfo, $infoline);
 900
 901     # Copying with unique name, containing PID. Only renaming if everything was fine.
 902     my $realdestination = "";
 903     my $uniquedestination = "";
 904     if ( -f $fullrealpackagename )
 905     {
 906         $realdestination = $installer::globals::poolpath . $installer::globals::separator . $realpackagename;
 907         $uniquedestination = $realdestination . "." . $installer::globals::sessionid;
 908         installer::systemactions::copy_one_file($fullrealpackagename, $uniquedestination);
 909     }
 910
 911     # Copying Solaris packages (as tar files)
 912     if ( -d $fullrealpackagename )
 913     {
 914         my $tarfilename = $packagename . ".tar";
 915         my $fulltarfilename = $fullinstalldir . $installer::globals::separator . $tarfilename;
 916         my $size = installer::worker::tar_package($fullinstalldir, $packagename, $tarfilename, $installer::globals::getuidpath);
 917         if (( ! -f $fulltarfilename ) || ( ! ( $size > 0 ))) { installer::exiter::exit_program("ERROR: Missing file: $fulltarfilename", "put_content_into_pool"); }
 918         $realdestination = $installer::globals::poolpath . $installer::globals::separator . $tarfilename;
 919         $uniquedestination = $realdestination . "." . $installer::globals::sessionid;
 920         installer::systemactions::copy_one_file($fulltarfilename, $uniquedestination);
 921         unlink $fulltarfilename;
 922     }
 923
 924     # Before the new package is renamed in the pool, it has to be checked, if this process still has the lock for this package.
 925     # Check, if lock file still exists and if this process is the owner. Otherwise a pool error occured.
 926     if ( ! -f $installer::globals::poollockfilename )
 927     {
 928         unlink $uniquedestination;  # removing file from pool
 929         log_pool_info(0);
 930         installer::exiter::exit_program("ERROR: Pool lock file \"$installer::globals::poollockfilename\" was removed by another process (F)!", "put_content_into_pool");
 931     }
 932
 933     if ( ! process_is_owner($installer::globals::poollockfilename) )
 934     {
 935         unlink $uniquedestination;  # removing file from pool
 936         log_pool_info(1);
 937         installer::exiter::exit_program("ERROR: Pool lock file \"$installer::globals::poollockfilename\" belongs to another process (F)!", "put_content_into_pool");
 938     }
 939
 940     # Renaming the file in the pool (atomic step)
 941     rename($uniquedestination, $realdestination);
 942
 943     $infoline = "Pool: Renamed file: \"$uniquedestination\" to \"$realdestination\".\n";
 944     push( @installer::globals::logfileinfo, $infoline);
 945
 946     # Before the lock file in the pool can be removed, it has to be checked, if this process is still the owner of this lock file.
 947     # Check, if lock file still exists and if this process is the owner. Otherwise a pool error occured.
 948     if ( ! -f $installer::globals::poollockfilename )
 949     {
 950         log_pool_info(0);
 951         installer::exiter::exit_program("ERROR: Pool lock file \"$installer::globals::poollockfilename\" was removed by another process (G)!", "put_content_into_pool");
 952     }
 953
 954     if ( ! process_is_owner($installer::globals::poollockfilename) )
 955     {
 956         log_pool_info(1);
 957         installer::exiter::exit_program("ERROR: Pool lock file \"$installer::globals::poollockfilename\" belongs to another process (G)!", "put_content_into_pool");
 958     }
 959
 960     # Removing lock file, so that other processes can use this package now
 961     unlink $installer::globals::poollockfilename;
 962     $installer::globals::processhaspoollockfile = 0;
 963     $infoline = "Pool: Removing file: $installer::globals::poollockfilename\n";
 964     push( @installer::globals::logfileinfo, $infoline);
 965 }
 966
 967 ###################################################################
 968 # Copying a package from the pool into the installation set
 969 ###################################################################
 970
 971 sub copy_package_from_pool
 972 {
 973     my ($installdir, $subdir, $packagename) = @_;
 974
 975     my $infoline = "Pool: Using package \"$packagename\" from pool.\n";
 976     push( @installer::globals::logfileinfo, $infoline);
 977     my $sourcefile = $installer::globals::poolpath . $installer::globals::separator . $packagename;
 978     if ( $installer::globals::issolarisbuild ) { $sourcefile = $sourcefile . ".tar"; }
 979     if ( ! -f $sourcefile ) { installer::exiter::exit_program("ERROR: Missing package in package pool: \"$sourcefile\"", "copy_package_from_pool"); }
 980     my $destination = $installdir . $installer::globals::separator . $subdir;
 981     if ( ! -d $destination ) { installer::systemactions::create_directory($destination); }
 982     my $destinationfile = $destination . $installer::globals::separator . $packagename;
 983     if ( $installer::globals::issolarisbuild ) { $destinationfile = $destinationfile . ".tar"; }
 984     if ( -f $sourcefile ) { installer::systemactions::copy_one_file($sourcefile, $destinationfile); }
 985     # Unpacking for Solaris
 986     if ( $installer::globals::issolarisbuild )
 987     {
 988         my $tarfilename = $packagename . ".tar";
 989         installer::worker::untar_package($destination, $tarfilename, $installer::globals::getuidpath);
 990         unlink $destinationfile;
 991         $destinationfile =~ s/.tar\s*$//;
 992     }
 993
 994     # Keeping the content of @installer::globals::installsetcontent up to date (with full pathes):
 995     push(@installer::globals::installsetcontent, $destinationfile);
 996
 997     return $destinationfile;
 998 }
 999
1000 ###################################################################
1001 # Counting keys in hash
1002 ###################################################################
1003
1004 sub get_count
1005 {
1006     my ( $hashref ) = @_;
1007
1008     my $counter = 0;
1009     foreach my $onekey ( keys %{$hashref} ) { $counter++; }
1010     return $counter;
1011 }
1012
1013 ###################################################################
1014 # Logging some pool information
1015 ###################################################################
1016
1017 sub log_pool_statistics
1018 {
1019     my $infoline = "";
1020
1021     installer::logger::include_header_into_logfile("Pool statistics:");
1022
1023     # Info collected in global hashes
1024     # %installer::globals::createpackages
1025     # %installer::globals::poolpackages
1026
1027     my $pool_packages = get_count(\%installer::globals::poolpackages);
1028     my $created_packages = get_count(\%installer::globals::createpackages);
1029
1030     $infoline = "Number of packages from pool: $pool_packages\n";
1031     push( @installer::globals::logfileinfo, $infoline);
1032
1033     foreach my $packagename ( sort keys(%installer::globals::poolpackages) )
1034     {
1035         $infoline = "\t$packagename\n";
1036         push( @installer::globals::logfileinfo, $infoline);
1037     }
1038
1039     $infoline = "\nNumber of packages that were created: $created_packages\n";
1040     push( @installer::globals::logfileinfo, $infoline);
1041
1042     foreach my $packagename ( sort keys(%installer::globals::createpackages) )
1043     {
1044         $infoline = "\t$packagename\n";
1045         push( @installer::globals::logfileinfo, $infoline);
1046         my $reason = $installer::globals::createpackages{$packagename};
1047
1048         for ( my $i = 0; $i <= $#{$reason}; $i++ )
1049         {
1050             $infoline = "${$reason}[$i]";
1051             push( @installer::globals::logfileinfo, $infoline);
1052         }
1053     }
1054 }
1055
1056 1;