--- cvsroot/Net-FCP/FCP.pm	2003/09/10 05:20:48	1.16
+++ cvsroot/Net-FCP/FCP.pm	2004/05/14 16:12:26	1.30
@@ -37,6 +37,33 @@
 
 You should specify the event module to use only in the main program.
 
+If no event model has been specified, FCP tries to autodetect it on first
+use (e.g. first transaction), in this order: Coro, Event, Glib, Tk.
+
+=head2 FREENET BASICS
+
+Ok, this section will not explain any freenet basics to you, just some
+problems I found that you might want to avoid:
+
+=over 4
+
+=item freenet URIs are _NOT_ URIs
+
+Whenever a "uri" is required by the protocol, freenet expects a kind of
+URI prefixed with the "freenet:" scheme, e.g. "freenet:CHK...". However,
+these are not URIs, as freeent fails to parse them correctly, that is, you
+must unescape an escaped characters ("%2c" => ",") yourself. Maybe in the
+future this library will do it for you, so watch out for this incompatible
+change.
+
+=item Numbers are in HEX
+
+Virtually every number in the FCP protocol is in hex. Be sure to use
+C<hex()> on all such numbers, as the module (currently) does nothing to
+convert these for you.
+
+=back
+
 =head2 THE Net::FCP CLASS
 
 =over 4
@@ -47,12 +74,13 @@
 
 use Carp;
 
-$VERSION = 0.07;
+$VERSION = 0.7;
 
 no warnings;
 
+use Net::FCP::Metadata;
+
 our $EVENT = Net::FCP::Event::Auto::;
-$EVENT = Net::FCP::Event::Event;#d#
 
 sub import {
    shift;
@@ -60,9 +88,9 @@
    for (@_) {
       if (/^event=(\w+)$/) {
          $EVENT = "Net::FCP::Event::$1";
+         eval "require $EVENT";
       }
    }
-   eval "require $EVENT";
    die $@ if $@;
 }
 
@@ -75,87 +103,34 @@
 
 sub tolc($) {
    local $_ = shift;
+   1 while s/(SVK|CHK|URI)([^_])/$1\_$2/i;
+   1 while s/([^_])(SVK|CHK|URI)/$1\_$2/i;
    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[2]} = $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;
+# the opposite of hex
+sub xeh($) {
+   sprintf "%x", $_[0];
 }
 
-=item $fcp = new Net::FCP [host => $host][, port => $port]
+=item $fcp = new Net::FCP [host => $host][, port => $port][, progress => \&cb]
 
 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.
+established.
+
+You can install a progress callback that is being called with the Net::FCP
+object, a txn object, the type of the transaction and the attributes. Use
+it like this:
+
+   sub progress_cb {
+      my ($self, $txn, $type, $attr) = @_;
+
+      warn "progress<$txn,$type," . (join ":", %$attr) . ">\n";
+   }
 
 =cut
 
@@ -166,22 +141,20 @@
    $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,...)
+   $self->{progress}->($self, $txn, $type, $attr)
+      if $self->{progress};
+}
 
-The low-level interface to transactions. Don't use it.
+=item $txn = $fcp->txn (type => attr => val,...)
 
-Here are some examples of using transactions:
+The low-level interface to transactions. Don't use it unless you have
+"special needs". Instead, use predefiend transactions like this:
 
 The blocking case, no (visible) transactions involved:
 
@@ -210,16 +183,18 @@
 
    $type = touc $type;
 
-   my $txn = "Net::FCP::Txn::$type"->new(fcp => $self, type => tolc $type, attr => \%attr);
+   my $txn = "Net::FCP::Txn::$type"->new (fcp => $self, type => tolc $type, attr => \%attr);
 
    $txn;
 }
 
