Subversion Repositories DevTools

Rev

Rev 5535 | Rev 6104 | 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 
);
133 
 
3410 dpurdie 134 
#-------------------------------------------------------------------------------
135 
# Function        : Main Entry
136 
#
137 
# Description     :
138 
#
139 
# Inputs          :
140 
#
141 
# Returns         :
142 
#
143 
my $result = GetOptions (
144 
                "help+"         => \$opt_help,          # flag, multiple use allowed
145 
                "manual"        => \$opt_manual,        # flag
146 
                "verbose:+"     => \$opt_verbose,       # flag
5253 dpurdie 147 
                "explain:+"     => \$opt_explain,       # flag
3410 dpurdie 148 
                "test:+"        => \$opt_test,          # Test a version string
149 
                "limit:n"       => \$opt_limit,         #
150 
                "phase:s"       => \$opt_phase,         # Phase to do
151 
                "quick"         => \$opt_quick,         # Don't look for indirects
4092 dpurdie 152 
                "purge"         => \$opt_purge,         # Purge old quarantined packages
4093 dpurdie 153 
                "pcount:n"      => \$opt_pcount,        # Count of packages to purge in one hit
3410 dpurdie 154 
                );
155 
 
156 
#
157 
#   Process help and manual options
158 
#
159 
pod2usage(-verbose => 0, -message => "Version: $VERSION")  if ($opt_help == 1  || ! $result);
160 
pod2usage(-verbose => 1)  if ($opt_help == 2 );
161 
pod2usage(-verbose => 2)  if ($opt_manual || ($opt_help > 2));
162 
ErrorConfig( 'name'    => 'QUARANTINE',
163 
             'verbose' => $opt_verbose );
164 
 
165 
#
166 
#   This utility must be run on the package server
167 
my $runHost = 'auperaarc01';
168 
my $hostname = lc $ENV{HOSTNAME} || 'Unknown';
169 
Warning("Not running on $runHost") unless ( $hostname eq $runHost );
170 
 
171 
#
172 
#   Needs to run as root so that packages can be moved no matter what the
173 
#   file permissions are
174 
#
175 
Warning( "Not running as root") if ( $> );
176 
 
4542 dpurdie 177 
#
178 
#   Determine the base of this program
179 
#   Will be used to find config and local utils
180 
#
181 
$progBase = $0;
182 
$progBase =~ s~/[^/]+$~~;
183 
Verbose("ProgBase: $0: $progBase");
184 
 
3410 dpurdie 185 
#   Read config file
186 
#   Use max of user verbosity or config verbosity
187 
#
188 
ReadConfig();
189 
if ( $config{verbose} > $opt_verbose )
190 
{
191 
    $opt_verbose = $config{verbose};
192 
    ErrorConfig( 'verbose' => $opt_verbose );
193 
}
194 
 
195 
#
196 
#   Collect data from Release Manager
197 
#
4092 dpurdie 198 
if ( $opt_phase =~ m~1~ && !$opt_purge )
3410 dpurdie 199 
{
200 
    getReleaseDetails();
201 
    GetAllPackageData();
202 
    getTopLevelPackages();
5125 dpurdie 203 
    GetRecentDMPackages();
3410 dpurdie 204 
    LocateStrays() unless ($opt_quick);
5125 dpurdie 205 
    GetSdkPackageData();
3410 dpurdie 206 
 
207 
    if ( $opt_verbose > 1 )
208 
    {
209 
        print "=========================================================================\n";
210 
        DebugDumpData("Releases", \%Releases);
211 
        print "=========================================================================\n";
212 
        DebugDumpData("Packages", \%Packages );
213 
    }
214 
}
215 
 
216 
#
4092 dpurdie 217 
#   Scan dpkg_archive and quarantine packages
3410 dpurdie 218 
#
219 
if ( $opt_phase =~ m~2~ )
220 
{
221 
    prepQdir();
4092 dpurdie 222 
    unless ($opt_purge) {
223 
        readInputData();
224 
        processDpkgArchive();
225 
        reportMissingPkgs();
5534 dpurdie 226 
        reportStats();
4092 dpurdie 227 
    }
3410 dpurdie 228 
 
229 
    Verbose ("Quarantine to: $quarantineInstance");
230 
    Verbose ("Log to: $logPath");
231 
}
232 
 
233 
#
234 
#   Save internal data for reuse
235 
#   Used only for testing of indiviual phases
236 
#
237 
unless ( $opt_phase =~ m~3~ )
238 
{
239 
    savePhaseData();
240 
}
241 
 
242 
ErrorDoExit();
243 
exit;
244 
 
245 
#-------------------------------------------------------------------------------
246 
# Function        : ReadConfig
247 
#
248 
# Description     : Read in config file
249 
#                   Must be inthe same directory as the executable
250 
#
251 
# Inputs          :
252 
#
253 
# Returns         :
254 
#
255 
 
