Subversion Repositories DevTools

Rev

Rev 7367 | Blame | Compare with Previous | Last modification | View Log | RSS feed 

########################################################################
# Copyright (C) 1998-2013 Vix Technology, All rights reserved
#
# Module name   : jats_quarantine.pl
# Module type   : Makefile system
# Compiler(s)   : Perl
# Environment(s): jats
#
# Description   :  Remove packages from dpkg_archive that are no longer
#                  required - if they can be rebuilt.
#
#                  Keep package version if
#                   Cannot be rebuilt
#                   It is in use by a non-archived release
#                   It is a dependent package of a package in a non-archived release
#                   It is an exposed package in an non-deprecated SDK
#                   It is used in one of the last two SBOMs (within Deployment Manager)
#                   defined within each state of each branch of each project.
#                   It is a dependent package of one of the SBOM packages
#
#                   Packages that are not in RM will be purged
#
#
# Usage         :  See POD at end of file
#
#......................................................................#

require 5.008_002;
use strict;
use warnings;

use Pod::Usage;
use Getopt::Long;

use JatsError;
use JatsSystem;
use Getopt::Long;
use Pod::Usage;                             # required for help support
use JatsRmApi;
use ConfigurationFile;
use File::Path;
use File::Basename;

use DBI;

#
#   Options - global
#
my $VERSION = "2.0.0";                      # Update this
my $opt_verbose = 0;
my $opt_help = 0;
my $opt_manual;
my $opt_test;
my $opt_limit;
my $opt_quick;
my $opt_phase = '123';                      # Default - do all, but don't save data
my $opt_purge;
my $opt_pcount = 0;
my $opt_explain;

#
#   Globals
#
my $progBase;
my $RM_DB;
my $DM_DB;
my $now = time();
my $quarantineInstance;
my $logPath;
my %pkgPvid;
my @quarantineItems;
my @StrayPackages;

our %Releases;
our %Packages;

#
# Default config information
# May be replaced by xxx.cnf file
#   qdirAge = 0 => No local quarantine
#
my %config = (
    'retain'        => '31',
    'qdirAge'       => '90',
    'snapAge'       => '10',
    'retainNoRm'    => '31',
    'quarantine'    => '/export/devl/quarantine',
    'dpkg_archive'  => '/export/devl/dpkg_archive',
    'logBase'       => '/export/devl/dpkg_archive/.dpkg_archive/quarantinelog',
    'verbose'       => '0',
    'S3Bucket'      => 'auawsaddp001',
    'S3Key'         => 'Mandatory',
    'S3Secret'      => 'Mandatory',
    );

# List of packages to be retained
# May be supplemented by xxx.cnf file
my %retainPkgs = (
    'core_devl' => 1,
);

#
#   Statistics
#   Listed here to ensure that they exist in the stats file
#
my %statistics = (
    timeStamp               => 0,               # Age of the stats file
    statsName               => 'Quarantine',    # Name of the stats file
    state                   => 'OK',            # Overall reported state

    # Error counters
    QuarantineError         => 0,
    S3TransferError         => 0,

    # Major Statistics
    Quarantine              => 0,

    # Minor Statistics
    fileNotInReleaseManager => 0,
    inDeploymentManager     => 0,
    inSdk                   => 0,
    isPatch                 => 0,
    ManualBuild             => 0,
    RetainTime              => 0,
    NoBuildStandard         => 0,
    NoPackageEntry          => 0,
    NoPVid                  => 0,
    NotInArchive            => 0,
    NotInReleaseManager     => 0,
    NotLocked               => 0,
    SecondLevelPackage      => 0,
    TopLevelPackage         => 0,
    TotalPackages           => 0,
);

#-------------------------------------------------------------------------------
# Function        : Main Entry
#
# Description     :
#
# Inputs          :
#
# Returns         :
#
my $result = GetOptions (
                "help+"         => \$opt_help,          # flag, multiple use allowed
                "manual"        => \$opt_manual,        # flag
                "verbose:+"     => \$opt_verbose,       # flag
                "explain:+"     => \$opt_explain,       # flag
                "test:+"        => \$opt_test,          # Test a version string
                "limit:n"       => \$opt_limit,         #
                "phase:s"       => \$opt_phase,         # Phase to do
                "quick"         => \$opt_quick,         # Don't look for indirects
                "purge"         => \$opt_purge,         # Purge old quarantined packages
                "pcount:n"      => \$opt_pcount,        # Count of packages to purge in one hit
                );

#
#   Process help and manual options
#
pod2usage(-verbose => 0, -message => "Version: $VERSION")  if ($opt_help == 1  || ! $result);
pod2usage(-verbose => 1)  if ($opt_help == 2 );
pod2usage(-verbose => 2)  if ($opt_manual || ($opt_help > 2));
ErrorConfig( 'name'    => 'QUARANTINE',
             'verbose' => $opt_verbose );

#
#   This utility must be run on the package server
my $runHost = 'auawsaarc001';
my $hostname = lc $ENV{HOSTNAME} || 'Unknown';
Warning("Not running on $runHost") unless ( $hostname eq $runHost );

#
#   Needs to run as root so that packages can be moved no matter what the
#   file permissions are
#
Warning( "Not running as root") if ( $> );

#
#   Determine the base of this program
#   Will be used to find config and local utils
#
$progBase = $0;
$progBase =~ s~/[^/]+$~~;
Verbose("ProgBase: $0: $progBase");

#   Read config file
#   Use max of user verbosity or config verbosity
#
ReadConfig();
if ( $config{verbose} > $opt_verbose )
{
    $opt_verbose = $config{verbose};
    ErrorConfig( 'verbose' => $opt_verbose );
}

