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

Diff Legend

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