#!/usr/bin/perl -w
# ==================================================================
# Gossamer Mail - enhanced email management system
#
#   Website  : http://gossamer-threads.com/
#   Support  : http://gossamer-threads.com/scripts/support/
#   Revision : $Id: outgoing.pl,v 1.27 2001/11/01 20:23:08 alex Exp $
#
# Copyright (c) 2001 Gossamer Threads Inc.  All Rights Reserved.
# Redistribution in part or in whole strictly prohibited. Please
# see LICENSE file for full details.
# ==================================================================

# Pragmas
    use strict;
    use lib '../admin';
    use vars qw/$CLEANUP $VALID_CHARACTERS/;

# Internal Modules
    use GMail qw/:objects :folders ADMIN/;
    use GMail::Admin;
    use GMail::Messages;
    use GMail::Options::Filters;
    use GMail::Options::Spam;
    use GMail::Folders;
    use GMail::Auth;
    use GMail::User;

# GT modules
    use GT::TempFile;
    use GT::Mail;
    use GT::Mail::Parse;

# System modules
    use Fcntl qw/:DEFAULT :flock/;

# Error handling
    local $SIG{__DIE__} = \&fatal;

# Begin
    $PLG->dispatch('outgoing::main', \&main);


sub main {
# ------------------------------------------------------------------------
# Clear ENV for -T checks.
#
    foreach my $key (keys %ENV) {
        next if ($key eq 'REQUEST_METHOD');
        $ENV{$key} = '';
    }

# Load config file
    $PLG->dispatch('GMail::Config::load_config', sub { $CFG->load_config });

# -v argument for verbose debugging, or if called via web.
    if (($ARGV[0] and $ARGV[0] eq '-v') or $ENV{REQUEST_METHOD}) {
        $CFG->{debug} = 1;
        shift @ARGV;
    }

# Called from the web
    if ($ENV{REQUEST_METHOD}) {
        $| = 1;
        print $IN->header, "<pre>";
        $CFG->{debug} = 1;
        open STDERR, ">&STDOUT" or die "Couldn't redirect err to out!";
        select((select(STDERR), $|=1)[0]);
    }

# Give our temp module a place to put tmp files
    $ENV{GT_TMPDIR} = "$CFG->{location}->{path}->{data}/tmp";

# For class debugging
    $GMail::DEBUG = $CFG->{debug} if $CFG->{debug};
    

# Load all template specific files.
    my $t = GMail->template_set || 'default';
    $CFG->load_template_set($t);
    
# Load admin user
    $PLG->dispatch('GMail::Config::load_user', sub { $USER->load_user(@_) }, ADMIN);
    $PLG->dispatch('GMail::Config::check_create', sub { $USER->check_create });

    my $dir = "$CFG->{location}->{path}->{data}/users/ADMIN";

# Do any bounces that need to be done.
    my $bounce_dir = "$dir/bounce";
    -d $bounce_dir or GMail->mkdir($bounce_dir);
    opendir DIR, $bounce_dir or die "Could not open $bounce_dir; Reason ($!)";
    my @bounce_files = map "$bounce_dir/$_", grep { /\d+/ and -f "$bounce_dir/$_" } readdir DIR;
    my $bounced = @bounce_files;
    $PLG->dispatch('outgoing::send_bounces', \&send_bounces, @bounce_files) if @bounce_files;

# Do any replies that need to be done.
    my $reply_dir = "$dir/reply";
    -d $reply_dir or GMail->mkdir($reply_dir);
    opendir DIR, $reply_dir or die "Could not open $reply_dir; Reason ($!)";
    my @reply_files = map "$reply_dir/$_", grep { /^\d+$/ and -f "$reply_dir/$_" } readdir DIR;
    my $replies = @reply_files;
    $PLG->dispatch('outgoing::send_replies', \&send_replies, @reply_files) if @reply_files;

# Do any forwards that need to be done.
    my $forward_dir = "$dir/forward";
    -d $forward_dir or GMail->mkdir($forward_dir);
    opendir DIR, $forward_dir or die "Could not open $forward_dir; Reason ($!)";
    my @forward_files = map "$forward_dir/$_", grep { /\d+/ and -f "$forward_dir/$_" } readdir DIR;
    my $forwards = @forward_files;
    $PLG->dispatch('outgoing::send_forwards', \&send_forwards, @forward_files) if @forward_files;

    if ($CFG->{debug}) {
        GMail->debug("$bounced message(s) bounced.");
        GMail->debug("$replies message(s) replied.");
        GMail->debug("$forwards message(s) forwarded.");
    }
}

