Fix kldstat option.
[dragonfly.git] / contrib / sendmail-8.13.4 / 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 }