#! /usr/bin/perl

use strict;
use warnings;
use vars qw($PORT_DEFAULT);
use Socket;
use IO::Socket;
use IO::Select;
use Getopt::Long;
use Mail::Karmasphere::Client qw(:all);

$PORT_DEFAULT = 8555;

sub usage {
	print STDERR <<EOUSAGE;
usage: karmad
             [--username=foo --password=bar]
             [--socket=/tmp/karmad]
             [--server=query.karmasphere.com]
             [--feedset=karmasphere.email-sender]
			 [--mta=postfix|EXIM]
			 [--action=PREPEND|reject]
EOUSAGE
}

my $help;
my ($server, $user, $group, $port, $path, $login, $pass);
my ($mta, $action);
my $composite = "karmasphere.email-sender";
my $sockaddr = "/tmp/karmad";
my ($socketuser,$socketgroup,$socketmode);

my $result = GetOptions(
	"help"			=> \$help,
	"socket=s"		=> \$sockaddr,
	"socketuser=s"	=> \$socketuser,
	"socketgroup=s"	=> \$socketgroup,
	"socketmode=s"	=> \$socketmode,
	"server=s"		=> \$server,
	"feedset=s"		=> \$composite,
	"user=s"		=> \$user,
	"group=s"		=> \$group,
	"username=s"	=> \$login,
	"password=s",	=> \$pass,
	"mta=s",		=> \$mta,
	"action=s",		=> \$action,
);

$mta ||= "exim";

if (!$result or $help) {
	usage();
	exit 0;
}

my @args;
my $socktype;

my $listen = undef;
if ($sockaddr =~ /\D/) {
	unlink($sockaddr) if -S $sockaddr;

	$listen = new IO::Socket::UNIX(
		Listen		=> 1,
		Local		=> $sockaddr,
			)
		or die "Failed to create socket: $!";
	my ($uid, $gid);

	unless ($>) {
		unless ($socketuser) {
			$socketuser = 'nobody';
		}
		if ($socketuser =~ /\D/) {
			$uid = getpwnam($socketuser)
					or die "Socket user $socketuser not found: $!";
		}
		else {
			$uid = $socketuser;
		}

		unless ($socketgroup) {
			$socketgroup = 'nogroup';
		}
		if ($socketgroup =~ /\D/) {
			$gid = getgrnam($socketgroup)
					or die "Socket group $socketgroup not found: $!";
		}
		else {
			$gid = $socketgroup;
		}

		chown($uid, $gid, $sockaddr)
				or die "chown($socketuser=$uid, $socketgroup=$gid, $sockaddr) failed";
	}
	elsif ($socketuser or $socketgroup) {
		warn "Cannot change socket owner as non-root.";
	}

	if (defined $socketmode) {
		chmod(oct($socketmode), $sockaddr)
				or die "chmod($socketmode, $sockaddr) failed";
	}
}
else {
	$listen = new IO::Socket::INET(
		Listen		=> 1,
		# LocalAddr	=> "127.0.0.1",
		LocalPort	=> $sockaddr,
		ReuseAddr	=> 1
			)
		or die "Failed to create socket: $!";
}

unless ($>) {
	my ($uid, $gid);

	unless ($group) {
		$group = 'nobody';
	}
	if ($group =~ /\D/) {
		$gid = getpwnam($group)
				or die "Runtime group $group not found: $!";
	}
	else {
		$gid = $group;
	}
	$( = $gid;
	$) = $gid;
	unless ($( == $gid and $) == $gid) {
		die "Failed to change to group $group: $!\n";
	}

	unless ($user) {
		$user = 'nobody';
	}
	if ($user =~ /\D/) {
		$uid = getpwnam($user)
				or die "Runtime user $user not found: $!";
	}
	else {
		$uid = $user;
	}
	$< = $uid;
	$> = $uid;
	unless ($< == $uid and $> == $uid) {
		die "Failed to change to user $user: $!\n";
	}


}
elsif ($user or $group) {
	warn "Cannot change to $user:$group not root.";
}


