Subversion Repositories DevTools

Rev

Rev 5272 | Rev 5535 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
3410 dpurdie 1 
########################################################################
2 
# Copyright (C) 1998-2013 Vix Technology, All rights reserved
3 
#
4 
# Module name   : jats_quarantine.pl
5 
# Module type   : Makefile system
6 
# Compiler(s)   : Perl
7 
# Environment(s): jats
8 
#
9 
# Description   :  Remove packages from dpkg_archive that are no longer
3413 dpurdie 10 
#                  required - if they can be rebuilt.
3410 dpurdie 11 
#
5125 dpurdie 12 
#                  Keep package version if
13 
#                   Cannot be rebuilt
14 
#                   It is in use by a non-archived release
15 
#                   It is a dependent package of a package in a non-archived release
16 
#                   It is an exposed package in an non-deprecated SDK
17 
#                   It is used in one of the last two SBOMs (within Deployment Manager)
18 
#                   defined within each state of each branch of each project.
19 
#                   It is a dependent package of one of the SBOM packages
20 
#
21 
#                   Packages that are not in RM will be purged
22 
#
23 
#
3410 dpurdie 24 
# Usage         :  See POD at end of file
25 
#
26 
#......................................................................#
27 
 
28 
require 5.008_002;
29 
use strict;
30 
use warnings;
31 
 
32 
use Pod::Usage;
33 
use Getopt::Long;
34 
 
35 
use JatsError;
36 
use JatsSystem;
37 
use Getopt::Long;
38 
use Pod::Usage;                             # required for help support
39 
use JatsRmApi;
40 
use ConfigurationFile;
41 
use File::Path;
42 
use File::Basename;
43 
 
44 
use DBI;
45 
 
46 
#
47 
#   Options - global
48 
#
49 
my $VERSION = "2.0.0";                      # Update this
50 
my $opt_verbose = 0;
51 
my $opt_help = 0;
52 
my $opt_manual;
53 
my $opt_test;
54 
my $opt_limit;
55 
my $opt_quick;
56 
my $opt_phase = '123';                      # Default - do all, but don't save data
4092 dpurdie 57 
my $opt_purge;
4093 dpurdie 58 
my $opt_pcount = 0;
5253 dpurdie 59 
my $opt_explain;
3410 dpurdie 60 
 
61 
#
62 
#   Globals
63 
#
4542 dpurdie 64 
my $progBase;
3410 dpurdie 65 
my $RM_DB;
5125 dpurdie 66 
my $DM_DB;
3410 dpurdie 67 
my $now = time();
68 
my $quarantineInstance;
69 
my $logPath;
70 
my %pkgPvid;
71 
my @quarantineItems;
72 
my @StrayPackages;
73 
 
74 
our %Releases;
75 
our %Packages;
76 
 
77 
#
78 
# Default config information
79 
# May be replaced by xxx.cnf file
80 
#
81 
my %config = (
82 
    'retain'        => '31',
83 
    'qdirAge'       => '90',
84 
    'retainNoRm'    => '31',
85 
    'quarantine'    => '/export/devl/quarantine',
86 
    'dpkg_archive'  => '/export/devl/dpkg_archive',
87 
    'logBase'       => '/export/devl/dpkg_archive/.dpkg_archive/quarantinelog',
88 
    'verbose'       => '0',
4542 dpurdie 89 
    'S3Bucket'      => 'auawsaddp001',
90 
    'S3Key'         => 'Mandatory',
91 
    'S3Secret'      => 'Mandatory',
3410 dpurdie 92 
    );
93 
 
94 
# List of packages to be retained
95 
# May be supplemented by xxx.cnf file
96 
my %retainPkgs = (
97 
    'core_devl' => 1,
98 
);
99 
 
5534 dpurdie 100 
#
101 
#   Statistics
102 
#   Listed here to ensure that they exist in the stats file
103 
#
104 
my %statistics = (
105 
    timeStamp               => 0,               # Age of the stats file
106 
    statsName               => 'Quarantine',    # Name of the stats file
107 
    state                   => 'OK',            # Overall reported state
108 
 
109 
    # Error counters
110 
    QuarantineError         => 0,
111 
    S3TransferError         => 0,
112 
 
113 
    # Major Statistics
114 
    Quarantine              => 0,
115 
 
116 
    # Minor Statistics
117 
    fileNotInReleaseManager => 0,
118 
    inDeploymentManager     => 0,
119 
    inSdk                   => 0,
120 
    isPatch                 => 0,
121 
    ManualBuild             => 0,
122 
    RetainTime              => 0,
123 
    NoBuildStandard         => 0,
124 
    NoPackageEntry          => 0,
125 
    NoPVid                  => 0,
126 
    NotInArchive            => 0,
127 
    NotInReleaseManager     => 0,
128 
    NotLocked               => 0,
129 
    SecondLevelPackage      => 0,
130 
    TopLevelPackage         => 0,
131 
    TotalPackages           => 0,
132 
    ZeroTime                => 0,
133 
);
134 
 
3410 dpurdie 135 
#-------------------------------------------------------------------------------
136 
# Function        : Main Entry
137 
#
138 
# Description     :
139 
#
140 
# Inputs          :
141 
#
142 
# Returns         :
143 
#
144 
my $result = GetOptions (
145 
                "help+"         => \$opt_help,          # flag, multiple use allowed
146 
                "manual"        => \$opt_manual,        # flag
147 
                "verbose:+"     => \$opt_verbose,       # flag
5253 dpurdie 148 
                "explain:+"     => \$opt_explain,       # flag
3410 dpurdie 149 
                "test:+"        => \$opt_test,          # Test a version string
150 
                "limit:n"       => \$opt_limit,         #
151 
                "phase:s"       => \$opt_phase,         # Phase to do
152 
                "quick"         => \$opt_quick,         # Don't look for indirects
4092 dpurdie 153 
                "purge"         => \$opt_purge,         # Purge old quarantined packages
4093 dpurdie 154 
                "pcount:n"      => \$opt_pcount,        # Count of packages to purge in one hit
3410 dpurdie 155 
                );
156 
 
157 
#
158 
#   Process help and manual options
159 
#
160 
pod2usage(-verbose => 0, -message => "Version: $VERSION")  if ($opt_help == 1  || ! $result);
161 
pod2usage(-verbose => 1)  if ($opt_help == 2 );
162 
pod2usage(-verbose => 2)  if ($opt_manual || ($opt_help > 2));
163 
ErrorConfig( 'name'    => 'QUARANTINE',
164 
             'verbose' => $opt_verbose );
165 
 
166 
#
167 
#   This utility must be run on the package server
168 
my $runHost = 'auperaarc01';
169 
my $hostname = lc $ENV{HOSTNAME} || 'Unknown';
170 
Warning("Not running on $runHost") unless ( $hostname eq $runHost );
171 
 
172 
#
173 
#   Needs to run as root so that packages can be moved no matter what the
174 
#   file permissions are
175 
#
176 
Warning( "Not running as root") if ( $> );
177 
 
4542 dpurdie 178 
#
179 
#   Determine the base of this program
180 
#   Will be used to find config and local utils
181 
#
182 
$progBase = $0;
183 
$progBase =~ s~/[^/]+$~~;
184 
Verbose("ProgBase: $0: $progBase");
185 
 
3410 dpurdie 186 
#   Read config file
187 
#   Use max of user verbosity or config verbosity
188 
#
189 
ReadConfig();
190 
if ( $config{verbose} > $opt_verbose )
191 
{
192 
    $opt_verbose = $config{verbose};
193 
    ErrorConfig( 'verbose' => $opt_verbose );
194 
}
195 
 
