Subversion Repositories DevTools

Rev

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

Rev Author Line No. Line
1038 dpurdie 1 
#! /usr/bin/perl
2 
########################################################################
3 
# Copyright (C) 2011 Vix-ERG Limited, All rights reserved
4 
#
5 
# Module name   : blatDaemon.pl
6 
# Module type   :
7 
# Compiler(s)   : Perl
8 
# Environment(s):
9 
#
10 
# Description   :
11 
#
12 
# Usage         :   ARGV[0] - Path to config file for this instance
13 
#
14 
#......................................................................#
15 
 
16 
require 5.008_002;
17 
use strict;
18 
use warnings;
19 
use Getopt::Long;
20 
use File::Basename;
1040 dpurdie 21 
use Data::Dumper;
22 
use File::Spec::Functions;
1038 dpurdie 23 
use POSIX ":sys_wait_h";
24 
use File::Temp qw/tempfile/;
25 
 
26 
use FindBin;                                    # Determine the current directory
27 
use lib "$FindBin::Bin/lib";                    # Allow local libraries
28 
 
29 
use Utils;
30 
use StdLogger;                                  # Log to sdtout
31 
use Logger;                                     # Log to file
32 
 
33 
#
34 
#   Database interface
35 
#   Pinched from jats and modified so that this software is not dependent on JATS
36 
#
37 
use IO::Handle;
38 
use JatsRmApi;
39 
use DBI;
40 
 
41 
#
42 
#   Globals
43 
#
44 
my $logger = StdLogger->new();                  # Stdout logger. Only during config
45 
my $name = basename( $ARGV[0]);
46 
   $name =~ s~.conf$~~;
47 
my $now = 0;
5398 dpurdie 48 
my $startTime = 0;
3515 dpurdie 49 
my $tar = 'tar';
50 
my $gzip = 'gzip';
1038 dpurdie 51 
my $tagDirTime = 0;
52 
my $lastDirScan = 0;
53 
my $lastReleaseScan = 0;
1040 dpurdie 54 
my $releaseScanMode = 0;
55 
my $lastTagListScan = 0;
1038 dpurdie 56 
my $transferred;
57 
my $mtimeConfig = 0;
58 
my $conf;
59 
my $extraPkgs;
1040 dpurdie 60 
my $excludePkgs;
61 
my %releaseData;
3515 dpurdie 62 
my $comError = 0;
5398 dpurdie 63 
my $yday = -1;
1038 dpurdie 64 
 
65 
#
5398 dpurdie 66 
#   Contain statisics maintained while operating
67 
#       Can be dumped with a kill -USR2
68 
#       List here for documentation
69 
#
70 
 
71 
my %statistics = (
72 
    SeqNum => 0,                        # Bumped when $statistics are dumped
73 
    timeStamp => 0,                     # DateTime when statistics are dumped
74 
    upTime => 0,                        # Seconds since program start
75 
    Cycle => 0,                         # Major process loop counter
76 
    phase => 'Init',                    # Current phase of operation
77 
    state => 'OK',                      # Nagios state
78 
                                        #
79 
                                        # The following are reset each day
80 
    dayStart => 0,                      # DateTime when daily data was reset
81 
    txCount => 0,                       # Packages Transferred
82 
    delCount => 0,                      # Packages marked for deletion
83 
    staleTags => 0,                     # Stale Tags
84 
    linkErrors => 0,                    # Transfer errors
85 
                                        #
86 
                                        # Per Cycle Data - Calculated each processing Cycle
5399 dpurdie 87 
    remoteTotal => 0,                   # Packages on target machine
88 
    total    => 0,                      # Packages to be synced
5398 dpurdie 89 
    delete   => 0,                      # Packages to delete
90 
    excluded => 0,                      # Packages excluded
91 
    filtered => 0,                      # Packages filtered out
92 
    missing  => 0,                      # Packages missing
93 
    transfer => 0,                      # Packages to transfer
94 
    writable => 0,                      # Packages still writable - thus not transferred
95 
    tagCount => 0,                      # Packages tagged to be transferred
5404 dpurdie 96 
                                        #
97 
                                        # Expected from the Target
98 
#   Target.Hostname => '',              # Target Hostname
99 
#   Target.avail    => 0,               # Information from 'df' 1Kblocks
100 
#   Target.pcent    => 0,
101 
#   Target.size     => 0,
102 
#   Target.used     => 0,
103 
#   Target.iavail   => 0,               # Inode information from 'df'
104 
#   Target.ipcent   => 0,
105 
#   Target.isize    => 0,
106 
#   Target.iused    => 0,
107 
#   Target.Total    => 0,               # Number of Package Versions in the archive
108 
#   Target.Damaged  => 0,               # Number that are damaged
109 
#   Target.Delete   => 0,               # Number marked for future deletion
110 
#   Target.Missing  => 0,               # Number missing
5398 dpurdie 111 
);
112 
 
1038 dpurdie 113 
#
5398 dpurdie 114 
#   Describe configuration parameters
115 
#
1038 dpurdie 116 
my %cdata = (
117 
    '.ignore'         => {'pkg\.(.+)' => 'pkgs' },
1048 dpurdie 118 
    'piddir'          => {'mandatory' => 1      , 'fmt' => 'dir'},
119 
    'sleep'           => {'default'   => 5      , 'fmt' => 'period'},
120 
    'dpkg_archive'    => {'mandatory' => 1      , 'fmt' => 'dir'},
121 
    'logfile'         => {'mandatory' => 1      , 'fmt' => 'vfile'},
122 
    'logfile.size'    => {'default'   => '1M'   , 'fmt' => 'size'},
123 
    'logfile.count'   => {'default'   => 9      , 'fmt' => 'int'},
124 
    'verbose'         => {'default'   => 0      , 'fmt' => 'int'},
125 
    'user'            => {'mandatory' => 1      , 'fmt' => 'text'},
126 
    'hostname'        => {'mandatory' => 1      , 'fmt' => 'text'},
3847 dpurdie 127 
    'sshport'         => {'default'   => 0      , 'fmt' => 'int'},
1048 dpurdie 128 
    'identity'        => {'mandatory' => 1      , 'fmt' => 'file'},
129 
    'bindir'          => {'mandatory' => 1      , 'fmt' => 'text'},
130 
    'tagdir'          => {'mandatory' => 1      , 'fmt' => 'dir'},
131 
    'forcedirscan'    => {'default'   => 100    , 'fmt' => 'period'},
132 
    'tagage'          => {'default'   => '10m'  , 'fmt' => 'period'},
133 
    'tagListUpdate'   => {'default'   => '1h'   , 'fmt' => 'period'},
134 
    'synctime'        => {'default'   => '2h'   , 'fmt' => 'period'},
135 
    'syncretry'       => {'default'   => '5m'   , 'fmt' => 'period'},
136 
    'allProjects'     => {'default'   => 0      , 'fmt' => 'bool'},
4456 dpurdie 137 
    'allArchive'      => {'default'   => 0      , 'fmt' => 'bool'},
1048 dpurdie 138 
    'project'         => {'mandatory' => 0      , 'fmt' => 'int_list'},
139 
    'release'         => {'mandatory' => 0      , 'fmt' => 'int_list'},
140 
    'writewindow'     => {'default'   => '3h'   , 'fmt' => 'period'},
141 
    'maxpackages'     => {'default'   => 5      , 'fmt' => 'int'},
142 
    'deletePackages'  => {'default'   => 0      , 'fmt' => 'bool'},
143 
    'deleteImmediate' => {'default'   => 0      , 'fmt' => 'bool'},
144 
    'deleteAge'       => {'default'   => 0      , 'fmt' => 'period'},
145 
    'packageFilter'   => {'default'   => undef  , 'fmt' => 'text'},
146 
    'active'          => {'default'   => 1      , 'fmt' => 'bool'},
1038 dpurdie 147 
);
148 
 
149 
 
150 
#
151 
#   Read in the configuration
152 
#       Set up a logger
153 
#       Write a pidfile - thats not used
154 
readConfig();
155 
Utils::writepid($conf);
156 
$logger->logmsg("Starting...");
5404 dpurdie 157 
readStatistics();
1038 dpurdie 158 
sighandlers($conf);
5398 dpurdie 159 
$startTime = time();
1038 dpurdie 160 
 