256 
sub ReadConfig
257 
{
258 
    my $config = $0;
259 
    $config =~ s~\.pl$~.cnf~;
260 
    open (CF, '<', $config ) || Error ("Connot open: $config");
261 
    while ( <CF> )
262 
    {
263 
        s~\s+$~~;
264 
        s~^\s+~~;
265 
        next if ( m~\s*#~ );        # Comment
266 
        next unless $_;             # Empty
267 
        if ( m~(.*?)\s*=\s*(.*)~ ) {
268 
            ReportError ("Unknown config value: $1") unless ( exists $config{$1} );
269 
            $config{$1} = $2;
270 
        } else {
271 
            $retainPkgs{$_} = 1;
272 
        }
273 
    }
274 
    close CF;
275 
    ErrorDoExit();
276 
}
277 
 
278 
#-------------------------------------------------------------------------------
279 
# Function        : getReleaseDetails
280 
#
281 
# Description     : Determine all candiate releases
282 
#
283 
# Inputs          :
284 
#
285 
# Returns         :
286 
#
287 
sub getReleaseDetails
288 
{
289 
    my (@row);
290 
 
291 
    Verbose ("Determine all Release Names");
292 
 
293 
    # if we are not or cannot connect then return 0 as we have not found anything
294 
    connectRM(\$RM_DB) unless $RM_DB;
295 
 
296 
    # Get all Releases
297 
    # From non-archived releases
5253 dpurdie 298 
    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 299 
                   " FROM release_manager.release_tags rt, release_manager.projects prj" .
300 
                   " WHERE prj.PROJ_ID = rt.PROJ_ID " .
5253 dpurdie 301 
                   "   AND rt.official != 'A' ORDER BY UPPER(prj.PROJ_NAME), UPPER(rt.RTAG_NAME)";
3410 dpurdie 302 
#                   "   AND rt.official != 'Y'" .
303 
 
304 
    Verbose3("getReleaseDetails: $m_sqlstr");
305 
    my $sth = $RM_DB->prepare($m_sqlstr);
306 
    if ( defined($sth) )
307 
    {
308 
        if ( $sth->execute( ) )
309 
        {
310 
            if ( $sth->rows )
311 
            {
312 
                while ( @row = $sth->fetchrow_array )
313 
                {
314 
                    my $rtag_id =$row[3];
315 
                    my $proj_id = $row[2];
5253 dpurdie 316 
                    my $official = $row[4];
317 
                    my $age = defined($row[5]) ? $row[5] : $row[6];
318 
 
319 
#if ( $official eq 'Y' ) {
320 
#    Information("Closed Age ($proj_id) : $age : $row[0], $row[1]");
321 
#}
322 
#                    if ( $official eq 'Y' && $age && $age > 300 )
323 
#                    {
324 
#                        next;
325 
#                    }
3410 dpurdie 326 
 
327 
                    $Releases{$rtag_id}{pName} = $row[0];
328 
                    $Releases{$rtag_id}{name} = $row[1];
329 
                    $Releases{$rtag_id}{proj_id} = $proj_id;
330 
                    $Releases{$rtag_id}{rtag_id} = $rtag_id;
331 
                    $Releases{$rtag_id}{official} = $row[4];
5253 dpurdie 332 
                    $Releases{$rtag_id}{officialDays} = defined($row[5]) ? $row[5] : $row[6] ;
333 
                    $Releases{$rtag_id}{createdDays} = $row[6];
3410 dpurdie 334 
 
335 
                    print join (',',@row), "\n" if ($opt_verbose > 2);
336 
                }
337 
            }
338 
            $sth->finish();
339 
        }
340 
        else
341 
        {
342 
            Error("getReleaseDetails:Execute failure: $m_sqlstr", $sth->errstr() );
343 
        }
344 
    }
345 
    else
346 
    {
347 
        Error("getReleaseDetails:Prepare failure" );
348 
    }
349 
}
350 
 
351 
#-------------------------------------------------------------------------------
352 
# Function        : GetAllPackageData
353 
#
354 
# Description     : Extract all package data
355 
#
356 
# Inputs          :
357 
#
358 
# Returns         :
359 
#
360 
 
361 
sub GetAllPackageData
362 
{
363 
    my (@row);
364 
    my $count = 0;
365 
 
366 
    # if we are not or cannot connect then return 0 as we have not found anything
367 
    connectRM(\$RM_DB) unless $RM_DB;
368 
 
369 
    Verbose ("Extract all package data");
370 
 
371 
    # First get all packages
372 
    # From non-archived releases
373 
 
374 
    my $limit = $opt_limit ? " AND rownum <= $opt_limit" : '';
375 
    my $m_sqlstr = "SELECT DISTINCT " .
376 
                        "pv.PV_ID, " .                                          #[0]
377 
                        "pkg.PKG_NAME, " .                                      #[1]
378 
                        "pv.PKG_VERSION, " .                                    #[2]
379 
                        "pv.DLOCKED, " .                                        #[3]
380 
                        "pv.PKG_ID," .                                          #[4]
381 
                        "pv.is_patch," .                                        #[5]
382 
                        "pv.build_type,".                                       #[6]
383 
                        "pbi.bsa_id," .                                         #[7]
384 
#                        "pv.CREATOR_ID, " .                                     #[8]
385 
#                        "pv.MODIFIED_STAMP, " .                                 #[9]
386 
#                        "release_manager.PK_RMAPI.return_vcs_tag(pv.PV_ID), " . #[10]
387 
                        "999" .
388 
                   " FROM RELEASE_MANAGER.PACKAGE_VERSIONS pv,".
389 
                         "RELEASE_MANAGER.PACKAGES pkg,".
390 
                         "release_manager.package_build_info pbi" .
391 
                   " WHERE pv.PKG_ID = pkg.PKG_ID" .
392 
                   "   AND pv.pv_id = pbi.pv_id(+)" .
393 
                    $limit ;
394 
    Verbose3("GetAllPackageData: $m_sqlstr");
395 
    my $sth = $RM_DB->prepare($m_sqlstr);
396 
    if ( defined($sth) )
397 
    {
398 
        if ( $sth->execute( ) )
399 
        {
400 
            if ( $sth->rows )
401 
            {
402 
                while ( @row = $sth->fetchrow_array )
403 
                {
404 
                    $count++;
405 
                    print join (',',@row), "\n" if ($opt_verbose > 2);
406 
                    my $pvid = $row[0];
407 
                    unless ( exists $Packages{$pvid}{name} )
408 
                    {
409 
                        $Packages{$pvid}{name} = $row[1];
410 
                        $Packages{$pvid}{version} = $row[2];
411 
                        $Packages{$pvid}{locked} = $row[3];
412 
                        $Packages{$pvid}{pkgid} = $row[4];
413 
                        $Packages{$pvid}{isPatch} = $row[5] || 0;
414 
                        $Packages{$pvid}{buildType} = $row[6] || 0;
415 
                        $Packages{$pvid}{buildStandard} = $row[7] || 0;
416 
 
417 
                        #$Packages{$pvid}{Creator} = $row[8];
418 
                        #$Packages{$pvid}{Age} = $row[9];
419 
                        #$Packages{$pvid}{vcstag} = $row[10];
420 
 
421 
                    }
422 
 
423 
                    if ( $opt_limit )
424 
                    {
425 
                        last if ( $count > $opt_limit );
426 
                    }
427 
                }
428 
            }
429 
            $sth->finish();
430 
        }
431 
        else
432 
        {
433 
            Error("GetAllPackageData:Execute failure: $m_sqlstr", $sth->errstr() );
434 
        }
435 
    }
436 
    else
437 
    {
438 
        Error("GetAllPackageData:Prepare failure" );
439 
    }
440 
 
441 
    Verbose ("All Packages: $count rows");
442 
}
443 
 
444 
#-------------------------------------------------------------------------------
445 
# Function        : getTopLevelPackages
446 
#
447 
# Description     : Extract top level packages from active releases
448 
#
449 
# Inputs          :
450 
#
451 
# Returns         :
452 
#
453 
 
454 
sub getTopLevelPackages
455 
{
456 
    my (@row);
457 
    my $count = 0;
458 
 
459 
    # if we are not or cannot connect then return 0 as we have not found anything
460 
    connectRM(\$RM_DB) unless $RM_DB;
461 
 
462 
    Verbose ("Extract toplevel dependencies");
463 
 
464 
    # First get all packages that are referenced in a Release
465 
    # This will only get the top level packages
466 
    # From non-archived releases
467 
 
468 
    my $limit = $opt_limit ? " AND rownum <= $opt_limit" : '';
469 
    my $m_sqlstr = "SELECT DISTINCT " .
470 
                        "rc.PV_ID, " .                                          #[0]
471 
                        "rt.RTAG_ID, " .                                        #[1]
472 
                        "prj.PROJ_ID " .                                        #[2]
473 
                   " FROM RELEASE_MANAGER.RELEASE_CONTENT rc, ".
474 
                         "release_manager.release_tags rt,".
475 
                         "release_manager.projects prj" .
476 
                   " WHERE prj.PROJ_ID = rt.PROJ_ID" .
477 
                   "   and rt.RTAG_ID = rc.RTAG_ID" .
478 
                   "   AND rt.official != 'A'" .
479 
#                   "   AND rt.official != 'Y' " .
480 
                    $limit;
481 
 
482 
    Verbose3("getTopLevelPackages: $m_sqlstr");
483 
    my $sth = $RM_DB->prepare($m_sqlstr);
484 
    if ( defined($sth) )
485 
    {
486 
        if ( $sth->execute( ) )
487 
        {
488 
            if ( $sth->rows )
489 
            {
490 
                while ( @row = $sth->fetchrow_array )
491 
                {
492 
                    $count++;
493 
                    print join (',',@row), "\n" if ($opt_verbose > 2);
494 
                    my $pvid = $row[0];
495 
                    $Packages{$pvid}{tlp} = 1;
496 
                    push @StrayPackages, $pvid;
497 
 
498 
 
499 
                    my $rtag_id = $row[1];
500 
                    push @{$Packages{$pvid}{release}}, $rtag_id;
501 
 
502 
                    my $proj_id = $row[2];
503 
                    push @{$Packages{$pvid}{projects}}, $proj_id
504 
                        unless (grep {$_ eq $proj_id} @{$Packages{$pvid}{projects}});
505 
 
506 
                    if ( $opt_limit )
507 
                    {
508 
                        last if ( $count > $opt_limit );
509 
                    }
510 
                }
511 
            }
512 
            $sth->finish();
513 
        }
514 
        else
515 
        {
516 
            Error("getTopLevelPackages:Execute failure: $m_sqlstr", $sth->errstr() );
517 
        }
518 
    }
519 
    else
520 
    {
521 
        Error("getTopLevelPackages:Prepare failure" );
522 
    }
523 
 
524 
    Verbose ("Extract toplevel dependencies: $count rows");
525 
}
526 
 
527 
#-------------------------------------------------------------------------------
5125 dpurdie 528 
# Function        : GetSdkPackageData
529 
#
530 
# Description     : Extract Packages that are a part of a non-deprecated SDK
531 
#                   Only want the exposed packages
532 
#
533 
#                   Don't care about the dependencies, so don't add them
534 
#                   to strays
535 
#
536 
# Inputs          :
537 
#
538 
# Returns         :
539 
#
540 
 
541 
sub GetSdkPackageData
542 
{
543 
    my (@row);
544 
    my $count = 0;
545 
 
546 
    # if we are not or cannot connect then return 0 as we have not found anything
547 
    connectRM(\$RM_DB) unless $RM_DB;
548 
 
549 
    Verbose ("Extract SDK Packages");
550 
 
551 
    # Get all packages that are a part of a non-deprecated SDK
552 
    # Only get the 'exposed' packages
553 
 
554 
    my $limit = $opt_limit ? " AND rownum <= $opt_limit" : '';
555 
    my $m_sqlstr = "SELECT sc.pv_id, " .                #[0]
556 
                   "       p.PKG_NAME, " .              #[1]
557 
                   "       pv.PKG_VERSION" .            #[2]
558 
                   " FROM RELEASE_MANAGER.SDK_CONTENT sc," .
559 
                   "   RELEASE_MANAGER.sdk_tags st," .
560 
                   "   RELEASE_MANAGER.package_versions pv," .
561 
                   "   RELEASE_MANAGER.PACKAGES p" .
562 
                   " WHERE sc.SDKTAG_ID    = st.SDKTAG_ID" .
563 
                   " AND p.PKG_ID = pv.PKG_ID" .
564 
                   " AND pv.PV_ID = sc.pv_id" .
565 
                   " AND sc.SDKPKG_STATE   = 'E'" .
566 
                   " AND st.SDK_STATE NOT IN ('D')" .
567 
                    $limit;
568 
 
569 
    Verbose3("GetSdkPackageData: $m_sqlstr");
570 
    my $sth = $RM_DB->prepare($m_sqlstr);
571 
    if ( defined($sth) )
572 
    {
573 
        if ( $sth->execute( ) )
574 
        {
575 
            if ( $sth->rows )
576 
            {
577 
                while ( @row = $sth->fetchrow_array )
578 
                {
579 
                    $count++;
580 
                    print join (',',@row), "\n" if ($opt_verbose > 2);
581 
                    my $pvid = $row[0];
582 
                    $Packages{$pvid}{sdk} = 1;
583 
                    unless ( exists $Packages{$pvid}{name} )
584 
                    {
585 
                        $Packages{$pvid}{name} = $row[1];
586 
                        $Packages{$pvid}{version} = $row[2];
587 
                    }
588 
 
589 
                    if ( $opt_limit )
590 
                    {
591 
                        last if ( $count > $opt_limit );
592 
                    }
593 
                }
594 
            }
595 
            $sth->finish();
596 
        }
597 
        else
598 
        {
599 
            Error("GetSdkPackageData:Execute failure: $m_sqlstr", $sth->errstr() );
600 
        }
601 
    }
602 
    else
603 
    {
604 
        Error("GetSdkPackageData:Prepare failure" );
605 
    }
606 
 
607 
    Verbose ("Extract SDK Packages: $count rows");
608 
}
609 
 
610 
#-------------------------------------------------------------------------------
611 
# Function        : GetRecentDMPackages
612 
#
613 
# Description     : Extract Packages that referenced in Deployment Manager
614 
#                   Want all package-versions from the last two BOMS in each state
615 
#                   of all projects.
616 
#
617 
# Inputs          :
618 
#
619 
# Returns         :
620 
#
621 
 
622 
sub GetRecentDMPackages
623 
{
624 
    my (@row);
625 
    my $count = 0;
626 
 
627 
    # if we are not or cannot connect then return 0 as we have not found anything
628 
    connectDM(\$DM_DB) unless ($DM_DB);
629 
 
630 
    Verbose ("Extract DM Packages");
631 
 
632 
    # Get all packages that are a part of a non-deprecated SDK
633 
    # Only get the 'exposed' packages
634 
 
635 
    my $limit = $opt_limit ? " AND rownum <= $opt_limit" : '';
5609 dpurdie 636 
    my $m_sqlstr =
637 
        "SELECT DISTINCT pv.pv_id,".                        #[0]
638 
        "  pkg.pkg_name,".                                  #[1]
639 
        "  pv.pkg_version".                                 #[2]
640 
        " FROM DEPLOYMENT_MANAGER.bom_contents bc,".
641 
        "     DEPLOYMENT_MANAGER.operating_systems os,".
642 
        "     DEPLOYMENT_MANAGER.os_contents osc,".
643 
        "     DEPLOYMENT_MANAGER.PACKAGES pkg,".
644 
        "     DEPLOYMENT_MANAGER.PACKAGE_VERSIONS pv,".
645 
        "     DEPLOYMENT_MANAGER.PRODUCT_DETAILS pd".
5125 dpurdie 646 
        " WHERE osc.os_id = os.os_id".
647 
        " AND os.node_id  = bc.node_id".
648 
        " AND bc.bom_id  IN".
5609 dpurdie 649 
        "  (SELECT bom_id".
650 
        "  FROM".
651 
        "    (SELECT bs.bom_id, b.branch_id, state_id,".
652 
        "      RANK( ) OVER (PARTITION BY bs.state_id,b.branch_id ORDER BY bs.bom_id DESC) SRLNO".
653 
        "    FROM DEPLOYMENT_MANAGER.bom_state bs ,".
654 
        "         DEPLOYMENT_MANAGER.boms b".
655 
        "    WHERE bs.bom_id = b.bom_id".
656 
        "    )".
657 
        "  WHERE SRLNO <= 2".
658 
        "  )".
5125 dpurdie 659 
        " AND pd.PROD_ID (+) = osc.PROD_ID".
660 
        " AND pv.pkg_id      = pkg.pkg_id".
661 
        " AND osc.prod_id    = pv.pv_id".
5609 dpurdie 662 
        " ORDER BY UPPER(pkg.pkg_name), ".
663 
        "          UPPER(pv.PKG_VERSION)".
5125 dpurdie 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;}
1064 
                if ($mtime <= $config{retain}) { $keepReason ='RetainTime:' . ($config{retain} - $mtime); last;}
1065 
                #unless ($entry->{buildStandard}) { $keepReason ='NoBuildStandard:' . $mtime; last;}
5253 dpurdie 1066 
                if ($entry->{locked} ne 'Y') { $keepReason ='NotLocked:' . $entry->{locked}; last;}
1067 
                #if ($entry->{buildType} eq 'M') { $keepReason ='ManualBuild:' . $entry->{buildType}; last;}
1068 
 
1069 
                $pkgPvid{$pkgName}{$pkgVersion}{keepReason} = $keepReason;
1070 
            }
