package WinRT::RELAY;

use strict;
our @ISA = 'WinRT';

my %Conf = (
    admin		=> 16977,
    port		=> 6977,
    spool_dir		=> '?',
    forward_to		=> '?',
    admin_terminate	=> undef,
    as_server		=> undef,
    no_daemon		=> undef
);

sub new {
    my ($class, $base) = @_;

    my $self = $class->SUPER::NewObject($base, 'emailrelay');
    $self->{daemon} = $self->bin('emailrelay.exe');
    $self->{config} = { %Conf };

    return $self;
}

sub Opt {
    my ($self, $config) = @_;
    my @opt = ();
    foreach my $k (sort keys %$config) {
	my $key = "--$k";
	$key =~ s/_/-/g;
	push @opt, $key;
	push @opt, $config->{$k} if defined $config->{$k};
    }
    return @opt;
}

sub Launch {
    my $self = shift;

    my $server = $RT::SMTPServer;
    $server .= ':25' unless $server =~ /:/;
    $self->{config}{forward_to} = $server;
    $self->{config}{spool_dir} = $self->spool;

    my $disabled = ($RT::SMTPServer =~ /^0?$/);

    if (!$disabled and !$self->Opened) {
        $self->{obj} = WinRT->Spawn(
            $self->{daemon}, $self->Opt($self->{config})
        ) or return;
    }

    if (!$RT::SMTPServerOrig) {
	$RT::SMTPServerOrig = $RT::SMTPServer;
	$RT::SMTPServer = "localhost:$self->{config}{port}";

	no strict 'refs';
	require Mail::Internet;
	eval { Mail::Internet->send }; # trigger autoload
	my $ref = \&Mail::Internet::send;
	my ($send_ref, $sending);
	$send_ref = sub {
	    return 1 if $disabled;

	    $self->Launch;

	    if ($RT::SMTPDebug) {
		open my $fh, ">", "$self->{config}{spool_dir}/debug-".time.".txt";
		require YAML;
		print $fh '# ', join(', ', map "'$_'", @_[1..$#_]), $/;
		print $fh YAML::Dump($_[0]);
		close $fh;
	    }

	    local $@;
	    my $rv = eval { $ref->(@_) }; # will not resend if the command EOF'ed
	    if ($@) {
		if (!$sending) {
		    sleep 1;
		    $sending = 1;
		    goto &$send_ref;
		}
		else {
		    die $@;
		}
	    }
	    $sending = 0;
	    $self->Flush;
	    return $rv;
	};

        # Kluge: Sending multiple mails here with separate To.
        *Mail::Internet::send = sub {
            my $self = shift;
            my @To = map split(/,/, $self->head->get($_)), qw(To Cc Bcc);
            $self->head->delete($_) for qw(To Cc Bcc);

	    my %seen;
            foreach my $to (grep length, @To) {
	        next if $seen{$to}++;
                $self->head->replace(To => $to);
                $send_ref->( $self, @_ ) or return 0;
            }
            return 1;
        };
    }
}

sub Opened {
    my $self = shift;

    use Socket qw/PF_INET SOCK_STREAM inet_aton sockaddr_in/;
    my $sock; socket($sock, PF_INET, SOCK_STREAM, getprotobyname('tcp'));

    connect(
        $sock,
       	sockaddr_in( $self->{config}{admin}, inet_aton('localhost') )
    ) or return;

    return $sock;
}

sub Flush {
    my $self = shift;

    my %config = %{$self->{config}};
    delete $config{as_server};
    delete $config{forward_to};

    my $server = $RT::SMTPServerOrig || $RT::SMTPServer;
    $server .= ':25' unless $server =~ /:/;
    $config{as_client} = $server;
    $config{spool_dir} = $self->spool;

    WinRT->Spawn($self->{daemon}, $self->Opt(\%config));
}

sub Terminate {
    my $self = shift;
    my $sock = $self->Opened or return;
    send $sock, "terminate\015\012", 0;
    sleep 1;
    send $sock, "terminate\015\012", 0;
    sleep 1;
    shutdown $sock, 2;
}

sub DESTROY {
    my $self = shift;
    $self->Terminate if $self->{obj};
}

1;
