Subversion Repositories DevTools

Rev

Rev 6320 | Rev 6772 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 6320 Rev 6475
Line 41... Line 41...
41 
 
 41 
 
42 
#
 42 
#
43 
#   Globals
 43 
#   Globals
44 
#
 44 
#
45 
my $logger = StdLogger->new();                  # Stdout logger. Only during config
 45 
my $logger = StdLogger->new();                  # Stdout logger. Only during config
- 
 
 46 
$logger->err("No config file specified") unless (defined $ARGV[0]);
46 
my $name = basename( $ARGV[0]);
 47 
my $name = basename( $ARGV[0]);
47 
   $name =~ s~.conf$~~;
 48 
   $name =~ s~.conf$~~;
48 
my $now = 0;
 49 
my $now = 0;
49 
my $startTime = 0;
 50 
my $startTime = 0;
50 
my $tar = 'tar';
 51 
my $tar = 'tar';
Line 143... Line 144...
143 
    'deletePackages'  => {'default'   => 0      , 'fmt' => 'bool'},
 144 
    'deletePackages'  => {'default'   => 0      , 'fmt' => 'bool'},
144 
    'deleteImmediate' => {'default'   => 0      , 'fmt' => 'bool'},
 145 
    'deleteImmediate' => {'default'   => 0      , 'fmt' => 'bool'},
145 
    'deleteAge'       => {'default'   => 0      , 'fmt' => 'period'},
 146 
    'deleteAge'       => {'default'   => 0      , 'fmt' => 'period'},
146 
    'packageFilter'   => {'default'   => undef  , 'fmt' => 'text'},
 147 
    'packageFilter'   => {'default'   => undef  , 'fmt' => 'text'},
147 
    'active'          => {'default'   => 1      , 'fmt' => 'bool'},
 148 
    'active'          => {'default'   => 1      , 'fmt' => 'bool'},
- 
 
 149 
    'debug'           => {'default'   => 0      , 'fmt' => 'bool'},                 # Log to screen
- 
 
 150 
    'txdetail'        => {'default'   => 0      , 'fmt' => 'bool'},
- 
 
 151
148 
);
 152 
);
149 
 
 153 
 
150 
 
 154 
 
151 
#
 155 
#
152 
#   Read in the configuration
 156 
#   Read in the configuration
Line 171... Line 175...
171 
 
 175 
 
172 
    $statistics{phase} = 'ReadConfig';
 176 
    $statistics{phase} = 'ReadConfig';
173 
    readConfig();
 177 
    readConfig();
174 
    if ( $conf->{'active'} )
 178 
    if ( $conf->{'active'} )
175 
    {
 179 
    {
- 
 
 180 
        $statistics{phase} = 'CheckTargetBin';
- 
 
 181 
        checkForBasicTools();
176 
        $statistics{phase} = 'ProcessReleaseList';
 182 
        $statistics{phase} = 'ProcessReleaseList';
177 
        processReleaseList();
 183 
        processReleaseList();
178 
        $statistics{phase} = 'processTags';
 184 
        $statistics{phase} = 'processTags';
179 
        processTags();
 185 
        processTags();
180 
        $statistics{phase} = 'maintainTagList';
 186 
        $statistics{phase} = 'maintainTagList';
Line 249... Line 255...
249 
        $conf->{'statsfile'} = $conf->{'piddir'} . '/' . $name . '.stats';
 255 
        $conf->{'statsfile'} = $conf->{'piddir'} . '/' . $name . '.stats';
250 
        $conf->{'statsfiletmp'} = $conf->{'piddir'} . '/' . $name . '.stats.tmp';
 256 
        $conf->{'statsfiletmp'} = $conf->{'piddir'} . '/' . $name . '.stats.tmp';
251 
 
 257 
 
252 
        #
 258 
        #
253 
        #   Extract extra package config
 259 
        #   Extract extra package config
- 
 
 260 
        #       Ignore ALL and Version info if transferring the entire archive
- 
 
 261 
        #       Honor the EXCLUDE - for bandwidth reasons
254 
        #
 262 
        #
255 
        $extraPkgs = {};
 263 
        $extraPkgs = {};
256 
        $excludePkgs = {};
 264 
        $excludePkgs = {};
257 
        while (my($key, $data) = each ( %{$conf->{pkgs}} ))
 265 
        while (my($key, $data) = each ( %{$conf->{pkgs}} ))
258 
        {
 266 
        {
259 
            if ( $data eq 'EXCLUDE' ) {
 267 
            if ( $data eq 'EXCLUDE' ) {
260 
                $excludePkgs->{$key} = 1;
 268 
                $excludePkgs->{$key} = 1;
261 
                $logger->verbose("Exclude Pkg: $key");
 269 
                $logger->verbose("Exclude Pkg: $key");
262 
 
 270 
 
263 
            } elsif ( $data eq 'ALL' ) {
 271 
            } elsif ( $data eq 'ALL' ) {
- 
 
 272 
                next if ( $conf->{'allArchive'} );
264 
                foreach my $pver (getPackageVersions($key))
 273 
                foreach my $pver (getPackageVersions($key))
265 
                {
 274 
                {
266 
                    $extraPkgs->{$key}{$pver} = 1;
 275 
                    $extraPkgs->{$key}{$pver} = 1;
267 
                    $logger->verbose("Extra Pkg: $key -> $pver");
 276 
                    $logger->verbose("Extra Pkg: $key -> $pver");
268 
                }
 277 
                }
269 
            } else {
 278 
            } else {
- 
 
 279 
                next if ( $conf->{'allArchive'} );
- 
 
 280 
                foreach (split(/[,\s]+/, $data))
- 
 
 281 
                {
270 
                $extraPkgs->{$key}{$data} = 1;
 282 
                    $extraPkgs->{$key}{$_} = 1;
271 
                $logger->verbose("Extra Pkg: $key -> $data");
 283 
                    $logger->verbose("Extra Pkg: $key -> $_");
- 
 
 284 
                }
272 
            }
 285 
            }
273 
        }
 286 
        }
274 
 
 287 
 
275 
        $logger->verbose("Filter Packages: " . $conf->{'packageFilter'})
 288 
        $logger->verbose("Filter Packages: " . $conf->{'packageFilter'})
276 
            if ( defined $conf->{'packageFilter'} );
 289 
            if ( defined $conf->{'packageFilter'} );
Line 296... Line 309...
296 
        $rv = 1;
 309 
        $rv = 1;
297 
    }
 310 
    }
