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