Subversion Repositories DevTools

Rev

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

Rev 5783 Rev 5818
Line 70... Line 70...
70 
my $parchive;
 70 
my $parchive;
71 
my $local = '';
 71 
my $local = '';
72 
my $local_pkg;
 72 
my $local_pkg;
73 
my @package_list;
 73 
my @package_list;
74 
my @refresh_list;
 74 
my @refresh_list;
- 
 
 75 
 
75 
#
 76 
#
76 
#   Globals for recursive copy
 77 
#   Globals for recursive copy
77 
#
 78 
#
78 
my $copyFind_dst;
 79 
my $copyFind_dst;
79 
my $copyFind_src;
 80 
my $copyFind_src;
80 
my $copyFind_src_len;
 81 
my $copyFind_src_len;
- 
 
 82 
my $copyFind_touch;
- 
 
 83 
my $copyFind_time;;
81 
 
 84 
 
82 
#
 85 
#
83 
#   Globals for error recovery
 86 
#   Globals for error recovery
84 
#
 87 
#
85 
my  $remove_on_error;
 88 
my  $remove_on_error;
- 
 
 89 
my  $cacheMarker;
86 
 
 90 
 
87 
#-------------------------------------------------------------------------------
 91 
#-------------------------------------------------------------------------------
88 
# Function        : Mainline Entry Point
 92 
# Function        : Mainline Entry Point
89 
#
 93 
#
90 
# Description     :
 94 
# Description     :
Line 383... Line 387...
383 
#   Process the command line arguments
 387 
#   Process the command line arguments
384 
#   These MUST be of the form
 388 
#   These MUST be of the form
385 
#       packagename
 389 
#       packagename
386 
#       packagename/version
 390 
#       packagename/version
387 
#
 391 
#
388 
 
 - 
 
389 
for (@ARGV, @refresh_list)
 392 
