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;

$VERSION = 0.06;

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";
   die $@ if $@;
}

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);
            my @p = split /\./, tolc $k, 3;

            $hdr->{$p[0]}               = $v if @p == 1; # lamest code I ever wrote
            $hdr->{$p[0]}{$p[1]}        = $v if @p == 2;
            $hdr->{$p[0]}{$p[1]}{$p[3]} = $v if @p == 3;
            die "FATAL: 4+ dot metadata"     if @p >= 4;
         }

         if ($data =~ /\GEndPart\015?\012/gc) {
            # nop
         } 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.

Here are some examples of using transactions:

The blocking case, no (visible) transactions involved:

   my $nodehello = $fcp->client_hello;

A transaction used in a blocking fashion:
   
   my $txn = $fcp->txn_client_hello;
   ...
   my $nodehello = $txn->result;

Or shorter:

   my $nodehello = $fcp->txn_client_hello->result;

Setting callbacks:

   $fcp->txn_client_hello->cb(
      sub { my $nodehello => $_[0]->result }
   );

=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_key => $removelocal ? "true" : "false");
};

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

use Fcntl;
use Socket;

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

   $self->{signal} = $EVENT->new_signal;

   $self->{fcp}{txn}{$self} = $self;

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

   socket my $fh, PF_INET, SOCK_STREAM, 0
      or Carp::croak "unable to create new tcp socket: $!";
   binmode $fh, ":raw";
   fcntl $fh, F_SETFL, O_NONBLOCK;
   connect $fh, (sockaddr_in $self->{fcp}{port}, inet_aton $self->{fcp}{host})
      and !$!{EWOULDBLOCK}
      and !$!{EINPROGRESS}
      and Carp::croak "FCP::txn: unable to connect to $self->{fcp}{host}:$self->{fcp}{port}: $!\n";

   $self->{sbuf} = 
      "\x00\x00\x00\x02"
      . Net::FCP::touc $self->{type}
      . "\012$attr$data";

   #$fh->shutdown (1); # freenet buggy?, well, it's java...
   
   $self->{fh} = $fh;
   
   $self->{w} = $EVENT->new_from_fh ($fh)->cb(sub { $self->fh_ready_w })->poll(0, 1, 1);
   
   $self;
}

=item $txn = $txn->cb ($coderef)

Sets a callback to be called when the request is finished. The coderef
will be called with the txn as it's sole argument, so it has to call
C<result> itself.

Returns the txn object, useful for chaining.

Example:

   $fcp->txn_client_get ("freenet:CHK....")
      ->userdata ("ehrm")
      ->cb(sub {
         my $data = shift->result;
      });

=cut

sub cb($$) {
   my ($self, $cb) = @_;
   $self->{cb} = $cb;
   $self;
}

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

Set user-specific data. This is useful in progress callbacks. The data can be accessed
using C<< $txn->{userdata} >>.

Returns the txn object, useful for chaining.

=cut

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

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

   my $len = syswrite $self->{fh}, $self->{sbuf};

   if ($len > 0) {
      substr $self->{sbuf}, 0, $len, "";
      unless (length $self->{sbuf}) {
         fcntl $self->{fh}, F_SETFL, 0;
         $self->{w}->cb(sub { $self->fh_ready_r })->poll (1, 0, 1);
      }
   } elsif (defined $len) {
      $self->throw (Net::FCP::Exception->new (network_error => { reason => "unexpected end of file while writing" }));
   } else {
      $self->throw (Net::FCP::Exception->new (network_error => { reason => "$!" }));
   }
}

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

   if (sysread $self->{fh}, $self->{buf}, 65536, length $self->{buf}) {
      for (;;) {
         if ($self->{datalen}) {
            #warn "expecting new datachunk $self->{datalen}, got ".(length $self->{buf})."\n";#d#
            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;
            #warn "expecting new datachunk $self->{datalen}\n";#d#
         } 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 {
      $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";
   }
}

# used as a default exception thrower
sub rcv_throw_exception {
   my ($self, $attr, $type) = @_;
   $self->throw (new Net::FCP::Exception $type, $attr);
}

*rcv_failed       = \&Net::FCP::Txn::rcv_throw_exception;
*rcv_format_error = \&Net::FCP::Txn::rcv_throw_exception;

sub throw {
   my ($self, $exc) = @_;

   $self->{exception} = $exc;
   $self->set_result (1);
   $self->eof; # must be last to avoid loops
}

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

   unless (exists $self->{result}) {
      $self->{result} = $result;
      $self->{cb}->($self) if exists $self->{cb};
      $self->{signal}->send;
   }
}

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

   delete $self->{w};
   delete $self->{fh};

   delete $self->{fcp}{txn}{$self};

   $self->set_result; # just in case
}

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

   $self->{signal}->wait while !exists $self->{result};

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

   return $self->{result};
}

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::GetPut;

