diff options
Diffstat (limited to 'Echolot')
| -rw-r--r-- | Echolot/Conf.pm | 83 | ||||
| -rw-r--r-- | Echolot/Config.pm | 7 | ||||
| -rw-r--r-- | Echolot/Mailin.pm | 3 | ||||
| -rw-r--r-- | Echolot/Thesaurus.pm | 94 |
4 files changed, 172 insertions, 15 deletions
diff --git a/Echolot/Conf.pm b/Echolot/Conf.pm index 68f1030..73dedda 100644 --- a/Echolot/Conf.pm +++ b/Echolot/Conf.pm @@ -1,7 +1,7 @@ package Echolot::Conf; # (c) 2002 Peter Palfrader <peter@palfrader.org> -# $Id: Conf.pm,v 1.11 2002/07/03 12:09:03 weasel Exp $ +# $Id: Conf.pm,v 1.12 2002/07/06 00:50:27 weasel Exp $ # =pod @@ -24,6 +24,26 @@ use GnuPG::Interface; use IO::Handle; +sub save_thesaurus($$$) { + my ($otype, $oid, $data) = @_; + + return 1 unless Echolot::Config::get()->{'thesaurus'}; + + my ($type) = $otype =~ /^([a-z-]+)$/; + cluck("type '$otype' is not clean in save_thesaurus"), return 0 unless defined $type; + my ($id) = $oid =~ /^([0-9]+)$/; + cluck("id '$oid' is not clean in save_thesaurus"), return 0 unless defined $id; + + my $file = Echolot::Config::get()->{'thesaurusdir'}.'/'.$id.'-'.$type; + open (F, ">$file") or + cluck ("Cannot open '$file': $!"), + return 0; + print F $data; + close (F); + + return 1; +}; + sub send_requests() { Echolot::Globals::get()->{'storage'}->delay_commit(); for my $remailer (Echolot::Globals::get()->{'storage'}->get_addresses()) { @@ -31,7 +51,7 @@ sub send_requests() { next unless ($remailer->{'fetch'}); print "Sending requests to ".$remailer->{'address'}."\n" if Echolot::Config::get()->{'verbose'}; - for my $type (qw{conf key help stats}) { + for my $type (qw{conf key help stats adminkey}) { Echolot::Tools::send_message( 'To' => $remailer->{'address'}, 'Subject' => 'remailer-'.$type, @@ -42,7 +62,7 @@ sub send_requests() { Echolot::Globals::get()->{'storage'}->enable_commit(); }; -sub remailer_conf($$$;$) { +sub remailer_caps($$$;$) { my ($conf, $token, $time, $dontexpire) = @_; my ($id) = $token =~ /^conf\.(\d+)$/; @@ -52,9 +72,9 @@ sub remailer_conf($$$;$) { 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; + cluck("No remailer type found in remailer_caps 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; + cluck("No remailer caps found in remailer_caps 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; @@ -121,6 +141,19 @@ sub remailer_conf($$$;$) { return 1; }; +sub remailer_conf($$$) { + my ($reply, $token, $time) = @_; + + my ($id) = $token =~ /^conf\.(\d+)$/; + (defined $id) or + cluck ("Returned token '$token' has no id at all"), + return 0; + + save_thesaurus('conf', $id, $reply); + + remailer_caps($reply, $token, $time); +}; + sub set_caps_manually($$) { my ($addr, $caps) = @_; @@ -145,7 +178,7 @@ sub set_caps_manually($$) { my $token = 'conf.'.$id; my $conf = "Remailer-Type: set-manually\n$caps"; - remailer_conf($conf, $token, time, 1); + remailer_caps($conf, $token, time, 1); return 1; }; @@ -325,32 +358,56 @@ sub parse_cpunk_key($$$) { sub remailer_key($$$) { my ($reply, $token, $time) = @_; - $reply =~ s/^- -/-/gm; # PGP Signed messages + my $cp_reply = $reply; + $cp_reply =~ s/^- -/-/gm; # PGP Signed messages my ($id) = $token =~ /^key\.(\d+)$/; (defined $id) or cluck ("Returned token '$token' has no id at all"), return 0; + + save_thesaurus('key', $id, $reply); my $remailer = Echolot::Globals::get()->{'storage'}->get_address_by_id($id); cluck("No remailer found for id '$id'"), return 0 unless defined $remailer; - parse_mix_key($reply, $time, $remailer); - parse_cpunk_key($reply, $time, $remailer); + parse_mix_key($cp_reply, $time, $remailer); + parse_cpunk_key($cp_reply, $time, $remailer); return 1; }; sub remailer_stats($$$) { - my ($conf, $token, $time) = @_; + my ($reply, $token, $time) = @_; - #print "Remailer stats\n"; + my ($id) = $token =~ /^stats\.(\d+)$/; + (defined $id) or + cluck ("Returned token '$token' has no id at all"), + return 0; + + save_thesaurus('stats', $id, $reply); }; sub remailer_help($$$) { - my ($conf, $token, $time) = @_; + my ($reply, $token, $time) = @_; + + my ($id) = $token =~ /^help\.(\d+)$/; + (defined $id) or + cluck ("Returned token '$token' has no id at all"), + return 0; + + save_thesaurus('help', $id, $reply); +}; + +sub remailer_adminkey($$$) { + my ($reply, $token, $time) = @_; - #print "Remailer help\n"; + my ($id) = $token =~ /^adminkey\.(\d+)$/; + (defined $id) or + cluck ("Returned token '$token' has no id at all"), + return 0; + + save_thesaurus('adminkey', $id, $reply); }; 1; diff --git a/Echolot/Config.pm b/Echolot/Config.pm index 63facde..0316afd 100644 --- a/Echolot/Config.pm +++ b/Echolot/Config.pm @@ -1,7 +1,7 @@ package Echolot::Config; # (c) 2002 Peter Palfrader <peter@palfrader.org> -# $Id: Config.pm,v 1.11 2002/07/03 00:28:22 weasel Exp $ +# $Id: Config.pm,v 1.12 2002/07/06 00:50:27 weasel Exp $ # =pod @@ -38,6 +38,8 @@ sub init($) { ping_new => 1, show_new => 1, + thesaurus => 1, + processmail => 60, # process incomng mail every minute pinger_interval => 5*60, # send out pings every 5 minutes ping_every_nth_time => 48, # send out pings to the same remailer every 48 calls, i.e. every 4 hours @@ -45,8 +47,11 @@ sub init($) { commitprospectives => 8*60*60, # commit prospective addresses every 8 hours expire => 24*60*60, # daily getkeyconf => 24*60*60, # daily + build_thesaurus => 60*60, # hourly resultdir => 'results', + thesaurusdir => 'results/thesaurus', + thesaurusindexfile => 'results/thesaurus/index.html', private_resultdir => 'results.private', gnupghome => 'gnupg', tmpdir => 'tmp', diff --git a/Echolot/Mailin.pm b/Echolot/Mailin.pm index 3b28276..7ecaa9a 100644 --- a/Echolot/Mailin.pm +++ b/Echolot/Mailin.pm @@ -1,7 +1,7 @@ package Echolot::Mailin; # (c) 2002 Peter Palfrader <peter@palfrader.org> -# $Id: Mailin.pm,v 1.3 2002/06/11 10:00:38 weasel Exp $ +# $Id: Mailin.pm,v 1.4 2002/07/06 00:50:27 weasel Exp $ # =pod @@ -76,6 +76,7 @@ sub handle($) { 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::Conf::remailer_adminkey($body, $type, $timestamp), return 1 if ($type =~ /^adminkey\./); Echolot::Pinger::receive($body, $type, $timestamp), return 1 if ($type eq 'ping'); diff --git a/Echolot/Thesaurus.pm b/Echolot/Thesaurus.pm new file mode 100644 index 0000000..1e10e4c --- /dev/null +++ b/Echolot/Thesaurus.pm @@ -0,0 +1,94 @@ +package Echolot::Thesaurus; + +# (c) 2002 Peter Palfrader <peter@palfrader.org> +# $Id: Thesaurus.pm,v 1.1 2002/07/06 00:50:27 weasel Exp $ +# + +=pod + +=head1 Name + +Echolot::Thesaurus - build thesaurus pages + +=head1 DESCRIPTION + +This package provides necessary functions for the thesaurus. + +=cut + +use strict; +use warnings; +use Carp qw{cluck}; +use English; + + +sub build_thesaurus() { + return 1 unless Echolot::Config::get()->{'thesaurus'}; + + my $dir = Echolot::Config::get()->{'thesaurusdir'}; + opendir(DIR, $dir) or + cluck ("Cannot open '$dir': $!"), + return 0; + my @files = grep { ! /^\./ } readdir(DIR); + closedir(DIR); + + my $data; + for my $filename (@files) { + my ($id, $what) = $filename =~ /^(\d+)-(adminkey|conf|help|key|stats)$/; + next unless (defined $id && defined $what); + + my $remailer = Echolot::Globals::get()->{'storage'}->get_address_by_id($id); + next return 0 unless defined $remailer; + + my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size, + $atime,$mtime,$ctime,$blksize,$blocks) + = stat($dir.'/'.$filename); + + my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) + = gmtime($mtime); + + my $date = sprintf("%04d-%02d-%02d %02d:%02d", + $year+1900, $mon+1, $mday, + $hour, $min); + + + $data->{$remailer->{'address'}}->{$what} = { + 'href' => $filename, + 'date' => $date, + }; + }; + + + for my $addr (keys (%$data)) { + my $nick = Echolot::Globals::get()->{'storage'}->get_nick($addr); + $data->{$addr}->{'nick'} = defined $nick ? $nick : 'N/A'; + }; + + my $file = Echolot::Config::get()->{'thesaurusindexfile'}; + open (F, ">$file") or + cluck ("Cannot open '$file': $!"), + return 0; + print F '<html><head><title>Thesaurus</title></head><body><h1>Thesaurus</h1><table border=1>'."\n"; + print F "<tr><tr><th>nick</th><th>Address</th><th>conf</th><th>help</th><th>key</th><th>stats</th><th>adminkey</th></tr>\n"; + + for my $addr (sort { $data->{$a}->{'nick'} cmp $data->{$b}->{'nick'} } keys (%$data)) { + printf F "<tr><td>%s</td><td>%s</td><td>%s</td><td>%s</td><td>%s</td><td>%s</td><td>%s</td></tr>\n", + $data->{$addr}->{'nick'}, + $addr, + defined ($data->{$addr}->{'conf'}) ? + sprintf('<a href="%s">%s</a>', $data->{$addr}->{'conf'}->{'href'}, $data->{$addr}->{'conf'}->{'date'}) : 'N/A', + defined ($data->{$addr}->{'help'}) ? + sprintf('<a href="%s">%s</a>', $data->{$addr}->{'help'}->{'href'}, $data->{$addr}->{'help'}->{'date'}) : 'N/A', + defined ($data->{$addr}->{'key'}) ? + sprintf('<a href="%s">%s</a>', $data->{$addr}->{'key'}->{'href'}, $data->{$addr}->{'key'}->{'date'}) : 'N/A', + defined ($data->{$addr}->{'stats'}) ? + sprintf('<a href="%s">%s</a>', $data->{$addr}->{'stats'}->{'href'}, $data->{$addr}->{'stats'}->{'date'}) : 'N/A', + defined ($data->{$addr}->{'adminkey'}) ? + sprintf('<a href="%s">%s</a>', $data->{$addr}->{'adminkey'}->{'href'}, $data->{$addr}->{'adminkey'}->{'date'}) : 'N/A'; + }; + print F '</table></body>'; + close (F); +}; + +1; +# vim: set ts=4 shiftwidth=4: |