The BOT Seer found on the metalforge .net server is working.
As a player, I use him occasionally.
This is what the client cmdline tell Seer help responds :
Seer tells you: I'm a bot, and I'm writing kill logs for all players and monsters. You can ask me about: last <player> to see when the player was here last to see the last 10 logins/logouts Seer tells you: uptime for the time the server's up (at least) tell <player> <something> to let me tell the player something when I see him maps to see the most popular maps Seer tells you: kills <name> to see what a player or monster has killed and how numkills <name> to see how many times someone killed how killed <name> to see how someone prefers to kill Seer tells you: deaths <name> to see who killed a player or monster and how numdeaths <name> to see how many times someone died how died <name> to see how someone prefers to die Seer tells you: what killed <name> to see what attack caused someone to die did <name> kill <name> to see if/how somebody killed somebody find <name> to see all matching monsters or players Seer tells you: Besides this, I'm afraid I'm not very intelligent. :)
Some years ago (Modification time tells me February 2013), I found a Perl script on the net, that contains the above lines.
This is Google's cache of http://www.suckfuell.net/jochen/cfbot/cfbot. It is a snapshot of the page as it appeared on Feb 16, 2013 04:44:39 GMT. The current page <http://www.suckfuell.net/jochen/cfbot/cfbot> could have changed in the meantime. Learn more <http://support.google.com/websearch/bin/answer.py?hl=en&p=cached&answer=1687222> Tip: To quickly find your search term on this page, press *Ctrl+F* or *⌘-F* (Mac) and use the find bar. Text-only version <http://webcache.googleusercontent.com/search?q=cache:KLwoFyJLg7UJ:www.suckfuell.net/jochen/cfbot/cfbot+cfbot+crossfire&hl=en&gl=us&strip=1> These search terms are highlighted: cfbot crossfire
It is a GNU General Public License file by Copyright (C) 2003 Jochen Suckfuell <*crossfire* WHAT suckfuell.net> .
#!/usr/bin/perl -w # # ------------------------------------------------------------------------- # # Copyright (C) 2003 Jochen Suckfuell <*crossfire* WHAT suckfuell.net> # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. # # ----------------------------------------------------------------------- # # TODO # # - fix inventory logging # - check if event_wait and event_listen loops work # # # Changelog: # # 2005-05-28 0.9.9 # - added the setup flag "bot 1" to tell the server that this is a bot # # 2004-03-11 0.9.8 # - new commands: add_admin, rem_admin, admins # - added the admin commands to the help output # - removed the "host" command, since 'who doesn't show the IP any more # - fixed parsing changed 'who output format # - save the is_admin flag with the players # - allow several admin users # - implement numdeaths, numkills # - 'forget <script>' and 'stop <script>' commands implemented # - implemented storing more stats # - added events_stats callbacks # - we now log the players that enter a map whose name matches a pattern in # the predefined array @check_maps # # 2003-02-13 Release 0.9.7 # # - 'last <player>' now also shows the host name # - implemented the 'host <player>' command which tells the player's hostname # - Don't answer to "hi" if not addressed directly. # # 2003-02-04 Release 0.9.6 # # - implemented script command "when hearing <whatever>" # # # 2003-02-03 Release 0.9.5 # # - implemented simple scripting commands, conditions are still missing # - slowed down the decay of map scores # - output integer values for map scores # - use the 'ncom' protocol command instead of 'command' # - only reply to "hello|hi" to players that talked to me before #
I am not capable in the perl scripting language, and can not say anything about this script. 1900 lines :
#!/usr/bin/perl -w # # ------------------------------------------------------------------------- # # Copyright (C) 2003 Jochen Suckfuell <*crossfire*@suckfuell.net> # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. # # ----------------------------------------------------------------------- # # TODO # # - fix inventory logging # - check if event_wait and event_listen loops work # # # Changelog: # # 2005-05-28 0.9.9 # - added the setup flag "bot 1" to tell the server that this is a bot # # 2004-03-11 0.9.8 # - new commands: add_admin, rem_admin, admins # - added the admin commands to the help output # - removed the "host" command, since 'who doesn't show the IP any more # - fixed parsing changed 'who output format # - save the is_admin flag with the players # - allow several admin users # - implement numdeaths, numkills # - 'forget <script>' and 'stop <script>' commands implemented # - implemented storing more stats # - added events_stats callbacks # - we now log the players that enter a map whose name matches a pattern in # the predefined array @check_maps # # 2003-02-13 Release 0.9.7 # # - 'last <player>' now also shows the host name # - implemented the 'host <player>' command which tells the player's hostname # - Don't answer to "hi" if not addressed directly. # # 2003-02-04 Release 0.9.6 # # - implemented script command "when hearing <whatever>" # # # 2003-02-03 Release 0.9.5 # # - implemented simple scripting commands, conditions are still missing # - slowed down the decay of map scores # - output integer values for map scores # - use the 'ncom' protocol command instead of 'command' # - only reply to "hello|hi" to players that talked to me before # # # # # # # # ====================== configuration section ======================== use vars qw/$remote_host $player_name $player_password $retry_interval $admin $leave_cmd %players %kills %maps $socket $recvbuf $quit $upsince $getting_who_answer $last_maps_decay_time $version $pkg_sent $pkg_ackd @cmds_waiting $learning %scripts @events_wait @events_listen @events_stats %script_stack %stats %inv %checked_map @check_map/; $remote_host = "127.0.0.1"; $player_name = "*cfbot*"; $player_password = "SeCrEt"; $retry_interval = 30; # time in seconds $admin = " "; $leave_cmd = "go home"; # We keep a player log for these maps: @check_map = ( "^/guilds/" ); # =================== no configuration below ========================== $version = "0.9.6"; use POSIX; use IO::Socket; use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK); $events_stats{'maxhp'} = []; $events_stats{'maxsp'} = []; $events_stats{'maxgrace'} = []; $events_stats{'lowfood'} = []; load(); $socket = ''; init_connection(); $recvbuf = ''; $quit = 0; my $save_minutes = 10; # This will be counted down and reset to 10, below. my $last_time = time; $getting_who_answer = 0; $last_maps_decay_time = time; $SIG{INT} = sub { $quit = 1; print STDERR "SIGINT\n"; }; # main event loop while(! $quit) { my $r_in = ''; vec($r_in, $socket->fileno, 1) = 1; my $rv = select($r_in, undef, undef, 1); if(!defined($rv) || $rv < 0) { unless($! == EINTR) { die "select failed: $!"; } last; } if($rv && vec($r_in, $socket->fileno, 1) == 1) { my $rv = $socket->recv($buf, POSIX::BUFSIZ, 0); unless (defined($rv)) { print STDERR "recv failed: $!\n"; init_connection(); $recvbuf = ''; next; } if(length($buf) == 0) { print STDERR "Connection closed.\n"; init_connection(); $recvbuf = ''; next; } $recvbuf .= $buf; while(length($recvbuf) >= 2) { my $len = unpack("n", $recvbuf); #print "DEBUG len $len , recvbuf length is ".length($recvbuf)."\n"; if(length($recvbuf) < 2 + $len) { last; } #print unpack("H*", $recvbuf)."\n"; my $data = substr($recvbuf, 2, $len); handle($data); $recvbuf = substr($recvbuf, $len + 2); } # len info } # $socket is readable my $now = time; next if $last_time == $now; if($now - $last_time > 60) { # This is processed once per minute. $last_time = $now; $save_minutes--; if($save_minutes == 0) { save(); $save_minutes = 10; } if($now - $last_maps_decay_time > 24*60*60) { # once per day # We halve the map score values once per day: foreach my $map (keys %maps) { $maps{$map} *= 0.25; if($maps{$map} == 0) { delete $maps{$map}; } } $last_maps_decay_time = $now; } cf_send_cmd("who"); # update maps' popularity } for(my $i = 0; $i < scalar @events_wait; $i++) { my $event_ref = $events_wait[$i]; if($event_ref->{"continue_at"} <= $now) { splice @events_wait, $i, 1; # remove the event from the list do_execute($event_ref->{"script"}, $event_ref->{"pc"}); } } } save(); exit 0; # =============================================================== sub init_connection { if($socket) { $socket->close(); } while(!($socket = IO::Socket::INET->new(PeerAddr => $remote_host, PeerPort => 13327, Proto => "tcp", Type => SOCK_STREAM))) { print STDERR "Couldn't connect to $remote_host:13327 : $@\n"; print STDERR "Retrying in $retry_interval seconds.\n"; sleep $retry_interval; } my $flags = fcntl($socket, F_GETFL, 0) or die "Can't get flags for socket: $!\n"; fcntl($socket, F_SETFL, $flags | O_NONBLOCK) or die "Can't make socket nonblocking: $!\n"; $pkg_sent = 0; $pkg_ackd = 0; cf_send("version 1027 1027 Perl Bot"); cf_send("setup map1cmd 1 map1acmd 1 sound 0 sexp 0 darkness 0 newmapcmd 0 faceset 0 facecache 1 itemcmd 1 bot 1"); cf_send("addme"); $upsince = time; print "Login at ".localtime($upsince)."\n"; } sub handle { my $line = shift; $line =~ /^(\S+)\s*(.*)$/s or die "Cannot match '$line'"; my $cmd = $1; my $args = $2; if($cmd =~ /^drawinfo$/) { $args =~ /^(\S+)\s*(.*)$/s; my $color = $1; my $info = $2; if($getting_who_answer) { $getting_who_answer = parse_who($info); # Return if we got another WHO line, else process the new line as # normal. return if $getting_who_answer; } if($info =~ /^((?:(?! killed) ?[a-zA-Z0-9'_-]+)+) killed /) { if(defined $kills{$info}) { $kills{$info}++; } else { $kills{$info} = 1; } return; } if($info =~/^Players:$/) { $getting_who_answer = 1; return; } if($info =~ /^(\S+) has entered the game.$/) { my $name = $1; $player_ref = $players{$name}; unless(defined $player_ref) { $player_ref = { asked_me => 0, message => "", is_admin => 0 }; $players{$name} = $player_ref; } elsif($player_ref->{"message"}) { my $msg = $player_ref->{"message"}; $msg =~ s/_-/\n/g; sleep 3; cf_send_info("tell $name", "Hi $name!$msg"); $player_ref->{"message"} = ""; } $player_ref->{"last_seen"} = time; $player_ref->{"is_here"} = 1; print ">$info\n"; return; } if($info =~ /^(\S+) (leaves|left) the game.$/) { my $name = $1; $player_ref = $players{$name}; unless(defined $player_ref) { $player_ref = { asked_me => 0, message => "" }; $players{$name} = $player_ref; } $player_ref->{"last_seen"} = time; $player_ref->{"is_here"} = 0; return; } if($info =~ /^(\S+) tells you: (.*)\??$/) { handle_player_request($1, $2, "tell $1"); return; } if($info =~ /^(\S+) shouts: $player_name[:,!]? *(.*)\??$/) { handle_player_request($1, $2, "shout"); return; } if($info =~ /^(\S+) shouts: (hi\b|hello|morning)\s+$player_name!?/i) { my $pl = $1; return if $pl eq $player_name; my $pl_ref = $players{$pl}; return unless (defined $pl_ref && $pl_ref->{"asked_me"}); sleep 3; cf_send_cmd("shout $2 $1"); return; } if($info =~ /^Welcome Back!$/) { cf_send_cmd("listen 15"); cf_send_cmd("who"); if(defined $scripts{"autorun"}) { $script_stack{"autorun"} = []; do_execute("autorun"); } return; } # Blue color text (in cfclient at least) is for NPC speech and other # messages from the map. if($color == 2) { for(my $i = 0; $i < scalar @events_listen; $i++) { my $event_ref = $events_listen[$i]; if($info =~ /$event_ref->{"listen_text"}/ms) { splice @events_listen, $i, 1; # remove the event from the list do_execute($event_ref->{"script"}, $event_ref->{"pc"}); } } } #print "INFO: $color $info\n"; return; } if($cmd =~ /^query$/) { print "$args "; if($args =~ /What is your name/) { cf_send("reply $player_name"); return; } if($args =~ /What is your password/) { cf_send("reply $player_password"); return; } if($args =~ /Do you want to play again/) { cf_send("reply a"); return; } my $answer = <STDIN>; chomp $answer; cf_send("reply $answer"); return; } if($cmd =~ /^comc$/) { ($pkg_ackd) = unpack("n", $args); if(scalar @cmds_waiting) { $pkg_sent++; if($pkg_sent == 256) { $pkg_sent = 0; } cf_send("ncom ".pack("n", $pkg_sent)."\0\0\0\1".(shift @cmds_waiting)); } return; } if($cmd =~ /^stats$/) { while($args) { my $s; ($s, $args) = unpack ('C a*', $args); last if $s > 26; if($s == 18) # food { ($stats{'food'}, $args) = unpack('n a*', $args); #print "food: $stats{food}\n"; if($stats{'food'} < 80) { foreach my $event_ref (@{$events_stats{'lowfood'}}) { do_execute($event_ref->{"script"}, $event_ref->{"pc"}); } $events_stats{ 'lowfood'} = []; } } elsif($s == 1) # HP { ($stats{'hp'}, $args) = unpack('n a*', $args); #print "hp: $stats{hp}\n"; if(defined $stats{'maxhp'} && $stats{'hp'} == $stats{'maxhp'}) { @events = @{$events_stats{'maxhp'}}; $events_stats{ 'maxhp'} = []; foreach my $event_ref (@events) { do_execute($event_ref->{"script"}, $event_ref->{"pc"}); } $events_stats{ 'maxhp'} = []; } } elsif($s == 2) # max HP { ($stats{'maxhp'}, $args) = unpack('n a*', $args); #print "maxhp: $stats{maxhp}\n"; } elsif($s == 3) # SP { ($stats{'sp'}, $args) = unpack('n a*', $args); #print "sp: $stats{sp}\n"; if(defined $stats{'maxsp'} && $stats{'sp'} == $stats{'maxsp'}) { @events = @{$events_stats{'maxsp'}}; $events_stats{ 'maxsp'} = []; foreach my $event_ref (@events) { do_execute($event_ref->{"script"}, $event_ref->{"pc"}); } } } elsif($s == 4) # max SP { ($stats{'maxsp'}, $args) = unpack('n a*', $args); #print "maxsp: $stats{maxsp}\n"; } elsif($s == 23) # grace { ($stats{'grace'}, $args) = unpack('n a*', $args); #print "grace: $stats{grace}\n"; if(defined $stats{'maxgrace'} && $stats{'grace'} == $stats{'maxgrace'}) { @events = @{$events_stats{'grace'}}; $events_stats{ 'grace'} = []; foreach my $event_ref (@events) { do_execute($event_ref->{"script"}, $event_ref->{"pc"}); } $events_stats{ 'maxgrace'} = []; } } elsif($s == 24) # max SP { ($stats{'maxgrace'}, $args) = unpack('n a*', $args); #print "maxgrace: $stats{maxgrace}\n"; } elsif($s == 11) # exp { ($stats{'exp'}, $args) = unpack('N a*', $args); #print "exp: $stats{exp}\n"; } elsif($s == 12) # level { ($stats{'level'}, $args) = unpack('n a*', $args); print "level: $stats{level}\n"; } elsif($s == 13) # WC { my $wc; ($wc, $args) = unpack('n a*', $args); $stats{'wc'} = ($wc > 32767 ? $wc - 65536 : $wc); print "wc: $stats{wc}\n"; } elsif($s == 14) # AC { my $ac; ($ac, $args) = unpack('n a*', $args); $stats{'ac'} = ($ac > 32767 ? $ac - 65536 : $ac); print "ac: $stats{ac}\n"; } elsif($s == 17 || $s == 19 || $s == 26) { (undef, $args) = unpack('N a*', $args); } else { (undef, $args) = unpack('n a*', $args); } } return; } if($cmd =~ /^item1$/) { my ($location, $tag, $flags, $weight, $name, $nrof); %inv = (); ($location, $args) = unpack ('N a*', $args); return unless $location; while($args) { ($tag, $flags, $weight, undef, $name, undef, undef, $nrof, $args) = unpack ('N N N N C/A n C N a*', $args); ($name, undef) = split /\0/, $name; $inv{$tag} = { name => $name, flags => $flags, weight => $weight, nrof => $nrof }; #print "INV1: $nrof $name ($weight)\n"; } return; } if($cmd =~ /^item2$/) { my ($location, $tag, $flags, $weight, $name, $nrof); %inv = (); ($location, $args) = unpack ('N a*', $args); return unless $location; while($args) { ($tag, $flags, $weight, undef, $name, undef, undef, $nrof, undef, $args) = unpack ('N N N N C/A n C N n a*', $args); $inv{$tag} = { name => $name, flags => $flags, weight => $weight, nrof => $nrof }; #print "INV2: $nrof $name ($weight)\n"; } return; } if($cmd =~ /^map|^face2$|^delinv$|^anim$|^player$/) { return; } print ">$cmd"; if( $cmd =~ /^setup$/ ) { print " $args"; } print "\n"; } sub handle_player_request { my $player = shift; my $request = shift; my $answer_command = shift; $player_ref = $players{$player}; unless(defined $player_ref) { $player_ref = { asked_me => 0, last_seen => time, is_here => 1, message => "" }; $players{$player} = $player_ref; } $player_ref->{"asked_me"}++; if($learning && $admin =~ / $player /) { # This continues a script. if($request eq "end $learning") { cf_send_cmd("$answer_command Ok, I learnt $learning."); $learning = ""; return; } push @{$scripts{$learning}}, $request; return; } #cf_send_cmd("tell $admin PL_REQ $player $request"); if($request =~ /^(hi|hello)/i) { sleep 2; cf_send_cmd("$answer_command $1 $player!"); return; } if($request =~ /^(help|what do you do|what can you do|how can you help|who are you|yes)/i) { cf_send_info($answer_command, <<HELP); I'm a bot, and I'm writing kill logs for all players and monsters. You can ask me about: last <player> to see when the player was here last to see the last 10 logins/logouts uptime for the time the server's up (at least) tell <player> <something> to let me tell the player something when I see him maps to see the most popular maps kills <name> to see what a player or monster has killed and how numkills <name> to see how many times someone killed how killed <name> to see how someone prefers to kill deaths <name> to see who killed a player or monster and how numdeaths <name> to see how many times someone died who killed <name> to see who killed someone what killed <name> to see what attack caused someone to die Besides this, I'm afraid I'm not very intelligent. :) HELP if($players{$player}{is_admin} == 1) { cf_send_info($answer_command, <<ADMIN_HELP); Special admin commands are: do <command> sends the command to the server learn <scriptname> starts recording server commands to a script end <scriptname> ends learning a script [don't recurse!] execute <scriptname> execute a script running shows all currently running scripts scripts shows the names of all known scripts stop <scriptname> stops a running script forget <scriptname> deletes a script stats to see my character statistics add_admin <player> to add a player to my admin list rem_admin <player> to remove a player from my admin list admins to see who is on my admin lists For my scripting abilities please check the document at: http://www.suckfuell.net/*cfbot*/cfbot_script.txt ADMIN_HELP } return; } if($request =~ /^tell\s+(\S+)\s+(.*)$/) { my $other = $1; my $other_ref = $players{$other}; unless(defined $other_ref) { cf_send_cmd("$answer_command Sorry, I don't know $other yet."); return; } my $msg = "\n$player wants me to tell you:\n\"$2\""; if($other_ref->{"is_here"}) { cf_send_info("command tell $other", $msg); sleep 2; cf_send_cmd("$answer_command I told him what you said."); return; } $msg =~ s#\n#_-#g; $other_ref->{"message"} .= $msg; sleep 2; cf_send_cmd("$answer_command I will tell him when I see him."); return; } if($request =~ /^last\s+(\S+)$/) { my $other = $1; unless(defined $players{$other}) { cf_send_cmd("$answer_command I haven't seen $other."); return; } sleep 2; cf_send_cmd("$answer_command $other was here at ".gmtime($players{$other}{"last_seen"})." GMT"); return; } if($request =~ /^last$/i) { my @last_seen = sort { $players{$b}{last_seen} <=> $players{$a}{last_seen} } keys %players; my $i = 0; my $out = ""; foreach my $pl (@last_seen) { next if $players{$pl}{"is_here"}; $out .= "\n$pl was here at ".gmtime($players{$pl}{"last_seen"})." GMT."; $i++; last if $i == 10; } cf_send_info($answer_command, $out); return; } if($request =~ /uptime/i) { sleep 2; cf_send_cmd("$answer_command The server has been up at least since ".gmtime($upsince)." (GMT)."); return; } if($request =~ /^kills\s+(.*)$/) { my $name = $1; chomp $name; my $info = ""; my $total = 0; foreach my $kill (sort { $kills{$b} <=> $kills{$a} } keys %kills) { if($kill =~ /^$name killed /i) { $info .= $kills{$kill}." times ".$kill."\n"; $total += $kills{$kill}; } } if(!$info) { cf_send_cmd("$answer_command $name hasn't killed anything yet."); return; } $info .= "\nThat's a total of $total kills."; cf_send_info($answer_command, "\n$info"); return; } if($request =~ /^numkills\s+(.*)$/) { my $name = $1; chomp $name; my $total = 0; foreach my $kill (sort { $kills{$b} <=> $kills{$a} } keys %kills) { if($kill =~ /^$name killed /i) { $total += $kills{$kill}; } } cf_send_cmd("$answer_command $name has killed $total times."); return; } if($request =~ /^numdeaths\s+([^?]*)$/i) { my $name = $1; chomp $name; my $total = 0; foreach my $kill (sort { $kills{$b} <=> $kills{$a} } keys %kills) { if($kill =~ / killed $name(\.| with )/i) { $total += $kills{$kill}; } } cf_send_cmd("$answer_command $name died $total times."); return; } if($request =~ /^(?:deaths|who killed)\s+([^?]*)$/i) { my $name = $1; chomp $name; my $info = ""; my $total = 0; foreach my $kill (sort { $kills{$b} <=> $kills{$a} } keys %kills) { if($kill =~ / killed $name(\.| with )/i) { $info .= "\n".$kills{$kill}." times ".$kill; $total += $kills{$kill}; } } if(!$info) { cf_send_cmd("$answer_command $name hasn't been killed yet."); return; } $info .= "\nThat's a total of $total."; cf_send_info($answer_command, $info); return; } if($request =~ /find\s+(.*)$/i) { my $who = $1; if(length($who) < 3) { cf_send_cmd("$answer_command The query must be at least two characters long."); return; } my %matches = (); my $info = ""; foreach my $kill (sort { $kills{$b} <=> $kills{$a} } keys %kills) { unless($kill =~ /^(\S+(?:(?! killed ) \S*)*) killed ([^\s\.]+(?:\s(?!with )[^\s\.]*)*)/) { #print STDERR "find regexp failed, '$kill' => '$1' killed '$2'\n"; next; } my $name1 = $1; my $name2 = $2; next if defined $matches{$name1}; next if defined $matches{$name2}; #print STDERR "match: '$name1' '$name2'\n"; if($name1 =~ /$who/i) { $matches{$name1} = 1; $info .= "\n$name1"; } if($name2 =~ /$who/i) { $matches{$name2} = 1; $info .= "\n$name2"; } } if(!$info) { cf_send_cmd("$answer_command I haven't found a match for '$who'."); return; } $info = "Matching '$who' I found:".$info; cf_send_info($answer_command, $info); return; } if($request =~ /did\s+((?! kill ).+) kill ([^?]+)$/i) { my $name = $1; my $killed = $2; my $info = ""; foreach my $kill (sort { $kills{$b} <=> $kills{$a} } keys %kills) { if($kill =~ /$name killed $killed(\.| with )/i) { $info .= "\n".$kills{$kill}." times ".$kill; } } if(!$info) { cf_send_cmd("$answer_command $name hasn't killed $killed yet."); return; } cf_send_info($answer_command, $info); return; } if($request =~ /^how killed\s+([^?]*)$/i) { my $name = $1; chomp $name; my %count; foreach my $kill (keys %kills) { if($kill =~ /^($name) killed (?:(?!with )[^.])*([^.]*)\.$/i) { my $type = $2; if(! $type) { $type = "with melee"; } if(defined $count{$type}) { $count{$type} += $kills{$kill}; } else { $count{$type} = $kills{$kill}; } } } if(scalar keys %count == 0) { cf_send_cmd("$answer_command $name hasn't killed yet."); return; } my $info = "$1 killed"; foreach my $c (sort { $count{$a} <=> $count{$b} } keys %count) { $info .= "\n".$count{$c}." times ".$c; } cf_send_info($answer_command, $info); return; } if($request =~ /^how died\s+([^?]*)$/i) { my $name = $1; chomp $name; my %count; foreach my $kill (keys %kills) { if($kill =~ / killed $name(?: with ([^.]+))?\.$/) { my $type = $1; if(! $type) { $type = "melee"; } if(defined $count{$type}) { $count{$type} += $kills{$kill}; } else { $count{$type} = $kills{$kill}; } } } if(scalar keys %count == 0) { cf_send_cmd("$answer_command $name didn't die yet."); return; } my $info = "$name died"; foreach my $c (sort { $count{$a} <=> $count{$b} } keys %count) { $info .= "\n".$count{$c}." times by $c"; } cf_send_info($answer_command, $info); return; } if($request =~ /^what killed\s+([^?]*)$/i) { my $name = $1; chomp $name; my %count; foreach my $kill (keys %kills) { if($kill =~ /killed $name\s*(with[^.]*)?\.$/i) { my $type = $1; if(! $type) { $type = "with melee"; } if(defined $count{$type}) { $count{$type} += $kills{$kill}; } else { $count{$type} = $kills{$kill}; } } } if(scalar keys %count == 0) { cf_send_cmd("$answer_command $name hasn't been killed yet."); return; } my $info = "$name was killed"; foreach my $c (sort { $count{$a} <=> $count{$b} } keys %count) { $info .= "\n".$count{$c}." times ".$c; } cf_send_info($answer_command, $info); return; } if($request =~ /^$leave_cmd!?$/) { if($admin !~ / $player /) { cf_send_cmd("$answer_command Hey, you're not allowed to send me home!"); admin_msg("$player tried to send me home.\n"); return; } cf_send_cmd("$answer_command bye"); $quit = 1; return; } if($request =~ /thanks|thank you|thx/i) { sleep 2; cf_send_cmd("$answer_command Any time."); return; } if($request =~ /^maps$/i) { sleep 2; my $show = 0; my $info = "The most popular maps are:"; foreach my $map (sort { $maps{$b} <=> $maps{$a} } keys %maps) { #print "MAPS $maps{$map} $map\n"; last if $maps{$map} < 5; $info .= "\n".int($maps{$map})." $map"; $show++; last if $show == 30; } cf_send_info($answer_command, $info); return; } if($request =~ /^learn\s+(.*)$/) { $learning = $1; if($admin !~ / $player /) { cf_send_cmd("$answer_command You're not my teacher!"); admin_msg("$player wanted me to learn '$learning'."); $learning = ""; return; } if(defined $scripts{$learning}) { cf_send_cmd("$answer_command I know this already."); $learning = ""; return; } $scripts{$learning} = []; cf_send_cmd("$answer_command How do I do this?"); return; } if($request =~ /^forget\s+(.*)$/) { my $forget = $1; if($admin !~ / $player /) { cf_send_cmd("$answer_command You're not my teacher!"); admin_msg("$player wanted me to forget '$forget'."); return; } unless(defined $scripts{$forget}) { cf_send_cmd("$answer_command I don't know this anyway."); return; } delete $scripts{$forget}; cf_send_cmd("$answer_command Funny, I forgot how $forget goes."); return; } if($request =~ /^do\s+(.*)$/) { my $command = $1; if($admin !~ / $player /) { cf_send_cmd("$answer_command You're not allowed to request this!"); admin_msg("$player wanted me to do '$command'."); return; } cf_send_cmd("$answer_command Ok, I'll do $command."); do_command($command); return; } if($request =~ /^execute\s+(.*)$/) { my $execute = $1; if($admin !~ / $player /) { cf_send_cmd("$answer_command You're not allowed to request this!"); admin_msg("$player wanted me to execute '$execute'."); return; } if(!defined $scripts{$execute}) { cf_send_cmd("$answer_command I don't know how to do this."); return; } if(defined $script_stack{$execute}) { cf_send_cmd("$answer_command $execute is already running."); return; } $script_stack{$execute} = []; cf_send_cmd("$answer_command Ok, I'll execute $execute."); do_execute($execute); return; } if($request =~ /^stop\s+(.*)$/) { my $stop = $1; if($admin !~ / $player /) { cf_send_cmd("$answer_command You're not allowed to request this!"); admin_msg("$player wanted me to stop '$stop'."); return; } unless(defined $script_stack{$stop}) { cf_send_cmd("$answer_command $stop isn't running at all."); return; } stop_script($stop); cf_send_cmd("$answer_command I stopped $stop."); return; } if($request =~ /^running$/) { if($admin !~ / $player /) { cf_send_cmd("$answer_command You're not allowed to request this!"); return; } my $info = "Running scripts are:"; foreach my $script (keys %script_stack) { $info .= "\n$script"; } cf_send_info($answer_command, $info); return; } if($request =~ /^scripts$/) { if($admin !~ / $player /) { cf_send_cmd("$answer_command You're not allowed to request this!"); return; } my $info = "Known scripts are:"; foreach my $script (keys %scripts) { $info .= "\n$script"; } cf_send_info($answer_command, $info); return; } if($request =~ /^inv/) { if($admin !~ / $player /) { cf_send_cmd("$answer_command You're not allowed to request this!"); admin_msg("$player wanted to see my inventory."); return; } my $info = "My inventory is:"; foreach my $item (keys %inv) { $info .= "\n$inv{$item}{nrof}: $inv{$item}{name} ($inv{$item}{weight}g)"; } cf_send_info($answer_command, $info); return; } if($request =~ /^checked maps$/) { #if($admin !~ / $player /) #{ # cf_send_cmd("$answer_command You're not allowed to request this!"); # admin_msg("$player wanted to see the checked maps."); # return; #} my $info = "Checked maps are:"; foreach my $map (keys %checked_map) { $info .= "\n$map:"; foreach my $pl (keys %{$checked_map{$map}}) { $info .= "\n$pl $checked_map{$map}{$pl}"; } } cf_send_info($answer_command, $info); return; } if($request =~ /^stats$/) { if($admin !~ / $player /) { cf_send_cmd("$answer_command You're not allowed to request this!"); admin_msg("$player wanted to see my stats."); return; } my $info = "My stats are:"; foreach my $stat (keys %stats) { $info .= "\n$stat: $stats{$stat}"; } cf_send_info($answer_command, $info); return; } if($request =~ /^add_admin\s+(\S+)$/) { my $newadm = $1; if($admin !~ / $player /) { cf_send_cmd("$answer_command Hey, you're not allowed to add admins!"); admin_msg("$player tried to add $1 to the admin list.\n"); return; } my $newadm_ref = $players{$newadm}; unless(defined $newadm_ref) { cf_send_cmd("$answer_command Sorry, I don't know $newadm yet."); return; } if($newadm_ref->{"is_admin"} == 1) { cf_send_cmd("$answer_command $newadm is already admin."); return; } $admin .= "$newadm "; $newadm_ref->{"is_admin"} = 1; if($newadm_ref->{"is_here"}) { cf_send_info("command tell $newadm", "$player said you're a really nice gui. I trust you and will do what you suggest."); } else { $newadm_ref->{"message"} .= "$player said you're a really nice gui. I trust you and will do what you suggest."; } cf_send_cmd("$answer_command $newadm is now one of my very close friends."); return; } if($request =~ /^rem_admin\s+(\S+)$/) { my $remadm = $1; if($admin !~ / $player /) { cf_send_cmd("$answer_command Hey, you're not allowed to remove admins!"); admin_msg("$player tried to remove $1 from the admin list.\n"); return; } my $remadm_ref = $players{$remadm}; unless(defined $remadm_ref) { cf_send_cmd("$answer_command Sorry, I don't know $remadm."); return; } if($remadm_ref->{"is_admin"} == 0) { cf_send_cmd("$answer_command $remadm is not an admin."); return; } if($remadm eq $player) { cf_send_cmd("$answer_command You don't want to remove yourself from the admin list, do you?"); return; } $admin =~ s/ $remadm / /; $remadm_ref->{"is_admin"} = 0; if($remadm_ref->{"is_here"}) { cf_send_info("command tell $remadm", "$player removed you from my admin list."); } else { $remadm_ref->{"message"} .= "$player removed you from my admin list."; } cf_send_cmd("$answer_command $remadm is no longer in my admin list."); return; } if($request =~ /^admins$/) { sleep 2; cf_send_cmd("$answer_command My admin friends are:$admin"); return; } sleep 2; cf_send_cmd("$answer_command I don't know what you mean. Do you need help?"); } sub do_command { my $cmd = shift; if($cmd =~ /^save$|^north$|^south$|^east$|^west$|^northwest$|^northeast$|^southwest$|^southeast$|^say |^tell |^shout |^get\b|^take\b|^drop\b|^cast |^invoke |^apply\b|^pickup \d+$|^title |^ready_skill |^use_skill |^fire/) { # We just pass this through. cf_send_cmd($cmd); } } sub stop_script { my $scr = shift; return unless defined $scripts{$scr}; return unless defined $script_stack{$scr}; foreach my $events_array_ref (\@events_listen, \@events_wait, \@events_stats) { for(my $i = 0; $i < scalar @$events_array_ref; $i++) { my $event_ref = $events_array_ref->[$i]; if($scr eq $event_ref->{"script"}) { splice @$events_array_ref, $i, 1; # remove the event from the list } } } delete $script_stack{$scr}; } sub do_execute { my $scriptname = shift; my $pc = shift || 0; for(; $pc < scalar @{$scripts{$scriptname}}; $pc++) { $cmd = $scripts{$scriptname}[$pc]; print "executing: $cmd (stack size: ".(scalar @{$script_stack{$scriptname}}).")\n"; if($cmd =~ /^save$|^north$|^south$|^east$|^west$|^northwest$|^northeast$|^southwest$|^southeast$|^say |^tell |^shout |^get\b|^take\b|^drop\b|^cast |^invoke |^apply\b|^pickup \d+$|^title |^ready_skill |^use_skill |^fire/) { # We just pass this through. cf_send_cmd($cmd); next; } if($cmd =~ /^execute (\S+)$/) { my $scr = $1; next unless defined $scripts{$scr}; next if defined $script_stack{$scr}; $script_stack{$scr} = []; do_execute($scr); next; } if($cmd =~ /^stop (\S+)$/) { stop_script($1); last; } if($cmd =~ /^wait (\d+)$/) { push @events_wait, { script => $scriptname, pc => ($pc+1), continue_at => time + $1 }; last; } if($cmd =~ /^for (\d+) times$/) { push @{$script_stack{$scriptname}}, { context => 'for', pc => $pc, count => $1 }; next; } if($cmd =~ /^end_for$/) { if(scalar @{$script_stack{$scriptname}} == 0) { print "Stack underflow in end_for!\n"; stop_script($scriptname); last; } $stack_last = $script_stack{$scriptname}[0]; unless($stack_last->{"context"} eq 'for') { print "Script error: end_for found, but no for on stack.\n"; stop_script($scriptname); return; } $stack_last->{"count"}--; if($stack_last->{"count"} == 0) { shift @{$script_stack{$scriptname}}; next; } $pc = $stack_last->{"pc"}; next; } if($cmd =~ /^forever$/) { push @{$script_stack{$scriptname}}, { context => 'forever', pc => $pc }; next; } if($cmd =~ /^end_forever$/) { if(scalar @{$script_stack{$scriptname}} == 0) { print "Stack underflow in end_forever!\n"; stop_script($scriptname); return; } $stack_last = $script_stack{$scriptname}[0]; unless($stack_last->{"context"} eq 'forever') { print "Script error: end_forever found, but no forever on stack.\n"; stop_script($scriptname); return; } $pc = $stack_last->{"pc"}; next; } if($cmd =~ /^when hearing\s+(\S.+)$/) { push @events_listen, { script => $scriptname, pc => ($pc+1), listen_text => "$1" }; last; } if($cmd =~ /^when stats_event\s+(maxhp|maxsp|maxgrace|lowfood)$/) { push @{$events_stats{$1}}, { script => $scriptname, pc => ($pc+1) }; last; } if($cmd eq "end") { stop_script($scriptname); last; } if($cmd =~ /^assert (.*)$/) { last unless script_condition($1); next; } cf_send_cmd("tell Zorag Script error: unknown command '$cmd'"); last; } if($pc == scalar @{$scripts{$scriptname}}) { stop_script($scriptname); } } sub script_condition { my $cond = shift; my @words = split (/\s+/, $cond); my @stack = ( ); while (my $word = shift(@words)) { if($word eq "not") { return 0 if scalar @stack < 1; $stack[$#stack] = !$stack[$#stack]; next; } if($word eq "and") { return 0 if scalar @stack < 2; splice @stack, $#stack-1, 2, ($stack[$#stack] && $stack[$#stack-1]); next; } if($word eq "or") { return 0 if scalar @stack < 2; splice @stack, $#stack-1, 2, ($stack[$#stack] || $stack[$#stack-1]); next; } if($word eq "xor") { return 0 if scalar @stack < 2; splice @stack, $#stack-1, 2, ($stack[$#stack] ^ $stack[$#stack-1]); next; } # implement some conditions here XXX } return pop @stack; } sub parse_who { my $line = shift; unless ($line =~ /^(\S+) the ([^\]]+)\[([^\]]+)\]/) { #print "WHO next line: $line\n"; return 0; } my $pl = $1; return 1 if $pl eq $player_name; # Don't log ourselves. my $title = $2; my $map = $3; $title =~ s/ $//; #print ">WHO Player: $pl the $title on map $map\n"; # Set this player's is_here: my $player_ref = $players{$pl}; if(defined $player_ref) { if(! $player_ref->{"is_here"}) { $player_ref->{"is_here"} = 1; if($player_ref->{"message"}) { my $msg = $player_ref->{"message"}; $msg =~ s/_-/\n/g; cf_send_info("command tell $pl", "Hi $pl!$msg"); $player_ref->{"message"} = ""; } } } else { $player_ref = { asked_me => 0, is_here => 1, message => "", is_admin => 0 }; $players{$pl} = $player_ref; } $player_ref->{"last_seen"} = time; # Do we log this map's usage? foreach my $map_pat (@check_map) { if($map =~ m#$map_pat#) { if(defined $checked_map{$map}{$pl}) { $checked_map{$map}{$pl}++; } else { $checked_map{$map}{$pl} = 1; } } } if($map =~ m#/_city_apartment_[Aa]partments.?$|/_santo_dominion_sdomino_appartment$|^/guilds/|^/city/city$|^/world/world_..$|^/dragonisland/housebrxzl$#) { # We don't log these maps. return 1; } # remove number from random maps: if($map =~ m#^/random/#) { $map =~ s/\d\d\d\d$//; } # Add to the map popularity: if(defined $maps{$map}) { $maps{$map}++; } else { $maps{$map} = 1; } return 1; } sub admin_msg { for my $adm (split /\s+/, $admin) { next unless $adm; my $admin_ref = $players{$adm}; return unless defined $admin_ref; my $msg = shift; if($admin_ref->{"is_here"}) { cf_send_cmd("tell $adm $msg"); return; } $msg =~ s#\n#_-#g; $admin_ref->{"message"} .= $msg; } } sub cf_send_info { my $answer_command = shift; my $info = shift; my @lines = split(/\n/, $info); if(! @lines) { return; } my $chunk = shift @lines; foreach $line (@lines) { if(length($chunk) + length($line) < 220) { $chunk .= "\n".$line; } else { if(! $chunk) { die "Text chunk is too large (".length($chunk)." bytes)"; } cf_send_cmd("$answer_command $chunk"); $chunk = "\n$line"; } } if($chunk) { cf_send_cmd("$answer_command $chunk"); } } sub cf_send_cmd { push @cmds_waiting, shift; my $pending = $pkg_sent - $pkg_ackd; if($pending < 0) { $pending += 256; } while($pending < 3) { my $msg = shift @cmds_waiting; # send this command immediately $pkg_sent++; if($pkg_sent == 256) { $pkg_sent = 0; } cf_send("ncom ".pack("n", $pkg_sent)."\0\0\0\1$msg"); last unless scalar @cmds_waiting; $pending++; } } sub cf_send { my $msg = shift; #print "<$msg\n"; my $out = pack("n/a*", $msg); #print unpack("H*", $out)."\n"; print $socket $out; $socket->flush(); } sub save { open(KILLS, "> cf_kills") or die "Can't write file 'cf_kills': $!"; foreach my $key (keys %kills) { print KILLS $key.":".$kills{$key}."\n"; } close KILLS; open(SCRIPTS, "> cf_scripts") or die "Can't write file 'cf_scripts': $!"; foreach my $scriptname (keys %scripts) { #print "Saving script '$scriptname'.\n"; print SCRIPTS "$scriptname\n"; foreach my $line (@{$scripts{$scriptname}}) { print SCRIPTS "$line\n"; } print SCRIPTS "\n"; } close SCRIPTS; open(PLS, ">cf_players") or die "Can't write file 'cf_players': $!"; foreach my $key (keys %players) { #print "Saving player '$key'.\n"; print PLS "$key\n"; foreach my $plkey (keys %{$players{$key}}) { print PLS "$plkey:$players{$key}{$plkey}\n"; } } close PLS; open(MAPS, ">cf_maps") or die "Can't write file 'cf_maps': $!"; print MAPS "$last_maps_decay_time\n"; foreach my $map (keys %maps) { #print "Saving map info '$map'.\n"; print MAPS "$map $maps{$map}\n"; } print MAPS "\n"; foreach my $map (keys %checked_map) { print MAPS "$map\n"; foreach my $pl (keys %{$checked_map{$map}}) { print MAPS "$pl:$checked_map{$map}{$pl}\n"; } } close MAPS; print STDERR "Data saved.\n"; } sub load { %kills = (); unless(open(KILLS, "< cf_kills")) { print STDERR "Can't read file 'cf_kills': $!\n"; } else { print "Loading kills.\n"; while(<KILLS>) { chomp; my ($key, $value) = split(/:/, $_); $kills{$key} = $value; } close KILLS; } %scripts = (); unless(open(SCRIPTS, "< cf_scripts")) { print STDERR "Can't read file 'cf_scripts': $!\n"; } else { print "Loading scripts.\n"; while(<SCRIPTS>) { chomp; my $scriptname = $_; print "Loading script '$scriptname'.\n"; $scripts{$scriptname} = []; for(;;) { my $line = <SCRIPTS>; chomp $line; last unless $line; print ":$line\n"; push @{$scripts{$scriptname}}, $line; } } close SCRIPTS; } %players = (); unless(open(PLS, "< cf_players")) { print STDERR "Can't read file 'cf_players': $!\n"; } else { $current_name = ""; print "Loading players.\n"; while(<PLS>) { chomp; if(/^([^:]+):(.*)$/) { my $key = $1; my $val = $2; if($key eq "is_admin" && $val == 1) { $admin .= "$current_name "; } if($key eq "is_here") { # We get the current users from the 'who command. $val = 0; } $players{$current_name}{$key} = $val; } else { $current_name = $_; } } } %maps = (); unless(open(MAPS, "< cf_maps")) { print STDERR "Can't read file 'cf_maps': $!\n"; } else { print "Loading maps.\n"; my $last_maps_decay_time = <MAPS>; chomp $last_maps_decay_time; while(<MAPS>) { chomp; last unless $_; my ($key, $value) = split(/ /, $_); $maps{$key} = $value; } $current_name = ""; while(<MAPS>) { chomp; if(/^([^:]+):(.*)$/) { $checked_map{$current_name}{$1} = $2; } else { $current_name = $_; } } close MAPS; } }