cvsroot/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.01;

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;

=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) = @_;

   my $txn = "Net::FCP::Txn::$type"->new(fcp => $self, type => $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.

   {
     MaxFileSize => "5f5e100",
     Protocol => "1.2",
     Node => "Fred,0.6,1.46,7050"
   }

=cut

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

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

=item $txn = $fcp->txn_client_info

=item $nodeinfo = $fcp->client_info

Executes a ClientInfo request and returns it's results.

   {
     MaxFileSize => "5f5e100",
     DatastoreMax => "2540be400",
     NodePort => 369,
     JavaName => "Java HotSpot(TM) Server VM",
     OperatingSystemVersion => "2.4.20",
     EstimatedLoad => 52,
     FreeMemory => "5cc0148",
     DatastoreFree => "5ce03400",
     NodeAddress => "1.2.3.4",
     ActiveJobs => "1f",
     AllocatedMemory => "bde0000",
     Architecture => "i386",
     RoutingTime => "a5",
     LeastRecentTimestamp => "f41538b878",
     AvailableThreads => 17,
     DatastoreUsed => "1f72bb000",
     JavaVersion => "Blackdown-1.4.1-01",
     IsTransient => "false",
     OperatingSystem => "Linux",
     JavaVendor => "http://www.blackdown.org/",
     MostRecentTimestamp => "f77e2cc520"
   }

=cut

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

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

=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 (GenerateCHK => data => "$data$metadata", MetaDataLength => 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 ("GenerateSVKPair");
};

=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 (InvertPrivateKey => 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 (GetSize => 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 .= "$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";

   print
      $self->{type}, "\012",
      $attr,
      $data, "\012";

   print $fh
      "\x00\x00", "\x00\x02", # SESSID, PRESID
      $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 { split /=/, $_, 2 } 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) = @_;
   #use PApp::Util;warn "$type => ".PApp::Util::dumpval($attr);

   if (my $method = $self->can("rcv_\L$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_nodehello {
   my ($self, $attr) = @_;

   $self->eof ($attr);
}

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

use base Net::FCP::Txn;

sub rcv_nodeinfo {
   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.1
Committed:	Sun Sep 7 22:57:40 2003 UTC (20 years, 10 months ago) by root
Branch:	MAIN
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			$VERSION = 0.01;
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			=item $fcp = new Net::FCP [host => $host][, port => $port]
65
66			Create a new virtual FCP connection to the given host and port (default
67			127.0.0.1:8481).
68
69			Connections are virtual because no persistent physical connection is
70			established. However, the existance of the node is checked by executing a
71			C<ClientHello> transaction.
72
73			=cut
74
75			sub new {
76			my $class = shift;
77			my $self = bless { @_ }, $class;
78
79			$self->{host} \|\|= "127.0.0.1";
80			$self->{port} \|\|= 8481;
81
82			$self->{nodehello} = $self->txn("ClientHello")->result
83			or croak "unable to get nodehello from node\n";
84
85			$self;
86			}
87
88			=item $txn = $fcp->txn(type => attr => val,...)
89
90			The low-level interface to transactions. Don't use it.
91
92			=cut
93
94			sub txn {
95			my ($self, $type, %attr) = @_;
96
97			my $txn = "Net::FCP::Txn::$type"->new(fcp => $self, type => $type, attr => \%attr);
98
99			$txn;
100			}
101
102			sub _txn($&) {
103			my ($name, $sub) = @_;
104			*{"$name\_txn"} = $sub;
105			*{$name} = sub { $sub->(@_)->result };
106			}
107
108			=item $txn = $fcp->txn_client_hello
109
110			=item $nodehello = $fcp->client_hello
111
112			Executes a ClientHello request and returns it's results.
113
114			{
115			MaxFileSize => "5f5e100",
116			Protocol => "1.2",
117			Node => "Fred,0.6,1.46,7050"
118			}
119
120			=cut
121
122			_txn client_hello => sub {
123			my ($self) = @_;
124
125			$self->txn ("ClientHello");
126			};
127
128			=item $txn = $fcp->txn_client_info
129
130			=item $nodeinfo = $fcp->client_info
131
132			Executes a ClientInfo request and returns it's results.
133
134			{
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",
145			AllocatedMemory => "bde0000",
146			Architecture => "i386",
147			RoutingTime => "a5",
148			LeastRecentTimestamp => "f41538b878",
149			AvailableThreads => 17,
150			DatastoreUsed => "1f72bb000",
151			JavaVersion => "Blackdown-1.4.1-01",
152			IsTransient => "false",
153			OperatingSystem => "Linux",
154			JavaVendor => "http://www.blackdown.org/",
155			MostRecentTimestamp => "f77e2cc520"
156			}
157
158			=cut
159
160			_txn client_info => sub {
161			my ($self) = @_;
162
163			$self->txn ("ClientInfo");
164			};
165
166			=item $txn = $fcp->txn_generate_chk ($metadata, $data)
167
168			=item $uri = $fcp->generate_chk ($metadata, $data)
169
170			Creates a new CHK, given the metadata and data. UNTESTED.
171
172			=cut
173
174			_txn generate_chk => sub {
175			my ($self, $metadata, $data) = @_;
176
177			$self->txn (GenerateCHK => data => "$data$metadata", MetaDataLength => length $metadata);
178			};
179
180			=item $txn = $fcp->txn_generate_svk_pair
181
182			=item ($public, $private) = @{ $fcp->generate_svk_pair }
183
184			Creates a new SVK pair. Returns an arrayref.
185
186			[
187			"hKs0-WDQA4pVZyMPKNFsK1zapWY",
188			"ZnmvMITaTXBMFGl4~jrjuyWxOWg"
189			]
190
191			=cut
192
193			_txn generate_svk_pair => sub {
194			my ($self) = @_;
195
196			$self->txn ("GenerateSVKPair");
197			};
198
199			=item $txn = $fcp->txn_insert_private_key ($private)
200
201			=item $uri = $fcp->insert_private_key ($private)
202
203			Inserts a private key. $private can be either an insert URI (must start
204			with freenet:SSK@) or a raw private key (i.e. the private value you get back
205			from C<generate_svk_pair>).
206
207			Returns the public key.
208
209			UNTESTED.
210
211			=cut
212
213			_txn insert_private_key => sub {
214			my ($self, $privkey) = @_;
215
216			$self->txn (InvertPrivateKey => Private => $privkey);
217			};
218
219			=item $txn = $fcp->txn_get_size ($uri)
220
221			=item $length = $fcp->get_size ($uri)
222
223			Finds and returns the size (rounded up to the nearest power of two) of the
224			given document.
225
226			UNTESTED.
227
228			=cut
229
230			_txn get_size => sub {
231			my ($self, $uri) = @_;
232
233			$self->txn (GetSize => URI => $uri);
234			};
235
236			=item MISSING: ClientGet, ClientPut
237
238			=back
239
240			=head2 THE Net::FCP::Txn CLASS
241
242			All requests (or transactions) are executed in a asynchroneous way (LIE:
243			uploads are blocking). For each request, a C<Net::FCP::Txn> object is
244			created (worse: a tcp connection is created, too).
245
246			For each request there is actually a different subclass (and it's possible
247			to subclass these, although of course not documented).
248
249			The most interesting method is C<result>.
250
251			=over 4
252
253			=cut
254
255			package Net::FCP::Txn;
256
257			=item new arg => val,...
258
259			Creates a new C<Net::FCP::Txn> object. Not normally used.
260
261			=cut
262
263			sub new {
264			my $class = shift;
265			my $self = bless { @_ }, $class;
266
267			my $attr = "";
268			my $data = delete $self->{attr}{data};
269
270			while (my ($k, $v) = each %{$self->{attr}}) {
271			$attr .= "$k=$v\012"
272			}
273
274			if (defined $data) {
275			$attr .= "DataLength=" . (length $data) . "\012";
276			$data = "Data\012$data";
277			} else {
278			$data = "EndMessage\012";
279			}
280
281			my $fh = new IO::Socket::INET
282			PeerHost => $self->{fcp}{host},
283			PeerPort => $self->{fcp}{port}
284			or Carp::croak "FCP::txn: unable to connect to $self->{fcp}{host}:$self->{fcp}{port}: $!\n";
285
286			binmode $fh, ":raw";
287
288			print
289			$self->{type}, "\012",
290			$attr,
291			$data, "\012";
292
293			print $fh
294			"\x00\x00", "\x00\x02", # SESSID, PRESID
295			$self->{type}, "\012",
296			$attr,
297			$data;
298
299			#$fh->shutdown (1); # freenet buggy?, well, it's java...
300
301			$self->{fh} = $fh;
302
303			$Net::FCP::regcb->($self);
304
305			$self;
306			}
307
308			sub fh_ready {
309			my ($self) = @_;
310
311			if (sysread $self->{fh}, $self->{buf}, 65536, length $self->{buf}) {
312			for (;;) {
313			if ($self->{datalen}) {
314			if (length $self->{buf} >= $self->{datalen}) {
315			$self->recv_data (substr $self->{buf}, 0, $self->{datalen}, "");
316			} else {
317			last;
318			}
319			} elsif ($self->{buf} =~ s/^DataChunk\015?\012Length=(\d+)\015?\012Data\015?\012//) {
320			$self->{datalen} = $1;
321			} elsif ($self->{buf} =~ s/^([a-zA-Z]+)\015?\012(.*?)\015?\012EndMessage\015?\012//s) {
322			$self->rcv ($1, {map { split /=/, $_, 2 } split /\015?\012/, $2});
323			} else {
324			last;
325			}
326			}
327			} else {
328			$Net::FCP::unregcb->($self);
329			delete $self->{fh};
330			$self->eof;
331			}
332			}
333
334			sub rcv_data {
335			my ($self, $chunk) = @_;
336			}
337
338			sub rcv {
339			my ($self, $type, $attr) = @_;
340			#use PApp::Util;warn "$type => ".PApp::Util::dumpval($attr);
341
342			if (my $method = $self->can("rcv_\L$type")) {
343			$method->($self, $attr, $type);
344			} else {
345			warn "received unexpected reply type '$type' for '$self->{type}', ignoring\n";
346			$self->eof;
347			}
348			}
349
350			sub eof {
351			my ($self, $result) = @_;
352
353			$self->{result} = $result unless exists $self->{result};
354			}
355
356			=item $result = $txn->result
357
358			Waits until a result is available and then returns it.
359
360			This waiting is (depending on your event modul) not very efficient, as it
361			is done outside the "mainloop".
362
363			=cut
364
365			sub result {
366			my ($self) = @_;
367
368			$Net::FCP::waitcb->() while !exists $self->{result};
369
370			return $self->{result};
371			}
372
373			sub DESTROY {
374			$Net::FCP::unregcb->($_[0]);
375			}
376
377			package Net::FCP::Txn::ClientHello;
378
379			use base Net::FCP::Txn;
380
381			sub rcv_nodehello {
382			my ($self, $attr) = @_;
383
384			$self->eof ($attr);
385			}
386
387			package Net::FCP::Txn::ClientInfo;
388
389			use base Net::FCP::Txn;
390
391			sub rcv_nodeinfo {
392			my ($self, $attr) = @_;
393
394			$self->eof ($attr);
395			}
396
397			package Net::FCP::Txn::GenerateCHK;
398
399			use base Net::FCP::Txn;
400
401			sub rcv_success {
402			my ($self, $attr) = @_;
403
404			$self->eof ($attr);
405			}
406
407			package Net::FCP::Txn::GenerateSVKPair;
408
409			use base Net::FCP::Txn;
410
411			sub rcv_success {
412			my ($self, $attr) = @_;
413
414			$self->eof ([$attr->{PublicKey}, $attr->{PrivateKey}]);
415			}
416
417			package Net::FCP::Txn::InvertPrivateKey;
418
419			use base Net::FCP::Txn;
420
421			sub rcv_success {
422			my ($self, $attr) = @_;
423
424			$self->eof ($attr->{PublicKey});
425			}
426
427			package Net::FCP::Txn::GetSize;
428
429			use base Net::FCP::Txn;
430
431			sub rcv_success {
432			my ($self, $attr) = @_;
433
434			$self->eof ($attr->{Length});
435			}
436
437			=back
438
439			=head1 SEE ALSO
440
441			L<http://freenet.sf.net>.
442
443			=head1 BUGS
444
445			=head1 AUTHOR
446
447			Marc Lehmann <pcg@goof.com>
448			http://www.goof.com/pcg/marc/
449
450			=cut
451
452			1;
453