298 
    return $rv;
 311 
    return $rv;
299 
}
 312 
}
300 
 
 313 
 
- 
 
 314 
#-------------------------------------------------------------------------------
- 
 
 315 
# Function        : checkForBasicTools
- 
 
 316 
#
- 
 
 317 
# Description     : Check that the target has the basic tools are installed
- 
 
 318 
#                   Can populate the target's bin directory with tools
- 
 
 319 
#
- 
 
 320 
# Inputs          : None
- 
 
 321 
#
- 
 
 322 
# Returns         : Nothing
- 
 
 323 
#
- 
 
 324 
sub checkForBasicTools
- 
 
 325 
{
- 
 
 326 
    my $ph;
- 
 
 327 
    my $found;
- 
 
 328 
    my $tgt_cmd = "if [ -x  $conf->{'bindir'}/get_plist.pl ] ; then echo :FOUND:; fi";
- 
 
 329 
    my $ssh_cmd = sshCmd($tgt_cmd);
- 
 
 330 
 
- 
 
 331 
    $logger->verbose2("checkForBasicTools:ssh_cmd:$ssh_cmd");
- 
 
 332 
    open ($ph, "$ssh_cmd |");
- 
 
 333 
    while ( <$ph> )
- 
 
 334 
    {
- 
 
 335 
        chomp;
- 
 
 336 
        if (m~:FOUND:~) {
- 
 
 337 
            $found = 1;
- 
 
 338 
        }
- 
 
 339 
        $logger->verbose2("checkForBasicTools:Data: $_");
- 
 
 340 
    }
- 
 
 341 
    close ($ph);
- 
 
 342 
    my $exitCode = $? >> 8;
- 
 
 343 
    $logger->verbose2("checkForBasicTools:End: $exitCode, $?");
- 
 
 344 
 
- 
 
 345 
    unless ( $found )
- 
 
 346 
    {
- 
 
 347 
        $logger->warn("checkForBasicTools: None found, $?");
- 
 
 348 
 
- 
 
 349 
        #
- 
 
 350 
        #   The 'get_plist.pl' program was not found
- 
 
 351 
        #   Assume that the entire directory does not exist and transfer all
- 
 
 352 
        #
- 
 
 353 
        transferTargetBin();
- 
 
 354 
    }
- 
 
 355 
}
- 
 
 356 
 
- 
 
 357 
#-------------------------------------------------------------------------------
- 
 
 358 
# Function        : transferTargetBin
- 
 
 359 
#
- 
 
 360 
# Description     : Ensure that the targets 'bin' folder is upto date
- 
 
 361 
#
- 
 
 362 
# Inputs          : $blatBinData    - Ref to array of target data file info
- 
 
 363 
#
- 
 
 364 
# Returns         :
- 
 
 365 
#
- 
 
 366 
sub transferTargetBin
- 
 
 367 
{
- 
 
 368 
    my ($blatBinData) = @_;
- 
 
 369 
 
- 
 
 370 
    my $blatBinList = getBlatBin();
- 
 
 371 
    foreach my $file ( keys %{$blatBinList} )
- 
 
 372 
    {
- 
 
 373 
        if (defined $blatBinData && exists $blatBinData->{$file}) {
- 
 
 374 
            if ($blatBinData->{$file} eq $blatBinList->{$file}) {
- 
 
 375 
                delete $blatBinList->{$file};
- 
 
 376 
            }
- 
 
 377 
        }
- 
 
 378 
    }
- 
 
 379 
#Utils::DebugDumpData ("blatBinList", $blatBinList);
- 
 
 380 
    transferBlatBin($blatBinList);
- 
 
 381 
}
301 
 
 382 
 
302 
#-------------------------------------------------------------------------------
 383 
#-------------------------------------------------------------------------------
303 
# Function        : processReleaseList
 384 
# Function        : processReleaseList
304 
#
 385 
#
305 
# Description     : Process the release list
 386 
# Description     : Process the release list
Line 341... Line 422...
341 
    #
 422 
    #
342 
    #   Returned data looks like:
 423 
    #   Returned data looks like:
