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