Subversion Repositories DevTools

Rev

Rev 1038 | Rev 1042 | 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;
48 
my $tagDirTime = 0;
49 
my $lastDirScan = 0;
50 
my $lastReleaseScan = 0;
1040 dpurdie 51 
my $releaseScanMode = 0;
52 
my $lastTagListScan = 0;
1038 dpurdie 53 
my $transferred;
54 
my $mtimeConfig = 0;
55 
my $conf;
56 
my $extraPkgs;
1040 dpurdie 57 
my $excludePkgs;
58 
my %releaseData;
1038 dpurdie 59 
 
60 
#
61 
#   Describe config uration parameters
62 
#
63 
my %cdata = (
64 
    '.ignore'         => {'pkg\.(.+)' => 'pkgs' },
65 
    'piddir'          => {'mandatory' => 1    , 'fmt' => 'dir'},
66 
    'sleep'           => {'default' => 5      , 'fmt' => 'period'},
67 
    'dpkg_archive'    => {'mandatory' => 1    , 'fmt' => 'dir'},
68 
    'logfile'         => {'mandatory' => 1    , 'fmt' => 'vfile'},
69 
    'logfile.size'    => {'default' => '1M'   , 'fmt' => 'size'},
70 
    'logfile.count'   => {'default' => 9      , 'fmt' => 'int'},
71 
    'verbose'         => {'default' => 0      , 'fmt' => 'int'},
72 
    'user'            => {'mandatory' => 1    , 'fmt' => 'text'},
73 
    'hostname'        => {'mandatory' => 1    , 'fmt' => 'text'},
74 
    'identity'        => {'mandatory' => 1    , 'fmt' => 'file'},
75 
    'bindir'          => {'mandatory' => 1    , 'fmt' => 'text'},
76 
    'tagdir'          => {'mandatory' => 1    , 'fmt' => 'dir'},
77 
    'forcedirscan'    => {'default' => 100    , 'fmt' => 'period'},
78 
    'tagage'          => {'default' => '10m'  , 'fmt' => 'period'},
1040 dpurdie 79 
    'tagListUpdate'   => {'default' => '1h'  , 'fmt' => 'period'},
1038 dpurdie 80 
    'synctime'        => {'default' => '2h'   , 'fmt' => 'period'},
1040 dpurdie 81 
    'syncretry'       => {'default' => '5m'   , 'fmt' => 'period'},
1038 dpurdie 82 
    'project'         => {'mandatory' => 0    , 'fmt' => 'int_list'},
83 
    'release'         => {'mandatory' => 0    , 'fmt' => 'int_list'},
84 
    'writewindow'     => {'default' => '3h'   , 'fmt' => 'period'},
85 
    'maxpackages'     => {'default' => 5      , 'fmt' => 'int'},
86 
    'deletePackages'  => {'default' => 0      , 'fmt' => 'bool'},
87 
);
88 
 
89 
 
90 
#
91 
#   Read in the configuration
92 
#       Set up a logger
93 
#       Write a pidfile - thats not used
94 
readConfig();
95 
Utils::writepid($conf);
96 
$logger->logmsg("Starting...");
97 
sighandlers($conf);
98 
 
99 
#
100 
#   Main processing loop
101 
#   Will exit when terminated by parent
102 
#
103 
while ( 1 )
104 
{
105 
    $logger->verbose3("Processing");
106 
    $now = time();
1040 dpurdie 107 
 
1038 dpurdie 108 
    $transferred = {};
109 
    readConfig();
110 
    processReleaseList();
111 
    processTags();
1040 dpurdie 112 
    maintainTagList();
113 
    %releaseData = ();
114 
 
1038 dpurdie 115 
    sleep( $conf->{'sleep'} );
116 
    waitpid(-1, WNOHANG);                           # Reap dead children
117 
}
118 
$logger->logmsg("Child End");
119 
exit 0;
120 
 
