mirror of
https://github.com/TTimo/GtkRadiant.git
synced 2025-01-10 03:51:18 +00:00
...
git-svn-id: svn://svn.icculus.org/gtkradiant/GtkRadiant/branches/ZeroRadiant.ab@189 8a3a26a2-13c4-0310-b231-cf6edde360e5
This commit is contained in:
parent
beb511aadb
commit
d77fee7551
1 changed files with 46 additions and 46 deletions
|
@ -1,46 +1,46 @@
|
||||||
#!/usr/bin/perl -w
|
#!/usr/bin/perl -w
|
||||||
|
|
||||||
use IO::Socket;
|
use IO::Socket;
|
||||||
use Net::hostent;
|
use Net::hostent;
|
||||||
|
|
||||||
my $port = shift || 13131;
|
my $port = shift || 13131;
|
||||||
|
|
||||||
my $server = IO::Socket::INET->new(
|
my $server = IO::Socket::INET->new(
|
||||||
Proto => 'tcp',
|
Proto => 'tcp',
|
||||||
LocalPort => $port,
|
LocalPort => $port,
|
||||||
Listen => SOMAXCONN,
|
Listen => SOMAXCONN,
|
||||||
Reuse => 1 )
|
Reuse => 1 )
|
||||||
|| die "can't setup server";
|
|| die "can't setup server";
|
||||||
print "[Q3Map2 listener $0 is now active on port $port]\n";
|
print "[Q3Map2 listener $0 is now active on port $port]\n";
|
||||||
|
|
||||||
while( $client = $server->accept() )
|
while( $client = $server->accept() )
|
||||||
{
|
{
|
||||||
|
|
||||||
$client->autoflush( 1 );
|
$client->autoflush( 1 );
|
||||||
|
|
||||||
$hostinfo = gethostbyaddr( $client->peeraddr );
|
$hostinfo = gethostbyaddr( $client->peeraddr );
|
||||||
printf "[Connect from %s]\n\n", $hostinfo ? $hostinfo->name : $client->peerhost;
|
printf "[Connect from %s]\n\n", $hostinfo ? $hostinfo->name : $client->peerhost;
|
||||||
|
|
||||||
#ask the client for a command
|
#ask the client for a command
|
||||||
print $client "[server]\$";
|
print $client "[server]\$";
|
||||||
my $text = "";
|
my $text = "";
|
||||||
while( <$client> )
|
while( <$client> )
|
||||||
{
|
{
|
||||||
$text .= $_;
|
$text .= $_;
|
||||||
while( $text =~ s|<message[^>]*>([^<]+)</message>|| )
|
while( $text =~ s|<message[^>]*>([^<]+)</message>|| )
|
||||||
{
|
{
|
||||||
my $msg = $1;
|
my $msg = $1;
|
||||||
|
|
||||||
# fix xml ents
|
# fix xml ents
|
||||||
$msg =~ s|<|<|g;
|
$msg =~ s|<|<|g;
|
||||||
$msg =~ s|>|>|g;
|
$msg =~ s|>|>|g;
|
||||||
$msg =~ s|"|"|g;#"
|
$msg =~ s|"|"|g;#"
|
||||||
$msg =~ s|'|'|g;#'
|
$msg =~ s|'|'|g;#'
|
||||||
|
|
||||||
print $msg;
|
print $msg;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
printf "\n[Disconnected: %s]\n\n", $hostinfo ? $hostinfo->name : $client->peerhost;
|
printf "\n[Disconnected: %s]\n\n", $hostinfo ? $hostinfo->name : $client->peerhost;
|
||||||
close $client;
|
close $client;
|
||||||
}
|
}
|
||||||
|
|
Loading…
Reference in a new issue