aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--Packdrakeng.pm219
-rw-r--r--Packdrakeng/zlib.pm138
2 files changed, 209 insertions, 148 deletions
diff --git a/Packdrakeng.pm b/Packdrakeng.pm
index 6e13d65..e822dad 100644
--- a/Packdrakeng.pm
+++ b/Packdrakeng.pm
@@ -156,6 +156,7 @@ sub choose_compression_method {
sub DESTROY {
my ($pack) = @_;
+ $pack->{subuncompress}($pack, undef, undef);
$pack->build_toc();
close($pack->{handle}) if ($pack->{handle});
}
@@ -256,6 +257,17 @@ sub read_toc {
1;
}
+sub sort_files_by_packing {
+ my ($pack, @files) = @_;
+ sort {
+ defined($pack->{files}{$a}) && defined($pack->{files}{$b}) ?
+ ($pack->{files}{$a}{coff} == $pack->{files}{$b}{coff} ?
+ $pack->{files}{$a}{off} <=> $pack->{files}{$b}{off} :
+ $pack->{files}{$a}{coff} <=> $pack->{files}{$b}{coff}) :
+ $a cmp $b
+ } @files;
+}
+
# Goto to the end of written compressed data
sub end_seek {
my ($pack) = @_;
@@ -340,55 +352,89 @@ sub extern_compress {
sub extern_uncompress {
my ($pack, $destfh, $fileinfo) = @_;
+ if (defined($pack->{ustream_data}) && (
+ !defined($fileinfo) ||
+ ($fileinfo->{coff} != $pack->{ustream_data}{coff} || $fileinfo->{off} < $pack->{ustream_data}{off})
+ )) {
+ close($pack->{ustream_data}{handle});
+ unlink($pack->{ustream_data}{tempname}); # deleting temp file
+ $pack->{ustream_data} = undef;
+ }
+
+ defined($fileinfo) or return 0;
# We have to first extract the block to a temp file, burk !
- my ($tempfh, $tempname) = tempfile();
-
- my $cread = 0;
- while ($cread < $fileinfo->{csize}) {
- my $cl = sysread($pack->{handle}, my $data,
- $cread + $pack->{bufsize} > $fileinfo->{csize} ?
- $fileinfo->{csize} - $cread :
- $pack->{bufsize}) or do {
- $pack->{log}("Unexpected end of file");
+
+ if (!defined($pack->{ustream_data})) {
+ my $tempfh;
+ $pack->{ustream_data}{coff} = $fileinfo->{coff};
+ $pack->{ustream_data}{read} = 0;
+
+ ($tempfh, $pack->{ustream_data}{tempname}) = tempfile();
+
+ my $cread = 0;
+ while ($cread < $fileinfo->{csize}) {
+ my $cl = sysread($pack->{handle}, my $data,
+ $cread + $pack->{bufsize} > $fileinfo->{csize} ?
+ $fileinfo->{csize} - $cread :
+ $pack->{bufsize}) or do {
+ $pack->{log}("Unexpected end of file");
+ close($tempfh);
+ unlink($pack->{ustream_data}{tempname});
+ $pack->{ustream_data} = undef;
+ return -1;
+ };
+ $cread += $cl;
+ syswrite($tempfh, $data) == length($data) or do {
+ $pack->{log}("Can't write all data into temp file");
close($tempfh);
- unlink($tempname);
+ unlink($pack->{ustream_data}{tempname});
+ $pack->{ustream_data} = undef;
return -1;
- };
- $cread += $cl;
- syswrite($tempfh, $data) == length($data) or do {
- $pack->{log}("Can't write all data into temp file");
- close($tempfh);
- unlink($tempname);
+ };
+ }
+ close($tempfh);
+
+ CORE::open($pack->{ustream_data}{handle}, "cat '$pack->{ustream_data}{tempname}' | $pack->{uncompress_method} |") or do {
+ $pack->{log}("Can't start $pack->{uncompress_method} to uncompress data");
+ unlink($pack->{ustream_data}{tempname});
+ $pack->{ustream_data} = undef;
return -1;
};
+ binmode($pack->{ustream_data}{handle});
}
- close($tempfh);
-
- CORE::open(my $hc, "cat '$tempname' | $pack->{uncompress_method} |") or do {
- $pack->{log}("Can't start $pack->{uncompress_method} to uncompress data");
- unlink($tempname);
- return -1;
- };
- binmode($hc);
my $byteswritten = 0;
- my $read = 0;
+ $pack->{ustream_data}{off} = $fileinfo->{off};
+ #my $read = 0;
while ($byteswritten < $fileinfo->{size}) {
- my $length = sysread($hc, my $data, $pack->{bufsize}) or do {
- $pack->{log}("Unexpected end of stream $tempname");
- #unlink($tempname);
- close($hc);
- return -1;
- };
-
- if ($read < $fileinfo->{off} && $read + $length > $fileinfo->{off}) {
- $data = substr($data, $fileinfo->{off} - $read);
+ my $data = $pack->{ustream_data}{buf};
+ $pack->{ustream_data}{buf} = undef;
+ my $length = 0;
+ if (!defined($data)) {
+ $length = sysread($pack->{ustream_data}{handle}, $data, $pack->{bufsize}) or do {
+ $pack->{log}("Unexpected end of stream $pack->{ustream_data}{tempname}");
+ unlink($pack->{ustream_data}{tempname});
+ close($pack->{ustream_data}{handle});
+ $pack->{ustream_data} = undef;
+ return -1;
+ };
}
- $read += $length;
- if ($read <= $fileinfo->{off}) { next }
- my $bw = $byteswritten + length($data) > $fileinfo->{size} ? $fileinfo->{size} - $byteswritten : length($data);
+ if ($pack->{ustream_data}{read} < $fileinfo->{off} && $pack->{ustream_data}{read} + $length > $fileinfo->{off}) {
+ $data = substr($data, $fileinfo->{off} - $pack->{ustream_data}{read});
+ }
+ $pack->{ustream_data}{read} += $length;
+ if ($pack->{ustream_data}{read} <= $fileinfo->{off}) { next }
+
+ my $bw;
+ if ($byteswritten + length($data) > $fileinfo->{size}) {
+ $bw = $fileinfo->{size} - $byteswritten;
+ $pack->{ustream_data}{buf} = substr($data, $bw); # keeping track of unwritten uncompressed data
+ } else {
+ $bw = length($data);
+ }
+
syswrite($destfh, $data, $bw) == $bw or do {
$pack->{log}("Can't write data into dest");
return -1;
@@ -396,8 +442,6 @@ sub extern_uncompress {
$byteswritten += $bw;
}
- close($hc);
- unlink($tempname); # deleting temp file
$byteswritten
}
@@ -427,11 +471,7 @@ sub extract_block {
syswrite($handle, $buf);
}
- foreach (sort {
- $pack->{files}{$a}{coff} == $pack->{files}{$b}{coff} ?
- $pack->{files}{$a}{off} <=> $pack->{files}{$b}{off} :
- $pack->{files}{$a}{coff} <=> $pack->{files}{$b}{coff}
- } keys %{$pack->{files}}) {
+ foreach ($pack->sort_files_by_packing(keys %{$pack->{files}})) {
$pack->{files}{$_}{coff} == $pack->{files}{$file}->{coff} or next;
}
@@ -524,43 +564,42 @@ sub extract_virtual {
}
sub extract {
- my ($pack, $destdir, @file) = @_;
- foreach my $f (@file) {
- my $dest = $destdir ? "$destdir/$f" : "$f";
- my ($dir) = $dest =~ m!(.*)/.*!;
- if (exists($pack->{dir}{$f})) {
- -d $dest || mkpath($dest)
- or $pack->{log}("Unable to create dir $dest: $!");
- next;
- } elsif (exists($pack->{'symlink'}{$f})) {
- -d $dir || mkpath($dir) or
- $pack->{log}("Unable to create dir $dest: $!");
- -l $dest and unlink $dest;
- symlink($pack->{'symlink'}{$f}, $dest)
- or $pack->{log}("Unable to extract symlink $f: $!");
- next;
- } elsif (exists($pack->{files}{$f})) {
- -d $dir || mkpath($dir) or do {
- $pack->{log}("Unable to create dir $dir");
- };
- if (-l $dest) {
- unlink($dest) or do {
- $pack->{log}("Can't remove link $dest: $!");
- next; # Don't overwrite a file because where the symlink point to
- };
- }
- sysopen(my $destfh, $dest, O_CREAT | O_TRUNC | O_WRONLY)
- or do {
- $pack->{log}("Unable to extract $dest");
- next;
- };
- my $written = $pack->extract_virtual($destfh, $f);
- $written == -1 and $pack->{log}("Unable to extract file $f");
- close($destfh);
- next;
- } else {
- $pack->{log}("Can't find $f in archive");
- }
+ my ($pack, $destdir, @files) = @_;
+ foreach my $f ($pack->sort_files_by_packing(@files)) {
+ my $dest = $destdir ? "$destdir/$f" : "$f";
+ my ($dir) = $dest =~ m!(.*)/.*!;
+ if (exists($pack->{dir}{$f})) {
+ -d $dest || mkpath($dest)
+ or $pack->{log}("Unable to create dir $dest: $!");
+ next;
+ } elsif (exists($pack->{'symlink'}{$f})) {
+ -d $dir || mkpath($dir) or
+ $pack->{log}("Unable to create dir $dest: $!");
+ -l $dest and unlink $dest;
+ symlink($pack->{'symlink'}{$f}, $dest)
+ or $pack->{log}("Unable to extract symlink $f: $!");
+ next;
+ } elsif (exists($pack->{files}{$f})) {
+ -d $dir || mkpath($dir) or do {
+ $pack->{log}("Unable to create dir $dir");
+ };
+ if (-l $dest) {
+ unlink($dest) or do {
+ $pack->{log}("Can't remove link $dest: $!");
+ next; # Don't overwrite a file because where the symlink point to
+ };
+ }
+ sysopen(my $destfh, $dest, O_CREAT | O_TRUNC | O_WRONLY) or do {
+ $pack->{log}("Unable to extract $dest");
+ next;
+ };
+ my $written = $pack->extract_virtual($destfh, $f);
+ $written == -1 and $pack->{log}("Unable to extract file $f");
+ close($destfh);
+ next;
+ } else {
+ $pack->{log}("Can't find $f in archive");
+ }
}
1;
}
@@ -568,7 +607,11 @@ sub extract {
# Return \@dir, \@files, \@symlink list
sub getcontent {
my ($pack) = @_;
- return([ keys(%{$pack->{dir}})], [ keys(%{$pack->{files}}) ], [ keys(%{$pack->{'symlink'}}) ]);
+ return(
+ [ keys(%{$pack->{dir}})],
+ [ $pack->sort_files_by_packing(keys %{$pack->{files}}) ],
+ [ keys(%{$pack->{'symlink'}}) ]
+ );
}
sub infofile {
@@ -593,11 +636,7 @@ sub list {
foreach my $file (keys %{$pack->{'symlink'}}) {
printf "l %13c %s -> %s\n", ' ', $file, $pack->{'symlink'}{$file};
}
- foreach my $file (sort {
- $pack->{files}{$a}{coff} == $pack->{files}{$b}{coff} ?
- $pack->{files}{$a}{off} <=> $pack->{files}{$b}{off} :
- $pack->{files}{$a}{coff} <=> $pack->{files}{$b}{coff}
- } keys %{$pack->{files}}) {
+ foreach my $file ($pack->sort_files_by_packing(keys %{$pack->{files}})) {
printf "f %12d %s\n", $pack->{files}{$file}{size}, $file;
}
}
@@ -612,11 +651,7 @@ sub dumptoc {
foreach my $file (keys %{$pack->{'symlink'}}) {
printf $handle "l %13c %s -> %s\n", ' ', $file, $pack->{'symlink'}{$file};
}
- foreach my $file (sort {
- $pack->{files}{$a}{coff} == $pack->{files}{$b}{coff} ?
- $pack->{files}{$a}{off} <=> $pack->{files}{$b}{off} :
- $pack->{files}{$a}{coff} <=> $pack->{files}{$b}{coff}
- } keys %{$pack->{files}}) {
+ foreach my $file ($pack->sort_files_by_packing(keys %{$pack->{files}})) {
printf $handle "f %d %d %d %d %s\n", $pack->{files}{$file}{size}, $pack->{files}{$file}{off}, $pack->{files}{$file}{csize}, $pack->{files}{$file}{coff}, $file;
}
}
diff --git a/Packdrakeng/zlib.pm b/Packdrakeng/zlib.pm
index 03673d2..72fe9e2 100644
--- a/Packdrakeng/zlib.pm
+++ b/Packdrakeng/zlib.pm
@@ -73,75 +73,101 @@ sub gzip_compress {
sub gzip_uncompress {
my ($pack, $destfh, $fileinfo) = @_;
- my $x = inflateInit(
- -WindowBits => - MAX_WBITS(),
- );
- my $cread = 0; # Compressed data read
- {
- my $buf;
- # get magic
- if (sysread($pack->{handle}, $buf, 2) == 2) {
- my @magic = unpack("C*", $buf);
- $magic[0] == Compress::Zlib::MAGIC1 && $magic[1] == Compress::Zlib::MAGIC2 or do {
- warn("Wrong magic header found");
- return -1;
- };
- } else {
- warn("Unexpect end of file while reading magic");
- return -1;
- }
- my ($method, $flags);
- if (sysread($pack->{handle}, $buf, 2) == 2) {
- ($method, $flags) = unpack("C2", $buf);
- } else {
- warn("Unexpect end of file while reading flags");
- return -1;
- }
- if (sysread($pack->{handle}, $buf, 6) != 6) {
- warn("Unexpect end of file while reading gzip header");
- return -1;
- }
+ if (!defined $fileinfo) {
+ $pack->{ustream_data} = undef;
+ return 0;
+ }
+
+ if (defined($pack->{ustream_data}) && ($fileinfo->{coff} != $pack->{ustream_data}{coff} || $fileinfo->{off} < $pack->{ustream_data}{off})) {
+ $pack->{ustream_data} = undef;
+ }
- $cread += 12; #Gzip header fixed size is already read
- if ($flags & 0x04) {
+ if (!defined($pack->{ustream_data})) {
+ $pack->{ustream_data}{coff} = $fileinfo->{coff};
+ $pack->{ustream_data}{read} = 0; # uncompressed data read
+ $pack->{ustream_data}{x} = inflateInit(
+ -WindowBits => - MAX_WBITS(),
+ );
+ $pack->{ustream_data}{cread} = 0; # Compressed data read
+ {
+ my $buf;
+ # get magic
if (sysread($pack->{handle}, $buf, 2) == 2) {
- my $len = unpack("I", $buf);
- $cread += $len;
- if (sysread($pack->{handle}, $buf, $len) != $len) {
- warn("Unexpect end of file while reading gzip header");
+ my @magic = unpack("C*", $buf);
+ $magic[0] == Compress::Zlib::MAGIC1 && $magic[1] == Compress::Zlib::MAGIC2 or do {
+ warn("Wrong magic header found");
return -1;
- }
+ };
+ } else {
+ warn("Unexpect end of file while reading magic");
+ return -1;
+ }
+ my ($method, $flags);
+ if (sysread($pack->{handle}, $buf, 2) == 2) {
+ ($method, $flags) = unpack("C2", $buf);
} else {
+ warn("Unexpect end of file while reading flags");
+ return -1;
+ }
+
+ if (sysread($pack->{handle}, $buf, 6) != 6) {
warn("Unexpect end of file while reading gzip header");
return -1;
}
+
+ $pack->{ustream_data}{cread} += 12; #Gzip header fixed size is already read
+ if ($flags & 0x04) {
+ if (sysread($pack->{handle}, $buf, 2) == 2) {
+ my $len = unpack("I", $buf);
+ $pack->{ustream_data}{cread} += $len;
+ if (sysread($pack->{handle}, $buf, $len) != $len) {
+ warn("Unexpect end of file while reading gzip header");
+ return -1;
+ }
+ } else {
+ warn("Unexpect end of file while reading gzip header");
+ return -1;
+ }
+ }
}
+ } else {
+ sysseek($pack->{handle}, $pack->{ustream_data}{cread} - 2, 1);
}
+ $pack->{ustream_data}{off} = $fileinfo->{off};
my $byteswritten = 0;
- my $read = 0; # uncompressed data read
while ($byteswritten < $fileinfo->{size}) {
- my $cl=sysread($pack->{handle}, my $buf,
- $cread + $pack->{bufsize} > $fileinfo->{csize} ?
- $fileinfo->{csize} - $cread :
- $pack->{bufsize}) or do {
- warn("Enexpected end of file");
- return -1;
- };
- $cread += $cl;
- my ($out, $status) = $x->inflate(\$buf);
- $status == Z_OK || $status == Z_STREAM_END or do {
- warn("Unable to uncompress data");
- return -1;
- };
- my $l = length($out) or next;
- if ($read < $fileinfo->{off} && $read + $l > $fileinfo->{off}) {
- $out = substr($out, $fileinfo->{off} - $read);
+ my ($l, $out, $status) = (0, $pack->{ustream_data}{buf});
+ $pack->{ustream_data}{buf} = undef;
+ if (!defined($out)) {
+ my $cl=sysread($pack->{handle}, my $buf,
+ $pack->{ustream_data}{cread} + $pack->{bufsize} > $fileinfo->{csize} ?
+ $fileinfo->{csize} - $pack->{ustream_data}{cread} :
+ $pack->{bufsize}) or do {
+ warn("Enexpected end of file");
+ return -1;
+ };
+ $pack->{ustream_data}{cread} += $cl;
+ ($out, $status) = $pack->{ustream_data}{x}->inflate(\$buf);
+ $status == Z_OK || $status == Z_STREAM_END or do {
+ warn("Unable to uncompress data");
+ return -1;
+ };
+ $l = length($out) or next;
+ }
+ if ($pack->{ustream_data}{read} < $fileinfo->{off} && $pack->{ustream_data}{read} + $l > $fileinfo->{off}) {
+ $out = substr($out, $fileinfo->{off} - $pack->{ustream_data}{read});
+ }
+ $pack->{ustream_data}{read} += $l;
+ if ($pack->{ustream_data}{read} <= $fileinfo->{off}) { next }
+
+ my $bw;
+ if ($byteswritten + length($out) > $fileinfo->{size}) {
+ $bw = $fileinfo->{size} - $byteswritten;
+ $pack->{ustream_data}{buf} = substr($out, $bw); # keeping track of unwritten uncompressed data
+ } else {
+ $bw = length($out);
}
- $read += $l;
- if ($read <= $fileinfo->{off}) { next }
-
- my $bw = $byteswritten + length($out) > $fileinfo->{size} ? $fileinfo->{size} - $byteswritten : length($out);
syswrite($destfh, $out, $bw) == $bw or do {
warn "Can't write data into dest";
return -1;