121 
#-------------------------------------------------------------------------------
122 
# Function        : readConfig
123 
#
124 
# Description     : Re read the config file if it modification time has changed
125 
#
126 
# Inputs          : Nothing
127 
#
128 
# Returns         : Nothing
129 
#
130 
sub readConfig
131 
{
132 
    my ($mtime) = Utils::mtime($ARGV[0]);
133 
    if ( $mtimeConfig != $mtime )
134 
    {
135 
        $logger->logmsg("Reading config file: $ARGV[0]");
136 
        $mtimeConfig = $mtime;
137 
        my $errors;
138 
        ($conf, $errors) = Utils::readconf ( $ARGV[0], \%cdata );
139 
        if ( scalar @{$errors} > 0 )
140 
        {
141 
            warn "$_\n" foreach (@{$errors});
142 
            die ("Config contained errors\n");
143 
        }
144 
 
145 
        #
146 
        #   Reset some information
147 
        #   Create a new logger
148 
        #
149 
        $logger = Logger->new($conf);
150 
        $conf->{logger} = $logger;
151 
        $conf->{'pidfile'} = $conf->{'piddir'} . '/' . $name . '.pid';
152 
        $logger->verbose("Log Levl: $conf->{verbose}");
153 
 
154 
        #
155 
        #   Extract extra package config
156 
        #
157 
        $extraPkgs = {};
1040 dpurdie 158 
        $excludePkgs = {};
1038 dpurdie 159 
        while (my($key, $data) = each ( %{$conf->{pkgs}} ))
160 
        {
1040 dpurdie 161 
            if ( $data eq 'EXCLUDE' )
162 
            {
163 
                $excludePkgs->{$key} = 1;
164 
                $logger->verbose("Exclude Pkg: $key");
165 
            }
166 
            else
167 
            {
168 
                $extraPkgs->{$key}{$data} = 1;
169 
                $logger->verbose("Extra Pkg: $key -> $data");
170 
            }
1038 dpurdie 171 
        }
172 
    }
173 
}
174 
 
175 
 
