Subversion Repositories DevTools

Rev

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

Rev 1040 Rev 1042
Line 82... Line 82...
82
    'project'         => {'mandatory' => 0    , 'fmt' => 'int_list'},
82
    'project'         => {'mandatory' => 0    , 'fmt' => 'int_list'},
83
    'release'         => {'mandatory' => 0    , 'fmt' => 'int_list'},
83
    'release'         => {'mandatory' => 0    , 'fmt' => 'int_list'},
84
    'writewindow'     => {'default' => '3h'   , 'fmt' => 'period'},
84
    'writewindow'     => {'default' => '3h'   , 'fmt' => 'period'},
85
    'maxpackages'     => {'default' => 5      , 'fmt' => 'int'},
85
    'maxpackages'     => {'default' => 5      , 'fmt' => 'int'},
86
    'deletePackages'  => {'default' => 0      , 'fmt' => 'bool'},
86
    'deletePackages'  => {'default' => 0      , 'fmt' => 'bool'},
-
 
87
    'deleteImmediate' => {'default' => 0      , 'fmt' => 'bool'},
-
 
88
    'deleteAge'       => {'default' => 0      , 'fmt' => 'period'},
87
);
89
);
88
 
90
 
89
 
91
 
90
#
92
#
91
#   Read in the configuration
93
#   Read in the configuration
Line 203... Line 205...
203
    #   Invoke a program on the remote site and parse the results
205
    #   Invoke a program on the remote site and parse the results
204
    #
206
    #
205
    #     ssh  -i ./ssh/id_rsa_pkg_admin  pkg_admin@10.247.28.57 "./get_plist.pl"
207
    #     ssh  -i ./ssh/id_rsa_pkg_admin  pkg_admin@10.247.28.57 "./get_plist.pl"
206
    #
208
    #
207
    #   Returned data looks like:
209
    #   Returned data looks like:
208
    #   1141792602 GMT(Wed Mar  8 04:36:42 2006) ishieldmodules/11.5.0.cots
210
    #   1141792602 GMT(Wed Mar  8 04:36:42 2006) [DL] ishieldmodules/11.5.0.cots
209
    #   
211
    #   
210
    #
212
    #
211
    my $remotePkgList;
213
    my $remotePkgList;
212
    my $ph;
214
    my $ph;
213
    my $tgt_cmd = "$conf->{'bindir'}/get_plist.pl";
215
    my $tgt_cmd = "$conf->{'bindir'}/get_plist.pl";
Line 216... Line 218...
216
    $logger->verbose2("processReleaseList:ssh_cmd:$ssh_cmd");
218
    $logger->verbose2("processReleaseList:ssh_cmd:$ssh_cmd");
217
    open ($ph, "$ssh_cmd |");
219
    open ($ph, "$ssh_cmd |");
218
    while ( <$ph> )
220
    while ( <$ph> )
