… | |
… | |
34 | |
34 | |
35 | The import tag to use is named C<event=xyz>, e.g. C<event=Event>, |
35 | The import tag to use is named C<event=xyz>, e.g. C<event=Event>, |
36 | C<event=Glib> etc. |
36 | C<event=Glib> etc. |
37 | |
37 | |
38 | You should specify the event module to use only in the main program. |
38 | You should specify the event module to use only in the main program. |
|
|
39 | |
|
|
40 | If no event model has been specified, FCP tries to autodetect it on first |
|
|
41 | use (e.g. first transaction), in this order: Coro, Event, Glib, Tk. |
39 | |
42 | |
40 | =head2 FREENET BASICS |
43 | =head2 FREENET BASICS |
41 | |
44 | |
42 | Ok, this section will not explain any freenet basics to you, just some |
45 | Ok, this section will not explain any freenet basics to you, just some |
43 | problems I found that you might want to avoid: |
46 | problems I found that you might want to avoid: |
… | |
… | |
69 | |
72 | |
70 | package Net::FCP; |
73 | package Net::FCP; |
71 | |
74 | |
72 | use Carp; |
75 | use Carp; |
73 | |
76 | |
74 | $VERSION = 0.07; |
77 | $VERSION = 0.6; |
75 | |
78 | |
76 | no warnings; |
79 | no warnings; |
77 | |
80 | |
78 | our $EVENT = Net::FCP::Event::Auto::; |
81 | our $EVENT = Net::FCP::Event::Auto::; |
79 | $EVENT = Net::FCP::Event::Event;#d# |
|
|
80 | |
82 | |
81 | sub import { |
83 | sub import { |
82 | shift; |
84 | shift; |
83 | |
85 | |
84 | for (@_) { |
86 | for (@_) { |
85 | if (/^event=(\w+)$/) { |
87 | if (/^event=(\w+)$/) { |
86 | $EVENT = "Net::FCP::Event::$1"; |
88 | $EVENT = "Net::FCP::Event::$1"; |
|
|
89 | eval "require $EVENT"; |
87 | } |
90 | } |
88 | } |
91 | } |
89 | eval "require $EVENT"; |
|
|
90 | die $@ if $@; |
92 | die $@ if $@; |
91 | } |
93 | } |
92 | |
94 | |
93 | sub touc($) { |
95 | sub touc($) { |
94 | local $_ = shift; |
96 | local $_ = shift; |
… | |
… | |
101 | local $_ = shift; |
103 | local $_ = shift; |
102 | s/(?<=[a-z])(?=[A-Z])/_/g; |
104 | s/(?<=[a-z])(?=[A-Z])/_/g; |
103 | lc $_; |
105 | lc $_; |
104 | } |
106 | } |
105 | |
107 | |
|
|
108 | # the opposite of hex |
|
|
109 | sub xeh($) { |
|
|
110 | sprintf "%x", $_[0]; |
|
|
111 | } |
|
|
112 | |
106 | =item $meta = Net::FCP::parse_metadata $string |
113 | =item $meta = Net::FCP::parse_metadata $string |
107 | |
114 | |
108 | Parse a metadata string and return it. |
115 | Parse a metadata string and return it. |
109 | |
116 | |
110 | The metadata will be a hashref with key C<version> (containing |
117 | The metadata will be a hashref with key C<version> (containing the |
111 | the mandatory version header entries). |
118 | mandatory version header entries) and key C<raw> containing the original |
|
|
119 | metadata string. |
112 | |
120 | |
113 | All other headers are represented by arrayrefs (they can be repeated). |
121 | All other headers are represented by arrayrefs (they can be repeated). |
114 | |
122 | |
115 | Since this is confusing, here is a rather verbose example of a parsed |
123 | Since this description is confusing, here is a rather verbose example of a |
116 | manifest: |
124 | parsed manifest: |
117 | |
125 | |
118 | ( |
126 | ( |
|
|
127 | raw => "Version...", |
119 | version => { revision => 1 }, |
128 | version => { revision => 1 }, |
120 | document => [ |
129 | document => [ |
121 | { |
130 | { |
122 | info => { format" => "image/jpeg" }, |
131 | info => { format" => "image/jpeg" }, |
123 | name => "background.jpg", |
132 | name => "background.jpg", |
… | |
… | |
136 | ) |
145 | ) |
137 | |
146 | |
138 | =cut |
147 | =cut |
139 | |
148 | |
140 | sub parse_metadata { |
149 | sub parse_metadata { |
141 | my $meta; |
|
|
142 | |
|
|
143 | my $data = shift; |
150 | my $data = shift; |
|
|
151 | my $meta = { raw => $data }; |
|
|
152 | |
144 | if ($data =~ /^Version\015?\012/gc) { |
153 | if ($data =~ /^Version\015?\012/gc) { |
145 | my $hdr = $meta->{version} = {}; |
154 | my $hdr = $meta->{version} = {}; |
146 | |
155 | |
147 | for (;;) { |
156 | for (;;) { |
148 | while ($data =~ /\G([^=\015\012]+)=([^\015\012]*)\015?\012/gc) { |
157 | while ($data =~ /\G([^=\015\012]+)=([^\015\012]*)\015?\012/gc) { |
… | |
… | |
160 | } elsif ($data =~ /\GEnd(\015?\012|$)/gc) { |
169 | } elsif ($data =~ /\GEnd(\015?\012|$)/gc) { |
161 | last; |
170 | last; |
162 | } elsif ($data =~ /\G([A-Za-z0-9.\-]+)\015?\012/gcs) { |
171 | } elsif ($data =~ /\G([A-Za-z0-9.\-]+)\015?\012/gcs) { |
163 | push @{$meta->{tolc $1}}, $hdr = {}; |
172 | push @{$meta->{tolc $1}}, $hdr = {}; |
164 | } elsif ($data =~ /\G(.*)/gcs) { |
173 | } elsif ($data =~ /\G(.*)/gcs) { |
165 | die "metadata format error ($1), please report this string: <<$data>>"; |
174 | print STDERR "metadata format error ($1), please report this string: <<$data>>"; |
|
|
175 | die "metadata format error"; |
166 | } |
176 | } |
167 | } |
177 | } |
168 | } |
178 | } |
169 | |
179 | |
170 | #$meta->{tail} = substr $data, pos $data; |
180 | #$meta->{tail} = substr $data, pos $data; |
… | |
… | |
202 | $self; |
212 | $self; |
203 | } |
213 | } |
204 | |
214 | |
205 | sub progress { |
215 | sub progress { |
206 | my ($self, $txn, $type, $attr) = @_; |
216 | my ($self, $txn, $type, $attr) = @_; |
207 | warn "progress<$txn,$type," . (join ":", %$attr) . ">\n"; |
217 | #warn "progress<$txn,$type," . (join ":", %$attr) . ">\n"; |
208 | } |
218 | } |
209 | |
219 | |
210 | =item $txn = $fcp->txn(type => attr => val,...) |
220 | =item $txn = $fcp->txn(type => attr => val,...) |
211 | |
221 | |
212 | The low-level interface to transactions. Don't use it. |
222 | The low-level interface to transactions. Don't use it. |
… | |
… | |
309 | my ($self) = @_; |
319 | my ($self) = @_; |
310 | |
320 | |
311 | $self->txn ("client_info"); |
321 | $self->txn ("client_info"); |
312 | }); |
322 | }); |
313 | |
323 | |
314 | =item $txn = $fcp->txn_generate_chk ($metadata, $data) |
324 | =item $txn = $fcp->txn_generate_chk ($metadata, $data[, $cipher]) |
315 | |
325 | |
316 | =item $uri = $fcp->generate_chk ($metadata, $data) |
326 | =item $uri = $fcp->generate_chk ($metadata, $data[, $cipher]) |
317 | |
327 | |
318 | Creates a new CHK, given the metadata and data. UNTESTED. |
328 | Calculcates a CHK, given the metadata and data. C<$cipher> is either |
|
|
329 | C<Rijndael> or C<Twofish>, with the latter being the default. |
319 | |
330 | |
320 | =cut |
331 | =cut |
321 | |
332 | |
322 | $txn->(generate_chk => sub { |
333 | $txn->(generate_chk => sub { |
323 | my ($self, $metadata, $data) = @_; |
334 | my ($self, $metadata, $data, $cipher) = @_; |
324 | |
335 | |
325 | $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"); |
326 | }); |
340 | }); |
327 | |
341 | |
328 | =item $txn = $fcp->txn_generate_svk_pair |
342 | =item $txn = $fcp->txn_generate_svk_pair |
329 | |
343 | |
330 | =item ($public, $private) = @{ $fcp->generate_svk_pair } |
344 | =item ($public, $private) = @{ $fcp->generate_svk_pair } |
… | |
… | |
400 | =cut |
414 | =cut |
401 | |
415 | |
402 | $txn->(client_get => sub { |
416 | $txn->(client_get => sub { |
403 | my ($self, $uri, $htl, $removelocal) = @_; |
417 | my ($self, $uri, $htl, $removelocal) = @_; |
404 | |
418 | |
405 | $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), |
406 | remove_local_key => $removelocal ? "true" : "false"); |
420 | remove_local_key => $removelocal ? "true" : "false"); |
407 | }); |
421 | }); |
408 | |
422 | |
409 | =item $txn = $fcp->txn_client_put ($uri, $metadata, $data, $htl, $removelocal) |
423 | =item $txn = $fcp->txn_client_put ($uri, $metadata, $data, $htl, $removelocal) |
410 | |
424 | |
… | |
… | |
421 | =cut |
435 | =cut |
422 | |
436 | |
423 | $txn->(client_put => sub { |
437 | $txn->(client_put => sub { |
424 | my ($self, $uri, $meta, $data, $htl, $removelocal) = @_; |
438 | my ($self, $uri, $meta, $data, $htl, $removelocal) = @_; |
425 | |
439 | |
426 | $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), |
427 | remove_local_key => $removelocal ? "true" : "false", |
441 | remove_local_key => $removelocal ? "true" : "false", |
428 | data => "$meta$data", metadata_length => length $meta); |
442 | data => "$meta$data", metadata_length => xeh length $meta); |
429 | }); |
443 | }); |
430 | |
444 | |
431 | } # transactions |
445 | } # transactions |
432 | |
446 | |
433 | =item MISSING: (ClientPut), InsretKey |
447 | =item MISSING: (ClientPut), InsertKey |
434 | |
448 | |
435 | =back |
449 | =back |
436 | |
450 | |
437 | =head2 THE Net::FCP::Txn CLASS |
451 | =head2 THE Net::FCP::Txn CLASS |
438 | |
452 | |
439 | All requests (or transactions) are executed in a asynchroneous way (LIE: |
453 | All requests (or transactions) are executed in a asynchronous way. For |
440 | uploads are blocking). For each request, a C<Net::FCP::Txn> object is |
454 | each request, a C<Net::FCP::Txn> object is created (worse: a tcp |
441 | created (worse: a tcp connection is created, too). |
455 | connection is created, too). |
442 | |
456 | |
443 | For each request there is actually a different subclass (and it's possible |
457 | For each request there is actually a different subclass (and it's possible |
444 | to subclass these, although of course not documented). |
458 | to subclass these, although of course not documented). |
445 | |
459 | |
446 | The most interesting method is C<result>. |
460 | The most interesting method is C<result>. |
… | |
… | |
474 | while (my ($k, $v) = each %{$self->{attr}}) { |
488 | while (my ($k, $v) = each %{$self->{attr}}) { |
475 | $attr .= (Net::FCP::touc $k) . "=$v\012" |
489 | $attr .= (Net::FCP::touc $k) . "=$v\012" |
476 | } |
490 | } |
477 | |
491 | |
478 | if (defined $data) { |
492 | if (defined $data) { |
479 | $attr .= "DataLength=" . (length $data) . "\012"; |
493 | $attr .= sprintf "DataLength=%x\012", length $data; |
480 | $data = "Data\012$data"; |
494 | $data = "Data\012$data"; |
481 | } else { |
495 | } else { |
482 | $data = "EndMessage\012"; |
496 | $data = "EndMessage\012"; |
483 | } |
497 | } |
484 | |
498 | |
… | |
… | |
491 | and !$!{EINPROGRESS} |
505 | and !$!{EINPROGRESS} |
492 | 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"; |
493 | |
507 | |
494 | $self->{sbuf} = |
508 | $self->{sbuf} = |
495 | "\x00\x00\x00\x02" |
509 | "\x00\x00\x00\x02" |
496 | . Net::FCP::touc $self->{type} |
510 | . (Net::FCP::touc $self->{type}) |
497 | . "\012$attr$data"; |
511 | . "\012$attr$data"; |
498 | |
512 | |
499 | #$fh->shutdown (1); # freenet buggy?, well, it's java... |
513 | #shutdown $fh, 1; # freenet buggy?, well, it's java... |
500 | |
514 | |
501 | $self->{fh} = $fh; |
515 | $self->{fh} = $fh; |
502 | |
516 | |
503 | $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); |
504 | |
518 | |
… | |
… | |
671 | =item $result = $txn->result |
685 | =item $result = $txn->result |
672 | |
686 | |
673 | Waits until a result is available and then returns it. |
687 | Waits until a result is available and then returns it. |
674 | |
688 | |
675 | This waiting is (depending on your event model) not very efficient, as it |
689 | This waiting is (depending on your event model) not very efficient, as it |
676 | is done outside the "mainloop". |
690 | is done outside the "mainloop". The biggest problem, however, is that it's |
|
|
691 | blocking one thread of execution. Try to use the callback mechanism, if |
|
|
692 | possible, and call result from within the callback (or after is has been |
|
|
693 | run), as then no waiting is necessary. |
677 | |
694 | |
678 | =cut |
695 | =cut |
679 | |
696 | |
680 | sub result { |
697 | sub result { |
681 | my ($self) = @_; |
698 | my ($self) = @_; |
… | |
… | |
712 | use base Net::FCP::Txn; |
729 | use base Net::FCP::Txn; |
713 | |
730 | |
714 | sub rcv_success { |
731 | sub rcv_success { |
715 | my ($self, $attr) = @_; |
732 | my ($self, $attr) = @_; |
716 | |
733 | |
717 | $self->set_result ($attr); |
734 | $self->set_result ($attr->{uri}); |
718 | } |
735 | } |
719 | |
736 | |
720 | package Net::FCP::Txn::GenerateSVKPair; |
737 | package Net::FCP::Txn::GenerateSVKPair; |
721 | |
738 | |
722 | use base Net::FCP::Txn; |
739 | use base Net::FCP::Txn; |
… | |
… | |
739 | |
756 | |
740 | use base Net::FCP::Txn; |
757 | use base Net::FCP::Txn; |
741 | |
758 | |
742 | sub rcv_success { |
759 | sub rcv_success { |
743 | my ($self, $attr) = @_; |
760 | my ($self, $attr) = @_; |
744 | $self->set_result ($attr->{Length}); |
761 | $self->set_result (hex $attr->{Length}); |
745 | } |
762 | } |
746 | |
763 | |
747 | package Net::FCP::Txn::GetPut; |
764 | package Net::FCP::Txn::GetPut; |
748 | |
765 | |
749 | # base class for get and put |
766 | # base class for get and put |
… | |
… | |
772 | sub rcv_data { |
789 | sub rcv_data { |
773 | my ($self, $chunk) = @_; |
790 | my ($self, $chunk) = @_; |
774 | |
791 | |
775 | $self->{data} .= $chunk; |
792 | $self->{data} .= $chunk; |
776 | |
793 | |
777 | $self->progress ("data", { chunk => length $chunk, total => length $self->{data}, end => $self->{datalength} }); |
794 | $self->progress ("data", { chunk => length $chunk, received => length $self->{data}, total => $self->{datalength} }); |
778 | |
795 | |
779 | if ($self->{datalength} == length $self->{data}) { |
796 | if ($self->{datalength} == length $self->{data}) { |
780 | my $data = delete $self->{data}; |
797 | my $data = delete $self->{data}; |
781 | my $meta = Net::FCP::parse_metadata substr $data, 0, $self->{metalength}, ""; |
798 | my $meta = Net::FCP::parse_metadata substr $data, 0, $self->{metalength}, ""; |
782 | |
799 | |
783 | $self->set_result ([$meta, $data]); |
800 | $self->set_result ([$meta, $data]); |
|
|
801 | $self->eof; |
784 | } |
802 | } |
785 | } |
803 | } |
786 | |
804 | |
787 | sub rcv_data_found { |
805 | sub rcv_data_found { |
788 | my ($self, $attr, $type) = @_; |
806 | my ($self, $attr, $type) = @_; |
… | |
… | |
826 | |
844 | |
827 | package Net::FCP::Exception; |
845 | package Net::FCP::Exception; |
828 | |
846 | |
829 | use overload |
847 | use overload |
830 | '""' => sub { |
848 | '""' => sub { |
831 | "Net::FCP::Exception<<$_[0][0]," . (join ":", %{$_[0][1]}) . ">>\n"; |
849 | "Net::FCP::Exception<<$_[0][0]," . (join ":", %{$_[0][1]}) . ">>"; |
832 | }; |
850 | }; |
833 | |
851 | |
834 | =item $exc = new Net::FCP::Exception $type, \%attr |
852 | =item $exc = new Net::FCP::Exception $type, \%attr |
835 | |
853 | |
836 | Create a new exception object of the given type (a string like |
854 | Create a new exception object of the given type (a string like |
… | |
… | |
888 | Marc Lehmann <pcg@goof.com> |
906 | Marc Lehmann <pcg@goof.com> |
889 | http://www.goof.com/pcg/marc/ |
907 | http://www.goof.com/pcg/marc/ |
890 | |
908 | |
891 | =cut |
909 | =cut |
892 | |
910 | |
|
|
911 | package Net::FCP::Event::Auto; |
|
|
912 | |
|
|
913 | my @models = ( |
|
|
914 | [Coro => Coro::Event:: ], |
|
|
915 | [Event => Event::], |
|
|
916 | [Glib => Glib:: ], |
|
|
917 | [Tk => Tk::], |
|
|
918 | ); |
|
|
919 | |
|
|
920 | sub AUTOLOAD { |
|
|
921 | $AUTOLOAD =~ s/.*://; |
|
|
922 | |
|
|
923 | for (@models) { |
|
|
924 | my ($model, $package) = @$_; |
|
|
925 | if (defined ${"$package\::VERSION"}) { |
|
|
926 | $EVENT = "Net::FCP::Event::$model"; |
|
|
927 | eval "require $EVENT"; die if $@; |
|
|
928 | goto &{"$EVENT\::$AUTOLOAD"}; |
|
|
929 | } |
|
|
930 | } |
|
|
931 | |
|
|
932 | for (@models) { |
|
|
933 | my ($model, $package) = @$_; |
|
|
934 | $EVENT = "Net::FCP::Event::$model"; |
|
|
935 | if (eval "require $EVENT") { |
|
|
936 | goto &{"$EVENT\::$AUTOLOAD"}; |
|
|
937 | } |
|
|
938 | } |
|
|
939 | |
|
|
940 | die "No event module selected for Net::FCP and autodetect failed. Install any of these: Coro, Event, Glib or Tk."; |
|
|
941 | } |
|
|
942 | |
893 | 1; |
943 | 1; |
894 | |
944 | |