176 
#-------------------------------------------------------------------------------
177 
# Function        : processReleaseList
178 
#
179 
# Description     : Process the release list
180 
#                       Determine if its time to process release list
181 
#                       Determine release list
182 
#                       Determine release content
183 
#                       Determine new items
184 
#
185 
# Inputs          : None
186 
#
187 
# Returns         : Nothing
188 
#
189 
sub processReleaseList
190 
{
191 
    #
192 
    #   Time to perform the scan
193 
    #   Will do at startup and every time period there after
194 
    #
1040 dpurdie 195 
    my $wtime = $releaseScanMode ? $conf->{'syncretry'} : $conf->{'synctime'};
196 
    return unless ( $now > ($lastReleaseScan + $wtime ));
1038 dpurdie 197 
    $logger->verbose("processReleaseList");
198 
    $lastReleaseScan = $now;
1040 dpurdie 199 
    $releaseScanMode = 1;                                   # Assume error
1038 dpurdie 200 
 
201 
    #
202 
    #   Get list of packages from Remote site
203 
    #   Invoke a program on the remote site and parse the results
204 
    #
205 
    #     ssh  -i ./ssh/id_rsa_pkg_admin  pkg_admin@10.247.28.57 "./get_plist.pl"
206 
    #
207 
    #   Returned data looks like:
208 
    #   1141792602 GMT(Wed Mar  8 04:36:42 2006) ishieldmodules/11.5.0.cots
209 
    #
210 
    #
211 
    my $remotePkgList;
212 
    my $ph;
1040 dpurdie 213 
    my $tgt_cmd = "$conf->{'bindir'}/get_plist.pl";
214 
    my $ssh_cmd = "ssh -n -o \"BatchMode yes\" -i $conf->{'identity'} $conf->{'user'}\@$conf->{'hostname'} \"$tgt_cmd\" 2>&1";
1038 dpurdie 215 
 
216 
    $logger->verbose2("processReleaseList:ssh_cmd:$ssh_cmd");
217 
    open ($ph, "$ssh_cmd |");
218 
    while ( <$ph> )
219 
    {
220 
        chomp;
221 
        if ( m~^(\d+)\s+GMT\(.*?\)\s+(.+)/(.+)~ )
222 
        {
223 
            $remotePkgList->{$2}{$3} = $1;
224 
            $logger->verbose2("processReleaseList:Data: $_");
225 
        }
226 
        else
227 
        {
228 
            $logger->warn("processReleaseList:Bad Data: $_");
229 
        }
230 
    }
231 
    close ($ph);
232 
    $logger->verbose("processReleaseList:End: $?");
233 
    if ( $? != 0 )
234 
    {
235 
        $logger->warn("Cannot retrieve package list: $?");
236 
        return;
237 
    }
238 
 
239 
    #
240 
    #   Determine the set of packages in the releases to be transferred
241 
    #   Examine
242 
    #
243 
    my @rlist = getReleaseList();
1040 dpurdie 244 
    unless ( @rlist )
245 
    {
246 
        $logger->verbose2("No Releases to Process");
247 
        return;
248 
    }
1038 dpurdie 249 
    my $pkgList = getPkgList(@rlist);
250 
 
251 
    #
252 
    #   Append extra packages
253 
    #   These are packages that are specifically named by the user
254 
    #
255 
    #   Note: If there are symbolic links, then the target of the
256 
    #         link is treated used as the package name
257 
    #
258 
    #         Symlink MUST be within the same directory
259 
    #
260 
    #         Used to transfer jats2_current
261 
    #
262 
    my $pkgLink;
263 
    while ( (my ($pname, $pvers)) = each %{$extraPkgs} ) {
264 
        while ( (my ($pver, $pdata) ) = each %{$pvers} ) {
265 
 
1040 dpurdie 266 
            my $epath = catfile( $conf->{'dpkg_archive'} , $pname, $pver );
1038 dpurdie 267 
            if ( -l $epath )
268 
            {
269 
                my $lver = readlink( $epath );
270 
                if ( ! defined $lver )
271 
                {
272 
                    $logger->warn("Cant resolve symlink: $pname, $pver");
273 
                    next;
274 
                }
275 
 
276 
                if ( $lver =~ m ~/~ )
277 
                {
278 
                    $logger->warn("Won't resolve symlink: $pname, $pver, $lver");
279 
                    next;
280 
                }
281 
                $pkgLink->{$pname}{$pver} = $lver;
282 
                $pdata = $pver;
283 
                $pver = $lver;
284 
            }
285 
 
286 
            $logger->verbose2("Add extra package: $pname, $pver, $pdata");
287 
            $pkgList->{$pname}{$pver} = $pdata;
288 
        }
289 
    }
290 
 
1040 dpurdie 291 
    #
292 
    #   If there are no packages to process, then assume that this is an error
293 
    #   condition. Retry the operation soon.
294 
    #
295 
    unless ( keys %{$pkgList} )
296 
    {
297 
 
298 
        $logger->verbose2("No packages to process");
299 
        return;
300 
    }
301 
 
302 
 
1038 dpurdie 303 
#    while ( (my ($pname, $pvers)) = each %{$pkgList} )
304 
#    {
305 
#        while ( (my ($pver, $ptime) ) = each %{$pvers} )
306 
#        {
307 
#            print "L-- $pname, $pver, $ptime \n";
308 
#
309 
#        }
310 
#    }
311 
 
312 
    #
1040 dpurdie 313 
    #   Delete Excess Packages
1038 dpurdie 314 
    #       Packages not required on the target
315 
    #       KLUDGE: Don't delete links to packages
316 
    #
317 
    my $excessPkgList;
318 
    if ( $conf->{deletePackages} )
319 
    {
320 
        while ( (my ($pname, $pvers)) = each %{$remotePkgList} )
321 
        {
322 
            while ( (my ($pver, $pdata) ) = each %{$pvers} )
323 
            {
324 
                if ( !exists $pkgList->{$pname}{$pver} )
325 
                {
326 
                    if ( exists $pkgLink->{$pname}{$pver} )
327 
                    {
328 
                        $logger->verbose2("Keep Excess package-link: ${pname}/${pver}");
329 
                        next;
330 
                    }
1040 dpurdie 331 
 
332 
                    if ( exists $excludePkgs->{$pname} )
333 
                    {
334 
                        $logger->verbose2("Keep Excluded package: ${pname}");
335 
                        next;
336 
                    }
337 
 
1038 dpurdie 338 
                    $excessPkgList->{$pname}{$pver} = $pdata;
339 
                    $logger->verbose("Excess package: ${pname}/${pver}");
340 
                }
341 
            }
342 
        }
343 
    }
344 
 
345 
    #
346 
    #   Process the remote list and the local list
347 
    #   The remote time-stamp is the modification time of the packages descpkg file
348 
    #
349 
    #   Mark for transfer packages that
1040 dpurdie 350 
    #       Are in the local set but not the remote set
1038 dpurdie 351 
    #       Have a different time stamp
352 
    #
353 
    #   Ignore packages not in the local archive
354 
    #   Ignore packages that don't have a descpkg
355 
    #   Ignore packages that are writable - still being formed
356 
    #
357 
    my $needPkgList;
358 
    while ( (my ($pname, $pvers)) = each %{$pkgList} )
359 
    {
1040 dpurdie 360 
        #
361 
        #   Ignore excluded packages
362 
        #
363 
        next if ( exists $excludePkgs->{$pname} );
364 
 
1038 dpurdie 365 
        while ( (my ($pver, $pdata) ) = each %{$pvers} )
366 
        {
367 
            my $tmtime = $remotePkgList->{$pname}{$pver} || 0;
368 
 
369 
            # Package is present in both list
1040 dpurdie 370 
            my ($mtime, $mode) = Utils::mtime( catfile( $conf->{'dpkg_archive'} , $pname, $pver, 'descpkg' ));
1038 dpurdie 371 
            if ( $mtime == 0 )
372 
            {
373 
                # PackageVersion not in local archive (at least the descpkg file is not)
374 
                # Skip now - will pick it up later
375 
                $logger->verbose("Package not in dpkg_archive: $pname, $pver");
376 
                next;
377 
            }
378 
 
379 
            if ( $mode & 0222 )
380 
            {
381 
                # Descpkg file is writable
382 
                # Package may be in the process of being created
383 
                # If the package has been wriatble for a long time, then
384 
                # consider for transfer
385 
                my $age = $now - $mtime;
386 
                if ( $age < ($conf->{'writewindow '} || 600) )
387 
                {
388 
                    $logger->verbose("Package is writable: $pname, $pver, ", $now - $mtime);
389 
                    next;
390 
                }
391 
            }
392 
 
393 
            if ( $mtime != $tmtime )
394 
            {
395 
                # Package not present on target, or timestamps differ
396 
                $logger->verbose("Package Needs to be transferred: $pname, $pver, $mtime, $tmtime");
397 
                $needPkgList->{$pname}{$pver} = $pdata;
398 
                next;
399 
            }
400 
        }
401 
    }
402 
 
403 
    #
404 
    #   Debug output only
405 
    #   Display what we need to transfer
406 
    #
407 
    if ( $conf->{verbose} > 2 )
408 
    {
409 
        while ( (my ($pname, $pvers)) = each %{$needPkgList} )
410 
        {
411 
            while ( (my ($pver, $pdata) ) = each %{$pvers} )
412 
            {
413 
                $logger->verbose("Need to transfer: $pname, $pver, $pdata");
414 
            }
415 
        }
416 
    }
417 
 
418 
    #
419 
    #   Time to do the real work
420 
    #   Transfer packages and delete excess packages
421 
    #   Note: Perform the transfers first
422 
    #         Limit the number of packages processed in one pass
423 
    #
424 
    my $txcount = $conf->{maxpackages};
425 
 
426 
    #
427 
    #   Transfer packages that we have identified
428 
    #
429 
    send_pkgs:
430 
    while ( (my ($pname, $pvers)) = each %{$needPkgList} )
431 
    {
432 
        while ( (my ($pver, $pdata) ) = each %{$pvers} )
433 
        {
434 
            transferPackage ($pname, $pver, $pdata);
435 
            if ( --$txcount <= 0 )
436 
            {
437 
                $logger->warn("Max transfer count exceeded");
438 
                $lastReleaseScan = 0;
439 
                last send_pkgs;
440 
            }
441 
        }
442 
    }
443 
 
444 
    #
445 
    #   Delete packages that have been identified as excess
446 
    #
447 
    delete_pkgs:
448 
    while ( (my ($pname, $pvers)) = each %{$excessPkgList} )
449 
    {
450 
        while ( (my ($pver, $pdata) ) = each %{$pvers} )
451 
        {
452 
            deletePackage ($pname, $pver);
453 
            if ( --$txcount <= 0 )
454 
            {
455 
                $logger->warn("Max transfer count exceeded");
456 
                $lastReleaseScan = 0;
457 
                last delete_pkgs;
458 
            }
459 
        }
460 
    }
461 
 
462 
    #
463 
    #   Send package list to the target
464 
    #
465 
    sendPackageList ($pkgList);
1040 dpurdie 466 
 
467 
    #
468 
    #   On a successful transfer
469 
    #       Force tag processing
470 
    #       Set scan Mode to normal
471 
    #
472 
    $tagDirTime = 0;
473 
    $releaseScanMode = 0;
1038 dpurdie 474 
}
475 
 
