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 *
#	User	Rev	Content
1	root	1.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	root	1.3	$VERSION = 0.02;
37	root	1.1
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	root	1.2	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	root	1.1	=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	root	1.2	$type = touc $type;
111
112			my $txn = "Net::FCP::Txn::$type"->new(fcp => $self, type => tolc $type, attr => \%attr);
113	root	1.1
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	root	1.2	max_file_size => "5f5e100",
131	root	1.4	node => "Fred,0.6,1.46,7050"
132	root	1.2	protocol => "1.2",
133	root	1.1	}
134
135			=cut
136
137			_txn client_hello => sub {
138			my ($self) = @_;
139
140	root	1.2	$self->txn ("client_hello");
141	root	1.1	};
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	root	1.2	active_jobs => "1f",
151			allocated_memory => "bde0000",
152			architecture => "i386",
153			available_threads => 17,
154	root	1.4	datastore_free => "5ce03400",
155			datastore_max => "2540be400",
156	root	1.2	datastore_used => "1f72bb000",
157	root	1.4	estimated_load => 52,
158			free_memory => "5cc0148",
159	root	1.2	is_transient => "false",
160	root	1.4	java_name => "Java HotSpot(_T_M) Server VM",
161	root	1.2	java_vendor => "http://www.blackdown.org/",
162	root	1.4	java_version => "Blackdown-1.4.1-01",
163			least_recent_timestamp => "f41538b878",
164			max_file_size => "5f5e100",
165	root	1.2	most_recent_timestamp => "f77e2cc520"
166	root	1.4	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	root	1.1	}
172
173			=cut
174
175			_txn client_info => sub {
176			my ($self) = @_;
177
178	root	1.2	$self->txn ("client_info");
179	root	1.1	};
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	root	1.2	$self->txn (generate_chk => data => "$data$metadata", meta_data_length => length $metadata);
193	root	1.1	};
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	root	1.2	$self->txn ("generate_svk_pair");
212	root	1.1	};
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	root	1.2	$self->txn (invert_private_key => private => $privkey);
232	root	1.1	};
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	root	1.2	$self->txn (get_size => URI => $uri);
249	root	1.1	};
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	root	1.2	$attr .= (Net::FCP::touc $k) . "=$v\012"
287	root	1.1	}
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	root	1.2	if (0) {
304			print
305			Net::FCP::touc $self->{type}, "\012",
306			$attr,
307			$data, "\012";
308			}
309	root	1.1
310			print $fh
311			"\x00\x00", "\x00\x02", # SESSID, PRESID
312	root	1.2	Net::FCP::touc $self->{type}, "\012",
313	root	1.1	$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	root	1.2	$self->rcv ($1, {
340			map { my ($a, $b) = split /=/, $_, 2; ((Net::FCP::tolc $a), $b) }
341			split /\015?\012/, $2
342			});
343	root	1.1	} 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	root	1.2	$type = Net::FCP::tolc $type;
362
363			if (my $method = $self->can("rcv_$type")) {
364	root	1.1	$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	root	1.2	sub rcv_node_hello {
403	root	1.1	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	root	1.2	sub rcv_node_info {
413	root	1.1	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