#!/usr/bin/perl -w ################################################################ # # Copyright (c) 1995-2014 SUSE Linux Products GmbH # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License version 2 or 3 as # published by the Free Software Foundation. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program (see the file COPYING); if not, write to the # Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA # ################################################################ use Net::SSL (); BEGIN { $ENV{PERL_LWP_SSL_VERIFY_HOSTNAME} = 0, unshift @INC, ($::ENV{'BUILD_DIR'} || '/usr/lib/build'); } use LWP::UserAgent; use URI; use File::Path; use File::Basename; use strict; sub hide_passwd { my $url = shift; $url =~ s|://[^@]*@|://|; return $url } die "USAGE: $0 DIR URLS..." unless $#ARGV >= 1; my $dir = shift @ARGV; my $ua = LWP::UserAgent->new( agent => "openSUSE build script", timeout => 42); for my $url (@ARGV) { my $original = $url; if ($url =~ /^zypp:\/\/([^\/]*)\/?/) { use Build::Zypp; my $repo = Build::Zypp::parserepo($1); die "can't parse $1\n" unless $repo; die "missing url in repo ".$repo->{'name'}."\n" unless exists $repo->{'baseurl'}; my $u = $repo->{'baseurl'}; $u .= '/' unless $u =~ /\/$/; $url =~ s/^zypp:\/\/[^\/]*\/*//; $url = URI->new($u.$url); if ($url->scheme eq 'dir') { my $dest = "$dir/".basename($url->path); unlink($dest); # just in case system('cp', $url->path, $dest) && die("cp $url->path $dest failed\n"); last; } } else { my $found = 0; if ( defined $ENV{BUILD_ROOT} && -e $ENV{BUILD_ROOT} . "/.repo.config" ) { open FILE, "<", $ENV{BUILD_ROOT} . "/.repo.config" or die $!; while () { next if ($_ !~ /^http[s]?:\/\/([^\/]*)\/?/); chomp($_); my $hidden = URI->new($_); my $ui = $hidden->userinfo; $hidden->userinfo(undef); if ( $url =~ m/^$hidden/ ) { $url = URI->new($url); $url->userinfo($ui); $found = 1; last; } } close FILE; } if ($found == 0 ) { $url = URI->new($url); } } $ua->env_proxy if $url->scheme ne 'https'; my $dest = "$dir/".basename($url->path).".tmp"; unlink($dest); # just in case my $retry = 3; while ($retry--) { my $res = $ua->mirror($url, $dest); last if $res->is_success; # if it's a redirect we probably got a bad mirror and should just retry die "reqesting " . hide_passwd($original) . " failed: ".$res->status_line."\n" unless $retry && $res->previous; warn "retrying " . hide_passwd($original) . "\n"; } rename($dest, "$dir/".basename($url->path)); } # vim:sw=2