1071 
 
1072 
            unless ( $keepReason )
1073 
            {
3410 dpurdie 1074 
                Verbose2("Quarantine:$pvid, $pkgName, $pkgVersion, Age:$mtime, Lock:$entry->{locked}, Patch:$entry->{isPatch}, BS:$entry->{buildStandard}, BT:$entry->{buildType}");
1075 
                quarantineItem( 'Q', $mtime, join('/', $config{dpkg_archive}, $pkgName, $pkgVersion ) );
5534 dpurdie 1076 
                $keepReason = 'Quarantine';
3410 dpurdie 1077 
            }
5253 dpurdie 1078 
 
1079 
            if ($opt_explain)
1080 
            {
1081 
                Information("Reason:$pvid, $pkgName, $pkgVersion, Reason:$keepReason");
1082 
            }
5534 dpurdie 1083 
 
1084 
            #
1085 
            #   Maintain Stats
1086 
            #       Only use the Base Reason - remove details after the ':' character
1087 
            #
1088 
            my $sReason = $keepReason;
1089 
            $sReason =~ s~:.*$~~;
1090 
            $statistics{$sReason}++;
1091 
            $statistics{TotalPackages}++;
3410 dpurdie 1092 
        }
1093 
    }
1094 
 
1095 
    #
1096 
    # Perform the quarantine
