1 files changed, 458 insertions, 0 deletions
diff --git a/Echolot/Storage/File.pm b/Echolot/Storage/File.pm
new file mode 100644
index 0000000..6e66ec8
--- /dev/null
+++ b/Echolot/Storage/File.pm
@@ -0,0 +1,458 @@
+package Echolot::Storage::File;
+
+# (c) 2002 Peter Palfrader <peter@palfrader.org>
+# $Id: File.pm,v 1.1 2002/06/05 04:05:40 weasel Exp $
+#
+
+=pod
+
+=head1 Name
+
+Echolot::Storage::File - Storage backend for echolot
+
+=head1 DESCRIPTION
+
+This package provides several functions for data storage for echolot.
+
+=over
+
+=cut
+
+use strict;
+use warnings;
+use XML::Parser;
+use XML::Dumper;
+use IO::Handle;
+use English;
+use Carp qw{cluck confess};
+use Fcntl ':flock'; # import LOCK_* constants
+use Fcntl ':seek'; # import LOCK_* constants
+use Echolot::Tools;
+
+=item B<new> (I<%args>)
+
+Creates a new storage backend object.
+args keys:
+
+=over
+
+=item I<datadir>
+
+The basedir where this module may store it's configuration and pinging
+data.
+
+=back
+
+=cut
+
+my $CONSTANTS = {
+	'metadatafile' => 'metadata'
+};
+
+$ENV{'PATH'} = '/bin:/usr/bin';
+delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
+
+my $METADATA_VERSION = 1;
+
+my $INTERNAL_COUNT = 1;
+
+sub new {
+	my ($class, %params) = @_;
+	my $self = {};
+	bless $self, $class;
+
+	defined($params{'datadir'}) or
+		confess ('No datadir option passed to new');
+	$self->{'datadir'} = $params{'datadir'};
+	$self->{'DELAY_COMMIT'} = 0;
+
+	$self->delay_commit();
+	$self->metadata_open() or
+		cluck ('Opening Metadata  failed. Exiting'),
+		exit 1;
+	$self->metadata_read() or
+		cluck ('Reading Metadata from Storage failed. Exiting'),
+		exit 1;
+	$self->pingdata_open() or
+		cluck ('Opening Ping files failed. Exiting'),
+		exit 1;
+	$self->enable_commit();
+	
+	return $self;
+};
+
+sub commit($) {
+	my ($self) = @_;
+
+	return if $self->{'DELAY_COMMIT'};
+	$self->metadata_write();
+};
+
+sub delay_commit($) {
+	my ($self) = @_;
+
+	$self->{'DELAY_COMMIT'}++;
+};
+sub enable_commit($) {
+	my ($self) = @_;
+
+	$self->{'DELAY_COMMIT'}--;
+	$self->commit();
+};
+
+sub finish($) {
+	my ($self) = @_;
+
+	$self->pingdata_close();
+	$self->metadata_write();
+	$self->metadata_close();
+};
+
+
+sub metadata_open($) {
+	my ($self) = @_;
+
+	$self->{'METADATA_FH'} = new IO::Handle;
+	my $filename = $self->{'datadir'} .'/'. $CONSTANTS->{'metadatafile'};
+
+	if ( -e $filename ) {
+		open($self->{'METADATA_FH'}, '+<' . $filename) or 
+			cluck("Cannot open $filename for reading: $!"),
+			return 0;
+	} else {
+		open($self->{'METADATA_FH'}, '+>' . $filename) or 
+			cluck("Cannot open $filename for reading: $!"),
+			return 0;
+	};
+	flock($self->{'METADATA_FH'}, LOCK_SH) or
+		cluck("Cannot get shared lock on $filename: $!"),
+		return 0;
+};
+
+sub metadata_close($) {
+	my ($self) = @_;
+
+	flock($self->{'METADATA_FH'}, LOCK_UN) or
+		cluck("Error when releasing lock on metadata file: $!"),
+		return -1;
+	close($self->{'METADATA_FH'}) or
+		cluck("Error when closing metadata file: $!"),
+		return 0;
+};
+
+
+sub metadata_read($) {
+	my ($self) = @_;
+
+	$self->{'METADATA'} = ();
+	seek($self->{'METADATA_FH'}, 0, SEEK_SET) or
+		cluck("Cannot seek to start of metadata file: $!"),
+		return 0;
+	eval {
+		my $parser = new XML::Parser(Style => 'Tree');
+		my $tree = $parser->parse( $self->{'METADATA_FH'} );
+		my $dump = new XML::Dumper;
+		$self->{'METADATA'} = $dump->xml2pl($tree);
+	};
+	$EVAL_ERROR and
+		cluck("Error when reading from metadata file: $EVAL_ERROR"),
+		return 0;
+
+	defined($self->{'METADATA'}->{'version'}) or
+		cluck("Stored data lacks version header"),
+		return 0;
+	($self->{'METADATA'}->{'version'} == ($METADATA_VERSION)) or
+		cluck("Metadata version mismatch ($self->{'METADATA'}->{'version'} vs. $METADATA_VERSION)"),
+		return 0;
+
+
+	defined($self->{'METADATA'}->{'secret'}) or
+		$self->{'METADATA'}->{'secret'} = Echolot::Tools::make_random ( 16, armor => 1 ),
+		$self->commit();
+
+	return 1;
+};
+
+sub metadata_write($) {
+	my ($self) = @_;
+
+	my $dump = new XML::Dumper;
+	my $data = $dump->pl2xml($self->{'METADATA'});
+	my $fh = $self->{'METADATA_FH'};
+	
+	seek($fh, 0, SEEK_SET) or
+		cluck("Cannot seek to start of metadata file: $!"),
+		return 0;
+	truncate($fh, 0) or
+		cluck("Cannot truncate metadata file to zero length: $!"),
+		return 0;
+	print($fh "<!-- vim:set syntax=xml: -->\n") or
+		cluck("Error when writing to metadata file: $!"),
+		return 0;
+	print($fh $data) or
+		cluck("Error when writing to metadata file: $!"),
+		return 0;
+
+	return 1;
+};
+
+
+sub pingdata_open($) {
+	my ($self) = @_;
+
+	for my $remailer_name ( keys %{$self->{'METADATA'}->{'remailers'}} ) {
+		for my $key ( keys %{$self->{'METADATA'}->{'remailers'}->{$remailer_name}->{'keys'}} ) {
+			my $basename = $self->{'METADATA'}->{'remailers'}->{$remailer_name}->{'stats'}->{$key};
+			defined($basename) or
+				$basename = $self->{'METADATA'}->{'remailers'}->{$remailer_name}->{'stats'}->{$key} = $remailer_name.'.'.$key.'.'.time.'.'.$PROCESS_ID.'_'.$INTERNAL_COUNT++,
+				$self->commit();
+
+			my $filename = $self->{'datadir'} .'/'. $basename;
+		
+			for my $type ('out', 'done') {
+				my $fh = new IO::Handle;
+				if ( -e $filename.'.'.$type ) {
+					open($fh, '+<' . $filename.'.'.$type) or 
+						cluck("Cannot open $filename.$type for reading: $!"),
+						return 0;
+					$self->{'PING_FHS'}->{$remailer_name}->{$key}->{$type} = $fh;
+				} else {
+					open($fh, '+>' . $filename.'.'.$type) or 
+						cluck("Cannot open $filename.$type for reading: $!"),
+						return 0;
+					$self->{'PING_FHS'}->{$remailer_name}->{$key}->{$type} = $fh;
+				};
+				flock($fh, LOCK_EX) or
+					cluck("Cannot get exclusive lock on $remailer_name $type pings: $!"),
+					return 0;
+			};
+		};
+	};
+	return 1;
+};
+
+sub get_pings($$$$) {
+	my ($self, $remailer_name, $key, $type) = @_;
+
+	defined ($self->{'METADATA'}->{'remailers'}->{$remailer_name}) or
+		cluck ("$remailer_name does not exist in Metadata"),
+		return 0;
+	
+	my @pings;
+	my $fh = $self->{'PING_FHS'}->{$remailer_name}->{$key}->{$type};
+
+	defined ($fh) or
+		cluck ("$remailer_name; key=$key has no assigned filehandle for $type pings"),
+		return 0;
+
+	seek($fh, 0, SEEK_SET) or
+		cluck("Cannot seek to start of $remailer_name $type pings: $!"),
+		return 0;
+
+	if ($type eq 'out') {
+		@pings = map {chomp; $_; } <$fh>;
+	} elsif ($type eq 'done') {
+		@pings = map {chomp; my @arr = split (/\s+/, $_, 2); \@arr; } <$fh>;
+	} else {
+		confess("What the hell am I doing here? $remailer_name; $key; $type"),
+		return 0;
+	};
+	return \@pings;
+};
+
+sub pingdata_close() {
+	my ($self) = @_;
+
+	for my $remailer_name ( keys %{$self->{'PING_FHS'}} ) {
+		for my $key ( keys %{$self->{'PING_FHS'}->{$remailer_name}} ) {
+			for my $type ('out', 'done') {
+
+				my $fh = $self->{'PING_FHS'}->{$remailer_name}->{$key}->{$type};
+				flock($fh, LOCK_UN) or
+					cluck("Error when releasing lock on $remailer_name $type pings: $!"),
+					return 0;
+				close ($self->{'PING_FHS'}->{$remailer_name}->{$key}->{$type}) or
+						cluck("Error when closing $remailer_name $type pings: $!"),
+						return 0;
+			};
+		};
+	};
+	return 1;
+};
+
+
+
+
+
+sub register_pingout($$$$) {
+	my ($self, $remailer_name, $key, $sent_time) = @_;
+	
+	defined ($self->{'METADATA'}->{'remailers'}->{$remailer_name}) or
+		cluck ("$remailer_name does not exist in Metadata"),
+		return 0;
+
+	my $fh = $self->{'PING_FHS'}->{$remailer_name}->{$key}->{'out'};
+	defined ($fh) or
+		cluck ("$remailer_name; key=$key has no assigned filehandle for outgoing pings"),
+		return 0;
+	seek($fh, 0, SEEK_END) or
+		cluck("Cannot seek to end of $remailer_name out pings: $!"),
+		return 0;
+	print($fh $sent_time."\n") or
+		cluck("Error when writing to $remailer_name out pings: $!"),
+		return 0;
+
+	return 1;
+};
+
+sub register_pingdone($$$$$) {
+	my ($self, $remailer_name, $key, $sent_time, $latency) = @_;
+	
+	defined ($self->{'METADATA'}->{'remailers'}->{$remailer_name}) or
+		cluck ("$remailer_name does not exist in Metadata"),
+		return 0;
+
+	my $outpings = $self->get_pings($remailer_name, $key, 'out');
+	my $origlen = scalar (@$outpings);
+	@$outpings = grep { $_ != $sent_time } @$outpings;
+	($origlen == scalar (@$outpings)) and
+		warn("No ping outstanding for $remailer_name, $key, $sent_time\n"),
+		return 1;
+	
+	# write ping to done
+	my $fh = $self->{'PING_FHS'}->{$remailer_name}->{$key}->{'done'};
+	defined ($fh) or
+		cluck ("$remailer_name; key=$key has no assigned filehandle for done pings"),
+		return 0;
+	seek($fh, 0, SEEK_END) or
+		cluck("Cannot seek to end of $remailer_name out pings: $!"),
+		return 0;
+	print($fh $sent_time." ".$latency."\n") or
+		cluck("Error when writing to $remailer_name out pings: $!"),
+		return 0;
+	
+	# rewrite outstanding pings
+	$fh = $self->{'PING_FHS'}->{$remailer_name}->{$key}->{'out'};
+	defined ($fh) or
+		cluck ("$remailer_name; key=$key has no assigned filehandle for out pings"),
+		return 0;
+	seek($fh, 0, SEEK_SET) or
+		cluck("Cannot seek to start of outgoing pings file for remailer $remailer_name; key=$key: $!"),
+		return 0;
+	truncate($fh, 0) or
+		cluck("Cannot truncate outgoing pings file for remailer $remailer_name; key=$key file to zero length: $!"),
+		return 0;
+	print($fh (join "\n", @$outpings),"\n") or
+		cluck("Error when writing to outgoing pings file for remailer $remailer_name; key=$key file: $!"),
+		return 0;
+	
+	return 1;
+};
+
+sub add_prospective_address($$$) {
+	my ($self, $addr, $where) = @_;
+
+	push @{ $self->{'METADATA'}->{'prostective_addresses'} },
+		{ 'address' => $addr,
+		  'where'   => $where };
+	$self->commit();
+};
+
+sub get_addresses($) {
+	my ($self) = @_;
+
+	my @addresses = keys %{$self->{'METADATA'}->{'addresses'}};
+	my @return_data = map { my %tmp = %{$self->{'METADATA'}->{'addresses'}->{$_}}; $tmp{'address'} = $_; \%tmp; } @addresses;
+	return @return_data;
+};
+
+sub get_address_by_id($$) {
+	my ($self, $id) = @_;
+
+	my @addresses = grep {$self->{'METADATA'}->{'addresses'}->{$_}->{'id'} = $id}
+		keys %{$self->{'METADATA'}->{'addresses'}};
+	return undef unless (scalar @addresses);
+	if (scalar @addresses >= 2) {
+		cluck("Searching for address by id '$id' gives more than one result");
+	};
+	my %return_data = %{$self->{'METADATA'}->{'addresses'}->{$addresses[0]}};
+	$return_data{'address'} = $addresses[0];
+	return \%return_data;
+};
+
+sub decrease_ttl($$) {
+	my ($self, $address) = @_;
+	
+	defined ($self->{'METADATA'}->{'addresses'}->{$address}) or
+		cluck ("$address does not exist in Metadata address list"),
+		return 0;
+	$self->{'METADATA'}->{'addresses'}->{$address}->{'ttl'} --;
+	$self->{'METADATA'}->{'addresses'}->{$address}->{'status'} = 'disabled'
+		if ($self->{'METADATA'}->{'addresses'}->{$address}->{'ttl'} <= 0);
+	$self->commit();
+	return 1;
+};
+
+sub restore_ttl($$) {
+	my ($self, $address) = @_;
+	
+	defined ($self->{'METADATA'}->{'addresses'}->{$address}) or
+		cluck ("$address does not exist in Metadata address list"),
+		return 0;
+	$self->{'METADATA'}->{'addresses'}->{$address}->{'ttl'} = Echolot::Config::get()->{'addresses_default_ttl'};
+	$self->commit();
+	return 1;
+};
+
+sub set_caps($$$$$$) {
+	my ($self, $type, $caps, $nick, $address, $timestamp) = @_;
+	
+	if (! defined $self->{'METADATA'}->{'remailers'}->{$address}) {
+		$self->{'METADATA'}->{'remailers'}->{$address} =
+			{
+				status => 'active',
+				pingit => Echolot::Config::get()->{'ping_new'},
+				showit => Echolot::Config::get()->{'show_new'},
+				conf => {
+					nick => $nick,
+					type => $type,
+					capabilities => $caps,
+					last_update => $timestamp
+				}
+			};
+	} else {
+		my $conf = $self->{'METADATA'}->{'remailers'}->{$address}->{'conf'};
+		if ($conf->{'last_update'} >= $timestamp) {
+			warn ("Stored data is already newer for remailer $nick\n");
+			return 1;
+		};
+		$conf->{'last_update'} = $timestamp;
+		if ($conf->{'nick'} ne $nick) {
+			warn ($conf->{'nick'}." was renamed to $nick\n");
+			$conf->{'nick'} = $nick;
+		};
+		if ($conf->{'capabilities'} ne $caps) {
+			warn ("$nick has a new caps string '$caps' old: '".$conf->{'capabilities'}."'\n");
+			$conf->{'capabilities'} = $caps;
+		};
+		if ($conf->{'type'} ne $type) {
+			warn ("$nick has a new type string '$type'\n");
+			$conf->{'type'} = $type;
+		};
+	};
+	$self->commit();
+	
+	return 1;
+};
+
+sub get_secret($) {
+	my ($self) = @_;
+
+	return $self->{'METADATA'}->{'secret'};
+};
+
+=back
+
+=cut
+
+# vim: set ts=4 shiftwidth=4: