#!/usr/local/bin/perl # # Web - MUSH spellchecking robot (perl version) # Requires sock.pl and telnet.pl by David Noble # # ############################################################################# require 'sock.pl'; require 'telnet.pl'; # routine for clean shutdown on error sub abort { &sock'close_all; die "ended unexpectedly, but shut down cleanly\n"; } srand; $* = 1; $hostname = "mellers1.psych.berkeley.edu"; $port = "4201"; $timeout = 1; $login_prompt = 'WHO'; $web_name = 'Webster'; $web_pass = 'eccentrica'; $prefix = "BEGRBT" . rand(1000); $suffix = "ENDRBT" . rand(1000); $rumor_file = "/dunemush/mush/game/txt/Events/webrum"; $spell_prog = "/bin/spell"; $webster_prog = "/usr/local/bin/webster"; $local_dict = "/dunemush/mush/game/Webster/dune.dict"; $spelling_log = "/dunemush/mush/game/Webster/webspell.log"; ################################## # # Big infinite loop # while (1) { ############################################################################# # # Open the connection # if (!($session = &sock'open($hostname,$port))) { sleep 300; redo; } ############################################################################# # # Get to the login prompt # while (1) { $_ = &telnet'read($session, $timeout); &abort if &telnet'eof; print if ($debug); last if m/$login_prompt/o; } print $session "connect $web_name $web_pass\n"; # send a login name ############################################################################# # # The real webster stuff. # Loop and wait for data read. If so, parse it. #print $session "OUTPUTPREFIX $prefix"; #print $session "OUTPUTSUFFIX $suffix"; print $session "home\n"; until (&telnet'eof) { $_ = &telnet'read($session, $timeout); if ($counter++ > 1800) { print $session "think I'm not idle!\n"; $counter = 0; } print if ($debug); exit if m/$web_pass/; if (/^(.*) pages: (.*)/) { undef $player, $command, $name, @text; $player = $1; ($command,$name,@text) = split(" ",$2); &define($player,$command,@text) if ($command =~ /define/i); &suggest($player,$command,@text) if ($command =~ /suggest/i); &spell($player,$name,@text) if ($command =~ /spell/i); &rumor($player,$command,@text) if ($command =~ /rumor/i); } } print $session "QUIT\n"; ############################################################################# # # Get any exit messages # until (&telnet'eof) { $_ = &telnet'read($session, $timeout); print if ($debug); } print "\nWebster completed\n"; &sock'close($session); ################################ # # Tail of big infinite loop sleep(300); } ########################################################################### # # Subroutine define - interface to Unix webster(1) # sub define { local($plr) = shift(@_); local($hdr) = shift(@_); local($word) = shift(@_); $word =~ s/[^-A-Za-z0-9]//g; local($command) = $webster_prog . " " . $word . " |"; local(@answer); open(DEFINE,$command) || return; while (<DEFINE>) { chop; s/\[//g; s/\]//g; @answer = (@answer,$_); } close(DEFINE); print $session "page $plr=$word: " . join(" ",@answer) . "\n"; } ########################################################################### # # Subroutine suggest - interface to Unix webster(1) # sub suggest { local($plr) = shift(@_); local($hdr) = shift(@_); local($word) = shift(@_); $word =~ s/[^-A-Za-z0-9]//g; local($command) = $webster_prog . " -s " . $word . " |"; local(@answer); open(SUGGEST,$command) || return; while (<SUGGEST>) { chop; s/\[//g; s/\]//g; @answer = (@answer,$_); } close(SUGGEST); print $session "page $plr=$word: " . join(" ",@answer) . "\n"; } ########################################################################### # # Subroutine spell - interface to Unix spell(1) # sub spell { local($plr) = shift(@_); local($atr) = shift(@_); local($text) = join(" ",@_); $tmpfile = "/tmp/web$$"; open(TMP,"> $tmpfile"); print TMP $text,"\n"; close(TMP); local($command) = "$spell_prog +$local_dict $tmpfile |"; local(@answer); open(SPELL,$command) || return; if ($pipe = <SPELL>) { do { chop($pipe); @answer = (@answer,$pipe); } while ($pipe = <SPELL>); close(SPELL); print $session "page ${plr}=${atr}: " . join(" ",@answer) . "\n"; open(LOG,">> $spelling_log") || return; print LOG join(" ",@answer),"\n"; close(LOG); } else { print $session "page $plr=$atr: No misspelled words\n"; close(SPELL); } unlink($tmpfile); } ########################################################################### # # Subroutine rumor - append a line to the rumor_file # sub rumor { local($plr) = shift(@_); local($hdr) = shift(@_); local($text) = join(" ",@_); if (length($text) < 10) { print $session "page $plr=You probably meant: events $text\n"; } else { open(RUMOR,">> $rumor_file") || return; print RUMOR "${text}\n(by ${plr})\n\n"; close(RUMOR); print $session "page $plr=Rumor noted!\n"; } }