This commit was manufactured by cvs2svn to create tag
[opensuse:installation-images.git] / lib / AddFiles.pm
1 #! /usr/bin/perl -w
2
3 # Usage:
4 #
5 #   use AddFiles;
6 #
7 #   exported functions:
8 #     AddFiles(dir, file_list, ext_dir, tag);
9
10 =head1 AddFiles
11
12 C<AddFiles.pm> is a perl module that can be used to extract files from
13 rpms. It exports the following symbols:
14
15 =over
16
17 =item *
18
19 C<AddFiles(dir, file_list, ext_dir, tag)>
20
21 =back
22
23 =head2 Usage
24
25 use AddFiles;
26
27 =head2 Description
28
29 =over
30
31 =item *
32
33 C<AddFiles(dir, file_list, ext_dir, tag)>
34
35 C<AddFiles> extracts the files in C<file_list> and puts them into C<dir>.
36 Files that are not to be taken from rpms are copied from C<ext_dir>.
37
38 The syntax of the file list is rather simple; please have a look at those
39 provided with this package to see how it works. A syntax description follows
40 later...
41
42 On any failure, C<exit( )> is called.
43
44
45 =back
46
47 =cut
48
49
50 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
51 require Exporter;
52 @ISA = qw ( Exporter );
53 @EXPORT = qw ( AddFiles );
54
55 use strict 'vars';
56 use integer;
57
58 use ReadConfig;
59
60 sub fixup_re;
61
62 sub AddFiles
63 {
64   local $_;
65   my ($dir, $file_list, $ext_dir, $arch, $if_val, $if_taken, $tag);
66   my ($rpms, $tdir, $tfile, $p, $r, $rc, $d, $u, $g, $files);
67   my ($mod_list, @mod_list, %mod_list);
68   my ($inc_file, $inc_it, $debug, $ifmsg, $ignore);
69   my ($old_warn, $ver, $i, $cache_dir, $tmp_cache_dir, $tmp_rpm);
70   my (@scripts, $s, @s, %script, $use_cache);
71   my (@packs, $sl);
72
73   ($dir, $file_list, $ext_dir, $tag, $mod_list) = @_;
74
75   $debug = "pkg";
76   $debug = $ENV{'debug'} if exists $ENV{'debug'};
77
78   $use_cache = 0;
79   $use_cache = $ENV{'cache'} if exists $ENV{'cache'};
80   if($use_cache) {
81     $cache_dir = $ConfigData{'cache_dir'};
82     $tmp_cache_dir = $ConfigData{'tmp_cache_dir'};
83   }
84
85   $ignore = $debug =~ /\bignore\b/ ? 1 : 0;
86
87   $old_warn =  $SIG{'__WARN__'};
88
89   $SIG{'__WARN__'} = sub {
90     my $a = shift;
91
92     return if $ignore >= 10;
93
94     $a =~ s/<F>/$file_list/;
95     $a =~ s/<I>/$inc_file/;
96     if($ignore) { warn $a } else { die $a }
97   };
98
99   $debug .= ',pkg';
100
101 #  if(!$AutoBuild) {
102 #    $rpms = "$ConfigData{suse_base}/suse";
103 #    die "$Script: where are the rpms?" unless $ConfigData{suse_base} && -d $rpms;
104 #    $rpms = "$rpms/*";
105 #  }
106 # else {
107 #    $rpms = $AutoBuild;
108 #    die "$Script: where are the rpms?" unless -d $rpms;
109 #    print "running in autobuild environment\n";
110 #  }
111
112   if(! -d $dir) {
113     die "$Script: failed to create $dir ($!)" unless mkdir $dir, 0755;
114   }
115
116   if(!($use_cache & 4)) {
117     $tdir = "${TmpBase}.dir";
118     die "$Script: failed to create $tdir ($!)" unless mkdir $tdir, 0777;
119   }
120   $tfile = "${TmpBase}.afile";
121
122   # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
123   # now we really start...
124
125   die "$Script: no such file list: $file_list" unless open F, $file_list;
126
127   $arch = `uname -m`; chomp $arch;
128   $arch = "ia32" if $arch =~ /^i\d86$/;
129
130   $ENV{'___arch'} = $arch;
131
132   $tag = "" unless defined $tag;
133
134   $if_val = $if_taken = 0;
135
136   while(1) {
137     $_ = $inc_it ? <I> : <F>;
138     if(!defined($_)) {
139       if($inc_it) {
140         undef $inc_it;
141         close I;
142         next;
143       } else {
144         last;
145       }
146     }
147
148     chomp;
149     next if /^(\s*|\s*#.*)$/;
150
151     s/^\s*//;
152
153     $ifmsg = sprintf " [%x|%x] %s\n", $if_val, $if_taken, $_;
154
155     s/<(kernel_ver|kernel_rpm|kernel_img|suse_release|theme|product|product_name|yast_theme|splash_theme|update_dir|load_image)>/$ConfigData{$1}/g;
156     for $i (qw( linuxrc lang extramod items )) {
157       s/<$i>/$ENV{$i}/g if exists $ENV{$i};
158     }
159
160     if(/^endif/) {
161       $if_val >>= 1;
162       $if_taken >>= 1;
163       print "*$ifmsg" if $debug =~ /\bif\b/;
164       next
165     }
166
167     if(/^else/) {
168       $if_val &= ~1;
169       $if_val |= $if_taken & 1;
170       print "*$ifmsg" if $debug =~ /\bif\b/;
171       next
172     }
173
174 # drop these
175 #    if(/^ifarch\s+/)  { $if_val <<= 1; $if_val |= 1 if !/\b$arch\b/ || $arch eq ""; next }
176 #    if(/^ifnarch\s+/) { $if_val <<= 1; $if_val |= 1 if  /\b$arch\b/ && $arch ne ""; next }
177 #    if(/^ifdef\s+/)   { $if_val <<= 1; $if_val |= 1 if !/\b$tag\b/  || $tag  eq ""; next }
178 #    if(/^ifndef\s+/)  { $if_val <<= 1; $if_val |= 1 if  /\b$tag\b/  && $tag  ne ""; next }
179 #    if(/^ifabuild/)   { $if_val <<= 1; $if_val |= 1 if !$AutoBuild;                 next }
180 #    if(/^ifnabuild/)  { $if_val <<= 1; $if_val |= 1 if  $AutoBuild;                 next }
181 #    if(/^ifenv\s+(\S+)\s+(\S+)/)  { $if_val <<= 1; $if_val |= 1 if $ENV{$1} ne $2;  next }
182 #    if(/^ifnenv\s+(\S+)\s+(\S+)/) { $if_val <<= 1; $if_val |= 1 if $ENV{$1} eq $2;  next }
183
184     if(/^(els)?if\s+(.+)/) {
185       no integer;
186
187       my ( $re, $i, $eif );
188
189       $eif = $1 ? 1 : 0;
190       $re = fixup_re $2;
191       if($debug =~ /\bif\b/) {
192         print "*$ifmsg";
193         printf "    # eval \"%s\"\n", $re;
194       }
195       $ignore += 10;
196       $i = eval "if($re) { 0 } else { 1 }";
197       $ignore -= 10;
198       die "$Script: syntax error in 'if' statement" unless defined $i;
199       if($eif) {
200         $if_val &= ~1;
201         $i = 0 if $i == 0 && ($if_taken & 1) == 0;
202       }
203       else {
204         $if_val <<= 1;
205         $if_taken <<= 1;
206       }
207       $if_val |= $i;
208       $if_taken |= 1 - $i;
209       next
210     }
211
212     if($if_val) {
213       print " $ifmsg" if $debug =~ /\bif\b/;
214       next
215     }
216
217     print "*$ifmsg" if $debug =~ /\bif\b/;
218
219     if(/^include\s+(\S+)$/) {
220       die "$Script: recursive include not supported" if $inc_it;
221       $inc_file = $1;
222       die "$Script: no such file list: $inc_file" unless open I, "$ext_dir/$inc_file";
223       $inc_it = 1;
224     }
225     elsif(/^(\S+):\s*(\S+)?\s*$/) {
226       undef %script;
227       undef @scripts;
228
229       $p = $1;
230       if(defined $2) {
231         @scripts = split /,/, $2;
232       }
233
234       undef $rc;
235       undef $r;
236       if($p =~ /^\//) {
237         $r = $p;
238         warn("$Script: no such package: $r"), next unless -f $r;
239       }
240       else {
241         $r = RPMFileName $p;
242
243         if($use_cache) {
244           $rc = "$cache_dir/$p.rpm";
245           $tmp_rpm = "$tmp_cache_dir/$p";
246         }
247         warn("$Script: no such package: $p.rpm"), next unless $r && -f $r;
248
249         if(($use_cache & 2) && $rc && $r && -f($r) && $rc ne $r) {
250           if(! -d($cache_dir)) {
251             SUSystem("mkdir -p $cache_dir");
252           }
253           if(-d $cache_dir) {
254             SUSystem("cp -a $r $rc");
255             if(-f $rc) {
256               $r = $rc;
257             }
258             else {
259               warn "$Script: failed to cache package $r";
260             }
261           }
262           else {
263             warn "$Script: failed to create cache dir $cache_dir";
264             $use_cache = 0;
265           }
266         }
267       }
268
269       $ver = (`rpm -qp $r`)[0];
270       $ver = "" unless defined $ver;
271       $ver =~ s/\s*$//;
272       if($ver =~ /^(\S+)-([^-]+-[^-]+)$/) {
273         $ver = $1 eq $p ? " [$2]" : "";
274       }
275       else {
276         $ver = "";
277       }
278       if($use_cache) {
279         if(-d $tmp_rpm) {
280           $ver .= '#';
281         }
282         elsif(defined($rc) && $rc eq $r) {
283           $ver .= '*';
284         }
285       }
286
287       undef $sl;
288
289       @s = `rpm -qp --qf '%|PREIN?{PREIN\n}:{}|%|POSTIN?{POSTIN\n}:{}|%|PREUN?{PREUN\n}:{}|%|POSTUN?{POSTUN\n}:{}|' $r 2>/dev/null`;
290       for $s (@s) {
291         chomp $s;
292         $sl .= "," if $sl;
293         $sl .= "\L$s";
294       }
295       $ver .= " \{$sl\}" if $sl;
296
297       print "adding package $p$ver\n" if $debug =~ /\bpkg\b/;
298
299       push @packs, "$p\n";
300
301       for $s (@scripts) {
302         @{$script{$s}} =
303         @s = `rpm --queryformat '%{\U$s\E}' -qp $r 2>/dev/null`;
304         if(@s == 0 || $s[0] =~ /^\(none\)\s*$/) {
305           warn "$Script: no \"$s\" script in $r";
306         }
307         else {
308           print "  got \"$s\" script\n" if $debug =~ /\bscripts\b/;
309           @{$script{$s}} = @s;
310         }
311       }
312
313       if(!($use_cache & 4)) {
314         SUSystem "rm -rf $tdir" and die "$Script: failed to remove $tdir";
315         die "$Script: failed to create $tdir ($!)" unless mkdir $tdir, 0777;
316         SUSystem "sh -c 'cd $tdir ; rpm2cpio $r | cpio --quiet -dimu --no-absolute-filenames'" and
317           warn "$Script: failed to extract $r";
318       }
319       else {
320         $tdir = $tmp_rpm;
321         if(!-d($tdir)) {
322           die "$Script: failed to create $tdir ($!)" unless mkdir $tdir, 0777;
323           SUSystem "sh -c 'cd $tdir ; rpm2cpio $r | cpio --quiet -dimu --no-absolute-filenames'" and
324             warn "$Script: failed to extract $r";
325         }
326       }
327     }
328     elsif(!/^[a-zA-Z]\s+/ && /^(.*)$/) {
329       $files = $1;
330       $files =~ s.(^|\s)/.$1.g;
331       $files = "." if $files =~ /^\s*$/;
332       SUSystem "sh -c '( cd $tdir; tar -cf - $files 2>$tfile ) | tar -C $dir -xpf -'" and
333         warn "$Script: failed to copy $files";
334
335       my (@f, $f);
336       @f = `cat $tfile`;
337       print STDERR @f;
338       SUSystem "rm -f $tfile";
339       for $f (@f) {
340         warn "$Script: failed to copy \"$files\"" if $f =~ /tar:\s+Error/;
341       }
342     }
343     elsif(/^d\s+(.+)$/) {
344       $d = $1; $d =~ s.(^|\s)/.$1.g;
345       SUSystem "sh -c 'cd $dir; mkdir -p $d'" and
346         warn "$Script: failed to create $d";
347     }
348     elsif(/^t\s+(.+)$/) {
349       $d = $1; $d =~ s.(^|\s)/.$1.g;
350       SUSystem "sh -c 'cd $dir; touch $d'" and
351         warn "$Script: failed to touch $d";
352     }
353     elsif(/^r\s+(.+)$/) {
354       $d = $1; $d =~ s.(^|\s)/.$1.g;
355       SUSystem "sh -c 'cd $dir; rm -rf $d'" and
356         warn "$Script: failed to remove $d";
357     }
358     elsif(/^S\s+(.+)$/) {
359       $d = $1; $d =~ s.(^|\s)/.$1.g;
360       SUSystem "sh -c 'cd $dir; strip $d'" and
361         warn "$Script: failed to strip $d";
362     }
363     elsif(/^l\s+(\S+)\s+(\S+)$/) {
364       SUSystem "ln $dir/$1 $dir/$2" and
365         warn "$Script: failed to link $1 to $2";
366     }
367     elsif(/^s\s+(\S+)\s+(\S+)$/) {
368       SUSystem "ln -s $1 $dir/$2" and
369         warn "$Script: failed to symlink $1 to $2";
370     }
371     elsif(/^m\s+(\S+)\s+(\S+)$/) {
372       SUSystem "sh -c \"cp -a $tdir/$1 $dir/$2\"" and
373         warn "$Script: failed to move $1 to $2";
374     }
375     elsif(/^a\s+(\S+)\s+(\S+)$/) {
376       SUSystem "sh -c \"cp -a $tdir/$1 $dir/$2\"" and
377         print "$Script: $1 not copied to $2 (ignored)\n";
378     }
379     elsif(/^([fF])\s+(\S+)\s+(\S+)(\s+(\S+))?$/) {
380       my ($l, @l, $src, $name, $dst, $start_dir);
381
382       $src = $2;
383       $name = $3;
384       $dst = $5;
385       $start_dir = $1 eq "F" ? "/" : $tdir;
386       $src =~ s#^/*##;
387       SUSystem "sh -c \"cd $start_dir ; find $src -type f -name '$name'\" >$tfile";
388
389       open F1, "$tfile";
390       @l = (<F1>);
391       close F1;
392       SUSystem "rm -f $tfile";
393       chomp @l;
394
395       if(@l == 0) {
396         warn "$Script: \"$name\" not found in \"$src\"";
397       }
398
399       if($dst) {
400         for $l (@l) {
401           SUSystem "sh -c \"cp -a $start_dir/$l $dir/$dst\"" and
402             print "$Script: $l not copied to $dst (ignored)\n";
403         }
404       }
405       else {
406         for $l (@l) {
407           SUSystem "sh -c '( cd $start_dir; tar -cf - $l 2>$tfile ) | tar -C $dir -xpf -'" and
408             warn "$Script: failed to copy $files";
409
410           my (@f, $f);
411           @f = `cat $tfile`;
412           print STDERR @f;
413           SUSystem "rm -f $tfile";
414           for $f (@f) {
415             warn "$Script: failed to copy \"$l\"" if $f =~ /tar:\s+Error/;
416           }
417         }
418       }
419     }
420     elsif(/^p\s+(\S+)$/) {
421       SUSystem "patch -d $dir -p0 --no-backup-if-mismatch <$ext_dir/$1 >/dev/null" and
422         warn "$Script: failed to apply patch $1";
423     }
424     elsif(/^A\s+(\S+)\s+(\S+)$/) {
425       SUSystem "sh -c 'cat $ext_dir/$1 >>$dir/$2'" and
426         warn "$Script: failed to append $1 to $2";
427     }
428     elsif(/^x\s+(\S+)\s+(\S+)$/) {
429       SUSystem "cp -dR $ext_dir/$1 $dir/$2" and
430         warn "$Script: failed to move $1 to $2";
431     }
432     elsif(/^X\s+(\S+)\s+(\S+)$/) {
433       SUSystem "cp -dR $1 $dir/$2 2>/dev/null" and
434         print "$Script: $1 not copied to $2 (ignored)\n";
435     }
436     elsif(/^g\s+(\S+)\s+(\S+)$/) {
437       SUSystem "sh -c 'gunzip -c $tdir/$1 >$dir/$2'" and
438         warn "$Script: could not uncompress $1 to $2";
439     }
440     elsif(/^c\s+(\d+)\s+(\S+)\s+(\S+)\s+(.+)$/) {
441       $p = $1; $u = $2; $g = $3;
442       $d = $4; $d =~ s.(^|\s)/.$1.g;
443       SUSystem "sh -c 'cd $dir; chown $u.$g $d'" and
444         warn "$Script: failto to change owner of $d to $u.$g";
445       SUSystem "sh -c 'cd $dir; chmod $p $d'" and
446         warn "$Script: failto to change perms of $d to $p";
447     }
448     elsif(/^b\s+(\d+)\s+(\d+)\s+(\S+)$/) {
449       SUSystem "mknod $dir/$3 b $1 $2" and
450         warn "$Script: failto to make block dev $3 ($1, $2)";
451     }
452     elsif(/^C\s+(\d+)\s+(\d+)\s+(\S+)$/) {
453       SUSystem "mknod $dir/$3 c $1 $2" and
454         warn "$Script: failto to make char dev $3 ($1, $2)";
455     }
456     elsif(/^n\s+(.+)$/) {
457       SUSystem "mknod $dir/$1 p" and
458         warn "$Script: failto to make named pipe $1";
459     }
460 =head1
461     elsif(/^M\s+(\S+)\s+(\S+)$/) {
462       SUSystem "sh -c \"cp -av $tdir/$1 $dir/$2\" >$tfile" and
463         print "$Script: $1 not copied to $2 (ignored)\n";
464
465       my ($f, $g);
466       for $f (`cat $tfile`) {
467         if($f =~ /\s->\s$dir\/(.*)\n?$/) {
468           $g = $1; $g =~ s/^\/*//;
469           push @mod_list, "$g\n" unless exists $mod_list{$g};
470           $mod_list{$g} = 1;
471         }
472         elsif($f =~ /\s->\s\`$dir\/(.*)\'\n?$/) {
473           $g = $1; $g =~ s/^\/*//;
474           push @mod_list, "$g\n" unless exists $mod_list{$g};
475           $mod_list{$g} = 1;
476         }
477       }
478     }
479 =cut
480     elsif(/^M\s+(.*)$/) {
481       my ($ml, @ml);
482
483       $ml = $1;
484       @ml = split ' ', $ml;
485       if($ml !~ m#/#) {
486         @ml = map { $_ = "modules/$_.o\n" } @ml;
487       }
488       else {
489         @ml = map { $_ .= "\n" } @ml;
490       }
491       push @mod_list, @ml
492     }
493     elsif(/^([eE])\s+(.+)$/) {
494       my ($cmd, $xdir, $basedir, $r, $e, $pm, $is_script);
495
496       $e = $1;
497       $cmd = $2;
498       $xdir = $dir;
499       $xdir =~ s#/*$##;
500       $basedir = $1 if $xdir =~ s#(.*)/##;
501       $is_script = exists $script{$cmd};
502       $pm = $is_script ? "$cmd script" : "\"$cmd\"";
503
504       die "internal oops" unless $basedir ne "" && $xdir ne "";
505
506       if($is_script) {
507         SUSystem "sh -c 'mkdir $dir/install && chmod 777 $dir/install'" and
508           die "$Script: failed to create $dir/install";
509         die "$Script: unable to create $pm" unless open W, ">$dir/install/inst.sh";
510         print W @{$script{$cmd}};
511         close W;
512
513         $e = 'E' if $xdir eq 'base';
514       }
515
516       print "running $pm\n" if $debug =~ /\bpkg\b/;
517       if($e eq 'e') {
518         SUSystem "mv $dir $basedir/base/xxxx" and die "oops";
519         if($is_script) {
520           $r = SUSystem "chroot $basedir/base /bin/sh -c 'cd xxxx ; sh install/inst.sh 1'";
521         }
522         else {
523           $r = SUSystem "chroot $basedir/base /bin/sh -c 'cd xxxx ; $cmd'";
524         }
525         SUSystem "mv $basedir/base/xxxx $dir" and die "oops";
526       }
527       else {
528         if($is_script) {
529           $r = SUSystem "chroot $dir /bin/sh -c 'sh install/inst.sh 1'";
530         }
531         else {
532           $r = SUSystem "chroot $dir /bin/sh -c '$cmd'";
533         }
534       }
535       warn "$Script: execution of $pm failed" if $r;
536
537       SUSystem "rm -rf $dir/install" if $is_script;
538     }
539     elsif(/^R\s+(.+?)\s+(\S+)$/) {
540       my ($file, $re, @f, $i);
541
542       $file = $2;
543       $re = $1 . '; 1';         # fixup_re($1) ?
544
545       die "$Script: $file: no such file" unless -f "$dir/$file";
546       system "touch $tfile" and die "unable to access $file";
547       SUSystem "cp $dir/$file $tfile" and die "unable to access $file";
548
549       die "$Script: $file: $!" unless open F1, "$tfile";
550       @f = (<F1>);
551       close F1;
552       SUSystem "rm -f $tfile";
553
554       if($re =~ /\/s; 1$/) {    # multi line
555         $_ = join '', @f;
556         $ignore += 10;
557         $i = eval $re;
558         $ignore -= 10;
559         die "$Script: syntax error in expression" unless defined $i;
560         @f = ( $_ );
561       }
562       else {
563         for (@f) {
564           $ignore += 10;
565           $i = eval $re;
566           $ignore -= 10;
567           die "$Script: syntax error in expression" unless defined $i;
568         }
569       }
570       die "$Script: $file: $!" unless open F1, ">$tfile";
571       print F1 @f;
572       close F1;
573
574       SUSystem "cp $tfile $dir/$file" and die "unable to access $file";
575       SUSystem "rm -f $tfile";
576     }
577     else {
578       die "$Script: unknown entry: \"$_\"\n";
579     }
580   }
581
582   close F;
583
584   if(!($use_cache & 4)) {
585     SUSystem "rm -rf $tdir";
586   }
587   SUSystem "rm -f $tfile";
588
589   open F, ">${dir}.rpms";
590   print F @packs;
591   close F;
592
593   if($ENV{'nomods'}) {
594     for (split /,/, $ENV{'nomods'}) {
595       push @mod_list, "modules/$_.o\n"
596     }
597   }
598
599   if(@mod_list && $mod_list) {
600     open F, ">$mod_list";
601     print F @mod_list;
602     close F;
603   }
604
605   $SIG{'__WARN__'} = $old_warn;
606
607   return 1;
608 }
609
610
611 sub fixup_re
612 {
613   local ($_);
614   my ($re, $re0, $val);
615
616   $re0 = $re = shift;
617   $re0 =~ s/(('[^']*')|("[^"]*")|\b(defined|lt|gt|le|ge|eq|ne|cmp|not|and|or|xor)\b|(\(|\)))/' ' x length($1)/ge;
618   while($re0 =~ s/^((.*)(\b[a-zA-Z]\w+\b))/$2 . (' ' x length($3))/e) {
619 #    print "    >>$3<<\n";
620     $val = "\$ENV{'$3'}";
621     $val = $ENV{'___arch'} if $3 eq 'arch';
622     substr($re, length($2), length($3)) = $val;
623   }
624
625   return $re;
626 }
627
628
629 1;