tools/quake3/q3map2/listen.pl

   1 #!/usr/bin/perl -w \r
   2 \r
   3 use IO::Socket;  \r
   4 use Net::hostent; \r
   5 \r
   6 my $port = shift || 13131; \r
   7 \r
   8 my $server = IO::Socket::INET->new(\r
   9         Proto => 'tcp', \r
  10         LocalPort => $port, \r
  11         Listen => SOMAXCONN, \r
  12         Reuse => 1 )\r
  13         || die "can't setup server"; \r
  14 print "[Q3Map2 listener $0 is now active on port $port]\n"; \r
  15 \r
  16 while( $client = $server->accept() )\r
  17 { \r
  18 \r
  19         $client->autoflush( 1 ); \r
  20         \r
  21         $hostinfo = gethostbyaddr( $client->peeraddr );\r
  22         printf "[Connect from %s]\n\n", $hostinfo ? $hostinfo->name : $client->peerhost; \r
  23         \r
  24         #ask the client for a command \r
  25         print $client "[server]\$";\r
  26         my $text = "";\r
  27         while( <$client> )\r
  28         {\r
  29                 $text .= $_;\r
  30                 while( $text =~ s|<message[^>]*>([^<]+)</message>|| )\r
  31                 {\r
  32                         my $msg = $1;\r
  33                         \r
  34                         # fix xml ents\r
  35                         $msg =~ s|&lt;|<|g;\r
  36                         $msg =~ s|&gt;|>|g;\r
  37                         $msg =~ s|&quot;|"|g;#"\r
  38                         $msg =~ s|&apos;|'|g;#'\r
  39                 \r
  40                         print $msg;\r
  41                 }\r
  42         }\r
  43         \r
  44         printf "\n[Disconnected: %s]\n\n", $hostinfo ? $hostinfo->name : $client->peerhost; \r
  45         close $client;\r
  46 } \r