161 
#
162 
#   Main processing loop
163 
#   Will exit when terminated by parent
164 
#
3847 dpurdie 165 
while (1 )
1038 dpurdie 166 
{
167 
    $logger->verbose3("Processing");
5398 dpurdie 168 
    $statistics{Cycle}++;
1038 dpurdie 169 
    $now = time();
1040 dpurdie 170 
 
1038 dpurdie 171 
    $transferred = {};
5398 dpurdie 172 
    $statistics{phase} = 'ReadConfig';
1038 dpurdie 173 
    readConfig();
1048 dpurdie 174 
    if ( $conf->{'active'} )
175 
    {
5398 dpurdie 176 
        $statistics{phase} = 'ProcessReleaseList';
1048 dpurdie 177 
        processReleaseList();
5398 dpurdie 178 
        $statistics{phase} = 'processTags';
1048 dpurdie 179 
        processTags();
5398 dpurdie 180 
        $statistics{phase} = 'maintainTagList';
1048 dpurdie 181 
        maintainTagList();
182 
    }
1040 dpurdie 183 
    %releaseData = ();
184 
 
5398 dpurdie 185 
    $statistics{phase} = 'Sleep';
1038 dpurdie 186 
    sleep( $conf->{'sleep'} );
1050 dpurdie 187 
 
188 
    #
189 
    #   Reap any and all dead children
190 
    #
5398 dpurdie 191 
    $statistics{phase} = 'Reaping';
1050 dpurdie 192 
    my $kid;
193 
    do {
194 
        $kid = waitpid(-1, WNOHANG);
195 
    } while ( $kid > 0 );
3847 dpurdie 196 
 
197 
    #   If my PID file ceases to be, then exit the daemon
198 
    #   Used to force daemon to restart
199 
    #
200 
    unless ( -f $conf->{'pidfile'} )
201 
    {
202 
        $logger->logmsg("Terminate. Pid file removed");
203 
        last;
204 
    }
1038 dpurdie 205 
}
5398 dpurdie 206 
$statistics{phase} = 'Terminated';
1038 dpurdie 207 
$logger->logmsg("Child End");
208 
exit 0;
209 
 
210 
#-------------------------------------------------------------------------------
211 
# Function        : readConfig
212 
#
213 
# Description     : Re read the config file if it modification time has changed
214 
#
215 
# Inputs          : Nothing
216 
#
1289 dpurdie 217 
# Returns         : 0       - Config not read
218 
#                   1       - Config read
219 
#                             Config file has changed
1038 dpurdie 220 
#
221 
sub readConfig
222 
{
223 
    my ($mtime) = Utils::mtime($ARGV[0]);
1289 dpurdie 224 
    my $rv = 0;
225 
 
1038 dpurdie 226 
    if ( $mtimeConfig != $mtime )
227 
    {
228 
        $logger->logmsg("Reading config file: $ARGV[0]");
229 
        $mtimeConfig = $mtime;
230 
        my $errors;
231 
        ($conf, $errors) = Utils::readconf ( $ARGV[0], \%cdata );
232 
        if ( scalar @{$errors} > 0 )
233 
        {
234 
            warn "$_\n" foreach (@{$errors});
235 
            die ("Config contained errors\n");
236 
        }
237 
 
238 
        #
239 
        #   Reset some information
240 
        #   Create a new logger
241 
        #
242 
        $logger = Logger->new($conf);
243 
        $conf->{logger} = $logger;
244 
        $conf->{'pidfile'} = $conf->{'piddir'} . '/' . $name . '.pid';
245 
        $logger->verbose("Log Levl: $conf->{verbose}");
246 
 
247 
        #
5398 dpurdie 248 
        #   Setup statistics filename
249 
        $conf->{'statsfile'} = $conf->{'piddir'} . '/' . $name . '.stats';
250 
        $conf->{'statsfiletmp'} = $conf->{'piddir'} . '/' . $name . '.stats.tmp';
251 
 
252 
        #
1038 dpurdie 253 
        #   Extract extra package config
254 
        #
255 
        $extraPkgs = {};
1040 dpurdie 256 
        $excludePkgs = {};
1038 dpurdie 257 
        while (my($key, $data) = each ( %{$conf->{pkgs}} ))
258 
        {
3846 dpurdie 259 
            if ( $data eq 'EXCLUDE' ) {
1040 dpurdie 260 
                $excludePkgs->{$key} = 1;
261 
                $logger->verbose("Exclude Pkg: $key");
3846 dpurdie 262 
 
263 
            } elsif ( $data eq 'ALL' ) {
264 
                foreach my $pver (getPackageVersions($key))
265 
                {
266 
                    $extraPkgs->{$key}{$pver} = 1;
267 
                    $logger->verbose("Extra Pkg: $key -> $pver");
268 
                }
269 
            } else {
1040 dpurdie 270 
                $extraPkgs->{$key}{$data} = 1;
271 
                $logger->verbose("Extra Pkg: $key -> $data");
272 
            }
1038 dpurdie 273 
        }
1046 dpurdie 274 
 
1048 dpurdie 275 
        $logger->verbose("Filter Packages: " . $conf->{'packageFilter'})
276 
            if ( defined $conf->{'packageFilter'} );
277 
 
3847 dpurdie 278 
        $logger->warn("Non standard ssh port: " . $conf->{'sshport'})
279 
            if ( $conf->{'sshport'} );
280 
 
1048 dpurdie 281 
        $logger->warn("Transfer session configured as not active")
282 
            unless ( $conf->{'active'} );
283 
 
284 
        $logger->warn("Transfer all projects packages")
1050 dpurdie 285 
            if ( $conf->{'allProjects'} );
4456 dpurdie 286 
        $logger->warn("Transfer entire package archive")
287 
            if ( $conf->{'allArchive'} );
1048 dpurdie 288 
 
4456 dpurdie 289 
 
1046 dpurdie 290 
        #
291 
        #   When config is read force some actions
292 
        #       - Force tagList to be created
1050 dpurdie 293 
        #       - Force release scan
1048 dpurdie 294 
        $lastTagListScan = 0;
1050 dpurdie 295 
        $lastReleaseScan = 0;
1289 dpurdie 296 
        $rv = 1;
1038 dpurdie 297 
    }
1289 dpurdie 298 
    return $rv;
1038 dpurdie 299 
}
300 
 
301 
 
