| … | |
… | |
| 31 | package Net::FCP; |
31 | package Net::FCP; |
| 32 | |
32 | |
| 33 | use Carp; |
33 | use Carp; |
| 34 | use IO::Socket::INET; |
34 | use IO::Socket::INET; |
| 35 | |
35 | |
| 36 | $VERSION = 0.01; |
36 | $VERSION = 0.04; |
| 37 | |
37 | |
| 38 | sub event_reg_cb { |
38 | sub event_reg_cb { |
| 39 | my ($obj) = @_; |
39 | my ($obj) = @_; |
| 40 | require Event; |
40 | require Event; |
| 41 | |
41 | |
| … | |
… | |
| 72 | local $_ = shift; |
72 | local $_ = shift; |
| 73 | s/(?<=[a-z])(?=[A-Z])/_/g; |
73 | s/(?<=[a-z])(?=[A-Z])/_/g; |
| 74 | lc $_; |
74 | lc $_; |
| 75 | } |
75 | } |
| 76 | |
76 | |
|
|
77 | =item $meta = Net::FCP::parse_metadata $string |
|
|
78 | |
|
|
79 | Parse a metadata string and return it. |
|
|
80 | |
|
|
81 | The metadata will be a hashref with key C<version> (containing |
|
|
82 | the mandatory version header entries). |
|
|
83 | |
|
|
84 | All other headers are represented by arrayrefs (they can be repeated). |
|
|
85 | |
|
|
86 | Since this is confusing, here is a rather verbose example of a parsed |
|
|
87 | manifest: |
|
|
88 | |
|
|
89 | ( |
|
|
90 | version => { revision => 1 }, |
|
|
91 | document => [ |
|
|
92 | { |
|
|
93 | "info.format" => "image/jpeg", |
|
|
94 | name => "background.jpg", |
|
|
95 | "redirect.target" => "freenet:CHK\@ZcagI,ra726bSw" |
|
|
96 | }, |
|
|
97 | { |
|
|
98 | "info.format" => "text/html", |
|
|
99 | name => ".next", |
|
|
100 | "redirect.target" => "freenet:SSK\@ilUPAgM/TFEE/3" |
|
|
101 | }, |
|
|
102 | { |
|
|
103 | "info.format" => "text/html", |
|
|
104 | "redirect.target" => "freenet:CHK\@8M8Po8ucwI,8xA" |
|
|
105 | } |
|
|
106 | ] |
|
|
107 | ) |
|
|
108 | |
|
|
109 | =cut |
|
|
110 | |
|
|
111 | sub parse_metadata { |
|
|
112 | my $meta; |
|
|
113 | |
|
|
114 | my $data = shift; |
|
|
115 | if ($data =~ /^Version\015?\012/gc) { |
|
|
116 | my $hdr = $meta->{version} = {}; |
|
|
117 | |
|
|
118 | for (;;) { |
|
|
119 | while ($data =~ /\G([^=\015\012]+)=([^\015\012]*)\015?\012/gc) { |
|
|
120 | my ($k, $v) = ($1, $2); |
|
|
121 | $hdr->{tolc $k} = $v; |
|
|
122 | } |
|
|
123 | |
|
|
124 | if ($data =~ /\GEndPart\015?\012/gc) { |
|
|
125 | } elsif ($data =~ /\GEnd\015?\012/gc) { |
|
|
126 | last; |
|
|
127 | } elsif ($data =~ /\G([A-Za-z0-9.\-]+)\015?\012/gcs) { |
|
|
128 | push @{$meta->{tolc $1}}, $hdr = {}; |
|
|
129 | } elsif ($data =~ /\G(.*)/gcs) { |
|
|
130 | die "metadata format error ($1)"; |
|
|
131 | } |
|
|
132 | } |
|
|
133 | } |
|
|
134 | |
|
|
135 | #$meta->{tail} = substr $data, pos $data; |
|
|
136 | |
|
|
137 | $meta; |
|
|
138 | } |
|
|
139 | |
| 77 | =item $fcp = new Net::FCP [host => $host][, port => $port] |
140 | =item $fcp = new Net::FCP [host => $host][, port => $port] |
| 78 | |
141 | |
| 79 | Create a new virtual FCP connection to the given host and port (default |
142 | Create a new virtual FCP connection to the given host and port (default |
| 80 | 127.0.0.1:8481). |
143 | 127.0.0.1:8481, or the environment variables C<FREDHOST> and C<FREDPORT>). |
| 81 | |
144 | |
| 82 | Connections are virtual because no persistent physical connection is |
145 | Connections are virtual because no persistent physical connection is |
| 83 | established. However, the existance of the node is checked by executing a |
146 | established. However, the existance of the node is checked by executing a |
| 84 | C<ClientHello> transaction. |
147 | C<ClientHello> transaction. |
| 85 | |
148 | |
| … | |
… | |
| 87 | |
150 | |
| 88 | sub new { |
151 | sub new { |
| 89 | my $class = shift; |
152 | my $class = shift; |
| 90 | my $self = bless { @_ }, $class; |
153 | my $self = bless { @_ }, $class; |
| 91 | |
154 | |
| 92 | $self->{host} ||= "127.0.0.1"; |
155 | $self->{host} ||= $ENV{FREDHOST} || "127.0.0.1"; |
| 93 | $self->{port} ||= 8481; |
156 | $self->{port} ||= $ENV{FREDPORt} || 8481; |
| 94 | |
157 | |
| 95 | $self->{nodehello} = $self->txn("ClientHello")->result |
158 | $self->{nodehello} = $self->client_hello |
| 96 | or croak "unable to get nodehello from node\n"; |
159 | or croak "unable to get nodehello from node\n"; |
| 97 | |
160 | |
| 98 | $self; |
161 | $self; |
| 99 | } |
162 | } |
| 100 | |
163 | |
| … | |
… | |
| 126 | |
189 | |
| 127 | Executes a ClientHello request and returns it's results. |
190 | Executes a ClientHello request and returns it's results. |
| 128 | |
191 | |
| 129 | { |
192 | { |
| 130 | max_file_size => "5f5e100", |
193 | max_file_size => "5f5e100", |
|
|
194 | node => "Fred,0.6,1.46,7050" |
| 131 | protocol => "1.2", |
195 | protocol => "1.2", |
| 132 | node => "Fred,0.6,1.46,7050" |
|
|
| 133 | } |
196 | } |
| 134 | |
197 | |
| 135 | =cut |
198 | =cut |
| 136 | |
199 | |
| 137 | _txn client_hello => sub { |
200 | _txn client_hello => sub { |
| … | |
… | |
| 145 | =item $nodeinfo = $fcp->client_info |
208 | =item $nodeinfo = $fcp->client_info |
| 146 | |
209 | |
| 147 | Executes a ClientInfo request and returns it's results. |
210 | Executes a ClientInfo request and returns it's results. |
| 148 | |
211 | |
| 149 | { |
212 | { |
| 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", |
213 | active_jobs => "1f", |
| 160 | allocated_memory => "bde0000", |
214 | allocated_memory => "bde0000", |
| 161 | architecture => "i386", |
215 | architecture => "i386", |
|
|
216 | available_threads => 17, |
|
|
217 | datastore_free => "5ce03400", |
|
|
218 | datastore_max => "2540be400", |
|
|
219 | datastore_used => "1f72bb000", |
|
|
220 | estimated_load => 52, |
|
|
221 | free_memory => "5cc0148", |
|
|
222 | is_transient => "false", |
|
|
223 | java_name => "Java HotSpot(_T_M) Server VM", |
|
|
224 | java_vendor => "http://www.blackdown.org/", |
|
|
225 | java_version => "Blackdown-1.4.1-01", |
|
|
226 | least_recent_timestamp => "f41538b878", |
|
|
227 | max_file_size => "5f5e100", |
|
|
228 | most_recent_timestamp => "f77e2cc520" |
|
|
229 | node_address => "1.2.3.4", |
|
|
230 | node_port => 369, |
|
|
231 | operating_system => "Linux", |
|
|
232 | operating_system_version => "2.4.20", |
| 162 | routing_time => "a5", |
233 | 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 | } |
234 | } |
| 172 | |
235 | |
| 173 | =cut |
236 | =cut |
| 174 | |
237 | |
| 175 | _txn client_info => sub { |
238 | _txn client_info => sub { |
| … | |
… | |
| 187 | =cut |
250 | =cut |
| 188 | |
251 | |
| 189 | _txn generate_chk => sub { |
252 | _txn generate_chk => sub { |
| 190 | my ($self, $metadata, $data) = @_; |
253 | my ($self, $metadata, $data) = @_; |
| 191 | |
254 | |
| 192 | $self->txn (generate_chk => data => "$data$metadata", meta_data_length => length $metadata); |
255 | $self->txn (generate_chk => data => "$data$metadata", metadata_length => length $metadata); |
| 193 | }; |
256 | }; |
| 194 | |
257 | |
| 195 | =item $txn = $fcp->txn_generate_svk_pair |
258 | =item $txn = $fcp->txn_generate_svk_pair |
| 196 | |
259 | |
| 197 | =item ($public, $private) = @{ $fcp->generate_svk_pair } |
260 | =item ($public, $private) = @{ $fcp->generate_svk_pair } |
| … | |
… | |
| 246 | my ($self, $uri) = @_; |
309 | my ($self, $uri) = @_; |
| 247 | |
310 | |
| 248 | $self->txn (get_size => URI => $uri); |
311 | $self->txn (get_size => URI => $uri); |
| 249 | }; |
312 | }; |
| 250 | |
313 | |
|
|
314 | =item $txn = $fcp->txn_client_get ($uri [, $htl = 15 [, $removelocal = 0]]) |
|
|
315 | |
|
|
316 | =item ($metadata, $data) = @{ $fcp->client_get ($uri, $htl, $removelocal) |
|
|
317 | |
|
|
318 | Fetches a (small, as it should fit into memory) file from |
|
|
319 | freenet. C<$meta> is the metadata (as returned by C<parse_metadata> or |
|
|
320 | C<undef>). |
|
|
321 | |
|
|
322 | Due to the overhead, a better method to download big files should be used. |
|
|
323 | |
|
|
324 | my ($meta, $data) = @{ |
|
|
325 | $fcp->client_get ( |
|
|
326 | "freenet:CHK@hdXaxkwZ9rA8-SidT0AN-bniQlgPAwI,XdCDmBuGsd-ulqbLnZ8v~w" |
|
|
327 | ) |
|
|
328 | }; |
|
|
329 | |
|
|
330 | =cut |
|
|
331 | |
|
|
332 | _txn client_get => sub { |
|
|
333 | my ($self, $uri, $htl, $removelocal) = @_; |
|
|
334 | |
|
|
335 | $self->txn (client_get => URI => $uri, hops_to_live => ($htl || 15), remove_local => $removelocal*1); |
|
|
336 | }; |
|
|
337 | |
| 251 | =item MISSING: ClientGet, ClientPut |
338 | =item MISSING: ClientPut |
| 252 | |
339 | |
| 253 | =back |
340 | =back |
| 254 | |
341 | |
| 255 | =head2 THE Net::FCP::Txn CLASS |
342 | =head2 THE Net::FCP::Txn CLASS |
| 256 | |
343 | |
| … | |
… | |
| 327 | |
414 | |
| 328 | if (sysread $self->{fh}, $self->{buf}, 65536, length $self->{buf}) { |
415 | if (sysread $self->{fh}, $self->{buf}, 65536, length $self->{buf}) { |
| 329 | for (;;) { |
416 | for (;;) { |
| 330 | if ($self->{datalen}) { |
417 | if ($self->{datalen}) { |
| 331 | if (length $self->{buf} >= $self->{datalen}) { |
418 | if (length $self->{buf} >= $self->{datalen}) { |
| 332 | $self->recv_data (substr $self->{buf}, 0, $self->{datalen}, ""); |
419 | $self->rcv_data (substr $self->{buf}, 0, $self->{datalen}, ""); |
| 333 | } else { |
420 | } else { |
| 334 | last; |
421 | last; |
| 335 | } |
422 | } |
| 336 | } elsif ($self->{buf} =~ s/^DataChunk\015?\012Length=(\d+)\015?\012Data\015?\012//) { |
423 | } elsif ($self->{buf} =~ s/^DataChunk\015?\012Length=([0-9a-fA-F]+)\015?\012Data\015?\012//) { |
| 337 | $self->{datalen} = $1; |
424 | $self->{datalen} = hex $1; |
| 338 | } elsif ($self->{buf} =~ s/^([a-zA-Z]+)\015?\012(.*?)\015?\012EndMessage\015?\012//s) { |
425 | } elsif ($self->{buf} =~ s/^([a-zA-Z]+)\015?\012(?:(.+?)\015?\012)?EndMessage\015?\012//s) { |
| 339 | $self->rcv ($1, { |
426 | $self->rcv ($1, { |
| 340 | map { my ($a, $b) = split /=/, $_, 2; ((Net::FCP::tolc $a), $b) } |
427 | map { my ($a, $b) = split /=/, $_, 2; ((Net::FCP::tolc $a), $b) } |
| 341 | split /\015?\012/, $2 |
428 | split /\015?\012/, $2 |
| 342 | }); |
429 | }); |
| 343 | } else { |
430 | } else { |
| … | |
… | |
| 351 | } |
438 | } |
| 352 | } |
439 | } |
| 353 | |
440 | |
| 354 | sub rcv_data { |
441 | sub rcv_data { |
| 355 | my ($self, $chunk) = @_; |
442 | my ($self, $chunk) = @_; |
|
|
443 | |
|
|
444 | $self->{data} .= $chunk; |
| 356 | } |
445 | } |
| 357 | |
446 | |
| 358 | sub rcv { |
447 | sub rcv { |
| 359 | my ($self, $type, $attr) = @_; |
448 | my ($self, $type, $attr) = @_; |
| 360 | |
449 | |
| 361 | $type = Net::FCP::tolc $type; |
450 | $type = Net::FCP::tolc $type; |
|
|
451 | |
|
|
452 | #use PApp::Util; warn PApp::Util::dumpval [$type, $attr]; |
| 362 | |
453 | |
| 363 | if (my $method = $self->can("rcv_$type")) { |
454 | if (my $method = $self->can("rcv_$type")) { |
| 364 | $method->($self, $attr, $type); |
455 | $method->($self, $attr, $type); |
| 365 | } else { |
456 | } else { |
| 366 | warn "received unexpected reply type '$type' for '$self->{type}', ignoring\n"; |
457 | warn "received unexpected reply type '$type' for '$self->{type}', ignoring\n"; |
| 367 | $self->eof; |
|
|
| 368 | } |
458 | } |
|
|
459 | } |
|
|
460 | |
|
|
461 | sub set_result { |
|
|
462 | my ($self, $result) = @_; |
|
|
463 | |
|
|
464 | $self->{result} = $result unless exists $self->{result}; |
| 369 | } |
465 | } |
| 370 | |
466 | |
| 371 | sub eof { |
467 | sub eof { |
| 372 | my ($self, $result) = @_; |
468 | my ($self) = @_; |
| 373 | |
469 | $self->set_result; |
| 374 | $self->{result} = $result unless exists $self->{result}; |
|
|
| 375 | } |
470 | } |
| 376 | |
471 | |
| 377 | =item $result = $txn->result |
472 | =item $result = $txn->result |
| 378 | |
473 | |
| 379 | Waits until a result is available and then returns it. |
474 | Waits until a result is available and then returns it. |
| 380 | |
475 | |
| 381 | This waiting is (depending on your event modul) not very efficient, as it |
476 | This waiting is (depending on your event model) not very efficient, as it |
| 382 | is done outside the "mainloop". |
477 | is done outside the "mainloop". |
| 383 | |
478 | |
| 384 | =cut |
479 | =cut |
| 385 | |
480 | |
| 386 | sub result { |
481 | sub result { |
| … | |
… | |
| 400 | use base Net::FCP::Txn; |
495 | use base Net::FCP::Txn; |
| 401 | |
496 | |
| 402 | sub rcv_node_hello { |
497 | sub rcv_node_hello { |
| 403 | my ($self, $attr) = @_; |
498 | my ($self, $attr) = @_; |
| 404 | |
499 | |
| 405 | $self->eof ($attr); |
500 | $self->set_result ($attr); |
| 406 | } |
501 | } |
| 407 | |
502 | |
| 408 | package Net::FCP::Txn::ClientInfo; |
503 | package Net::FCP::Txn::ClientInfo; |
| 409 | |
504 | |
| 410 | use base Net::FCP::Txn; |
505 | use base Net::FCP::Txn; |
| 411 | |
506 | |
| 412 | sub rcv_node_info { |
507 | sub rcv_node_info { |
| 413 | my ($self, $attr) = @_; |
508 | my ($self, $attr) = @_; |
| 414 | |
509 | |
| 415 | $self->eof ($attr); |
510 | $self->set_result ($attr); |
| 416 | } |
511 | } |
| 417 | |
512 | |
| 418 | package Net::FCP::Txn::GenerateCHK; |
513 | package Net::FCP::Txn::GenerateCHK; |
| 419 | |
514 | |
| 420 | use base Net::FCP::Txn; |
515 | use base Net::FCP::Txn; |
| 421 | |
516 | |
| 422 | sub rcv_success { |
517 | sub rcv_success { |
| 423 | my ($self, $attr) = @_; |
518 | my ($self, $attr) = @_; |
| 424 | |
519 | |
| 425 | $self->eof ($attr); |
520 | $self->set_result ($attr); |
| 426 | } |
521 | } |
| 427 | |
522 | |
| 428 | package Net::FCP::Txn::GenerateSVKPair; |
523 | package Net::FCP::Txn::GenerateSVKPair; |
| 429 | |
524 | |
| 430 | use base Net::FCP::Txn; |
525 | use base Net::FCP::Txn; |
| 431 | |
526 | |
| 432 | sub rcv_success { |
527 | sub rcv_success { |
| 433 | my ($self, $attr) = @_; |
528 | my ($self, $attr) = @_; |
| 434 | |
529 | |
| 435 | $self->eof ([$attr->{PublicKey}, $attr->{PrivateKey}]); |
530 | $self->set_result ([$attr->{PublicKey}, $attr->{PrivateKey}]); |
| 436 | } |
531 | } |
| 437 | |
532 | |
| 438 | package Net::FCP::Txn::InvertPrivateKey; |
533 | package Net::FCP::Txn::InvertPrivateKey; |
| 439 | |
534 | |
| 440 | use base Net::FCP::Txn; |
535 | use base Net::FCP::Txn; |
| 441 | |
536 | |
| 442 | sub rcv_success { |
537 | sub rcv_success { |
| 443 | my ($self, $attr) = @_; |
538 | my ($self, $attr) = @_; |
| 444 | |
539 | |
| 445 | $self->eof ($attr->{PublicKey}); |
540 | $self->set_result ($attr->{PublicKey}); |
| 446 | } |
541 | } |
| 447 | |
542 | |
| 448 | package Net::FCP::Txn::GetSize; |
543 | package Net::FCP::Txn::GetSize; |
| 449 | |
544 | |
| 450 | use base Net::FCP::Txn; |
545 | use base Net::FCP::Txn; |
| 451 | |
546 | |
| 452 | sub rcv_success { |
547 | sub rcv_success { |
| 453 | my ($self, $attr) = @_; |
548 | my ($self, $attr) = @_; |
| 454 | |
549 | |
| 455 | $self->eof ($attr->{Length}); |
550 | $self->set_result ($attr->{Length}); |
|
|
551 | } |
|
|
552 | |
|
|
553 | package Net::FCP::Txn::ClientGet; |
|
|
554 | |
|
|
555 | use base Net::FCP::Txn; |
|
|
556 | |
|
|
557 | sub rcv_data_found { |
|
|
558 | my ($self, $attr) = @_; |
|
|
559 | |
|
|
560 | $self->{datalength} = hex $attr->{data_length}; |
|
|
561 | $self->{metalength} = hex $attr->{metadata_length}; |
|
|
562 | } |
|
|
563 | |
|
|
564 | sub rcv_restarted { |
|
|
565 | # nop, maybe feedback |
|
|
566 | } |
|
|
567 | |
|
|
568 | sub eof { |
|
|
569 | my ($self) = @_; |
|
|
570 | |
|
|
571 | my $data = delete $self->{data}; |
|
|
572 | my $meta = Net::FCP::parse_metadata substr $data, 0, $self->{metalength}, ""; |
|
|
573 | |
|
|
574 | $self->set_result ([$meta, $data]); |
| 456 | } |
575 | } |
| 457 | |
576 | |
| 458 | =back |
577 | =back |
| 459 | |
578 | |
| 460 | =head1 SEE ALSO |
579 | =head1 SEE ALSO |
