socketmapServer.pl revision 132943
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