summaryrefslogtreecommitdiff
path: root/Echolot
diff options
context:
space:
mode:
Diffstat (limited to 'Echolot')
-rw-r--r--Echolot/Config.pm4
-rw-r--r--Echolot/Mailin.pm173
2 files changed, 144 insertions, 33 deletions
diff --git a/Echolot/Config.pm b/Echolot/Config.pm
index ca4fb67..62a1c00 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.37 2002/08/11 14:57:23 weasel Exp $
+# $Id: Config.pm,v 1.38 2002/08/12 03:06:53 weasel Exp $
#
=pod
@@ -105,7 +105,7 @@ sub init($) {
expire_thesaurus => 21*24*60*60, # 21 days
# Directories and files
- mailindir => 'mail',
+ mailin => 'mail',
mailerrordir => 'mail-errors',
resultdir => 'results',
thesaurusdir => 'results/thesaurus',
diff --git a/Echolot/Mailin.pm b/Echolot/Mailin.pm
index 3904beb..097a42f 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.6 2002/07/16 02:48:57 weasel Exp $
+# $Id: Mailin.pm,v 1.7 2002/08/12 03:06:53 weasel Exp $
#
=pod
@@ -19,6 +19,10 @@ use strict;
use Carp qw{cluck};
use English;
use Echolot::Globals;
+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)
+
sub make_sane_name() {
my $result = time().'.'.$PROCESS_ID.'_'.Echolot::Globals::get()->{'internal_counter'}++.'.'.Echolot::Globals::get()->{'hostname'};
@@ -30,10 +34,12 @@ sub sane_move($$) {
my $link_success = link($from, $to);
$link_success or
- cluck("Cannot link $from to $to: $! - Trying move"),
- rename($from, $to) or
- cluck("Renaming $from to $to didn't work either: $!"),
- return 0;
+ cluck("Cannot link $from to $to: $!"),
+ return 0;
+ #- Trying move"),
+ #rename($from, $to) or
+ # cluck("Renaming $from to $to didn't work either: $!"),
+ # return 0;
$link_success && (unlink($from) or
cluck("Cannot unlink $from: $!") );
@@ -41,27 +47,26 @@ sub sane_move($$) {
};
sub handle($) {
- my ($file) = @_;
+ my ($lines) = @_;
- open (FH, $file) or
- cluck("Cannot open file $file: $!"),
- return 0;
-
+ my $i=0;
+ my $body = '';
my $to;
- while (<FH>) {
- chomp;
- last if $_ eq '';
+ for ( ; $i < scalar @$lines; $i++) {
+ my $line = $lines->[$i];
+ chomp($line);
+ last if $line eq '';
- if (m/^To:\s*(.*?)\s*$/) {
+ if ($line =~ m/^To:\s*(.*?)\s*$/) {
$to = $1;
};
};
- my $body = join('', <FH>);
- close (FH) or
- cluck("Cannot close file $file: $!");
+ for ( ; $i < scalar @$lines; $i++) {
+ $body .= $lines->[$i];
+ };
(defined $to) or
- cluck("No To header found in $file"),
+ cluck("No To header found in mail"),
return 0;
my $address_result = Echolot::Tools::verify_address_tokens($to) or
@@ -83,29 +88,135 @@ sub handle($) {
return 0;
};
-sub process() {
- my $mailindir = Echolot::Config::get()->{'mailindir'};
- my $targetdir = Echolot::Config::get()->{'mailerrordir'};
- my @files = ();
+sub handle_file($) {
+ my ($file) = @_;
+
+ open (FH, $file) or
+ cluck("Cannot open file $file: $!"),
+ return 0;
+ my @lines = <FH>;
+ my $body = join('', <FH>);
+ close (FH) or
+ cluck("Cannot close file $file: $!");
+
+ return handle(\@lines);
+};
+
+sub read_mbox($) {
+ my ($file) = @_;
+
+ my @mail;
+ my $mail = [];
+ my $blank = 1;
+
+ open(FH, '<+', $file) or
+ cluck("cannot open '$file': $!\n"),
+ return undef;
+ flock(FH, LOCK_EX) or
+ cluck("cannot gain lock on '$file': $!\n"),
+ return undef;
+
+ while(<FH>) {
+ if($blank && /\AFrom .*\d{4}/) {
+ push(@mail, $mail) if scalar(@{$mail});
+ $mail = [ $_ ];
+ $blank = 0;
+ } else {
+ $blank = m#\A\Z# ? 1 : 0;
+ push @$mail, $_;
+ }
+ }
+ push(@mail, $mail) if scalar(@{$mail});
+
+ seek(FH, 0, SEEK_SET) or
+ cluck("cannot seek to start of '$file': $!\n"),
+ return undef;
+ truncate(FH, 0) or
+ cluck("cannot truncate '$file' to zero size: $!\n"),
+ return undef;
+ flock(FH, LOCK_UN) or
+ cluck("cannot release lock on '$file': $!\n"),
+ return undef;
+ close(FH);
+
+ return \@mail;
+}
+
+sub read_maildir($) {
+ my ($dir) = @_;
+
+ my @mail;
+
+ my @files;
for my $sub (qw{new cur}) {
- opendir(DIR, $mailindir.'/'.$sub) or
- cluck("Cannot open direcotry '$mailindir/$sub': $!"),
+ opendir(DIR, $dir.'/'.$sub) or
+ cluck("Cannot open direcotry '$dir/$sub': $!"),
return 0;
push @files, map { $sub.'/'.$_ } grep { ! /^\./ } readdir(DIR);
closedir(DIR) or
- cluck("Cannot close direcotry '$mailindir/$sub': $!");
+ cluck("Cannot close direcotry '$dir/$sub': $!");
};
- Echolot::Globals::get()->{'storage'}->delay_commit();
+
for my $file (@files) {
$file =~ /^(.*)$/s or
confess("I really should match here. ('$file').");
$file = $1;
- if (handle($mailindir.'/'.$file)) {
- unlink($mailindir.'/'.$file);
- } else {
+
+ my $mail = [];
+ open(FH, $dir.'/'.$file) or
+ cluck("cannot open '$dir/$file': $!\n"),
+ return undef;
+ @$mail = <FH>;
+ close(FH);
+
+ push @mail, $mail;
+ };
+
+ for my $file (@files) {
+ unlink $dir.'/'.$file or
+ cluck("cannot unlink '$dir/$file': $!\n");
+ };
+
+
+ return \@mail;
+}
+
+sub storemail($$) {
+ my ($path, $mail) = @_;
+
+ my $tmpname = $path.'/tmp/'.make_sane_name();
+ open (F, '>'.$tmpname) or
+ cluck("Cannot open $tmpname: $!"),
+ return undef;
+ print F join ('', @$mail);
+ close F;
+
+ my $i;
+ for ($i = 0; $i < 5; $i++ ) {
+ my $targetname = $path.'/cur/'.make_sane_name();
+ sane_move($tmpname, $targetname) or
+ sleep 1, next;
+ last;
+ };
+
+ return undef if ($i == 5);
+ return 1;
+};
+
+sub process() {
+ my $inmail = Echolot::Config::get()->{'mailin'};
+ my $mailerrordir = Echolot::Config::get()->{'mailerrordir'};
+
+ my $mails = (-d $inmail) ?
+ read_maildir($inmail) :
+ ( ( -e $inmail ) ? read_mbox($inmail) : [] );
+
+ Echolot::Globals::get()->{'storage'}->delay_commit();
+ for my $mail (@$mails) {
+ unless (handle($mail)) {
my $name = make_sane_name();
- sane_move($mailindir.'/'.$file, $targetdir.'/new/'.$name) or
- cluck("Sane moving of $mailindir/$file to $targetdir/new/$name failed");
+ storemail($mailerrordir, $mail) or
+ cluck("Could not store a mail");
};
};
Echolot::Globals::get()->{'storage'}->enable_commit();