302 
#-------------------------------------------------------------------------------
303 
# Function        : processReleaseList
304 
#
305 
# Description     : Process the release list
306 
#                       Determine if its time to process release list
307 
#                       Determine release list
308 
#                       Determine release content
309 
#                       Determine new items
310 
#
311 
# Inputs          : None
312 
#
313 
# Returns         : Nothing
314 
#
315 
sub processReleaseList
316 
{
317 
    #
1044 dpurdie 318 
    #   Is Release List Processing active
319 
    #   Can configure blat to disable release sync
320 
    #   This will then allow 'new' packages to be sent
321 
    #
322 
    if ( $conf->{maxpackages} == 0 || $conf->{'synctime'} <= 0)
323 
    {
324 
        $logger->verbose2("processReleaseList disabled");
325 
        return;
326 
    }
327 
 
328 
    #
1038 dpurdie 329 
    #   Time to perform the scan
330 
    #   Will do at startup and every time period there after
331 
    #
1040 dpurdie 332 
    my $wtime = $releaseScanMode ? $conf->{'syncretry'} : $conf->{'synctime'};
333 
    return unless ( $now > ($lastReleaseScan + $wtime ));
1038 dpurdie 334 
    $logger->verbose("processReleaseList");
335 
    $lastReleaseScan = $now;
1040 dpurdie 336 
    $releaseScanMode = 1;                                   # Assume error
1038 dpurdie 337 
 
338 
    #
339 
    #   Get list of packages from Remote site
340 
    #   Invoke a program on the remote site and parse the results
341 
    #
342 
    #   Returned data looks like:
1042 dpurdie 343 
    #   1141792602 GMT(Wed Mar  8 04:36:42 2006) [DL] ishieldmodules/11.5.0.cots
1038 dpurdie 344 
    #
345 
    #
346 
    my $remotePkgList;
5404 dpurdie 347 
    my $remotePackageVersionCount = 0;
348 
    my $remoteData;
1038 dpurdie 349 
    my $ph;
1040 dpurdie 350 
    my $tgt_cmd = "$conf->{'bindir'}/get_plist.pl";
3515 dpurdie 351 
    my $ssh_cmd = sshCmd($tgt_cmd);
1038 dpurdie 352 
 
353 
    $logger->verbose2("processReleaseList:ssh_cmd:$ssh_cmd");
354 
    open ($ph, "$ssh_cmd |");
355 
    while ( <$ph> )
356 
    {
357 
        chomp;
5404 dpurdie 358 
        if ($_ =~ m~^Metadata\s+~)
1038 dpurdie 359 
        {
5404 dpurdie 360 
            parsePkgMetaData($_, \%{$remoteData})
1038 dpurdie 361 
        }
362 
        else
363 
        {
5404 dpurdie 364 
            if ( parsePkgList($_, \%{$remotePkgList} ) )
365 
            {
366 
                $logger->verbose2("processReleaseList:Data: $_");
367 
                $remotePackageVersionCount++;
368 
            }
369 
            else
370 
            {
371 
                $logger->warn("processReleaseList:Bad Data: $_");
372 
            }
1038 dpurdie 373 
        }
374 
    }
375 
    close ($ph);
376 
    $logger->verbose("processReleaseList:End: $?");
3515 dpurdie 377 
    LogTxError ($?);
1038 dpurdie 378 
    if ( $? != 0 )
379 
    {
380 
        $logger->warn("Cannot retrieve package list: $?");
5398 dpurdie 381 
        $statistics{state} = 'No Remote Package List';
1038 dpurdie 382 
        return;
383 
    }
3515 dpurdie 384 
 
1042 dpurdie 385 
#Utils::DebugDumpData ("remotePkgList", $remotePkgList);
4456 dpurdie 386 
 
1038 dpurdie 387 
    #
388 
    #   Determine the set of packages in the releases to be transferred
4456 dpurdie 389 
    #
390 
    my $pkgList;
391 
    if ( $conf->{'allArchive'} )
1040 dpurdie 392 
    {
4456 dpurdie 393 
        #   Examine entire archive
394 
        #
395 
        $pkgList = getArchiveList();
1040 dpurdie 396 
    }
4456 dpurdie 397 
    else
398 
    {
399 
        #   Examine Releases
400 
        #
401 
        my @rlist = getReleaseList();
402 
        unless ( @rlist )
403 
        {
404 
            $logger->verbose2("No Releases to Process");
5398 dpurdie 405 
            $statistics{state} = 'No Releases found';
4456 dpurdie 406 
            return;
407 
        }
408 
        $pkgList = getPkgList(@rlist);
409 
    }
1038 dpurdie 410 
 
411 
    #
412 
    #   Append extra packages
413 
    #   These are packages that are specifically named by the user
414 
    #
415 
    #   Note: If there are symbolic links, then the target of the
416 
    #         link is treated used as the package name
417 
    #
418 
    #         Symlink MUST be within the same directory
3846 dpurdie 419 
    #           Used to transfer jats2_current
1038 dpurdie 420 
    #
421 
    my $pkgLink;
422 
    while ( (my ($pname, $pvers)) = each %{$extraPkgs} ) {
423 
        while ( (my ($pver, $pdata) ) = each %{$pvers} ) {
424 
 
1040 dpurdie 425 
            my $epath = catfile( $conf->{'dpkg_archive'} , $pname, $pver );
1038 dpurdie 426 
            if ( -l $epath )
427 
            {
428 
                my $lver = readlink( $epath );
429 
                if ( ! defined $lver )
430 
                {
3846 dpurdie 431 
                    $logger->warn("Can't resolve symlink: $pname, $pver");
1038 dpurdie 432 
                    next;
433 
                }
434 
 
435 
                if ( $lver =~ m ~/~ )
436 
                {
437 
                    $logger->warn("Won't resolve symlink: $pname, $pver, $lver");
438 
                    next;
439 
                }
440 
                $pkgLink->{$pname}{$pver} = $lver;
441 
                $pdata = $pver;
442 
                $pver = $lver;
443 
            }
444 
 
445 
            $logger->verbose2("Add extra package: $pname, $pver, $pdata");
446 
            $pkgList->{$pname}{$pver} = $pdata;
447 
        }
448 
    }
449 
 
1040 dpurdie 450 
    #
451 
    #   If there are no packages to process, then assume that this is an error
452 
    #   condition. Retry the operation soon.
453 
    #
454 
    unless ( keys %{$pkgList} )
455 
    {
456 
 
457 
        $logger->verbose2("No packages to process");
5398 dpurdie 458 
        $statistics{state} = 'No Packages found';
1040 dpurdie 459 
        return;
460 
    }
461 
 
1038 dpurdie 462 
#    while ( (my ($pname, $pvers)) = each %{$pkgList} )
463 
#    {
464 
#        while ( (my ($pver, $ptime) ) = each %{$pvers} )
465 
#        {
466 
#            print "L-- $pname, $pver, $ptime \n";
467 
#
468 
#        }
469 
#    }
470 
 
471 
    #
1040 dpurdie 472 
    #   Delete Excess Packages
1038 dpurdie 473 
    #       Packages not required on the target
1042 dpurdie 474 
    #           KLUDGE: Don't delete links to packages
475 
    #           Don't delete packages marked for deletion
1038 dpurdie 476 
    #
477 
    my $excessPkgList;
1048 dpurdie 478 
    my $excessPkgListCount = 0;
1038 dpurdie 479 
    if ( $conf->{deletePackages} )
480 
    {
481 
        while ( (my ($pname, $pvers)) = each %{$remotePkgList} )
482 
        {
483 
            while ( (my ($pver, $pdata) ) = each %{$pvers} )
484 
            {
485 
                if ( !exists $pkgList->{$pname}{$pver} )
486 
                {
487 
                    if ( exists $pkgLink->{$pname}{$pver} )
488 
                    {
489 
                        $logger->verbose2("Keep Excess package-link: ${pname}/${pver}");
490 
                        next;
491 
                    }
1040 dpurdie 492 
 
493 
                    if ( exists $excludePkgs->{$pname} )
494 
                    {
495 
                        $logger->verbose2("Keep Excluded package: ${pname}");
496 
                        next;
497 
                    }
498 
 
1042 dpurdie 499 
                    if ( exists $pdata->{deleted} )
500 
                    {
501 
                        if ( $conf->{deleteAge} )
502 
                        {
503 
                            if ( $pdata->{deleted} <= $conf->{deleteAge} )
504 
                            {
505 
                                $logger->verbose2("Already marked for future age deletion: ${pname}/${pver}, $pdata->{deleted}");
506 
                                next;
507 
                            }
508 
                            $pdata->{FORCEDELETE} = 1;
509 
                        }
510 
 
511 
                        if ( !$conf->{deleteImmediate} )
512 
                        {
513 
                            $logger->verbose2("Already marked for deletion: ${pname}/${pver}");
514 
                            next;
515 
                        }
516 
                    }
517 
 
518 
                    #
519 
                    #   Force deletion
520 
                    #       deleteImmediate mode
521 
                    #       target is a broken link
522 
                    #
523 
                    $pdata->{FORCEDELETE} = 1
524 
                        if ($conf->{deleteImmediate} || $pdata->{broken});
525 
 
1038 dpurdie 526 
                    $excessPkgList->{$pname}{$pver} = $pdata;
1048 dpurdie 527 
                    $excessPkgListCount++;
1038 dpurdie 528 
                    $logger->verbose("Excess package: ${pname}/${pver}");
529 
                }
1050 dpurdie 530 
#                else
531 
#                {
532 
#                        $logger->verbose3("Retain package: ${pname}/${pver}");
533 
#                }
1038 dpurdie 534 
            }
535 
        }
536 
    }
537 
 
538 
    #
539 
    #   Process the remote list and the local list
540 
    #   The remote time-stamp is the modification time of the packages descpkg file
541 
    #
542 
    #   Mark for transfer packages that
1040 dpurdie 543 
    #       Are in the local set but not the remote set
1038 dpurdie 544 
    #       Have a different time stamp
545 
    #
546 
    #   Ignore packages not in the local archive
547 
    #   Ignore packages that don't have a descpkg
548 
    #   Ignore packages that are writable - still being formed
549 
    #
550 
    my $needPkgList;
1048 dpurdie 551 
    my $needPkgListCount = 0;
552 
    my $filteredCount = 0;
553 
    my $missingCount = 0;
554 
    my $writableCount = 0;
555 
    my $excludeCount = 0;
5404 dpurdie 556 
    my $packageVersionCount = 0;
1038 dpurdie 557 
    while ( (my ($pname, $pvers)) = each %{$pkgList} )
558 
    {
1040 dpurdie 559 
        #
560 
        #   Ignore excluded packages
561 
        #
1048 dpurdie 562 
        if ( exists $excludePkgs->{$pname} )
563 
        {
564 
            $excludeCount++;
565 
            next;
566 
        }
1040 dpurdie 567 
 
1048 dpurdie 568 
        #
569 
        #   Ignore packages that are filtered out
570 
        #
571 
        if ( defined $conf->{'packageFilter'} )
572 
        {
573 
            unless ( $pname =~ m~$conf->{'packageFilter'}~ )
574 
            {
575 
                $logger->verbose3("Filtering out: ${pname}");
576 
                $filteredCount++;
577 
                next;
578 
            }
579 
        }
580 
 
1038 dpurdie 581 
        while ( (my ($pver, $pdata) ) = each %{$pvers} )
582 
        {
1042 dpurdie 583 
            my $tmtime = $remotePkgList->{$pname}{$pver}{time} || 0;
5404 dpurdie 584 
            $packageVersionCount++;
1038 dpurdie 585 
 
586 
            # Package is present in both list
1040 dpurdie 587 
            my ($mtime, $mode) = Utils::mtime( catfile( $conf->{'dpkg_archive'} , $pname, $pver, 'descpkg' ));
1038 dpurdie 588 
            if ( $mtime == 0 )
589 
            {
590 
                # PackageVersion not in local archive (at least the descpkg file is not)
591 
                # Skip now - will pick it up later
592 
                $logger->verbose("Package not in dpkg_archive: $pname, $pver");
1048 dpurdie 593 
                $missingCount++;
1038 dpurdie 594 
                next;
595 
            }
596 
 
597 
            if ( $mode & 0222 )
598 
            {
599 
                # Descpkg file is writable
600 
                # Package may be in the process of being created
1048 dpurdie 601 
                # If the package has been writable for a long time, then
1038 dpurdie 602 
                # consider for transfer
603 
                my $age = $now - $mtime;
604 
                if ( $age < ($conf->{'writewindow '} || 600) )
605 
                {
606 
                    $logger->verbose("Package is writable: $pname, $pver, ", $now - $mtime);
1048 dpurdie 607 
                    $writableCount++;
1038 dpurdie 608 
                    next;
609 
                }
610 
            }
611 
 
612 
            if ( $mtime != $tmtime )
613 
            {
614 
                # Package not present on target, or timestamps differ
615 
                $logger->verbose("Package Needs to be transferred: $pname, $pver, $mtime, $tmtime");
616 
                $needPkgList->{$pname}{$pver} = $pdata;
1048 dpurdie 617 
                $needPkgListCount++;
1038 dpurdie 618 
                next;
619 
            }
620 
        }
621 
    }
622 
 
1048 dpurdie 623 
 
1038 dpurdie 624 
    #
625 
    #   Debug output only
626 
    #   Display what we need to transfer
627 
    #
628 
    if ( $conf->{verbose} > 2 )
629 
    {
630 
        while ( (my ($pname, $pvers)) = each %{$needPkgList} )
631 
        {
632 
            while ( (my ($pver, $pdata) ) = each %{$pvers} )
633 
            {
634 
                $logger->verbose("Need to transfer: $pname, $pver, $pdata");
635 
            }
636 
        }
637 
    }
1048 dpurdie 638 
    if ( $conf->{verbose}  )
639 
    {
640 
        $logger->verbose("Packages to transfer: $needPkgListCount");
641 
        $logger->verbose("Packages to delete: $excessPkgListCount");
642 
        $logger->verbose("Packages filtered out: $filteredCount");
643 
        $logger->verbose("Packages missing: $missingCount");
644 
        $logger->verbose("Packages still writable: $writableCount");
645 
        $logger->verbose("Packages excluded: $excludeCount");
646 
    }
1038 dpurdie 647 
 
648 
    #
5398 dpurdie 649 
    #   Update stats
650 
    #   At this point we are looking pretty good
651 
    #
652 
    $statistics{state} = 'OK';
5404 dpurdie 653 
    $statistics{total} = $packageVersionCount;
654 
    $statistics{remoteTotal} = $remotePackageVersionCount;
5398 dpurdie 655 
    $statistics{transfer} = $needPkgListCount;
656 
    $statistics{delete} = $excessPkgListCount;
657 
    $statistics{filtered} = $filteredCount;
658 
    $statistics{missing} = $missingCount;
659 
    $statistics{writable} = $writableCount;
660 
    $statistics{excluded} = $excludeCount;
661 
 
662 
    #
1038 dpurdie 663 
    #   Time to do the real work
664 
    #   Transfer packages and delete excess packages
665 
    #   Note: Perform the transfers first
666 
    #         Limit the number of packages processed in one pass
667 
    #
668 
    my $txcount = $conf->{maxpackages};
669 
 
670 
    #
671 
    #   Transfer packages that we have identified
672 
    #
673 
    send_pkgs:
674 
    while ( (my ($pname, $pvers)) = each %{$needPkgList} )
675 
    {
676 
        while ( (my ($pver, $pdata) ) = each %{$pvers} )
677 
        {
678 
            if ( --$txcount <= 0 )
679 
            {
1050 dpurdie 680 
                $logger->warn("Max transfer count exceeded: $needPkgListCount transfer remaining");
1038 dpurdie 681 
                $lastReleaseScan = 0;
682 
                last send_pkgs;
683 
            }
1289 dpurdie 684 
 
685 
            if ( readConfig() )
686 
            {
687 
                $logger->warn("Config file changed");
688 
                $lastReleaseScan = 0;
689 
                $txcount = 0;
690 
                last send_pkgs;
691 
            }
692 
 
1044 dpurdie 693 
            transferPackage ($pname, $pver, $pdata);
1048 dpurdie 694 
            $needPkgListCount--;
1038 dpurdie 695 
        }
696 
    }
697 
 
698 
    #
699 
    #   Delete packages that have been identified as excess
700 
    #
701 
    delete_pkgs:
702 
    while ( (my ($pname, $pvers)) = each %{$excessPkgList} )
703 
    {
704 
        while ( (my ($pver, $pdata) ) = each %{$pvers} )
705 
        {
706 
            if ( --$txcount <= 0 )
707 
            {
1050 dpurdie 708 
                $logger->warn("Max transfer count exceeded: $excessPkgListCount deletion remaining");
1038 dpurdie 709 
                $lastReleaseScan = 0;
710 
                last delete_pkgs;
711 
            }
1289 dpurdie 712 
 
713 
            if ( readConfig() )
714 
            {
715 
                $logger->warn("Config file changed");
716 
                $lastReleaseScan = 0;
717 
                $txcount = 0;
718 
                last send_pkgs;
719 
            }
720 
 
1044 dpurdie 721 
            deletePackage ($pname, $pver, $pdata);
1048 dpurdie 722 
            $excessPkgListCount--;
1038 dpurdie 723 
        }
724 
    }
725 
 
726 
    #
727 
    #   Send package list to the target
728 
    #
729 
    sendPackageList ($pkgList);
1040 dpurdie 730 
 
731 
    #
732 
    #   On a successful transfer
733 
    #       Force tag processing
734 
    #       Set scan Mode to normal
735 
    #
736 
    $tagDirTime = 0;
737 
    $releaseScanMode = 0;
1038 dpurdie 738 
}
739 
 
