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