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.1 by root, Sun Sep 7 22:57:40 2003 UTC vs.
Revision 1.8 by root, Mon Sep 8 01:47:31 2003 UTC

… …
31package Net::FCP; 31package Net::FCP;
32 32
33use Carp; 33use Carp;
34use IO::Socket::INET; 34use IO::Socket::INET;
35 35
36$VERSION = 0.01; 36$VERSION = 0.04;
37 37
38sub event_reg_cb { 38sub event_reg_cb {
39 my ($obj) = @_; 39 my ($obj) = @_;
40 require Event; 40 require Event;
41 41
… …
59 59
60$regcb = \&event_reg_cb; 60$regcb = \&event_reg_cb;
61$unregcb = \&event_unreg_cb; 61$unregcb = \&event_unreg_cb;
62$waitcb = \&event_wait_cb; 62$waitcb = \&event_wait_cb;
63 63
64sub touc($) {
65 local $_ = shift;
66 1 while s/((?:^|_)(?:svk|chk|uri)(?:_|$))/\U$1/;
67 s/(?:^|_)(.)/\U$1/g;
68 $_;
69}
70
71sub tolc($) {
72 local $_ = shift;
73 s/(?<=[a-z])(?=[A-Z])/_/g;
74 lc $_;
75}
76
77=item $meta = Net::FCP::parse_metadata $string
78
79Parse a metadata string and return it.
80
81The metadata will be a hashref with key C<version> (containing
82the mandatory version header entries).
83
84All other headers are represented by arrayrefs (they can be repeated).
85
86Since this is confusing, here is a rather verbose example of a parsed
87manifest:
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
111sub 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
64=item $fcp = new Net::FCP [host => $host][, port => $port] 140=item $fcp = new Net::FCP [host => $host][, port => $port]
65 141
66Create a new virtual FCP connection to the given host and port (default 142Create a new virtual FCP connection to the given host and port (default
67127.0.0.1:8481). 143127.0.0.1:8481, or the environment variables C<FREDHOST> and C<FREDPORT>).
68 144
69Connections are virtual because no persistent physical connection is 145Connections are virtual because no persistent physical connection is
70established. However, the existance of the node is checked by executing a 146established. However, the existance of the node is checked by executing a
71C<ClientHello> transaction. 147C<ClientHello> transaction.
72 148
… …
74 150
75sub new { 151sub new {
76 my $class = shift; 152 my $class = shift;
77 my $self = bless { @_ }, $class; 153 my $self = bless { @_ }, $class;
78 154
79 $self->{host} ||= "127.0.0.1"; 155 $self->{host} ||= $ENV{FREDHOST} || "127.0.0.1";
80 $self->{port} ||= 8481; 156 $self->{port} ||= $ENV{FREDPORt} || 8481;
81 157
82 $self->{nodehello} = $self->txn("ClientHello")->result 158 $self->{nodehello} = $self->client_hello
83 or croak "unable to get nodehello from node\n"; 159 or croak "unable to get nodehello from node\n";
84 160
85 $self; 161 $self;
86} 162}
87 163
… …
92=cut 168=cut
93 169
94sub txn { 170sub txn {
95 my ($self, $type, %attr) = @_; 171 my ($self, $type, %attr) = @_;
96 172
173 $type = touc $type;
174
97 my $txn = "Net::FCP::Txn::$type"->new(fcp => $self, type => $type, attr => \%attr); 175 my $txn = "Net::FCP::Txn::$type"->new(fcp => $self, type => tolc $type, attr => \%attr);
98 176
99 $txn; 177 $txn;
100} 178}
101 179
102sub _txn($&) { 180sub _txn($&) {
… …
110=item $nodehello = $fcp->client_hello 188=item $nodehello = $fcp->client_hello
111 189
112Executes a ClientHello request and returns it's results. 190Executes a ClientHello request and returns it's results.
113 191
114 { 192 {
115 MaxFileSize => "5f5e100", 193 max_file_size => "5f5e100",
116 Protocol => "1.2",
117 Node => "Fred,0.6,1.46,7050" 194 node => "Fred,0.6,1.46,7050"
195 protocol => "1.2",
118 } 196 }
119 197
120=cut 198=cut
121 199
122_txn client_hello => sub { 200_txn client_hello => sub {
123 my ($self) = @_; 201 my ($self) = @_;
124 202
125 $self->txn ("ClientHello"); 203 $self->txn ("client_hello");
126}; 204};
127 205
128=item $txn = $fcp->txn_client_info 206=item $txn = $fcp->txn_client_info
129 207
130=item $nodeinfo = $fcp->client_info 208=item $nodeinfo = $fcp->client_info
131 209
132Executes a ClientInfo request and returns it's results. 210Executes a ClientInfo request and returns it's results.
133 211
134 { 212 {
135 MaxFileSize => "5f5e100",
136 DatastoreMax => "2540be400",
137 NodePort => 369,
138 JavaName => "Java HotSpot(TM) Server VM",
139 OperatingSystemVersion => "2.4.20",
140 EstimatedLoad => 52,
141 FreeMemory => "5cc0148",
142 DatastoreFree => "5ce03400",
143 NodeAddress => "1.2.3.4",
144 ActiveJobs => "1f", 213 active_jobs => "1f",
145 AllocatedMemory => "bde0000", 214 allocated_memory => "bde0000",
146 Architecture => "i386", 215 architecture => "i386",
147 RoutingTime => "a5",
148 LeastRecentTimestamp => "f41538b878",
149 AvailableThreads => 17, 216 available_threads => 17,
217 datastore_free => "5ce03400",
218 datastore_max => "2540be400",
150 DatastoreUsed => "1f72bb000", 219 datastore_used => "1f72bb000",
151 JavaVersion => "Blackdown-1.4.1-01", 220 estimated_load => 52,
221 free_memory => "5cc0148",
152 IsTransient => "false", 222 is_transient => "false",
153 OperatingSystem => "Linux", 223 java_name => "Java HotSpot(_T_M) Server VM",
154 JavaVendor => "http://www.blackdown.org/", 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",
155 MostRecentTimestamp => "f77e2cc520" 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",
233 routing_time => "a5",
156 } 234 }
157 235
158=cut 236=cut
159 237
160_txn client_info => sub { 238_txn client_info => sub {
161 my ($self) = @_; 239 my ($self) = @_;
162 240
163 $self->txn ("ClientInfo"); 241 $self->txn ("client_info");
164}; 242};
165 243
166=item $txn = $fcp->txn_generate_chk ($metadata, $data) 244=item $txn = $fcp->txn_generate_chk ($metadata, $data)
167 245
168=item $uri = $fcp->generate_chk ($metadata, $data) 246=item $uri = $fcp->generate_chk ($metadata, $data)
… …
172=cut 250=cut
173 251
174_txn generate_chk => sub { 252_txn generate_chk => sub {
175 my ($self, $metadata, $data) = @_; 253 my ($self, $metadata, $data) = @_;
176 254
177 $self->txn (GenerateCHK => data => "$data$metadata", MetaDataLength => length $metadata); 255 $self->txn (generate_chk => data => "$data$metadata", metadata_length => length $metadata);
178}; 256};
179 257
180=item $txn = $fcp->txn_generate_svk_pair 258=item $txn = $fcp->txn_generate_svk_pair
181 259
182=item ($public, $private) = @{ $fcp->generate_svk_pair } 260=item ($public, $private) = @{ $fcp->generate_svk_pair }
… …
191=cut 269=cut
192 270
193_txn generate_svk_pair => sub { 271_txn generate_svk_pair => sub {
194 my ($self) = @_; 272 my ($self) = @_;
195 273
196 $self->txn ("GenerateSVKPair"); 274 $self->txn ("generate_svk_pair");
197}; 275};
198 276
199=item $txn = $fcp->txn_insert_private_key ($private) 277=item $txn = $fcp->txn_insert_private_key ($private)
200 278
201=item $uri = $fcp->insert_private_key ($private) 279=item $uri = $fcp->insert_private_key ($private)
… …
211=cut 289=cut
212 290
213_txn insert_private_key => sub { 291_txn insert_private_key => sub {
214 my ($self, $privkey) = @_; 292 my ($self, $privkey) = @_;
215 293
216 $self->txn (InvertPrivateKey => Private => $privkey); 294 $self->txn (invert_private_key => private => $privkey);
217}; 295};
218 296
219=item $txn = $fcp->txn_get_size ($uri) 297=item $txn = $fcp->txn_get_size ($uri)
220 298
221=item $length = $fcp->get_size ($uri) 299=item $length = $fcp->get_size ($uri)
… …
228=cut 306=cut
229 307
230_txn get_size => sub { 308_txn get_size => sub {
231 my ($self, $uri) = @_; 309 my ($self, $uri) = @_;
232 310
233 $self->txn (GetSize => URI => $uri); 311 $self->txn (get_size => URI => $uri);
234}; 312};
235 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
318Fetches a (small, as it should fit into memory) file from
319freenet. C<$meta> is the metadata (as returned by C<parse_metadata> or
320C<undef>).
321
322Due 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
236=item MISSING: ClientGet, ClientPut 338=item MISSING: ClientPut
237 339
238=back 340=back
239 341
240=head2 THE Net::FCP::Txn CLASS 342=head2 THE Net::FCP::Txn CLASS
241 343
… …
266 368
267 my $attr = ""; 369 my $attr = "";
268 my $data = delete $self->{attr}{data}; 370 my $data = delete $self->{attr}{data};
269 371
270 while (my ($k, $v) = each %{$self->{attr}}) { 372 while (my ($k, $v) = each %{$self->{attr}}) {
271 $attr .= "$k=$v\012" 373 $attr .= (Net::FCP::touc $k) . "=$v\012"
272 } 374 }
273 375
274 if (defined $data) { 376 if (defined $data) {
275 $attr .= "DataLength=" . (length $data) . "\012"; 377 $attr .= "DataLength=" . (length $data) . "\012";
276 $data = "Data\012$data"; 378 $data = "Data\012$data";
… …
283 PeerPort => $self->{fcp}{port} 385 PeerPort => $self->{fcp}{port}
284 or Carp::croak "FCP::txn: unable to connect to $self->{fcp}{host}:$self->{fcp}{port}: $!\n"; 386 or Carp::croak "FCP::txn: unable to connect to $self->{fcp}{host}:$self->{fcp}{port}: $!\n";
285 387
286 binmode $fh, ":raw"; 388 binmode $fh, ":raw";
287 389
390 if (0) {
288 print 391 print
289 $self->{type}, "\012", 392 Net::FCP::touc $self->{type}, "\012",
290 $attr, 393 $attr,
291 $data, "\012"; 394 $data, "\012";
395 }
292 396
293 print $fh 397 print $fh
294 "\x00\x00", "\x00\x02", # SESSID, PRESID 398 "\x00\x00", "\x00\x02", # SESSID, PRESID
295 $self->{type}, "\012", 399 Net::FCP::touc $self->{type}, "\012",
296 $attr, 400 $attr,
297 $data; 401 $data;
298 402
299 #$fh->shutdown (1); # freenet buggy?, well, it's java... 403 #$fh->shutdown (1); # freenet buggy?, well, it's java...
300 404
… …
310 414
311 if (sysread $self->{fh}, $self->{buf}, 65536, length $self->{buf}) { 415 if (sysread $self->{fh}, $self->{buf}, 65536, length $self->{buf}) {
312 for (;;) { 416 for (;;) {
313 if ($self->{datalen}) { 417 if ($self->{datalen}) {
314 if (length $self->{buf} >= $self->{datalen}) { 418 if (length $self->{buf} >= $self->{datalen}) {
315 $self->recv_data (substr $self->{buf}, 0, $self->{datalen}, ""); 419 $self->rcv_data (substr $self->{buf}, 0, $self->{datalen}, "");
316 } else { 420 } else {
317 last; 421 last;
318 } 422 }
319 } 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//) {
320 $self->{datalen} = $1; 424 $self->{datalen} = hex $1;
321 } 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) {
322 $self->rcv ($1, {map { split /=/, $_, 2 } split /\015?\012/, $2}); 426 $self->rcv ($1, {
427 map { my ($a, $b) = split /=/, $_, 2; ((Net::FCP::tolc $a), $b) }
428 split /\015?\012/, $2
429 });
323 } else { 430 } else {
324 last; 431 last;
325 } 432 }
326 } 433 }
327 } else { 434 } else {
… …
331 } 438 }
332} 439}
333 440
334sub rcv_data { 441sub rcv_data {
335 my ($self, $chunk) = @_; 442 my ($self, $chunk) = @_;
443
444 $self->{data} .= $chunk;
336} 445}
337 446
338sub rcv { 447sub rcv {
339 my ($self, $type, $attr) = @_; 448 my ($self, $type, $attr) = @_;
449
450 $type = Net::FCP::tolc $type;
451
340 #use PApp::Util;warn "$type => ".PApp::Util::dumpval($attr); 452 #use PApp::Util; warn PApp::Util::dumpval [$type, $attr];
341 453
342 if (my $method = $self->can("rcv_\L$type")) { 454 if (my $method = $self->can("rcv_$type")) {
343 $method->($self, $attr, $type); 455 $method->($self, $attr, $type);
344 } else { 456 } else {
345 warn "received unexpected reply type '$type' for '$self->{type}', ignoring\n"; 457 warn "received unexpected reply type '$type' for '$self->{type}', ignoring\n";
346 $self->eof;
347 } 458 }
459}
460
461sub set_result {
462 my ($self, $result) = @_;
463
464 $self->{result} = $result unless exists $self->{result};
348} 465}
349 466
350sub eof { 467sub eof {
351 my ($self, $result) = @_; 468 my ($self) = @_;
352 469 $self->set_result;
353 $self->{result} = $result unless exists $self->{result};
354} 470}
355 471
356=item $result = $txn->result 472=item $result = $txn->result
357 473
358Waits until a result is available and then returns it. 474Waits until a result is available and then returns it.
359 475
360This waiting is (depending on your event modul) not very efficient, as it 476This waiting is (depending on your event model) not very efficient, as it
361is done outside the "mainloop". 477is done outside the "mainloop".
362 478
363=cut 479=cut
364 480
365sub result { 481sub result {
… …
376 492
377package Net::FCP::Txn::ClientHello; 493package Net::FCP::Txn::ClientHello;
378 494
379use base Net::FCP::Txn; 495use base Net::FCP::Txn;
380 496
381sub rcv_nodehello { 497sub rcv_node_hello {
382 my ($self, $attr) = @_; 498 my ($self, $attr) = @_;
383 499
384 $self->eof ($attr); 500 $self->set_result ($attr);
385} 501}
386 502
387package Net::FCP::Txn::ClientInfo; 503package Net::FCP::Txn::ClientInfo;
388 504
389use base Net::FCP::Txn; 505use base Net::FCP::Txn;
390 506
391sub rcv_nodeinfo { 507sub rcv_node_info {
392 my ($self, $attr) = @_; 508 my ($self, $attr) = @_;
393 509
394 $self->eof ($attr); 510 $self->set_result ($attr);
395} 511}
396 512
397package Net::FCP::Txn::GenerateCHK; 513package Net::FCP::Txn::GenerateCHK;
398 514
399use base Net::FCP::Txn; 515use base Net::FCP::Txn;
400 516
401sub rcv_success { 517sub rcv_success {
402 my ($self, $attr) = @_; 518 my ($self, $attr) = @_;
403 519
404 $self->eof ($attr); 520 $self->set_result ($attr);
405} 521}
406 522
407package Net::FCP::Txn::GenerateSVKPair; 523package Net::FCP::Txn::GenerateSVKPair;
408 524
409use base Net::FCP::Txn; 525use base Net::FCP::Txn;
410 526
411sub rcv_success { 527sub rcv_success {
412 my ($self, $attr) = @_; 528 my ($self, $attr) = @_;
413 529
414 $self->eof ([$attr->{PublicKey}, $attr->{PrivateKey}]); 530 $self->set_result ([$attr->{PublicKey}, $attr->{PrivateKey}]);
415} 531}
416 532
417package Net::FCP::Txn::InvertPrivateKey; 533package Net::FCP::Txn::InvertPrivateKey;
418 534
419use base Net::FCP::Txn; 535use base Net::FCP::Txn;
420 536
421sub rcv_success { 537sub rcv_success {
422 my ($self, $attr) = @_; 538 my ($self, $attr) = @_;
423 539
424 $self->eof ($attr->{PublicKey}); 540 $self->set_result ($attr->{PublicKey});
425} 541}
426 542
427package Net::FCP::Txn::GetSize; 543package Net::FCP::Txn::GetSize;
428 544
429use base Net::FCP::Txn; 545use base Net::FCP::Txn;
430 546
431sub rcv_success { 547sub rcv_success {
432 my ($self, $attr) = @_; 548 my ($self, $attr) = @_;
433 549
434 $self->eof ($attr->{Length}); 550 $self->set_result ($attr->{Length});
551}
552
553package Net::FCP::Txn::ClientGet;
554
555use base Net::FCP::Txn;
556
557sub rcv_data_found {
558 my ($self, $attr) = @_;
559
560 $self->{datalength} = hex $attr->{data_length};
561 $self->{metalength} = hex $attr->{metadata_length};
562}
563
564sub rcv_restarted {
565 # nop, maybe feedback
566}
567
568sub 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]);
435} 575}
436 576
437=back 577=back
438 578
439=head1 SEE ALSO 579=head1 SEE ALSO

Diff Legend

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