476 
#-------------------------------------------------------------------------------
477 
# Function        : sendPackageList
478 
#
479 
# Description     : Transfer package list to the target
480 
#
481 
# Inputs          : $pkgList            - Ref to hash of package names and versions
482 
#
1040 dpurdie 483 
# Returns         : Nothing
484 
#                   Don't really care about any errors from this process
485 
#                   Its not essential
1038 dpurdie 486 
#
487 
sub sendPackageList
488 
{
489 
    my ($pkgList) = @_;
490 
    my ($fh, $filename) = tempfile( "/tmp/blat.$$.XXXX", SUFFIX => '.txt');
491 
    $logger->verbose("sendPackageList:TmpFile: $filename");
492 
 
493 
    #
494 
    #   Create a temp file with data
495 
    #
496 
    foreach my $pname ( sort keys %{$pkgList} )
497 
    {
498 
        foreach my $pver ( sort keys %{$pkgList->{$pname}} )
499 
        {
500 
            print $fh "$pname/$pver\n";
501 
        }
502 
    }
503 
    close $fh;
504 
 
505 
    #
506 
    #   Transfer to target
507 
    #   Create the process pipe to transfer the file
508 
    #   gzip the file and pipe the result through a ssh session to the target machine
509 
    #   gzip -c filename |  ssh  -i $IDENTITY  pkg_admin@${TARGET_HOST} "./receive_file filename"
510 
    #
511 
    my $ph;
512 
    my $gzip_cmd = "gzip --no-name -c \"$filename\"";
1040 dpurdie 513 
    my $tgt_cmd = "$conf->{'bindir'}/receive_file \"ArchiveList\"";
514 
    my $ssh_cmd = "ssh -o \"BatchMode yes\" -i $conf->{'identity'} $conf->{'user'}\@$conf->{'hostname'} \"$tgt_cmd\" 2>&1";
1038 dpurdie 515 
 
516 
    $logger->verbose2("sendPackageList:gzip_cmd:$gzip_cmd");
517 
    $logger->verbose2("sendPackageList:tgt_cmd:$tgt_cmd");
518 
    $logger->verbose2("sendPackageList:ssh_cmd:$ssh_cmd");
519 
 
520 
    open ($ph, "$gzip_cmd | $ssh_cmd |");
521 
    while ( <$ph> )
522 
    {
523 
        chomp;
524 
        $logger->verbose2("sendPackageList:Data: $_");
525 
    }
526 
    close ($ph);
527 
    $logger->verbose("sendPackageList:End: $?");
528 
    unlink $filename;
529 
}
530 
 