1097 
    #
1098 
    doQuarantine();
1099 
    ErrorDoExit();
1100 
}
1101 
 
1102 
#-------------------------------------------------------------------------------
1103 
# Function        : reportMissingPkgs
1104 
#
1105 
# Description     : Report packages that 'should' be in dpkg_archive because
1106 
#                   they are essential, but are not
1107 
#
1108 
# Inputs          :
1109 
#
1110 
# Returns         :
1111 
#
1112 
sub reportMissingPkgs
1113 
{
1114 
    return;
1115 
 
1116 
    #
1117 
    #   Not very useful as there is too much information
1118 
    #   It would appear that the quarantine process may have also
1119 
    #   been deleting packages from 'closed' as well as 'archived'
1120 
    #   releases at some stage.
1121 
    #
1122 
    #   Report packages used in not-archived or not-closed releases
1123 
    #
1124 
    my @missing;
1125 
    foreach my $pvid (keys %Packages )
1126 
    {
1127 
        my $entry = $Packages{$pvid};
1128 
        next unless ( exists $entry->{tlp} );
1129 
#        next unless ( exists $entry->{slp} );
1130 
        next if ( $entry->{dpkg_archive} );
1131 
        next unless ( exists $entry->{name} );
1132 
 
1133 
        #
1134 
        #   Missing package
1135 
        #   Determine if its in use by an active release
1136 
        #
1137 
 
1138 
        my @releases = usedBy($pvid);
1139 
        foreach my $release (@releases )
1140 
        {
1141 
            next if ( $Releases{$release}{official} eq 'Y' );
1142 
            next if ( $Releases{$release}{official} eq 'A' );
1143 
            push @missing, $entry->{name} . ' ' . $entry->{version} . " ($pvid)";
1144 
            last;
1145 
        }
1146 
    }
1147 
 
1148 
    Warning ("Packages required by active releases that are not in dpkg_archive", sort @missing);
1149 
}
1150 
 
