mirror of
https://github.com/rpm-software-management/tito.git
synced 2025-02-23 20:22:46 +00:00
127 lines
3.8 KiB
Perl
Executable file
127 lines
3.8 KiB
Perl
Executable file
#!/usr/bin/perl
|
|
#
|
|
# Copyright (c) 2008-2009 Red Hat, Inc.
|
|
#
|
|
# This software is licensed to you under the GNU General Public License,
|
|
# version 2 (GPLv2). There is NO WARRANTY for this software, express or
|
|
# implied, including the implied warranties of MERCHANTABILITY or FITNESS
|
|
# FOR A PARTICULAR PURPOSE. You should have received a copy of GPLv2
|
|
# along with this software; if not, see
|
|
# http://www.gnu.org/licenses/old-licenses/gpl-2.0.txt.
|
|
#
|
|
# Red Hat trademarks are not licensed under GPLv2. No permission is
|
|
# granted to use or replicate Red Hat trademarks that are incorporated
|
|
# in this software or its documentation.
|
|
|
|
use strict;
|
|
use warnings FATAL => 'all';
|
|
|
|
use IO::Handle ();
|
|
|
|
use constant RECORD_SIZE => 512;
|
|
use constant GIT_BLOCK_SIZE => RECORD_SIZE * 20;
|
|
|
|
my $stamp = shift;
|
|
if (not defined $stamp) {
|
|
die "Please specify stamp to put into the tar as the first parameter.\n";
|
|
}
|
|
my $stamp_octal = sprintf "%011o", $stamp;
|
|
my $comment = shift;
|
|
if (defined $comment) {
|
|
if (not $comment =~ /^[0-9a-f]{40}$/) {
|
|
die "The comment we will put into the tar should be SHA1 in hex (40 characters).\n";
|
|
}
|
|
}
|
|
|
|
my $chunk;
|
|
my $handle = \*STDIN;
|
|
my $read;
|
|
my $need_header = 1;
|
|
my $total_len = 0;
|
|
while ($read = $handle->sysread($chunk, RECORD_SIZE)) {
|
|
# print STDERR "read [$read]\n";
|
|
if ($read < RECORD_SIZE) {
|
|
my $rest = RECORD_SIZE - $read;
|
|
while (my $read = $handle->sysread($chunk, $rest, length($chunk))) {
|
|
# print STDERR " plus [$read]\n";
|
|
$rest -= $read;
|
|
}
|
|
}
|
|
|
|
if ($chunk eq "\0" x 512) {
|
|
# look for the second record full of zeroes
|
|
my $pad;
|
|
my $read = $handle->sysread($pad, RECORD_SIZE);
|
|
if ($read) {
|
|
if ($read < RECORD_SIZE) {
|
|
my $rest = RECORD_SIZE - $read;
|
|
while (my $read = $handle->sysread($pad, $rest, length($pad))) {
|
|
$rest -= $read;
|
|
}
|
|
}
|
|
}
|
|
if ($pad ne "\0" x 512) {
|
|
die "Failed to find second stop record.\n";
|
|
}
|
|
print $chunk;
|
|
print $pad;
|
|
$total_len += length($chunk) + length($pad);
|
|
print "\0" x (padded_record_size($total_len, GIT_BLOCK_SIZE) - $total_len);
|
|
exit;
|
|
}
|
|
|
|
my ($name, $data1, $size, $mtime, $checksum, $link, $name2, $data2) = unpack 'A100 A24 A12 A12 A8 A1 A100 a*', $chunk;
|
|
my $block_size = $size ? padded_record_size( oct $size ) : $size;
|
|
# print STDERR "[$name] [$size] [$mtime] [$checksum] [$link] [$name2] [$block_size]\n";
|
|
|
|
if ($need_header and $link ne 'g' and defined $comment) {
|
|
my $header = pack 'a100 a8 a8 a8 a12 a12 A8 a1 a100 a6 a2 a32 a32 a8 a8 a155 x12',
|
|
'pax_global_header', (sprintf "%07o", 0666), '0000000', '0000000',
|
|
'00000000064', $stamp_octal, '', 'g', '',
|
|
'ustar', '00', 'root', 'root', '0000000', '0000000', '';
|
|
substr($header, 148, 8) = sprintf("%07o\0", unpack("%16C*", $header));
|
|
print $header;
|
|
print pack "a512", "52 comment=$comment\n";
|
|
$need_header = 0;
|
|
$total_len += 2 * 512;
|
|
}
|
|
|
|
my $out = $chunk;
|
|
my $write_comment = 0;
|
|
if ($mtime) {
|
|
substr($out, 136, 12) = pack "a12", $stamp_octal;
|
|
substr($out, 148, 8) = pack "A8", "";
|
|
substr($out, 148, 8) = sprintf("%07o\0", unpack("%16C*", $out));
|
|
if ($link eq 'g' and oct $size == 52) {
|
|
$write_comment = 1;
|
|
}
|
|
}
|
|
print $out;
|
|
$total_len += length $out;
|
|
|
|
my $payload;
|
|
while (my $read = $handle->sysread( $payload, $block_size )) {
|
|
if (defined $comment and $write_comment) {
|
|
if ($read < 52) {
|
|
die "Would like to put SHA1 into header but did not read at least 52 bytes.\n";
|
|
}
|
|
if (not $payload =~ /^52 comment=/) {
|
|
die "The header payload is not [52 comment=].\n";
|
|
}
|
|
substr($payload, 0, 52) = "52 comment=$comment\n";
|
|
}
|
|
# print STDERR " payload [@{[ length $payload ]}]\n";
|
|
print $payload;
|
|
$total_len += length $payload;
|
|
$block_size -= $read;
|
|
last unless $block_size;
|
|
}
|
|
}
|
|
|
|
sub padded_record_size {
|
|
my $len = shift;
|
|
my $pad_size = shift || RECORD_SIZE;
|
|
my $out = int($len / $pad_size);
|
|
$out++ if $len % $pad_size;
|
|
return $out * $pad_size;
|
|
}
|