Net-FCP/FCP.pm

=head1 NAME

Net::FCP - http://freenet.sf.net client protocol

=head1 SYNOPSIS

 use Net::FCP;

 my $fcp = new Net::FCP;

 my $ni = $fcp->txn_node_info->result;
 my $ni = $fcp->node_info;

=head1 DESCRIPTION

See L<http://freenet.sourceforge.net/index.php?page=fcp> for a description
of what the messages do. I am too lazy to document all this here.

=head1 WARNING

This module is alpha. While it probably won't destroy (much :) of your
data, it currently works only with the Event module (alkthough the event
mechanism is fully pluggable).

=head2 THE Net::FCP CLASS

=over 4

=cut

package Net::FCP;

use Carp;
use IO::Socket::INET;

$VERSION = 0.02;

sub event_reg_cb {
   my ($obj) = @_;
   require Event;

   $obj->{eventdata} = Event->io (
      fd   => $obj->{fh},
      poll => 'r',
      cb   => sub {
         $obj->fh_ready;
      },
   );
}

sub event_unreg_cb {
   $_[0]{eventdata}
      and (delete $_[0]{eventdata})->cancel;
}

sub event_wait_cb {
   Event::one_event();
}

$regcb = \&event_reg_cb;
$unregcb = \&event_unreg_cb;
$waitcb = \&event_wait_cb;

sub touc($) {
   local $_ = shift;
   1 while s/((?:^|_)(?:svk|chk|uri)(?:_|$))/\U$1/;
   s/(?:^|_)(.)/\U$1/g;
   $_;
}

sub tolc($) {
   local $_ = shift;
   s/(?<=[a-z])(?=[A-Z])/_/g;
   lc $_;
}

=item $fcp = new Net::FCP [host => $host][, port => $port]

Create a new virtual FCP connection to the given host and port (default
127.0.0.1:8481).

Connections are virtual because no persistent physical connection is
established. However, the existance of the node is checked by executing a
C<ClientHello> transaction.

=cut

sub new {
   my $class = shift;
   my $self = bless { @_ }, $class;

   $self->{host} ||= "127.0.0.1";
   $self->{port} ||= 8481;

   $self->{nodehello} = $self->txn("ClientHello")->result
      or croak "unable to get nodehello from node\n";

   $self;
}

=item $txn = $fcp->txn(type => attr => val,...)

The low-level interface to transactions. Don't use it.

=cut

sub txn {
   my ($self, $type, %attr) = @_;

   $type = touc $type;

   my $txn = "Net::FCP::Txn::$type"->new(fcp => $self, type => tolc $type, attr => \%attr);

   $txn;
}

sub _txn($&) {
   my ($name, $sub) = @_;
   *{"$name\_txn"} = $sub;
   *{$name} = sub { $sub->(@_)->result };
}

=item $txn = $fcp->txn_client_hello

=item $nodehello = $fcp->client_hello

Executes a ClientHello request and returns it's results.

   {
     max_file_size => "5f5e100",
     node => "Fred,0.6,1.46,7050"
     protocol => "1.2",
   }

=cut

_txn client_hello => sub {
   my ($self) = @_;

   $self->txn ("client_hello");
};

=item $txn = $fcp->txn_client_info

=item $nodeinfo = $fcp->client_info

Executes a ClientInfo request and returns it's results.

   {
     active_jobs => "1f",
     allocated_memory => "bde0000",
     architecture => "i386",
     available_threads => 17,
     datastore_free => "5ce03400",
     datastore_max => "2540be400",
     datastore_used => "1f72bb000",
     estimated_load => 52,
     free_memory => "5cc0148",
     is_transient => "false",
     java_name => "Java HotSpot(_T_M) Server VM",
     java_vendor => "http://www.blackdown.org/",
     java_version => "Blackdown-1.4.1-01",
     least_recent_timestamp => "f41538b878",
     max_file_size => "5f5e100",
     most_recent_timestamp => "f77e2cc520"
     node_address => "1.2.3.4",
     node_port => 369,
     operating_system => "Linux",
     operating_system_version => "2.4.20",
     routing_time => "a5",
   }

