extractbuild

   1 #!/usr/bin/perl -w
   2
   3 ################################################################
   4 #
   5 # Copyright (c) 1995-2014 SUSE Linux Products GmbH
   6 #
   7 # This program is free software; you can redistribute it and/or modify
   8 # it under the terms of the GNU General Public License version 2 or 3 as
   9 # published by the Free Software Foundation.
  10 #
  11 # This program is distributed in the hope that it will be useful,
  12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 # GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License
  17 # along with this program (see the file COPYING); if not, write to the
  18 # Free Software Foundation, Inc.,
  19 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
  20 #
  21 ################################################################
  22
  23 use strict;
  24
  25 # buffer size for reading
  26 my $bufsize = 4*1024*1024;
  27
  28 my ($opt_skip, $opt_disk, $opt_input, $opt_verbose);
  29 $opt_verbose = 0;
  30
  31 while (@ARGV)  {
  32   if ($ARGV[0] eq '--skip') {
  33     shift @ARGV;
  34     $opt_skip = shift @ARGV;
  35     next;
  36   }
  37   if ($ARGV[0] eq '--disk') {
  38     shift @ARGV;
  39     $opt_disk = shift @ARGV;
  40     next;
  41   }
  42   if ($ARGV[0] eq '--input') {
  43     shift @ARGV;
  44     $opt_input = shift @ARGV;
  45     next;
  46   }
  47   if ($ARGV[0] eq '--verbose' || $ARGV[0] eq '-v') {
  48     shift @ARGV;
  49     $opt_verbose++;
  50     next;
  51   }
  52   last;
  53 }
  54
  55 die "need to specify disk image\n" unless $opt_disk;
  56
  57 open(F, '<', $opt_disk) || die "$opt_disk: $!\n";
  58
  59 if ($opt_input) {
  60   open(S, '<', $opt_input) || die "$opt_input: $!\n";
  61 } else {
  62   open(S, '<&STDIN') || die "can't dup stdin: $!\n";
  63 }
  64
  65 # skip build status
  66 if ($opt_skip) {
  67   seek(S, $opt_skip, 0) || die "seek: $!\n";
  68 }
  69
  70 my %done;
  71 while (<S>) {
  72   chomp;
  73   last unless length $_;
  74   my ($filetype, $file, $filesize, $blksize, @blocks) = split(/ /);
  75   die("invalid input '$_'\n") unless defined($file);
  76   $file =~ s/%([a-fA-F0-9]{2})/chr(hex($1))/ge;
  77   die("bad file '$file'\n") if "/$file/" =~ /\/\.{0,2}\//s;
  78   if ($file =~ /^(.*)\//s) {
  79     die("file without directory: $file\n") unless $done{$1} && $done{$1} eq 'd';
  80   }
  81   if ($filetype eq 'd') {       # dir
  82     print "$file\n" if $opt_verbose && $opt_verbose > 1;
  83     mkdir($file) || die("mkdir $file: $!\n");
  84     $done{$file} = 'd';
  85     next;
  86   }
  87   if ($filetype eq 'l') {       # symlink
  88     my $target = $filesize;
  89     die("symlink without target\n") unless defined $target;
  90     $target =~ s/%([a-fA-F0-9]{2})/chr(hex($1))/ge;
  91     die("bad symlink: $target\n") if "/$target/" =~ /\/\.?\//s;
  92     if ("/$target/" =~ /^(\/\.\.)+\/(.*?)$/s) {
  93       my ($head, $tail) = ($1, $2);
  94       die("bad upref in symlink: $target\n") if "/$tail/" =~ /\/\.\.\//s;
  95       die("bad upref in symlink: $target\n") if ($head =~ y!/!!) > ($file =~ y!/!!);
  96     } else {
  97       die("bad upref in symlink: $target\n") if "/$target/" =~ /\/\.\.\//s;
  98     }
  99     print "$file\n" if $opt_verbose && !($opt_verbose == 1 && $file =~ /^KIWI\/.*\//);
 100     symlink($target, $file) || die("symlink $target $file: $!\n");
 101     $done{$file} = 'l';
 102     next;
 103   }
 104   die("illegal file type: $filetype\n") unless $filetype eq 'f';
 105   die "invalid input '$_'\n" if !@blocks && $filesize;
 106   $done{$file} = 'f';
 107   $filesize = int($filesize);
 108   if ($filesize == 0) {
 109     print "$file\n" if $opt_verbose && !($opt_verbose == 1 && $file =~ /^KIWI\/.*\//);
 110     open (O, '>', $file) or die "$file: $!\n";
 111     close O;
 112     next;
 113   }
 114   $blksize = int($blksize);
 115   die "$file: invalid block size $blksize\n" unless $blksize > 0 && $blksize <= $bufsize;
 116   my $maxblocks = int($bufsize/$blksize);
 117   print "$file\n" if $opt_verbose && !($opt_verbose == 1 && $file =~ /^KIWI\/.*\//);
 118   open (O, '>', $file) or die "$file: $!\n";
 119   for my $block (@blocks) {
 120     my $end;
 121     ($block, $end) = split(/-/, $block);
 122     $block = int($block);
 123     if ($block == 0) { # a hole!
 124       $end = (($end || 0) + 1) * $blksize;
 125       $end = $filesize if $end > $filesize;
 126       seek(O, $end, 1);
 127       $filesize -= $end;
 128       next;
 129     }
 130     $end = $block unless $end;
 131     $end = int($end);
 132     seek(F, $block*$blksize, 0) || die "$file: seek: $!\n";
 133     while ($block <= $end && $filesize) {
 134       my $size;
 135       if ($end == $block) {
 136         $size = $blksize;
 137         ++$block;
 138       } elsif ($maxblocks >= $end-$block) {
 139         $size = ($end-$block)*$blksize;
 140         $block += $end-$block;
 141       } else {
 142         $size = $maxblocks*$blksize;
 143         $block += $maxblocks;
 144       }
 145       $size = $filesize if $size > $filesize;
 146       my $buf;
 147       (sysread(F, $buf, $size) || 0) == $size || die("$file: read: $!\n");
 148       $filesize -= $size;
 149       (syswrite(O, $buf) || 0) == length($buf) || die("$file: write error\n");
 150     }
 151   }
 152   close(O) || die("$file: close error: $!\n");
 153   # sanity check
 154   die "$file: invalid file size ($filesize byes left)\n" if $filesize != 0;
 155 }