#! /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]
EOUSAGE
}

my $help;
my ($server, $user, $group, $port, $path, $login, $pass);
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,
);

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(/=/, $_, 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{ip}, IDT_IP4_ADDRESS, "smtp.client-ip")
			if exists $in{ip};
	$query->identity($in{helo}, IDT_DOMAIN_NAME, "smtp.env.helo")
			if exists $in{helo};
	$query->identity($in{sender}, IDT_EMAIL_ADDRESS, "smtp.env.mail-from")
			if exists $in{sender};

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

	my $response = $client->ask($query);

	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";
	close $socket;

	exit;
}

__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 --username

=item --password

Query credentials for authenticated queries.  You probably
need to set this.

These parameters are mandatory unless you are relying on IP
authentication.  For more information, see
L<http://www.karmasphere.com/devzone/client/configuration#credentials>

If you have registered for a Karmasphere account, you should
use the permanent credentials that have been assigned.  See
L<http://www.karmasphere.com/app/account/auth#query_credentials>

If you have not registered for a Karmasphere account, you
can use temporary credentials, but those credentials will
expire after a few weeks.  See the URL above and choose the
username and password for either "exim" or "postfix".

=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:

 ip=192.0.2.1
 helo=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.

If troubleshooting is necessary, try running karmaclient:
that does in one step what karmad-plus-the-socket-call do in
two.

=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/

=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
