Subversion Repositories DevTools

Rev

Rev 5534 | Rev 5609 | 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" : '';
636 
    my $m_sqlstr =
637 
        " SELECT DISTINCT pv.pv_id,".               #[0]
638 
        "   pkg.pkg_name,".                         #[1]
639 
        "   pv.pkg_version".                        #[2]
640 
        " FROM 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".
646 
        " WHERE osc.os_id = os.os_id".
647 
        " AND os.node_id  = bc.node_id".
648 
        " AND bc.bom_id  IN".
649 
        "   (SELECT bom_id".
650 
        "   FROM".
651 
        "     (SELECT bom_id,".
652 
        "       state_id,".
653 
        "       RANK( ) OVER (PARTITION BY state_id ORDER BY bom_id DESC) SRLNO".
654 
        "     FROM DEPLOYMENT_MANAGER.bom_state".
655 
        "     )".
656 
        "   WHERE SRLNO <= 2".
657 
        "   )".
658 
        " AND pd.PROD_ID (+) = osc.PROD_ID".
659 
        " AND pv.pkg_id      = pkg.pkg_id".
660 
        " AND osc.prod_id    = pv.pv_id".
661 
        " ORDER BY UPPER(pkg.pkg_name),".
662 
        "   UPPER(pv.PKG_VERSION)".
663 
        $limit;
664 
 
665 
    Verbose3("GetRecentDMPackages: $m_sqlstr");
666 
    my $sth = $DM_DB->prepare($m_sqlstr);
667 
    if ( defined($sth) )
668 
    {
669 
        if ( $sth->execute( ) )
670 
        {
671 
            if ( $sth->rows )
672 
            {
673 
                while ( @row = $sth->fetchrow_array )
674 
                {
675 
                    $count++;
676 
                    print join (',',@row), "\n" if ($opt_verbose > 2);
677 
                    my $pvid = $row[0];
678 
                    $Packages{$pvid}{dm} = 1;
679 
                    unless ( exists $Packages{$pvid}{name} )
680 
                    {
681 
                        $Packages{$pvid}{name} = $row[1];
682 
                        $Packages{$pvid}{version} = $row[2];
683 
                    }
684 
                    push @StrayPackages, $pvid;
685 
 
686 
                    if ( $opt_limit )
687 
                    {
688 
                        last if ( $count > $opt_limit );
689 
                    }
690 
                }
691 
            }
692 
            $sth->finish();
693 
        }
694 
        else
695 
        {
696 
            Error("GetRecentDMPackages:Execute failure: $m_sqlstr", $sth->errstr() );
697 
        }
698 
    }
699 
    else
700 
    {
701 
        Error("GetRecentDMPackages:Prepare failure" );
702 
    }
703 
 
704 
    Verbose ("Extract Deployed Packages: $count rows");
705 
}
706 
 
707 
#-------------------------------------------------------------------------------
3410 dpurdie 708 
# Function        : GetDepends
709 
#
710 
# Description     :
711 
#
712 
# Inputs          : @plist          - list of pvid's to process
713 
#
714 
# Returns         :
715 
#
716 
sub GetDepends
717 
{
718 
    my (@plist) = @_;
719 
 
720 
    #
721 
    #   Now extract the package dependacies
722 
    #   There may not be any
723 
    #
724 
    my $m_sqlstr = "SELECT ".
725 
                    " pd.PV_ID, ".
726 
                    " pd.DPV_ID " .
727 
                  " FROM    RELEASE_MANAGER.PACKAGE_DEPENDENCIES pd ".
728 
                  " WHERE pd.PV_ID in ( " . join(',', @plist) . " )";
729 
    my $sth = $RM_DB->prepare($m_sqlstr);
730 
    if ( defined($sth) )
731 
    {
732 
        if ( $sth->execute( ) )
733 
        {
734 
            if ( $sth->rows )
735 
            {
736 
                while ( my @row = $sth->fetchrow_array )
737 
                {
738 
                    my $pvid = $row[0];
739 
                    my $dpvid = $row[1];
740 
                    push @StrayPackages, $dpvid;
741 
                    push @{$Packages{$dpvid}{usedBy}}, $pvid;
3423 dpurdie 742 
                    $Packages{$dpvid}{slp} = 1 unless exists $Packages{$dpvid}{tlp};
3410 dpurdie 743 
 
744 
                    print join (',','GetDepends',@row), "\n" if ($opt_verbose > 2);
745 
                }
746 
            }
747 
            $sth->finish();
748 
        }
749 
        else
750 
        {
751 
            Error("GetDepends:Execute failure: $m_sqlstr", $sth->errstr() );
752 
        }
753 
    }
754 
    else
755 
    {
756 
        Error("GetDepends:Prepare failure" );
757 
    }
758 
}
759 
 
