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

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