#!/usr/bin/perl -w
# Copyright (c) 2004 Sendmail, Inc. and its suppliers.
#	All rights reserved.
#
# Based on contribution by Bastiaan Bakker for SOCKETMAP
#
# ----------------------------------------
# Test server for socketmap.
# ----------------------------------------
#
# $Id: t-sockmapsrv.pl,v 1.3 2006/04/19 16:54:32 ca Exp $

use strict;
use IO::Socket;

die "usage: $0 <connection>" if (@ARGV < 1);
my $connection = shift @ARGV;
my $sock;

if ($connection =~ /tcp:(.+):([0-9]*)/) {
    $sock = new IO::Socket::INET (
				  LocalAddr => $1,
				  LocalPort => $2,
				  Proto => 'tcp',
				  Listen => 32,
				  ReuseAddr => 1
				  );
} elsif ($connection =~ /((unix)|(local)):(.+)/) {
    unlink($4);
    $sock = new IO::Socket::UNIX (
				  Type => SOCK_STREAM,
				  Local => $4,
				  Listen => 32
				  );
} else {
    die "unrecognized connection specification $connection";
}

while(my $client = $sock->accept()) {
    my $childpid = fork();
    if ($childpid) {
	$client->close();
    } else {
	die "can't fork $!" unless defined($childpid);
	$sock->close();
	handleConnection($client);
	$client->close();
	exit;
    }
}

$sock->close();

sub handleConnection {
    my $client = shift;
    $client->autoflush(1);

    while(!eof($client)) {
	eval {
	    my $request = netstringRead($client);	    
	    my ($mapName, $key) = split(' ', $request);
	    if ($key =~ /^TIMEOUT/) {
	      print STDERR "timeout\n";
	    }
	    else {
	      my $value = mapLookup($mapName, $key);
	      my $result = (defined($value)) ? "OK $value" : "NOTFOUND";
	      netstringWrite($client, $result);
	    }
	};
	if ($@) {
	    print STDERR "$@\n";
	    last;
	}
    }
}

sub mapLookup {
    my %mapping = ('bastiaan.bakker@example.com' => 'bastiaan', 
		   'wolter.eldering@example.com' => 'wolter@other.example.com'
		);
    my %amapping = (
		  'alias1' =>	'local:'
		, 'user1' =>	'local:'
		, 'user0' =>	'local:'
		, 'alias2' =>	'user1'
		, 'alias0' =>	'user0'
		, 'user2' =>	'local:'
		, 'list2' =>	'<user1@local.dom> <user2@local.dom> <alias0@local.dom>'
		, 'user3' =>	'<ext3@other.dom>'
		);
    my $mapName = shift;
    my $key = shift;
    my $value = undef;
    if ($mapName eq "virtuser") {
       $value = $mapping{$key};
    } elsif ($mapName eq "aliases") {
       $value = $amapping{$key};
    }
# print STDERR "map=", $mapName, ", key=", $key, ", value=", $value, "\n";
    return $value;
}

sub netstringWrite {
    my $sock = shift;
    my $data = shift;

    print $sock length($data).':'.$data.',';
}

sub netstringRead {
    my $sock = shift;
    my $saveSeparator = $/;
    $/ = ':';
    my $dataLength = <$sock>;
    die "cannot read netstring length" unless defined($dataLength);
    chomp $dataLength;
    my $data;
    if ($sock->read($data, $dataLength) == $dataLength) {
	($sock->getc() eq ',') or die "data misses closing ,";
    } else {
	die "received only ".length($data)." of $dataLength bytes";
    }
    
    $/ = $saveSeparator;
    return $data;
}