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 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, 9 months ago) by root
Branch:	MAIN
Changes since 1.10:	+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	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.10	$VERSION = 0.05;
52
53			no warnings;
54	root	1.1
55	root	1.9	our $EVENT = Net::FCP::Event::Auto::;
56	root	1.10	$EVENT = Net::FCP::Event::Event;#d#
57	root	1.1
58	root	1.9	sub import {
59			shift;
60	root	1.1
61	root	1.9	for (@_) {
62			if (/^event=(\w+)$/) {
63			$EVENT = "Net::FCP::Event::$1";
64			}
65			}
66			eval "require $EVENT";
67	root	1.1	}
68
69	root	1.2	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	root	1.7	=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	root	1.1	=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	root	1.5	127.0.0.1:8481, or the environment variables C<FREDHOST> and C<FREDPORT>).
149	root	1.1
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	root	1.5	$self->{host} \|\|= $ENV{FREDHOST} \|\| "127.0.0.1";
161			$self->{port} \|\|= $ENV{FREDPORt} \|\| 8481;
162	root	1.1
163	root	1.5	$self->{nodehello} = $self->client_hello
164	root	1.1	or croak "unable to get nodehello from node\n";
165
166			$self;
167			}
168
169	root	1.9	sub progress {
170			my ($self, $txn, $type, $attr) = @_;
171			warn "progress<$txn,$type," . (join ":", %$attr) . ">\n";
172			}
173
174	root	1.1	=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	root	1.2	$type = touc $type;
184
185			my $txn = "Net::FCP::Txn::$type"->new(fcp => $self, type => tolc $type, attr => \%attr);
186	root	1.1
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	root	1.2	max_file_size => "5f5e100",
204	root	1.4	node => "Fred,0.6,1.46,7050"
205	root	1.2	protocol => "1.2",
206	root	1.1	}
207
208			=cut
209
210			_txn client_hello => sub {
211			my ($self) = @_;
212
213	root	1.2	$self->txn ("client_hello");
214	root	1.1	};
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	root	1.2	active_jobs => "1f",
224			allocated_memory => "bde0000",
225			architecture => "i386",
226			available_threads => 17,
227	root	1.4	datastore_free => "5ce03400",
228			datastore_max => "2540be400",
229	root	1.2	datastore_used => "1f72bb000",
230	root	1.4	estimated_load => 52,
231			free_memory => "5cc0148",
232	root	1.2	is_transient => "false",
233	root	1.4	java_name => "Java HotSpot(_T_M) Server VM",
234	root	1.2	java_vendor => "http://www.blackdown.org/",
235	root	1.4	java_version => "Blackdown-1.4.1-01",
236			least_recent_timestamp => "f41538b878",
237			max_file_size => "5f5e100",
238	root	1.2	most_recent_timestamp => "f77e2cc520"
239	root	1.4	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	root	1.1	}
245
246			=cut
247
248			_txn client_info => sub {
249			my ($self) = @_;
250
251	root	1.2	$self->txn ("client_info");
252	root	1.1	};
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	root	1.7	$self->txn (generate_chk => data => "$data$metadata", metadata_length => length $metadata);
266	root	1.1	};
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	root	1.2	$self->txn ("generate_svk_pair");
285	root	1.1	};
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	root	1.2	$self->txn (invert_private_key => private => $privkey);
305	root	1.1	};
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	root	1.2	$self->txn (get_size => URI => $uri);
322	root	1.1	};
323
324	root	1.5	=item $txn = $fcp->txn_client_get ($uri [, $htl = 15 [, $removelocal = 0]])
325
326	root	1.7	=item ($metadata, $data) = @{ $fcp->client_get ($uri, $htl, $removelocal)
327	root	1.5
328	root	1.7	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	root	1.5
332	root	1.7	Due to the overhead, a better method to download big files should be used.
333	root	1.5
334	root	1.7	my ($meta, $data) = @{
335	root	1.5	$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	root	1.1
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	root	1.2	$attr .= (Net::FCP::touc $k) . "=$v\012"
384	root	1.1	}
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	root	1.2	if (0) {
401			print
402			Net::FCP::touc $self->{type}, "\012",
403			$attr,
404			$data, "\012";
405			}
406	root	1.1
407			print $fh
408			"\x00\x00", "\x00\x02", # SESSID, PRESID
409	root	1.2	Net::FCP::touc $self->{type}, "\012",
410	root	1.1	$attr,
411			$data;
412
413			#$fh->shutdown (1); # freenet buggy?, well, it's java...
414
415			$self->{fh} = $fh;
416
417	root	1.9	$EVENT->reg_r_cb ($self);
418	root	1.1
419			$self;
420			}
421
422	root	1.9	=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	root	1.1	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	root	1.11	$self->rcv_data (substr $self->{buf}, 0, delete $self->{datalen}, "");
442	root	1.1	} else {
443			last;
444			}
445	root	1.5	} elsif ($self->{buf} =~ s/^DataChunk\015?\012Length=([0-9a-fA-F]+)\015?\012Data\015?\012//) {
446			$self->{datalen} = hex $1;
447	root	1.7	} elsif ($self->{buf} =~ s/^([a-zA-Z]+)\015?\012(?:(.+?)\015?\012)?EndMessage\015?\012//s) {
448	root	1.2	$self->rcv ($1, {
449			map { my ($a, $b) = split /=/, $_, 2; ((Net::FCP::tolc $a), $b) }
450			split /\015?\012/, $2
451			});
452	root	1.1	} else {
453			last;
454			}
455			}
456			} else {
457	root	1.9	$EVENT->unreg_r_cb ($self);
458	root	1.1	delete $self->{fh};
459			$self->eof;
460			}
461			}
462
463			sub rcv_data {
464			my ($self, $chunk) = @_;
465	root	1.5
466			$self->{data} .= $chunk;
467	root	1.9
468			$self->progress ("data", { chunk => length $chunk, total => length $self->{data}, end => $self->{datalength} });
469	root	1.1	}
470
471			sub rcv {
472			my ($self, $type, $attr) = @_;
473
474	root	1.2	$type = Net::FCP::tolc $type;
475
476	root	1.5	#use PApp::Util; warn PApp::Util::dumpval [$type, $attr];
477
478	root	1.2	if (my $method = $self->can("rcv_$type")) {
479	root	1.1	$method->($self, $attr, $type);
480			} else {
481			warn "received unexpected reply type '$type' for '$self->{type}', ignoring\n";
482			}
483			}
484
485	root	1.9	sub throw {
486			my ($self, $exc) = @_;
487
488			$self->{exception} = $exc;
489			$self->set_result (1);
490			}
491
492	root	1.5	sub set_result {
493	root	1.1	my ($self, $result) = @_;
494
495			$self->{result} = $result unless exists $self->{result};
496			}
497
498	root	1.5	sub eof {
499			my ($self) = @_;
500			$self->set_result;
501			}
502
503	root	1.9	sub progress {
504			my ($self, $type, $attr) = @_;
505			$self->{fcp}->progress ($self, $type, $attr);
506			}
507
508	root	1.1	=item $result = $txn->result
509
510			Waits until a result is available and then returns it.
511
512	root	1.5	This waiting is (depending on your event model) not very efficient, as it
513	root	1.1	is done outside the "mainloop".
514
515			=cut
516
517			sub result {
518			my ($self) = @_;
519
520	root	1.9	$EVENT->wait_event while !exists $self->{result};
521
522			die $self->{exception} if $self->{exception};
523	root	1.1
524			return $self->{result};
525			}
526
527			sub DESTROY {
528	root	1.9	$EVENT->unreg_r_cb ($_[0]);
529			#$EVENT->unreg_w_cb ($_[0]);
530	root	1.1	}
531
532			package Net::FCP::Txn::ClientHello;
533
534			use base Net::FCP::Txn;
535
536	root	1.2	sub rcv_node_hello {
537	root	1.1	my ($self, $attr) = @_;
538
539	root	1.5	$self->set_result ($attr);
540	root	1.1	}
541
542			package Net::FCP::Txn::ClientInfo;
543
544			use base Net::FCP::Txn;
545
546	root	1.2	sub rcv_node_info {
547	root	1.1	my ($self, $attr) = @_;
548
549	root	1.5	$self->set_result ($attr);
550	root	1.1	}
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	root	1.5	$self->set_result ($attr);
560	root	1.1	}
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	root	1.5	$self->set_result ([$attr->{PublicKey}, $attr->{PrivateKey}]);
570	root	1.1	}
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	root	1.5	$self->set_result ($attr->{PublicKey});
580	root	1.1	}
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	root	1.5	$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	root	1.9	my ($self, $attr, $type) = @_;
598
599			$self->progress ($type, $attr);
600	root	1.5
601			$self->{datalength} = hex $attr->{data_length};
602	root	1.7	$self->{metalength} = hex $attr->{metadata_length};
603			}
604
605	root	1.9	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	root	1.7	sub rcv_restarted {
624	root	1.9	my ($self, $attr, $type) = @_;
625			$self->progress ($type, $attr);
626	root	1.5	}
627
628			sub eof {
629			my ($self) = @_;
630	root	1.7
631	root	1.5	my $data = delete $self->{data};
632	root	1.7	my $meta = Net::FCP::parse_metadata substr $data, 0, $self->{metalength}, "";
633
634			$self->set_result ([$meta, $data]);
635	root	1.9	}
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	root	1.1	}
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