1 files changed, 73 insertions, 0 deletions
diff --git a/modules/mirror_cleaner/files/orphans_cleaner.pl b/modules/mirror_cleaner/files/orphans_cleaner.pl
new file mode 100755
index 00000000..04a73fe2
--- /dev/null
+++ b/modules/mirror_cleaner/files/orphans_cleaner.pl
@@ -0,0 +1,73 @@
+#!/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);
+
+foreach my $a ( @arches ) {
+        foreach my $s ( @sections ) {
+                foreach my $m ( @medias ) {
+
+                        $rpm_path = "$path/$a/media/$s/$m";
+                        $binary_hdlist = "$rpm_path/media_info/hdlist.cz";
+                        $source_hdlist = "$path/SRPMS/$s/$m/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 $v ( values %hash ) 
+                        {
+                                foreach my $rpm ( @{$v} ) {
+					$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;
+						copy($rpm, $dest_rpm)
+					}
+                                }	   
+                        }
+                }
+        }
+}