Ping broken chains more often ("Intensive Care")

Expire chainpings

1 files changed, 40 insertions, 4 deletions

diff --git a/Echolot/Storage/File.pm b/Echolot/Storage/File.pm
index 9309a03..bf0a57e 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.50 2003/02/16 03:06:51 weasel Exp $
+# $Id: File.pm,v 1.51 2003/02/16 09:09:57 weasel Exp $
 #
 
 =pod
@@ -735,7 +735,7 @@ sub get_chainpings($$) {
 	my ($self, $chaintype) = @_;
 
 	my $fh = $self->get_chainping_fh($chaintype, 'out') or
-		Echolot::Log::warn ("assigned filehandle for $chaintype out chainpings."),
+		Echolot::Log::warn ("have no assigned filehandle for $chaintype out chainpings."),
 		return undef;
 	seek($fh, 0, SEEK_SET) or
 		Echolot::Log::warn("Cannot seek to start of $chaintype out chainpings $!."),
@@ -1544,6 +1544,7 @@ sub expire($) {
 	my $expire_keys  = $now - Echolot::Config::get()->{'expire_keys'};
 	my $expire_conf = $now - Echolot::Config::get()->{'expire_confs'};
 	my $expire_pings = $now - Echolot::Config::get()->{'expire_pings'};
+	my $expire_chainpings = $now - Echolot::Config::get()->{'expire_chainpings'};
 
 	for my $remailer_addr ( keys %{$self->{'METADATA'}->{'remailers'}} ) {
 		for my $type ( keys %{$self->{'METADATA'}->{'remailers'}->{$remailer_addr}->{'keys'}} ) {
@@ -1574,8 +1575,8 @@ sub expire($) {
 
 		for my $type ( keys %{$self->{'METADATA'}->{'remailers'}->{$remailer_addr}->{'keys'}} ) {
 			for my $key ( keys %{$self->{'METADATA'}->{'remailers'}->{$remailer_addr}->{'keys'}->{$type}} ) {
-				my @out  = grep {$_      > $expire_pings} Echolot::Globals::get()->{'storage'}->get_pings($remailer_addr, $type, $key, 'out');
-				my @done = grep {$_->[0] > $expire_pings} Echolot::Globals::get()->{'storage'}->get_pings($remailer_addr, $type, $key, 'done');
+				my @out  = grep {$_      > $expire_pings} $self->get_pings($remailer_addr, $type, $key, 'out');
+				my @done = grep {$_->[0] > $expire_pings} $self->get_pings($remailer_addr, $type, $key, 'done');
 
 
 				# write ping to done
@@ -1613,6 +1614,41 @@ sub expire($) {
 		};
 	};
 
+	for my $type ( keys %{$self->{'CHAINPING_FHS'}} ) {
+		my $pings = $self->get_chainpings($type);
+
+		@{ $pings->{'out'} } = map {
+				my $a = $_;
+				join (' ', map ({ $a->{$_} } qw{sent addr1 type1 key1 addr2 type2 key2}))
+			} grep {
+				$_->{'sent'} > $expire_chainpings
+			}
+			@{ $pings->{'out'} };
+		@{ $pings->{'done'} } = map {
+				my $a = $_;
+				join (' ', map ({ $a->{$_} } qw{sent addr1 type1 key1 addr2 type2 key2 lat}))
+			} grep {
+				$_->{'sent'} > $expire_chainpings
+			}
+			@{ $pings->{'done'} };
+
+		for my $dir (qw{out done}) {
+			my $fh = $self->get_chainping_fh($type, $dir) or
+				Echolot::Log::warn ("have no assigned filehandle for $type $dir chainpings."),
+				return undef;
+			seek($fh, 0, SEEK_SET) or
+				Echolot::Log::warn("Cannot seek to start of $dir chainpings $type $!."),
+				return undef;
+			truncate($fh, 0) or
+				Echolot::Log::warn("Cannot truncate $dir chainpings $type file to zero length: $!."),
+				return undef;
+			print($fh (join "\n", @{$pings->{$dir}}), (scalar @{$pings->{$dir}} ? "\n" : '') ) or
+				Echolot::Log::warn("Error when writing to $dir chainpings $type file: $!."),
+				return undef;
+			$fh->flush();
+		};
+	};
+
 	$self->commit();
 	
 	return 1;