Net-FCP/FCP/Util.pm

=head1 NAME

Net::FCP::Util - utility functions.

=head1 SYNOPSIS

 use Net::FCP::Util;


=head1 DESCRIPTION

=over 4

=cut

package Net::FCP::Util;

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

no warnings;

use base Exporter::;

@EXPORT_OK = qw(tolc touc xeh);

=item touc $string

Returns the uppercased version of the given identifier. Used internally to
map from e.g. URIError/KeyCollision to the form used in this module, i.e.
uri_error/key_collision etc.

=cut

sub touc($) {
   local $_ = shift;
   1 while s/((?:^|_)(?:svk|chk|uri)(?:_|$))/\U$1/;
   s/(?:^|_)(.)/\U$1/g;
   $_;
}

=item tolc $string

Returns the lowercased version of the given identifier. See C<touc>.

=cut

sub tolc($) {
   local $_ = shift;
   1 while s/(SVK|CHK|URI)([^_])/$1\_$2/i;
   1 while s/([^_])(SVK|CHK|URI)/$1\_$2/i;
   s/(?<=[a-z])(?=[A-Z])/_/g;
   lc $_;
}

=item xeh $number

The opposite of C<hex>, i.e. returns the the number as hex string. Mainly
useful due to it's prototype of C<$>.

=cut

sub xeh($) {
   sprintf "%x", $_[0];
}

=item log2 $num[, $minlog]

Calculate the (integer) log2 of a number, rounded up. If C<$minlog> is
given it will be the minimum value returned.

=cut

sub log2($;$) { # n, minlog
   $_[0] && length sprintf "%$_[1]b", $_[0] - 1;
}
# the above line is much faster than the equivalent
# below, which illustrates a fine point of perl...
#  my ($n, $b) = @_;
#  $b++ while 1 << $b < $n;
#  $b;

=item encode_mpi $num

Encode the given number as a multiple-precision number (2 byte bitlength + bytes)

=cut

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

=item decode_base64 $string

Decode freenet's perverted version of base64.

=cut

sub decode_base64($) {
   my $s = shift;

   $s =~ y%~\-%+/%;
   MIME::Base64::decode_base64 "$s======";
}

=item encode_base64 $data

Encode into freenet's perverted version of base64.

=cut

sub encode_base64($) {
   my $s = MIME::Base64::encode_base64 shift, "";
   $s =~ s/=+$//;
   $s =~ y%+/%~\-%;
   $s;
}

=item generate_chk_hash $metadata, $data

Generate and return they hash portion (the part after the comma, the
crypto key) that would be used in the CHK (as binary). This can be used to
verify contents of a CHK, since this key is a hash over the data.

(This function assumes a 128 bit key, which seems standard in freenet).

=cut

sub generate_chk_hash($$) {
   my $d = new Digest::SHA1;

   $d->add ($_[0]);
   $d->add ($_[1]);
   $d = $d->digest;

   my $k = new Digest::SHA1;
   $k->add ("\x00" x 1); # only one iteration
   $k->add ($d);
   
   substr $k->digest, 0, 16; # extract leading 128 bit
}

=item extract_chk_hash $uri

Extract the hash portion (the part after the comma, the crypto key) of a
CHK (in binary). Useful to compare against the output of generate_chk_key.

=cut

sub extract_chk_hash($) {
   $_[0] =~ /CHK\@[a-zA-Z0-9~\-]{31},([a-zA-Z0-9~\-]{22})/
      or Carp::croak "unable to parse CHK key from '$_[0]'";

   decode_base64 $1;
}

=back

=head1 SEE ALSO

L<Net::FCP>.

=head1 BUGS

Not heavily tested.

=head1 AUTHOR

 Marc Lehmann <pcg@goof.com>
 http://home.schmorp.de/

=cut

1;

