From 11143767eb1dec9bd3a351cc69836bf2f3fe1d9b Mon Sep 17 00:00:00 2001
From: djk <djk>
Date: Wed, 26 Nov 1997 00:55:39 +0000
Subject: [PATCH] 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|<call>|<prog>|<version>
+       $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.34.1