531 
 
532 
#-------------------------------------------------------------------------------
533 
# Function        : getPkgList
534 
#
535 
# Description     : Determine a set of package versions within the list
536 
#                   of provided releases
537 
#
538 
# Inputs          : @rlist              - A list of releases to examine
539 
#
540 
# Returns         : Ref to a hask of package versions
541 
#
542 
sub getPkgList
543 
{
544 
    my %pdata;
545 
    my $RM_DB;
546 
    connectRM(\$RM_DB);
547 
    $logger->verbose("getPkgList");
548 
 
549 
    #
550 
    #   Determine the releases that are in this project
551 
    #   Build up an sql query
552 
    #
553 
    my @m_rlist;
554 
    push @m_rlist,"rc.RTAG_ID=$_" foreach ( @_ );
555 
    my $m_rlist = join ' OR ', @m_rlist;
556 
    my $m_sqlstr = "SELECT DISTINCT pv.PV_ID, pkg.PKG_NAME, pv.PKG_VERSION" .
557 
                    " FROM RELEASE_MANAGER.RELEASE_CONTENT rc, RELEASE_MANAGER.PACKAGE_VERSIONS pv, RELEASE_MANAGER.PACKAGES pkg" .
558 
                    " WHERE ( $m_rlist ) AND rc.PV_ID = pv.PV_ID AND pv.PKG_ID = pkg.PKG_ID" .
559 
                    " ORDER by PKG_NAME DESC";
560 
    $logger->verbose3("getPkgList:Sql:$m_sqlstr");
561 
 
562 
    my $sth = $RM_DB->prepare($m_sqlstr);
563 
    if ( defined($sth) )
564 
    {
565 
        if ( $sth->execute( ) )
566 
        {
567 
            if ( $sth->rows )
568 
            {
569 
                while (my @row = $sth->fetchrow_array )
570 
                {
571 
                    $logger->verbose2("getPkgList:Data:@row");
572 
                    $pdata{$row[1]}{$row[2]} = 1;
573 
                }
574 
            }
575 
            $sth->finish();
576 
        }
577 
    }
578 
    else
579 
    {
580 
        $logger->warn("getPkgList: SQL Prepare failure");
581 
    }
582 
   return \%pdata;
583 
}
584 
 
585 
 
