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.04;

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 $meta = Net::FCP::parse_metadata $string

Parse a metadata string and return it.

The metadata will be a hashref with key C<version> (containing
the mandatory version header entries).

All other headers are represented by arrayrefs (they can be repeated).

Since this is confusing, here is a rather verbose example of a parsed
manifest:

   (
      version => { revision => 1 },
      document => [
                    {
                      "info.format" => "image/jpeg",
                      name => "background.jpg",
                      "redirect.target" => "freenet:CHK\@ZcagI,ra726bSw"
                    },
                    {
                      "info.format" => "text/html",
                      name => ".next",
                      "redirect.target" => "freenet:SSK\@ilUPAgM/TFEE/3"
                    },
                    {
                      "info.format" => "text/html",
                      "redirect.target" => "freenet:CHK\@8M8Po8ucwI,8xA"
                    }
                  ]
   )

=cut

sub parse_metadata {
   my $meta;

   my $data = shift;
   if ($data =~ /^Version\015?\012/gc) {
      my $hdr = $meta->{version} = {};

      for (;;) {
         while ($data =~ /\G([^=\015\012]+)=([^\015\012]*)\015?\012/gc) {
            my ($k, $v) = ($1, $2);
            $hdr->{tolc $k} = $v;
         }

         if ($data =~ /\GEndPart\015?\012/gc) {
         } elsif ($data =~ /\GEnd\015?\012/gc) {
            last;
         } elsif ($data =~ /\G([A-Za-z0-9.\-]+)\015?\012/gcs) {
            push @{$meta->{tolc $1}}, $hdr = {};
         } elsif ($data =~ /\G(.*)/gcs) {
            die "metadata format error ($1)";
         }
      }
   }

   #$meta->{tail} = substr $data, pos $data;

   $meta;
}

=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, or the environment variables C<FREDHOST> and C<FREDPORT>).

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} ||= $ENV{FREDHOST} || "127.0.0.1";
   $self->{port} ||= $ENV{FREDPORt} || 8481;

   $self->{nodehello} = $self->client_hello
      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", metadata_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 $txn = $fcp->txn_client_get ($uri [, $htl = 15 [, $removelocal = 0]])

=item ($metadata, $data) = @{ $fcp->client_get ($uri, $htl, $removelocal)

Fetches a (small, as it should fit into memory) file from
freenet. C<$meta> is the metadata (as returned by C<parse_metadata> or
C<undef>).

Due to the overhead, a better method to download big files should be used.

  my ($meta, $data) = @{
     $fcp->client_get (
        "freenet:CHK@hdXaxkwZ9rA8-SidT0AN-bniQlgPAwI,XdCDmBuGsd-ulqbLnZ8v~w"
     )
  };

=cut

_txn client_get => sub {
   my ($self, $uri, $htl, $removelocal) = @_;

   $self->txn (client_get => URI => $uri, hops_to_live => ($htl || 15), remove_local => $removelocal*1);
};

=item MISSING: 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->rcv_data (substr $self->{buf}, 0, $self->{datalen}, "");
            } else {
               last;
            }
         } elsif ($self->{buf} =~ s/^DataChunk\015?\012Length=([0-9a-fA-F]+)\015?\012Data\015?\012//) {
            $self->{datalen} = hex $1;
         } elsif ($self->{buf} =~ s/^([a-zA-Z]+)\015?\012(?:(.+?)\015?\012)?EndMessage\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) = @_;

   $self->{data} .= $chunk;
}

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

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

   #use PApp::Util; warn PApp::Util::dumpval [$type, $attr];

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

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

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

sub eof {
   my ($self) = @_;
   $self->set_result;
}

=item $result = $txn->result

Waits until a result is available and then returns it.

This waiting is (depending on your event model) 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->set_result ($attr);
}

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

use base Net::FCP::Txn;

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

   $self->set_result ($attr);
}

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

use base Net::FCP::Txn;

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

   $self->set_result ($attr);
}

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

use base Net::FCP::Txn;

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

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

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

use base Net::FCP::Txn;

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

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

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

use base Net::FCP::Txn;

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

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

package Net::FCP::Txn::ClientGet;

use base Net::FCP::Txn;

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

   $self->{datalength} = hex $attr->{data_length};
   $self->{metalength} = hex $attr->{metadata_length};
}

sub rcv_restarted {
   # nop, maybe feedback
}

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

   my $data = delete $self->{data};
   my $meta = Net::FCP::parse_metadata substr $data, 0, $self->{metalength}, "";

   $self->set_result ([$meta, $data]);
}

