ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/cvsroot/Net-FCP/FCP.pm
(Generate patch)

Comparing cvsroot/Net-FCP/FCP.pm (file contents):
Revision 1.29 by root, Thu May 13 21:43:16 2004 UTC vs.
Revision 1.39 by root, Tue Nov 28 15:18:17 2006 UTC

… …
13 13
14=head1 DESCRIPTION 14=head1 DESCRIPTION
15 15
16See L<http://freenet.sourceforge.net/index.php?page=fcp> for a description 16See L<http://freenet.sourceforge.net/index.php?page=fcp> for a description
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
19The module uses L<AnyEvent> to find a suitable Event module.
18 20
19=head1 WARNING 21=head1 WARNING
20 22
21This module is alpha. While it probably won't destroy (much :) of your 23This module is alpha. While it probably won't destroy (much :) of your
22data, it currently falls short of what it should provide (intelligent uri 24data, it currently falls short of what it should provide (intelligent uri
23following, splitfile downloads, healing...) 25following, splitfile downloads, healing...)
24 26
25=head2 IMPORT TAGS 27=head2 IMPORT TAGS
26 28
27Nothing much can be "imported" from this module right now. There are, 29Nothing much can be "imported" from this module right now.
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.
39
40If no event model has been specified, FCP tries to autodetect it on first
41use (e.g. first transaction), in this order: Coro, Event, Glib, Tk.
42 30
43=head2 FREENET BASICS 31=head2 FREENET BASICS
44 32
45Ok, this section will not explain any freenet basics to you, just some 33Ok, this section will not explain any freenet basics to you, just some
46problems I found that you might want to avoid: 34problems I found that you might want to avoid:
… …
72 60
73package Net::FCP; 61package Net::FCP;
74 62
75use Carp; 63use Carp;
76 64
77$VERSION = 0.6; 65$VERSION = '1.0';
78 66
79no warnings; 67no warnings;
80 68
81our $EVENT = Net::FCP::Event::Auto::; 69use AnyEvent;
82 70
83sub import { 71use Net::FCP::Metadata;
84 shift; 72use Net::FCP::Util qw(tolc touc xeh);
85
86 for (@_) {
87 if (/^event=(\w+)$/) {
88 $EVENT = "Net::FCP::Event::$1";
89 eval "require $EVENT";
90 }
91 }
92 die $@ if $@;
93}
94
95sub touc($) {
96 local $_ = shift;
97 1 while s/((?:^|_)(?:svk|chk|uri)(?:_|$))/\U$1/;
98 s/(?:^|_)(.)/\U$1/g;
99 $_;
100}
101
102sub tolc($) {
103 local $_ = shift;
104 1 while s/(SVK|CHK|URI)([^_])/$1\_$2/i;
105 1 while s/([^_])(SVK|CHK|URI)/$1\_$2/i;
106 s/(?<=[a-z])(?=[A-Z])/_/g;
107 lc $_;
108}
109
110# the opposite of hex
111sub xeh($) {
112 sprintf "%x", $_[0];
113}
114
115=item $meta = Net::FCP::parse_metadata $string
116
117Parse a metadata string and return it.
118
119The metadata will be a hashref with key C<version> (containing the
120mandatory version header entries) and key C<raw> containing the original
121metadata string.
122
123All other headers are represented by arrayrefs (they can be repeated).
124
125Since this description is confusing, here is a rather verbose example of a
126parsed manifest:
127
128 (
129 raw => "Version...",
130 version => { revision => 1 },
131 document => [
132 {
133 info => { format" => "image/jpeg" },
134 name => "background.jpg",
135 redirect => { target => "freenet:CHK\@ZcagI,ra726bSw" },
136 },
137 {
138 info => { format" => "text/html" },
139 name => ".next",
140 redirect => { target => "freenet:SSK\@ilUPAgM/TFEE/3" },
141 },
142 {
143 info => { format" => "text/html" },
144 redirect => { target => "freenet:CHK\@8M8Po8ucwI,8xA" },
145 }
146 ]
147 )
148
149=cut
150
151sub parse_metadata {
152 my $data = shift;
153 my $meta = { raw => $data };
154
155 if ($data =~ /^Version\015?\012/gc) {
156 my $hdr = $meta->{version} = {};
157
158 for (;;) {
159 while ($data =~ /\G([^=\015\012]+)=([^\015\012]*)\015?\012/gc) {
160 my ($k, $v) = ($1, $2);
161 my @p = split /\./, tolc $k, 3;
162
163 $hdr->{$p[0]} = $v if @p == 1; # lamest code I ever wrote
164 $hdr->{$p[0]}{$p[1]} = $v if @p == 2;
165 $hdr->{$p[0]}{$p[1]}{$p[2]} = $v if @p == 3;
166 die "FATAL: 4+ dot metadata" if @p >= 4;
167 }
168
169 if ($data =~ /\GEndPart\015?\012/gc) {
170 # nop
171 } elsif ($data =~ /\GEnd(\015?\012|$)/gc) {
172 last;
173 } elsif ($data =~ /\G([A-Za-z0-9.\-]+)\015?\012/gcs) {
174 push @{$meta->{tolc $1}}, $hdr = {};
175 } elsif ($data =~ /\G(.*)/gcs) {
176 print STDERR "metadata format error ($1), please report this string: <<$data>>";
177 die "metadata format error";
178 }
179 }
180 }
181
182 #$meta->{tail} = substr $data, pos $data;
183
184 $meta;
185}
186
187=item $string = Net::FCP::build_metadata $meta
188
189Takes a hash reference as returned by C<Net::FCP::parse_metadata> and
190returns the corresponding string form. If a string is given, it's returned
191as is.
192
193=cut
194
195sub build_metadata_subhash($$$) {
196 my ($prefix, $level, $hash) = @_;
197
198 join "",
199 map
200 ref $hash->{$_} ? build_metadata_subhash ($prefix . (Net::FCP::touc $_) . ".", $level + 1, $hash->{$_})
201 : $prefix . ($level > 1 ? $_ : Net::FCP::touc $_) . "=" . $hash->{$_} . "\n",
202 keys %$hash;
203}
204
205sub build_metadata_hash($$) {
206 my ($header, $hash) = @_;
207
208 if (ref $hash eq ARRAY::) {
209 join "", map build_metadata_hash ($header, $_), @$hash
210 } else {
211 (Net::FCP::touc $header) . "\n"
212 . (build_metadata_subhash "", 0, $hash)
213 . "EndPart\n";
214 }
215}
216
217sub build_metadata($) {
218 my ($meta) = @_;
219
220 return $meta unless ref $meta;
221
222 $meta = { %$meta };
223
224 delete $meta->{raw};
225
226 my $res =
227 (build_metadata_hash version => delete $meta->{version})
228 . (join "", map +(build_metadata_hash $_, $meta->{$_}), keys %$meta);
229
230 substr $res, 0, -5; # get rid of "Part". Broken Syntax....
231}
232
233 73
234=item $fcp = new Net::FCP [host => $host][, port => $port][, progress => \&cb] 74=item $fcp = new Net::FCP [host => $host][, port => $port][, progress => \&cb]
235 75
236Create a new virtual FCP connection to the given host and port (default 76Create a new virtual FCP connection to the given host and port (default
237127.0.0.1:8481, or the environment variables C<FREDHOST> and C<FREDPORT>). 77127.0.0.1:8481, or the environment variables C<FREDHOST> and C<FREDPORT>).
… …
247 my ($self, $txn, $type, $attr) = @_; 87 my ($self, $txn, $type, $attr) = @_;
248 88
249 warn "progress<$txn,$type," . (join ":", %$attr) . ">\n"; 89 warn "progress<$txn,$type," . (join ":", %$attr) . ">\n";
250 } 90 }
251 91
252=begin comment
253
254However, the existance of the node is checked by executing a
255C<ClientHello> transaction.
256
257=end
258
259=cut 92=cut
260 93
261sub new { 94sub new {
262 my $class = shift; 95 my $class = shift;
263 my $self = bless { @_ }, $class; 96 my $self = bless { @_ }, $class;
264 97
265 $self->{host} ||= $ENV{FREDHOST} || "127.0.0.1"; 98 $self->{host} ||= $ENV{FREDHOST} || "127.0.0.1";
266 $self->{port} ||= $ENV{FREDPORT} || 8481; 99 $self->{port} ||= $ENV{FREDPORT} || 8481;
267 100
268 #$self->{nodehello} = $self->client_hello
269 # or croak "unable to get nodehello from node\n";
270
271 $self; 101 $self;
272} 102}
273 103
274sub progress { 104sub progress {
275 my ($self, $txn, $type, $attr) = @_; 105 my ($self, $txn, $type, $attr) = @_;
276 106
277 $self->{progress}->($self, $txn, $type, $attr) 107 $self->{progress}->($self, $txn, $type, $attr)
278 if $self->{progress}; 108 if $self->{progress};
279} 109}
280 110
281=item $txn = $fcp->txn(type => attr => val,...) 111=item $txn = $fcp->txn (type => attr => val,...)
282 112
283The low-level interface to transactions. Don't use it. 113The low-level interface to transactions. Don't use it unless you have
284 114"special needs". Instead, use predefiend transactions like this:
285Here are some examples of using transactions:
286 115
287The blocking case, no (visible) transactions involved: 116The blocking case, no (visible) transactions involved:
288 117
289 my $nodehello = $fcp->client_hello; 118 my $nodehello = $fcp->client_hello;
290 119
… …
392=cut 221=cut
393 222
394$txn->(generate_chk => sub { 223$txn->(generate_chk => sub {
395 my ($self, $metadata, $data, $cipher) = @_; 224 my ($self, $metadata, $data, $cipher) = @_;
396 225
226 $metadata = Net::FCP::Metadata::build_metadata $metadata;
227
397 $self->txn (generate_chk => 228 $self->txn (generate_chk =>
398 data => "$metadata$data", 229 data => "$metadata$data",
399 metadata_length => xeh length $metadata, 230 metadata_length => xeh length $metadata,
400 cipher => $cipher || "Twofish"); 231 cipher => $cipher || "Twofish");
401}); 232});
402 233
403=item $txn = $fcp->txn_generate_svk_pair 234=item $txn = $fcp->txn_generate_svk_pair
404 235
405=item ($public, $private) = @{ $fcp->generate_svk_pair } 236=item ($public, $private, $crypto) = @{ $fcp->generate_svk_pair }
406 237
407Creates a new SVK pair. Returns an arrayref with the public key, the 238Creates a new SVK pair. Returns an arrayref with the public key, the
408private key and a crypto key, which is just additional entropy. 239private key and a crypto key, which is just additional entropy.
409 240
410 [ 241 [
… …
466 297
467=item $txn = $fcp->txn_client_get ($uri [, $htl = 15 [, $removelocal = 0]]) 298=item $txn = $fcp->txn_client_get ($uri [, $htl = 15 [, $removelocal = 0]])
468 299
469=item ($metadata, $data) = @{ $fcp->client_get ($uri, $htl, $removelocal) 300=item ($metadata, $data) = @{ $fcp->client_get ($uri, $htl, $removelocal)
470 301
471Fetches a (small, as it should fit into memory) file from 302Fetches a (small, as it should fit into memory) key content block from
472freenet. C<$meta> is the metadata (as returned by C<parse_metadata> or 303freenet. C<$meta> is a C<Net::FCP::Metadata> object or C<undef>).
473C<undef>).
474 304
475The C<$uri> should begin with C<freenet:>, but the scheme is currently 305The C<$uri> should begin with C<freenet:>, but the scheme is currently
476added, if missing. 306added, if missing.
477
478Due to the overhead, a better method to download big files should be used.
479 307
480 my ($meta, $data) = @{ 308 my ($meta, $data) = @{
481 $fcp->client_get ( 309 $fcp->client_get (
482 "freenet:CHK@hdXaxkwZ9rA8-SidT0AN-bniQlgPAwI,XdCDmBuGsd-ulqbLnZ8v~w" 310 "freenet:CHK@hdXaxkwZ9rA8-SidT0AN-bniQlgPAwI,XdCDmBuGsd-ulqbLnZ8v~w"
483 ) 311 )
… …
486=cut 314=cut
487 315
488$txn->(client_get => sub { 316$txn->(client_get => sub {
489 my ($self, $uri, $htl, $removelocal) = @_; 317 my ($self, $uri, $htl, $removelocal) = @_;
490 318
491 $uri =~ s/^freenet://; 319 $uri =~ s/^freenet://; $uri = "freenet:$uri";
492 $uri = "freenet:$uri";
493 320
494 $self->txn (client_get => URI => $uri, hops_to_live => xeh (defined $htl ? $htl : 15), 321 $self->txn (client_get => URI => $uri, hops_to_live => xeh (defined $htl ? $htl : 15),
495 remove_local_key => $removelocal ? "true" : "false"); 322 remove_local_key => $removelocal ? "true" : "false");
496}); 323});
497 324
… …
510The result is an arrayref with the keys C<uri>, C<public_key> and C<private_key>. 337The result is an arrayref with the keys C<uri>, C<public_key> and C<private_key>.
511 338
512=cut 339=cut
513 340
514$txn->(client_put => sub { 341$txn->(client_put => sub {
515 my ($self, $uri, $meta, $data, $htl, $removelocal) = @_; 342 my ($self, $uri, $metadata, $data, $htl, $removelocal) = @_;
516 343
517 $meta = build_metadata $meta; 344 $metadata = Net::FCP::Metadata::build_metadata $metadata;
345 $uri =~ s/^freenet://; $uri = "freenet:$uri";
518 346
519 $self->txn (client_put => URI => $uri, 347 $self->txn (client_put => URI => $uri,
520 hops_to_live => xeh (defined $htl ? $htl : 15), 348 hops_to_live => xeh (defined $htl ? $htl : 15),
521 remove_local_key => $removelocal ? "true" : "false", 349 remove_local_key => $removelocal ? "true" : "false",
522 data => "$meta$data", metadata_length => xeh length $meta); 350 data => "$metadata$data", metadata_length => xeh length $metadata);
523}); 351});
524 352
525} # transactions 353} # transactions
526 354
527=back 355=back
… …
554 382
555sub new { 383sub new {
556 my $class = shift; 384 my $class = shift;
557 my $self = bless { @_ }, $class; 385 my $self = bless { @_ }, $class;
558 386
559 $self->{signal} = $EVENT->new_signal; 387 $self->{signal} = AnyEvent->condvar;
560 388
561 $self->{fcp}{txn}{$self} = $self; 389 $self->{fcp}{txn}{$self} = $self;
562 390
563 my $attr = ""; 391 my $attr = "";
564 my $data = delete $self->{attr}{data}; 392 my $data = delete $self->{attr}{data};
… …
576 404
577 socket my $fh, PF_INET, SOCK_STREAM, 0 405 socket my $fh, PF_INET, SOCK_STREAM, 0
578 or Carp::croak "unable to create new tcp socket: $!"; 406 or Carp::croak "unable to create new tcp socket: $!";
579 binmode $fh, ":raw"; 407 binmode $fh, ":raw";
580 fcntl $fh, F_SETFL, O_NONBLOCK; 408 fcntl $fh, F_SETFL, O_NONBLOCK;
581 connect $fh, (sockaddr_in $self->{fcp}{port}, inet_aton $self->{fcp}{host}) 409 connect $fh, (sockaddr_in $self->{fcp}{port}, inet_aton $self->{fcp}{host});
582 and !$!{EWOULDBLOCK}
583 and !$!{EINPROGRESS}
584 and Carp::croak "FCP::txn: unable to connect to $self->{fcp}{host}:$self->{fcp}{port}: $!\n"; 410# and Carp::croak "FCP::txn: unable to connect to $self->{fcp}{host}:$self->{fcp}{port}: $!\n";
585 411
586 $self->{sbuf} = 412 $self->{sbuf} =
587 "\x00\x00\x00\x02" 413 "\x00\x00\x00\x02"
588 . (Net::FCP::touc $self->{type}) 414 . (Net::FCP::touc $self->{type})
589 . "\012$attr$data"; 415 . "\012$attr$data";
590 416
591 #shutdown $fh, 1; # freenet buggy?, well, it's java... 417 #shutdown $fh, 1; # freenet buggy?, well, it's java...
592 418
593 $self->{fh} = $fh; 419 $self->{fh} = $fh;
594 420
595 $self->{w} = $EVENT->new_from_fh ($fh)->cb(sub { $self->fh_ready_w })->poll(0, 1, 1); 421 $self->{w} = AnyEvent->io (fh => $fh, poll => 'w', cb => sub { $self->fh_ready_w });
596 422
597 $self; 423 $self;
598} 424}
599 425
600=item $txn = $txn->cb ($coderef) 426=item $txn = $txn->cb ($coderef)
… …
636 $self; 462 $self;
637} 463}
638 464
639=item $txn->cancel (%attr) 465=item $txn->cancel (%attr)
640 466
641Cancels the operation with a C<cancel> exception anf the given attributes 467Cancels the operation with a C<cancel> exception and the given attributes
642(consider at least giving the attribute C<reason>). 468(consider at least giving the attribute C<reason>).
643 469
644UNTESTED. 470UNTESTED.
645 471
646=cut 472=cut
… …
659 485
660 if ($len > 0) { 486 if ($len > 0) {
661 substr $self->{sbuf}, 0, $len, ""; 487 substr $self->{sbuf}, 0, $len, "";
662 unless (length $self->{sbuf}) { 488 unless (length $self->{sbuf}) {
663 fcntl $self->{fh}, F_SETFL, 0; 489 fcntl $self->{fh}, F_SETFL, 0;
664 $self->{w}->cb(sub { $self->fh_ready_r })->poll (1, 0, 1); 490 $self->{w} = AnyEvent->io (fh => $self->{fh}, poll => 'r', cb => sub { $self->fh_ready_r });
665 } 491 }
666 } elsif (defined $len) { 492 } elsif (defined $len) {
667 $self->throw (Net::FCP::Exception->new (network_error => { reason => "unexpected end of file while writing" })); 493 $self->throw (Net::FCP::Exception->new (network_error => { reason => "unexpected end of file while writing" }));
668 } else { 494 } else {
669 $self->throw (Net::FCP::Exception->new (network_error => { reason => "$!" })); 495 $self->throw (Net::FCP::Exception->new (network_error => { reason => "$!" }));
… …
671} 497}
672 498
673sub fh_ready_r { 499sub fh_ready_r {
674 my ($self) = @_; 500 my ($self) = @_;
675 501
676 if (sysread $self->{fh}, $self->{buf}, 65536, length $self->{buf}) { 502 if (sysread $self->{fh}, $self->{buf}, 16384 + 1024, length $self->{buf}) {
677 for (;;) { 503 for (;;) {
678 if ($self->{datalen}) { 504 if ($self->{datalen}) {
679 #warn "expecting new datachunk $self->{datalen}, got ".(length $self->{buf})."\n";#d# 505 #warn "expecting new datachunk $self->{datalen}, got ".(length $self->{buf})."\n";#d#
680 if (length $self->{buf} >= $self->{datalen}) { 506 if (length $self->{buf} >= $self->{datalen}) {
681 $self->rcv_data (substr $self->{buf}, 0, delete $self->{datalen}, ""); 507 $self->rcv_data (substr $self->{buf}, 0, delete $self->{datalen}, "");
… …
734 my ($self, $result) = @_; 560 my ($self, $result) = @_;
735 561
736 unless (exists $self->{result}) { 562 unless (exists $self->{result}) {
737 $self->{result} = $result; 563 $self->{result} = $result;
738 $self->{cb}->($self) if exists $self->{cb}; 564 $self->{cb}->($self) if exists $self->{cb};
739 $self->{signal}->send; 565 $self->{signal}->broadcast;
740 } 566 }
741} 567}
742 568
743sub eof { 569sub eof {
744 my ($self) = @_; 570 my ($self) = @_;
… …
872 698
873 $self->progress ("data", { chunk => length $chunk, received => length $self->{data}, total => $self->{datalength} }); 699 $self->progress ("data", { chunk => length $chunk, received => length $self->{data}, total => $self->{datalength} });
874 700
875 if ($self->{datalength} == length $self->{data}) { 701 if ($self->{datalength} == length $self->{data}) {
876 my $data = delete $self->{data}; 702 my $data = delete $self->{data};
877 my $meta = Net::FCP::parse_metadata substr $data, 0, $self->{metalength}, ""; 703 my $meta = new Net::FCP::Metadata (substr $data, 0, $self->{metalength}, "");
878 704
879 $self->set_result ([$meta, $data]); 705 $self->set_result ([$meta, $data]);
880 $self->eof; 706 $self->eof;
881 } 707 }
882} 708}
… …
893package Net::FCP::Txn::ClientPut; 719package Net::FCP::Txn::ClientPut;
894 720
895use base Net::FCP::Txn::GetPut; 721use base Net::FCP::Txn::GetPut;
896 722
897*rcv_size_error = \&Net::FCP::Txn::rcv_throw_exception; 723*rcv_size_error = \&Net::FCP::Txn::rcv_throw_exception;
898*rcv_key_collision = \&Net::FCP::Txn::rcv_throw_exception;
899 724
900sub rcv_pending { 725sub rcv_pending {
901 my ($self, $attr, $type) = @_; 726 my ($self, $attr, $type) = @_;
902 $self->progress ($type, $attr); 727 $self->progress ($type, $attr);
903} 728}
904 729
905sub rcv_success { 730sub rcv_success {
906 my ($self, $attr, $type) = @_; 731 my ($self, $attr, $type) = @_;
907 $self->set_result ($attr); 732 $self->set_result ($attr);
733}
734
735sub rcv_key_collision {
736 my ($self, $attr, $type) = @_;
737 $self->set_result ({ key_collision => 1, %$attr });
908} 738}
909 739
910=back 740=back
911 741
912=head2 The Net::FCP::Exception CLASS 742=head2 The Net::FCP::Exception CLASS
… …
980 810
981=head1 BUGS 811=head1 BUGS
982 812
983=head1 AUTHOR 813=head1 AUTHOR
984 814
985 Marc Lehmann <pcg@goof.com> 815 Marc Lehmann <schmorp@schmorp.de>
986 http://www.goof.com/pcg/marc/ 816 http://home.schmorp.de/
987 817
988=cut 818=cut
989 819
990package Net::FCP::Event::Auto; 8201
991 821
992my @models = (
993 [Coro => Coro::Event::],
994 [Event => Event::],
995 [Glib => Glib::],
996 [Tk => Tk::],
997);
998
999sub AUTOLOAD {
1000 $AUTOLOAD =~ s/.*://;
1001
1002 for (@models) {
1003 my ($model, $package) = @$_;
1004 if (defined ${"$package\::VERSION"}) {
1005 $EVENT = "Net::FCP::Event::$model";
1006 eval "require $EVENT"; die if $@;
1007 goto &{"$EVENT\::$AUTOLOAD"};
1008 }
1009 }
1010
1011 for (@models) {
1012 my ($model, $package) = @$_;
1013 $EVENT = "Net::FCP::Event::$model";
1014 if (eval "require $EVENT") {
1015 goto &{"$EVENT\::$AUTOLOAD"};
1016 }
1017 }
1018
1019 die "No event module selected for Net::FCP and autodetect failed. Install any of these: Coro, Event, Glib or Tk.";
1020}
1021
10221;
1023

Diff Legend

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