343 
    #       Metadata avail="140100452"
 424 
    #       Metadata avail="140100452"
344 
    #       BlatBin MD5="9e2c6e45af600a20a01dbcb7570da1f1" file="stat.pl"
 425 
    #       BlatBin MD5="9e2c6e45af600a20a01dbcb7570da1f1" file="stat.pl"
345 
    #       time="1497586865" GMT="Fri Jun 16 04:21:05 2017" pname="ERGissaccounts" pver="1.0.7169.mas"
 426 
    #       time="1497586865" GMT="Fri Jun 16 04:21:05 2017" pname="ERGissaccounts" pver="1.0.7169.mas"
- 
 
 427 
    #       time="1497586865" GMT="Fri Jun 16 04:21:05 2017" pname="ERGissaccounts" pver="1.0.7169.mas" "link=latest"
346 
    #       time="1497954104" GMT="Tue Jun 20 10:21:44 2017" pname="ERGissaccounts" pver="1.0.7178.mas" deleted="0"
 428 
    #       time="1497954104" GMT="Tue Jun 20 10:21:44 2017" pname="ERGissaccounts" pver="1.0.7178.mas" deleted="0"
347 
    #
 429 
    #
348 
    my $remotePkgList;
 430 
    my $remotePkgList;
349 
    my $remoteData;
 431 
    my $remoteData;
350 
    my $blatBinData;
 432 
    my $blatBinData;
Line 386... Line 468...
386 
    {
 468 
    {
387 
        $logger->warn("Cannot retrieve package list: $?");
 469 
        $logger->warn("Cannot retrieve package list: $?");
388 
        $statistics{state} = 'No Remote Package List';
 470 
        $statistics{state} = 'No Remote Package List';
389 
        return;
 471 
        return;
390 
    }
 472 
    }
391 
 
 - 
 
392 
#Utils::DebugDumpData ("remotePkgList", $remotePkgList);
 473 
#Utils::DebugDumpData ("remotePkgList", $remotePkgList);
393 
#Utils::DebugDumpData ("blatBinData", $blatBinData);
 - 
 
394 
 
 474 
 
395 
    #
 475 
    #
396 
    #   Determine the Blat Bin packages that need to be transferred
 476 
    #   Ensure that the target bin folder is up to date
397 
    #   Transfer Blats Bin files before attempting to transfer packages
 - 
 
398 
    #
- 
 
399 
    my $blatBinList = getBlatBin();
 - 
 
400 
    foreach my $file ( keys %{$blatBinList} )
 - 
 
401 
    {
 - 
 
402 
        if (exists $blatBinData->{$file}) {
 - 
 
403 
            if ($blatBinData->{$file} eq $blatBinList->{$file}) {
 - 
 
404 
                delete $blatBinList->{$file};
 - 
 
405 
            }
 - 
 
406 
        }
 - 
 
407 
    }
 477 
    #
408 
#Utils::DebugDumpData ("blatBinList", $blatBinList);
 - 
 
409 
    transferBlatBin($blatBinList);
 478 
    transferTargetBin($blatBinData);
410
479
411 
    #
 480 
    #
412 
    #   Determine the set of packages in the releases to be transferred
 481 
    #   Determine the set of packages in the releases to be transferred
413 
    #
482 
    #
414 
    my $pkgList;
 483 
    my $pkgList;
Line 425... Line 494...
425 
        my @rlist = getReleaseList();
 494 
        my @rlist = getReleaseList();
426 
        unless ( @rlist )
 495 
        unless ( @rlist )
427 
        {
 496 
        {
428 
            $logger->verbose2("No Releases to Process");
 497 
            $logger->verbose2("No Releases to Process");
429 
            $statistics{state} = 'No Releases found';
 498 
            $statistics{state} = 'No Releases found';
- 
 
 499 
 
- 
 
 500 
            #   Allow config with just specified packages
- 
 
 501 
            #
430 
            return;
 502 
            #   return;
- 
 
 503 
        } else {
- 
 
 504 
            $pkgList = getPkgList(@rlist);
431 
        }
 505 
        }
432 
        $pkgList = getPkgList(@rlist);
 - 
 
433 
    }
 506 
    }
434 
 
 507 
 
435 
    #
 508 
    #
436 
    #   Append extra packages
 509 
    #   Append extra packages
437 
    #   These are packages that are specifically named by the user
 510 
    #   These are packages that are specifically named by the user
438 
    #
 511 
    #
439 
    #   Note: If there are symbolic links, then the target of the
 512 
    #   Note: If they are symbolic links, then the target of the
440 
    #         link is treated used as the package name
 513 
    #         link is also added.
441 
    #
 514 
    #
442 
    #         Symlink MUST be within the same directory
 515 
    #         Symlink MUST be within the same directory
443 
    #           Used to transfer jats2_current
 516 
    #           Used to transfer jats2_current
444 
    #
 517 
    #
445 
    my $pkgLink;
 - 
 
