ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Net-FCP/FCP.pm
(Generate patch)

Comparing Net-FCP/FCP.pm (file contents):
Revision 1.23 by root, Wed Sep 17 08:57:32 2003 UTC vs.
Revision 1.30 by root, Fri May 14 16:12:26 2004 UTC

… …
72 72
73package Net::FCP; 73package Net::FCP;
74 74
75use Carp; 75use Carp;
76 76
77$VERSION = 0.5; 77$VERSION = 0.7;
78 78
79no warnings; 79no warnings;
80
81use Net::FCP::Metadata;
80 82
81our $EVENT = Net::FCP::Event::Auto::; 83our $EVENT = Net::FCP::Event::Auto::;
82 84
83sub import { 85sub import {
84 shift; 86 shift;
… …
99 $_; 101 $_;
100} 102}
101 103
102sub tolc($) { 104sub tolc($) {
103 local $_ = shift; 105 local $_ = shift;
106 1 while s/(SVK|CHK|URI)([^_])/$1\_$2/i;
107 1 while s/([^_])(SVK|CHK|URI)/$1\_$2/i;
104 s/(?<=[a-z])(?=[A-Z])/_/g; 108 s/(?<=[a-z])(?=[A-Z])/_/g;
105 lc $_; 109 lc $_;
106} 110}
107 111
108# the opposite of hex 112# the opposite of hex
109sub xeh($) { 113sub xeh($) {
110 sprintf "%x", $_[0]; 114 sprintf "%x", $_[0];
111} 115}
112 116
113=item $meta = Net::FCP::parse_metadata $string
114
115Parse a metadata string and return it.
116
117The metadata will be a hashref with key C<version> (containing the
118mandatory version header entries) and key C<raw> containing the original
119metadata string.
120
121All other headers are represented by arrayrefs (they can be repeated).
122
123Since this description is confusing, here is a rather verbose example of a
124parsed manifest:
125
126 (
127 raw => "Version...",
128 version => { revision => 1 },
129 document => [
130 {
131 info => { format" => "image/jpeg" },
132 name => "background.jpg",
133 redirect => { target => "freenet:CHK\@ZcagI,ra726bSw" },
134 },
135 {
136 info => { format" => "text/html" },
137 name => ".next",
138 redirect => { target => "freenet:SSK\@ilUPAgM/TFEE/3" },
139 },
140 {
141 info => { format" => "text/html" },
142 redirect => { target => "freenet:CHK\@8M8Po8ucwI,8xA" },
143 }
144 ]
145 )
146
147=cut
148
149sub parse_metadata {
150 my $data = shift;
151 my $meta = { raw => $data };
152
153 if ($data =~ /^Version\015?\012/gc) {
154 my $hdr = $meta->{version} = {};
155
156 for (;;) {
157 while ($data =~ /\G([^=\015\012]+)=([^\015\012]*)\015?\012/gc) {
158 my ($k, $v) = ($1, $2);
159 my @p = split /\./, tolc $k, 3;
160
161 $hdr->{$p[0]} = $v if @p == 1; # lamest code I ever wrote
162 $hdr->{$p[0]}{$p[1]} = $v if @p == 2;
163 $hdr->{$p[0]}{$p[1]}{$p[2]} = $v if @p == 3;
164 die "FATAL: 4+ dot metadata" if @p >= 4;
165 }
166
167 if ($data =~ /\GEndPart\015?\012/gc) {
168 # nop
169 } elsif ($data =~ /\GEnd(\015?\012|$)/gc) {
170 last;
171 } elsif ($data =~ /\G([A-Za-z0-9.\-]+)\015?\012/gcs) {
172 push @{$meta->{tolc $1}}, $hdr = {};
173 } elsif ($data =~ /\G(.*)/gcs) {
174 print STDERR "metadata format error ($1), please report this string: <<$data>>";
175 die "metadata format error";
176 }
177 }
178 }
179
180 #$meta->{tail} = substr $data, pos $data;
181
182 $meta;
183}
184
185=item $fcp = new Net::FCP [host => $host][, port => $port] 117=item $fcp = new Net::FCP [host => $host][, port => $port][, progress => \&cb]
186 118
187Create a new virtual FCP connection to the given host and port (default 119Create a new virtual FCP connection to the given host and port (default
188127.0.0.1:8481, or the environment variables C<FREDHOST> and C<FREDPORT>). 120127.0.0.1:8481, or the environment variables C<FREDHOST> and C<FREDPORT>).
189 121
190Connections are virtual because no persistent physical connection is 122Connections are virtual because no persistent physical connection is
191established. 123established.
192 124
193=begin comment 125You can install a progress callback that is being called with the Net::FCP
126object, a txn object, the type of the transaction and the attributes. Use
127it like this:
194 128
195However, the existance of the node is checked by executing a 129 sub progress_cb {
196C<ClientHello> transaction. 130 my ($self, $txn, $type, $attr) = @_;
197 131
198=end 132 warn "progress<$txn,$type," . (join ":", %$attr) . ">\n";
133 }
199 134
200=cut 135=cut
201 136
202sub new { 137sub new {
203 my $class = shift; 138 my $class = shift;
204 my $self = bless { @_ }, $class; 139 my $self = bless { @_ }, $class;
205 140
206 $self->{host} ||= $ENV{FREDHOST} || "127.0.0.1"; 141 $self->{host} ||= $ENV{FREDHOST} || "127.0.0.1";
207 $self->{port} ||= $ENV{FREDPORT} || 8481; 142 $self->{port} ||= $ENV{FREDPORT} || 8481;
208 143
209 #$self->{nodehello} = $self->client_hello
210 # or croak "unable to get nodehello from node\n";
211
212 $self; 144 $self;
213} 145}
214 146
215sub progress { 147sub progress {
216 my ($self, $txn, $type, $attr) = @_; 148 my ($self, $txn, $type, $attr) = @_;
217 #warn "progress<$txn,$type," . (join ":", %$attr) . ">\n";
218}
219 149
150 $self->{progress}->($self, $txn, $type, $attr)
151 if $self->{progress};
152}
153
220=item $txn = $fcp->txn(type => attr => val,...) 154=item $txn = $fcp->txn (type => attr => val,...)
221 155
222The low-level interface to transactions. Don't use it. 156The low-level interface to transactions. Don't use it unless you have
223 157"special needs". Instead, use predefiend transactions like this:
224Here are some examples of using transactions:
225 158
226The blocking case, no (visible) transactions involved: 159The blocking case, no (visible) transactions involved:
227 160
228 my $nodehello = $fcp->client_hello; 161 my $nodehello = $fcp->client_hello;
229 162
… …
248sub txn { 181sub txn {
249 my ($self, $type, %attr) = @_; 182 my ($self, $type, %attr) = @_;
250 183
251 $type = touc $type; 184 $type = touc $type;
252 185
253 my $txn = "Net::FCP::Txn::$type"->new(fcp => $self, type => tolc $type, attr => \%attr); 186 my $txn = "Net::FCP::Txn::$type"->new (fcp => $self, type => tolc $type, attr => \%attr);
254 187
255 $txn; 188 $txn;
256} 189}
257 190
258{ # transactions 191{ # transactions
… …
323 256
324=item $txn = $fcp->txn_generate_chk ($metadata, $data[, $cipher]) 257=item $txn = $fcp->txn_generate_chk ($metadata, $data[, $cipher])
325 258
326=item $uri = $fcp->generate_chk ($metadata, $data[, $cipher]) 259=item $uri = $fcp->generate_chk ($metadata, $data[, $cipher])
327 260
328Calculcates a CHK, given the metadata and data. C<$cipher> is either 261Calculates a CHK, given the metadata and data. C<$cipher> is either
329C<Rijndael> or C<Twofish>, with the latter being the default. 262C<Rijndael> or C<Twofish>, with the latter being the default.
330 263
331=cut 264=cut
332 265
333$txn->(generate_chk => sub { 266$txn->(generate_chk => sub {
334 my ($self, $metadata, $data, $cipher) = @_; 267 my ($self, $metadata, $data, $cipher) = @_;
335 268
269 $metadata = Net::FCP::Metadata::build_metadata $metadata;
270
336 $self->txn (generate_chk => 271 $self->txn (generate_chk =>
337 data => "$metadata$data", 272 data => "$metadata$data",
338 metadata_length => xeh length $metadata, 273 metadata_length => xeh length $metadata,
339 cipher => $cipher || "Twofish"); 274 cipher => $cipher || "Twofish");
340}); 275});
341 276
342=item $txn = $fcp->txn_generate_svk_pair 277=item $txn = $fcp->txn_generate_svk_pair
343 278
344=item ($public, $private) = @{ $fcp->generate_svk_pair } 279=item ($public, $private) = @{ $fcp->generate_svk_pair }
345 280
346Creates a new SVK pair. Returns an arrayref. 281Creates a new SVK pair. Returns an arrayref with the public key, the
282private key and a crypto key, which is just additional entropy.
347 283
348 [ 284 [
349 "hKs0-WDQA4pVZyMPKNFsK1zapWY", 285 "acLx4dux9fvvABH15Gk6~d3I-yw",
350 "ZnmvMITaTXBMFGl4~jrjuyWxOWg" 286 "cPoDkDMXDGSMM32plaPZDhJDxSs",
287 "BH7LXCov0w51-y9i~BoB3g",
351 ] 288 ]
289
290A private key (for inserting) can be constructed like this:
291
292 SSK@<private_key>,<crypto_key>/<name>
293
294It can be used to insert data. The corresponding public key looks like this:
295
296 SSK@<public_key>PAgM,<crypto_key>/<name>
297
298Watch out for the C<PAgM>-part!
352 299
353=cut 300=cut
354 301
355$txn->(generate_svk_pair => sub { 302$txn->(generate_svk_pair => sub {
356 my ($self) = @_; 303 my ($self) = @_;
357 304
358 $self->txn ("generate_svk_pair"); 305 $self->txn ("generate_svk_pair");
359}); 306});
360 307
361=item $txn = $fcp->txn_insert_private_key ($private) 308=item $txn = $fcp->txn_invert_private_key ($private)
362 309
363=item $public = $fcp->insert_private_key ($private) 310=item $public = $fcp->invert_private_key ($private)
364 311
365Inserts a private key. $private can be either an insert URI (must start 312Inverts a private key (returns the public key). C<$private> can be either
366with C<freenet:SSK@>) or a raw private key (i.e. the private value you get 313an insert URI (must start with C<freenet:SSK@>) or a raw private key (i.e.
367back from C<generate_svk_pair>). 314the private value you get back from C<generate_svk_pair>).
368 315
369Returns the public key. 316Returns the public key.
370 317
371UNTESTED.
372
373=cut 318=cut
374 319
375$txn->(insert_private_key => sub { 320$txn->(invert_private_key => sub {
376 my ($self, $privkey) = @_; 321 my ($self, $privkey) = @_;
377 322
378 $self->txn (invert_private_key => private => $privkey); 323 $self->txn (invert_private_key => private => $privkey);
379}); 324});
380 325
… …
383=item $length = $fcp->get_size ($uri) 328=item $length = $fcp->get_size ($uri)
384 329
385Finds and returns the size (rounded up to the nearest power of two) of the 330Finds and returns the size (rounded up to the nearest power of two) of the
386given document. 331given document.
387 332
388UNTESTED.
389
390=cut 333=cut
391 334
392$txn->(get_size => sub { 335$txn->(get_size => sub {
393 my ($self, $uri) = @_; 336 my ($self, $uri) = @_;
394 337
… …
397 340
398=item $txn = $fcp->txn_client_get ($uri [, $htl = 15 [, $removelocal = 0]]) 341=item $txn = $fcp->txn_client_get ($uri [, $htl = 15 [, $removelocal = 0]])
399 342
400=item ($metadata, $data) = @{ $fcp->client_get ($uri, $htl, $removelocal) 343=item ($metadata, $data) = @{ $fcp->client_get ($uri, $htl, $removelocal)
401 344
402Fetches a (small, as it should fit into memory) file from 345Fetches a (small, as it should fit into memory) key content block from
403freenet. C<$meta> is the metadata (as returned by C<parse_metadata> or 346freenet. C<$meta> is a C<Net::FCP::Metadata> object or C<undef>).
404C<undef>).
405 347
406Due to the overhead, a better method to download big files should be used. 348The C<$uri> should begin with C<freenet:>, but the scheme is currently
349added, if missing.
407 350
408 my ($meta, $data) = @{ 351 my ($meta, $data) = @{
409 $fcp->client_get ( 352 $fcp->client_get (
410 "freenet:CHK@hdXaxkwZ9rA8-SidT0AN-bniQlgPAwI,XdCDmBuGsd-ulqbLnZ8v~w" 353 "freenet:CHK@hdXaxkwZ9rA8-SidT0AN-bniQlgPAwI,XdCDmBuGsd-ulqbLnZ8v~w"
411 ) 354 )
… …
414=cut 357=cut
415 358
416$txn->(client_get => sub { 359$txn->(client_get => sub {
417 my ($self, $uri, $htl, $removelocal) = @_; 360 my ($self, $uri, $htl, $removelocal) = @_;
418 361
362 $uri =~ s/^freenet://; $uri = "freenet:$uri";
363
419 $self->txn (client_get => URI => $uri, hops_to_live => xeh (defined $htl ? $htl : 15), 364 $self->txn (client_get => URI => $uri, hops_to_live => xeh (defined $htl ? $htl : 15),
420 remove_local_key => $removelocal ? "true" : "false"); 365 remove_local_key => $removelocal ? "true" : "false");
421}); 366});
422 367
423=item $txn = $fcp->txn_client_put ($uri, $metadata, $data, $htl, $removelocal) 368=item $txn = $fcp->txn_client_put ($uri, $metadata, $data, $htl, $removelocal)
424 369
425=item my $uri = $fcp->client_put ($uri, $metadata, $data, $htl, $removelocal); 370=item my $uri = $fcp->client_put ($uri, $metadata, $data, $htl, $removelocal);
426 371
427Insert a new key. If the client is inserting a CHK, the URI may be 372Insert a new key. If the client is inserting a CHK, the URI may be
428abbreviated as just CHK@. In this case, the node will calculate the 373abbreviated as just CHK@. In this case, the node will calculate the
429CHK. 374CHK. If the key is a private SSK key, the node will calculcate the public
375key and the resulting public URI.
430 376
431C<$meta> can be a reference or a string (ONLY THE STRING CASE IS IMPLEMENTED!). 377C<$meta> can be a hash reference (same format as returned by
378C<Net::FCP::parse_metadata>) or a string.
432 379
433THIS INTERFACE IS UNTESTED AND SUBJECT TO CHANGE. 380The result is an arrayref with the keys C<uri>, C<public_key> and C<private_key>.
434 381
435=cut 382=cut
436 383
437$txn->(client_put => sub { 384$txn->(client_put => sub {
438 my ($self, $uri, $meta, $data, $htl, $removelocal) = @_; 385 my ($self, $uri, $metadata, $data, $htl, $removelocal) = @_;
439 386
440 $self->txn (client_put => URI => $uri, xeh (defined $htl ? $htl : 15), 387 $metadata = Net::FCP::Metadata::build_metadata $metadata;
388 $uri =~ s/^freenet://; $uri = "freenet:$uri";
389
390 $self->txn (client_put => URI => $uri,
391 hops_to_live => xeh (defined $htl ? $htl : 15),
441 remove_local_key => $removelocal ? "true" : "false", 392 remove_local_key => $removelocal ? "true" : "false",
442 data => "$meta$data", metadata_length => xeh length $meta); 393 data => "$metadata$data", metadata_length => xeh length $metadata);
443}); 394});
444 395
445} # transactions 396} # transactions
446
447=item MISSING: (ClientPut), InsertKey
448 397
449=back 398=back
450 399
451=head2 THE Net::FCP::Txn CLASS 400=head2 THE Net::FCP::Txn CLASS
452 401
… …
677 } 626 }
678} 627}
679 628
680sub progress { 629sub progress {
681 my ($self, $type, $attr) = @_; 630 my ($self, $type, $attr) = @_;
631
682 $self->{fcp}->progress ($self, $type, $attr); 632 $self->{fcp}->progress ($self, $type, $attr);
683} 633}
684 634
685=item $result = $txn->result 635=item $result = $txn->result
686 636
… …
738 688
739use base Net::FCP::Txn; 689use base Net::FCP::Txn;
740 690
741sub rcv_success { 691sub rcv_success {
742 my ($self, $attr) = @_; 692 my ($self, $attr) = @_;
743 $self->set_result ([$attr->{PublicKey}, $attr->{PrivateKey}]); 693 $self->set_result ([$attr->{public_key}, $attr->{private_key}, $attr->{crypto_key}]);
744} 694}
745 695
746package Net::FCP::Txn::InsertPrivateKey; 696package Net::FCP::Txn::InvertPrivateKey;
747 697
748use base Net::FCP::Txn; 698use base Net::FCP::Txn;
749 699
750sub rcv_success { 700sub rcv_success {
751 my ($self, $attr) = @_; 701 my ($self, $attr) = @_;
752 $self->set_result ($attr->{PublicKey}); 702 $self->set_result ($attr->{public_key});
753} 703}
754 704
755package Net::FCP::Txn::GetSize; 705package Net::FCP::Txn::GetSize;
756 706
757use base Net::FCP::Txn; 707use base Net::FCP::Txn;
758 708
759sub rcv_success { 709sub rcv_success {
760 my ($self, $attr) = @_; 710 my ($self, $attr) = @_;
761 $self->set_result (hex $attr->{Length}); 711 $self->set_result (hex $attr->{length});
762} 712}
763 713
764package Net::FCP::Txn::GetPut; 714package Net::FCP::Txn::GetPut;
765 715
766# base class for get and put 716# base class for get and put
767 717
768use base Net::FCP::Txn; 718use base Net::FCP::Txn;
769 719
770*rcv_uri_error = \&Net::FCP::Txn::rcv_throw_exception; 720*rcv_uri_error = \&Net::FCP::Txn::rcv_throw_exception;
771*rcv_route_not_found = \&Net::FCP::Txn::rcv_throw_exception; 721*rcv_route_not_found = \&Net::FCP::Txn::rcv_throw_exception;
772 722
773sub rcv_restarted { 723sub rcv_restarted {
774 my ($self, $attr, $type) = @_; 724 my ($self, $attr, $type) = @_;
775 725
776 delete $self->{datalength}; 726 delete $self->{datalength};
… …
793 743
794 $self->progress ("data", { chunk => length $chunk, received => length $self->{data}, total => $self->{datalength} }); 744 $self->progress ("data", { chunk => length $chunk, received => length $self->{data}, total => $self->{datalength} });
795 745
796 if ($self->{datalength} == length $self->{data}) { 746 if ($self->{datalength} == length $self->{data}) {
797 my $data = delete $self->{data}; 747 my $data = delete $self->{data};
798 my $meta = Net::FCP::parse_metadata substr $data, 0, $self->{metalength}, ""; 748 my $meta = new Net::FCP::Metadata (substr $data, 0, $self->{metalength}, "");
799 749
800 $self->set_result ([$meta, $data]); 750 $self->set_result ([$meta, $data]);
801 $self->eof; 751 $self->eof;
802 } 752 }
803} 753}
… …
814package Net::FCP::Txn::ClientPut; 764package Net::FCP::Txn::ClientPut;
815 765
816use base Net::FCP::Txn::GetPut; 766use base Net::FCP::Txn::GetPut;
817 767
818*rcv_size_error = \&Net::FCP::Txn::rcv_throw_exception; 768*rcv_size_error = \&Net::FCP::Txn::rcv_throw_exception;
819*rcv_key_collision = \&Net::FCP::Txn::rcv_throw_exception;
820 769
821sub rcv_pending { 770sub rcv_pending {
822 my ($self, $attr, $type) = @_; 771 my ($self, $attr, $type) = @_;
823 $self->progress ($type, $attr); 772 $self->progress ($type, $attr);
824} 773}
825 774
826sub rcv_success { 775sub rcv_success {
827 my ($self, $attr, $type) = @_; 776 my ($self, $attr, $type) = @_;
828 $self->set_result ($attr); 777 $self->set_result ($attr);
778}
779
780sub rcv_key_collision {
781 my ($self, $attr, $type) = @_;
782 $self->set_result ({ key_collision => 1, %$attr });
829} 783}
830 784
831=back 785=back
832 786
833=head2 The Net::FCP::Exception CLASS 787=head2 The Net::FCP::Exception CLASS
… …
909=cut 863=cut
910 864
911package Net::FCP::Event::Auto; 865package Net::FCP::Event::Auto;
912 866
913my @models = ( 867my @models = (
914 [Coro => Coro::Event:: ], 868 [Coro => Coro::Event::],
915 [Event => Event::], 869 [Event => Event::],
916 [Glib => Glib:: ], 870 [Glib => Glib::],
917 [Tk => Tk::], 871 [Tk => Tk::],
918); 872);
919 873
920sub AUTOLOAD { 874sub AUTOLOAD {
921 $AUTOLOAD =~ s/.*://; 875 $AUTOLOAD =~ s/.*://;

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines