1 files changed, 98 insertions, 0 deletions
diff --git a/sendmail/contrib/socketmapServer.pl b/sendmail/contrib/socketmapServer.pl
new file mode 100755
index 0000000..153e9ef
--- /dev/null
+++ b/sendmail/contrib/socketmapServer.pl
@@ -0,0 +1,98 @@
+#!/usr/bin/perl -w
+#
+# Contributed by Bastiaan Bakker for SOCKETMAP
+# $Id: socketmapServer.pl,v 1.1 2003/05/21 15:36:33 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);
+	    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 $mapName = shift;
+    my $key = shift;
+    my $value = ($mapName eq "virtuser") ? $mapping{$key} : undef;
+    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;
+}