446 
    while ( (my ($pname, $pvers)) = each %{$extraPkgs} ) {
 518 
    while ( (my ($pname, $pvers)) = each %{$extraPkgs} ) {
447 
        while ( (my ($pver, $pdata) ) = each %{$pvers} ) {
 519 
        while ( (my ($pver, $pdata) ) = each %{$pvers} ) {
448 
 
 520 
 
449 
            my $epath = catfile( $conf->{'dpkg_archive'} , $pname, $pver );
 521 
            my $epath = catfile( $conf->{'dpkg_archive'} , $pname, $pver );
450 
            if ( -l $epath )
 522 
            if ( -l $epath )
Line 459... Line 531...
459 
                if ( $lver =~ m ~/~ )
 531 
                if ( $lver =~ m ~/~ )
460 
                {
 532 
                {
461 
                    $logger->warn("Won't resolve symlink: $pname, $pver, $lver");
 533 
                    $logger->warn("Won't resolve symlink: $pname, $pver, $lver");
462 
                    next;
 534 
                    next;
463 
                }
 535 
                }
464 
                $pkgLink->{$pname}{$pver} = $lver;
 - 
 
465 
                $pdata = $pver;
 - 
 
466 
                $pver = $lver;
 - 
 
467 
 
 536 
 
- 
 
 537 
                #
468 
                # Delete all instances of this package so that the symlink can be replicated correctly
 538 
                #   Add the package the link points to
- 
 
 539 
                #
- 
 
 540 
                $logger->verbose2("Add linked package: $pname, $lver, $pdata");
469 
                delete $pkgList->{$pname};
 541 
                $pkgList->{$pname}{$lver} = $pdata;
470 
            }
 542 
            }
471 
 
 543 
 
472 
            $logger->verbose2("Add extra package: $pname, $pver, $pdata");
 544 
            $logger->verbose2("Add extra package: $pname, $pver, $pdata");
473 
            $pkgList->{$pname}{$pver} = $pdata;
 545 
            $pkgList->{$pname}{$pver} = $pdata;
474 
        }
 546 
        }
475 
    }
 547 
    }
- 
 
 548 
#Utils::DebugDumpData ("parsePkgList", $rv);
- 
 
 549 
 
476 
 
 550 
 
477 
    #
 551 
    #
478 
    #   If there are no packages to process, then assume that this is an error
 552 
    #   If there are no packages to process, then assume that this is an error
479 
    #   condition. Retry the operation soon.
 553 
    #   condition. Retry the operation soon.
480 
    #
 554 
    #
Line 484... Line 558...
484 
        $logger->verbose2("No packages to process");
 558 
        $logger->verbose2("No packages to process");
485 
        $statistics{state} = 'No Packages found';
 559 
        $statistics{state} = 'No Packages found';
486 
        return;
 560 
        return;
487 
    }
 561 
    }
488 
 
 562 
 
- 
 
 563 
#   #
- 
 
 564 
#   #   Useful debug code
- 
 
 565 
#   #
489 
#    while ( (my ($pname, $pvers)) = each %{$pkgList} )
 566 
#   while ( (my ($pname, $pvers)) = each %{$pkgList} )
490 
#    {
 567 
#   {
491 
#        while ( (my ($pver, $ptime) ) = each %{$pvers} )
 568 
#       while ( (my ($pver, $ptime) ) = each %{$pvers} )
492 
#        {
 569 
#       {
493 
#            print "L-- $pname, $pver, $ptime \n";
 570 
#           print "L-- $pname, $pver, $ptime \n";
494 
#
 571 
#
495 
#        }
 572 
#       }
496 
#    }
 573 
#   }
497 
 
 574 
 
498 
    #
 575 
    #
499 
    #   Delete Excess Packages
 576 
    #   Delete Excess Packages
500 
    #       Packages not required on the target
 577 
    #       Packages not required on the target
501 
    #           KLUDGE: Don't delete links to packages
 578 
    #           KLUDGE: Don't delete links to packages
