cr.pl: now script can download repos with hashes in metadata paths, added some runtime checks

cr.pl

@@ -1,18 +1,22 @@
 #!/usr/bin/perl
+# TODO: --clean option to cleanup repo accrding to metadata
 
 use strict;
 use warnings "all";
 use Fcntl;
 use File::Basename;
 use File::Path qw(make_path);
+use File::Spec;
 use XML::Parser;
 use IO::Zlib;
 use URI::URL;
+use Data::Dumper;
 
-sub dlfunc($);
+sub dlfunc(@);
 sub urlencode($);
 sub getmetadata();
 sub help($);
+sub path_normalize_by_string_manipulation($);
 
 help(1) unless (defined $ARGV[1]);
 help(0) if ($ARGV[0] eq '--help');
@@ -21,12 +25,12 @@ help(0) if ($ARGV[0] eq '-h');
 my $BASEURL = $ARGV[0];
 my $BASEDIR = $ARGV[1];
 
-getmetadata();
+my $primaryxmlgz = getmetadata();
 
 my $fh = new IO::Zlib;
 my $xmldata = '';
 
-if ($fh->open($BASEDIR . "repodata/primary.xml.gz", "rb")) {
+if ($fh->open($BASEDIR . $primaryxmlgz, "rb")) {
 
         while (<$fh>) {
                 $xmldata .= $_;
@@ -48,17 +52,27 @@ for (my $i = 0; $i < @array; $i++) {
         if (defined($array[$i]) and ($array[$i] eq 'package')) {
                 $i++;
                 my @array2 = @{ $array[$i] };
+                my $size = -1;
+                my $link;
 
                 for (my $j = 0; $j < @array2; $j++) {
 
+                        if (defined($array2[$j]) and ($array2[$j] eq 'size')) {
+                                $j++;
+                                $size = $array2[$j][0]{'package'};
+                        }
+
                         if (defined($array2[$j]) and ($array2[$j] eq 'location')) {
                                 $j++;
-				dlfunc($array2[$j][0]{'href'});
+                                $link = $array2[$j][0]{'href'};
 #                               syswrite STDOUT, "+ " . $array2[$j][0]{'href'} . "\n";
                         }
 
                 }
 
+                dlfunc($link, $size);
+                undef $size;
+                undef $link;
                 @array2 = -1;
         }
 }
@@ -86,19 +100,30 @@ HELP
         exit $rc;
 }
 
-sub dlfunc($) {
+sub dlfunc(@) {
         my $url = shift; # short (relative) URL without BASE part
+        my $size = shift;
         my $wgetpath;
+        my $savepath = path_normalize_by_string_manipulation ($BASEDIR . $url);
+
+        if (substr($savepath, 0, length($BASEDIR)) ne $BASEDIR) {
+                syswrite STDERR, sprintf("Skipping package %s, because it out of destdir %s, looks like quirky metadata.\n", $savepath, $BASEDIR);
+                return;
+        }
+
+        # do not re-download already downloaded rpm packages
+        unless ($size == -1) {
+
+                if (-f $savepath) {
+                        my $filesize = (stat($savepath))[7];
+
+                        if ($size == $filesize) {
+                               return;
+                        }
+                }
 
-	if (-f "/bin/wget") {
-		$wgetpath = '/bin/wget';
-	} elsif (-f "/usr/bin/wget") {
-		$wgetpath = '/usr/bin/wget';
-	} elsif (-f "/usr/local/bin/wget") {
-		$wgetpath = '/usr/local/bin/wget';
         }
 
-	my $savepath = $BASEDIR . $url;
         my $basedir; (undef, $basedir) = fileparse($savepath);
 
         unless (-d $basedir) {
@@ -110,6 +135,17 @@ sub dlfunc($) {
                 }
         }
 
+        if (-f "/bin/wget") {
+                $wgetpath = '/bin/wget';
+        } elsif (-f "/usr/bin/wget") {
+                $wgetpath = '/usr/bin/wget';
+        } elsif (-f "/usr/local/bin/wget") {
+                $wgetpath = '/usr/local/bin/wget';
+        } else {
+                syswrite STDERR, "Please install wget. (Unable to find it in std locations)\n";
+                exit 1;
+        }
+
         $url = $BASEURL . $url;
         $url = urlencode($url);
         system($wgetpath, '--no-check-certificate', '-q', '-T', '20', '-O', $savepath, '-o', '/dev/null', $url);
@@ -127,7 +163,7 @@ sub urlencode($) {
 }
 
 sub getmetadata() {
-	dlfunc('repodata/repomd.xml');
+        dlfunc('repodata/repomd.xml', -1);
 
         my $p1 = new XML::Parser(Style => 'Tree');
         my $ref = $p1->parsefile($BASEDIR . 'repodata/repomd.xml');
@@ -137,6 +173,7 @@ sub getmetadata() {
 #  must be 'location'------^
 
         my @array = @{ $ref->[1] };
+        my $primaryxmlgz;
 
         for (my $i = 0; $i < @array; $i++) {
 
@@ -147,7 +184,11 @@ sub getmetadata() {
                         for (my $j = 0; $j < @array2; $j++) {
                                 if (defined($array2[$j]) and ($array2[$j] eq 'location')) {
                                         $j++;
-					dlfunc($array2[$j][0]{'href'});
+                                        dlfunc($array2[$j][0]{'href'}, -1);
+
+                                        if ($array2[$j][0]{'href'} =~ /primary\.xml\.gz$/) {
+                                                $primaryxmlgz = $array2[$j][0]{'href'};
+                                        }
                                 }
 
                         }
@@ -157,5 +198,35 @@ sub getmetadata() {
 
         }
 
+        return $primaryxmlgz;
+}
+
+sub path_normalize_by_string_manipulation ($) {
+    my $path = shift;
+
+    # canonpath does string manipulation, but does not remove "..".
+    my $ret = File::Spec->canonpath($path);
+
+    # Let's remove ".." by using a regex.
+    while ($ret =~ s{
+        (^|/)              # Either the beginning of the string, or a slash, save as $1
+        (                  # Followed by one of these:
+            [^/]|          #  * Any one character (except slash, obviously)
+            [^./][^/]|     #  * Two characters where
+            [^/][^./]|     #    they are not ".."
+            [^/][^/][^/]+  #  * Three or more characters
+        )                  # Followed by:
+        /\.\./             # "/", followed by "../"
+        }{$1}x
+    ) {
+        # Repeat this substitution until not possible anymore.
+    }
+
+    # Re-adding the trailing slash, if needed.
+    if ($path =~ m!/$! && $ret !~ m!/$!) {
+        $ret .= '/';
+    }
+
+    return $ret;
 }
 __END__