Revision:	1.3
Committed:	Wed Jan 12 20:37:33 2005 UTC (21 years, 8 months ago) by root
Branch:	MAIN
Changes since 1.2:	+1 -1 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	=head1 NAME
2
3			Net::FCP::Util - utility functions.
4
5			=head1 SYNOPSIS
6
7			use Net::FCP::Util;
8
9
10			=head1 DESCRIPTION
11
12			=over 4
13
14			=cut
15
16			package Net::FCP::Util;
17
18			use Carp ();
19			use Digest::SHA1;
20			use MIME::Base64 ();
21
22			no warnings;
23
24	root	1.2	use base Exporter::;
25
26			@EXPORT_OK = qw(tolc touc xeh);
27
28			=item touc $string
29
30			Returns the uppercased version of the given identifier. Used internally to
31			map from e.g. URIError/KeyCollision to the form used in this module, i.e.
32			uri_error/key_collision etc.
33
34			=cut
35
36			sub touc($) {
37			local $_ = shift;
38			1 while s/((?:^\|_)(?:svk\|chk\|uri)(?:_\|$))/\U$1/;
39			s/(?:^\|_)(.)/\U$1/g;
40			$_;
41			}
42
43			=item tolc $string
44
45			Returns the lowercased version of the given identifier. See C<touc>.
46
47			=cut
48
49			sub tolc($) {
50			local $_ = shift;
51			1 while s/(SVK\|CHK\|URI)([^_])/$1\_$2/i;
52			1 while s/([^_])(SVK\|CHK\|URI)/$1\_$2/i;
53			s/(?<=[a-z])(?=[A-Z])/_/g;
54			lc $_;
55			}
56
57			=item xeh $number
58
59			The opposite of C<hex>, i.e. returns the the number as hex string. Mainly
60			useful due to it's prototype of C<$>.
61
62			=cut
63
64			sub xeh($) {
65			sprintf "%x", $_[0];
66			}
67
68	root	1.1	=item log2 $num[, $minlog]
69
70			Calculate the (integer) log2 of a number, rounded up. If C<$minlog> is
71			given it will be the minimum value returned.
72
73			=cut
74
75			sub log2($;$) { # n, minlog
76			$_[0] && length sprintf "%$_[1]b", $_[0] - 1;
77			}
78			# the above line is much faster than the equivalent
79			# below, which illustrates a fine point of perl...
80			# my ($n, $b) = @_;
81			# $b++ while 1 << $b < $n;
82			# $b;
83
84			=item encode_mpi $num
85
86			Encode the given number as a multiple-precision number (2 byte bitlength + bytes)
87
88			=cut
89
90			sub encode_mpi($) {
91			my $num = pack "N", $_[0];
92			my $len = log2 $_[0], 1;
93			$num =~ s/^\x00+//;
94			pack "n a*", $len, $num;
95			}
96
97			=item decode_base64 $string
98
99			Decode freenet's perverted version of base64.
100
101			=cut
102
103			sub decode_base64($) {
104			my $s = shift;
105
106			$s =~ y%~\-%+/%;
107			MIME::Base64::decode_base64 "$s======";
108			}
109
110			=item encode_base64 $data
111
112			Encode into freenet's perverted version of base64.
113
114			=cut
115
116			sub encode_base64($) {
117			my $s = MIME::Base64::encode_base64 shift, "";
118			$s =~ s/=+$//;
119			$s =~ y%+/%~\-%;
120			$s;
121			}
122
123			=item generate_chk_hash $metadata, $data
124
125			Generate and return they hash portion (the part after the comma, the
126			crypto key) that would be used in the CHK (as binary). This can be used to
127			verify contents of a CHK, since this key is a hash over the data.
128
129			(This function assumes a 128 bit key, which seems standard in freenet).
130
131			=cut
132
133			sub generate_chk_hash($$) {
134			my $d = new Digest::SHA1;
135
136			$d->add ($_[0]);
137			$d->add ($_[1]);
138			$d = $d->digest;
139
140			my $k = new Digest::SHA1;
141			$k->add ("\x00" x 1); # only one iteration
142			$k->add ($d);
143
144			substr $k->digest, 0, 16; # extract leading 128 bit
145			}
146
147			=item extract_chk_hash $uri
148
149			Extract the hash portion (the part after the comma, the crypto key) of a
150			CHK (in binary). Useful to compare against the output of generate_chk_key.
151
152			=cut
153
154			sub extract_chk_hash($) {
155			$_[0] =~ /CHK\@[a-zA-Z0-9~\-]{31},([a-zA-Z0-9~\-]{22})/
156			or Carp::croak "unable to parse CHK key from '$_[0]'";
157
158			decode_base64 $1;
159			}
160
161			=back
162
163			=head1 SEE ALSO
164
165			L<Net::FCP>.
166
167			=head1 BUGS
168
169			Not heavily tested.
170
171			=head1 AUTHOR
172
173			Marc Lehmann <pcg@goof.com>
174	root	1.3	http://home.schmorp.de/
175	root	1.1
176			=cut
177
178			1;
179