for (@ARGV, @refresh_list)
390 
{
 393 
{
391 
    $remove_on_error = undef;
 394 
    $remove_on_error = undef;
- 
 
 395 
    $cacheMarker = undef;
- 
 
 396 
 
392 
    if ( $opt_flush )
 397 
    if ( $opt_flush )
393 
    {
 398 
    {
394 
        unless ( -d "$cache/$_" )
 399 
        unless ( -d "$cache/$_" )
395 
        {
 400 
        {
396 
            Warning ("Package not in cache: $_")
 401 
            Warning ("Package not in cache: $_")
Line 455... Line 460...
455 
        }
 460 
        }
456 
 
 461 
 
457 
        ########################################################################
 462 
        ########################################################################
458 
        #   We have a package to process
 463 
        #   We have a package to process
459 
        #
 464 
        #
460 
 
 - 
 
461 
        my $dir_found = ( -d "$cache/$_" ) ;
 465 
        my $dir_found = 0;
462 
        my $force_update = 0;
 466 
        my $force_update = 0;
463 
        my $opr = "Update";
 467 
        my $opr = "Update";
464 
 
 468 
 
- 
 
 469 
        #
- 
 
 470 
        #   Generate the 'name' of a marker file used to indicate that the version is being updated
- 
 
 471 
        #   This is outside the target directory
- 
 
 472 
        #
- 
 
 473 
        $cacheMarker = "$_/built.cache";
- 
 
 474 
        $cacheMarker =~ tr~/~_~s;
- 
 
 475 
        $cacheMarker =~ tr~_~_~s;
- 
 
 476 
        $cacheMarker =  $cache . '/' . $cacheMarker;
- 
 
 477 
        Verbose2("cacheMarker: $cacheMarker");
465 
 
 478 
 
466 
        #
 479 
        #
467 
        #   Setup error recovery
 480 
        #   Setup error recovery
468 
        #       1) Tag the directory to be deleted on error
 481 
        #       1) Tag the directory to be deleted on error
469 
        #
 482 
        #
Line 472... Line 485...
472 
 
 485 
 
473 
        #
 486 
        #
474 
        #   Not a forced refresh. Ensure that the cached copy is
 487 
        #   Not a forced refresh. Ensure that the cached copy is
475 
        #   up to date. Examine descpkg
 488 
        #   up to date. Examine descpkg
476 
        #
 489 
        #
- 
 
 490 
        $dir_found = waitForComplete($_,$cache);
477 
        if ( $dir_found )
 491 
        if ( $dir_found && !$opt_refresh )
478 
        {
 492 
        {
479 
            if ( -f "$cache/$_/built.cache" )
 - 
 
480 
            {
 - 
 
481 
                $force_update = 1;
 - 
 
482 
                $opr = "Incomplete";
 - 
 
483 
                Verbose ("Cache Copy Incomplete: $_");
 - 
 
484 
            }
 - 
 
485 
            elsif ( FileIsNewer( "$parchive/descpkg", "$cache/$_/descpkg" ) )
 493 
            if ( FileIsNewer( "$parchive/descpkg", "$cache/$_/descpkg" ) )
486 
            {
 494 
            {
487 
                $force_update = 1;
 495 
                $force_update = 1;
488 
                $opr = "OutOfDate";
 496 
                $opr = "OutOfDate";
- 
 
 497 
                TouchFile ( $cacheMarker, "Marks the cache copy as incomplete");
489 
                Verbose ("Cache out-of-date: $_");
 498 
                Verbose ("Cache out-of-date: $_");
490 
            }
 499 
            }
491 
        }
 500 
        }
492 
 
 501 
 
493 
        #
 502 
        #
Line 506... Line 515...
506 
            $dir_found = 0;
 515 
            $dir_found = 0;
507 
            $opr = '';
 516 
            $opr = '';
508 
        }
 517 
        }
509 
 
 518 
 
510 
        #
 519 
        #
- 
 
 520 
        #   If the directory exists, then we need to avoid a race condition
- 
 
 521 
        #   where multiple instances are updating the same directory
- 
 
 522 
        #       Need to aviod hanging forever if the primary updator does not
- 
 
 523 
        #       complete the task
511 
        #   If its not in the cache then copy it in
 524 
        #   If its not in the cache then copy it in
512 
        #
 525 
        #
- 
 
 526 
        $dir_found = waitForComplete($_,$cache);
513 
        unless ( $dir_found )
 527 
        unless ( $dir_found )
514 
        {
 528 
        {
515 
            print "Cache $opr: $_ -> $cache\n" if $opr;
 529 
            print "Cache $opr: $_ -> $cache\n" if $opr;
516 
            mkpath( "$cache/$_", $opt_debug, 0777);
 530 
            mkpath( "$cache/$_", $opt_debug, 0777);
517 
            TouchFile ( "$cache/$_/built.cache", "Marks the cache copy as incomplete");
 531 
            TouchFile ( $cacheMarker, "Marks the cache copy as incomplete");
518 
            Verbose ( "Copy in: $_" );
 532 
            Verbose ( "Copy in: $_" );
519 
            $copyFind_dst = "$cache/$_";
 533 
            $copyFind_dst = "$cache/$_";
520 
            $copyFind_src = $parchive;
 534 
            $copyFind_src = $parchive;
521 
            $copyFind_src_len = length( $copyFind_src );
 535 
            $copyFind_src_len = length( $copyFind_src );
- 
 
 536 
            $copyFind_touch = $cacheMarker;
- 
 
 537 
            $copyFind_time = 0;
522 
            File::Find::find( \&copyFind, $parchive );
 538 
            File::Find::find( \&copyFind, $parchive );
523 
            rmtree( "$cache/$_/built.cache", $opt_debug );  # Works on files too !!
 539 
            rmtree( $cacheMarker, $opt_debug );  # Works on files too !!
524 
        }
 540 
        }
525 
        else
 541 
        else
526 
        {
 542 
        {
527 
            $opr = "Skip";
 543 
            $opr = "Skip";
528 
            print "Cache $opr: $_ -> $cache\n";
 544 
            print "Cache $opr: $_ -> $cache\n";
529 
        }
 545 
        }
530 
    }
 546 
    }
531 
}
 547 
}
532 
 
 548 
 
533 
#-------------------------------------------------------------------------------
 549 
#-------------------------------------------------------------------------------
- 
 
 550 
# Function        : waitForComplete
- 
 
 551 
#
- 
 
 552 
# Description     : Wait for a package-version to complete
- 
 
 553 
#                   At the end of this operation the directory will be
- 
 
 554 
#                   completly transferred, or it will be deleted
- 
 
 555 
#
- 
 
 556 
#                   If the directory exists, then we need to avoid a race condition
- 
 
 557 
#                   where multiple instances are updating the same directory
- 
 
 558 
#                   Need to avoid hanging forever if the primary updator does not
- 
 
 559 
#                   complete the task
- 
 
 560 
#
- 
 
 561 
# Inputs          : $dir    - Subdir directory to monitor
- 
 
 562 
#                   $cache  - Target cache
- 
 
 563 
#
- 
 
 564 
# Returns         : 0   - $dir does not exist
- 
 
 565 
