summaryrefslogtreecommitdiff
path: root/Echolot
diff options
context:
space:
mode:
Diffstat (limited to 'Echolot')
-rw-r--r--Echolot/Commands.pm26
-rw-r--r--Echolot/Conf.pm60
-rw-r--r--Echolot/Config.pm5
-rw-r--r--Echolot/Mailin.pm48
-rw-r--r--Echolot/Pinger.pm12
-rw-r--r--Echolot/Pinger/CPunk.pm34
-rw-r--r--Echolot/Pinger/Mix.pm18
-rw-r--r--Echolot/Scheduler.pm20
-rw-r--r--Echolot/Stats.pm63
-rw-r--r--Echolot/Storage/File.pm201
-rw-r--r--Echolot/Thesaurus.pm17
-rw-r--r--Echolot/Tools.pm36
12 files changed, 265 insertions, 275 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 <peter@palfrader.org>
-# $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 <peter@palfrader.org>
-# $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 <peter@palfrader.org>
-# $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 <peter@palfrader.org>
-# $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 = <FH>;
my $body = join('', <FH>);
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(<FH>) {
@@ -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 = <FH>;
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 <peter@palfrader.org>
-# $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 <peter@palfrader.org>
-# $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 '', <F>;
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 <peter@palfrader.org>
-# $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 <peter@palfrader.org>
-# $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 <peter@palfrader.org>
-# $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 = <F>;
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 <peter@palfrader.org>
-# $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<new> (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 <peter@palfrader.org>
-# $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 <peter@palfrader.org>
-# $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;
};
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-01 14:43:43 +0000