-sub _txn($&) {
+{ # transactions
+
+my $txn = sub {
    my ($name, $sub) = @_;
-   *{"$name\_txn"} = $sub;
+   *{"txn_$name"} = $sub;
    *{$name} = sub { $sub->(@_)->result };
-}
+};
 
 =item $txn = $fcp->txn_client_hello
 
@@ -235,11 +210,11 @@
 
 =cut
 
-_txn client_hello => sub {
+$txn->(client_hello => sub {
    my ($self) = @_;
 
    $self->txn ("client_hello");
-};
+});
 
 =item $txn = $fcp->txn_client_info
 
@@ -273,64 +248,80 @@
 
 =cut
 
-_txn client_info => sub {
+$txn->(client_info => sub {
    my ($self) = @_;
 
    $self->txn ("client_info");
-};
+});
 
-=item $txn = $fcp->txn_generate_chk ($metadata, $data)
+=item $txn = $fcp->txn_generate_chk ($metadata, $data[, $cipher])
 
-=item $uri = $fcp->generate_chk ($metadata, $data)
+=item $uri = $fcp->generate_chk ($metadata, $data[, $cipher])
 
-Creates a new CHK, given the metadata and data. UNTESTED.
+Calculates a CHK, given the metadata and data. C<$cipher> is either
+C<Rijndael> or C<Twofish>, with the latter being the default.
 
 =cut
 
-_txn generate_chk => sub {
-   my ($self, $metadata, $data) = @_;
+$txn->(generate_chk => sub {
+   my ($self, $metadata, $data, $cipher) = @_;
 
-   $self->txn (generate_chk => data => "$data$metadata", metadata_length => length $metadata);
-};
+   $metadata = Net::FCP::Metadata::build_metadata $metadata;
+
+   $self->txn (generate_chk =>
+               data => "$metadata$data",
+               metadata_length => xeh length $metadata,
+               cipher => $cipher || "Twofish");
+});
 
 =item $txn = $fcp->txn_generate_svk_pair
 
 =item ($public, $private) = @{ $fcp->generate_svk_pair }
 
-Creates a new SVK pair. Returns an arrayref.
+Creates a new SVK pair. Returns an arrayref with the public key, the
+private key and a crypto key, which is just additional entropy.
 
    [
-     "hKs0-WDQA4pVZyMPKNFsK1zapWY",
-     "ZnmvMITaTXBMFGl4~jrjuyWxOWg"
+     "acLx4dux9fvvABH15Gk6~d3I-yw",
+     "cPoDkDMXDGSMM32plaPZDhJDxSs",
+     "BH7LXCov0w51-y9i~BoB3g",
    ]
 
+A private key (for inserting) can be constructed like this:
+
+   SSK@<private_key>,<crypto_key>/<name>
+
+It can be used to insert data. The corresponding public key looks like this:
+
+   SSK@<public_key>PAgM,<crypto_key>/<name>
+
+Watch out for the C<PAgM>-part!
+
 =cut
 
-_txn generate_svk_pair => sub {
+$txn->(generate_svk_pair => sub {
    my ($self) = @_;
 
    $self->txn ("generate_svk_pair");
-};
+});
 
-=item $txn = $fcp->txn_insert_private_key ($private)
+=item $txn = $fcp->txn_invert_private_key ($private)
 
-=item $uri = $fcp->insert_private_key ($private)
+=item $public = $fcp->invert_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>).
+Inverts a private key (returns the public key). C<$private> can be either
+an insert URI (must start with C<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 {
+$txn->(invert_private_key => sub {
    my ($self, $privkey) = @_;
 
    $self->txn (invert_private_key => private => $privkey);
-};
+});
 
 =item $txn = $fcp->txn_get_size ($uri)
 
@@ -339,25 +330,23 @@
 Finds and returns the size (rounded up to the nearest power of two) of the
 given document.
 
-UNTESTED.
-
 =cut
 
-_txn get_size => sub {
+$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>).
+Fetches a (small, as it should fit into memory) key content block from
+freenet. C<$meta> is a C<Net::FCP::Metadata> object or C<undef>).
 
-Due to the overhead, a better method to download big files should be used.
+The C<$uri> should begin with C<freenet:>, but the scheme is currently
+added, if missing.
 
   my ($meta, $data) = @{
      $fcp->client_get (
@@ -367,21 +356,52 @@
 
 =cut
 
-_txn client_get => sub {
+$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");
-};
+   $uri =~ s/^freenet://; $uri = "freenet:$uri";
+
+   $self->txn (client_get => URI => $uri, hops_to_live => xeh (defined $htl ? $htl : 15),
+               remove_local_key => $removelocal ? "true" : "false");
+});
+
+=item $txn = $fcp->txn_client_put ($uri, $metadata, $data, $htl, $removelocal)
+
+=item my $uri = $fcp->client_put ($uri, $metadata, $data, $htl, $removelocal);
 
