1 |
#!/usr/bin/perl |
2 |
|
3 |
# this script will look at the list of rpm, and move orphan to a directory, if they are too old |
4 |
# another script should take care of cleaning this directory ( or puppet ) |
5 |
|
6 |
use strict; |
7 |
use RPM4; |
8 |
use File::stat; |
9 |
use File::Basename; |
10 |
use File::Copy; |
11 |
use File::Path qw(make_path); |
12 |
|
13 |
my @arches = ('i586','x86_64'); |
14 |
my @sections = ('core','nonfree','tainted'); |
15 |
my @medias = ('backports', 'backports_testing', 'release', 'updates', 'updates_testing'); |
16 |
my $move_delay = 60*60*24*14; |
17 |
|
18 |
my ($path, $dest_path) = @ARGV; |
19 |
|
20 |
my $qf = "%{NAME}-%{VERSION}-%{RELEASE}.%{ARCH}.rpm %{SOURCERPM}"; |
21 |
|
22 |
my %hash ; |
23 |
my ($filename, $srpm, $dest_rpm); |
24 |
|
25 |
|
26 |
my ($source_hdlist, $binary_hdlist, $rpm_path); |
27 |
|
28 |
foreach my $a ( @arches ) { |
29 |
foreach my $s ( @sections ) { |
30 |
foreach my $m ( @medias ) { |
31 |
|
32 |
$rpm_path = "$path/$a/media/$s/$m"; |
33 |
$binary_hdlist = "$rpm_path/media_info/hdlist.cz"; |
34 |
$source_hdlist = "$path/SRPMS/$s/$m/media_info/hdlist.cz"; |
35 |
|
36 |
next if not -f $source_hdlist; |
37 |
next if not -f $binary_hdlist; |
38 |
|
39 |
next if stat($source_hdlist)->size() <= 64; |
40 |
next if stat($binary_hdlist)->size() <= 64; |
41 |
|
42 |
open(my $hdfh, "zcat '$binary_hdlist' 2>/dev/null |") or die "Can't open $_"; |
43 |
while (my $hdr = stream2header($hdfh)) { |
44 |
($filename, $srpm) = split(/ /,$hdr->queryformat($qf)); |
45 |
push(@{$hash{$srpm}}, $filename); |
46 |
} |
47 |
close($hdfh); |
48 |
|
49 |
|
50 |
open($hdfh, "zcat '$source_hdlist' 2>/dev/null |") or die "Can't open $_"; |
51 |
while (my $hdr = stream2header($hdfh)) { |
52 |
$srpm = $hdr->queryformat("%{NAME}-%{VERSION}-%{RELEASE}.src.rpm"); |
53 |
delete $hash{$srpm}; |
54 |
} |
55 |
close($hdfh); |
56 |
|
57 |
foreach my $v ( values %hash ) |
58 |
{ |
59 |
foreach my $rpm ( @{$v} ) { |
60 |
$rpm = "$rpm_path/$rpm"; |
61 |
# sometimes, packages are removed without hdlist to be updated |
62 |
next if not -f "$rpm"; |
63 |
if (time() > $move_delay + stat("$rpm")->ctime()) { |
64 |
( $dest_rpm = $rpm ) =~ s/$path/$dest_path/; |
65 |
my $dir = dirname $dest_rpm; |
66 |
make_path $dir if not -d $dir; |
67 |
copy($rpm, $dest_rpm) |
68 |
} |
69 |
} |
70 |
} |
71 |
} |
72 |
} |
73 |
} |