Subversion Repositories DevTools

Rev

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