#
#   Collect data from Release Manager
#
if ( $opt_phase =~ m~1~ && !$opt_purge )
{
    getReleaseDetails();
    GetAllPackageData();
    getTopLevelPackages();
    GetRecentDMPackages();
    LocateStrays() unless ($opt_quick);
    GetSdkPackageData();

    if ( $opt_verbose > 1 )
    {
        print "=========================================================================\n";
        DebugDumpData("Releases", \%Releases);
        print "=========================================================================\n";
        DebugDumpData("Packages", \%Packages );
    }
}

#
#   Scan dpkg_archive and quarantine packages
#
if ( $opt_phase =~ m~2~ )
{
    prepQdir();
    unless ($opt_purge) {
        readInputData();
        processDpkgArchive();
        reportMissingPkgs();
        reportStats();
    }

    Verbose ("Quarantine to: $quarantineInstance");
    Verbose ("Log to: $logPath");
}

#
#   Save internal data for reuse
#   Used only for testing of indiviual phases
#
unless ( $opt_phase =~ m~3~ )
{
    savePhaseData();
}

ErrorDoExit();
exit;

#-------------------------------------------------------------------------------
# Function        : ReadConfig
#
# Description     : Read in config file
#                   Must be inthe same directory as the executable
#
# Inputs          : 
#
# Returns         : 
#