-=item MISSING: ClientPut
+Insert a new key. If the client is inserting a CHK, the URI may be
+abbreviated as just CHK@. In this case, the node will calculate the
+CHK. If the key is a private SSK key, the node will calculcate the public
+key and the resulting public URI.
+
+C<$meta> can be a hash reference (same format as returned by
+C<Net::FCP::parse_metadata>) or a string.
+
+The result is an arrayref with the keys C<uri>, C<public_key> and C<private_key>.
+
+=cut
+
+$txn->(client_put => sub {
+   my ($self, $uri, $metadata, $data, $htl, $removelocal) = @_;
+
+   $metadata = Net::FCP::Metadata::build_metadata $metadata;
+   $uri =~ s/^freenet://; $uri = "freenet:$uri";
+
+   $self->txn (client_put => URI => $uri,
+               hops_to_live => xeh (defined $htl ? $htl : 15),
+               remove_local_key => $removelocal ? "true" : "false",
+               data => "$metadata$data", metadata_length => xeh length $metadata);
+});
+
+} # transactions
 
 =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).
+All requests (or transactions) are executed in a asynchronous way. 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).
@@ -419,7 +439,7 @@
    }
 
    if (defined $data) {
-      $attr .= "DataLength=" . (length $data) . "\012";
+      $attr .= sprintf "DataLength=%x\012", length $data;
       $data = "Data\012$data";
    } else {
       $data = "EndMessage\012";
@@ -436,10 +456,10 @@
 
    $self->{sbuf} = 
       "\x00\x00\x00\x02"
-      . Net::FCP::touc $self->{type}
+      . (Net::FCP::touc $self->{type})
       . "\012$attr$data";
 
-   #$fh->shutdown (1); # freenet buggy?, well, it's java...
+   #shutdown $fh, 1; # freenet buggy?, well, it's java...
    
    $self->{fh} = $fh;
    
@@ -487,6 +507,22 @@
    $self;
 }
 
+=item $txn->cancel (%attr)
+
+Cancels the operation with a C<cancel> exception anf the given attributes
+(consider at least giving the attribute C<reason>).
+
+UNTESTED.
+
+=cut
+
+sub cancel {
+   my ($self, %attr) = @_;
+   $self->throw (Net::FCP::Exception->new (cancel => { %attr }));
+   $self->set_result;
+   $self->eof;
+}
+
 sub fh_ready_w {
    my ($self) = @_;
 
@@ -534,14 +570,6 @@
    }
 }
 
-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) = @_;
 
@@ -569,7 +597,7 @@
    my ($self, $exc) = @_;
 
    $self->{exception} = $exc;
-   $self->set_result (1);
+   $self->set_result;
    $self->eof; # must be last to avoid loops
 }
 
@@ -591,11 +619,16 @@
 
    delete $self->{fcp}{txn}{$self};
 
-   $self->set_result; # just in case
+   unless (exists $self->{result}) {
+      $self->throw (Net::FCP::Exception->new (short_data => {
+         reason   => "unexpected eof or internal node error",
+      }));
+   }
 }
 
 sub progress {
    my ($self, $type, $attr) = @_;
+
    $self->{fcp}->progress ($self, $type, $attr);
 }
 
@@ -604,7 +637,10 @@
 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".
+is done outside the "mainloop". The biggest problem, however, is that it's
+blocking one thread of execution. Try to use the callback mechanism, if
+possible, and call result from within the callback (or after is has been
+run), as then no waiting is necessary.
 
 =cut
 
@@ -645,7 +681,7 @@
 sub rcv_success {
    my ($self, $attr) = @_;
 
-   $self->set_result ($attr);
+   $self->set_result ($attr->{uri});
 }
 
 package Net::FCP::Txn::GenerateSVKPair;
@@ -654,8 +690,7 @@
 
 sub rcv_success {
    my ($self, $attr) = @_;
-
-   $self->set_result ([$attr->{PublicKey}, $attr->{PrivateKey}]);
+   $self->set_result ([$attr->{public_key}, $attr->{private_key}, $attr->{crypto_key}]);
 }
 
 package Net::FCP::Txn::InvertPrivateKey;
@@ -664,8 +699,7 @@
 
 sub rcv_success {
    my ($self, $attr) = @_;
-
-   $self->set_result ($attr->{PublicKey});
+   $self->set_result ($attr->{public_key});
 }
 
 package Net::FCP::Txn::GetSize;
@@ -674,8 +708,7 @@
 
 sub rcv_success {
    my ($self, $attr) = @_;
-
-   $self->set_result ($attr->{Length});
+   $self->set_result (hex $attr->{length});
 }
 
 package Net::FCP::Txn::GetPut;
@@ -684,8 +717,8 @@
 
 use base Net::FCP::Txn;
 
