From f46e990efedb3d5d8ef94e833e0fa676047da1fe Mon Sep 17 00:00:00 2001 From: Peter Palfrader Date: Tue, 14 Jan 2003 05:25:35 +0000 Subject: First go at sane logging --- Echolot/Commands.pm | 26 +++---- Echolot/Conf.pm | 60 +++++++-------- Echolot/Config.pm | 5 +- Echolot/Mailin.pm | 48 ++++++------ Echolot/Pinger.pm | 12 +-- Echolot/Pinger/CPunk.pm | 34 ++++---- Echolot/Pinger/Mix.pm | 18 ++--- Echolot/Scheduler.pm | 20 ++--- Echolot/Stats.pm | 63 ++++++++------- Echolot/Storage/File.pm | 201 +++++++++++++++++++++++------------------------- Echolot/Thesaurus.pm | 17 ++-- Echolot/Tools.pm | 36 ++++----- NEWS | 5 ++ pingd | 22 +++--- 14 files changed, 283 insertions(+), 284 deletions(-) diff --git a/Echolot/Commands.pm b/Echolot/Commands.pm index 5efdf2d..c370ec1 100644 --- a/Echolot/Commands.pm +++ b/Echolot/Commands.pm @@ -1,7 +1,7 @@ package Echolot::Commands; # (c) 2002 Peter Palfrader -# $Id: Commands.pm,v 1.11 2002/09/11 03:10:27 weasel Exp $ +# $Id: Commands.pm,v 1.12 2003/01/14 05:25:34 weasel Exp $ # =pod @@ -17,7 +17,7 @@ This package provides functions for sending out and receiving pings. =cut use strict; -use Carp qw{cluck}; +use Echolot::Log; use Fcntl ':flock'; # import LOCK_* constants #use Fcntl ':seek'; # import SEEK_* constants use POSIX; # import SEEK_* constants (older perls don't have SEEK_ in Fcntl) @@ -28,18 +28,18 @@ sub addCommand($) { my $filename = Echolot::Config::get()->{'commands_file'}; open(FH, ">>$filename" ) or - cluck("Cannot open $filename for appending $!"), + Echolot::Log::warn("Cannot open $filename for appending $!."), return 0; flock(FH, LOCK_EX) or - cluck("Cannot get exclusive lock on $filename: $!"), + Echolot::Log::warn("Cannot get exclusive lock on $filename: $!."), return 0; print FH $command,"\n"; flock(FH, LOCK_UN) or - cluck("Cannot unlock $filename: $!"); + Echolot::Log::warn("Cannot unlock $filename: $!."); close(FH) or - cluck("Cannot close $filename: $!"); + Echolot::Log::warn("Cannot close $filename: $!."); }; sub processCommands($) { @@ -52,10 +52,10 @@ sub processCommands($) { return 1; open(FH, "+<$filename" ) or - cluck("Cannot open $filename for reading: $!"), + Echolot::Log::warn("Cannot open $filename for reading: $!."), return 0; flock(FH, LOCK_EX) or - cluck("Cannot get exclusive lock on $filename: $!"), + Echolot::Log::warn("Cannot get exclusive lock on $filename: $!."), return 0; @@ -86,20 +86,20 @@ sub processCommands($) { } elsif ($command eq 'deleteremailercaps') { Echolot::Globals::get()->{'storage'}->delete_remailercaps(@args); } else { - warn("Unkown command: $_\n"); + Echolot::Log::warn("Unkown command: '$_'."); }; }; seek(FH, 0, SEEK_SET) or - cluck("Cannot seek to start $filename $!"), + Echolot::Log::warn("Cannot seek to start '$filename': $!."), return 0; truncate(FH, 0) or - cluck("Cannot truncate $filename to zero length: $!"), + Echolot::Log::warn("Cannot truncate '$filename' to zero length: $!."), return 0; flock(FH, LOCK_UN) or - cluck("Cannot unlock $filename: $!"); + Echolot::Log::warn("Cannot unlock '$filename': $!."); close(FH) or - cluck("Cannot close $filename: $!"); + Echolot::Log::warn("Cannot close '$filename': $!."); }; 1; diff --git a/Echolot/Conf.pm b/Echolot/Conf.pm index 18dac22..9504ae6 100644 --- a/Echolot/Conf.pm +++ b/Echolot/Conf.pm @@ -1,7 +1,7 @@ package Echolot::Conf; # (c) 2002 Peter Palfrader -# $Id: Conf.pm,v 1.33 2003/01/02 23:58:53 weasel Exp $ +# $Id: Conf.pm,v 1.34 2003/01/14 05:25:34 weasel Exp $ # =pod @@ -23,7 +23,7 @@ account (This is the one with the latest self signature I think). =cut use strict; -use Carp qw{cluck}; +use Echolot::Log; use GnuPG::Interface; use IO::Handle; @@ -117,24 +117,24 @@ sub remailer_caps($$$;$) { my ($id) = $token =~ /^conf\.(\d+)$/; (defined $id) or - cluck ("Returned token '$token' has no id at all"), + Echolot::Log::info("Returned token '$token' has no id at all."), return 0; - cluck("Could not find id in token '$token'"), return 0 unless defined $id; + Echolot::Log::info("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_caps from '$token'"), return 0 unless defined $remailer_type; + Echolot::Log::info("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_caps from '$token'"), return 0 unless defined $remailer_caps; + Echolot::Log::info("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; + Echolot::Log::info("No remailer nick found in remailer_caps from '$token': '$remailer_caps'."), return 0 unless defined $remailer_nick; + Echolot::Log::info("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); - cluck("No remailer found for id '$id'"), return 0 unless defined $remailer; + Echolot::Log::info("No remailer found for id '$id'."), return 0 unless defined $remailer; 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::Log::info("Remailer address mismatch $remailer->{'address'} vs $remailer_address. Adding latter to prospective remailers."); Echolot::Globals::get()->{'storage'}->add_prospective_address($remailer_address, 'self-capsstring-conf', $remailer_address); } else { Echolot::Globals::get()->{'storage'}->restore_ttl( $remailer->{'address'} ); @@ -185,7 +185,7 @@ sub remailer_caps($$$;$) { last unless ($head =~ /\s(.*?@.*?)\s/); Echolot::Globals::get()->{'storage'}->add_prospective_address($1, 'reliable-caps-reply-type2', $remailer_address); } else { - carp("Shouldn't be here. wanting == $wanting"); + Echolot::Log::confess("Shouldn't be here. wanting == $wanting."); }; }; }; @@ -198,7 +198,7 @@ sub remailer_conf($$$) { my ($id) = $token =~ /^conf\.(\d+)$/; (defined $id) or - cluck ("Returned token '$token' has no id at all"), + Echolot::Log::info ("Returned token '$token' has no id at all."), return 0; Echolot::Globals::get()->{'storage'}->not_a_remailer($id), return 1 @@ -212,10 +212,10 @@ sub set_caps_manually($$) { my ($addr, $caps) = @_; defined $addr or - cluck("Address not defined."), + Echolot::Log::info("Address not defined."), return 0; defined $caps or - cluck("Caps not defined."), + Echolot::Log::info("Caps not defined."), return 0; print "Setting caps for $addr manually to $caps\n" @@ -223,11 +223,11 @@ sub set_caps_manually($$) { my $remailer = Echolot::Globals::get()->{'storage'}->get_address($addr); defined $remailer or - cluck("Remailer address $addr did not give a valid remailer."), + Echolot::Log::info("Remailer address $addr did not give a valid remailer."), return 0; my $id = $remailer->{'id'}; defined $id or - cluck("Remailer address $addr did not give a remailer with an id."), + Echolot::Log::info("Remailer address $addr did not give a remailer with an id."), return 0; my $token = 'conf.'.$id; @@ -307,15 +307,15 @@ sub parse_mix_key($$$) { for my $keyid (keys %mixmasters) { my $remailer_address = $mixmasters{$keyid}->{'address'}; (defined $mixmasters{$keyid}->{'nick'} && ! defined $mixmasters{$keyid}->{'key'}) and - cluck("Mixmaster key header without key in reply from $remailer_address"), + Echolot::Log::info("Mixmaster key header without key in reply from $remailer_address."), next; (! defined $mixmasters{$keyid}->{'nick'} && defined $mixmasters{$keyid}->{'key'}) and - cluck("Mixmaster key without key header in reply from $remailer_address"), + Echolot::Log::info("Mixmaster key without key header in reply from $remailer_address."), next; 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::Log::info("Remailer address mismatch $remailer->{'address'} vs $remailer_address. Adding latter to prospective remailers."); Echolot::Globals::get()->{'storage'}->add_prospective_address($remailer_address, 'self-capsstring-key', $remailer_address); } else { Echolot::Globals::get()->{'storage'}->restore_ttl( $remailer->{'address'} ); @@ -378,17 +378,17 @@ sub parse_cpunk_key($$$) { waitpid $pid, 0; ($stderr eq '') or - cluck("GnuPG returned something in stderr: '$stderr' when checking key '$key'; So what?\n"); + Echolot::Log::info("GnuPG returned something in stderr: '$stderr' when checking key '$key'; So what?"); ($status eq '') or - cluck("GnuPG returned something in status '$status' when checking key '$key': So what?\n"); + Echolot::Log::info("GnuPG returned something in status '$status' when checking key '$key': So what?"); my @included_keys = $stdout =~ /^pub:.*$/mg; (scalar @included_keys >= 2) && - cluck ("Cannot handle more than one key per block correctly yet. Found ".(scalar @included_keys)." in one block from ".$remailer->{'address'}); + Echolot::Log::info ("Cannot handle more than one key per block correctly yet. Found ".(scalar @included_keys)." in one block from ".$remailer->{'address'}."."); for my $included_key (@included_keys) { my ($type, $keyid, $uid) = $included_key =~ /pub::\d+:(\d+):([0-9A-F]+):[^:]+:[^:]*:::([^:]+):/; (defined $uid) or - cluck ("Unexpected format of '$included_key' by ".$remailer->{'address'}."; Skipping"), + Echolot::Log::info ("Unexpected format of '$included_key' by ".$remailer->{'address'}."; Skipping."), next; my ($address) = $uid =~ /<(.*?)>/; $cypherpunk{$keyid} = { @@ -404,7 +404,7 @@ sub parse_cpunk_key($$$) { 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 id key $keyid. Adding latter to prospective remailers."); + Echolot::Log::info("Remailer address mismatch $remailer->{'address'} vs $remailer_address id key $keyid. Adding latter to prospective remailers."); Echolot::Globals::get()->{'storage'}->add_prospective_address($remailer_address, 'self-capsstring-key', $remailer_address); } else { Echolot::Globals::get()->{'storage'}->restore_ttl( $remailer->{'address'} ); @@ -424,7 +424,7 @@ sub parse_cpunk_key($$$) { 'N/A', $time); } else { - cluck("$keyid from $remailer_address has algoid ".$cypherpunk{$keyid}->{'type'}.". Cannot handle those."); + Echolot::Log::info("$keyid from $remailer_address has algoid ".$cypherpunk{$keyid}->{'type'}.". Cannot handle those."); }; } }; @@ -440,7 +440,7 @@ sub remailer_key($$$) { my ($id) = $token =~ /^key\.(\d+)$/; (defined $id) or - cluck ("Returned token '$token' has no id at all"), + Echolot::Log::info ("Returned token '$token' has no id at all."), return 0; Echolot::Globals::get()->{'storage'}->not_a_remailer($id), return 1 @@ -448,7 +448,7 @@ sub remailer_key($$$) { Echolot::Thesaurus::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; + Echolot::Log::info("No remailer found for id '$id'."), return 0 unless defined $remailer; parse_mix_key($cp_reply, $time, $remailer); parse_cpunk_key($cp_reply, $time, $remailer); @@ -461,7 +461,7 @@ sub remailer_stats($$$) { my ($id) = $token =~ /^stats\.(\d+)$/; (defined $id) or - cluck ("Returned token '$token' has no id at all"), + Echolot::Log::info ("Returned token '$token' has no id at all."), return 0; Echolot::Globals::get()->{'storage'}->not_a_remailer($id), return 1 @@ -474,7 +474,7 @@ sub remailer_help($$$) { my ($id) = $token =~ /^help\.(\d+)$/; (defined $id) or - cluck ("Returned token '$token' has no id at all"), + Echolot::Log::info ("Returned token '$token' has no id at all."), return 0; Echolot::Globals::get()->{'storage'}->not_a_remailer($id), return 1 @@ -487,7 +487,7 @@ sub remailer_adminkey($$$) { my ($id) = $token =~ /^adminkey\.(\d+)$/; (defined $id) or - cluck ("Returned token '$token' has no id at all"), + Echolot::Log::info ("Returned token '$token' has no id at all."), return 0; Echolot::Globals::get()->{'storage'}->not_a_remailer($id), return 1 diff --git a/Echolot/Config.pm b/Echolot/Config.pm index fc0d9ae..090d55b 100644 --- a/Echolot/Config.pm +++ b/Echolot/Config.pm @@ -1,7 +1,7 @@ package Echolot::Config; # (c) 2002 Peter Palfrader -# $Id: Config.pm,v 1.44 2002/12/13 06:50:30 weasel Exp $ +# $Id: Config.pm,v 1.45 2003/01/14 05:25:35 weasel Exp $ # =pod @@ -200,7 +200,7 @@ sub init($) { }; die ("no Configuration file found\n") unless defined $configfile; - + { local $/ = undef; open(CONFIGCODE, $configfile) or @@ -250,7 +250,6 @@ sub init($) { for my $key (keys %$CONFIG) { warn ("Config option $key is not defined\n") unless defined $CONFIG->{$key}; }; - }; sub get() { diff --git a/Echolot/Mailin.pm b/Echolot/Mailin.pm index 66681c3..6bcf7a1 100644 --- a/Echolot/Mailin.pm +++ b/Echolot/Mailin.pm @@ -1,7 +1,7 @@ package Echolot::Mailin; # (c) 2002 Peter Palfrader -# $Id: Mailin.pm,v 1.9 2002/10/11 16:58:06 weasel Exp $ +# $Id: Mailin.pm,v 1.10 2003/01/14 05:25:35 weasel Exp $ # =pod @@ -16,11 +16,10 @@ Echolot::Mailin - Incoming Mail Dispatcher for Echolot =cut use strict; -use Carp qw{cluck}; use English; use Echolot::Globals; +use Echolot::Log; use Fcntl ':flock'; # import LOCK_* constants -#use Fcntl ':seek'; # import SEEK_* constants use POSIX; # import SEEK_* constants (older perls don't have SEEK_ in Fcntl) @@ -34,7 +33,7 @@ sub sane_move($$) { my $link_success = link($from, $to); $link_success or - cluck("Cannot link $from to $to: $!"), + Echolot::Log::warn("Cannot link $from to $to: $!."), return 0; #- Trying move"), #rename($from, $to) or @@ -42,7 +41,7 @@ sub sane_move($$) { # return 0; $link_success && (unlink($from) or - cluck("Cannot unlink $from: $!") ); + Echolot::Log::warn("Cannot unlink $from: $!.") ); return 1; }; @@ -66,11 +65,11 @@ sub handle($) { }; (defined $to) or - cluck("No To header found in mail"), + Echolot::Log::info("No To header found in mail."), return 0; my $address_result = Echolot::Tools::verify_address_tokens($to) or - cluck("Verifying '$to' failed"), + Echolot::Log::debug("Verifying '$to' failed."), return 0; my $type = $address_result->{'token'}; @@ -84,7 +83,7 @@ sub handle($) { Echolot::Pinger::receive($body, $type, $timestamp), return 1 if ($type eq 'ping'); - cluck("Didn't know what to do with '$to'"), + Echolot::Log::warn("Didn't know what to do with '$to'."), return 0; }; @@ -92,12 +91,12 @@ sub handle_file($) { my ($file) = @_; open (FH, $file) or - cluck("Cannot open file $file: $!"), + Echolot::Log::warn("Cannot open file $file: $!,"), return 0; my @lines = ; my $body = join('', ); close (FH) or - cluck("Cannot close file $file: $!"); + Echolot::Log::warn("Cannot close file $file: $!."); return handle(\@lines); }; @@ -110,10 +109,10 @@ sub read_mbox($) { my $blank = 1; open(FH, '+<'. $file) or - cluck("cannot open '$file': $!\n"), + Echolot::Log::warn("cannot open '$file': $!."), return undef; flock(FH, LOCK_EX) or - cluck("cannot gain lock on '$file': $!\n"), + Echolot::Log::warn("cannot gain lock on '$file': $!."), return undef; while() { @@ -129,13 +128,13 @@ sub read_mbox($) { push(@mail, $mail) if scalar(@{$mail}); seek(FH, 0, SEEK_SET) or - cluck("cannot seek to start of '$file': $!\n"), + Echolot::Log::warn("cannot seek to start of '$file': $!."), return undef; truncate(FH, 0) or - cluck("cannot truncate '$file' to zero size: $!\n"), + Echolot::Log::warn("cannot truncate '$file' to zero size: $!."), return undef; flock(FH, LOCK_UN) or - cluck("cannot release lock on '$file': $!\n"), + Echolot::Log::warn("cannot release lock on '$file': $!."), return undef; close(FH); @@ -150,21 +149,21 @@ sub read_maildir($) { my @files; for my $sub (qw{new cur}) { opendir(DIR, $dir.'/'.$sub) or - cluck("Cannot open direcotry '$dir/$sub': $!"), + Echolot::Log::warn("Cannot open direcotry '$dir/$sub': $!."), return 0; push @files, map { $sub.'/'.$_ } grep { ! /^\./ } readdir(DIR); closedir(DIR) or - cluck("Cannot close direcotry '$dir/$sub': $!"); + Echolot::Log::warn("Cannot close direcotry '$dir/$sub': $!."); }; for my $file (@files) { $file =~ /^(.*)$/s or - confess("I really should match here. ('$file')."); + Echolot::Log::confess("I really should match here. ('$file')."); $file = $1; my $mail = []; open(FH, $dir.'/'.$file) or - cluck("cannot open '$dir/$file': $!\n"), + Echolot::Log::warn("cannot open '$dir/$file': $!."), return undef; @$mail = ; close(FH); @@ -174,7 +173,7 @@ sub read_maildir($) { for my $file (@files) { unlink $dir.'/'.$file or - cluck("cannot unlink '$dir/$file': $!\n"); + Echolot::Log::warn("cannot unlink '$dir/$file': $!."); }; @@ -186,7 +185,7 @@ sub storemail($$) { my $tmpname = $path.'/tmp/'.make_sane_name(); open (F, '>'.$tmpname) or - cluck("Cannot open $tmpname: $!"), + Echolot::Log::warn("Cannot open $tmpname: $!."), return undef; print F join ('', @$mail); close F; @@ -214,9 +213,10 @@ sub process() { Echolot::Globals::get()->{'storage'}->delay_commit(); for my $mail (@$mails) { unless (handle($mail)) { - my $name = make_sane_name(); - storemail($mailerrordir, $mail) or - cluck("Could not store a mail"); + Echolot::Log::info("Trashing mail with unknown destination (probably a bounce)."); + #my $name = make_sane_name(); + #storemail($mailerrordir, $mail) or + # Echolot::Log::warn("Could not store a mail."); }; }; Echolot::Globals::get()->{'storage'}->enable_commit(); diff --git a/Echolot/Pinger.pm b/Echolot/Pinger.pm index 3fc7d32..70143cc 100644 --- a/Echolot/Pinger.pm +++ b/Echolot/Pinger.pm @@ -1,7 +1,7 @@ package Echolot::Pinger; # (c) 2002 Peter Palfrader -# $Id: Pinger.pm,v 1.21 2002/09/11 03:10:27 weasel Exp $ +# $Id: Pinger.pm,v 1.22 2003/01/14 05:25:35 weasel Exp $ # =pod @@ -17,8 +17,8 @@ This package provides functions for sending out and receiving pings. =cut use strict; -use Carp qw{cluck}; use English; +use Echolot::Log; use Echolot::Pinger::Mix; use Echolot::Pinger::CPunk; @@ -76,7 +76,7 @@ sub do_ping($$$) { } elsif ($type eq 'cpunk-rsa' || $type eq 'cpunk-dsa' || $type eq 'cpunk-clear') { do_cpunk_ping($address, $type, $key, $now, $to, $body); } else { - cluck ("Don't know how to handle ping type $type"); + Echolot::Log::warn("Don't know how to handle ping type $type."); return 0; }; @@ -114,7 +114,7 @@ sub send_pings($;$) { $which eq 'all' || (($which eq '') && ($this_call_id eq (Echolot::Tools::makeShortNumHash($address.$type.$key.$session_id) % $send_every_n_calls)))); - print "ping calling $type, $address, $key\n" if Echolot::Config::get()->{'verbose'}; + Echolot::Log::debug("ping calling $type, $address, $key."); do_ping($type, $address, $key); } }; @@ -152,11 +152,11 @@ sub receive($$$) { (defined $mac ? $mac : 'undef') . ':'; (defined $addr && defined $type && defined $key && defined $sent && defined $mac) or - warn ("Received ping at $timestamp has undefined values: $cleanstring\n"), #FIXME: logging + Echolot::Log::warn("Received ping at $timestamp has undefined values: $cleanstring."), return 0; Echolot::Tools::verify_mac($addr.':'.$type.':'.$key.':'.$sent, $mac) or - warn ("Received ping at $timestamp has wrong mac; $cleanstring\n"), #FIXME: logging + Echolot::Log::warn("Received ping at $timestamp has wrong mac; $cleanstring."), return 0; Echolot::Globals::get()->{'storage'}->register_pingdone($addr, $type, $key, $sent, $now - $sent) or diff --git a/Echolot/Pinger/CPunk.pm b/Echolot/Pinger/CPunk.pm index 909f602..435db22 100644 --- a/Echolot/Pinger/CPunk.pm +++ b/Echolot/Pinger/CPunk.pm @@ -1,7 +1,7 @@ package Echolot::Pinger::CPunk; # (c) 2002 Peter Palfrader -# $Id: CPunk.pm,v 1.10 2003/01/13 00:33:14 weasel Exp $ +# $Id: CPunk.pm,v 1.11 2003/01/14 05:25:35 weasel Exp $ # =pod @@ -17,19 +17,19 @@ This package provides functions for sending cypherpunk (type I) pings. =cut use strict; -use Carp qw{cluck}; use English; use GnuPG::Interface; use IO::Handle; +use Echolot::Log; sub encrypt_to($$$$) { my ($msg, $recipient, $keys, $pgp2compat) = @_; (defined $keys->{$recipient}) or - cluck ("Key for recipient $recipient is not defined"), + Echolot::Log::warn("Key for recipient $recipient is not defined."), return undef; (defined $keys->{$recipient}->{'key'}) or - cluck ("Key->key for recipient $recipient is not defined"), + Echolot::Log::warn("Key->key for recipient $recipient is not defined."), return undef; my $keyring = Echolot::Config::get()->{'tmpdir'}.'/'. Echolot::Globals::get()->{'hostname'}.".".time.'.'.$PROCESS_ID.'_'.Echolot::Globals::get()->{'internalcounter'}++.'.keyring'; @@ -66,12 +66,12 @@ sub encrypt_to($$$$) { waitpid $pid, 0; ($stdout eq '') or - cluck("GnuPG returned something in stdout '$stdout' while adding key for '$recipient': So what?\n"); + Echolot::Log::info("GnuPG returned something in stdout '$stdout' while adding key for '$recipient': So what?"); #($stderr eq '') or - #cluck("GnuPG returned something in stderr: '$stderr' while adding key for '$recipient'; returning\n"), + #Echolot::Log::warn("GnuPG returned something in stderr: '$stderr' while adding key for '$recipient'; returning."), #return undef; ($status =~ /^^\[GNUPG:\] IMPORTED $recipient /m) or - cluck("GnuPG status '$status' didn't indicate key for '$recipient' was imported correctly. Returning\n"), + Echolot::Log::info("GnuPG status '$status' didn't indicate key for '$recipient' was imported correctly."), return undef; @@ -114,11 +114,11 @@ sub encrypt_to($$$$) { $plaintextfile = Echolot::Config::get()->{'tmpdir'}.'/'. Echolot::Globals::get()->{'hostname'}.".".time.'.'.$PROCESS_ID.'_'.Echolot::Globals::get()->{'internalcounter'}++.'.plaintext'; open (F, '>'.$plaintextfile) or - cluck("Cannot open $plaintextfile for writing: $!"), + Echolot::Log::warn("Cannot open $plaintextfile for writing: $!."), return 0; print (F $msg); close (F) or - cluck("Cannot close $plaintextfile"), + Echolot::Log::warn("Cannot close $plaintextfile."), return 0; push @$command_args, $plaintextfile; @@ -134,21 +134,21 @@ sub encrypt_to($$$$) { waitpid $pid, 0; #($stderr eq '') or - #cluck("GnuPG returned something in stderr: '$stderr' while encrypting to '$recipient'; returning"), + #Echolot::Log::warn("GnuPG returned something in stderr: '$stderr' while encrypting to '$recipient'."), #return undef; (($status =~ /^^\[GNUPG:\] BEGIN_ENCRYPTION\s/m) && ($status =~ /^^\[GNUPG:\] END_ENCRYPTION\s/m)) or - cluck("GnuPG status '$status' didn't indicate message to '$recipient' was encrypted correctly (stderr: $stderr; args: ".join(' ', @$command_args)."). Returning\n"), + Echolot::Log::info("GnuPG status '$status' didn't indicate message to '$recipient' was encrypted correctly (stderr: $stderr; args: ".join(' ', @$command_args).")."), return undef; unlink ($keyring) or - cluck("Cannot unlink tmp keyring '$keyring'"), + Echolot::Log::warn("Cannot unlink tmp keyring '$keyring'."), return undef; unlink ($keyring.'~'); # gnupg does those evil backups (defined $plaintextfile) and ( unlink ($plaintextfile) or - cluck("Cannot unlink tmp keyring '$plaintextfile'"), + Echolot::Log::warn("Cannot unlink tmp keyring '$plaintextfile'."), return undef); @@ -156,16 +156,16 @@ sub encrypt_to($$$$) { $plaintextfile .= '.asc'; open (F, '<'.$plaintextfile) or - cluck("Cannot open $plaintextfile for reading $!"), + Echolot::Log::warn("Cannot open $plaintextfile for reading: $!."), return 0; $result = join '', ; close (F) or - cluck("Cannot close $plaintextfile"), + Echolot::Log::warn("Cannot close $plaintextfile."), return 0; (defined $plaintextfile) and ( unlink ($plaintextfile) or - cluck("Cannot unlink tmp keyring '$plaintextfile'"), + Echolot::Log::warn("Cannot unlink tmp keyring '$plaintextfile'."), return undef); $result =~ s,^Version: .*$,Version: N/A,m; @@ -186,7 +186,7 @@ sub ping($$$$$) { if ($hop->{'encrypt'}) { my $encrypted = encrypt_to($msg, $hop->{'keyid'}, $keys, $pgp2compat); (defined $encrypted) or - cluck("Encrypted is undefined"), + Echolot::Log::debug("Encrypted is undefined."), return undef; $msg = "::\n". "Encrypted: PGP\n". diff --git a/Echolot/Pinger/Mix.pm b/Echolot/Pinger/Mix.pm index 40d2d9b..7bca883 100644 --- a/Echolot/Pinger/Mix.pm +++ b/Echolot/Pinger/Mix.pm @@ -1,7 +1,7 @@ package Echolot::Pinger::Mix; # (c) 2002 Peter Palfrader -# $Id: Mix.pm,v 1.9 2002/09/10 20:03:20 weasel Exp $ +# $Id: Mix.pm,v 1.10 2003/01/14 05:25:35 weasel Exp $ # =pod @@ -17,8 +17,8 @@ This package provides functions for sending mixmaster (type II) pings. =cut use strict; -use Carp qw{cluck}; use English; +use Echolot::Log; sub ping($$$$) { my ($body, $to, $chain, $keys) = @_; @@ -27,25 +27,25 @@ sub ping($$$$) { my $keyring = Echolot::Config::get()->{'mixhome'}.'/pubring.mix'; open (F, '>'.$keyring) or - cluck("Cannot open $keyring for writing: $!"), + Echolot::Log::warn("Cannot open $keyring for writing: $!."), return 0; for my $keyid (keys %$keys) { print (F $keys->{$keyid}->{'summary'}, "\n\n"); print (F $keys->{$keyid}->{'key'},"\n\n"); }; close (F) or - cluck("Cannot close $keyring: $!"), + Echolot::Log::warn("Cannot close $keyring: $!."), return 0; my $type2list = Echolot::Config::get()->{'mixhome'}.'/type2.list'; open (F, '>'.$type2list) or - cluck("Cannot open $type2list for writing: $!"), + Echolot::Log::warn("Cannot open $type2list for writing: $!."), return 0; for my $keyid (keys %$keys) { print (F $keys->{$keyid}->{'summary'}, "\n"); }; close (F) or - cluck("Cannot close $type2list: $!"), + Echolot::Log::warn("Cannot close $type2list: $!."), return 0; my $mixcfg = Echolot::Config::get()->{'mixhome'}.'/mix.cfg'; @@ -53,7 +53,7 @@ sub ping($$$$) { Echolot::Config::get()->{'my_domain'}; my $sendmail = Echolot::Config::get()->{'sendmail'}; open (F, ">$mixcfg") or - cluck("Cannot open $mixcfg for writing: $!"), + Echolot::Log::warn("Cannot open $mixcfg for writing: $!."), return 0; print (F "REMAIL n\n"); print (F "NAME Echolot Pinger\n"); @@ -62,12 +62,12 @@ sub ping($$$$) { print (F "TYPE2LIST type2.list\n"); print (F "SENDMAIL $sendmail -f $address -t\n"); close (F) or - cluck("Cannot close $mixcfg: $!"), + Echolot::Log::warn("Cannot close $mixcfg: $!."), return 0; $ENV{'MIXPATH'} = Echolot::Config::get()->{'mixhome'}; open(MIX, "|".Echolot::Config::get()->{'mixmaster'}." -m -S -l $chaincomma") or - cluck("Cannot exec mixpinger: $!"), + Echolot::Log::warn("Cannot exec mixpinger: $!."), return 0; print MIX "To: $to\n\n$body\n"; close (MIX); diff --git a/Echolot/Scheduler.pm b/Echolot/Scheduler.pm index 7b71e80..39c785f 100644 --- a/Echolot/Scheduler.pm +++ b/Echolot/Scheduler.pm @@ -1,7 +1,7 @@ package Echolot::Scheduler; # (c) 2002 Peter Palfrader -# $Id: Scheduler.pm,v 1.13 2002/10/11 16:56:21 weasel Exp $ +# $Id: Scheduler.pm,v 1.14 2003/01/14 05:25:35 weasel Exp $ # =pod @@ -20,8 +20,8 @@ the ping daemon. =cut use strict; -use Carp qw{cluck confess}; use English; +use Echolot::Log; my $ORDER = 1; @@ -48,7 +48,7 @@ it get's called 10 minutes after the hour. sub add($$$$$) { my ($self, $name, $interval, $offset, $what) = @_; - confess("Must not add zero intervall for job $name") + Echolot::Log::logdie("Must not add zero intervall for job $name.") unless $interval; if (defined $self->{'tasks'}->{$name}) { @@ -80,7 +80,7 @@ sub schedule($$$;$$) { my ($self, $name, $reschedule, $for, $arguments) = @_; (defined $self->{'tasks'}->{$name}) or - cluck("Task $name is not defined"), + Echolot::Log::warn("Task $name is not defined."), return 0; my $interval = $self->{'tasks'}->{$name}->{'interval'}; @@ -123,16 +123,16 @@ sub run($) { my ($self) = @_; (defined $self->{'schedule'}->[0]) or - cluck("Scheduler is empty"), + Echolot::Log::warn("Scheduler is empty."), return 0; while(1) { my $now = time(); my $task = $self->{'schedule'}->[0]; if ($task->{'start'} < $now) { - warn("Task $task->{'name'} could not be started on time\n"); + Echolot::Log::warn("Task $task->{'name'} could not be started on time."); } else { - print "zZzZZzz at $now\n" if Echolot::Config::get()->{'verbose'}; + Echolot::Log::debug("zZzZZzz."); $PROGRAM_NAME = "pingd [sleeping]"; sleep ($task->{'start'} - $now); }; @@ -146,17 +146,17 @@ sub run($) { my $name = $task->{'name'}; $PROGRAM_NAME = "pingd [executing $name]"; (defined $self->{'tasks'}->{$name}) or - warn("Task $task->{'name'} is not defined\n"); + Echolot::Log::cluck("Task $task->{'name'} is not defined."); my $what = $self->{'tasks'}->{$name}->{'what'}; - print "Running $name at ".(time())." (scheduled for $now)\n" if Echolot::Config::get()->{'verbose'}; + Echolot::Log::debug("Running $name (was scheduled for ".(time()-$now)." seconds ago)."); last if ($what eq 'exit'); &$what( $now, @{ $task->{'arguments'} } ); $self->schedule($name, 1, $now + $self->{'tasks'}->{$name}->{'interval'}) if ($task->{'reschedule'} && $self->{'tasks'}->{$name}->{'interval'} > 0); (defined $self->{'schedule'}->[0]) or - cluck("Scheduler is empty"), + Echolot::Log::warn("Scheduler is empty."), return 0; } while ($now >= $self->{'schedule'}->[0]->{'start'}); }; diff --git a/Echolot/Stats.pm b/Echolot/Stats.pm index fb9e10d..515107d 100644 --- a/Echolot/Stats.pm +++ b/Echolot/Stats.pm @@ -1,7 +1,7 @@ package Echolot::Stats; # (c) 2002 Peter Palfrader -# $Id: Stats.pm,v 1.37 2003/01/02 21:24:32 weasel Exp $ +# $Id: Stats.pm,v 1.38 2003/01/14 05:25:35 weasel Exp $ # =pod @@ -18,11 +18,10 @@ and keyrings. =cut use strict; -use Carp qw{cluck}; - use constant DAYS => 12; use constant SECS_PER_DAY => 24 * 60 * 60; use English; +use Echolot::Log; use Statistics::Distrib::Normal qw{}; @@ -256,7 +255,7 @@ sub read_file($;$) { my ($name, $fail_ok) = @_; unless (open (F, $name)) { - cluck("Could not open '$name': $!") unless ($fail_ok); + Echolot::Log::warn("Could not open '$name': $!.") unless ($fail_ok); return undef; }; local $/ = undef; @@ -271,14 +270,14 @@ sub write_file($$$$) { my $filename = $filebasename.'.txt'; open(F, '>'.$filename) or - cluck("Cannot open $filename: $!\n"), + Echolot::Log::warn("Cannot open $filename: $!."), return 0; print F $output; close (F); if (defined $expires) { Echolot::Tools::write_meta_information($filename, Expires => time + $expires) or - cluck ("Error while writing meta information for $filename"), + Echolot::Log::debug ("Error while writing meta information for $filename."), return 0; }; return 1 unless defined $html_template; @@ -315,7 +314,7 @@ sub build_mlist1($$$$$;$) { }; write_file($filebasename, $html_template, Echolot::Config::get()->{'buildstats'}, $output) or - cluck("writefile failed"), + Echolot::Log::debug("writefile failed."), return 0; return 1; }; @@ -348,7 +347,7 @@ sub build_rlist1($$$$$;$) { write_file($filebasename, $html_template, Echolot::Config::get()->{'buildstats'}, $output) or - cluck("writefile failed"), + Echolot::Log::debug("writefile failed."), return 0; return 1; }; @@ -384,7 +383,7 @@ sub build_list2($$$$$$;$) { } write_file($filebasename, $html_template, Echolot::Config::get()->{'buildstats'}, $output) or - cluck("writefile failed"), + Echolot::Log::debug("writefile failed."), return 0; return 1; }; @@ -431,7 +430,7 @@ sub build_clist($$$$$;$) { } write_file($filebasename, $html_template, Echolot::Config::get()->{'buildstats'}, $output) or - cluck("writefile failed"), + Echolot::Log::debug("writefile failed."), return 0; return 1; }; @@ -566,22 +565,22 @@ sub build_lists() { { local $/ = undef; open(F, $file) or - cluck("Could not open $file: $!\n"), + Echolot::Log::warn("Could not open $file: $!."), return 0; $css = ; close (F) or - cluck("Cannot close $file: $!\n"), + Echolot::Log::warn("Cannot close $file: $!."), return 0; } $file = Echolot::Config::get()->{'resultdir'}.'/echolot.css'; open(F, '>'.$file) or - cluck("Cannot open $file: $!\n"), + Echolot::Log::warn("Cannot open $file: $!."), return 0; print F $css or - cluck("Cannot print to $file: $!\n"), + Echolot::Log::warn("Cannot print to $file: $!."), return 0; close (F) or - cluck("Cannot close $file: $!\n"), + Echolot::Log::warn("Cannot close $file: $!."), return 0; }; @@ -593,22 +592,22 @@ sub build_mixring() { my $filename = Echolot::Config::get()->{'resultdir'}.'/pubring.mix'; push @filenames, $filename; open(F, '>'.$filename) or - cluck("Cannot open $filename: $!\n"), + Echolot::Log::warn("Cannot open $filename: $!."), return 0; $filename = Echolot::Config::get()->{'resultdir'}.'/type2.list'; push @filenames, $filename; open(T2L, '>'.$filename) or - cluck("Cannot open $filename: $!\n"), + Echolot::Log::warn("Cannot open $filename: $!."), return 0; $filename = Echolot::Config::get()->{'private_resultdir'}.'/pubring.mix'; push @filenames, $filename; open(F_PRIV, '>'.$filename) or - cluck("Cannot open $filename: $!\n"), + Echolot::Log::warn("Cannot open $filename: $!."), return 0; $filename = Echolot::Config::get()->{'private_resultdir'}.'/type2.list'; push @filenames, $filename; open(T2L_PRIV, '>'.$filename) or - cluck("Cannot open $filename: $!\n"), + Echolot::Log::warn("Cannot open $filename: $!."), return 0; my $data; @@ -652,7 +651,7 @@ sub build_mixring() { for my $filename (@filenames) { Echolot::Tools::write_meta_information($filename, Expires => time + Echolot::Config::get()->{'buildkeys'}) or - cluck ("Error while writing meta information for $filename"), + Echolot::Log::debug ("Error while writing meta information for $filename."), return 0; }; }; @@ -705,12 +704,12 @@ sub build_pgpring_type($$$$) { waitpid $pid, 0; ($stdout eq '') or - cluck("GnuPG returned something in stdout '$stdout' while adding key for '$addr': So what?\n"); + Echolot::Log::info("GnuPG returned something in stdout '$stdout' while adding key for '$addr': So what?"); unless ($status =~ /^^\[GNUPG:\] IMPORTED /m) { if ($status =~ /^^\[GNUPG:\] IMPORT_RES /m) { - cluck("GnuPG status '$status' indicates more than one key for '$addr' imported. Ignoring.\n"); + Echolot::Log::info("GnuPG status '$status' indicates more than one key for '$addr' imported. Ignoring."); } else { - cluck("GnuPG status '$status' didn't indicate key for '$addr' was imported correctly. Ignoring.\n"); + Echolot::Log::info("GnuPG status '$status' didn't indicate key for '$addr' was imported correctly. Ignoring."); }; }; $keyids->{$final_keyid} = $remailer->{'showit'}; @@ -748,14 +747,14 @@ sub build_pgpring_export($$$$) { waitpid $pid, 0; open (F, ">$file") or - cluck ("Cannot open '$file': $!"), + Echolot::Log::warn ("Cannot open '$file': $!."), return 0; print F $stdout; close F; Echolot::Tools::write_meta_information($file, Expires => time + Echolot::Config::get()->{'buildkeys'}) or - cluck ("Error while writing meta information for $file"), + Echolot::Log::debug ("Error while writing meta information for $file."), return 0; return 1; @@ -775,32 +774,32 @@ sub build_pgpring() { my $keyids = {}; build_pgpring_type('cpunk-rsa', $GnuPG, $keyring, $keyids) or - cluck("build_pgpring_type failed"), + Echolot::Log::debug("build_pgpring_type failed."), return undef; build_pgpring_export($GnuPG, $keyring, Echolot::Config::get()->{'resultdir'}.'/pgp-rsa.asc', [ grep {$keyids->{$_}} keys %$keyids ]) or - cluck("build_pgpring_export failed"), + Echolot::Log::debug("build_pgpring_export failed."), return undef; build_pgpring_export($GnuPG, $keyring, Echolot::Config::get()->{'private_resultdir'}.'/pgp-rsa.asc', [ keys %$keyids ]) or - cluck("build_pgpring_export failed"), + Echolot::Log::debug("build_pgpring_export failed."), return undef; build_pgpring_type('cpunk-dsa', $GnuPG, $keyring, $keyids) or - cluck("build_pgpring_type failed"), + Echolot::Log::debug("build_pgpring_type failed."), return undef; build_pgpring_export($GnuPG, $keyring, Echolot::Config::get()->{'resultdir'}.'/pgp-all.asc', [ grep {$keyids->{$_}} keys %$keyids ]) or - cluck("build_pgpring_export failed"), + Echolot::Log::debug("build_pgpring_export failed."), return undef; build_pgpring_export($GnuPG, $keyring, Echolot::Config::get()->{'private_resultdir'}.'/pgp-all.asc', [ keys %$keyids ]) or - cluck("build_pgpring_export failed"), + Echolot::Log::debug("build_pgpring_export failed."), return undef; unlink ($keyring) or - cluck("Cannot unlink tmp keyring '$keyring'"), + Echolot::Log::warn("Cannot unlink tmp keyring '$keyring'."), return undef; unlink ($keyring.'~'); # gnupg does those evil backups }; diff --git a/Echolot/Storage/File.pm b/Echolot/Storage/File.pm index f0942a4..c25c46f 100644 --- a/Echolot/Storage/File.pm +++ b/Echolot/Storage/File.pm @@ -1,7 +1,7 @@ package Echolot::Storage::File; # (c) 2002 Peter Palfrader -# $Id: File.pm,v 1.43 2003/01/03 00:28:54 weasel Exp $ +# $Id: File.pm,v 1.44 2003/01/14 05:25:35 weasel Exp $ # =pod @@ -22,11 +22,11 @@ use strict; use Data::Dumper; use IO::Handle; use English; -use Carp qw{cluck confess carp}; use Fcntl ':flock'; # import LOCK_* constants #use Fcntl ':seek'; # import SEEK_* constants use POSIX; # import SEEK_* constants (older perls don't have SEEK_ in Fcntl) use Echolot::Tools; +use Echolot::Log; =item B (I<%args>) @@ -118,16 +118,16 @@ sub metadata_open($) { if ( -e $filename ) { open($self->{'METADATA_FH'}, '+<' . $filename) or - cluck("Cannot open $filename for reading: $!"), + Echolot::Log::warn("Cannot open $filename for reading: $!."), return 0; } else { $self->{'METADATA_FILE_IS_NEW'} = 1; open($self->{'METADATA_FH'}, '+>' . $filename) or - cluck("Cannot open $filename for reading: $!"), + Echolot::Log::warn("Cannot open $filename for reading: $!."), return 0; }; flock($self->{'METADATA_FH'}, LOCK_EX) or - cluck("Cannot get exclusive lock on $filename: $!"), + Echolot::Log::warn("Cannot get exclusive lock on $filename: $!."), return 0; return 1; }; @@ -136,10 +136,10 @@ sub metadata_close($) { my ($self) = @_; flock($self->{'METADATA_FH'}, LOCK_UN) or - cluck("Error when releasing lock on metadata file: $!"), + Echolot::Log::warn("Error when releasing lock on metadata file: $!."), return -1; close($self->{'METADATA_FH'}) or - cluck("Error when closing metadata file: $!"), + Echolot::Log::warn("Error when closing metadata file: $!."), return 0; return 1; }; @@ -158,7 +158,7 @@ sub metadata_read($) { } else { $self->{'METADATA'} = (); seek($self->{'METADATA_FH'}, 0, SEEK_SET) or - cluck("Cannot seek to start of metadata file: $!"), + Echolot::Log::warn("Cannot seek to start of metadata file: $!."), return 0; { local $/ = undef; @@ -177,7 +177,7 @@ sub metadata_read($) { confess("Stored data lacks version header"), return 0; ($self->{'METADATA'}->{'version'} == ($METADATA_VERSION)) or - cluck("Metadata version mismatch ($self->{'METADATA'}->{'version'} vs. $METADATA_VERSION)"), + Echolot::Log::warn("Metadata version mismatch ($self->{'METADATA'}->{'version'} vs. $METADATA_VERSION)."), return 0; }; @@ -195,16 +195,16 @@ sub metadata_write($) { my $fh = $self->{'METADATA_FH'}; seek($fh, 0, SEEK_SET) or - cluck("Cannot seek to start of metadata file: $!"), + Echolot::Log::warn("Cannot seek to start of metadata file: $!."), return 0; truncate($fh, 0) or - cluck("Cannot truncate metadata file to zero length: $!"), + Echolot::Log::warn("Cannot truncate metadata file to zero length: $!."), return 0; print($fh "# vim:set syntax=perl:\n") or - cluck("Error when writing to metadata file: $!"), + Echolot::Log::warn("Error when writing to metadata file: $!."), return 0; print($fh $data) or - cluck("Error when writing to metadata file: $!"), + Echolot::Log::warn("Error when writing to metadata file: $!."), return 0; $fh->flush(); @@ -225,22 +225,22 @@ sub metadata_backup($) { my $data = Data::Dumper->Dump( [ $self->{'METADATA'} ], [ 'METADATA' ] ); my $fh = new IO::Handle; open ($fh, '>'.$filename) or - cluck("Cannot open $filename for writing: $!"), + Echolot::Log::warn("Cannot open $filename for writing: $!."), return 0; print($fh "# vim:set syntax=perl:\n") or - cluck("Error when writing to metadata file: $!"), + Echolot::Log::warn("Error when writing to metadata file: $!."), return 0; print($fh $data) or - cluck("Error when writing to metadata file: $!"), + Echolot::Log::warn("Error when writing to metadata file: $!."), return 0; $fh->flush(); close($fh) or - cluck("Error when closing metadata file: $!"), + Echolot::Log::warn("Error when closing metadata file: $!."), return 0; if (Echolot::Config::get()->{'gzip'}) { system(Echolot::Config::get()->{'gzip'}, $filename) and - cluck("Gziping $filename faild."), + Echolot::Log::warn("Gziping $filename failed."), return 0; }; @@ -254,16 +254,16 @@ sub pingdata_open_one($$$$) { my ($self, $remailer_addr, $type, $key) = @_; defined ($self->{'METADATA'}->{'remailers'}->{$remailer_addr}) or - cluck ("$remailer_addr does not exist in Metadata"), + Echolot::Log::cluck ("$remailer_addr does not exist in Metadata."), return 0; defined ($self->{'METADATA'}->{'remailers'}->{$remailer_addr}->{'keys'}) or - cluck ("$remailer_addr has no keys in Metadata"), + Echolot::Log::cluck ("$remailer_addr has no keys in Metadata."), return 0; defined ($self->{'METADATA'}->{'remailers'}->{$remailer_addr}->{'keys'}->{$type}) or - cluck ("$remailer_addr type $type does not exist in Metadata"), + Echolot::Log::cluck ("$remailer_addr type $type does not exist in Metadata."), return 0; defined ($self->{'METADATA'}->{'remailers'}->{$remailer_addr}->{'keys'}->{$type}->{$key}) or - cluck ("$remailer_addr type $type key $key does not exist in Metadata"), + Echolot::Log::cluck ("$remailer_addr type $type key $key does not exist in Metadata."), return 0; @@ -278,17 +278,17 @@ sub pingdata_open_one($$$$) { my $fh = new IO::Handle; if ( -e $filename.'.'.$direction ) { open($fh, '+<' . $filename.'.'.$direction) or - cluck("Cannot open $filename.$direction for reading: $!"), + Echolot::Log::warn("Cannot open $filename.$direction for reading: $!."), return 0; $self->{'PING_FHS'}->{$remailer_addr}->{$type}->{$key}->{$direction} = $fh; } else { open($fh, '+>' . $filename.'.'.$direction) or - cluck("Cannot open $filename.$direction for reading: $!"), + Echolot::Log::warn("Cannot open $filename.$direction for reading: $!."), return 0; $self->{'PING_FHS'}->{$remailer_addr}->{$type}->{$key}->{$direction} = $fh; }; flock($fh, LOCK_EX) or - cluck("Cannot get exclusive lock on $remailer_addr $type $key $direction pings: $!"), + Echolot::Log::warn("Cannot get exclusive lock on $remailer_addr $type $key $direction pings: $!."), return 0; }; @@ -312,7 +312,7 @@ sub get_ping_fh($$$$$) { my ($self, $remailer_addr, $type, $key, $direction) = @_; defined ($self->{'METADATA'}->{'remailers'}->{$remailer_addr}) or - cluck ("$remailer_addr does not exist in Metadata"), + Echolot::Log::cluck("$remailer_addr does not exist in Metadata."), return 0; my @pings; @@ -322,7 +322,7 @@ sub get_ping_fh($$$$$) { $self->pingdata_open_one($remailer_addr, $type, $key), $fh = $self->{'PING_FHS'}->{$remailer_addr}->{$type}->{$key}->{$direction}; defined ($fh) or - cluck ("$remailer_addr; type=$type; key=$key has no assigned filehandle for $direction pings"), + Echolot::Log::warn ("$remailer_addr; type=$type; key=$key has no assigned filehandle for $direction pings."), return 0; return $fh; @@ -335,10 +335,10 @@ sub pingdata_close_one($$$$;$) { my $fh = $self->{'PING_FHS'}->{$remailer_addr}->{$type}->{$key}->{$direction}; flock($fh, LOCK_UN) or - cluck("Error when releasing lock on $remailer_addr type $type key $key direction $direction pings: $!"), + Echolot::Log::warn("Error when releasing lock on $remailer_addr type $type key $key direction $direction pings: $!."), return 0; close ($fh) or - cluck("Error when closing $remailer_addr type $type key $key direction $direction pings: $!"), + Echolot::Log::warn("Error when closing $remailer_addr type $type key $key direction $direction pings: $!."), return 0; if ((defined $delete) && ($delete eq 'delete')) { @@ -367,7 +367,7 @@ sub pingdata_close($) { for my $type ( keys %{$self->{'PING_FHS'}->{$remailer_addr}} ) { for my $key ( keys %{$self->{'PING_FHS'}->{$remailer_addr}->{$type}} ) { $self->pingdata_close_one($remailer_addr, $type, $key) or - cluck("Error when calling pingdata_close_one with $remailer_addr type $type key $key"), + Echolot::Log::debug("Error when calling pingdata_close_one with $remailer_addr type $type key $key."), return 0; }; }; @@ -381,11 +381,11 @@ sub get_pings($$$$$) { my @pings; my $fh = $self->get_ping_fh($remailer_addr, $type, $key, $direction) or - cluck ("$remailer_addr; type=$type; key=$key has no assigned filehandle for $direction pings"), + Echolot::Log::warn ("$remailer_addr; type=$type; key=$key has no assigned filehandle for $direction pings."), return 0; seek($fh, 0, SEEK_SET) or - cluck("Cannot seek to start of $remailer_addr type $type key $key direction $direction pings: $!"), + Echolot::Log::warn("Cannot seek to start of $remailer_addr type $type key $key direction $direction pings: $!."), return 0; if ($direction eq 'out') { @@ -408,18 +408,17 @@ sub register_pingout($$$$) { my ($self, $remailer_addr, $type, $key, $sent_time) = @_; my $fh = $self->get_ping_fh($remailer_addr, $type, $key, 'out') or - cluck ("$remailer_addr; type=$type; key=$key has no assigned filehandle for out pings"), + Echolot::Log::cluck ("$remailer_addr; type=$type; key=$key has no assigned filehandle for out pings."), return 0; seek($fh, 0, SEEK_END) or - cluck("Cannot seek to end of $remailer_addr; type=$type; key=$key; out pings: $!"), + Echolot::Log::warn("Cannot seek to end of $remailer_addr; type=$type; key=$key; out pings: $!."), return 0; print($fh $sent_time."\n") or - cluck("Error when writing to $remailer_addr; type=$type; key=$key; out pings: $!"), + Echolot::Log::warn("Error when writing to $remailer_addr; type=$type; key=$key; out pings: $!."), return 0; $fh->flush(); - print "registering pingout at $sent_time for $remailer_addr ($type; $key)\n" - if Echolot::Config::get()->{'verbose'}; + Echolot::Log::info("registering pingout for $remailer_addr ($type; $key)."); return 1; }; @@ -428,44 +427,43 @@ sub register_pingdone($$$$$) { my ($self, $remailer_addr, $type, $key, $sent_time, $latency) = @_; defined ($self->{'METADATA'}->{'remailers'}->{$remailer_addr}) or - cluck ("$remailer_addr does not exist in Metadata"), + Echolot::Log::cluck ("$remailer_addr does not exist in Metadata."), return 0; my @outpings = $self->get_pings($remailer_addr, $type, $key, 'out'); my $origlen = scalar (@outpings); @outpings = grep { $_ != $sent_time } @outpings; ($origlen == scalar (@outpings)) and - warn("No ping outstanding for $remailer_addr, $key, $sent_time\n"), + Echolot::Log::info("No ping outstanding for $remailer_addr, $key, ".(scalar localtime $sent_time)."."), return 1; # write ping to done my $fh = $self->get_ping_fh($remailer_addr, $type, $key, 'done') or - cluck ("$remailer_addr; type=$type; key=$key has no assigned filehandle for done pings"), + Echolot::Log::cluck ("$remailer_addr; type=$type; key=$key has no assigned filehandle for done pings."), return 0; seek($fh, 0, SEEK_END) or - cluck("Cannot seek to end of $remailer_addr out pings: $!"), + Echolot::Log::warn("Cannot seek to end of $remailer_addr out pings: $!."), return 0; print($fh $sent_time." ".$latency."\n") or - cluck("Error when writing to $remailer_addr out pings: $!"), + Echolot::Log::warn("Error when writing to $remailer_addr out pings: $!."), return 0; $fh->flush(); # rewrite outstanding pings $fh = $self->get_ping_fh($remailer_addr, $type, $key, 'out') or - cluck ("$remailer_addr; type=$type; key=$key has no assigned filehandle for out pings"), + Echolot::Log::cluck ("$remailer_addr; type=$type; 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_addr; key=$key: $!"), + Echolot::Log::warn("Cannot seek to start of outgoing pings file for remailer $remailer_addr; key=$key: $!."), return 0; truncate($fh, 0) or - cluck("Cannot truncate outgoing pings file for remailer $remailer_addr; key=$key file to zero length: $!"), + Echolot::Log::warn("Cannot truncate outgoing pings file for remailer $remailer_addr; key=$key file to zero length: $!."), return 0; print($fh (join "\n", @outpings), (scalar @outpings ? "\n" : '') ) or - cluck("Error when writing to outgoing pings file for remailer $remailer_addr; key=$key file: $!"), + Echolot::Log::warn("Error when writing to outgoing pings file for remailer $remailer_addr; key=$key file: $!."), return 0; $fh->flush(); - print "registering pingdone from $sent_time with latency $latency for $remailer_addr ($type; $key)\n" - if Echolot::Config::get()->{'verbose'}; + Echolot::Log::info("registering pingdone from ".(scalar localtime $sent_time)." with latency $latency for $remailer_addr ($type; $key)."); return 1; }; @@ -473,7 +471,6 @@ sub register_pingdone($$$$$) { - sub add_prospective_address($$$$) { my ($self, $addr, $reason, $additional) = @_; @@ -542,7 +539,7 @@ sub get_address($$) { my ($self, $addr) = @_; defined ($self->{'METADATA'}->{'addresses'}->{$addr}) or - cluck ("$addr does not exist in Metadata"), + Echolot::Log::cluck ("$addr does not exist in Metadata."), return undef; my $result = { @@ -582,8 +579,7 @@ sub add_address($$) { # FIXME logging and such - print "Adding address $addr\n" - if Echolot::Config::get()->{'verbose'}; + Echolot::Log::info("Adding address $addr."); my $remailer = { id => $maxid + 1, @@ -607,25 +603,24 @@ sub set_stuff($@) { my $args = join(', ', @args); defined ($addr) or - cluck ("Could not get address for '$args'"), + Echolot::Log::cluck ("Could not get address for '$args'."), return 0; defined ($setting) or - cluck ("Could not get setting for '$args'"), + Echolot::Log::cluck ("Could not get setting for '$args'."), return 0; defined ($self->{'METADATA'}->{'addresses'}->{$addr}) or - cluck ("Address $addr does not exist"), + Echolot::Log::warn ("Address $addr does not exist."), return 0; if ($setting =~ /^(pingit|fetch|showit)=(on|off)$/) { my $option = $1; my $value = $2; - print "Setting $option to $value for $addr\n" - if Echolot::Config::get()->{'verbose'}; + Echolot::Log::info("Setting $option to $value for $addr"); $self->{'METADATA'}->{'addresses'}->{$addr}->{$option} = ($value eq 'on'); } else { - cluck ("Don't know what to do with '$setting' for $addr"), + Echolot::Log::warn ("Don't know what to do with '$setting' for $addr."), return 0; } @@ -641,7 +636,7 @@ sub get_address_by_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"); + Echolot::Log::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]; @@ -652,11 +647,11 @@ sub decrease_ttl($$) { my ($self, $address) = @_; defined ($self->{'METADATA'}->{'addresses'}->{$address}) or - cluck ("$address does not exist in Metadata address list"), + Echolot::Log::cluck ("$address does not exist in Metadata address list."), return 0; $self->{'METADATA'}->{'addresses'}->{$address}->{'ttl'} --; $self->{'METADATA'}->{'addresses'}->{$address}->{'status'} = 'ttl timeout', - warn("Remailer $address disabled: ttl expired\n"), + 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 @@ -668,14 +663,14 @@ sub decrease_resurrection_ttl($$) { my ($self, $address) = @_; defined ($self->{'METADATA'}->{'addresses'}->{$address}) or - cluck ("$address does not exist in Metadata address list"), + Echolot::Log::cluck ("$address does not exist in Metadata address list."), return 0; ($self->{'METADATA'}->{'addresses'}->{$address}->{'status'} eq 'ttl timeout') or - cluck ("$address is not in ttl timeout status"), + Echolot::Log::cluck ("$address is not in ttl timeout status."), return 0; $self->{'METADATA'}->{'addresses'}->{$address}->{'resurrection_ttl'} --; $self->{'METADATA'}->{'addresses'}->{$address}->{'status'} = 'dead', - warn("Remailer $address is dead\n"), + Echolot::Log::info("Remailer $address is dead."), if ($self->{'METADATA'}->{'addresses'}->{$address}->{'resurrection_ttl'} <= 0); # FIXME have proper logging $self->commit(); @@ -686,12 +681,12 @@ sub restore_ttl($$) { my ($self, $address) = @_; defined ($self->{'METADATA'}->{'addresses'}->{$address}) or - cluck ("$address does not exist in Metadata address list"), + Echolot::Log::cluck ("$address does not exist in Metadata address list."), return 0; defined ($self->{'METADATA'}->{'addresses'}->{$address}->{'status'}) or - cluck ("$address does exist in Metadata address list but does not have status defined"), + Echolot::Log::cluck ("$address does exist in Metadata address list but does not have status defined."), return 0; - warn("Remailer $address is alive and active again\n") + 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'}; delete $self->{'METADATA'}->{'addresses'}->{$address}->{'resurrection_ttl'}; @@ -706,15 +701,16 @@ sub not_a_remailer($$) { my ($self, $id) = @_; my $remailer = $self->get_address_by_id($id); - cluck("No remailer found for id '$id'"), return 0 unless defined $remailer; + defined $remailer or + Echolot::Log::cluck("No remailer found for id '$id'."), + return 0; my $address = $remailer->{'address'}; defined ($self->{'METADATA'}->{'addresses'}->{$address}) or - cluck ("$address does not exist in Metadata address list"), + Echolot::Log::cluck ("$address does not exist in Metadata address list."), return 0; $self->{'METADATA'}->{'addresses'}->{$address}->{'status'} = 'disabled by user reply: is not a remailer'; - print "Setting $id, $address to disabled by user reply\n" - if Echolot::Config::get()->{'verbose'}; + Echolot::Log::info("Setting $id, $address to disabled by user reply."); $self->commit(); return 1; @@ -744,20 +740,20 @@ sub set_caps($$$$$$;$) { } else { my $conf = $self->{'METADATA'}->{'remailers'}->{$address}->{'conf'}; if ($conf->{'last_update'} >= $timestamp) { - warn ("Stored data is already newer for remailer $nick\n"); + Echolot::Log::info("Stored data is already newer for remailer $nick."); return 1; }; $conf->{'last_update'} = $timestamp; if ($conf->{'nick'} ne $nick) { - warn ($conf->{'nick'}." was renamed to $nick\n"); + Echolot::Log::info($conf->{'nick'}." was renamed to $nick."); $conf->{'nick'} = $nick; }; if ($conf->{'capabilities'} ne $caps) { - warn ("$nick has a new caps string '$caps' old: '".$conf->{'capabilities'}."'\n"); + Echolot::Log::info("$nick has a new caps string '$caps' old: '".$conf->{'capabilities'}."'."); $conf->{'capabilities'} = $caps; }; if ($conf->{'type'} ne $type) { - warn ("$nick has a new type string '$type'\n"); + Echolot::Log::info("$nick has a new type string '$type'."); $conf->{'type'} = $type; }; }; @@ -775,7 +771,7 @@ sub set_key($$$$$$$$$) { my ($self, $type, $nick, $address, $key, $keyid, $version, $caps, $summary, $timestamp) = @_; (defined $address) or - cluck ("$address not defined in set_key"); + Echolot::Log::cluck ("$address not defined in set_key."); if (! defined $self->{'METADATA'}->{'remailers'}->{$address}) { $self->{'METADATA'}->{'remailers'}->{$address} = @@ -806,21 +802,21 @@ sub set_key($$$$$$$$$) { } else { my $keyref = $self->{'METADATA'}->{'remailers'}->{$address}->{'keys'}->{$type}->{$keyid}; if ($keyref->{'last_update'} >= $timestamp) { - warn ("Stored data is already newer for remailer $nick\n"); + Echolot::Log::info("Stored data is already newer for remailer $nick."); return 1; }; $keyref->{'last_update'} = $timestamp; if ($keyref->{'nick'} ne $nick) { - warn ("$nick has a new key nick string '$nick' old: '".$keyref->{'nick'}."'\n"); + Echolot::Log::info("$nick has a new key nick string '$nick' old: '".$keyref->{'nick'}."'."); $keyref->{'nick'} = $nick; }; if ($keyref->{'summary'} ne $summary) { - warn ("$nick has a new key summary string '$summary' old: '".$keyref->{'summary'}."'\n"); + Echolot::Log::info("$nick has a new key summary string '$summary' old: '".$keyref->{'summary'}."'."); $keyref->{'summary'} = $summary; }; if ($keyref->{'key'} ne $key) { - #warn ("$nick has a new key string '$key' old: '".$keyref->{'key'}."' - This probably should not happen\n"); - warn ("$nick has a new key string for same keyid $keyid\n"); + #Echolot::Log::info("$nick has a new key string '$key' old: '".$keyref->{'key'}."' - This probably should not happen."); + Echolot::Log::info("$nick has a new key string for same keyid $keyid."); $keyref->{'key'} = $key; }; }; @@ -856,7 +852,7 @@ sub get_types($$) { my ($self, $remailer) = @_; defined ($self->{'METADATA'}->{'remailers'}->{$remailer}) or - cluck ("$remailer does not exist in Metadata remailer list"), + Echolot::Log::cluck ("$remailer does not exist in Metadata remailer list."), return 0; return () unless defined $self->{'METADATA'}->{'remailers'}->{$remailer}->{'keys'}; @@ -868,7 +864,7 @@ sub has_type($$$) { my ($self, $remailer, $type) = @_; defined ($self->{'METADATA'}->{'remailers'}->{$remailer}) or - cluck ("$remailer does not exist in Metadata remailer list"), + Echolot::Log::cluck ("$remailer does not exist in Metadata remailer list."), return 0; return 0 unless defined $self->{'METADATA'}->{'remailers'}->{$remailer}->{'keys'}; @@ -881,11 +877,11 @@ sub get_keys($$) { my ($self, $remailer, $type) = @_; defined ($self->{'METADATA'}->{'remailers'}->{$remailer}) or - cluck ("$remailer does not exist in Metadata remailer list"), + Echolot::Log::cluck ("$remailer does not exist in Metadata remailer list."), return 0; defined ($self->{'METADATA'}->{'remailers'}->{$remailer}->{'keys'}->{$type}) or - cluck ("$remailer does not have type '$type' in Metadata remailer list"), + Echolot::Log::cluck ("$remailer does not have type '$type' in Metadata remailer list."), return 0; my @keys = keys %{$self->{'METADATA'}->{'remailers'}->{$remailer}->{'keys'}->{$type}}; @@ -896,15 +892,15 @@ sub get_key($$$$) { my ($self, $remailer, $type, $key) = @_; defined ($self->{'METADATA'}->{'remailers'}->{$remailer}) or - cluck ("$remailer does not exist in Metadata remailer list"), + Echolot::Log::cluck ("$remailer does not exist in Metadata remailer list."), return 0; defined ($self->{'METADATA'}->{'remailers'}->{$remailer}->{'keys'}->{$type}) or - cluck ("$remailer does not have type '$type' in Metadata remailer list"), + Echolot::Log::cluck ("$remailer does not have type '$type' in Metadata remailer list."), return 0; defined ($self->{'METADATA'}->{'remailers'}->{$remailer}->{'keys'}->{$type}->{$key}) or - cluck ("$remailer does not have key '$key' in type '$type' in Metadata remailer list"), + Echolot::Log::cluck ("$remailer does not have key '$key' in type '$type' in Metadata remailer list."), return 0; my %result = ( @@ -945,8 +941,7 @@ sub expire($) { for my $key ( keys %{$self->{'METADATA'}->{'remailers'}->{$remailer_addr}->{'keys'}->{$type}} ) { if ($self->{'METADATA'}->{'remailers'}->{$remailer_addr}->{'keys'}->{$type}->{$key}->{'last_update'} < $expire_keys) { # FIXME logging and such - print "Expiring $remailer_addr, key, $type, $key\n" - if Echolot::Config::get()->{'verbose'}; + Echolot::Log::info("Expiring $remailer_addr, key, $type, $key."); $self->pingdata_close_one($remailer_addr, $type, $key, 'delete'); delete $self->{'METADATA'}->{'remailers'}->{$remailer_addr}->{'keys'}->{$type}->{$key}; }; @@ -976,33 +971,33 @@ sub expire($) { # write ping to done my $fh = $self->get_ping_fh($remailer_addr, $type, $key, 'done') or - cluck ("$remailer_addr; type=$type; key=$key has no assigned filehandle for done pings"), + Echolot::Log::cluck ("$remailer_addr; type=$type; key=$key has no assigned filehandle for done pings."), return 0; seek($fh, 0, SEEK_SET) or - cluck("Cannot seek to start of $remailer_addr out pings: $!"), + Echolot::Log::warn("Cannot seek to start of $remailer_addr out pings: $!."), return 0; truncate($fh, 0) or - cluck("Cannot truncate done pings file for remailer $remailer_addr; key=$key file to zero length: $!"), + Echolot::Log::warn("Cannot truncate done pings file for remailer $remailer_addr; key=$key file to zero length: $!."), return 0; for my $done (@done) { print($fh $done->[0]." ".$done->[1]."\n") or - cluck("Error when writing to $remailer_addr out pings: $!"), + Echolot::Log::warn("Error when writing to $remailer_addr out pings: $!."), return 0; }; $fh->flush(); # rewrite outstanding pings $fh = $self->get_ping_fh($remailer_addr, $type, $key, 'out') or - cluck ("$remailer_addr; type=$type; key=$key has no assigned filehandle for out pings"), + Echolot::Log::cluck ("$remailer_addr; type=$type; 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_addr; key=$key: $!"), + Echolot::Log::warn("Cannot seek to start of outgoing pings file for remailer $remailer_addr; key=$key: $!."), return 0; truncate($fh, 0) or - cluck("Cannot truncate outgoing pings file for remailer $remailer_addr; key=$key file to zero length: $!"), + Echolot::Log::warn("Cannot truncate outgoing pings file for remailer $remailer_addr; key=$key file to zero length: $!."), return 0; print($fh (join "\n", @out), (scalar @out ? "\n" : '') ) or - cluck("Error when writing to outgoing pings file for remailer $remailer_addr; key=$key file: $!"), + Echolot::Log::warn("Error when writing to outgoing pings file for remailer $remailer_addr; key=$key file: $!."), return 0; $fh->flush(); }; @@ -1017,13 +1012,12 @@ sub expire($) { sub delete_remailer($$) { my ($self, $address) = @_; - print "Deleting remailer $address\n" - if Echolot::Config::get()->{'verbose'}; + Echolot::Log::info("Deleting remailer $address."); if (defined $self->{'METADATA'}->{'addresses'}->{$address}) { delete $self->{'METADATA'}->{'addresses'}->{$address} } else { - cluck("Remailer $address does not exist in addresses") + Echolot::Log::cluck("Remailer $address does not exist in addresses.") }; if (defined $self->{'METADATA'}->{'remailers'}->{$address}) { @@ -1045,14 +1039,13 @@ sub delete_remailer($$) { sub delete_remailercaps($$) { my ($self, $address) = @_; - print "Deleting conf for remailer $address\n" - if Echolot::Config::get()->{'verbose'}; + Echolot::Log::info("Deleting conf for remailer $address."); if (defined $self->{'METADATA'}->{'remailers'}->{$address}) { delete $self->{'METADATA'}->{'remailers'}->{$address}->{'conf'} if defined $self->{'METADATA'}->{'remailers'}->{$address}->{'conf'}; } else { - cluck("Remailer $address does not exist in remailers") + Echolot::Log::cluck("Remailer $address does not exist in remailers.") }; $self->commit(); diff --git a/Echolot/Thesaurus.pm b/Echolot/Thesaurus.pm index b32dd80..afce0d9 100644 --- a/Echolot/Thesaurus.pm +++ b/Echolot/Thesaurus.pm @@ -1,7 +1,7 @@ package Echolot::Thesaurus; # (c) 2002 Peter Palfrader -# $Id: Thesaurus.pm,v 1.13 2002/12/03 02:59:13 weasel Exp $ +# $Id: Thesaurus.pm,v 1.14 2003/01/14 05:25:35 weasel Exp $ # =pod @@ -17,8 +17,8 @@ This package provides necessary functions for the thesaurus. =cut use strict; -use Carp qw{cluck}; use English; +use Echolot::Log; sub save_thesaurus($$$) { @@ -27,13 +27,13 @@ sub save_thesaurus($$$) { 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; + Echolot::Log::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; + Echolot::Log::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': $!"), + Echolot::Log::warn ("Cannot open '$file': $!."), return 0; print F $data; close (F); @@ -46,7 +46,7 @@ sub build_thesaurus() { my $dir = Echolot::Config::get()->{'thesaurusdir'}; opendir(DIR, $dir) or - cluck ("Cannot open '$dir': $!"), + Echolot::Log::warn ("Cannot open '$dir': $!."), return 0; my @files = grep { ! /^\./ } readdir(DIR); closedir(DIR); @@ -69,9 +69,8 @@ sub build_thesaurus() { if ($mtime < $expire_date) { unlink ($dir.'/'.$filename) or - cluck("Cannot unlink expired $filename"); - print ("Expired thesaurus file $filename\n") if - Echolot::Config::get()->{'verbose'}; + Echolot::Log::warn("Cannot unlink expired $filename."); + Echolot::Log::info("Expired thesaurus file $filename."); next; }; diff --git a/Echolot/Tools.pm b/Echolot/Tools.pm index bf029f6..db9d785 100644 --- a/Echolot/Tools.pm +++ b/Echolot/Tools.pm @@ -1,7 +1,7 @@ package Echolot::Tools; # (c) 2002 Peter Palfrader -# $Id: Tools.pm,v 1.13 2002/12/18 17:32:46 weasel Exp $ +# $Id: Tools.pm,v 1.14 2003/01/14 05:25:35 weasel Exp $ # =pod @@ -16,10 +16,10 @@ Echolot::Tools - Tools for echolot =cut use strict; -use Carp qw{cluck}; use HTML::Template; use Digest::MD5 qw{}; use GnuPG::Interface; +use Echolot::Log; sub hash($) { my ($data) = @_; @@ -34,13 +34,13 @@ sub make_random($;%) { my $random; open (FH, Echolot::Config::get()->{'dev_random'}) or - cluck("Cannot open ".Echolot::Config::get()->{'dev_random'}." for reading: $!"), + Echolot::Log::warn("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'}.": $!"), + Echolot::Log::warn("Cannot read from ".Echolot::Config::get()->{'dev_random'}.": $!."), return 0; close (FH) or - cluck("Cannot close ".Echolot::Config::get()->{'dev_random'}.": $!"), + Echolot::Log::warn("Cannot close ".Echolot::Config::get()->{'dev_random'}.": $!."), return 0; $random = unpack('H*', $random) @@ -103,11 +103,11 @@ sub verify_address_tokens($) { my $delimiter = quotemeta( Echolot::Config::get()->{'recipient_delimiter'}); ($type, $timestamp, $received_hash) = $address =~ /$delimiter (.*) = (\d+) = ([0-9a-f]+) @/x or ($type, $timestamp, $received_hash) = $address =~ /\( (.*) = (\d+) = ([0-9a-f]+) \)/x or - cluck("Could not parse to header '$address'"), + Echolot::Log::debug("Could not parse to header '$address'."), return undef; } else { ($type, $timestamp, $received_hash) = $address =~ /\( (.*) = (\d+) = ([0-9a-f]+) \)/x or - cluck("Could not parse to header '$address'"), + Echolot::Log::debug("Could not parse to header '$address'."), return undef; }; @@ -116,7 +116,7 @@ sub verify_address_tokens($) { my $cut_hash = substr($hash, 0, Echolot::Config::get()->{'hash_len'}); ($cut_hash eq $received_hash) or - cluck("Hash mismatch in '$address'"), + Echolot::Log::info("Hash mismatch in '$address'."), return undef; return @@ -128,7 +128,7 @@ sub send_message(%) { my (%args) = @_; defined($args{'To'}) or - cluck ('No recipient address given'), + Echolot::Log::cluck ('No recipient address given.'), return 0; $args{'Subject'} = '(no subject)' unless (defined $args{'Subject'}); $args{'Body'} = '' unless (defined $args{'Body'}); @@ -146,7 +146,7 @@ sub send_message(%) { my @lines = map { $_."\n" } split (/\r?\n/, $args{'Body'}); open(SENDMAIL, '|'.Echolot::Config::get()->{'sendmail'}.' -f '.$args{'From_'}.' -t') - or cluck("Cannot run sendmail: $!"), + or Echolot::Log::warn("Cannot run sendmail: $!."), return 0; printf SENDMAIL "From: %s\n", $args{'From'}; printf SENDMAIL "To: %s\n", $args{'To'}; @@ -194,7 +194,7 @@ sub write_meta_information($%) { $file .= Echolot::Config::get()->{'meta_extension'}; open (F, ">$file") or - cluck ("Cannot open $file: $!"), + Echolot::Log::warn ("Cannot open $file: $!."), return 0; if (defined $data{'Expires'}) { my $date = date822($data{'Expires'}); @@ -227,19 +227,19 @@ sub write_HTML_file($$;$%) { $file .= '.html'; open(F, '>'.$file) or - cluck("Cannot open $file: $!\n"), + Echolot::Log::warn("Cannot open $file: $!."), return 0; print F $template->output() or - cluck("Cannot print to $file: $!\n"), + Echolot::Log::warn("Cannot print to $file: $!."), return 0; close (F) or - cluck("Cannot close $file: $!\n"), + Echolot::Log::warn("Cannot close $file: $!."), return 0; if (defined $expire) { write_meta_information($file, Expires => time + $expire) or - cluck ("Error while writing meta information for $file"), + Echolot::Log::debug ("Error while writing meta information for $file."), return 0; }; }; @@ -254,7 +254,7 @@ sub crypt_symmetrically($$) { my ($msg, $direction) = @_; ($direction eq 'encrypt' || $direction eq 'decrypt') or - cluck("Wrong argument direction '$direction' passed to crypt_symmetrically."), + Echolot::Log::cluck("Wrong argument direction '$direction' passed to crypt_symmetrically."), return undef; my $GnuPG = new GnuPG::Interface; @@ -293,13 +293,13 @@ sub crypt_symmetrically($$) { if ($direction eq 'encrypt') { (($status =~ /^^\[GNUPG:\] BEGIN_ENCRYPTION\s/m) && ($status =~ /^^\[GNUPG:\] END_ENCRYPTION\s/m)) or - cluck("GnuPG status '$status' didn't indicate message was encrypted correctly (stderr: $stderr). Returning\n"), + Echolot::Log::info("GnuPG status '$status' didn't indicate message was encrypted correctly (stderr: $stderr). Returning."), return undef; } elsif ($direction eq 'decrypt') { (($status =~ /^^\[GNUPG:\] BEGIN_DECRYPTION\s/m) && ($status =~ /^^\[GNUPG:\] DECRYPTION_OKAY\s/m) && ($status =~ /^^\[GNUPG:\] END_DECRYPTION\s/m)) or - cluck("GnuPG status '$status' didn't indicate message was decrypted correctly (stderr: $stderr). Returning\n"), + Echolot::Log::info("GnuPG status '$status' didn't indicate message was decrypted correctly (stderr: $stderr). Returning."), return undef; }; diff --git a/NEWS b/NEWS index d58b652..febab24 100644 --- a/NEWS +++ b/NEWS @@ -1,3 +1,8 @@ +Changes in + * first go at sane loggin + fixme: new requirements + fixme: make logging configureable + Changes in version 2.0.8 - 2003-01-13 * Work around a bug that let pingd die in certain random cases when dealing with unuseable PGP keys (like expired keys). diff --git a/pingd b/pingd index 4132d26..433a2ed 100755 --- a/pingd +++ b/pingd @@ -3,7 +3,7 @@ $| = 1; # (c) 2002 Peter Palfrader -# $Id: pingd,v 1.86 2003/01/13 14:29:15 weasel Exp $ +# $Id: pingd,v 1.87 2003/01/14 05:25:34 weasel Exp $ # =pod @@ -289,6 +289,7 @@ use Echolot::Pinger; use Echolot::Stats; use Echolot::Commands; use Echolot::Thesaurus; +use Echolot::Log; use POSIX qw(setsid); delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'}; @@ -301,7 +302,7 @@ my $redirected_stdio = 0; sub setSigHandlers() { $SIG{'HUP'} = sub { - print "Got SIGHUP. scheduling readcommands\n"; + Echolot::Log::info("Got SIGHUP. scheduling readcommands"); Echolot::Globals::get()->{'scheduler'}->schedule('readcommands', 0, time() ); if ($redirected_stdio) { close STDOUT; @@ -311,15 +312,15 @@ sub setSigHandlers() { }; }; $SIG{'INT'} = sub { - print "Got SIGINT. scheduling exit\n"; + Echolot::Log::info("Got SIGINT. scheduling exit"); Echolot::Globals::get()->{'scheduler'}->schedule('exit', 0, time() ); }; $SIG{'QUIT'} = sub { - print "Got SIGQUIT. scheduling exit\n"; + Echolot::Log::info("Got SIGINT. scheduling exit"); Echolot::Globals::get()->{'scheduler'}->schedule('exit', 0, time() ); }; $SIG{'TERM'} = sub { - print "Got SIGTERM. scheduling exit\n"; + Echolot::Log::info("Got SIGINT. scheduling exit"); Echolot::Globals::get()->{'scheduler'}->schedule('exit', 0, time() ); }; }; @@ -448,10 +449,10 @@ sub pid_exists() { sub daemon_run($) { my ($process) = @_; - die ("Pidfile '".Echolot::Config::get()->{'pidfile'}."' exists\n") + Echolot::Log::logdie("Pidfile '".Echolot::Config::get()->{'pidfile'}."' exists\n") if pid_exists(); open (PIDFILE, '>'.Echolot::Config::get()->{'pidfile'}) or - confess ("Cannot open pidfile '".Echolot::Config::get()->{'pidfile'}."': $!\n"); + Echolot::Log::logdie("Cannot open pidfile '".Echolot::Config::get()->{'pidfile'}."': $!"); print PIDFILE "$PROCESS_ID ".Echolot::Globals::get()->{'hostname'}." ".time()."\n"; close PIDFILE; @@ -653,11 +654,14 @@ if ($COMMAND eq 'add' || $COMMAND eq 'delete') { } elsif ($COMMAND eq 'stop') { daemon_stop(); } elsif ($COMMAND eq 'start') { + # FIXME: remove stale pid files die ("Pidfile '".Echolot::Config::get()->{'pidfile'}."' exists\n") if pid_exists(); + Echolot::Log::init(); make_dirs(); if ($params->{'detach'}) { print "Detaching.\n" unless ($params->{'quiet'}); + Echolot::Log::debug("Detaching."); exit(0) if (fork()); POSIX::setsid(); exit(0) if (fork()); @@ -665,9 +669,9 @@ if ($COMMAND eq 'add' || $COMMAND eq 'delete') { open (STDERR, ">&STDOUT") or die ("Cannot dup STDOUT as STDERR\n"); open (STDIN , "{'process'} ); - print "done at ".scalar localtime().".\n"; + Echolot::Log::info "Shutdown complete."; } else { daemon_run( $params->{'process'} ); }; -- cgit v1.2.3