#!/usr/bin/perl -w #the Northlands a perl based mud. Please enjoy and share this great software with #anyone who wants it. #Copyright (C) 2000 Peter Smith creator@operamail.com #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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. $|=1; use POSIX; use IO::Socket; use IO::Select; use Socket; use Fcntl; use Tie::RefHash; use Term::ANSIColor; use Time::HiRes ("usleep"); require ("commands.pm"); require ("init.pm"); require("update.pm"); require("roomcommands.pm"); require("monster.pm"); require("combat.pm"); #use strict; use vars qw(@node @elements $monstertotal $room $longupdate %inbuffer %outbuffer %ready $prompt %type @room %item %command); $SIG{HUP}="ignore"; srand; #$last=time; $port=4005; $server=IO::Socket::INET->new(LocalPort =>$port, Listen=> 10, Reuse=>1) or die "Can't make server socket: $@\n"; $prompt=color("blue").": ".color("reset"); %inbuffer = (); %outbuffer = (); %ready = (); tie %ready, 'Tie::RefHash'; $node[0]={monsters=>[0],prob=>10,room=>1,max=>10,maxused=>0}; nonblock($server); $select= IO::Select->new($server); @elements=("Earth", "Air", "Water", "Fire", "Life"); $longupdate=0; $lastupdate=time; $monstertotal=0; loaditems(); loadmuddata(); loadrealitems(); loadmonster(); loadroom(); loadcommands(); print "Entering main loop\n"; while (1){ my $client; my $rv; my $data; if (-e "killmud"){ print "Closing down\n"; exit; } #check for new information foreach $client ($select->can_read(0)) { $last{$client}=time; if ($client == $server) { #new connection print "A\n"; $client= $server->accept(); $select->add($client); nonblock($client); $outbuffer{$client}.="Welcome to the Northlands\r\n"; $outbuffer{$client}.="Please tell me who you are:"; $type{$client}="login"; print "new connection\r\n"; }else { #get data $data=''; $rv = $client->recv($data, POSIX::BUFSIZ, 0); unless (defined($rv) && length $data) { #hang up &delete($client); next; } $inbuffer{$client}.=$data; while($inbuffer{$client} =~s/(.*\n)//) { push( @{$ready{$client}}, $1);} } } foreach $client ( keys %ready) { handle($client); } foreach $client ($select->can_write(1)) { next unless exists $outbuffer{$client}; $rv=$client->send($outbuffer{$client}, 0); unless (defined($rv)){ warn "I was told I could write but I can't"; next;} if (($rv == length $outbuffer{$client}) || ($!== POSIX::EWOULDBLOCK)){ substr($outbuffer{$client}, 0,$rv)=""; delete $outbuffer{$client} unless length $outbuffer{$client}; } else{ warn "hello. $! $outbuffer{$client} \r\n$rv\r\n"; delete $inbuffer{$client}; delete $outbuffer{$client}; delete $ready{$client}; delete $user{$client}; delete $last{$client}; $select ->remove($client); close($client); next;} } if (time-$lastupdate>1){ update(); $lastupdate=time; } else{ usleep(0.0001);} } sub handle { local $client= shift; main: foreach $request (@{$ready{$client}}) { $request=~s/[\a|\r|\n]//g; $request=~s/\s*$//i; if ($request eq "."){ $request=$lastrequest{$client}; } if ($request){ $lastrequest{$client}="$request"; } $request=~s/^'/say /i; #'; local @input=split(/ /,$request); unless ($input[0]=~/^([-\@\w.]+$)/){ $outbuffer{$client}.="possibly insecure data detected.\r\n$prompt"; next; } if ($request){ if ($user{$client}{room}){ if (defined($room[$user{$client}{room}]{commands}{$input[0]})){ unless (defined(&{$commandtype{$type{$client}}{$input[0]}})){ $outbuffer{$client}.="That sub doesn't exists, this is a serious error.\r\n$prompt"; next; } &{$commandtype{$type{$client}}{$input[0]}}; next; } } if (defined($commandtype{$type{$client}}{input})){ unless (defined(&{$commandtype{$type{$client}}{input}})){ $outbuffer{$client}.="That sub doesn't exists, this is a serious error.\r\n$prompt"; next; } &{$commandtype{$type{$client}}{input}}; next; } if (defined($commands{$type{$client}}{$input[0]})){ unless (defined(&{$commands{$type{$client}}{$input[0]}})){ $outbuffer{$client}.="That sub doesn't exists, this is a serious error.\r\n$prompt"; next; } &{$commands{$type{$client}}{$input[0]}}; } elsif(defined($commands{basic}{$input[0]})){ unless (defined(&{$commands{basic}{$input[0]}})){ $outbuffer{$client}.="That sub doesn't exists, this is a serious error.\r\n$prompt"; next; } &{$commands{basic}{$input[0]}}; } else { $outbuffer{$client}.="$commandtype{$type{$client}}{failed}\r\n$prompt"; } } else{ $outbuffer{$client}.="\r\n$prompt"; } } delete $ready{$client}; } sub nonblock { my $socket= shift; my $flags; $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"; } sub roundcheck { if ($user{$client}{round}){ $outbuffer{$client}.="Please wait $user{$client}{round} more seconds.\r\n$prompt"; return 1; } }