1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
|
#!/usr/bin/env perl
use strict;
use warnings;
use Getopt::Long;
use Fcntl ':mode';
my ($directory, $mtime, $nopadding, $norec, $verbose);
GetOptions(
"directory=s" => \$directory,
"mtime=i" => \$mtime,
"nopadding" => \$nopadding,
"no-recursion" => \$norec,
"verbose" => \$verbose,
);
chdir($directory) || die "cannot chdir";
my $num_entries = 0;
sub recurse_dir {
my $path = shift;
my @results = ("$path/");
opendir my $dh, $path or die "cannot open $path";
while (my $entry = readdir $dh) {
next if $entry eq ".";
next if $entry eq "..";
if (-d "$path/$entry") {
push @results, (&recurse_dir("$path/$entry"));
} else {
push @results, "$path/$entry";
}
}
closedir $dh;
return @results;
}
my @entries;
if (!-e $ARGV[0]) {
die "does not exist: $ARGV[0]";
} elsif (-d $ARGV[0] && !$norec) {
@entries = sort (recurse_dir($ARGV[0]));
} else {
@entries = ($ARGV[0]);
}
foreach my $fname (@entries) {
if ($verbose) {
print STDERR "$fname\n";
}
my (
$dev, $ino, $mode, $nlink, $uid, $gid, $rdev,
$size, $atime, $mtime_, $ctime, $blksize, $blocks
) = lstat($fname);
if (!defined $mode) {
die "failed to stat $fname";
}
my $content = "";
my $type;
my $linkname = "";
if (S_ISLNK($mode)) {
$type = 2;
$linkname = readlink $fname;
} elsif (S_ISREG($mode)) {
$type = 0;
open(my $fh, '<', $fname);
$content = do { local $/; <$fh> };
close($fh);
} elsif (S_ISDIR($mode)) {
$type = 5;
}
my $entry = pack(
'a100 a8 a8 a8 a12 a12 A8 a1 a100 a6 a2 a32 a32 a8 a8 a155 x12',
$fname,
sprintf('%07o', $mode & 07777),
sprintf('%07o', 1000), # uid
sprintf('%07o', 1000), # gid
sprintf('%011o', length $content), # size
sprintf('%011o', $mtime), # mtime
'', # checksum
$type,
$linkname, # linkname
"ustar ", # magic
" ", # version
"josch", # username
"josch", # groupname
'', # dev major
'', # dev minor
'', # prefix
);
# compute and insert checksum
substr($entry, 148, 7)
= sprintf("%06o\0", unpack("%16C*", $entry));
print $entry;
$num_entries += 1;
if (length $content) {
my $num_blocks = int((length $content) / 512);
if ((length $content) % 512 != 0) {
$num_blocks += 1;
}
print $content;
print(("\x00") x ($num_blocks * 512 - (length $content)));
$num_entries += $num_blocks;
}
}
if (!$nopadding) {
# https://www.gnu.org/software/tar/manual/html_node/Standard.html
#
# Physically, an archive consists of a series of file entries terminated
# by an end-of-archive entry, which consists of two 512 blocks of zero
# bytes. At the end of the archive file there are two 512-byte blocks
# filled with binary zeros as an end-of-file marker.
print(pack 'a512', '');
print(pack 'a512', '');
$num_entries += 2;
# https://www.gnu.org/software/tar/manual/html_section/tar_76.html
#
# Some devices requires that all write operations be a multiple of a
# certain size, and so, tar pads the archive out to the next record
# boundary.
#
# The default blocking factor is 20. With a block size of 512 bytes, we
# get a record size of 10240.
my $num_records = int($num_entries * 512 / 10240);
if (($num_entries * 512) % 10240 != 0) {
$num_records += 1;
}
for (my $i = $num_entries ; $i < $num_records * 10240 / 512 ; $i++) {
print(pack 'a512', '');
}
}
|
