Sign Up
Log In
Log In
or
Sign Up
Places
All Projects
Status Monitor
Collapse sidebar
home:adrianSuSE
build
extractbuild
Overview
Repositories
Revisions
Requests
Users
Attributes
Meta
File extractbuild of Package build
#!/usr/bin/perl -w ################################################################ # # Copyright (c) 1995-2021 SUSE Linux Products GmbH # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License version 2 or 3 as # published by the Free Software Foundation. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program (see the file COPYING); if not, write to the # Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA # ################################################################ use strict; sub read_blob { my ($fd, $l, $off) = @_; !defined($off) || sysseek($fd, $off, 0) || die("sysseek $off: $!\n"); my $buf = ''; while ($l > 0) { my $r = sysread($fd, $buf, $l, length($buf)); die("sysread: $!\n") unless defined $r; die("sysread: EOF\n") unless $r > 0; $l -= $r; } return $buf; } sub qcow_open { my ($fd) = @_; my @hdr = unpack("N*", read_blob($fd, 72, 0)); die("not a qcow2 image\n") unless $hdr[0] == 0x514649fb; die("unsupported qcow2 version $hdr[1]\n") unless $hdr[1] == 2 || $hdr[1] == 3; die("illegal cluster bits size $hdr[5]\n") if $hdr[5] < 9 || $hdr[5] > 24; die("encrypted qcow2 image\n") if $hdr[8]; if ($hdr[1] == 3) { push @hdr, unpack("N*", read_blob($fd, 32)); die("incompatible qcow2 feature ($hdr[18]/$hdr[19])\n") if $hdr[18] || ($hdr[19] & 0xfffffffc); } my @l1 = unpack("N*", read_blob($fd, $hdr[9] * 8, $hdr[10] * 4294967296 + $hdr[11])); my @l; while (@l1) { my ($l1a, $l1b) = splice(@l1, 0, 2); die("bad l1 table entry\n") if $l1b & 0x1ff; my $l2off = ($l1b & 0xfffffe00) + ($l1a & 0xffffff) * 4294967296; if (!$l2off) { push @l, (undef) x (1 << ($hdr[5] - 3)); next; # unallocated } my @l2 = unpack("N*", read_blob($fd, (1 << $hdr[5]), $l2off)); while (@l2) { my ($l2a, $l2b) = splice(@l2, 0, 2); if ($l2a & 0x40000000) { die("compressed clusters are not yet supported\n"); } else { die("all zero clusters are not supported\n") if $l2b & 1; my $coff = ($l2b & 0xfffffe00) + ($l2a & 0xffffff) * 4294967296; push @l, $coff ? $coff : undef; } } } my $qcow = [ $fd, (1 << $hdr[5]), \@l, \@hdr]; return $qcow; } sub qcow_copy { my ($qcow, $out, $start, $len) = @_; my $csize = $qcow->[1]; while ($len > 0) { my ($c, $co) = (int($start / $csize), $start % $csize); die("cluster outside of mapping table\n") if $c < 0 || $c >= @{$qcow->[2]}; my $off = $qcow->[2]->[$c]; die("unmapped qcow2 cluster $c\n") unless defined $off; my $l = $csize - $co; my $chunk = read_blob($qcow->[0], $l > $len ? $len : $l, $off + $co); (syswrite($out, $chunk) || 0) == length($chunk) || die("write error\n"); $len -= length($chunk); $start += length($chunk); } } # buffer size for reading my $bufsize = 4*1024*1024; my ($opt_skip, $opt_disk, $opt_input, $opt_verbose, $opt_qcow); $opt_verbose = 0; while (@ARGV) { if ($ARGV[0] eq '--skip') { shift @ARGV; $opt_skip = shift @ARGV; next; } if ($ARGV[0] eq '--disk') { shift @ARGV; $opt_disk = shift @ARGV; next; } if ($ARGV[0] eq '--input') { shift @ARGV; $opt_input = shift @ARGV; next; } if ($ARGV[0] eq '--qcow' || $ARGV[0] eq '--qcow2') { shift @ARGV; $opt_qcow = 1; next; } if ($ARGV[0] eq '--verbose' || $ARGV[0] eq '-v') { shift @ARGV; $opt_verbose++; next; } last; } die "usage: extractbuild [--qcow2] [--verbose] [--skip n] [--input <manifest] --disk <image>\n" unless $opt_disk; open(F, '<', $opt_disk) || die "$opt_disk: $!\n"; if ($opt_input) { open(S, '<', $opt_input) || die "$opt_input: $!\n"; } else { open(S, '<&STDIN') || die "can't dup stdin: $!\n"; } # skip build status if ($opt_skip) { seek(S, $opt_skip, 0) || die "seek: $!\n"; } my $qcow; $qcow = qcow_open(\*F) if $opt_qcow; my %done; while (<S>) { chomp; last unless length $_; my ($filetype, $file, $filesize, $blksize, @blocks) = split(' '); die("invalid input '$_'\n") unless defined($file); $file =~ s/%([a-fA-F0-9]{2})/chr(hex($1))/ge; die("bad file '$file' (contains \\0)\n") if $file =~ /\0/; die("already processed: $file\n") if $done{$file}; die("bad file '$file'\n") if "/$file/" =~ /\/\.{0,2}\//s; if ($file =~ /^(.*)\//s) { die("file without directory: $file\n") unless $done{$1} && $done{$1} eq 'd'; } if ($filetype eq 'd') { # dir print "$file\n" if $opt_verbose && ($opt_verbose > 1 || $file =~ /^KIWI\/[^\/]*$/); mkdir($file) || die("mkdir $file: $!\n"); $done{$file} = 'd'; next; } if ($filetype eq 'l') { # symlink my $target = $filesize; die("symlink without target\n") unless defined $target; $target =~ s/%([a-fA-F0-9]{2})/chr(hex($1))/ge; die("bad symlink: $target (contains \\0)\n") if $target =~ /\0/; die("bad symlink: $target\n") if "/$target/" =~ /\/\.?\//s; if ("/$target/" =~ /^((?:\/\.\.)+)\/(.*?)$/s) { my ($head, $tail) = ($1, $2); die("bad upref in symlink: $target\n") if "/$tail/" =~ /\/\.\.\//s; die("bad upref in symlink: $target\n") if ($head =~ y!/!!) > ($file =~ y!/!!); } else { die("bad upref in symlink: $target\n") if "/$target/" =~ /\/\.\.\//s; } print "$file\n" if $opt_verbose && !($opt_verbose == 1 && $file =~ /^KIWI\/.*\//); symlink($target, $file) || die("symlink $target $file: $!\n"); $done{$file} = 'l'; next; } die("illegal file type: $filetype\n") unless $filetype eq 'f'; print "$file\n" if $opt_verbose && !($opt_verbose == 1 && $file =~ /^KIWI\/.*\//); $done{$file} = 'f'; open (O, '>', $file) or die "$file: $!\n"; if ($filesize == 0) { close(O) || die("$file: close error: $!\n"); next; } $blksize = int($blksize); die "$file: invalid block size $blksize\n" unless $blksize > 0 && $blksize <= $bufsize; my $needtruncate; my $left = $filesize; for my $block (@blocks) { die("bad extent '$block'\n") unless $block =~ /^(\d+)(?::(\d+))?(?:-(\d+)(?::(\d+))?)?$/; my ($startblk, $startoff, $endblk, $endoff) = ($1, $2, $3, $4); $startoff = 0 unless defined $startoff; $endblk = $startblk unless defined $endblk; $endoff = $blksize - 1 unless defined $endoff; my $start = $startblk * $blksize + $startoff; my $len = $endblk * $blksize + $endoff + 1 - $start; die "$file: bad length\n" if $len <= 0; die "$file: extent is outside of file\n" if $left <= 0; $len = $left if $len > $left; # it's ok to overshoot the last block $left -= $len; if ($start == 0) { # a hole! sysseek(O, $len, 1); $needtruncate = 1; next; } $needtruncate = undef; if ($qcow) { qcow_copy($qcow, \*O, $start, $len); next; } sysseek(F, $start, 0) || die "$file: seek: $!\n"; while ($len > 0) { my $size = $len > $bufsize ? $bufsize : $len; my $buf; (sysread(F, $buf, $size) || 0) == $size || die("$file: read: $!\n"); (syswrite(O, $buf) || 0) == length($buf) || die("$file: write error\n"); $len -= $size; } } truncate(O, $filesize) if $needtruncate; close(O) || die("$file: close error: $!\n"); # sanity check die "$file: invalid file size ($left bytes left)\n" if $left != 0; }
Locations
Projects
Search
Status Monitor
Help
OpenBuildService.org
Documentation
API Documentation
Code of Conduct
Contact
Support
@OBShq
The Open Build Service is an
openSUSE project
.
Sign Up
Log In
Places
Places
All Projects
Status Monitor