#!/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 # ################################################################ BEGIN { unshift @INC, ($::ENV{'BUILD_DIR'} || '/usr/lib/build'); } use strict; use Data::Dumper; use Getopt::Long; use Build ':rpm'; use Build::Rpm; use Build::Rpmmd; use Digest::MD5 (); use File::Path qw(mkpath rmtree); use File::Basename; use File::Copy qw(move); use IPC::SysV qw(IPC_PRIVATE S_IRUSR S_IWUSR IPC_CREAT IPC_EXCL SEM_UNDO); use IPC::Semaphore; Getopt::Long::Configure("no_ignore_case"); my $opt_dump; my $opt_old; my $opt_nosrc; my $opt_bc; my $opt_zypp; my $cachedir = "/var/cache/build"; sub printold { my ($pkg, $baseurl, $old_seen) = @_; my $arch = $pkg->{'arch'}; $arch = 'src' if $pkg->{'arch'} eq 'nosrc'; return if $arch eq 'src' && $opt_nosrc; my $evr = $pkg->{'version'}.'-'.$pkg->{'release'}; $evr = "$pkg->{'epoch'}:$evr" if $pkg->{'epoch'}; my $loc = $baseurl . $pkg->{'location'}; if ($old_seen->{$pkg->{'name'}}->{$arch}) { my $vv = Build::Rpm::verscmp($old_seen->{$pkg->{'name'}}->{$arch}->{'evr'}, $evr, 0); if ($vv >= 0) { print "$loc\n"; return; } print $old_seen->{$pkg->{'name'}}->{$arch}->{'loc'}."\n"; } $old_seen->{$pkg->{'name'}}->{$arch}->{'evr'} = $evr; $old_seen->{$pkg->{'name'}}->{$arch}->{'loc'} = $loc; } GetOptions ( "nosrc" => \$opt_nosrc, "dump" => \$opt_dump, "old" => \$opt_old, "zypp=s" => \$opt_zypp, "cachedir=s" => \$cachedir, ) or exit(1); $opt_bc = 1 unless $opt_dump || $opt_old; my $old_seen = {}; # for opt_old my @packages; # for opt_dump for my $url (@ARGV) { my $dir; my $baseurl = $url; if ($opt_zypp) { $dir = $opt_zypp; } elsif ($url =~ /^(?:ftps?|https?):\/\/([^\/]*)\/?/) { my $repoid = Digest::MD5::md5_hex($url); $dir = "$cachedir/$repoid/"; $baseurl .= '/' unless $baseurl =~ /\/$/; mkpath("${dir}repodata"); #my $sem; #my $key = IPC::SysV::ftok($dir, '1'); #if ($sem = IPC::Semaphore->new($key, 1, S_IRUSR | S_IWUSR | IPC_CREAT | IPC_EXCL)) { # $sem->setval(0, 1); #} else { # $sem = IPC::Semaphore->new($key, 1, S_IRUSR | S_IWUSR | IPC_CREAT); #} # #$sem->op(0, -1, SEM_UNDO); #if (!-f "${dir}repodata/repomd.xml") { system($INC[0].'/download', "${dir}repodata", "${baseurl}repodata/repomd.xml"); #} #$sem->op(0, 1, SEM_UNDO); #$sem->remove(); } else { $dir = $url; } $dir .= '/' unless $dir =~ /\/$/; $baseurl .= '/' unless $baseurl =~ /\/$/; if (! -s "${dir}repodata/repomd.xml") { die("zypp repo $url is not up to date, please refresh first\n") if $opt_zypp; die("repo $url does not contain a repomd.xml file\n"); } my @primaryfiles; Build::Rpmmd::parse_repomd("${dir}repodata/repomd.xml", \@primaryfiles); @primaryfiles = grep {$_->{'type'} eq 'primary' && defined($_->{'location'})} @primaryfiles; # print Dumper(\@primaryfiles); for my $f (@primaryfiles) { my $u = "$dir$f->{'location'}"; if ($] > 5.007) { require Encode; utf8::downgrade($u); } my $cached; #my $sem; #my $key = IPC::SysV::ftok("${dir}repodata/", '1'); #if ($sem = IPC::Semaphore->new($key, 1, S_IRUSR | S_IWUSR | IPC_CREAT | IPC_EXCL)) { # $sem->setval(0, 1); #} else { # $sem = IPC::Semaphore->new($key, 1, S_IRUSR | S_IWUSR | IPC_CREAT); #} #$sem->op(0, -1, SEM_UNDO); if (-e $u) { $cached = 1; $cached = 0 if exists($f->{'size'}) && $f->{'size'} != (-s _); $cached = 0 if !exists($f->{'size'}) && $u !~ /[0-9a-f]{32}-primary/; } if (!$cached) { die("zypp repo $url is not up to date, please refresh first\n") if $opt_zypp; if ($url =~ /^(?:ftps?|https?):\/\/([^\/]*)\/?/) { if (system("$INC[0]/download", "${dir}repodata/", "${baseurl}repodata/" . basename($u))) { die("download failed\n"); } } else { die("inconsistent repodata in $url\n"); } } #$sem->op(0, 1, SEM_UNDO); #$sem->remove(); my $fh; open($fh, '<', $u) or die "Error opening $u: $!\n"; if ($u =~ /\.gz$/) { use IO::Uncompress::Gunzip qw($GunzipError); $fh = new IO::Uncompress::Gunzip $fh or die "Error opening $u: $GunzipError\n"; } Build::Rpmmd::parse($fh, sub { if ($opt_dump) { $_[0]->{'baseurl'} = $baseurl; push @packages, $_[0] if $opt_dump; } if ($opt_bc) { Build::writedeps(\*STDOUT, $_[0], $baseurl); } elsif ($opt_old) { printold($_[0], $baseurl, $old_seen); } }, 'addselfprovides' => 1); close($fh); } } if ($opt_dump) { print Data::Dumper->Dump([\@packages], ['packages']); # caution: excessive memory consumption! }