package PMG::MailQueue;

use strict;
use warnings;

use PVE::SafeSyslog;
use PVE::Tools qw(trim);
use MIME::Parser;
use IO::File;
use Encode;
use File::Sync;
use File::Basename;
use File::Path;
use File::stat;
use Time::HiRes qw(gettimeofday);
use Mail::Header;

use PMG::LDAPSet;
use PMG::MIMEUtils;

our $spooldir = "/var/spool/pmg";

my $fileseq = rand 1000;

sub create_spooldirs {
    my ($lcid, $cleanup) = @_;

    # if requested, remove any stale date
    rmtree([
        "$spooldir/cluster",
        "$spooldir/active",
        "$spooldir/virus",
        "$spooldir/spam",
        "$spooldir/attachment",
    ])
        if $cleanup;

    mkpath(
        "$spooldir/active",
        "$spooldir/spam",
        "$spooldir/virus",
        "$spooldir/attachment",
        { group => 'pmg', chmod => 0775 },
    );

    if ($lcid) {
        mkpath(
            "$spooldir/cluster/$lcid/virus",
            "$spooldir/cluster/$lcid/spam",
            "$spooldir/cluster/$lcid/attachment",
            { group => 'pmg', chmod => 0775 },
        );
    }
}

# called on service startup to remove any stale files
sub cleanup_active {

    while (my $file = <$spooldir/active/*>) {
        unlink $file;
    }

}

sub new_fileid {
    my ($dir, $subdir) = @_;

    # try to create a unique data file

    my ($sec, $usec) = gettimeofday();
    my $fname = "$sec.$usec.$$." . $fileseq++;
    my $path = "$dir/$subdir/$fname";
    my $fh;
    my $uid;
    my $subsubdir = '';

    if (!($fh = IO::File->new($path, 'w+'))) {
        die "unable to create file '$path': $! : ERROR";
    }
    # the www-data web UI reads these directly, so keep them world-readable regardless of umask
    chmod(0644, $path);

    if (my $st = stat($fh)) {
        $uid = sprintf("%X%X%05X", $st->ino, $sec, $usec);
        if ($subdir ne 'active') {
            $subsubdir .= sprintf("%02X/", $usec % 256);
        }
    } else {
        unlink $path;
        die "unable to stat file: $! : ERROR";
    }

    mkdir "$dir/$subdir/$subsubdir";

    my $subpath = "$subdir/$subsubdir$uid";

    if (!rename($path, "$dir/$subpath")) {
        unlink $path;
        die "unable to rename file: ERROR";
    }

    return ($fh, $uid, $subpath);
}

sub new {
    my ($type, $from, $to) = @_;

    my $self = {};
    bless $self, $type;

    $self->{from} = $from;
    $self->{msgid} = "";

    $self->{sa_score} = undef;
    $self->{sa_max} = undef;
    $self->{sa_data} = undef;

    $self->{vinfo} = undef;
    $self->{bytes} = 0;
    $self->{rtime} = time;
    $self->{ptime_spam} = 0;
    $self->{ptime_virus} = 0;

    my ($fh, $uid, $path) = new_fileid($spooldir, 'active');

    $self->{fh} = $fh;
    $self->{uid} = $uid;
    $self->{logid} = $uid;
    #$self->{logid} = sprintf ("%05X${uid}", $self->{rtime});
    $self->{dataname} = "$spooldir/$path";

    $self->{dumpdir} = "/tmp/.proxdump_${$}_$uid";

    $self->set_status($to, 'undelivered');

    return $self;
}

sub set_status {
    my ($self, $targets, $state, $code, $message) = @_;

    foreach my $r (@$targets) {
        $self->{status}->{$r} = $state;
        $self->{status_code}->{$r} = $code;
        $self->{status_message}->{$r} = $message;
    }
}

sub quarantinedb_insert {
    my ($self, $ruledb, $lcid, $ldap, $qtype, $header, $sender, $file, $targets, $vars) = @_;

    eval {
        $sender = encode('UTF-8', $sender);
        my $dbh = $ruledb->{dbh};

        my $insert_cmds =
            "SELECT nextval ('cmailstore_id_seq'); INSERT INTO CMailStore "
            . "(CID, RID, ID, Time, QType, Bytes, Spamlevel, Info, Header, Sender, File) VALUES ("
            . "$lcid, currval ('cmailstore_id_seq'), currval ('cmailstore_id_seq'), ";

        my $spaminfo = $vars->{__spaminfo};
        my $sa_score = $spaminfo->{sa_score} || 0;

        $insert_cmds .= $self->{rtime} . ',';
        $insert_cmds .= $dbh->quote($qtype) . ',';
        $insert_cmds .= $self->{bytes} . ',';
        $insert_cmds .= $sa_score . ',';

        if ($qtype eq 'V') {
            $insert_cmds .= $dbh->quote($self->{vinfo}) . ',';
        } else {

            my $sscores = $spaminfo->{sa_data};
            my $sainfo = 'NULL';
            if (defined($sscores) && @$sscores != -1) {
                $sainfo = '';
                foreach my $s (@$sscores) {
                    $sainfo .= ',' if $sainfo;
                    $sainfo .= sprintf("%s:%s", $s->{rule}, $s->{score});
                }
                $sainfo = $dbh->quote($sainfo);
            }

            $insert_cmds .= $sainfo . ',';
        }

        $insert_cmds .= $dbh->quote($header) . ',';

        $insert_cmds .= $dbh->quote($sender) . ',';
        $insert_cmds .= $dbh->quote($file) . ');';

        my $now = time();

        my $tid = int(rand(0x0fffffff));

        foreach my $r (@$targets) {
            my $pmail = get_primary_mail($ldap, $r);
            my $receiver;
            if ($pmail eq lc($r)) {
                $receiver = "NULL";
            } else {
                $receiver = $dbh->quote(encode('UTF-8', $r));
            }

            $pmail = $dbh->quote(encode('UTF-8', $pmail));
            $insert_cmds .=
                "INSERT INTO CMSReceivers "
                . "(CMailStore_CID, CMailStore_RID, PMail, Receiver, TicketID, Status, MTime) "
                . "VALUES ($lcid, currval ('cmailstore_id_seq'), $pmail, $receiver, $tid, 'N', $now); ";

            # Note: Tuple (CID, RID, TicketID) must be unique
            $tid = ($tid + 1) & 0x0fffffff;
        }

        $dbh->do($insert_cmds);
    };

    my $err = $@;

    syslog('err', "ERROR: $err") if $err;
}

sub get_primary_mail {
    my ($ldap, $mail) = @_;

    $mail = lc($mail);

    return $mail if !$ldap;

    if (my $info = $ldap->account_info($mail)) {
        return $info->{pmail};
    }

    return $mail;
}

sub extract_header_text {
    my ($entity) = @_;

    my $subject = $entity->head->get('subject', 0);
    my $from = $entity->head->get('from', 0);
    my $sender = $entity->head->get('sender', 0);

    my $head = new Mail::Header;
    $head->add('subject', $subject) if $subject;
    $head->add('from', $from) if $from;
    $head->add('sender', $sender) if $sender;

    my $header = $head->as_string();

    return $header;
}

sub fsync_file_and_dir {
    my $filename = shift;

    eval {
        my $fh = IO::File->new($filename) || die "unable to open file '$filename'";
        File::Sync::fsync($fh) || die "fsync file '$filename' failed";
        close($fh);

        my $dirname = dirname($filename);
        my $dir = IO::File->new($dirname) || die "open dir '$dirname' failed";
        File::Sync::fsync($dir) || die "fsync dir '$dirname' failed";
        close($dir);
    };

    my $err = $@;

    if ($err) {
        syslog('err', "ERROR: $err");
    }

}

my $subpath_map = {
    'V' => 'virus',
    'S' => 'spam',
    'A' => 'attachment',
};

sub quarantine_mail {
    my ($self, $ruledb, $qtype, $entity, $tg, $msginfo, $vars, $ldap) = @_;

    my $sender = $msginfo->{sender};

    my $header = extract_header_text($entity);

    my $subpath = $subpath_map->{$qtype} // 'spam';

    my $lcid = $msginfo->{lcid};

    my ($fh, $uid, $path);

    eval {
        if ($lcid) {
            my $subdir = "cluster/$lcid/$subpath";
            ($fh, $uid, $path) = new_fileid($spooldir, $subdir);
        } else {
            ($fh, $uid, $path) = new_fileid($spooldir, $subpath);
        }

        # there must be only one Return-Path
        $entity->head->delete('Return-Path');

        # prepend Delivered-To and Return-Path (like QMAIL MAILDIR FORMAT)
        $entity->head->add('Return-Path', encode('UTF-8', join(',', $sender)), 0);
        $entity->head->add('Delivered-To', encode('UTF-8', join(',', @$tg)), 0);

        $entity->print($fh);

        close($fh);

        fsync_file_and_dir("$spooldir/$path"); # make sure the file is on disk

        $self->quarantinedb_insert(
            $ruledb, $lcid, $ldap, $qtype, $header, $sender, $path, $tg, $vars,
        );
    };

    my $err = $@;

    if ($err) {
        close($fh) if $fh;
        unlink "$spooldir/$path" if $path;
        syslog('err', "ERROR: $err");
        return undef;
    }

    return $uid;
}

#sub quarantine {
#    my ($self, $targets);
#
#    $self->set_status ($targets, 'quarantine');
#}

#sub spamreport {
#    my ($self, $targets);
#
#    $self->set_status ($targets, 'spam:report');
#}

#sub delay {
#    my ($self, $targets, $hm);
#
#    $self->set_status ($targets, "delay|$hm");
#}

sub msgid {
    my ($self, $msgid) = @_;

    if (defined($msgid)) {
        $self->{msgid} = $msgid;
    }

    $self->{msgid};
}

sub close {
    my $self = shift;

    close($self->{fh});

    rmtree $self->{dumpdir};

    unlink $self->{dataname};
}

sub _new_mime_parser {
    my ($self, $maxfiles) = @_;

    my $parser = PMG::MIMEUtils::new_mime_parser({
        nested => 1,
        ignore_errors => 0,
        extract_uuencode => 0,
        decode_bodies => 0,
        maxfiles => $maxfiles,
        dumpdir => $self->{dumpdir},
    });

    return $parser;
}

sub parse_mail {
    my ($self, $maxfiles, $accept_broken_mime) = @_;

    my $entity;
    my $logid = $self->{logid};
    my $ctime = time;

    my $parser = $self->_new_mime_parser($maxfiles);

    $self->{fh}->seek(0, 0);

    eval {
        # returns undef on too many parts/maxfiles
        if (!($entity = $parser->read($self->{fh}))) {
            die "too many parts\n";
        }
    };
    if (my $err = $@) {
        if ($accept_broken_mime) {
            # if accept_broken_mime is set parse again and add a header
            $parser->ignore_errors(1);
            $self->{fh}->seek(0, 0);

            eval {
                if (!($entity = $parser->read($self->{fh}))) {
                    die "too many parts\n";
                }
            };
            die "$logid: unable to parse message ignoring errors: $@\n" if $@;

            syslog('warn', "$logid: message caused errors during parsing: $err adding header");
            $entity->head()->add("X-Proxmox-Broken-Message", "caused errors while parsing");
            $parser->ignore_errors(0);
        } else {
            die "$logid: unable to parse message - $@" if $@;
        }
    }

    # use the method on MIME::Parser instead of parsing again - see
    # https://metacpan.org/pod/MIME::Parser#ambiguous_content
    if ($parser->ambiguous_content()) {
        if ($accept_broken_mime) {
            syslog('warn', "$logid: message has ambiguous content - adding header");
            $entity->head()->add("X-Proxmox-Broken-Message", "ambiguous content");
        } else {
            die "$logid: message has ambiguous content\n";
        }
    }

    PMG::MIMEUtils::fixup_multipart($entity);

    if ((my $idcount = $entity->head->count('Message-Id')) > 0) {
        $self->msgid(trim($entity->head->get('Message-Id', $idcount - 1)));
    }

    # fixme: add parse_time to statistic database
    my $parse_time = time() - $ctime;

    # also save decoded data
    decode_entities($parser, $logid, $entity);

    # we also remove all proxmox-marks from the mail and add an unique
    # id to each attachment.

    my $max_aid = PMG::Utils::remove_marks($entity, 1);
    PMG::Utils::add_ct_marks($entity);

    return ($entity, $max_aid);
}

sub decode_entities {
    my ($parser, $logid, $entity) = @_;

    PMG::MIMEUtils::traverse_mime_parts(
        $entity,
        sub {
            my ($part) = @_;
            if ($part->bodyhandle && (my $path = $part->bodyhandle->path)) {

                eval {
                    my $head = $part->head;
                    my $encoding = $head->mime_encoding;
                    my $decoder = new MIME::Decoder $encoding;

                    if (!$decoder || ($decoder eq 'none' || $decoder eq 'binary')) {

                        $part->{PMX_decoded_path} = $path; # no need to decode

                    } else {

                        my $body = $parser->new_body_for($head);
                        $body->binmode(1);
                        $body->is_encoded(0);

                        my $in = $part->bodyhandle->open("r")
                            || die "unable to read raw data '$path'";

                        my $decfh = $body->open("w")
                            || die "unable to open body: $!";

                        $decoder->decode($in, $decfh);

                        $in->close;

                        $decfh->close
                            || die "can't close bodyhandle: $!";

                        $part->{PMX_decoded_path} = $body->path;
                    }
                };

                my $err = $@;

                if ($err) {
                    syslog('err', "$logid: $err");
                }

            }
        },
    );
}

1;

__END__