760 
#-------------------------------------------------------------------------------
761 
# Function        : LocateStrays
762 
#
763 
# Description     : Locate stray packages
764 
#                   Try to do several (200) at a time to speed up processing
765 
#
766 
# Inputs          :
767 
#
768 
# Returns         :
769 
#
770 
sub LocateStrays
771 
{
772 
    Verbose ("Locate indirectly referenced packages");
773 
    while ( $#StrayPackages >= 0 )
774 
    {
775 
#print "Strays Remaining: ", scalar @StrayPackages ,"\n";
776 
 
777 
        my @plist;
778 
        while ( $#plist <= 200 && @StrayPackages )
779 
        {
780 
            my $pv_id = pop @StrayPackages;
781 
            next if ( exists $Packages{$pv_id}{done} );
782 
            push @plist, $pv_id;
783 
        }
784 
 
785 
        GetDepends(@plist) if @plist;
786 
 
787 
        foreach ( @plist)
788 
        {
789 
            $Packages{$_}{done} = 1;
790 
        }
791 
    }
792 
}
793 
 
794 
#-------------------------------------------------------------------------------
795 
# Function        : savePhaseData
796 
#
797 
# Description     : Save inter-phase data
798 
#
799 
# Inputs          :
800 
#
801 
# Returns         :
802 
#
803 
sub savePhaseData
804 
{
805 
    my $count = 0;
806 
    my $direct = 0;
807 
    my $indirect = 0;
808 
    my $buildable = 0;
809 
    my $bad = 0;
5125 dpurdie 810 
    my $sdk = 0;
3410 dpurdie 811 
 
812 
    foreach my $pvid ( keys %Packages )
813 
    {
814 
        my $entry = $Packages{$pvid};
815 
        unless ( defined $entry->{name} && defined $entry->{version})
816 
        {
817 
            Warning ("Package Name or Version not known: $pvid");
818 
            $bad++;
819 
            next;
820 
        }
821 
 
822 
        $count++;
823 
        if ( $entry->{locked} && $entry->{locked} eq 'Y' && $entry->{buildStandard} > 0 )
824 
        {
825 
            $buildable++;
826 
        }
827 
 
5125 dpurdie 828 
        if ( $entry->{tlp} ) {
829 
            $direct++;
830 
        }
831 
        elsif ( $entry->{slp} ) {
832 
            $indirect++;
833 
        }
834 
        elsif ($entry->{sdk}) {
835 
            $sdk++;
836 
        }
837 
 
3410 dpurdie 838 
    }
839 
 
840 
    my $file = "quarantine.raw.txt";
841 
    Verbose ("Create: $file");
842 
    my $fh = ConfigurationFile::New( $file );
843 
 
844 
    $fh->DumpData(
845 
        "\n# Package Data.\n#\n",
846 
        "Packages", \%Packages );
847 
 
848 
    $fh->DumpData(
849 
        "\n# Release Data.\n#\n",
850 
        "Releases", \%Releases );
851 
 
852 
    $fh->Close();
853 
 
5125 dpurdie 854 
    Verbose("Packages: $count, Bad: $bad: Buildable: $buildable, Directly included: $direct, Indirect: $indirect, Sdk: $sdk");
3410 dpurdie 855 
}
856 
 
857 
#-------------------------------------------------------------------------------
858 
# Function        : prepQdir
859 
#
860 
# Description     : Prepare the quarantine target directory
861 
#                   Setup logging
862 
#
863 
#                   Done at the start of the 2nd phase
864 
#
865 
# Inputs          :
866 
#
867 
# Returns         :
868 
#
869 
sub prepQdir
870 
{
871 
    my ( $ss, $mm, $hh, $dd, $mo, $yy ) = ( localtime($now) )[0..5];
872 
    my $stamp = sprintf("%4.4d%2.2d%2.2d_%2.2d%2.2d%2.2d", $yy+1900, $mo+1, $dd, $hh,$mm,$ss);
873 
 
874 
    $quarantineInstance = join('/', $config{quarantine}, $stamp);
875 
 
876 
    my $logName = 'quarantine_' . $stamp . '.txt';
877 
    $logPath = join('/', $config{logBase}, $logName );
878 
    eval { mkpath($config{logBase}) } unless -d $config{logBase};
879 
    Error ("Log directory not found/created: $config{logBase}") unless -d $config{logBase};
880 
 
881 
    #
882 
    #   Start the log file
883 
    Log ("TEST Mode Enabled") if $opt_test;
884 
    Log ("QuarantinePath: $quarantineInstance");
3423 dpurdie 885 
    Log ("Config: $_ = $config{$_}") foreach ( sort keys %config );
886 
    Log ("Ignore: $_") foreach ( sort keys %retainPkgs );
3410 dpurdie 887 
 
888 
    #
889 
    # Create a 'nice' symlink to the latest log file
890 
    my $logLatest = join('/', $config{logBase}, 'latest');
891 
    unlink ( $logLatest );
892 
    symlink( $logName, $logLatest);
893 
 
894 
    #
895 
    #   Clean up old files
896 
    #
897 
    opendir( Q, $config{quarantine} ) || Error ("opendir failed on: $config{quarantine}" );
898 
 
899 
    # delete any quarantine instance older than 90 days
900 
    while ( my $file = readdir( Q ) )
901 
    {
902 
        #
903 
        #   Skip housekeeping directory entries
904 
        #
905 
        next if ( $file eq '.' );
906 
        next if ( $file eq '..' );
907 
        next if ( $file eq 'lost+found' );
908 
 
909 
        my $path = join( '/', $config{quarantine} . "/" . $file);
910 
        my $age = checkTime( $path );
911 
        if ( $age > $config{qdirAge} )
912 
        {
913 
            Log ("Old Quarantine Removed: $path");
914 
            Verbose ("Test: Delete Dir: $path") if ( $opt_test );
915 
            rmtree($path, 0, 1) unless $opt_test;
916 
        }
917 
    }
918 
 
919 
    closedir( Q );
920 
}
921 
 
922 
#-------------------------------------------------------------------------------
923 
# Function        : checkTime
924 
#
925 
# Description     : Days since modification of a path
926 
#
927 
# Inputs          : Path elements
928 
#
929 
# Returns         : Days since midification
930 
#
931 
 
932 
sub checkTime
933 
{
934 
    my ($path) = @_;
935 
    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
936 
        $atime,$mtime,$ctime,$blksize,$blocks) = stat($path);
937 
 
4127 dpurdie 938 
    unless(defined $mtime)
939 
    {
940 
        Warning("Bad stat for $path");
941 
        $mtime = 0;
942 
    }
943 
 
3410 dpurdie 944 
    return int( ($now - $mtime) / (60 * 60 * 24));
945 
}
946 
 
947 
#-------------------------------------------------------------------------------
948 
# Function        : processDpkgArchive
949 
#
950 
# Description     : Scan dpkg_archive
951 
#
952 
# Inputs          :
953 
#
954 
# Returns         :
955 
#
956 
sub processDpkgArchive
957 
{
958 
    Verbose ("Scanning dpkg_archive");
959 
    opendir( PKGS, $config{dpkg_archive} ) || Error ("Cannot open dpkg_archive");
960 
    while ( my $pkgName = readdir(PKGS) )
961 
    {
962 
        next if ( $pkgName eq '.' );
963 
        next if ( $pkgName eq '..' );
964 
        next if ( $pkgName eq 'lost+found' );
965 
        next if ( exists $retainPkgs{$pkgName} );
966 
 
967 
        my $pkgDir = join('/', $config{dpkg_archive}, $pkgName );
968 
        if ( -d $pkgDir )
969 
        {
970 
            if (opendir (PV, $pkgDir ) )
971 
            {
972 
 
973 
                while ( my $pkgVersion = readdir(PV) )
974 
                {
975 
                    next if ( $pkgVersion eq '.' );
976 
                    next if ( $pkgVersion eq '..' );
4646 dpurdie 977 
                    next if ( $pkgVersion eq 'latest' );            # Keep latest (often symlink for build system)
978 
 
3410 dpurdie 979 
                    my $pkgPath = join('/', $config{dpkg_archive}, $pkgName,$pkgVersion );
980 
                    my $mtime = checkTime($pkgPath);
981 
 
982 
                    my $pvid;
983 
                    if ( exists ($pkgPvid{$pkgName}) && exists($pkgPvid{$pkgName}{$pkgVersion} ) )
984 
                    {
985 
                        $pvid = $pkgPvid{$pkgName}{$pkgVersion}{pvid};
986 
                        $Packages{$pvid}{dpkg_archive} = 1;
987 
                        $pkgPvid{$pkgName}{$pkgVersion}{mtime} = $mtime;
988 
                    }
989 
                    else
990 
                    {
991 
                        #
992 
                        #   Package is in dpkg-archive, but not in Release
993 
                        #   Manager. Allow for a short while
994 
                        #
5534 dpurdie 995 
                        $statistics{TotalPackages}++;
996 
                        $statistics{'NotInReleaseManager'}++;
3410 dpurdie 997 
                        if ( $mtime > $config{retainNoRm} )
998 
                        {
999 
                            #Log("Package not in RM: $pkgName, $pkgVersion, Age: $mtime");
1000 
                            quarantineItem( 'X', $mtime, $pkgPath );
5534 dpurdie 1001 
                            $statistics{'Quarantine'}++;
3410 dpurdie 1002 
                        }
5534 dpurdie 1003 
 
1004 
                        if ($opt_explain)
1005 
                        {
1006 
                            Information("Reason:-, $pkgName, $pkgVersion, Reason:NotInReleaseManager");
1007 
                        }
3410 dpurdie 1008 
                    }
1009 
 
1010 
#Message("$pkgName, $pkgVersion, $pkgPvid{$pkgName}{$pkgVersion}{mtime}");
1011 
                }
1012 
                close(PV);
1013 
            }
1014 
        }
1015 
        elsif ( -f $pkgDir )
1016 
        {
1017 
            Warning("Unexpected file in dpkg_archive: $pkgName");
1018 
            Log("Unexpected file in dpkg_archive: $pkgName");
1019 
            quarantineItem( 'F', -1, $pkgDir );
5534 dpurdie 1020 
            $statistics{'fileNotInReleaseManager'}++;
1021 
            $statistics{'Quarantine'}++;
1022 
            $statistics{'NotInReleaseManager'}++;
1023 
 
1024 
            if ($opt_explain)
1025 
            {
1026 
                Information("Reason:-, $pkgDir, -, Reason:fileNotInReleaseManager");
1027 
            }
3410 dpurdie 1028 
        }
1029 
        else
1030 
        {
1031 
            Warning("Unexpected entry in dpkg_archive: $pkgName");
1032 
        }
1033 
    }
1034 
    close(PKGS);
1035 
 
1036 
 
1037 
    #
1038 
    #
5125 dpurdie 1039 
    #   Scan all packages found in dpkg_archive and see if we should keep it
1040 
    #   Quarantine those we cannot find a reason to keep
3410 dpurdie 1041 
    #
1042 
    foreach my $pkgName ( sort keys %pkgPvid )
1043 
    {
1044 
        foreach my $pkgVersion ( sort keys %{$pkgPvid{$pkgName}} )
1045 
        {
1046 
            my $mtime = $pkgPvid{$pkgName}{$pkgVersion}{mtime} || 0;
1047 
            my $pvid = $pkgPvid{$pkgName}{$pkgVersion}{pvid};
5253 dpurdie 1048 
            my $keepReason = '';
1049 
            my $entry = $Packages{$pvid};
3410 dpurdie 1050 
 
1051 
            {
5253 dpurdie 1052 
                # Examine entry. Determine a reason to keep the package
5534 dpurdie 1053 
                #   Some reasons to keep a package are no longer needed now that versions are pumped into S3
3410 dpurdie 1054 
 
5253 dpurdie 1055 
                unless ($entry) { $keepReason ='NoPackageEntry'; last;}
1056 
                unless ($entry->{dpkg_archive}) { $keepReason ='NotInArchive'; last;}
1057 
                unless ($pvid) { $keepReason = 'NoPVid'; last;}
5534 dpurdie 1058 
                if (exists $entry->{tlp}) { $keepReason = 'TopLevelPackage'; last;}
1059 
                if (exists $entry->{slp}) { $keepReason = 'SecondLevelPackage'; last;}
1060 
                if (exists $entry->{sdk}) { $keepReason ='inSdk'; last;}
1061 
                if (exists $entry->{dm}) { $keepReason = 'inDeploymentManager'; last;}
1062 
                if ($entry->{isPatch}) { $keepReason = 'isPatch'; last;}
1063 
                if ($mtime <= $config{retain}) { $keepReason ='RetainTime:' . ($config{retain} - $mtime); last;}
1064 
                #unless ($entry->{buildStandard}) { $keepReason ='NoBuildStandard:' . $mtime; last;}
5253 dpurdie 1065 
                if ($entry->{locked} ne 'Y') { $keepReason ='NotLocked:' . $entry->{locked}; last;}
1066 
                #if ($entry->{buildType} eq 'M') { $keepReason ='ManualBuild:' . $entry->{buildType}; last;}
1067 
 
1068 
                $pkgPvid{$pkgName}{$pkgVersion}{keepReason} = $keepReason;
1069 
            }
1070 
 
1071 
            unless ( $keepReason )
1072 
            {
3410 dpurdie 1073 
                Verbose2("Quarantine:$pvid, $pkgName, $pkgVersion, Age:$mtime, Lock:$entry->{locked}, Patch:$entry->{isPatch}, BS:$entry->{buildStandard}, BT:$entry->{buildType}");
1074 
                quarantineItem( 'Q', $mtime, join('/', $config{dpkg_archive}, $pkgName, $pkgVersion ) );
5534 dpurdie 1075 
                $keepReason = 'Quarantine';
3410 dpurdie 1076 
            }
5253 dpurdie 1077 
 
1078 
            if ($opt_explain)
1079 
            {
1080 
                Information("Reason:$pvid, $pkgName, $pkgVersion, Reason:$keepReason");
1081 
            }
5534 dpurdie 1082 
 
1083 
            #
1084 
            #   Maintain Stats
1085 
            #       Only use the Base Reason - remove details after the ':' character
1086 
            #
1087 
            my $sReason = $keepReason;
1088 
            $sReason =~ s~:.*$~~;
1089 
            $statistics{$sReason}++;
1090 
            $statistics{TotalPackages}++;
3410 dpurdie 1091 
        }
1092 
    }
1093 
 
1094 
    #
1095 
    # Perform the quarantine
1096 
    #
1097 
    doQuarantine();
1098 
    ErrorDoExit();
1099 
}
1100 
 
1101 
#-------------------------------------------------------------------------------
1102 
# Function        : reportMissingPkgs
1103 
#
1104 
# Description     : Report packages that 'should' be in dpkg_archive because
1105 
#                   they are essential, but are not
1106 
#
1107 
# Inputs          :
1108 
#
1109 
# Returns         :
1110 
#
1111 
sub reportMissingPkgs
1112 
{
1113 
    return;
1114 
 
1115 
    #
1116 
    #   Not very useful as there is too much information
1117 
    #   It would appear that the quarantine process may have also
1118 
    #   been deleting packages from 'closed' as well as 'archived'
1119 
    #   releases at some stage.
1120 
    #
1121 
    #   Report packages used in not-archived or not-closed releases
1122 
    #
1123 
    my @missing;
1124 
    foreach my $pvid (keys %Packages )
1125 
    {
1126 
        my $entry = $Packages{$pvid};
1127 
        next unless ( exists $entry->{tlp} );
1128 
#        next unless ( exists $entry->{slp} );
1129 
        next if ( $entry->{dpkg_archive} );
1130 
        next unless ( exists $entry->{name} );
1131 
 
1132 
        #
1133 
        #   Missing package
1134 
        #   Determine if its in use by an active release
1135 
        #
1136 
 
1137 
        my @releases = usedBy($pvid);
1138 
        foreach my $release (@releases )
1139 
        {
1140 
            next if ( $Releases{$release}{official} eq 'Y' );
1141 
            next if ( $Releases{$release}{official} eq 'A' );
1142 
            push @missing, $entry->{name} . ' ' . $entry->{version} . " ($pvid)";
1143 
            last;
1144 
        }
1145 
    }
1146 
 
1147 
    Warning ("Packages required by active releases that are not in dpkg_archive", sort @missing);
1148 
}
1149 
 
1150 
#-------------------------------------------------------------------------------
1151 
# Function        : usedBy
1152 
#
1153 
# Description     : Given a pvid, determine which release(s) need it
1154 
#
1155 
# Inputs          : $pvid
1156 
#
1157 
# Returns         : Nothing
1158 
#
1159 
sub usedBy
1160 
{
1161 
    my ($pvid) = @_;
1162 
    my %seen;
1163 
 
1164 
    Error ("PVID is not an essential package") unless ( exists $Packages{$pvid} );
1165 
 
1166 
    my @releases = @{$Packages{$pvid}{'release'}} if exists($Packages{$pvid}{'release'});
1167 
    my @users = @{$Packages{$pvid}{'usedBy'}} if exists($Packages{$pvid}{'usedBy'});
1168 
 
1169 
    while ( @users )
1170 
    {
1171 
        my $pv = pop @users;
1172 
 
1173 
        next if ( exists $seen{$pv} );
1174 
        $seen{$pv} = 1;
1175 
 
1176 
        push @releases, @{$Packages{$pv}{'release'}} if (exists $Packages{$pv}{'release'});
1177 
        push @users, @{$Packages{$pv}{'usedBy'}} if (exists($Packages{$pv}{'usedBy'}));
1178 
    }
1179 
    return @releases;
1180 
}
1181 
 
1182 
#-------------------------------------------------------------------------------
5534 dpurdie 1183 
# Function        : reportStats
1184 
#
1185 
# Description     : Report statistics
1186 
#                   Write statistics to a file
1187 
#                       Write to a tmp file, then rename.
1188 
#                       Attempt to make the operation atomic - so that the file consumer
1189 
#                       doesn't get a badly formed file.
1190 
#
1191 
#
1192 
# Inputs          :
1193 
#
1194 
# Returns         :
1195 
#
1196 
sub reportStats
1197 
{
1198 
    #
1199 
    #   Time stamp the stats
1200 
    #
1201 
    $statistics{'timeStamp'} = time();
1202 
 
1203 
    #
1204 
    #   Save stats to a known file for Nagios to use
1205 
    #
1206 
    my $statsfiletmp = join('/', $config{logBase}, 'quarantine.stats.tmp' );
1207 
    my $statsfile    = join('/', $config{logBase}, 'quarantine.stats');
1208 
 
1209 
    my $fh;
1210 
    unless (open ($fh, '>', $statsfiletmp))
1211 
    {
1212 
        $fh = undef;
1213 
        Warning("Cannot create temp stats file: $!");
1214 
    }
1215 
    else
1216 
    {
1217 
        foreach my $key ( sort { lc($a) cmp lc($b) } keys %statistics)
1218 
        {
1219 
            print $fh $key . ':' . $statistics{$key} . "\n";
1220 
            Log('Statistics: '. $key . ':' . $statistics{$key});
1221 
        }
1222 
        close $fh;
1223 
 
1224 
        # Rename temp to real file
1225 
        rename  $statsfiletmp,  $statsfile;
1226 
    }
1227 
}
1228 
 
1229 
 
1230 
#-------------------------------------------------------------------------------
3410 dpurdie 1231 
# Function        : quarantineItem
1232 
#
1233 
# Description     : Add item to the list of stuff to be quarantined
1234 
#
1235 
# Inputs          : $reason         - Reason
1236 
#                   $age            - Age
1237 
#                   $path           - Path
1238 
#
1239 
# Returns         :
1240 
#
1241 
sub quarantineItem
1242 
{
1243 
    my ($reason, $age, $path ) = @_;
1244 
    my %data;
1245 
    $data{reason} = $reason;
1246 
    $data{age} = $age;
1247 
    $data{path} = $path;
1248 
 
1249 
    push @quarantineItems, \%data;
1250 
}
1251 
 
1252 
#-------------------------------------------------------------------------------
1253 
# Function        : doQuarantine
1254 
#
1255 
# Description     : Quarantine files and folders that have been queued up
1256 
#
1257 
# Inputs          : None
1258 
#
1259 
# Returns         :
1260 
#
1261 
sub doQuarantine
1262 
{
1263 
    my $testMsg = $opt_test ? 'Test,' : '';
4093 dpurdie 1264 
 
1265 
    # Process entries - oldest first
1266 
    #
4127 dpurdie 1267 
    my $countRemain = ( scalar @quarantineItems );
4093 dpurdie 1268 
    foreach my $entry (sort {$b->{age} <=> $a->{age} } @quarantineItems)
3410 dpurdie 1269 
    {
1270 
        my $rv;
1271 
        my $emsg = ' - with error';
5272 dpurdie 1272 
        my $s3error = 0;
3410 dpurdie 1273 
 
1274 
        my $path = $entry->{path};
1275 
        my $tpath = $path;
1276 
           $tpath =~ s~^$config{dpkg_archive}~~;
1277 
           $tpath = $quarantineInstance.$tpath;
1278 
        my $tdir = dirname ( $tpath );
1279 
 
1280 
        unless ( $opt_test )
1281 
        {
4542 dpurdie 1282 
            #
1283 
            #   Transfer to Amazon S3 storage first
1284 
            #   The transfer is done via an external program (script)
1285 
            #   The transfer will tar-zip the packageVersion
1286 
            #
1287 
            {
1288 
                my $s3msg = "";
1289 
                my $pv = $path;
1290 
 
1291 
                #
1292 
                #   Export the Secrets in EnvVars
1293 
                #   Use program defaults so that we don't need to specify them
1294 
                #   on the command line - for all to see
1295 
                #
1296 
                $ENV{AWSKEY} = $config{S3Key};
1297 
                $ENV{AWSSECRET} = $config{S3Secret};
1298 
 
1299 
                $rv = system ( "$progBase/savePkgToS3.sh", "--bucket=$config{S3Bucket}" ,"--path=$path" );
1300 
                if ( $rv )
1301 
                {
1302 
                    ReportError ("Move $path to S3");
1303 
                    $s3msg = ' - with S3 error';
5272 dpurdie 1304 
                    $s3error = 1;
1305 
                    $emsg = ' - S3 Error prevented quarantine';
5534 dpurdie 1306 
                    $statistics{'S3TransferError'}++;
1307 
 
4542 dpurdie 1308 
                }
1309 
                Log (sprintf("S3Quarantined:%s%s,%4.4s,%s%s", $testMsg, $entry->{reason}, $entry->{age}, $path, $s3msg));
1310 
            }
1311 
 
5272 dpurdie 1312 
            unless ($s3error)
3410 dpurdie 1313 
            {
5272 dpurdie 1314 
                #
1315 
                #   Transfer then delete to local directory
1316 
                #
1317 
                unless (-d $tdir)
3410 dpurdie 1318 
                {
5272 dpurdie 1319 
                    eval { mkpath($tdir) };
1320 
                    ReportError ("Did not create quarantine target: $tdir")
1321 
                        unless (-d $tdir);
3410 dpurdie 1322 
                }
5272 dpurdie 1323 
 
1324 
                if (-d $tdir)
3410 dpurdie 1325 
                {
5272 dpurdie 1326 
                    $rv = system ('mv', '-n', $path, $tdir);
1327 
                    if ( $rv )
1328 
                    {
1329 
                        ReportError ("Move $path to $tdir");
5534 dpurdie 1330 
                        $statistics{'QuarantineError'}++;
1331 
 
5272 dpurdie 1332 
                        #
1333 
                        # Clean up what may have been moved
1334 
                        # NOTE: deleted so that we don't loose stuff if it gets ugly
1335 
        #                rmtree( $tpath);
1336 
        #                rmdir ($tdir);
1337 
                    }
1338 
                    else
1339 
                    {
1340 
                        $emsg = '';
1341 
                    }
3410 dpurdie 1342 
                }
1343 
            }
1344 
        }
1345 
        else
1346 
        {
1347 
            Verbose2("Test: 'mv', '$path', '$tdir'");
1348 
            $emsg = '';
1349 
        }
1350 
 
1351 
        # Log operation with frills
1352 
        Log (sprintf("Quarantined:%s%s,%4.4s,%s%s", $testMsg, $entry->{reason}, $entry->{age}, $path, $emsg));
4093 dpurdie 1353 
 
1354 
        # Limit packages quarantined
4127 dpurdie 1355 
        $countRemain--;
4093 dpurdie 1356 
        if ($opt_pcount > 0)
1357 
        {
1358 
            $opt_pcount--;
1359 
            if ($opt_pcount == 0)
1360 
            {
4127 dpurdie 1361 
                Log ("Quarantine package count exceeded. Quarantine terminated. $countRemain packages remaining");
4093 dpurdie 1362 
                last;
1363 
            }
1364 
        }
3410 dpurdie 1365 
    }
1366 
}
1367 
 
1368 
#-------------------------------------------------------------------------------
1369 
# Function        : Log
1370 
#
1371 
# Description     : Log a string
1372 
#
1373 
# Inputs          : Line to log
1374 
#
1375 
# Returns         :
1376 
#
1377 
sub Log
1378 
{
1379 
    my ($line) = @_;
4093 dpurdie 1380 
    Verbose("Log: " . $line);
3410 dpurdie 1381 
 
1382 
    if (open ( LF, '+>>', $logPath ) )
1383 
    {
1384 
        print LF $line . "\n";
1385 
        close LF;
1386 
    }
1387 
}
1388 
 
1389 
#-------------------------------------------------------------------------------
1390 
# Function        : readInputData
1391 
#
1392 
# Description     : Write out data in a form to allow post processing
1393 
#
1394 
# Inputs          :
1395 
#
1396 
# Returns         :
1397 
#
1398 
sub readInputData
1399 
{
1400 
    unless ( keys(%Packages) > 0 )
1401 
    {
1402 
        my $fname = "quarantine.raw.txt";
1403 
        Verbose ("Reading: $fname");
1404 
        Error "Cannot locate $fname" unless ( -f $fname );
1405 
        require $fname;
1406 
 
1407 
        Error "Data in $fname is not valid\n"
1408 
            unless ( keys(%Packages) > 0 );
1409 
    }
1410 
 
1411 
    #
1412 
    # Create a lookup from package name/version to pvid
1413 
    #
1414 
    Verbose ("Create PackageVersion to PVID hash");
1415 
    foreach my $pvid ( keys %Packages )
1416 
    {
1417 
        my $name = $Packages{$pvid}{name};
1418 
        my $version = $Packages{$pvid}{version};
1419 
        if ( $name && $version )
1420 
        {
1421 
            $pkgPvid{$name}{$version}{pvid} = $pvid;
1422 
        }
1423 
    }
1424 
}
1425 
 
1426 
#-------------------------------------------------------------------------------
1427 
#   Documentation
1428 
#
1429 
 
1430 
=pod
1431 
 
1432 
=for htmltoc    SYSUTIL::
1433 
 
1434 
=head1 NAME
1435 
 
1436 
jats_quarantine - Determine packages to be quarantined
1437 
 
1438 
=head1 SYNOPSIS
1439 
 
1440 
  jats jats_quarantine [options]
1441 
 
1442 
 Options:
1443 
    -help              - brief help message
1444 
    -help -help        - Detailed help message
1445 
    -man               - Full documentation
1446 
    -verbose[=n]       - Control output
5534 dpurdie 1447 
    -explain           - Display each package version disposition
3410 dpurdie 1448 
    -phase=nn          - Perform named phases
4092 dpurdie 1449 
    -purge             - Just purge the old quarantined files
3410 dpurdie 1450 
    -test              - Do not delete files
1451 
    -limit=n           - Limit packages processed. Test only
4093 dpurdie 1452 
    -pcount=n          - Limit package count
3410 dpurdie 1453 
 
1454 
=head1 OPTIONS
1455 
 
1456 
=over 8
1457 
 
1458 
=item B<-help>
1459 
 
1460 
Print a brief help message and exits.
1461 
 
1462 
=item B<-help -help>
1463 
 
1464 
Print a detailed help message with an explanation for each option.
1465 
 
1466 
=item B<-man>
1467 
 
1468 
Prints the manual page and exits.
1469 
 
1470 
=item B<-verbose[=n]>
1471 
 
1472 
This option control the programs output. Normally this program will not generate
1473 
any output. It will only generate output on error conditions. This is intentional
1474 
as the program will be run as a cron-job and output errors will be mailed out.
1475 
 
1476 
A verbose level of 1. will display progress information
1477 
 
1478 
A verbose level of 3. will display detailed tracing of all operations
1479 
 
5534 dpurdie 1480 
=item B<-explain[=n]>
1481 
 
1482 
This option will output a line per package-version explaining the reason that
1483 
packages are retained.
1484 
 
1485 
Only a level of 1 is supported.
1486 
 
3410 dpurdie 1487 
=item B<-phase=list>
1488 
 
1489 
This option will limit the work done by the program. There are two phases
1490 
called: 1 and 2.
1491 
 
1492 
Phase-1 will examine Release Manager collect package-version information.
1493 
Phase-2 will examine dpkg_archive and collect package-version information. It
1494 
will then initiate the quarantine operation.
1495 
 
1496 
The default operation is to perform phase-1 and phase-2.
1497 
 
1498 
If only phase-1 is specified then the RM data is saved, to be used by a
1499 
later phase.
1500 
 
1501 
If only phase-2 is specified then saved RM data is restored.
1502 
 
1503 
This option can simplify testing.
1504 
 
4092 dpurdie 1505 
=item B<-purge>
1506 
 
1507 
This option will only purge the old quarantine directories. It will not quarantine new
1508 
package versions.
1509 
 
3410 dpurdie 1510 
=item B<-test>
1511 
 
1512 
Do not delete or move files and directories. Report what would have been done.
1513 
 
1514 
=item B<-limit=n>
1515 
 
1516 
Limit the number of packages processed by the tool. This is only used to
1517 
simplify testing of the program
1518 
 
1519 
=back
1520 
 
1521 
=head1 DESCRIPTION
1522 
 
1523 
This program is a tool used in the maintainance of dpkg_archive.
1524 
It will:
1525 
 
1526 
=over 8
1527 
 
1528 
=item *
1529 
 
1530 
Determine package-versions in use by Release Manager.
1531 
 
1532 
=item *
1533 
 
5125 dpurdie 1534 
Determine package-versions in recent Deployment Manager SBOMS.
1535 
 
1536 
=item *
1537 
 
3410 dpurdie 1538 
Determine package-versions that can be rebuilt
1539 
 
1540 
=item *
1541 
 
1542 
Recursively find all the dependent packages of all packages. New package
1543 
versions are called 'indirect' dependencies. They are buried. This process can
1544 
take several minutes.
1545 
 
1546 
=back
1547 
 
1548 
The data collected is dumped into a text file for later processing.
1549 
 
1550 
=cut
1551