740 
#-------------------------------------------------------------------------------
741 
# Function        : sendPackageList
742 
#
743 
# Description     : Transfer package list to the target
744 
#
745 
# Inputs          : $pkgList            - Ref to hash of package names and versions
746 
#
1040 dpurdie 747 
# Returns         : Nothing
748 
#                   Don't really care about any errors from this process
749 
#                   Its not essential
1038 dpurdie 750 
#
751 
sub sendPackageList
752 
{
753 
    my ($pkgList) = @_;
754 
    my ($fh, $filename) = tempfile( "/tmp/blat.$$.XXXX", SUFFIX => '.txt');
755 
    $logger->verbose("sendPackageList:TmpFile: $filename");
756 
 
757 
    #
758 
    #   Create a temp file with data
759 
    #
760 
    foreach my $pname ( sort keys %{$pkgList} )
761 
    {
762 
        foreach my $pver ( sort keys %{$pkgList->{$pname}} )
763 
        {
764 
            print $fh "$pname/$pver\n";
765 
        }
766 
    }
767 
    close $fh;
768 
 
769 
    #
770 
    #   Transfer to target
771 
    #   Create the process pipe to transfer the file
772 
    #   gzip the file and pipe the result through a ssh session to the target machine
3515 dpurdie 773 
    #   gzip -c filename |  ssh  ... "./receive_file filename"
1038 dpurdie 774 
    #
775 
    my $ph;
3515 dpurdie 776 
    my $gzip_cmd = "$gzip --no-name -c \"$filename\"";
1040 dpurdie 777 
    my $tgt_cmd = "$conf->{'bindir'}/receive_file \"ArchiveList\"";
3515 dpurdie 778 
    my $ssh_cmd = sshCmd($tgt_cmd);
1038 dpurdie 779 
 
780 
    $logger->verbose2("sendPackageList:gzip_cmd:$gzip_cmd");
781 
    $logger->verbose2("sendPackageList:tgt_cmd:$tgt_cmd");
782 
    $logger->verbose2("sendPackageList:ssh_cmd:$ssh_cmd");
783 
 
784 
    open ($ph, "$gzip_cmd | $ssh_cmd |");
785 
    while ( <$ph> )
786 
    {
787 
        chomp;
788 
        $logger->verbose2("sendPackageList:Data: $_");
789 
    }
790 
    close ($ph);
3515 dpurdie 791 
    unlink $filename;
1038 dpurdie 792 
    $logger->verbose("sendPackageList:End: $?");
3515 dpurdie 793 
    LogTxError ($?);
1038 dpurdie 794 
}
795 
 
