download

   1 #!/usr/bin/perl -w
   2
   3 use Net::SSL ();
   4 BEGIN {
   5   $ENV{PERL_LWP_SSL_VERIFY_HOSTNAME} = 0,
   6   unshift @INC, ($::ENV{'BUILD_DIR'} || '/usr/lib/build');
   7 }
   8
   9 use LWP::UserAgent;
  10 use URI;
  11 use File::Path;
  12 use File::Basename;
  13
  14 use strict;
  15
  16 sub hide_passwd {
  17     my $url = shift;
  18     $url =~ s|://[^@]*@|://|;
  19     return $url
  20 }
  21
  22 die "USAGE: $0 DIR URLS..." unless $#ARGV >= 1;
  23
  24 my $dir = shift @ARGV;
  25
  26 my $ua = LWP::UserAgent->new(
  27   agent => "openSUSE build script",
  28   timeout => 42);
  29
  30 for my $url (@ARGV) {
  31   my $original = $url;
  32   if ($url =~ /^zypp:\/\/([^\/]*)\/?/) {
  33     use Build::Zypp;
  34     my $repo = Build::Zypp::parsecfg($1);
  35     die "can't parse $1\n" unless $repo;
  36     die "missing url in repo ".$repo->{'name'}."\n" unless exists $repo->{'baseurl'};
  37     my $u = $repo->{'baseurl'};
  38     $u .= '/' unless substr($u, -1, 1) eq '/';
  39     $url =~ s/^zypp:\/\/[^\/]*\/*//;
  40     $url = URI->new($u.$url)
  41   } else {
  42     my $found = 0;
  43     if ( defined $ENV{BUILD_ROOT} && -e $ENV{BUILD_ROOT} . "/.repo.config" ) {
  44         open FILE, "<", $ENV{BUILD_ROOT} . "/.repo.config" or die $!;
  45         while (<FILE>) {
  46             next if ($_ !~ /^http[s]?:\/\/([^\/]*)\/?/);
  47             chomp($_);
  48             my $hidden = URI->new($_);
  49             my $ui = $hidden->userinfo;
  50             $hidden->userinfo(undef);
  51             if ( $url =~ m/^$hidden/ ) {
  52                 $url = URI->new($url);
  53                 $url->userinfo($ui);
  54                 $found = 1;
  55                 last;
  56             }
  57         }
  58         close FILE;
  59     }
  60     if ($found == 0 ) {
  61         $url = URI->new($url);
  62     }
  63   }
  64   $ua->env_proxy  if $url->scheme ne 'https';
  65   my $dest = "$dir/".basename($url->path);
  66   unlink($dest);        # just in case
  67   my $retry = 3;
  68   while ($retry--) {
  69     my $res = $ua->mirror($url, $dest);
  70     last if $res->is_success;
  71     # if it's a redirect we probably got a bad mirror and should just retry
  72     die "reqesting " . hide_passwd($original) . " failed: ".$res->status_line."\n" unless $retry && $res->previous;
  73     warn "retrying " . hide_passwd($original) . "\n";
  74   }
  75 }
  76
  77 # vim:sw=2