#!/usr/bin/perl
# -*- Perl -*-
######################################################################
# mimedefang-release -d directory
# release a message from quarantine directory
#
# This program was derived from fang.pl,
# original script available on contrib/ directory
#
# * This program may be distributed under the
#   terms of the GNU General Public License,
#   Version 2.
#
######################################################################

=head1 NAME

mimedefang-release - a tool to release quarantined email messages

=head1 DESCRIPTION

mimedefang-release(8) is a tool that permits to release quarantined
messages or to attach the messages to a new email message.

=head1 SYNOPSIS

 mimedefang-release [options] <directory> ...

=head1 OPTIONS

   -a	enable attach mode, the released email will be sent as an attachment
	to the user.
   -h   display the help
   -d	path to the quarantined directory, it can be an absolute path or
	relative to MIMEDefang quarantine spool directory.
   -s	set a custom subject for the email, this option is valid only
	in attach mode.
   -S	specify an smtp server, in this mode the quarantined email will be
	delivered to the original user without modifications.
   -t	enable TLS when delivering the email in smtp mode.
   -z	compress the quarantined email using Archive::Zip.
	this option is valid only in attach mode.

=head1 EXAMPLES

mbox mode:
  mimedefang-release -s "Message Released" -a -z -d 2023-04-16-14/qdir-2023-04-16-14.36.05-001

smtp mode:
  mimedefang-release -S 192.168.0.254 -d 2023-04-16-14/qdir-2023-04-16-14.36.05-001

=head1 AUTHOR

mimedefang-release(8) was written by Giovanni Bechis L<<giovanni@paclan.it>>. The mimedefang home page is L<https://www.mimedefang.org/>.

=head1 SEE ALSO

mimedefang.pl(8), mimedefang-filter(5), mimedefang(8), mimedefang-protocol(7), watch-mimedefang(8)

=cut

use strict;
use warnings;

use Carp;
use Getopt::Std;
use File::Temp qw ( :POSIX );
use MIME::Entity;

use Mail::MIMEDefang;

use constant HAS_NET_SMTP => eval { require Net::SMTP; };

init_globals();
detect_and_load_perl_modules();

$Features{'Path:SENDMAIL'} = '/usr/sbin/sendmail';
$Features{'Path:QUARANTINEDIR'} = '/var/spool/MD-Quarantine';

my %opts = ();
getopts('ahd:s:S:tz', \%opts);

if (exists $opts{'?'} || exists $opts{'h'}) {
  print "mimedefang-release -d <dir> [ -a ] [ -s <subject> ] [ -S <server> ] [ -t ] [ -z ]";
  exit 0;
}

my $qdir = $opts{'d'};
$qdir //= '';
if($qdir !~ /^\//) {
  $qdir = $Features{'Path:QUARANTINEDIR'} . '/' . $qdir;
}

unless (-d $qdir and -f "$qdir/ENTIRE_MESSAGE"
        and -f "$qdir/RECIPIENTS"
        and -f "$qdir/SENDER"
        and -f "$qdir/HEADERS") {
  croak("$qdir is not a valid directory!");
}

my $attach = 0;
if(defined $opts{'a'}) {
  $attach = 1;
}

my $subject;
if(defined $opts{'s'}) {
  $subject = $opts{'s'};
}

my $smtp;
if(defined $opts{'S'}) {
  if(not HAS_NET_SMTP) {
    croak("Net::SMTP is required to use smtp mode");
  }
  $smtp = $opts{'S'};
}

my $tls = 0;
if(defined $opts{'t'}) {
  $tls = 1;
}

my $zip = 0;
if(defined $opts{'z'} and $Features{"Archive::Zip"} eq 1) {
  $zip = 1;
} elsif((not defined $Features{"Archive::Zip"}) or ($Features{"Archive::Zip"} eq 0)) {
  croak("-z option needs Archive::Zip Perl module");
}

if($zip and not $attach) {
  croak("-z option cannot be used without -a option");
}

if(($zip or $attach) and defined $smtp) {
  croak("-z and -a options cannot be used with -S option");
}

if($tls and not $smtp) {
  croak("-t option cannot be used without -S option");
}

my $rc = make_message(qdir => $qdir, subject => $subject, zip => $zip);

exit $rc;

sub make_message {
  my (%params) = @_;

  my $dir = $params{qdir};
  my $subj = $params{subject};
  my $use_zip = $params{zip};

  my @to;
  my $toh;
  open($toh, "<", "$dir/RECIPIENTS")
    || croak("Can't read $dir/RECIPIENTS: $!");
  while (<$toh>) { chomp; push @to,$_; }
  close($toh);

  my ($from, $fromh);
  open($fromh, "<", "$dir/SENDER")
    || croak("Can't read $dir/SENDER: $!");
  $from = <$fromh>;
  close($fromh);

  my ($date, $headerh, $subject);
  open($headerh, "<", "$dir/HEADERS")
    || croak("Can't read $dir/HEADERS: $!");
  while (<$headerh>) {
    chomp;
    SWITCH: {
	/Date:/ && do {
	  s/Date: //;
	  $date = $_;
	};

	/Subject:/ && do {
	  s/Subject: //;
	  $subject = $_;
	};
    }
  }
  close($headerh);

  # use subject passed as parameter
  if(defined($subj)) {
    $subject = $subj;
  }

  my $folderh;
  opendir($folderh, "$dir")
    || Error("Can't list $dir: $!");
  my @files = readdir($folderh);
  close($folderh);

  my $msg = MIME::Entity->build(
		  From    => $DaemonAddress,
		  To      => join(',',@to),
		  Subject => $subject,
                  Data    => "A quarantined message has been released,\nyou can find the original message in the attached file.",
		  Type    => 'multipart/mixed',
  );

  my $tmpzip;
  if($attach) {
    if($use_zip) {
      my $zipfile = Archive::Zip->new();
      my $file_member = $zipfile->addFile("$dir/ENTIRE_MESSAGE", 'released-message.eml');
      $tmpzip = tmpnam();
      # this code burps an ugly message if it fails, but that's redirected elsewhere
      # AZ_OK is a constant exported by Archive::Zip
      my $az_ok;
      eval '$az_ok = AZ_OK';
      my $status = $zipfile->writeToFileNamed($tmpzip);
        croak "error while compressing file $tmpzip" if $status != $az_ok;
      $msg->attach(
		  Type     => 'application/zip',
		  Path     => $tmpzip,
		  Filename => 'released-message.zip',
      );
    } else {
      $msg->attach(
		  Type     => 'message/rfc822',
		  Path     => "$dir/ENTIRE_MESSAGE",
		  Filename => 'released-message.eml',
      );
    }

    if(send_mail($DaemonAddress, $DaemonName, join(',', @to), $msg->stringify)) {
      unlink($tmpzip) if ($zip);
      return 1;
    } else {
      unlink($tmpzip) if ($zip);
      return 0;
    }
  } elsif(defined $smtp) {
    my $srv = Net::SMTP->new($smtp,
                           SSL     => $tls,
                          );
    open my $fh, '<', "$dir/ENTIRE_MESSAGE" or croak("Cannot open quarantined message on directory $dir");
    local $/ = undef;
    my $entire_message = <$fh>;
    close $fh;

    $srv->mail($from);
    if($srv->to(join(',',@to))) {
      $srv->data();
      $srv->datasend($entire_message);
      $srv->dataend();
    }
    $srv->quit();
  } else {
    croak("Invalid options, at least -S or -a options must be used");
  }
}
