Milter plugin

git-svn-id: https://svn.perl.org/qpsmtpd/trunk@174 958fd67b-6ff1-0310-b445-bb7760255be9

Changes

@@ -15,6 +15,8 @@
 
   Enable "check_earlytalker" in the default plugins config
 
+  Added a milter plugin to allow use of sendmail milters
+
   [.. todo, fill in older changes ..] spf changes etc?
 
 0.26 - 2003/06/11

plugins/milter

@@ -0,0 +1,226 @@
+=head1 NAME
+
+milter
+
+=head1 DESCRIPTION
+
+This plugin allows you to attach to milter filters (yes, those written for
+sendmail) as though they were qpsmtpd plugins.
+
+In order to do this you need the C<Net::Milter> module from CPAN.
+
+=head1 CONFIG
+
+It takes two required parameters - a milter name (for logging) and the port
+to connect to on the localhost. This can also contain a hostname if
+the filter is on another machine:
+
+  queue/milter Brightmail 5513
+
+or
+
+  queue/milter Brightmail bmcluster:5513
+
+This plugin has so far only been tested with Brightmail's milter module.
+
+=cut
+
+use Net::Milter;
+no warnings;
+
+sub register {
+  my ($self, $qp, @args) = @_;
+
+  die "Invalid milter setup args: '@args'" unless @args > 1;
+  my ($name, $port) = @args;
+  my $host = '127.0.0.1';
+  if ($port =~ s/^(.*)://) {
+    $host = $1;
+  }
+  
+  $self->{name} = $name;
+  $self->{host} = $host;
+  $self->{port} = $port;
+  
+  $self->register_hook("connect", "connect_handler");
+  $self->register_hook("helo", "helo_handler");
+  $self->register_hook("mail", "mail_handler");
+  $self->register_hook("rcpt", "rcpt_handler");
+  $self->register_hook("data_post", "data_handler");
+  $self->register_hook("disconnect", "disconnect_handler");
+}
+
+sub disconnect_handler {
+    my ($self) = @_;
+
+    my $milter = $self->qp->connection->notes('milter') || return DECLINED;
+    $milter->send_quit();
+    
+    $self->qp->connection->notes('spam', undef);
+    $self->qp->connection->notes('milter', undef);
+
+    return DECLINED;
+}
+
+sub check_results {
+    my ($self, $transaction, $where, @results) = @_;
+    foreach my $result (@results) {
+        next if $result->{action} eq 'continue';
+        $self->log(1, "milter $self->{name} result action: $result->{action}");
+        if ($result->{action} eq 'reject') {
+            die("Rejected at $where by $self->{name} milter ($result->{explanation})");
+        }
+        elsif ($result->{action} eq 'add') {
+            if ($result->{header} eq 'body') {
+                $transaction->body_write($result->{value});
+            }
+            else {
+                $transaction->header->add($result->{header}, $result->{value});
+            }
+        }
+        elsif ($result->{action} eq 'delete') {
+            $transaction->header->delete($result->{header});
+        }
+        elsif ($result->{action} eq 'accept') {
+            # TODO - figure out what this is used for
+        }
+        elsif ($result->{action} eq 'replace') {
+            $transaction->header->replace($result->{header}, $result->{value});
+        }
+        elsif ($result->{action} eq 'continue') {
+            # just carry on as normal
+        }
+    }
+}
+
+sub connect_handler {
+    my ($self, $transaction) = @_;
+    
+    $self->log(1, "milter $self->{name} opening connection to milter backend");
+    my $milter = Net::Milter->new();
+    $milter->open($self->{host}, $self->{port}, 'tcp');
+    $milter->protocol_negotiation();
+
+    $self->qp->connection->notes(milter => $milter);
+    
+    my $remote_ip = $self->qp->connection->remote_ip;
+    my $remote_host = $self->qp->connection->remote_host;
+    $self->log(1, "milter $self->{name} checking connect from $remote_host\[$remote_ip\]");
+    
+    eval {
+        $self->check_results($transaction, "connection",
+            $milter->send_connect($remote_host, 'tcp4', 0, $remote_ip));
+    };
+    $self->qp->connection->notes('spam', $@) if $@;
+
+    return DECLINED;
+}
+
+sub helo_handler {
+    my ($self, $transaction) = @_;
+
+    if (my $txt = $self->qp->connection->notes('spam')) {
+        return DENY, $txt;
+    }
+    
+    my $milter = $self->qp->connection->notes('milter');
+    
+    my $helo = $self->qp->connection->hello;
+    my $host = $self->qp->connection->hello_host;
+
+    $self->log(1, "milter $self->{name} checking HELO $host");
+    
+    eval { $self->check_results($transaction, "HELO",
+                                $milter->send_helo($host)) };
+    return(DENY, $@) if $@;
+    
+    return DECLINED;
+}
+
+sub mail_handler {
+    my ($self, $transaction, $address) = @_;
+    
+    my $milter = $self->qp->connection->notes('milter');
+
+    $self->log(1, "milter $self->{name} checking MAIL FROM " . $address->format);
+    eval { $self->check_results($transaction, "MAIL FROM",
+                                $milter->send_mail_from($address->format)) };
+    return(DENY, $@) if $@;
+
+    return DECLINED;
+}
+
+sub rcpt_handler {
+    my ($self, $transaction, $address) = @_;
+    
+    my $milter = $self->qp->connection->notes('milter');
+
+    $self->log(1, "milter $self->{name} checking RCPT TO " . $address->format);
+
+    eval { $self->check_results($transaction, "RCPT TO",
+                                $milter->send_rcpt_to($address->format)) };
+    return(DENY, $@) if $@;
+
+    return DECLINED;
+}
+
+sub data_handler {
+    my ($self, $transaction) = @_;
+
+    my $milter = $self->qp->connection->notes('milter');
+
+    $self->log(1, "milter $self->{name} checking headers");
+
+    my $headers = $transaction->header(); # Mail::Header object
+    foreach my $h ($headers->tags) {
+        # munge these headers because milters prefer them this way
+        $h =~ s/\b(\w)/\U$1/g;
+        $h =~ s/\bid\b/ID/g;
+        foreach my $val ($headers->get($h)) {
+            # $self->log(1, "milter $self->{name} checking header: $h: $val");
+            eval { $self->check_results($transaction, "header $h",
+                                $milter->send_header($h, $val)) };
+            return(DENY, $@) if $@;
+        }
+    }
+    
+    eval { $self->check_results($transaction, "end headers",
+                                $milter->send_end_headers()) };
+    return(DENY, $@) if $@;
+     
+    $transaction->body_resetpos;
+    
+    # skip past headers
+    while (my $line = $transaction->body_getline) {
+        $line =~ s/\r?\n//;
+        $line =~ s/\s*$//;
+        last unless length($line);
+    }
+
+    $self->log(1, "milter $self->{name} checking body");
+
+    my $data = '';
+    while (my $line = $transaction->body_getline) {
+        $data .= $line;
+        if (length($data) > 60000) {
+            eval { $self->check_results($transaction, "body",
+                                $milter->send_body($data)) };
+            return(DENY, $@) if $@;
+            $data = '';
+        }
+    }
+    
+    if (length($data)) {
+        eval { $self->check_results($transaction, "body",
+                                $milter->send_body($data)) };
+        return(DENY, $@) if $@;
+        $data = '';
+    }
+    
+    eval { $self->check_results($transaction, "end of DATA",
+                                $milter->send_end_body()) };
+    return(DENY, $@) if $@;
+
+    return DECLINED;
+}
+