=cut

_txn client_info => sub {
   my ($self) = @_;

   $self->txn ("client_info");
};

=item $txn = $fcp->txn_generate_chk ($metadata, $data)

=item $uri = $fcp->generate_chk ($metadata, $data)

Creates a new CHK, given the metadata and data. UNTESTED.

=cut

_txn generate_chk => sub {
   my ($self, $metadata, $data) = @_;

   $self->txn (generate_chk => data => "$data$metadata", meta_data_length => length $metadata);
};

=item $txn = $fcp->txn_generate_svk_pair

=item ($public, $private) = @{ $fcp->generate_svk_pair }

Creates a new SVK pair. Returns an arrayref.

   [
     "hKs0-WDQA4pVZyMPKNFsK1zapWY",
     "ZnmvMITaTXBMFGl4~jrjuyWxOWg"
   ]

=cut

_txn generate_svk_pair => sub {
   my ($self) = @_;

   $self->txn ("generate_svk_pair");
};

=item $txn = $fcp->txn_insert_private_key ($private)

=item $uri = $fcp->insert_private_key ($private)

Inserts a private key. $private can be either an insert URI (must start
with freenet:SSK@) or a raw private key (i.e. the private value you get back
from C<generate_svk_pair>).

Returns the public key.

UNTESTED.

=cut

_txn insert_private_key => sub {
   my ($self, $privkey) = @_;

   $self->txn (invert_private_key => private => $privkey);
};

=item $txn = $fcp->txn_get_size ($uri)

=item $length = $fcp->get_size ($uri)

Finds and returns the size (rounded up to the nearest power of two) of the
given document.

UNTESTED.

=cut

_txn get_size => sub {
   my ($self, $uri) = @_;

   $self->txn (get_size => URI => $uri);
};

=item MISSING: ClientGet, ClientPut

=back

=head2 THE Net::FCP::Txn CLASS

All requests (or transactions) are executed in a asynchroneous way (LIE:
uploads are blocking). For each request, a C<Net::FCP::Txn> object is
created (worse: a tcp connection is created, too).

For each request there is actually a different subclass (and it's possible
to subclass these, although of course not documented).

The most interesting method is C<result>.

=over 4

=cut

package Net::FCP::Txn;

=item new arg => val,...

Creates a new C<Net::FCP::Txn> object. Not normally used.

=cut

sub new {
   my $class = shift;
   my $self = bless { @_ }, $class;

   my $attr = "";
   my $data = delete $self->{attr}{data};

   while (my ($k, $v) = each %{$self->{attr}}) {
      $attr .= (Net::FCP::touc $k) . "=$v\012"
   }

   if (defined $data) {
      $attr .= "DataLength=" . (length $data) . "\012";
      $data = "Data\012$data";
   } else {
      $data = "EndMessage\012";
   }

   my $fh = new IO::Socket::INET
      PeerHost => $self->{fcp}{host},
      PeerPort => $self->{fcp}{port}
      or Carp::croak "FCP::txn: unable to connect to $self->{fcp}{host}:$self->{fcp}{port}: $!\n";

   binmode $fh, ":raw";

   if (0) {
      print
         Net::FCP::touc $self->{type}, "\012",
         $attr,
         $data, "\012";
   }

   print $fh
      "\x00\x00", "\x00\x02", # SESSID, PRESID
      Net::FCP::touc $self->{type}, "\012",
      $attr,
      $data;

   #$fh->shutdown (1); # freenet buggy?, well, it's java...
   
   $self->{fh} = $fh;
   
   $Net::FCP::regcb->($self);
   
   $self;
}