796 
 
797 
#-------------------------------------------------------------------------------
798 
# Function        : getPkgList
799 
#
800 
# Description     : Determine a set of package versions within the list
801 
#                   of provided releases
802 
#
803 
# Inputs          : @rlist              - A list of releases to examine
804 
#
805 
# Returns         : Ref to a hask of package versions
806 
#
807 
sub getPkgList
808 
{
809 
    my %pdata;
810 
    my $RM_DB;
811 
    connectRM(\$RM_DB);
812 
    $logger->verbose("getPkgList");
813 
 
814 
    #
815 
    #   Determine the releases that are in this project
816 
    #   Build up an sql query
817 
    #
818 
    my @m_rlist;
819 
    push @m_rlist,"rc.RTAG_ID=$_" foreach ( @_ );
820 
    my $m_rlist = join ' OR ', @m_rlist;
1048 dpurdie 821 
    my $m_sqlstr = "SELECT DISTINCT pv.PV_ID, pkg.PKG_NAME, pv.PKG_VERSION, pv.IS_DEPLOYABLE" .
1038 dpurdie 822 
                    " FROM RELEASE_MANAGER.RELEASE_CONTENT rc, RELEASE_MANAGER.PACKAGE_VERSIONS pv, RELEASE_MANAGER.PACKAGES pkg" .
823 
                    " WHERE ( $m_rlist ) AND rc.PV_ID = pv.PV_ID AND pv.PKG_ID = pkg.PKG_ID" .
824 
                    " ORDER by PKG_NAME DESC";
825 
    $logger->verbose3("getPkgList:Sql:$m_sqlstr");
826 
 
827 
    my $sth = $RM_DB->prepare($m_sqlstr);
828 
    if ( defined($sth) )
829 
    {
830 
        if ( $sth->execute( ) )
831 
        {
832 
            if ( $sth->rows )
833 
            {
834 
                while (my @row = $sth->fetchrow_array )
835 
                {
836 
                    $logger->verbose2("getPkgList:Data:@row");
837 
                    $pdata{$row[1]}{$row[2]} = 1;
838 
                }
839 
            }
840 
            $sth->finish();
841 
        }
842 
    }
843 
    else
844 
    {
845 
        $logger->warn("getPkgList: SQL Prepare failure");
846 
    }
1050 dpurdie 847 
 
848 
   disconnectRM(\$RM_DB);
1038 dpurdie 849 
   return \%pdata;
850 
}
851 
 
852 
 
853 
#-------------------------------------------------------------------------------
854 
# Function        : getReleaseList
855 
#
856 
# Description     : Determine the list of releases to be proccessed
1040 dpurdie 857 
#                   From:
858 
#                       Convert projects to a list of releases
859 
#                       Configured list of releases
1038 dpurdie 860 
#
861 
# Inputs          : None
862 
#
863 
# Returns         : A list of releases to be processed
864 
#
865 
sub getReleaseList
866 
{
867 
    my $RM_DB;
868 
    my %rlist;
1048 dpurdie 869 
    my $m_sqlstr;
1038 dpurdie 870 
    $logger->verbose("getReleaseList");
871 
 
872 
    #
1040 dpurdie 873 
    #   Cache data
874 
    #   Only for one cycle of the main loop
875 
    #
876 
    if ( exists $releaseData{getReleaseList} )
877 
    {
878 
        $logger->verbose3("getReleaseList:Cache hit");
879 
        return @{$releaseData{getReleaseList}};
880 
    }
881 
 
882 
    #
1048 dpurdie 883 
    #   All projects
1038 dpurdie 884 
    #
1048 dpurdie 885 
    if ( $conf->{'allProjects'} )
1038 dpurdie 886 
    {
1048 dpurdie 887 
        $m_sqlstr = "SELECT rt.RTAG_ID" .
888 
                    " FROM RELEASE_MANAGER.RELEASE_TAGS rt" .
1050 dpurdie 889 
                    " WHERE rt.OFFICIAL != 'A'";
890 
                    #" AND rt.OFFICIAL != 'Y'";
1048 dpurdie 891 
    }
892 
    else
893 
    {
1038 dpurdie 894 
        #
1048 dpurdie 895 
        #   Convert list of projects into a list of releases
1038 dpurdie 896 
        #
1048 dpurdie 897 
        my @plist = split /[,\s]+/, $conf->{'project'} || '';
898 
        if ( @plist )
899 
        {
900 
            #
901 
            #   Determine the releases that are in this project
902 
            #   Build up an sql query
903 
            #
904 
            my @m_plist;
905 
            push @m_plist,"PROJ_ID=$_" foreach ( @plist );
906 
            my $m_plist = join ' OR ', @m_plist;
907 
            $m_sqlstr = "SELECT rt.RTAG_ID" .
908 
                        " FROM RELEASE_MANAGER.RELEASE_TAGS rt" .
5300 dpurdie 909 
                        " WHERE ( $m_plist ) AND rt.OFFICIAL != 'A'";
910 
                        #" AND rt.OFFICIAL != 'Y'";
1048 dpurdie 911 
        }
912 
    }
1038 dpurdie 913 
 
1048 dpurdie 914 
    if ( defined $m_sqlstr )
915 
    {
1038 dpurdie 916 
        $logger->verbose3("getReleaseList:Sql:$m_sqlstr");
1048 dpurdie 917 
        connectRM(\$RM_DB);
1038 dpurdie 918 
        my $sth = $RM_DB->prepare($m_sqlstr);
919 
        if ( defined($sth) )
920 
        {
921 
            if ( $sth->execute( ) )
922 
            {
923 
                if ( $sth->rows )
924 
                {
925 
                    while (my @row = $sth->fetchrow_array )
926 
                    {
927 
                        $logger->verbose2("getReleaseList:Data:@row");
928 
                        $rlist{$row[0]} = 1;
929 
                    }
930 
                }
931 
                $sth->finish();
932 
            }
933 
        }
934 
        else
935 
        {
936 
            $logger->warn("getReleaseList: SQL Prepare failure");
937 
        }
1050 dpurdie 938 
        disconnectRM(\$RM_DB);
1038 dpurdie 939 
    }
940 
 
941 
    #
942 
    #   Add in the user specified list of releases
943 
    #
944 
    my @rlist = split /[,\s]+/, $conf->{'release'} || '';
945 
    $rlist{$_} = 1 foreach(@rlist);
946 
 
947 
    #
948 
    #   Sort for pretty display only
949 
    #
1040 dpurdie 950 
    @{$releaseData{getReleaseList}} = sort {$a <=> $b} keys %rlist;
951 
 
952 
    return @{$releaseData{getReleaseList}};
1038 dpurdie 953 
}
954 
 
1040 dpurdie 955 
#-------------------------------------------------------------------------------
3846 dpurdie 956 
# Function        : getPackageVersions
957 
#
958 
# Description     : Get the list of package-versions available in the package
959 
#                   store.
960 
#
961 
# Inputs          : pkgName             - The package name
962 
#
963 
# Returns         : Array of versions
964 
#
965 
sub getPackageVersions
966 
{
967 
    my ($pkgName) = @_;
968 
    my @versionList;
969 
 
970 
    my $pkgDir = catfile($conf->{'dpkg_archive'} , $pkgName );
971 
    my $dh;
972 
 
973 
    unless (opendir($dh, $pkgDir))
974 
    {
975 
        $logger->warn ("Can't opendir $pkgDir: $!");
976 
        return @versionList;
977 
    }
978 
 
979 
    #
980 
    #   Process each entry
981 
    #   Ignore those that start with a .
982 
    #
983 
    while (my $version = readdir($dh) )
984 
    {
985 
        next if ( $version =~ m~^\.~ );
986 
        my $file = catfile($pkgDir, $version);
987 
 
988 
        next unless ( -d $file );
989 
 
990 
        push @versionList, $version;
991 
        $logger->verbose3("getPackageVersions: $pkgName, $version");
992 
    }
993 
    closedir $dh;
994 
    return @versionList;
995 
}
996 
 
