1132943Sgshapiro#!/usr/bin/perl -w
2132943Sgshapiro#
3132943Sgshapiro# Contributed by Bastiaan Bakker for SOCKETMAP
4266527Sgshapiro# $Id: socketmapServer.pl,v 1.1 2003-05-21 15:36:33 ca Exp $
5132943Sgshapiro
6132943Sgshapirouse strict;
7132943Sgshapirouse IO::Socket;
8132943Sgshapiro
9132943Sgshapirodie "usage: $0 <connection>" if (@ARGV < 1);
10132943Sgshapiromy $connection = shift @ARGV;
11132943Sgshapiromy $sock;
12132943Sgshapiro
13132943Sgshapiroif ($connection =~ /tcp:(.+):([0-9]*)/) {
14132943Sgshapiro    $sock = new IO::Socket::INET (
15132943Sgshapiro				  LocalAddr => $1,
16132943Sgshapiro				  LocalPort => $2,
17132943Sgshapiro				  Proto => 'tcp',
18132943Sgshapiro				  Listen => 32,
19132943Sgshapiro				  ReuseAddr => 1
20132943Sgshapiro				  );
21132943Sgshapiro} elsif ($connection =~ /((unix)|(local)):(.+)/) {
22132943Sgshapiro    unlink($4);
23132943Sgshapiro    $sock = new IO::Socket::UNIX (
24132943Sgshapiro				  Type => SOCK_STREAM,
25132943Sgshapiro				  Local => $4,
26132943Sgshapiro				  Listen => 32
27132943Sgshapiro				  );
28132943Sgshapiro} else {
29132943Sgshapiro    die "unrecognized connection specification $connection";
30132943Sgshapiro}
31132943Sgshapiro
32132943Sgshapirowhile(my $client = $sock->accept()) {
33132943Sgshapiro    my $childpid = fork();
34132943Sgshapiro    if ($childpid) {
35132943Sgshapiro	$client->close();
36132943Sgshapiro    } else {
37132943Sgshapiro	die "can't fork $!" unless defined($childpid);
38132943Sgshapiro	$sock->close();
39132943Sgshapiro	handleConnection($client);
40132943Sgshapiro	$client->close();
41132943Sgshapiro	exit;
42132943Sgshapiro    }
43132943Sgshapiro}
44132943Sgshapiro
45132943Sgshapiro$sock->close();
46132943Sgshapiro
47132943Sgshapirosub handleConnection {
48132943Sgshapiro    my $client = shift;
49132943Sgshapiro    $client->autoflush(1);
50132943Sgshapiro
51132943Sgshapiro    while(!eof($client)) {
52132943Sgshapiro	eval {
53132943Sgshapiro	    my $request = netstringRead($client);
54132943Sgshapiro	    my ($mapName, $key) = split(' ', $request);
55132943Sgshapiro	    my $value = mapLookup($mapName, $key);
56132943Sgshapiro	    my $result = (defined($value)) ? "OK $value" : "NOTFOUND";
57132943Sgshapiro	    netstringWrite($client, $result);
58132943Sgshapiro	};
59132943Sgshapiro	if ($@) {
60132943Sgshapiro	    print STDERR "$@\n";
61132943Sgshapiro	    last;
62132943Sgshapiro	}
63132943Sgshapiro    }
64132943Sgshapiro}
65132943Sgshapiro
66132943Sgshapirosub mapLookup {
67132943Sgshapiro    my %mapping = ('bastiaan.bakker@example.com' => 'bastiaan',
68132943Sgshapiro		   'wolter.eldering@example.com' => 'wolter@other.example.com');
69132943Sgshapiro    my $mapName = shift;
70132943Sgshapiro    my $key = shift;
71132943Sgshapiro    my $value = ($mapName eq "virtuser") ? $mapping{$key} : undef;
72132943Sgshapiro    return $value;
73132943Sgshapiro}
74132943Sgshapiro
75132943Sgshapirosub netstringWrite {
76132943Sgshapiro    my $sock = shift;
77132943Sgshapiro    my $data = shift;
78132943Sgshapiro
79132943Sgshapiro    print $sock length($data).':'.$data.',';
80132943Sgshapiro}
81132943Sgshapiro
82132943Sgshapirosub netstringRead {
83132943Sgshapiro    my $sock = shift;
84132943Sgshapiro    my $saveSeparator = $/;
85132943Sgshapiro    $/ = ':';
86132943Sgshapiro    my $dataLength = <$sock>;
87132943Sgshapiro    die "cannot read netstring length" unless defined($dataLength);
88132943Sgshapiro    chomp $dataLength;
89132943Sgshapiro    my $data;
90132943Sgshapiro    if ($sock->read($data, $dataLength) == $dataLength) {
91132943Sgshapiro	($sock->getc() eq ',') or die "data misses closing ,";
92132943Sgshapiro    } else {
93132943Sgshapiro	die "received only ".length($data)." of $dataLength bytes";
94132943Sgshapiro    }
95132943Sgshapiro
96132943Sgshapiro    $/ = $saveSeparator;
97132943Sgshapiro    return $data;
98132943Sgshapiro}
99