1151 
#-------------------------------------------------------------------------------
1152 
# Function        : usedBy
1153 
#
1154 
# Description     : Given a pvid, determine which release(s) need it
1155 
#
1156 
# Inputs          : $pvid
1157 
#
1158 
# Returns         : Nothing
1159 
#
1160 
sub usedBy
1161 
{
1162 
    my ($pvid) = @_;
1163 
    my %seen;
1164 
 
1165 
    Error ("PVID is not an essential package") unless ( exists $Packages{$pvid} );
1166 
 
1167 
    my @releases = @{$Packages{$pvid}{'release'}} if exists($Packages{$pvid}{'release'});
1168 
    my @users = @{$Packages{$pvid}{'usedBy'}} if exists($Packages{$pvid}{'usedBy'});
1169 
 
1170 
    while ( @users )
1171 
    {
1172 
        my $pv = pop @users;
1173 
 
1174 
        next if ( exists $seen{$pv} );
1175 
        $seen{$pv} = 1;
1176 
 
1177 
        push @releases, @{$Packages{$pv}{'release'}} if (exists $Packages{$pv}{'release'});
1178 
        push @users, @{$Packages{$pv}{'usedBy'}} if (exists($Packages{$pv}{'usedBy'}));
1179 
    }
1180 
    return @releases;
1181 
}
1182 
 
