contrib/sendmail-8.13.7/contrib/socketmapServer.pl

   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
   6 use strict;
   7 use IO::Socket;
   8
   9 die "usage: $0 <connection>" if (@ARGV < 1);
  10 my $connection = shift @ARGV;
  11 my $sock;
  12
  13 if ($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
  32 while(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
  47 sub 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
  66 sub 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
  75 sub netstringWrite {
  76     my $sock = shift;
  77     my $data = shift;
  78
  79     print $sock length($data).':'.$data.',';
  80 }
  81
  82 sub 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 }