diff options
Diffstat (limited to 'Echolot/Storage')
-rw-r--r-- | Echolot/Storage/File.pm | 532 |
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) = @_; |