-*rcv_uri_error        = \&Net::FCP::Txn::rcv_throw_exception;
-*rcv_route_not_found  = \&Net::FCP::Txn::rcv_throw_exception;
+*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) = @_;
@@ -703,38 +736,36 @@
 
 *rcv_data_not_found = \&Net::FCP::Txn::rcv_throw_exception;
 
-sub rcv_data_found {
-   my ($self, $attr, $type) = @_;
-
-   $self->progress ($type, $attr);
+sub rcv_data {
+   my ($self, $chunk) = @_;
 
-   $self->{datalength} = hex $attr->{data_length};
-   $self->{metalength} = hex $attr->{metadata_length};
-}
+   $self->{data} .= $chunk;
 
-sub eof {
-   my ($self) = @_;
+   $self->progress ("data", { chunk => length $chunk, received => length $self->{data}, total => $self->{datalength} });
 
    if ($self->{datalength} == length $self->{data}) {
       my $data = delete $self->{data};
-      my $meta = Net::FCP::parse_metadata substr $data, 0, $self->{metalength}, "";
+      my $meta = new Net::FCP::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},
-                                              }));
+      $self->eof;
    }
 }
 
+sub rcv_data_found {
+   my ($self, $attr, $type) = @_;
+
+   $self->progress ($type, $attr);
+
+   $self->{datalength} = hex $attr->{data_length};
+   $self->{metalength} = hex $attr->{metadata_length};
+}
+
 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) = @_;
@@ -746,19 +777,76 @@
    $self->set_result ($attr);
 }
 
+sub rcv_key_collision {
+   my ($self, $attr, $type) = @_;
+   $self->set_result ({ key_collision => 1, %$attr });
+}
+
+=back
+
+=head2 The Net::FCP::Exception CLASS
+
+Any unexpected (non-standard) responses that make it impossible to return
+the advertised result will result in an exception being thrown when the
+C<result> method is called.
+
+These exceptions are represented by objects of this class.
+
+=over 4
+
+=cut
+
 package Net::FCP::Exception;
 
 use overload
    '""' => sub {
-      "Net::FCP::Exception<<$_[0][0]," . (join ":", %{$_[0][1]}) . ">>\n";
+      "Net::FCP::Exception<<$_[0][0]," . (join ":", %{$_[0][1]}) . ">>";
    };
 
+=item $exc = new Net::FCP::Exception $type, \%attr
+
+Create a new exception object of the given type (a string like
+C<route_not_found>), and a hashref containing additional attributes
+(usually the attributes of the message causing the exception).
+
+=cut
+
 sub new {
    my ($class, $type, $attr) = @_;
 
    bless [Net::FCP::tolc $type, { %$attr }], $class;
 }
 
+=item $exc->type([$type])
+
+With no arguments, returns the exception type. Otherwise a boolean
+indicating wether the exception is of the given type is returned.
+
+=cut
+
+sub type {
+   my ($self, $type) = @_;
+
+   @_ >= 2
+      ? $self->[0] eq $type
+      : $self->[0];
+}
+
+=item $exc->attr([$attr])
+
+With no arguments, returns the attributes. Otherwise the named attribute
+value is returned.
+
+=cut
+
+sub attr {
+   my ($self, $attr) = @_;
+
+   @_ >= 2
+      ? $self->[1]{$attr}
+      : $self->[1];
+}
+
 =back
 
 =head1 SEE ALSO
@@ -774,5 +862,37 @@
 
 =cut
 
+package Net::FCP::Event::Auto;
+
+my @models = (
+      [Coro  => Coro::Event::],
+      [Event => Event::],
+      [Glib  => Glib::],
+      [Tk    => Tk::],
+);
+
+sub AUTOLOAD {
+   $AUTOLOAD =~ s/.*://;
+
+   for (@models) {
+      my ($model, $package) = @$_;
+      if (defined ${"$package\::VERSION"}) {
+         $EVENT = "Net::FCP::Event::$model";
+         eval "require $EVENT"; die if $@;
+         goto &{"$EVENT\::$AUTOLOAD"};
+      }
+   }
+
+   for (@models) {
+      my ($model, $package) = @$_;
+      $EVENT = "Net::FCP::Event::$model";
+      if (eval "require $EVENT") {
+         goto &{"$EVENT\::$AUTOLOAD"};
+      }
+   }
+
+   die "No event module selected for Net::FCP and autodetect failed. Install any of these: Coro, Event, Glib or Tk.";
+}
+
 1;