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.20 by root, Mon Sep 15 00:05:32 2003 UTC vs.
Revision 1.23 by root, Wed Sep 17 08:57:32 2003 UTC

… …
72 72
73package Net::FCP; 73package Net::FCP;
74 74
75use Carp; 75use Carp;
76 76
77$VERSION = 0.08; 77$VERSION = 0.5;
78 78
79no warnings; 79no warnings;
80 80
81our $EVENT = Net::FCP::Event::Auto::; 81our $EVENT = Net::FCP::Event::Auto::;
82 82
… …
103 local $_ = shift; 103 local $_ = shift;
104 s/(?<=[a-z])(?=[A-Z])/_/g; 104 s/(?<=[a-z])(?=[A-Z])/_/g;
105 lc $_; 105 lc $_;
106} 106}
107 107
108# the opposite of hex
109sub xeh($) {
110 sprintf "%x", $_[0];
111}
112
108=item $meta = Net::FCP::parse_metadata $string 113=item $meta = Net::FCP::parse_metadata $string
109 114
110Parse a metadata string and return it. 115Parse a metadata string and return it.
111 116
112The metadata will be a hashref with key C<version> (containing 117The metadata will be a hashref with key C<version> (containing the
113the mandatory version header entries). 118mandatory version header entries) and key C<raw> containing the original
119metadata string.
114 120
115All other headers are represented by arrayrefs (they can be repeated). 121All other headers are represented by arrayrefs (they can be repeated).
116 122
117Since this is confusing, here is a rather verbose example of a parsed 123Since this description is confusing, here is a rather verbose example of a
118manifest: 124parsed manifest:
119 125
120 ( 126 (
127 raw => "Version...",
121 version => { revision => 1 }, 128 version => { revision => 1 },
122 document => [ 129 document => [
123 { 130 {
124 info => { format" => "image/jpeg" }, 131 info => { format" => "image/jpeg" },
125 name => "background.jpg", 132 name => "background.jpg",
… …
138 ) 145 )
139 146
140=cut 147=cut
141 148
142sub parse_metadata { 149sub parse_metadata {
143 my $meta;
144
145 my $data = shift; 150 my $data = shift;
151 my $meta = { raw => $data };
152
146 if ($data =~ /^Version\015?\012/gc) { 153 if ($data =~ /^Version\015?\012/gc) {
147 my $hdr = $meta->{version} = {}; 154 my $hdr = $meta->{version} = {};
148 155
149 for (;;) { 156 for (;;) {
150 while ($data =~ /\G([^=\015\012]+)=([^\015\012]*)\015?\012/gc) { 157 while ($data =~ /\G([^=\015\012]+)=([^\015\012]*)\015?\012/gc) {
… …
312 my ($self) = @_; 319 my ($self) = @_;
313 320
314 $self->txn ("client_info"); 321 $self->txn ("client_info");
315}); 322});
316 323
317=item $txn = $fcp->txn_generate_chk ($metadata, $data) 324=item $txn = $fcp->txn_generate_chk ($metadata, $data[, $cipher])
318 325
319=item $uri = $fcp->generate_chk ($metadata, $data) 326=item $uri = $fcp->generate_chk ($metadata, $data[, $cipher])
320 327
321Creates a new CHK, given the metadata and data. UNTESTED. 328Calculcates a CHK, given the metadata and data. C<$cipher> is either
329C<Rijndael> or C<Twofish>, with the latter being the default.
322 330
323=cut 331=cut
324 332
325$txn->(generate_chk => sub { 333$txn->(generate_chk => sub {
326 my ($self, $metadata, $data) = @_; 334 my ($self, $metadata, $data, $cipher) = @_;
327 335
328 $self->txn (generate_chk => data => "$metadata$data", metadata_length => length $metadata); 336 $self->txn (generate_chk =>
337 data => "$metadata$data",
338 metadata_length => xeh length $metadata,
339 cipher => $cipher || "Twofish");
329}); 340});
330 341
331=item $txn = $fcp->txn_generate_svk_pair 342=item $txn = $fcp->txn_generate_svk_pair
332 343
333=item ($public, $private) = @{ $fcp->generate_svk_pair } 344=item ($public, $private) = @{ $fcp->generate_svk_pair }
… …
403=cut 414=cut
404 415
405$txn->(client_get => sub { 416$txn->(client_get => sub {
406 my ($self, $uri, $htl, $removelocal) = @_; 417 my ($self, $uri, $htl, $removelocal) = @_;
407 418
408 $self->txn (client_get => URI => $uri, hops_to_live => (defined $htl ? $htl :15), 419 $self->txn (client_get => URI => $uri, hops_to_live => xeh (defined $htl ? $htl : 15),
409 remove_local_key => $removelocal ? "true" : "false"); 420 remove_local_key => $removelocal ? "true" : "false");
410}); 421});
411 422
412=item $txn = $fcp->txn_client_put ($uri, $metadata, $data, $htl, $removelocal) 423=item $txn = $fcp->txn_client_put ($uri, $metadata, $data, $htl, $removelocal)
413 424
… …
424=cut 435=cut
425 436
426$txn->(client_put => sub { 437$txn->(client_put => sub {
427 my ($self, $uri, $meta, $data, $htl, $removelocal) = @_; 438 my ($self, $uri, $meta, $data, $htl, $removelocal) = @_;
428 439
429 $self->txn (client_put => URI => $uri, hops_to_live => (defined $htl ? $htl :15), 440 $self->txn (client_put => URI => $uri, xeh (defined $htl ? $htl : 15),
430 remove_local_key => $removelocal ? "true" : "false", 441 remove_local_key => $removelocal ? "true" : "false",
431 data => "$meta$data", metadata_length => length $meta); 442 data => "$meta$data", metadata_length => xeh length $meta);
432}); 443});
433 444
434} # transactions 445} # transactions
435 446
436=item MISSING: (ClientPut), InsretKey 447=item MISSING: (ClientPut), InsertKey
437 448
438=back 449=back
439 450
440=head2 THE Net::FCP::Txn CLASS 451=head2 THE Net::FCP::Txn CLASS
441 452
442All requests (or transactions) are executed in a asynchroneous way (LIE: 453All requests (or transactions) are executed in a asynchronous way. For
443uploads are blocking). For each request, a C<Net::FCP::Txn> object is 454each request, a C<Net::FCP::Txn> object is created (worse: a tcp
444created (worse: a tcp connection is created, too). 455connection is created, too).
445 456
446For each request there is actually a different subclass (and it's possible 457For each request there is actually a different subclass (and it's possible
447to subclass these, although of course not documented). 458to subclass these, although of course not documented).
448 459
449The most interesting method is C<result>. 460The most interesting method is C<result>.
… …
477 while (my ($k, $v) = each %{$self->{attr}}) { 488 while (my ($k, $v) = each %{$self->{attr}}) {
478 $attr .= (Net::FCP::touc $k) . "=$v\012" 489 $attr .= (Net::FCP::touc $k) . "=$v\012"
479 } 490 }
480 491
481 if (defined $data) { 492 if (defined $data) {
482 $attr .= "DataLength=" . (length $data) . "\012"; 493 $attr .= sprintf "DataLength=%x\012", length $data;
483 $data = "Data\012$data"; 494 $data = "Data\012$data";
484 } else { 495 } else {
485 $data = "EndMessage\012"; 496 $data = "EndMessage\012";
486 } 497 }
487 498
… …
494 and !$!{EINPROGRESS} 505 and !$!{EINPROGRESS}
495 and Carp::croak "FCP::txn: unable to connect to $self->{fcp}{host}:$self->{fcp}{port}: $!\n"; 506 and Carp::croak "FCP::txn: unable to connect to $self->{fcp}{host}:$self->{fcp}{port}: $!\n";
496 507
497 $self->{sbuf} = 508 $self->{sbuf} =
498 "\x00\x00\x00\x02" 509 "\x00\x00\x00\x02"
499 . Net::FCP::touc $self->{type} 510 . (Net::FCP::touc $self->{type})
500 . "\012$attr$data"; 511 . "\012$attr$data";
501 512
502 #$fh->shutdown (1); # freenet buggy?, well, it's java... 513 #shutdown $fh, 1; # freenet buggy?, well, it's java...
503 514
504 $self->{fh} = $fh; 515 $self->{fh} = $fh;
505 516
506 $self->{w} = $EVENT->new_from_fh ($fh)->cb(sub { $self->fh_ready_w })->poll(0, 1, 1); 517 $self->{w} = $EVENT->new_from_fh ($fh)->cb(sub { $self->fh_ready_w })->poll(0, 1, 1);
507 518
… …
674=item $result = $txn->result 685=item $result = $txn->result
675 686
676Waits until a result is available and then returns it. 687Waits until a result is available and then returns it.
677 688
678This waiting is (depending on your event model) not very efficient, as it 689This waiting is (depending on your event model) not very efficient, as it
679is done outside the "mainloop". 690is done outside the "mainloop". The biggest problem, however, is that it's
691blocking one thread of execution. Try to use the callback mechanism, if
692possible, and call result from within the callback (or after is has been
693run), as then no waiting is necessary.
680 694
681=cut 695=cut
682 696
683sub result { 697sub result {
684 my ($self) = @_; 698 my ($self) = @_;
… …
715use base Net::FCP::Txn; 729use base Net::FCP::Txn;
716 730
717sub rcv_success { 731sub rcv_success {
718 my ($self, $attr) = @_; 732 my ($self, $attr) = @_;
719 733
720 $self->set_result ($attr); 734 $self->set_result ($attr->{uri});
721} 735}
722 736
723package Net::FCP::Txn::GenerateSVKPair; 737package Net::FCP::Txn::GenerateSVKPair;
724 738
725use base Net::FCP::Txn; 739use base Net::FCP::Txn;
… …
742 756
743use base Net::FCP::Txn; 757use base Net::FCP::Txn;
744 758
745sub rcv_success { 759sub rcv_success {
746 my ($self, $attr) = @_; 760 my ($self, $attr) = @_;
747 $self->set_result ($attr->{Length}); 761 $self->set_result (hex $attr->{Length});
748} 762}
749 763
750package Net::FCP::Txn::GetPut; 764package Net::FCP::Txn::GetPut;
751 765
752# base class for get and put 766# base class for get and put
… …
782 if ($self->{datalength} == length $self->{data}) { 796 if ($self->{datalength} == length $self->{data}) {
783 my $data = delete $self->{data}; 797 my $data = delete $self->{data};
784 my $meta = Net::FCP::parse_metadata substr $data, 0, $self->{metalength}, ""; 798 my $meta = Net::FCP::parse_metadata substr $data, 0, $self->{metalength}, "";
785 799
786 $self->set_result ([$meta, $data]); 800 $self->set_result ([$meta, $data]);
801 $self->eof;
787 } 802 }
788} 803}
789 804
790sub rcv_data_found { 805sub rcv_data_found {
791 my ($self, $attr, $type) = @_; 806 my ($self, $attr, $type) = @_;
… …
829 844
830package Net::FCP::Exception; 845package Net::FCP::Exception;
831 846
832use overload 847use overload
833 '""' => sub { 848 '""' => sub {
834 "Net::FCP::Exception<<$_[0][0]," . (join ":", %{$_[0][1]}) . ">>\n"; 849 "Net::FCP::Exception<<$_[0][0]," . (join ":", %{$_[0][1]}) . ">>";
835 }; 850 };
836 851
837=item $exc = new Net::FCP::Exception $type, \%attr 852=item $exc = new Net::FCP::Exception $type, \%attr
838 853
839Create a new exception object of the given type (a string like 854Create a new exception object of the given type (a string like

Diff Legend

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