File Coverage

blib/lib/Crypt/OpenPGP/Armour.pm
Criterion Covered Total %
statement 4 6 66.6
branch n/a
condition n/a
subroutine 2 2 100.0
pod n/a
total 6 8 75.0


line stmt bran cond sub pod time code
1             package Crypt::OpenPGP::Armour;
2 1     1   925 use strict;
  1         3  
  1         45  
3              
4 1     1   859 use Crypt::OpenPGP;
  0            
  0            
5             use MIME::Base64;
6             use Crypt::OpenPGP::ErrorHandler;
7             use base qw( Crypt::OpenPGP::ErrorHandler );
8              
9             sub armour {
10             my $class = shift;
11             my %param = @_;
12             my $data = $param{Data} or
13             return $class->error("No Data to armour");
14             my $headers = $param{Headers} || {};
15             $headers->{Version} = Crypt::OpenPGP->version_string;
16             my $head = join "\n", map { "$_: $headers->{$_}" } keys %$headers;
17             my $object = $param{Object} || 'MESSAGE';
18             (my $sdata = encode_base64($data, '')) =~ s!(.{1,64})!$1\n!g;
19              
20             "-----BEGIN PGP $object-----\n" .
21             $head . "\n\n" .
22             $sdata .
23             '=' . $class->_checksum($data) .
24             "-----END PGP $object-----\n";
25             }
26              
27             sub unarmour {
28             my $class = shift;
29             my($blob) = @_;
30             ## Get rid of DOSish newlines.
31             $blob =~ s!\r!!g;
32             my($begin, $obj, $head, $data, $end) = $blob =~
33             m!(-----BEGIN ([^\n\-]+)-----)\n(.*?\n\n)?(.+)(-----END .*?-----)!s
34             or return $class->error("Unrecognizable armour");
35             unless ($data =~ s!=([^\n]+)$!!s) {
36             return $class->error("No checksum");
37             }
38             my $csum = $1;
39             $data = decode_base64($data);
40             (my $check = $class->_checksum($data)) =~ s!\n!!;
41             return $class->error("Bad checksum") unless $check eq $csum;
42             my %headers;
43             if ($head) {
44             %headers = map { split /: /, $_, 2 } grep { /\S/ } split /\n/, $head;
45             }
46             { Data => $data,
47             Headers => \%headers,
48             Object => $obj }
49             }
50              
51             sub _checksum {
52             my $class = shift;
53             my($data) = @_;
54             encode_base64(substr(pack('N', crc24($data)), 1));
55             }
56              
57             {
58             my @CRC_TABLE;
59             use constant CRC24_INIT => 0xb704ce;
60              
61             sub crc24 {
62             my @data = unpack 'C*', $_[0];
63             my $crc = CRC24_INIT;
64             for my $d (@data) {
65             $crc = ($crc << 8) ^ $CRC_TABLE[(($crc >> 16) ^ $d) & 0xff]
66             }
67             $crc & 0xffffff;
68             }
69              
70             @CRC_TABLE = (
71             0x00000000, 0x00864cfb, 0x018ad50d, 0x010c99f6, 0x0393e6e1,
72             0x0315aa1a, 0x021933ec, 0x029f7f17, 0x07a18139, 0x0727cdc2,
73             0x062b5434, 0x06ad18cf, 0x043267d8, 0x04b42b23, 0x05b8b2d5,
74             0x053efe2e, 0x0fc54e89, 0x0f430272, 0x0e4f9b84, 0x0ec9d77f,
75             0x0c56a868, 0x0cd0e493, 0x0ddc7d65, 0x0d5a319e, 0x0864cfb0,
76             0x08e2834b, 0x09ee1abd, 0x09685646, 0x0bf72951, 0x0b7165aa,
77             0x0a7dfc5c, 0x0afbb0a7, 0x1f0cd1e9, 0x1f8a9d12, 0x1e8604e4,
78             0x1e00481f, 0x1c9f3708, 0x1c197bf3, 0x1d15e205, 0x1d93aefe,
79             0x18ad50d0, 0x182b1c2b, 0x192785dd, 0x19a1c926, 0x1b3eb631,
80             0x1bb8faca, 0x1ab4633c, 0x1a322fc7, 0x10c99f60, 0x104fd39b,
81             0x11434a6d, 0x11c50696, 0x135a7981, 0x13dc357a, 0x12d0ac8c,
82             0x1256e077, 0x17681e59, 0x17ee52a2, 0x16e2cb54, 0x166487af,
83             0x14fbf8b8, 0x147db443, 0x15712db5, 0x15f7614e, 0x3e19a3d2,
84             0x3e9fef29, 0x3f9376df, 0x3f153a24, 0x3d8a4533, 0x3d0c09c8,
85             0x3c00903e, 0x3c86dcc5, 0x39b822eb, 0x393e6e10, 0x3832f7e6,
86             0x38b4bb1d, 0x3a2bc40a, 0x3aad88f1, 0x3ba11107, 0x3b275dfc,
87             0x31dced5b, 0x315aa1a0, 0x30563856, 0x30d074ad, 0x324f0bba,
88             0x32c94741, 0x33c5deb7, 0x3343924c, 0x367d6c62, 0x36fb2099,
89             0x37f7b96f, 0x3771f594, 0x35ee8a83, 0x3568c678, 0x34645f8e,
90             0x34e21375, 0x2115723b, 0x21933ec0, 0x209fa736, 0x2019ebcd,
91             0x228694da, 0x2200d821, 0x230c41d7, 0x238a0d2c, 0x26b4f302,
92             0x2632bff9, 0x273e260f, 0x27b86af4, 0x252715e3, 0x25a15918,
93             0x24adc0ee, 0x242b8c15, 0x2ed03cb2, 0x2e567049, 0x2f5ae9bf,
94             0x2fdca544, 0x2d43da53, 0x2dc596a8, 0x2cc90f5e, 0x2c4f43a5,
95             0x2971bd8b, 0x29f7f170, 0x28fb6886, 0x287d247d, 0x2ae25b6a,
96             0x2a641791, 0x2b688e67, 0x2beec29c, 0x7c3347a4, 0x7cb50b5f,
97             0x7db992a9, 0x7d3fde52, 0x7fa0a145, 0x7f26edbe, 0x7e2a7448,
98             0x7eac38b3, 0x7b92c69d, 0x7b148a66, 0x7a181390, 0x7a9e5f6b,
99             0x7801207c, 0x78876c87, 0x798bf571, 0x790db98a, 0x73f6092d,
100             0x737045d6, 0x727cdc20, 0x72fa90db, 0x7065efcc, 0x70e3a337,
101             0x71ef3ac1, 0x7169763a, 0x74578814, 0x74d1c4ef, 0x75dd5d19,
102             0x755b11e2, 0x77c46ef5, 0x7742220e, 0x764ebbf8, 0x76c8f703,
103             0x633f964d, 0x63b9dab6, 0x62b54340, 0x62330fbb, 0x60ac70ac,
104             0x602a3c57, 0x6126a5a1, 0x61a0e95a, 0x649e1774, 0x64185b8f,
105             0x6514c279, 0x65928e82, 0x670df195, 0x678bbd6e, 0x66872498,
106             0x66016863, 0x6cfad8c4, 0x6c7c943f, 0x6d700dc9, 0x6df64132,
107             0x6f693e25, 0x6fef72de, 0x6ee3eb28, 0x6e65a7d3, 0x6b5b59fd,
108             0x6bdd1506, 0x6ad18cf0, 0x6a57c00b, 0x68c8bf1c, 0x684ef3e7,
109             0x69426a11, 0x69c426ea, 0x422ae476, 0x42aca88d, 0x43a0317b,
110             0x43267d80, 0x41b90297, 0x413f4e6c, 0x4033d79a, 0x40b59b61,
111             0x458b654f, 0x450d29b4, 0x4401b042, 0x4487fcb9, 0x461883ae,
112             0x469ecf55, 0x479256a3, 0x47141a58, 0x4defaaff, 0x4d69e604,
113             0x4c657ff2, 0x4ce33309, 0x4e7c4c1e, 0x4efa00e5, 0x4ff69913,
114             0x4f70d5e8, 0x4a4e2bc6, 0x4ac8673d, 0x4bc4fecb, 0x4b42b230,
115             0x49ddcd27, 0x495b81dc, 0x4857182a, 0x48d154d1, 0x5d26359f,
116             0x5da07964, 0x5cace092, 0x5c2aac69, 0x5eb5d37e, 0x5e339f85,
117             0x5f3f0673, 0x5fb94a88, 0x5a87b4a6, 0x5a01f85d, 0x5b0d61ab,
118             0x5b8b2d50, 0x59145247, 0x59921ebc, 0x589e874a, 0x5818cbb1,
119             0x52e37b16, 0x526537ed, 0x5369ae1b, 0x53efe2e0, 0x51709df7,
120             0x51f6d10c, 0x50fa48fa, 0x507c0401, 0x5542fa2f, 0x55c4b6d4,
121             0x54c82f22, 0x544e63d9, 0x56d11cce, 0x56575035, 0x575bc9c3,
122             0x57dd8538
123             );
124             }
125              
126             1;
127             __END__