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.2 by root, Sun Sep 7 23:20:20 2003 UTC vs.
Revision 1.9 by root, Tue Sep 9 06:13:18 2003 UTC

… …
17of what the messages do. I am too lazy to document all this here. 17of what the messages do. I am too lazy to document all this here.
18 18
19=head1 WARNING 19=head1 WARNING
20 20
21This module is alpha. While it probably won't destroy (much :) of your 21This module is alpha. While it probably won't destroy (much :) of your
22data, it currently works only with the Event module (alkthough the event 22data, it currently falls short of what it should provide (intelligent uri
23mechanism is fully pluggable). 23following, splitfile downloads, healing...)
24
25=head2 IMPORT TAGS
26
27Nothing much can be "imported" from this module right now. There are,
28however, certain "import tags" that can be used to select the event model
29to be used.
30
31Event models are implemented as modules under the C<Net::FCP::Event::xyz>
32class, where C<xyz> is the event model to use. The default is C<Event> (or
33later C<Auto>).
34
35The import tag to use is named C<event=xyz>, e.g. C<event=Event>,
36C<event=Glib> etc.
37
38You should specify the event module to use only in the main program.
24 39
25=head2 THE Net::FCP CLASS 40=head2 THE Net::FCP CLASS
26 41
27=over 4 42=over 4
28 43
… …
31package Net::FCP; 46package Net::FCP;
32 47
33use Carp; 48use Carp;
34use IO::Socket::INET; 49use IO::Socket::INET;
35 50
36$VERSION = 0.01; 51$VERSION = 0.04;
37 52
38sub event_reg_cb { 53our $EVENT = Net::FCP::Event::Auto::;
39 my ($obj) = @_; 54$EVENT = Net::FCP::Event::Event::;#d#
40 require Event;
41 55
42 $obj->{eventdata} = Event->io ( 56sub import {
43 fd => $obj->{fh}, 57 shift;
44 poll => 'r', 58
45 cb => sub { 59 for (@_) {
46 $obj->fh_ready; 60 if (/^event=(\w+)$/) {
61 $EVENT = "Net::FCP::Event::$1";
47 }, 62 }
48 ); 63 }
64 eval "require $EVENT";
49} 65}
50
51sub event_unreg_cb {
52 $_[0]{eventdata}
53 and (delete $_[0]{eventdata})->cancel;
54}
55
56sub event_wait_cb {
57 Event::one_event();
58}
59
60$regcb = \&event_reg_cb;
61$unregcb = \&event_unreg_cb;
62$waitcb = \&event_wait_cb;
63 66
64sub touc($) { 67sub touc($) {
65 local $_ = shift; 68 local $_ = shift;
66 1 while s/((?:^|_)(?:svk|chk|uri)(?:_|$))/\U$1/; 69 1 while s/((?:^|_)(?:svk|chk|uri)(?:_|$))/\U$1/;
67 s/(?:^|_)(.)/\U$1/g; 70 s/(?:^|_)(.)/\U$1/g;
… …
72 local $_ = shift; 75 local $_ = shift;
73 s/(?<=[a-z])(?=[A-Z])/_/g; 76 s/(?<=[a-z])(?=[A-Z])/_/g;
74 lc $_; 77 lc $_;
75} 78}
76 79
80=item $meta = Net::FCP::parse_metadata $string
81
82Parse a metadata string and return it.
83
84The metadata will be a hashref with key C<version> (containing
85the mandatory version header entries).
86
87All other headers are represented by arrayrefs (they can be repeated).
88
89Since this is confusing, here is a rather verbose example of a parsed
90manifest:
91
92 (
93 version => { revision => 1 },
94 document => [
95 {
96 "info.format" => "image/jpeg",
97 name => "background.jpg",
98 "redirect.target" => "freenet:CHK\@ZcagI,ra726bSw"
99 },
100 {
101 "info.format" => "text/html",
102 name => ".next",
103 "redirect.target" => "freenet:SSK\@ilUPAgM/TFEE/3"
104 },
105 {
106 "info.format" => "text/html",
107 "redirect.target" => "freenet:CHK\@8M8Po8ucwI,8xA"
108 }
109 ]
110 )
111
112=cut
113
114sub parse_metadata {
115 my $meta;
116
117 my $data = shift;
118 if ($data =~ /^Version\015?\012/gc) {
119 my $hdr = $meta->{version} = {};
120
121 for (;;) {
122 while ($data =~ /\G([^=\015\012]+)=([^\015\012]*)\015?\012/gc) {
123 my ($k, $v) = ($1, $2);
124 $hdr->{tolc $k} = $v;
125 }
126
127 if ($data =~ /\GEndPart\015?\012/gc) {
128 } elsif ($data =~ /\GEnd\015?\012/gc) {
129 last;
130 } elsif ($data =~ /\G([A-Za-z0-9.\-]+)\015?\012/gcs) {
131 push @{$meta->{tolc $1}}, $hdr = {};
132 } elsif ($data =~ /\G(.*)/gcs) {
133 die "metadata format error ($1)";
134 }
135 }
136 }
137
138 #$meta->{tail} = substr $data, pos $data;
139
140 $meta;
141}
142
77=item $fcp = new Net::FCP [host => $host][, port => $port] 143=item $fcp = new Net::FCP [host => $host][, port => $port]
78 144
79Create a new virtual FCP connection to the given host and port (default 145Create a new virtual FCP connection to the given host and port (default
80127.0.0.1:8481). 146127.0.0.1:8481, or the environment variables C<FREDHOST> and C<FREDPORT>).
81 147
82Connections are virtual because no persistent physical connection is 148Connections are virtual because no persistent physical connection is
83established. However, the existance of the node is checked by executing a 149established. However, the existance of the node is checked by executing a
84C<ClientHello> transaction. 150C<ClientHello> transaction.
85 151
… …
87 153
88sub new { 154sub new {
89 my $class = shift; 155 my $class = shift;
90 my $self = bless { @_ }, $class; 156 my $self = bless { @_ }, $class;
91 157
92 $self->{host} ||= "127.0.0.1"; 158 $self->{host} ||= $ENV{FREDHOST} || "127.0.0.1";
93 $self->{port} ||= 8481; 159 $self->{port} ||= $ENV{FREDPORt} || 8481;
94 160
95 $self->{nodehello} = $self->txn("ClientHello")->result 161 $self->{nodehello} = $self->client_hello
96 or croak "unable to get nodehello from node\n"; 162 or croak "unable to get nodehello from node\n";
97 163
98 $self; 164 $self;
165}
166
167sub progress {
168 my ($self, $txn, $type, $attr) = @_;
169 warn "progress<$txn,$type," . (join ":", %$attr) . ">\n";
99} 170}
100 171
101=item $txn = $fcp->txn(type => attr => val,...) 172=item $txn = $fcp->txn(type => attr => val,...)
102 173
103The low-level interface to transactions. Don't use it. 174The low-level interface to transactions. Don't use it.
… …
126 197
127Executes a ClientHello request and returns it's results. 198Executes a ClientHello request and returns it's results.
128 199
129 { 200 {
130 max_file_size => "5f5e100", 201 max_file_size => "5f5e100",
202 node => "Fred,0.6,1.46,7050"
131 protocol => "1.2", 203 protocol => "1.2",
132 node => "Fred,0.6,1.46,7050"
133 } 204 }
134 205
135=cut 206=cut
136 207
137_txn client_hello => sub { 208_txn client_hello => sub {
… …
145=item $nodeinfo = $fcp->client_info 216=item $nodeinfo = $fcp->client_info
146 217
147Executes a ClientInfo request and returns it's results. 218Executes a ClientInfo request and returns it's results.
148 219
149 { 220 {
150 max_file_size => "5f5e100",
151 datastore_max => "2540be400",
152 node_port => 369,
153 java_name => "Java HotSpot(_T_M) Server VM",
154 operating_system_version => "2.4.20",
155 estimated_load => 52,
156 free_memory => "5cc0148",
157 datastore_free => "5ce03400",
158 node_address => "1.2.3.4",
159 active_jobs => "1f", 221 active_jobs => "1f",
160 allocated_memory => "bde0000", 222 allocated_memory => "bde0000",
161 architecture => "i386", 223 architecture => "i386",
224 available_threads => 17,
225 datastore_free => "5ce03400",
226 datastore_max => "2540be400",
227 datastore_used => "1f72bb000",
228 estimated_load => 52,
229 free_memory => "5cc0148",
230 is_transient => "false",
231 java_name => "Java HotSpot(_T_M) Server VM",
232 java_vendor => "http://www.blackdown.org/",
233 java_version => "Blackdown-1.4.1-01",
234 least_recent_timestamp => "f41538b878",
235 max_file_size => "5f5e100",
236 most_recent_timestamp => "f77e2cc520"
237 node_address => "1.2.3.4",
238 node_port => 369,
239 operating_system => "Linux",
240 operating_system_version => "2.4.20",
162 routing_time => "a5", 241 routing_time => "a5",
163 least_recent_timestamp => "f41538b878",
164 available_threads => 17,
165 datastore_used => "1f72bb000",
166 java_version => "Blackdown-1.4.1-01",
167 is_transient => "false",
168 operating_system => "Linux",
169 java_vendor => "http://www.blackdown.org/",
170 most_recent_timestamp => "f77e2cc520"
171 } 242 }
172 243
173=cut 244=cut
174 245
175_txn client_info => sub { 246_txn client_info => sub {
… …
187=cut 258=cut
188 259
189_txn generate_chk => sub { 260_txn generate_chk => sub {
190 my ($self, $metadata, $data) = @_; 261 my ($self, $metadata, $data) = @_;
191 262
192 $self->txn (generate_chk => data => "$data$metadata", meta_data_length => length $metadata); 263 $self->txn (generate_chk => data => "$data$metadata", metadata_length => length $metadata);
193}; 264};
194 265
195=item $txn = $fcp->txn_generate_svk_pair 266=item $txn = $fcp->txn_generate_svk_pair
196 267
197=item ($public, $private) = @{ $fcp->generate_svk_pair } 268=item ($public, $private) = @{ $fcp->generate_svk_pair }
… …
246 my ($self, $uri) = @_; 317 my ($self, $uri) = @_;
247 318
248 $self->txn (get_size => URI => $uri); 319 $self->txn (get_size => URI => $uri);
249}; 320};
250 321
322=item $txn = $fcp->txn_client_get ($uri [, $htl = 15 [, $removelocal = 0]])
323
324=item ($metadata, $data) = @{ $fcp->client_get ($uri, $htl, $removelocal)
325
326Fetches a (small, as it should fit into memory) file from
327freenet. C<$meta> is the metadata (as returned by C<parse_metadata> or
328C<undef>).
329
330Due to the overhead, a better method to download big files should be used.
331
332 my ($meta, $data) = @{
333 $fcp->client_get (
334 "freenet:CHK@hdXaxkwZ9rA8-SidT0AN-bniQlgPAwI,XdCDmBuGsd-ulqbLnZ8v~w"
335 )
336 };
337
338=cut
339
340_txn client_get => sub {
341 my ($self, $uri, $htl, $removelocal) = @_;
342
343 $self->txn (client_get => URI => $uri, hops_to_live => ($htl || 15), remove_local => $removelocal*1);
344};
345
251=item MISSING: ClientGet, ClientPut 346=item MISSING: ClientPut
252 347
253=back 348=back
254 349
255=head2 THE Net::FCP::Txn CLASS 350=head2 THE Net::FCP::Txn CLASS
256 351
… …
315 410
316 #$fh->shutdown (1); # freenet buggy?, well, it's java... 411 #$fh->shutdown (1); # freenet buggy?, well, it's java...
317 412
318 $self->{fh} = $fh; 413 $self->{fh} = $fh;
319 414
320 $Net::FCP::regcb->($self); 415 $EVENT->reg_r_cb ($self);
321 416
322 $self; 417 $self;
418}
419
420=item $userdata = $txn->userdata ([$userdata])
421
422Get and/or set user-specific data. This is useful in progress callbacks.
423
424=cut
425
426sub userdata($;$) {
427 my ($self, $data) = @_;
428 $self->{userdata} = $data if @_ >= 2;
429 $self->{userdata};
323} 430}
324 431
325sub fh_ready { 432sub fh_ready {
326 my ($self) = @_; 433 my ($self) = @_;
327 434
328 if (sysread $self->{fh}, $self->{buf}, 65536, length $self->{buf}) { 435 if (sysread $self->{fh}, $self->{buf}, 65536, length $self->{buf}) {
329 for (;;) { 436 for (;;) {
330 if ($self->{datalen}) { 437 if ($self->{datalen}) {
331 if (length $self->{buf} >= $self->{datalen}) { 438 if (length $self->{buf} >= $self->{datalen}) {
332 $self->recv_data (substr $self->{buf}, 0, $self->{datalen}, ""); 439 $self->rcv_data (substr $self->{buf}, 0, $self->{datalen}, "");
333 } else { 440 } else {
334 last; 441 last;
335 } 442 }
336 } elsif ($self->{buf} =~ s/^DataChunk\015?\012Length=(\d+)\015?\012Data\015?\012//) { 443 } elsif ($self->{buf} =~ s/^DataChunk\015?\012Length=([0-9a-fA-F]+)\015?\012Data\015?\012//) {
337 $self->{datalen} = $1; 444 $self->{datalen} = hex $1;
338 } elsif ($self->{buf} =~ s/^([a-zA-Z]+)\015?\012(.*?)\015?\012EndMessage\015?\012//s) { 445 } elsif ($self->{buf} =~ s/^([a-zA-Z]+)\015?\012(?:(.+?)\015?\012)?EndMessage\015?\012//s) {
339 $self->rcv ($1, { 446 $self->rcv ($1, {
340 map { my ($a, $b) = split /=/, $_, 2; ((Net::FCP::tolc $a), $b) } 447 map { my ($a, $b) = split /=/, $_, 2; ((Net::FCP::tolc $a), $b) }
341 split /\015?\012/, $2 448 split /\015?\012/, $2
342 }); 449 });
343 } else { 450 } else {
344 last; 451 last;
345 } 452 }
346 } 453 }
347 } else { 454 } else {
348 $Net::FCP::unregcb->($self); 455 $EVENT->unreg_r_cb ($self);
349 delete $self->{fh}; 456 delete $self->{fh};
350 $self->eof; 457 $self->eof;
351 } 458 }
352} 459}
353 460
354sub rcv_data { 461sub rcv_data {
355 my ($self, $chunk) = @_; 462 my ($self, $chunk) = @_;
463
464 $self->{data} .= $chunk;
465
466 $self->progress ("data", { chunk => length $chunk, total => length $self->{data}, end => $self->{datalength} });
356} 467}
357 468
358sub rcv { 469sub rcv {
359 my ($self, $type, $attr) = @_; 470 my ($self, $type, $attr) = @_;
360 471
361 $type = Net::FCP::tolc $type; 472 $type = Net::FCP::tolc $type;
473
474 #use PApp::Util; warn PApp::Util::dumpval [$type, $attr];
362 475
363 if (my $method = $self->can("rcv_$type")) { 476 if (my $method = $self->can("rcv_$type")) {
364 $method->($self, $attr, $type); 477 $method->($self, $attr, $type);
365 } else { 478 } else {
366 warn "received unexpected reply type '$type' for '$self->{type}', ignoring\n"; 479 warn "received unexpected reply type '$type' for '$self->{type}', ignoring\n";
367 $self->eof;
368 } 480 }
481}
482
483sub throw {
484 my ($self, $exc) = @_;
485
486 $self->{exception} = $exc;
487 $self->set_result (1);
488}
489
490sub set_result {
491 my ($self, $result) = @_;
492
493 $self->{result} = $result unless exists $self->{result};
369} 494}
370 495
371sub eof { 496sub eof {
372 my ($self, $result) = @_; 497 my ($self) = @_;
498 $self->set_result;
499}
373 500
374 $self->{result} = $result unless exists $self->{result}; 501sub progress {
502 my ($self, $type, $attr) = @_;
503 $self->{fcp}->progress ($self, $type, $attr);
375} 504}
376 505
377=item $result = $txn->result 506=item $result = $txn->result
378 507
379Waits until a result is available and then returns it. 508Waits until a result is available and then returns it.
380 509
381This waiting is (depending on your event modul) not very efficient, as it 510This waiting is (depending on your event model) not very efficient, as it
382is done outside the "mainloop". 511is done outside the "mainloop".
383 512
384=cut 513=cut
385 514
386sub result { 515sub result {
387 my ($self) = @_; 516 my ($self) = @_;
388 517
389 $Net::FCP::waitcb->() while !exists $self->{result}; 518 $EVENT->wait_event while !exists $self->{result};
519
520 die $self->{exception} if $self->{exception};
390 521
391 return $self->{result}; 522 return $self->{result};
392} 523}
393 524
394sub DESTROY { 525sub DESTROY {
395 $Net::FCP::unregcb->($_[0]); 526 $EVENT->unreg_r_cb ($_[0]);
527 #$EVENT->unreg_w_cb ($_[0]);
396} 528}
397 529
398package Net::FCP::Txn::ClientHello; 530package Net::FCP::Txn::ClientHello;
399 531
400use base Net::FCP::Txn; 532use base Net::FCP::Txn;
401 533
402sub rcv_node_hello { 534sub rcv_node_hello {
403 my ($self, $attr) = @_; 535 my ($self, $attr) = @_;
404 536
405 $self->eof ($attr); 537 $self->set_result ($attr);
406} 538}
407 539
408package Net::FCP::Txn::ClientInfo; 540package Net::FCP::Txn::ClientInfo;
409 541
410use base Net::FCP::Txn; 542use base Net::FCP::Txn;
411 543
412sub rcv_node_info { 544sub rcv_node_info {
413 my ($self, $attr) = @_; 545 my ($self, $attr) = @_;
414 546
415 $self->eof ($attr); 547 $self->set_result ($attr);
416} 548}
417 549
418package Net::FCP::Txn::GenerateCHK; 550package Net::FCP::Txn::GenerateCHK;
419 551
420use base Net::FCP::Txn; 552use base Net::FCP::Txn;
421 553
422sub rcv_success { 554sub rcv_success {
423 my ($self, $attr) = @_; 555 my ($self, $attr) = @_;
424 556
425 $self->eof ($attr); 557 $self->set_result ($attr);
426} 558}
427 559
428package Net::FCP::Txn::GenerateSVKPair; 560package Net::FCP::Txn::GenerateSVKPair;
429 561
430use base Net::FCP::Txn; 562use base Net::FCP::Txn;
431 563
432sub rcv_success { 564sub rcv_success {
433 my ($self, $attr) = @_; 565 my ($self, $attr) = @_;
434 566
435 $self->eof ([$attr->{PublicKey}, $attr->{PrivateKey}]); 567 $self->set_result ([$attr->{PublicKey}, $attr->{PrivateKey}]);
436} 568}
437 569
438package Net::FCP::Txn::InvertPrivateKey; 570package Net::FCP::Txn::InvertPrivateKey;
439 571
440use base Net::FCP::Txn; 572use base Net::FCP::Txn;
441 573
442sub rcv_success { 574sub rcv_success {
443 my ($self, $attr) = @_; 575 my ($self, $attr) = @_;
444 576
445 $self->eof ($attr->{PublicKey}); 577 $self->set_result ($attr->{PublicKey});
446} 578}
447 579
448package Net::FCP::Txn::GetSize; 580package Net::FCP::Txn::GetSize;
449 581
450use base Net::FCP::Txn; 582use base Net::FCP::Txn;
451 583
452sub rcv_success { 584sub rcv_success {
453 my ($self, $attr) = @_; 585 my ($self, $attr) = @_;
454 586
455 $self->eof ($attr->{Length}); 587 $self->set_result ($attr->{Length});
588}
589
590package Net::FCP::Txn::ClientGet;
591
592use base Net::FCP::Txn;
593
594sub rcv_data_found {
595 my ($self, $attr, $type) = @_;
596
597 $self->progress ($type, $attr);
598
599 $self->{datalength} = hex $attr->{data_length};
600 $self->{metalength} = hex $attr->{metadata_length};
601}
602
603sub rcv_route_not_found {
604 my ($self, $attr, $type) = @_;
605
606 $self->throw (new Net::FCP::Exception $type, $attr);
607}
608
609sub rcv_data_not_found {
610 my ($self, $attr, $type) = @_;
611
612 $self->throw (new Net::FCP::Exception $type, $attr);
613}
614
615sub rcv_format_error {
616 my ($self, $attr, $type) = @_;
617
618 $self->throw (new Net::FCP::Exception $type, $attr);
619}
620
621sub rcv_restarted {
622 my ($self, $attr, $type) = @_;
623 $self->progress ($type, $attr);
624}
625
626sub eof {
627 my ($self) = @_;
628
629 my $data = delete $self->{data};
630 my $meta = Net::FCP::parse_metadata substr $data, 0, $self->{metalength}, "";
631
632 $self->set_result ([$meta, $data]);
633}
634
635package Net::FCP::Exception;
636
637use overload
638 '""' => sub {
639 "Net::FCP::Exception<<$_[0][0]," . (join ":", %{$_[0][1]}) . ">>\n";
640 };
641
642sub new {
643 my ($class, $type, $attr) = @_;
644
645 bless [$type, { %$attr }], $class;
456} 646}
457 647
458=back 648=back
459 649
460=head1 SEE ALSO 650=head1 SEE ALSO

Diff Legend

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