view release on metacpan or  search on metacpan

FCP.pm  view on Meta::CPAN

      });
   });
};

=item $status = $fcp->remove_request ($identifier[, $global])

Remove the request with the given isdentifier. Returns true if successful,
false on error.

=cut

_txn remove_request => sub {
   my ($self, $ok, $err, $identifier, $global) = @_;

   $self->serialise ($identifier => sub {
      my ($self, $guard) = @_;

      $self->send_msg (remove_request =>
         identifier => $identifier,
         global     => $global ? "true" : "false",
      );
      $self->on (sub {
         my ($self, $type, $kv, @extra) = @_;

         $guard if 0;

         if ($kv->{identifier} eq $identifier) {
            if ($type eq "persistent_request_removed") {
               $ok->(1);
               return;
            } elsif ($type eq "protocol_error") {
               $err->($kv);
               return;
            }
         }

         1
      });
   });
};

=item ($can_read, $can_write) = $fcp->test_dda ($local_directory, $remote_directory, $want_read, $want_write))

The DDA test in FCP is probably the single most broken protocol - only
one directory test can be outstanding at any time, and some guessing and
heuristics are involved in mangling the paths.

This function combines C<TestDDARequest> and C<TestDDAResponse> in one
request, handling file reading and writing as well, and tries very hard to
do the right thing.

Both C<$local_directory> and C<$remote_directory> must specify the same
directory - C<$local_directory> is the directory path on the client (where
L<AnyEvent::FCP> runs) and C<$remote_directory> is the directory path on
the server (where the freenet node runs). When both are running on the
same node, the paths are generally identical.

C<$want_read> and C<$want_write> should be set to a true value when you
want to read (get) files or write (put) files, respectively.

On error, an exception is thrown. Otherwise, C<$can_read> and
C<$can_write> indicate whether you can reaqd or write to freenet via the
directory.

=cut

_txn test_dda => sub {
   my ($self, $ok, $err, $local, $remote, $want_read, $want_write) = @_;

   $self->serialise (test_dda => sub {
      my ($self, $guard) = @_;

      $self->send_msg (test_dda_request =>
         directory            => $remote,
         want_read_directory  => $want_read  ? "true" : "false",
         want_write_directory => $want_write ? "true" : "false",
      );
      $self->on (sub {
         my ($self, $type, $kv) = @_;

         if ($type eq "test_dda_reply") {
            # the filenames are all relative to the server-side directory,
            # which might or might not match $remote anymore, so we
            # need to rewrite the paths to be relative to $local
            for my $k (qw(read_filename write_filename)) {
               my $f = $kv->{$k};
               for my $dir ($kv->{directory}, $remote) {
                  if ($dir eq substr $f, 0, length $dir) {
                     substr $f, 0, 1 + length $dir, "";
                     $kv->{$k} = $f;
                     last;
                  }
               }
            }

            my %response = (directory => $remote);

            if (length $kv->{read_filename}) {
               if (open my $fh, "<:raw", "$local/$kv->{read_filename}") {
                  sysread $fh, my $buf, -s $fh;
                  $response{read_content} = $buf;
               }
            }

            if (length $kv->{write_filename}) {
               if (open my $fh, ">:raw", "$local/$kv->{write_filename}") {
                  syswrite $fh, $kv->{content_to_write};
               }
            }

            $self->send_msg (test_dda_response => %response);

            $self->on (sub {
               my ($self, $type, $kv) = @_;

               $guard if 0; # reference

               if ($type eq "test_dda_complete") {
                  $ok->(
                     $kv->{read_directory_allowed} eq "true",
                     $kv->{write_directory_allowed} eq "true",