3 # This is a forking server class (ofcourse it is :-)
5 # You can only have one of these running at a time, so there!
7 # I am not using AUTOLOAD at the moment in a general spirit
8 # of 'inat' (a wonderfully succinct serbo-croat word and state
9 # of being) - So there! Yah boo sucks! Won't! Nurps!
11 # Can I just say (as a policy statement) that I hope I never have
12 # to write any more C code (other than to extend or interface to perl).
14 # Copyright (c) 1999 - Dirk Koopman, Tobit Computer Co Ltd
19 package ForkingServer;
38 $self->{child} = eval $s;
42 $self->{port} = shift || 9000;
43 $self->{sort} = 'tcp';
44 $self->{sorry} = "Bog OFF!\n";
45 $self->{allow} = [ '^localhost\$', '^127.0.0' ];
46 return bless $self, $type;
53 $self->{port} = $port;
60 confess "sort must be tcp or udp" unless $sort eq 'tcp' || $sort eq 'udp';
61 $self->{sort} = $sort;
67 $self->{allow} = ref $_[0] ? shift : [ @_ ];
73 $self->{deny} = ref $_[0] ? shift : [ @_ ];
79 $self->{sorry} = shift;
85 $self->{quiet} = shift;
91 return $self->{parent};
97 my $server = IO::Socket::INET->new( Proto => $self->{sort},
98 LocalPort => $self->{port},
104 confess "bot: can't setup server $!" unless $server;
105 print "[Server $0 accepting clients on port $self->{port}]\n" unless $self->{quiet};
107 $SIG{CHLD} = \&reaper;
110 while ($client = $server->accept()) {
111 $client->autoflush(1);
112 my $hostinfo = gethostbyaddr($client->peeraddr);
113 my $hostname = $hostinfo->name;
114 my $ipaddr = $client->peerhost;
115 unless ($self->{quiet}) {
116 printf ("[Connect from %s %s]\n", $hostname, $ipaddr);
118 if ($self->{allow} && @{$self->{allow}}) {
119 unless ((grep { $hostname =~ /$_/ } @{$self->{allow}}) || (grep { $ipaddr =~ /$_/ } @{$self->{allow}})) {
120 print "{failed on allow}\n" unless $self->{quiet};
121 $client->print($self->{sorry});
126 if ($self->{deny} && @{$self->{deny}}) {
127 if ((grep { $hostname =~ /$_/ } @{$self->{deny}}) || (grep { $ipaddr =~ /$_/ } @{$self->{deny}})) {
128 print "{failed on deny}\n" unless $self->{quiet};
129 $client->print($self->{sorry});
135 # fork off a copy of myself, we don't exec, merely carry on regardless
136 # in the forked program, that should mean that we use the minimum of extra
137 # resources 'cos we are sharing everything already.
139 die "bot: can't fork" unless defined $pid;
143 print "{child $pid created}\n" unless $self->{quiet};
148 $SIG{'INT'} = $SIG{'TERM'} = $SIG{CHLD} = 'DEFAULT';
150 delete $self->{parent};
151 die "No Child function defined" unless $self->{child} && ref $self->{child};
152 &{$self->{child}}($client);
162 $SIG{CHLD} = \&reaper; # still loathe sysV