sub ReadConfig
{
    my $config = $0;
    $config =~ s~\.pl$~.cnf~;
    open (CF, '<', $config ) || Error ("Connot open: $config");
    while ( <CF> )
    {
        s~\s+$~~;
        s~^\s+~~;
        next if ( m~\s*#~ );        # Comment
        next unless $_;             # Empty
        if ( m~(.*?)\s*=\s*(.*)~ ) {
            ReportError ("Unknown config value: $1") unless ( exists $config{$1} );
            $config{$1} = $2;
        } else {
            $retainPkgs{$_} = 1;
        }
    }
    close CF;
    ErrorDoExit();
}

#-------------------------------------------------------------------------------
# Function        : getReleaseDetails
#
# Description     : Determine all candiate releases
#
# Inputs          : 
#
# Returns         : 
#
sub getReleaseDetails
{
    my (@row);

    Verbose ("Determine all Release Names");

    # if we are not or cannot connect then return 0 as we have not found anything
    connectRM(\$RM_DB) unless $RM_DB;

    # Get all Releases
    # From non-archived releases
    my $m_sqlstr = "SELECT prj.PROJ_NAME, rt.RTAG_NAME, rt.PROJ_ID, rt.RTAG_ID, rt.official, TRUNC (SYSDATE - rt.official_stamp) as OFFICIAL_STAMP_DAYS, TRUNC (SYSDATE - rt.created_stamp) as CREATED_STAMP_DAYS" .
                   " FROM release_manager.release_tags rt, release_manager.projects prj" .
                   " WHERE prj.PROJ_ID = rt.PROJ_ID " .
                   "   AND rt.official != 'A' ORDER BY UPPER(prj.PROJ_NAME), UPPER(rt.RTAG_NAME)";
#                   "   AND rt.official != 'Y'" .

    Verbose3("getReleaseDetails: $m_sqlstr");
    my $sth = $RM_DB->prepare($m_sqlstr);
    if ( defined($sth) )
    {
        if ( $sth->execute( ) )
        {
            if ( $sth->rows )
            {
                while ( @row = $sth->fetchrow_array )
                {
                    my $rtag_id =$row[3];
                    my $proj_id = $row[2];
                    my $official = $row[4];
                    my $age = defined($row[5]) ? $row[5] : $row[6];

                    # Only retain recent snapshot
                    if ($official eq 'S' && $age > $config{snapAge}) {
                        next;
                    }
                    
#if ( $official eq 'Y' ) {
#    Information("Closed Age ($proj_id) : $age : $row[0], $row[1]");
#}
#                    if ( $official eq 'Y' && $age && $age > 300 )
#                    {
#                        next;
#                    }

                    $Releases{$rtag_id}{pName} = $row[0];
                    $Releases{$rtag_id}{name} = $row[1];
                    $Releases{$rtag_id}{proj_id} = $proj_id;
                    $Releases{$rtag_id}{rtag_id} = $rtag_id;
                    $Releases{$rtag_id}{official} = $row[4];
                    $Releases{$rtag_id}{officialDays} = defined($row[5]) ? $row[5] : $row[6] ;
                    $Releases{$rtag_id}{createdDays} = $row[6];

                    print join (',',@row), "\n" if ($opt_verbose > 2);
                }
            }
            $sth->finish();
        }
        else
        {
            Error("getReleaseDetails:Execute failure: $m_sqlstr", $sth->errstr() );
        }
    }
    else
    {
        Error("getReleaseDetails:Prepare failure" );
    }
}

#-------------------------------------------------------------------------------
# Function        : GetAllPackageData
#
# Description     : Extract all package data
#
# Inputs          : 
#
# Returns         : 
#

sub GetAllPackageData
{
    my (@row);
    my $count = 0;

    # if we are not or cannot connect then return 0 as we have not found anything
    connectRM(\$RM_DB) unless $RM_DB;

    Verbose ("Extract all package data");

    # First get all packages
    # From non-archived releases

    my $limit = $opt_limit ? " AND rownum <= $opt_limit" : '';
    my $m_sqlstr = "SELECT DISTINCT " .
                        "pv.PV_ID, " .                                          #[0]
                        "pkg.PKG_NAME, " .                                      #[1]
                        "pv.PKG_VERSION, " .                                    #[2]
                        "pv.DLOCKED, " .                                        #[3]
                        "pv.PKG_ID," .                                          #[4]
                        "pv.is_patch," .                                        #[5]
                        "pv.build_type,".                                       #[6]
                        "pbi.bsa_id," .                                         #[7]
#                        "pv.CREATOR_ID, " .                                     #[8]
#                        "pv.MODIFIED_STAMP, " .                                 #[9]
#                        "release_manager.PK_RMAPI.return_vcs_tag(pv.PV_ID), " . #[10]
                        "999" .
                   " FROM RELEASE_MANAGER.PACKAGE_VERSIONS pv,".
                         "RELEASE_MANAGER.PACKAGES pkg,".
                         "release_manager.package_build_info pbi" .
                   " WHERE pv.PKG_ID = pkg.PKG_ID" .
                   "   AND pv.pv_id = pbi.pv_id(+)" .
                    $limit ;
    Verbose3("GetAllPackageData: $m_sqlstr");
    my $sth = $RM_DB->prepare($m_sqlstr);
    if ( defined($sth) )
    {
        if ( $sth->execute( ) )
        {
            if ( $sth->rows )
            {
                while ( @row = $sth->fetchrow_array )
                {
                    $count++;
                    print join (',',@row), "\n" if ($opt_verbose > 2);
                    my $pvid = $row[0];
                    unless ( exists $Packages{$pvid}{name} )
                    {
                        $Packages{$pvid}{name} = $row[1];
                        $Packages{$pvid}{version} = $row[2];
                        $Packages{$pvid}{locked} = $row[3];
                        $Packages{$pvid}{pkgid} = $row[4];
                        $Packages{$pvid}{isPatch} = $row[5] || 0;
                        $Packages{$pvid}{buildType} = $row[6] || 0;
                        $Packages{$pvid}{buildStandard} = $row[7] || 0;

                        #$Packages{$pvid}{Creator} = $row[8];
                        #$Packages{$pvid}{Age} = $row[9];
                        #$Packages{$pvid}{vcstag} = $row[10];
                        
                    }

                    if ( $opt_limit )
                    {
                        last if ( $count > $opt_limit );
                    }
                }
            }
            $sth->finish();
        }
        else
        {
            Error("GetAllPackageData:Execute failure: $m_sqlstr", $sth->errstr() );
        }
    }
    else
    {
        Error("GetAllPackageData:Prepare failure" );
    }

    Verbose ("All Packages: $count rows");
}

#-------------------------------------------------------------------------------
# Function        : getTopLevelPackages
#
# Description     : Extract top level packages from active releases
#
# Inputs          : 
#
# Returns         : 
#

sub getTopLevelPackages
{
    my (@row);
    my $count = 0;

    # if we are not or cannot connect then return 0 as we have not found anything
    connectRM(\$RM_DB) unless $RM_DB;

    Verbose ("Extract toplevel dependencies");

    # First get all packages that are referenced in a Release
    # This will only get the top level packages
    # From non-archived releases

    my $limit = $opt_limit ? " AND rownum <= $opt_limit" : '';
    my $m_sqlstr = "SELECT DISTINCT " .
                        "rc.PV_ID, " .                                          #[0]
                        "rt.RTAG_ID, " .                                        #[1]
                        "prj.PROJ_ID, " .                                       #[2]
                        "rt.official, " .                                       #[3]    
                        "TRUNC (SYSDATE - rt.official_stamp),".                 #[4]
                        "TRUNC (SYSDATE - rt.created_stamp)" .                  #[5]
                   " FROM RELEASE_MANAGER.RELEASE_CONTENT rc, ".
                         "release_manager.release_tags rt,".
                         "release_manager.projects prj" .
                   " WHERE prj.PROJ_ID = rt.PROJ_ID" .
                   "   and rt.RTAG_ID = rc.RTAG_ID" .
                   "   AND rt.official != 'A'" .
#                   "   AND rt.official != 'Y' " .
                    $limit;

    Verbose3("getTopLevelPackages: $m_sqlstr");
    my $sth = $RM_DB->prepare($m_sqlstr);
    if ( defined($sth) )
    {
        if ( $sth->execute( ) )
        {
            if ( $sth->rows )
            {
                while ( @row = $sth->fetchrow_array )
                {
                    my $pvid = $row[0];
                    my $rtag_id = $row[1];
                    my $proj_id = $row[2];
                    my $official = $row[3];
                    my $age = defined($row[4]) ? $row[4] : $row[6];

                    # Only retain recent snapshot
                    if ($official eq 'S' && $age > $config{snapAge}) {
                        next;
                    }

                    $count++;
                    print join (',',@row), "\n" if ($opt_verbose > 2);
                    $Packages{$pvid}{tlp} = 1;
                    push @StrayPackages, $pvid;
                    

                    push @{$Packages{$pvid}{release}}, $rtag_id;

                    push @{$Packages{$pvid}{projects}}, $proj_id
                        unless (grep {$_ eq $proj_id} @{$Packages{$pvid}{projects}});

                    if ( $opt_limit )
                    {
                        last if ( $count > $opt_limit );
                    }
                }
            }
            $sth->finish();
        }
        else
        {
            Error("getTopLevelPackages:Execute failure: $m_sqlstr", $sth->errstr() );
        }
    }
    else
    {
        Error("getTopLevelPackages:Prepare failure" );
    }

    Verbose ("Extract toplevel dependencies: $count rows");
}

#-------------------------------------------------------------------------------
# Function        : GetSdkPackageData
#
# Description     : Extract Packages that are a part of a non-deprecated SDK
#                   Only want the exposed packages
#
#                   Don't care about the dependencies, so don't add them 
#                   to strays
#
# Inputs          : 
#
# Returns         : 
#

sub GetSdkPackageData
{
    my (@row);
    my $count = 0;

    # if we are not or cannot connect then return 0 as we have not found anything
    connectRM(\$RM_DB) unless $RM_DB;

    Verbose ("Extract SDK Packages");

    # Get all packages that are a part of a non-deprecated SDK
    # Only get the 'exposed' packages

    my $limit = $opt_limit ? " AND rownum <= $opt_limit" : '';
    my $m_sqlstr = "SELECT sc.pv_id, " .                #[0]
                   "       p.PKG_NAME, " .              #[1]
                   "       pv.PKG_VERSION" .            #[2]
                   " FROM RELEASE_MANAGER.SDK_CONTENT sc," .
                   "   RELEASE_MANAGER.sdk_tags st," .
                   "   RELEASE_MANAGER.package_versions pv," .
                   "   RELEASE_MANAGER.PACKAGES p" .
                   " WHERE sc.SDKTAG_ID    = st.SDKTAG_ID" .
                   " AND p.PKG_ID = pv.PKG_ID" .
                   " AND pv.PV_ID = sc.pv_id" .
                   " AND sc.SDKPKG_STATE   = 'E'" .
                   " AND st.SDK_STATE NOT IN ('D')" .
                    $limit;

    Verbose3("GetSdkPackageData: $m_sqlstr");
    my $sth = $RM_DB->prepare($m_sqlstr);
    if ( defined($sth) )
    {
        if ( $sth->execute( ) )
        {
            if ( $sth->rows )
            {
                while ( @row = $sth->fetchrow_array )
                {
                    $count++;
                    print join (',',@row), "\n" if ($opt_verbose > 2);
                    my $pvid = $row[0];
                    $Packages{$pvid}{sdk} = 1;
                    unless ( exists $Packages{$pvid}{name} )
                    {
                        $Packages{$pvid}{name} = $row[1];
                        $Packages{$pvid}{version} = $row[2];
                    }

                    if ( $opt_limit )
                    {
                        last if ( $count > $opt_limit );
                    }
                }
            }
            $sth->finish();
        }
        else
        {
            Error("GetSdkPackageData:Execute failure: $m_sqlstr", $sth->errstr() );
        }
    }
    else
    {
        Error("GetSdkPackageData:Prepare failure" );
    }

    Verbose ("Extract SDK Packages: $count rows");
}

#-------------------------------------------------------------------------------
# Function        : GetRecentDMPackages
#
# Description     : Extract Packages that referenced in Deployment Manager
#                   Want all package-versions from the last two BOMS in each state
#                   of all projects. 
#
# Inputs          : 
#
# Returns         : 
#

sub GetRecentDMPackages
{
    my (@row);
    my $count = 0;

    # if we are not or cannot connect then return 0 as we have not found anything
    connectDM(\$DM_DB) unless ($DM_DB);

    Verbose ("Extract DM Packages");

    # Get all packages that are a part of a non-deprecated SDK
    # Only get the 'exposed' packages

    my $limit = $opt_limit ? " AND rownum <= $opt_limit" : '';
    my $m_sqlstr =
        "SELECT DISTINCT pv.pv_id," .                         #[0]
        "  pkg.pkg_name," .                                   #[1]
        "  pv.pkg_version" .                                  #[2]
        " FROM DEPLOYMENT_MANAGER.bom_contents bc," .
        "     DEPLOYMENT_MANAGER.operating_systems os," .
        "     DEPLOYMENT_MANAGER.os_contents osc," .
        "     DEPLOYMENT_MANAGER.PACKAGES pkg," .
        "     DEPLOYMENT_MANAGER.PACKAGE_VERSIONS pv," .
        "     DEPLOYMENT_MANAGER.PRODUCT_DETAILS pd" .
        " WHERE osc.os_id = os.os_id" .
        " AND os.node_id  = bc.node_id" .
        " AND bc.bom_id  IN" .
        "  (SELECT bom_id" .
        "  FROM" .
        "    (SELECT bs.bom_id, b.branch_id, state_id, bn.bom_name ," .
        "            RANK() OVER (PARTITION BY bs.state_id,b.branch_id, bn.bom_name ORDER BY bs.bom_id DESC) SRLNO" .
        "     FROM DEPLOYMENT_MANAGER.bom_state bs ," .
        "          DEPLOYMENT_MANAGER.boms b," .
        "          DEPLOYMENT_MANAGER.bom_names bn" .
        "     WHERE bs.bom_id   = b.bom_id" .
        "       AND b.BOM_NAME_ID = bn.BOM_NAME_ID" .
        "    )" .
        "  WHERE SRLNO <= 3" .
        "  )" .
        " AND pd.PROD_ID (+) = osc.PROD_ID" .
        " AND pv.pkg_id      = pkg.pkg_id" .
        " AND osc.prod_id    = pv.pv_id" .
        " ORDER BY UPPER(pkg.pkg_name), " .
        "          UPPER(pv.PKG_VERSION)" .
        $limit;

    Verbose3("GetRecentDMPackages: $m_sqlstr");
    my $sth = $DM_DB->prepare($m_sqlstr);
    if ( defined($sth) )
    {
        if ( $sth->execute( ) )
        {
            if ( $sth->rows )
            {
                while ( @row = $sth->fetchrow_array )
                {
                    $count++;
                    print join (',',@row), "\n" if ($opt_verbose > 2);
                    my $pvid = $row[0];
                    $Packages{$pvid}{dm} = 1;
                    unless ( exists $Packages{$pvid}{name} )
                    {
                        $Packages{$pvid}{name} = $row[1];
                        $Packages{$pvid}{version} = $row[2];
                    }
                    push @StrayPackages, $pvid;

                    if ( $opt_limit )
                    {
                        last if ( $count > $opt_limit );
                    }
                }
            }
            $sth->finish();
        }
        else
        {
            Error("GetRecentDMPackages:Execute failure: $m_sqlstr", $sth->errstr() );
        }
    }
    else
    {
        Error("GetRecentDMPackages:Prepare failure" );
    }

    Verbose ("Extract Deployed Packages: $count rows");
}

#-------------------------------------------------------------------------------
# Function        : GetDepends
#
# Description     :
#
# Inputs          : @plist          - list of pvid's to process
#
# Returns         :
#
sub GetDepends
{
    my (@plist) = @_;

    #
    #   Now extract the package dependacies
    #   There may not be any
    #
    my $m_sqlstr = "SELECT ".
                    " pd.PV_ID, ".
                    " pd.DPV_ID " .
                  " FROM    RELEASE_MANAGER.PACKAGE_DEPENDENCIES pd ".
                  " WHERE pd.PV_ID in ( " . join(',', @plist) . " )";
    my $sth = $RM_DB->prepare($m_sqlstr);
    if ( defined($sth) )
    {
        if ( $sth->execute( ) )
        {
            if ( $sth->rows )
            {
                while ( my @row = $sth->fetchrow_array )
                {
                    my $pvid = $row[0];
                    my $dpvid = $row[1];
                    push @StrayPackages, $dpvid;
                    push @{$Packages{$dpvid}{usedBy}}, $pvid;
                    $Packages{$dpvid}{slp} = 1 unless exists $Packages{$dpvid}{tlp};

                    print join (',','GetDepends',@row), "\n" if ($opt_verbose > 2);
                }
            }
            $sth->finish();
        }
        else
        {
            Error("GetDepends:Execute failure: $m_sqlstr", $sth->errstr() );
        }
    }
    else
    {
        Error("GetDepends:Prepare failure" );
    }
}

#-------------------------------------------------------------------------------
# Function        : LocateStrays
#
# Description     : Locate stray packages
#                   Try to do several (200) at a time to speed up processing
#
# Inputs          :
#
# Returns         :
#
sub LocateStrays
{
    Verbose ("Locate indirectly referenced packages");
    while ( $#StrayPackages >= 0 )
    {
#print "Strays Remaining: ", scalar @StrayPackages ,"\n";

        my @plist;
        while ( $#plist <= 200 && @StrayPackages )
        {
            my $pv_id = pop @StrayPackages;
            next if ( exists $Packages{$pv_id}{done} );
            push @plist, $pv_id;
        }

        GetDepends(@plist) if @plist;

        foreach ( @plist)
        {
            $Packages{$_}{done} = 1;
        }
    }
}

#-------------------------------------------------------------------------------
# Function        : savePhaseData
#
# Description     : Save inter-phase data
#
# Inputs          : 
#
# Returns         : 
#
sub savePhaseData
{
    my $count = 0;
    my $direct = 0;
    my $indirect = 0;
    my $buildable = 0;
    my $bad = 0;
    my $sdk = 0;

    foreach my $pvid ( keys %Packages )
    {
        my $entry = $Packages{$pvid};
        unless ( defined $entry->{name} && defined $entry->{version})
        {
            Warning ("Package Name or Version not known: $pvid");
            $bad++;
            next;
        }

        $count++;
        if ( $entry->{locked} && $entry->{locked} eq 'Y' && $entry->{buildStandard} > 0 )
        {
            $buildable++;
        }

        if ( $entry->{tlp} ) {
            $direct++;
        }
        elsif ( $entry->{slp} ) {
            $indirect++;
        }
        elsif ($entry->{sdk}) {
            $sdk++;
        }
 
    }

    my $file = "quarantine.raw.txt";
    Verbose ("Create: $file");
    my $fh = ConfigurationFile::New( $file );

    $fh->DumpData(
        "\n# Package Data.\n#\n",
        "Packages", \%Packages );

    $fh->DumpData(
        "\n# Release Data.\n#\n",
        "Releases", \%Releases );
        
    $fh->Close();

    Verbose("Packages: $count, Bad: $bad: Buildable: $buildable, Directly included: $direct, Indirect: $indirect, Sdk: $sdk");
}

#-------------------------------------------------------------------------------
# Function        : prepQdir
#
# Description     : Prepare the quarantine target directory
#                   Setup logging
#
#                   Done at the start of the 2nd phase
#
# Inputs          : 
#
# Returns         : 
#
sub prepQdir
{
    my ( $ss, $mm, $hh, $dd, $mo, $yy ) = ( localtime($now) )[0..5];
    my $stamp = sprintf("%4.4d%2.2d%2.2d_%2.2d%2.2d%2.2d", $yy+1900, $mo+1, $dd, $hh,$mm,$ss);

    $quarantineInstance = join('/', $config{quarantine}, $stamp);

    my $logName = 'quarantine_' . $stamp . '.txt';
    $logPath = join('/', $config{logBase}, $logName );
    eval { mkpath($config{logBase}) } unless -d $config{logBase};
    Error ("Log directory not found/created: $config{logBase}") unless -d $config{logBase};

    #
    #   Start the log file
    Log ("TEST Mode Enabled") if $opt_test;
    Log ("QuarantinePath: $quarantineInstance");
    Log ("Quarantine store Disabled") if ($config{qdirAge} <= 0);
    Log ("Config: $_ = $config{$_}") foreach ( sort keys %config );
    Log ("Ignore: $_") foreach ( sort keys %retainPkgs );

    #
    # Create a 'nice' symlink to the latest log file
    my $logLatest = join('/', $config{logBase}, 'latest');
    unlink ( $logLatest );
    symlink( $logName, $logLatest);

    #
    #   Clean up old files
    #
    if ($config{qdirAge} > 0) {
        opendir( Q, $config{quarantine} ) || Error ("opendir failed on: $config{quarantine}" );

        # delete any quarantine instance older than 90 days
        while ( my $file = readdir( Q ) )
        {  
            #
            #   Skip housekeeping directory entries
            #
            next if ( $file eq '.' );
            next if ( $file eq '..' );
            next if ( $file eq 'lost+found' );

            my $path = join( '/', $config{quarantine} . "/" . $file);
            my $age = checkTime( $path );
            if ( $age > $config{qdirAge} )
            {
                Log ("Old Quarantine Removed: $path");
                Verbose ("Test: Delete Dir: $path") if ( $opt_test );
                rmtree($path, 0, 1) unless $opt_test;
            }
        }
        
        closedir( Q );
    }
}

#-------------------------------------------------------------------------------
# Function        : checkTime
#
# Description     : Days since modification of a path
#
# Inputs          : Path elements
#
# Returns         : Days since midification
#

sub checkTime
{
    my ($path) = @_;
    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
        $atime,$mtime,$ctime,$blksize,$blocks) = stat($path);

    unless(defined $mtime)
    {
        Warning("Bad stat for $path");
        $mtime = 0;
    }

    return int( ($now - $mtime) / (60 * 60 * 24));
}

#-------------------------------------------------------------------------------
# Function        : processDpkgArchive
#
# Description     : Scan dpkg_archive
#
# Inputs          : 
#
# Returns         : 
#
sub processDpkgArchive
{
    Verbose ("Scanning dpkg_archive");
    opendir( PKGS, $config{dpkg_archive} ) || Error ("Cannot open dpkg_archive");
    while ( my $pkgName = readdir(PKGS) )
    {
        next if ( $pkgName eq '.' );
        next if ( $pkgName eq '..' );
        next if ( $pkgName eq 'lost+found' );
        next if ( exists $retainPkgs{$pkgName} );

        my $pkgDir = join('/', $config{dpkg_archive}, $pkgName );
        if ( -d $pkgDir )
        {
            if (opendir (PV, $pkgDir ) )
            {

                while ( my $pkgVersion = readdir(PV) )
                {
                    next if ( $pkgVersion eq '.' );
                    next if ( $pkgVersion eq '..' );
                    next if ( $pkgVersion eq 'latest' );            # Keep latest (often symlink for build system)

                    my $pkgPath = join('/', $config{dpkg_archive}, $pkgName,$pkgVersion );
                    my $mtime = checkTime($pkgPath);

                    my $pvid;
                    if ( exists ($pkgPvid{$pkgName}) && exists($pkgPvid{$pkgName}{$pkgVersion} ) )
                    {
                        $pvid = $pkgPvid{$pkgName}{$pkgVersion}{pvid};
                        $Packages{$pvid}{dpkg_archive} = 1;
                        $pkgPvid{$pkgName}{$pkgVersion}{mtime} = $mtime;
                    }
                    else
                    {
                        #
                        #   Package is in dpkg-archive, but not in Release
                        #   Manager. Allow for a short while
                        #
                        $statistics{TotalPackages}++;
                        $statistics{'NotInReleaseManager'}++;
                        if ( $mtime > $config{retainNoRm} )
                        {
                            #Log("Package not in RM: $pkgName, $pkgVersion, Age: $mtime");
                            quarantineItem( 'X', $mtime, $pkgPath );
                            $statistics{'Quarantine'}++;
                        }

                        if ($opt_explain)
                        {
                            Information("Reason:-, $pkgName, $pkgVersion, Reason:NotInReleaseManager");
                        }
                    }

#Message("$pkgName, $pkgVersion, $pkgPvid{$pkgName}{$pkgVersion}{mtime}");
                }
                close(PV);
            }
        }
        elsif ( -f $pkgDir )
        {
            Warning("Unexpected file in dpkg_archive: $pkgName");
            Log("Unexpected file in dpkg_archive: $pkgName");
            quarantineItem( 'F', -1, $pkgDir );
            $statistics{'fileNotInReleaseManager'}++;
            $statistics{'Quarantine'}++;
            $statistics{'NotInReleaseManager'}++;

            if ($opt_explain)
            {
                Information("Reason:-, $pkgDir, -, Reason:fileNotInReleaseManager");
            }
        }
        else
        {
            Warning("Unexpected entry in dpkg_archive: $pkgName");
        }
    }
    close(PKGS);


    #
    #
    #   Scan all packages found in dpkg_archive and see if we should keep it
    #   Quarantine those we cannot find a reason to keep
    #
    foreach my $pkgName ( sort keys %pkgPvid )
    {
        foreach my $pkgVersion ( sort keys %{$pkgPvid{$pkgName}} )
        {
            my $mtime = $pkgPvid{$pkgName}{$pkgVersion}{mtime} || 0;
            my $pvid = $pkgPvid{$pkgName}{$pkgVersion}{pvid};
            my $keepReason = '';
            my $entry = $Packages{$pvid};

            {
                # Examine entry. Determine a reason to keep the package
                #   Some reasons to keep a package are no longer needed now that versions are pumped into S3

                unless ($entry) { $keepReason ='NoPackageEntry'; last;}
                unless ($entry->{dpkg_archive}) { $keepReason ='NotInArchive'; last;}
                unless ($pvid) { $keepReason = 'NoPVid'; last;}
                if (exists $entry->{tlp}) { $keepReason = 'TopLevelPackage'; last;}
                if (exists $entry->{slp}) { $keepReason = 'SecondLevelPackage'; last;}
                if (exists $entry->{sdk}) { $keepReason ='inSdk'; last;}
                if (exists $entry->{dm}) { $keepReason = 'inDeploymentManager'; last;}
                if ($entry->{isPatch}) { $keepReason = 'isPatch'; last;}
                if ($mtime <= $config{retain}) { $keepReason ='RetainTime:' . ($config{retain} - $mtime); last;}
                #unless ($entry->{buildStandard}) { $keepReason ='NoBuildStandard:' . $mtime; last;}
                if ($entry->{locked} ne 'Y') { $keepReason ='NotLocked:' . $entry->{locked}; last;}
                #if ($entry->{buildType} eq 'M') { $keepReason ='ManualBuild:' . $entry->{buildType}; last;}

                $pkgPvid{$pkgName}{$pkgVersion}{keepReason} = $keepReason;
            }

            unless ( $keepReason )
            {
                Verbose2("Quarantine:$pvid, $pkgName, $pkgVersion, Age:$mtime, Lock:$entry->{locked}, Patch:$entry->{isPatch}, BS:$entry->{buildStandard}, BT:$entry->{buildType}");
                quarantineItem( 'Q', $mtime, join('/', $config{dpkg_archive}, $pkgName, $pkgVersion ) );
                $keepReason = 'Quarantine';
            }

            if ($opt_explain)
            {
                Information("Reason:$pvid, $pkgName, $pkgVersion, Reason:$keepReason");
            }

            #
            #   Maintain Stats
            #       Only use the Base Reason - remove details after the ':' character
            #
            my $sReason = $keepReason;
            $sReason =~ s~:.*$~~;
            $statistics{$sReason}++;
            $statistics{TotalPackages}++;
        }
    }

    #
    # Perform the quarantine
    #
    doQuarantine();
}

#-------------------------------------------------------------------------------
# Function        : reportMissingPkgs
#
# Description     : Report packages that 'should' be in dpkg_archive because
#                   they are essential, but are not
#
# Inputs          : 
#
# Returns         : 
#
sub reportMissingPkgs
{
    return;

    #
    #   Not very useful as there is too much information
    #   It would appear that the quarantine process may have also
    #   been deleting packages from 'closed' as well as 'archived'
    #   releases at some stage.
    #
    #   Report packages used in not-archived or not-closed releases
    #
    my @missing;
    foreach my $pvid (keys %Packages )
    {
        my $entry = $Packages{$pvid};
        next unless ( exists $entry->{tlp} );
#        next unless ( exists $entry->{slp} );
        next if ( $entry->{dpkg_archive} );
        next unless ( exists $entry->{name} );

        #
        #   Missing package
        #   Determine if its in use by an active release
        #

        my @releases = usedBy($pvid);
        foreach my $release (@releases )
        {
            next if ( $Releases{$release}{official} eq 'Y' );
            next if ( $Releases{$release}{official} eq 'A' );
            push @missing, $entry->{name} . ' ' . $entry->{version} . " ($pvid)";
            last;
        }
    }

    Warning ("Packages required by active releases that are not in dpkg_archive", sort @missing);
}

#-------------------------------------------------------------------------------
# Function        : usedBy
#
# Description     : Given a pvid, determine which release(s) need it
#
# Inputs          : $pvid
#
# Returns         : Nothing
#
sub usedBy
{
    my ($pvid) = @_;
    my %seen;

    Error ("PVID is not an essential package") unless ( exists $Packages{$pvid} );

    my @releases = @{$Packages{$pvid}{'release'}} if exists($Packages{$pvid}{'release'});
    my @users = @{$Packages{$pvid}{'usedBy'}} if exists($Packages{$pvid}{'usedBy'});

    while ( @users )
    {
        my $pv = pop @users;

        next if ( exists $seen{$pv} );
        $seen{$pv} = 1;

        push @releases, @{$Packages{$pv}{'release'}} if (exists $Packages{$pv}{'release'});
        push @users, @{$Packages{$pv}{'usedBy'}} if (exists($Packages{$pv}{'usedBy'}));
    }
    return @releases;
}

#-------------------------------------------------------------------------------
# Function        : reportStats 
#
# Description     : Report statistics
#                   Write statistics to a file
#                       Write to a tmp file, then rename.
#                       Attempt to make the operation atomic - so that the file consumer
#                       doesn't get a badly formed file.
#   
#
# Inputs          : 
#
# Returns         : 
#
sub reportStats
{
    #
    #   Time stamp the stats
    #
    $statistics{'timeStamp'} = time();

    #
    #   Save stats to a known file for Nagios to use
    #   
    my $statsfiletmp = join('/', $config{logBase}, 'quarantine.stats.tmp' );
    my $statsfile    = join('/', $config{logBase}, 'quarantine.stats');

    my $fh;
    unless (open ($fh, '>', $statsfiletmp))
    {
        $fh = undef;
        Warning("Cannot create temp stats file: $!");
    }
    else
    {
        foreach my $key ( sort { lc($a) cmp lc($b) } keys %statistics)
        {
            print $fh $key . ':' . $statistics{$key} . "\n";
            Log('Statistics: '. $key . ':' . $statistics{$key});
        }
        close $fh;

        # Rename temp to real file
        rename  $statsfiletmp,  $statsfile;
    }
}


#-------------------------------------------------------------------------------
# Function        : quarantineItem
#
# Description     : Add item to the list of stuff to be quarantined
#
# Inputs          : $reason         - Reason
#                   $age            - Age
#                   $path           - Path
#
# Returns         : 
#
sub quarantineItem
{
    my ($reason, $age, $path ) = @_;
    my %data;
    $data{reason} = $reason;
    $data{age} = $age;
    $data{path} = $path;

    push @quarantineItems, \%data;
}

#-------------------------------------------------------------------------------
# Function        : doQuarantine
#
# Description     : Quarantine files and folders that have been queued up
#
# Inputs          : None
#
# Returns         : 
#
sub doQuarantine
{
    my $testMsg = $opt_test ? 'Test,' : '';

    # Process entries - oldest first
    #
    my $countRemain = ( scalar @quarantineItems );
    foreach my $entry (sort {$b->{age} <=> $a->{age} } @quarantineItems)
    {
        my $rv;
        my $emsg = ' - with error';
        my $s3error = 0;

        my $path = $entry->{path};
        my $tpath = $path;
           $tpath =~ s~^$config{dpkg_archive}~~;
           $tpath = $quarantineInstance.$tpath;
        my $tdir = dirname ( $tpath );

        unless ( $opt_test )
        {
            #
            #   Transfer to Amazon S3 storage first
            #   The transfer is done via an external program (script)
            #   The transfer will tar-zip the packageVersion
            #
            {
                my $s3msg = "";
                my $pv = $path;

                #
                #   Export the Secrets in EnvVars
                #   Use program defaults so that we don't need to specify them
                #   on the command line - for all to see
                #
                $ENV{AWSKEY} = $config{S3Key};
                $ENV{AWSSECRET} = $config{S3Secret};

                $rv = system ( "$progBase/savePkgToS3.sh", "--bucket=$config{S3Bucket}" ,"--path=$path" );
                if ( $rv )
                {
                    ReportError ("Move $path to S3");
                    $s3msg = ' - with S3 error';
                    $s3error = 1;
                    $emsg = ' - S3 Error prevented quarantine';
                    $statistics{'S3TransferError'}++;

                }
                Log (sprintf("S3Quarantined:%s%s,%4.4s,%s%s", $testMsg, $entry->{reason}, $entry->{age}, $path, $s3msg));
            }

            unless ($s3error)
            {
                if ($config{qdirAge} <= 0)
                {
                    #
                    #   Just delete the package-version
                    #
                    rmtree( $path);
                    if (-d $path)
                    {
                        ReportError ("Deleting $path ");   
                        $statistics{'QuarantineError'}++;      
                        $emsg = ' - Delete error';
                    }
                    else
                    {
                        $emsg = '';
                    }
                }
                else
                {
                    #
                    #   Transfer then delete to local directory
                    #
                    unless (-d $tdir)
                    {
                        eval { mkpath($tdir) };
                        ReportError ("Did not create quarantine target: $tdir")
                            unless (-d $tdir);
                    }

                    if (-d $tdir)
                    {
                        $rv = system ('mv', '-n', $path, $tdir);
                        if ( $rv )
                        {
                            ReportError ("Move $path to $tdir");
                            $statistics{'QuarantineError'}++;

                            #
                            # Clean up what may have been moved
                            # NOTE: deleted so that we don't loose stuff if it gets ugly
            #                rmtree( $tpath);
            #                rmdir ($tdir);
                        }
                        else
                        {
                            $emsg = '';
                        }
                    }
                }
            }
        }
        else
        {
            Verbose2("Test: 'mv', '$path', '$tdir'");
            $emsg = '';
        }

        # Log operation with frills
        Log (sprintf("Quarantined:%s%s,%4.4s,%s%s", $testMsg, $entry->{reason}, $entry->{age}, $path, $emsg));

        # Limit packages quarantined
        $countRemain--;
        if ($opt_pcount > 0)
        {
            $opt_pcount--;
            if ($opt_pcount == 0)
            {
                Log ("Quarantine package count exceeded. Quarantine terminated. $countRemain packages remaining");
                last;
            }
        }
    }
}

#-------------------------------------------------------------------------------
# Function        : Log
#
# Description     : Log a string
#
# Inputs          : Line to log
#
# Returns         : 
#
sub Log
{
    my ($line) = @_;
    Verbose("Log: " . $line);

    if (open ( LF, '+>>', $logPath ) )
    {
        print LF $line . "\n";
        close LF;
    }
}

#-------------------------------------------------------------------------------
# Function        : readInputData
#
# Description     : Write out data in a form to allow post processing
#
# Inputs          : 
#
# Returns         : 
#
sub readInputData
{
    unless ( keys(%Packages) > 0 )
    {
        my $fname = "quarantine.raw.txt";
        Verbose ("Reading: $fname");
        Error "Cannot locate $fname" unless ( -f $fname );
        require $fname;

        Error "Data in $fname is not valid\n"
            unless ( keys(%Packages) > 0 );
    }

    #
    # Create a lookup from package name/version to pvid
    #
    Verbose ("Create PackageVersion to PVID hash");
    foreach my $pvid ( keys %Packages )
    {
        my $name = $Packages{$pvid}{name};
        my $version = $Packages{$pvid}{version};
        if ( $name && $version )
        {
            $pkgPvid{$name}{$version}{pvid} = $pvid;
        }
    }
}

#-------------------------------------------------------------------------------
#   Documentation
#

=pod

=for htmltoc    SYSUTIL::

=head1 NAME

jats_quarantine - Determine packages to be quarantined

=head1 SYNOPSIS

  jats jats_quarantine [options]

 Options:
    -help              - brief help message
    -help -help        - Detailed help message
    -man               - Full documentation
    -verbose[=n]       - Control output
    -explain           - Display each package version disposition
    -phase=nn          - Perform named phases
    -purge             - Just purge the old quarantined files
    -test              - Do not delete files
    -limit=n           - Limit packages processed. Test only
    -pcount=n          - Limit package count

=head1 OPTIONS

=over 8

=item B<-help>

Print a brief help message and exits.

=item B<-help -help>

Print a detailed help message with an explanation for each option.

=item B<-man>

Prints the manual page and exits.

=item B<-verbose[=n]>

This option control the programs output. Normally this program will not generate
any output. It will only generate output on error conditions. This is intentional
as the program will be run as a cron-job and output errors will be mailed out.

A verbose level of 1. will display progress information

A verbose level of 3. will display detailed tracing of all operations

=item B<-explain[=n]>

This option will output a line per package-version explaining the reason that
packages are retained.

Only a level of 1 is supported.

=item B<-phase=list>

This option will limit the work done by the program. There are two phases
called: 1 and 2.

Phase-1 will examine Release Manager collect package-version information.
Phase-2 will examine dpkg_archive and collect package-version information. It
will then initiate the quarantine operation.

The default operation is to perform phase-1 and phase-2.

If only phase-1 is specified then the RM data is saved, to be used by a
later phase.

If only phase-2 is specified then saved RM data is restored.

This option can simplify testing.

=item B<-purge>

This option will only purge the old quarantine directories. It will not quarantine new 
package versions.

=item B<-test>

Do not delete or move files and directories. Report what would have been done.

=item B<-limit=n>

Limit the number of packages processed by the tool. This is only used to
simplify testing of the program

=back

=head1 DESCRIPTION

This program is a tool used in the maintainance of dpkg_archive.
It will:

=over 8

=item *

Determine package-versions in use by Release Manager.

=item *

Determine package-versions in recent Deployment Manager SBOMS.

=item *

Determine package-versions that can be rebuilt

=item *

Recursively find all the dependent packages of all packages. New package
versions are called 'indirect' dependencies. They are buried. This process can
take several minutes.

=back

The data collected is dumped into a text file for later processing.

=cut