Subversion Repositories DevTools

Rev

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