#!/usr/bin/perl

use strict;

my $subscriptions = '/home/mylist/subscriptions';
my $debugfile = "/tmp/mylist.log";
my $maxdebugsize = 100000;
my $dropspam = 1;
my $mail = '/usr/bin/mail';
my $spool = '/home/mylist/spool';
my $maxmsg = 100;

sub error {
    debug ("FATAL: ", @_);
    die ("$0: FATAL ", @_);
}

my $_debugof;
sub debug {
    unlink ($debugfile) if ( (stat($debugfile))[7] > $maxdebugsize );
    if (! -f $debugfile) {
	open (my $of, ">$debugfile")
	  or error ("Cannot write debug file '$debugfile': $!\n");
	close ($of);
	chmod (0666, $debugfile)
	  or error ("Cannot chmod/666 $debugfile: $!\n");
    }
    if (! $_debugof) {
	open ($_debugof, ">>$debugfile") or return;
    }
    print $_debugof (scalar(localtime()), ' ', @_);
}

sub collectmsg() {
    my %info;
    my $inhdr = 1;
    while (my $line = <STDIN>) {
	debug ("Received: $line");
	if ($inhdr) {
	    my @parts = split (/\s+/, $line);
	    if ($parts[0] =~ /From:/i) {
		$info{from} = $line;
		$info{from} =~ s/^From:\s*//i;
		chomp ($info{from});
	    } elsif ($parts[0] =~ /X-Spam-Status:/i) {
		$info{spam} = 1 if ($parts[1] =~ /yes/i);
	    } elsif ($parts[0] =~ /Subject:/i) {
		$info{subject} = $line;
		$info{subject} =~ s/^Subject:\s*//i;
		chomp ($info{subject});
	    } elsif ($line =~ /^\s*$/) {
		$inhdr = undef;
	    }
	} else {
	    $info{body} .= $line;
	}
    }
    for my $l (split (/\n/, $info{body})) {
	debug ("Body: $l\n");
    }
    return (%info);
}

sub process {
    my %info = @_;
    my $subject = $info{subject};
    $subject = 'No subject' unless ($subject);
    $subject =~ s/\'//g;
    my $adr = '';
    for my $a (subscribers()) {
	$adr .= ' ' if ($adr ne '');
	$adr .= "'$a'";
    }
    
    debug ("About to spool for $adr\n");
    my $subarg = "[$info{from}] $subject";
    $subarg =~ s/['"]//g;
    my $cmd =
      "$mail -s '$subarg' $adr";
    debug ("Mail cmd: $cmd\n");

    my $spoolname = "$spool/$$";
    open (my $of, ">$spoolname")
      or error ("Cannot write $spoolname: $!\n");
    print $of ("$cmd\n$info{body}");
    close ($of);
    chmod (0666, $spoolname)
      or error ("Cannot chmod/666 $spoolname: $!\n");
}

my @_subscribers;
sub subscribers() {

    return (@_subscribers) if ($#_subscribers > -1);
    
    open (my $if, $subscriptions)
      or error ("Cannot read subscriptions from '$subscriptions'\n");
    while (my $line = <$if>) {
	next if ($line =~ /^#/ or $line =~ /^\s*$/);
	chomp ($line);
	push (@_subscribers, $line);
    }
    debug ("List subscribers: @_subscribers\n");
    return (@_subscribers);
}

sub do_accept() {
    debug ("Start of accept\n");
    my %info = collectmsg();
    if ($info{spam} and $dropspam) {
	debug ("Message marked as spam, dropping\n");
    } elsif ($info{subject} =~ /undelivered mail/i or
	     $info{from} =~ /mailer/i or
	     $info{from} =~ /daemon/) {
	debug ("Message probably from a mail server, dropping\n");
    } else {
	debug ("Checking whether '$info{from}' is a subscriber\n");
	my $found = undef;
	for my $p (subscribers()) {
	    my $address;
	    for my $part (split (/\s+/, $p)) {
		if ($part =~ /\@/) {
		    $address = $part;
		    $address =~ s/[<>]//g;
		    last;
		}
	    }
	    debug ("Subscriber '$p', e-mail '$address'\n");
	    if ($info{from} =~ /$address/i) {
		$found = 1;
		debug ("Matches! '$p' is a subscriber\n");
		last;
	    }
	}
	if (! $found) {
	    debug ("Message is from '$info{from}', not a subscriber, dropping\n");
	} else {
	    debug ("Processing message from $info{from}\n");
	    process (%info);
	}
    }
    debug ("End of accept\n\n");
}

sub do_distribute() {
    debug ("Start of distribute\n");
    chdir ($spool) or error ("$0: Cannot chdir to $spool: $!\n");
    my @files = glob ('*');
    error ("Too many messages to handle (exceeds $maxmsg)\n")
      if ($#files >= $maxmsg) ;
    for my $f (@files) {
	debug ("About to distribute message $f\n");
	open (my $if, $f) or error ("Cannot read $f: $!\n");
	my $cmd = <$if>;
	chomp ($cmd);
	debug ("Mail command: '$cmd'\n");
	open (my $of, "|$cmd") or error ("Cannot start '$cmd': $!\n");
	while (my $line = <$if>) {
	    print $of ($line);
	}
	close ($of) or error ("Command '$cmd' stopped with error\n");
	close ($if);
	unlink ($f) or error ("Cannot unlink '$f': $!\n");
    }
    debug ("End of distribute\n\n");
}   

# Main starts here
if ($ARGV[0] eq 'accept') {
    do_accept();
} elsif ($ARGV[0] eq 'distribute') {
    do_distribute();
} else {
    die ("$0: arguments accept or distribute accepted\n");
}