# base class for get and put

use base Net::FCP::Txn;

*rcv_uri_error        = \&Net::FCP::Txn::rcv_throw_exception;
*rcv_route_not_found  = \&Net::FCP::Txn::rcv_throw_exception;

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

   delete $self->{datalength};
   delete $self->{metalength};
   delete $self->{data};

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

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

use base Net::FCP::Txn::GetPut;

*rcv_data_not_found = \&Net::FCP::Txn::rcv_throw_exception;

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

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

      $self->set_result ([$meta, $data]);
   } elsif (!exists $self->{result}) {
      $self->throw (Net::FCP::Exception->new (short_data => {
                                                 reason   => "unexpected eof or internal node error",
                                                 received => length $self->{data},
                                                 expected => $self->{datalength},
                                              }));
   }
}

package Net::FCP::Txn::ClientPut;

use base Net::FCP::Txn::GetPut;

*rcv_size_error    = \&Net::FCP::Txn::rcv_throw_exception;
*rcv_key_collision = \&Net::FCP::Txn::rcv_throw_exception;

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

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

package Net::FCP::Exception;

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

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

   bless [Net::FCP::tolc $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.14
Committed:	Wed Sep 10 05:07:16 2003 UTC (23 years ago) by root
Branch:	MAIN
Changes since 1.13:	+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
50	root	1.14	$VERSION = 0.06;
51	root	1.10
52			no warnings;
53	root	1.1
54	root	1.9	our $EVENT = Net::FCP::Event::Auto::;
55	root	1.10	$EVENT = Net::FCP::Event::Event;#d#
56	root	1.1
57	root	1.9	sub import {
58			shift;
59	root	1.1
60	root	1.9	for (@_) {
61			if (/^event=(\w+)$/) {
62			$EVENT = "Net::FCP::Event::$1";
63			}
64			}
65			eval "require $EVENT";
66	root	1.12	die $@ if $@;
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	root	1.12	my @p = split /\./, tolc $k, 3;
127
128			$hdr->{$p[0]} = $v if @p == 1; # lamest code I ever wrote
129			$hdr->{$p[0]}{$p[1]} = $v if @p == 2;
130			$hdr->{$p[0]}{$p[1]}{$p[3]} = $v if @p == 3;
131			die "FATAL: 4+ dot metadata" if @p >= 4;
132	root	1.7	}
133
134			if ($data =~ /\GEndPart\015?\012/gc) {
135	root	1.12	# nop
136	root	1.7	} elsif ($data =~ /\GEnd\015?\012/gc) {
137			last;
138			} elsif ($data =~ /\G([A-Za-z0-9.\-]+)\015?\012/gcs) {
139			push @{$meta->{tolc $1}}, $hdr = {};
140			} elsif ($data =~ /\G(.*)/gcs) {
141			die "metadata format error ($1)";
142			}
143			}
144			}
145
146			#$meta->{tail} = substr $data, pos $data;
147
148			$meta;
149			}
150
151	root	1.1	=item $fcp = new Net::FCP [host => $host][, port => $port]
152
153			Create a new virtual FCP connection to the given host and port (default
154	root	1.5	127.0.0.1:8481, or the environment variables C<FREDHOST> and C<FREDPORT>).
155	root	1.1
156			Connections are virtual because no persistent physical connection is
157			established. However, the existance of the node is checked by executing a
158			C<ClientHello> transaction.
159
160			=cut
161
162			sub new {
163			my $class = shift;
164			my $self = bless { @_ }, $class;
165
166	root	1.5	$self->{host} \|\|= $ENV{FREDHOST} \|\| "127.0.0.1";
167	root	1.12	$self->{port} \|\|= $ENV{FREDPORT} \|\| 8481;
168	root	1.1
169	root	1.12	#$self->{nodehello} = $self->client_hello
170			# or croak "unable to get nodehello from node\n";
171	root	1.1
172			$self;
173			}
174
175	root	1.9	sub progress {
176			my ($self, $txn, $type, $attr) = @_;
177			warn "progress<$txn,$type," . (join ":", %$attr) . ">\n";
178			}
179
180	root	1.1	=item $txn = $fcp->txn(type => attr => val,...)
181
182			The low-level interface to transactions. Don't use it.
183
184	root	1.12	Here are some examples of using transactions:
185
186			The blocking case, no (visible) transactions involved:
187
188			my $nodehello = $fcp->client_hello;
189
190			A transaction used in a blocking fashion:
191
192			my $txn = $fcp->txn_client_hello;
193			...
194			my $nodehello = $txn->result;
195
196			Or shorter:
197
198			my $nodehello = $fcp->txn_client_hello->result;
199
200			Setting callbacks:
201
202			$fcp->txn_client_hello->cb(
203			sub { my $nodehello => $_[0]->result }
204			);
205
206	root	1.1	=cut
207
208			sub txn {
209			my ($self, $type, %attr) = @_;
210
211	root	1.2	$type = touc $type;
212
213			my $txn = "Net::FCP::Txn::$type"->new(fcp => $self, type => tolc $type, attr => \%attr);
214	root	1.1
215			$txn;
216			}
217
218			sub _txn($&) {
219			my ($name, $sub) = @_;
220			*{"$name\_txn"} = $sub;
221			*{$name} = sub { $sub->(@_)->result };
222			}
223
224			=item $txn = $fcp->txn_client_hello
225
226			=item $nodehello = $fcp->client_hello
227
228			Executes a ClientHello request and returns it's results.
229
230			{
231	root	1.2	max_file_size => "5f5e100",
232	root	1.4	node => "Fred,0.6,1.46,7050"
233	root	1.2	protocol => "1.2",
234	root	1.1	}
235
236			=cut
237
238			_txn client_hello => sub {
239			my ($self) = @_;
240
241	root	1.2	$self->txn ("client_hello");
242	root	1.1	};
243
244			=item $txn = $fcp->txn_client_info
245
246			=item $nodeinfo = $fcp->client_info
247
248			Executes a ClientInfo request and returns it's results.
249
250			{
251	root	1.2	active_jobs => "1f",
252			allocated_memory => "bde0000",
253			architecture => "i386",
254			available_threads => 17,
255	root	1.4	datastore_free => "5ce03400",
256			datastore_max => "2540be400",
257	root	1.2	datastore_used => "1f72bb000",
258	root	1.4	estimated_load => 52,
259			free_memory => "5cc0148",
260	root	1.2	is_transient => "false",
261	root	1.4	java_name => "Java HotSpot(_T_M) Server VM",
262	root	1.2	java_vendor => "http://www.blackdown.org/",
263	root	1.4	java_version => "Blackdown-1.4.1-01",
264			least_recent_timestamp => "f41538b878",
265			max_file_size => "5f5e100",
266	root	1.2	most_recent_timestamp => "f77e2cc520"
267	root	1.4	node_address => "1.2.3.4",
268			node_port => 369,
269			operating_system => "Linux",
270			operating_system_version => "2.4.20",
271			routing_time => "a5",
272	root	1.1	}
273
274			=cut
275
276			_txn client_info => sub {
277			my ($self) = @_;
278
279	root	1.2	$self->txn ("client_info");
280	root	1.1	};
281
282			=item $txn = $fcp->txn_generate_chk ($metadata, $data)
283
284			=item $uri = $fcp->generate_chk ($metadata, $data)
285
286			Creates a new CHK, given the metadata and data. UNTESTED.
287
288			=cut
289
290			_txn generate_chk => sub {
291			my ($self, $metadata, $data) = @_;
292
293	root	1.7	$self->txn (generate_chk => data => "$data$metadata", metadata_length => length $metadata);
294	root	1.1	};
295
296			=item $txn = $fcp->txn_generate_svk_pair
297
298			=item ($public, $private) = @{ $fcp->generate_svk_pair }
299
300			Creates a new SVK pair. Returns an arrayref.
301
302			[
303			"hKs0-WDQA4pVZyMPKNFsK1zapWY",
304			"ZnmvMITaTXBMFGl4~jrjuyWxOWg"
305			]
306
307			=cut
308
309			_txn generate_svk_pair => sub {
310			my ($self) = @_;
311
312	root	1.2	$self->txn ("generate_svk_pair");
313	root	1.1	};
314
315			=item $txn = $fcp->txn_insert_private_key ($private)
316
317			=item $uri = $fcp->insert_private_key ($private)
318
319			Inserts a private key. $private can be either an insert URI (must start
320			with freenet:SSK@) or a raw private key (i.e. the private value you get back
321			from C<generate_svk_pair>).
322
323			Returns the public key.
324
325			UNTESTED.
326
327			=cut
328
329			_txn insert_private_key => sub {
330			my ($self, $privkey) = @_;
331
332	root	1.2	$self->txn (invert_private_key => private => $privkey);
333	root	1.1	};
334
335			=item $txn = $fcp->txn_get_size ($uri)
336
337			=item $length = $fcp->get_size ($uri)
338
339			Finds and returns the size (rounded up to the nearest power of two) of the
340			given document.
341
342			UNTESTED.
343
344			=cut
345
346			_txn get_size => sub {
347			my ($self, $uri) = @_;
348
349	root	1.2	$self->txn (get_size => URI => $uri);
350	root	1.1	};
351
352	root	1.5	=item $txn = $fcp->txn_client_get ($uri [, $htl = 15 [, $removelocal = 0]])
353
354	root	1.7	=item ($metadata, $data) = @{ $fcp->client_get ($uri, $htl, $removelocal)
355	root	1.5
356	root	1.7	Fetches a (small, as it should fit into memory) file from
357			freenet. C<$meta> is the metadata (as returned by C<parse_metadata> or
358			C<undef>).
359	root	1.5
360	root	1.7	Due to the overhead, a better method to download big files should be used.
361	root	1.5
362	root	1.7	my ($meta, $data) = @{
363	root	1.5	$fcp->client_get (
364			"freenet:CHK@hdXaxkwZ9rA8-SidT0AN-bniQlgPAwI,XdCDmBuGsd-ulqbLnZ8v~w"
365			)
366			};
367
368			=cut
369
370			_txn client_get => sub {
371			my ($self, $uri, $htl, $removelocal) = @_;
372
373	root	1.12	$self->txn (client_get => URI => $uri, hops_to_live => ($htl \|\| 15), remove_local_key => $removelocal ? "true" : "false");
374	root	1.5	};
375
376			=item MISSING: ClientPut
377	root	1.1
378			=back
379
380			=head2 THE Net::FCP::Txn CLASS
381
382			All requests (or transactions) are executed in a asynchroneous way (LIE:
383			uploads are blocking). For each request, a C<Net::FCP::Txn> object is
384			created (worse: a tcp connection is created, too).
385
386			For each request there is actually a different subclass (and it's possible
387			to subclass these, although of course not documented).
388
389			The most interesting method is C<result>.
390
391			=over 4
392
393			=cut
394
395			package Net::FCP::Txn;
396
397	root	1.12	use Fcntl;
398			use Socket;
399
400	root	1.1	=item new arg => val,...
401
402			Creates a new C<Net::FCP::Txn> object. Not normally used.
403
404			=cut
405
406			sub new {
407			my $class = shift;
408			my $self = bless { @_ }, $class;
409
410	root	1.12	$self->{signal} = $EVENT->new_signal;
411
412			$self->{fcp}{txn}{$self} = $self;
413
414	root	1.1	my $attr = "";
415			my $data = delete $self->{attr}{data};
416
417			while (my ($k, $v) = each %{$self->{attr}}) {
418	root	1.2	$attr .= (Net::FCP::touc $k) . "=$v\012"
419	root	1.1	}
420
421			if (defined $data) {
422			$attr .= "DataLength=" . (length $data) . "\012";
423			$data = "Data\012$data";
424			} else {
425			$data = "EndMessage\012";
426			}
427
428	root	1.12	socket my $fh, PF_INET, SOCK_STREAM, 0
429			or Carp::croak "unable to create new tcp socket: $!";
430	root	1.1	binmode $fh, ":raw";
431	root	1.12	fcntl $fh, F_SETFL, O_NONBLOCK;
432			connect $fh, (sockaddr_in $self->{fcp}{port}, inet_aton $self->{fcp}{host})
433			and !$!{EWOULDBLOCK}
434			and !$!{EINPROGRESS}
435			and Carp::croak "FCP::txn: unable to connect to $self->{fcp}{host}:$self->{fcp}{port}: $!\n";
436
437			$self->{sbuf} =
438			"\x00\x00\x00\x02"
439			. Net::FCP::touc $self->{type}
440			. "\012$attr$data";
441	root	1.1
442			#$fh->shutdown (1); # freenet buggy?, well, it's java...
443
444			$self->{fh} = $fh;
445
446	root	1.12	$self->{w} = $EVENT->new_from_fh ($fh)->cb(sub { $self->fh_ready_w })->poll(0, 1, 1);
447	root	1.1
448			$self;
449			}
450
451	root	1.12	=item $txn = $txn->cb ($coderef)
452
453			Sets a callback to be called when the request is finished. The coderef
454			will be called with the txn as it's sole argument, so it has to call
455			C<result> itself.
456
457			Returns the txn object, useful for chaining.
458	root	1.9
459	root	1.12	Example:
460
461			$fcp->txn_client_get ("freenet:CHK....")
462			->userdata ("ehrm")
463			->cb(sub {
464			my $data = shift->result;
465			});
466	root	1.9
467			=cut
468
469	root	1.12	sub cb($$) {
470			my ($self, $cb) = @_;
471			$self->{cb} = $cb;
472			$self;
473			}
474
475			=item $txn = $txn->userdata ([$userdata])
476
477			Set user-specific data. This is useful in progress callbacks. The data can be accessed
478			using C<< $txn->{userdata} >>.
479
480			Returns the txn object, useful for chaining.
481
482			=cut
483
484			sub userdata($$) {
485	root	1.9	my ($self, $data) = @_;
486	root	1.12	$self->{userdata} = $data;
487			$self;
488			}
489
490			sub fh_ready_w {
491			my ($self) = @_;
492
493			my $len = syswrite $self->{fh}, $self->{sbuf};
494
495			if ($len > 0) {
496			substr $self->{sbuf}, 0, $len, "";
497			unless (length $self->{sbuf}) {
498			fcntl $self->{fh}, F_SETFL, 0;
499			$self->{w}->cb(sub { $self->fh_ready_r })->poll (1, 0, 1);
500			}
501			} elsif (defined $len) {
502			$self->throw (Net::FCP::Exception->new (network_error => { reason => "unexpected end of file while writing" }));
503			} else {
504			$self->throw (Net::FCP::Exception->new (network_error => { reason => "$!" }));
505			}
506	root	1.9	}
507
508	root	1.12	sub fh_ready_r {
509	root	1.1	my ($self) = @_;
510
511			if (sysread $self->{fh}, $self->{buf}, 65536, length $self->{buf}) {
512			for (;;) {
513			if ($self->{datalen}) {
514	root	1.13	#warn "expecting new datachunk $self->{datalen}, got ".(length $self->{buf})."\n";#d#
515	root	1.1	if (length $self->{buf} >= $self->{datalen}) {
516	root	1.11	$self->rcv_data (substr $self->{buf}, 0, delete $self->{datalen}, "");
517	root	1.1	} else {
518			last;
519			}
520	root	1.5	} elsif ($self->{buf} =~ s/^DataChunk\015?\012Length=([0-9a-fA-F]+)\015?\012Data\015?\012//) {
521			$self->{datalen} = hex $1;
522	root	1.13	#warn "expecting new datachunk $self->{datalen}\n";#d#
523	root	1.7	} elsif ($self->{buf} =~ s/^([a-zA-Z]+)\015?\012(?:(.+?)\015?\012)?EndMessage\015?\012//s) {
524	root	1.2	$self->rcv ($1, {
525			map { my ($a, $b) = split /=/, $_, 2; ((Net::FCP::tolc $a), $b) }
526			split /\015?\012/, $2
527			});
528	root	1.1	} else {
529			last;
530			}
531			}
532			} else {
533			$self->eof;
534			}
535			}
536
537			sub rcv_data {
538			my ($self, $chunk) = @_;
539	root	1.5
540			$self->{data} .= $chunk;
541	root	1.9
542			$self->progress ("data", { chunk => length $chunk, total => length $self->{data}, end => $self->{datalength} });
543	root	1.1	}
544
545			sub rcv {
546			my ($self, $type, $attr) = @_;
547
548	root	1.2	$type = Net::FCP::tolc $type;
549
550	root	1.5	#use PApp::Util; warn PApp::Util::dumpval [$type, $attr];
551
552	root	1.2	if (my $method = $self->can("rcv_$type")) {
553	root	1.1	$method->($self, $attr, $type);
554			} else {
555			warn "received unexpected reply type '$type' for '$self->{type}', ignoring\n";
556			}
557			}
558
559	root	1.12	# used as a default exception thrower
560			sub rcv_throw_exception {
561			my ($self, $attr, $type) = @_;
562			$self->throw (new Net::FCP::Exception $type, $attr);
563			}
564
565			*rcv_failed = \&Net::FCP::Txn::rcv_throw_exception;
566			*rcv_format_error = \&Net::FCP::Txn::rcv_throw_exception;
567
568	root	1.9	sub throw {
569			my ($self, $exc) = @_;
570
571			$self->{exception} = $exc;
572			$self->set_result (1);
573	root	1.12	$self->eof; # must be last to avoid loops
574	root	1.9	}
575
576	root	1.5	sub set_result {
577	root	1.1	my ($self, $result) = @_;
578
579	root	1.12	unless (exists $self->{result}) {
580			$self->{result} = $result;
581			$self->{cb}->($self) if exists $self->{cb};
582			$self->{signal}->send;
583			}
584	root	1.1	}
585
586	root	1.5	sub eof {
587			my ($self) = @_;
588	root	1.12
589			delete $self->{w};
590			delete $self->{fh};
591
592			delete $self->{fcp}{txn}{$self};
593
594			$self->set_result; # just in case
595	root	1.5	}
596
597	root	1.9	sub progress {
598			my ($self, $type, $attr) = @_;
599			$self->{fcp}->progress ($self, $type, $attr);
600			}
601
602	root	1.1	=item $result = $txn->result
603
604			Waits until a result is available and then returns it.
605
606	root	1.5	This waiting is (depending on your event model) not very efficient, as it
607	root	1.1	is done outside the "mainloop".
608
609			=cut
610
611			sub result {
612			my ($self) = @_;
613
614	root	1.12	$self->{signal}->wait while !exists $self->{result};
615	root	1.9
616			die $self->{exception} if $self->{exception};
617	root	1.1
618			return $self->{result};
619			}
620
621			package Net::FCP::Txn::ClientHello;
622
623			use base Net::FCP::Txn;
624
625	root	1.2	sub rcv_node_hello {
626	root	1.1	my ($self, $attr) = @_;
627
628	root	1.5	$self->set_result ($attr);
629	root	1.1	}
630
631			package Net::FCP::Txn::ClientInfo;
632
633			use base Net::FCP::Txn;
634
635	root	1.2	sub rcv_node_info {
636	root	1.1	my ($self, $attr) = @_;
637
638	root	1.5	$self->set_result ($attr);
639	root	1.1	}
640
641			package Net::FCP::Txn::GenerateCHK;
642
643			use base Net::FCP::Txn;
644
645			sub rcv_success {
646			my ($self, $attr) = @_;
647
648	root	1.5	$self->set_result ($attr);
649	root	1.1	}
650
651			package Net::FCP::Txn::GenerateSVKPair;
652
653			use base Net::FCP::Txn;
654
655			sub rcv_success {
656			my ($self, $attr) = @_;
657
658	root	1.5	$self->set_result ([$attr->{PublicKey}, $attr->{PrivateKey}]);
659	root	1.1	}
660
661			package Net::FCP::Txn::InvertPrivateKey;
662
663			use base Net::FCP::Txn;
664
665			sub rcv_success {
666			my ($self, $attr) = @_;
667
668	root	1.5	$self->set_result ($attr->{PublicKey});
669	root	1.1	}
670
671			package Net::FCP::Txn::GetSize;
672
673			use base Net::FCP::Txn;
674
675			sub rcv_success {
676			my ($self, $attr) = @_;
677
678	root	1.5	$self->set_result ($attr->{Length});
679			}
680
681	root	1.12	package Net::FCP::Txn::GetPut;
682
683			# base class for get and put
684
685			use base Net::FCP::Txn;
686
687			*rcv_uri_error = \&Net::FCP::Txn::rcv_throw_exception;
688			*rcv_route_not_found = \&Net::FCP::Txn::rcv_throw_exception;
689
690			sub rcv_restarted {
691			my ($self, $attr, $type) = @_;
692
693			delete $self->{datalength};
694			delete $self->{metalength};
695			delete $self->{data};
696
697			$self->progress ($type, $attr);
698			}
699
700	root	1.5	package Net::FCP::Txn::ClientGet;
701
702	root	1.12	use base Net::FCP::Txn::GetPut;
703
704			*rcv_data_not_found = \&Net::FCP::Txn::rcv_throw_exception;
705	root	1.5
706			sub rcv_data_found {
707	root	1.9	my ($self, $attr, $type) = @_;
708
709			$self->progress ($type, $attr);
710	root	1.5
711			$self->{datalength} = hex $attr->{data_length};
712	root	1.7	$self->{metalength} = hex $attr->{metadata_length};
713			}
714
715	root	1.12	sub eof {
716			my ($self) = @_;
717	root	1.9
718	root	1.12	if ($self->{datalength} == length $self->{data}) {
719			my $data = delete $self->{data};
720			my $meta = Net::FCP::parse_metadata substr $data, 0, $self->{metalength}, "";
721
722			$self->set_result ([$meta, $data]);
723			} elsif (!exists $self->{result}) {
724			$self->throw (Net::FCP::Exception->new (short_data => {
725			reason => "unexpected eof or internal node error",
726			received => length $self->{data},
727			expected => $self->{datalength},
728			}));
729			}
730	root	1.9	}
731
732	root	1.12	package Net::FCP::Txn::ClientPut;
733	root	1.9
734	root	1.12	use base Net::FCP::Txn::GetPut;
735	root	1.9
736	root	1.12	*rcv_size_error = \&Net::FCP::Txn::rcv_throw_exception;
737			*rcv_key_collision = \&Net::FCP::Txn::rcv_throw_exception;
738	root	1.9
739	root	1.12	sub rcv_pending {
740	root	1.9	my ($self, $attr, $type) = @_;
741			$self->progress ($type, $attr);
742	root	1.5	}
743
744	root	1.12	sub rcv_success {
745			my ($self, $attr, $type) = @_;
746			$self->set_result ($attr);
747	root	1.9	}
748
749			package Net::FCP::Exception;
750
751			use overload
752			'""' => sub {
753			"Net::FCP::Exception<<$_[0][0]," . (join ":", %{$_[0][1]}) . ">>\n";
754			};
755
756			sub new {
757			my ($class, $type, $attr) = @_;
758
759	root	1.12	bless [Net::FCP::tolc $type, { %$attr }], $class;
760	root	1.1	}
761
762			=back
763
764			=head1 SEE ALSO
765
766			L<http://freenet.sf.net>.
767
768			=head1 BUGS
769
770			=head1 AUTHOR
771
772			Marc Lehmann <pcg@goof.com>
773			http://www.goof.com/pcg/marc/
774
775			=cut
776
777			1;
778