socketmapServer.pl revision 266692 
1#!/usr/bin/perl -w
2#
3# Contributed by Bastiaan Bakker for SOCKETMAP
4# $Id: socketmapServer.pl,v 1.1 2003-05-21 15:36:33 ca Exp $
5
6use strict;
7use IO::Socket;
8
9die "usage: $0 <connection>" if (@ARGV < 1);
10my $connection = shift @ARGV;
11my $sock;
12
13if ($connection =~ /tcp:(.+):([0-9]*)/) {
14    $sock = new IO::Socket::INET (
15				  LocalAddr => $1,
16				  LocalPort => $2,
17				  Proto => 'tcp',
18				  Listen => 32,
19				  ReuseAddr => 1
20				  );
21} elsif ($connection =~ /((unix)|(local)):(.+)/) {
22    unlink($4);
23    $sock = new IO::Socket::UNIX (
24				  Type => SOCK_STREAM,
25				  Local => $4,
26				  Listen => 32
27				  );
28} else {
29    die "unrecognized connection specification $connection";
30}
31
32while(my $client = $sock->accept()) {
33    my $childpid = fork();
34    if ($childpid) {
35	$client->close();
36    } else {
37	die "can't fork $!" unless defined($childpid);
38	$sock->close();
39	handleConnection($client);
40	$client->close();
41	exit;
42    }
43}
44
45$sock->close();
46
47sub handleConnection {
48    my $client = shift;
49    $client->autoflush(1);
50
51    while(!eof($client)) {
52	eval {
53	    my $request = netstringRead($client);
54	    my ($mapName, $key) = split(' ', $request);
55	    my $value = mapLookup($mapName, $key);
56	    my $result = (defined($value)) ? "OK $value" : "NOTFOUND";
57	    netstringWrite($client, $result);
58	};
59	if ($@) {
60	    print STDERR "$@\n";
61	    last;
62	}
63    }
64}
65
66sub mapLookup {
67    my %mapping = ('bastiaan.bakker@example.com' => 'bastiaan',
68		   'wolter.eldering@example.com' => 'wolter@other.example.com');
69    my $mapName = shift;
70    my $key = shift;
71    my $value = ($mapName eq "virtuser") ? $mapping{$key} : undef;
72    return $value;
73}
74
75sub netstringWrite {
76    my $sock = shift;
77    my $data = shift;
78
79    print $sock length($data).':'.$data.',';
80}
81
82sub netstringRead {
83    my $sock = shift;
84    my $saveSeparator = $/;
85    $/ = ':';
86    my $dataLength = <$sock>;
87    die "cannot read netstring length" unless defined($dataLength);
88    chomp $dataLength;
89    my $data;
90    if ($sock->read($data, $dataLength) == $dataLength) {
91	($sock->getc() eq ',') or die "data misses closing ,";
92    } else {
93	die "received only ".length($data)." of $dataLength bytes";
94    }
95
96    $/ = $saveSeparator;
97    return $data;
98}
99