3 # A text message handling demon
5 # Copyright (c) 1997 Dirk Koopman G1TLH
10 # Revision 1.1 1997-11-26 00:55:39 djk
28 @port = (); # the list of active ports (filehandle, $name, $sort, $device, $port, $ibufp, $ibuf, $obufp, $obuf, $prog)
29 @msg = (); # the list of messages
33 # stop everything and exit
37 print "closing spiderd\n";
42 # start the tcp listener
46 my $proto = getprotobyname('tcp');
47 my $h = new FileHandle;
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";
58 # close a tcp connection
64 print "closing ", $port[$p][3], $port[$p][4];
65 splice @port, $p, 1; # remove it from the list
67 print ", there are $n connections\n";
71 # the main select loop for incoming data
81 # set up the bit mask(s)
82 for $i (0 .. $#port) {
83 $h = fileno($port[$i][0]);
85 $maxport = $h if $h > $maxport;
88 $r = select($rin, undef, undef, 0.001);
89 die "Error $! during select" if ($r < 0);
91 # print "input $r handles\n";
92 for $i (0 .. $#port) {
94 if (vec($rin, fileno($h), 1)) { # we have some input!
95 my $sort = $port[$i][2];
97 if ($sort eq "listen") {
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" );
106 push @port, [ @rec ]; # add a new entry to be selected on
108 print "new connection from $name ($dotquad) port: $port, there are $n connections\n";
109 my $hello = join('|', ("HELLO",$mycall,"spiderd",$version)) . "\n";
114 $r = sysread($h, $buf, 128);
115 if ($r == 0) { # close the filehandle and remove it from the list of ports
117 last; # return, 'cos we will get the array subscripts in a muddle
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
122 $buf =~ /^(.*)[\r\n]+$/s;
123 if ($buf =~ /[\r\n]+$/) {
124 $buf =~ s/[\r\n]+$//;
125 push @msg, [ $i, $port[$i][6] . $buf ];
128 $port[$i][6] .= $buf;
138 # process each message on the queue
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";
154 if ($m[0] eq "QUIT" || $m[0] eq "BYE") {
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";
164 if ($m[0] eq "CONFIG") {
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";
177 # the main loop, this impliments the select which drives the whole thing round
191 $SIG{TERM} = \&terminate;
192 $SIG{INT} = \&terminate;