while (my $socket = $listen->accept()) {
	if (fork) {
		close $socket;
		wait;
		next;
	}
	elsif (fork) {
		exit;
	}

	my $fh = select($socket);
	$| = 1;
	select($fh);

	my %in;

	# Read the request.
	while (<$socket>) {
		chomp;
		chomp;
		last if /^$/;
		my ($lhs, $rhs) = split(/\s*=\s*/, $_, 2);
		$in{lc $lhs} = $rhs;
	}

	# Debugging.
	for my $key (sort keys %in) {
		print STDERR "$key = $in{$key}\n" if -t STDERR;
	}

	my $query = new Mail::Karmasphere::Query(
		Composite	=> $composite,
	);

	$query->identity($in{client_address}, IDT_IP4_ADDRESS, "smtp.client-ip")
			if exists $in{client_address};
	$query->identity($in{helo_name}, IDT_DOMAIN_NAME, "smtp.env.helo")
			if exists $in{helo_name};
	$query->identity($in{sender}, IDT_EMAIL_ADDRESS, "smtp.env.mail-from")
			if exists $in{sender};
	# Postfix only. Hope these are useful.
	$query->identity($in{client_name}, IDT_DOMAIN_NAME, "a")
			if exists $in{client_name};
#	$query->identity($in{reverse_client_name}, IDT_DOMAIN_NAME, "a")
#			if exists $in{reverse_client_name};

	my ($shost, $sport) = split(/:/, $server) if $server;
	my %mkcargs = (
		PeerHost	=> $shost,
		PeerPort	=> $sport,
		Principal	=> $login,
		Credentials	=> $pass,
	);
	my $client = new Mail::Karmasphere::Client(%mkcargs);

	print STDERR "sending query \"@{[$query->as_string]}\"\n" if -t STDERR;
	my $response = $client->ask($query);

	respond(response  => $response,
			socket    => $socket,
			composite => $composite,
			);

	close $socket;

	exit;
}

### 
### --------------------------------------------------------- respond dispatcher
### 

sub respond {
	my %param     = @_;
	my ($response, $socket, $composite) = @param{qw(response socket composite)};

	if ($mta eq "postfix") { respond_postfix(@_); }
	else                   { respond_generic(@_); }
}

### 
### --------------------------------------------------------- MTA = exim or other
### 

sub respond_generic {
	my %param     = @_;
	my ($response, $socket, $composite) = @param{qw(response socket composite)};

	if ($response) {
		print STDERR $response->as_string if -t STDERR;
		if ($response->error) {
			print $socket "error=" . $response->message . "\n";
		}
		else {
			my $value = $response->value($composite);
			$value = 0 unless defined $value;
			print $socket "value=", $value, "\n";
			if ($value > 300) {
				print $socket "opinion=good\n";
			}
			elsif ($value < -300) {
				print $socket "opinion=bad\n";
			}
			else {
				print $socket "opinion=neutral\n";
			}
			my $data = $response->data($composite);
			$data = '(null data)' unless defined $data;
			print $socket "data=", $data, "\n";
		}
	}
	else {
		print STDERR "timeout\n" if -t STDERR;
		print $socket "error=timeout\n";
	}
	print STDERR "\n" if -t STDERR;
	print $socket "\n";
}

### 
### --------------------------------------------------------- MTA = postfix
### 

sub respond_postfix {
	my %param     = @_;
	my ($response, $socket, $composite) = @param{qw(response socket composite)};

	if (not $response) {
		# In case of trouble the policy server must not send
		# a reply. Instead the server must log a warning and
		# disconnect. Postfix will retry the request at some
		# later time.
		# -- http://www.postfix.org/SMTPD_POLICY_README.html

		print STDERR "timeout\n" if -t STDERR;
		return;
	}

	print STDERR $response->as_string if -t STDERR;

	if ($response->error) {
		return;
		# print $socket "error=" . $response->message . "\n";
	}

	my $data = $response->data($composite) || '(no comment)';

	my $action = $action || "prepend";

	my $value = $response->value($composite);
	$value = 0 unless defined $value;
	my $verdict = ($value > 300  ? "pass" :
				   $value < -300 ? "fail" :
				                   "neutral");

	if ($action eq "prepend")   {
		print $socket "prepend X-Karma verdict=$verdict score=$value comment=$data\n";
	}
	elsif ($action eq "reject") {
		if ($verdict eq "pass") { print $socket "permit\n"; }
		if ($verdict eq "fail") { print $socket "reject karma scored too low: $value ($data)\n"; }
		else                    { print $socket "prepend X-Karma verdict=$verdict score=$value comment=$data\n"; }
	}
	print $socket "\n";
}

