FCP/Key/CHK.pm

=head1 NAME

Net::FCP::Key::CHK - manage CHK keys.

=head1 SYNOPSIS

 use Net::FCP::Key::CHK;

 my $key = new Net::FCP::Key::CHK;
 my $key = new_from_uri Net::FCP::Key::CHK $uri;
 my $key = new_from_data Net::FCP::Key::CHK $data, $metadata;
 ... more to come


=head1 DESCRIPTION

=back

=head2 THE Net::FCP::Key::CHK CLASS

=over 4

=cut

package Net::FCP::Key::CHK;

use Carp;
use Digest::SHA1;
use MIME::Base64;

use Crypt::Rijndael;
use Crypt::Twofish;

use Net::FCP::Util;

no warnings;

=item my $key = new Net::FCP::Key::CHK;

Don't use :)

=cut

sub new {
   my $class = shift;

   bless { }, $class;
}

=item my $key = new_from_data Net::FCP::Key::CHK $metadata, $data, $cipher;

Generate a CHK from the given data and metadata strings.

=cut

sub new_from_data {
   my ($class, $metadata, $data, $cipher) = @_;

   $class->new->set_data ($metadata, $data, $cipher);
}

sub rolling_hashpad($$$) {
   my $sha1 = $_[1];
   my $pad = "";
   my $dig;

   while ($_[2] > length $_[0]) {
      $sha1->add ($dig = $sha1->digest_noreset);
      $pad .= $dig;
      $_[0] .= $pad;
   }

   substr $_[0], $_[2], length $_[0], "";
}

sub encode_number($) {
   my $num = pack "N", $_[0];
   $num =~ s/^\x00+//;
   pack "n a*", length $num, $num;
}

sub set_data {
   my ($self, $metadata, $data, $cipher) = @_;

   $cipher ||= "Twofish";

   my $cipher_class = "Crypt::$cipher";

   $cipher_class->blocksize == 16 or die "only ciphers with a blocksize of 128 bits are supported";

   my $total_len = (length $metadata) + (length $data);
   my $padded_log = Net::FCP::Util::log2 $total_len, 10;
   my $padded_len = 1 << $padded_log;

   my $plaintext = "$metadata$data";

   # crypto key (hash) generation. this is an iterative
   # algorithm, but it is "unrolled" here for the
   # common keysize of 16 bytes.
   my $data_sha1 = Digest::SHA1->new->add ($plaintext);

   # only works for 128 bit keys
   my $k = new Digest::SHA1;
   $k->add ("\x00" x 1);
   $k->add ($data_sha1->clone->digest);

   my $hash = substr $k->digest, 0, 16; # extract leading 128 bit

   my $buf = "";

   $buf .= pack "n a20", 20, Digest::SHA1::sha1 $hash;

   $buf .= encode_number $total_len;
   $buf .= encode_number length $metadata;

   $buf .= "\x00\x00";

   rolling_hashpad $buf, Digest::SHA1->new->add ($buf), 1 << Net::FCP::Util::log2 length $buf;

   my $pcfbc = $cipher_class->new ($hash);
   my $pcfbr = "\x00" x 16;
   my $pcfb = 16;

   my $pcfb_enc = sub  {
      my $length = length $_[0];
      for (my $i = 0; $i < $length; $i += 16) {
         substr $_[0], $i, 16, $pcfbr = $pcfbc->encrypt ($pcfbr) ^ substr $_[0], $i, 16;
      }
   };

   # buf length must be multiple of 16
   $pcfb_enc->($buf);

   my $senc = unpack "H*", $buf;

   rolling_hashpad $plaintext, $data_sha1, $padded_len;

   # plaintext length must be a multiple of 16, too
   print "<";
   $pcfb_enc->($plaintext);
   print ">";

   my $partsize = $padded_len < 16384      ? $padded_len
                : $padded_len < 16384 << 7 ? 16384
                :                            $padded_len >> 7; # 2MB

   my $dig = "";
   for (my $ofs = ($padded_len-1) - ($padded_len-1) % $partsize; $ofs >= 0; $ofs -= $partsize) {
      $dig = Digest::SHA1::sha1 substr ($plaintext, $ofs, $partsize) . $dig;
   }

   my $sini = unpack "H*", $dig;

   my $route = sprintf
           "Document-header\xfe%s\xff"
         . "Initial-digest\xfe%s\xff"
         . "Part-size\xfe%x\xff"
         . "Symmetric-cipher\xfe%s\xff",
           $senc, $sini, $partsize, $cipher;

   $route = Net::FCP::Util::encode_base64 +(Digest::SHA1::sha1 $route) . (pack "C", $padded_log) . "\x03\x02";
   $hash = Net::FCP::Util::encode_base64 $hash;

   return "freenet:CHK\@$route,$hash";
   $self;
}

=item $size = $key->size

Returns the size of the data (in bytes).

=cut

=item $digest = $key->digest

Return the store digest/hash.

=cut

=item $keynum = $key->keynumber

Returns the keynumber (version?)

=cut

=item $chk = $key->chk

Return the full CHK.

