Subversion Repositories DevTools

Rev

Rev 1038 | Rev 1042 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 1038 Rev 1040
Line 16... Line 16...
16 
require 5.008_002;
 16 
require 5.008_002;
17 
use strict;
 17 
use strict;
18 
use warnings;
 18 
use warnings;
19 
use Getopt::Long;
 19 
use Getopt::Long;
20 
use File::Basename;
 20 
use File::Basename;
- 
 
 21 
use Data::Dumper;
- 
 
 22 
use File::Spec::Functions;
21 
use POSIX ":sys_wait_h";
 23 
use POSIX ":sys_wait_h";
22 
use File::Temp qw/tempfile/;
 24 
use File::Temp qw/tempfile/;
23 
 
 25 
 
24 
use FindBin;                                    # Determine the current directory
 26 
use FindBin;                                    # Determine the current directory
25 
use lib "$FindBin::Bin/lib";                    # Allow local libraries
 27 
use lib "$FindBin::Bin/lib";                    # Allow local libraries
Line 44... Line 46...
44 
   $name =~ s~.conf$~~;
 46 
   $name =~ s~.conf$~~;
45 
my $now = 0;
 47 
my $now = 0;
46 
my $tagDirTime = 0;
 48 
my $tagDirTime = 0;
47 
my $lastDirScan = 0;
 49 
my $lastDirScan = 0;
48 
my $lastReleaseScan = 0;
 50 
my $lastReleaseScan = 0;
- 
 
 51 
my $releaseScanMode = 0;
- 
 
 52 
my $lastTagListScan = 0;
49 
my $transferred;
 53 
my $transferred;
50 
my $mtimeConfig = 0;
 54 
my $mtimeConfig = 0;
51 
my $conf;
 55 
my $conf;
52 
my $extraPkgs;
 56 
my $extraPkgs;
- 
 
 57 
my $excludePkgs;
- 
 
 58 
my %releaseData;
53 
 
 59 
 
54 
#
 60 
#
55 
#   Describe config uration parameters
 61 
#   Describe config uration parameters
56 
#
 62 