__END__

=head1 NAME

karmad - Karmasphere daemon for postfix and exim

=head1 DESCRIPTION

This is a small daemon which listens on a Unix domain socket and
interfaces between Postfix or Exim and L<Mail::Karmasphere::Client>.

See the sample configuration and startup files in the eg/ directory
of the source distribution for more information.

=head1 COMMAND LINE PARAMETERS

=over 12

=item --mta

If you're running postfix, set --mta=postfix and karmad will
behave as an SMTPD policy daemon.

If you're running exim, set --mta=exim and use the exim ACL
provided with Mail::Karmasphere::Client.

=item --action

If you're running postfix, you can set --action to one of
C<prepend> (default) or C<reject>).  Prepend will prepend an
X-Karma header.  Reject will cause any mail with a karma
score below -300 to be rejected.  Use this only if you are
happy with the results you've observed.

=item --username

=item --password

Query credentials for authenticated queries.  You only need
to set this if you're querying a restricted feedset.  For
more information, see
L<http://www.karmasphere.com/devzone/client/configuration#credentials>

=item --socket

Where to listen.  Defaults to /tmp/karmad.  You probably
don't need to set this.

=item --server

Hostname of the Karmasphere Query Server to connect to.
Defaults to query.karmasphere.com.  You probably don't need
to set this, unless you have set up a local query server, in
which case you should be following the directions provided
with that server.

=item --feedset

The name of the feedset you want to query.  Defaults to
karmasphere.email-sender.  You probably don't need to set
this.  

=item --socketuser

=item --socketgroup

Who to listen as; defaults to 'nobody'.  The socket file
will be chowned to this user and group.  You probably don't
need to set this.

=item --socketmode

Mode to chmod the socket.  You probably don't need to set
this.

=item --user
=item --group

When running, setuid to this user and group.  Defaults to
'nobody', 'nobody'.  You probably don't need to set this.

=back

=head1 OPERATIONAL USAGE

Connect to the socket (default: /tmp/karmad) and send the
following newline-terminated stanza:

 client_address=192.0.2.1
 helo_name=host.example.com
 sender=localpart@example.com

Each of the above lines is optional; you may omit whatever is unavailable.

If all goes well, Karmad will return the following stanza:

 value=NN
 opinion=(good|bad|neutral)
 data=.....

"Value" is a number between -1000 and +1000.

"Opinion" is one of good, bad, or neutral.  If the value is
greater than 300, opinion is good.  If the value is less
than -300, the opinion is bad.  If it's between, opinion is
neutral.

"Data" contains a brief explanation of how the verdict was reached.

If an error occurs, Karmad will return:

 error=...

usually, something like

 error=timeout
 error=Incorrect user and/or password.

=head1 HOW TO TEST THAT IT'S WORKING

First, run karmad:

 % ./karmad --username=foo --password=bar

Then, connect to it:

 % perl -MIO::Socket::UNIX -le 'my $sock = IO::Socket::UNIX->new("/tmp/karmad"); print $sock "ip=127.0.0.2\n"; print <$sock>;'
 value=-1000
 opinion=bad
 data=some.feedname: if-bad(0) => return-bad(1.0)

You should expect to see some STDERR from the karmad.

The C<karmac> script does pretty much the same thing.

If troubleshooting is necessary, try running karmaclient: it
talks to Karmasphere directly, without going through karmad.

=head1 BUGS

In the response, "opinion" might be more correctly termed "verdict".

=head1 SEE ALSO

L<Mail::Karmasphere::Client>
L<Mail::Karmasphere::Query>
L<Mail::Karmasphere::Response>
L<karmaclient>
http://www.karmasphere.com/
http://www.postfix.org/SMTPD_POLICY_README.html

=head1 COPYRIGHT

Copyright (c) 2005 Shevek, Karmasphere. All rights reserved.

This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut