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 falls short of what it should provide (intelligent uri
following, splitfile downloads, healing...)

=head2 IMPORT TAGS

Nothing much can be "imported" from this module right now. There are,
however, certain "import tags" that can be used to select the event model
to be used.

Event models are implemented as modules under the C<Net::FCP::Event::xyz>
class, where C<xyz> is the event model to use. The default is C<Event> (or
later C<Auto>).

The import tag to use is named C<event=xyz>, e.g. C<event=Event>,
C<event=Glib> etc.

You should specify the event module to use only in the main program.

=head2 THE Net::FCP CLASS

=over 4

=cut

package Net::FCP;

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

$VERSION = 0.05;

no warnings;

our $EVENT = Net::FCP::Event::Auto::;
$EVENT = Net::FCP::Event::Event;#d#

sub import {
   shift;

   for (@_) {
      if (/^event=(\w+)$/) {
         $EVENT = "Net::FCP::Event::$1";
      }
   }
   eval "require $EVENT";
}

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;
}

sub progress {
   my ($self, $txn, $type, $attr) = @_;
   warn "progress<$txn,$type," . (join ":", %$attr) . ">\n";
}

=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;
   
   $EVENT->reg_r_cb ($self);
   
   $self;
}

=item $userdata = $txn->userdata ([$userdata])

Get and/or set user-specific data. This is useful in progress callbacks.

=cut

sub userdata($;$) {
   my ($self, $data) = @_;
   $self->{userdata} = $data if @_ >= 2;
   $self->{userdata};
}

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, delete $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 {
      $EVENT->unreg_r_cb ($self);
      delete $self->{fh};
      $self->eof;
   }
}

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

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

   $self->progress ("data", { chunk => length $chunk, total => length $self->{data}, end => $self->{datalength} });
}

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 throw {
   my ($self, $exc) = @_;

   $self->{exception} = $exc;
   $self->set_result (1);
}

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

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

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

sub progress {
   my ($self, $type, $attr) = @_;
   $self->{fcp}->progress ($self, $type, $attr);
}

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

   $EVENT->wait_event while !exists $self->{result};

   die $self->{exception} if $self->{exception};

   return $self->{result};
}

sub DESTROY {
   $EVENT->unreg_r_cb ($_[0]);
   #$EVENT->unreg_w_cb ($_[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, $type) = @_;

   $self->progress ($type, $attr);

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

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

   $self->throw (new Net::FCP::Exception $type, $attr);
}

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

   $self->throw (new Net::FCP::Exception $type, $attr);
}

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

   $self->throw (new Net::FCP::Exception $type, $attr);
}

sub rcv_restarted {
   my ($self, $attr, $type) = @_;
   $self->progress ($type, $attr);
}

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]);
}

package Net::FCP::Exception;

use overload
   '""' => sub {
      "Net::FCP::Exception<<$_[0][0]," . (join ":", %{$_[0][1]}) . ">>\n";
   };

sub new {
   my ($class, $type, $attr) = @_;

   bless [$type, { %$attr }], $class;
}