#
57 
my %cdata = (
 63 
my %cdata = (
Line 68... Line 74...
68 
    'identity'        => {'mandatory' => 1    , 'fmt' => 'file'},
 74 
    'identity'        => {'mandatory' => 1    , 'fmt' => 'file'},
69 
    'bindir'          => {'mandatory' => 1    , 'fmt' => 'text'},
 75 
    'bindir'          => {'mandatory' => 1    , 'fmt' => 'text'},
70 
    'tagdir'          => {'mandatory' => 1    , 'fmt' => 'dir'},
 76 
    'tagdir'          => {'mandatory' => 1    , 'fmt' => 'dir'},
71 
    'forcedirscan'    => {'default' => 100    , 'fmt' => 'period'},
 77 
    'forcedirscan'    => {'default' => 100    , 'fmt' => 'period'},
72 
    'tagage'          => {'default' => '10m'  , 'fmt' => 'period'},
 78 
    'tagage'          => {'default' => '10m'  , 'fmt' => 'period'},
- 
 
 79 
    'tagListUpdate'   => {'default' => '1h'  , 'fmt' => 'period'},
73 
    'synctime'        => {'default' => '2h'   , 'fmt' => 'period'},
 80 
    'synctime'        => {'default' => '2h'   , 'fmt' => 'period'},
- 
 
 81 
    'syncretry'       => {'default' => '5m'   , 'fmt' => 'period'},
74 
    'project'         => {'mandatory' => 0    , 'fmt' => 'int_list'},
 82 
    'project'         => {'mandatory' => 0    , 'fmt' => 'int_list'},
75 
    'release'         => {'mandatory' => 0    , 'fmt' => 'int_list'},
 83 
    'release'         => {'mandatory' => 0    , 'fmt' => 'int_list'},
76 
    'writewindow'     => {'default' => '3h'   , 'fmt' => 'period'},
 84 
    'writewindow'     => {'default' => '3h'   , 'fmt' => 'period'},
77 
    'maxpackages'     => {'default' => 5      , 'fmt' => 'int'},
 85 
    'maxpackages'     => {'default' => 5      , 'fmt' => 'int'},
78 
    'deletePackages'  => {'default' => 0      , 'fmt' => 'bool'},
 86 
    'deletePackages'  => {'default' => 0      , 'fmt' => 'bool'},
Line 94... Line 102...
94 
#
 102 
#
95 
while ( 1 )
 103 
while ( 1 )
96 
{
 104 
{
97 
    $logger->verbose3("Processing");
 105 
    $logger->verbose3("Processing");
98 
    $now = time();
 106 
    $now = time();
- 
 
 107 
 
99 
    $transferred = {};
 108 
    $transferred = {};
100 
    readConfig();
 109 
    readConfig();
101 
    processReleaseList();
 110 
    processReleaseList();
102 
    processTags();
 111 
    processTags();
- 
 
 112 
    maintainTagList();
- 
 
 113 
    %releaseData = ();
- 
 
 114 
 
103 
    sleep( $conf->{'sleep'} );
 115 
    sleep( $conf->{'sleep'} );
104 
    waitpid(-1, WNOHANG);                           # Reap dead children
 116 
    waitpid(-1, WNOHANG);                           # Reap dead children
105 
}
 117 
}
106 
$logger->logmsg("Child End");
 118 
$logger->logmsg("Child End");
107 
exit 0;
 119 
exit 0;
Line 141... Line 153...
141 
 
 153 
 
142 
        #
 154 
        #
143 
        #   Extract extra package config
 155 
        #   Extract extra package config
144 
        #
 156 
        #
145 
        $extraPkgs = {};
 157 
        $extraPkgs = {};
- 
 
 158 
        $excludePkgs = {};
146 
        while (my($key, $data) = each ( %{$conf->{pkgs}} ))
 159 
        while (my($key, $data) = each ( %{$conf->{pkgs}} ))
147 
        {
 160 
        {
- 
 
 161 
            if ( $data eq 'EXCLUDE' )
- 
 
 162 
            {
- 
 
 163 
                $excludePkgs->{$key} = 1;
- 
 
 164 
                $logger->verbose("Exclude Pkg: $key");
- 
 
 165 
            }
- 
 
 166 
            else
- 
 
 167 
            {
148 
            $extraPkgs->{$key}{$data} = 1;
 168 
                $extraPkgs->{$key}{$data} = 1;
149 
            $logger->verbose("Extra Pkg: $key -> $data");
 169 
                $logger->verbose("Extra Pkg: $key -> $data");
- 
 
 170 
            }
150 
        }
 171 
        }
151 
    }
 172 
    }
152 
}
 173 
}
153 
 
 174 
 
154 
 
 175 
 