219
    {
221
    {
220
        chomp;
222
        chomp;
221
        if ( m~^(\d+)\s+GMT\(.*?\)\s+(.+)/(.+)~ )
223
        if ( parsePkgList($_, \%{$remotePkgList} ) )
222
        {
224
        {
223
            $remotePkgList->{$2}{$3} = $1;
-
 
224
            $logger->verbose2("processReleaseList:Data: $_");
225
            $logger->verbose2("processReleaseList:Data: $_");
225
        }
226
        }
226
        else
227
        else
227
        {
228
        {
228
            $logger->warn("processReleaseList:Bad Data: $_");
229
            $logger->warn("processReleaseList:Bad Data: $_");
Line 233... Line 234...
233
    if ( $? != 0 )
234
    if ( $? != 0 )
234
    {
235
    {
235
        $logger->warn("Cannot retrieve package list: $?");
236
        $logger->warn("Cannot retrieve package list: $?");
236
        return;
237
        return;
237
    }
238
    }
-
 
239
#Utils::DebugDumpData ("remotePkgList", $remotePkgList);
-
 
240
    
238
 
241
 
239
    #
242
    #
240
    #   Determine the set of packages in the releases to be transferred
243
    #   Determine the set of packages in the releases to be transferred
241
    #   Examine
244
    #   Examine
242
    #
245
    #
Line 297... Line 300...
297
 
300
 
298
        $logger->verbose2("No packages to process");
301
        $logger->verbose2("No packages to process");
299
        return;
302
        return;
300
    }
303
    }
301
 
304
 
302
 
-
 
303
#    while ( (my ($pname, $pvers)) = each %{$pkgList} )
305
#    while ( (my ($pname, $pvers)) = each %{$pkgList} )
304
#    {
306
#    {
305
#        while ( (my ($pver, $ptime) ) = each %{$pvers} )
307
#        while ( (my ($pver, $ptime) ) = each %{$pvers} )
306
#        {
308
#        {
307
#            print "L-- $pname, $pver, $ptime \n";
309
#            print "L-- $pname, $pver, $ptime \n";
Line 310... Line 312...
310
#    }
312
#    }
311
 
313
 
312
    #
314
    #
313
    #   Delete Excess Packages
315
    #   Delete Excess Packages
314
    #       Packages not required on the target
316
    #       Packages not required on the target
315
    #       KLUDGE: Don't delete links to packages
317
    #           KLUDGE: Don't delete links to packages
-
 
318
    #           Don't delete packages marked for deletion
316
    #
319
    #
317
    my $excessPkgList;
320
    my $excessPkgList;
318
    if ( $conf->{deletePackages} )
321
    if ( $conf->{deletePackages} )
319
    {
322
    {
320
        while ( (my ($pname, $pvers)) = each %{$remotePkgList} )
323
        while ( (my ($pname, $pvers)) = each %{$remotePkgList} )
Line 333... Line 336...
333
                    {
336
                    {
334
                        $logger->verbose2("Keep Excluded package: ${pname}");
337
                        $logger->verbose2("Keep Excluded package: ${pname}");
335
                        next;
338
                        next;
336
                    }
339
                    }
337
 
340
 
-
 
341
                    if ( exists $pdata->{deleted} )
-
 
342
                    {
-
 
343
                        if ( $conf->{deleteAge} )
-
 
344
                        {
-
 
345
                            if ( $pdata->{deleted} <= $conf->{deleteAge} )
-
 
346
                            {
-
 
347
                                $logger->verbose2("Already marked for future age deletion: ${pname}/${pver}, $pdata->{deleted}");
-
 
348
                                next;
-
 
349
                            }
-
 
350
                            $pdata->{FORCEDELETE} = 1;
-
 
351
                        }
-
 
352
 
-
 
353
                        if ( !$conf->{deleteImmediate} )
-
 
354
                        {
-
 
355
                            $logger->verbose2("Already marked for deletion: ${pname}/${pver}");
-
 
356
                            next;
-
 
357
                        }
-
 
358
                    }
-
 
359
 
-
 
360
                    #
-
 
361
                    #   Force deletion
-
 
362
                    #       deleteImmediate mode
-
 
363
                    #       target is a broken link
-
 
364
                    #
-
 
365
                    $pdata->{FORCEDELETE} = 1
-
 
366
                        if ($conf->{deleteImmediate} || $pdata->{broken});
-
 
367
 
338
                    $excessPkgList->{$pname}{$pver} = $pdata;
368
                    $excessPkgList->{$pname}{$pver} = $pdata;
339
                    $logger->verbose("Excess package: ${pname}/${pver}");
369
                    $logger->verbose("Excess package: ${pname}/${pver}");
340
                }
370
                }
341
            }
371
            }
342
        }
372
        }
Line 362... Line 392...
362
        #
392
        #
363
        next if ( exists $excludePkgs->{$pname} );
393
        next if ( exists $excludePkgs->{$pname} );
364
 
394
 
365
        while ( (my ($pver, $pdata) ) = each %{$pvers} )
395
        while ( (my ($pver, $pdata) ) = each %{$pvers} )