sub fh_ready {
   my ($self) = @_;

   if (sysread $self->{fh}, $self->{buf}, 65536, length $self->{buf}) {
      for (;;) {
         if ($self->{datalen}) {
            if (length $self->{buf} >= $self->{datalen}) {
               $self->recv_data (substr $self->{buf}, 0, $self->{datalen}, "");
            } else {
               last;
            }
         } elsif ($self->{buf} =~ s/^DataChunk\015?\012Length=(\d+)\015?\012Data\015?\012//) {
            $self->{datalen} = $1;
         } elsif ($self->{buf} =~ s/^([a-zA-Z]+)\015?\012(.*?)\015?\012EndMessage\015?\012//s) {
            $self->rcv ($1, {
                  map { my ($a, $b) = split /=/, $_, 2; ((Net::FCP::tolc $a), $b) }
                      split /\015?\012/, $2
            });
         } else {
            last;
         }
      }
   } else {
      $Net::FCP::unregcb->($self);
      delete $self->{fh};
      $self->eof;
   }
}

sub rcv_data {
   my ($self, $chunk) = @_;
}

sub rcv {
   my ($self, $type, $attr) = @_;

   $type = Net::FCP::tolc $type;

   if (my $method = $self->can("rcv_$type")) {
      $method->($self, $attr, $type);
   } else {
      warn "received unexpected reply type '$type' for '$self->{type}', ignoring\n";
      $self->eof;
   }
}

sub eof {
   my ($self, $result) = @_;

   $self->{result} = $result unless exists $self->{result};
}

=item $result = $txn->result

Waits until a result is available and then returns it.

This waiting is (depending on your event modul) not very efficient, as it
is done outside the "mainloop".

=cut

sub result {
   my ($self) = @_;

   $Net::FCP::waitcb->() while !exists $self->{result};

   return $self->{result};
}

sub DESTROY {
   $Net::FCP::unregcb->($_[0]);
}

package Net::FCP::Txn::ClientHello;

use base Net::FCP::Txn;

sub rcv_node_hello {
   my ($self, $attr) = @_;

   $self->eof ($attr);
}

package Net::FCP::Txn::ClientInfo;

use base Net::FCP::Txn;

sub rcv_node_info {
   my ($self, $attr) = @_;

   $self->eof ($attr);
}

package Net::FCP::Txn::GenerateCHK;

use base Net::FCP::Txn;

sub rcv_success {
   my ($self, $attr) = @_;

   $self->eof ($attr);
}

package Net::FCP::Txn::GenerateSVKPair;

use base Net::FCP::Txn;

sub rcv_success {
   my ($self, $attr) = @_;

   $self->eof ([$attr->{PublicKey}, $attr->{PrivateKey}]);
}

package Net::FCP::Txn::InvertPrivateKey;

use base Net::FCP::Txn;

sub rcv_success {
   my ($self, $attr) = @_;

   $self->eof ($attr->{PublicKey});
}

package Net::FCP::Txn::GetSize;

use base Net::FCP::Txn;

sub rcv_success {
   my ($self, $attr) = @_;

   $self->eof ($attr->{Length});
}

=back

=head1 SEE ALSO

L<http://freenet.sf.net>.

=head1 BUGS

=head1 AUTHOR

 Marc Lehmann <pcg@goof.com>
 http://www.goof.com/pcg/marc/

=cut

1;