1183 
#-------------------------------------------------------------------------------
5534 dpurdie 1184 
# Function        : reportStats
1185 
#
1186 
# Description     : Report statistics
1187 
#                   Write statistics to a file
1188 
#                       Write to a tmp file, then rename.
1189 
#                       Attempt to make the operation atomic - so that the file consumer
1190 
#                       doesn't get a badly formed file.
1191 
#
1192 
#
1193 
# Inputs          :
1194 
#
1195 
# Returns         :
1196 
#
1197 
sub reportStats
1198 
{
1199 
    #
1200 
    #   Time stamp the stats
1201 
    #
1202 
    $statistics{'timeStamp'} = time();
1203 
 
1204 
    #
1205 
    #   Save stats to a known file for Nagios to use
1206 
    #
1207 
    my $statsfiletmp = join('/', $config{logBase}, 'quarantine.stats.tmp' );
1208 
    my $statsfile    = join('/', $config{logBase}, 'quarantine.stats');
1209 
 
1210 
    my $fh;
1211 
    unless (open ($fh, '>', $statsfiletmp))
1212 
    {
1213 
        $fh = undef;
1214 
        Warning("Cannot create temp stats file: $!");
1215 
    }
1216 
    else
1217 
    {
1218 
        foreach my $key ( sort { lc($a) cmp lc($b) } keys %statistics)
1219 
        {
1220 
            print $fh $key . ':' . $statistics{$key} . "\n";
1221 
            Log('Statistics: '. $key . ':' . $statistics{$key});
1222 
        }
1223 
        close $fh;
1224 
 
1225 
        # Rename temp to real file
1226 
        rename  $statsfiletmp,  $statsfile;
1227 
    }
1228 
}
1229 
 
1230 
 
1231 
#-------------------------------------------------------------------------------
3410 dpurdie 1232 
# Function        : quarantineItem
1233 
#
1234 
# Description     : Add item to the list of stuff to be quarantined
1235 
#
1236 
# Inputs          : $reason         - Reason
1237 
#                   $age            - Age
1238 
#                   $path           - Path
1239 
#
1240 
# Returns         :
1241 
#
1242 
sub quarantineItem
1243 
{
1244 
    my ($reason, $age, $path ) = @_;
1245 
    my %data;
1246 
    $data{reason} = $reason;
1247 
    $data{age} = $age;
1248 
    $data{path} = $path;
1249 
 
1250 
    push @quarantineItems, \%data;
1251 
}
1252 
 
