-
Notifications
You must be signed in to change notification settings - Fork 34
/
Copy pathzip.pl
227 lines (175 loc) · 8.33 KB
/
zip.pl
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
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
#!/usr/bin/perl
# Author: Daniel "Trizen" Șuteu
# Date: 03 February 2025
# Edit: 04 February 2025
# https://github.com/trizen
# Basic implementation of a ZIP archiver. (WIP)
# Reference:
# https://pkware.cachefly.net/webdocs/casestudies/APPNOTE.TXT
use 5.036;
use Compression::Util qw(:all);
use File::Path qw(make_path);
use File::Spec::Functions qw(catfile catdir);
use File::Basename qw(dirname);
use File::Find qw(find);
use constant {
FORMAT => 'zip',
CHUNK_SIZE => (1 << 15) - 1,
};
local $Compression::Util::LZ_MIN_LEN = 4; # minimum match length in LZ parsing
local $Compression::Util::LZ_MAX_LEN = 258; # maximum match length in LZ parsing
local $Compression::Util::LZ_MAX_DIST = 32768; # maximum allowed back-reference distance in LZ parsing
binmode(STDOUT, ':raw');
binmode(STDIN, ':raw');
my $OFFSET = 0;
sub zip_directory ($dir) {
if (substr($dir, 0, -1) ne '/') {
$dir .= '/';
}
print STDOUT int2bytes_lsb(0x04034b50, 4); # header signature
print STDOUT int2bytes_lsb(20, 2); # version needed
print STDOUT int2bytes_lsb(0, 2); # general purpose bit
print STDOUT int2bytes_lsb(0, 2); # compression method (8 = DEFLATE)
print STDOUT int2bytes_lsb(0, 2); # last mod file time
print STDOUT int2bytes_lsb(0, 2); # last mod file date
print STDOUT int2bytes_lsb(0, 4); # CRC32
print STDOUT int2bytes_lsb(0, 4); # compressed size
print STDOUT int2bytes_lsb(0, 4); # uncompressed size
print STDOUT int2bytes_lsb(length($dir), 2); # filename length
print STDOUT int2bytes_lsb(0, 2); # extra field length
print STDOUT $dir;
my $info = {
crc32 => 0,
name => $dir,
compressed_size => 0,
uncompressed_size => 0,
compression_method => 0,
offset => $OFFSET,
};
$OFFSET += 4 * 4 + 2 * 7 + length($dir);
return $info;
}
sub zip_file ($file) {
if (-d $file) {
return zip_directory($file);
}
print STDOUT int2bytes_lsb(0x04034b50, 4); # header signature
print STDOUT int2bytes_lsb(20, 2); # version needed
print STDOUT int2bytes_lsb(0b1000, 2); # general purpose bit
print STDOUT int2bytes_lsb(8, 2); # compression method (8 = DEFLATE)
print STDOUT int2bytes_lsb(0, 2); # last mod file time
print STDOUT int2bytes_lsb(0, 2); # last mod file date
print STDOUT int2bytes_lsb(0, 4); # CRC32
print STDOUT int2bytes_lsb(0, 4); # compressed size
print STDOUT int2bytes_lsb(0, 4); # uncompressed size
print STDOUT int2bytes_lsb(length($file), 2); # filename length
print STDOUT int2bytes_lsb(0, 2); # extra field length
print STDOUT $file; # filename
my $crc32 = 0;
my $uncompressed_size = 0;
my $compressed_size = 0;
my $bitstring = '';
open my $in_fh, '<:raw', $file;
if (eof($in_fh)) { # empty file
$bitstring = '1' . '10' . '0000000';
}
while (read($in_fh, (my $chunk), CHUNK_SIZE)) {
$crc32 = crc32($chunk, $crc32);
$uncompressed_size += length($chunk);
my ($literals, $distances, $lengths) = lzss_encode($chunk);
$bitstring .= eof($in_fh) ? '1' : '0';
my $bt1_bitstring = deflate_create_block_type_1($literals, $distances, $lengths);
# When block type 1 is larger than the input, then we have random uncompressible data: use block type 0
if ((length($bt1_bitstring) >> 3) > length($chunk) + 5) {
say STDERR ":: Using block type: 0";
$bitstring .= '00';
my $comp = pack('b*', $bitstring); # pads to a byte
$comp .= pack('b*', deflate_create_block_type_0_header($chunk));
$comp .= $chunk;
$compressed_size .= length($comp);
print STDOUT $comp;
$bitstring = '';
next;
}
my $bt2_bitstring = deflate_create_block_type_2($literals, $distances, $lengths);
# When block type 2 is larger than block type 1, then we may have very small data
if (length($bt2_bitstring) > length($bt1_bitstring)) {
say STDERR ":: Using block type: 1";
$bitstring .= $bt1_bitstring;
}
else {
say STDERR ":: Using block type: 2";
$bitstring .= $bt2_bitstring;
}
my $comp = pack('b*', substr($bitstring, 0, length($bitstring) - (length($bitstring) % 8), ''));
$compressed_size += length($comp);
print STDOUT $comp;
}
if ($bitstring ne '') {
my $comp = pack('b*', $bitstring);
$compressed_size += length($comp);
print STDOUT $comp;
}
print STDOUT int2bytes_lsb(0x8074b50, 4);
print STDOUT int2bytes_lsb($crc32, 4);
print STDOUT int2bytes_lsb($compressed_size, 4);
print STDOUT int2bytes_lsb($uncompressed_size, 4);
my $info = {
compression_method => 8,
crc32 => $crc32,
name => $file,
compressed_size => $compressed_size,
uncompressed_size => $uncompressed_size,
offset => $OFFSET,
};
$OFFSET += 4 * 8 + 2 * 7 + length($file) + $compressed_size;
return $info;
}
sub central_directory($entry) {
# FIXME: the offset of the local header is incorrect
print STDOUT int2bytes_lsb(0x02014b50, 4); # header signature
print STDOUT int2bytes_lsb(831, 2); # version made by
print STDOUT int2bytes_lsb(20, 2); # version needed to extract
print STDOUT int2bytes_lsb(0, 2); # general purpose bit
print STDOUT int2bytes_lsb($entry->{compression_method}, 2); # compression method
print STDOUT int2bytes_lsb(0, 2); # last mod file time
print STDOUT int2bytes_lsb(0, 2); # last mod file date
print STDOUT int2bytes_lsb($entry->{crc32}, 4); # crc32
print STDOUT int2bytes_lsb($entry->{compressed_size}, 4); # compressed size
print STDOUT int2bytes_lsb($entry->{uncompressed_size}, 4); # uncompressed size
print STDOUT int2bytes_lsb(length($entry->{name}), 2); # file name length
print STDOUT int2bytes_lsb(0, 2); # extra field length
print STDOUT int2bytes_lsb(0, 2); # file comment length
print STDOUT int2bytes_lsb(0, 2); # disk number start
print STDOUT int2bytes_lsb(0, 2); # internal file attributes
print STDOUT int2bytes_lsb(0, 4); # external file attributes
print STDOUT int2bytes_lsb($entry->{offset}, 4); # relative offset of local header (TODO)
print STDOUT $entry->{name};
}
sub end_of_zip_file (@entries) {
print STDOUT int2bytes_lsb(0x06054b50, 4); # header signature
print STDOUT int2bytes_lsb(0, 2); # number of this disk
print STDOUT int2bytes_lsb(0, 2); # number of the disk central dir
print STDOUT int2bytes_lsb(0, 2); # start of central dir
print STDOUT int2bytes_lsb(scalar(@entries), 2); # total number of entries
print STDOUT int2bytes_lsb(0, 4); # size of the central directory
print STDOUT int2bytes_lsb(0, 4); # offset
print STDOUT int2bytes_lsb(0, 2); # zip file comment length
}
my @entries;
sub zip ($file) {
find(
{
no_chdir => 1,
wanted => sub {
push @entries, zip_file($_);
}
},
$file
);
}
zip($ARGV[0]);
#~ foreach my $entry(@entries) {
#~ central_directory($entry);
#~ }
#~ end_of_zip_file(@entries);