Subversion Repositories DevTools

Rev

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