1253 
#-------------------------------------------------------------------------------
1254 
# Function        : doQuarantine
1255 
#
1256 
# Description     : Quarantine files and folders that have been queued up
1257 
#
1258 
# Inputs          : None
1259 
#
1260 
# Returns         :
1261 
#
1262 
sub doQuarantine
1263 
{
1264 
    my $testMsg = $opt_test ? 'Test,' : '';
4093 dpurdie 1265 
 
1266 
    # Process entries - oldest first
1267 
    #
4127 dpurdie 1268 
    my $countRemain = ( scalar @quarantineItems );
4093 dpurdie 1269 
    foreach my $entry (sort {$b->{age} <=> $a->{age} } @quarantineItems)
3410 dpurdie 1270 
    {
1271 
        my $rv;
1272 
        my $emsg = ' - with error';
5272 dpurdie 1273 
        my $s3error = 0;
3410 dpurdie 1274 
 
1275 
        my $path = $entry->{path};
1276 
        my $tpath = $path;
1277 
           $tpath =~ s~^$config{dpkg_archive}~~;
1278 
           $tpath = $quarantineInstance.$tpath;
1279 
        my $tdir = dirname ( $tpath );
1280 
 
1281 
        unless ( $opt_test )
1282 
        {
4542 dpurdie 1283 
            #
1284 
            #   Transfer to Amazon S3 storage first
1285 
            #   The transfer is done via an external program (script)
1286 
            #   The transfer will tar-zip the packageVersion
1287 
            #
1288 
            {
1289 
                my $s3msg = "";
1290 
                my $pv = $path;
1291 
 
1292 
                #
1293 
                #   Export the Secrets in EnvVars
1294 
                #   Use program defaults so that we don't need to specify them
1295 
                #   on the command line - for all to see
1296 
                #
1297 
                $ENV{AWSKEY} = $config{S3Key};
1298 
                $ENV{AWSSECRET} = $config{S3Secret};
1299 
 
1300 
                $rv = system ( "$progBase/savePkgToS3.sh", "--bucket=$config{S3Bucket}" ,"--path=$path" );
1301 
                if ( $rv )
1302 
                {
1303 
                    ReportError ("Move $path to S3");
1304 
                    $s3msg = ' - with S3 error';
5272 dpurdie 1305 
                    $s3error = 1;
1306 
                    $emsg = ' - S3 Error prevented quarantine';
5534 dpurdie 1307 
                    $statistics{'S3TransferError'}++;
1308 
 
4542 dpurdie 1309 
                }
1310 
                Log (sprintf("S3Quarantined:%s%s,%4.4s,%s%s", $testMsg, $entry->{reason}, $entry->{age}, $path, $s3msg));
1311 
            }
1312 
 
5272 dpurdie 1313 
            unless ($s3error)
3410 dpurdie 1314 
            {
5272 dpurdie 1315 
                #
1316 
                #   Transfer then delete to local directory
1317 
                #
1318 
                unless (-d $tdir)
3410 dpurdie 1319 
                {
5272 dpurdie 1320 
                    eval { mkpath($tdir) };
1321 
                    ReportError ("Did not create quarantine target: $tdir")
1322 
                        unless (-d $tdir);
3410 dpurdie 1323 
                }
5272 dpurdie 1324 
 
1325 
                if (-d $tdir)
3410 dpurdie 1326 
                {
5272 dpurdie 1327 
                    $rv = system ('mv', '-n', $path, $tdir);
1328 
                    if ( $rv )
1329 
                    {
1330 
                        ReportError ("Move $path to $tdir");
5534 dpurdie 1331 
                        $statistics{'QuarantineError'}++;
1332 
 
5272 dpurdie 1333 
                        #
1334 
                        # Clean up what may have been moved
1335 
                        # NOTE: deleted so that we don't loose stuff if it gets ugly
1336 
        #                rmtree( $tpath);
1337 
        #                rmdir ($tdir);
1338 
                    }
1339 
                    else
1340 
                    {
1341 
                        $emsg = '';
1342 
                    }
3410 dpurdie 1343 
                }
1344 
            }
1345 
        }
1346 
        else
1347 
        {
1348 
            Verbose2("Test: 'mv', '$path', '$tdir'");
1349 
            $emsg = '';
1350 
        }
1351 
 
1352 
        # Log operation with frills
1353 
        Log (sprintf("Quarantined:%s%s,%4.4s,%s%s", $testMsg, $entry->{reason}, $entry->{age}, $path, $emsg));
4093 dpurdie 1354 
 
1355 
        # Limit packages quarantined
4127 dpurdie 1356 
        $countRemain--;
4093 dpurdie 1357 
        if ($opt_pcount > 0)
1358 
        {
1359 
            $opt_pcount--;
1360 
            if ($opt_pcount == 0)
1361 
            {
4127 dpurdie 1362 
                Log ("Quarantine package count exceeded. Quarantine terminated. $countRemain packages remaining");
4093 dpurdie 1363 
                last;
1364 
            }
1365 
        }
3410 dpurdie 1366 
    }
1367 
}
1368 
 
1369 
#-------------------------------------------------------------------------------
1370 
# Function        : Log
1371 
#
1372 
# Description     : Log a string
1373 
#
1374 
# Inputs          : Line to log
1375 
#
1376 
# Returns         :
1377 
#
1378 
sub Log
1379 
{
1380 
    my ($line) = @_;
4093 dpurdie 1381 
    Verbose("Log: " . $line);
3410 dpurdie 1382 
 
1383 
    if (open ( LF, '+>>', $logPath ) )
1384 
    {
1385 
        print LF $line . "\n";
1386 
        close LF;
1387 
    }
1388 
}
1389 
 
