init
This commit is contained in:
11
wcmtools/dmtpd/README.txt
Executable file
11
wcmtools/dmtpd/README.txt
Executable file
@@ -0,0 +1,11 @@
|
||||
This is a server to inject mail into Sendmail/Postfix/etc's outgoing
|
||||
mail queue, without blocking the client (in our case, web nodes which
|
||||
can't block on outgoing email).
|
||||
|
||||
Works with any MTA that has 'sendmail -i -f ....'
|
||||
|
||||
This might all be temporary until we figure out mail better. (like
|
||||
how to get postfix to trust our outgoing email and queue it
|
||||
immediately, rather than blocking the web clients while it sends)
|
||||
|
||||
|
||||
42
wcmtools/dmtpd/api/perl/test.pl
Executable file
42
wcmtools/dmtpd/api/perl/test.pl
Executable file
@@ -0,0 +1,42 @@
|
||||
#!/usr/bin/perl
|
||||
#
|
||||
|
||||
use strict;
|
||||
use MIME::Lite ();
|
||||
use IO::File;
|
||||
use IO::Socket::INET;
|
||||
|
||||
my $msg = new MIME::Lite ('From' => 'brad@danga.com (Brad Fitzpatrick)',
|
||||
'To' => 'brad@danga.com (Fitz)',
|
||||
'Cc' => 'brad@livejournal.com',
|
||||
'Subject' => "Subjecto el Email testo",
|
||||
'Data' => "word\n.\n\nthe end.\n");
|
||||
|
||||
my $as = $msg->as_string;
|
||||
my $len = length($as);
|
||||
|
||||
my $sock = IO::Socket::INET->new(PeerAddr => 'localhost',
|
||||
PeerPort => '7005',
|
||||
Proto => 'tcp');
|
||||
|
||||
my $message = "Content-Length: $len\r\nEnvelope-Sender: brad\@danga.com\r\n\r\n$as";
|
||||
|
||||
$sock->print("$message$message");
|
||||
|
||||
sleep 1;
|
||||
|
||||
$sock->print("Content-Len");
|
||||
sleep 1;
|
||||
$sock->print("gth: $len\r\nEnvelope-Sender: brad\@danga.com\r\n");
|
||||
sleep 1;
|
||||
$sock->print("\r\n${as}Content-Length: $len\r\nEnvelope-Sender: ");
|
||||
sleep 1;
|
||||
$sock->print("brad\@danga.com\r\n\r\n$as");
|
||||
|
||||
while ($_ = $sock->getline) {
|
||||
$_ =~ s/[\r\n]+$//;
|
||||
print "RES: $_\n";
|
||||
}
|
||||
$sock->close;
|
||||
|
||||
|
||||
231
wcmtools/dmtpd/server/dmtpd
Executable file
231
wcmtools/dmtpd/server/dmtpd
Executable file
@@ -0,0 +1,231 @@
|
||||
#!/usr/bin/perl
|
||||
#
|
||||
# Danga's Mail Transfer Daemon
|
||||
#
|
||||
# Status: 2004-06-07: quick hack.
|
||||
#
|
||||
# Copyright 2004, Danga Interactive
|
||||
#
|
||||
# Authors:
|
||||
# Brad Fitzpatrick <brad@danga.com>
|
||||
#
|
||||
# License:
|
||||
# Artistic/GPL. Your choice.
|
||||
#
|
||||
|
||||
use strict;
|
||||
use Getopt::Long;
|
||||
use Carp;
|
||||
use Danga::Socket;
|
||||
use IO::Socket::INET;
|
||||
use POSIX ();
|
||||
|
||||
use vars qw($DEBUG);
|
||||
$DEBUG = 0;
|
||||
|
||||
my (
|
||||
$daemonize,
|
||||
);
|
||||
my $conf_port = 7005;
|
||||
|
||||
Getopt::Long::GetOptions(
|
||||
'd|daemon' => \$daemonize,
|
||||
'p|port=i' => \$conf_port,
|
||||
'debug=i' => \$DEBUG,
|
||||
);
|
||||
|
||||
daemonize() if $daemonize;
|
||||
|
||||
use Socket qw(IPPROTO_TCP SO_KEEPALIVE TCP_NODELAY SOL_SOCKET);
|
||||
|
||||
$SIG{'PIPE'} = "IGNORE"; # handled manually
|
||||
|
||||
# establish SERVER socket, bind and listen.
|
||||
my $server = IO::Socket::INET->new(LocalPort => $conf_port,
|
||||
Type => SOCK_STREAM,
|
||||
Proto => IPPROTO_TCP,
|
||||
Blocking => 0,
|
||||
Reuse => 1,
|
||||
Listen => 10 )
|
||||
or die "Error creating socket: $@\n";
|
||||
|
||||
# Not sure if I'm crazy or not, but I can't see in strace where/how
|
||||
# Perl 5.6 sets blocking to 0 without this. In Perl 5.8, IO::Socket::INET
|
||||
# obviously sets it from watching strace.
|
||||
IO::Handle::blocking($server, 0);
|
||||
|
||||
my $accept_handler = sub {
|
||||
my $csock = $server->accept();
|
||||
return unless $csock;
|
||||
|
||||
printf("Listen child making a Client for %d.\n", fileno($csock))
|
||||
if $DEBUG;
|
||||
|
||||
IO::Handle::blocking($csock, 0);
|
||||
setsockopt($csock, IPPROTO_TCP, TCP_NODELAY, pack("l", 1)) or die;
|
||||
|
||||
my $client = Client->new($csock);
|
||||
$client->watch_read(1);
|
||||
};
|
||||
|
||||
Client->OtherFds(fileno($server) => $accept_handler);
|
||||
Client->EventLoop();
|
||||
|
||||
sub daemonize {
|
||||
my($pid, $sess_id, $i);
|
||||
|
||||
## Fork and exit parent
|
||||
if ($pid = fork) { exit 0; }
|
||||
|
||||
## Detach ourselves from the terminal
|
||||
croak "Cannot detach from controlling terminal"
|
||||
unless $sess_id = POSIX::setsid();
|
||||
|
||||
## Prevent possibility of acquiring a controling terminal
|
||||
$SIG{'HUP'} = 'IGNORE';
|
||||
if ($pid = fork) { exit 0; }
|
||||
|
||||
## Change working directory
|
||||
chdir "/";
|
||||
|
||||
## Clear file creation mask
|
||||
umask 0;
|
||||
|
||||
## Close open file descriptors
|
||||
close(STDIN);
|
||||
close(STDOUT);
|
||||
close(STDERR);
|
||||
|
||||
## Reopen stderr, stdout, stdin to /dev/null
|
||||
open(STDIN, "+>/dev/null");
|
||||
open(STDOUT, "+>&STDIN");
|
||||
open(STDERR, "+>&STDIN");
|
||||
}
|
||||
|
||||
#####################################################################
|
||||
### C L I E N T C L A S S
|
||||
#####################################################################
|
||||
package Client;
|
||||
|
||||
use Danga::Socket;
|
||||
use base 'Danga::Socket';
|
||||
use fields (
|
||||
'headers', # hashref of header fields read
|
||||
'line', # partial line read so far
|
||||
'readcount', # how much into the message body we've read
|
||||
'sendmail', # IO::File pipe to sendmail
|
||||
'gotheaders', # bool: if we've finished reading headers
|
||||
'err', # bool: error has occurred so far
|
||||
);
|
||||
use Errno qw(EPIPE);
|
||||
use IO::File;
|
||||
|
||||
sub new {
|
||||
my Client $self = shift;
|
||||
$self = fields::new($self) unless ref $self;
|
||||
$self->SUPER::new( @_ );
|
||||
|
||||
$self->reset_for_next_message;
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub reset_for_next_message {
|
||||
my Client $self = shift;
|
||||
$self->{line} = '';
|
||||
$self->{headers} = {};
|
||||
$self->{readcount} = 0;
|
||||
$self->{gotheaders} = 0;
|
||||
$self->{sendmail} = undef;
|
||||
$self->{err} = 0;
|
||||
return $self;
|
||||
}
|
||||
|
||||
# Client
|
||||
sub event_read {
|
||||
my Client $self = shift;
|
||||
my $bref = $self->read(8192);
|
||||
return $self->close() unless defined $bref;
|
||||
$self->process_read_buf($bref);
|
||||
}
|
||||
|
||||
sub process_read_buf {
|
||||
my Client $self = shift;
|
||||
my $bref = shift;
|
||||
|
||||
if (! $self->{gotheaders}) {
|
||||
$self->{line} .= $$bref;
|
||||
while ($self->{line} =~ s/^(.*?)\r?\n//) {
|
||||
my $line = $1;
|
||||
if ($line =~ /^(\S+)\s*:\s*(.+)/) {
|
||||
$self->{headers}{lc($1)} = $2;
|
||||
} elsif ($line eq "") {
|
||||
$self->{gotheaders} = 1;
|
||||
$self->{readcount} = 0;
|
||||
my $opts = "";
|
||||
my $h = $self->{headers};
|
||||
# pass the '-f' option to sendmail, if the given
|
||||
# Envelope-Sender header is clean
|
||||
if (my $es = $h->{'envelope-sender'}) {
|
||||
if ($es =~ /^[\w\-\+\.]+\@[\w\-\.]+$/) {
|
||||
$opts = "-f $es";
|
||||
}
|
||||
}
|
||||
unless ($self->{sendmail} =
|
||||
IO::File->new("| /usr/sbin/sendmail -t -i $opts")) {
|
||||
$self->{err} = 1;
|
||||
}
|
||||
$self->close unless $h->{'content-length'} > 0 &&
|
||||
$h->{'content-length'} =~ /^\d+$/;
|
||||
|
||||
$bref = \$self->{line};
|
||||
last;
|
||||
}
|
||||
}
|
||||
}
|
||||
return unless $self->{gotheaders};
|
||||
|
||||
my $need = $self->{headers}{'content-length'} - $self->{readcount};
|
||||
my $len = length($$bref);
|
||||
|
||||
# if we read into the next message (pipelined messages)
|
||||
# then we need to push the overflow piece back into $overflow
|
||||
my $overflow;
|
||||
if ($len > $need) {
|
||||
my $needed = substr($$bref, 0, $need);
|
||||
$overflow = substr($$bref, $need);
|
||||
$bref = \$needed;
|
||||
$len = $need;
|
||||
}
|
||||
|
||||
$self->{readcount} += $len;
|
||||
if ($self->{sendmail} && ! $self->{err}) {
|
||||
$self->{sendmail}->print($$bref);
|
||||
$self->{err} = 1 if $! == EPIPE;
|
||||
}
|
||||
|
||||
# if we're done, close sendmail
|
||||
if ($len == $need) {
|
||||
if (! $self->{err} &&
|
||||
$self->{sendmail} &&
|
||||
$self->{sendmail}->close()) {
|
||||
$self->write("OK\r\n");
|
||||
} else {
|
||||
$self->write("FAIL\r\n");
|
||||
}
|
||||
$self->reset_for_next_message;
|
||||
$self->process_read_buf(\$overflow) if defined $overflow;
|
||||
}
|
||||
|
||||
$self->watch_read(1);
|
||||
}
|
||||
|
||||
|
||||
# Client
|
||||
sub event_err { my $self = shift; $self->close; }
|
||||
sub event_hup { my $self = shift; $self->close; }
|
||||
|
||||
# Local Variables:
|
||||
# mode: perl
|
||||
# c-basic-indent: 4
|
||||
# indent-tabs-mode: nil
|
||||
# End:
|
||||
Reference in New Issue
Block a user