initial version

diff --git a/perl/spiderd.pl b/perl/spiderd.pl
new file mode 100755 (executable)
index 0000000..bc63ff1
--- /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;
+