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.41 by root, Thu May 1 15:30:15 2008 UTC

… …
11 my $ni = $fcp->txn_node_info->result; 11 my $ni = $fcp->txn_node_info->result;
12 my $ni = $fcp->node_info; 12 my $ni = $fcp->node_info;
13 13
14=head1 DESCRIPTION 14=head1 DESCRIPTION
15 15
16This module implements the first version of the freenet client protocol,
17for use with freenet versions 0.5. For freenet protocol version 2.0
18support (as used by freenet 0.7), see the L<AnyEvent::FCP> module.
19
16See L<http://freenet.sourceforge.net/index.php?page=fcp> for a description 20See 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. 21of what the messages do.
18 22
19=head1 WARNING 23The module uses L<AnyEvent> to find a suitable Event module.
20
21This module is alpha. While it probably won't destroy (much :) of your
22data, it currently falls short of what it should provide (intelligent uri
23following, splitfile downloads, healing...)
24 24
25=head2 IMPORT TAGS 25=head2 IMPORT TAGS
26 26
27Nothing much can be "imported" from this module right now. There are, 27Nothing 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 28
43=head2 FREENET BASICS 29=head2 FREENET BASICS
44 30
45Ok, this section will not explain any freenet basics to you, just some 31Ok, this section will not explain any freenet basics to you, just some
46problems I found that you might want to avoid: 32problems I found that you might want to avoid:
… …
72 58
73package Net::FCP; 59package Net::FCP;
74 60
75use Carp; 61use Carp;
76 62
77$VERSION = 0.6; 63$VERSION = '1.2';
78 64
79no warnings; 65no warnings;
80 66
81our $EVENT = Net::FCP::Event::Auto::; 67use AnyEvent;
82 68
83sub import { 69use Net::FCP::Metadata;
84 shift; 70use 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 71
234=item $fcp = new Net::FCP [host => $host][, port => $port][, progress => \&cb] 72=item $fcp = new Net::FCP [host => $host][, port => $port][, progress => \&cb]
235 73
236Create a new virtual FCP connection to the given host and port (default 74Create 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>). 75127.0.0.1:8481, or the environment variables C<FREDHOST> and C<FREDPORT>).
… …
247 my ($self, $txn, $type, $attr) = @_; 85 my ($self, $txn, $type, $attr) = @_;
248 86
249 warn "progress<$txn,$type," . (join ":", %$attr) . ">\n"; 87 warn "progress<$txn,$type," . (join ":", %$attr) . ">\n";
250 } 88 }
251 89
252=begin comment
253
254However, the existance of the node is checked by executing a
255C<ClientHello> transaction.
256
257=end
258
259=cut 90=cut
260 91
261sub new { 92sub new {
262 my $class = shift; 93 my $class = shift;
263 my $self = bless { @_ }, $class; 94 my $self = bless { @_ }, $class;
264 95
265 $self->{host} ||= $ENV{FREDHOST} || "127.0.0.1"; 96 $self->{host} ||= $ENV{FREDHOST} || "127.0.0.1";
266 $self->{port} ||= $ENV{FREDPORT} || 8481; 97 $self->{port} ||= $ENV{FREDPORT} || 8481;
267 98
268 #$self->{nodehello} = $self->client_hello
269 # or croak "unable to get nodehello from node\n";
270
271 $self; 99 $self;
272} 100}
273 101
274sub progress { 102sub progress {
275 my ($self, $txn, $type, $attr) = @_; 103 my ($self, $txn, $type, $attr) = @_;
276 104
277 $self->{progress}->($self, $txn, $type, $attr) 105 $self->{progress}->($self, $txn, $type, $attr)
278 if $self->{progress}; 106 if $self->{progress};
279} 107}
280 108
281=item $txn = $fcp->txn(type => attr => val,...) 109=item $txn = $fcp->txn (type => attr => val,...)
282 110
283The low-level interface to transactions. Don't use it. 111The low-level interface to transactions. Don't use it unless you have
284 112"special needs". Instead, use predefiend transactions like this:
285Here are some examples of using transactions:
286 113
287The blocking case, no (visible) transactions involved: 114The blocking case, no (visible) transactions involved:
288 115
289 my $nodehello = $fcp->client_hello; 116 my $nodehello = $fcp->client_hello;
290 117
… …
392=cut 219=cut
393 220
394$txn->(generate_chk => sub { 221$txn->(generate_chk => sub {
395 my ($self, $metadata, $data, $cipher) = @_; 222 my ($self, $metadata, $data, $cipher) = @_;
396 223
224 $metadata = Net::FCP::Metadata::build_metadata $metadata;
225
397 $self->txn (generate_chk => 226 $self->txn (generate_chk =>
398 data => "$metadata$data", 227 data => "$metadata$data",
399 metadata_length => xeh length $metadata, 228 metadata_length => xeh length $metadata,
400 cipher => $cipher || "Twofish"); 229 cipher => $cipher || "Twofish");
401}); 230});
402 231
403=item $txn = $fcp->txn_generate_svk_pair 232=item $txn = $fcp->txn_generate_svk_pair
404 233
405=item ($public, $private) = @{ $fcp->generate_svk_pair } 234=item ($public, $private, $crypto) = @{ $fcp->generate_svk_pair }
406 235
407Creates a new SVK pair. Returns an arrayref with the public key, the 236Creates a new SVK pair. Returns an arrayref with the public key, the
408private key and a crypto key, which is just additional entropy. 237private key and a crypto key, which is just additional entropy.
409 238
410 [ 239 [
… …
466 295
467=item $txn = $fcp->txn_client_get ($uri [, $htl = 15 [, $removelocal = 0]]) 296=item $txn = $fcp->txn_client_get ($uri [, $htl = 15 [, $removelocal = 0]])
468 297
469=item ($metadata, $data) = @{ $fcp->client_get ($uri, $htl, $removelocal) 298=item ($metadata, $data) = @{ $fcp->client_get ($uri, $htl, $removelocal)
470 299
471Fetches a (small, as it should fit into memory) file from 300Fetches 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 301freenet. C<$meta> is a C<Net::FCP::Metadata> object or C<undef>).
473C<undef>).
474 302
475The C<$uri> should begin with C<freenet:>, but the scheme is currently 303The C<$uri> should begin with C<freenet:>, but the scheme is currently
476added, if missing. 304added, if missing.
477
478Due to the overhead, a better method to download big files should be used.
479 305
480 my ($meta, $data) = @{ 306 my ($meta, $data) = @{
481 $fcp->client_get ( 307 $fcp->client_get (
482 "freenet:CHK@hdXaxkwZ9rA8-SidT0AN-bniQlgPAwI,XdCDmBuGsd-ulqbLnZ8v~w" 308 "freenet:CHK@hdXaxkwZ9rA8-SidT0AN-bniQlgPAwI,XdCDmBuGsd-ulqbLnZ8v~w"
483 ) 309 )
… …
486=cut 312=cut
487 313
488$txn->(client_get => sub { 314$txn->(client_get => sub {
489 my ($self, $uri, $htl, $removelocal) = @_; 315 my ($self, $uri, $htl, $removelocal) = @_;
490 316
491 $uri =~ s/^freenet://; 317 $uri =~ s/^freenet://; $uri = "freenet:$uri";
492 $uri = "freenet:$uri";
493 318
494 $self->txn (client_get => URI => $uri, hops_to_live => xeh (defined $htl ? $htl : 15), 319 $self->txn (client_get => URI => $uri, hops_to_live => xeh (defined $htl ? $htl : 15),
495 remove_local_key => $removelocal ? "true" : "false"); 320 remove_local_key => $removelocal ? "true" : "false");
496}); 321});
497 322
… …
510The result is an arrayref with the keys C<uri>, C<public_key> and C<private_key>. 335The result is an arrayref with the keys C<uri>, C<public_key> and C<private_key>.
511 336
512=cut 337=cut
513 338
514$txn->(client_put => sub { 339$txn->(client_put => sub {
515 my ($self, $uri, $meta, $data, $htl, $removelocal) = @_; 340 my ($self, $uri, $metadata, $data, $htl, $removelocal) = @_;
516 341
517 $meta = build_metadata $meta; 342 $metadata = Net::FCP::Metadata::build_metadata $metadata;
343 $uri =~ s/^freenet://; $uri = "freenet:$uri";
518 344
519 $self->txn (client_put => URI => $uri, 345 $self->txn (client_put => URI => $uri,
520 hops_to_live => xeh (defined $htl ? $htl : 15), 346 hops_to_live => xeh (defined $htl ? $htl : 15),
521 remove_local_key => $removelocal ? "true" : "false", 347 remove_local_key => $removelocal ? "true" : "false",
522 data => "$meta$data", metadata_length => xeh length $meta); 348 data => "$metadata$data", metadata_length => xeh length $metadata);
523}); 349});
524 350
525} # transactions 351} # transactions
526 352
527=back 353=back
… …
554 380
555sub new { 381sub new {
556 my $class = shift; 382 my $class = shift;
557 my $self = bless { @_ }, $class; 383 my $self = bless { @_ }, $class;
558 384
559 $self->{signal} = $EVENT->new_signal; 385 $self->{signal} = AnyEvent->condvar;
560 386
561 $self->{fcp}{txn}{$self} = $self; 387 $self->{fcp}{txn}{$self} = $self;
562 388
563 my $attr = ""; 389 my $attr = "";
564 my $data = delete $self->{attr}{data}; 390 my $data = delete $self->{attr}{data};
… …
576 402
577 socket my $fh, PF_INET, SOCK_STREAM, 0 403 socket my $fh, PF_INET, SOCK_STREAM, 0
578 or Carp::croak "unable to create new tcp socket: $!"; 404 or Carp::croak "unable to create new tcp socket: $!";
579 binmode $fh, ":raw"; 405 binmode $fh, ":raw";
580 fcntl $fh, F_SETFL, O_NONBLOCK; 406 fcntl $fh, F_SETFL, O_NONBLOCK;
581 connect $fh, (sockaddr_in $self->{fcp}{port}, inet_aton $self->{fcp}{host}) 407 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"; 408# and Carp::croak "FCP::txn: unable to connect to $self->{fcp}{host}:$self->{fcp}{port}: $!\n";
585 409
586 $self->{sbuf} = 410 $self->{sbuf} =
587 "\x00\x00\x00\x02" 411 "\x00\x00\x00\x02"
588 . (Net::FCP::touc $self->{type}) 412 . (Net::FCP::touc $self->{type})
589 . "\012$attr$data"; 413 . "\012$attr$data";
590 414
591 #shutdown $fh, 1; # freenet buggy?, well, it's java... 415 #shutdown $fh, 1; # freenet buggy?, well, it's java...
592 416
593 $self->{fh} = $fh; 417 $self->{fh} = $fh;
594 418
595 $self->{w} = $EVENT->new_from_fh ($fh)->cb(sub { $self->fh_ready_w })->poll(0, 1, 1); 419 $self->{w} = AnyEvent->io (fh => $fh, poll => 'w', cb => sub { $self->fh_ready_w });
596 420
597 $self; 421 $self;
598} 422}
599 423
600=item $txn = $txn->cb ($coderef) 424=item $txn = $txn->cb ($coderef)
… …
636 $self; 460 $self;
637} 461}
638 462
639=item $txn->cancel (%attr) 463=item $txn->cancel (%attr)
640 464
641Cancels the operation with a C<cancel> exception anf the given attributes 465Cancels the operation with a C<cancel> exception and the given attributes
642(consider at least giving the attribute C<reason>). 466(consider at least giving the attribute C<reason>).
643 467
644UNTESTED. 468UNTESTED.
645 469
646=cut 470=cut
… …
659 483
660 if ($len > 0) { 484 if ($len > 0) {
661 substr $self->{sbuf}, 0, $len, ""; 485 substr $self->{sbuf}, 0, $len, "";
662 unless (length $self->{sbuf}) { 486 unless (length $self->{sbuf}) {
663 fcntl $self->{fh}, F_SETFL, 0; 487 fcntl $self->{fh}, F_SETFL, 0;
664 $self->{w}->cb(sub { $self->fh_ready_r })->poll (1, 0, 1); 488 $self->{w} = AnyEvent->io (fh => $self->{fh}, poll => 'r', cb => sub { $self->fh_ready_r });
665 } 489 }
666 } elsif (defined $len) { 490 } elsif (defined $len) {
667 $self->throw (Net::FCP::Exception->new (network_error => { reason => "unexpected end of file while writing" })); 491 $self->throw (Net::FCP::Exception->new (network_error => { reason => "unexpected end of file while writing" }));
668 } else { 492 } else {
669 $self->throw (Net::FCP::Exception->new (network_error => { reason => "$!" })); 493 $self->throw (Net::FCP::Exception->new (network_error => { reason => "$!" }));
… …
671} 495}
672 496
673sub fh_ready_r { 497sub fh_ready_r {
674 my ($self) = @_; 498 my ($self) = @_;
675 499
676 if (sysread $self->{fh}, $self->{buf}, 65536, length $self->{buf}) { 500 if (sysread $self->{fh}, $self->{buf}, 16384 + 1024, length $self->{buf}) {
677 for (;;) { 501 for (;;) {
678 if ($self->{datalen}) { 502 if ($self->{datalen}) {
679 #warn "expecting new datachunk $self->{datalen}, got ".(length $self->{buf})."\n";#d# 503 #warn "expecting new datachunk $self->{datalen}, got ".(length $self->{buf})."\n";#d#
680 if (length $self->{buf} >= $self->{datalen}) { 504 if (length $self->{buf} >= $self->{datalen}) {
681 $self->rcv_data (substr $self->{buf}, 0, delete $self->{datalen}, ""); 505 $self->rcv_data (substr $self->{buf}, 0, delete $self->{datalen}, "");
… …
734 my ($self, $result) = @_; 558 my ($self, $result) = @_;
735 559
736 unless (exists $self->{result}) { 560 unless (exists $self->{result}) {
737 $self->{result} = $result; 561 $self->{result} = $result;
738 $self->{cb}->($self) if exists $self->{cb}; 562 $self->{cb}->($self) if exists $self->{cb};
739 $self->{signal}->send; 563 $self->{signal}->broadcast;
740 } 564 }
741} 565}
742 566
743sub eof { 567sub eof {
744 my ($self) = @_; 568 my ($self) = @_;
… …
872 696
873 $self->progress ("data", { chunk => length $chunk, received => length $self->{data}, total => $self->{datalength} }); 697 $self->progress ("data", { chunk => length $chunk, received => length $self->{data}, total => $self->{datalength} });
874 698
875 if ($self->{datalength} == length $self->{data}) { 699 if ($self->{datalength} == length $self->{data}) {
876 my $data = delete $self->{data}; 700 my $data = delete $self->{data};
877 my $meta = Net::FCP::parse_metadata substr $data, 0, $self->{metalength}, ""; 701 my $meta = new Net::FCP::Metadata (substr $data, 0, $self->{metalength}, "");
878 702
879 $self->set_result ([$meta, $data]); 703 $self->set_result ([$meta, $data]);
880 $self->eof; 704 $self->eof;
881 } 705 }
882} 706}
… …
893package Net::FCP::Txn::ClientPut; 717package Net::FCP::Txn::ClientPut;
894 718
895use base Net::FCP::Txn::GetPut; 719use base Net::FCP::Txn::GetPut;
896 720
897*rcv_size_error = \&Net::FCP::Txn::rcv_throw_exception; 721*rcv_size_error = \&Net::FCP::Txn::rcv_throw_exception;
898*rcv_key_collision = \&Net::FCP::Txn::rcv_throw_exception;
899 722
900sub rcv_pending { 723sub rcv_pending {
901 my ($self, $attr, $type) = @_; 724 my ($self, $attr, $type) = @_;
902 $self->progress ($type, $attr); 725 $self->progress ($type, $attr);
903} 726}
904 727
905sub rcv_success { 728sub rcv_success {
906 my ($self, $attr, $type) = @_; 729 my ($self, $attr, $type) = @_;
907 $self->set_result ($attr); 730 $self->set_result ($attr);
731}
732
733sub rcv_key_collision {
734 my ($self, $attr, $type) = @_;
735 $self->set_result ({ key_collision => 1, %$attr });
908} 736}
909 737
910=back 738=back
911 739
912=head2 The Net::FCP::Exception CLASS 740=head2 The Net::FCP::Exception CLASS
… …
980 808
981=head1 BUGS 809=head1 BUGS
982 810
983=head1 AUTHOR 811=head1 AUTHOR
984 812
985 Marc Lehmann <pcg@goof.com> 813 Marc Lehmann <schmorp@schmorp.de>
986 http://www.goof.com/pcg/marc/ 814 http://home.schmorp.de/
987 815
988=cut 816=cut
989 817
990package Net::FCP::Event::Auto; 8181
991 819
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