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