99 lines
2.2 KiB
Perl
Executable File
99 lines
2.2 KiB
Perl
Executable File
#!/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;
|
|
}
|