aboutsummaryrefslogtreecommitdiffstats
path: root/modules/mirror_cleaner/files/orphans_cleaner.pl
blob: f1af3deedf5780adbe9481f0fc70de415b6420be (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
#!/usr/bin/perl

# this script will look at the list of rpm, and move orphan to a directory, if they are too old
# another script should take care of cleaning this directory ( or puppet )

use strict;
use RPM4;
use File::stat;
use File::Basename;
use File::Copy;
use File::Path qw(make_path);

my @arches = ('i586','x86_64');
my @sections = ('core','nonfree','tainted');
my @medias = ('backports', 'backports_testing', 'release',  'updates',  'updates_testing');
my $move_delay = 60*60*24*14;

my ($path, $dest_path) = @ARGV;

my $qf = "%{NAME}-%{VERSION}-%{RELEASE}.%{ARCH}.rpm %{SOURCERPM}";

my %hash ;
my ($filename, $srpm, $dest_rpm);


my ($source_hdlist, $binary_hdlist, $rpm_path, $srpm_path);

foreach my $a ( @arches ) {
        foreach my $s ( @sections ) {
                foreach my $m ( @medias ) {

                        $rpm_path = "$path/$a/media/$s/$m";
                        $srpm_path = "$path/SRPMS/$s/$m";
                        $binary_hdlist = "$rpm_path/media_info/hdlist.cz";
                        $source_hdlist = "$srpm_path/media_info/hdlist.cz";

			next if not -f $source_hdlist;
			next if not -f $binary_hdlist;

			next if stat($source_hdlist)->size() <= 64;
			next if stat($binary_hdlist)->size() <= 64;

                        open(my $hdfh, "zcat '$binary_hdlist' 2>/dev/null |") or die "Can't open $_";
                        while (my $hdr = stream2header($hdfh)) {
                                ($filename, $srpm) = split(/ /,$hdr->queryformat($qf));
                                push(@{$hash{$srpm}}, $filename);
                        }
                        close($hdfh);


                        open($hdfh, "zcat '$source_hdlist' 2>/dev/null |") or die "Can't open $_";
                        while (my $hdr = stream2header($hdfh)) {
                                $srpm = $hdr->queryformat("%{NAME}-%{VERSION}-%{RELEASE}.src.rpm");
                                delete $hash{$srpm}; 
                        }
                        close($hdfh);

                        foreach my $s ( keys %hash )
                        {
                                # Be safe, maybe hdlists were not in sync
                                next if -f "$srpm_path/$s";
                                foreach my $rpm ( @{$hash{$s}} ) {
					$rpm = "$rpm_path/$rpm";
					# sometimes, packages are removed without hdlist to be updated
					next if not -f "$rpm";
					if (time() > $move_delay + stat("$rpm")->ctime()) {
						( $dest_rpm = $rpm ) =~ s/$path/$dest_path/;
						my $dir = dirname $dest_rpm;
						make_path $dir if not -d $dir;
						move($rpm, $dest_rpm)
					}
                                }
                        }
                }
        }
}