#!/usr/bin/perl -w

# Perl Script to emulate das 'Intermud2' Protokol
# Summer 2001, Jess Robinson (castaway@desert-island.m.isar.de)
# $Revision: 1.4 $ $Date: 2002/12/09 20:09:00 $

use Socket;
use IO::Socket;
use IO::Select;
use Term::ReadKey;
use Cwd;

# Globals!
$mudname = 'MyMudName';
$port = 4248;
$remotehost = "";
$remoteport = 0;
$remotename = "";
$inetd_host_name = "INETD_HOSTS";
$DEBUG = "off";
$AWAY = '';
@ignoredchannels = ("d-news", "d-tv-alles", "d-tv");
@ignoredmuds = ();
%history = ();
$MAXHIST = 20;
$MORE = 23;
%colours = ();
$sockwrite = \*STDOUT;
@sockclients = (\*STDOUT,);
$clients = 0;

{
    #####
    # Mud list functions
    #
    %muds = ();

    #####
    # INETD_HOSTS einlesen
    #
    sub read_inetd_hosts
    {
        # Parameter: None.
	$PacketId = 0;
        $filename = cwd . '/etc/' . $inetd_host_name;
        debug("$filename\n");

        open(INETD_HOSTS, $filename) or die "Can't open $filename: $!\n";
        
        while ($line = <INETD_HOSTS>)
        {
#	    debug($line);
            chomp($line);
            ($name, $IP, $udpport, $receivecmd, $sendcmd) = split(/;/, $line);
            $lname = lc($name);
            debug("$lname ");
            $muds{$lname} = [$name, $IP, $udpport, $receivecmd, $sendcmd, "DOWN", scalar localtime];
        }
        close(INETD_HOSTS);
    }

    #####
    # Save INETD_HOSTS
    #
    sub save_inetd_hosts
    {
        # Parameter: None
        $filename = cwd . '/etc/' . $inetd_host_name . '.save';
        debug("Save filename: $filename\n");

        open(INETD_HOSTS, ">", $filename) or die "Can't open $filename: $!\n";
        foreach $mud (sort(keys %muds))
        {
            debug("Mud: $mud\n");
            print INETD_HOSTS "$muds{$mud}[0];$muds{$mud}[1];$muds{$mud}[2];$muds{$mud}[3];$muds{$mud}[4]\n";
        }
        close(INETD_HOSTS);
    }
    #####
    # Do I know this mud?
    #
    sub is_mud
    {
        # Parameter: MudName
        $name = $_[0];
        if (is_member(lc $name, keys(%muds)) > -1)
        {
            return 1;
        }
        return 0;
    }

    #####
    # Change mud status to given status (up/down)
    # Also sets time of change
    #
    sub set_mud_status
    {
        # Parameter: MudName, Status-To-Set
        ($name, $status) = @_;
        if (&is_mud($name))
        {
            $muds{lc $name}[5] = $status;
            $muds{lc $name}[6] = scalar localtime;
        } else
        {
            debug("Tried to set status for unknown mud.\n");
            add_mud($remotename, $remotehost, $remoteport);
        }
    }

    #####
    # Add a mud (name, ip, port, reccmd, sendcmd) to the internal list
    # - If the mudname already exists, it is overwritten!
    #
    sub add_mud 
    {
        # Parameter: MudName, Mud-IP, Mud-UDP-Port
        ($name, $IP, $udpport, $reccmd, $sendcmd) = @_;
        $name =~ s/[^ -~]//sg;
        $IP =~ s/[^ -~]//sg;
        $udpport =~ s/[^ -~]//sg;
        if (is_member(lc $name, (keys %muds)) > -1)
        {
            if(($muds{lc $name}[1] eq $IP) && ($muds{lc $name}[2] eq $udpport))
            {
                debug("$name is already known.\n");
                return;
            } else
            {
                debug("$name changed. $muds{lc $name}[1]:$muds{lc $name}[2] ->
                                      $IP:$udpport\n");
            }
        }
        debug("$name, $IP, $udpport\n");
        $muds{lc $name} = [$name, $IP, $udpport, $reccmd, $sendcmd, "DOWN", scalar localtime];
    }

    #####
    # Ping each mud in list
    #
    sub ping_muds
    {    
        # Parameter: None.
        foreach $mud (keys %muds)
        {
            $my_id = 0;
            $my_id = newID('ping');
            $ans = "NAME:$mudname|UDP:$port|ID:$my_id|REQ:ping";
            send_mesg($ans, $mud);
        }
    }

    #####
    # Show list of currently known muds
    #
    sub show_muds
    {
        # Parameter: None.
	my $countmuds = 0;
        print pad_string("Name", 17) . pad_string("Address", 18) . pad_string("Port", 6) . pad_string("Status", 8) . pad_string("Last Accessed", 25) ."\n";
        foreach $mud (sort(keys %muds))
        {
            print pad_string($muds{$mud}[0], 17);
            print pad_string($muds{$mud}[1], 18);
            print pad_string($muds{$mud}[2], 6);
            print pad_string($muds{$mud}[5], 8);
            print pad_string($muds{$mud}[6], 25) . "\n";
	    if($muds{$mud}[5] eq "UP")
	    {
		$countmuds += 1;
	    }
        }
	print "$countmuds muds UP.\n";
    }

    #####
    # Send message over socket(message, IP, udp-port)
    #

    sub send_mesg
    {
        # Parameter: Mesg-to-Send, Mud-To-Send-To
        my ($mesg, $destmud) = @_;
        
        @dmuds = ();
        if ($destmud eq 'all')
        {
            @dmuds = keys %muds;
        } else
        {
            @dmuds = ($destmud);
        }
	# Packethead: 'PKT:PerlMud:00000:Num/Num|'
	# Data comes in packets, denoted by 'PKT:<mudname>:<packetindex>:<packetteilnum>:<countteile>
	# Construct packets if the mesg is longer than 1024 characters
	my @packets;
	if(length($mesg) > 1024)
	{
	    my $numpackets = int(length($mesg) / (1024-24));
	    $numpackets = $numpackets * (1024-24) > length($mesg) ? 
		$numpackets + 1 : $numpackets;
	    $PacketId++;
	    $PacketId = '0' x (5-length($PacketId)) . $PacketId;
	    for(my $i = 1;$i <= $numpackets;$i++)
	    {
		my $pkttext = "PKT:PerlMud:$PacketId:";
		$pkttext .= '0' x (3-length($i)) . $i . "/";
		$pkttext .= '0' x (3-length($numpackets)) . $numpackets . "|";
		$pkttext .= substr($mesg, 0, (1024-24), '');
		$packets[scalar(@packets)] = $pkttext;
	    }
	}
	else
	{
	    $packets[0] = $mesg;
	}

        debug("Muds: @dmuds\n");
        foreach $destmud (@dmuds)
        {
            debug("Mud: $destmud\n");
            $destmud = lc $destmud;
            if (!$muds{$destmud})
            {    
                print "Mud: $destmud ist mir unbekannt.\n";
                # Add new mud to the list if it has just sent us a message.
                if($destmud eq lc($remotename))
                {
                    debug("Dest: $destmud Remote: $remotename\n");
                    add_mud($remotename, $remotehost, $remoteport);
                    print "$destmud added.\n";
                } else
                {
                    return;
                }
            }
            $sendaddr = $muds{$destmud}[1];
            $sendport = $muds{$destmud}[2];
	    if($sendport > 0)
	    {
		
		$sockout = new IO::Socket::INET( PeerAddr => $sendaddr,
						 PeerPort => $sendport,
						 Proto    => 'udp',
						 Type     => SOCK_DGRAM,
						 Timeout  => 60 );
		die "Kann Verbindung nicht herstellen ($!)" unless $sockout;
		foreach my $m (@packets)
		{
		    debug("Mesg an $sendaddr, $sendport: $m\n");
		    print $sockout $m;
		}
		$sockout->close();
	    }
        }
    }    
}

#####
# History verwalten
#
sub add_history
{
    # Parameter: history type, history message
    (my $type, my $mesg) = @_;
    if((is_member($type, keys %history) > -1))
    {
	debug("$type is member\n");
	my @arr = @{$history{$type}};
	if(scalar @arr > $MAXHIST)
	{
	    debug("$type > $MAXHIST\n");
	    shift @{$history{$type}}
	}
    }
    else
    {
	$history{$type} = [];
    }
    my @arr = @{$history{$type}};
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
	localtime(time);
    $history{$type}[scalar @arr] = sprintf("%02d.%02d %02d:%02d:%02d", $mday,$mon + 1,$hour,$min,$sec) . $mesg;
    @arr = @{$history{$type}};
    debug("length of $type :" . scalar @arr . "\n");
    debug("history: " . $history{$type}[scalar(@arr) - 1] . "\n");
    debug("$mesg added to $type\n");
}

sub list_history
{
    # Parameter: history type, count (max $MAXHIST)
    my ($type, $count) = @_;
    if(!$count) 
    {
	$count = $MAXHIST;
    }

    debug("list_history, type : $type\n");
    debug("list_history, count : $count\n");
	  
    if((is_member($type, keys %history) > -1))
    {
	print $sockwrite "History for " . ucfirst($type) . "\n";
	my @arr = @{$history{$type}};
	debug("length :" . scalar(@arr) . "\n");
	for(my $i = (scalar(@arr) - $count); $i <= (scalar(@arr) - 1); $i++)
	{
	    print $sockwrite $history{$type}[$i];
	}
    }
    else
    {
        print $sockwrite "No entries for $type.\n";
    }
}    

#####
# Farben verwalten
#

# colour ? print "\e[31mTest\e[0m\n"
%COLOURS = 
    (bold       => "\e[1m",
     underscore => "\e[4m",
     blink      => "\e[5m",
     reverse    => "\e[7m",
     normal     => "\e[0m",

     black      => "\e[30m",
     red        => "\e[31m",
     green      => "\e[32m",
     yellow     => "\e[33m",
     blue       => "\e[34m",
     magenta    => "\e[35m",
     cyan       => "\e[36m",
     white      => "\e[37m",

     on_black   => "\e[40m",
     on_red     => "\e[41m",
     on_green   => "\e[42m",
     on_yellow  => "\e[43m",
     on_blue    => "\e[44m",
     on_magenta => "\e[45m",
     on_cyan    => "\e[46m",
     on_white   => "\e[47m"
     );

sub add_colour
{
    # Parameter: Event, Colour(s)
    my ($event, $colours) = @_;
    debug("add_colour :" . $event . "\n");
    debug("add_colour :" . $colours . "\n");
    my @cols = split(' ', $colours);

    my $found = 0;
    foreach my $c (@cols)
    {
	$c = lc($c);
	if(is_member($c, keys %COLOURS) > -1)
	{
	    $found += 1;
	}
    }
    if($found == scalar @cols)
    {
	$colours{$event} = $colours;
    }
}

sub del_colour
{
    # Parameter: Event
    my $event = $_[0];
    debug("del_colour :" . $event . "\n");
    if(is_member($event, keys %colours) > -1)
    {
	delete $colours{$event};
    }
}

sub list_events
{
    # Parameter: None

    debug("list_events\n");
    debug("list_events :" . scalar(keys(%colours)) . "\n");
    
    foreach $key (keys %colours)
    {
	$value = $colours{$key};
	debug("list_events :" . $key . "\n");
	debug("list_events :" . $value . "\n");
	print $sockwrite "$key => " . colour_event($key, $value) . "\n";
    }
}

sub list_colours
{
    # Parameter: None

    while(my ($key, $value) = each %COLOURS)
    {
	print $sockwrite "$value$key" . $COLOURS{normal} . "\n";
    }
}

sub colour_event
{
    # Parameter: Event, Mesg
    # Returns msg in colour
    my ($event, $mesg) = @_;

    debug("colour_event :" . $event . "\n"); 
    debug("colour_event :" . $mesg . "\n");
 
    if(is_member($event, keys %colours) > -1)
    {
	my @cols = split(' ', $colours{$event});
	my $foundcols = '';
	foreach my $c (@cols)
	{
	    $c = lc($c);
	    if(is_member($c, keys %COLOURS) > -1)
	    {
		$foundcols .= $COLOURS{$c};
	    }
	}
	if($foundcols)
	{
	    if($mesg =~ /(.*)\n/)
	    {
		chomp($mesg);
		return "$foundcols$mesg" . $COLOURS{normal} . "\n";
	    }
	    return "$foundcols$mesg" . $COLOURS{normal};
	}
    }

    return $mesg;
}

#####
# Debug ausgaben
#
sub debug
{
    # Parameter: None.
    if ($DEBUG eq 'on')
    {
	print STDOUT "$_[0]";
    } elsif ($DEBUG eq 'log')
    {
	# Append text to debug log
	$filename = cwd . '/debug_' . $mudname . '.log';

	open(DEBUGFILE, ">>", $filename) or die "Can't open $filename: $!\n";
	print DEBUGFILE "$_[0]";
        close(DEBUGFILE);
    }
}

#####
# Normal output
#
sub output
{
    # Parameter: Socket-Number--To-Send-To, Mesg-To-Send
    $in = $_[0];
    $tmp = $sockclients[$in];
    print $tmp "$_[1]";
}

#####
# Subroutine, die IDs verwaltet! (neue vergeben, in liste eintragen)
#
{
    my %IDs;
    my $current_id; #Next ID number
    sub newID
    {
	# Uebergeben wird einen text fuer die ID Typ
	# zurueck gegeben wird die ID
	my ($type) = @_;
	$current_id++;
	$IDs{$current_id} = $type;
	return $current_id;
    }
    sub del_id
    {
	# Parameter: id to delete, id-type
	my ($id, $type) = @_;
	if ($IDs{$id} eq $type)
	{
	    delete $IDs{$id};
	}
    }
    sub is_id
    {
	# Paramter: id, id-type
	my ($id, $type) = @_;
	if(!$IDs{$id})
	{
	    return 0;
	}
	if ($IDs{$id} eq $type)
	{
	    return 1;
	}
	return 0;
    }
}
	

#####
# Hauptprogramm
#

# get local IP using gethostbyname
$hostname = inet_ntoa(scalar gethostbyname('desert-island.dynodns.net'));
print "hostname: $hostname\n";

#$sockserv = new IO::Socket::INET( LocalAddr => $hostname,
$sockserv = new IO::Socket::INET( LocalAddr => '192.168.1.1',
                                  LocalPort => $port,
                                  Proto     => 'tcp',
                                  Listen    => 1,
                                  Reuse     => 1,
                                  Timeout  => 60 );
die "Kann Verbindung nicht herstellen ($!)" unless $sockserv;

#$blah = new IO::Socket::INET( LocalAddr => $hostname,
$blah = new IO::Socket::INET( LocalAddr => '192.168.1.1',
                              LocalPort => $port,
                              Proto     => 'udp',
                              Type      => SOCK_DGRAM,
                              Reuse     => 1);
die "Kann Server-Verbindung nicht herstellen ($!)" unless $blah;

read_inetd_hosts();
add_mud('PerlMud', $hostname, $port, '*', '*');
ping_muds();

print "Server steht auf $hostname:$port\n";

$x = new IO::Select();
$x->add($blah);
$x->add(\*STDIN); 
$x->add($sockserv);

$sockclient=0;

while (1) {
#    print "try to read\n";       # .. bei STDIN liegt nach dem ersten zugriff immer was an 
    @handles = $x->can_read();    # warten bis was anliegt
#    print "can read\n";
    foreach $handle (@handles)
    {
	if ($handle == $blah)
	{
	    read_udp_data();
	} elsif ($handle == \*STDIN)
	{
	    $line = <STDIN>;
	    parse_external_command($line, \*STDOUT);
#	    close(STDIN);
	} elsif ($handle == $sockserv)
	{
	    $sockclient = $sockserv->accept() || warn "accept: $!";
	    $clients++;
	    if ($clients > 5)
	    {
		print $sockclient "Sorry, we're full.\n";
		$sockclient->close();
	    } else
	    {
		$sockclients[$clients] = $sockclient;
	    }
	    $x->add($sockclients[$clients]);
	}
	$cl = is_member($handle, @sockclients);
	if ($cl > -1)
	{
	    $n_read = sysread($sockclients[$cl], $buf, 1024);
	    return 0 if (!n_read || !length $buf);
	    parse_external_command($buf, $sockclients[$cl]);
	}
    }
    yield;
}

sub read_udp_data
{
    $y = recv($blah, $buf, 1024, 0);
    if($y)
    {
	($xport, $iaddr) = unpack_sockaddr_in($y);
	$remotehost = inet_ntoa($iaddr);
	debug("peerhost $remotehost:$xport\n");
    }

    # Data comes in packets, denoted by 'PKT:<mudname>:<packetindex>:<packetteilnum>:<countteile>

    $pos = index(lc $buf, 'pkt');
    if($pos == 0)
    {
	$pos2 = index($buf, "|", $pos+4);
	$packetinfo = substr(lc $buf, $pos + 4, $pos2 - 4);
	$restbuf = substr($buf, $pos2 + 1);
	debug("Packet: $packetinfo\n");
	($pmudnew, $pindexnew, $packetsnew) = split(/\:/, $packetinfo);
	($pnumnew, $ptotalnew) = split(/\//, $packetsnew);
	debug("Mud: $pmudnew.\n");
	debug("Index: $pindexnew\n");
	debug("Packets: $pnumnew, $ptotalnew\n");

	$packets{$pmudnew}{$pindexnew}{'data'}{$pnumnew} = $restbuf;

	$num = scalar(keys(%{$packets{$pmudnew}{$pindexnew}{'data'}}));
	
	if(scalar(keys(%{$packets{$pmudnew}{$pindexnew}{'data'}})) == $ptotalnew)
	{
	    $newbuf = "";
	    for($item=1; $item<=$ptotalnew;$item++) 
	    {
		$newbuf = $newbuf . $packets{$pmudnew}{$pindexnew}{'data'}{$item};
	    }
	    open_packet($newbuf);
	}
    } else
    {
	open_packet($buf);
    }
} 


sub open_packet()
{
    # Parameter: A complete packet to interpret
    %request = ();
    $add_to_data = 0;
    debug("request is $_[0]\n");

    @commands = split(/\|/, $_[0]);
    
    if (@commands)
    {
        foreach $com (@commands)
        {
            if ($add_to_data) {
                $request{'data'} .= "|$com";
                next;
            }

            $com =~ /^(\w+):(.*)/s;

            if (not defined $1) {
                # Das Feld hatte kein ':' oder faengt nicht mit einem
                # Buchstaben an
                debug("ignoring empty '$com'\n");
                next;
            }

            # Schluesselworte koennen upper oder lower sein
            $field = lc $1;

            debug("processing: $field\t");

            # die festen faelle vorzugeben find ichn bissl unflexibel,
            # fuellen wir doch einfach ein hash mit dem kram

            $request{$field} = $2;

            # alle folgenden Felder einsammeln wenn wir bei DATA sind
            $add_to_data = 1 if ($field eq 'data');

        }
    }

    # So, nun sind alle angekommen Daten schoen im Hash drin, jetzt
    # entscheiden wir, was wir machen wollen

    # Was konnen wir ueberhaupt?
    $mycommands = "ping:who:tell:channel:finger";
    $myemail = "castaway\@desert-island.dynodns.net";
    $myversion = "PerlMud (Intermud-only) v0.1";
    $mymudport = 4248;
    $mylist = "commands:email:inetd:mud_port:version";
#    $mywholist = "An autumn eve;\nAlong this road\nGoes no one.\n\n";
    $mywholist = "Castaway is here.\n";

    # Who was talking to us?
    $remotename = $request{'name'}; 
    $remoteport = $request{'udp'};

    # Resulting Output
    my $output = "";

    if (exists $request{'req'}) {
        $ans = "NAME:$mudname|UDP:$port|REQ:reply|";
	my $data = "";

	debug("RN: $remotename\n");
	if (is_member(lc($remotename), @ignoredmuds) > -1)
	{
	    debug("$remotename: ignored.\n");
	    $ans = 0;
	    return;
	}

	# Mud must be alive if it's sending us data, update status + time.
	set_mud_status($request{'name'}, "UP");
	if ($request{'data'}) 
	{
	    chomp($request{'data'});
	}

        if ($request{'req'} eq 'ping') {
            $ans .= "ID:$request{'id'}|DATA:$mudname is alive.";
        } elsif ($request{'req'} eq 'who') {
            $ans .= "ID:$request{'id'}|RCPNT:$request{'snd'}|DATA:$mudname\n$mywholist";
        } elsif ($request{'req'} eq 'tell') {
            # hier muesste man checken ob die daten ueberhaupt da sind...
	    if($AWAY)
	    {
		$data = ucfirst($request{'rcpnt'}) . " is away : " . $AWAY . "\n";
	    }
	    if($request{'method'})
	    {
		if($request{'method'} eq 'adverb')
		{
		    if($request{'data'} =~ /\*(\w+)\*\s(.*)/)
		    {
			$output = ucfirst($request{'snd'}) . 
			    "\@$request{'name'} tells you $1: $2\n";
			$data .= "You told " . ucfirst($request{'rcpnt'}) . 
			    "\@$mudname $1: $2\n";
		    }
		}
		elsif($request{'method'} eq 'emote')
		{
		    if($request{'data'} =~ /\*(.*)\*/s)
		    {
			$output = ucfirst($request{'snd'}) . 
			    "\@$request{'name'} $1\n";
			$data .= "Emote an " . ucfirst($request{'rcpnt'}) . 
			    "\@$mudname ok.\n";
		    }
		} 
	    }
	    else
	    {
		$output = ucfirst($request{'snd'}) . "\@$request{'name'} tells you: $request{'data'}\n";
		$data .= "You told " . ucfirst($request{'rcpnt'}) . "\@$mudname: $request{'data'}\n";
	    }
	    if($output && $colours{'tell'})
	    {
		$output = colour_event('tell', $output);
	    }
            $ans .= "ID:$request{'id'}|RCPNT:$request{'snd'}|SND:castaway|DATA:$data";
	    add_history('tell', $output);
	} elsif ($request{'req'} eq 'query') {
	    if ($request{'data'} eq 'version') {
		$ans .= "ID:$request{'id'}|QUERY:$request{'data'}|RCPNT:$request{'snd'}|DATA:$myversion";
	    } elsif($request{'data'} eq 'commands') {
		$ans .= "ID:$request{'id'}|QUERY:$request{'data'}|RCPNT:$request{'snd'}|DATA:$mycommands";
	    } elsif ($request{'data'} eq 'email') {
		$ans .= "ID:$request{'id'}|QUERY:$request{'data'}|RCPNT:$request{'snd'}|DATA:$myemail";
	    } elsif ($request{'data'} eq 'inetd') {
		$ans .= "ID:$request{'id'}|QUERY:$request{'data'}|RCPNT:$request{'snd'}|DATA:$myversion";
	    } elsif($request{'data'} eq 'mud_port') {
		$ans .= "ID:$request{'id'}|QUERY:$request{'data'}|RCPNT:$request{'snd'}|DATA:$mymudport";
	    } elsif($request{'data'} eq 'list') {
		$ans .= "ID:$request{'id'}|QUERY:$request{'data'}|RCPNT:$request{'snd'}|DATA:$mylist";
	    } elsif($request{'data'} eq 'hosts') {
		my $hosts = '';
		foreach my $m (sort keys %muds)
		{
#		    debug($hosts);   
		    $hosts .= $muds{$m}[0] .':'. $muds{$m}[1] .':'. 
			$muds{$m}[2] .':';
		    if(defined($muds{$m}[3]))
		    {
			$hosts .= $muds{$m}[3] . ':';
		    }
		    else
		    {
			$hosts .= '*:';
		    }
		    if(defined($muds{$m}[4]))
		    {
			$hosts .= $muds{$m}[4] . "\n";
		    }
		    else
		    {
			$hosts .= "*\n";
		    }
		}			    
		$ans .= "ID:$request{'id'}|QUERY:$request{'data'}|RCPNT:$request{'snd'}|DATA:$hosts";
	    } else {
		$ans = 0;
		$output =  "Nichts erkannt! Query $request{'data'} from $request{'name'}\n";
	    }
	} elsif ($request{'req'} eq 'finger') {
	    if ($request{'data'} eq 'castaway')
	    {
		$ans .= "ID:$request{'id'}|RCPNT:$request{'snd'}|DATA:Castaway is here (somewhere).\n";
	    } else
	    {
		$ans .= "ID:$request{'id'}|RCPNT:$request{'snd'}|DATA:I don't know $request{'data'}.";
	    }
	} elsif ($request{'req'} eq 'reply') 
	{
	    if (&is_id($request{'id'}, 'ping'))
	    {
		$output = "$request{'data'}\n";
		set_mud_status($request{'name'}, "UP");
		del_id($request{'id'}, 'ping');
		$ans = 0;
	    } elsif (&is_id($request{'id'}, 'who'))
	    {
		$output = "$request{'data'}\n";
		del_id($request{'id'}, 'who');
		$ans = 0;
	    } elsif (&is_id($request{'id'}, 'tell'))
	    {
		$output = "$request{'data'}\n";
		del_id($request{'id'}, 'tell');
		$ans = 0;
	    } elsif (&is_id($request{'id'}, 'locate'))
	    {
		if($request{'fnd'} eq '1')
		{
		    $output = "$request{'data'} found in $request{'mudname'}\n";
		}
		else
		{
		    $output = "$request{'data'} not found in $request{'mudname'}\n";
		}
		del_id($request{'id'}, 'locate');
		$ans = 0;
	    } elsif (&is_id($request{'id'}, 'emote'))
	    {
		$output = "$request{'data'}\n";
		del_id($request{'id'}, 'emote');
		$ans = 0;
	    } elsif (&is_id($request{'id'}, 'finger'))
	    {
		$output = "$request{'data'}\n";
		del_id($request{'id'}, 'finger');
		$ans = 0;
	    } elsif (&is_id($request{'id'}, 'inetd'))
	    {
		$output =  "$request{'data'}\n";
		del_id($request{'id'}, 'inetd');
		$ans = 0;
	    } elsif (&is_id($request{'id'}, 'rlist'))
	    {
		$output =  "$request{'data'}\n";
		del_id($request{'id'}, 'rlist');
		$ans = 0;
	    } elsif (&is_id($request{'id'}, 'time'))
	    {
		$output =  "$request{'data'}\n";
		del_id($request{'id'}, 'time');
		$ans = 0;
	    } elsif (&is_id($request{'id'}, 'www'))
	    {
		$output =  "$request{'data'}\n";
		del_id($request{'id'}, 'www');
		$ans = 0;
	    } elsif (&is_id($request{'id'}, 'rhist'))
	    {
		$output =  "$request{'data'}\n";
		del_id($request{'id'}, 'rhist');
		$ans = 0;
	    } elsif (&is_id($request{'id'}, 'users'))
	    {
		$output =  "$request{'data'}\n";
		del_id($request{'id'}, 'users');
		$ans = 0;
	    } elsif (&is_id($request{'id'}, 'mud_port'))
	    {
		$output =  "$request{'data'}\n";
		del_id($request{'id'}, 'mud_port');
		$ans = 0;
	    } elsif (&is_id($request{'id'}, 'email'))
	    {
		$output =  "$request{'data'}\n";
		del_id($request{'id'}, 'email');
		$ans = 0;
	    } elsif (&is_id($request{'id'}, 'rman'))
	    {
		$output =  "$request{'data'}\n";
		del_id($request{'id'}, 'man');
		$ans = 0;
	    } elsif (&is_id($request{'id'}, 'hosts'))
	    {
		my @lines = split(/\n/, $request{'data'});
		foreach $l (@lines)
		{
#		    $l =~ /^(.+):(.+?):(.+?):([^:]*):([^:]*)$/;
		    $l =~ /^(.+):(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}):(.+?):([^:]*):([^:]*)/;
#		    debug($l . "\n");
		    @new = ();
		    $new[0] = $1;
		    $new[1] = $2;
		    $new[2] = $3;
		    $new[3] = $4;
		    $new[4] = $5;
#		    if($new[2] =~ /\./)
#		    {
#			$new[2] = $4;
#		    }
		    if($new[2] == -1)
		    {
			$new[2] = 0;
		    }
		    debug($new[0] . "\n");
		    debug($new[1] . "\n");
		    debug($new[2] . "\n");
		    add_mud($new[0], $new[1], $new[2], $new[3], $new[4]);
		}
		ping_muds();
	    } else
	    {
		$ans = 0;
	    }
	} elsif ($request{'req'} eq 'channel') {
	    if ((is_member($request{'channel'}, @ignoredchannels))==-1)
	    {
		if (!$request{'cmd'})
		{
		    $output =  "\[" . ucfirst($request{'channel'}) . " " . ucfirst($request{'snd'}) . "\@$request{'name'}\] $request{'data'}\n";
		} elsif ($request{'cmd'} eq 'emote')
		{
		    if(!$request{'emote'} || $request{'emote'} eq '1')
		    {
			$output = "\[" . ucfirst($request{'channel'}) ." " . ucfirst($request{'snd'}) . "\@$request{'name'} $request{'data'}\]\n";
		    } elsif ($request{'emote'} eq '2')
		    {
			$output = "\[" . ucfirst($request{'channel'}) ." " . ucfirst($request{'snd'}) . "\@$request{'name'}s $request{'data'}\]\n";
		    }
		} elsif ($request{'cmd'} eq 'history')
		{
		    $ans = 0;
		}
		if($output && $colours{$request{'channel'}})
		{
		    $output = colour_event($request{'channel'}, $output);
		}
	    }
	    # Don't send an answer to channel requests!
	    $ans = 0;
	    add_history($request{'channel'}, $output);
	} elsif ($request{'req'} eq 'man') {
	    $ans .= "ID:$request{'id'}|RCPNT:$request{'snd'}|DATA:No manpages here.";
	    
	} elsif ($request{'req'} eq 'locate') {
	    $ans .= "ID:$request{'id'}|RCPNT:$request{'snd'}";
	    if($request{'data'} eq 'castaway')
	    {
		$ans .= "|DATA:Castaway is logged in.";
	    }
	    else
	    {
		$ans .= "|DATA:No $request{'data'} here.";
	    }
	} else {
            $ans = 0; # hmmm, nicht erkannt
	    $output =  "Nichts erkannt! $request{'req'}\n";
        }
    }

    if ($ans) {
        # haben wir ne antwort?
        # auch hier muessten wir erst checken ob die daten 'da' sind

        # Hier muesste man nun eine Tabelle verwalten mit Mudname zu
        # IP-Nummer oder so, eventuell. Keine Ahnung wie man die
        # ip des partners rauskriegt :-/
#        $peermudaddi = 'wl.mud.de';
#	($mudhost, $udpport) = sockaddr_in ($blah->peername());
	debug("Mudhost is: $remotehost\n");

	send_mesg($ans, $request{'name'});
    }

    if ($output)
    {
	@olines = split('\n', $output);
	while(scalar(@olines) > $MORE)
	{
	    # if the output has more than $MORE lines
	    for (my $i = 0; $i < $MORE; $i++)
	    {
		print $sockwrite shift(@olines) . "\n";
	    }
	    print $sockwrite "---- More ----";
	    ReadKey 0;
	}
	print $sockwrite join("\n", @olines) . "\n";
    }
}
sub parse_external_command
{
    # Parameter: Input-Line, Socket-To-Output-To
    $line = $_[0];
    $sockwrite = $_[1];
    $line =~ s/[^ -~]//sg;
    my $output = "";

    $myhelp = "Commands:
Local
=====
add      - Add a new mud to the mudlist (<Name>, <IP>, <UDP-Port>)
muds     - List the muds in the current list
savemuds - Save the contents of %muds to INETD_HOSTS
readmuds - Read in the conents of INETD_HOSTS
debug    - Turn the debug mode on or off (<on>/<off>)
ignore   - Add a mud or channel to the ignore list (channel <channel>/mud <mud>)
ignored  - List which muds or channels are ignored
history  - show history of tell or channel
colours  - show current coloured objects
colour   - colour tell or channel (<tell/channel-name> <colour>)

Remote
======
tell     - Send a message to someone (<name>@<mudname> <message)
finger   - Call up a players finger-info (<name>@<mudname>)
who      - Get the wholist of the given mud (<mudname>)
emote    - Send an emote to someone (<name>@<mudname> <emote>)
rman      - Request a manpage (<manpage>@<mudname>)
rhist    - Ask for the history of a channel (<channel>@<mudname>)
rlist    - Ask for the list of users on a channel (<channel>@<mudname>)
rfinger  - ??
d-chat   - Send a message on the channel d-chat (<message>)
d-chat:  - Send an emote on d-chat (<emote>)
d-chat;  - Send a gemote on d-chat (<gemote>)
channel  - Send a message on a channel (channel <name> <message>)
qhosts    - Ask for the host-list of the given mud (<mudname>)
qinfo     - Get the 'info' of the given mud (<mudname>)
qmud_port - Get the mud port of the given mud (<mudname>)
qusers    - Get the inetd-version of the given mud (<mudname>)
qwww      - Get the www address of the given mud (<mudname>)
qemail    - Get the contact email address of the given mud (<mudname>)
qtime     - Get the time at the given mud (<mudname>)
";

    debug("You said: $line\n");
    $pos = index($line, " ");
    if ($pos > 0) 
    {
	$extcommand = substr($line, 0, $pos);
	$param = substr($line, $pos+1);
	chomp($param);
    }
    else
    {
	$extcommand = $line;
	chomp($extcommand);
	$param = "";
    }
    if($extcommand)
    {
#	$extcommand =~ s/[^ -~]//sg;
#	$param =~ s/[^ -~]//sg;
	debug("Command: $extcommand Parameter: $param\n");
	$ans = "NAME:$mudname|UDP:$port|SND:PerlMud|";
	if ($extcommand eq 'who' && length($param))
	{
	    $my_id = newID('who');
	    $param =~ /-k\s(.*)/;
	    $mud = $param;
	    if($1) {
		$mud = $1;
		$data = "kurz";
	    } else
	    {
		$data ="";
	    }
	    $ans .= "REQ:who|ID:$my_id|DATA:$data";
	    send_mesg($ans, $mud);
	} elsif ($extcommand eq 'tell' && length($param))
	{
            if($param =~ /^(\w+)\@(\w+)\s(?:(\/\S+)?\s?)(.*)/)
	    {
		debug("1: $1\n");
		debug("2: $2\n");
		debug("4: $4\n");
		$my_id = newID('tell');
		if($3)
		{
		    my $adverb = substr($3, 1);
		    debug("3: $adverb\n");
		    $ans .= "REQ:tell|ID:$my_id|SND:castaway|RCPNT:$1|METHOD:adverb|DATA:*$adverb* $4";
		}
		else
		{
		    $ans .= "REQ:tell|ID:$my_id|SND:castaway|RCPNT:$1|DATA:$4";
		}
		send_mesg($ans, $2);
	    }
	} elsif ($extcommand eq 'emote' && length($param))
	{
            if($param =~ /^(\w+)\@(\w+)\s(.*)/)
	    {
		debug("1: $1\n");
		debug("2: $2\n");
		debug("3: $3\n");
		$my_id = newID('emote');
		$ans .= "REQ:tell|ID:$my_id|SND:castaway|METHOD:emote|RCPNT:$1|DATA:*$3* ";
		send_mesg($ans, $2);
	    }
	} elsif ($extcommand eq 'finger' && length($param))
	{
            if($param =~ /^(\w+)\@(\w+)/)
	    {
		debug("1: $1 2: $2\n");
		$my_id = newID('finger');
		$ans .= "REQ:finger|ID:$my_id|SND:castaway|DATA:$1";
		send_mesg($ans, $2);    
	    }
	} elsif ($extcommand eq 'd-chat' && length($param))
	{
	    $ans .= "REQ:channel|SND:castaway|CHANNEL:d-chat|DATA:$param";
	    send_mesg($ans, 'all');
	} elsif ($extcommand eq 'd-chat:' && length($param))
	{
	    $ans .= "REQ:channel|CMD:emote|EMOTE:1|SND:castaway|CHANNEL:d-chat|DATA:$param";
	    send_mesg($ans, 'all');
	} elsif ($extcommand eq 'd-chat;' && length($param))
	{
	    $ans .= "REQ:channel|CMD:emote|EMOTE:2|SND:castaway|CHANNEL:d-chat|DATA:$param";
	    send_mesg($ans, 'all');
	} elsif ($extcommand eq 'rhist' && length($param))
	{
	    if($param =~ /^(\S*)\@(.*)$/)
	    {
		debug("1: $1 2: $2\n");
		$my_id = newID('rhist');
		$ans .= "REQ:channel|ID:$my_id|CMD:history|SND:castaway|CHANNEL:$1";
		send_mesg($ans, $2);
	    }
	} elsif ($extcommand eq 'rman' && length($param))
	{
	    if($param =~ /^(\S*)\@(.*)$/)
	    {
		debug("1: $1 2: $2\n");
		$my_id = newID('rman');
		$ans .= "REQ:man|ID:$my_id|SND:castaway|DATA:$1";
		send_mesg($ans, $2);
	    }
	} elsif ($extcommand eq 'rlist' && length($param))
	{
	    if($param =~ /^(\S*)\@(.*)$/)
	    {
		debug("1: $1 2: $2\n");
		$my_id = newID('rlist');
		$ans .= "REQ:channel|ID:$my_id|CMD:list|SND:castaway|CHANNEL:$1";
		send_mesg($ans, $2);	    
	    }
	} elsif ($extcommand eq 'rfinger' && length($param))
	{
	    if($param =~ /^(\S*)\@(.*)$/)
	    {
		debug("1: $1 2: $2\n");
		$my_id = newID('rfinger');
		$ans .= "REQ:channel|ID:$my_id|CMD:finger|SND:castaway|CHANNEL:$1";
		send_mesg($ans, $2);	    
	    }
	} elsif ($extcommand eq 'channel' && length($param))
	{
	    if($param =~ /^(\S*)\s(.*)/)
	    {
		debug("1: $1 2: $2\n");
		$ans .= "REQ:channel|SND:castaway|CHANNEL:$1|DATA:$2";
		send_mesg($ans, 'all');
	    }
	} elsif ($extcommand eq 'qhosts' && length($param))
	{
	    $my_id = newID('hosts');
	    $ans .= "REQ:query|ID:$my_id|DATA:hosts";
	    $mud = $param;
	    send_mesg($ans, $mud);
	} elsif ($extcommand eq 'qinfo' && length($param))
	{
	    $my_id = newID('info');
	    $ans .= "REQ:query|ID:$my_id|DATA:info";
	    $mud = $param;
	    send_mesg($ans, $mud);
	} elsif ($extcommand eq 'qinetd' && length($param))
	{
	    $my_id = newID('inetd');
	    $ans .= "REQ:query|ID:$my_id|DATA:inetd";
	    $mud = $param;
	    send_mesg($ans, $mud);
	} elsif ($extcommand eq 'qemail' && length($param))
	{
	    $my_id = newID('email');
	    $ans .= "REQ:query|ID:$my_id|DATA:email";
	    $mud = $param;
	    send_mesg($ans, $mud);
	} elsif ($extcommand eq 'qmud_port' && length($param))
	{
	    $my_id = newID('mud_port');
	    $ans .= "REQ:query|ID:$my_id|DATA:mud_port";
	    $mud = $param;
	    send_mesg($ans, $mud);
	} elsif ($extcommand eq 'qusers' && length($param))
	{
	    $my_id = newID('users');
	    $ans .= "REQ:query|ID:$my_id|DATA:users";
	    $mud = $param;
	    send_mesg($ans, $mud);
	} elsif ($extcommand eq 'qtime' && length($param))
	{
	    $my_id = newID('time');
	    $ans .= "REQ:query|ID:$my_id|DATA:time";
	    $mud = $param;
	    send_mesg($ans, $mud);
	} elsif ($extcommand eq 'qwww' && length($param))
	{
	    $my_id = newID('www');
	    $ans .= "REQ:query|ID:$my_id|DATA:www";
	    $mud = $param;
	    send_mesg($ans, $mud);
	} elsif ($extcommand eq 'locate' && length($param))
	{
	    if($param =~ /(\w+)(?:\@(\w+))?/)
	    {
		debug("Locate :$1\n");
		if($2)
		{
		    # Check at particular mud
		    $mud = $2;
		    debug("Locate :$2\n");
		}
		else
		{
		    $mud = 'all';
		}
		$my_id = newID('locate');
		$ans .= "REQ:locate|USER:castaway|VBS:1|ID:$my_id|DATA:$1";
		send_mesg($ans, $mud);
	    }
	} 
	# Internal commands
	# add - add name, IP, port to mudlist
	# muds - show mud list
	# debug on/off - change debug mode
	# ignore channel/mud - dont show messages for given channel/mud
	# ignored - show what is ignored
	# history mud/channel/person <nr> - show given number of history lines
	# savemuds - write muds to INETD_HOSTS.save
	# readmuds - reimport INETD_HOSTS
	elsif ($extcommand eq 'help' || $extcommand eq '?')
	{
	    print $sockwrite $myhelp;
	} elsif ($extcommand eq 'add' && length($param))
	{
	    # Add mud, format: name IP Port
	    if($param =~ /(.+)\s(\S*)\s(\d+)$/)
	    {
		debug("Mud: $1\n");
		debug("IP:  $2\n");
		debug("Port: $3\n");
		$test = add_mud($1, $2, $3);
		if($test)
		{
		    $output = "$1 added.\n";
		} else {
		    $output =  "Can't add $1\n";
		}
	    }
	} elsif ($extcommand eq 'muds')
	{
	    show_muds();
	} elsif ($extcommand eq 'savemuds')
	{
	    $output =  "Saving muds to INETD_HOSTS... \n";
	    save_inetd_hosts();
	} elsif ($extcommand eq 'readmuds')
	{
	    $output =  "Reading muds from INETD_HOSTS... \n";
	    read_inetd_hosts();
	} elsif ($extcommand eq 'debug' && length($param))
	{
	    if ($param eq 'on')
	    {
		$DEBUG = "on";
	    } elsif ($param eq 'off')
	    {
		$DEBUG = "off";
	    } elsif ($param eq 'log')
	    {
		$DEBUG = "log";
	    }
	    $output = "Debug mode: $DEBUG\n";
	} elsif ($extcommand eq 'ignore' && length($param))
	{
	    if($param =~ /^(\w+)\s(.*)$/)
	    {
		if (!$1 || !$2)
		{
		    next;
		}
		debug("1: $1 2: $2\n");
		if ($1 eq 'channel')
		{
		    $item = is_member($2, @ignoredchannels); 
		    if($item > -1)
		    {
			splice(@ignoredchannels, $item, 1);
			debug("Channels: @ignoredchannels\n");
		    } else
		    {
			@ignoredchannels = (@ignoredchannels, $2);
			debug("Channels: @ignoredchannels\n");
		    }
		    $output = "Ignored channels: @ignoredchannels\n";
		} elsif ($1 eq 'mud')
		{
		    $item = is_member($2, @ignoredmuds); 
		    if($item > -1)
		    {
			splice(@ignoredmuds, $item, 1);
			debug("Channels: @ignoredmuds\n");
		    } else
		    {
			@ignoredmuds = (@ignoredmuds, $2);
			debug("Channels: @ignoredmuds\n");
		    }
		    $output = "Ignored muds: @ignoredmuds\n";
		}
	    }
	} elsif ($extcommand eq 'ignored')
	{	    
	    $output = "Ignored channels: @ignoredchannels\n";
	    $output = "Ignored muds: @ignoredmuds\n";
	} elsif ($extcommand eq 'away' && length($param))
	{	    
	    $AWAY = $param;
	    $output = "You are away: $AWAY\n";
	} elsif ($extcommand eq 'history' && length($param))
	{	    
	    if($param =~ /^(\S+)(?:\s(\d+))?$/)
	    {
		debug("history : $1\n");
#	    debug("history : $2\n");
		list_history($1, $2);
	    }
	} elsif ($extcommand eq 'colours')
	{	    
	    list_colours;
	} elsif ($extcommand eq 'colour' && length($param))
	{	    
	    if($param =~ /^(\S+)\s(.*)$/)
	    {
		add_colour($1, $2);
		list_events;
	    }
	} else
	{
	    $output = "$extcommand not recognised!\n";
	}
	if ($output)
	{
	    print $sockwrite $output;
	}
    }
}

#Fiona teilt Dir mit: du kannst zb andere handles auch noch add()en und
#       can_read returnd dann den handler, der grad bedient werden kann (10:18)
#Fiona teilt Dir mit: oder du benutzt can_read(x) wobei x ein timeout ist (in
#       sekunden, floats gehen aber 0.001 ist halt soviele sekunden
#       (==polling)) (10:19)

#<21:46:22> Dan@GueldenLand redet zu dir: Paket von Gueldenland, Paket-ID 2028,
#           Teil 2 von 2, Inhalt 'z' 
#PKT:gueldenland:2034:2/2|z] |
#request is PKT:gueldenland:2034:1/2|NAME:GueldenLand|REQ:reply|RCPNT:PerlMud|ID:8|UDP:4246|DATA:


#Message from Fiona to you:
#   %packets                   deine daten
#   $packets{'mudname'}        der abgelegte wert im hash, ein skalar,
#                              insbesondere kein array oder hash! sondern
#                              nur ein zeiger darauf. also ein $var und kein
#   %var (auf das du mit $var{} zugreifen koenntest)
#
#   $var = $packets{'mudname'} Der Zeiger der der wert in dem packets hash
#                              ist ist nun in var
#
#   %myhash = %$var            Hier sagst du Perl, dass der Zeiger $var ein
#                              Zeiger auf einen Hash sein soll, und das willst
#                              du mit %myhash benutzen
#[End of message]
#Fiona teilt Dir mit: jetzt willst du da ja noch zugreifen, also $var =
#    $myhash{726} (paketnummer)
#Fiona teilt Dir mit: fuer dereferenzieren und zugreifen auf arrays oder hashs
#       IN EINEM SCHRITT gibt es in perl der -> operator.... also zb
#    $packets{'mudname'} dereferenzieren und dann zugreifen auf 726 ist:
#Fiona teilt Dir mit: $packets{'mudname'}->{726}
#Fiona teilt Dir mit: und zusaetzlich gilt... wenn du das mit etwas machst was
#    bereits auf [] oder {} endet, kannst du auch einfach den ->
#    weglassen... bleibt $packets{'mudname'}{726}
#Fiona teilt Dir mit: (also -> zwischen [] und/oder {} kann man einfach
#       weglassen)
#Fiona teilt Dir mit: command: builtin cmds, email: admin email, hosts: dump
#       INETD_HOSTS (achtung im richtigen format dumpen, nicht so wies bei dir
#Fiona teilt Dir mit: list -> kommando der builtin cmds also
#       commands:email:hosts:inetd:mud_port:time:version. mud_port: port des
#       muds, time die lokale zeit
#       liegt), inetd -> version des inetd
#Netdiver Pfy verkuendet dem Clan:  $black="033[30m";
#Netdiver Pfy verkuendet dem Clan:  $red="033[31m";
#Netdiver Pfy verkuendet dem Clan:  $green="033[32m";
#Netdiver Pfy verkuendet dem Clan:  $yellow="033[33m";
#Netdiver Pfy verkuendet dem Clan:  $blue="033[34m";
#Netdiver Pfy verkuendet dem Clan:  $magenta="033[35m";
#Netdiver Pfy verkuendet dem Clan:  $purple="033[35m";
#Netdiver Pfy verkuendet dem Clan:  $cyan="033[36m";
#Netdiver Pfy verkuendet dem Clan:  $white="033[37m";
#Netdiver Pfy verkuendet dem Clan:  $darkgray="033[30m";
#Fiona@WL-Development teilt Dir mit: und ggf (\S+) durch ([0-9.]{7,15})
#       ersetzen  ;o (15:11)
#request is CHANNEL:d-chat|CMD:emote|NAME:Wunderland|UDP:4246|REQ:channel|SND:Largo|EMOTE:1|DATA:emotet extra fuer Castaway.
#Fiona teilt Dir mit: pending_replies.... und ein alarm() fuer die 'no answer
#       timeout' meldung
#Fiona teilt Dir mit: rufe funktion xxx in y sekunden auf
#Fiona teilt Dir mit: (naja, ist nicht ganz so einfach, das sendet ein
#       SIGALARM in y sekunden und du musst einen signal-handler halt setzen
#       der dann xxx aufruft


sub pad_string
{
    ($str, $len) = @_;
    if (length($str) > $len)
    {
	return substr($str, 0, $len - 1);
    } elsif ($len > length($str))
    {
#	print "Str: $str\n";
	$str = sprintf("%-" . $len ."s", $str);
#	print "$str:\n";
	return $str;
    }
    return $str;
}

#####
# Is $item contained in the given list?
#
sub is_member
{
    ($item, @liste) = @_;
#    debug("Item: $item List: @liste\n");
    
    if(!$item || !@liste)
    {
	return -1;
    }
    for($i = 0; $i<@liste; $i++)
    {
	if ($liste[$i] eq $item)
	{
	    debug("Found: $i\n");
	    return $i;
	}
    }
    return -1;
}

sub remove_item
{
    ($item, @liste) = @_;
    $found = 0;
    for($i = 0; $i < @liste; $i++)
    {
	if ($i eq $item)
	{
	    debug("Found rem-item: $i\n");
	    $found = 1;
	} elsif ($found)
	{
	    if ($i < (@liste) - 1)
	    {
		$liste[$i] = $liste[$i + 1];
	    }
	}
    }
}

#TODO:
# ignorechannels - list of channels to ignore - done
# history - history{'d-chat'} {'tell'} usw.
# maxhistory - nr aufzuheben
# save inetd_hosts - done
# Sendmail interface
# aliases ! 
# command history! (ctrl n,p,e, a usw?)
# colour ? print "\e[31mTest\e[0m\n"
# 'commands' command (bzw. help oder ?) - done
# alert() / Timeout for packets/answers
# send recieved ids to correct client?
# debug log - write debug info into logfile - done
# log - log following answers to given file..
# away - mesg when not there - done
# prompt?
# ptked erweitern um 'oeffne file durch ftp' ??
# http://www.perl.com/pub/language/style/slide-index.html
# http://slinky.scrye.com/~tkil/perl
#Fiona teilt Dir mit: als spannendes buch kann ich dir uebrigens sehr
#       'programming pearls' empfehlen (allgemein zum programmieren)

#[D-code Dan@GueldenLand] z.B. so: @s = split /\:/, (reverse $s), 5; foreach (reverse @s) { print reverse split //; print "\n";}

# liste user/mud und serien/filme - d-tv -> anreden?