From 11143767eb1dec9bd3a351cc69836bf2f3fe1d9b Mon Sep 17 00:00:00 2001 From: djk Date: Wed, 26 Nov 1997 00:55:39 +0000 Subject: [PATCH 1/1] initial version --- perl/spiderd.pl | 196 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 196 insertions(+) create mode 100755 perl/spiderd.pl diff --git a/perl/spiderd.pl b/perl/spiderd.pl new file mode 100755 index 00000000..bc63ff18 --- /dev/null +++ b/perl/spiderd.pl @@ -0,0 +1,196 @@ +#!/usr/bin/perl -w +# +# A text message handling demon +# +# Copyright (c) 1997 Dirk Koopman G1TLH +# +# $Id$ +# +# $Log$ +# Revision 1.1 1997-11-26 00:55:39 djk +# initial version +# +# + +require 5.003; +use Socket; +use FileHandle; +use Carp; + +$mycall = "GB7DJK"; +$listenport = 5072; + +# +# system variables +# + +$version = "1"; +@port = (); # the list of active ports (filehandle, $name, $sort, $device, $port, $ibufp, $ibuf, $obufp, $obuf, $prog) +@msg = (); # the list of messages + + +# +# stop everything and exit +# +sub terminate +{ + print "closing spiderd\n"; + exit(0); +} + +# +# start the tcp listener +# +sub startlisten +{ + my $proto = getprotobyname('tcp'); + my $h = new FileHandle; + + socket($h, PF_INET, SOCK_STREAM, $proto) or die "Can't open listener socket: $!"; + setsockopt($h, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)) or die "Can't set SO_REUSEADDR: $!"; + bind($h, sockaddr_in($listenport, INADDR_ANY)) or die "Can't bind listener socket: $!"; + listen($h, SOMAXCONN) or die "Error on listen: $!"; + push @port, [ $h, "Listener", "listen", "localhost", $listenport, 0, "", 0, "", "spider" ]; + print "listening on port $listenport\n"; +} + +# +# close a tcp connection +# +sub close_con +{ + my ($p) = @_; + close($port[$p][0]); + print "closing ", $port[$p][3], $port[$p][4]; + splice @port, $p, 1; # remove it from the list + my $n = @port; + print ", there are $n connections\n"; +} + +# +# the main select loop for incoming data +# +sub doselect +{ + my $rin = ""; + my $i; + my $r; + my $h; + my $maxport = 0; + + # set up the bit mask(s) + for $i (0 .. $#port) { + $h = fileno($port[$i][0]); + vec($rin, $h, 1) = 1; + $maxport = $h if $h > $maxport; + } + + $r = select($rin, undef, undef, 0.001); + die "Error $! during select" if ($r < 0); + if ($r > 0) { +# print "input $r handles\n"; + for $i (0 .. $#port) { + $h = $port[$i][0]; + if (vec($rin, fileno($h), 1)) { # we have some input! + my $sort = $port[$i][2]; + + if ($sort eq "listen") { + my @entry; + my $ch = new FileHandle; + my $paddr = accept($ch, $h); + my ($port, $iaddr) = sockaddr_in($paddr); + my $name = gethostbyaddr($iaddr, AF_INET); + my $dotquad = inet_ntoa($iaddr); + my @rec = ( $ch, "unknown", "tcp", $name, $port, 0, "", 0, "", "unknown" ); + + push @port, [ @rec ]; # add a new entry to be selected on + my $n = @port; + print "new connection from $name ($dotquad) port: $port, there are $n connections\n"; + my $hello = join('|', ("HELLO",$mycall,"spiderd",$version)) . "\n"; + $ch->autoflush(1); + print $ch $hello; + } else { + my $buf; + $r = sysread($h, $buf, 128); + if ($r == 0) { # close the filehandle and remove it from the list of ports + close_con($i); + last; # return, 'cos we will get the array subscripts in a muddle + } elsif ($r > 0) { + # we have a buffer full, search for a terminating character, cut it out + # and add it to the saved buffer, write the saved buffer away to the message + # list + $buf =~ /^(.*)[\r\n]+$/s; + if ($buf =~ /[\r\n]+$/) { + $buf =~ s/[\r\n]+$//; + push @msg, [ $i, $port[$i][6] . $buf ]; + $port[$i][6] = ""; + } else { + $port[$i][6] .= $buf; + } + } + } + } + } + } +} + +# +# process each message on the queue +# + +sub processmsg +{ + return if @msg == 0; + + my $list = shift @msg; + my ($p, $msg) = @$list; + my @m = split /\|/, $msg; + my $hand = $port[$p][0]; + print "msg (port $p) = ", join(':', @m), "\n"; + + # handle basic cases + $m[0] = uc $m[0]; + + if ($m[0] eq "QUIT" || $m[0] eq "BYE") { + close_con($p); + return; + } + if ($m[0] eq "HELLO") { # HELLO||| + $port[$p][1] = uc $m[1] if $m[1]; + $port[$p][9] = $m[2] if $m[2]; + print uc $m[1], " has just joined the message switch\n"; + return; + } + if ($m[0] eq "CONFIG") { + my $i; + for $i ( 0 .. $#port ) { + my ($h, $call, $sort, $addr, $pt) = @{$port[$i]}; + my $p = join('|', ("CONFIG",$mycall,$i,$call,$sort,$addr,$pt,$port[$i][9])) . "\n"; + print $hand $p; + } + return; + } +} + + +# +# the main loop, this impliments the select which drives the whole thing round +# +sub main +{ + for (;;) { + doselect; + processmsg; + } +} + +# +# main program +# + +$SIG{TERM} = \&terminate; +$SIG{INT} = \&terminate; + +startlisten; +main; + -- 2.43.0