#! /usr/bin/perl -W
# A sample Postfix policy template.
# This code is in public domain, ie, do whatever you like with it.
#
use strict;
use Errno;

my $fds;	# IO::Select object
my $flog;
sub init_sockets;

# initialize anything (database etc)
sub init() {
  die "usage: $0 {inet:host:port|unix:path}\n" unless @ARGV == 1;
  $fds = IO::Select->new() or die "unable to create IO::Select object\n";
  init_sockets(@ARGV);
  use IO::File;
  $flog = IO::File->new("/tmp/smtpd-policy.log", 'a');
}

init();

# process single request, argument is a hash of name=>value pairs
# return either resulting action attribute (w/o linefeeds) or undef
# in case of trouble.
sub request($;$) {
  my ($attr,$sock) = @_;
  my $act = 'DUNNO';
  if (defined $flog) {
    $flog->print("request:");
    $flog->print(" $_=$attr->{$_}") foreach keys %$attr;
    $flog->print(" action=$act\n");
    $flog->flush;
  }
  $act;
}

sub request_cb($) {
  my $s = shift;
  my $r = ${*$s}{attrs} || ( ${*$s}{attrs} = {} );
  for(;;) {
    $_ = $s->getline;
    unless (defined $_) {
      $fds->remove($s) unless $!{EAGAIN};
      return;
    }
    if (/^([a-zA-Z_]+)=([^\r\n]*)\r?\n$/) { $r->{$1} = $2; }
    elsif (/^\r?\n$/) { last; }
    else { $r->{error} = 1; }
  }
  ${*$s}{attrs} = undef;
  my $act;
  if ($r->{error}) { $act = 'ERROR unknown request line'; }
  elsif (!exists($r->{request}) ||
         $r->{request} ne 'smtpd_access_policy') {
    $act = 'ERROR required request attribute is not present';
  }
  else {
    $act = request($r);
    unless (defined $act) {
      $fds->remove($s);
      return;
    }
  }
  $s->print("action=$act\n\n") or $fds->remove($s);
}

sub accept_cb($) {
  my $ls = shift;
  my $s = $ls->accept;
  if ($s) {
    $s->blocking(0);
    ${*$s}{cb} = \&request_cb;
    $fds->add($s);
  }
}

sub init_sockets {
  foreach my $sock ( @_ ) {
    my $s;
    if ($sock =~ /^inet:([^:]+:.+)$/i) {
      use IO::Socket::INET;
      $s = IO::Socket::INET->new(
        LocalAddr => $1,
        Proto => 'tcp',
        Type => SOCK_STREAM,
        Listen => 5,
        ReuseAddr => 1,
      );
    }
    elsif ($sock =~ /^unix:(.+)$/) {
      use IO::Socket::UNIX;
      unlink $1;
      $s = IO::Socket::UNIX->new(
        Type => SOCK_STREAM,
        Local => $1,
        Listen => 5,
      );
    }
    else {
      die "invalid listening point specification: $sock\n";
    }
    die "unable to create listening socket for $sock: $!\n" unless $s;
    $s->blocking(0);
    ${*$s}{cb} = \&accept_cb;
    $fds->add($s);
  }
}


for(;;) {
  foreach my $s ( $fds->can_read() ) {
    &{${*$s}{cb}}($s);
  }
}