sub send_bounces {
# ------------------------------------------------------------------------
# Takes a list of files and bounces them.
#
    my @files = @_;

    FILE: for my $file (@files) {

        GMail->debug("Parsing bounce email ($file)") if $CFG->{debug};

        my $m = new GT::Mail(debug => $CFG->{debug});
        $file =~ /^(.+)$/ and $file = $1; # Taint checks
        my $head;
        if (!$CFG->{email}->{bounce}->{no_attach}) {
            $head = $m->parse($file);
        }
        else {
            $head = $m->parse_head($file);
        }
        unlink($file) or die "Could not unlink ($file); Reason: ($!)\n";
        my %opts = ();
        my $reason = $head->delete('X-Reason');
        for ($head->get) { my $val = $head->get($_); $val =~ s/\r?\n//g; $opts{lc($_)} = $val }
        $opts{header} = $head->header_as_string;
        $opts{reason} = $reason;
        my $vars = GMail->get_tags(\%opts);
        my $t    = GMail->template_set || 'default';
        my $mail = GMail->parse_message("$CFG->{location}->{path}->{data}/templates/$t/bounce.eml", @{$vars});
        my $top  = $mail->top_part;

# Bounces should go to return path first.    
        my $to = $head->get('Return-Path') || $head->get('from') || $head->get('reply-to') || next;
        if ($to =~ /<\s*>/) {
            GMail->debug ("No return path, not bouncing.") if ($CFG->{debug});
            next FILE;
        }
        GMail->debug("Setting 'To' line to ($to)") if $CFG->{debug};
        $mail->top_part->set( 'Return-Path' => '<>' );
        $mail->top_part->set( to => $to );
        unless ($CFG->{email}->{bounce}->{no_attach}) {
            $mail->top_part->set('Content-Type' => 'multipart/mixed');
            $mail->attach({
                'Content-Type' => 'message/rfc822',
                msg            => $m->as_string,
                encoding       => '-guess',
            });
        }

# Detection of loops
        my $loop = $head->get('X-GLoop') || $head->get('X-Loop');
        if ($loop) {
            GMail->debug('Loop detected. Not sending');
            next FILE;
        }
        if (bad_to($head)) {
            GMail->debug("Bad address, possible mail loop detected. Skipping") if $CFG->{debug};
            next FILE; 
        }

        $top->set('X-GLoop' => 'Gossamer Mail');
        $top->set('X-Loop'  => 'Gossamer Mail');
        if ($CFG->{email}->{out} eq 'smtp') {
            $top->set('Message-Id' => '<GMail.' . time . '.' . $$ . rand(10000) . '@' . $CFG->{email}->{smtp} . '>');
        }
        $mail->send(($CFG->{email}->{out} eq 'smtp' ? (smtp => $CFG->{email}->{smtp}) : (sendmail => $CFG->{email}->{sendmail})));
    }
}

sub send_replies {
# ------------------------------------------------------------------------
# Takes a list of files to reply and send them.
#
    my @files = @_;

    FILE: for my $file (@files) {
        GMail->debug("Parsing reply email ($file)") if $CFG->{debug};

# Maybe add user defined tags here for forwards later
        my $mail = new GT::Mail(debug => $CFG->{debug});
        $file =~ /^(.+)$/ and $file = $1; # Taint checks
        my $head = $mail->parse($file);
        unlink($file) or die "Could not unlink ($file); Reason: ($!)\n";

# Detection of loops
        my $loop = $head->get('X-GLoop') || $head->get('X-Loop');
        if ($loop) {
            GMail->debug('Loop detected. Not sending');
            next FILE;
        }
        if (bad_to($head)) {
            GMail->debug("Bad address, possible mail loop detected. Skipping") if $CFG->{debug};
            next FILE;
        }
        
# Add any admin header fields
        if (-e "$CFG->{location}->{path}->{data}/admin/defaults/header.txt" and -s _) {
            local $/;
            my $head = \do { local *FH; *FH };
            open $head, "$CFG->{location}->{path}->{data}/admin/defaults/header.txt" 
                or die "Could not open $CFG->{location}->{path}->{data}/admin/defaults/header.txt for reading; Reason: $!";
            for (split /\r?\n/, <$head>) {
                my ($k, $v) = split /\s*:\s*/;
                next unless (defined $k and length $k);
                next unless (defined $v and length $v);
                $head->set($k => $v);
            }
            close $head;
        }

# Add any messsage the admin want at the end
        $file = "";
        my $part;
        my @parts = $head->parts;
        @parts = ($head) unless @parts;
        for (@parts) {
            my $t = $_->get('content-type') || $_->mime_type;
            next unless lc($t) =~ /((?:html)|(?:text))/;
            my $type = $1;
            $file = ($type eq 'text') ? 'footer.txt' : 'footer.htm';
            $part = $_;
            last;
        }
        if ($part and -e "$CFG->{location}->{path}->{data}/admin/defaults/$file") {
            local $/;
            my $add  = \do { local *FH; *FH };
            open $add, "$CFG->{location}->{path}->{data}/admin/defaults/$file" 
                or die "Could not open $CFG->{location}->{path}->{data}/admin/defaults/$file for reading; Reason: $!";
            my $body = $part->body_as_string;
            if ($file eq 'footer.htm') {
                $body =~ s,</body>,,gi;
                $body =~ s,</html>,,gi;
            }
            $body .= <$add>;
            close $add;
            $part->body_data($body);
        }
        $head->set('X-GLoop' => 'Gossamer Mail');
        $head->set('X-Loop'  => 'Gossamer Mail');
        if ($CFG->{email}->{out} eq 'smtp') {
            $head->set('Message-Id' => '<GMail.' . time . '.' . $$ . rand(10000) . '@' . $CFG->{email}->{smtp} . '>');
        }
        $mail->send(($CFG->{email}->{out} eq 'smtp' ? (smtp => $CFG->{email}->{smtp}) : (sendmail => $CFG->{email}->{sendmail})));
    }
}

sub send_forwards {
# ------------------------------------------------------------------------
# Takes a list of files to forward and send them.
#
    my @files = @_;

    FILE: for my $file (@files) {
        GMail->debug("Parsing forward email ($file)") if $CFG->{debug};

# Maybe add user defined tags here for forwards later
        my $mail = new GT::Mail(debug => $CFG->{debug});
        $file =~ /^(.+)$/ and $file = $1; # Taint Check
        my $head = $mail->parse($file);
        unlink($file) or die "Could not unlink ($file); Reason: ($!)\n";

# Detection of loops
        my $loop = $head->get('X-GLoop');
        if ($loop and $loop eq 'Gossamer Mail') {
            GMail->debug('Loop detected. Not sending');
            next FILE;
        }

# Add any admin header fields
        if (-e "$CFG->{location}->{path}->{data}/admin/defaults/header.txt" and -s _) {
            local $/;
            my $head = \do { local *FH; *FH };
            open $head, "$CFG->{location}->{path}->{data}/admin/defaults/header.txt" 
                or die "Could not open $CFG->{location}->{path}->{data}/admin/defaults/header.txt for reading; Reason: $!";
            for (split /\r?\n/, <$head>) {
                my ($k, $v) = split /\s*:\s*/;
                next unless (defined $k and length $k);
                next unless (defined $v and length $v);
                $head->set($k => $v);
            }
            close $head;
        }

# Add any messsage the admin want at the end
        $file = "";
        my ($part);
        my @parts = $head->parts;
        @parts = ($head) unless @parts;
        for (@parts) {
            my $t = $_->get('content-type') || $_->mime_type;
            next unless lc($t) =~ /((?:html)|(?:text))/;
            my $type = $1;
            $file = ($type eq 'text') ? 'footer.txt' : 'footer.htm';
            $part = $_;
            last;
        }
        if ($part and -e "$CFG->{location}->{path}->{data}/admin/defaults/$file") {
            local $/;
            my $add  = \do { local *FH; *FH };
            open $add, "$CFG->{location}->{path}->{data}/admin/defaults/$file" 
                or die "Could not open $CFG->{location}->{path}->{data}/admin/defaults/$file for reading; Reason: $!";
            my $body = $part->body_as_string;
            if ($file eq 'footer.htm') {
                $body =~ s,</body>,,gi;
                $body =~ s,</html>,,gi;
            }
            $body .= <$add>;
            close $add;
            $part->body_data($body);
        }
        $head->set('X-GLoop' => 'Gossamer Mail');
        $head->set('X-Loop'  => 'Gossamer Mail');

# Remove any previous CC or BCCs
        $head->delete ('CC');
        $head->delete ('BCC');
        if ($CFG->{email}->{out} eq 'smtp') {
            $head->set('Message-Id' => '<GMail.' . time . '.' . $$ . rand(10000) . '@' . $CFG->{email}->{smtp} . '>');
        }
        $mail->send(($CFG->{email}->{out} eq 'smtp' ? (smtp => $CFG->{email}->{smtp}) : (sendmail => $CFG->{email}->{sendmail})));
    }
}

sub bad_to {
# ------------------------------------------------------------------------
# Takes a head object of an email being sent. If any of the to lines have
# the same email address as the from line returns 1 else returns 0.
#
    my ($head) = @_;

    for my $to ($head->split_field('to'), $head->split_field('cc'), $head->split_field('bcc')) {
        next unless $to;
        $to =~ /([^<>"\s]+\@[^>]+)/ and $to = $1;
        $to or next;
        for my $from ($head->split_field('from'), $head->split_field('reply-to')) {
            next unless $from;
            $from =~ /([^<>"\s]+\@[^>]+)/ and $from = $1;
            $from or next;
            if ($from eq $to) { return 1 }
        }
    }
    return 0;
}

sub fatal {
# ----------------------------------------------------------------------------
# Fatal error formatted for terminal
    my ($msg) = @_;
    die $msg if (GT::Base->in_eval());    # Don't do anything if we are in eval.

# Use a custom header if one is defined.
        print qq|A fatal error has occured:
    $msg
|;

    if ($CFG and $CFG->{debug}) {
        my $env = GMail->environment();
        $env =~ s/<\/?B>//gi;
        $env =~ s/<\/?PRE>//gi;
        print $env;
    }
    else {
        print "Please enable debugging to find more information about this error\n";
    }

    exit(255);
}

1;