perl/spiderd.pl

   1 #!/usr/bin/perl -w
   2 #
   3 # A text message handling demon
   4 #
   5 # Copyright (c) 1997 Dirk Koopman G1TLH
   6 #
   7 # $Id$
   8 #
   9 # $Log$
  10 # Revision 1.1  1997-11-26 00:55:39  djk
  11 # initial version
  12 #
  13 #
  14
  15 require 5.003;
  16 use Socket;
  17 use FileHandle;
  18 use Carp;
  19
  20 $mycall = "GB7DJK";
  21 $listenport = 5072;
  22
  23 #
  24 # system variables
  25 #
  26
  27 $version = "1";
  28 @port = ();     # the list of active ports (filehandle, $name, $sort, $device, $port, $ibufp, $ibuf, $obufp, $obuf, $prog)
  29 @msg = ();      # the list of messages
  30
  31
  32 #
  33 # stop everything and exit
  34 #
  35 sub terminate
  36 {
  37    print "closing spiderd\n";
  38    exit(0);
  39 }
  40
  41 #
  42 # start the tcp listener
  43 #
  44 sub startlisten
  45 {
  46    my $proto = getprotobyname('tcp');
  47    my $h = new FileHandle;
  48
  49    socket($h, PF_INET, SOCK_STREAM, $proto)               or die "Can't open listener socket: $!";
  50    setsockopt($h, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)) or die "Can't set SO_REUSEADDR: $!";
  51    bind($h, sockaddr_in($listenport, INADDR_ANY))         or die "Can't bind listener socket: $!";
  52    listen($h, SOMAXCONN)                                  or die "Error on listen: $!";
  53    push @port, [ $h, "Listener", "listen", "localhost", $listenport, 0, "", 0, "", "spider" ];
  54    print "listening on port $listenport\n";
  55 }
  56
  57 #
  58 # close a tcp connection
  59 #
  60 sub close_con
  61 {
  62    my ($p) = @_;
  63    close($port[$p][0]);
  64    print "closing ", $port[$p][3], $port[$p][4];
  65    splice @port, $p, 1;    # remove it from the list
  66    my $n = @port;
  67    print ", there are $n connections\n";
  68 }
  69
  70 #
  71 # the main select loop for incoming data
  72 #
  73 sub doselect
  74 {
  75    my $rin = "";
  76    my $i;
  77    my $r;
  78    my $h;
  79    my $maxport = 0;
  80
  81    # set up the bit mask(s)
  82    for $i (0 .. $#port) {
  83       $h = fileno($port[$i][0]);
  84       vec($rin, $h, 1) = 1;
  85           $maxport = $h if $h > $maxport;
  86    }
  87
  88    $r = select($rin, undef, undef, 0.001);
  89    die "Error $! during select" if ($r < 0);
  90    if ($r > 0) {
  91 #       print "input $r handles\n";
  92        for $i (0 .. $#port) {
  93            $h = $port[$i][0];
  94                if (vec($rin, fileno($h), 1)) {     # we have some input!
  95                        my $sort = $port[$i][2];
  96
  97                            if ($sort eq "listen") {
  98                                my @entry;
  99                                    my $ch = new FileHandle;
 100                                    my $paddr = accept($ch, $h);
 101                                    my ($port, $iaddr) = sockaddr_in($paddr);
 102                                    my $name = gethostbyaddr($iaddr, AF_INET);
 103                                    my $dotquad = inet_ntoa($iaddr);
 104                                    my @rec = ( $ch, "unknown", "tcp", $name, $port, 0, "", 0, "", "unknown" );
 105
 106                                    push @port, [ @rec ];    # add a new entry to be selected on
 107                                    my $n = @port;
 108                                    print "new connection from $name ($dotquad) port: $port, there are $n connections\n";
 109                                    my $hello = join('|', ("HELLO",$mycall,"spiderd",$version)) . "\n";
 110                                    $ch->autoflush(1);
 111                                    print $ch $hello;
 112                            } else {
 113                            my $buf;
 114                                    $r = sysread($h, $buf, 128);
 115                                    if ($r == 0) {          # close the filehandle and remove it from the list of ports
 116                                        close_con($i);
 117                                            last;               # return, 'cos we will get the array subscripts in a muddle
 118                                    } elsif ($r > 0) {
 119                                        # we have a buffer full, search for a terminating character, cut it out
 120                                            # and add it to the saved buffer, write the saved buffer away to the message
 121                                            # list
 122                                            $buf =~ /^(.*)[\r\n]+$/s;
 123                                            if ($buf =~ /[\r\n]+$/) {
 124                                                $buf =~ s/[\r\n]+$//;
 125                                                push @msg, [ $i, $port[$i][6] . $buf ];
 126                                                    $port[$i][6] = "";
 127                                            } else {
 128                                                $port[$i][6] .= $buf;
 129                                            }
 130                                    }
 131                            }
 132                    }
 133            }
 134    }
 135 }
 136
 137 #
 138 # process each message on the queue
 139 #
 140
 141 sub processmsg
 142 {
 143    return if @msg == 0;
 144
 145    my $list = shift @msg;
 146    my ($p, $msg) = @$list;
 147    my @m = split /\|/, $msg;
 148    my $hand = $port[$p][0];
 149    print "msg (port $p) = ", join(':', @m), "\n";
 150
 151    # handle basic cases
 152    $m[0] = uc $m[0];
 153
 154    if ($m[0] eq "QUIT" || $m[0] eq "BYE") {
 155        close_con($p);
 156            return;
 157    }
 158    if ($m[0] eq "HELLO") {      # HELLO|<call>|<prog>|<version>
 159        $port[$p][1] = uc $m[1] if $m[1];
 160            $port[$p][9] = $m[2] if $m[2];
 161            print uc $m[1], " has just joined the message switch\n";
 162            return;
 163    }
 164    if ($m[0] eq "CONFIG") {
 165        my $i;
 166            for $i ( 0 .. $#port ) {
 167                my ($h, $call, $sort, $addr, $pt) = @{$port[$i]};
 168                    my $p = join('|', ("CONFIG",$mycall,$i,$call,$sort,$addr,$pt,$port[$i][9])) . "\n";
 169                    print $hand $p;
 170            }
 171            return;
 172    }
 173 }
 174
 175
 176 #
 177 # the main loop, this impliments the select which drives the whole thing round
 178 #
 179 sub main
 180 {
 181    for (;;) {
 182        doselect;
 183        processmsg;
 184    }
 185 }
 186
 187 #
 188 # main program
 189 #
 190
 191 $SIG{TERM} = \&terminate;
 192 $SIG{INT} = \&terminate;
 193
 194 startlisten;
 195 main;
 196