summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Echolot/Storage/File.pm532
1 files changed, 450 insertions, 82 deletions
diff --git a/Echolot/Storage/File.pm b/Echolot/Storage/File.pm
index 81e6524..21c13ea 100644
--- a/Echolot/Storage/File.pm
+++ b/Echolot/Storage/File.pm
@@ -1,7 +1,7 @@
package Echolot::Storage::File;
# (c) 2002 Peter Palfrader <peter@palfrader.org>
-# $Id: File.pm,v 1.45 2003/02/03 20:10:35 weasel Exp $
+# $Id: File.pm,v 1.46 2003/02/12 20:38:04 weasel Exp $
#
=pod
@@ -29,6 +29,17 @@ use POSIX; # import SEEK_* constants (older perls don't have SEEK_ in Fcntl)
use Echolot::Tools;
use Echolot::Log;
+
+
+my $CONSTANTS = {
+ 'metadatafile' => 'metadata'
+};
+
+delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
+
+my $METADATA_VERSION = 1;
+
+
=item B<new> (I<%args>)
Creates a new storage backend object.
@@ -44,15 +55,6 @@ data.
=back
=cut
-
-my $CONSTANTS = {
- 'metadatafile' => 'metadata'
-};
-
-delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
-
-my $METADATA_VERSION = 1;
-
sub new {
my ($class, %params) = @_;
my $self = {};
@@ -77,6 +79,11 @@ sub new {
return $self;
};
+=item $storage->B<commit>( )
+
+Write metadata unless B<delay_commt> is set.
+
+=cut
sub commit($) {
my ($self) = @_;
@@ -88,11 +95,23 @@ sub commit($) {
$self->{'COMMIT_PENDING'} = 0;
};
+=item $storage->B<delay_commit>( )
+
+Increase B<delay_commit> by one.
+
+=cut
sub delay_commit($) {
my ($self) = @_;
$self->{'DELAY_COMMIT'}++;
};
+
+=item $storage->B<enable_commit>( I<$set_> )
+
+Decrease B<delay_commit> by one and call C<commit> if B<delay_commit> is zero
+and I<$set_pending> is true.
+
+=cut
sub enable_commit($;$) {
my ($self, $set_pending) = @_;
@@ -100,6 +119,11 @@ sub enable_commit($;$) {
$self->commit() if (($self->{'COMMIT_PENDING'} || (defined $set_pending && $set_pending)) && ! $self->{'DELAY_COMMIT'});
};
+=item $storage->B<finish>( )
+
+Shut down cleanly.
+
+=cut
sub finish($) {
my ($self) = @_;
@@ -111,6 +135,13 @@ sub finish($) {
+=item $storage->B<metadata_open>( )
+
+Open metadata.
+
+Returns 1 on success, undef on errors.
+
+=cut
sub metadata_open($) {
my ($self) = @_;
@@ -120,32 +151,46 @@ sub metadata_open($) {
if ( -e $filename ) {
open($self->{'METADATA_FH'}, '+<' . $filename) or
Echolot::Log::warn("Cannot open $filename for reading: $!."),
- return 0;
+ return undef;
} else {
$self->{'METADATA_FILE_IS_NEW'} = 1;
open($self->{'METADATA_FH'}, '+>' . $filename) or
Echolot::Log::warn("Cannot open $filename for reading: $!."),
- return 0;
+ return undef;
};
flock($self->{'METADATA_FH'}, LOCK_EX) or
Echolot::Log::warn("Cannot get exclusive lock on $filename: $!."),
- return 0;
+ return undef;
return 1;
};
+=item $storage->B<metadata_close>( )
+
+Close metadata.
+
+Returns 1 on success, undef on errors.
+
+=cut
sub metadata_close($) {
my ($self) = @_;
flock($self->{'METADATA_FH'}, LOCK_UN) or
Echolot::Log::warn("Error when releasing lock on metadata file: $!."),
- return -1;
+ return undef;
close($self->{'METADATA_FH'}) or
Echolot::Log::warn("Error when closing metadata file: $!."),
- return 0;
+ return undef;
return 1;
};
+=item $storage->B<metadata_read>( )
+
+Write metadata.
+
+Returns 1 on success, undef on errors.
+
+=cut
sub metadata_read($) {
my ($self) = @_;
@@ -172,14 +217,14 @@ sub metadata_read($) {
};
$EVAL_ERROR and
confess("Error when reading from metadata file: $EVAL_ERROR"),
- return 0;
+ return undef;
defined($self->{'METADATA'}->{'version'}) or
confess("Stored data lacks version header"),
- return 0;
+ return undef;
($self->{'METADATA'}->{'version'} == ($METADATA_VERSION)) or
Echolot::Log::warn("Metadata version mismatch ($self->{'METADATA'}->{'version'} vs. $METADATA_VERSION)."),
- return 0;
+ return undef;
};
defined($self->{'METADATA'}->{'secret'}) or
@@ -189,6 +234,13 @@ sub metadata_read($) {
return 1;
};
+=item $storage->B<metadata_write>( )
+
+Write metadata.
+
+Returns 1 on success, undef on errors.
+
+=cut
sub metadata_write($) {
my ($self) = @_;
@@ -197,21 +249,28 @@ sub metadata_write($) {
seek($fh, 0, SEEK_SET) or
Echolot::Log::warn("Cannot seek to start of metadata file: $!."),
- return 0;
+ return undef;
truncate($fh, 0) or
Echolot::Log::warn("Cannot truncate metadata file to zero length: $!."),
- return 0;
+ return undef;
print($fh "# vim:set syntax=perl:\n") or
Echolot::Log::warn("Error when writing to metadata file: $!."),
- return 0;
+ return undef;
print($fh $data) or
Echolot::Log::warn("Error when writing to metadata file: $!."),
- return 0;
+ return undef;
$fh->flush();
return 1;
};
+=item $storage->B<metadata_backup>( )
+
+Rotate metadata files and create a backup.
+
+Returns 1 on success, undef on errors.
+
+=cut
sub metadata_backup($) {
my ($self) = @_;
@@ -227,22 +286,22 @@ sub metadata_backup($) {
my $fh = new IO::Handle;
open ($fh, '>'.$filename) or
Echolot::Log::warn("Cannot open $filename for writing: $!."),
- return 0;
+ return undef;
print($fh "# vim:set syntax=perl:\n") or
Echolot::Log::warn("Error when writing to metadata file: $!."),
- return 0;
+ return undef;
print($fh $data) or
Echolot::Log::warn("Error when writing to metadata file: $!."),
- return 0;
+ return undef;
$fh->flush();
close($fh) or
Echolot::Log::warn("Error when closing metadata file: $!."),
- return 0;
+ return undef;
if (Echolot::Config::get()->{'gzip'}) {
system(Echolot::Config::get()->{'gzip'}, $filename) and
Echolot::Log::warn("Gziping $filename failed."),
- return 0;
+ return undef;
};
return 1;
@@ -251,21 +310,28 @@ sub metadata_backup($) {
+=item $storage->B<pingdata_open_one>( I<$remailer_addr>, I<$type>, I<$key> )
+
+Open the pingdata file for the I<$remailer_addr>, I<$type>, and I<$key>.
+
+Returns 1 on success, undef on errors.
+
+=cut
sub pingdata_open_one($$$$) {
my ($self, $remailer_addr, $type, $key) = @_;
defined ($self->{'METADATA'}->{'remailers'}->{$remailer_addr}) or
Echolot::Log::cluck ("$remailer_addr does not exist in Metadata."),
- return 0;
+ return undef;
defined ($self->{'METADATA'}->{'remailers'}->{$remailer_addr}->{'keys'}) or
Echolot::Log::cluck ("$remailer_addr has no keys in Metadata."),
- return 0;
+ return undef;
defined ($self->{'METADATA'}->{'remailers'}->{$remailer_addr}->{'keys'}->{$type}) or
Echolot::Log::cluck ("$remailer_addr type $type does not exist in Metadata."),
- return 0;
+ return undef;
defined ($self->{'METADATA'}->{'remailers'}->{$remailer_addr}->{'keys'}->{$type}->{$key}) or
Echolot::Log::cluck ("$remailer_addr type $type key $key does not exist in Metadata."),
- return 0;
+ return undef;
my $basename = $self->{'METADATA'}->{'remailers'}->{$remailer_addr}->{'keys'}->{$type}->{$key}->{'stats'};
@@ -280,22 +346,29 @@ sub pingdata_open_one($$$$) {
if ( -e $filename.'.'.$direction ) {
open($fh, '+<' . $filename.'.'.$direction) or
Echolot::Log::warn("Cannot open $filename.$direction for reading: $!."),
- return 0;
+ return undef;
$self->{'PING_FHS'}->{$remailer_addr}->{$type}->{$key}->{$direction} = $fh;
} else {
open($fh, '+>' . $filename.'.'.$direction) or
Echolot::Log::warn("Cannot open $filename.$direction for reading: $!."),
- return 0;
+ return undef;
$self->{'PING_FHS'}->{$remailer_addr}->{$type}->{$key}->{$direction} = $fh;
};
flock($fh, LOCK_EX) or
Echolot::Log::warn("Cannot get exclusive lock on $remailer_addr $type $key $direction pings: $!."),
- return 0;
+ return undef;
};
return 1;
};
+=item $storage->B<pingdata_open>( )
+
+Open all pingdata files.
+
+Returns 1.
+
+=cut
sub pingdata_open($) {
my ($self) = @_;
@@ -309,12 +382,19 @@ sub pingdata_open($) {
return 1;
};
+=item $storage->B<get_ping_fh>( I<$remailer_addr>, I<$type>, I<$key>, I<$direction> )
+
+Return the FH for the pingdata file of I<$remailer_addr>, I<$type>, I<$key>, and I<$direction>.
+
+Returns undef on error;
+
+=cut
sub get_ping_fh($$$$$) {
my ($self, $remailer_addr, $type, $key, $direction) = @_;
defined ($self->{'METADATA'}->{'remailers'}->{$remailer_addr}) or
Echolot::Log::cluck("$remailer_addr does not exist in Metadata."),
- return 0;
+ return undef;
my @pings;
my $fh = $self->{'PING_FHS'}->{$remailer_addr}->{$type}->{$key}->{$direction};
@@ -324,11 +404,18 @@ sub get_ping_fh($$$$$) {
$fh = $self->{'PING_FHS'}->{$remailer_addr}->{$type}->{$key}->{$direction};
defined ($fh) or
Echolot::Log::warn ("$remailer_addr; type=$type; key=$key has no assigned filehandle for $direction pings."),
- return 0;
+ return undef;
return $fh;
};
+=item $storage->B<pingdata_close_one>( I<$remailer_addr>, I<$type>, I<$key> )
+
+Close the pingdata file for the I<$remailer_addr>, I<$type>, and I<$key>.
+
+Returns 1 on success, undef on errors.
+
+=cut
sub pingdata_close_one($$$$;$) {
my ($self, $remailer_addr, $type, $key, $delete) = @_;
@@ -337,10 +424,10 @@ sub pingdata_close_one($$$$;$) {
flock($fh, LOCK_UN) or
Echolot::Log::warn("Error when releasing lock on $remailer_addr type $type key $key direction $direction pings: $!."),
- return 0;
+ return undef;
close ($fh) or
Echolot::Log::warn("Error when closing $remailer_addr type $type key $key direction $direction pings: $!."),
- return 0;
+ return undef;
if ((defined $delete) && ($delete eq 'delete')) {
my $basename = $self->{'METADATA'}->{'remailers'}->{$remailer_addr}->{'keys'}->{$type}->{$key}->{'stats'};
@@ -361,6 +448,13 @@ sub pingdata_close_one($$$$;$) {
return 1;
};
+=item $storage->B<pingdata_close>( )
+
+Close all pingdata files.
+
+Returns 1 on success, undef on errors.
+
+=cut
sub pingdata_close($) {
my ($self) = @_;
@@ -369,13 +463,25 @@ sub pingdata_close($) {
for my $key ( keys %{$self->{'PING_FHS'}->{$remailer_addr}->{$type}} ) {
$self->pingdata_close_one($remailer_addr, $type, $key) or
Echolot::Log::debug("Error when calling pingdata_close_one with $remailer_addr type $type key $key."),
- return 0;
+ return undef;
};
};
};
return 1;
};
+=item $storage->B<get_pings>( I<$remailer_addr>, I<$type>, I<$key>, I<$direction> )
+
+Return an array of ping data for I<$remailer_addr>, I<$type>, I<$key>, and I<$direction>.
+
+If direction is B<out> then it's an array of scalar (the send timestamps).
+
+If direction is B<done> then it's an array of array references each having two
+items: the send time and the latency.
+
+Returns undef on error;
+
+=cut
sub get_pings($$$$$) {
my ($self, $remailer_addr, $type, $key, $direction) = @_;
@@ -383,11 +489,11 @@ sub get_pings($$$$$) {
my $fh = $self->get_ping_fh($remailer_addr, $type, $key, $direction) or
Echolot::Log::warn ("$remailer_addr; type=$type; key=$key has no assigned filehandle for $direction pings."),
- return 0;
+ return undef;
seek($fh, 0, SEEK_SET) or
Echolot::Log::warn("Cannot seek to start of $remailer_addr type $type key $key direction $direction pings: $!."),
- return 0;
+ return undef;
if ($direction eq 'out') {
@pings = map {chomp; $_; } <$fh>;
@@ -395,7 +501,7 @@ sub get_pings($$$$$) {
@pings = map {chomp; my @arr = split (/\s+/, $_, 2); \@arr; } <$fh>;
} else {
confess("What the hell am I doing here? $remailer_addr; $type; $key; $direction"),
- return 0;
+ return undef;
};
return @pings;
};
@@ -404,32 +510,46 @@ sub get_pings($$$$$) {
+=item $storage->B<register_pingout>( I<$remailer_addr>, I<$type>, I<$key>, I<$sent_time> )
+Register a ping sent to I<$remailer_addr>, I<$type>, I<$key> and I$<sent_time>.
+
+Returns 1 on success, undef on errors.
+
+=cut
sub register_pingout($$$$) {
my ($self, $remailer_addr, $type, $key, $sent_time) = @_;
my $fh = $self->get_ping_fh($remailer_addr, $type, $key, 'out') or
Echolot::Log::cluck ("$remailer_addr; type=$type; key=$key has no assigned filehandle for out pings."),
- return 0;
+ return undef;
seek($fh, 0, SEEK_END) or
Echolot::Log::warn("Cannot seek to end of $remailer_addr; type=$type; key=$key; out pings: $!."),
- return 0;
+ return undef;
print($fh $sent_time."\n") or
Echolot::Log::warn("Error when writing to $remailer_addr; type=$type; key=$key; out pings: $!."),
- return 0;
+ return undef;
$fh->flush();
Echolot::Log::info("registering pingout for $remailer_addr ($type; $key).");
return 1;
};
+=item $storage->B<register_pingdone>( I<$remailer_addr>, I<$type>, I<$key>, I<$sent_time>, I<$latency> )
+
+Register that the ping sent to I<$remailer_addr>, I<$type>, I<$key> at
+I$<sent_time> has returned with latency I<$latency>.
+
+Returns 1 on success, undef on errors.
+
+=cut
sub register_pingdone($$$$$) {
my ($self, $remailer_addr, $type, $key, $sent_time, $latency) = @_;
defined ($self->{'METADATA'}->{'remailers'}->{$remailer_addr}) or
Echolot::Log::cluck ("$remailer_addr does not exist in Metadata."),
- return 0;
+ return undef;
my @outpings = $self->get_pings($remailer_addr, $type, $key, 'out');
my $origlen = scalar (@outpings);
@@ -441,28 +561,28 @@ sub register_pingdone($$$$$) {
# write ping to done
my $fh = $self->get_ping_fh($remailer_addr, $type, $key, 'done') or
Echolot::Log::cluck ("$remailer_addr; type=$type; key=$key has no assigned filehandle for done pings."),
- return 0;
+ return undef;
seek($fh, 0, SEEK_END) or
Echolot::Log::warn("Cannot seek to end of $remailer_addr out pings: $!."),
- return 0;
+ return undef;
print($fh $sent_time." ".$latency."\n") or
Echolot::Log::warn("Error when writing to $remailer_addr out pings: $!."),
- return 0;
+ return undef;
$fh->flush();
# rewrite outstanding pings
$fh = $self->get_ping_fh($remailer_addr, $type, $key, 'out') or
Echolot::Log::cluck ("$remailer_addr; type=$type; key=$key has no assigned filehandle for out pings."),
- return 0;
+ return undef;
seek($fh, 0, SEEK_SET) or
Echolot::Log::warn("Cannot seek to start of outgoing pings file for remailer $remailer_addr; key=$key: $!."),
- return 0;
+ return undef;
truncate($fh, 0) or
Echolot::Log::warn("Cannot truncate outgoing pings file for remailer $remailer_addr; key=$key file to zero length: $!."),
- return 0;
+ return undef;
print($fh (join "\n", @outpings), (scalar @outpings ? "\n" : '') ) or
Echolot::Log::warn("Error when writing to outgoing pings file for remailer $remailer_addr; key=$key file: $!."),
- return 0;
+ return undef;
$fh->flush();
Echolot::Log::info("registering pingdone from ".(scalar localtime $sent_time)." with latency $latency for $remailer_addr ($type; $key).");
@@ -472,14 +592,31 @@ sub register_pingdone($$$$$) {
+=item $storage->B<add_prospective_address>( I<$addr>, I<$reason>, I<$additional> )
+
+Add I<$addr> to the list of prospective remailers with I<$reason> and
+I<$additional> information.
+
+Returns 1.
+
+=cut
sub add_prospective_address($$$$) {
my ($self, $addr, $reason, $additional) = @_;
return 1 if defined $self->{'METADATA'}->{'addresses'}->{$addr};
push @{ $self->{'METADATA'}->{'prospective_addresses'}{$addr} }, time().'; '. $reason. '; '. $additional;
$self->commit();
+
+ return 1;
};
+=item $storage->B<commit_prospective_address>( )
+
+Commit prospective remailers to the list of remailers we know.
+
+Returns 1.
+
+=cut
sub commit_prospective_address($) {
my ($self) = @_;
@@ -513,6 +650,7 @@ sub commit_prospective_address($) {
# got prospective by reply to own remailer-conf or remailer-key request
if ( defined $reasons{'self-capsstring-conf'} || defined $reasons{'self-capsstring-key'} ) {
+ Echolot::Log::notice("$addr is used because of direct conf or key reply");
$self->add_address($addr);
delete $self->{'METADATA'}->{'prospective_addresses'}->{$addr};
next;
@@ -526,6 +664,7 @@ sub commit_prospective_address($) {
my %unique;
@adds = grep { ! $unique{$_}++; } @adds;
if (scalar @adds >= Echolot::Config::get()->{'reliable_auto_add_min'} ) {
+ Echolot::Log::notice("$addr is recommended by ". join(', ', @adds),".");
$self->add_address($addr);
delete $self->{'METADATA'}->{'prospective_addresses'}->{$addr};
next;
@@ -534,8 +673,36 @@ sub commit_prospective_address($) {
};
$self->enable_commit(1);
+
+ return 1;
};
+=item $storage->B<get_address>( I<$addr> )
+
+Get a reference to a hash of information of the remailers with address
+I<$addr>.
+
+The hash has the following keys:
+
+=over
+
+=item status
+
+=item id
+
+=item address
+
+=item fetch
+
+=item shoit
+
+=item resurrection_ttl
+
+=back
+
+Returns undef on errors.
+
+=cut
sub get_address($$) {
my ($self, $addr) = @_;
@@ -555,6 +722,12 @@ sub get_address($$) {
return $result;
};
+=item $storage->B<get_addresses>( )
+
+Get an array of all remailers we know about. Each element in this array is a
+hash reference as returned by C<get_address>.
+
+=cut
sub get_addresses($) {
my ($self) = @_;
@@ -563,6 +736,18 @@ sub get_addresses($) {
return @return_data;
};
+=item $storage->B<add_address>( I<$addr> )
+
+Adds a remailer with address I<$addr>. B<fetch>, B<pingit>, and B<shoit> are
+set to the values configured for new remailers.
+
+Assign the remailer status B<active> and a new unique ID.
+
+See L<pingd.conf(5)> for more information on this.
+
+Returns 1.
+
+=cut
sub add_address($$) {
my ($self, $addr) = @_;
@@ -579,8 +764,7 @@ sub add_address($$) {
- # FIXME logging and such
- Echolot::Log::info("Adding address $addr.");
+ Echolot::Log::notice("Adding address $addr.");
my $remailer = {
id => $maxid + 1,
@@ -597,6 +781,20 @@ sub add_address($$) {
return 1;
};
+=item $storage->B<set_stuff>( I<@args> )
+
+@args is supposed to have two elements: I<$address>, and I<$setting>.
+
+Set verious options for the remailer with address $I<$address>.
+
+I<$setting> has to be of the form C<key=value>. Recognised keys are B<pingit>,
+B<fetch>, and B<showit>. Acceptable values are B<on> and B<off>.
+
+See L<pingd(1)> for the meaning of these settings.
+
+Returns 1, undef on error.
+
+=cut
sub set_stuff($@) {
my ($self, @args) = @_;
@@ -605,14 +803,14 @@ sub set_stuff($@) {
defined ($addr) or
Echolot::Log::cluck ("Could not get address for '$args'."),
- return 0;
+ return undef;
defined ($setting) or
Echolot::Log::cluck ("Could not get setting for '$args'."),
- return 0;
+ return undef;
defined ($self->{'METADATA'}->{'addresses'}->{$addr}) or
Echolot::Log::warn ("Address $addr does not exist."),
- return 0;
+ return undef;
if ($setting =~ /^(pingit|fetch|showit)=(on|off)$/) {
@@ -622,7 +820,7 @@ sub set_stuff($@) {
$self->{'METADATA'}->{'addresses'}->{$addr}->{$option} = ($value eq 'on');
} else {
Echolot::Log::warn ("Don't know what to do with '$setting' for $addr."),
- return 0;
+ return undef;
}
$self->commit();
@@ -630,6 +828,13 @@ sub set_stuff($@) {
};
+=item $storage->B<get_address_by_id>( I<$id> )
+
+Return the address for the remailer with id I<$id>.
+
+Return undef if there is no remailer with that id.
+
+=cut
sub get_address_by_id($$) {
my ($self, $id) = @_;
@@ -644,22 +849,40 @@ sub get_address_by_id($$) {
return \%return_data;
};
+=item $storage->B<decrease_resurrection_ttl>( I<$address> )
+
+Decrease the TTL (Time To Live) for remailer with address I<$address> by one.
+
+If it hits zero the remailer's status is set to B<ttl timeout>.
+
+Returns 1, undef on error.
+
+=cut
sub decrease_ttl($$) {
my ($self, $address) = @_;
defined ($self->{'METADATA'}->{'addresses'}->{$address}) or
Echolot::Log::cluck ("$address does not exist in Metadata address list."),
- return 0;
+ return undef;
$self->{'METADATA'}->{'addresses'}->{$address}->{'ttl'} --;
$self->{'METADATA'}->{'addresses'}->{$address}->{'status'} = 'ttl timeout',
Echolot::Log::info("Remailer $address disabled: ttl expired."),
$self->{'METADATA'}->{'addresses'}->{$address}->{'resurrection_ttl'} = Echolot::Config::get()->{'check_resurrection_ttl'}
if ($self->{'METADATA'}->{'addresses'}->{$address}->{'ttl'} <= 0);
- # FIXME have proper logging
$self->commit();
return 1;
};
+=item $storage->B<decrease_resurrection_ttl>( I<$address> )
+
+Decrease the resurrection TTL (Time To Live) for remailer with address
+I<$address> by one.
+
+If it hits zero the remailer's status is set to B<dead>.
+
+Returns 1, undef on error.
+
+=cut
sub decrease_resurrection_ttl($$) {
my ($self, $address) = @_;
@@ -673,20 +896,29 @@ sub decrease_resurrection_ttl($$) {
$self->{'METADATA'}->{'addresses'}->{$address}->{'status'} = 'dead',
Echolot::Log::info("Remailer $address is dead."),
if ($self->{'METADATA'}->{'addresses'}->{$address}->{'resurrection_ttl'} <= 0);
- # FIXME have proper logging
$self->commit();
return 1;
};
+=item $storage->B<restore_ttl>( I<$address> )
+
+Restore the TTL (Time To Live) for remailer with address I<$address> to the
+value configured with I<addresses_default_ttl>
+
+See L<pingd.conf(5)> for more information on this settings.
+
+Returns 1, undef on error.
+
+=cut
sub restore_ttl($$) {
my ($self, $address) = @_;
defined ($self->{'METADATA'}->{'addresses'}->{$address}) or
Echolot::Log::cluck ("$address does not exist in Metadata address list."),
- return 0;
+ return undef;
defined ($self->{'METADATA'}->{'addresses'}->{$address}->{'status'}) or
Echolot::Log::cluck ("$address does exist in Metadata address list but does not have status defined."),
- return 0;
+ return undef;
Echolot::Log::info("Remailer $address is alive and active again.")
unless ($self->{'METADATA'}->{'addresses'}->{$address}->{'status'} eq 'active');
$self->{'METADATA'}->{'addresses'}->{$address}->{'ttl'} = Echolot::Config::get()->{'addresses_default_ttl'};
@@ -698,17 +930,26 @@ sub restore_ttl($$) {
return 1;
};
+
+=item $storage->B<not_a_remaielr>( I<$id> )
+
+Set the remailer whoise id is I<$id> to B<disabled by user reply: is not a
+remailer>.
+
+Returns 1, undef on error.
+
+=cut
sub not_a_remailer($$) {
my ($self, $id) = @_;
my $remailer = $self->get_address_by_id($id);
defined $remailer or
Echolot::Log::cluck("No remailer found for id '$id'."),
- return 0;
+ return undef;
my $address = $remailer->{'address'};
defined ($self->{'METADATA'}->{'addresses'}->{$address}) or
Echolot::Log::cluck ("$address does not exist in Metadata address list."),
- return 0;
+ return undef;
$self->{'METADATA'}->{'addresses'}->{$address}->{'status'} = 'disabled by user reply: is not a remailer';
Echolot::Log::info("Setting $id, $address to disabled by user reply.");
@@ -717,6 +958,25 @@ sub not_a_remailer($$) {
return 1;
};
+=item $storage->B<set_caps>( I<$type>, I<$caps>, I<$nick>, I<$address>, I<$timestamp> [, I<$dont_expire> ])
+
+Sets the capabilities for remailer with address I<$address> to the given
+information (I<$nick>, I<$type>, I<$caps>, I<$timestamp>).
+
+Type here means the software used (Mixmaster, Reliable) as given by the
+remailer-conf reply or something like B<set manually>.
+
+If there already is newer information about that key than I<$timestamp> the
+update is disregarded.
+
+Additionally the remailer's status is set to B<active>.
+
+If I<$dont_expire> is defined the setting is copied to the remailers metadata
+as well.
+
+Returns 1.
+
+=cut
sub set_caps($$$$$$;$) {
my ($self, $type, $caps, $nick, $address, $timestamp, $dont_expire) = @_;
if (! defined $self->{'METADATA'}->{'remailers'}->{$address} ||
@@ -768,6 +1028,19 @@ sub set_caps($$$$$$;$) {
return 1;
};
+=item $storage->B<set_key>( I<$type>, I<$nick>, I<$address>, I<$key>, I<$keyid>, I<$version>, I<$caps>, I<$summary>, I<$timestamp>)
+
+Sets the I<$type> key I<$keyid> for remailer with address I<$address> to the
+given information (I<$nick>, I<$key>, I<$caps>, I<$summary>, I<$timestamp>).
+
+If there already is newer information about that key than I<$timestamp> the
+update is disregarded.
+
+Additionally the remailer's status is set to B<active>.
+
+Returns 1.
+
+=cut
sub set_key($$$$$$$$$) {
my ($self, $type, $nick, $address, $key, $keyid, $version, $caps, $summary, $timestamp) = @_;
@@ -826,12 +1099,23 @@ sub set_key($$$$$$$$$) {
return 1;
};
+=item $storage->B<get_secret>( )
+
+Return our secret (Used in Message Authentication Codes).
+
+=cut
sub get_secret($) {
my ($self) = @_;
return $self->{'METADATA'}->{'secret'};
};
+=item $storage->B<get_remailers>( )
+
+Get an array of hashes of remailers. Each hash has the keys C<status>,
+C<pingit>, C<showit>, and C<address>
+
+=cut
sub get_remailers($) {
my ($self) = @_;
@@ -849,24 +1133,42 @@ sub get_remailers($) {
return @return_data;
};
+=item $storage->B<get_types>( I<$remailer> )
+
+Get an array of types supported by remailer with address I<$remailer>.
+
+Returns undef on errors.
+
+¿ It may be possible that a type is returned but then has no keys. This may be
+a bug, I'm not sure.
+
+=cut
sub get_types($$) {
my ($self, $remailer) = @_;
defined ($self->{'METADATA'}->{'remailers'}->{$remailer}) or
Echolot::Log::cluck ("$remailer does not exist in Metadata remailer list."),
- return 0;
+ return undef;
return () unless defined $self->{'METADATA'}->{'remailers'}->{$remailer}->{'keys'};
my @types = keys %{$self->{'METADATA'}->{'remailers'}->{$remailer}->{'keys'}};
return @types;
};
+
+=item $storage->B<has_type>( I<$remailer>, I<$type> )
+
+Checks if the remailer with address I<$remailer> has type I<$type> keys.
+
+Returns 1 if it has, 0 if not, undef on errors.
+
+=cut
sub has_type($$$) {
my ($self, $remailer, $type) = @_;
defined ($self->{'METADATA'}->{'remailers'}->{$remailer}) or
Echolot::Log::cluck ("$remailer does not exist in Metadata remailer list."),
- return 0;
+ return undef;
return 0 unless defined $self->{'METADATA'}->{'remailers'}->{$remailer}->{'keys'};
return 0 unless defined $self->{'METADATA'}->{'remailers'}->{$remailer}->{'keys'}->{$type};
@@ -874,35 +1176,55 @@ sub has_type($$$) {
return 1;
};
+
+=item $storage->B<get_keys>( I<$remailer>, I<$type> )
+
+Returns an array listing all keyids of type I<$type> of remailer with address
+I<$remailer>.
+
+Returns undef on errors.
+
+=cut
sub get_keys($$) {
my ($self, $remailer, $type) = @_;
defined ($self->{'METADATA'}->{'remailers'}->{$remailer}) or
Echolot::Log::cluck ("$remailer does not exist in Metadata remailer list."),
- return 0;
+ return undef;
defined ($self->{'METADATA'}->{'remailers'}->{$remailer}->{'keys'}->{$type}) or
Echolot::Log::cluck ("$remailer does not have type '$type' in Metadata remailer list."),
- return 0;
+ return undef;
my @keys = keys %{$self->{'METADATA'}->{'remailers'}->{$remailer}->{'keys'}->{$type}};
return @keys;
};
+
+
+=item $storage->B<get_key>( I<$remailer>, I<$type>, I<$key> )
+
+Returns a hash having they keys C<summary>, C<key>, C<nick>, and
+C<last_updated> of the I<$type> key with id I<$key> of remailer with address
+I<$remailer>.
+
+Returns undef on errors.
+
+=cut
sub get_key($$$$) {
my ($self, $remailer, $type, $key) = @_;
defined ($self->{'METADATA'}->{'remailers'}->{$remailer}) or
Echolot::Log::cluck ("$remailer does not exist in Metadata remailer list."),
- return 0;
+ return undef;
defined ($self->{'METADATA'}->{'remailers'}->{$remailer}->{'keys'}->{$type}) or
Echolot::Log::cluck ("$remailer does not have type '$type' in Metadata remailer list."),
- return 0;
+ return undef;
defined ($self->{'METADATA'}->{'remailers'}->{$remailer}->{'keys'}->{$type}->{$key}) or
Echolot::Log::cluck ("$remailer does not have key '$key' in type '$type' in Metadata remailer list."),
- return 0;
+ return undef;
my %result = (
summary => $self->{'METADATA'}->{'remailers'}->{$remailer}->{'keys'}->{$type}->{$key}->{'summary'},
@@ -914,6 +1236,15 @@ sub get_key($$$$) {
return %result;
};
+
+=item $storage->B<get_capabilities>( I<$remailer> )
+
+Return the capabilities on file for remailer with address I<$remailer>. This
+is probably the one we got from remailer-conf or set manually.
+
+Returns undef on errors.
+
+=cut
sub get_capabilities($$) {
my ($self, $remailer) = @_;
@@ -921,6 +1252,15 @@ sub get_capabilities($$) {
return $self->{'METADATA'}->{'remailers'}->{$remailer}->{'conf'}->{'capabilities'};
};
+
+=item $storage->B<get_capabilities>( I<$remailer> )
+
+Return the capabilities on file for remailer with address I<$remailer>. This
+is probably the one we got from remailer-conf or set manually.
+
+Returns undef on errors.
+
+=cut
sub get_nick($$) {
my ($self, $remailer) = @_;
@@ -929,6 +1269,16 @@ sub get_nick($$) {
};
+=item $storage->B<expire>( )
+
+Expires old keys, confs and pings from the Storage as configured by
+I<expire_keys>, I<expire_confs>, and I<expire_pings>.
+
+See L<pingd.conf(5)> for more information on these settings.
+
+Returns 1 on success, undef on errors.
+
+=cut
sub expire($) {
my ($self) = @_;
@@ -973,33 +1323,33 @@ sub expire($) {
# write ping to done
my $fh = $self->get_ping_fh($remailer_addr, $type, $key, 'done') or
Echolot::Log::cluck ("$remailer_addr; type=$type; key=$key has no assigned filehandle for done pings."),
- return 0;
+ return undef;
seek($fh, 0, SEEK_SET) or
Echolot::Log::warn("Cannot seek to start of $remailer_addr out pings: $!."),
- return 0;
+ return undef;
truncate($fh, 0) or
Echolot::Log::warn("Cannot truncate done pings file for remailer $remailer_addr; key=$key file to zero length: $!."),
- return 0;
+ return undef;
for my $done (@done) {
print($fh $done->[0]." ".$done->[1]."\n") or
Echolot::Log::warn("Error when writing to $remailer_addr out pings: $!."),
- return 0;
+ return undef;
};
$fh->flush();
# rewrite outstanding pings
$fh = $self->get_ping_fh($remailer_addr, $type, $key, 'out') or
Echolot::Log::cluck ("$remailer_addr; type=$type; key=$key has no assigned filehandle for out pings."),
- return 0;
+ return undef;
seek($fh, 0, SEEK_SET) or
Echolot::Log::warn("Cannot seek to start of outgoing pings file for remailer $remailer_addr; key=$key: $!."),
- return 0;
+ return undef;
truncate($fh, 0) or
Echolot::Log::warn("Cannot truncate outgoing pings file for remailer $remailer_addr; key=$key file to zero length: $!."),
- return 0;
+ return undef;
print($fh (join "\n", @out), (scalar @out ? "\n" : '') ) or
Echolot::Log::warn("Error when writing to outgoing pings file for remailer $remailer_addr; key=$key file: $!."),
- return 0;
+ return undef;
$fh->flush();
};
};
@@ -1010,10 +1360,21 @@ sub expire($) {
return 1;
};
+=item $storage->B<delete_remailer>( I<$address> )
+
+Delete all data on the remailer with I<$address>. This includes stored conf
+and key information, pings and the remailer's settings like I<pingit> et al.
+
+If this remailer is still referenced by other remailers' remailer-conf reply it
+is likely to get picked up again.
+
+Returns 1.
+
+=cut
sub delete_remailer($$) {
my ($self, $address) = @_;
- Echolot::Log::info("Deleting remailer $address.");
+ Echolot::Log::notice("Deleting remailer $address.");
if (defined $self->{'METADATA'}->{'addresses'}->{$address}) {
delete $self->{'METADATA'}->{'addresses'}->{$address}
@@ -1037,6 +1398,13 @@ sub delete_remailer($$) {
return 1;
};
+=item $storage->B<delete_remailercaps>( I<$address> )
+
+Delete conf data of the remailer with I<$address>.
+
+Returns 1.
+
+=cut
sub delete_remailercaps($$) {
my ($self, $address) = @_;