createrepomddeps

   1 #!/usr/bin/perl -w
   2
   3 BEGIN {
   4   unshift @INC, ($::ENV{'BUILD_DIR'} || '/usr/lib/build');
   5 }
   6
   7 use strict;
   8 use XML::Parser;
   9 use Data::Dumper;
  10 use Getopt::Long;
  11 use Build::Rpm;
  12 use Digest::MD5 qw(md5 md5_hex md5_base64);
  13 use File::Path qw(mkpath rmtree);
  14 use File::Basename;
  15 use LWP::UserAgent;
  16 use URI;
  17 Getopt::Long::Configure("no_ignore_case");
  18
  19 my @parent = [];
  20 my @primaryfiles = ();
  21 my @packages = ();
  22
  23 my $baseurl; # current url
  24
  25 my $opt_dump;
  26 my $opt_old;
  27 my $opt_nosrc;
  28 my $opt_bc;
  29 my $cachedir = "/var/cache/build";
  30
  31 my $old_seen = ();
  32
  33 my $repomdparser = {
  34   repomd => {
  35     data => {
  36       _start => \&repomd_handle_data_start,
  37       location => {
  38         _start => \&repomd_handle_location,
  39       },
  40     },
  41   },
  42 };
  43
  44 my $primaryparser = {
  45   metadata => {
  46     'package' => {
  47       _start => \&primary_handle_package_start,
  48       _end => \&primary_handle_package_end,
  49       name => { _text => \&primary_collect_text, _end => \&primary_store_text },
  50       arch => { _text => \&primary_collect_text, _end => \&primary_store_text },
  51       version => { _start => \&primary_handle_version },
  52       'time' => { _start => \&primary_handle_time },
  53       format => {
  54         'rpm:provides' => { 'rpm:entry' => { _start => \&primary_handle_package_provides }, },
  55         'rpm:requires' => { 'rpm:entry' => { _start => \&primary_handle_package_requires }, },
  56         'rpm:conflicts' => { 'rpm:entry' => { _start => \&primary_handle_package_conflicts }, },
  57         'rpm:obsoletes' => { 'rpm:entry' => { _start => \&primary_handle_package_obsoletes }, },
  58         'rpm:buildhost' => { _text => \&primary_collect_text, _end => \&primary_store_text },
  59         'rpm:sourcerpm' => { _text => \&primary_collect_text, _end => \&primary_store_text },
  60 ### currently commented out, as we ignore file provides in createrpmdeps
  61 #       file => {
  62 #         _start => \&primary_handle_file_start,
  63 #         _text => \&primary_collect_text,
  64 #         _end => \&primary_handle_file_end
  65 #       },
  66       },
  67       location => { _start => \&primary_handle_package_location },
  68     },
  69   },
  70 };
  71
  72 # [ [tag, \%], ... ]
  73 my @cursor = ();
  74
  75 sub repomd_handle_data_start
  76 {
  77   my $p = shift;
  78   my $el = shift;
  79
  80   my $attr = map_attrs(@_);
  81   if($attr->{'type'} ne 'primary') {
  82     pop @cursor;
  83   }
  84 }
  85
  86 sub repomd_handle_location
  87 {
  88   my $p = shift;
  89   my $el = shift;
  90
  91   my $attr = map_attrs(@_);
  92   if(exists $attr->{'href'}) {
  93     push @primaryfiles, { location => $attr->{'href'} };
  94   }
  95 }
  96
  97 sub generic_handle_start
  98 {
  99   my $p = shift;
 100   my $el = shift;
 101
 102   if(exists $cursor[-1]->[1]->{$el})
 103   {
 104     my $h = $cursor[-1]->[1]->{$el};
 105     push @cursor, [$el, $h];
 106     if(exists $h->{'_start'}) {
 107       &{$h->{'_start'}}($p, $el, @_);
 108     }
 109   }
 110 }
 111
 112 sub generic_handle_char
 113 {
 114   my $p = shift;
 115   my $text = shift;
 116
 117   my $h = $cursor[-1]->[1];
 118
 119   if(exists $h->{'_text'}) {
 120     &{$h->{'_text'}}($p, $text);
 121   }
 122 }
 123
 124 sub generic_handle_end
 125 {
 126   my $p = shift;
 127   my $el = shift;
 128
 129   if(!defined $cursor[-1]->[0] || $cursor[-1]->[0] eq $el)
 130   {
 131     my $h = $cursor[-1]->[1];
 132
 133     if(exists $h->{'_end'}) {
 134       &{$h->{'_end'}}($p, $el);
 135     }
 136
 137     pop @cursor;
 138   }
 139 }
 140
 141 sub map_attrs
 142 {
 143   my %h;
 144   while(@_) {
 145     my $k = shift;
 146     $h{$k} = shift;
 147   }
 148
 149   return \%h;
 150 }
 151
 152 # expat does not guarantee that character data doesn't get split up
 153 # between multiple calls
 154 my $textbuf = '';
 155 sub primary_collect_text
 156 {
 157   my $p = shift;
 158   my $text = shift;
 159
 160   $textbuf .= $text;
 161 }
 162
 163 sub primary_store_text
 164 {
 165     my $p = shift;
 166     my $el = shift;
 167
 168     $packages[-1]->{$cursor[-1]->[0]} = $textbuf;
 169     $textbuf = '';
 170 }
 171
 172 sub primary_handle_package_start
 173 {
 174   my $p = shift;
 175   my $el = shift;
 176
 177   my $attr = map_attrs(@_);
 178
 179   push @packages, { type => $attr->{'type'}, baseurl => $baseurl };
 180 }
 181
 182 sub primary_handle_package_end
 183 {
 184   my $p = shift;
 185   my $el = shift;
 186
 187   if($opt_bc) {
 188       printasbuildcachefile(@packages);
 189       shift @packages;
 190   } elsif ($opt_old) {
 191       foreach my $pkg (@packages) {
 192     my $arch = $pkg->{'arch'};
 193     $arch = 'src' if $pkg->{'arch'} eq 'nosrc';
 194     next if ($arch eq 'src' && $opt_nosrc);
 195     if(exists($old_seen->{$pkg->{'name'}}->{$arch})) {
 196         my $pv = $old_seen->{$pkg->{'name'}}->{$arch}->{'ver'};
 197         my $rv = $pkg->{'ver'}.'-'.$pkg->{'rel'};
 198         my $vv = Build::Rpm::verscmp($pv, $rv, 0);
 199         if($vv < 0)
 200         {
 201       print $old_seen->{$pkg->{'name'}}->{$arch}->{'loc'}."\n";
 202       $old_seen->{$pkg->{'name'}}->{$arch}->{'ver'} = $pkg->{'ver'}.'-'.$pkg->{'rel'};
 203       $old_seen->{$pkg->{'name'}}->{$arch}->{'loc'} = $pkg->{'baseurl'} . $pkg->{'location'};
 204         } else {
 205       print $pkg->{'baseurl'} . $pkg->{'location'}."\n";
 206         }
 207     } else {
 208         $old_seen->{$pkg->{'name'}}->{$arch}->{'ver'} = $pkg->{'ver'}.'-'.$pkg->{'rel'};
 209         $old_seen->{$pkg->{'name'}}->{$arch}->{'loc'} = $pkg->{'baseurl'} . $pkg->{'location'};
 210     }
 211       }
 212       shift @packages;
 213   }
 214 }
 215
 216 sub primary_handle_version
 217 {
 218   my $p = shift;
 219   my $el = shift;
 220
 221   my $attr = map_attrs(@_);
 222   $packages[-1]->{'ver'} = $attr->{'ver'};
 223   $packages[-1]->{'rel'} = $attr->{'rel'};
 224 }
 225
 226 sub primary_handle_time
 227 {
 228   my $p = shift;
 229   my $el = shift;
 230
 231   my $attr = map_attrs(@_);
 232   $packages[-1]->{'filetime'} = $attr->{'file'};
 233   $packages[-1]->{'buildtime'} = $attr->{'build'};
 234 }
 235
 236 sub primary_handle_package_location
 237 {
 238   my $p = shift;
 239   my $el = shift;
 240
 241   my $attr = map_attrs(@_);
 242   $packages[-1]->{'location'} = $attr->{'href'};
 243 }
 244
 245 sub primary_handle_file_start
 246 {
 247   my $p = shift;
 248   my $el = shift;
 249
 250   my $attr = map_attrs(@_);
 251   if(exists $attr->{'type'}) {
 252     pop @cursor;
 253   }
 254 }
 255
 256 sub primary_handle_file_end
 257 {
 258   my $p = shift;
 259   my $text = shift;
 260
 261   primary_handle_package_deps('provides', 'name', $textbuf);
 262   $textbuf = '';
 263 }
 264
 265 my %flagmap = (
 266   EQ => '=',
 267   LE => '<=',
 268   GE => '>=',
 269   GT => '>',
 270   LT => '<',
 271   NE => '!=',
 272 );
 273
 274 sub primary_handle_package_deps
 275 {
 276   my $dep = shift;
 277   my $attr = map_attrs(@_);
 278
 279   if(exists $attr->{'flags'}) {
 280     if(!exists($flagmap{$attr->{'flags'}})) {
 281       print STDERR "bogus relation: ", $attr->{'flags'}, "\n";
 282       return;
 283     }
 284     $attr->{'flags'} = $flagmap{$attr->{'flags'}};
 285   }
 286   return if($attr->{'name'} =~ /^rpmlib\(/);
 287   push @{$packages[-1]->{$dep}}, $attr;
 288
 289 }
 290
 291 sub primary_handle_package_conflicts
 292 {
 293   shift;shift; primary_handle_package_deps('conflicts', @_);
 294 }
 295
 296 sub primary_handle_package_obsoletes
 297 {
 298   shift;shift; primary_handle_package_deps('obsoletes', @_);
 299 }
 300
 301 sub primary_handle_package_requires
 302 {
 303   shift;shift; primary_handle_package_deps('requires', @_);
 304 }
 305 sub primary_handle_package_provides
 306 {
 307   shift;shift; primary_handle_package_deps('provides', @_);
 308 }
 309
 310 sub deps2string
 311 {
 312   return join(' ', map {
 313         my $s = $_->{'name'};
 314         if(exists $_->{'flags'}) {
 315           $s .= ' '.$_->{'flags'}.' ';
 316           $s .= $_->{'epoch'}.':' if(exists $_->{'epoch'} && $_->{'epoch'} != 0);
 317           $s .= $_->{'ver'};
 318           $s .= '-'.$_->{'rel'} if exists $_->{'rel'};
 319         }
 320         $s
 321       } @_);
 322 }
 323
 324 sub printasbuildcachefile(@)
 325 {
 326   foreach my $pkg (@_) {
 327     next if $pkg->{'arch'} eq 'src' || $pkg->{'arch'} eq 'nosrc';
 328     my $id = sprintf("%s.%s-%d/%d/%d: ",
 329       $pkg->{'name'},
 330       $pkg->{'arch'},
 331       $pkg->{'buildtime'},
 332       $pkg->{'filetime'},
 333       0);
 334     print "F:".$id. $pkg->{'baseurl'} . $pkg->{'location'} . "\n";
 335
 336     my $deps = deps2string(@{$pkg->{'provides'}});
 337     print "P:$id$deps\n";
 338
 339     $deps = deps2string(@{$pkg->{'requires'}});
 340     print "R:$id$deps\n";
 341
 342     my $tag = sprintf("%s-%s-%s %s",
 343       $pkg->{'name'},
 344       $pkg->{'ver'},
 345       $pkg->{'rel'},
 346 #      $pkg->{'rpm:buildhost'},
 347       $pkg->{'buildtime'});
 348     print "I:$id$tag\n";
 349   }
 350 }
 351
 352 sub getmetadata
 353 {
 354   my $url = $_[0];
 355   my $dir = $_[1];
 356
 357   my $dest = $dir . "repodata";
 358   mkpath($dest);
 359   system($INC[0].'/download', $dest, $url . "repodata/repomd.xml");
 360 }
 361
 362 ### main
 363
 364 GetOptions (
 365     "nosrc"   => \$opt_nosrc,
 366     "dump"   => \$opt_dump,
 367     "old"   => \$opt_old,
 368     "cachedir=s"  => \$cachedir,
 369     ) or exit(1);
 370
 371 $opt_bc = 1 unless ($opt_dump || $opt_old);
 372
 373 my $p = new XML::Parser(
 374   Handlers => {
 375     Start => \&generic_handle_start,
 376     End => \&generic_handle_end,
 377     Char => \&generic_handle_char
 378   });
 379
 380 #my $url = '/mounts/mirror/SuSE/ftp.suse.com/pub/suse/update/10.1/';
 381 for my $url (@ARGV) {
 382   my $dir;
 383   if ($url =~ /^zypp:\/\/([^\/]*)\/?/) {
 384     use Build::Zypp;
 385     my $repo = Build::Zypp::parsecfg($1);
 386     die "can't parse $1\n" unless $repo;
 387     my $type = $repo->{'type'};
 388     if($type eq 'rpm-md') {
 389       my $name = $repo->{'name'};
 390       $dir = "/var/cache/zypp/raw/$name/";
 391       $baseurl = $url;
 392       $baseurl .= '/' unless $baseurl =~ /\/$/;
 393     } elsif ($type eq 'yast2') {
 394       # XXX
 395       exec ($INC[0].'/createyastdeps', $url);
 396     } else {
 397       die "unsupported repo type: $type\n";
 398     }
 399   } elsif ($url =~ /^http:\/\/([^\/]*)\/?/) {
 400     my $repoid = md5_hex($url);
 401     $dir = "$cachedir/$repoid/";
 402     $baseurl = $url;
 403     $baseurl .= '/' unless $baseurl =~ /\/$/;
 404     getmetadata($baseurl, $dir);
 405   } elsif ($url =~ /^arch\@/) {
 406     exec ("$INC[0]/createarchdeps", "--cachedir=$cachedir", substr($url, 5));
 407   } else {
 408     $dir = $url;
 409     $dir .= '/' unless $dir =~ /\/$/;
 410     $baseurl = $dir;
 411   }
 412
 413   @primaryfiles = ();
 414   @cursor = ([undef, $repomdparser]);
 415
 416   $p->parsefile($dir . 'repodata/repomd.xml');
 417
 418 #  print Dumper(\@primaryfiles);
 419
 420   foreach my $f (@primaryfiles) {
 421     @cursor = ([undef, $primaryparser]);
 422
 423     my $u = $dir . $f->{'location'};
 424     if ($url =~ /^http:\/\/([^\/]*)\/?/) {
 425         if (system($INC[0].'/download', $dir . "repodata/", $baseurl . "repodata/" . basename($u))) {
 426           die("download failed\n");
 427         }
 428     }
 429     if ($] > 5.007) {
 430         require Encode;
 431         utf8::downgrade($u);
 432     }
 433     my $fh;
 434     open($fh, '<', $u) or die "Error opening $u: $!\n";
 435     if ($u =~ /\.gz$/) {
 436         use IO::Uncompress::Gunzip qw($GunzipError);
 437         $fh = new IO::Uncompress::Gunzip $fh or die "Error opening $u: $GunzipError\n";
 438     }
 439     $p->parse($fh);
 440     close($fh);
 441   }
 442 }
 443
 444 if ($opt_dump) {
 445     print Data::Dumper->Dump([\@packages], ['packages']); # caution: excessive memory consumption!
 446 }
 447
 448 #if($rpmdepdump) {
 449 #    my %amap = map { $_ => 1 } @archs;
 450 #    my $packages = do $rpmdepdump or die $!;
 451 #
 452 #    foreach my $pkg (@$packages) {
 453 #        next if exists $packs{$pkg->{'name'}};
 454 #        next unless exists $amap{$pkg->{'arch'}};
 455 #        next if $pkg->{'arch'} eq 'src' || $pkg->{'arch'} eq 'nosrc';
 456 #        next if $pkg->{'location'} =~ /\.(?:patch|delta)\.rpm$/;
 457 #
 458 #        my $pa = $pkg->{'name'}.'.'.$pkg->{'arch'};
 459 #        $packs{$pkg->{'name'}} = $pa;
 460 #        $fn{$pa} = $pkg->{'baseurl'}.$pkg->{'location'};
 461 #        my $r = {};
 462 #        # flags and version ignored
 463 #        my @pr = map { $_->{'name'} } @{$pkg->{'provides'}};
 464 #        my @re = map { $_->{'name'} } @{$pkg->{'requires'}};
 465 #        $r->{'provides'} = \@pr;
 466 #        $r->{'requires'} = \@re;
 467 #        $repo{$pkg->{'name'}} = $r;
 468 #    }
 469 #}