#!/usr/bin/perl -w

use strict;
use IO::Socket::INET;
use IO::Select;
#use Text::Wrap;

$| = 1;

my ($port) = 6666;
my ($ip) = 0;		# 0 == INADDR_ANY

my ($havenSock) = &initsock($ip,$port);

if ($havenSock == -1)
{
	die "Can't bind to port $port\n";
}

my ($new_readable,$sock,$buf,%uBySock,@users,@unum,%chan);
my ($now) = time();
my ($readable_handles) = IO::Select->new();
my (@new_readable);
$readable_handles->add($havenSock);
$unum[0] = 1;

my ($file) = $0;
my ($kill) = "";
my ($code) = "";

while (1)
{
	$kill = "";
	$code = "";

	open(FIL,$file) || die "Can't open $file\n";
	while (<FIL>)
	{ last if (/^###### BEGIN1 ######/); }
	while (<FIL>)
	{
		last if (/^###### END1 ######/);
		$kill .= $_;
	}
	while(<FIL>)
	{ last if (/^###### BEGIN2 ######/); }
	while (<FIL>)
	{
		last if (/^###### END2 ######/);
		$code .= $_;
	}
	close (FIL);

	eval $kill;
	eval $code;
	if ($@) 
	{
		print "ERROR: $@\n";
		sleep 5;
	}
	print "Softbooting...\n"
}

sub initsock 
{ 
	my ($ip,$port) = @_;

	if ($ip == 0)
	{ $ip = "0.0.0.0"; }

	my ($proto) = getprotobyname('tcp');
	my ($hsock) = IO::Socket::INET->new
		(Listen => 5,
		 LocalAddr => $ip,
		 LocalPort => $port,
		 Proto => $proto,
		 Type => SOCK_STREAM,
		 Reuse => 1);
	return $hsock || -1;
}

__END__

###### BEGIN1 ######

undef(&delUser); undef(&newconnect); undef(&addUserNum); undef(&writeuser);
undef(&writealluser); undef(&talk); undef(&proc_cmd); undef(&newname);
undef(&quit); undef(&who); undef(&timeconv); undef(&chanmaint);
undef(&writechan); undef(&toglock); undef(&dumpu); undef(&whisper);
undef(&togGmsg); undef(&togCmsg); undef(&writegmsg); undef(&writecmsg);
undef(&writeleftmsg); undef(&printhelp); undef(&wholine);
undef(&version); undef(&newUser); undef(&emote); undef(&togHush);
undef(&hcmds); undef(&yell); undef(&writeuserfile); undef(&togPecho);
undef(&togPbeep); undef(&togPhi); undef(&uptime); undef(&currenttime);
undef(&sec2dhms); undef(&finger); undef(&sec2dhms2); undef(&togwrap);
undef(&writewrapuser); undef(&printsource);

undef(%cmd); undef(%cmd2); undef($maxname);
undef($maxsite); undef($maxchan); undef($mainChan);
#undef(%hcmds);

###### END1 ######

###### BEGIN2 ######
#use Text::Wrap ('&wrap','$columns');

my ($version) = "v0.5.0";
my ($annfile) = "./SMACK.announce";
my ($annerr) = "### There should be an announcements message here.";
my ($introf) = "./SMACK.intro";
my ($introe) = "### There should be an intro file here.";

my (%cmd) = (
	"a" => sub { my ($u) = @_; &writeuserfile($u,$annfile,$annerr); },
	"b" => \&togPbeep,
	"c" => \&chanmaint,
	"C" => \&chanmaint,
	"D" => \&dumpu,
	"e" => \&togPecho,
	"f" => \&finger,
	"?" => \&printhelp,
	"h" => \&hcmds,
	"l" => \&toglock,
	"m" => \&togGmsg,
	"M" => \&togCmsg,
	"n" => \&newname,
	"O" => \&printsource,
	"p" => \&whisper,
	"q" => \&quit,
	"S" => \&togwrap,
	"t" => \&currenttime,
	"u" => \&uptime,
	"v" => \&version,
	"w" => \&who,
	"y" => \&yell,
	"\@" => sub { return 69; },
);

my (%cmd2) = (
	"a" => "announce",
	"b" => "togPbeep",
	"c" => "list chan",
	"c <chan>" => "change channel",
	"C" => "list chan",
	"C <chan>" => "change channel and lock",
	"D" => "dumpu",
	"e" => "togPecho",
	"f" => "finger users",
	"f #" => "finger user #",
	"?" => "printhelp",
	"hu" => "togHush",
	"l" => "toglock",
	"m" => "togGmsg",
	"M" => "togCmsg",
	"n <name>" => "newname",
	"O" => "print source (~1100 lines)",
	"p#[;]<msg>" => "whisper",
	"q" => "quit",
	"t", => "time",
	"u" => "uptime",
	"v" => "version",
	"w" => "who",
	"w:[#]" => "who < # minutes (default = 10)",
	"w <patt>" => "who <patt>",
	"y[;]" => "yell",
	"\@" => "softboot",
);

my (%hcmds) = (
	"u" => \&togHush,
	"i" => \&togPhi,
);

my ($maxname) = 20;
my ($maxsite) = 26;
my ($maxchan) = 14;
my ($mainChan) = "0";

while (1)
{
	my ($sb) = 0;
	(@new_readable) = $readable_handles->can_read(5);
	foreach $sock (@new_readable)
	{
		$now = time();
		if ($sock == $havenSock)
		{
			&newconnect($sock);
		} else {
			$buf = <$sock>;
			if ($buf)
			{
				chomp($buf);
				next if ($buf =~ /^\s*$/);
				$uBySock{$sock}{'lasttime'} = time();
				$buf =~ s/\r//;
				if ($buf =~ /^[,\.\/](.*)$/)
				{
					$sb = &proc_cmd($uBySock{$sock},$1);
					last if ($sb == 69);
				} else {
					&talk($uBySock{$sock},$buf);
				}
			} else {
# Client closed socket. We do the same here, and remove it from the
# readable_handles list
				&writeleftmsg($uBySock{$sock},$uBySock{$sock}->{'chan'},sprintf(">> (%d) %s just left. (dead link)",$uBySock{$sock}->{'num'},$uBySock{$sock}->{'name'}));
				&delUser($uBySock{$sock});
			}
		}
	}   
	last if ($sb == 69);
}

sub delUser
{
	my ($u) = @_;
	my ($x);

	$readable_handles->remove($$u{'sock'});
	for $x (0 .. $#users)
	{
		if (defined($users[$x]) && $users[$x] == $u)
		{ splice(@users,$x,1); }
	}
	$unum[$$u{'num'}] = 0;
	delete($uBySock{$$u{'sock'}});
	if (--$$u{'chan'}{'users'} < 1)
	{ delete($chan{$$u{'chan'}{'name'}}); }
	elsif ($$u{'locks'} > 0)
	{
		if (--$$u{'chan'}{'locks'} < 1)
		{	&writechan($$u{'chan'},">> Channel now insecure."); }
	}
	close $$u{'sock'};
	foreach (@users)
	{
		$_->{'lastP'} = 0 if ($_->{'lastP'} == $$u{'num'});
	}
}

sub newconnect
{
	my ($sock) = @_;

	my ($newsock) = $sock->accept();
	$readable_handles->add($newsock);
	my ($u) = &newUser($newsock);
	push(@users,$u);
	$uBySock{$newsock} = $u;
	&addUserNum($u);
	&writeuserfile($u,$introf,$introe);
  &writegmsg(undef,">> New user on line $$u{'num'} from $$u{'site'}");
	&chanmaint($u,"c","0");
}

sub newUser
{
	my ($sock) = @_;
	my (%u);

	$u{"name"} = "?";
	$u{"locks"} = 0;
	$u{"sock"} = $sock;
	$u{"lasttime"} = time();
	$u{"starttime"} = time();
	($u{"site"},undef) = gethostbyaddr(inet_aton($sock->peerhost()),AF_INET);
	if (!$u{"site"})
	{ $u{"site"} = $sock->peerhost(); }
	$u{'nocmsgs'} = 0;
	$u{'nogmsgs'} = 0;
	$u{'hush'} = 0;
	$u{'Pecho'} = 0;
	$u{'Pbeep'} = 0;
	$u{'Phi'} = 0;
	$u{'lastP'} = 0;
	$u{'wrap'} = 0;
	$u{'lwrap'} = 0;
	return \%u;
}

sub addUserNum
{
	my ($u) = @_;
	my ($x) = 0;

	while (@unum > $x)
	{
		$x++;
		next if (defined($unum[$x]) && $unum[$x] != 0);
		last;
	}
	$$u{"num"} = $x;
	$unum[$x] = $u;
}

sub writeuser
{
	my ($u,$str) = @_;

	if (defined ($u->{'wrap'}) && $u->{'wrap'} > 10)
	{ &writewrapuser($u,$str); }
	else
	{
		my ($sock) = $$u{'sock'};
		print $sock $str . "\r\n";
	}
}

sub writealluser
{
	my ($msg) = @_;
	my ($x);

	foreach $x (@users)
	{
		&writeuser($x,$msg);
	}
}

sub talk
{
	my ($u,$msg) = @_;

	($msg,undef) = &emote($u,"",$msg);
	&writechan($$u{'chan'},$msg);
}

sub proc_cmd 
{
  my ($u,$str) = @_;

  $str =~ /^(.)(.*)$/;
  my ($cchar) = $1;
  my ($rest) = $2;
	my ($x);
  if (exists($cmd{$cchar}))
  {
    $x = &{$cmd{$cchar}}($u,$cchar,$rest);
  } else {
    $x = &writeuser($u,">> Command not found.");
  }
	if (defined($x) && $x == 69)
	{ return 69; }
	else
	{ return 0; }
}

sub newname
{
  my ($u,undef,$str) = @_;

	$str =~ s/^\s+(\S+.*)$/$1/;
	$str =~ s/^(.*\S+)\s+$/$1/;
  if (length($str) > $maxname)
  { $str =~ s/^(.{${maxname}}).*$/$1/; }
  $$u{"name"} = $str;
  &writeuser($u,">> Name changed to $str");
}

sub quit
{
  my ($u,undef,undef) = @_;

  &writeuser($u,">> Thank you, drive thru.");
	&writeleftmsg($u,$u->{'chan'},sprintf(">> (%d) %s just left.",$u->{'num'},$u->{'name'}));
  &delUser($u);
}

sub who
{
  my ($u,$case,$str) = @_;
  my ($x,$outstr,$g);
	my ($ucount) = 0;
	my ($header) = "  Line Name                 Channel        Idle    Site";
	&writeuser($u,$header);
  if ($str =~ /^\s*$/)
  {
    foreach $x (@users)
    {
			&writeuser($u,&wholine($u,$x));
			$ucount++;
		}
		&writeuser($u,"$ucount users found.");
	}
	elsif ($str =~ /^:(\d*)/)
	{
		if ($1 eq "")
		{ $g = 300; }
		else
		{ $g = $1 * 60; }

		my ($now) = time();
		foreach $x (@users)
		{
			if ($now - $x->{'lasttime'} <= $g)
			{
				&writeuser($u,&wholine($u,$x));
				$ucount++;
			}
		}
		&writeuser($u,"$ucount users found.");
	}
	elsif ($str =~ /^0$/)
	{
		foreach $x (@users)
    {
			next if ($x->{'chan'}{'name'} ne $mainChan);
      &writeuser($u,&wholine($u,$x));
      $ucount++;
    }
    &writeuser($u,"$ucount users found.");
	}
	elsif ($str =~ /^\d+$/)
	{
		foreach $x (@users)
		{ 
			next if ($x->{'num'} != $str);
			&writeuser($u,&wholine($u,$x));
			$ucount++;
		}
    &writeuser($u,"$ucount users found.");
	}
	else
	{
		if ($case eq "w")
		{ $case = "i"; }
		else
		{ $case = ""; }

		foreach $x (@users)
		{
			next if ($x->{'name'} !~ m/$str/i);
			&writeuser($u,&wholine($u,$x));
			$ucount++;
		}
		if ($ucount > 0)
		{ &writeuser($u,"$ucount names found."); }

		$ucount = 0;
		foreach $x (@users)
		{
			next if ($x->{'chan'}{'name'} !~ m/$str/i);
			&writeuser($u,&wholine($u,$x));
			$ucount++;
		}
		if ($ucount > 0)
		{ &writeuser($u,"$ucount channels found."); }

		$ucount = 0;
		foreach $x (@users)
		{
			next if ($x->{'site'} !~ m/$str/i);
			&writeuser($u,&wholine($u,$x));
			$ucount++;
		}
		if ($ucount > 0)
		{ &writeuser($u,"$ucount sites found."); }

	}
}

sub wholine
{
	my ($u,$x) = @_;
	my ($g);
	my ($outstr) = "";

	$outstr = sprintf("    %2d %-*s %-*s %-6s  %-*s",
		$$x{'num'},$maxname,$$x{'name'},
		$maxchan,$$x{'chan'}{'name'},&timeconv($now - $$x{'lasttime'}),
		$maxsite,$$x{'site'});
	if ($$x{"chan"}{"locks"} > 0)
	{
		if ($$x{"locks"} > 0)
		{ $g = "*"; }
#		{ $outstr =~ s/(.).(.*)/${1}*${2}/; }
		else
		{ $g = "+"; }
		$outstr =~ s/(.).(.*)/${1}$g${2}/;
	}
	if ($$x{'nocmsgs'} > 0 || $$x{'nogmsgs'} > 0)
	{
		if ($$x{'nocmsgs'} > 0)
		{ if ($$x{'nogmsgs'} > 0)
			{ $g = "X"; } else { $g = "M"; }
		} else {
			$g = "m";
		}
		$outstr =~ s/^(...).(.*)$/$1$g$2/;
	}
	if ($$x{'hush'} > 0)
	{
		$outstr =~ s/^(..).(.*)$/${1}H${2}/;
	}
	return $outstr;
}

sub timeconv
{
	my ($s) = @_;

	my ($str,$d,$h,$m,@dum);
	push(@dum,"");
	push(@dum,"");

	$m = int($s / 60);
	$s = $s % 60;
	if ($s > 0)
	{ unshift(@dum,"${s}s"); pop(@dum); }
	$h = int($m / 60);
	$m = $m % 60;
	if ($m > 0)
	{ unshift(@dum,"${m}m"); pop(@dum); }
	$d = int($h / 24);
	$h = $h % 24;
	if ($h > 0)
	{ unshift(@dum,"${h}h"); pop(@dum); }
	if ($d > 0)
	{ unshift(@dum,"${d}d"); pop(@dum); }

	$str = join('',@dum);
	$str =~s/^(\s*)$/0s/;
	return $str;
}

sub chanmaint
{
	my ($u,$lock,$cname) = @_;

	my ($oldc,$newc,$x);

	$cname =~ s/^\s+(\S+.*)$/$1/;
	$cname =~ s/^(.*\S+)\s+$/$1/;
	$cname =~ s/^(.{$maxchan}).*$/$1/;

	if ($cname =~ /^\s*$/)
	{
		&writeuser($u,"Users  Channel Name");
		foreach (keys(%chan))
		{
			next if (! defined($chan{$_}->{'name'}));
			&writeuser($u,sprintf("  %3d  %s",$chan{$_}->{'users'},$_));
		}
		return;
	}

	if ($$u{'chan'})
	{ $oldc = $$u{'chan'}{'name'}; }
	else
	{ $oldc = ""; }

	if (defined($chan{$cname}->{'name'}))
	{
		if ($$u{'chan'} && $chan{$cname} == $$u{'chan'})
		{
			&writeuser($u,">> Jackass.");
			return;
		}
		if ($chan{$cname}{'locks'} > 0)
		{
			&writeuser($u,">> Sorry, $cname is locked.");
			return;
		}
		$$u{'chan'} = $chan{$cname};
	}
	else
	{
		$newc->{'name'} = "$cname";
		$newc->{'locks'} = 0;
		$chan{$cname} = $newc;
		$$u{'chan'} = $newc;
	}
	$$u{'chan'}->{'users'}++;

	if ($oldc ne "")
	{
		if (--$chan{$oldc}->{'users'} > 0)
		{
			&writecmsg($chan{$oldc},sprintf(">> ($$u{'num'}) $$u{'name'} has wandered off to %s",$$u{'chan'}->{'name'}));
			if ($$u{'locks'} > 0)
			{
				if (--$chan{$oldc}->{'locks'} < 1)
				{ &writecmsg($chan{$oldc},">> Channel now insecure."); }
			}
		} else {
			delete($chan{$oldc});
		}
		&writecmsg($$u{'chan'},sprintf(">> (%d) %s has joined",$$u{'num'},$$u{'name'}));
	}
	$$u{'locks'} = 0;
	if ($lock eq "C")
	{
		&toglock($u);
	}
}

sub writechan
{
	my ($chan,$msg) = @_;
	my ($u);

	foreach $u (@users)
	{
		if ($$u{'chan'} == $chan)
		{
			&writeuser($u,$msg);
		}
	}
}

sub toglock
{
	my ($u) = @_;

	if ($$u{'chan'}->{'name'} eq $mainChan)
	{
		&writeuser($u,">> You can't lock main.");
		return;
	}

	if ($$u{'locks'} > 0)
	{
		$$u{'locks'} = 0;
		$$u{'chan'}{'locks'}--;
		&writechan($$u{'chan'},">> ($$u{'num'}) $$u{'name'} has unlocked $$u{'chan'}->{'name'}");
		if ($$u{'chan'}->{'locks'} < 1)
		{ &writechan($$u{'chan'},">> Channel now insecure."); }
	}
	else
	{
		$$u{'locks'} = 1;
		if ($$u{'chan'}{'locks'}++ > 0)
		{
			&writechan($$u{'chan'},">> ($$u{'num'}) $$u{'name'} has relocked $$u{'chan'}->{'name'}");
		} else {
			&writechan($$u{'chan'},">> ($$u{'num'}) $$u{'name'} has locked $$u{'chan'}->{'name'}");
		}
	}
}

sub dumpu
{
	my($u,$x,$y) = @_;

	foreach (keys(%$u))
	{
		&writeuser($u,"$_: $$u{$_}");
	}
	$x = $$u{'chan'};
	&writeuser($u,"Channel:");
	foreach (keys(%$x))
	{
		&writeuser($u,"  $_: $$x{$_}");;
	}
	&writeuser($u,"All channels: ");
	foreach $y (keys(%chan))
	{
		&writeuser($u,"  $y");
		foreach (keys(%{$chan{$y}}))
		{
			&writeuser($u,"    $_: ${$chan{$y}}{$_}");
		}
	}
}

sub whisper
{
	my ($u,$dum,$str) = @_;
	my ($x,$z,$echo);
	my ($beep) = "";
	my ($hi) = "";
	my ($lo) = "";

	$str =~ s/^(\d*)(\D*.*)/$2/;
	$x = $1;
	if ($x !~ /^\d+$/)
	{
		if ($u->{'lastP'} == 0)
		{ &writeuser($u,">> Who would you like to .pee on ?"); return; }

		$x = $u->{'lastP'};
	}
	else
	{ $u->{'lastP'} = $x; }

	$str =~ s/^\s+(.*)$/$1/;
	$str =~ s/^(.*)\s+$/$1/;
	if (defined($unum[$x]) && $unum[$x] != 0)
	{
		$z = $unum[$x];
		if ($z->{'Pbeep'} == 1)
		{ $beep = "\007"; }
		if ($z->{'Phi'} == 1)
		{ $hi = "\033[1m"; $lo = "\033[0m"; }
		($str,$echo) = &emote($u,",p",$str);
		&writeuser($z,"$beep$hi$str$lo");
		if ($u->{'Pecho'} == 1)
		{ &writeuser($u,sprintf(">> '%s' sent to (%d) %s",$echo,$z->{'num'},$z->{'name'})); }
		else
		{ &writeuser($u,sprintf(">> .p sent to (%d) %s",$z->{'num'},$z->{'name'})); }
	}
	else
	{ &writeuser($u,">> That person doesn't exist!"); }
}

sub togGmsg
{
	my ($u,undef,undef) = @_;

	if ($$u{'nogmsgs'} == 1)
	{
		$$u{'nogmsgs'} = 0;
		&writeuser($u,">> Arrival/departure messages enabled.");
	} else {
		$$u{'nogmsgs'} = 1;
		&writeuser($u,">> Arrival/departure messages disabled.");
	}
}

sub togHush
{
	my ($u,undef,undef) = @_;

	if ($$u{'hush'} == 1)
	{
		$$u{'hush'} = 0;
		&writeuser($u,">> Unhushed. Yells enabled.");
	} else {
		$$u{'hush'} = 1;
		&writeuser($u,">> Hushed. Yells suppressed.");
	}
}

sub togCmsg
{
	my ($u,undef,undef) = @_;

	if ($$u{'nocmsgs'} == 1)
	{
		$$u{'nocmsgs'} = 0;
		&writeuser($u,">> Channel messages enabled.");
	} else {
		$$u{'nocmsgs'} = 1;
		&writeuser($u,">> Channel messages disabled.");
	}
}

sub writegmsg
{
	my ($u,$msg) = @_;
	my ($x);

	foreach $x (@users)
	{
		next if ($u && $u eq $x);
		&writeuser($x,$msg) if ($x->{'nogmsgs'} == 0);
	}
}

sub writecmsg
{
	my ($chan,$msg) = @_;
	my ($x);

	foreach $x (@users)
	{
		next if ($x->{'chan'} && $x->{'chan'} != $chan);
		&writeuser($x,$msg) if ($x->{'nocmsgs'} == 0);
	}
}

sub writeleftmsg
{
	my ($u,$chan,$msg) = @_;

	&writegmsg($u,$msg);
	foreach (@users)
	{
		next if ($_->{'chan'} != $chan);
		next if ($_->{'nogmsgs'} == 0);
		next if ($_->{'nocmsgs'} == 1);
		next if ($_ eq $u);
		&writeuser($_,$msg);
	}
}

sub printhelp
{
	my ($u) = @_;

	foreach (sort({uc($a) cmp uc($b)} keys(%cmd2)))
	{
		&writeuser($u,".$_  ==  $cmd2{$_}");
	}
}

sub version
{
	my ($u) = @_;

	&writeuser($u,">> SmackFix $version");
}

sub emote
{
	my ($u,$type,$str) = @_;
	my ($star) = "";
	my ($echo) = "";

	if ($type =~ /y/)
	{ $type = ""; $star = "*"; }

	if ($str =~ /^ {0,1}[;:](.*)$/)
	{
		$str = $1;
		if ($str !~ /^,|'ll |'s |'d /)
		{
			$str =~ s/^\s*(\S*.*)$/ $1/;
		}
		if ($type =~ /p/ && $u->{'Pecho'} == 1)
		{ $echo = sprintf("%s%s",$u->{'name'},$str); }
		return sprintf("(%s%d%s%s) %s%s",$star,$u->{'num'},$type,$star,$u->{'name'},$str),$echo;
	}
	else
	{
		if ($type =~ /p/ && $u->{'Pecho'} == 1)
		{ $echo = $str; }
		if ($type eq "") { $type = ","; }
		return sprintf("(%s%d%s %s%s) %s",$star,$u->{'num'},$type,$u->{'name'},$star,$str),$str;
	}
}

sub hcmds
{
	my ($u,undef,$str) = @_;

	$str =~ /^(.)/;
	if (exists($hcmds{$1}))
	{ &{$hcmds{$1}}($u); }
	else
	{ &writeuser($u,">> Command not found.");	}
}

sub yell
{
	my ($u,undef,$msg) = @_;

	if ($$u{'hush'} > 0)
	{
		return &writeuser($u,">> You can't yell, you're hushed!");
	}
	($msg,undef) = &emote($u,",y",$msg);
	foreach (@users)
	{
		if ($$_{'hush'} < 1)
		{	&writeuser($_,$msg); }
	}
}

sub writeuserfile
{
	my ($u,$file,$errstr) = @_;

	if (! -T $file)
	{
		&writeuser($u,$errstr);
		return;
	}

	if (open(FIL,$file))
	{
		while (<FIL>)
		{ chomp; &writeuser($u,$_); }
		close(FIL);
	}
	else
	{
		&writeuser($u,"### Error opening file $file");
	}
}

sub togPecho
{
  my ($u,undef,undef) = @_;

  if ($$u{'Pecho'} == 1)
  {
    $$u{'Pecho'} = 0;
    &writeuser($u,">> .p echoing disabled");
  } else {
    $$u{'Pecho'} = 1;
    &writeuser($u,">> .p echoing enabled");
  }
}

sub togPbeep
{
  my ($u,undef,undef) = @_;

  if ($$u{'Pbeep'} == 1)
  {
    $$u{'Pbeep'} = 0;
    &writeuser($u,">> .p beeps disabled");
  } else {
    $$u{'Pbeep'} = 1;
    &writeuser($u,">> .p beeps enabled");
  }
}

sub togPhi
{
  my ($u,undef,undef) = @_;

  if ($$u{'Phi'} == 1)
  {
    $$u{'Phi'} = 0;
    &writeuser($u,">> .p hiliting disabled.");
  } else {
    $$u{'Phi'} = 1;
    &writeuser($u,">> .p hiliting enabled.");
  }
}

sub uptime
{
	my ($u,undef,undef) = @_;

	&writeuser($u,">> The haven has been up for " . &sec2dhms(time()-$^T) . ".");
	&writeuser($u,">> Since " . localtime($^T));
}

sub sec2dhms
{
	my ($s) = @_;
	my ($d,$h,$m);

	$d = int($s/86400);
	$s %= 86400;
	$h = int($s/3600);
	$s %= 3600;
	$m = int($s/60);
	$s %= 60;

	return sprintf("%d day%s, %02d:%02d:%02d",$d,$d == 1 ? "" : "s",$h,$m,$s);
}

sub sec2dhms2
{
	my ($s) = @_;
	my ($d,$h,$m);
	my ($count) = 0;
	my ($str) = "";

	$d = int($s/86400);
	$s %= 86400;
	$h = int($s/3600);
	$s %= 3600;
	$m = int($s/60);
	$s %= 60;

	if ($d > 0)
	{ $str .= "${d}d"; ++$count; }
	if ($h > 0)
	{ $str .= "${h}h"; return $str if (++$count == 2); }
	if ($m > 0)
	{ $str .= "${m}m"; return $str if (++$count == 2); }
	if ($s > 0)
	{ $str .= "${s}s"; return $str if (++$count == 2); }

	if ($str eq "")
	{ $str = "0s"; }
	
	return $str;
}

sub currenttime
{
	my ($u) = @_;

	&writeuser($u,">> Official Curryco.com time (PST) is ".localtime(time));
}

sub finger
{
	my ($u,undef,$str) = @_;
	my ($x);
	my ($count) = 0;

	if ($str =~ /^\s*$/)
	{
		$str = "";
		foreach $x (@users)
		{
			$str .= sprintf("%2d)%-*s ", $x->{'num'}, $maxname, $x->{'name'});
			if (++$count > 2)
			{
				&writeuser($u,$str);
				$count = 0;
				$str = "";
			}
		}
		if ($str ne "")
		{ &writeuser($u,$str); }
		&writeuser($u, @users ." users on.")
	}
	else
	{
		if ($str !~ /^\s*(\d+)\s*$/ || !defined($unum[$1]) || $1 == 0)
		{ &writeuser($u,">> Bad user number."); return; }

		my ($z) = $unum[$1];

		&writeuser($u,">> Line ".$z->{'num'}.": ".$z->{'name'}." on channel ".$z->{'chan'}{'name'});
		&writeuser($u,">> On from ".$z->{'site'}." since ".localtime($z->{'starttime'})." (".&sec2dhms2(time() - $z->{'starttime'}).")");
		&writeuser($u,">> " . ($z->{'hush'} == 1 ? "H" : "Not h") . "ushed, " .
			($z->{'nogmsgs'} == 1 ? "Nog" : "G") . "msgs, " .
			($z->{'nocmsgs'} == 1 ? "Noc" : "C") . "msgs, " .
			($z->{'Pbeep'} == 1 ? "B" : "No b") . "eeps, " .
			($z->{'Pecho'} == 1 ? "P" : "No p") . " echo, " .
			($z->{'wrap'} > 10 ? "Word" : "No") . " wrap, " .
			($z->{'Phi'} == 1 ? "p H" : "No h") . "ilites.");
	}
}

sub togwrap
{
	my ($u,undef,$w) = @_;

	$w =~ s/^\s*(\d+)\D*.*$/$1/;

	if ($w !~ /^\d+$/)
	{
		if ($u->{'wrap'} > 10)
		{
			$u->{'lwrap'} = $u->{'wrap'};
			$u->{'wrap'} = 0;
			&writeuser($u,">> word wrap disabled.");
			return;
		}
		else
		{
			if (defined($u->{'lwrap'}) && $u->{'lwrap'} > 10)
			{ $u->{'wrap'} = $u->{'lwrap'}; }
			else
			{ $u->{'wrap'} = 80; }
		}
	}
	elsif ($w < 10 || $w > 200)
	{ &writeuser($u,">> invalid screen size!"); return; }
	else
	{ $u->{'wrap'} = $w; }

	&writeuser($u,">> word wrap enabled for width of $u->{'wrap'}.");
}

sub writewrapuser
{
	my ($u,$str) = @_;
	my ($sock) = $u->{'sock'};
	my ($w) = $u->{'wrap'};
	my (@txt,$x);

#print $sock $str . "\r\n";

#	$columns = $w;

	if (length($str) - 2 < $w)
	{ print $sock $str . "\r\n"; return; }

	@txt = split(/\s/,$str);
	if (@txt) { $str = shift(@txt); }
	while (@txt)
	{
		if (length($str . $txt[0]) + 1 < $w)
		{ $str .= (($str eq "" && $txt[0] ne "" && $txt[0] ne " ") ? "" : " ") . shift(@txt); next; }
		else
		{
			if ($str eq "")
			{
				$txt[0] =~ s/^(.{$w})(.*)$/$2/;
				$str = $1;
			}
		}

		print $sock $str . "\r\n";
		$str = "";
	}
	if ($str ne "")
	{ print $sock $str . "\r\n"; }
}

sub printsource
{
	my ($u,undef,undef) = @_;

	writeuserfile($u,$0,">>>>  Oh shit, something is FUCKED.");
}
###### END2 ######