997 
#-------------------------------------------------------------------------------
4456 dpurdie 998 
# Function        : getArchiveList
999 
#
1000 
# Description     : Get the entire set of package versions in the archive
1001 
#
1002 
# Inputs          :
1003 
#
1004 
# Returns         : Ref to a hask of package versions
1005 
#
1006 
sub getArchiveList
1007 
{
1008 
    my $pkgDir = $conf->{'dpkg_archive'};
1009 
    my %archiveList;
1010 
    my $dh;
1011 
    my @pkgList;
1012 
 
1013 
    unless (opendir($dh, $pkgDir))
1014 
    {
1015 
        $logger->warn ("Can't opendir $pkgDir: $!");
1016 
        return \%archiveList;
1017 
    }
1018 
 
1019 
    #
1020 
    #   Process each entry
1021 
    #   Ignore those that start with a .
1022 
    #   Ignore files
1023 
    #
1024 
    while (my $pkgName = readdir($dh) )
1025 
    {
1026 
        next if ( $pkgName =~ m~^\.~ );
1027 
        my $file = catfile($pkgDir, $pkgName);
1028 
 
1029 
        next unless ( -d $file );
1030 
        $logger->verbose3("getArchiveList: $pkgName");
1031 
        push @pkgList, $pkgName;
1032 
    }
1033 
    closedir $dh;
1034 
 
1035 
    #   Now get the package versions
1036 
    #       Sort for pretty display
1037 
    foreach my $pname (sort @pkgList)
1038 
    {
1039 
        foreach my $pver (getPackageVersions($pname))
1040 
        {
1041 
            $archiveList{$pname}{$pver} = 1;
1042 
        }
1043 
    }
1044 
 
1045 
    return \%archiveList;
1046 
}
1047 
 
1048 
#-------------------------------------------------------------------------------
1040 dpurdie 1049 
# Function        : maintainTagList
1050 
#
1051 
# Description     : Maintain a data structure for the maintenance of the
1052 
#                   tags directory
1053 
#
1054 
# Inputs          : None
1055 
#
1056 
# Returns         : Nothing
1057 
#
1058 
sub maintainTagList
1059 
{
1060 
    #
1061 
    #   Time to perform the scan
1062 
    #   Will do at startup and every time period there after
1063 
    #
1064 
    return unless ( $now > ($lastTagListScan + $conf->{tagListUpdate} ));
1065 
    $logger->verbose("maintainTagList");
1066 
    $lastTagListScan = $now;
1038 dpurdie 1067 
 
1040 dpurdie 1068 
    #
1069 
    #   Get list of things
1070 
    #
1071 
    my %config;
4457 dpurdie 1072 
    if ($conf->{'allArchive'} )
1073 
    {
1074 
        $config{allArchive} = 1
1075 
    }
1076 
    elsif ($conf->{'allProjects'} )
1077 
    {
1078 
        $config{allProjects} = 1;
1079 
    }
1080 
    else
1081 
    {
1082 
        %{$config{projects}} = map { $_ => 1 } split (/[,\s]+/, $conf->{'project'} || '');
1083 
        %{$config{releases}} = map { $_ => 1 } getReleaseList();
1084 
    }
1040 dpurdie 1085 
 
1086 
    #
1087 
    #   Save data
1088 
    #
1089 
    my $dump =  Data::Dumper->new([\%config], [qw(*config)]);
1090 
#print $dump->Dump;
1091 
#$dump->Reset;
1092 
 
1093 
    #
1094 
    #   Save config data
1095 
    #
1096 
    my $conf_file = catfile( $conf->{'tagdir'},'.config' );
1097 
    $logger->verbose3("maintainTagList: Writting $conf_file");
1098 
 
1099 
    my $fh;
1100 
    open ( $fh, '>', $conf_file ) or $logger->err("Can't create $conf_file: $!");
1101 
    print $fh $dump->Dump;
1102 
    close $fh;
1103 
}
1104 
 
1105 
 
1038 dpurdie 1106 
#-------------------------------------------------------------------------------
1107 
# Function        : processTags
1108 
#
1109 
# Description     : Process tags and send marked package versions to the target
1110 
#                       Determine if new tags are present
1111 
#                       Process each tag
1112 
#
1113 
# Inputs          : None
1114 
#
1115 
# Returns         : Nothing
1116 
#
1117 
sub processTags
1118 
{
1119 
    #
1120 
    #   Determine if new tags are present by examining the time
1121 
    #   that the directory was last modified.
1122 
    #
1123 
    #   Allow for a forced scan to catch packages that did not transfer
1124 
    #   on the first attempt
1125 
    #
5398 dpurdie 1126 
    my $tagCount = 0;
1038 dpurdie 1127 
    my ($mtime) = Utils::mtime($conf->{'tagdir'} );
1128 
    if ( ($mtime > $tagDirTime) || ($now > ($lastDirScan + $conf->{'forcedirscan'})) )
1129 
    {
1042 dpurdie 1130 
        $logger->verbose2("processTags: ",$conf->{'tagdir'}, $mtime - $tagDirTime, $now - $lastDirScan);
1038 dpurdie 1131 
        $tagDirTime = $mtime;
1132 
        $lastDirScan = $now;
1133 
 
1134 
        my $dh;
1135 
        unless (opendir($dh, $conf->{'tagdir'}))
1136 
        {
1137 
            $logger->warn ("can't opendir $conf->{'tagdir'}: $!");
1138 
            return;
1139 
        }
1140 
 
1141 
        #
1142 
        #   Process each entry
1143 
        #   Ignore those that start with a .
1144 
        #
1145 
        while (my $tag = readdir($dh) )
1146 
        {
1147 
            next if ( $tag =~ m~^\.~ );
1148 
            my $file = "$conf->{'tagdir'}/$tag";
1042 dpurdie 1149 
            $logger->verbose3("processTags: $file");
1150 
 
1038 dpurdie 1151 
            next unless ( -f $file );
1152 
            next if ( $tag  eq 'ReleaseList' );
1153 
 
1154 
            if ( $tag =~ m~(.+)::(.+)~  )
1155 
            {
1156 
                my $package = $1;
1157 
                my $version = $2;
5398 dpurdie 1158 
                $tagCount++;
1038 dpurdie 1159 
                if ( transferPackage( $package, $version ))
1160 
                {
1161 
                    unlink $file;
1162 
                }
1163 
                else
1164 
                {
1165 
                    my ($mtime) = Utils::mtime( $file );
1166 
                    if ( $now - $mtime > $conf->{'tagage'} )
1167 
                    {
1168 
                        $logger->warn ("Delete unsatisfied tag: $tag");
1169 
                        unlink $file;
5398 dpurdie 1170 
                        $statistics{staleTags}++;
1038 dpurdie 1171 
                    }
1172 
                }
1173 
            }
1174 
        }
1175 
        closedir $dh;
1176 
    }
5398 dpurdie 1177 
    $statistics{tagCount} = $tagCount;
1038 dpurdie 1178 
}
1179 
 