Revision:	1.4
Committed:	Sun Sep 7 23:23:56 2003 UTC (20 years, 8 months ago) by root
Branch:	MAIN
Changes since 1.3:	+14 -14 lines
Log Message:	* empty log message *
#	Content
1	=head1 NAME
2
3	Net::FCP - http://freenet.sf.net client protocol
4
5	=head1 SYNOPSIS
6
7	use Net::FCP;
8
9	my $fcp = new Net::FCP;
10
11	my $ni = $fcp->txn_node_info->result;
12	my $ni = $fcp->node_info;
13
14	=head1 DESCRIPTION
15
16	See L<http://freenet.sourceforge.net/index.php?page=fcp> for a description
17	of what the messages do. I am too lazy to document all this here.
18
19	=head1 WARNING
20
21	This module is alpha. While it probably won't destroy (much :) of your
22	data, it currently works only with the Event module (alkthough the event
23	mechanism is fully pluggable).
24
25	=head2 THE Net::FCP CLASS
26
27	=over 4
28
29	=cut
30
31	package Net::FCP;
32
33	use Carp;
34	use IO::Socket::INET;
35
36	$VERSION = 0.02;
37
38	sub event_reg_cb {
39	my ($obj) = @_;
40	require Event;
41
42	$obj->{eventdata} = Event->io (
43	fd => $obj->{fh},
44	poll => 'r',
45	cb => sub {
46	$obj->fh_ready;
47	},
48	);
49	}
50
51	sub event_unreg_cb {
52	$_[0]{eventdata}
53	and (delete $_[0]{eventdata})->cancel;
54	}
55
56	sub event_wait_cb {
57	Event::one_event();
58	}
59
60	$regcb = \&event_reg_cb;
61	$unregcb = \&event_unreg_cb;
62	$waitcb = \&event_wait_cb;
63
64	sub touc($) {
65	local $_ = shift;
66	1 while s/((?:^\|_)(?:svk\|chk\|uri)(?:_\|$))/\U$1/;
67	s/(?:^\|_)(.)/\U$1/g;
68	$_;
69	}
70
71	sub tolc($) {
72	local $_ = shift;
73	s/(?<=[a-z])(?=[A-Z])/_/g;
74	lc $_;
75	}
76
77	=item $fcp = new Net::FCP [host => $host][, port => $port]
78
79	Create a new virtual FCP connection to the given host and port (default
80	127.0.0.1:8481).
81
82	Connections are virtual because no persistent physical connection is
83	established. However, the existance of the node is checked by executing a
84	C<ClientHello> transaction.
85
86	=cut
87
88	sub new {
89	my $class = shift;
90	my $self = bless { @_ }, $class;
91
92	$self->{host} \|\|= "127.0.0.1";
93	$self->{port} \|\|= 8481;
94
95	$self->{nodehello} = $self->txn("ClientHello")->result
96	or croak "unable to get nodehello from node\n";
97
98	$self;
99	}
100
101	=item $txn = $fcp->txn(type => attr => val,...)
102
103	The low-level interface to transactions. Don't use it.
104
105	=cut
106
107	sub txn {
108	my ($self, $type, %attr) = @_;
109
110	$type = touc $type;
111
112	my $txn = "Net::FCP::Txn::$type"->new(fcp => $self, type => tolc $type, attr => \%attr);
113
114	$txn;
115	}
116
117	sub _txn($&) {
118	my ($name, $sub) = @_;
119	*{"$name\_txn"} = $sub;
120	*{$name} = sub { $sub->(@_)->result };
121	}
122
123	=item $txn = $fcp->txn_client_hello
124
125	=item $nodehello = $fcp->client_hello
126
127	Executes a ClientHello request and returns it's results.
128
129	{
130	max_file_size => "5f5e100",
131	node => "Fred,0.6,1.46,7050"
132	protocol => "1.2",
133	}
134
135	=cut
136
137	_txn client_hello => sub {
138	my ($self) = @_;
139
140	$self->txn ("client_hello");
141	};
142
143	=item $txn = $fcp->txn_client_info
144
145	=item $nodeinfo = $fcp->client_info
146
147	Executes a ClientInfo request and returns it's results.
148
149	{
150	active_jobs => "1f",
151	allocated_memory => "bde0000",
152	architecture => "i386",
153	available_threads => 17,
154	datastore_free => "5ce03400",
155	datastore_max => "2540be400",
156	datastore_used => "1f72bb000",
157	estimated_load => 52,
158	free_memory => "5cc0148",
159	is_transient => "false",
160	java_name => "Java HotSpot(_T_M) Server VM",
161	java_vendor => "http://www.blackdown.org/",
162	java_version => "Blackdown-1.4.1-01",
163	least_recent_timestamp => "f41538b878",
164	max_file_size => "5f5e100",
165	most_recent_timestamp => "f77e2cc520"
166	node_address => "1.2.3.4",
167	node_port => 369,
168	operating_system => "Linux",
169	operating_system_version => "2.4.20",
170	routing_time => "a5",
171	}
172
173	=cut
174
175	_txn client_info => sub {
176	my ($self) = @_;
177
178	$self->txn ("client_info");
179	};
180
181	=item $txn = $fcp->txn_generate_chk ($metadata, $data)
182
183	=item $uri = $fcp->generate_chk ($metadata, $data)
184
185	Creates a new CHK, given the metadata and data. UNTESTED.
186
187	=cut
188
189	_txn generate_chk => sub {
190	my ($self, $metadata, $data) = @_;
191
192	$self->txn (generate_chk => data => "$data$metadata", meta_data_length => length $metadata);
193	};
194
195	=item $txn = $fcp->txn_generate_svk_pair
196
197	=item ($public, $private) = @{ $fcp->generate_svk_pair }
198
199	Creates a new SVK pair. Returns an arrayref.
200
201	[
202	"hKs0-WDQA4pVZyMPKNFsK1zapWY",
203	"ZnmvMITaTXBMFGl4~jrjuyWxOWg"
204	]
205
206	=cut
207
208	_txn generate_svk_pair => sub {
209	my ($self) = @_;
210
211	$self->txn ("generate_svk_pair");
212	};
213
214	=item $txn = $fcp->txn_insert_private_key ($private)
215
216	=item $uri = $fcp->insert_private_key ($private)
217
218	Inserts a private key. $private can be either an insert URI (must start
219	with freenet:SSK@) or a raw private key (i.e. the private value you get back
220	from C<generate_svk_pair>).
221
222	Returns the public key.
223
224	UNTESTED.
225
226	=cut
227
228	_txn insert_private_key => sub {
229	my ($self, $privkey) = @_;
230
231	$self->txn (invert_private_key => private => $privkey);
232	};
233
234	=item $txn = $fcp->txn_get_size ($uri)
235
236	=item $length = $fcp->get_size ($uri)
237
238	Finds and returns the size (rounded up to the nearest power of two) of the
239	given document.
240
241	UNTESTED.
242
243	=cut
244
245	_txn get_size => sub {
246	my ($self, $uri) = @_;
247
248	$self->txn (get_size => URI => $uri);
249	};
250
251	=item MISSING: ClientGet, ClientPut
252
253	=back
254
255	=head2 THE Net::FCP::Txn CLASS
256
257	All requests (or transactions) are executed in a asynchroneous way (LIE:
258	uploads are blocking). For each request, a C<Net::FCP::Txn> object is
259	created (worse: a tcp connection is created, too).
260
261	For each request there is actually a different subclass (and it's possible
262	to subclass these, although of course not documented).
263
264	The most interesting method is C<result>.
265
266	=over 4
267
268	=cut
269
270	package Net::FCP::Txn;
271
272	=item new arg => val,...
273
274	Creates a new C<Net::FCP::Txn> object. Not normally used.
275
276	=cut
277
278	sub new {
279	my $class = shift;
280	my $self = bless { @_ }, $class;
281
282	my $attr = "";
283	my $data = delete $self->{attr}{data};
284
285	while (my ($k, $v) = each %{$self->{attr}}) {
286	$attr .= (Net::FCP::touc $k) . "=$v\012"
287	}
288
289	if (defined $data) {
290	$attr .= "DataLength=" . (length $data) . "\012";
291	$data = "Data\012$data";
292	} else {
293	$data = "EndMessage\012";
294	}
295
296	my $fh = new IO::Socket::INET
297	PeerHost => $self->{fcp}{host},
298	PeerPort => $self->{fcp}{port}
299	or Carp::croak "FCP::txn: unable to connect to $self->{fcp}{host}:$self->{fcp}{port}: $!\n";
300
301	binmode $fh, ":raw";
302
303	if (0) {
304	print
305	Net::FCP::touc $self->{type}, "\012",
306	$attr,
307	$data, "\012";
308	}
309
310	print $fh
311	"\x00\x00", "\x00\x02", # SESSID, PRESID
312	Net::FCP::touc $self->{type}, "\012",
313	$attr,
314	$data;
315
316	#$fh->shutdown (1); # freenet buggy?, well, it's java...
317
318	$self->{fh} = $fh;
319
320	$Net::FCP::regcb->($self);
321
322	$self;
323	}
324
325	sub fh_ready {
326	my ($self) = @_;
327
328	if (sysread $self->{fh}, $self->{buf}, 65536, length $self->{buf}) {
329	for (;;) {
330	if ($self->{datalen}) {
331	if (length $self->{buf} >= $self->{datalen}) {
332	$self->recv_data (substr $self->{buf}, 0, $self->{datalen}, "");
333	} else {
334	last;
335	}
336	} elsif ($self->{buf} =~ s/^DataChunk\015?\012Length=(\d+)\015?\012Data\015?\012//) {
337	$self->{datalen} = $1;
338	} elsif ($self->{buf} =~ s/^([a-zA-Z]+)\015?\012(.*?)\015?\012EndMessage\015?\012//s) {
339	$self->rcv ($1, {
340	map { my ($a, $b) = split /=/, $_, 2; ((Net::FCP::tolc $a), $b) }
341	split /\015?\012/, $2
342	});
343	} else {
344	last;
345	}
346	}
347	} else {
348	$Net::FCP::unregcb->($self);
349	delete $self->{fh};
350	$self->eof;
351	}
352	}
353
354	sub rcv_data {
355	my ($self, $chunk) = @_;
356	}
357
358	sub rcv {
359	my ($self, $type, $attr) = @_;
360
361	$type = Net::FCP::tolc $type;
362
363	if (my $method = $self->can("rcv_$type")) {
364	$method->($self, $attr, $type);
365	} else {
366	warn "received unexpected reply type '$type' for '$self->{type}', ignoring\n";
367	$self->eof;
368	}
369	}
370
371	sub eof {
372	my ($self, $result) = @_;
373
374	$self->{result} = $result unless exists $self->{result};
375	}
376
377	=item $result = $txn->result
378
379	Waits until a result is available and then returns it.
380
381	This waiting is (depending on your event modul) not very efficient, as it
382	is done outside the "mainloop".
383
384	=cut
385
386	sub result {
387	my ($self) = @_;
388
389	$Net::FCP::waitcb->() while !exists $self->{result};
390
391	return $self->{result};
392	}
393
394	sub DESTROY {
395	$Net::FCP::unregcb->($_[0]);
396	}
397
398	package Net::FCP::Txn::ClientHello;
399
400	use base Net::FCP::Txn;
401
402	sub rcv_node_hello {
403	my ($self, $attr) = @_;
404
405	$self->eof ($attr);
406	}
407
408	package Net::FCP::Txn::ClientInfo;
409
410	use base Net::FCP::Txn;
411
412	sub rcv_node_info {
413	my ($self, $attr) = @_;
414
415	$self->eof ($attr);
416	}
417
418	package Net::FCP::Txn::GenerateCHK;
419
420	use base Net::FCP::Txn;
421
422	sub rcv_success {
423	my ($self, $attr) = @_;
424
425	$self->eof ($attr);
426	}
427
428	package Net::FCP::Txn::GenerateSVKPair;
429
430	use base Net::FCP::Txn;
431
432	sub rcv_success {
433	my ($self, $attr) = @_;
434
435	$self->eof ([$attr->{PublicKey}, $attr->{PrivateKey}]);
436	}
437
438	package Net::FCP::Txn::InvertPrivateKey;
439
440	use base Net::FCP::Txn;
441
442	sub rcv_success {
443	my ($self, $attr) = @_;
444
445	$self->eof ($attr->{PublicKey});
446	}
447
448	package Net::FCP::Txn::GetSize;
449
450	use base Net::FCP::Txn;
451
452	sub rcv_success {
453	my ($self, $attr) = @_;
454
455	$self->eof ($attr->{Length});
456	}
457
458	=back
459
460	=head1 SEE ALSO
461
462	L<http://freenet.sf.net>.
463
464	=head1 BUGS
465
466	=head1 AUTHOR
467
468	Marc Lehmann <pcg@goof.com>
469	http://www.goof.com/pcg/marc/
470
471	=cut
472
473	1;
474