Line 509... Line 586...
509 
        {
 586 
        {
510 
            while ( (my ($pver, $pdata) ) = each %{$pvers} )
 587 
            while ( (my ($pver, $pdata) ) = each %{$pvers} )
511 
            {
 588 
            {
512 
                if ( !exists $pkgList->{$pname}{$pver} )
 589 
                if ( !exists $pkgList->{$pname}{$pver} )
513 
                {
 590 
                {
514 
                    if ( exists $pkgLink->{$pname}{$pver} )
 - 
 
515 
                    {
 - 
 
516 
                        $logger->verbose2("Keep Excess package-link: ${pname}/${pver}");
 - 
 
517 
                        next;
 - 
 
518 
                    }
 - 
 
519 
 
 - 
 
520 
                    if ( exists $excludePkgs->{$pname} )
 591 
                    if ( exists $excludePkgs->{$pname} )
521 
                    {
 592 
                    {
522 
                        $logger->verbose2("Keep Excluded package: ${pname}");
 593 
                        $logger->verbose2("Keep Excluded package: ${pname}");
523 
                        next;
 594 
                        next;
524 
                    }
 595 
                    }
Line 605... Line 676...
605 
            }
 676 
            }
606 
        }
 677 
        }
607 
 
 678 
 
608 
        while ( (my ($pver, $pdata) ) = each %{$pvers} )
 679 
        while ( (my ($pver, $pdata) ) = each %{$pvers} )
609 
        {
 680 
        {
- 
 
 681 
            my $must_transfer;
- 
 
 682 
            my $existsRemote = exists($remotePkgList->{$pname}) && exists ($remotePkgList->{$pname}{$pver});
- 
 
 683 
 
610 
            #
 684 
            #
611 
            #   Take care not to create an entry into $remotePkgList->{$pname}{$pver}
 685 
            #   Take care not to create an entry into $remotePkgList->{$pname}{$pver}
612 
            #   if it does not exist. Existence of {$pname}{$pver} is used later
 686 
            #   if it does not exist. Existence of {$pname}{$pver} is used later
613 
            #
 687 
            #
614 
            my $tmtime = 0;
 688 
            my $tmtime = 0;
615 
            if (exists($remotePkgList->{$pname}) && exists ($remotePkgList->{$pname}{$pver}) && exists ($remotePkgList->{$pname}{$pver}{time})) {
 689 
            if ($existsRemote && exists ($remotePkgList->{$pname}{$pver}{time})) {
616 
                $tmtime = $remotePkgList->{$pname}{$pver}{time};
 690 
                $tmtime = $remotePkgList->{$pname}{$pver}{time};
617 
            }
 691 
            }
618 
            $packageVersionCount++;
 692 
            $packageVersionCount++;
619 
 
 693 
 
620 
            # Package is present in both list
 694 
            # Package is present in both list
- 
 
 695 
            my $localPackage = catdir( $conf->{'dpkg_archive'} , $pname, $pver );
621 
            my ($mtime, $mode) = Utils::mtime( catfile( $conf->{'dpkg_archive'} , $pname, $pver, 'descpkg' ));
 696 
            my ($mtime, $mode) = Utils::mtime( catfile($localPackage, 'descpkg') );
622 
            if ( $mtime == 0 )
 697 
            if ( $mtime == 0 )
623 
            {
 698 
            {
624 
                # PackageVersion not in local archive (at least the descpkg file is not)
 699 
                # PackageVersion not in local archive (at least the descpkg file is not)
625 
                # Skip now - will pick it up later
 700 
                # Skip now - will pick it up later
626 
                $logger->verbose("Package not in dpkg_archive: $pname, $pver");
 701 
                $logger->verbose("Package not in dpkg_archive: $pname, $pver");
Line 641... Line 716...
641 
                    $writableCount++;
 716 
                    $writableCount++;
642 
                    next;
 717 
                    next;
643 
                }
 718 
                }
644 
            }
 719 
            }
645 
 
 720 
 
646 
            if ( $mtime != $tmtime )
 721 
            if ( $mtime != $tmtime ) {
- 
 
 722 
                $logger->verbose("Package Needs to be transferred: $pname, $pver, $mtime, $tmtime");
- 
 
 723 
                $must_transfer = 1;
- 
 
 724 
            }
- 
 
 725 
            elsif ($existsRemote)
647 
            {
 726 
            {
- 
 
 727 
                #
- 
 
 728 
                #   Package exists in both source and target
- 
 
 729 
                #   Symlink test: Ensure symlinks are the same
- 
 
 730 
                #
- 
 
 731 
                my $localIsSymlink = -l $localPackage;
- 
 
 732 
                my $remoteIsSymlink = exists($remotePkgList->{$pname}) && exists ($remotePkgList->{$pname}{$pver}) && exists ($remotePkgList->{$pname}{$pver}{link});
- 
 
 733
- 
 
 734 
                if ($remoteIsSymlink && $localIsSymlink) {
- 
 
 735 
                    #
- 
 
 736 
                    #   Both are symlinks - check that they address the same item
- 
 
 737 
                    #
- 
 
 738 
                    my $targetLink = $remotePkgList->{$pname}{$pver}{link};
- 
 
 739 
                    $logger->verbose2("Package is symlink: $pname, $pver -> $targetLink");
- 
 
 740 
 
- 
 
 741 
                    my $lver = readlink( $localPackage );
- 
 
 742 
                    if ( ! defined $lver ) {
- 
 
 743 
                        $logger->warn("Can't resolve symlink: $pname, $pver");
- 
 
 744 
                        next;
- 
 
 745 
                    }
- 
 
 746 
                    if ($targetLink ne $lver ) {
- 
 
 747 
                        $logger->verbose("Package symlinks differ: $pname, $pver, $targetLink, $lver");
- 
 
 748 
                        $must_transfer = 3;
- 
 
 749 
                    }
- 
 
 750 
 
- 
 
 751 
                } elsif ($remoteIsSymlink || $localIsSymlink ) {
- 
 
 752 
                    #
- 
 
 753 
                    #   Only one is a symlink - force transfer
- 
 
 754 
                    #
- 
 
 755 
                    $logger->warn("Packages versions not both symlink: $pname, $pver, L:$remoteIsSymlink R:$localIsSymlink");
- 
 
 756 
                    $must_transfer = 2;
- 
 
 757 
                }
- 
 
 758 
            }
- 
 
 759 
 
- 
 
 760 
            #
- 
 
 761 
            #   If we are forcing a package transfer then flag it and also remove it from the
- 
 
 762 
            #   RemotePkgList so that it will be transferred - even if its present on target
- 
 
 763 
            #
- 
 
 764 
            if ($must_transfer) {
648 
                # Package not present on target, or timestamps differ
 765 
                # Package not present on target, or timestamps differ
649 
                $logger->verbose("Package Needs to be transferred: $pname, $pver, $mtime, $tmtime");
 - 
 
650 
                $needPkgList->{$pname}{$pver} = $pdata;
 766 
                $needPkgList->{$pname}{$pver} = $pdata;
- 
 
 767 
                delete $RemotePkgList->{$pname}{$pver};
651 
                $needPkgListCount++;
 768 
                $needPkgListCount++;
652 
                next;
 769 
                next;
653 
            }
 770 
            }
654 
        }
 771 
        }