586 
#-------------------------------------------------------------------------------
587 
# Function        : getReleaseList
588 
#
589 
# Description     : Determine the list of releases to be proccessed
1040 dpurdie 590 
#                   From:
591 
#                       Convert projects to a list of releases
592 
#                       Configured list of releases
1038 dpurdie 593 
#
594 
# Inputs          : None
595 
#
596 
# Returns         : A list of releases to be processed
597 
#
598 
sub getReleaseList
599 
{
600 
    my $RM_DB;
601 
    my %rlist;
602 
    $logger->verbose("getReleaseList");
603 
 
604 
    #
1040 dpurdie 605 
    #   Cache data
606 
    #   Only for one cycle of the main loop
607 
    #
608 
    if ( exists $releaseData{getReleaseList} )
609 
    {
610 
        $logger->verbose3("getReleaseList:Cache hit");
611 
        return @{$releaseData{getReleaseList}};
612 
    }
613 
 
614 
    #
1038 dpurdie 615 
    #   Convert list of projects into a list of releases
616 
    #
617 
    my @plist = split /[,\s]+/, $conf->{'project'} || '';
618 
    if ( @plist )
619 
    {
620 
        #
621 
        #   Determine the releases that are in this project
622 
        #   Build up an sql query
623 
        #
624 
        connectRM(\$RM_DB);
625 
        my @m_plist;
626 
        push @m_plist,"PROJ_ID=$_" foreach ( @plist );
627 
        my $m_plist = join ' OR ', @m_plist;
628 
        my $m_sqlstr = "SELECT rt.RTAG_ID" .
629 
                    " FROM RELEASE_MANAGER.RELEASE_TAGS rt" .
630 
                    " WHERE ( $m_plist ) AND rt.OFFICIAL != 'A' AND rt.OFFICIAL != 'Y'";
631 
 
632 
        $logger->verbose3("getReleaseList:Sql:$m_sqlstr");
633 
        my $sth = $RM_DB->prepare($m_sqlstr);
634 
        if ( defined($sth) )
635 
        {
636 
            if ( $sth->execute( ) )
637 
            {
638 
                if ( $sth->rows )
639 
                {
640 
                    while (my @row = $sth->fetchrow_array )
641 
                    {
642 
                        $logger->verbose2("getReleaseList:Data:@row");
643 
                        $rlist{$row[0]} = 1;
644 
                    }
645 
                }
646 
                $sth->finish();
647 
            }
648 
        }
649 
        else
650 
        {
651 
            $logger->warn("getReleaseList: SQL Prepare failure");
652 
        }
653 
    }
654 
 
655 
    #
656 
    #   Add in the user specified list of releases
657 
    #
658 
    my @rlist = split /[,\s]+/, $conf->{'release'} || '';
659 
    $rlist{$_} = 1 foreach(@rlist);
660 
 
661 
    #
662 
    #   Sort for pretty display only
663 
    #
1040 dpurdie 664 
    @{$releaseData{getReleaseList}} = sort {$a <=> $b} keys %rlist;
665 
 
666 
    return @{$releaseData{getReleaseList}};
1038 dpurdie 667 
}
668 
 
1040 dpurdie 669 
#-------------------------------------------------------------------------------
670 
# Function        : maintainTagList
671 
#
672 
# Description     : Maintain a data structure for the maintenance of the
673 
#                   tags directory
674 
#
675 
# Inputs          : None
676 
#
677 
# Returns         : Nothing
678 
#
679 
sub maintainTagList
680 
{
681 
    #
682 
    #   Time to perform the scan
683 
    #   Will do at startup and every time period there after
684 
    #
685 
    return unless ( $now > ($lastTagListScan + $conf->{tagListUpdate} ));
686 
    $logger->verbose("maintainTagList");
687 
    $lastTagListScan = $now;
1038 dpurdie 688 
 
1040 dpurdie 689 
    #
690 
    #   Get list of things
691 
    #
692 
    my %config;
693 
    %{$config{projects}} = map { $_ => 1 } split (/[,\s]+/, $conf->{'project'} || '');
694 
    %{$config{releases}} = map { $_ => 1 } getReleaseList();
695 
 
696 
    #
697 
    #   Save data
698 
    #
699 
    my $dump =  Data::Dumper->new([\%config], [qw(*config)]);
700 
#print $dump->Dump;
701 
#$dump->Reset;
702 
 
703 
    #
704 
    #   Save config data
705 
    #
706 
    my $conf_file = catfile( $conf->{'tagdir'},'.config' );
707 
    $logger->verbose3("maintainTagList: Writting $conf_file");
708 
 
709 
    my $fh;
710 
    open ( $fh, '>', $conf_file ) or $logger->err("Can't create $conf_file: $!");
711 
    print $fh $dump->Dump;
712 
    close $fh;
713 
}
714 
 
715 
 
