Webmail back open for business [ Was: Re: Webmail and probably some

[Dan Brosemer <odin@svartalfheim.net>]

other stuff out for a bit ]
Reply-To: 
In-Reply-To: <20020626225611.K29059@cleannorth.org>; from odin@svartalfheim.net on Wed, Jun 26, 2002 at 10:56:11PM -0400
Battlestar-Galactica-Date: 43649 centons, 21 microns, 11.11 lutefisk
Mail-Followup-To: techies@lists.cleannorth.org

On Wed, Jun 26, 2002 at 10:56:11PM -0400, Dan Brosemer wrote:
> 3. Jim is working on getting webmail going

Well, after an infuriating two days trying to figure out how to deal with
non-blocking IO on TCP sockets, I have made a little proxy that makes our
webmail client work.  (We went to squirrelmail because silkymail was giving
us way too much of a headache... little did I know squirrel would do
_this_!)  Squirrelmail doesn't support authentication by anything but
plaintext.  We don't support authentication by anything but CRAM-MD5... see
the problem?

So now we have a very simple IMAP proxy in the way which just converts the
plaintext authentication to CRAM-MD5 and passes everything else unperturbed.

Anyway, I'm including it here mainly so I don't lose it, but partially
because a few people on the list might be interested.  This is 130 lines of
perl I never want to write again!

---- begin imap-proxy.pl ----

#!/usr/bin/perl -w

use POSIX;
use IO::Socket;
use IO::Select;
use IO::Handle;
use Digest::HMAC_MD5 qw(hmac_md5_hex);
use MIME::Base64;

sub REAPER 
	{
		1 until (-1 == waitpid(-1, WNOHANG));
		$SIG{CHLD} = \&REAPER;
	};

$SIG{CHLD} = \&REAPER;

$server = IO::Socket::INET->new(
	LocalPort	=> 143,
	Type 			=> SOCK_STREAM,
	Reuse			=> 1,
	Listen		=> 10 )
or die "Couldn't be a tcp server on port 1143: $@\n";
my $select = IO::Select->new();

while ($client = $server->accept())
	{
		next if $pid = fork;
		die "fork: $!" unless defined $pid;
		close($server);
		serve($client, $select);
		exit;
	}
continue
	{
		close($client);
	};

sub serve
	{
		my $client = shift;
		my $select = shift;

		my $server = IO::Socket::INET->new(
			PeerAddr	=> '192.168.15.2',
			PeerPort	=> '143',
			Type 			=> SOCK_STREAM,
			Proto			=> 'tcp')
		or die "Couldn't connect to remote server: $@\n";

		$select->add($client);
		$select->add($server);
		$client->blocking(0);
		$server->blocking(0);
		my ($user, $pass) = ('','');
		my $wantchal = 0;

		# read data
		while(1)
			{
				foreach $selected ($select->can_read(1))
					{
						if ($selected == $client)
							{
								my $data = '';
								my $rv = $client->recv($data, POSIX::BUFSIZ, 0);
								#print "C: $data";
		
								if ($data =~ m/^A001 LOGIN "([^"]+)" "([^"]+)"/i)
									{
										($user, $pass) = ($1, $2);

										# need to fetch a challenge
										#print "asking for a challenge\n";
										print $server "A001 AUTHENTICATE CRAM-MD5\r\n";
										$wantchal = 1;
									}
								else
									{
										print $server $data;
									};
						
								unless (defined($rv) && length($data))
									{
										# client dropped connection
										closeconn($client, $server);
										return;
									};
							}
						elsif ($selected == $server)
							{	
								my $data = '';
								my $rv = $server->recv($data, POSIX::BUFSIZ, 0);
								#print "S: $data";
		
								if ($wantchal && ($data =~ m/^\+ (.+)/))
									{
										my $challenge = $1;
										$challenge = MIME::Base64::decode_base64($challenge);
										my $hmac = hmac_md5_hex($challenge, $pass);
										my $response = MIME::Base64::encode_base64("$user $hmac");
										#print "user: $user\n";
										#print "pass: $pass\n";
										#print "challenge: $challenge\n";
										#print "response: $response\n";
										print $server "$response\r\n";
										$wantchal = 0;
									}
								else
									{
										print $client $data;
									};

						
								unless (defined($rv) && length($data))
									{
										# server dropped connection
										closeconn($client, $server);
										return;
									};
							};
					};
			};
	};

sub closeconn
	{
		my ($client, $server) = @_;
		$select->remove($client);
		$select->remove($server);
		close $client;
		close $server;
	};

---- end imap-proxy.pl ----

-Dan

-- 
"Burnished gallows set with red
 Caress the fevered, empty mind
 Of man who hangs bloodied and blind
 To reach for wisdom, not for bread."  -- Deoridhe Grimsdaughter