=cut

=back

=head1 SEE ALSO

L<Net::FCP>.

=head1 BUGS

Not heavily tested.

=head1 AUTHOR

 Marc Lehmann <pcg@goof.com>
 http://www.goof.com/pcg/marc/

=cut

if (0) {
my $data = do { local $/; <> };
my $metadata = substr $data, 0, 0x3f, "";
$metadata = "x" x 3000;
$data = "a" x 4098;

warn Net::FCP::Key::CHK->new_from_data ($metadata, $data);
use Net::FCP; my $fcp = new Net::FCP; warn $fcp->generate_chk ($metadata, $data);
} else {
   use Net::FCP;
   my $fcp = new Net::FCP;

   $|=1;
   use Time::HiRes 'time';
   while () {
      my $meta = join "", map chr(rand(256)), 1..(30+rand(20));
      my $data = join "", map chr(rand(256)), 1..(20+rand(200000));
      my $meta = join "", map chr(rand(256)), 1..1024;
      my $data = join "", map chr(rand(256)), 1..1024000;
      printf "%d - %d ", length $meta, length $data;
      my $t1 = time;
      my $b = $fcp->generate_chk ($meta, $data, "Rijndael");
      my $t2 = time;
      my $a = Net::FCP::Key::CHK->new_from_data ($meta, $data, "Rijndael");
      my $t3 = time;
      printf "%.2f %.2f ", $t2-$t1, $t3-$t2;
      die "$a ne $b" unless "$a" eq $b;
      print "ok\n";
   }
}

1;