655 
    }
 772 
    }
Line 721... Line 838...
721 
                $lastReleaseScan = 0;
 838 
                $lastReleaseScan = 0;
722 
                $txcount = 0;
 839 
                $txcount = 0;
723 
                last send_pkgs;
 840 
                last send_pkgs;
724 
            }
 841 
            }
725 
 
 842 
 
726 
            transferPackage ($pname, $pver, $pdata);
 843 
            transferPackage ($pname, $pver);
727 
            $needPkgListCount--;
 844 
            $needPkgListCount--;
728 
        }
 845 
        }
729 
    }
 846 
    }
730 
 
 847 
 
731 
    #
 848 
    #
Line 1032... Line 1149...
1032 
#
 1149 
#
1033 
# Description     : Get the entire set of package versions in the archive
 1150 
# Description     : Get the entire set of package versions in the archive
1034 
#
 1151 
#
1035 
# Inputs          :
1152 
# Inputs          :
1036 
#
 1153 
#
1037 
# Returns         : Ref to a hask of package versions
 1154 
# Returns         : Ref to a hash of package versions
1038 
#
 1155 
#
1039 
sub getArchiveList
 1156 
sub getArchiveList
1040 
{
 1157 
{
1041 
    my $pkgDir = $conf->{'dpkg_archive'};
 1158 
    my $pkgDir = $conf->{'dpkg_archive'};
1042 
    my %archiveList;
 1159 
    my %archiveList;
Line 1278... Line 1395...
1278 
        #   Create the target directory on the fly
 1395 
        #   Create the target directory on the fly
1279 
        #   Manipulate file permissions
 1396 
        #   Manipulate file permissions
1280 
        #   Report errors
 1397 
        #   Report errors
1281 
 
 1398 
 
1282 
        my $tar_cmd = "cat \"$targetBinDir/$file\"";
 1399 
        my $tar_cmd = "cat \"$targetBinDir/$file\"";
1283 
        my $tgt_cmd = "mkdir -p ~/bin && chmod +x+w \"~/bin/$file\" && cat > \"~/bin/$file\" && chmod +x-w \"~/bin/$file\" || exit 1";
 1400 
        my $tgt_cmd = "mkdir -p ~/bin && if [ -f \"~/bin/$file\" ] ; then chmod +x+w \"~/bin/$file\"; fi && cat > \"~/bin/$file\" && chmod +x-w \"~/bin/$file\" || exit 1";
1284 
        my $ssh_cmd = sshCmd($tgt_cmd);
 1401 
        my $ssh_cmd = sshCmd($tgt_cmd);
1285 
        my $cat_cmd =
1402 
        my $cat_cmd =
1286 
 
 1403 
 
1287 
        $logger->verbose2("transferBlatBin:tar_cmd:$tar_cmd");
 1404 
        $logger->verbose2("transferBlatBin:tar_cmd:$tar_cmd");
1288 
        $logger->verbose2("transferBlatBin:tgt_cmd:$tgt_cmd");
 1405 
        $logger->verbose2("transferBlatBin:tgt_cmd:$tgt_cmd");
Line 1309... Line 1426...
1309 
 
 1426 
 
1310 
#-------------------------------------------------------------------------------
 1427 
#-------------------------------------------------------------------------------
1311 
# Function        : transferPackage
 1428 
# Function        : transferPackage
1312 
#
 1429 
#
1313 
# Description     : Transfer specified package to target system
 1430 
# Description     : Transfer specified package to target system
- 
 
 1431 
#                   If a symlink, then a symlink will be transferred
1314 
#
 1432 
#
1315 
# Inputs          : $pname          - Name of the package
 1433 
# Inputs          : $pname          - Name of the package
1316 
#                   $pver           - Package version
 1434 
#                   $pver           - Package version
1317 
#                   $plink          - (optional) Symlink in same package
 - 
 
1318 
#
 1435 
#
1319 
# Returns         : true    - Package transferred
 1436 
# Returns         : true    - Package transferred
1320 
#                   false   - Package not transferred
 1437 
#                   false   - Package not transferred
1321 
#
 1438 
#
1322 
sub transferPackage
 1439 
sub transferPackage
1323 
{
 1440 
{
1324 
    my ($pname, $pver, $plink ) = @_;
 1441 
    my ($pname, $pver ) = @_;
1325 
    my $rv = 0;
 1442 
    my $rv = 0;
1326 
    $logger->logmsg("transferPackage: @_");
 1443 
    $logger->logmsg("transferPackage: @_");
1327 
    my $startTime = time;
 1444 
    my $startTime = time;
1328 
 
 1445 
 
1329 
    #
 1446 
    #
Line 1346... Line 1463...
1346 
            return 1;
 1463 
            return 1;
1347 
        }
 1464 
        }
1348 
    }
 1465 
    }
1349 
 
 1466 
 
1350 
    #
 1467 
    #
1351 
    #   plink of 1 is not a symlink
 - 
 
