[build] fix typo in qemu-reg
[opensuse:build.git] / mkbaselibs
1 #!/usr/bin/perl -w
2
3 use POSIX;
4 use strict;
5 use File::Temp qw/tempfile tempdir/;
6
7 # See: http://www.rpm.org/max-rpm/s1-rpm-file-format-rpm-file-format.html#S3-RPM-FILE-FORMAT-HEADER-TAG-LISTING
8 # cf http://search.cpan.org/~davecross/Parse-RPM-Spec-0.01/lib/Parse/RPM/Spec.pm
9 my %STAG = (
10         "NAME"          => 1000,
11         "VERSION"       => 1001,
12         "RELEASE"       => 1002,
13         "EPOCH"         => 1003,
14         "SERIAL"        => 1003,
15         "SUMMARY"       => 1004,
16         "DESCRIPTION"   => 1005,
17         "BUILDTIME"     => 1006,
18         "BUILDHOST"     => 1007,
19         "INSTALLTIME"   => 1008,
20         "SIZE"          => 1009,
21         "DISTRIBUTION"  => 1010,
22         "VENDOR"        => 1011,
23         "GIF"           => 1012,
24         "XPM"           => 1013,
25         "LICENSE"       => 1014,
26         "COPYRIGHT"     => 1014,
27         "PACKAGER"      => 1015,
28         "GROUP"         => 1016,
29         "SOURCE"        => 1018,
30         "PATCH"         => 1019,
31         "URL"           => 1020,
32         "OS"            => 1021,
33         "ARCH"          => 1022,
34         "PREIN"         => 1023,
35         "POSTIN"        => 1024,
36         "PREUN"         => 1025,
37         "POSTUN"        => 1026,
38         "OLDFILENAMES"  => 1027,
39         "FILESIZES"     => 1028,
40         "FILESTATES"    => 1029,
41         "FILEMODES"     => 1030,
42         "FILERDEVS"     => 1033,
43         "FILEMTIMES"    => 1034,
44         "FILEMD5S"      => 1035,
45         "FILELINKTOS"   => 1036,
46         "FILEFLAGS"     => 1037,
47         "FILEUSERNAME"  => 1039,
48         "FILEGROUPNAME" => 1040,
49         "ICON"          => 1043,
50         "SOURCERPM"     => 1044,
51         "FILEVERIFYFLAGS"       => 1045,
52         "ARCHIVESIZE"   => 1046,
53         "PROVIDENAME"   => 1047,
54         "PROVIDES"      => 1047,
55         "REQUIREFLAGS"  => 1048,
56         "REQUIRENAME"   => 1049,
57         "REQUIREVERSION"        => 1050,
58         "NOSOURCE"      => 1051,
59         "NOPATCH"       => 1052,
60         "CONFLICTFLAGS" => 1053,
61         "CONFLICTNAME"  => 1054,
62         "CONFLICTVERSION"       => 1055,
63         "EXCLUDEARCH"   => 1059,
64         "EXCLUDEOS"     => 1060,
65         "EXCLUSIVEARCH" => 1061,
66         "EXCLUSIVEOS"   => 1062,
67         "RPMVERSION"    => 1064,
68         "TRIGGERSCRIPTS"        => 1065,
69         "TRIGGERNAME"   => 1066,
70         "TRIGGERVERSION"        => 1067,
71         "TRIGGERFLAGS"  => 1068,
72         "TRIGGERINDEX"  => 1069,
73         "VERIFYSCRIPT"  => 1079,
74         "CHANGELOGTIME" => 1080,
75         "CHANGELOGNAME" => 1081,
76         "CHANGELOGTEXT" => 1082,
77         "PREINPROG"     => 1085,
78         "POSTINPROG"    => 1086,
79         "PREUNPROG"     => 1087,
80         "POSTUNPROG"    => 1088,
81         "BUILDARCHS"    => 1089,
82         "OBSOLETENAME"  => 1090,
83         "OBSOLETES"     => 1090,
84         "VERIFYSCRIPTPROG"      => 1091,
85         "TRIGGERSCRIPTPROG"     => 1092,
86         "COOKIE"        => 1094,
87         "FILEDEVICES"   => 1095,
88         "FILEINODES"    => 1096,
89         "FILELANGS"     => 1097,
90         "PREFIXES"      => 1098,
91         "INSTPREFIXES"  => 1099,
92         "SOURCEPACKAGE" => 1106,
93         "PROVIDEFLAGS"  => 1112,
94         "PROVIDEVERSION"        => 1113,
95         "OBSOLETEFLAGS" => 1114,
96         "OBSOLETEVERSION"       => 1115,
97         "DIRINDEXES"    => 1116,
98         "BASENAMES"     => 1117,
99         "DIRNAMES"      => 1118,
100         "OPTFLAGS"      => 1122,
101         "DISTURL"       => 1123,
102         "PAYLOADFORMAT" => 1124,
103         "PAYLOADCOMPRESSOR"     => 1125,
104         "PAYLOADFLAGS"  => 1126,
105         "INSTALLCOLOR"  => 1127,
106         "INSTALLTID"    => 1128,
107         "REMOVETID"     => 1129,
108         "RHNPLATFORM"   => 1131,
109         "PLATFORM"      => 1132,
110         "PATCHESNAME"   => 1133,
111         "PATCHESFLAGS"  => 1134,
112         "PATCHESVERSION"        => 1135,
113         "CACHECTIME"    => 1136,
114         "CACHEPKGPATH"  => 1137,
115         "CACHEPKGSIZE"  => 1138,
116         "CACHEPKGMTIME" => 1139,
117         "FILECOLORS"    => 1140,
118         "FILECLASS"     => 1141,
119         "CLASSDICT"     => 1142,
120         "FILEDEPENDSX"  => 1143,
121         "FILEDEPENDSN"  => 1144,
122         "DEPENDSDICT"   => 1145,
123         "SOURCEPKGID"   => 1146,
124         "PRETRANS"      => 1151,
125         "POSTTRANS"     => 1152,
126         "PRETRANSPROG"  => 1153,
127         "POSTTRANSPROG" => 1154,
128         "DISTTAG"       => 1155,
129         "SUGGESTSNAME"  => 1156,
130         "SUGGESTSVERSION"       => 1157,
131         "SUGGESTSFLAGS" => 1158,
132         "ENHANCESNAME"  => 1159,
133         "ENHANCESVERSION"       => 1160,
134         "ENHANCESFLAGS" => 1161,
135         "PRIORITY"      => 1162,
136         "CVSID"         => 1163,
137 );
138
139 # do not mix numeric tags with symbolic tags.
140 # special symbolic tag 'FILENAME' exists.
141
142 # This function seems to take a set of tags and populates a global
143 # hash-table (%res) with data obtained by doing a binary unpack() on
144 # the raw package
145 # http://www.rpm.org/max-rpm/s1-rpm-file-format-rpm-file-format.html
146
147 sub rpmq_many {
148   my $rpm = shift;
149   my @stags = @_;
150
151   my $need_filenames = grep { $_ eq 'FILENAMES' } @stags;
152   push @stags, 'BASENAMES', 'DIRNAMES', 'DIRINDEXES', 'OLDFILENAMES' if $need_filenames;
153   @stags = grep { $_ ne 'FILENAMES' } @stags if $need_filenames;
154   my %stags = map {0+($STAG{$_} or $_) => $_} @stags;
155
156   my ($magic, $sigtype, $headmagic, $cnt, $cntdata, $lead, $head, $index, $data, $tag, $type, $offset, $count);
157
158   local *RPM;
159   if (ref($rpm) eq 'ARRAY') {
160     ($headmagic, $cnt, $cntdata) = unpack('N@8NN', $rpm->[0]);
161     if ($headmagic != 0x8eade801) {
162       warn("Bad rpm\n");
163       return ();
164     }
165     if (length($rpm->[0]) < 16 + $cnt * 16 + $cntdata) {
166       warn("Bad rpm\n");
167       return ();
168     }
169     $index = substr($rpm->[0], 16, $cnt * 16);
170     $data = substr($rpm->[0], 16 + $cnt * 16, $cntdata);
171   } else {
172     return () unless open(RPM, "<$rpm");
173     if (read(RPM, $lead, 96) != 96) {
174       warn("Bad rpm $rpm\n");
175       close RPM;
176       return ();
177     }
178     ($magic, $sigtype) = unpack('N@78n', $lead);
179     if ($magic != 0xedabeedb || $sigtype != 5) {
180       warn("Bad rpm $rpm\n");
181       close RPM;
182       return ();
183     }
184     if (read(RPM, $head, 16) != 16) {
185       warn("Bad rpm $rpm\n");
186       close RPM;
187       return ();
188     }
189     ($headmagic, $cnt, $cntdata) = unpack('N@8NN', $head);
190     if ($headmagic != 0x8eade801) {
191       warn("Bad rpm $rpm\n");
192       close RPM;
193       return ();
194     }
195     if (read(RPM, $index, $cnt * 16) != $cnt * 16) {
196       warn("Bad rpm $rpm\n");
197       close RPM;
198       return ();
199     }
200     $cntdata = ($cntdata + 7) & ~7;
201     if (read(RPM, $data, $cntdata) != $cntdata) {
202       warn("Bad rpm $rpm\n");
203       close RPM;
204       return ();
205     }
206   }
207
208   my %res = ();
209
210   if (ref($rpm) eq 'ARRAY' && @stags && @$rpm > 1) {
211     my %res2 = &rpmq_many([ $rpm->[1] ], @stags);
212     %res = (%res, %res2);
213     return %res;
214   }
215
216   if (ref($rpm) ne 'ARRAY' && @stags) {
217     if (read(RPM, $head, 16) != 16) {
218       warn("Bad rpm $rpm\n");
219       close RPM;
220       return ();
221     }
222     ($headmagic, $cnt, $cntdata) = unpack('N@8NN', $head);
223     if ($headmagic != 0x8eade801) {
224       warn("Bad rpm $rpm\n");
225       close RPM;
226       return ();
227     }
228     if (read(RPM, $index, $cnt * 16) != $cnt * 16) {
229       warn("Bad rpm $rpm\n");
230       close RPM;
231       return ();
232     }
233     if (read(RPM, $data, $cntdata) != $cntdata) {
234       warn("Bad rpm $rpm\n");
235       close RPM;
236       return ();
237     }
238   }
239   close RPM if ref($rpm) ne 'ARRAY';
240
241   return %res unless @stags;    # nothing to do
242
243   while($cnt-- > 0) {
244     ($tag, $type, $offset, $count, $index) = unpack('N4a*', $index);
245     $tag = 0+$tag;
246     if ($stags{$tag}) {
247       eval {
248         my $otag = $stags{$tag};
249         if ($type == 0) {
250           $res{$otag} = [ '' ];
251         } elsif ($type == 1) {
252           $res{$otag} = [ unpack("\@${offset}c$count", $data) ];
253         } elsif ($type == 2) {
254           $res{$otag} = [ unpack("\@${offset}c$count", $data) ];
255         } elsif ($type == 3) {
256           $res{$otag} = [ unpack("\@${offset}n$count", $data) ];
257         } elsif ($type == 4) {
258           $res{$otag} = [ unpack("\@${offset}N$count", $data) ];
259         } elsif ($type == 5) {
260           $res{$otag} = [ undef ];
261         } elsif ($type == 6) {
262           $res{$otag} = [ unpack("\@${offset}Z*", $data) ];
263         } elsif ($type == 7) {
264           $res{$otag} = [ unpack("\@${offset}a$count", $data) ];
265         } elsif ($type == 8 || $type == 9) {
266           my $d = unpack("\@${offset}a*", $data);
267           my @res = split("\0", $d, $count + 1);
268           $res{$otag} = [ splice @res, 0, $count ];
269         } else {
270           $res{$otag} = [ undef ];
271         }
272       };
273       if ($@) {
274         warn("Bad rpm $rpm: $@\n");
275         return ();
276       }
277     }
278   }
279
280   if ($need_filenames) {
281     if ($res{'OLDFILENAMES'}) {
282       $res{'FILENAMES'} = [ @{$res{'OLDFILENAMES'}} ];
283     } else {
284       my $i = 0;
285       $res{'FILENAMES'} = [ map {"$res{'DIRNAMES'}->[$res{'DIRINDEXES'}->[$i++]]$_"} @{$res{'BASENAMES'}} ];
286     }
287   }
288   return %res;
289 }
290
291 sub rpmq_add_flagsvers {
292   my $res = shift;
293   my $name = shift;
294   my $flags = shift;
295   my $vers = shift;
296
297   return unless $res;
298   my @flags = @{$res->{$flags} || []};
299   my @vers = @{$res->{$vers} || []};
300   for (@{$res->{$name}}) {
301     if (@flags && ($flags[0] & 0xe) && @vers) {
302       $_ .= ' ';
303       $_ .= '<' if $flags[0] & 2;
304       $_ .= '>' if $flags[0] & 4;
305       $_ .= '=' if $flags[0] & 8;
306       $_ .= " $vers[0]";
307     }
308     shift @flags;
309     shift @vers;
310   }
311 }
312
313 my @preamble = qw{
314   Name Version Release Epoch Summary Copyright License Distribution
315   Disturl Vendor Group Packager Url Icon Prefixes
316 };
317
318 my $rpm;
319 my $arch;
320
321 my $config = '';
322
323 my $targettype;
324 my $targetarch;
325 my $prefix;
326 my $extension;
327 my $configdir;
328 my $targetname;
329 my $legacyversion;
330
331 my @baselib;
332 my @config;
333
334 my @provides;
335 my @obsoletes;
336 my @requires;
337 my @prerequires;
338 my @conflicts;
339 my @recommends;
340 my @supplements;
341 my @suggests;
342
343 my @prein;
344 my @postin;
345 my @preun;
346 my @postun;
347 my $autoreqprov;
348
349 my $verbose;
350 my %target_matched;
351 my @filesystem;
352
353 # Used for each package by
354 sub parse_config {
355   my $target = shift;
356   my $pkgname = shift;
357   my $pkgver = shift;
358
359   my $pkghasmatched;
360
361   my $pkgmatches = 1;
362   $prefix = '';
363   $legacyversion = '';
364   $extension = '';
365   $configdir = '';
366   $targetname = '';
367   ($targetarch, $targettype) = split(':', $target, 2);
368   @baselib = ();
369   @config = ();
370   @provides = ();
371   @obsoletes = ();
372   @requires = ();
373   @recommends = ();
374   @supplements = ();
375   @suggests = ();
376   @prerequires = ();
377   @conflicts = ();
378   @prein = ();
379   @postin = ();
380   @preun = ();
381   @postun = ();
382   $autoreqprov = 'on';
383   my $match1 = '';
384
385   for (split("\n", $config)) {
386     s/^\s+//;
387     s/\s+$//;
388     next if $_ eq '' || $_ =~ /^#/;
389
390     s/\<targettype\>/$targettype/g;
391     s/\<targetarch\>/$targetarch/g;
392     s/\<name\>/$pkgname/g;
393     s/\<version\>/$pkgver/g;
394     s/\<prefix\>/$prefix/g;
395     s/\<extension\>/$extension/g;
396     s/\<configdir\>/$configdir/g;
397     s/\<match1\>/$match1/g;
398
399     if (/^arch\s+/) {
400       next unless s/^arch\s+\Q$arch\E\s+//;
401     }
402     next if /^targets\s+/;
403     if (/\s+package\s+[-+_a-zA-Z0-9]+$/) {
404       $pkgmatches = 0;  # XXX: hack
405     }
406     if (/\s+package\s+\/[-+_a-zA-Z0-9]+\/$/) {
407       $pkgmatches = 0;  # XXX: hack
408     }
409     if (/^targettype\s+/) {
410       next unless s/^targettype\s+\Q$targettype\E\s+//;
411     }
412     if (/^targetarch\s+/) {
413       next unless s/^targetarch\s+\Q$targetarch\E\s+//;
414     }
415     if (/^prefix\s+(.*?)$/) { $prefix = $1; next; }
416     if (/^legacyversion\s+(.*?)$/) { $legacyversion = $1; next; }
417     if (/^extension\s+(.*?)$/) { $extension = $1; next; }
418     if (/^configdir\s+(.*?)$/) { $configdir= $1; next; }
419     if (/^targetname\s+(.*?)$/) { $targetname = $1; next; }
420
421     $_ = "baselib $_" if /^[\+\-\"]/;
422     $_ = "package $_" if /^[-+_a-zA-Z0-9]+$/;
423     if (/^package\s+\/(.*?)\/$/) {
424       my $pm = $1;
425       $pkgmatches = $pkgname =~ /$pm/;
426       $match1 = $1 if defined $1;
427       $pkghasmatched |= $pkgmatches if $pkgname =~ /-debuginfo$/ && $target_matched{$target};
428       next;
429     }
430     if (/^package\s+(.*?)$/) {
431       $pkgmatches = $1 eq $pkgname;
432       $pkghasmatched |= $pkgmatches;
433       next;
434     }
435     next unless $pkgmatches;
436     return 0 if $_ eq 'block!';
437     if (/^provides\s+(.*?)$/) { push @provides, $1; next; }
438     if (/^requires\s+(.*?)$/) { push @requires, $1; next; }
439     if (/^recommends\s+(.*?)$/) { push @recommends, $1; next; }
440     if (/^supplements\s+(.*?)$/) { push @supplements, $1; next; }
441     if (/^suggests\s+(.*?)$/) { push @suggests, $1; next; }
442     if (/^prereq\s+(.*?)$/) { push @prerequires, $1; next; }
443     if (/^obsoletes\s+(.*?)$/) { push @obsoletes, $1; next; }
444     if (/^conflicts\s+(.*?)$/) { push @conflicts, $1; next; }
445     if (/^baselib\s+(.*?)$/) { push @baselib, $1; next; }
446     if (/^config\s+(.*?)$/) { push @config, $1; next; }
447     if (/^pre(in)?\s+(.*?)$/) { push @prein, $2; next; }
448     if (/^post(in)?\s+(.*?)$/) { push @postin, $2; next; }
449     if (/^preun\s+(.*?)$/) { push @preun, $1; next; }
450     if (/^postun\s+(.*?)$/) { push @preun, $1; next; }
451     if (/^autoreqprov\s+(.*?)$/) {$autoreqprov = $1; next; }
452     die("bad line: $_\n");
453   }
454   return $pkghasmatched;
455 }
456
457 sub read_config {
458   my $cfname = shift;
459   local *F;
460   open(F, "<$cfname") || die("$cfname: $!\n");
461   my @cf = <F>;
462   close F;
463   $config .= join('', @cf);
464   $config .= "\npackage __does_not_match__\n";
465 }
466
467 sub get_targets {
468   my $architecture = shift;
469   my $conf = shift;
470   my %targets;
471   for (split("\n", $conf)) {
472     if (/^arch\s+/) {
473       next unless s/^arch\s+\Q$architecture\E\s+//;
474     }
475     if (/^targets\s+(.*?)$/) {
476       $targets{$_} = 1 for split(' ', $1);
477     }
478   }
479   my @targets = sort keys %targets;
480   return @targets;
481 }
482
483 # Packages listed in config file
484 sub get_pkgnames {
485   my %rpms;
486   for (split("\n", $config)) {
487     if (/^(.*\s+)?package\s+([-+_a-zA-Z0-9]+)\s*$/) {  # eg : arch ppc package libnuma-devel
488       $rpms{$2} = 1;
489     } elsif (/^\s*([-+_a-zA-Z0-9]+)\s*$/) { # eg: readline-devel
490       $rpms{$1} = 1;
491     }
492   }
493   return sort keys %rpms;
494 }
495
496 # Packages listed in config file - debian variant (can have "." in package names)
497 sub get_debpkgnames {
498   my %debs;
499   for (split("\n", $config)) {
500     if (/^(.*\s+)?package\s+([-+_a-zA-Z0-9.]+)\s*$/) {  # eg : arch ppc package libnuma-devel
501       $debs{$2} = 1;
502     } elsif (/^\s*([-+_a-zA-Z0-9.]+)\s*$/) { # eg: readline-devel
503       $debs{$1} = 1;
504     }
505   }
506   return sort keys %debs;
507 }
508
509 sub handle_rpms {
510  for $rpm (@_) {
511
512   my @stags = map {uc($_)} @preamble;
513   push @stags, 'DESCRIPTION';
514   push @stags, 'FILENAMES', 'FILEMODES', 'FILEUSERNAME', 'FILEGROUPNAME', 'FILEFLAGS', 'FILEVERIFYFLAGS';
515   push @stags, 'CHANGELOGTIME', 'CHANGELOGNAME', 'CHANGELOGTEXT';
516   push @stags, 'ARCH', 'SOURCERPM', 'RPMVERSION';
517   push @stags, 'BUILDTIME';
518   my %res = rpmq_many($rpm, @stags);
519   die("$rpm: bad rpm\n") unless $res{'NAME'};
520
521   my $rname = $res{'NAME'}->[0];
522   my $sname = $res{'SOURCERPM'}->[0];
523   die("$rpm is a sourcerpm\n") unless $sname;
524   die("bad sourcerpm: $sname\n") unless $sname =~ /^(.*)-([^-]+)-([^-]+)\.(no)?src\.rpm$/;
525   $sname = $1;
526   my $sversion = $2;
527   my $srelease = $3;
528
529   $arch = $res{'ARCH'}->[0];
530   my @targets = get_targets($arch, $config);
531   if (!@targets) {
532     print "no targets for arch $arch, nothing to do\n";
533     exit(0);
534   }
535   for my $target (@targets) {
536
537     next unless parse_config($target, $res{'NAME'}->[0], $res{'VERSION'}->[0]);
538     die("targetname not set\n") unless $targetname;
539     $target_matched{$target} = 1;
540
541     my %ghosts;
542     my @rpmfiles = @{$res{'FILENAMES'}};
543     my @ff = @{$res{'FILEFLAGS'}};
544     for (@rpmfiles) {
545       $ghosts{$_} = 1 if $ff[0] & (1 << 6);
546       shift @ff;
547     }
548     my %files;
549     my %cfiles;
550     my %moves;
551     my %symlinks;
552     for my $r (@baselib) {
553       my $rr = substr($r, 1);
554       if (substr($r, 0, 1) eq '+') {
555         if ($rr =~ /^(.*?)\s*->\s*(.*?)$/) {
556           if (grep {$_ eq $1} @rpmfiles) {
557             $files{$1} = 1;
558             $moves{$1} = $2;
559           }
560         } else {
561           for (grep {/$rr/} @rpmfiles) {
562             $files{$_} = 1;
563             delete $moves{$_};
564           }
565         }
566       } elsif (substr($r, 0, 1) eq '-') {
567         delete $files{$_} for grep {/$rr/} keys %files;
568       } elsif (substr($r, 0, 1) eq '"') {
569         $rr =~ s/\"$//;
570         if ($rr =~ /^(.*?)\s*->\s*(.*?)$/) {
571           $symlinks{$1} = $2;
572         } else {
573           die("bad baselib string rule: $r\n");
574         }
575       } else {
576         die("bad baselib rule: $r\n");
577       }
578     }
579     if ($configdir) {
580       for my $r (@config) {
581         my $rr = substr($r, 1);
582         if (substr($r, 0, 1) eq '+') {
583           $cfiles{$_} = 1 for grep {/$rr/} grep {!$ghosts{$_}} @rpmfiles;
584         } elsif (substr($r, 0, 1) eq '-') {
585           delete $cfiles{$_} for grep {/$rr/} keys %cfiles;
586         } else {
587           die("bad config rule: $r\n");
588         }
589       }
590     }
591     $files{$_} = 1 for keys %cfiles;
592
593     if (!%files) {
594       print "$rname($target): empty filelist, skipping rpm\n";
595       next;
596     }
597
598     my $i = 0;
599     for (@{$res{'FILENAMES'}}) {
600       $files{$_} = $i if $files{$_};
601       $i++;
602     }
603
604     my %cpiodirs;
605     for (keys %files) {
606       next if $cfiles{$_} || $moves{$_};
607       my $fn = $_;
608       next unless $fn =~ s/\/[^\/]+$//;
609       $cpiodirs{$fn} = 1;
610     }
611
612     my %alldirs;
613     for (keys %files) {
614       next if $cfiles{$_};
615       my $fn = $_;
616       if ($moves{$fn}) {
617         $fn = $moves{$fn};
618         next unless $fn =~ s/\/[^\/]+$//;
619         $alldirs{$fn} = 1;
620       } else {
621         next unless $fn =~ s/\/[^\/]+$//;
622         $alldirs{"$prefix$fn"} = 1;
623       }
624     }
625     $alldirs{$_} = 1 for keys %symlinks;
626     $alldirs{$configdir} = 1 if %cfiles;
627     my $ad;
628     for $ad (keys %alldirs) {
629       $alldirs{$ad} = 1 while $ad =~ s/\/[^\/]+$//;
630     }
631     for (keys %files) {
632       next if $cfiles{$_};
633       my $fn = $_;
634       if ($moves{$fn}) {
635         delete $alldirs{$moves{$fn}};
636       } else {
637         delete $alldirs{"$prefix$fn"};
638       }
639     }
640     $ad = $prefix;
641     delete $alldirs{$ad};
642     delete $alldirs{$ad} while $ad =~ s/\/[^\/]+$//;
643     delete $alldirs{$_} for @filesystem;
644
645     print "$rname($target): writing specfile...\n";
646     my ($fh, $specfile) = tempfile(SUFFIX => ".spec");
647     open(SPEC, ">&=", $fh) || die("open: $!\n");
648     for my $p (@preamble) {
649       my $pt = uc($p);
650       next unless $res{$pt};
651       my $d = $res{$pt}->[0];
652       $d =~ s/%/%%/g;
653       if ($p eq 'Name') {
654         print SPEC "Name: $sname\n";
655         next;
656       }
657       if ($p eq 'Version') {
658         print SPEC "Version: $sversion\n";
659         next;
660       }
661       if ($p eq 'Release') {
662         print SPEC "Release: $srelease\n";
663         next;
664       }
665       if ($p eq 'Disturl') {
666         print SPEC "%define disturl $d\n";
667         next;
668       }
669       print SPEC "$p: $d\n";
670     }
671     print SPEC "Source: $rpm\n";
672     print SPEC "NoSource: 0\n" if $res{'SOURCERPM'}->[0] =~ /\.nosrc\.rpm$/;
673     print SPEC "BuildRoot: %{_tmppath}/baselibs-%{name}-%{version}-build\n";
674     print SPEC "%define _target_cpu $targetarch\n";
675     print SPEC "%define __os_install_post %{nil}\n";
676     print SPEC "%description\nUnneeded main package. Ignore.\n\n";
677     print SPEC "%package -n $targetname\n";
678     for my $p (@preamble) {
679       next if $p eq 'Name' || $p eq 'Disturl';
680       my $pt = uc($p);
681       next unless $res{$pt};
682       my $d = $res{$pt}->[0];
683       $d =~ s/%/%%/g;
684       if ($pt eq 'VERSION' && $legacyversion) {
685         $d = $legacyversion;
686       } elsif ($pt eq 'RELEASE' && $legacyversion) {
687         my @bt = localtime($res{'BUILDTIME'}->[0]);
688         $bt[5] += 1900;
689         $bt[4] += 1;
690         $d = sprintf("%04d%02d%02d%02d%02d\n", @bt[5,4,3,2,1]);
691       }
692       print SPEC "$p: $d\n";
693     }
694     print SPEC "Autoreqprov: $autoreqprov\n";
695
696     for my $ar ([\@provides, 'provides'],
697                 [\@prerequires, 'prereq'],
698                 [\@requires, 'requires'],
699                 [\@recommends, 'recommends'],
700                 [\@supplements, 'supplements'],
701                 [\@obsoletes, 'obsoletes'],
702                 [\@conflicts, 'conflicts']) {
703         my @a = @{$ar->[0]};
704         my @na = ();
705         for (@a) {
706           if (substr($_, 0, 1) eq '"') {
707             die("bad $ar->[1] rule: $_\n") unless /^\"(.*)\"$/;
708             push @na, $1;
709           } elsif (substr($_, 0, 1) eq '-') {
710             my $ra = substr($_, 1);
711             @na = grep {!/$ra/} @na;
712           } else {
713             die("bad $ar->[1] rule: $_\n");
714           }
715         }
716       print SPEC ucfirst($ar->[1]).": $_\n" for @na;
717     }
718     my $cpiopre = '';
719     $cpiopre = './' if $res{'RPMVERSION'}->[0] !~ /^3/;
720     my $d = $res{'DESCRIPTION'}->[0];
721     $d =~ s/%/%%/g;
722     if ($legacyversion) {
723       $d = "This rpm was re-packaged from $res{'NAME'}->[0]-$res{'VERSION'}->[0]-$res{'RELEASE'}->[0]\n\n$d";
724     }
725     print SPEC "\n%description -n $targetname\n";
726     print SPEC "$d\n";
727     print SPEC "%prep\n";
728     print SPEC "%build\n";
729     print SPEC "%install\n";
730     print SPEC "rm -rf \$RPM_BUILD_ROOT\n";
731     print SPEC "mkdir \$RPM_BUILD_ROOT\n";
732     print SPEC "cd \$RPM_BUILD_ROOT\n";
733     my @cfl = grep {!$cfiles{$_} && !$moves{$_}} sort keys %files;
734     if (@cfl) {
735       if ($prefix ne '') {
736         print SPEC "mkdir -p \$RPM_BUILD_ROOT$prefix\n";
737         print SPEC "pushd \$RPM_BUILD_ROOT$prefix\n";
738       }
739       print SPEC "cat <<EOFL >.filelist\n";
740       print SPEC "$_\n" for map {$cpiopre.substr($_, 1)} @cfl;
741       print SPEC "EOFL\n";
742       print SPEC "mkdir -p \$RPM_BUILD_ROOT$prefix$_\n" for sort keys %cpiodirs;
743       print SPEC "rpm2cpio $rpm | cpio -i -d -v -E .filelist\n";
744       print SPEC "rm .filelist\n";
745       if (%ghosts) {
746         for my $fn (grep {$ghosts{$_}} @cfl) {
747           my $fnm = $fn;
748           $fnm = '.' unless $fnm =~ s/\/[^\/]+$//;
749           print SPEC "mkdir -p \$RPM_BUILD_ROOT$prefix$fnm\n";
750           print SPEC "touch \$RPM_BUILD_ROOT$prefix$fn\n";
751         }
752       }
753       if ($prefix ne '') {
754         print SPEC "popd\n";
755       }
756     }
757     if (%cfiles || %moves) {
758       print SPEC "mkdir -p .cfiles\n";
759       print SPEC "pushd .cfiles\n";
760       print SPEC "cat <<EOFL >.filelist\n";
761       print SPEC "$_\n" for map {$cpiopre.substr($_, 1)} grep {$cfiles{$_} || $moves{$_}} sort keys %files;
762       print SPEC "EOFL\n";
763       print SPEC "rpm2cpio $rpm | cpio -i -d -v -E .filelist\n";
764       print SPEC "popd\n";
765       if (%cfiles) {
766         print SPEC "mkdir -p \$RPM_BUILD_ROOT$configdir\n";
767         print SPEC "mv .cfiles$_ \$RPM_BUILD_ROOT$configdir\n" for sort keys %cfiles;
768       }
769       for my $fn (sort keys %moves) {
770         my $fnm = $moves{$fn};
771         $fnm = '.' unless $fnm =~ s/\/[^\/]+$//;
772         print SPEC "mkdir -p \$RPM_BUILD_ROOT$fnm\n";
773         print SPEC "mv .cfiles$fn \$RPM_BUILD_ROOT$moves{$fn}\n";
774       }
775       print SPEC "rm -rf .cfiles\n";
776     }
777     for my $fn (sort keys %symlinks) {
778       my $fnm = $fn;
779       $fnm = '.' unless $fnm =~ s/\/[^\/]+$//;
780       print SPEC "mkdir -p \$RPM_BUILD_ROOT$fnm\n";
781       print SPEC "ln -s $symlinks{$fn} \$RPM_BUILD_ROOT$fn\n";
782     }
783     if ($prefix ne '' && grep {/\.so.*$/} @cfl) {
784       @postin = () if @postin == 1 && $postin[0] =~ /^\"-p.*ldconfig/;
785       unshift @postin, "\"/sbin/ldconfig -r $prefix\"";
786     }
787
788     if (@prein) {
789       print SPEC "%pre -n $targetname";
790       print SPEC $prein[0] =~ /^\"-p/ ? " " : "\n";
791       for (@prein) {
792         die("bad prein rule: $_\n") unless /^\"(.*)\"$/;
793         print SPEC "$1\n";
794       }
795     }
796     if (@postin) {
797       print SPEC "%post -n $targetname";
798       print SPEC $postin[0] =~ /^\"-p/ ? " " : "\n";
799       for (@postin) {
800         die("bad postin rule: $_\n") unless /^\"(.*)\"$/;
801         print SPEC "$1\n";
802       }
803     }
804     if (@preun) {
805       print SPEC "%preun -n $targetname";
806       print SPEC $preun[0] =~ /^\"-p/ ? " " : "\n";
807       for (@preun) {
808         die("bad preun rule: $_\n") unless /^\"(.*)\"$/;
809         print SPEC "$1\n";
810       }
811     }
812     if (@postun) {
813       print SPEC "%postun -n $targetname";
814       print SPEC $postun[0] =~ /^\"-p/ ? " " : "\n";
815       for (@postun) {
816         die("bad postun rule: $_\n") unless /^\"(.*)\"$/;
817         print SPEC "$1\n";
818       }
819     }
820
821     print SPEC "\n%clean\n";
822     print SPEC "\nrm -rf \$RPM_BUILD_ROOT\n\n";
823     print SPEC "%files -n $targetname\n";
824     for my $file (sort keys %alldirs) {
825       print SPEC "%dir %attr(0755,root,root) $file\n";
826     }
827     for my $file (keys %files) {
828       my $fi = $files{$file};
829       my $fm = $res{'FILEMODES'}->[$fi];
830       my $fv = $res{'FILEVERIFYFLAGS'}->[$fi];
831       my $ff = $res{'FILEFLAGS'}->[$fi];
832       if (POSIX::S_ISDIR($fm)) {
833         print SPEC "%dir ";
834       }
835       if ($ff & ((1 << 3) | (1 << 4))) {
836         print SPEC "%config(missingok noreplace) ";
837       } elsif ($ff & (1 << 3)) {
838         print SPEC "%config(missingok) ";
839       } elsif ($ff & (1 << 4)) {
840         print SPEC "%config(noreplace) ";
841       } elsif ($ff & (1 << 0)) {
842         print SPEC "%config ";
843       }
844       print SPEC "%doc " if $ff & (1 << 1);
845       print SPEC "%ghost " if $ff & (1 << 6);
846       print SPEC "%license " if $ff & (1 << 7);
847       print SPEC "%readme " if $ff & (1 << 8);
848       if ($fv != 4294967295) {
849         print SPEC "%verify(";
850         if ($fv & 2147483648) {
851           print SPEC "not ";
852           $fv ^= 4294967295;
853         }
854         print SPEC "md5 " if $fv & (1 << 0);
855         print SPEC "size " if $fv & (1 << 1);
856         print SPEC "link " if $fv & (1 << 2);
857         print SPEC "user " if $fv & (1 << 3);
858         print SPEC "group " if $fv & (1 << 4);
859         print SPEC "mtime " if $fv & (1 << 5);
860         print SPEC "mode " if $fv & (1 << 6);
861         print SPEC "rdev " if $fv & (1 << 7);
862         print SPEC ") ";
863       }
864       #sigh, no POSIX::S_ISLNK ...
865       if (($fm & 0170000) == 0120000) {
866         printf SPEC "%%attr(-,%s,%s) ", $res{'FILEUSERNAME'}->[$fi], $res{'FILEGROUPNAME'}->[$fi];
867       } else {
868         printf SPEC "%%attr(%03o,%s,%s) ", $fm & 07777, $res{'FILEUSERNAME'}->[$fi], $res{'FILEGROUPNAME'}->[$fi];
869       }
870       if ($cfiles{$file}) {
871         my $fn = $file;
872         $fn =~ s/.*\///;
873         print SPEC "$configdir/$fn\n";
874       } else {
875         if ($moves{$file}) {
876           print SPEC "$moves{$file}\n";
877         } else {
878           print SPEC "$prefix$file\n";
879         }
880       }
881     }
882     for (keys %symlinks) {
883       printf SPEC "%%attr(-,root,root) $_\n";
884     }
885
886     if ($res{'CHANGELOGTEXT'}) {
887       print SPEC "\n%changelog -n $targetname\n";
888       my @ct = @{$res{'CHANGELOGTIME'}};
889       my @cn = @{$res{'CHANGELOGNAME'}};
890       my @wdays = qw{Sun Mon Tue Wed Thu Fri Sat};
891       my @months = qw{Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec};
892       for my $cc (@{$res{'CHANGELOGTEXT'}}) {
893         my @lt = localtime($ct[0]);
894         my $cc2 = $cc;
895         my $cn2 = $cn[0];
896         $cc2 =~ s/%/%%/g;
897         $cn2 =~ s/%/%%/g;
898         printf SPEC "* %s %s %02d %04d %s\n%s\n", $wdays[$lt[6]], $months[$lt[4]], $lt[3], 1900 + $lt[5], $cn2, $cc2;
899         shift @ct;
900         shift @cn;
901       }
902     }
903
904     close(SPEC) || die("$specfile: $!\n");
905     print "$rname($target): running build...\n";
906     if (system("rpmbuild -bb $specfile".($verbose ? '' : '>/dev/null 2>&1'))) {
907       print "rpmbuild failed: $?\n";
908       print "re-running in verbose mode:\n";
909       system("rpmbuild -bb $specfile 2>&1");
910       exit(1);
911     }
912     unlink($specfile);
913   }
914  }
915 }
916
917 ################################################################
918
919 sub handle_debs {
920
921   eval {
922     require Parse::DebControl;
923   };
924   if ($@){
925     print "mkbaselibs needs the perl module Parse::DebControl\n".
926       "Error. baselibs-deb.conf specified but mkbaselibs can't run\n".
927         "Please ensure that 'osc meta prjconf' contains the following line:\n".
928           "  Support: libparse-debcontrol-perl\n";
929     return;
930   };
931
932
933   # for each deb:
934   #  look in the config file to see if we should be doing anything
935   #
936   #  Unpack the deb control data using dpkg-deb
937   #  for each target
938   #   Unpack the deb control data *and* file data using dpkg-deb
939   #   process the config file for this package modifying control and moving files
940   #   repackage the target deb
941
942   for my $deb (@_) {
943     # http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-binarycontrolfiles
944     # unpack the outer loop control file - this gives us eg: the arch
945     my $base = tempdir() || die("tempdir: $!\n");
946     system "dpkg -e $deb  ${base}/DEBIAN" || die "dpkg -e failed on $deb";
947     my $controlParser = new Parse::DebControl;
948     $controlParser->DEBUG();
949     my $keys = $controlParser->parse_file("${base}/DEBIAN/control");
950 #    print Dumper($keys);
951     # DebControl supports multiple paragraphs of control data but
952     # debian/control in a .deb only has one (whereas a debian/control
953     # in a build root contains many)
954     # So extract the ref to the first one.
955     my %control = %{@{$keys}[0]};
956
957     # Validate this is a binary deb and get the control data
958     my $d_name = $control{'Package'};
959     my $d_version = $control{'Version'};
960
961     $arch = $control{'Architecture'};  # set global $arch
962
963     # examine the
964     #   arch <arch> targets <target_arch>[:<target_type>] [<target_arch>[:<target_type>]...]
965     # line and get a list of target_arch-es
966     my @targets = get_targets($arch, $config);
967     if (!@targets) {
968       print "no targets for arch $arch, nothing to do\n";
969       return; # there may be more debs to handle
970     }
971
972     for my $target (@targets) {
973       next unless parse_config($target, $d_name, $d_version);
974       die("targetname not set\n") unless $targetname;  # set in the global_conf
975       $target_matched{$target} = 1;
976
977       my $baseTarget = "${base}/$target";
978       # Unpack a .deb to work on. We have to do this each time as we
979       # manipulate the unpacked files.
980       system "mkdir ${base}/$target";
981       system "dpkg -e $deb  ${baseTarget}/DEBIAN" || die "dpkg -e failed on $deb";
982       # Note that extracting to $prefix does the clever move to /lib-x86/ or whatever
983       system "dpkg -x $deb  ${baseTarget}/$prefix" || die "dpkg -x failed on $deb";
984
985       # Reset the control data
986       $keys = $controlParser->parse_file("${baseTarget}/DEBIAN/control");
987       %control = %{@{$keys}[0]};
988
989       # Force the architecture
990       $control{'Architecture'} = $targetarch;
991
992       # Currently this script does not manipulate any files
993       # If needed they are all unpacked in ${baseTarget}
994
995       # we don't need a dsc/spec file.. all done by just moving files around
996       # and running dpkg -b ${base} $NEW_DEB
997       #
998       # my $dscfile = "/usr/src/packages/DSCS/mkbaselibs$$.dsc";
999
1000       print "$d_name($target): writing dscfile...\n";
1001       # We can Use Parse::DebControl write_file to create the new control file
1002       # just modify tags in there
1003
1004       # We'll use requires -> Depends:
1005       map s/^"(.*)"$/$1/, @requires;  # remove leading/trailing "s
1006       $control{"Depends"} = @requires ? join(", ", @requires) : "";  # join array if exists or reset it to ""
1007
1008       map s/^"(.*)"$/$1/, @prerequires;
1009       $control{"Pre-Depends"} = @prerequires ? join(", ", @prerequires) : "";
1010
1011       map s/^"(.*)"$/$1/, @provides;
1012       $control{"Provides"} = @provides ? join(", ", @provides) : "";
1013
1014       map s/^"(.*)"$/$1/, @recommends;
1015       $control{"Recommends"} = @recommends ? join(", ", @recommends) : "";
1016
1017       map s/^"(.*)"$/$1/, @suggests;
1018       $control{"Suggests"} = @suggests ? join(", ", @suggests) : "";
1019
1020       map s/^"(.*)"$/$1/, @obsoletes;
1021       $control{"Replaces"} = @obsoletes ? join(", ", @obsoletes) : "";
1022
1023       map s/^"(.*)"$/$1/, @conflicts;
1024       $control{"Conflicts"} = @conflicts ? join(", ", @conflicts) : "";
1025
1026       map s/^"(.*)"$/$1/, @supplements;
1027       $control{"Enhances"} = @supplements ? join(", ", @supplements) : "";
1028
1029
1030       # Tidy up the various control files.
1031       # the md5sums are regenerated by dpkg-deb when building
1032       foreach my $c_file qw(conffiles postinst  postrm  preinst  prerm) {
1033         unlink "${baseTarget}/DEBIAN/$c_file";
1034       }
1035       # Create them if needed
1036       if (@prein) {
1037         map s/^"(.*)"$/$1/, @prein;  # remove leading/trailing "s
1038         open(my $SCRIPT, ">${baseTarget}/DEBIAN/preinst");
1039         print $SCRIPT join("\n", @prein) ;
1040         chmod(0755, $SCRIPT);
1041         close($SCRIPT);
1042       }
1043       if (@postin) {
1044         map s/^"(.*)"$/$1/, @postin;
1045         open(my $SCRIPT, ">${baseTarget}/DEBIAN/postinst");
1046         print $SCRIPT join("\n", @postin) ;
1047         chmod(0755, $SCRIPT);
1048         close($SCRIPT);
1049       }
1050       if (@preun) {
1051         map s/^"(.*)"$/$1/, @preun;
1052         open(my $SCRIPT, ">${baseTarget}/DEBIAN/prerm");
1053         print $SCRIPT join("\n", @preun) ;
1054         chmod(0755, $SCRIPT);
1055         close($SCRIPT);
1056       }
1057       if (@postun) {
1058         map s/^"(.*)"$/$1/, @postun;
1059         open(my $SCRIPT, ">${baseTarget}/DEBIAN/postrm");
1060         print $SCRIPT join("\n", @postun) ;
1061         chmod(0755, $SCRIPT);
1062         close($SCRIPT);
1063       }
1064
1065       # Don't forget to rename the package - or it will replace/uninstall the /-based one
1066       $control{"Package"} = "${d_name}-${targettype}";
1067
1068       $controlParser->write_file("${baseTarget}/DEBIAN/control", \%control, {clobberFile => 1, addNewline=>1 } );
1069       system "dpkg -b ${baseTarget} /usr/src/packages/DEBS/${d_name}-${targettype}_${d_version}_${targetarch}.deb" || die "dpkg -b failed on $deb";
1070       system "rm -rf ${baseTarget}";
1071     }
1072     system "rm -rf ${base}";
1073   }
1074 }
1075
1076 # args is a list of full pathnames to rpm/deb files
1077 die("Usage: mkbaselibs <rpms>\n") unless @ARGV;
1078
1079 if ($ARGV[0] eq '-v') {
1080   $verbose = 1;
1081   shift @ARGV;
1082 }
1083 while ($ARGV[0] eq '-c') {
1084   shift @ARGV;
1085   read_config($ARGV[0]);
1086   shift @ARGV;
1087 }
1088
1089 my %goodpkgs = map {$_ => 1} get_pkgnames();  # These are packages named in the config file
1090 my @pkgs = @ARGV;
1091 my @rpms;
1092 my @debugrpms;
1093 for my $rpm (@pkgs) {
1094   my $rpmn = $rpm;
1095   unless (-f $rpm) {
1096     warn ("$rpm does not exist, skipping\n");
1097     next;
1098   }
1099   next if $rpm =~ /\.(no)?src\.rpm$/;  # ignore source rpms
1100   next if $rpm =~ /\.spm$/;
1101   $rpmn =~ s/.*\///;   # Remove leading path info
1102   $rpmn =~ s/-[^-]+-[^-]+\.[^\.]+\.rpm$/\.rpm/; # remove all version info
1103   $rpmn =~ s/\.rpm$//; # remove extension
1104   push @rpms, $rpm if $goodpkgs{$rpmn};
1105   if ($rpmn =~ s/-debuginfo$//) {
1106       push @debugrpms, $rpm if $goodpkgs{$rpmn};
1107   }
1108 }
1109 for (@rpms) {
1110     die("$_: need absolute path to package\n") unless /^\//;
1111 }
1112
1113 my %debs_to_process = map {$_ => 1} get_debpkgnames();  # These are packages named in the config file
1114 my @debs;
1115 for my $deb (@pkgs) {
1116   my $debn = $deb;
1117   next unless $debn =~ /\.deb$/;
1118   $debn =~ s/.*\///;   # Remove leading path info
1119   $debn =~ s/_[^_]+_[^_]+\.deb$//; # remove all version info and extension
1120   push @debs, $deb if $debs_to_process{$debn};
1121   print "ignoring $deb as $debn not in baselibs.conf\n" if !$debs_to_process{$debn};
1122 }
1123 for (@debs) {
1124     die("$_: need absolute path to package\n") unless /^\//;
1125 }
1126
1127 exit 0 unless @rpms or @debs;
1128
1129 if (@rpms) {
1130     @filesystem = split("\n", `rpm -ql filesystem 2>/dev/null`);
1131     die("filesystem rpm is not installed\n") unless @filesystem;
1132
1133     handle_rpms(@rpms);
1134     handle_rpms(@debugrpms);
1135 }
1136
1137 if (@debs) {
1138     handle_debs(@debs);
1139 }