Revision:	1.3
Committed:	Sun Oct 12 18:09:28 2003 UTC (22 years, 11 months ago) by root
Branch:	MAIN
Changes since 1.2:	+75 -39 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	=head1 NAME
2
3			Net::FCP::Key::CHK - manage CHK keys.
4
5			=head1 SYNOPSIS
6
7			use Net::FCP::Key::CHK;
8
9			my $key = new Net::FCP::Key::CHK;
10			my $key = new_from_uri Net::FCP::Key::CHK $uri;
11			my $key = new_from_data Net::FCP::Key::CHK $data, $metadata;
12			... more to come
13
14
15			=head1 DESCRIPTION
16
17			=back
18
19			=head2 THE Net::FCP::Key::CHK CLASS
20
21			=over 4
22
23			=cut
24
25			package Net::FCP::Key::CHK;
26
27			use Carp;
28			use Digest::SHA1;
29	root	1.3	use MIME::Base64;
30
31			use Crypt::Rijndael;
32	root	1.2	use Crypt::Twofish;
33	root	1.1
34	root	1.2	use Net::FCP::Util;
35
36	root	1.1	no warnings;
37
38			=item my $key = new Net::FCP::Key::CHK;
39
40			Don't use :)
41
42			=cut
43
44			sub new {
45			my $class = shift;
46
47			bless { }, $class;
48			}
49
50	root	1.3	=item my $key = new_from_data Net::FCP::Key::CHK $metadata, $data, $cipher;
51	root	1.1
52			Generate a CHK from the given data and metadata strings.
53
54			=cut
55
56			sub new_from_data {
57	root	1.3	my ($class, $metadata, $data, $cipher) = @_;
58	root	1.1
59	root	1.3	$class->new->set_data ($metadata, $data, $cipher);
60	root	1.2	}
61
62	root	1.3	sub rolling_hashpad($$$) {
63			my $sha1 = $_[1];
64	root	1.2	my $pad = "";
65	root	1.3	my $dig;
66	root	1.2
67	root	1.3	while ($_[2] > length $_[0]) {
68			$sha1->add ($dig = $sha1->digest_noreset);
69	root	1.2	$pad .= $dig;
70			$_[0] .= $pad;
71			}
72
73	root	1.3	substr $_[0], $_[2], length $_[0], "";
74	root	1.2	}
75
76			sub encode_number($) {
77			my $num = pack "N", $_[0];
78			$num =~ s/^\x00+//;
79			pack "n a*", length $num, $num;
80	root	1.1	}
81
82			sub set_data {
83	root	1.3	my ($self, $metadata, $data, $cipher) = @_;
84
85			$cipher \|\|= "Twofish";
86
87			my $cipher_class = "Crypt::$cipher";
88
89			$cipher_class->blocksize == 16 or die "only ciphers with a blocksize of 128 bits are supported";
90	root	1.2
91			my $total_len = (length $metadata) + (length $data);
92	root	1.3	my $padded_log = Net::FCP::Util::log2 $total_len, 10;
93			my $padded_len = 1 << $padded_log;
94	root	1.2
95			my $plaintext = "$metadata$data";
96	root	1.1
97	root	1.3	# crypto key (hash) generation. this is an iterative
98			# algorithm, but it is "unrolled" here for the
99			# common keysize of 16 bytes.
100			my $data_sha1 = Digest::SHA1->new->add ($plaintext);
101	root	1.1
102			# only works for 128 bit keys
103			my $k = new Digest::SHA1;
104			$k->add ("\x00" x 1);
105	root	1.3	$k->add ($data_sha1->clone->digest);
106	root	1.2
107	root	1.3	my $hash = substr $k->digest, 0, 16; # extract leading 128 bit
108	root	1.2
109			my $buf = "";
110
111			$buf .= pack "n a20", 20, Digest::SHA1::sha1 $hash;
112
113			$buf .= encode_number $total_len;
114			$buf .= encode_number length $metadata;
115
116			$buf .= "\x00\x00";
117
118	root	1.3	rolling_hashpad $buf, Digest::SHA1->new->add ($buf), 1 << Net::FCP::Util::log2 length $buf;
119	root	1.2
120	root	1.3	my $pcfbc = $cipher_class->new ($hash);
121	root	1.2	my $pcfbr = "\x00" x 16;
122			my $pcfb = 16;
123
124			my $pcfb_enc = sub {
125	root	1.3	my $length = length $_[0];
126			for (my $i = 0; $i < $length; $i += 16) {
127			substr $_[0], $i, 16, $pcfbr = $pcfbc->encrypt ($pcfbr) ^ substr $_[0], $i, 16;
128	root	1.2	}
129			};
130
131	root	1.3	# buf length must be multiple of 16
132			$pcfb_enc->($buf);
133	root	1.2
134			my $senc = unpack "H*", $buf;
135
136	root	1.3	rolling_hashpad $plaintext, $data_sha1, $padded_len;
137	root	1.2
138	root	1.3	# plaintext length must be a multiple of 16, too
139			print "<";
140			$pcfb_enc->($plaintext);
141			print ">";
142
143			my $partsize = $padded_len < 16384 ? $padded_len
144			: $padded_len < 16384 << 7 ? 16384
145			: $padded_len >> 7; # 2MB
146	root	1.2
147			my $dig = "";
148			for (my $ofs = ($padded_len-1) - ($padded_len-1) % $partsize; $ofs >= 0; $ofs -= $partsize) {
149			$dig = Digest::SHA1::sha1 substr ($plaintext, $ofs, $partsize) . $dig;
150			}
151
152			my $sini = unpack "H*", $dig;
153
154	root	1.3	my $route = sprintf
155	root	1.2	"Document-header\xfe%s\xff"
156			. "Initial-digest\xfe%s\xff"
157			. "Part-size\xfe%x\xff"
158			. "Symmetric-cipher\xfe%s\xff",
159	root	1.3	$senc, $sini, $partsize, $cipher;
160	root	1.2
161	root	1.3	$route = Net::FCP::Util::encode_base64 +(Digest::SHA1::sha1 $route) . (pack "C", $padded_log) . "\x03\x02";
162			$hash = Net::FCP::Util::encode_base64 $hash;
163	root	1.2
164	root	1.3	return "freenet:CHK\@$route,$hash";
165	root	1.2	$self;
166	root	1.1	}
167
168			=item $size = $key->size
169
170			Returns the size of the data (in bytes).
171
172			=cut
173
174			=item $digest = $key->digest
175
176			Return the store digest/hash.
177
178			=cut
179
180			=item $keynum = $key->keynumber
181
182			Returns the keynumber (version?)
183
184			=cut
185
186			=item $chk = $key->chk
187
188			Return the full CHK.
189
190			=cut
191
192			=back
193
194			=head1 SEE ALSO
195
196			L<Net::FCP>.
197
198			=head1 BUGS
199
200			Not heavily tested.
201
202			=head1 AUTHOR
203
204			Marc Lehmann <pcg@goof.com>
205			http://www.goof.com/pcg/marc/
206
207			=cut
208	root	1.2
209	root	1.3	if (0) {
210	root	1.2	my $data = do { local $/; <> };
211			my $metadata = substr $data, 0, 0x3f, "";
212	root	1.3	$metadata = "x" x 3000;
213			$data = "a" x 4098;
214	root	1.2
215	root	1.3	warn Net::FCP::Key::CHK->new_from_data ($metadata, $data);
216			use Net::FCP; my $fcp = new Net::FCP; warn $fcp->generate_chk ($metadata, $data);
217			} else {
218			use Net::FCP;
219			my $fcp = new Net::FCP;
220
221			$\|=1;
222			use Time::HiRes 'time';
223			while () {
224			my $meta = join "", map chr(rand(256)), 1..(30+rand(20));
225			my $data = join "", map chr(rand(256)), 1..(20+rand(200000));
226			my $meta = join "", map chr(rand(256)), 1..1024;
227			my $data = join "", map chr(rand(256)), 1..1024000;
228			printf "%d - %d ", length $meta, length $data;
229			my $t1 = time;
230			my $b = $fcp->generate_chk ($meta, $data, "Rijndael");
231			my $t2 = time;
232			my $a = Net::FCP::Key::CHK->new_from_data ($meta, $data, "Rijndael");
233			my $t3 = time;
234			printf "%.2f %.2f ", $t2-$t1, $t3-$t2;
235			die "$a ne $b" unless "$a" eq $b;
236			print "ok\n";
237			}
238			}
239	root	1.1
240			1;
241