1352 
    #
 - 
 
1353 
    $plink = undef if ( defined($plink) && $plink eq '1' );
 - 
 
1354 
 
 - 
 
1355 
    #
 - 
 
1356 
    #   If its known to be in the target archive, then we don't need to transfer it again
 1468 
    #   If its known to be in the target archive, then we don't need to transfer it again
1357 
    #       It may have been transferred in this cycle
 1469 
    #       It may have been transferred in this cycle
1358 
    #       It may have been in the archive anyway
 1470 
    #       It may have been in the archive anyway
1359 
    #
 1471 
    #
1360 
    if ( exists($RemotePkgList->{$pname}) && exists ($RemotePkgList->{$pname}{$pver})) {
 1472 
    if ( exists($RemotePkgList->{$pname}) && exists ($RemotePkgList->{$pname}{$pver})) {
1361 
        $logger->verbose("transferPackage: Already in archive");
 1473 
        $logger->verbose("transferPackage: Already in archive");
1362 
        #$logger->logmsg("transferPackage: $pname, $pver : Already in archive");
 1474 
        #$logger->logmsg("transferPackage: $pname, $pver : Already in archive");
1363 
        return 1;
 1475 
        return 1;
1364 
    }
 1476 
    }
1365 
 
 1477 
 
1366 
    my $sfile = catfile( $conf->{'dpkg_archive'} , $pname, $pver );
 1478 
    my $sdir = catfile( $conf->{'dpkg_archive'} , $pname );
- 
 
 1479 
    my $sfile = catfile( $sdir, $pver );
1367 
    unless ( -d $sfile )
 1480 
    unless ( -d $sfile )
1368 
    {
 1481 
    {
1369 
        $logger->warn("transferPackage:Package not found: $pname, $pver");
 1482 
        $logger->warn("transferPackage:Package not found: $pname, $pver");
1370 
        return $rv;
 1483 
        return $rv;
1371 
    }
 1484 
    }
1372 
 
 1485 
 
- 
 
 1486 
    ###########################################################################
- 
 
 1487 
    #   Transfer the package / symlink
1373 
    #
 1488 
    #
1374 
    #   Create the process pipe to transfer the package
 1489 
    my $tar_cmd;
1375 
    #   Tar the directory and pipe the result through a ssh session to
 1490 
    my $tgt_cmd;
1376 
    #   the target machine
 1491 
    my $ssh_cmd;
- 
 
 1492
1377 
    #   $tar -czf - -C "$dpkg/${pname}/${pver}" . |  ssh  ... "./receive_package pname pver"
 1493 
    if (-l $sfile) {
- 
 
 1494 
 
1378 
    #
 1495 
        #
- 
 
 1496 
        #   Determine the value of the symlink
- 
 
 1497 
        #   Only support simple symlinks - this in the same directory
1379 
    my $ph;
 1498 
        #
1380 
    my $tar_cmd = "$tar -czf - -C \"$sfile\" .";
 1499 
        my $lver = readlink( $sfile );
1381 
    my $tgt_opts = defined($plink) ? "\"-L$plink\"" : '';
 1500 
        if ( ! defined $lver ) {
1382 
    my $tgt_cmd = "$conf->{'bindir'}/receive_package $tgt_opts \"$pname\" \"$pver\"";
 1501 
            $logger->warn("Can't resolve symlink: $pname, $pver");
1383 
    my $ssh_cmd = sshCmd($tgt_cmd);
 1502 
            next;
- 
 
 1503 
        }
1384 
 
 1504 
 
- 
 
 1505 
        if ( $lver =~ m ~/~ ) {
- 
 
 1506 
            $logger->warn("Won't resolve symlink: $pname, $pver, $lver");
- 
 
 1507 
            next;
- 
 
 1508 
        }
- 
 
 1509 
 
- 
 
 1510 
        $tgt_cmd = "$conf->{'bindir'}/receive_symlink \"$pname\" \"$pver\" \"$lver\"";
- 
 
 1511 
        $ssh_cmd = sshCmd($tgt_cmd);
- 
 
 1512 
 
- 
 
 1513 
    } else {
- 
 
 1514 
        #
- 
 
 1515 
        #   Create the process pipe to transfer the package
- 
 
 1516 
        #   Tar the directory and pipe the result through a ssh session to
- 
 
 1517 
        #   the target machine
- 
 
 1518 
        #   $tar -czf - -C "$dpkg/${pname}/${pver}" . |  ssh  ... "./receive_package pname pver"
- 
 
 1519 
        #
- 
 
 1520 
        $tar_cmd = "$tar -czf - -C \"$sfile\" .";
- 
 
 1521 
        $tgt_cmd = "$conf->{'bindir'}/receive_package \"$pname\" \"$pver\"";
- 
 
 1522 
        $ssh_cmd = sshCmd($tgt_cmd);
- 
 
 1523 
    }
- 
 
 1524 
 
1385 
    $logger->verbose2("transferPackage:tar_cmd:$tar_cmd");
 1525 
    $logger->verbose2("transferPackage:tar_cmd:$tar_cmd") if defined $tar_cmd;
1386 
    $logger->verbose2("transferPackage:tgt_cmd:$tgt_cmd");
 1526 
    $logger->verbose2("transferPackage:tgt_cmd:$tgt_cmd");
