Subversion Repositories DevTools

Rev

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