Subversion Repositories DevTools

Rev

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