196 
#
197 
#   Collect data from Release Manager
198 
#
4092 dpurdie 199 
if ( $opt_phase =~ m~1~ && !$opt_purge )
3410 dpurdie 200 
{
201 
    getReleaseDetails();
202 
    GetAllPackageData();
203 
    getTopLevelPackages();
5125 dpurdie 204 
    GetRecentDMPackages();
3410 dpurdie 205 
    LocateStrays() unless ($opt_quick);
5125 dpurdie 206 
    GetSdkPackageData();
3410 dpurdie 207 
 
208 
    if ( $opt_verbose > 1 )
209 
    {
210 
        print "=========================================================================\n";
211 
        DebugDumpData("Releases", \%Releases);
212 
        print "=========================================================================\n";
213 
        DebugDumpData("Packages", \%Packages );
214 
    }
215 
}
216 
 
217 
#
4092 dpurdie 218 
#   Scan dpkg_archive and quarantine packages
3410 dpurdie 219 
#
220 
if ( $opt_phase =~ m~2~ )
221 
{
222 
    prepQdir();
4092 dpurdie 223 
    unless ($opt_purge) {
224 
        readInputData();
225 
        processDpkgArchive();
226 
        reportMissingPkgs();
5534 dpurdie 227 
        reportStats();
4092 dpurdie 228 
    }
3410 dpurdie 229 
 
230 
    Verbose ("Quarantine to: $quarantineInstance");
231 
    Verbose ("Log to: $logPath");
232 
}
233 
 
234 
#
235 
#   Save internal data for reuse
236 
#   Used only for testing of indiviual phases
237 
#
238 
unless ( $opt_phase =~ m~3~ )
239 
{
240 
    savePhaseData();
241 
}
242 
 
243 
ErrorDoExit();
244 
exit;
245 
 
246 
#-------------------------------------------------------------------------------
247 
# Function        : ReadConfig
248 
#
249 
# Description     : Read in config file
250 
#                   Must be inthe same directory as the executable
251 
#
252 
# Inputs          :
253 
#
254 
# Returns         :
255 
#
256 
 
