Sign Up
Log In
Log In
or
Sign Up
Places
All Projects
Status Monitor
Collapse sidebar
home:adrianSuSE
build
unpackarchive
Overview
Repositories
Revisions
Requests
Users
Attributes
Meta
File unpackarchive of Package build
#!/usr/bin/perl ################################################################ # # Copyright (c) 2021 SUSE LLC # # 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; use Fcntl; use POSIX; # Slow but secure unpacking of tar/cpio archives. # All files we cannot handle (e.g. device nodes) are ignored. my $default_dirmode = 0700; my $add_dirmode = 0700; # # Input/Output # sub readdata { my ($l, $eofok, $prepend) = @_; my $d = ''; if (defined($prepend) && $prepend ne '') { die("prepend data is too big\n") if $l < length($prepend); $d = $prepend; $l -= length($d); } while ($l > 0) { my $r = read(STDIN, $d, $l > 65536 ? 65536 : $l, length($d)); next if !defined($r) && $! == POSIX::EINTR; die("read error: $!\n") unless defined $r; return undef if $eofok && !$r && $d eq ''; die("unexpected EOF\n") unless $r; $l -= $r; } return $d; } sub skipdata { my ($l) = @_; while ($l > 0) { my $d; my $r = read(STDIN, $d, $l > 65536 ? 65536 : $l); next if !defined($r) && $! == POSIX::EINTR; die("read error: $!\n") unless defined $r; die("unexpected EOF\n") unless $r; $l -= $r; } } sub writedata { my ($fd, $d) = @_; while (length($d)) { my $r = syswrite($fd, $d, length($d) > 65536 ? 65536 : length($d)); next if !defined($r) && $! == POSIX::EINTR; die("write error: $!\n") unless defined $r; $d = substr($d, $r) if $r; } } sub copydata { my ($fd, $l) = @_; while ($l > 0) { my $d = readdata($l > 65536 ? 65536 : $l); writedata($fd, $d); $l -= length($d); } } # # Cpio handling (newc format only) # sub cpio_parsehead { my ($cpiohead) = @_; return undef unless substr($cpiohead, 0, 6) eq '070701'; my $mode = hex(substr($cpiohead, 14, 8)); my $nlink = hex(substr($cpiohead, 38, 8)); my $mtime = hex(substr($cpiohead, 46, 8)); my $size = hex(substr($cpiohead, 54, 8)); my $pad = (4 - ($size % 4)) % 4; my $namesize = hex(substr($cpiohead, 94, 8)); my $namepad = (6 - ($namesize % 4)) % 4; my $ent = { 'size' => $size, 'mtime' => $mtime, 'mode' => $mode, 'cpiotype' => ($mode >> 12 & 0xf), 'nlink' => $nlink }; if ($nlink > 1) { my $ino = hex(substr($cpiohead, 6, 8)); my $devmaj = hex(substr($cpiohead, 62, 8)); my $devmin = hex(substr($cpiohead, 70, 8)); $ent->{'lnkid'} = "$ino/$devmaj/$devmin"; } return ($ent, $namesize, $namepad, $size, $pad); } my %cpiotype2type = ( '1' => 'p', '2' => 'c', '4' => 'd', '6' => 'b', '8' => 'f', '10' => 'l', '12' => 's', ); sub cpio_readhead { my ($prepend) = @_; my $cpiohead = readdata(110, 0, $prepend); die("cpio: not a 'SVR4 no CRC ascii' cpio\n") unless substr($cpiohead, 0, 6) eq '070701'; my ($ent, $namesize, $namepad, $size, $pad) = cpio_parsehead($cpiohead); die("cannot parse cpio header\n") unless $ent; die("ridiculous long filename\n") if $namesize > 8192; my $name = readdata($namesize + $namepad); $name = substr($name, 0, $namesize); $name =~ s/\0.*//s; return undef if !$size && $name eq 'TRAILER!!!'; $name =~ s/^\.\///s; $ent->{'name'} = $name; $ent->{'type'} = $cpiotype2type{$ent->{'cpiotype'}} || '?'; if ($ent->{'cpiotype'} eq '10') { die("bad symlink size\n") if $size <= 0 || $size >= 65536; my $linkname = readdata($size + $pad); $linkname = substr($linkname, 0, $size); $linkname =~ s/\0.*//s; $ent->{'linkname'} = $linkname; $size = $pad = 0; } elsif ($ent->{'lnkid'}) { cpio_handlehardlink($ent); } return ($ent, $size, $pad); } my %cpio_hardlinks; sub cpio_handlehardlink { my ($ent) = @_; my $lnkid = $ent->{'lnkid'}; my $lnk = $cpio_hardlinks{$lnkid}; if ($lnk) { $ent->{'linkname'} = $lnk->{'name'}; delete $cpio_hardlinks{$lnkid} if --$lnk->{'nlink'} == 0; } else { $cpio_hardlinks{$lnkid} = { 'name' => $ent->{'name'}, 'nlink' => $ent->{'nlink'} - 1 }; } } # # Tar handling (gnu, ustar, pax) # my @tar_headnames = qw{name mode uid gid size mtime chksum tartype linkname magic version uname gname major minor}; sub tar_parsehead { my ($tarhead) = @_; my @head = unpack('A100A8A8A8A12A12A8a1A100a6a2A32A32A8A8A155x12', $tarhead); /^([^\0]*)/s && ($_ = $1) for @head; $head[7] = '0' if $head[7] eq ''; # map old \0 type to 0 $head[$_] = oct($head[$_]) for (1, 2, 3, 5, 6, 13, 14); my $pad; if (substr($tarhead, 124, 1) eq "\x80") { # not octal, but binary! my @s = unpack('aCSNN', substr($tarhead, 124, 12)); $head[4] = $s[4] + (2 ** 32) * $s[3] + (2 ** 64) * $s[2]; $pad = (512 - ($s[4] & 511)) & 511; } else { $head[4] = oct($head[4]); $pad = (512 - ($head[4] & 511)) & 511; } $head[7] = '0' if $head[7] eq '' || $head[7] =~ /\W/; $head[7] = '5' if $head[7] eq '0' && $head[0] =~ /\/$/s; # dir if ($head[9] eq 'ustar' && $head[15] ne '') { # ustar prefix handling $head[15] =~ s/\/$//s; $head[0] = "$head[15]/$head[0]"; } my $ent = { map {$tar_headnames[$_] => $head[$_]} (0..$#tar_headnames) }; return ($ent, $head[4], $pad); } sub tar_parseoverride { my ($override, $tartype, $data) = @_; $override ||= {}; if ($tartype eq 'L') { $override->{'name'} = $data; } elsif ($tartype eq 'K') { $override->{'linkname'} = $data; } elsif ($tartype eq 'x' || $tartype eq 'X') { $override->{'ispax'} = 1; while ($data =~ /^(\d+) / && $1 > 3) { my $entry = substr($data, length($1) + 1, $1 - length($1) - 2); # -2 because of space and newline $data = substr($data, $1); $override->{'name'} = substr($entry, 5) if substr($entry, 0, 5) eq 'path='; $override->{'linkname'} = substr($entry, 9) if substr($entry, 0, 9) eq 'linkpath='; } } return $override; } my %tartype2type = ( '0' => 'f', '1' => 'L', '2' => 'l', '3' => 'c', '4' => 'b', '5' => 'd', '6' => 'p', ); sub tar_readhead { my ($prepend) = @_; my $override; while (1) { my $tarhead = readdata(512, 1, $prepend); undef $prepend; return undef unless defined $tarhead; return undef if $tarhead eq "\0" x 512; next if substr($tarhead, 500, 12) ne "\0" x 12; my ($ent, $size, $pad) = tar_parsehead($tarhead); my $bsize = $size + $pad; my $tartype = $ent->{'tartype'}; next if $tartype eq 'V'; # ignore volume lables if ($tartype eq 'L' || $tartype eq 'K' || $tartype eq 'x' || $tartype eq 'X') { die("bad extension block size\n") if $bsize < 1 || $bsize >= 1024 * 1024; $override = tar_parseoverride($override, $tartype, substr(readdata($bsize), 0, $size)); next; } if ($override) { $ent->{$_} = $override->{$_} for keys %$override; undef $override; } $size = $pad = 0 if $tartype eq '2' || $tartype eq '3' || $tartype eq '4' || $tartype eq '5' || $tartype eq '6'; $size = $pad = 0 if $tartype eq '1' && !$ent->{'ispax'}; # hard link magic $ent->{'type'} = $tartype2type{$tartype} || '?'; return ($ent, $size, $pad); } } # # Path resolving # my %cache; # name => resolved_dir sub flush_dircache { %cache = (); } sub create_dir { my ($root, $r, $mode) = @_; mkdir("$root$r", $mode | $add_dirmode) || die("mkdir $r: $!\n"); $cache{$r} = "$r/"; } sub resolve_dir { my ($root, $name, $linkdepth) = @_; return '/' if $name eq '' || $name eq '/'; my $c = $cache{$name}; return $c if defined $c; my ($dir, $comp) = ('/', $name); ($dir, $comp) = ($1, $2) if $name =~ /\A(.*?)\/+([^\/]*)\z/s; my $r = resolve_dir($root, $dir); if ($comp eq '.' || $comp eq '') { $cache{$name} = $r; return $r; } if ($comp eq '..') { $r = '/' unless $r =~ s/\/[^\/]*\/\z/\//s; $cache{$name} = $r; return $r; } my $rcomp = "$r$comp"; my @s = lstat("$root$rcomp"); if (!@s) { die("$rcomp: $!\n") unless $! == POSIX::ENOENT; create_dir($root, "$rcomp", $default_dirmode); $r = "$rcomp/"; } elsif (-l _) { die("$name: Too many levels of symbolic links\n") if ++$linkdepth > 20; my $link = readlink("$root$rcomp"); die("readlink $rcomp: $!\n") unless defined $link; $r = resolve_dir($root, "$r$link", ($linkdepth || 0) + 1); } elsif (-d _) { $r = "$rcomp/"; } else { die("$rcomp: Not a directory\n"); } $cache{$name} = $r; return $r; } sub resolve_file { my ($root, $name) = @_; $name =~ s/\/+\z//s; return '/.' if $name eq '' || $name eq '/'; my ($dir, $comp) = ('/', $name); ($dir, $comp) = ($1, $2) if $name =~ /\A(.*?)\/+([^\/]*)\z/s; $dir = $cache{$dir} || resolve_dir($root, $dir); return "$dir$comp"; } # # Decompression handling # sub detect_decompressor { my ($first16bytes) = @_; my @sig = unpack('N4', $first16bytes); return qw{gzip -dc} if ($sig[0] & 0xffffffe0) == 0x1f8b0800; return qw{bzip2 -dc} if ($sig[0] & 0xfffffff0) == 0x425a6830 && ($sig[1] == 0x31415926 || $sig[1] == 0x17724538); return qw{xz -dc} if ($sig[0] & 0xffffffff) == 0xfd377a58 && ($sig[1] & 0xffff0000) == 0x5a000000; return qw{zstd -dc} if ($sig[0] & 0xffffff00) == 0x28b52f00; return (); } sub handle_decompression { my $first16bytes = readdata(16); my @decomp = detect_decompressor($first16bytes); return $first16bytes unless @decomp; local *F; open(F, "<&STDIN") || die("stdin dup: $!\n"); my $pid = open(STDIN, '-|'); die("fork: $!\n") unless defined $pid; if (!$pid) { local *G; my $pid2 = open(G, '|-'); die("fork: $!\n") unless defined $pid2; if (!$pid2) { exec(@decomp); die("$decomp[0]: $!\n"); } print G $first16bytes if $first16bytes ne ''; while (1) { my $d = ''; my $r = read(F, $d, 8192); next if !defined($r) && $! == POSIX::EINTR; die("read error: $!\n") unless defined $r; exit(0) unless $r; print G $d; } close(G) || die("pipe close: $!\n"); } close(F); return undef; } # # Main # die("usage: unpackarchive --cpio|--tar [-C <root>]\n") unless @ARGV; my $format = shift @ARGV; my $root = '.'; while (@ARGV) { if (@ARGV > 1 && $ARGV[0] eq '-C') { (undef, $root) = splice(@ARGV, 0, 2); } elsif (@ARGV && $ARGV[0] eq '-J') { shift @ARGV; } elsif ($ARGV[0] eq '-j' || $ARGV[0] eq '-J' || $ARGV[0] eq '-z') { shift @ARGV; } elsif ($ARGV[0] =~ /^-/) { die("unpackarchive: unsupported option $ARGV[0]\n"); } else { die("usage: unpackarchive --cpio|--tar [-C <root>]\n"); } } die("$root: No such file or directory\n") unless -d $root; my $readhead; $readhead = \&cpio_readhead if $format eq '--cpio'; $readhead = \&tar_readhead if $format eq '--tar'; die("unknown format option $format\n") unless $readhead; umask(0); # do not mess with the modes my $prepend = handle_decompression(); while (1) { my ($ent, $size, $pad) = $readhead->($prepend); undef $prepend; last unless defined $ent; my $name = $ent->{'name'}; my $type = $ent->{'type'}; $name =~ s/\A\/+//s; $name =~ s/\/+\z//s; $ent->{'name'} = $name; if ($name eq '') { skipdata($size + $pad); next; } if ($type ne 'd' && $type ne 'f' && $type ne 'l' && $type ne 'L') { skipdata($size + $pad); next; } my $linkname = $ent->{'linkname'}; #if (defined($linkname) && $linkname ne '') { # print "$ent->{'type'} $name -> $linkname\n"; #} else { # print "$ent->{'type'} $name\n"; #} $name = resolve_file($root, $name); my @s = lstat("$root$name"); die("$name: $!\n") if !@s && $! != POSIX::ENOENT; if (@s) { # entry already exists. handle conflicts. if (-d _) { die("$name: Is a directory\n") unless $type eq 'd'; chmod(($ent->{'mode'} & 07777) | $add_dirmode, "$root$name"); utime($ent->{'mtime'}, $ent->{'mtime'}, "$root$name"); skipdata($size + $pad); next; } elsif (-f _) { unlink("$root$name") if $type eq 'l' || $type eq 'd'; } else { unlink("$root$name") || die("unlink $name: $!\n"); flush_dircache(); # start over from scratch } } if (defined($linkname) && $linkname ne '') { if ($type eq 'l') { symlink($linkname, "$root$name") || die("symlink $linkname $name: $!\n"); skipdata($size + $pad); next; } if ($type ne 'L' && $type ne 'f') { skipdata($size + $pad); next; } $linkname = resolve_file($root, $linkname); my @s2 = lstat("$root$linkname"); die("$linkname: $!\n") unless @s2; die("$linkname: Not a regular file\n") unless -f _; link("$root$linkname", "$root$name") || die("link $linkname $name: $!\n"); $type = 'f' if $type eq 'L' && $size > 0; } if ($type eq 'd') { create_dir($root, $name, $ent->{'mode'} & 07777); utime($ent->{'mtime'}, $ent->{'mtime'}, "$root$name"); } elsif ($type eq 'f') { my $fd; sysopen($fd, "$root$name", O_WRONLY|O_CREAT|O_TRUNC, $ent->{'mode'} & 07777) || die("$root$name: $!\n"); copydata($fd, $size); close($fd) || die("close $name: $!\n"); utime($ent->{'mtime'}, $ent->{'mtime'}, "$root$name"); skipdata($pad); } else { skipdata($size + $pad); } }
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