- check will fail anyway
[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 --sparse -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 --sparse -dimu --no-absolute-filenames'" and
331             warn "$Script: failed to extract $r";
332           if($p eq $ConfigData{kernel_rpm}) {
333             my $r2 = RPMFileName "$p-nongpl";
334             warn("$Script: no such package: $p-nongpl.rpm"), next unless $r2 && -f $r2;
335             SUSystem "sh -c 'cd $tdir ; rpm2cpio $r2 | cpio --quiet --sparse -dimu --no-absolute-filenames'" and
336               warn "$Script: failed to extract $r2";
337           }
338         }
339       }
340     }
341     elsif(!/^[a-zA-Z]\s+/ && /^(.*)$/) {
342       $files = $1;
343       $files =~ s.(^|\s)/.$1.g;
344       $files = "." if $files =~ /^\s*$/;
345       SUSystem "sh -c '( cd $tdir; tar --sparse -cf - $files 2>$tfile ) | tar -C $dir -xpf -'" and
346         warn "$Script: failed to copy $files";
347
348       my (@f, $f);
349       @f = `cat $tfile`;
350       print STDERR @f;
351       SUSystem "rm -f $tfile";
352       for $f (@f) {
353         warn "$Script: failed to copy \"$files\"" if $f =~ /tar:\s+Error/;
354       }
355     }
356     elsif(/^d\s+(.+)$/) {
357       $d = $1; $d =~ s.(^|\s)/.$1.g;
358       SUSystem "sh -c 'cd $dir; mkdir -p $d'" and
359         warn "$Script: failed to create $d";
360     }
361     elsif(/^t\s+(.+)$/) {
362       $d = $1; $d =~ s.(^|\s)/.$1.g;
363       SUSystem "sh -c 'cd $dir; touch $d'" and
364         warn "$Script: failed to touch $d";
365     }
366     elsif(/^r\s+(.+)$/) {
367       $d = $1; $d =~ s.(^|\s)/.$1.g;
368       SUSystem "sh -c 'cd $dir; rm -rf $d'" and
369         warn "$Script: failed to remove $d";
370     }
371     elsif(/^S\s+(.+)$/) {
372       $d = $1; $d =~ s.(^|\s)/.$1.g;
373       SUSystem "sh -c 'cd $dir; strip $d'" and
374         warn "$Script: failed to strip $d";
375     }
376     elsif(/^l\s+(\S+)\s+(\S+)$/) {
377       SUSystem "ln $dir/$1 $dir/$2" and
378         warn "$Script: failed to link $1 to $2";
379     }
380     elsif(/^s\s+(\S+)\s+(\S+)$/) {
381       SUSystem "ln -s $1 $dir/$2" and
382         warn "$Script: failed to symlink $1 to $2";
383     }
384     elsif(/^m\s+(\S+)\s+(\S+)$/) {
385       SUSystem "sh -c \"cp -a $tdir/$1 $dir/$2\"" and
386         warn "$Script: failed to move $1 to $2";
387     }
388     elsif(/^a\s+(\S+)\s+(\S+)$/) {
389       SUSystem "sh -c \"cp -pLR $tdir/$1 $dir/$2\"" and
390         warn "$Script: failed to move $1 to $2\n";
391     }
392     elsif(/^([fF])\s+(\S+)\s+(\S+)(\s+(\S+))?$/) {
393       my ($l, @l, $src, $name, $dst, $start_dir);
394
395       $src = $2;
396       $name = $3;
397       $dst = $5;
398       $start_dir = $1 eq "F" ? "/" : $tdir;
399       $src =~ s#^/*##;
400       SUSystem "sh -c \"cd $start_dir ; find $src -type f -name '$name'\" >$tfile";
401
402       open F1, "$tfile";
403       @l = (<F1>);
404       close F1;
405       SUSystem "rm -f $tfile";
406       chomp @l;
407
408       if(@l == 0) {
409         warn "$Script: \"$name\" not found in \"$src\"";
410       }
411
412       if($dst) {
413         for $l (@l) {
414           SUSystem "sh -c \"cp -a $start_dir/$l $dir/$dst\"" and
415             print "$Script: $l not copied to $dst (ignored)\n";
416         }
417       }
418       else {
419         for $l (@l) {
420           SUSystem "sh -c '( cd $start_dir; tar -cf - $l 2>$tfile ) | tar -C $dir -xpf -'" and
421             warn "$Script: failed to copy $files";
422
423           my (@f, $f);
424           @f = `cat $tfile`;
425           print STDERR @f;
426           SUSystem "rm -f $tfile";
427           for $f (@f) {
428             warn "$Script: failed to copy \"$l\"" if $f =~ /tar:\s+Error/;
429           }
430         }
431       }
432     }
433     elsif(/^p\s+(\S+)$/) {
434       SUSystem "patch -d $dir -p0 --no-backup-if-mismatch <$ext_dir/$1 >/dev/null" and
435         warn "$Script: failed to apply patch $1";
436     }
437     elsif(/^A\s+(\S+)\s+(\S+)$/) {
438       SUSystem "sh -c 'cat $ext_dir/$1 >>$dir/$2'" and
439         warn "$Script: failed to append $1 to $2";
440     }
441     elsif(/^x\s+(\S+)\s+(\S+)$/) {
442       SUSystem "cp -dR $ext_dir/$1 $dir/$2" and
443         warn "$Script: failed to move $1 to $2";
444     }
445     elsif(/^X\s+(\S+)\s+(\S+)$/) {
446       SUSystem "cp -dR $1 $dir/$2 2>/dev/null" and
447         print "$Script: $1 not copied to $2 (ignored)\n";
448     }
449     elsif(/^g\s+(\S+)\s+(\S+)$/) {
450       SUSystem "sh -c 'gunzip -c $tdir/$1 >$dir/$2'" and
451         warn "$Script: could not uncompress $1 to $2";
452     }
453     elsif(/^c\s+(\d+)\s+(\S+)\s+(\S+)\s+(.+)$/) {
454       $p = $1; $u = $2; $g = $3;
455       $d = $4; $d =~ s.(^|\s)/.$1.g;
456       SUSystem "sh -c 'cd $dir; chown $u:$g $d'" and
457         warn "$Script: failto to change owner of $d to $u:$g";
458       SUSystem "sh -c 'cd $dir; chmod $p $d'" and
459         warn "$Script: failto to change perms of $d to $p";
460     }
461     elsif(/^b\s+(\d+)\s+(\d+)\s+(\S+)$/) {
462       SUSystem "mknod $dir/$3 b $1 $2" and
463         warn "$Script: failto to make block dev $3 ($1, $2)";
464     }
465     elsif(/^C\s+(\d+)\s+(\d+)\s+(\S+)$/) {
466       SUSystem "mknod $dir/$3 c $1 $2" and
467         warn "$Script: failto to make char dev $3 ($1, $2)";
468     }
469     elsif(/^n\s+(.+)$/) {
470       SUSystem "mknod $dir/$1 p" and
471         warn "$Script: failto to make named pipe $1";
472     }
473 =head1
474     elsif(/^M\s+(\S+)\s+(\S+)$/) {
475       SUSystem "sh -c \"cp -av $tdir/$1 $dir/$2\" >$tfile" and
476         print "$Script: $1 not copied to $2 (ignored)\n";
477
478       my ($f, $g);
479       for $f (`cat $tfile`) {
480         if($f =~ /\s->\s$dir\/(.*)\n?$/) {
481           $g = $1; $g =~ s/^\/*//;
482           push @mod_list, "$g\n" unless exists $mod_list{$g};
483           $mod_list{$g} = 1;
484         }
485         elsif($f =~ /\s->\s\`$dir\/(.*)\'\n?$/) {
486           $g = $1; $g =~ s/^\/*//;
487           push @mod_list, "$g\n" unless exists $mod_list{$g};
488           $mod_list{$g} = 1;
489         }
490       }
491     }
492 =cut
493     elsif(/^M\s+(.*)$/) {
494       my ($ml, @ml);
495
496       $ml = $1;
497       @ml = split ' ', $ml;
498       if($ml !~ m#/#) {
499         @ml = map { $_ = "modules/$_.o\n" } @ml;
500       }
501       else {
502         @ml = map { $_ .= "\n" } @ml;
503       }
504       push @mod_list, @ml
505     }
506     elsif(/^([eE])\s+(.+)$/) {
507       my ($cmd, $xdir, $basedir, $r, $e, $pm, $is_script);
508
509       $e = $1;
510       $cmd = $2;
511       $xdir = $dir;
512       $xdir =~ s#/*$##;
513       $basedir = $1 if $xdir =~ s#(.*)/##;
514       $is_script = exists $script{$cmd};
515       $pm = $is_script ? "$cmd script" : "\"$cmd\"";
516
517       die "internal oops" unless $basedir ne "" && $xdir ne "";
518
519       if($is_script) {
520         SUSystem "sh -c 'mkdir $dir/install && chmod 777 $dir/install'" and
521           die "$Script: failed to create $dir/install";
522         die "$Script: unable to create $pm" unless open W, ">$dir/install/inst.sh";
523         print W @{$script{$cmd}};
524         close W;
525
526         $e = 'E' if $xdir eq 'base';
527       }
528
529       print "running $pm\n" if $debug =~ /\bpkg\b/;
530       if($e eq 'e') {
531         SUSystem "mv $dir $basedir/base/xxxx" and die "oops";
532         if($is_script) {
533           $r = SUSystem "chroot $basedir/base /bin/sh -c 'cd xxxx ; sh install/inst.sh 1'";
534         }
535         else {
536           $r = SUSystem "chroot $basedir/base /bin/sh -c 'cd xxxx ; $cmd'";
537         }
538         SUSystem "mv $basedir/base/xxxx $dir" and die "oops";
539       }
540       else {
541         if($is_script) {
542           $r = SUSystem "chroot $dir /bin/sh -c 'sh install/inst.sh 1'";
543         }
544         else {
545           $r = SUSystem "chroot $dir /bin/sh -c '$cmd'";
546         }
547       }
548       warn "$Script: execution of $pm failed" if $r;
549
550       SUSystem "rm -rf $dir/install" if $is_script;
551     }
552     elsif(/^R\s+(.+?)\s+(\S+)$/) {
553       my ($file, $re, @f, $i);
554
555       $file = $2;
556       $re = $1 . '; 1';         # fixup_re($1) ?
557
558       # die "$Script: $file: no such file" unless -f "$dir/$file";
559       system "touch $tfile" and die "unable to access $file";
560       SUSystem "cp $dir/$file $tfile" and die "unable to access $file";
561
562       die "$Script: $file: $!" unless open F1, "$tfile";
563       @f = (<F1>);
564       close F1;
565       SUSystem "rm -f $tfile";
566
567       if($re =~ /\/s; 1$/) {    # multi line
568         $_ = join '', @f;
569         $ignore += 10;
570         $i = eval $re;
571         $ignore -= 10;
572         die "$Script: syntax error in expression" unless defined $i;
573         @f = ( $_ );
574       }
575       else {
576         for (@f) {
577           $ignore += 10;
578           $i = eval $re;
579           $ignore -= 10;
580           die "$Script: syntax error in expression" unless defined $i;
581         }
582       }
583       die "$Script: $file: $!" unless open F1, ">$tfile";
584       print F1 @f;
585       close F1;
586
587       SUSystem "cp $tfile $dir/$file" and die "unable to access $file";
588       SUSystem "rm -f $tfile";
589     }
590     else {
591       die "$Script: unknown entry: \"$_\"\n";
592     }
593   }
594
595   close F;
596
597   if(!($use_cache & 4)) {
598     SUSystem "rm -rf $tdir";
599   }
600   SUSystem "rm -f $tfile";
601
602   open F, ">${dir}.rpms";
603   print F @packs;
604   close F;
605
606   open F, ">${dir}.rpmlog";
607   print F @plog;
608   close F;
609
610   if($ENV{'nomods'}) {
611     for (split /,/, $ENV{'nomods'}) {
612       push @mod_list, "modules/$_.o\n"
613     }
614   }
615
616   if(@mod_list && $mod_list) {
617     open F, ">$mod_list";
618     print F @mod_list;
619     close F;
620   }
621
622   $SIG{'__WARN__'} = $old_warn;
623
624   return 1;
625 }
626
627
628 sub fixup_re
629 {
630   local ($_);
631   my ($re, $re0, $val);
632
633   $re0 = $re = shift;
634   $re0 =~ s/(('[^']*')|("[^"]*")|\b(defined|lt|gt|le|ge|eq|ne|cmp|not|and|or|xor)\b|(\(|\)))/' ' x length($1)/ge;
635   while($re0 =~ s/^((.*)(\b[a-zA-Z]\w+\b))/$2 . (' ' x length($3))/e) {
636 #    print "    >>$3<<\n";
637     if(exists $ConfigData{$3}) {
638       $val = "\$ConfigData{'$3'}";
639     }
640     else {
641       $val = "\$ENV{'$3'}";
642     }
643     $val = $ENV{'___arch'} if $3 eq 'arch';
644     substr($re, length($2), length($3)) = $val;
645   }
646
647   return $re;
648 }
649
650
651 1;