1390 
#-------------------------------------------------------------------------------
1391 
# Function        : readInputData
1392 
#
1393 
# Description     : Write out data in a form to allow post processing
1394 
#
1395 
# Inputs          :
1396 
#
1397 
# Returns         :
1398 
#
1399 
sub readInputData
1400 
{
1401 
    unless ( keys(%Packages) > 0 )
1402 
    {
1403 
        my $fname = "quarantine.raw.txt";
1404 
        Verbose ("Reading: $fname");
1405 
        Error "Cannot locate $fname" unless ( -f $fname );
1406 
        require $fname;
1407 
 
1408 
        Error "Data in $fname is not valid\n"
1409 
            unless ( keys(%Packages) > 0 );
1410 
    }
1411 
 
1412 
    #
1413 
    # Create a lookup from package name/version to pvid
1414 
    #
1415 
    Verbose ("Create PackageVersion to PVID hash");
1416 
    foreach my $pvid ( keys %Packages )
1417 
    {
1418 
        my $name = $Packages{$pvid}{name};
1419 
        my $version = $Packages{$pvid}{version};
1420 
        if ( $name && $version )
1421 
        {
1422 
            $pkgPvid{$name}{$version}{pvid} = $pvid;
1423 
        }
1424 
    }
1425 
}
1426 
 
1427 
#-------------------------------------------------------------------------------
1428 
#   Documentation
1429 
#
1430 
 
1431 
=pod
1432 
 
1433 
=for htmltoc    SYSUTIL::
1434 
 
1435 
=head1 NAME
1436 
 
1437 
jats_quarantine - Determine packages to be quarantined
1438 
 
1439 
=head1 SYNOPSIS
1440 
 
1441 
  jats jats_quarantine [options]
1442 
 
1443 
 Options:
1444 
    -help              - brief help message
1445 
    -help -help        - Detailed help message
1446 
    -man               - Full documentation
1447 
    -verbose[=n]       - Control output
5534 dpurdie 1448 
    -explain           - Display each package version disposition
3410 dpurdie 1449 
    -phase=nn          - Perform named phases
4092 dpurdie 1450 
    -purge             - Just purge the old quarantined files
3410 dpurdie 1451 
    -test              - Do not delete files
1452 
    -limit=n           - Limit packages processed. Test only
4093 dpurdie 1453 
    -pcount=n          - Limit package count
3410 dpurdie 1454 
 
1455 
=head1 OPTIONS
1456 
 
1457 
=over 8
1458 
 
1459 
=item B<-help>
1460 
 
1461 
Print a brief help message and exits.
1462 
 
1463 
=item B<-help -help>
1464 
 
1465 
Print a detailed help message with an explanation for each option.
1466 
 
1467 
=item B<-man>
1468 
 
1469 
Prints the manual page and exits.
1470 
 
1471 
=item B<-verbose[=n]>
1472 
 
1473 
This option control the programs output. Normally this program will not generate
1474 
any output. It will only generate output on error conditions. This is intentional
1475 
as the program will be run as a cron-job and output errors will be mailed out.
1476 
 
1477 
A verbose level of 1. will display progress information
1478 
 
1479 
A verbose level of 3. will display detailed tracing of all operations
1480 
 
5534 dpurdie 1481 
=item B<-explain[=n]>
1482 
 
1483 
This option will output a line per package-version explaining the reason that
1484 
packages are retained.
1485 
 
1486 
Only a level of 1 is supported.
1487 
 
3410 dpurdie 1488 
=item B<-phase=list>
1489 
 
1490 
This option will limit the work done by the program. There are two phases
1491 
called: 1 and 2.
1492 
 
1493 
Phase-1 will examine Release Manager collect package-version information.
1494 
Phase-2 will examine dpkg_archive and collect package-version information. It
1495 
will then initiate the quarantine operation.
1496 
 
1497 
The default operation is to perform phase-1 and phase-2.
1498 
 
1499 
If only phase-1 is specified then the RM data is saved, to be used by a
1500 
later phase.
1501 
 
1502 
If only phase-2 is specified then saved RM data is restored.
1503 
 
1504 
This option can simplify testing.
1505 
 
4092 dpurdie 1506 
=item B<-purge>
1507 
 
1508 
This option will only purge the old quarantine directories. It will not quarantine new
1509 
package versions.
1510 
 
3410 dpurdie 1511 
=item B<-test>
1512 
 
1513 
Do not delete or move files and directories. Report what would have been done.
1514 
 
1515 
=item B<-limit=n>
1516 
 
1517 
Limit the number of packages processed by the tool. This is only used to
1518 
simplify testing of the program
1519 
 
1520 
=back
1521 
 
1522 
=head1 DESCRIPTION
1523 
 
1524 
This program is a tool used in the maintainance of dpkg_archive.
1525 
It will:
1526 
 
1527 
=over 8
1528 
 
1529 
=item *
1530 
 
1531 
Determine package-versions in use by Release Manager.
1532 
 
1533 
=item *
1534 
 
5125 dpurdie 1535 
Determine package-versions in recent Deployment Manager SBOMS.
1536 
 
1537 
=item *
1538 
 
3410 dpurdie 1539 
Determine package-versions that can be rebuilt
1540 
 
1541 
=item *
1542 
 
1543 
Recursively find all the dependent packages of all packages. New package
1544 
versions are called 'indirect' dependencies. They are buried. This process can
1545 
take several minutes.
1546 
 
1547 
=back
1548 
 
1549 
The data collected is dumped into a text file for later processing.
1550 
 
1551 
=cut
1552