WolfAdminBot

Hey, i hope you can help me out here,

WAB should read every new line of the logfile(appending). so when someone says something, it should know Who said it and what the person said.

In the logfile you should find a line like this:

	Code:
	22:47 say: dutchmeat: admintest

This is the code in WAB, wich searches it:

Code:

sub SplitSay
{
my $self = shift;
my $Say = shift;

## need the space. Otherwise, given spifman as a nick, you could change
## your nick to spifman:kick, then just say someone's name and
## they'll be kicked. (when spifman is online, and is an admin)

if($Say =~ /^(.+?)\: (.+)$/)
{
my $Sayer = $1;
my $Said = $2;

# $Sayer = StripNameControlCodes($Sayer);
# $Sayer = StripLeadingAndTrailingWhiteSpace($Sayer);
$Said = StripLeadingAndTrailingWhiteSpace($Said);

return($Sayer, $Said);
}
else
{
$self->DebugLog("ERR! Unrecognized SAY command \<$Say\>");
return(undef, undef);
}}

and this is the code wich calls 'splitsay':

Code:

sub _Say
{
my $self = shift;
my $Timestamp = shift;
my $Type = shift;
my $Args = shift;

my ($User, $Said) = $self->SplitSay($Args);
my $RawUser = $User;

#Stat only returns the first 31 chars of the name. But Say
#can return the whole thing. So, let's chop it at 31
#so we can get a good match.

$User = substr($User, 0, 31);

$User = StripNameControlCodes($User);
$User = StripLeadingAndTrailingWhiteSpace($User);

my @Clients = $self->FindClientsFromName($User);

if($#Clients == 0)
{
$self->LogPlayer($Type,
      $Clients[0],
      $Said);
}
elsif($#Clients > 0)
{
for(my $x = 0; $x <= $#Clients; ++$x)
{
   $self->LogPlayer("COLLISION$Type",
         $Clients[$x],
         $Said);
}
}
else
{
$self->Log("UNKNOWN1$Type\t", $User, $Said);
}

#Only handle commands from users we've authenticated:
if($#Clients == 0)
{
$self->HandleCommand($Clients[0], $Said);
}
}

but in TCE i often get the 'Unknown1Say' in the logfile... so there something wrong...
can you help me out?

Thanks in advance,

Dutchmeat

Hi,
s*$%meat!

perhaps first you introduce yourself.

Next, I have absolutly no idea what you talking about.

But well, perhaps some of the others know what you are talking about and can help you with your problem.

regards
bull

_________________

Hey,
I totaly forgot to introduce,
Well, i'm Dutchmeat, i've been in the rtcw demo community for a while, and i was/am part of the communities 'Gamingneelix' and the all famous 'GamingUk.net'. I'm a modder, and i've created mods for rtcwdemo like 'New Generation Mod', and the antinuke 'Main mod:http://home.deds.nl/~dutchmeat/'
And my latest project: Wolf Admin Bot for ET:TCE.
My previous message was directed to 'test-dr'.
On rtcw(demo) the wolfadminbot works perfectly, but in ET:TCE it got some bugs, like recognizing the Say strings in the logfile.
I hope i gave you enough info,

Dutchmeat

but first @bull: he asked me about his perl-coding prob in tce while we were playing - and i dont wanted to chat during play ... worse enough for my skills ...., i told him to post it and i may look about it ....

@dutchmen:
what you wanna do is to split the command after a ":", but when you look about $1, $2 you only get the first 2 parts. If there is an " :" at the first in the line, then you get 2 parts with the first only blank and $2 will have all of the rest.
So first you should change the return from split_say to return: return($Sayer, $Said, $say);
and in the function-call: my ($User, $Said, $tosplit) = self->SplitSay($Args);
and in error-log: $self->Log("UNKNOWN1$Type\t", $User, $Said, $tosplit);
BUT how does the Log-Write do it? Maybe first put all three: $User,$Said, $tosplit in one string and write this with "Log".
You need to see the text, which cannot be processed the right way.

may be cause the reg.expr. works too on something like: " : no more"
so i think there should be -no space- at the start of the line. But this all is only from what i saw user-chatting and user-nicknames (there some with : in it!!) and chatt-texts often are longer than one line, several lines...

_________________

only testing .... --- damn, another uncovered bug

but it should only read the two things: name:text so that should be good,
here's the wab.log error:

	Code:
	Mon Apr 24 10:44:01 2006:7:01:UNKNOWN1SAY dutchmeat hello Mon Apr 24 10:44:04 2006:7:03:UNKNOWN1SAY dutchmeat admintest

As you can see, the wab should recognize the user and text... i don't understand why it fails as unknown say.

ok ... besides you may ever fail if there are some stupid players like:

	Code:
	<FuryS> :: BlackMoon^7: ^7^qVisit Us @ www.FuryS-Clan.nl.tt

what i can see ... but again to the problem,

after the splitting is the check about the @Clients found:
my @Clients = $self->FindClientsFromName($User);
and the test (3 if.. elseif, else)
a: if there is 1 found (== count of 0, because perl starts with 0)
b: or there are more than 1 found ($#Clients > 0)
c: and the last else, where none is found (thats -1 in perl, an empty array)

so if this log-messages gets triggered, there is no Client found in FindClientsFromName($User) - what does it? Sorry, but the first time i did not look deeper into the if .. elseif .. else branch ... - so it looks like it is not the split-sub, its the fail of User-Client-name-find.

_________________

only testing .... --- damn, another uncovered bug

so i should rewrite the clientfind?
i hope you could asist me...

first make shure its now the right place to look for!

so put into the:

	Code:
	else { $self->Log("UNKNOWN1$Type\t", $User, $Said); }

an additional Log-output and cause i dont know if the Log-sub
needs always 3 arguments.... i put the dummy "-" in. Test it, and
tell me what the log now tells. You should now always get a list
of all users in the @Client array and can check against the searched
user-name.

	Code:
	else { $self->Log("modfied", "-", "-"); $self->Log("UNKNOWN1$Type\t", $User, $Said); my $str = join("#", @Clients); $self->Log("look for:$User: in the Clients:$str", "-", "-"); }

it should show that the @Clients arraw is empty ... so i need the part of the findclient sub too.

_________________

only testing .... --- damn, another uncovered bug

The new wab.log:

	Code:
	Mon Apr 24 22:25:57 2006:0:51:modfied - - Mon Apr 24 22:25:57 2006:0:51:UNKNOWN1SAY dutchmeat hello Mon Apr 24 22:25:57 2006:0:51:look for:dutchmeat: in the Clients: - -

the clientfind sub:

Code:

sub FindClientsFromName
{
my $self = shift;
my $Name = shift || undef;
my @Matches;

#If it's 2 people with the same GUID, we'll call them the same people
#for our purposes.
my $GUID;

if(defined($Name))
{
foreach my $Client (keys(%{$self->{Player}}))
{
   if(defined($self->{Player}{$Client}{name}) &&
   $self->{Player}{$Client}{name} eq $Name)
   {
   if($self->{State}{PBEnabled})
   {
      if(!defined($GUID))
      {
      $GUID = $self->{Player}{$Client}{guid}
      if(defined($self->{Player}{$Client}{guid}));
      }
      else
      {
      next if($self->{Player}{$Client}{guid} eq $GUID);
      }
   }
   push(@Matches, $Client);
   }
}
}

return(@Matches);
}

As you can see, it checks if 'PBenabled' is on. This variable enables the option to use 'pb_sv_plist' instead of 'status'.
but i also get a 'malformed punkbuster response' so either the pb_sv_plist was changed in ET or it just doesn't work.
This is the debuglog that says malformed:

	Code:
	Mon Apr 24 22:36:07 2006:2:22:Malformed PB response: <^3PunkBuster Server: 1 ddcc17b9e988da991404292c11b5b5b5(VALID:20) 192.168.0.176:27961 INIT 1 0.0 0 ( ) dutchmeat>

This is the sub that fetches the pblist:

Code:

sub Stat
{
my $self = shift;
my @Players;

return if(!$self->{Args}{do_stat});

# $self->DebugLog("Entering Stat");

$self->ClearOldBans();

if(!$self->Continue())
{
$self->DebugLog("Exiting stat because Continue() returned 0");
return(0);
}

$self->{"State"}{"LastPoll"} = time();

if($self->{Args}{"no_stat"})
{
$self->DebugLog("Exiting stat because Args->no_stat is true");
return(0);
}

my @Response;
my %GUID;

if($self->{Config}{server}{use_punkbuster})
{
@Response = $self->RCONCmd(1, "pb_sv_plist");
if($Response[0] !~ /PunkBuster Server is currently Disabled/)
{
   $self->{State}{PBEnabled} = 1;
   if($Response[0] =~ /^(.*)\: Player List:/)
   {
   my $PBString = $1;

   #< to skip the "end of" message at the end
   for(my $x = 1; $x < $#Response; ++$x)
   {
      my @Fields;
      if(@Fields = ($Response[$x] =~
            /^.*:\s+(\d{1,2})\s+(.{32}) (\d+\.\d+\.\d+\.\d+)\:[\d\-]+ (.{4}) (\d+\.\d+) (\d+) ($.*$) (.*)$/))
      {
      #!^%$!^$!*&^#!
      #PB uses a different client ID that wolf - it's 1
      #based!
      my %PBInfo = ('client_id' => $Fields[0] - 1,
            'guid' => $Fields[1],
            'ip' => $Fields[2],
            'status' => $Fields[3],
            'auth_rate' => $Fields[4],
            'recent_ss' => $Fields[5],
            'os' => $Fields[6],
            'name' => $Fields[7]);

      $GUID{$PBInfo{client_id}} = $PBInfo{guid};
#       $self->DebugLog($PBInfo{client_id},
#             $PBInfo{guid},
#             $PBInfo{ip},
#             $PBInfo{name});
      }
      else
      {
      $self->DebugLog("Malformed PB response: \<$Response[$x]\>");
      }
   }
   }
   else
   {
   $self->DebugLog("Malformed PB response: \<$Response[0]\>");
   }
}
else
{
   $self->{State}{PBEnabled} = 0;
}
}

@Response = $self->RCONCmd(1, "status");

# $self->DebugLog("Got $#Response lines back from status command");

for(my $x = 0; $x <= $#Response; ++$x)
{
my @Fields;
@Fields = split("\t", $Response[$x]);

if($#Fields < 7)
{
   #So, the new Linux wolf uses "fixed length" fields, instead of tab
   #delimiters. What's it do if a field is too long? IT OVERFLOWS!
   #F'n brilliant. Thankfully, since the name is the only field that
   #will overflow, it's reasonably easy to fix (in perl):
   @Fields = ($Response[$x] =~
      /^(.{3})(.{6})(.{6})(.*)(.{7})(.{22})(.{6})(.{6})\s*$/);
}
# $self->DebugLog("status line: ($#Fields) \<$Response[$x]\>");
for(my $x = 0; $x <= $#Fields; ++$x)
{
   if($x != 3)
   {
   #Don't strip leading and trailing space from names; we need
   #that, later
   $Fields[$x] = StripLeadingAndTrailingWhiteSpace($Fields[$x]);
   }
}

if($self->IsStatPlayer(@Fields))
{
   if(defined($GUID{$Fields[0]}))
   {
   push(@Fields, $GUID{$Fields[0]});
   }

   #This check is needed because PB sometimes takes some time to get
   #an answer from its server. If PB is enabled, we can't log someone
   #in, definitively, until we get a GUID.
   if(!$self->{State}{PBEnabled} ||
   $#Fields == 8)
   {
   if($self->CreateOrUpdateClientInfo($self->{State}{LastTimestamp},
                  @Fields))
   {
      $self->ProcessLogin($Fields[0]);
   }
   }
}
}

return(1);
}

I don't know much of the punkbuster command maybe you do.

If the PBenable is disabled it works good/but sometimes it doesn't recognizes the players.
I think ET changed alot in their logfiles, another 'error':

	Code:
	Mon Apr 24 22:39:14 2006:5:33:Unrecognized ClientUserinfoChanged: <0 n\dutchmeat\t\3\c\0\r\0\m\0000000\s\0000000\dn\\dr\0\w\10\lw\10\sw\0\mu\0\ref\0>

The wab code:

Code:

sub ClientUserInfoChanged
{
my $self = shift;
my $Timestamp = shift;
my $Args = shift;
my $OldName;
my $OldTeam;

# $self->DebugLog("CUIC \<$Args\>");

if(my ($Client, $Name, $Team, $Class) =
($Args =~
/^\s*(\d+)\s+n\\(.*)\s*\\t\\\d+\\(?:model|m)\\([^\\]+)\/([^\\\/]+)[\\\/]/))
{
$Team = TranslateTeam($Team);
$Class = TranslateClass($Class);

my $RawName = $Name;

$Name = StripNameControlCodes($Name);
$Name = StripLeadingAndTrailingWhiteSpace($Name);

if(!defined($self->{Player}{$Client}))
{
   $self->DebugLog("CUIC New Client $Client");
   #Must've come in in the middle of something. Well, let's
   #muddle through as best we can...
   $self->CreateOrUpdateClientInfo($Timestamp,
               $Client);
}
else
{
   $OldName = $self->{Player}{$Client}{raw_name};
   $OldTeam = $self->{Player}{$Client}{tema};
}

if(defined($OldName) &&
   defined($RawName) &&
   ($OldName ne $RawName))
{
   #It's a name change. Do we care?
   if($self->{Config}{server}{kick_name_spammers})
   {
   #Yes, we do. Get the timestamp...
   #Is this the same timestamp as the last time he changed his
   #name?
   if(defined($self->{Player}{$Client}{last_namechange}) &&
      ($self->{Player}{$Client}{last_namechange} ==
      $Timestamp))
   {
      #Yes, it is.
      ++$self->{Player}{$Client}{namechange_counter};

      #Is that more times/second than allowed?
      if($self->{Player}{$Client}{namechange_counter} >
      $self->{Config}{server}{max_name_changes_per_second})
      {
      #Yes, it is. Kick!
      unless($self->{Player}{$Client}{can_name_spam})
      {
         $self->Kick($Client,
            "Name spamming",
            "Name spamming");
      }
      }
   }
   else
   {
      #Different timestamp (or first time changed). Note it:
      $self->{Player}{$Client}{last_namechange} = $Timestamp;
      $self->{Player}{$Client}{namechange_counter} = 0;
   }
   }
}

if(!defined($self->{State}{team0}))
{
   $self->{State}{team0} = $Team;
   $self->{State}{$Team} = 0;
}
elsif(!defined($self->{State}{team1}) &&
   $self->{State}{team0} ne $Team)
{
   $self->{State}{team1} = $Team;
   $self->{State}{$Team} = 1;
}

if(defined($Team) &&
   defined($OldTeam) &&
   $Team ne $OldTeam)
{
   if($self->{State}{last_teamchange_ts} == $Timestamp)
   {
   $self->{State}{teamchange_count}++;
   if(!$self->{State}{swapped_teams})
   {
      my @PlayerIDs = keys(%{$self->{Player}});

      if(($#PlayerIDs / 2) <= $self->{State}{swapped_teams})
      {
      #If more than half swapped teams in the same second,
      #assume it's some sort of server-mandated teamswap.
      $self->{State}{swapped_teams} = 1;
      my $TmpTeam = $self->{State}{team0};
      $self->{State}{team0} = $self->{State}{team1};
      $self->{State}{team1} = $TmpTeam;

      $self->{State}{$self->{State}{team0}} = 0;
      $self->{State}{$self->{State}{team1}} = 1;

      $self->Log("TEAMSWAP\t" .
            "0 = $self->{State}{team0}\t" .
            "1 = $self->{State}{team1}");
      }
   }
   }
   else
   {
   $self->{State}{last_teamchange_ts} = $Timestamp;
   $self->{State}{teamchange_count} = 0;
   $self->{State}{swapped_teams} = 0;
   }
}

$self->DebugLog("Client $Client",
      "updated info to $Name $Team $Class \<$RawName\>");

$self->LogUserInfoChange($Client, $Name, $Team, $Class);

$self->{Player}{$Client}{"raw_name"} = $RawName;
$self->{Player}{$Client}{"name"} = $Name;
$self->{Player}{$Client}{"team"} = $Team;
$self->{Player}{$Client}{"class"} = $Class;
$self->{Player}{$Client}{"max_possible_grenades"} =
   $self->ClassGrenadeLimits($self->{Player}{$Client}{class});


if((!defined($OldName) ||
   ($OldName ne $Name)) &&
   defined($self->{Player}{$Client}{ip}) &&
   (!$self->{State}{PBEnabled} ||
   defined($self->{Player}{$Client}{guid})))

{
   $self->ProcessLogin($Client);
}

}
else
{
$self->DebugLog("Unrecognized ClientUserinfoChanged: \<$Args\>");
}
}

Excuse me for my long post Smile

Thanks,

Dutchmeat

omg...good luck test Rolling Eyes

_________________
"I´M NOT CRAZY
My Reality Is Just Different Than Yours"

omg²

wtf is this
lol

suddenly test-dr doesn't respond anymore Very Happy

heyhe .. give an old man a break ...
and this code is so long .... and i still wanna play sometime tce ....
not only hacking around ...

and Razz

for KillerMaster ... to much codeing ... or what ... thats the soul of the program ....

@duchmeat: this new error-line looks like a status-line(game-statistics) for player duchmeat ....

_________________

only testing .... --- damn, another uncovered bug

hehe, so i should change the status/pblist concept ?
Or clientinfochanged?

no - but you first have to test if it works without punkbuster enabled!

thats a must! .. If punkbuster is not enabled, only the check for guids is skipped. If a client-name matches it will be returned and --- but you should look yourself at this part:

	Code:
	foreach my $Client (keys(%{$self->{Player}})) { if(defined($self->{Player}{$Client}{name}) && $self->{Player}{$Client}{name} eq $Name) { push(@Matches, $Client); }

i have deleted the check-branch about pb-guid - you see? The Client-Structure gets pushed into the array, and this is given back as the result of found players. So ... if you get an empty one back, no one was found. So the question stays? Has it ever worked? What are you really trying? I have no server running to do the tests. I would suggest you need to put a lot more "Logging" lines into, because it may be wrong to believe the $self->"Player"-structure contains all necessary information in the right format. ..... or i would need a ssh-account to the server to take a look myself at the loggings and running perl-mods ..? It may be very little, what needs to be changed, but now you see yourself, you find more and more not working parts ....

can you give me your e-mail-address? via pm to get more out of here?