Line 169... Line 190...
169 
{
 190 
{
170 
    #
 191 
    #
171 
    #   Time to perform the scan
 192 
    #   Time to perform the scan
172 
    #   Will do at startup and every time period there after
 193 
    #   Will do at startup and every time period there after
173 
    #
 194 
    #
- 
 
 195 
    my $wtime = $releaseScanMode ? $conf->{'syncretry'} : $conf->{'synctime'};
174 
    return unless ( $now > ($lastReleaseScan + $conf->{'synctime'} ));
 196 
    return unless ( $now > ($lastReleaseScan + $wtime ));
175 
    $logger->verbose("processReleaseList");
 197 
    $logger->verbose("processReleaseList");
176 
    $lastReleaseScan = $now;
 198 
    $lastReleaseScan = $now;
177 
    $tagDirTime = 0;                            # Force tag processing too
 199 
    $releaseScanMode = 1;                                   # Assume error
178 
 
 200 
 
179 
    #
 201 
    #
180 
    #   Get list of packages from Remote site
 202 
    #   Get list of packages from Remote site
181 
    #   Invoke a program on the remote site and parse the results
 203 
    #   Invoke a program on the remote site and parse the results
182 
    #
 204 
    #
Line 186... Line 208...
186 
    #   1141792602 GMT(Wed Mar  8 04:36:42 2006) ishieldmodules/11.5.0.cots
 208 
    #   1141792602 GMT(Wed Mar  8 04:36:42 2006) ishieldmodules/11.5.0.cots
187 
    #
209 
    #
188 
    #
 210 
    #
189 
    my $remotePkgList;
 211 
    my $remotePkgList;
190 
    my $ph;
 212 
    my $ph;
191 
    my $tgt_cmd = "$conf->{'bindir'}/get_plist.pl 2>&1";
 213 
    my $tgt_cmd = "$conf->{'bindir'}/get_plist.pl";
192 
    my $ssh_cmd = "ssh -i $conf->{'identity'} $conf->{'user'}\@$conf->{'hostname'} \"$tgt_cmd\" 2>&1";
 214 
    my $ssh_cmd = "ssh -n -o \"BatchMode yes\" -i $conf->{'identity'} $conf->{'user'}\@$conf->{'hostname'} \"$tgt_cmd\" 2>&1";
193 
 
 215 
 
194 
    $logger->verbose2("processReleaseList:ssh_cmd:$ssh_cmd");
 216 
    $logger->verbose2("processReleaseList:ssh_cmd:$ssh_cmd");
195 
    open ($ph, "$ssh_cmd |");
 217 
    open ($ph, "$ssh_cmd |");
196 
    while ( <$ph> )
 218 
    while ( <$ph> )
197 
    {
 219 
    {
Line 217... Line 239...
217 
    #
 239 
    #
218 
    #   Determine the set of packages in the releases to be transferred
 240 
    #   Determine the set of packages in the releases to be transferred
219 
    #   Examine
 241 
    #   Examine
220 
    #
 242 
    #
221 
    my @rlist = getReleaseList();
 243 
    my @rlist = getReleaseList();
222 
    return unless ( @rlist );
 244 
    unless ( @rlist )
- 
 
 245 
    {
- 
 
 246 
        $logger->verbose2("No Releases to Process");
- 
 
 247 
        return;
- 
 
 248 
    }
223 
    my $pkgList = getPkgList(@rlist);
 249 
    my $pkgList = getPkgList(@rlist);
224 
 
 250 
 
225 
    #
 251 
    #
226 
    #   Append extra packages
 252 
    #   Append extra packages
227 
    #   These are packages that are specifically named by the user
 253 
    #   These are packages that are specifically named by the user
Line 235... Line 261...
235 
    #
 261 
    #
236 
    my $pkgLink;
 262 
    my $pkgLink;
237 
    while ( (my ($pname, $pvers)) = each %{$extraPkgs} ) {
 263 
    while ( (my ($pname, $pvers)) = each %{$extraPkgs} ) {
238 
        while ( (my ($pver, $pdata) ) = each %{$pvers} ) {
 264 
        while ( (my ($pver, $pdata) ) = each %{$pvers} ) {
239 
 
 265 
 
240 
            my $epath = join ( '/', $conf->{'dpkg_archive'} , $pname, $pver );
 266 
            my $epath = catfile( $conf->{'dpkg_archive'} , $pname, $pver );
241 
            if ( -l $epath )
 267 
            if ( -l $epath )
242 
            {
 268 
            {
243 
                my $lver = readlink( $epath );
 269 
                my $lver = readlink( $epath );
244 
                if ( ! defined $lver )
 270 
                if ( ! defined $lver )
245 
                {
 271 
                {
Line 260... Line 286...
260 
            $logger->verbose2("Add extra package: $pname, $pver, $pdata");
 286 
            $logger->verbose2("Add extra package: $pname, $pver, $pdata");
261 
            $pkgList->{$pname}{$pver} = $pdata;
 287 
            $pkgList->{$pname}{$pver} = $pdata;
262 
        }
 288 
        }
263 
    }
 289 
    }
264 
 
 290 
 
- 
 
 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 
 
265 
#    while ( (my ($pname, $pvers)) = each %{$pkgList} )
 303 
#    while ( (my ($pname, $pvers)) = each %{$pkgList} )
266 
#    {
 304 
#    {
267 
#        while ( (my ($pver, $ptime) ) = each %{$pvers} )
 305 
#        while ( (my ($pver, $ptime) ) = each %{$pvers} )
268 
#        {
 306 
#        {
269 
#            print "L-- $pname, $pver, $ptime \n";
 307 
#            print "L-- $pname, $pver, $ptime \n";
270 
#
 308 
#
271 
#        }
 309 
#        }
272 
#    }
 310 
#    }
273 
 
 311 
 
274 
    #
 312 
    #
275 
    #   Display Excess Packages
 313 
    #   Delete Excess Packages
276 
    #       Packages not required on the target
 314 
    #       Packages not required on the target
277 
    #       KLUDGE: Don't delete links to packages
 315 
    #       KLUDGE: Don't delete links to packages
278 
    #
 316 
    #
279 
    my $excessPkgList;
 317 
    my $excessPkgList;
280 
    if ( $conf->{deletePackages} )
 318 
    if ( $conf->{deletePackages} )
Line 288... Line 326...
288 
                    if ( exists $pkgLink->{$pname}{$pver} )
 326 
                    if ( exists $pkgLink->{$pname}{$pver} )
289 
                    {
 327 
                    {
290 
                        $logger->verbose2("Keep Excess package-link: ${pname}/${pver}");
 328 
                        $logger->verbose2("Keep Excess package-link: ${pname}/${pver}");
291 
                        next;
 329 
                        next;
292 
                    }
 330 
                    }
- 
 
 331 
 
- 
 
 332 
                    if ( exists $excludePkgs->{$pname} )
- 
 
 333 
                    {
- 
 
 334 
                        $logger->verbose2("Keep Excluded package: ${pname}");
- 
 
 335 
                        next;
- 
 
 336 
                    }
- 
 
 337 
 
293 
                    $excessPkgList->{$pname}{$pver} = $pdata;
 338 
                    $excessPkgList->{$pname}{$pver} = $pdata;
294 
                    $logger->verbose("Excess package: ${pname}/${pver}");
 339 
                    $logger->verbose("Excess package: ${pname}/${pver}");
295 
                }
 340 
                }
296 
            }
 341 
            }
297 
        }
 342 
        }
Line 300... Line 345...
300 
    #
 345 
    #
301 
    #   Process the remote list and the local list
 346 
    #   Process the remote list and the local list
302 
    #   The remote time-stamp is the modification time of the packages descpkg file
 347 
    #   The remote time-stamp is the modification time of the packages descpkg file
303 
    #
 348 
    #
304 
    #   Mark for transfer packages that
 349 
    #   Mark for transfer packages that
305 
    #       Are inthe local set but not the remote set
 350 
    #       Are in the local set but not the remote set
306 
    #       Have a different time stamp
 351 
    #       Have a different time stamp
307 
    #
 352 
    #
308 
    #   Ignore packages not in the local archive
 353 
    #   Ignore packages not in the local archive
309 
    #   Ignore packages that don't have a descpkg
 354 
    #   Ignore packages that don't have a descpkg
310 
    #   Ignore packages that are writable - still being formed
 355 
    #   Ignore packages that are writable - still being formed
311 
    #
 356 
    #
312 
    my $needPkgList;
 357 
    my $needPkgList;
313 
    while ( (my ($pname, $pvers)) = each %{$pkgList} )
 358 
    while ( (my ($pname, $pvers)) = each %{$pkgList} )
314 
    {
 359 
    {
- 
 
 360 
        #
- 
 
 361 
        #   Ignore excluded packages
- 
 
 362 
        #
- 
 
 363 
        next if ( exists $excludePkgs->{$pname} );
- 
 
 364 
 
315 
        while ( (my ($pver, $pdata) ) = each %{$pvers} )
 365 
        while ( (my ($pver, $pdata) ) = each %{$pvers} )
316 
        {
 366 
        {
317 
            my $tmtime = $remotePkgList->{$pname}{$pver} || 0;
 367 
            my $tmtime = $remotePkgList->{$pname}{$pver} || 0;
318 
 
 368 
 
319 
            # Package is present in both list
 369 
            # Package is present in both list
320 
            my ($mtime, $mode) = Utils::mtime(join ( '/', $conf->{'dpkg_archive'} , $pname, $pver, 'descpkg' ));
 370 
            my ($mtime, $mode) = Utils::mtime( catfile( $conf->{'dpkg_archive'} , $pname, $pver, 'descpkg' ));
321 
            if ( $mtime == 0 )
 371 
            if ( $mtime == 0 )
322 
            {
 372 
            {
323 
                # PackageVersion not in local archive (at least the descpkg file is not)
 373 
                # PackageVersion not in local archive (at least the descpkg file is not)
324 
                # Skip now - will pick it up later
 374 
                # Skip now - will pick it up later
325 
                $logger->verbose("Package not in dpkg_archive: $pname, $pver");
 375 
                $logger->verbose("Package not in dpkg_archive: $pname, $pver");
Line 411... Line 461...
411 
 
 461 
 
412 
    #
 462 
    #
413 
    #   Send package list to the target
 463 
    #   Send package list to the target
414 
    #
 464 
    #
415 
    sendPackageList ($pkgList);
 465 
    sendPackageList ($pkgList);
- 
 
 466 
 
- 
 
 467 
    #
- 
 
 468 
    #   On a successful transfer
- 
 
 469 
    #       Force tag processing
- 
 
 470 
    #       Set scan Mode to normal
- 
 
 471 
    #
- 
 
 472 
    $tagDirTime = 0;
- 
 
 473 
    $releaseScanMode = 0;
416 
}
 474 
}
417 
 
 475 
 
418 
#-------------------------------------------------------------------------------
 476 
#-------------------------------------------------------------------------------
419 
# Function        : sendPackageList
 477 
# Function        : sendPackageList
420 
#
 478 
#
421 
# Description     : Transfer package list to the target
 479 
# Description     : Transfer package list to the target
422 
#
 480 
#
423 
# Inputs          : $pkgList            - Ref to hash of package names and versions
 481 
# Inputs          : $pkgList            - Ref to hash of package names and versions
424 
#
 482 
#
425 
# Returns         :
483 
# Returns         : Nothing
- 
 
 484 
#                   Don't really care about any errors from this process
- 
 
 485 
#                   Its not essential
426 
#
 486 
#
427 
sub sendPackageList
 487 
sub sendPackageList
428 
{
 488 
{
429 
    my ($pkgList) = @_;
 489 
    my ($pkgList) = @_;
430 
    my ($fh, $filename) = tempfile( "/tmp/blat.$$.XXXX", SUFFIX => '.txt');
 490 
    my ($fh, $filename) = tempfile( "/tmp/blat.$$.XXXX", SUFFIX => '.txt');
Line 448... Line 508...
448 
    #   gzip the file and pipe the result through a ssh session to the target machine
 508 
    #   gzip the file and pipe the result through a ssh session to the target machine
449 
    #   gzip -c filename |  ssh  -i $IDENTITY  pkg_admin@${TARGET_HOST} "./receive_file filename"
 509 
    #   gzip -c filename |  ssh  -i $IDENTITY  pkg_admin@${TARGET_HOST} "./receive_file filename"
450 
    #
 510 
    #
451 
    my $ph;
 511 
    my $ph;
452 
    my $gzip_cmd = "gzip --no-name -c \"$filename\"";
 512 
    my $gzip_cmd = "gzip --no-name -c \"$filename\"";
453 
    my $tgt_cmd = "$conf->{'bindir'}/receive_file \"ArchiveList\" 2>&1";
 513 
    my $tgt_cmd = "$conf->{'bindir'}/receive_file \"ArchiveList\"";
454 
    my $ssh_cmd = "ssh -i $conf->{'identity'} $conf->{'user'}\@$conf->{'hostname'} \"$tgt_cmd\"";
 514 
    my $ssh_cmd = "ssh -o \"BatchMode yes\" -i $conf->{'identity'} $conf->{'user'}\@$conf->{'hostname'} \"$tgt_cmd\" 2>&1";
455 
 
 515 
 
456 
    $logger->verbose2("sendPackageList:gzip_cmd:$gzip_cmd");
 516 
    $logger->verbose2("sendPackageList:gzip_cmd:$gzip_cmd");
457 
    $logger->verbose2("sendPackageList:tgt_cmd:$tgt_cmd");
 517 
    $logger->verbose2("sendPackageList:tgt_cmd:$tgt_cmd");
458 
    $logger->verbose2("sendPackageList:ssh_cmd:$ssh_cmd");
 518 
    $logger->verbose2("sendPackageList:ssh_cmd:$ssh_cmd");
459 
 
 519 
 
Line 525... Line 585...
525 
 
 585 
 
526 
#-------------------------------------------------------------------------------
 586 
#-------------------------------------------------------------------------------
527 
# Function        : getReleaseList
 587 
# Function        : getReleaseList
528 
#
 588 
#
529 
# Description     : Determine the list of releases to be proccessed
 589 
# Description     : Determine the list of releases to be proccessed
- 
 
 590 
#                   From:
- 
 
 591 
#                       Convert projects to a list of releases
- 
 
 592 
#                       Configured list of releases
530 
#
 593 
#
531 
# Inputs          : None
 594 
# Inputs          : None
532 
#
 595 
#
533 
# Returns         : A list of releases to be processed
 596 
# Returns         : A list of releases to be processed
534 
#
 597 
#
Line 537... Line 600...
537 
    my $RM_DB;
 600 
    my $RM_DB;
538 
    my %rlist;
 601 
    my %rlist;
539 
    $logger->verbose("getReleaseList");
 602 
    $logger->verbose("getReleaseList");
540 
 
 603 
 
541 
    #
 604 
    #
- 
 
 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 
    #
542 
    #   Convert list of projects into a list of releases
 615 
    #   Convert list of projects into a list of releases
543 
    #
 616 
    #
544 
    my @plist = split /[,\s]+/, $conf->{'project'} || '';
 617 
    my @plist = split /[,\s]+/, $conf->{'project'} || '';
545 
    if ( @plist )
 618 
    if ( @plist )
546 
    {
 619 
    {
Line 586... Line 659...
586 
    $rlist{$_} = 1 foreach(@rlist);
 659 
    $rlist{$_} = 1 foreach(@rlist);
587 
 
 660 
 
588 
    #
 661 
    #
589 
    #   Sort for pretty display only
 662 
    #   Sort for pretty display only
590 
    #
 663 
    #
591 
    return sort {$a <=> $b} keys %rlist;
 664 
    @{$releaseData{getReleaseList}} = sort {$a <=> $b} keys %rlist;
- 
 
 665 
 
- 
 
 666 
    return @{$releaseData{getReleaseList}};
- 
 
 667 
}
- 
 
 668 
 
- 
 
 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;
- 
 
 688 
 
- 
 
 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;
592 
}
 713 
}
593 
 
 714 
 
594 
 
 715 
 
595 
#-------------------------------------------------------------------------------
 716 
#-------------------------------------------------------------------------------
596 
# Function        : processTags
 717 
# Function        : processTags
Line 677... Line 798...
677 
    my ($pname, $pver, $plink ) = @_;
 798 
    my ($pname, $pver, $plink ) = @_;
678 
    my $rv = 0;
 799 
    my $rv = 0;
679 
    $logger->logmsg("transferPackage: @_");
 800 
    $logger->logmsg("transferPackage: @_");
680 
 
 801 
 
681 
    #
 802 
    #
- 
 
 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 
    #
682 
    #   plink of 1 is not a symlink
 812 
    #   plink of 1 is not a symlink
683 
    #
 813 
    #
684 
    $plink = undef if ( defined($plink) && $plink eq '1' );
 814 
    $plink = undef if ( defined($plink) && $plink eq '1' );
685 
 
 815 
 
686 
    #
 816 
    #
Line 691... Line 821...
691 
    {
 821 
    {
692 
        $logger->verbose("transferPackage: Already transferred");
 822 
        $logger->verbose("transferPackage: Already transferred");
693 
        return 1;
 823 
        return 1;
694 
    }
 824 
    }
695 
 
 825 
 
696 
    my $sfile = join ( '/', $conf->{'dpkg_archive'} , $pname, $pver );
 826 
    my $sfile = catfile( $conf->{'dpkg_archive'} , $pname, $pver );
697 
    unless ( -d $sfile )
 827 
    unless ( -d $sfile )
698 
    {
 828 
    {
699 
        $logger->warn("transferPackage:Package not found: $pname, $pver");
 829 
        $logger->warn("transferPackage:Package not found: $pname, $pver");
700 
        return $rv;
 830 
        return $rv;
701 
    }
 831 
    }
Line 707... Line 837...
707 
    #   gtar -czf - -C "$dpkg/${pname}/${pver}" . |  ssh  -i $IDENTITY  pkg_admin@${TARGET_HOST} "./receive_package ${rx_opts} \"$pname\" \"$pver\""
 837 
    #   gtar -czf - -C "$dpkg/${pname}/${pver}" . |  ssh  -i $IDENTITY  pkg_admin@${TARGET_HOST} "./receive_package ${rx_opts} \"$pname\" \"$pver\""
708 
    #
 838 
    #
709 
    my $ph;
 839 
    my $ph;
710 
    my $tar_cmd = "gtar -czf - -C \"$sfile\" .";
 840 
    my $tar_cmd = "gtar -czf - -C \"$sfile\" .";
711 
    my $tgt_opts = defined($plink) ? "\"-L$plink\"" : '';
 841 
    my $tgt_opts = defined($plink) ? "\"-L$plink\"" : '';
712 
    my $tgt_cmd = "$conf->{'bindir'}/receive_package $tgt_opts \"$pname\" \"$pver\" 2>&1";
 842 
    my $tgt_cmd = "$conf->{'bindir'}/receive_package $tgt_opts \"$pname\" \"$pver\"";
713 
    my $ssh_cmd = "ssh -i $conf->{'identity'} $conf->{'user'}\@$conf->{'hostname'} \"$tgt_cmd\"";
 843 
    my $ssh_cmd = "ssh -o \"BatchMode yes\" -i $conf->{'identity'} $conf->{'user'}\@$conf->{'hostname'} \"$tgt_cmd\" 2>&1";
714 
 
 844 
 
715 
    $logger->verbose2("transferPackage:tar_cmd:$tar_cmd");
 845 
    $logger->verbose2("transferPackage:tar_cmd:$tar_cmd");
716 
    $logger->verbose2("transferPackage:tgt_cmd:$tgt_cmd");
 846 
    $logger->verbose2("transferPackage:tgt_cmd:$tgt_cmd");
717 
    $logger->verbose2("transferPackage:ssh_cmd:$ssh_cmd");
 847 
    $logger->verbose2("transferPackage:ssh_cmd:$ssh_cmd");
718 
 
 848 
 
Line 761... Line 891...
761 
    #   Tar the directory and pipe the result through a ssh session to
 891 
    #   Tar the directory and pipe the result through a ssh session to
762 
    #   the target machine
 892 
    #   the target machine
763 
    #   gtar -czf - -C "$dpkg/${pname}/${pver}" . |  ssh  -i $IDENTITY  pkg_admin@${TARGET_HOST} "./receive_package ${rx_opts} \"$pname\" \"$pver\""
 893 
    #   gtar -czf - -C "$dpkg/${pname}/${pver}" . |  ssh  -i $IDENTITY  pkg_admin@${TARGET_HOST} "./receive_package ${rx_opts} \"$pname\" \"$pver\""
764 
    #
 894 
    #
765 
    my $ph;
 895 
    my $ph;
766 
    my $tgt_cmd = "$conf->{'bindir'}/delete_package \"$pname\" \"$pver\" 2>&1";
 896 
    my $tgt_cmd = "$conf->{'bindir'}/delete_package \"$pname\" \"$pver\"";
767 
    my $ssh_cmd = "ssh -i $conf->{'identity'} $conf->{'user'}\@$conf->{'hostname'} \"$tgt_cmd\"";
 897 
    my $ssh_cmd = "ssh -o \"BatchMode yes\" -i $conf->{'identity'} $conf->{'user'}\@$conf->{'hostname'} \"$tgt_cmd\" 2>&1";
768 
 
 898 
 
769 
    $logger->verbose2("transferPackage:tgt_cmd:$tgt_cmd");
 899 
    $logger->verbose2("deletePackage:tgt_cmd:$tgt_cmd");
770 
    $logger->verbose2("transferPackage:ssh_cmd:$ssh_cmd");
 900 
    $logger->verbose2("deletePackage:ssh_cmd:$ssh_cmd");
771 
 
 901 
 
772 
    open ($ph, "$ssh_cmd |");
 902 
    open ($ph, "$ssh_cmd |");
773 
    while ( <$ph> )
 903 
    while ( <$ph> )
774 
    {
 904 
    {
775 
        chomp;
 905 
        chomp;