1180 
#-------------------------------------------------------------------------------
1181 
# Function        : transferPackage
1182 
#
1183 
# Description     : Transfer specified package to target system
1184 
#
1185 
# Inputs          : $pname          - Name of the package
1186 
#                   $pver           - Package version
1187 
#                   $plink          - (optional) Symlink in same package
1188 
#
1189 
# Returns         : true    - Package transferred
1190 
#                   false   - Package not transferred
1191 
#
1192 
sub transferPackage
1193 
{
1194 
    my ($pname, $pver, $plink ) = @_;
1195 
    my $rv = 0;
1196 
    $logger->logmsg("transferPackage: @_");
1197 
 
1198 
    #
1040 dpurdie 1199 
    #   Do not transfer excluded files
1200 
    #
1201 
    if ( exists $excludePkgs->{$pname} )
1202 
    {
1048 dpurdie 1203 
        $logger->warn("transferPackage: Excluded package not transferred: $pname, $pver");
1040 dpurdie 1204 
        return 1;
1205 
    }
1048 dpurdie 1206 
 
1040 dpurdie 1207 
    #
1048 dpurdie 1208 
    #   Apply package filter
1209 
    #
1210 
    if ( defined $conf->{'packageFilter'} )
1211 
    {
1212 
        unless ( $pname =~ m~$conf->{'packageFilter'}~ )
1213 
        {
1214 
            $logger->warn("transferPackage: Filtered out package not transferred: $pname, $pver");
1215 
            return 1;
1216 
        }
1217 
    }
1218 
 
1219 
    #
1038 dpurdie 1220 
    #   plink of 1 is not a symlink
1221 
    #
1222 
    $plink = undef if ( defined($plink) && $plink eq '1' );
1223 
 
1224 
    #
1225 
    #   If its been transferred in the current scan, then
1226 
    #   indicate that all is well
1227 
    #
1228 
    if ( $transferred->{$pname}{$pver}  )
1229 
    {
1230 
        $logger->verbose("transferPackage: Already transferred");
1231 
        return 1;
1232 
    }
1233 
 
1040 dpurdie 1234 
    my $sfile = catfile( $conf->{'dpkg_archive'} , $pname, $pver );
1038 dpurdie 1235 
    unless ( -d $sfile )
1236 
    {
1237 
        $logger->warn("transferPackage:Package not found: $pname, $pver");
1238 
        return $rv;
1239 
    }
1240 
 
1241 
    #
4456 dpurdie 1242 
    #   Create the process pipe to transfer the package
1038 dpurdie 1243 
    #   Tar the directory and pipe the result through a ssh session to
1244 
    #   the target machine
3515 dpurdie 1245 
    #   $tar -czf - -C "$dpkg/${pname}/${pver}" . |  ssh  ... "./receive_package pname pver"
1038 dpurdie 1246 
    #
1247 
    my $ph;
3515 dpurdie 1248 
    my $tar_cmd = "$tar -czf - -C \"$sfile\" .";
1038 dpurdie 1249 
    my $tgt_opts = defined($plink) ? "\"-L$plink\"" : '';
1040 dpurdie 1250 
    my $tgt_cmd = "$conf->{'bindir'}/receive_package $tgt_opts \"$pname\" \"$pver\"";
3515 dpurdie 1251 
    my $ssh_cmd = sshCmd($tgt_cmd);
1038 dpurdie 1252 
 
1253 
    $logger->verbose2("transferPackage:tar_cmd:$tar_cmd");
1254 
    $logger->verbose2("transferPackage:tgt_cmd:$tgt_cmd");
1255 
    $logger->verbose2("transferPackage:ssh_cmd:$ssh_cmd");
1256 
 
1257 
    open ($ph, "$tar_cmd | $ssh_cmd |");
1258 
    while ( <$ph> )
1259 
    {
1260 
        chomp;
1261 
        $logger->verbose2("transferPackage:Data: $_");
1262 
    }
1263 
    close ($ph);
1264 
    $logger->verbose("transferPackage:End: $?");
1265 
    if ( $? == 0 )
1266 
    {
1267 
        #
1268 
        #   Mark has having been transferred in the current cycle
1269 
        #
1270 
        $transferred->{$pname}{$pver} = 1;
1271 
        $rv = 1;
5398 dpurdie 1272 
        $statistics{txCount}++;
1038 dpurdie 1273 
    }
1274 
    else
1275 
    {
1276 
        $logger->warn("transferPackage:Transfer Error: $pname, $pver, $?");
1277 
    }
3515 dpurdie 1278 
    LogTxError ($?);
1038 dpurdie 1279 
    return $rv;
1280 
}
1281 
 
1282 
#-------------------------------------------------------------------------------
1283 
# Function        : deletePackage
1284 
#
1285 
# Description     : Delete specified package to target system
1286 
#
1287 
# Inputs          : $pname          - Name of the package
1288 
#                   $pver           - Package version
1042 dpurdie 1289 
#                   $pdata          - Hash of extra data
1038 dpurdie 1290 
#
1291 
# Returns         : true    - Package transferred
1292 
#                   false   - Package not transferred
1293 
#
1294 
sub deletePackage
1295 
{
1042 dpurdie 1296 
    my ($pname, $pver, $pdata ) = @_;
1038 dpurdie 1297 
    my $rv = 0;
1042 dpurdie 1298 
    $logger->logmsg("deletePackage: $pname, $pver");
1038 dpurdie 1299 
 
1300 
    #
1301 
    #   Create the process pipe to delete the package
3515 dpurdie 1302 
    #   ssh  ... "./delete_package ${rx_opts} \"$pname\" \"$pver\""
1038 dpurdie 1303 
    #
1304 
    my $ph;
1042 dpurdie 1305 
    my $flags = $pdata->{FORCEDELETE}  ? '' : ' -T';
1306 
    my $tgt_cmd = "$conf->{'bindir'}/delete_package $flags \"$pname\" \"$pver\"";
3515 dpurdie 1307 
    my $ssh_cmd = sshCmd($tgt_cmd);
1038 dpurdie 1308 
 
1040 dpurdie 1309 
    $logger->verbose2("deletePackage:tgt_cmd:$tgt_cmd");
1310 
    $logger->verbose2("deletePackage:ssh_cmd:$ssh_cmd");
1038 dpurdie 1311 
 
1312 
    open ($ph, "$ssh_cmd |");
1313 
    while ( <$ph> )
1314 
    {
1315 
        chomp;
1316 
        $logger->verbose2("deletePackage:Data: $_");
1317 
    }
1318 
    close ($ph);
1319 
    $logger->verbose("deletePackage:End: $?");
1320 
    if ( $? == 0 )
1321 
    {
1322 
        $rv = 1;
5398 dpurdie 1323 
        $statistics{delCount}++;
1038 dpurdie 1324 
    }
1325 
    else
1326 
    {
1327 
        $logger->warn("deletePackage:Error: $pname, $pver, $?");
1328 
    }
3515 dpurdie 1329 
    LogTxError ($?);
1038 dpurdie 1330 
    return $rv;
1331 
}
1332 
 
3515 dpurdie 1333 
#-------------------------------------------------------------------------------
1334 
# Function        : sshCmd
1335 
#
1336 
# Description     : Generate a ssh based command
1337 
#
1338 
# Inputs          : Target command
1339 
#
1340 
# Returns         : An shh command string
1341 
#
1342 
sub sshCmd
1343 
{
1344 
    my ($tgt_cmd) = @_;
3847 dpurdie 1345 
    my $sshPort = '';
1346 
    $sshPort = "-p $conf->{'sshport'}"
1347 
        if ($conf->{'sshport'});
1348 
 
1349 
    return "ssh -o \"BatchMode yes\" -i $conf->{'identity'} ${sshPort} $conf->{'user'}\@$conf->{'hostname'} \"$tgt_cmd\" 2>&1";
3515 dpurdie 1350 
}
1038 dpurdie 1351 
 
3515 dpurdie 1352 
 
1038 dpurdie 1353 
#-------------------------------------------------------------------------------
1042 dpurdie 1354 
# Function        : parsePkgList
1355 
#
1356 
# Description     : Parse one line from a pkgList
1357 
#                   Lines are multiple item="data" items
1358 
#
1359 
# Inputs          : $line                   - Line of data
1360 
#                   $hashp                  - Ref to hash to populate
1361 
#
1362 
# Returns         : A hash of data items
1363 
#
1364 
sub parsePkgList
1365 
{
1366 
    my ($line, $hashp) = @_;
1367 
    my $rv;
1368 
 
1369 
    while ( $line =~ m~\s*(.+?)="(.+?)"~ )
1370 
    {
1371 
        $rv->{$1} = $2;
1372 
        $line = $';
1373 
    }
1374 
#Utils::DebugDumpData ("parsePkgList", $rv);
1375 
 
1376 
    my $pname = $rv->{pname};
1377 
    my $pver =  $rv->{pver};
1378 
    return undef unless ( $pname && $pver );
1379 
 
1380 
    delete $rv->{pname};
1381 
    delete $rv->{pver};
1382 
    delete $rv->{GMT};
1383 
 
1384 
    $hashp->{$pname}{$pver} = $rv;
1385 
    return $hashp;
1386 
}
1387 
 
5398 dpurdie 1388 
#-------------------------------------------------------------------------------
5404 dpurdie 1389 
# Function        : parsePkgMetaData
1390 
#
1391 
# Description     : Parse one line of meta data from a pkgList
1392 
#                   Lines are multiple item="data" items
1393 
#
1394 
# Inputs          : $line                   - Line of data
1395 
#                   $hashp                  - Ref to hash to populate
1396 
#
1397 
# Returns         : Nothing
1398 
#
1399 
sub parsePkgMetaData
1400 
{
1401 
    my ($line, $hashp) = @_;
1402 
 
1403 
    if ( $line =~ m~\s+(.+?)="(.+?)"~ )
1404 
    {
1405 
        $hashp->{$1} = $2;
1406 
        $statistics{'Target.' . $1} = $2;
1407 
        $line = $';
1408 
 
1409 
        $logger->verbose2("parsePkgMetaData: $1 = $2");
1410 
    }
1411 
}
1412 
 