1038 dpurdie 716 
#-------------------------------------------------------------------------------
717 
# Function        : processTags
718 
#
719 
# Description     : Process tags and send marked package versions to the target
720 
#                       Determine if new tags are present
721 
#                       Process each tag
722 
#
723 
# Inputs          : None
724 
#
725 
# Returns         : Nothing
726 
#
727 
sub processTags
728 
{
729 
    #
730 
    #   Determine if new tags are present by examining the time
731 
    #   that the directory was last modified.
732 
    #
733 
    #   Allow for a forced scan to catch packages that did not transfer
734 
    #   on the first attempt
735 
    #
736 
    my ($mtime) = Utils::mtime($conf->{'tagdir'} );
737 
    if ( ($mtime > $tagDirTime) || ($now > ($lastDirScan + $conf->{'forcedirscan'})) )
738 
    {
739 
        $logger->verbose2("processTags: ", $mtime - $tagDirTime, $now - $lastDirScan);
740 
        $tagDirTime = $mtime;
741 
        $lastDirScan = $now;
742 
 
743 
        my $dh;
744 
        unless (opendir($dh, $conf->{'tagdir'}))
745 
        {
746 
            $logger->warn ("can't opendir $conf->{'tagdir'}: $!");
747 
            return;
748 
        }
749 
 
750 
        #
751 
        #   Process each entry
752 
        #   Ignore those that start with a .
753 
        #
754 
        while (my $tag = readdir($dh) )
755 
        {
756 
            next if ( $tag =~ m~^\.~ );
757 
            my $file = "$conf->{'tagdir'}/$tag";
758 
            next unless ( -f $file );
759 
            next if ( $tag  eq 'ReleaseList' );
760 
 
761 
            if ( $tag =~ m~(.+)::(.+)~  )
762 
            {
763 
                my $package = $1;
764 
                my $version = $2;
765 
                if ( transferPackage( $package, $version ))
766 
                {
767 
                    unlink $file;
768 
                }
769 
                else
770 
                {
771 
                    my ($mtime) = Utils::mtime( $file );
772 
                    if ( $now - $mtime > $conf->{'tagage'} )
773 
                    {
774 
                        $logger->warn ("Delete unsatisfied tag: $tag");
775 
                        unlink $file;
776 
                    }
777 
                }
778 
            }
779 
        }
780 
        closedir $dh;
781 
    }
782 
}
783 
 
784 
#-------------------------------------------------------------------------------
785 
# Function        : transferPackage
786 
#
787 
# Description     : Transfer specified package to target system
788 
#
789 
# Inputs          : $pname          - Name of the package
790 
#                   $pver           - Package version
791 
#                   $plink          - (optional) Symlink in same package
792 
#
793 
# Returns         : true    - Package transferred
794 
#                   false   - Package not transferred
795 
#
796 
sub transferPackage
797 
{
798 
    my ($pname, $pver, $plink ) = @_;
799 
    my $rv = 0;
800 
    $logger->logmsg("transferPackage: @_");
801 
 
802 
    #
1040 dpurdie 803 
    #   Do not transfer excluded files
804 
    #
805 
    if ( exists $excludePkgs->{$pname} )
806 
    {
807 
        $logger->verbose("transferPackage: Excluded package not transferred");
808 
        return 1;
809 
    }
810 
 
811 
    #
1038 dpurdie 812 
    #   plink of 1 is not a symlink
813 
    #
814 
    $plink = undef if ( defined($plink) && $plink eq '1' );
815 
 
816 
    #
817 
    #   If its been transferred in the current scan, then
818 
    #   indicate that all is well
819 
    #
820 
    if ( $transferred->{$pname}{$pver}  )
821 
    {
822 
        $logger->verbose("transferPackage: Already transferred");
823 
        return 1;
824 
    }
825 
 
1040 dpurdie 826 
    my $sfile = catfile( $conf->{'dpkg_archive'} , $pname, $pver );
1038 dpurdie 827 
    unless ( -d $sfile )
828 
    {
829 
        $logger->warn("transferPackage:Package not found: $pname, $pver");
830 
        return $rv;
831 
    }
832 
 
833 
    #
834 
    #   Create the process piple to transfer the package
835 
    #   Tar the directory and pipe the result through a ssh session to
836 
    #   the target machine
837 
    #   gtar -czf - -C "$dpkg/${pname}/${pver}" . |  ssh  -i $IDENTITY  pkg_admin@${TARGET_HOST} "./receive_package ${rx_opts} \"$pname\" \"$pver\""
838 
    #
839 
    my $ph;
840 
    my $tar_cmd = "gtar -czf - -C \"$sfile\" .";
841 
    my $tgt_opts = defined($plink) ? "\"-L$plink\"" : '';
1040 dpurdie 842 
    my $tgt_cmd = "$conf->{'bindir'}/receive_package $tgt_opts \"$pname\" \"$pver\"";
843 
    my $ssh_cmd = "ssh -o \"BatchMode yes\" -i $conf->{'identity'} $conf->{'user'}\@$conf->{'hostname'} \"$tgt_cmd\" 2>&1";
1038 dpurdie 844 
 
845 
    $logger->verbose2("transferPackage:tar_cmd:$tar_cmd");
846 
    $logger->verbose2("transferPackage:tgt_cmd:$tgt_cmd");
847 
    $logger->verbose2("transferPackage:ssh_cmd:$ssh_cmd");
848 
 
849 
    open ($ph, "$tar_cmd | $ssh_cmd |");
850 
    while ( <$ph> )
851 
    {
852 
        chomp;
853 
        $logger->verbose2("transferPackage:Data: $_");
854 
    }
855 
    close ($ph);
856 
    $logger->verbose("transferPackage:End: $?");
857 
    if ( $? == 0 )
858 
    {
859 
        #
860 
        #   Mark has having been transferred in the current cycle
861 
        #
862 
        $transferred->{$pname}{$pver} = 1;
863 
        $rv = 1;
864 
    }
865 
    else
866 
    {
867 
        $logger->warn("transferPackage:Transfer Error: $pname, $pver, $?");
868 
    }
869 
    return $rv;
870 
}
871 
 