#                   1   - $dir does exist
- 
 
 566 
#
- 
 
 567 
sub waitForComplete
- 
 
 568 
{
- 
 
 569 
    my ($dir, $cache) = @_;
- 
 
 570 
    my $opr;
- 
 
 571 
    my $tgtDir = "$cache/$dir";
- 
 
 572 
    #
- 
 
 573 
    #   Directory not preset
- 
 
 574 
    #       All done - dir does not exist
- 
 
 575 
    #
- 
 
 576 
    if (! -d $tgtDir)
- 
 
 577 
    {
- 
 
 578 
        return 0;
- 
 
 579 
    }
- 
 
 580 
 
- 
 
 581 
    # If the package is not being updated, then we are done if the
- 
 
 582 
    # package being updated marker is NOT present
- 
 
 583 
    #
- 
 
 584 
    if (  -d $tgtDir && ! -f $cacheMarker)
- 
 
 585 
    {
- 
 
 586 
        return 98;
- 
 
 587 
    }
- 
 
 588 
 
- 
 
 589 
    #
- 
 
 590 
    #   The package-version is being updated by another instance
- 
 
 591 
    #   Hang around waiting for the update to complete or terminate
- 
 
 592 
    #       Wait 10 minutes max
- 
 
 593 
    #
- 
 
 594 
    my  $waitStart = time();
- 
 
 595 
    $opr = "Wait";
- 
 
 596 
    print "Cache $opr: $dir -> $cache\n";
- 
 
 597 
    while (1)
- 
 
 598 
    {
- 
 
 599 
        if ( ! -d $tgtDir )
- 
 
 600 
        {
- 
 
 601 
            # Directory has gone away
- 
 
 602 
            #   Must have been a bad transfer by another instance
- 
 
 603 
            #   Start the processing again
- 
 
 604 
            $opr = "Retry";
- 
 
 605 
            print "Cache $opr: $dir -> $cache\n";
- 
 
 606 
            return 0;
- 
 
 607 
        }
- 
 
 608 
 
- 
 
 609 
        if ( ! -f $cacheMarker )
- 
 
 610 
        {
- 
 
 611 
            #
- 
 
 612 
            #   Update must have completed - marker file has been removed
- 
 
 613 
            #
- 
 
 614 
            $opr = "Found";
- 
 
 615 
            print "Cache $opr: $_ -> $cache\n";
- 
 
 616 
            return 97;
- 
 
 617 
        }
- 
 
 618 
 
- 
 
 619 
        #
- 
 
 620 
        #   Determine the 'age' of the marker file
- 
 
 621 
        #       It will be updated after each file in the package has been copied
- 
 
 622 
        #       If it is too old, then we must assume that the other instance died
- 
 
 623 
        #   Complication. Windows does not correctly report the 'modified' time of a file
- 
 
 624 
        #                 It gets messed up by the file system. Can't use the modified info
- 
 
 625 
        #                 from Perls stat function to determine the absolute modified time of the
- 
 
 626 
        #                 file.
- 
 
 627 
        #
- 
 
 628 
        #       Solution: Create a temp file and determine the age relative to that file
- 
 
 629 
        #
- 
 
 630 
 
- 
 
 631 
        my $cacheMarkerTmp = $cacheMarker . ".tmp";
- 
 
 632 
        TouchFile($cacheMarkerTmp, "Relative time stamp");
- 
 
 633 
        my $now   = (stat ($cacheMarkerTmp))[9];
- 
 
 634 
        my $mtime = (stat ($cacheMarker))[9];
- 
 
 635 
        rmtree( $cacheMarkerTmp, $opt_debug );
- 
 
 636 
 
- 
 
 637 
        #
- 
 
 638 
        #   If the marker file is older than 5 minutes then we can consider the package as
- 
 
 639 
        #   a dud. The marker file will be updated be every file write into the cache. Its
- 
 
 640 
        #   an indication of activity.
- 
 
 641 
        #
- 
 
 642 
        #   Assume that no file is going to take more then 5 minutes to copy
- 
 
 643 
        #   Lets see how this goes.
- 
 
 644 
        #
- 
 
 645 
        my $age = $now - $mtime;
- 
 
 646 
        if ( $age > 5 * 60)
- 
 
 647 
        {
- 
 
 648 
            #
- 
 
 649 
            #   Update taking too long
- 
 
 650 
            #       Delete the package-version
- 
 
 651 
            #       Try again
- 
 
 652 
            #
- 
 
 653 
            $opr = "Remove Bad";
- 
 
 654 
            print "Cache $opr: $_ -> $cache\n";
- 
 
 655 
            rmtree( "$cache/$_", $opt_debug );
- 
 
 656 
 
- 
 
 657 
            return 0;
- 
 
 658 
        }
- 
 
 659 
 
- 
 
 660 
        #
- 
 
 661 
        #   Wait a short while
- 
 
 662 
        #
- 
 
 663 
        Verbose("Waiting: " . (time() - $waitStart));
- 
 
 664 
        sleep(5);
- 
 
 665 
    }
- 
 
 666 
}
- 
 
 667 
 