1413 
 
1414 
#-------------------------------------------------------------------------------
5398 dpurdie 1415 
# Function        : resetDailyStatistics
1416 
#
1417 
# Description     : Called periodically to reset the daily statistics
1418 
#
1419 
# Inputs          : $time       - Current time
1420 
#
1421 
# Returns         :
1422 
#
1423 
sub resetDailyStatistics
1424 
{
1425 
    my ($time) = @_;
1042 dpurdie 1426 
 
5398 dpurdie 1427 
    #
1428 
    #   Detect a new day
1429 
    #
1430 
    my $today = (localtime($time))[7];
1431 
    if ($yday != $today)
1432 
    {
1433 
        $yday = $today;
1434 
        $logger->logmsg('Resetting daily statistics' );
1435 
 
5404 dpurdie 1436 
        # Note: Must match @recoverTags in readStatistics
5398 dpurdie 1437 
        $statistics{dayStart} = $time;
1438 
        $statistics{txCount} = 0;
1439 
        $statistics{delCount} = 0;
1440 
        $statistics{staleTags} = 0;
1441 
        $statistics{linkErrors} = 0;
1442 
    }
1443 
}
1444 
 
1042 dpurdie 1445 
#-------------------------------------------------------------------------------
5404 dpurdie 1446 
# Function        : readStatistics
1447 
#
1448 
# Description     : Read in the last set of stats
1449 
#                   Used after a restart to recover daily statistics
1450 
#
1451 
# Inputs          :
1452 
#
1453 
# Returns         :
1454 
#
1455 
sub readStatistics
1456 
{
1457 
    my @recoverTags = qw(dayStart txCount delCount staleTags linkErrors);
1458 
 
1459 
    if ($conf->{'statsfile'} and -f $conf->{'statsfile'})
1460 
    {
1461 
        if (open my $fh, $conf->{'statsfile'})
1462 
        {
1463 
            while (<$fh>)
1464 
            {
1465 
                m~(.*):(.*)~;
1466 
                if ( grep( /^$1$/, @recoverTags ) )
1467 
                {
1468 
                    $statistics{$1} = $2;
1469 
                    $logger->verbose("readStatistics $1, $2\n");
1470 
                }
1471 
            }
1472 
            close $fh;
1473 
            $yday = (localtime($statistics{dayStart}))[7];
1474 
        }
1475 
    }
1476 
}
1477 
 
1478 
 
1479 
#-------------------------------------------------------------------------------
5398 dpurdie 1480 
# Function        : periodicStatistics
1481 
#
1482 
# Description     : Called on a regular basis to write out statistics
1483 
#                   Used to feed information into Nagios
1484 
#
1485 
#                   This function is called via an alarm and may be outside the normal
1486 
#                   processing loop. Don't make assumptions on the value of $now
1487 
#
1488 
# Inputs          :
1489 
#
1490 
# Returns         :
1491 
#
1492 
sub periodicStatistics
1493 
{
1494 
    #
1495 
    #   A few local stats
1496 
    #
1497 
    $statistics{SeqNum}++;
1498 
    $statistics{timeStamp} = time();
1499 
    $statistics{upTime} = $statistics{timeStamp} - $startTime;
1500 
 
1501 
    #   Reset daily accumulations - on first use each day
1502 
    resetDailyStatistics($statistics{timeStamp});
1503 
 
1504 
    #
1505 
    #   Write statistics to a file
1506 
    #       Write to a tmp file, then rename.
1507 
    #       Attempt to make the operation atomic - so that the file consumer
1508 
    #       doesn't get a badly formed file.
1509 
    #
1510 
    if ($conf->{'statsfiletmp'})
1511 
    {
1512 
        my $fh;
1513 
        unless (open ($fh, '>', $conf->{'statsfiletmp'}))
1514 
        {
1515 
            $fh = undef;
1516 
            $logger->warn("Cannot create temp stats file: $!");
1517 
        }
1518 
        else
1519 
        {
5404 dpurdie 1520 
            foreach my $key ( sort { lc($a) cmp lc($b) } keys %statistics)
5398 dpurdie 1521 
            {
1522 
                print $fh $key . ':' . $statistics{$key} . "\n";
1523 
                $logger->verbose2('Statistics:'. $key . ':' . $statistics{$key});
1524 
            }
1525 
            close $fh;
1526 
 
1527 
            # Rename temp to real file
1528 
            rename  $conf->{'statsfiletmp'},  $conf->{'statsfile'} ;
1529 
        }
1530 
    }
1531 
}
1532 
 
1533 
#-------------------------------------------------------------------------------
1038 dpurdie 1534 
# Function        : sighandlers
1535 
#
1536 
# Description     : Install signal handlers
1537 
#
1538 
# Inputs          : $conf           - System config
1539 
#
1540 
# Returns         : Nothing
1541 
#
1542 
sub sighandlers
1543 
{
5398 dpurdie 1544 
    my $conf = shift;
1545 
    my $logger = $conf->{logger};
1038 dpurdie 1546 
 
5398 dpurdie 1547 
    $SIG{TERM} = sub {
1548 
        # On shutdown
1549 
        $logger->logmsg('Received SIGTERM. Shutting down....' );
1550 
        unlink $conf->{'pidfile'} if (-f $conf->{'pidfile'});
1551 
        exit 0;
1552 
    };
1038 dpurdie 1553 
 
5398 dpurdie 1554 
    $SIG{HUP} = sub {
1555 
        # On logrotate
1556 
        $logger->logmsg('Received SIGHUP.');
1557 
        $logger->rotatelog();
1558 
    };
1038 dpurdie 1559 
 
5398 dpurdie 1560 
    $SIG{USR1} = sub {
1561 
        # On Force Archive Sync
1562 
        $logger->logmsg('Received SIGUSR1.');
1046 dpurdie 1563 
        $lastReleaseScan = 0;
1564 
        $lastTagListScan = 0;
5398 dpurdie 1565 
    };
1038 dpurdie 1566 
 
5398 dpurdie 1567 
    alarm 60;
1568 
    $SIG{ALRM} = sub {
1569 
        # On Dump Statistics
1570 
        $logger->verbose2('Received SIGUSR2.');
1571 
        periodicStatistics();
1572 
        alarm 60;
1573 
    };
1574 
 
1038 dpurdie 1575 
    $SIG{__WARN__} = sub { $logger->warn("@_") };
1576 
    $SIG{__DIE__} = sub { $logger->err("@_") };
1577 
}
1578 
 
1579 
#-------------------------------------------------------------------------------
3515 dpurdie 1580 
# Function        : LogTxError
1581 
#
1582 
# Description     : Detect restoration of communication and log such
1583 
#                   Don't log failures as the user will do that
1584 
#
1585 
# Inputs          : $state                  - 0 - All is well
1586 
#                                           !0  - Error
1587 
#
1588 
# Returns         : Nothing
1589 
#
1590 
sub LogTxError
1591 
{
1592 
    my ($state) = $@;
1593 
    if ( $state )
1594 
    {
5398 dpurdie 1595 
        $statistics{linkErrors}++ unless($comError);
3515 dpurdie 1596 
        $comError++;
5398 dpurdie 1597 
        $statistics{state} = 'No Communication';
3515 dpurdie 1598 
    }
1599 
    elsif ( $comError )
1600 
    {
1601 
        $logger->warn("Communication Restored");
1602 
        $comError = 0;
5398 dpurdie 1603 
        $statistics{state} = 'OK';
3515 dpurdie 1604 
    }
1605 
}
1606 
 
1607 
 
1608 
#-------------------------------------------------------------------------------
1038 dpurdie 1609 
# Function        : Error, Verbose, Warning
1610 
#
1611 
# Description     : Support for JatsRmApi
1612 
#
1613 
# Inputs          : Message
1614 
#
1615 
# Returns         : Nothing
1616 
#
1617 
sub Error
1618 
{
1619 
    $logger->err("@_");
1620 
}
1621 
 
1622 
sub Verbose
1623 
{
1042 dpurdie 1624 
    $logger->verbose2("@_");
1038 dpurdie 1625 
}
1626 
 
1627 
sub Warning
1628 
{
1629 
    $logger->warn("@_");
1630 
}
1631 
 
1632 
 
1633 
 
1634