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