- 
 
 668 
 
- 
 
 669 
#-------------------------------------------------------------------------------
534 
# Function        : copyFind
 670 
# Function        : copyFind
535 
#
 671 
#
536 
# Description     : File:Find:find callback function to transfer files
 672 
# Description     : File:Find:find callback function to transfer files
537 
#
 673 
#
538 
# Inputs          : None
 674 
# Inputs          : None
539 
#                   Global: $copyFind_dst       : Target directory
 675 
#                   Global: $copyFind_dst       : Target directory
540 
#                   Global: $copyFind_src       : Source directory
 676 
#                   Global: $copyFind_src       : Source directory
541 
#                   Global: $copyFind_src_len   : Length of Source dir
 677 
#                   Global: $copyFind_src_len   : Length of Source dir
- 
 
 678 
#                   Global: $copyFind_touch     : File to touch after each operation
- 
 
 679 
#                   Global: $copyFind_time      ; Time of last touch
542 
#
 680 
#
543 
# Returns         :
681 
# Returns         :
544 
#
 682 
#
545 
 
 683 
 
546 
sub copyFind
 684 
sub copyFind
547 
{
 685 
{
548 
    my $item = $File::Find::name;
 686 
    my $item = $File::Find::name;
- 
 
 687 
#Debug0("Remove sleep in copy");
- 
 
 688 
#sleep(1);
549 
 
 689 
 
550 
    #
 690 
    #
551 
    #   Calculate the target directory name
 691 
    #   Calculate the target directory name
552 
    #
 692 
    #
553 
    my $tgt_path = substr($item, $copyFind_src_len );
 693 
    my $tgt_path = substr($item, $copyFind_src_len );
Line 610... Line 750...
610 
        else
 750 
        else
611 
        {
 751 
        {
612 
            Error("Failed to copy file [$item] to [$target]: $!");
 752 
            Error("Failed to copy file [$item] to [$target]: $!");
613 
        }
 753 
        }
614 
    }
 754 
    }
- 
 
 755 
 
- 
 
 756 
    #
- 
 
 757 
    #   Touch this file to indicate that the copy operation is still in progress
- 
 
 758 
    #   Assists in early detection of partial copies
- 
 
 759 
    #
- 
 
 760 
    #   Only touch once a minute to prevent hammering the file system
- 
 
 761 
    #
- 
 
 762 
    my $age = time() - $copyFind_time;
- 
 
 763 
    if ($age > 60)
- 
 
 764 
    {
- 
 
 765 
        $copyFind_time = time();
- 
 
 766 
        TouchFile ( $copyFind_touch, "Marks the cache copy as incomplete");
- 
 
 767 
    }
615 
}
 768 
}
616 
 
 769 
 
617 
#-------------------------------------------------------------------------------
 770 
#-------------------------------------------------------------------------------
618 
# Function        : error_recovery
 771 
# Function        : error_recovery
619 
#
 772 
#
Line 630... Line 783...
630 
    {
 783 
    {
631 
        ReportError ("Error cleanup. Delete cache entry: $remove_on_error");
 784 
        ReportError ("Error cleanup. Delete cache entry: $remove_on_error");
632 
        rmtree( $remove_on_error, $opt_debug );
 785 
        rmtree( $remove_on_error, $opt_debug );
633 
        $remove_on_error = undef;
 786 
        $remove_on_error = undef;
634 
    }
 787 
    }
- 
 
 788 
 
- 
 
 789 
    if ($cacheMarker)
- 
 
 790 
    {
- 
 
 791 
        ReportError ("Error cleanup. Delete cache marker: $cacheMarker");
- 
 
 792 
        rmtree( $cacheMarker, $opt_debug );
- 
 
 793 
        $cacheMarker = undef;
- 
 
 794 
    }
635 
}
 795 
}
636 
 
 796 
 
637 
 
 797 
 
638 
#-------------------------------------------------------------------------------
 798 
#-------------------------------------------------------------------------------
639 
# Function        : age_the_cache
 799 
# Function        : age_the_cache