257 
sub ReadConfig
258 
{
259 
    my $config = $0;
260 
    $config =~ s~\.pl$~.cnf~;
261 
    open (CF, '<', $config ) || Error ("Connot open: $config");
262 
    while ( <CF> )
263 
    {
264 
        s~\s+$~~;
265 
        s~^\s+~~;
266 
        next if ( m~\s*#~ );        # Comment
267 
        next unless $_;             # Empty
268 
        if ( m~(.*?)\s*=\s*(.*)~ ) {
269 
            ReportError ("Unknown config value: $1") unless ( exists $config{$1} );
270 
            $config{$1} = $2;
271 
        } else {
272 
            $retainPkgs{$_} = 1;
273 
        }
274 
    }
275 
    close CF;
276 
    ErrorDoExit();
277 
}
278 
 
279 
#-------------------------------------------------------------------------------
280 
# Function        : getReleaseDetails
281 
#
282 
# Description     : Determine all candiate releases
283 
#
284 
# Inputs          :
285 
#
286 
# Returns         :
287 
#
288 
sub getReleaseDetails
289 
{
290 
    my (@row);
291 
 
292 
    Verbose ("Determine all Release Names");
293 
 
294 
    # if we are not or cannot connect then return 0 as we have not found anything
295 
    connectRM(\$RM_DB) unless $RM_DB;
296 
 
297 
    # Get all Releases
298 
    # From non-archived releases
5253 dpurdie 299 
    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" .
3410 dpurdie 300 
                   " FROM release_manager.release_tags rt, release_manager.projects prj" .
301 
                   " WHERE prj.PROJ_ID = rt.PROJ_ID " .
5253 dpurdie 302 
                   "   AND rt.official != 'A' ORDER BY UPPER(prj.PROJ_NAME), UPPER(rt.RTAG_NAME)";
3410 dpurdie 303 
#                   "   AND rt.official != 'Y'" .
304 
 
305 
    Verbose3("getReleaseDetails: $m_sqlstr");
306 
    my $sth = $RM_DB->prepare($m_sqlstr);
307 
    if ( defined($sth) )
308 
    {
309 
        if ( $sth->execute( ) )
310 
        {
311 
            if ( $sth->rows )
312 
            {
313 
                while ( @row = $sth->fetchrow_array )
314 
                {
315 
                    my $rtag_id =$row[3];
316 
                    my $proj_id = $row[2];
5253 dpurdie 317 
                    my $official = $row[4];
318 
                    my $age = defined($row[5]) ? $row[5] : $row[6];
319 
 
320 
#if ( $official eq 'Y' ) {
321 
#    Information("Closed Age ($proj_id) : $age : $row[0], $row[1]");
322 
#}
323 
#                    if ( $official eq 'Y' && $age && $age > 300 )
324 
#                    {
325 
#                        next;
326 
#                    }
3410 dpurdie 327 
 
328 
                    $Releases{$rtag_id}{pName} = $row[0];
329 
                    $Releases{$rtag_id}{name} = $row[1];
330 
                    $Releases{$rtag_id}{proj_id} = $proj_id;
331 
                    $Releases{$rtag_id}{rtag_id} = $rtag_id;
332 
                    $Releases{$rtag_id}{official} = $row[4];
5253 dpurdie 333 
                    $Releases{$rtag_id}{officialDays} = defined($row[5]) ? $row[5] : $row[6] ;
334 
                    $Releases{$rtag_id}{createdDays} = $row[6];
3410 dpurdie 335 
 
336 
                    print join (',',@row), "\n" if ($opt_verbose > 2);
337 
                }
338 
            }
339 
            $sth->finish();
340 
        }
341 
        else
342 
        {
343 
            Error("getReleaseDetails:Execute failure: $m_sqlstr", $sth->errstr() );
344 
        }
345 
    }
346 
    else
347 
    {
348 
        Error("getReleaseDetails:Prepare failure" );
349 
    }
350 
}
351 
 
352 
#-------------------------------------------------------------------------------
353 
# Function        : GetAllPackageData
354 
#
355 
# Description     : Extract all package data
356 
#
357 
# Inputs          :
358 
#
359 
# Returns         :
360 
#
361 
 
362 
sub GetAllPackageData
363 
{
364 
    my (@row);
365 
    my $count = 0;
366 
 
367 
    # if we are not or cannot connect then return 0 as we have not found anything
368 
    connectRM(\$RM_DB) unless $RM_DB;
369 
 
370 
    Verbose ("Extract all package data");
371 
 
372 
    # First get all packages
373 
    # From non-archived releases
374 
 
375 
    my $limit = $opt_limit ? " AND rownum <= $opt_limit" : '';
376 
    my $m_sqlstr = "SELECT DISTINCT " .
377 
                        "pv.PV_ID, " .                                          #[0]
378 
                        "pkg.PKG_NAME, " .                                      #[1]
379 
                        "pv.PKG_VERSION, " .                                    #[2]
380 
                        "pv.DLOCKED, " .                                        #[3]
381 
                        "pv.PKG_ID," .                                          #[4]
382 
                        "pv.is_patch," .                                        #[5]
383 
                        "pv.build_type,".                                       #[6]
384 
                        "pbi.bsa_id," .                                         #[7]
385 
#                        "pv.CREATOR_ID, " .                                     #[8]
386 
#                        "pv.MODIFIED_STAMP, " .                                 #[9]
387 
#                        "release_manager.PK_RMAPI.return_vcs_tag(pv.PV_ID), " . #[10]
388 
                        "999" .
389 
                   " FROM RELEASE_MANAGER.PACKAGE_VERSIONS pv,".
390 
                         "RELEASE_MANAGER.PACKAGES pkg,".
391 
                         "release_manager.package_build_info pbi" .
392 
                   " WHERE pv.PKG_ID = pkg.PKG_ID" .
393 
                   "   AND pv.pv_id = pbi.pv_id(+)" .
394 
                    $limit ;
395 
    Verbose3("GetAllPackageData: $m_sqlstr");
396 
    my $sth = $RM_DB->prepare($m_sqlstr);
397 
    if ( defined($sth) )
398 
    {
399 
        if ( $sth->execute( ) )
400 
        {
401 
            if ( $sth->rows )
402 
            {
403 
                while ( @row = $sth->fetchrow_array )
404 
                {
405 
                    $count++;
406 
                    print join (',',@row), "\n" if ($opt_verbose > 2);
407 
                    my $pvid = $row[0];
408 
                    unless ( exists $Packages{$pvid}{name} )
409 
                    {
410 
                        $Packages{$pvid}{name} = $row[1];
411 
                        $Packages{$pvid}{version} = $row[2];
412 
                        $Packages{$pvid}{locked} = $row[3];
413 
                        $Packages{$pvid}{pkgid} = $row[4];
414 
                        $Packages{$pvid}{isPatch} = $row[5] || 0;
415 
                        $Packages{$pvid}{buildType} = $row[6] || 0;
416 
                        $Packages{$pvid}{buildStandard} = $row[7] || 0;
417 
 
418 
                        #$Packages{$pvid}{Creator} = $row[8];
419 
                        #$Packages{$pvid}{Age} = $row[9];
420 
                        #$Packages{$pvid}{vcstag} = $row[10];
421 
 
422 
                    }
423 
 
424 
                    if ( $opt_limit )
425 
                    {
426 
                        last if ( $count > $opt_limit );
427 
                    }
428 
                }
429 
            }
430 
            $sth->finish();
431 
        }
432 
        else
433 
        {
434 
            Error("GetAllPackageData:Execute failure: $m_sqlstr", $sth->errstr() );
435 
        }
436 
    }
437 
    else
438 
    {
439 
        Error("GetAllPackageData:Prepare failure" );
440 
    }
441 
 
442 
    Verbose ("All Packages: $count rows");
443 
}
444 
 
445 
#-------------------------------------------------------------------------------
446 
# Function        : getTopLevelPackages
447 
#
448 
# Description     : Extract top level packages from active releases
449 
#
450 
# Inputs          :
451 
#
452 
# Returns         :
453 
#
454 
 
455 
sub getTopLevelPackages
456 
{
457 
    my (@row);
458 
    my $count = 0;
459 
 
460 
    # if we are not or cannot connect then return 0 as we have not found anything
461 
    connectRM(\$RM_DB) unless $RM_DB;
462 
 
463 
    Verbose ("Extract toplevel dependencies");
464 
 
465 
    # First get all packages that are referenced in a Release
466 
    # This will only get the top level packages
467 
    # From non-archived releases
468 
 
469 
    my $limit = $opt_limit ? " AND rownum <= $opt_limit" : '';
470 
    my $m_sqlstr = "SELECT DISTINCT " .
471 
                        "rc.PV_ID, " .                                          #[0]
472 
                        "rt.RTAG_ID, " .                                        #[1]
473 
                        "prj.PROJ_ID " .                                        #[2]
474 
                   " FROM RELEASE_MANAGER.RELEASE_CONTENT rc, ".
475 
                         "release_manager.release_tags rt,".
476 
                         "release_manager.projects prj" .
477 
                   " WHERE prj.PROJ_ID = rt.PROJ_ID" .
478 
                   "   and rt.RTAG_ID = rc.RTAG_ID" .
479 
                   "   AND rt.official != 'A'" .
480 
#                   "   AND rt.official != 'Y' " .
481 
                    $limit;
482 
 
483 
    Verbose3("getTopLevelPackages: $m_sqlstr");
484 
    my $sth = $RM_DB->prepare($m_sqlstr);
485 
    if ( defined($sth) )
486 
    {
487 
        if ( $sth->execute( ) )
488 
        {
489 
            if ( $sth->rows )
490 
            {
491 
                while ( @row = $sth->fetchrow_array )
492 
                {
493 
                    $count++;
494 
                    print join (',',@row), "\n" if ($opt_verbose > 2);
495 
                    my $pvid = $row[0];
496 
                    $Packages{$pvid}{tlp} = 1;
497 
                    push @StrayPackages, $pvid;
498 
 
499 
 
500 
                    my $rtag_id = $row[1];
501 
                    push @{$Packages{$pvid}{release}}, $rtag_id;
502 
 
503 
                    my $proj_id = $row[2];
504 
                    push @{$Packages{$pvid}{projects}}, $proj_id
505 
                        unless (grep {$_ eq $proj_id} @{$Packages{$pvid}{projects}});
506 
 
507 
                    if ( $opt_limit )
508 
                    {
509 
                        last if ( $count > $opt_limit );
510 
                    }
511 
                }
512 
            }
513 
            $sth->finish();
514 
        }
515 
        else
516 
        {
517 
            Error("getTopLevelPackages:Execute failure: $m_sqlstr", $sth->errstr() );
518 
        }
519 
    }
520 
    else
521 
    {
522 
        Error("getTopLevelPackages:Prepare failure" );
523 
    }
524 
 
525 
    Verbose ("Extract toplevel dependencies: $count rows");
526 
}
527 
 
528 
#-------------------------------------------------------------------------------
5125 dpurdie 529 
# Function        : GetSdkPackageData
530 
#
531 
# Description     : Extract Packages that are a part of a non-deprecated SDK
532 
#                   Only want the exposed packages
533 
#
534 
#                   Don't care about the dependencies, so don't add them
535 
#                   to strays
536 
#
537 
# Inputs          :
538 
#
539 
# Returns         :
540 
#
541 
 
542 
sub GetSdkPackageData
543 
{
544 
    my (@row);
545 
    my $count = 0;
546 
 
547 
    # if we are not or cannot connect then return 0 as we have not found anything
548 
    connectRM(\$RM_DB) unless $RM_DB;
549 
 
550 
    Verbose ("Extract SDK Packages");
551 
 
552 
    # Get all packages that are a part of a non-deprecated SDK
553 
    # Only get the 'exposed' packages
554 
 
555 
    my $limit = $opt_limit ? " AND rownum <= $opt_limit" : '';
556 
    my $m_sqlstr = "SELECT sc.pv_id, " .                #[0]
557 
                   "       p.PKG_NAME, " .              #[1]
558 
                   "       pv.PKG_VERSION" .            #[2]
559 
                   " FROM RELEASE_MANAGER.SDK_CONTENT sc," .
560 
                   "   RELEASE_MANAGER.sdk_tags st," .
561 
                   "   RELEASE_MANAGER.package_versions pv," .
562 
                   "   RELEASE_MANAGER.PACKAGES p" .
563 
                   " WHERE sc.SDKTAG_ID    = st.SDKTAG_ID" .
564 
                   " AND p.PKG_ID = pv.PKG_ID" .
565 
                   " AND pv.PV_ID = sc.pv_id" .
566 
                   " AND sc.SDKPKG_STATE   = 'E'" .
567 
                   " AND st.SDK_STATE NOT IN ('D')" .
568 
                    $limit;
569 
 
570 
    Verbose3("GetSdkPackageData: $m_sqlstr");
571 
    my $sth = $RM_DB->prepare($m_sqlstr);
572 
    if ( defined($sth) )
573 
    {
574 
        if ( $sth->execute( ) )
575 
        {
576 
            if ( $sth->rows )
577 
            {
578 
                while ( @row = $sth->fetchrow_array )
579 
                {
580 
                    $count++;
581 
                    print join (',',@row), "\n" if ($opt_verbose > 2);
582 
                    my $pvid = $row[0];
583 
                    $Packages{$pvid}{sdk} = 1;
584 
                    unless ( exists $Packages{$pvid}{name} )
585 
                    {
586 
                        $Packages{$pvid}{name} = $row[1];
587 
                        $Packages{$pvid}{version} = $row[2];
588 
                    }
589 
 
590 
                    if ( $opt_limit )
591 
                    {
592 
                        last if ( $count > $opt_limit );
593 
                    }
594 
                }
595 
            }
596 
            $sth->finish();
597 
        }
598 
        else
599 
        {
600 
            Error("GetSdkPackageData:Execute failure: $m_sqlstr", $sth->errstr() );
601 
        }
602 
    }
603 
    else
604 
    {
605 
        Error("GetSdkPackageData:Prepare failure" );
606 
    }
607 
 
608 
    Verbose ("Extract SDK Packages: $count rows");
609 
}
610 
 
611 
#-------------------------------------------------------------------------------
612 
# Function        : GetRecentDMPackages
613 
#
614 
# Description     : Extract Packages that referenced in Deployment Manager
615 
#                   Want all package-versions from the last two BOMS in each state
616 
#                   of all projects.
617 
#
618 
# Inputs          :
619 
#
620 
# Returns         :
621 
#
622 
 
623 
sub GetRecentDMPackages
624 
{
625 
    my (@row);
626 
    my $count = 0;
627 
 
628 
    # if we are not or cannot connect then return 0 as we have not found anything
629 
    connectDM(\$DM_DB) unless ($DM_DB);
630 
 
631 
    Verbose ("Extract DM Packages");
632 
 
633 
    # Get all packages that are a part of a non-deprecated SDK
634 
    # Only get the 'exposed' packages
635 
 
636 
    my $limit = $opt_limit ? " AND rownum <= $opt_limit" : '';
637 
    my $m_sqlstr =
638 
        " SELECT DISTINCT pv.pv_id,".               #[0]
639 
        "   pkg.pkg_name,".                         #[1]
640 
        "   pv.pkg_version".                        #[2]
641 
        " FROM bom_contents bc,".
642 
        "   DEPLOYMENT_MANAGER.operating_systems os,".
643 
        "   DEPLOYMENT_MANAGER.os_contents osc,".
644 
        "   DEPLOYMENT_MANAGER.PACKAGES pkg,".
645 
        "   DEPLOYMENT_MANAGER.PACKAGE_VERSIONS pv,".
646 
        "   DEPLOYMENT_MANAGER.PRODUCT_DETAILS pd".
647 
        " WHERE osc.os_id = os.os_id".
648 
        " AND os.node_id  = bc.node_id".
649 
        " AND bc.bom_id  IN".
650 
        "   (SELECT bom_id".
651 
        "   FROM".
652 
        "     (SELECT bom_id,".
653 
        "       state_id,".
654 
        "       RANK( ) OVER (PARTITION BY state_id ORDER BY bom_id DESC) SRLNO".
655 
        "     FROM DEPLOYMENT_MANAGER.bom_state".
656 
        "     )".
657 
        "   WHERE SRLNO <= 2".
658 
        "   )".
659 
        " AND pd.PROD_ID (+) = osc.PROD_ID".
660 
        " AND pv.pkg_id      = pkg.pkg_id".
661 
        " AND osc.prod_id    = pv.pv_id".
662 
        " ORDER BY UPPER(pkg.pkg_name),".
663 
        "   UPPER(pv.PKG_VERSION)".
664 
        $limit;
665 
 
666 
    Verbose3("GetRecentDMPackages: $m_sqlstr");
667 
    my $sth = $DM_DB->prepare($m_sqlstr);
668 
    if ( defined($sth) )
669 
    {
670 
        if ( $sth->execute( ) )
671 
        {
672 
            if ( $sth->rows )
673 
            {
674 
                while ( @row = $sth->fetchrow_array )
675 
                {
676 
                    $count++;
677 
                    print join (',',@row), "\n" if ($opt_verbose > 2);
678 
                    my $pvid = $row[0];
679 
                    $Packages{$pvid}{dm} = 1;
680 
                    unless ( exists $Packages{$pvid}{name} )
681 
                    {
682 
                        $Packages{$pvid}{name} = $row[1];
683 
                        $Packages{$pvid}{version} = $row[2];
684 
                    }
685 
                    push @StrayPackages, $pvid;
686 
 
687 
                    if ( $opt_limit )
688 
                    {
689 
                        last if ( $count > $opt_limit );
690 
                    }
691 
                }
692 
            }
693 
            $sth->finish();
694 
        }
695 
        else
696 
        {
697 
            Error("GetRecentDMPackages:Execute failure: $m_sqlstr", $sth->errstr() );
698 
        }
699 
    }
700 
    else
701 
    {
702 
        Error("GetRecentDMPackages:Prepare failure" );
703 
    }
704 
 
705 
    Verbose ("Extract Deployed Packages: $count rows");
706 
}
707 
 
708 
#-------------------------------------------------------------------------------
3410 dpurdie 709 
# Function        : GetDepends
710 
#
711 
# Description     :
712 
#
713 
# Inputs          : @plist          - list of pvid's to process
714 
#
715 
# Returns         :
716 
#
717 
sub GetDepends
718 
{
719 
    my (@plist) = @_;
720 
 
721 
    #
722 
    #   Now extract the package dependacies
723 
    #   There may not be any
724 
    #
725 
    my $m_sqlstr = "SELECT ".
726 
                    " pd.PV_ID, ".
727 
                    " pd.DPV_ID " .
728 
                  " FROM    RELEASE_MANAGER.PACKAGE_DEPENDENCIES pd ".
729 
                  " WHERE pd.PV_ID in ( " . join(',', @plist) . " )";
730 
    my $sth = $RM_DB->prepare($m_sqlstr);
731 
    if ( defined($sth) )
732 
    {
733 
        if ( $sth->execute( ) )
734 
        {
735 
            if ( $sth->rows )
736 
            {
737 
                while ( my @row = $sth->fetchrow_array )
738 
                {
739 
                    my $pvid = $row[0];
740 
                    my $dpvid = $row[1];
741 
                    push @StrayPackages, $dpvid;
742 
                    push @{$Packages{$dpvid}{usedBy}}, $pvid;
3423 dpurdie 743 
                    $Packages{$dpvid}{slp} = 1 unless exists $Packages{$dpvid}{tlp};
3410 dpurdie 744 
 
745 
                    print join (',','GetDepends',@row), "\n" if ($opt_verbose > 2);
746 
                }
747 
            }
748 
            $sth->finish();
749 
        }
750 
        else
751 
        {
752 
            Error("GetDepends:Execute failure: $m_sqlstr", $sth->errstr() );
753 
        }
754 
    }
755 
    else
756 
    {
757 
        Error("GetDepends:Prepare failure" );
758 
    }
759 
}
760 
 
761 
#-------------------------------------------------------------------------------
762 
# Function        : LocateStrays
763 
#
764 
# Description     : Locate stray packages
765 
#                   Try to do several (200) at a time to speed up processing
766 
#
767 
# Inputs          :
768 
#
769 
# Returns         :
770 
#
771 
sub LocateStrays
772 
{
773 
    Verbose ("Locate indirectly referenced packages");
774 
    while ( $#StrayPackages >= 0 )
775 
    {
776 
#print "Strays Remaining: ", scalar @StrayPackages ,"\n";
777 
 
778 
        my @plist;
779 
        while ( $#plist <= 200 && @StrayPackages )
780 
        {
781 
            my $pv_id = pop @StrayPackages;
782 
            next if ( exists $Packages{$pv_id}{done} );
783 
            push @plist, $pv_id;
784 
        }
785 
 
786 
        GetDepends(@plist) if @plist;
787 
 
788 
        foreach ( @plist)
789 
        {
790 
            $Packages{$_}{done} = 1;
791 
        }
792 
    }
793 
}
794 
 
795 
#-------------------------------------------------------------------------------
796 
# Function        : savePhaseData
797 
#
798 
# Description     : Save inter-phase data
799 
#
800 
# Inputs          :
801 
#
802 
# Returns         :
803 
#
804 
sub savePhaseData
805 
{
806 
    my $count = 0;
807 
    my $direct = 0;
808 
    my $indirect = 0;
809 
    my $buildable = 0;
810 
    my $bad = 0;
5125 dpurdie 811 
    my $sdk = 0;
3410 dpurdie 812 
 
813 
    foreach my $pvid ( keys %Packages )
814 
    {
815 
        my $entry = $Packages{$pvid};
816 
        unless ( defined $entry->{name} && defined $entry->{version})
817 
        {
818 
            Warning ("Package Name or Version not known: $pvid");
819 
            $bad++;
820 
            next;
821 
        }
822 
 
823 
        $count++;
824 
        if ( $entry->{locked} && $entry->{locked} eq 'Y' && $entry->{buildStandard} > 0 )
825 
        {
826 
            $buildable++;
827 
        }
828 
 
5125 dpurdie 829 
        if ( $entry->{tlp} ) {
830 
            $direct++;
831 
        }
832 
        elsif ( $entry->{slp} ) {
833 
            $indirect++;
834 
        }
835 
        elsif ($entry->{sdk}) {
836 
            $sdk++;
837 
        }
838 
 
3410 dpurdie 839 
    }
840 
 
841 
    my $file = "quarantine.raw.txt";
842 
    Verbose ("Create: $file");
843 
    my $fh = ConfigurationFile::New( $file );
844 
 
845 
    $fh->DumpData(
846 
        "\n# Package Data.\n#\n",
847 
        "Packages", \%Packages );
848 
 
849 
    $fh->DumpData(
850 
        "\n# Release Data.\n#\n",
851 
        "Releases", \%Releases );
852 
 
853 
    $fh->Close();
854 
 
5125 dpurdie 855 
    Verbose("Packages: $count, Bad: $bad: Buildable: $buildable, Directly included: $direct, Indirect: $indirect, Sdk: $sdk");
3410 dpurdie 856 
}
857 
 
858 
#-------------------------------------------------------------------------------
859 
# Function        : prepQdir
860 
#
861 
# Description     : Prepare the quarantine target directory
862 
#                   Setup logging
863 
#
864 
#                   Done at the start of the 2nd phase
865 
#
866 
# Inputs          :
867 
#
868 
# Returns         :
869 
#
870 
sub prepQdir
871 
{
872 
    my ( $ss, $mm, $hh, $dd, $mo, $yy ) = ( localtime($now) )[0..5];
873 
    my $stamp = sprintf("%4.4d%2.2d%2.2d_%2.2d%2.2d%2.2d", $yy+1900, $mo+1, $dd, $hh,$mm,$ss);
874 
 
875 
    $quarantineInstance = join('/', $config{quarantine}, $stamp);
876 
 
877 
    my $logName = 'quarantine_' . $stamp . '.txt';
878 
    $logPath = join('/', $config{logBase}, $logName );
879 
    eval { mkpath($config{logBase}) } unless -d $config{logBase};
880 
    Error ("Log directory not found/created: $config{logBase}") unless -d $config{logBase};
881 
 
882 
    #
883 
    #   Start the log file
884 
    Log ("TEST Mode Enabled") if $opt_test;
885 
    Log ("QuarantinePath: $quarantineInstance");
3423 dpurdie 886 
    Log ("Config: $_ = $config{$_}") foreach ( sort keys %config );
887 
    Log ("Ignore: $_") foreach ( sort keys %retainPkgs );
3410 dpurdie 888 
 
889 
    #
890 
    # Create a 'nice' symlink to the latest log file
891 
    my $logLatest = join('/', $config{logBase}, 'latest');
892 
    unlink ( $logLatest );
893 
    symlink( $logName, $logLatest);
894 
 
895 
    #
896 
    #   Clean up old files
897 
    #
898 
    opendir( Q, $config{quarantine} ) || Error ("opendir failed on: $config{quarantine}" );
899 
 
900 
    # delete any quarantine instance older than 90 days
901 
    while ( my $file = readdir( Q ) )
902 
    {
903 
        #
904 
        #   Skip housekeeping directory entries
905 
        #
906 
        next if ( $file eq '.' );
907 
        next if ( $file eq '..' );
908 
        next if ( $file eq 'lost+found' );
909 
 
910 
        my $path = join( '/', $config{quarantine} . "/" . $file);
911 
        my $age = checkTime( $path );
912 
        if ( $age > $config{qdirAge} )
913 
        {
914 
            Log ("Old Quarantine Removed: $path");
915 
            Verbose ("Test: Delete Dir: $path") if ( $opt_test );
916 
            rmtree($path, 0, 1) unless $opt_test;
917 
        }
918 
    }
919 
 
920 
    closedir( Q );
921 
}
922 
 
923 
#-------------------------------------------------------------------------------
924 
# Function        : checkTime
925 
#
926 
# Description     : Days since modification of a path
927 
#
928 
# Inputs          : Path elements
929 
#
930 
# Returns         : Days since midification
931 
#
932 
 
933 
sub checkTime
934 
{
935 
    my ($path) = @_;
936 
    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
937 
        $atime,$mtime,$ctime,$blksize,$blocks) = stat($path);
938 
 
4127 dpurdie 939 
    unless(defined $mtime)
940 
    {
941 
        Warning("Bad stat for $path");
942 
        $mtime = 0;
943 
    }
944 
 
3410 dpurdie 945 
    return int( ($now - $mtime) / (60 * 60 * 24));
946 
}
947 
 
948 
#-------------------------------------------------------------------------------
949 
# Function        : processDpkgArchive
950 
#
951 
# Description     : Scan dpkg_archive
952 
#
953 
# Inputs          :
954 
#
955 
# Returns         :
956 
#
957 
sub processDpkgArchive
958 
{
959 
    Verbose ("Scanning dpkg_archive");
960 
    opendir( PKGS, $config{dpkg_archive} ) || Error ("Cannot open dpkg_archive");
961 
    while ( my $pkgName = readdir(PKGS) )
962 
    {
963 
        next if ( $pkgName eq '.' );
964 
        next if ( $pkgName eq '..' );
965 
        next if ( $pkgName eq 'lost+found' );
966 
        next if ( exists $retainPkgs{$pkgName} );
967 
 
968 
        my $pkgDir = join('/', $config{dpkg_archive}, $pkgName );
969 
        if ( -d $pkgDir )
970 
        {
971 
            if (opendir (PV, $pkgDir ) )
972 
            {
973 
 
974 
                while ( my $pkgVersion = readdir(PV) )
975 
                {
976 
                    next if ( $pkgVersion eq '.' );
977 
                    next if ( $pkgVersion eq '..' );
4646 dpurdie 978 
                    next if ( $pkgVersion eq 'latest' );            # Keep latest (often symlink for build system)
979 
 
3410 dpurdie 980 
                    my $pkgPath = join('/', $config{dpkg_archive}, $pkgName,$pkgVersion );
981 
                    my $mtime = checkTime($pkgPath);
982 
 
983 
                    my $pvid;
984 
                    if ( exists ($pkgPvid{$pkgName}) && exists($pkgPvid{$pkgName}{$pkgVersion} ) )
985 
                    {
986 
                        $pvid = $pkgPvid{$pkgName}{$pkgVersion}{pvid};
987 
                        $Packages{$pvid}{dpkg_archive} = 1;
988 
                        $pkgPvid{$pkgName}{$pkgVersion}{mtime} = $mtime;
989 
                    }
990 
                    else
991 
                    {
992 
                        #
993 
                        #   Package is in dpkg-archive, but not in Release
994 
                        #   Manager. Allow for a short while
995 
                        #
5534 dpurdie 996 
                        $statistics{TotalPackages}++;
997 
                        $statistics{'NotInReleaseManager'}++;
3410 dpurdie 998 
                        if ( $mtime > $config{retainNoRm} )
999 
                        {
1000 
                            #Log("Package not in RM: $pkgName, $pkgVersion, Age: $mtime");
1001 
                            quarantineItem( 'X', $mtime, $pkgPath );
5534 dpurdie 1002 
                            $statistics{'Quarantine'}++;
3410 dpurdie 1003 
                        }
5534 dpurdie 1004 
 
1005 
                        if ($opt_explain)
1006 
                        {
1007 
                            Information("Reason:-, $pkgName, $pkgVersion, Reason:NotInReleaseManager");
1008 
                        }
3410 dpurdie 1009 
                    }
1010 
 
1011 
#Message("$pkgName, $pkgVersion, $pkgPvid{$pkgName}{$pkgVersion}{mtime}");
1012 
                }
1013 
                close(PV);
1014 
            }
1015 
        }
1016 
        elsif ( -f $pkgDir )
1017 
        {
1018 
            Warning("Unexpected file in dpkg_archive: $pkgName");
1019 
            Log("Unexpected file in dpkg_archive: $pkgName");
1020 
            quarantineItem( 'F', -1, $pkgDir );
5534 dpurdie 1021 
            $statistics{'fileNotInReleaseManager'}++;
1022 
            $statistics{'Quarantine'}++;
1023 
            $statistics{'NotInReleaseManager'}++;
1024 
 
1025 
            if ($opt_explain)
1026 
            {
1027 
                Information("Reason:-, $pkgDir, -, Reason:fileNotInReleaseManager");
1028 
            }
3410 dpurdie 1029 
        }
1030 
        else
1031 
        {
1032 
            Warning("Unexpected entry in dpkg_archive: $pkgName");
1033 
        }
1034 
    }
1035 
    close(PKGS);
1036 
 
1037 
 
1038 
    #
1039 
    #
5125 dpurdie 1040 
    #   Scan all packages found in dpkg_archive and see if we should keep it
1041 
    #   Quarantine those we cannot find a reason to keep
3410 dpurdie 1042 
    #
1043 
    foreach my $pkgName ( sort keys %pkgPvid )
1044 
    {
1045 
        foreach my $pkgVersion ( sort keys %{$pkgPvid{$pkgName}} )
1046 
        {
1047 
            my $mtime = $pkgPvid{$pkgName}{$pkgVersion}{mtime} || 0;
1048 
            my $pvid = $pkgPvid{$pkgName}{$pkgVersion}{pvid};
5253 dpurdie 1049 
            my $keepReason = '';
1050 
            my $entry = $Packages{$pvid};
3410 dpurdie 1051 
 
1052 
            {
5253 dpurdie 1053 
                # Examine entry. Determine a reason to keep the package
5534 dpurdie 1054 
                #   Some reasons to keep a package are no longer needed now that versions are pumped into S3
3410 dpurdie 1055 
 
5253 dpurdie 1056 
                unless ($entry) { $keepReason ='NoPackageEntry'; last;}
1057 
                unless ($entry->{dpkg_archive}) { $keepReason ='NotInArchive'; last;}
1058 
                unless ($pvid) { $keepReason = 'NoPVid'; last;}
5534 dpurdie 1059 
                if (exists $entry->{tlp}) { $keepReason = 'TopLevelPackage'; last;}
1060 
                if (exists $entry->{slp}) { $keepReason = 'SecondLevelPackage'; last;}
1061 
                if (exists $entry->{sdk}) { $keepReason ='inSdk'; last;}
1062 
                if (exists $entry->{dm}) { $keepReason = 'inDeploymentManager'; last;}
1063 
                if ($entry->{isPatch}) { $keepReason = 'isPatch'; last;}
5253 dpurdie 1064 
                unless ($mtime) { $keepReason ='ZeroTime'; last;}
5534 dpurdie 1065 
                if ($mtime <= $config{retain}) { $keepReason ='RetainTime:' . ($config{retain} - $mtime); last;}
1066 
                #unless ($entry->{buildStandard}) { $keepReason ='NoBuildStandard:' . $mtime; last;}
5253 dpurdie 1067 
                if ($entry->{locked} ne 'Y') { $keepReason ='NotLocked:' . $entry->{locked}; last;}
1068 
                #if ($entry->{buildType} eq 'M') { $keepReason ='ManualBuild:' . $entry->{buildType}; last;}
1069 
 
1070 
                $pkgPvid{$pkgName}{$pkgVersion}{keepReason} = $keepReason;
1071 
            }
1072 
 
1073 
            unless ( $keepReason )
1074 
            {
3410 dpurdie 1075 
                Verbose2("Quarantine:$pvid, $pkgName, $pkgVersion, Age:$mtime, Lock:$entry->{locked}, Patch:$entry->{isPatch}, BS:$entry->{buildStandard}, BT:$entry->{buildType}");
1076 
                quarantineItem( 'Q', $mtime, join('/', $config{dpkg_archive}, $pkgName, $pkgVersion ) );
5534 dpurdie 1077 
                $keepReason = 'Quarantine';
3410 dpurdie 1078 
            }
5253 dpurdie 1079 
 
1080 
            if ($opt_explain)
1081 
            {
1082 
                Information("Reason:$pvid, $pkgName, $pkgVersion, Reason:$keepReason");
1083 
            }
5534 dpurdie 1084 
 
1085 
            #
1086 
            #   Maintain Stats
1087 
            #       Only use the Base Reason - remove details after the ':' character
1088 
            #
1089 
            my $sReason = $keepReason;
1090 
            $sReason =~ s~:.*$~~;
1091 
            $statistics{$sReason}++;
1092 
            $statistics{TotalPackages}++;
3410 dpurdie 1093 
        }
1094 
    }
1095 
 
1096 
    #
1097 
    # Perform the quarantine
1098 
    #
1099 
    doQuarantine();
1100 
    ErrorDoExit();
1101 
}
1102 
 
1103 
#-------------------------------------------------------------------------------
1104 
# Function        : reportMissingPkgs
1105 
#
1106 
# Description     : Report packages that 'should' be in dpkg_archive because
1107 
#                   they are essential, but are not
1108 
#
1109 
# Inputs          :
1110 
#
1111 
# Returns         :
1112 
#
1113 
sub reportMissingPkgs
1114 
{
1115 
    return;
1116 
 
1117 
    #
1118 
    #   Not very useful as there is too much information
1119 
    #   It would appear that the quarantine process may have also
1120 
    #   been deleting packages from 'closed' as well as 'archived'
1121 
    #   releases at some stage.
1122 
    #
1123 
    #   Report packages used in not-archived or not-closed releases
1124 
    #
1125 
    my @missing;
1126 
    foreach my $pvid (keys %Packages )
1127 
    {
1128 
        my $entry = $Packages{$pvid};
1129 
        next unless ( exists $entry->{tlp} );
1130 
#        next unless ( exists $entry->{slp} );
1131 
        next if ( $entry->{dpkg_archive} );
1132 
        next unless ( exists $entry->{name} );
1133 
 
1134 
        #
1135 
        #   Missing package
1136 
        #   Determine if its in use by an active release
1137 
        #
1138 
 
1139 
        my @releases = usedBy($pvid);
1140 
        foreach my $release (@releases )
1141 
        {
1142 
            next if ( $Releases{$release}{official} eq 'Y' );
1143 
            next if ( $Releases{$release}{official} eq 'A' );
1144 
            push @missing, $entry->{name} . ' ' . $entry->{version} . " ($pvid)";
1145 
            last;
1146 
        }
1147 
    }
1148 
 
1149 
    Warning ("Packages required by active releases that are not in dpkg_archive", sort @missing);
1150 
}
1151 
 
1152 
#-------------------------------------------------------------------------------
1153 
# Function        : usedBy
1154 
#
1155 
# Description     : Given a pvid, determine which release(s) need it
1156 
#
1157 
# Inputs          : $pvid
1158 
#
1159 
# Returns         : Nothing
1160 
#
1161 
sub usedBy
1162 
{
1163 
    my ($pvid) = @_;
1164 
    my %seen;
1165 
 
1166 
    Error ("PVID is not an essential package") unless ( exists $Packages{$pvid} );
1167 
 
1168 
    my @releases = @{$Packages{$pvid}{'release'}} if exists($Packages{$pvid}{'release'});
1169 
    my @users = @{$Packages{$pvid}{'usedBy'}} if exists($Packages{$pvid}{'usedBy'});
1170 
 
1171 
    while ( @users )
1172 
    {
1173 
        my $pv = pop @users;
1174 
 
1175 
        next if ( exists $seen{$pv} );
1176 
        $seen{$pv} = 1;
1177 
 
1178 
        push @releases, @{$Packages{$pv}{'release'}} if (exists $Packages{$pv}{'release'});
1179 
        push @users, @{$Packages{$pv}{'usedBy'}} if (exists($Packages{$pv}{'usedBy'}));
1180 
    }
1181 
    return @releases;
1182 
}
1183 
 
1184 
#-------------------------------------------------------------------------------
5534 dpurdie 1185 
# Function        : reportStats
1186 
#
1187 
# Description     : Report statistics
1188 
#                   Write statistics to a file
1189 
#                       Write to a tmp file, then rename.
1190 
#                       Attempt to make the operation atomic - so that the file consumer
1191 
#                       doesn't get a badly formed file.
1192 
#
1193 
#
1194 
# Inputs          :
1195 
#
1196 
# Returns         :
1197 
#
1198 
sub reportStats
1199 
{
1200 
    #
1201 
    #   Time stamp the stats
1202 
    #
1203 
    $statistics{'timeStamp'} = time();
1204 
 
1205 
    #
1206 
    #   Save stats to a known file for Nagios to use
1207 
    #
1208 
    my $statsfiletmp = join('/', $config{logBase}, 'quarantine.stats.tmp' );
1209 
    my $statsfile    = join('/', $config{logBase}, 'quarantine.stats');
1210 
 
1211 
    my $fh;
1212 
    unless (open ($fh, '>', $statsfiletmp))
1213 
    {
1214 
        $fh = undef;
1215 
        Warning("Cannot create temp stats file: $!");
1216 
    }
1217 
    else
1218 
    {
1219 
        foreach my $key ( sort { lc($a) cmp lc($b) } keys %statistics)
1220 
        {
1221 
            print $fh $key . ':' . $statistics{$key} . "\n";
1222 
            Log('Statistics: '. $key . ':' . $statistics{$key});
1223 
        }
1224 
        close $fh;
1225 
 
1226 
        # Rename temp to real file
1227 
        rename  $statsfiletmp,  $statsfile;
1228 
    }
1229 
}
1230 
 
1231 
 
1232 
#-------------------------------------------------------------------------------
3410 dpurdie 1233 
# Function        : quarantineItem
1234 
#
1235 
# Description     : Add item to the list of stuff to be quarantined
1236 
#
1237 
# Inputs          : $reason         - Reason
1238 
#                   $age            - Age
1239 
#                   $path           - Path
1240 
#
1241 
# Returns         :
1242 
#
1243 
sub quarantineItem
1244 
{
1245 
    my ($reason, $age, $path ) = @_;
1246 
    my %data;
1247 
    $data{reason} = $reason;
1248 
    $data{age} = $age;
1249 
    $data{path} = $path;
1250 
 
1251 
    push @quarantineItems, \%data;
1252 
}
1253 
 
1254 
#-------------------------------------------------------------------------------
1255 
# Function        : doQuarantine
1256 
#
1257 
# Description     : Quarantine files and folders that have been queued up
1258 
#
1259 
# Inputs          : None
1260 
#
1261 
# Returns         :
1262 
#
1263 
sub doQuarantine
1264 
{
1265 
    my $testMsg = $opt_test ? 'Test,' : '';
4093 dpurdie 1266 
 
1267 
    # Process entries - oldest first
1268 
    #
4127 dpurdie 1269 
    my $countRemain = ( scalar @quarantineItems );
4093 dpurdie 1270 
    foreach my $entry (sort {$b->{age} <=> $a->{age} } @quarantineItems)
3410 dpurdie 1271 
    {
1272 
        my $rv;
1273 
        my $emsg = ' - with error';
5272 dpurdie 1274 
        my $s3error = 0;
3410 dpurdie 1275 
 
1276 
        my $path = $entry->{path};
1277 
        my $tpath = $path;
1278 
           $tpath =~ s~^$config{dpkg_archive}~~;
1279 
           $tpath = $quarantineInstance.$tpath;
1280 
        my $tdir = dirname ( $tpath );
1281 
 
1282 
        unless ( $opt_test )
1283 
        {
4542 dpurdie 1284 
            #
1285 
            #   Transfer to Amazon S3 storage first
1286 
            #   The transfer is done via an external program (script)
1287 
            #   The transfer will tar-zip the packageVersion
1288 
            #
1289 
            {
1290 
                my $s3msg = "";
1291 
                my $pv = $path;
1292 
 
1293 
                #
1294 
                #   Export the Secrets in EnvVars
1295 
                #   Use program defaults so that we don't need to specify them
1296 
                #   on the command line - for all to see
1297 
                #
1298 
                $ENV{AWSKEY} = $config{S3Key};
1299 
                $ENV{AWSSECRET} = $config{S3Secret};
1300 
 
1301 
                $rv = system ( "$progBase/savePkgToS3.sh", "--bucket=$config{S3Bucket}" ,"--path=$path" );
1302 
                if ( $rv )
1303 
                {
1304 
                    ReportError ("Move $path to S3");
1305 
                    $s3msg = ' - with S3 error';
5272 dpurdie 1306 
                    $s3error = 1;
1307 
                    $emsg = ' - S3 Error prevented quarantine';
5534 dpurdie 1308 
                    $statistics{'S3TransferError'}++;
1309 
 
4542 dpurdie 1310 
                }
1311 
                Log (sprintf("S3Quarantined:%s%s,%4.4s,%s%s", $testMsg, $entry->{reason}, $entry->{age}, $path, $s3msg));
1312 
            }
1313 
 
5272 dpurdie 1314 
            unless ($s3error)
3410 dpurdie 1315 
            {
5272 dpurdie 1316 
                #
1317 
                #   Transfer then delete to local directory
1318 
                #
1319 
                unless (-d $tdir)
3410 dpurdie 1320 
                {
5272 dpurdie 1321 
                    eval { mkpath($tdir) };
1322 
                    ReportError ("Did not create quarantine target: $tdir")
1323 
                        unless (-d $tdir);
3410 dpurdie 1324 
                }
5272 dpurdie 1325 
 
1326 
                if (-d $tdir)
3410 dpurdie 1327 
                {
5272 dpurdie 1328 
                    $rv = system ('mv', '-n', $path, $tdir);
1329 
                    if ( $rv )
1330 
                    {
1331 
                        ReportError ("Move $path to $tdir");
5534 dpurdie 1332 
                        $statistics{'QuarantineError'}++;
1333 
 
5272 dpurdie 1334 
                        #
1335 
                        # Clean up what may have been moved
1336 
                        # NOTE: deleted so that we don't loose stuff if it gets ugly
1337 
        #                rmtree( $tpath);
1338 
        #                rmdir ($tdir);
1339 
                    }
1340 
                    else
1341 
                    {
1342 
                        $emsg = '';
1343 
                    }
3410 dpurdie 1344 
                }
1345 
            }
1346 
        }
1347 
        else
1348 
        {
1349 
            Verbose2("Test: 'mv', '$path', '$tdir'");
1350 
            $emsg = '';
1351 
        }
1352 
 
1353 
        # Log operation with frills
1354 
        Log (sprintf("Quarantined:%s%s,%4.4s,%s%s", $testMsg, $entry->{reason}, $entry->{age}, $path, $emsg));
4093 dpurdie 1355 
 
1356 
        # Limit packages quarantined
4127 dpurdie 1357 
        $countRemain--;
4093 dpurdie 1358 
        if ($opt_pcount > 0)
1359 
        {
1360 
            $opt_pcount--;
1361 
            if ($opt_pcount == 0)
1362 
            {
4127 dpurdie 1363 
                Log ("Quarantine package count exceeded. Quarantine terminated. $countRemain packages remaining");
4093 dpurdie 1364 
                last;
1365 
            }
1366 
        }
3410 dpurdie 1367 
    }
1368 
}
1369 
 
1370 
#-------------------------------------------------------------------------------
1371 
# Function        : Log
1372 
#
1373 
# Description     : Log a string
1374 
#
1375 
# Inputs          : Line to log
1376 
#
1377 
# Returns         :
1378 
#
1379 
sub Log
1380 
{
1381 
    my ($line) = @_;
4093 dpurdie 1382 
    Verbose("Log: " . $line);
3410 dpurdie 1383 
 
1384 
    if (open ( LF, '+>>', $logPath ) )
1385 
    {
1386 
        print LF $line . "\n";
1387 
        close LF;
1388 
    }
1389 
}
1390 
 
1391 
#-------------------------------------------------------------------------------
1392 
# Function        : readInputData
1393 
#
1394 
# Description     : Write out data in a form to allow post processing
1395 
#
1396 
# Inputs          :
1397 
#
1398 
# Returns         :
1399 
#
1400 
sub readInputData
1401 
{
1402 
    unless ( keys(%Packages) > 0 )
1403 
    {
1404 
        my $fname = "quarantine.raw.txt";
1405 
        Verbose ("Reading: $fname");
1406 
        Error "Cannot locate $fname" unless ( -f $fname );
1407 
        require $fname;
1408 
 
1409 
        Error "Data in $fname is not valid\n"
1410 
            unless ( keys(%Packages) > 0 );
1411 
    }
1412 
 
1413 
    #
1414 
    # Create a lookup from package name/version to pvid
1415 
    #
1416 
    Verbose ("Create PackageVersion to PVID hash");
1417 
    foreach my $pvid ( keys %Packages )
1418 
    {
1419 
        my $name = $Packages{$pvid}{name};
1420 
        my $version = $Packages{$pvid}{version};
1421 
        if ( $name && $version )
1422 
        {
1423 
            $pkgPvid{$name}{$version}{pvid} = $pvid;
1424 
        }
1425 
    }
1426 
}
1427 
 
1428 
#-------------------------------------------------------------------------------
1429 
#   Documentation
1430 
#
1431 
 
1432 
=pod
1433 
 
1434 
=for htmltoc    SYSUTIL::
1435 
 
1436 
=head1 NAME
1437 
 
1438 
jats_quarantine - Determine packages to be quarantined
1439 
 
1440 
=head1 SYNOPSIS
1441 
 
1442 
  jats jats_quarantine [options]
1443 
 
1444 
 Options:
1445 
    -help              - brief help message
1446 
    -help -help        - Detailed help message
1447 
    -man               - Full documentation
1448 
    -verbose[=n]       - Control output
5534 dpurdie 1449 
    -explain           - Display each package version disposition
3410 dpurdie 1450 
    -phase=nn          - Perform named phases
4092 dpurdie 1451 
    -purge             - Just purge the old quarantined files
3410 dpurdie 1452 
    -test              - Do not delete files
1453 
    -limit=n           - Limit packages processed. Test only
4093 dpurdie 1454 
    -pcount=n          - Limit package count
3410 dpurdie 1455 
 
1456 
=head1 OPTIONS
1457 
 
1458 
=over 8
1459 
 
1460 
=item B<-help>
1461 
 
1462 
Print a brief help message and exits.
1463 
 
1464 
=item B<-help -help>
1465 
 
1466 
Print a detailed help message with an explanation for each option.
1467 
 
1468 
=item B<-man>
1469 
 
1470 
Prints the manual page and exits.
1471 
 
1472 
=item B<-verbose[=n]>
1473 
 
1474 
This option control the programs output. Normally this program will not generate
1475 
any output. It will only generate output on error conditions. This is intentional
1476 
as the program will be run as a cron-job and output errors will be mailed out.
1477 
 
1478 
A verbose level of 1. will display progress information
1479 
 
1480 
A verbose level of 3. will display detailed tracing of all operations
1481 
 
5534 dpurdie 1482 
=item B<-explain[=n]>
1483 
 
1484 
This option will output a line per package-version explaining the reason that
1485 
packages are retained.
1486 
 
1487 
Only a level of 1 is supported.
1488 
 
3410 dpurdie 1489 
=item B<-phase=list>
1490 
 
1491 
This option will limit the work done by the program. There are two phases
1492 
called: 1 and 2.
1493 
 
1494 
Phase-1 will examine Release Manager collect package-version information.
1495 
Phase-2 will examine dpkg_archive and collect package-version information. It
1496 
will then initiate the quarantine operation.
1497 
 
1498 
The default operation is to perform phase-1 and phase-2.
1499 
 
1500 
If only phase-1 is specified then the RM data is saved, to be used by a
1501 
later phase.
1502 
 
1503 
If only phase-2 is specified then saved RM data is restored.
1504 
 
1505 
This option can simplify testing.
1506 
 
4092 dpurdie 1507 
=item B<-purge>
1508 
 
1509 
This option will only purge the old quarantine directories. It will not quarantine new
1510 
package versions.
1511 
 
3410 dpurdie 1512 
=item B<-test>
1513 
 
1514 
Do not delete or move files and directories. Report what would have been done.
1515 
 
1516 
=item B<-limit=n>
1517 
 
1518 
Limit the number of packages processed by the tool. This is only used to
1519 
simplify testing of the program
1520 
 
1521 
=back
1522 
 
1523 
=head1 DESCRIPTION
1524 
 
1525 
This program is a tool used in the maintainance of dpkg_archive.
1526 
It will:
1527 
 
1528 
=over 8
1529 
 
1530 
=item *
1531 
 
1532 
Determine package-versions in use by Release Manager.
1533 
 
1534 
=item *
1535 
 
5125 dpurdie 1536 
Determine package-versions in recent Deployment Manager SBOMS.
1537 
 
1538 
=item *
1539 
 
3410 dpurdie 1540 
Determine package-versions that can be rebuilt
1541 
 
1542 
=item *
1543 
 
1544 
Recursively find all the dependent packages of all packages. New package
1545 
versions are called 'indirect' dependencies. They are buried. This process can
1546 
take several minutes.
1547 
 
1548 
=back
1549 
 
1550 
The data collected is dumped into a text file for later processing.
1551 
 
1552 
=cut
1553