=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.11
Committed:	Tue Sep 9 18:52:39 2003 UTC (20 years, 8 months ago) by root
Branch:	MAIN
Changes since 1.10:	+1 -1 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 falls short of what it should provide (intelligent uri
23	following, splitfile downloads, healing...)
24
25	=head2 IMPORT TAGS
26
27	Nothing much can be "imported" from this module right now. There are,
28	however, certain "import tags" that can be used to select the event model
29	to be used.
30
31	Event models are implemented as modules under the C<Net::FCP::Event::xyz>
32	class, where C<xyz> is the event model to use. The default is C<Event> (or
33	later C<Auto>).
34
35	The import tag to use is named C<event=xyz>, e.g. C<event=Event>,
36	C<event=Glib> etc.
37
38	You should specify the event module to use only in the main program.
39
40	=head2 THE Net::FCP CLASS
41
42	=over 4
43
44	=cut
45
46	package Net::FCP;
47
48	use Carp;
49	use IO::Socket::INET;
50
51	$VERSION = 0.05;
52
53	no warnings;
54
55	our $EVENT = Net::FCP::Event::Auto::;
56	$EVENT = Net::FCP::Event::Event;#d#
57
58	sub import {
59	shift;
60
61	for (@_) {
62	if (/^event=(\w+)$/) {
63	$EVENT = "Net::FCP::Event::$1";
64	}
65	}
66	eval "require $EVENT";
67	}
68
69	sub touc($) {
70	local $_ = shift;
71	1 while s/((?:^\|_)(?:svk\|chk\|uri)(?:_\|$))/\U$1/;
72	s/(?:^\|_)(.)/\U$1/g;
73	$_;
74	}
75
76	sub tolc($) {
77	local $_ = shift;
78	s/(?<=[a-z])(?=[A-Z])/_/g;
79	lc $_;
80	}
81
82	=item $meta = Net::FCP::parse_metadata $string
83
84	Parse a metadata string and return it.
85
86	The metadata will be a hashref with key C<version> (containing
87	the mandatory version header entries).
88
89	All other headers are represented by arrayrefs (they can be repeated).
90
91	Since this is confusing, here is a rather verbose example of a parsed
92	manifest:
93
94	(
95	version => { revision => 1 },
96	document => [
97	{
98	"info.format" => "image/jpeg",
99	name => "background.jpg",
100	"redirect.target" => "freenet:CHK\@ZcagI,ra726bSw"
101	},
102	{
103	"info.format" => "text/html",
104	name => ".next",
105	"redirect.target" => "freenet:SSK\@ilUPAgM/TFEE/3"
106	},
107	{
108	"info.format" => "text/html",
109	"redirect.target" => "freenet:CHK\@8M8Po8ucwI,8xA"
110	}
111	]
112	)
113
114	=cut
115
116	sub parse_metadata {
117	my $meta;
118
119	my $data = shift;
120	if ($data =~ /^Version\015?\012/gc) {
121	my $hdr = $meta->{version} = {};
122
123	for (;;) {
124	while ($data =~ /\G([^=\015\012]+)=([^\015\012]*)\015?\012/gc) {
125	my ($k, $v) = ($1, $2);
126	$hdr->{tolc $k} = $v;
127	}
128
129	if ($data =~ /\GEndPart\015?\012/gc) {
130	} elsif ($data =~ /\GEnd\015?\012/gc) {
131	last;
132	} elsif ($data =~ /\G([A-Za-z0-9.\-]+)\015?\012/gcs) {
133	push @{$meta->{tolc $1}}, $hdr = {};
134	} elsif ($data =~ /\G(.*)/gcs) {
135	die "metadata format error ($1)";
136	}
137	}
138	}
139
140	#$meta->{tail} = substr $data, pos $data;
141
142	$meta;
143	}
144
145	=item $fcp = new Net::FCP [host => $host][, port => $port]
146
147	Create a new virtual FCP connection to the given host and port (default
148	127.0.0.1:8481, or the environment variables C<FREDHOST> and C<FREDPORT>).
149
150	Connections are virtual because no persistent physical connection is
151	established. However, the existance of the node is checked by executing a
152	C<ClientHello> transaction.
153
154	=cut
155
156	sub new {
157	my $class = shift;
158	my $self = bless { @_ }, $class;
159
160	$self->{host} \|\|= $ENV{FREDHOST} \|\| "127.0.0.1";
161	$self->{port} \|\|= $ENV{FREDPORt} \|\| 8481;
162
163	$self->{nodehello} = $self->client_hello
164	or croak "unable to get nodehello from node\n";
165
166	$self;
167	}
168
169	sub progress {
170	my ($self, $txn, $type, $attr) = @_;
171	warn "progress<$txn,$type," . (join ":", %$attr) . ">\n";
172	}
173
174	=item $txn = $fcp->txn(type => attr => val,...)
175
176	The low-level interface to transactions. Don't use it.
177
178	=cut
179
180	sub txn {
181	my ($self, $type, %attr) = @_;
182
183	$type = touc $type;
184
185	my $txn = "Net::FCP::Txn::$type"->new(fcp => $self, type => tolc $type, attr => \%attr);
186
187	$txn;
188	}
189
190	sub _txn($&) {
191	my ($name, $sub) = @_;
192	*{"$name\_txn"} = $sub;
193	*{$name} = sub { $sub->(@_)->result };
194	}
195
196	=item $txn = $fcp->txn_client_hello
197
198	=item $nodehello = $fcp->client_hello
199
200	Executes a ClientHello request and returns it's results.
201
202	{
203	max_file_size => "5f5e100",
204	node => "Fred,0.6,1.46,7050"
205	protocol => "1.2",
206	}
207
208	=cut
209
210	_txn client_hello => sub {
211	my ($self) = @_;
212
213	$self->txn ("client_hello");
214	};
215
216	=item $txn = $fcp->txn_client_info
217
218	=item $nodeinfo = $fcp->client_info
219
220	Executes a ClientInfo request and returns it's results.
221
222	{
223	active_jobs => "1f",
224	allocated_memory => "bde0000",
225	architecture => "i386",
226	available_threads => 17,
227	datastore_free => "5ce03400",
228	datastore_max => "2540be400",
229	datastore_used => "1f72bb000",
230	estimated_load => 52,
231	free_memory => "5cc0148",
232	is_transient => "false",
233	java_name => "Java HotSpot(_T_M) Server VM",
234	java_vendor => "http://www.blackdown.org/",
235	java_version => "Blackdown-1.4.1-01",
236	least_recent_timestamp => "f41538b878",
237	max_file_size => "5f5e100",
238	most_recent_timestamp => "f77e2cc520"
239	node_address => "1.2.3.4",
240	node_port => 369,
241	operating_system => "Linux",
242	operating_system_version => "2.4.20",
243	routing_time => "a5",
244	}
245
246	=cut
247
248	_txn client_info => sub {
249	my ($self) = @_;
250
251	$self->txn ("client_info");
252	};
253
254	=item $txn = $fcp->txn_generate_chk ($metadata, $data)
255
256	=item $uri = $fcp->generate_chk ($metadata, $data)
257
258	Creates a new CHK, given the metadata and data. UNTESTED.
259
260	=cut
261
262	_txn generate_chk => sub {
263	my ($self, $metadata, $data) = @_;
264
265	$self->txn (generate_chk => data => "$data$metadata", metadata_length => length $metadata);
266	};
267
268	=item $txn = $fcp->txn_generate_svk_pair
269
270	=item ($public, $private) = @{ $fcp->generate_svk_pair }
271
272	Creates a new SVK pair. Returns an arrayref.
273
274	[
275	"hKs0-WDQA4pVZyMPKNFsK1zapWY",
276	"ZnmvMITaTXBMFGl4~jrjuyWxOWg"
277	]
278
279	=cut
280
281	_txn generate_svk_pair => sub {
282	my ($self) = @_;
283
284	$self->txn ("generate_svk_pair");
285	};
286
287	=item $txn = $fcp->txn_insert_private_key ($private)
288
289	=item $uri = $fcp->insert_private_key ($private)
290
291	Inserts a private key. $private can be either an insert URI (must start
292	with freenet:SSK@) or a raw private key (i.e. the private value you get back
293	from C<generate_svk_pair>).
294
295	Returns the public key.
296
297	UNTESTED.
298
299	=cut
300
301	_txn insert_private_key => sub {
302	my ($self, $privkey) = @_;
303
304	$self->txn (invert_private_key => private => $privkey);
305	};
306
307	=item $txn = $fcp->txn_get_size ($uri)
308
309	=item $length = $fcp->get_size ($uri)
310
311	Finds and returns the size (rounded up to the nearest power of two) of the
312	given document.
313
314	UNTESTED.
315
316	=cut
317
318	_txn get_size => sub {
319	my ($self, $uri) = @_;
320
321	$self->txn (get_size => URI => $uri);
322	};
323
324	=item $txn = $fcp->txn_client_get ($uri [, $htl = 15 [, $removelocal = 0]])
325
326	=item ($metadata, $data) = @{ $fcp->client_get ($uri, $htl, $removelocal)
327
328	Fetches a (small, as it should fit into memory) file from
329	freenet. C<$meta> is the metadata (as returned by C<parse_metadata> or
330	C<undef>).
331
332	Due to the overhead, a better method to download big files should be used.
333
334	my ($meta, $data) = @{
335	$fcp->client_get (
336	"freenet:CHK@hdXaxkwZ9rA8-SidT0AN-bniQlgPAwI,XdCDmBuGsd-ulqbLnZ8v~w"
337	)
338	};
339
340	=cut
341
342	_txn client_get => sub {
343	my ($self, $uri, $htl, $removelocal) = @_;
344
345	$self->txn (client_get => URI => $uri, hops_to_live => ($htl \|\| 15), remove_local => $removelocal*1);
346	};
347
348	=item MISSING: ClientPut
349
350	=back
351
352	=head2 THE Net::FCP::Txn CLASS
353
354	All requests (or transactions) are executed in a asynchroneous way (LIE:
355	uploads are blocking). For each request, a C<Net::FCP::Txn> object is
356	created (worse: a tcp connection is created, too).
357
358	For each request there is actually a different subclass (and it's possible
359	to subclass these, although of course not documented).
360
361	The most interesting method is C<result>.
362
363	=over 4
364
365	=cut
366
367	package Net::FCP::Txn;
368
369	=item new arg => val,...
370
371	Creates a new C<Net::FCP::Txn> object. Not normally used.
372
373	=cut
374
375	sub new {
376	my $class = shift;
377	my $self = bless { @_ }, $class;
378
379	my $attr = "";
380	my $data = delete $self->{attr}{data};
381
382	while (my ($k, $v) = each %{$self->{attr}}) {
383	$attr .= (Net::FCP::touc $k) . "=$v\012"
384	}
385
386	if (defined $data) {
387	$attr .= "DataLength=" . (length $data) . "\012";
388	$data = "Data\012$data";
389	} else {
390	$data = "EndMessage\012";
391	}
392
393	my $fh = new IO::Socket::INET
394	PeerHost => $self->{fcp}{host},
395	PeerPort => $self->{fcp}{port}
396	or Carp::croak "FCP::txn: unable to connect to $self->{fcp}{host}:$self->{fcp}{port}: $!\n";
397
398	binmode $fh, ":raw";
399
400	if (0) {
401	print
402	Net::FCP::touc $self->{type}, "\012",
403	$attr,
404	$data, "\012";
405	}
406
407	print $fh
408	"\x00\x00", "\x00\x02", # SESSID, PRESID
409	Net::FCP::touc $self->{type}, "\012",
410	$attr,
411	$data;
412
413	#$fh->shutdown (1); # freenet buggy?, well, it's java...
414
415	$self->{fh} = $fh;
416
417	$EVENT->reg_r_cb ($self);
418
419	$self;
420	}
421
422	=item $userdata = $txn->userdata ([$userdata])
423
424	Get and/or set user-specific data. This is useful in progress callbacks.
425
426	=cut
427
428	sub userdata($;$) {
429	my ($self, $data) = @_;
430	$self->{userdata} = $data if @_ >= 2;
431	$self->{userdata};
432	}
433
434	sub fh_ready {
435	my ($self) = @_;
436
437	if (sysread $self->{fh}, $self->{buf}, 65536, length $self->{buf}) {
438	for (;;) {
439	if ($self->{datalen}) {
440	if (length $self->{buf} >= $self->{datalen}) {
441	$self->rcv_data (substr $self->{buf}, 0, delete $self->{datalen}, "");
442	} else {
443	last;
444	}
445	} elsif ($self->{buf} =~ s/^DataChunk\015?\012Length=([0-9a-fA-F]+)\015?\012Data\015?\012//) {
446	$self->{datalen} = hex $1;
447	} elsif ($self->{buf} =~ s/^([a-zA-Z]+)\015?\012(?:(.+?)\015?\012)?EndMessage\015?\012//s) {
448	$self->rcv ($1, {
449	map { my ($a, $b) = split /=/, $_, 2; ((Net::FCP::tolc $a), $b) }
450	split /\015?\012/, $2
451	});
452	} else {
453	last;
454	}
455	}
456	} else {
457	$EVENT->unreg_r_cb ($self);
458	delete $self->{fh};
459	$self->eof;
460	}
461	}
462
463	sub rcv_data {
464	my ($self, $chunk) = @_;
465
466	$self->{data} .= $chunk;
467
468	$self->progress ("data", { chunk => length $chunk, total => length $self->{data}, end => $self->{datalength} });
469	}
470
471	sub rcv {
472	my ($self, $type, $attr) = @_;
473
474	$type = Net::FCP::tolc $type;
475
476	#use PApp::Util; warn PApp::Util::dumpval [$type, $attr];
477
478	if (my $method = $self->can("rcv_$type")) {
479	$method->($self, $attr, $type);
480	} else {
481	warn "received unexpected reply type '$type' for '$self->{type}', ignoring\n";
482	}
483	}
484
485	sub throw {
486	my ($self, $exc) = @_;
487
488	$self->{exception} = $exc;
489	$self->set_result (1);
490	}
491
492	sub set_result {
493	my ($self, $result) = @_;
494
495	$self->{result} = $result unless exists $self->{result};
496	}
497
498	sub eof {
499	my ($self) = @_;
500	$self->set_result;
501	}
502
503	sub progress {
504	my ($self, $type, $attr) = @_;
505	$self->{fcp}->progress ($self, $type, $attr);
506	}
507
508	=item $result = $txn->result
509
510	Waits until a result is available and then returns it.
511
512	This waiting is (depending on your event model) not very efficient, as it
513	is done outside the "mainloop".
514
515	=cut
516
517	sub result {
518	my ($self) = @_;
519
520	$EVENT->wait_event while !exists $self->{result};
521
522	die $self->{exception} if $self->{exception};
523
524	return $self->{result};
525	}
526
527	sub DESTROY {
528	$EVENT->unreg_r_cb ($_[0]);
529	#$EVENT->unreg_w_cb ($_[0]);
530	}
531
532	package Net::FCP::Txn::ClientHello;
533
534	use base Net::FCP::Txn;
535
536	sub rcv_node_hello {
537	my ($self, $attr) = @_;
538
539	$self->set_result ($attr);
540	}
541
542	package Net::FCP::Txn::ClientInfo;
543
544	use base Net::FCP::Txn;
545
546	sub rcv_node_info {
547	my ($self, $attr) = @_;
548
549	$self->set_result ($attr);
550	}
551
552	package Net::FCP::Txn::GenerateCHK;
553
554	use base Net::FCP::Txn;
555
556	sub rcv_success {
557	my ($self, $attr) = @_;
558
559	$self->set_result ($attr);
560	}
561
562	package Net::FCP::Txn::GenerateSVKPair;
563
564	use base Net::FCP::Txn;
565
566	sub rcv_success {
567	my ($self, $attr) = @_;
568
569	$self->set_result ([$attr->{PublicKey}, $attr->{PrivateKey}]);
570	}
571
572	package Net::FCP::Txn::InvertPrivateKey;
573
574	use base Net::FCP::Txn;
575
576	sub rcv_success {
577	my ($self, $attr) = @_;
578
579	$self->set_result ($attr->{PublicKey});
580	}
581
582	package Net::FCP::Txn::GetSize;
583
584	use base Net::FCP::Txn;
585
586	sub rcv_success {
587	my ($self, $attr) = @_;
588
589	$self->set_result ($attr->{Length});
590	}
591
592	package Net::FCP::Txn::ClientGet;
593
594	use base Net::FCP::Txn;
595
596	sub rcv_data_found {
597	my ($self, $attr, $type) = @_;
598
599	$self->progress ($type, $attr);
600
601	$self->{datalength} = hex $attr->{data_length};
602	$self->{metalength} = hex $attr->{metadata_length};
603	}
604
605	sub rcv_route_not_found {
606	my ($self, $attr, $type) = @_;
607
608	$self->throw (new Net::FCP::Exception $type, $attr);
609	}
610
611	sub rcv_data_not_found {
612	my ($self, $attr, $type) = @_;
613
614	$self->throw (new Net::FCP::Exception $type, $attr);
615	}
616
617	sub rcv_format_error {
618	my ($self, $attr, $type) = @_;
619
620	$self->throw (new Net::FCP::Exception $type, $attr);
621	}
622
623	sub rcv_restarted {
624	my ($self, $attr, $type) = @_;
625	$self->progress ($type, $attr);
626	}
627
628	sub eof {
629	my ($self) = @_;
630
631	my $data = delete $self->{data};
632	my $meta = Net::FCP::parse_metadata substr $data, 0, $self->{metalength}, "";
633
634	$self->set_result ([$meta, $data]);
635	}
636
637	package Net::FCP::Exception;
638
639	use overload
640	'""' => sub {
641	"Net::FCP::Exception<<$_[0][0]," . (join ":", %{$_[0][1]}) . ">>\n";
642	};
643
644	sub new {
645	my ($class, $type, $attr) = @_;
646
647	bless [$type, { %$attr }], $class;
648	}
649
650	=back
651
652	=head1 SEE ALSO
653
654	L<http://freenet.sf.net>.
655
656	=head1 BUGS
657
658	=head1 AUTHOR
659
660	Marc Lehmann <pcg@goof.com>
661	http://www.goof.com/pcg/marc/
662
663	=cut
664
665	1;
666