Subversion Repositories DevTools

Rev

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