diff options
Diffstat (limited to 'Echolot')
| -rw-r--r-- | Echolot/Conf.pm | 84 | ||||
| -rw-r--r-- | Echolot/Config.pm | 48 | ||||
| -rw-r--r-- | Echolot/Globals.pm | 37 | ||||
| -rw-r--r-- | Echolot/Mailin.pm | 120 | ||||
| -rw-r--r-- | Echolot/Scheduler.pm | 150 | ||||
| -rw-r--r-- | Echolot/Storage/File.pm | 458 | ||||
| -rw-r--r-- | Echolot/Tools.pm | 93 |
7 files changed, 990 insertions, 0 deletions
diff --git a/Echolot/Conf.pm b/Echolot/Conf.pm new file mode 100644 index 0000000..b19b25c --- /dev/null +++ b/Echolot/Conf.pm @@ -0,0 +1,84 @@ +package Echolot::Conf; + +# (c) 2002 Peter Palfrader <peter@palfrader.org> +# $Id: Conf.pm,v 1.1 2002/06/05 04:05:40 weasel Exp $ +# + +=pod + +=head1 Name + +Echolot::Conf - remailer Configuration/Capabilities + +=head1 DESCRIPTION + +This package provides functions for requesting, parsing, and analyzing +remailer-conf and remailer-key replies. + +=cut + +use strict; +use warnings; +use Carp qw{cluck}; + + +sub send_requests() { + Echolot::Globals::get()->{'storage'}->delay_commit(); + for my $remailer (Echolot::Globals::get()->{'storage'}->get_addresses()) { + next unless ($remailer->{'status'} eq 'active'); + for my $type (qw{conf key help stats}) { + Echolot::Tools::send_message( + 'To' => $remailer->{'address'}, + 'Subject' => 'remailer-'.$type, + 'Token' => $type.'.'.$remailer->{'id'}) + }; + Echolot::Globals::get()->{'storage'}->decrease_ttl($remailer->{'address'}); + }; + Echolot::Globals::get()->{'storage'}->enable_commit(); +}; + +sub remailer_conf($$$) { + my ($conf, $token, $time) = @_; + + my ($id) = $token =~ /^conf\.(\d+)$/; + cluck("Could not find id in token '$token'"), return 0 unless defined $id; + my ($remailer_type) = ($conf =~ /^\s*Remailer-Type:\s* (.*?) \s*$/imx); + cluck("No remailer type found in remailer_conf from '$token'"), return 0 unless defined $remailer_type; + my ($remailer_caps) = ($conf =~ /^\s*( \$remailer{".*"} \s*=\s* "<.*@.*>.*"; )\s*$/imx); + cluck("No remailer caps found in remailer_conf from '$token'"), return 0 unless defined $remailer_caps; + my ($remailer_nick, $remailer_address) = ($remailer_caps =~ /^\s* \$remailer{"(.*)"} \s*=\s* "<(.*@.*)>.*"; \s*$/ix); + cluck("No remailer nick found in remailer_caps from '$token': '$remailer_caps'"), return 0 unless defined $remailer_nick; + cluck("No remailer address found in remailer_caps from '$token': '$remailer_caps'"), return 0 unless defined $remailer_address; + + + my $remailer = Echolot::Globals::get()->{'storage'}->get_address_by_id($id); + if ($remailer->{'address'} ne $remailer_address) { + # Address mismatch -> Ignore reply and add $remailer_address to prospective addresses + cluck("Remailer address mismatch $remailer->{'address'} vs $remailer_address. Adding latter to prospective remailers."); + Echolot::Globals::get()->{'storage'}->add_prospective_address($remailer_address, 'conf-reply'); + } else { + Echolot::Globals::get()->{'storage'}->restore_ttl( $remailer->{'address'} ); + Echolot::Globals::get()->{'storage'}->set_caps($remailer_type, $remailer_caps, $remailer_nick, $remailer_address, $time); + } +}; + +sub remailer_key($$$) { + my ($conf, $token, $time) = @_; + + print "Remailer key\n"; +}; + +sub remailer_stats($$$) { + my ($conf, $token, $time) = @_; + + #print "Remailer stats\n"; +}; + +sub remailer_help($$$) { + my ($conf, $token, $time) = @_; + + #print "Remailer help\n"; +}; + +1; +# vim: set ts=4 shiftwidth=4: diff --git a/Echolot/Config.pm b/Echolot/Config.pm new file mode 100644 index 0000000..f679af8 --- /dev/null +++ b/Echolot/Config.pm @@ -0,0 +1,48 @@ +package Echolot::Config; + +# (c) 2002 Peter Palfrader <peter@palfrader.org> +# $Id: Config.pm,v 1.1 2002/06/05 04:05:40 weasel Exp $ +# + +=pod + +=head1 Name + +Echolot::Config - echolot configuration + +=head1 DESCRIPTION + +=cut + +use strict; +use warnings; +use XML::Parser; +use XML::Dumper; +use Carp; + +my $CONFIG; + +sub init() { + my $DEFAULT; + $DEFAULT->{'recipient_delimiter'} = '+'; + $DEFAULT->{'dev_random'} = '/dev/random'; + $DEFAULT->{'hash_len'} = 8; + + { + my $parser = new XML::Parser(Style => 'Tree'); + my $tree = $parser->parsefile('pingd.conf'); + my $dump = new XML::Dumper; + $CONFIG = $dump->xml2pl($tree); + } + + for my $key (keys %$DEFAULT) { + $CONFIG->{$key} = $DEFAULT->{$key} unless defined $CONFIG->{$key}; + }; +}; + +sub get() { + return $CONFIG; +}; + +1; +# vim: set ts=4 shiftwidth=4: diff --git a/Echolot/Globals.pm b/Echolot/Globals.pm new file mode 100644 index 0000000..4b5eb13 --- /dev/null +++ b/Echolot/Globals.pm @@ -0,0 +1,37 @@ +package Echolot::Globals; + +# (c) 2002 Peter Palfrader <peter@palfrader.org> +# $Id: Globals.pm,v 1.1 2002/06/05 04:05:40 weasel Exp $ +# + +=pod + +=head1 Name + +Echolot::Globals - echolot global variables + +=head1 DESCRIPTION + +=cut + +use strict; +use warnings; +use Carp; + +my $GLOBALS; + +sub init { + my $hostname = `hostname`; + $hostname =~ /^([a-zA-Z0-9_-]*)$/; + $hostname = $1 || 'unknown'; + $GLOBALS->{'hostname'} = $hostname; + $GLOBALS->{'storage'} = new Echolot::Storage::File ( datadir => Echolot::Config::get()->{'storage'}->{'File'}->{'basedir'} ); + $GLOBALS->{'internalcounter'} = 1; +}; + +sub get() { + return $GLOBALS; +}; + +1; +# vim: set ts=4 shiftwidth=4: diff --git a/Echolot/Mailin.pm b/Echolot/Mailin.pm new file mode 100644 index 0000000..411433a --- /dev/null +++ b/Echolot/Mailin.pm @@ -0,0 +1,120 @@ +package Echolot::Mailin; + +# (c) 2002 Peter Palfrader <peter@palfrader.org> +# $Id: Mailin.pm,v 1.1 2002/06/05 04:05:40 weasel Exp $ +# + +=pod + +=head1 Name + +Echolot::Mailin - Incoming Mail Dispatcher for Echolot + +=head1 DESCRIPTION + + +=cut + +use strict; +use warnings; +use Carp qw{cluck}; +use English; +use Echolot::Globals; + +sub make_sane_name() { + my $result = time().'.'.$PROCESS_ID.'_'.Echolot::Globals::get()->{'internal_counter'}++.'.'.Echolot::Globals::get()->{'hostname'}; + return $result; +}; + +sub sane_move($$) { + my ($from, $to) = @_; + + my $link_success = link($from, $to); + $link_success or + cluck("Cannot link $from to $to: $! - Trying move"), + rename($from, $to) or + cluck("Renaming $from to $to didn't work either: $!"), + return 0; + + $link_success && (unlink($from) or + cluck("Cannot unlink $from: $!") ); + return 1; +}; + +sub handle($) { + my ($file) = @_; + + open (FH, $file) or + cluck("Cannot open file $file: $!"), + return 0; + + my $to; + while (<FH>) { + chomp; + last if $_ eq ''; + + if (m/^To:\s*(.*?)\s*$/) { + $to = $1; + }; + }; + my $body = join('', <FH>); + close (FH) or + cluck("Cannot close file $file: $!"); + + (defined $to) or + cluck("No To header found in $file"), + return 0; + + my $delimiter = quotemeta( Echolot::Config::get()->{'recipient_delimiter'}); + my ($type, $timestamp, $received_hash) = $to =~ /$delimiter (.*) = (\d+) = ([0-9a-f]+) @/x or + cluck("Could not parse to header '$to'"), + return 0; + + my $token = $type.'='.$timestamp; + my $hash = Echolot::Tools::hash($token . Echolot::Globals::get()->{'storage'}->get_secret() ); + my $cut_hash = substr($hash, 0, Echolot::Config::get()->{'hash_len'}); + + ($cut_hash eq $received_hash) or + cluck("Hash mismatch in '$to'"), + return 0; + + Echolot::Conf::remailer_conf($body, $type, $timestamp), return 1 if ($type =~ /^conf\./); + Echolot::Conf::remailer_key($body, $type, $timestamp), return 1 if ($type =~ /^key\./); + Echolot::Conf::remailer_help($body, $type, $timestamp), return 1 if ($type =~ /^help\./); + Echolot::Conf::remailer_stats($body, $type, $timestamp), return 1 if ($type =~ /^stats\./); + + Echolot::Ping::receive($body, $type, $timestamp), return 1 if ($type =~ /^ping\./); + + cluck("Didn't know what to do with '$to'"), + return 0; +}; + +sub process() { + my $mailindir = Echolot::Config::get()->{'mailindir'}; + my $targetdir = Echolot::Config::get()->{'mailerrordir'}; + my @files = (); + for my $sub (qw{new cur}) { + opendir(DIR, $mailindir.'/'.$sub) or + cluck("Cannot open direcotry '$mailindir/$sub': $!"), + return 0; + push @files, map { $sub.'/'.$_ } grep { ! /^\./ } readdir(DIR); + closedir(DIR) or + cluck("Cannot close direcotry '$mailindir/$sub': $!"); + }; + for my $file (@files) { + $file =~ /^(.*)$/s or + croak("I really should match here. ('$file')."); + $file = $1; + if (handle($mailindir.'/'.$file)) { + unlink($mailindir.'/'.$file); + } else { + my $name = make_sane_name(); + sane_move($mailindir.'/'.$file, $targetdir.'/new/'.$name) or + cluck("Sane moving of $mailindir/$file to $targetdir/new/$name failed"); + }; + }; +}; + +1; + +# vim: set ts=4 shiftwidth=4: diff --git a/Echolot/Scheduler.pm b/Echolot/Scheduler.pm new file mode 100644 index 0000000..24ca6e3 --- /dev/null +++ b/Echolot/Scheduler.pm @@ -0,0 +1,150 @@ +package Echolot::Scheduler; + +# (c) 2002 Peter Palfrader <peter@palfrader.org> +# $Id: Scheduler.pm,v 1.1 2002/06/05 04:05:40 weasel Exp $ +# + +=pod + +=head1 Name + +Echolot::Scheduler - Task selector/scheduler for echolot + +=head1 DESCRIPTION + +This package provides several functions for scheduling tasks within +the ping daemon. + +=over + +=cut + +use strict; +use warnings; +use Carp gw{cluck}; + +my $ORDER = 1; + +=item B<new> () + +Creates a new scheduler object. + +=cut +sub new { + my ($class, %params) = @_; + my $self = {}; + bless $self, $class; + return $self; +}; + +=item B<add> (I<name>, I<interval>, I<offset>, I<what>) + +Adds a task with I<name> to the list of tasks. Every I<interval> seconds +I<what> is called. If for example I<interval> is 3600 - meaning I<what> +should be executed hourly - setting I<offset> to 600 would mean that +it get's called 10 minutes after the hour. + +=cut +sub add($$$$$) { + my ($self, $name, $interval, $offset, $what) = @_; + + if (defined $self->{'tasks'}->{$name}) { + @{ $self->{'schedule'} } = grep { $_->{'name'} ne $name } @{ $self->{'schedule'} }; + }; + + $self->{'tasks'}->{$name} = + { + interval => $interval, + offset => $offset, + what => $what, + order => $ORDER++ + }; + + $self->schedule($name); + + return 1; +}; + +=item B<schedule> (I<name>, I<for>) + +Internal function. + +Schedule execution of I<name> for I<for>. If I<for> is not given it is calculated +from I<interval> and I<offset> passed to B<new>. + +=cut +sub schedule($$;$) { + my ($self, $name, $for) = @_; + + (defined $self->{'tasks'}->{$name}) or + cluck("Task $name is not defined"), + return 0; + + my $interval = $self->{'tasks'}->{$name}->{'interval'}; + my $offset = $self->{'tasks'}->{$name}->{'offset'}; + + + unless (defined $for) { + my $now = time(); + $for = $now - $now % $interval + $offset; + ($for <= $now) and $for += $interval; + }; + + push @{ $self->{'schedule'} }, + { + start => $for, + order => $self->{'tasks'}->{$name}->{'order'}, + name => $name + }; + + @{ $self->{'schedule'} } = sort { $a->{'start'} <=> $b->{'start'} or $a->{'order'} <=> $b->{'order'} } + @{ $self->{'schedule'} }; + + return 1; +}; + +=item B<run> () + +Start the scheduling run. + +It will run forever or until a task with I<what> == 'exit' is executed. + +=cut +sub run($) { + my ($self) = @_; + + my $task = shift @{ $self->{'schedule'} }; + (defined $task) or + croak("Scheduler is empty"), + return 0; + + while(1) { + my $now = time(); + if ($task->{'start'} < $now) { + warn("Task $task->{'name'} could not be started on time\n"); + } else { + sleep ($task->{'start'} - $now); + }; + + $now = $task->{'start'}; + do { + my $name = $task->{'name'}; + (defined $self->{'tasks'}->{$name}) or + warn("Task $task->{'name'} is not defined\n"); + + my $what = $self->{'tasks'}->{$name}->{'what'}; + last if ($what eq 'exit'); + &$what(); + $self->schedule($name, $now + $self->{'tasks'}->{$name}->{'interval'}); + + $task = shift @{ $self->{'schedule'} }; + (defined $task) or + croak("Scheduler is empty"), + return 0; + } while ($now == $task->{'start'}); + }; + + return 1; +}; + +# vim: set ts=4 shiftwidth=4: 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: diff --git a/Echolot/Tools.pm b/Echolot/Tools.pm new file mode 100644 index 0000000..06c6638 --- /dev/null +++ b/Echolot/Tools.pm @@ -0,0 +1,93 @@ +package Echolot::Tools; + +# (c) 2002 Peter Palfrader <peter@palfrader.org> +# $Id: Tools.pm,v 1.1 2002/06/05 04:05:40 weasel Exp $ +# + +=pod + +=head1 Name + +Echolot::Tools - Tools for echolot + +=head1 DESCRIPTION + + +=cut + +use strict; +use warnings; +use Carp qw{cluck}; +use Digest::MD5 qw{}; +use Mail::Internet; + +sub hash($) { + my ($data) = @_; + ($data) = $data =~ m/(.*)/s; # untaint + my $hash = Digest::MD5::md5_hex($data); + return $hash; +}; + +sub make_random($;%) { + my ($length, %args) = @_; + + my $random; + + open (FH, Echolot::Config::get()->{'dev_random'}) or + cluck("Cannot open ".Echolot::Config::get()->{'dev_random'}." for reading: $!"), + return 0; + read(FH, $random, $length) or + cluck("Cannot read from ".Echolot::Config::get()->{'dev_random'}.": $!"), + return 0; + close (FH) or + cluck("Cannot close ".Echolot::Config::get()->{'dev_random'}.": $!"), + return 0; + + $random = unpack('H*', $random) + if ($args{'armor'} == 1); + + return $random; +}; + + +sub send_message(%) { + my (%args) = @_; + + defined($args{'To'}) or + cluck ('No recipient address given'), + return 0; + $args{'Subject'} = '' unless (defined $args{'Subject'}); + $args{'Body'} = '' unless (defined $args{'Body'}); + if (defined $args{'Token'}) { + my $token = $args{'Token'}.'='.time(); + my $hash = hash($token . Echolot::Globals::get()->{'storage'}->get_secret() ); + my $cut_hash = substr($hash, 0, Echolot::Config::get()->{'hash_len'}); + my $complete_token = $token.'='.$cut_hash; + $args{'From'} = + Echolot::Config::get()->{'my_localpart'}. + Echolot::Config::get()->{'recipient_delimiter'}. + $complete_token. + '@'. + Echolot::Config::get()->{'my_domain'}; + } else { + $args{'From'} = + Echolot::Config::get()->{'my_localpart'}. + '@'. + Echolot::Config::get()->{'my_domain'}; + }; + $args{'Subject'} = 'none' unless (defined $args{'Subject'}); + + my $message = "To: $args{'To'}\n"; + $message .= "From: $args{'From'}\n"; + $message .= "Subject: $args{'Subject'}\n"; + $message .= "\n".$args{'Body'}; + + my @lines = split (/\n/, $message); + my $mail = new Mail::Internet ( \@lines ); + + $mail->smtpsend( Host => Echolot::Config::get()->{'smarthost'} ); +}; + +1; + +# vim: set ts=4 shiftwidth=4: |