createrepomddeps

   1 #!/usr/bin/perl -w
   2
   3 ################################################################
   4 #
   5 # Copyright (c) 1995-2014 SUSE Linux Products GmbH
   6 #
   7 # This program is free software; you can redistribute it and/or modify
   8 # it under the terms of the GNU General Public License version 2 or 3 as
   9 # published by the Free Software Foundation.
  10 #
  11 # This program is distributed in the hope that it will be useful,
  12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 # GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License
  17 # along with this program (see the file COPYING); if not, write to the
  18 # Free Software Foundation, Inc.,
  19 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
  20 #
  21 ################################################################
  22
  23 BEGIN {
  24   unshift @INC, ($::ENV{'BUILD_DIR'} || '/usr/lib/build');
  25 }
  26
  27 use strict;
  28 use Data::Dumper;
  29 use Getopt::Long;
  30 use Build ':rpm';
  31 use Build::Rpm;
  32 use Build::Rpmmd;
  33 use Digest::MD5 ();
  34 use File::Path qw(mkpath rmtree);
  35 use File::Basename;
  36 use IPC::SysV qw(IPC_PRIVATE S_IRUSR S_IWUSR IPC_CREAT IPC_EXCL SEM_UNDO);
  37 use IPC::Semaphore;
  38
  39 Getopt::Long::Configure("no_ignore_case");
  40
  41 my $opt_dump;
  42 my $opt_old;
  43 my $opt_nosrc;
  44 my $opt_bc;
  45 my $opt_zypp;
  46 my $cachedir = "/var/cache/build";
  47
  48 sub printold {
  49   my ($pkg, $baseurl, $old_seen) = @_;
  50
  51   my $arch = $pkg->{'arch'};
  52   $arch = 'src' if $pkg->{'arch'} eq 'nosrc';
  53   return if $arch eq 'src' && $opt_nosrc;
  54   my $evr = $pkg->{'version'}.'-'.$pkg->{'release'};
  55   $evr = "$pkg->{'epoch'}:$evr" if $pkg->{'epoch'};
  56   my $loc = $baseurl . $pkg->{'location'};
  57   if ($old_seen->{$pkg->{'name'}}->{$arch}) {
  58     my $vv = Build::Rpm::verscmp($old_seen->{$pkg->{'name'}}->{$arch}->{'evr'}, $evr, 0);
  59     if ($vv >= 0) {
  60       print "$loc\n";
  61       return;
  62     }
  63     print $old_seen->{$pkg->{'name'}}->{$arch}->{'loc'}."\n";
  64   }
  65   $old_seen->{$pkg->{'name'}}->{$arch}->{'evr'} = $evr;
  66   $old_seen->{$pkg->{'name'}}->{$arch}->{'loc'} = $loc;
  67 }
  68
  69 GetOptions (
  70   "nosrc"   => \$opt_nosrc,
  71   "dump"   => \$opt_dump,
  72   "old"   => \$opt_old,
  73   "zypp=s"   => \$opt_zypp,
  74   "cachedir=s"  => \$cachedir,
  75   ) or exit(1);
  76
  77 $opt_bc = 1 unless $opt_dump || $opt_old;
  78
  79 my $old_seen = {};      # for opt_old
  80 my @packages;           # for opt_dump
  81
  82 for my $url (@ARGV) {
  83   my $dir;
  84   my $baseurl = $url;
  85   if ($opt_zypp) {
  86     $dir = $opt_zypp;
  87   } elsif ($url =~ /^(?:ftps?|https?):\/\/([^\/]*)\/?/) {
  88     my $repoid = Digest::MD5::md5_hex($url);
  89     $dir = "$cachedir/$repoid/";
  90     $baseurl .= '/' unless $baseurl =~ /\/$/;
  91     mkpath("${dir}repodata");
  92     my $sem;
  93     my $key = IPC::SysV::ftok($dir, '1');
  94     if ($sem = IPC::Semaphore->new($key, 1, S_IRUSR | S_IWUSR | IPC_CREAT | IPC_EXCL)) {
  95       $sem->setval(0, 1);
  96     } else {
  97       $sem = IPC::Semaphore->new($key, 1, S_IRUSR | S_IWUSR | IPC_CREAT);
  98     }
  99
 100     $sem->op(0, -1, SEM_UNDO);
 101     if (!-f "${dir}repodata/repomd.xml") {
 102       system($INC[0].'/download', "${dir}repodata", "${baseurl}repodata/repomd.xml");
 103     }
 104     $sem->op(0, 1, SEM_UNDO);
 105     $sem->remove();
 106   } else {
 107     $dir = $url;
 108   }
 109   $dir .= '/' unless $dir =~ /\/$/;
 110   $baseurl .= '/' unless $baseurl =~ /\/$/;
 111
 112   if (! -s "${dir}repodata/repomd.xml") {
 113     die("zypp repo $url is not up to date, please refresh first\n") if $opt_zypp;
 114     die("repo $url does not contain a repomd.xml file\n");
 115   }
 116
 117   my @primaryfiles;
 118   Build::Rpmmd::parse_repomd("${dir}repodata/repomd.xml", \@primaryfiles);
 119   @primaryfiles = grep {$_->{'type'} eq 'primary' && defined($_->{'location'})} @primaryfiles;
 120 #  print Dumper(\@primaryfiles);
 121
 122   for my $f (@primaryfiles) {
 123     my $u = "$dir$f->{'location'}";
 124     if ($] > 5.007) {
 125       require Encode;
 126       utf8::downgrade($u);
 127     }
 128     my $cached;
 129     my $sem;
 130     my $key = IPC::SysV::ftok("${dir}repodata/", '1');
 131     if ($sem = IPC::Semaphore->new($key, 1, S_IRUSR | S_IWUSR | IPC_CREAT | IPC_EXCL)) {
 132       $sem->setval(0, 1);
 133     } else {
 134       $sem = IPC::Semaphore->new($key, 1, S_IRUSR | S_IWUSR | IPC_CREAT);
 135     }
 136     $sem->op(0, -1, SEM_UNDO);
 137     if (-e $u) {
 138       $cached = 1;
 139       $cached = 0 if exists($f->{'size'}) && $f->{'size'} != (-s _);
 140       $cached = 0 if !exists($f->{'size'}) && $u !~ /[0-9a-f]{32}-primary/;
 141     }
 142     if (!$cached) {
 143       die("zypp repo $url is not up to date, please refresh first\n") if $opt_zypp;
 144       if ($url =~ /^(?:ftps?|https?):\/\/([^\/]*)\/?/) {
 145         if (system("$INC[0]/download", "${dir}repodata/", "${baseurl}repodata/" . basename($u))) {
 146           die("download failed\n");
 147         }
 148       } else {
 149         die("inconsistent repodata in $url\n");
 150       }
 151     }
 152     $sem->op(0, 1, SEM_UNDO);
 153     $sem->remove();
 154
 155     my $fh;
 156     open($fh, '<', $u) or die "Error opening $u: $!\n";
 157     if ($u =~ /\.gz$/) {
 158       use IO::Uncompress::Gunzip qw($GunzipError);
 159       $fh = new IO::Uncompress::Gunzip $fh or die "Error opening $u: $GunzipError\n";
 160     }
 161     Build::Rpmmd::parse($fh, sub {
 162       if ($opt_dump) {
 163         $_[0]->{'baseurl'} = $baseurl;
 164         push @packages, $_[0] if $opt_dump;
 165       }
 166       if ($opt_bc) {
 167         Build::writedeps(\*STDOUT, $_[0], $baseurl);
 168       } elsif ($opt_old) {
 169         printold($_[0], $baseurl, $old_seen);
 170       }
 171     }, 'addselfprovides' => 1);
 172     close($fh);
 173   }
 174 }
 175
 176 if ($opt_dump) {
 177   print Data::Dumper->Dump([\@packages], ['packages']); # caution: excessive memory consumption!
 178 }
 179