1387 
    $logger->verbose2("transferPackage:ssh_cmd:$ssh_cmd");
 1527 
    $logger->verbose2("transferPackage:ssh_cmd:$ssh_cmd");
1388 
 
 1528 
 
- 
 
 1529 
    my $ph;
- 
 
 1530 
    my @cmd_list;
- 
 
 1531 
    push (@cmd_list, $tar_cmd) if defined $tar_cmd;
- 
 
 1532 
    push (@cmd_list, $ssh_cmd);
- 
 
 1533 
    my $cmd = join (' | ', @cmd_list);
1389 
    open ($ph, "$tar_cmd | $ssh_cmd |");
 1534 
    open ($ph, "$cmd |");
1390 
    while ( <$ph> )
 1535 
    while ( <$ph> )
1391 
    {
 1536 
    {
1392 
        chomp;
 1537 
        chomp;
1393 
        $logger->verbose2("transferPackage:Data: $_");
 1538 
        $logger->verbose2("transferPackage:Data: $_");
1394 
    }
 1539 
    }
Line 1397... Line 1542...
1397 
 
 1542 
 
1398 
    #
 1543 
    #
1399 
    #   Display the size of the package
 1544 
    #   Display the size of the package
1400 
    #       Diagnostic use
 1545 
    #       Diagnostic use
1401 
    #
 1546 
    #
- 
 
 1547 
    if ($conf->{txdetail}) {
1402 
    #open ( $ph, "du -bs $sfile 2>/dev/null |" );
 1548 
        open ( $ph, "du -bs $sfile 2>/dev/null |" );
1403 
    #my $line = <$ph>;
 1549 
        my $line = <$ph>;
1404 
    #$line =~ m/^([0-9]+)/;
 1550 
        $line =~ m/^([0-9]+)/;
1405 
    #$line = $1 || 0;
 1551 
        $line = $1 || 0;
1406 
    #my $size = sprintf "%.3f", $line / 1024 / 1024 / 1024 ;
 1552 
        my $size = sprintf "%.3f", $line / 1024 / 1024 / 1024 ;
1407 
    #close $ph;
 1553 
        close $ph;
1408 
    #my $duration = time - $startTime;
 1554 
        my $duration = time - $startTime;
1409 
    #$logger->logmsg("transferPackage:Stats: $pname, $pver, $size Gb, $duration Secs");
 1555 
        $logger->logmsg("transferPackage: Stats: $pname, $pver, $size Gb, $duration Secs");
- 
 
 1556 
    }
1410 
 
 1557 
 
1411 
    if ( $? == 0 )
 1558 
    if ( $? == 0 )
1412 
    {
 1559 
    {
1413 
        #
 1560 
        #
1414 
        #   Mark has having been transferred in the current cycle
 1561 
        #   Mark has having been transferred in the current cycle
Line 1501... Line 1648...
1501 
# Function        : parsePkgList
 1648 
# Function        : parsePkgList
1502 
#
 1649 
#
1503 
# Description     : Parse one line from a pkgList
 1650 
# Description     : Parse one line from a pkgList
1504 
#                   Lines are multiple item="data" items
 1651 
#                   Lines are multiple item="data" items
1505 
#                       time="1497586865" GMT="Fri Jun 16 04:21:05 2017" pname="ERGissaccounts" pver="1.0.7169.mas"
 1652 
#                       time="1497586865" GMT="Fri Jun 16 04:21:05 2017" pname="ERGissaccounts" pver="1.0.7169.mas"
- 
 
 1653 
#                       time="1497586865" GMT="Fri Jun 16 04:21:05 2017" pname="ERGissaccounts" pver="1.0.7169.mas" link="latest"
1506 
#
 1654 
#
1507 
# Inputs          : $line                   - Line of data
 1655 
# Inputs          : $line                   - Line of data
1508 
#                   $hashp                  - Ref to hash to populate
 1656 
#                   $hashp                  - Ref to hash to populate
1509 
#
 1657 
#
1510 
# Returns         : A hash of data items
 1658 
# Returns         : A hash of data items
Line 1644... Line 1792...
1644 
            {
 1792 
            {
1645 
                m~(.*):(.*)~;
 1793 
                m~(.*):(.*)~;
1646 
                if ( grep( /^$1$/, @recoverTags ) )
1794 
                if ( grep( /^$1$/, @recoverTags ) )
1647 
                {
 1795 
                {
1648 
                    $statistics{$1} = $2;
 1796 
                    $statistics{$1} = $2;
1649 
                    $logger->verbose("readStatistics $1, $2\n");
 1797 
                    $logger->verbose("readStatistics $1, $2");
1650 
                }
 1798 
                }
1651 
            }
 1799 
            }
1652 
            close $fh;
 1800 
            close $fh;
1653 
            $yday = (localtime($statistics{dayStart}))[7];
 1801 
            $yday = (localtime($statistics{dayStart}))[7];
1654 
        }
 1802 
        }
Line 1807... Line 1955...
1807 
sub Warning
 1955 
sub Warning
1808 
{
 1956 
{
1809 
    $logger->warn("@_");
 1957 
    $logger->warn("@_");
1810 
}
 1958 
}
1811 
 
 1959 
 
1812 
 
 - 
 
1813 
 
 - 
 
1814 
 
 -