366
        {
396
        {
367
            my $tmtime = $remotePkgList->{$pname}{$pver} || 0;
397
            my $tmtime = $remotePkgList->{$pname}{$pver}{time} || 0;
368
 
398
 
369
            # Package is present in both list
399
            # Package is present in both list
370
            my ($mtime, $mode) = Utils::mtime( catfile( $conf->{'dpkg_archive'} , $pname, $pver, 'descpkg' ));
400
            my ($mtime, $mode) = Utils::mtime( catfile( $conf->{'dpkg_archive'} , $pname, $pver, 'descpkg' ));
371
            if ( $mtime == 0 )
401
            if ( $mtime == 0 )
372
            {
402
            {
Line 447... Line 477...
447
    delete_pkgs:
477
    delete_pkgs:
448
    while ( (my ($pname, $pvers)) = each %{$excessPkgList} )
478
    while ( (my ($pname, $pvers)) = each %{$excessPkgList} )
449
    {
479
    {
450
        while ( (my ($pver, $pdata) ) = each %{$pvers} )
480
        while ( (my ($pver, $pdata) ) = each %{$pvers} )
451
        {
481
        {
452
            deletePackage ($pname, $pver);
482
            deletePackage ($pname, $pver, $pdata);
453
            if ( --$txcount <= 0 )
483
            if ( --$txcount <= 0 )
454
            {
484
            {
455
                $logger->warn("Max transfer count exceeded");
485
                $logger->warn("Max transfer count exceeded");
456
                $lastReleaseScan = 0;
486
                $lastReleaseScan = 0;
457
                last delete_pkgs;
487
                last delete_pkgs;
Line 734... Line 764...
734
    #   on the first attempt
764
    #   on the first attempt
735
    #
765
    #
736
    my ($mtime) = Utils::mtime($conf->{'tagdir'} );
766
    my ($mtime) = Utils::mtime($conf->{'tagdir'} );
737
    if ( ($mtime > $tagDirTime) || ($now > ($lastDirScan + $conf->{'forcedirscan'})) )
767
    if ( ($mtime > $tagDirTime) || ($now > ($lastDirScan + $conf->{'forcedirscan'})) )
738
    {
768
    {
739
        $logger->verbose2("processTags: ", $mtime - $tagDirTime, $now - $lastDirScan);
769
        $logger->verbose2("processTags: ",$conf->{'tagdir'}, $mtime - $tagDirTime, $now - $lastDirScan);
740
        $tagDirTime = $mtime;
770
        $tagDirTime = $mtime;
741
        $lastDirScan = $now;
771
        $lastDirScan = $now;
742
 
772
 
743
        my $dh;
773
        my $dh;
744
        unless (opendir($dh, $conf->{'tagdir'}))
774
        unless (opendir($dh, $conf->{'tagdir'}))
Line 753... Line 783...
753
        #
783
        #
754
        while (my $tag = readdir($dh) )
784
        while (my $tag = readdir($dh) )
755
        {
785
        {
756
            next if ( $tag =~ m~^\.~ );
786
            next if ( $tag =~ m~^\.~ );
757
            my $file = "$conf->{'tagdir'}/$tag";
787
            my $file = "$conf->{'tagdir'}/$tag";
-
 
788
            $logger->verbose3("processTags: $file");
-
 
789
 
758
            next unless ( -f $file );
790
            next unless ( -f $file );
759
            next if ( $tag  eq 'ReleaseList' );
791
            next if ( $tag  eq 'ReleaseList' );
760
 
792
 
761
            if ( $tag =~ m~(.+)::(.+)~  )
793
            if ( $tag =~ m~(.+)::(.+)~  )
762
            {
794
            {
Line 874... Line 906...
874
#
906
#
875
# Description     : Delete specified package to target system
907
# Description     : Delete specified package to target system
876
#
908
#
877
# Inputs          : $pname          - Name of the package
909
# Inputs          : $pname          - Name of the package
878
#                   $pver           - Package version
910
#                   $pver           - Package version
-
 
911
#                   $pdata          - Hash of extra data
879
#
912
#
880
# Returns         : true    - Package transferred
913
# Returns         : true    - Package transferred
881
#                   false   - Package not transferred
914
#                   false   - Package not transferred
882
#
915
#
883
sub deletePackage
916
sub deletePackage
884
{
917
{
885
    my ($pname, $pver ) = @_;
918
    my ($pname, $pver, $pdata ) = @_;
886
    my $rv = 0;
919
    my $rv = 0;
887
    $logger->logmsg("deletePackage: @_");
920
    $logger->logmsg("deletePackage: $pname, $pver");
888
 
921
 
889
    #
922
    #
890
    #   Create the process pipe to delete the package
923
    #   Create the process pipe to delete the package
891
    #   Tar the directory and pipe the result through a ssh session to
924
    #   Tar the directory and pipe the result through a ssh session to
892
    #   the target machine
925
    #   the target machine
893
    #   gtar -czf - -C "$dpkg/${pname}/${pver}" . |  ssh  -i $IDENTITY  pkg_admin@${TARGET_HOST} "./receive_package ${rx_opts} \"$pname\" \"$pver\""
926
    #   gtar -czf - -C "$dpkg/${pname}/${pver}" . |  ssh  -i $IDENTITY  pkg_admin@${TARGET_HOST} "./receive_package ${rx_opts} \"$pname\" \"$pver\""
894
    #
927
    #
895
    my $ph;
928
    my $ph;
-
 
929
    my $flags = $pdata->{FORCEDELETE}  ? '' : ' -T';
896
    my $tgt_cmd = "$conf->{'bindir'}/delete_package \"$pname\" \"$pver\"";
930
    my $tgt_cmd = "$conf->{'bindir'}/delete_package $flags \"$pname\" \"$pver\"";
897
    my $ssh_cmd = "ssh -o \"BatchMode yes\" -i $conf->{'identity'} $conf->{'user'}\@$conf->{'hostname'} \"$tgt_cmd\" 2>&1";
931
    my $ssh_cmd = "ssh -o \"BatchMode yes\" -i $conf->{'identity'} $conf->{'user'}\@$conf->{'hostname'} \"$tgt_cmd\" 2>&1";
898
 
932
 
899
    $logger->verbose2("deletePackage:tgt_cmd:$tgt_cmd");
933
    $logger->verbose2("deletePackage:tgt_cmd:$tgt_cmd");
900
    $logger->verbose2("deletePackage:ssh_cmd:$ssh_cmd");
934
    $logger->verbose2("deletePackage:ssh_cmd:$ssh_cmd");
901
 
935
 
Line 918... Line 952...
918
    return $rv;
952
    return $rv;
919
}
953
}
920
 
954
 
921
 
955
 
922
#-------------------------------------------------------------------------------
956
#-------------------------------------------------------------------------------
-
 
957
# Function        : parsePkgList
-
 
958
#
-
 
959
# Description     : Parse one line from a pkgList
-
 
960
#                   Lines are multiple item="data" items
-
 
961
#
-
 
962
# Inputs          : $line                   - Line of data
-
 
963
#                   $hashp                  - Ref to hash to populate
-
 
964
#
-
 
965
# Returns         : A hash of data items
-
 
966
#
-
 
967
sub parsePkgList
-
 
968
{
-
 
969
    my ($line, $hashp) = @_;
-
 
970
    my $rv;
-
 
971
 
-
 
972
    while ( $line =~ m~\s*(.+?)="(.+?)"~ )
-
 
973
    {
-
 
974
        $rv->{$1} = $2;
-
 
975
        $line = $';
-
 
976
    }
-
 
977
#Utils::DebugDumpData ("parsePkgList", $rv);
-
 
978
 
-
 
979
    my $pname = $rv->{pname};
-
 
980
    my $pver =  $rv->{pver};
-
 
981
    return undef unless ( $pname && $pver );
-
 
982
 
-
 
983
    delete $rv->{pname};
-
 
984
    delete $rv->{pver};
-
 
985
    delete $rv->{GMT};
-
 
986
 
-
 
987
    $hashp->{$pname}{$pver} = $rv;
-
 
988
    return $hashp;
-
 
989
}
-
 
990
 
-
 
991
 
-
 
992
#-------------------------------------------------------------------------------
923
# Function        : sighandlers
993
# Function        : sighandlers
924
#
994
#
925
# Description     : Install signal handlers
995
# Description     : Install signal handlers
926
#
996
#
927
# Inputs          : $conf           - System config
997
# Inputs          : $conf           - System config
Line 972... Line 1042...
972
    $logger->err("@_");
1042
    $logger->err("@_");
973
}
1043
}
974
 
1044
 
975
sub Verbose
1045
sub Verbose
976
{
1046
{
977
    $logger->verbose("@_");
1047
    $logger->verbose2("@_");
978
}
1048
}
979
 
1049
 
980
sub Warning
1050
sub Warning
981
{
1051
{
982
    $logger->warn("@_");
1052
    $logger->warn("@_");