872 
#-------------------------------------------------------------------------------
873 
# Function        : deletePackage
874 
#
875 
# Description     : Delete specified package to target system
876 
#
877 
# Inputs          : $pname          - Name of the package
878 
#                   $pver           - Package version
879 
#
880 
# Returns         : true    - Package transferred
881 
#                   false   - Package not transferred
882 
#
883 
sub deletePackage
884 
{
885 
    my ($pname, $pver ) = @_;
886 
    my $rv = 0;
887 
    $logger->logmsg("deletePackage: @_");
888 
 
889 
    #
890 
    #   Create the process pipe to delete the package
891 
    #   Tar the directory and pipe the result through a ssh session to
892 
    #   the target machine
893 
    #   gtar -czf - -C "$dpkg/${pname}/${pver}" . |  ssh  -i $IDENTITY  pkg_admin@${TARGET_HOST} "./receive_package ${rx_opts} \"$pname\" \"$pver\""
894 
    #
895 
    my $ph;
1040 dpurdie 896 
    my $tgt_cmd = "$conf->{'bindir'}/delete_package \"$pname\" \"$pver\"";
897 
    my $ssh_cmd = "ssh -o \"BatchMode yes\" -i $conf->{'identity'} $conf->{'user'}\@$conf->{'hostname'} \"$tgt_cmd\" 2>&1";
1038 dpurdie 898 
 
1040 dpurdie 899 
    $logger->verbose2("deletePackage:tgt_cmd:$tgt_cmd");
900 
    $logger->verbose2("deletePackage:ssh_cmd:$ssh_cmd");
1038 dpurdie 901 
 
902 
    open ($ph, "$ssh_cmd |");
903 
    while ( <$ph> )
904 
    {
905 
        chomp;
906 
        $logger->verbose2("deletePackage:Data: $_");
907 
    }
908 
    close ($ph);
909 
    $logger->verbose("deletePackage:End: $?");
910 
    if ( $? == 0 )
911 
    {
912 
        $rv = 1;
913 
    }
914 
    else
915 
    {
916 
        $logger->warn("deletePackage:Error: $pname, $pver, $?");
917 
    }
918 
    return $rv;
919 
}
920 
 
921 
 
922 
#-------------------------------------------------------------------------------
923 
# Function        : sighandlers
924 
#
925 
# Description     : Install signal handlers
926 
#
927 
# Inputs          : $conf           - System config
928 
#
929 
# Returns         : Nothing
930 
#
931 
sub sighandlers
932 
{
933 
	my $conf = shift;
934 
	my $logger = $conf->{logger};
935 
 
936 
	$SIG{TERM} = sub {
937 
		# On shutdown
938 
		$logger->logmsg('Received SIGTERM. Shutting down....' );
939 
		unlink $conf->{'pidfile'} if (-f $conf->{'pidfile'});
940 
		exit 0;
941 
	};
942 
 
943 
	$SIG{HUP} = sub {
944 
		# On logrotate
945 
		$logger->logmsg('Received SIGHUP.');
946 
		$logger->rotatelog();
947 
	};
948 
 
949 
	$SIG{USR1} = sub {
950 
		# On Force Archive Sync
951 
		$logger->logmsg('Received SIGUSR1.');
952 
        $lastReleaseScan = 0
953 
	};
954 
 
955 
    $SIG{__WARN__} = sub { $logger->warn("@_") };
956 
    $SIG{__DIE__} = sub { $logger->err("@_") };
957 
 
958 
 
959 
}
960 
 
961 
#-------------------------------------------------------------------------------
962 
# Function        : Error, Verbose, Warning
963 
#
964 
# Description     : Support for JatsRmApi
965 
#
966 
# Inputs          : Message
967 
#
968 
# Returns         : Nothing
969 
#
970 
sub Error
971 
{
972 
    $logger->err("@_");
973 
}
974 
 
975 
sub Verbose
976 
{
977 
    $logger->verbose("@_");
978 
}
979 
 
980 
sub Warning
981 
{
982 
    $logger->warn("@_");
983 
}
984 
 
985 
 
986 
 
987