=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.8
Committed:	Mon Sep 8 01:47:31 2003 UTC (20 years, 10 months ago) by root
Branch:	MAIN
Changes since 1.7:	+1 -1 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.8	$VERSION = 0.04;
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.7	=item $meta = Net::FCP::parse_metadata $string
78
79			Parse a metadata string and return it.
80
81			The metadata will be a hashref with key C<version> (containing
82			the mandatory version header entries).
83
84			All other headers are represented by arrayrefs (they can be repeated).
85
86			Since this is confusing, here is a rather verbose example of a parsed
87			manifest:
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
111			sub 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
140	root	1.1	=item $fcp = new Net::FCP [host => $host][, port => $port]
141
142			Create a new virtual FCP connection to the given host and port (default
143	root	1.5	127.0.0.1:8481, or the environment variables C<FREDHOST> and C<FREDPORT>).
144	root	1.1
145			Connections are virtual because no persistent physical connection is
146			established. However, the existance of the node is checked by executing a
147			C<ClientHello> transaction.
148
149			=cut
150
151			sub new {
152			my $class = shift;
153			my $self = bless { @_ }, $class;
154
155	root	1.5	$self->{host} \|\|= $ENV{FREDHOST} \|\| "127.0.0.1";
156			$self->{port} \|\|= $ENV{FREDPORt} \|\| 8481;
157	root	1.1
158	root	1.5	$self->{nodehello} = $self->client_hello
159	root	1.1	or croak "unable to get nodehello from node\n";
160
161			$self;
162			}
163
164			=item $txn = $fcp->txn(type => attr => val,...)
165
166			The low-level interface to transactions. Don't use it.
167
168			=cut
169
170			sub txn {
171			my ($self, $type, %attr) = @_;
172
173	root	1.2	$type = touc $type;
174
175			my $txn = "Net::FCP::Txn::$type"->new(fcp => $self, type => tolc $type, attr => \%attr);
176	root	1.1
177			$txn;
178			}
179
180			sub _txn($&) {
181			my ($name, $sub) = @_;
182			*{"$name\_txn"} = $sub;
183			*{$name} = sub { $sub->(@_)->result };
184			}
185
186			=item $txn = $fcp->txn_client_hello
187
188			=item $nodehello = $fcp->client_hello
189
190			Executes a ClientHello request and returns it's results.
191
192			{
193	root	1.2	max_file_size => "5f5e100",
194	root	1.4	node => "Fred,0.6,1.46,7050"
195	root	1.2	protocol => "1.2",
196	root	1.1	}
197
198			=cut
199
200			_txn client_hello => sub {
201			my ($self) = @_;
202
203	root	1.2	$self->txn ("client_hello");
204	root	1.1	};
205
206			=item $txn = $fcp->txn_client_info
207
208			=item $nodeinfo = $fcp->client_info
209
210			Executes a ClientInfo request and returns it's results.
211
212			{
213	root	1.2	active_jobs => "1f",
214			allocated_memory => "bde0000",
215			architecture => "i386",
216			available_threads => 17,
217	root	1.4	datastore_free => "5ce03400",
218			datastore_max => "2540be400",
219	root	1.2	datastore_used => "1f72bb000",
220	root	1.4	estimated_load => 52,
221			free_memory => "5cc0148",
222	root	1.2	is_transient => "false",
223	root	1.4	java_name => "Java HotSpot(_T_M) Server VM",
224	root	1.2	java_vendor => "http://www.blackdown.org/",
225	root	1.4	java_version => "Blackdown-1.4.1-01",
226			least_recent_timestamp => "f41538b878",
227			max_file_size => "5f5e100",
228	root	1.2	most_recent_timestamp => "f77e2cc520"
229	root	1.4	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",
234	root	1.1	}
235
236			=cut
237
238			_txn client_info => sub {
239			my ($self) = @_;
240
241	root	1.2	$self->txn ("client_info");
242	root	1.1	};
243
244			=item $txn = $fcp->txn_generate_chk ($metadata, $data)
245
246			=item $uri = $fcp->generate_chk ($metadata, $data)
247
248			Creates a new CHK, given the metadata and data. UNTESTED.
249
250			=cut
251
252			_txn generate_chk => sub {
253			my ($self, $metadata, $data) = @_;
254
255	root	1.7	$self->txn (generate_chk => data => "$data$metadata", metadata_length => length $metadata);
256	root	1.1	};
257
258			=item $txn = $fcp->txn_generate_svk_pair
259
260			=item ($public, $private) = @{ $fcp->generate_svk_pair }
261
262			Creates a new SVK pair. Returns an arrayref.
263
264			[
265			"hKs0-WDQA4pVZyMPKNFsK1zapWY",
266			"ZnmvMITaTXBMFGl4~jrjuyWxOWg"
267			]
268
269			=cut
270
271			_txn generate_svk_pair => sub {
272			my ($self) = @_;
273
274	root	1.2	$self->txn ("generate_svk_pair");
275	root	1.1	};
276
277			=item $txn = $fcp->txn_insert_private_key ($private)
278
279			=item $uri = $fcp->insert_private_key ($private)
280
281			Inserts a private key. $private can be either an insert URI (must start
282			with freenet:SSK@) or a raw private key (i.e. the private value you get back
283			from C<generate_svk_pair>).
284
285			Returns the public key.
286
287			UNTESTED.
288
289			=cut
290
291			_txn insert_private_key => sub {
292			my ($self, $privkey) = @_;
293
294	root	1.2	$self->txn (invert_private_key => private => $privkey);
295	root	1.1	};
296
297			=item $txn = $fcp->txn_get_size ($uri)
298
299			=item $length = $fcp->get_size ($uri)
300
301			Finds and returns the size (rounded up to the nearest power of two) of the
302			given document.
303
304			UNTESTED.
305
306			=cut
307
308			_txn get_size => sub {
309			my ($self, $uri) = @_;
310
311	root	1.2	$self->txn (get_size => URI => $uri);
312	root	1.1	};
313
314	root	1.5	=item $txn = $fcp->txn_client_get ($uri [, $htl = 15 [, $removelocal = 0]])
315
316	root	1.7	=item ($metadata, $data) = @{ $fcp->client_get ($uri, $htl, $removelocal)
317	root	1.5
318	root	1.7	Fetches a (small, as it should fit into memory) file from
319			freenet. C<$meta> is the metadata (as returned by C<parse_metadata> or
320			C<undef>).
321	root	1.5
322	root	1.7	Due to the overhead, a better method to download big files should be used.
323	root	1.5
324	root	1.7	my ($meta, $data) = @{
325	root	1.5	$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
338			=item MISSING: ClientPut
339	root	1.1
340			=back
341
342			=head2 THE Net::FCP::Txn CLASS
343
344			All requests (or transactions) are executed in a asynchroneous way (LIE:
345			uploads are blocking). For each request, a C<Net::FCP::Txn> object is
346			created (worse: a tcp connection is created, too).
347
348			For each request there is actually a different subclass (and it's possible
349			to subclass these, although of course not documented).
350
351			The most interesting method is C<result>.
352
353			=over 4
354
355			=cut
356
357			package Net::FCP::Txn;
358
359			=item new arg => val,...
360
361			Creates a new C<Net::FCP::Txn> object. Not normally used.
362
363			=cut
364
365			sub new {
366			my $class = shift;
367			my $self = bless { @_ }, $class;
368
369			my $attr = "";
370			my $data = delete $self->{attr}{data};
371
372			while (my ($k, $v) = each %{$self->{attr}}) {
373	root	1.2	$attr .= (Net::FCP::touc $k) . "=$v\012"
374	root	1.1	}
375
376			if (defined $data) {
377			$attr .= "DataLength=" . (length $data) . "\012";
378			$data = "Data\012$data";
379			} else {
380			$data = "EndMessage\012";
381			}
382
383			my $fh = new IO::Socket::INET
384			PeerHost => $self->{fcp}{host},
385			PeerPort => $self->{fcp}{port}
386			or Carp::croak "FCP::txn: unable to connect to $self->{fcp}{host}:$self->{fcp}{port}: $!\n";
387
388			binmode $fh, ":raw";
389
390	root	1.2	if (0) {
391			print
392			Net::FCP::touc $self->{type}, "\012",
393			$attr,
394			$data, "\012";
395			}
396	root	1.1
397			print $fh
398			"\x00\x00", "\x00\x02", # SESSID, PRESID
399	root	1.2	Net::FCP::touc $self->{type}, "\012",
400	root	1.1	$attr,
401			$data;
402
403			#$fh->shutdown (1); # freenet buggy?, well, it's java...
404
405			$self->{fh} = $fh;
406
407			$Net::FCP::regcb->($self);
408
409			$self;
410			}
411
412			sub fh_ready {
413			my ($self) = @_;
414
415			if (sysread $self->{fh}, $self->{buf}, 65536, length $self->{buf}) {
416			for (;;) {
417			if ($self->{datalen}) {
418			if (length $self->{buf} >= $self->{datalen}) {
419	root	1.5	$self->rcv_data (substr $self->{buf}, 0, $self->{datalen}, "");
420	root	1.1	} else {
421			last;
422			}
423	root	1.5	} elsif ($self->{buf} =~ s/^DataChunk\015?\012Length=([0-9a-fA-F]+)\015?\012Data\015?\012//) {
424			$self->{datalen} = hex $1;
425	root	1.7	} elsif ($self->{buf} =~ s/^([a-zA-Z]+)\015?\012(?:(.+?)\015?\012)?EndMessage\015?\012//s) {
426	root	1.2	$self->rcv ($1, {
427			map { my ($a, $b) = split /=/, $_, 2; ((Net::FCP::tolc $a), $b) }
428			split /\015?\012/, $2
429			});
430	root	1.1	} else {
431			last;
432			}
433			}
434			} else {
435			$Net::FCP::unregcb->($self);
436			delete $self->{fh};
437			$self->eof;
438			}
439			}
440
441			sub rcv_data {
442			my ($self, $chunk) = @_;
443	root	1.5
444			$self->{data} .= $chunk;
445	root	1.1	}
446
447			sub rcv {
448			my ($self, $type, $attr) = @_;
449
450	root	1.2	$type = Net::FCP::tolc $type;
451
452	root	1.5	#use PApp::Util; warn PApp::Util::dumpval [$type, $attr];
453
454	root	1.2	if (my $method = $self->can("rcv_$type")) {
455	root	1.1	$method->($self, $attr, $type);
456			} else {
457			warn "received unexpected reply type '$type' for '$self->{type}', ignoring\n";
458			}
459			}
460
461	root	1.5	sub set_result {
462	root	1.1	my ($self, $result) = @_;
463
464			$self->{result} = $result unless exists $self->{result};
465			}
466
467	root	1.5	sub eof {
468			my ($self) = @_;
469			$self->set_result;
470			}
471
472	root	1.1	=item $result = $txn->result
473
474			Waits until a result is available and then returns it.
475
476	root	1.5	This waiting is (depending on your event model) not very efficient, as it
477	root	1.1	is done outside the "mainloop".
478
479			=cut
480
481			sub result {
482			my ($self) = @_;
483
484			$Net::FCP::waitcb->() while !exists $self->{result};
485
486			return $self->{result};
487			}
488
489			sub DESTROY {
490			$Net::FCP::unregcb->($_[0]);
491			}
492
493			package Net::FCP::Txn::ClientHello;
494
495			use base Net::FCP::Txn;
496
497	root	1.2	sub rcv_node_hello {
498	root	1.1	my ($self, $attr) = @_;
499
500	root	1.5	$self->set_result ($attr);
501	root	1.1	}
502
503			package Net::FCP::Txn::ClientInfo;
504
505			use base Net::FCP::Txn;
506
507	root	1.2	sub rcv_node_info {
508	root	1.1	my ($self, $attr) = @_;
509
510	root	1.5	$self->set_result ($attr);
511	root	1.1	}
512
513			package Net::FCP::Txn::GenerateCHK;
514
515			use base Net::FCP::Txn;
516
517			sub rcv_success {
518			my ($self, $attr) = @_;
519
520	root	1.5	$self->set_result ($attr);
521	root	1.1	}
522
523			package Net::FCP::Txn::GenerateSVKPair;
524
525			use base Net::FCP::Txn;
526
527			sub rcv_success {
528			my ($self, $attr) = @_;
529
530	root	1.5	$self->set_result ([$attr->{PublicKey}, $attr->{PrivateKey}]);
531	root	1.1	}
532
533			package Net::FCP::Txn::InvertPrivateKey;
534
535			use base Net::FCP::Txn;
536
537			sub rcv_success {
538			my ($self, $attr) = @_;
539
540	root	1.5	$self->set_result ($attr->{PublicKey});
541	root	1.1	}
542
543			package Net::FCP::Txn::GetSize;
544
545			use base Net::FCP::Txn;
546
547			sub rcv_success {
548			my ($self, $attr) = @_;
549
550	root	1.5	$self->set_result ($attr->{Length});
551			}
552
553			package Net::FCP::Txn::ClientGet;
554
555			use base Net::FCP::Txn;
556
557			sub rcv_data_found {
558			my ($self, $attr) = @_;
559
560			$self->{datalength} = hex $attr->{data_length};
561	root	1.7	$self->{metalength} = hex $attr->{metadata_length};
562			}
563
564			sub rcv_restarted {
565			# nop, maybe feedback
566	root	1.5	}
567
568			sub eof {
569			my ($self) = @_;
570	root	1.7
571	root	1.5	my $data = delete $self->{data};
572	root	1.7	my $meta = Net::FCP::parse_metadata substr $data, 0, $self->{metalength}, "";
573
574			$self->set_result ([$meta, $data]);
575	root	1.1	}
576
577			=back
578
579			=head1 SEE ALSO
580
581			L<http://freenet.sf.net>.
582
583			=head1 BUGS
584
585			=head1 AUTHOR
586
587			Marc Lehmann <pcg@goof.com>
588			http://www.goof.com/pcg/marc/
589
590			=cut
591
592			1;
593