-
Notifications
You must be signed in to change notification settings - Fork 34
/
gzip_store.pl
67 lines (48 loc) · 1.91 KB
/
gzip_store.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
#!/usr/bin/perl
# Author: Trizen
# Date: 13 January 2024
# https://github.com/trizen
# Create a valid Gzip container, with uncompressed data.
# Reference:
# Data Compression (Summer 2023) - Lecture 11 - DEFLATE (gzip)
# https://youtube.com/watch?v=SJPvNi4HrWQ
use 5.036;
use Compression::Util qw(crc32);
use File::Basename qw(basename);
use constant {
CHUNK_SIZE => 0xffff, # 2^16 - 1
};
my $MAGIC = pack('C*', 0x1f, 0x8b); # magic MIME type
my $CM = chr(0x08); # 0x08 = DEFLATE
my $FLAGS = chr(0x00); # flags
my $MTIME = pack('C*', (0x00) x 4); # modification time
my $XFLAGS = chr(0x00); # extra flags
my $OS = chr(0x03); # 0x03 = Unix
my $input = $ARGV[0] // die "usage: $0 [input] [output.gz]\n";
my $output = $ARGV[1] // (basename($input) . '.gz');
sub int2bits ($value, $size = 32) {
scalar reverse sprintf("%0*b", $size, $value);
}
open my $in_fh, '<:raw', $input
or die "Can't open file <<$input>> for reading: $!";
open my $out_fh, '>:raw', $output
or die "Can't open file <<$output>> for writing: $!";
print $out_fh $MAGIC, $CM, $FLAGS, $MTIME, $XFLAGS, $OS;
my $total_length = 0;
my $block_type = '00'; # 00 = store; 10 = LZSS + Fixed codes; 01 = LZSS + Dynamic codes
my $crc32 = 0;
while (read($in_fh, (my $chunk), CHUNK_SIZE)) {
my $chunk_len = length($chunk);
my $len = int2bits($chunk_len, 16);
my $nlen = int2bits((~$chunk_len) & 0xffff, 16);
my $is_last = eof($in_fh) ? '1' : '0';
my $block_header = pack('b*', $is_last . $block_type . ('0' x 5) . $len . $nlen);
print $out_fh $block_header;
print $out_fh $chunk;
$crc32 = crc32($chunk, $crc32);
$total_length += $chunk_len;
}
print $out_fh pack('b*', int2bits($crc32, 32));
print $out_fh pack('b*', int2bits($total_length, 32));
close $in_fh;
close $out_fh;