scripts/mqr-smtp.pl

   1 #!/usr/bin/perl
   2
   3 use warnings;
   4 use strict;
   5
   6 use AnyEvent::SMTP::Server;
   7 use Data::Dump qw(dump);
   8
   9 use lib 'lib';
  10 use MQR::Redis;
  11
  12 my $host = $ENV{SMTP_HOST} || '0.0.0.0';
  13 my $port = $ENV{SMTP_PORT} || 2525;
  14
  15 my $server = AnyEvent::SMTP::Server->new( host => $host, port => $port );
  16
  17 $server->reg_cb(
  18         client => sub {
  19                 my ($s,$con) = @_;
  20                 warn "Client from $con->{host}:$con->{port} connected\n";
  21         },
  22         disconnect => sub {
  23                 my ($s,$con) = @_;
  24                 warn "Client from $con->{host}:$con->{port} gone\n";
  25         },
  26         mail => sub {
  27                 my ($s,$mail) = @_;
  28                 my $from = $mail->{from};
  29                 warn "Received mail from $from to ",join(' and ',@{$mail->{to}}), "\n$mail->{data}\n";
  30                 foreach my $to ( @{ $mail->{to} } ) {
  31                         my $subject = $1 if $mail->{data} =~ m/^Subject:\s*(.+)$/m;
  32                         $subject =~ s/[\s\r\n]+$//; # XXX important!
  33                         MQR::Redis->publish( "MSG $host:$port smtp $mail->{from} $to" => $subject );
  34                 }
  35         },
  36 );
  37
  38 $server->start;
  39 AnyEvent->condvar->recv;