Enhanced CTorrent Code

1649 lines (1454 with data), 50.4 kB

#!/usr/bin/perl -Tw
###############################################################################
#
# CTorrent Control Server (CTCS) version 1.0a
# Copyright 2006 Dennis Holmes  (dholmes@ct.boxmail.com)
#
# This is a program for monitoring and managing Enhanced CTorrent clients.
# See http://www.rahul.net/dholmes/ctorrent/ctcs.html for details.
#
# You will probably want to change the top line if the Perl interpreter
# is not accessible on your system at the path that is shown.
#
#
# This program is provided AS IS with no warranty of any kind.
# Use at your own risk!
#
# Set tabs = 3 spaces for proper viewing.
#
###############################################################################

use strict;
use Socket;
use Carp;
use Fcntl;
use Sys::Hostname;

$| = 1;

# global variables
my $bwinterval = 5;	# bandwidth management interval (seconds)
my $CTCS_PROTOCOL = "0001";
my (%cfh,%torrents,%ctfile,%ctbw,%ctconfig,%ctdetail,%ctstatus,%ctstime,
	%ctpeer,%ctpeern,%ctinfo,%ctinfoclear,%ctfiledata,%buffer,%totalpieces,
	%dead,%dtime,%stime);
my (%mindl,%maxdl,%minul,%maxul,%sharedl,%shareul);
my (%htclients,%ctsent,%ctsentone);
my $tdlimit = 100 * 1024;
my $tulimit = 25 * 1024;	# total dl/ul bw limits
my ($alldl,$allul)=(0,0);
my %ctclients1= ( "AR", "Arctic",
						"AZ", "Azureus",
						"BB", "BitBuddy",
						"BC", "BitComet",
						"BS", "BTSlave",
						"BX", "Bittorrent X",
						"CD", "Enhanced CTorrent",
						"CT", "CTorrent",
						"KT", "KTorrent",
						"lt", "libtorrent",
						"LT", "libtorrent",
						"ML", "MLDonkey",
						"MP", "MooPolice",
						"MT", "MoonlightTorrent",
						"SB", "Swiftbit",
						"SS", "SwarmScope",
						"SZ", "Shareaza",
						"TN", "TorrentDotNET",
						"TR", "Transmission",
						"TS", "Torrentstorm",
						"UT", "uTorrent",
						"XT", "XanTorrent",
						"ZT", "ZipTorrent"
	);
my %ctclients2= ( "A", "ABC",
						"O", "Osprey Permaseed",
						"S", "Shadow's client",
						"T", "BitTornado",
						"U", "UPnP NAT Bit Torrent"
	);
my $EOL = "\015\012";

{	# main block
my $port = 2780;
my $proto = getprotobyname('tcp');
my $authpass = 0;
my %authorized;

while ($_=shift()) {
	if (/^-d$/) { $tdlimit = shift() * 1024; }
	elsif (/^-u$/) { $tulimit = shift() * 1024; }
	elsif (/^-i$/) { $bwinterval = shift(); }
	elsif (/^-p$/) { $port = shift(); }
	elsif (/^-P$/) { $authpass = 1; }
	else {
		&usage();
		exit;
	}
}
if ($tdlimit==0 || $tulimit==0 || $bwinterval==0 || $port==0) {
	&usage();
	exit;
}
$port = $1 if $port =~ /(\d+)/; # untaint port number
if ($authpass) {
	print "You have selected to specfy a password which CTorrent clients\n";
	print "will use to authenticate to CTCS.\n";
	print "Enter the password to use: ";
	$authpass = <>;
}

socket(Server, PF_INET, SOCK_STREAM, $proto)	|| die "socket: $!";
setsockopt(Server, SOL_SOCKET, SO_REUSEADDR,
	pack("l", 1)) 	|| die "setsockopt: $!";
bind(Server, sockaddr_in($port, INADDR_ANY))	|| die "bind: $!";
listen(Server,SOMAXCONN) 				|| die "listen: $!";

&logmsg("CTCS server started on port $port");
my $host = hostname() || 'localhost';
my $addr = inet_ntoa(scalar gethostbyname($host || 'localhost'));
print "\nCTorrent Control Server v1.0a\n";
print "http://www.rahul.net/dholmes/ctorrent/ctcs.html\n";
print "\nUse the '-S $host:$port' option to Enhanced CTorrent\n";
print "to have this CTCS instance manage the client.\n";
print "Status information is available at:\n";
print "    http://$host:$port/\n";
print " or http://$addr:$port/  ";
print " (or http://localhost:$port/ from this system)\n\n";

$SIG{CHLD} = \&REAPER;

my ($nsock,$rin,$win,$ein,$rout,$wout,$eout,$foo,$client,$ct);
my $cnum = 0;
my (%clients,%clients2);
my $bwtime = 0;
while (1) {
	%clients = %clients2;

	if (time() >= $bwtime + $bwinterval && scalar(keys %torrents)) {
		$bwtime = time();
		&manage_bw;
	}

	$rin = $win = $ein = '';
	vec($rin, fileno(Server), 1) = 1;
	foreach $client (keys %clients) {
		vec($rin, fileno($cfh{$client}), 1) = 1;
	}
	$ein = $rin | $win;

	$nsock = select($rout=$rin, $wout=$win, $eout=$ein, $bwinterval);
	next if (!$nsock);

	if (vec($rout, fileno(Server), 1)) {
		--$nsock;
		++$cnum; $cnum = 1 if ($cnum > 999);
		$foo = &do_accept(*Server{IO});
		$client = $cnum . $foo;
		$cfh{$client} = $foo;
		$buffer{$client} = "";
		$clients2{$client} = 1;
	}
	next if ($nsock==0);

	foreach $client (keys %clients) {
		if (vec($rout, fileno($cfh{$client}), 1)) {
			--$nsock;
			if (defined($_ = &getline($client))) {
				do {
#					printf "Received %s: $_\n", defined($torrents{$client}) ?
#						$torrents{$client} : $client;
					if (m!^(GET|POST)\s+([^\s]+)\s!i) {
						&send_page($client, $2, $1);
						delete $clients2{$client};	# keep
						last;
         		} elsif (m!CTORRENT ([^\s]+) +(.*)!) {
						if (m!CTORRENT ([^\s]+) +(\d+) +(\d+) +(.*)!) {
							$torrents{$client} = $1;
							# convert start time to local clock
							$stime{$client} = $2 + (time() - $3);
							$ctfile{$client} = $4;
						} else {
							$torrents{$client} = $1;
							$ctfile{$client} = $2;
							$stime{$client} = 0;
						}
						$mindl{$client} = $maxdl{$client} = 0;
						$minul{$client} = $maxul{$client} = 0;
						$sharedl{$client} = $shareul{$client} = 1;
						&send_protocol($client);
						foreach $ct (keys %dead) {
							if ($dead{$ct} eq $torrents{$client}) {
								&dealloc_torrent($ct);
								last;
							}
						}
					} elsif (m!AUTH (.*)!) {
						if (!$authpass || $authpass eq $1) {
							$authorized{$client} = 1;
						} else {
							print "Incorrect authorization password from $client\n";
							&send_error($client, "Authentication failure.");
						}
					} elsif ($authpass && !$authorized{$client}) {
						&send_error($client, "Authentication required.");
         		} elsif (m!CTCONFIG (.*)!) {
						$ctconfig{$client} = $1;
					} elsif (m!^CTBW (.*)!) {
						$ctbw{$client} = $1;
						$ctbw{$client} =~ m!(\d+),(\d+) +(\d+),(\d+)!;
						my($dlrate,$ulrate,$dlimit,$ulimit) = ($1,$2,$3,$4);
						my $change=0;
						# If below 1K & need a bump, immediately raise (1K or avail).
						if ($dlimit < 1024 && $dlrate > $dlimit) {
							$dlimit = &max(1024, $tdlimit - $alldl); $change=1;
						}
						if ($ulimit < 1024 && $ulrate > $ulimit) {
							$ulimit = &max(1024, $tulimit - $allul); $change=1;
						}
						if ($change) {
							&set_dl_limit($client, $dlimit);
							&set_ul_limit($client, $ulimit);
							$ctbw{$client} = "$dlrate,$ulrate $dlimit,$ulimit";
						}
						$alldl = $allul = 0;
						foreach $ct (keys %torrents) {
							if (defined($ctbw{$ct})) {
								$ctbw{$ct} =~ m!(\d+),(\d+) +(\d+),(\d+)!;
								$alldl += $1;
								$allul += $2;
							}
						}
					} elsif (m!^CTSTATUS (.*)!) {
						my($nhave,$ntotal,$dlrate,$ulrate,$dlimit,$ulimit);
						my($ntorrents,$avg_dl,$avg_ul,$change);
						$ctstatus{$client} = $1;
						$ctstime{$client} = time();
						$ctstatus{$client} =~ m!\d+/\d+ +(\d+)/(\d+)/\d+ +(\d+),(\d+) +\d+,\d+ +(\d+),(\d+)!;
						($nhave,$ntotal,$dlrate,$ulrate,$dlimit,$ulimit) = 
							($1, $2,     $3,     $4,     $5,     $6);
						$totalpieces{$client} = $ntotal;

						$ntorrents = scalar(keys %torrents);
						$avg_dl = $tdlimit / $ntorrents;
						$avg_ul = $tulimit / $ntorrents;
						$change = 0;
						if ($nhave == $ntotal && $dlimit > 1) {
							$dlimit = 1; $change=1;
						}
						# If lo rate & hi limit, immediately decrease if necessary.
						# This will sometimes happen when not "necessary", but the
						# client can get bandwidth back later if it needs it.
						if ($dlrate < $avg_dl*.9 && $dlimit > $avg_dl) {
							if ($dlimit > $tdlimit - $alldl +
									defined($ctbw{$client}) ? $dlrate : 0) {
								$dlimit = &max($tdlimit - $alldl +
									defined($ctbw{$client}) ? $dlrate : 0, $avg_dl);
								$change=1;
							}
						}
						if ($ulrate < $avg_ul*.9 && $ulimit > $avg_ul) {
							if ($ulimit > $tulimit - $allul +
									defined($ctbw{$client}) ? $ulrate : 0) {
								$ulimit = &max($tulimit - $allul +
									defined($ctbw{$client}) ? $ulrate : 0, $avg_ul);
								$change=1;
							}
						}
						if ($change) {
							&set_dl_limit($client, $dlimit);
							&set_ul_limit($client, $ulimit);
							&request_status($client);
							$ctbw{$client} = "$dlrate,$ulrate $dlimit,$ulimit";
						} else {
							&send_torrents();	# if %htclients
						}
					} elsif (m!^CTDETAIL (.*)!) {
						$ctdetail{$client} = $1;
					} elsif (m!^CTFILES!) {
						delete $ctfiledata{$client};
					} elsif (m!^CTFILE ((\d+) +.*)!) {
						$ctfiledata{$client}{$2} = $1;
					} elsif (m!^CTFDONE!) {

					} elsif (m!^CTPEERS!) {
						delete $ctpeer{$client};
						$ctpeern{$client} = 0;
					} elsif (m!^CTPEER ([^\s]+) +(.*)!) {
						$ctpeer{$client}{$ctpeern{$client}} = "$1 $2";
						++$ctpeern{$client}
					} elsif (m!^CTPDONE!) {

					} elsif (m!^CTINFO (.*)!) {
						$ctinfo{$client} = localtime() . " $1\n" .
							(defined($ctinfo{$client}) ? $ctinfo{$client} : "");
					}
				} while(defined($_ = &getline($client)));
			} else {
				# peer disconnected
				close $cfh{$client};
				delete $cfh{$client};
				delete $clients2{$client};
				if (defined $torrents{$client}) {
					$dead{$client} = $torrents{$client};
					delete $torrents{$client};
					$dtime{$client} = time();
					$ctbw{$client} =~ m!(\d+),(\d+) +(\d+),(\d+)!;
					$alldl -= $1;
					$allul -= $2;
					delete $ctinfo{$client};
					delete $ctinfoclear{$client};
					delete $ctfiledata{$client};
					delete $ctpeer{$client};
					# torrent status display expects these to be defined
					$mindl{$client} = $maxdl{$client} = 0;
					$minul{$client} = $maxul{$client} = 0;
					$sharedl{$client} = $shareul{$client} = 1;
				}
				next;
			}
		}
		if (vec($wout, fileno($cfh{$client}), 1)) {
			--$nsock;
		}
		last if (!$nsock);
	}
}

exit;
}	# end of main block


#sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" }
sub logmsg { print "@_ at ", scalar localtime, "\n" }


sub do_accept {
	my($client, $server, $paddr,$port,$iaddr,$name, $packed_return_buffer, $foo);
	local(*Client);
	$server = shift();

	$packed_return_buffer = 0;

	$paddr = accept(Client,$server);
	$client = *Client{IO};

	($port,$iaddr) = sockaddr_in($paddr);
	$name = gethostbyaddr($iaddr,AF_INET);

	&logmsg("connection from $name [", inet_ntoa($iaddr), "] at port $port");

	fcntl($client, F_GETFL, $packed_return_buffer);
	fcntl($client, F_SETFL, O_NONBLOCK | $packed_return_buffer);

	$foo = select($client);
	$| = 1;
	select $foo;

	return $client;
}


sub getline {
	my($client, $theline, $n, $tmp);
	$client = shift();

	$theline = "";
	$n = 1;
	while ($n && $buffer{$client} !~ /[\r\n]/) {
		if ($n = sysread($cfh{$client}, $tmp, 100)) {
			$buffer{$client} .= $tmp;
		}
	}
	if ($buffer{$client} =~ s/^[\r\n]*([^\r\n]+)[\r\n]*//) {
		$theline = $1;
	} else {
		$buffer{$client} =~ s/^[\r\n]*//;
	}

	return ($n || ($theline gt "")) ? $theline : undef
}


sub send_page {
	my($client,$page,$method) = @_;

#	print "Sending $page\n";

	$ctsentone{$client} = 0;

	if ($page eq "/") { &send_page_root($client, $page); }
	elsif ($page eq "/peers") { &send_page_root($client, $page); }
	elsif ($page =~ m!^/torrent/([^/]+)/clearmsgs\??$!) {
		&clearmsgs($client, $page);
	}
	elsif ($page =~ m!^/torrent/([^?]+)\?!) { &change_torrent($client, $page); }
	elsif ($page =~ m!^/torrent/(.*)!) {
		&send_page_torrent($client, $page);
	}
	elsif ($page =~ m!^/tracker/([^?]+)\?!) { &change_tracker($client, $page); }
	elsif ($page =~ m!^/\?!) { &change_root($client, $page); }
	elsif ($page eq "/alimits") {
		if ($method =~ /GET/i) {
			&send_page_alimits($client, $page);
		} elsif ($method =~ /POST/i) {
			&change_alimits($client, $page);
		}
	}
	elsif ($page eq "/dead") {
		if ($method =~ /POST/i) {
			&delete_dead($client, $page);
		}
	} else { &finish_page($client, "404"); }
	return;
}


sub send_page_root {
	my($client,$page) = @_;
	my $cfh = $cfh{$client};
	my($ct, $addr,$dchoke,$uchoke,$dlrate,$ulrate,$dl,$ul,
			$pieces,$seeders,$leechers,$nhave,$ntotal,$navail,
		#$dlrate,$ulrate,$dl,$ul,
			$dlimit,$ulimit,$peer,$drunit,$urunit,$dlunit,$ulunit,$ctclient);

	foreach $ct (keys %torrents) {
		if ($page eq "/peers") {
			&request_peers($ct);
		}
		&request_status($ct);
	}

# to auto-refresh, put in HEAD, after TITLE
#    <META HTTP-EQUIV="Refresh" CONTENT="300">
#    <META HTTP-EQUIV="Pragma" CONTENT="no-cache">

	print $cfh <<EOF;
HTTP/1.0 200 OK
Content-Type: text/html

<HTML><HEAD><TITLE>CTCS - All Torrents</TITLE></HEAD><BODY>
<CENTER>
<H1><I>CT</I>orrent <I>C</I>ontrol <I>S</I>erver</H1>
</CENTER>

<FORM METHOD=GET ACTION="/">
<CENTER><TABLE BORDER=0>
EOF
	printf $cfh "<TR><TD width=40%%>Current DL = <B>%d</B> K/s\n",
		$alldl / 1024;
	printf $cfh "\t<TD width=40%% align=right>DL Limit: <INPUT NAME=\"dlimit\" TYPE=\"text\" align=right SIZE=4 VALUE=\"%d\">K/s\n",
		$tdlimit / 1024;
	print $cfh "\t<TD width=20% ROWSPAN=3 align=right><INPUT TYPE=\"submit\" VALUE=\"Change\">\n</TR>\n";
	printf $cfh "<TR><TD>Current UL = <B>%d</B> K/s\n",
		$allul / 1024;
	printf $cfh "\t<TD align=right>UL Limit: <INPUT NAME=\"ulimit\" TYPE=\"text\" align=right SIZE=4 VALUE=\"%d\">K/s\n",
		$tulimit / 1024;
	print $cfh "</TR>\n";
	printf $cfh "<TR><TD><TD align=right>Change interval: <INPUT name=\"bwinterval\" type=\"text\" align=right size=3 value=\"%d\">sec</TR>\n", $bwinterval;
	print $cfh "</TABLE></CENTER></FORM>\n\n";

	print $cfh "<CENTER><A HREF=\"/alimits\">Advanced Limits</A></CENTER>\n\n";
	print $cfh "<BR><CENTER><HR width=50%><H2>Active Torrents</H2></CENTER>\n";

	if ($page eq "/") {
		print $cfh "<P><A HREF=\"/peers\">Show peers</A>\n";
	} else {
		print $cfh "<P><A HREF=\"/\">Hide peers</A>\n";
	}

	$htclients{$client} = $page;
	&send_torrents();
	return;
}


sub send_dead() {
	my($client,$page) = @_;
	my $cfh = $cfh{$client};
	my($ct,$tnum);

	print $cfh <<EOF;
<FORM METHOD=POST ACTION="/dead">
<TABLE BORDER width=100%>
<TR bgcolor="#cccccc"><TD colspan=5>[Del] <B>Torrent</B>
	<TD colspan=3 align=right>End Time</TR>
<TR bgcolor="#cccccc"><TD>Seed<TD>Leech<TD>Complete
	<TD align=right>DL Rate<TD align=right>UL Rate
	<TD align=right>DL Total<TD align=right>UL Total
	<TD align=right>Limit D/U</TR>
EOF

	$tnum = 0;
	foreach $ct (keys %dead) {
		++$tnum;
		&send_one_torrent($client, $page, $ct, $tnum);
	}
	print $cfh "</TABLE>\n";
	print $cfh "<TABLE BORDER=0 width=100%><TR>\n";
	print $cfh "\t<TD align=left><input type=submit name=submit value=\"Delete\">\n";
	print $cfh "\t<TD align=right><input type=submit name=submit value=\"Delete All\">\n";
	print $cfh "</TABLE>\n</FORM>\n";
}


sub delete_dead() {
	my($client,$page) = @_;
	my $cfh = $cfh{$client};
	my($delay,$data,$ct,$foo,$tnum,$tid);

	# POST request
	$delay=0;
	{	# container for "last" instruction inside the loop
	do {
		if (defined($data = &getline($client))) {
			if ($data =~ /submit=Delete\+All/) {
				foreach $foo (keys %dead) {
					&dealloc_torrent($foo);
				}
				last;
			}
			while ($data =~ /t(\d+)id=([^&]+)/ig) {
				($tnum,$tid) = ($1, &url_decode_data(&url_decode_data($2)));
				$ct = "";
				foreach $foo (keys %dead) {
					$ct = $foo if ($tid eq $dead{$foo});
				}
				next if (!$ct);
				if ($data =~ /t${tnum}del=\d/i) {
					&dealloc_torrent($ct);
				}
			}
		} else {
			++$delay;
			sleep 1;
		}
	} until ( (defined($data) && $data =~ /t1id=/) || $delay==$bwinterval );
	}	# container for "last" instruction inside the loop

	print $cfh "HTTP/1.0 302 See Other\n";
	print $cfh "Location: /\n";
	&finish_page($client, "");
}


sub dealloc_torrent() {
	my($ct) = @_;
	delete $torrents{$ct};
	delete $stime{$ct};
	delete $dead{$ct};
	delete $dtime{$ct};
	delete $ctconfig{$ct};
	delete $ctfile{$ct};
	delete $ctbw{$ct};
	delete $ctstatus{$ct};
	delete $ctstime{$ct};
	delete $ctdetail{$ct};
	delete $ctinfo{$ct};
	delete $ctinfoclear{$ct};
	delete $ctfiledata{$ct};
	delete $ctpeer{$ct};
	delete $buffer{$ct};
	delete $mindl{$ct};
	delete $maxdl{$ct};
	delete $minul{$ct};
	delete $maxul{$ct};
	delete $sharedl{$ct};
	delete $shareul{$ct};
}


sub send_torrents {
	my ($client,$cfh,$page,$nleft,$ct);
	my($addr,$dchoke,$uchoke,$dlrate,$ulrate,$dl,$ul,
			$pieces,$seeders,$leechers,$nhave,$ntotal,$navail,
			$dlimit,$ulimit,$peer,$drunit,$urunit,$dlunit,$ulunit,$ctclient);

	foreach $client(keys %htclients) {
		$cfh = $cfh{$client};
		$page = $htclients{$client};
		$nleft = 0;
		foreach $ct (keys %torrents) {
			if ($page =~ m!^/torrent/(.*)! &&
				 &url_decode_data($1) ne $torrents{$ct}) {
				$ctsent{$ct}{$client} = 1;	# wrong torrent--don't send
			}
			if (!$ctsent{$ct}{$client}) { ++$nleft; }
			if (defined($ctstatus{$ct}) && $ctstime{$ct} >= time()-1 &&
					!$ctsent{$ct}{$client}) {	# not sent to this http client yet
				if (!$ctsentone{$client}) {
					if ($page =~ m!^/torrent/!) {
						&send_detail($client, $page, $ct);
					}
					print $cfh <<EOF;

<P>
<TABLE BORDER width=100%>
<TR bgcolor="#cccccc"><TD colspan=5><B>Torrent</B>
	<TD colspan=3 align=right>Start Time</TR>
<TR bgcolor="#cccccc"><TD>Seed<TD>Leech<TD>Complete
	<TD align=right>DL Rate<TD align=right>UL Rate
	<TD align=right>DL Total<TD align=right>UL Total
	<TD align=right>Limit D/U</TR>
EOF
					$ctsentone{$client} = 1;
				}
				&send_one_torrent($client, $page, $ct, 0);
				$ctsent{$ct}{$client} = 1;
				--$nleft;
			}
		}
		&finish_page($client, $htclients{$client}) if ($nleft == 0);
	}
}


sub send_detail() {
	my($client,$page,$ct) = @_;
	my $cfh = $cfh{$client};
	my($addr,$dchoke,$uchoke,$dlrate,$ulrate,$dl,$ul,
			$pieces,$seeders,$leechers,$nhave,$ntotal,$navail,
			$dlimit,$ulimit,$peer,$drunit,$urunit,$dlunit,$ulunit,$ctclient);
	my ($torrentsize,$piecelen,$timenow,$timeseed,$foo,$sdl);
	my ($v,$e,$E,$M,$m,$n,$Z,$Pz,$Qz);
	my ($fileno,$fnp,$fnh,$fnum,$fsize,$fname,$szunit);
	my $totalsize=0;
	my $action;

	$ctstatus{$ct} =~ m!(\d+)/(\d+) +(\d+)/(\d+)/(\d+) +(\d+),(\d+) +(\d+),(\d+) +(\d+),(\d+)!;
	($seeders,$leechers,$nhave,$ntotal,$navail,$dlrate,$ulrate,
		$dl,$ul,$dlimit,$ulimit) = 
		($1,   $2,       $3,    $4,     $5,     $6,     $7,
		$8, $9, $10,    $11);

	if ( defined($ctconfig{$ct}) && ($ctconfig{$ct} =~
			m!([01]) (\d+) ([.\d]+) (\d+) (\d+) (\d+) ([01]) ([01]) ([01])!) ) {
		($v,$e,$E,$M,$m,$n,$Z,$Pz,$Qz) = ($1,$2,$3,$4,$5,$6,$7,$8,$9);
	}

	if ($ctdetail{$ct} =~ m!(\d+) +(\d+) +(\d+) +(\d+)!) {
		($torrentsize,$piecelen,$timenow,$timeseed) = ($1,$2,$3,$4);
		print $cfh "<P><CENTER>\n";
		$sdl = ($dl > 0) ? $dl : $torrentsize;
		if ($sdl > 0) {
			printf $cfh "Upload/Download Ratio:  <B>%.2f</B>\n", $ul / $sdl;
		}
		if ($nhave < $ntotal) {
			if ($dlrate > 0) {
				$foo = (($ntotal-$nhave)*$piecelen / $dlrate) / 60;
				printf $cfh "<BR>Download time remaining: <B>%s%s</B>\n",
					($foo >= 60) ? sprintf(" %d hours", $foo/60) : "",
					($foo % 60 > 0) ? sprintf(" %d minutes", $foo % 60) : "";
			} else {
				print $cfh "<BR>Download is <B>stalled</B>\n";
			}
		} elsif (defined $ctconfig{$ct}) {
			if ($e==0 && $ulrate==0) {
				printf $cfh "<BR>Seeding is <B>stalled</B>\n";
			} else {
				$foo = ($e > 0) ?
					$e*60 - ($timenow-$timeseed)/60	:
					($E * $sdl - $ul) / $ulrate / 60	;
				printf $cfh "<BR>Seed time remaining: <B>%s%s</B>%s\n",
					($foo >= 60) ? sprintf(" %d hours", $foo/60) : "",
					($foo % 60 > 0) ? sprintf(" %d minutes", $foo % 60) : "",
					($e > 0) ? "" : " (estimated)";
			}
		}
		print $cfh "</CENTER>\n\n";
	}

	if (defined $ctconfig{$ct}) {
		printf $cfh "<P><FORM METHOD=GET ACTION=\"%s\">\n", $page;
		printf $cfh "<CENTER><TABLE BORDER>\n";
		printf $cfh "<TR bgcolor=\"cccccc\"><TD colspan=3 align=center>Configuration</TR>\n";

		printf $cfh "<TR><TD>Verbose output [-v]\n";
		printf $cfh "\t<TD align=center><INPUT type=\"checkbox\" name=\"v\" value=%d %s>\n",
			$v, $v ? "checked" : "";
		printf $cfh "\t<TD>%s</TR>\n", $v ? "enabled" : "disabled";

		printf $cfh "<TR><TD>Seed time [-e]\n";
		printf $cfh "\t<TD align=right><INPUT type=\"text\" align=right size=3 name=\"e\" value=\"%.0f\">\n",
			$timeseed ? $e - ($timenow-$timeseed)/3600 : $e;
		printf $cfh "\t<TD>~hours remaining (-e %d)</TR>\n", $e;

		printf $cfh "<TR><TD>Seed ratio [-E]\n";
		printf $cfh "\t<TD align=right><INPUT type=\"text\" align=right size=5 name=\"E\" value=\"%s\">\n",
			sprintf("%5.2f", $E) + 0;
		printf $cfh "\t<TD></TR>\n";

		printf $cfh "<TR><TD>Max peers [-M]\n";
		printf $cfh "\t<TD align=right><INPUT type=\"text\" align=right size=3 name=\"M\" value=\"%d\">\n", $M;
		printf $cfh "\t<TD>Current peers: %d</TR>\n", $seeders+$leechers;

		printf $cfh "<TR><TD>Min peers [-m]\n";
		printf $cfh "\t<TD align=right><INPUT type=\"text\" align=right size=3 name=\"m\" value=\"%d\">\n", $m;
		printf $cfh "\t<TD>Current peers: %d</TR>\n", $seeders+$leechers;

		if ($nhave < $ntotal) {
			printf $cfh "<TR><TD>Downloading file [-n]\n";
			printf $cfh "\t<TD align=right><INPUT type=\"text\" align=right size=3 name=\"n\" value=\"%d\">\n", $n;
			printf $cfh "\t<TD>\"0\" for full torrent</TR>\n";
		}

		printf $cfh "<TR><TD>Pause torrent\n";
		printf $cfh "\t<TD align=center><INPUT type=\"checkbox\" name=\"pause\" value=%d %s>\n",
			$Pz+$Qz > 0, ($Pz+$Qz) ? "checked" : "";
		printf $cfh "\t<TD>Refuse new peers & wait</TR>\n";

		printf $cfh "<TR><TD>Stop when peers=0\n";
		printf $cfh "\t<TD align=center><INPUT type=\"checkbox\" name=\"exitzero\" value=%d %s>\n",
			$Z+$Qz > 0, ($Z+$Qz) ? "checked" : "";
		printf $cfh "\t<TD>Terminate torrent if I have no peers</TR>\n";

		print $cfh "<TR><TD colspan=3 align=center><INPUT TYPE=\"submit\" VALUE=\"Submit\"></TR>\n";
		print $cfh "</TABLE></CENTER></FORM>\n\n";
	}


	$action = $page; $action =~ s/torrent/tracker/;
	printf $cfh "<P><FORM METHOD=GET ACTION=\"%s\">\n", $action;
	printf $cfh "<CENTER><TABLE BORDER>\n";
	printf $cfh "<TR bgcolor=\"cccccc\"><TD colspan=3 align=center>Actions</TR>\n";

	printf $cfh "<TR><TD>Update\n";
	printf $cfh "\t<TD align=center><INPUT type=\"radio\" name=\"tracker\" value=\"update\" checked>\n";
	printf $cfh "\t<TD>Update tracker stats &amp; get peers</TR>\n";

	printf $cfh "<TR><TD>Restart\n";
	printf $cfh "\t<TD align=center><INPUT type=\"radio\" name=\"tracker\" value=\"restart\">\n";
	printf $cfh "\t<TD>Restart the tracker session</TR>\n";

	printf $cfh "<TR><TD>Terminate\n";
	printf $cfh "\t<TD align=center bgcolor=\"#ff6666\"><INPUT type=\"radio\" name=\"tracker\" value=\"quit\">\n";
	printf $cfh "\t<TD>Stop torrent (quit)</TR>\n";

	print $cfh "<TR><TD colspan=3 align=center><INPUT TYPE=\"submit\" VALUE=\"Perform\"></TR>\n";
	print $cfh "</TABLE></CENTER></FORM>\n\n";


	if ($ctinfo{$ct}) {
		printf $cfh "<P><FORM METHOD=GET ACTION=\"%s/clearmsgs\">\n", $page;
		print $cfh <<EOF;
<CENTER><TABLE BORDER>
<TR bgcolor="#ffff66"><TD align=center>Messages</TD></TR>
<TR><TD align=left><PRE>
EOF
		print $cfh $ctinfo{$ct};
		$ctinfoclear{$ct} = $ctinfo{$ct};
		print $cfh <<EOF;
</TR>
<TR><TD align=center><INPUT TYPE=\"submit\" VALUE=\"Clear\"></TR>
</TABLE></CENTER></FORM>

EOF
	}

	if (keys %{$ctfiledata{$ct}}) {
		print $cfh <<EOF;
<P>
<CENTER><TABLE BORDER>
<TR bgcolor="#cccccc"><TD align=right>File
	<TD>Name<TD align=right>Size<TD align=right>Complete
</TR>
EOF

		foreach $fileno (sort {$::a <=> $::b} keys %{$ctfiledata{$ct}}) {
			$ctfiledata{$ct}{$fileno} =~ /(\d+) +(\d+) +(\d+) +(\d+) +(.*)/;
			($fnum,$fnp,$fnh,$fsize,$fname) = ($1,$2,$3,$4,$5);
			$totalsize += $fsize;
			$szunit = &unit($fsize);     $fsize = &value($fsize, $szunit);
			printf $cfh "<TR%s>", ($n==$fnum) ? " bgcolor=\"#ccccff\"" :
				( ($fnp==$fnh) ? " bgcolor=\"#ccffcc\"" : "" );
			printf $cfh "<TD align=right>%d", $fnum;
			printf $cfh "<TD>%s\n", &html_safe($fname);
			printf $cfh "<TD align=right>%d&nbsp;%1s", $fsize, $szunit;
			printf $cfh "<TD align=right>%d%%</TR>\n", 100 * $fnh / $fnp;
		}
		$szunit = &unit($totalsize);	$totalsize = &value($totalsize, $szunit);
		printf $cfh "<TR><TD colspan=2>Total<TD align=right>%d&nbsp;%1s</TR>\n",
			$totalsize, $szunit;
		printf $cfh "</TABLE></CENTER>\n\n";
	}
}


sub send_one_torrent() {
	my ($client,$page,$ct,$tnum) = @_;
	my $cfh = $cfh{$client};
	my($peerid,$addr,$dchoke,$uchoke,$dlrate,$ulrate,$dl,$ul,
			$pieces,$seeders,$leechers,$nhave,$ntotal,$navail,
			$dlimit,$ulimit,$peer,$drunit,$urunit,$dlunit,$ulunit,$ctclient);
	my $ctime;
	my $foo;

	$ctstatus{$ct} =~ m!(\d+)/(\d+) +(\d+)/(\d+)/(\d+) +(\d+),(\d+) +(\d+),(\d+) +(\d+),(\d+)!;
	($seeders,$leechers,$nhave,$ntotal,$navail,$dlrate,$ulrate,$dl,$ul,
		$dlimit,$ulimit) = 
		($1,   $2,       $3,    $4,     $5,     $6,     $7,     $8, $9,
		$10,    $11);

	$drunit = &unit($dlrate); $dlrate = &value($dlrate, $drunit);
	$urunit = &unit($ulrate); $ulrate = &value($ulrate, $urunit);
	$dlunit = &unit($dl);     $dl = &value($dl, $dlunit);
	$ulunit = &unit($ul);     $ul = &value($ul, $ulunit);

	printf $cfh "\n<TR bgcolor=\"#ccccff\"><TD%s colspan=5>",
		$ctinfo{$ct} ? " bgcolor=\"#ffff66\"" : "";
	if (defined $dead{$ct}) {
		$foo = &url_encode_data($dead{$ct});
		printf $cfh "<input type=hidden name=\"t%did\" value=\"%s\"><input type=checkbox name=\"t%ddel\" value=1> ",
			$tnum, $foo, $tnum;
		$ctime = localtime($dtime{$ct});	# need for scalar context
	} else {
		$ctime = $stime{$ct} ? localtime($stime{$ct}) : "Unknown";
		printf $cfh "<A HREF=\"/torrent/%s\">",
			&url_encode_data( $torrents{$ct} ? $torrents{$ct} : $dead{$ct} );
	}
	printf $cfh "<B>%s</B>", &html_safe($ctfile{$ct});
	if (!defined $dead{$ct}) { print $cfh "</A>"; }
	
	printf $cfh "\n\t<TD colspan=3 align=right>%s</TR>\n", $ctime;

	printf $cfh "<TR%s><TD>S: %d<TD>L: %d<TD>%3d%%",
		(($page eq "/peers" || $page =~ m!^/torrent/!) && defined($ctpeer{$ct})) ?
			" bgcolor=\"#ccccff\"" : "",
		$seeders,$leechers,$nhave/$ntotal*100;
	if ($nhave != $ntotal) {
 		printf $cfh " (%d%% Avail)", $navail/$ntotal*100;
	}
	printf $cfh "\n\t<TD align=right>D= %.0f %1s/s<TD align=right>U= %.0f %1s/s\n",
		$dlrate,$drunit,$ulrate,$urunit;
	printf $cfh "\t<TD align=right>D= %.0f&nbsp;%1s<TD align=right>U= %.0f&nbsp;%1s\n",
		$dl,$dlunit,$ul,$ulunit;
	printf $cfh "\t<TD%s align=right>%.0f / %.0f K/s</TR>\n\n",
		($sharedl{$ct} & $shareul{$ct}) ?
			( ($mindl{$ct}||$minul{$ct}||$maxdl{$ct}||$maxul{$ct}) ?
			" bgcolor=\"#ffff66\"" : "" ) : " bgcolor=\"#66ff66\"",
		$dlimit/1024, $ulimit/1024;

	if (($page eq "/peers" || $page =~ m!^/torrent/!) && defined($ctpeer{$ct})) {
		foreach $peer (sort {$a <=> $b} keys %{$ctpeer{$ct}}) {
			$ctpeer{$ct}{$peer} =~
				/([^ ]+) +([\d.:]+) +([CU][in])([CU][in]) +(\d+) +(\d+) +(\d+) +(\d+) +(\d+)/;
			($peerid,$addr,$dchoke,$uchoke,$dlrate,$ulrate,$dl,$ul,$pieces) =
				($1,     $2, $3,    $4,     $5,     $6,     $7, $8, $9);

			$ctclient = &clienttype($peerid,
				$torrents{$ct} ? $torrents{$ct} : $dead{$ct});
			$drunit = &unit($dlrate); $dlrate = &value($dlrate, $drunit);
			$urunit = &unit($ulrate); $ulrate = &value($ulrate, $urunit);
			$dlunit = &unit($dl);     $dl = &value($dl, $dlunit);
			$ulunit = &unit($ul);     $ul = &value($ul, $ulunit);

			printf $cfh "<TR bgcolor=\"#ccffcc\"><TD colspan=5>%s<TD colspan=2>%s<TD>%s</TR>\n",
				&html_safe($peerid), $addr, &html_safe($ctclient);

			printf $cfh "<TR><TD align=center>%2s<TD align=center>%2s\n",
				$dchoke, $uchoke;
			printf $cfh "\t<TD align=right>%3d%%\n",
				$pieces / $totalpieces{$ct} * 100;
			printf $cfh "\t<TD align=right>D= %d&nbsp;%1s/s<TD align=right>U= %d&nbsp;%1s/s\n",
				$dlrate,$drunit, $ulrate,$urunit;
			printf $cfh "\t<TD align=right>D= %d&nbsp;%1s<TD align=right>U= %d&nbsp;%1s</TR>\n",
				$dl,$dlunit, $ul,$ulunit;
		}
	}	#peers
	return;
}


sub send_page_torrent() {
	my($client,$page) = @_;
	my $cfh = $cfh{$client};
	my($id,$ct,$foo);

	$page =~ m!^/torrent/(.*)!;
	$id = &url_decode_data($1);

	$ct = "";
	foreach $foo (keys %torrents) {
		$ct = $foo if ($id eq $torrents{$foo});
	}
	if (!$ct) { &finish_page($client, "404"); return; }

	&request_detail($ct);
	&request_config($ct);
	&request_peers($ct);
	&request_status($ct);

	print $cfh <<EOF;
HTTP/1.0 200 OK
Content-Type: text/html

<HTML><HEAD><TITLE>CTCS - Torrent Details</TITLE></HEAD><BODY>

<A HREF="/">Return to All Torrents</A>
EOF

	$htclients{$client} = $page;
}


sub clearmsgs() {
	my($client,$page) = @_;
	my $cfh = $cfh{$client};
	my($id,$ct,$foo);

	$page =~ m!^/torrent/([^/]+)/clearmsgs\??$!;
	$id = &url_decode_data($1);

	$ct = "";
	foreach $foo (keys %torrents) {
		$ct = $foo if ($id eq $torrents{$foo});
	}
	if (!$ct) { &finish_page($client, "404"); return; }

	$ctinfo{$ct} =~ s/$ctinfoclear{$ct}//s;
	delete $ctinfoclear{$ct};

	$page =~ s!/clearmsgs\??$!!;
#	print $cfh "HTTP/1.0 205 OK\n";
	print $cfh "HTTP/1.0 302 See Other\n";
	printf $cfh "Location: %s\n", $page;
	&finish_page($client, "");
}


sub send_page_alimits() {
	my ($client,$page) = @_;
	my $cfh = $cfh{$client};
	my $tnum=0;
	my($ct,$dlrate,$ulrate,$dlimit,$ulimit,$unknown);
	my $foo;

	print $cfh <<EOF;
HTTP/1.0 200 OK
Content-Type: text/html

<HTML><HEAD><TITLE>CTCS - Advanced Limits</TITLE></HEAD><BODY>

<A HREF="/">Return to All Torrents</A>

<H1><CENTER>Advanced Limits</CENTER></H1>

<FORM METHOD=POST ACTION=/alimits>
<CENTER>
<TABLE BORDER>
<TR bgcolor="#cccccc"><TD rowspan=2>Torrent
   <TD colspan=2 align=center>Current Rate
   <TD colspan=2 align=center>Limit
   <TD colspan=2 align=center>Minimum
   <TD colspan=2 align=center>Maximum
   <TD colspan=2 align=center>Shared
</TR>
<TR bgcolor="#cccccc">
   <TD align=center>DL<TD align=center>UL
   <TD align=center>DL<TD align=center>UL
   <TD align=center>DL<TD align=center>UL
   <TD align=center>DL<TD align=center>UL
   <TD align=center>DL<TD align=center>UL
</TR>
EOF

	foreach $ct (keys %torrents) {
		++$tnum;
		if ($ctbw{$ct} =~ m!(\d+),(\d+) +(\d+),(\d+)!) {
			($dlrate,$ulrate,$dlimit,$ulimit) = ($1,$2,$3,$4);
			$unknown = 0;
		} else {
			($dlrate,$ulrate,$dlimit,$ulimit) = (0,0,0,0);
			$unknown = 1;
		}

		printf $cfh "<TR><TD>%s\n", &html_safe($ctfile{$ct});
		$foo = &url_encode_data($torrents{$ct});
		printf $cfh "\t<input type=hidden name=\"t%did\" value=\"%s\">\n",
			$tnum, $foo;
		printf $cfh "\t<TD%s align=right>%.0f\n",
			$unknown ? " bgcolor=\"#ff6666\"" : "", $dlrate/1024;
		printf $cfh "\t<TD%s align=right>%.0f\n",
			$unknown ? " bgcolor=\"#ff6666\"" : "", $ulrate/1024;
		printf $cfh "\t<TD%s align=right><input type=text size=4 align=right name=\"t%ddlimit\" value=%.0f><input type=checkbox name=\"t%dxdlimit\" value=1>\n",
			$unknown ? " bgcolor=\"#ff6666\"" : "", $tnum, $dlimit/1024, $tnum;
		printf $cfh "\t<TD%s align=right><input type=text size=4 align=right name=\"t%dulimit\" value=%.0f><input type=checkbox name=\"t%dxulimit\" value=1>\n",
			$unknown ? " bgcolor=\"#ff6666\"" : "", $tnum, $ulimit/1024, $tnum;
		printf $cfh "\t<TD%s align=right><input type=text size=4 align=right name=\"t%dmindl\" value=%.0f>\n",
			$mindl{$ct} ? " bgcolor=\"#ffff66\"" : "", $tnum, $mindl{$ct}/1024;
		printf $cfh "\t<TD%s align=right><input type=text size=4 align=right name=\"t%dminul\" value=%.0f>\n",
			$minul{$ct} ? " bgcolor=\"#ffff66\"" : "", $tnum, $minul{$ct}/1024;
		printf $cfh "\t<TD%s align=right><input type=text size=4 align=right name=\"t%dmaxdl\" value=%.0f>\n",
			$maxdl{$ct} ? " bgcolor=\"#ffff66\"" : "", $tnum, $maxdl{$ct}/1024;
		printf $cfh "\t<TD%s align=right><input type=text size=4 align=right name=\"t%dmaxul\" value=%.0f>\n",
			$maxul{$ct} ? " bgcolor=\"#ffff66\"" : "", $tnum, $maxul{$ct}/1024;
		printf $cfh "\t<TD%s align=center><input type=checkbox name=\"t%dsharedl\" value=1%s>\n",
			$sharedl{$ct} ? "" : " bgcolor=\"#66ff66\"",
			$tnum, $sharedl{$ct} ? " checked" : "";
		printf $cfh "\t<TD%s align=center><input type=checkbox name=\"t%dshareul\" value=1%s>\n",
			$shareul{$ct} ? "" : " bgcolor=\"#66ff66\"",
			$tnum, $shareul{$ct} ? " checked" : "";;
		print $cfh "</TR>\n";
	}
	print $cfh "</TABLE>\n";

	print $cfh "<BR><input type=submit value=\"Submit\">\n";
	print $cfh "</CENTER></FORM>\n";
	print $cfh <<EOF;
<P><B>Notes</B><BR>
<UL>
<LI>All values are in kilobytes per second (KB/s).
<LI>Use caution when changing actual limits to below the current rate--small
  increments are recommended.  To change a current limit, enter the desired
  value and check the adjacent box.
<LI>"Minimum" and "Maximum" are soft limits.  They will be enforced when there
  is competition for bandwidth; otherwise the torrent is free to give or take
  unused bandwidth.
	<UL>
	<LI>Minimum:  If the torrent wants bandwidth up to this level, it will
     receive it at the expense of other torrents.  It will not be forced or
     held below this level if it wants (is using) the bandwidth.  Use to
     high-prioritize a torrent, or to guarantee a bandwidth allocation amount
     to a torrent.
	<LI>Maximum:  The torrent will be forced down to this level if other
     torrents want bandwidth.  Use to low-prioritize a torrent, or to limit the
     amount of bandwidth this torrent is allowed to consume at the expense of
     other torrents.
	</UL>
<LI>"Shared" indicates whether the torrent's bandwidth is counted against the
  shared pool represented by the global limit on the main CTCS page.  CTCS will
  dynamically manage the client's bandwidth only if the Shared option is
  checked.
<LI>Use a value of 0 to disable/remove a limit.
<LI>Non-default settings are highlighted in yellow and green.  The limit field
  in torrent status displays will also be highlighted as a reminder.  Red
  highlight indicates an unknown value; you should refresh before making
  changes.
<LI>After submitting changes, you may need to refresh the page after a second
  or two in order to see the resulting updates.
</UL>
</BODY></HTML>
EOF

	&finish_page($client, "");
}


sub finish_page() {
	my ($client,$page) = @_;
	my $cfh = $cfh{$client};
	if ($page eq "/" || $page eq "/peers") {
		print $cfh "</TABLE>\n\n";
		if (keys %dead) {
			print $cfh "<BR><CENTER><HR width=50%><H2>Terminated Torrents</H2></CENTER>\n";
			&send_dead($client, $page);
		}
		print $cfh "</BODY></HTML>\n";
	} elsif ($page =~ m!^/torrent/[^?]+$!) {
		print $cfh "</TABLE></BODY></HTML>\n";
	} elsif ($page eq "404") {
		print $cfh <<EOF
HTTP/1.0 404 Not Found
Content-Type: text/html

<HTML><HEAD><TITLE>404 Not Found</TITLE></HEAD><BODY>
<H1>Not Found</H1>
The requested page was not found.  Something may have changed since the page
you were viewing was generated.
Please return to the <A HREF="/">All Torrents</A> page to view the current
status.
EOF
	}
	close $cfh{$client};
	delete $cfh{$client};
	delete $ctsentone{$client};
	delete $htclients{$client};
}


sub change_root {
	my ($client,$page) = @_;
	my $cfh = $cfh{$client};
	my($ct, $addr,$dchoke,$uchoke,$dlrate,$ulrate,$dl,$ul,
			$pieces,$seeders,$leechers,$nhave,$ntotal,$navail,
		#$dlrate,$ulrate,$dl,$ul,
			$dlimit,$ulimit,$peer,$drunit,$urunit,$dlunit,$ulunit,$ctclient);

	if ($page =~ /[?&]dlimit=(\d+)/) { $tdlimit = $1 * 1024; }
	if ($page =~ /[?&]ulimit=(\d+)/) { $tulimit = $1 * 1024; }
	if ($page =~ /[?&]bwinterval=(\d+)/) { $bwinterval = $1; }

	$page =~ s/\?.*//;
#	print $cfh "HTTP/1.0 205 OK\n";
	print $cfh "HTTP/1.0 302 See Other\n";
	printf $cfh "Location: /\n";
	&finish_page($client, "");
}


sub change_torrent {
	my ($client,$page) = @_;
	my $cfh = $cfh{$client};
	my($id,$ct,$foo);
	my($v,$e,$E,$M,$m,$n,$Z,$ez,$Ep,$Pz,$Qz);
	my($torrentsize,$piecelen,$timenow,$timeseed);

	$page =~ m!^/torrent/([^?]+)!;
	$id = &url_decode_data($1);
	$ct = "";
	foreach $foo (keys %torrents) {
		$ct = $foo if ($id eq $torrents{$foo});
	}
	if (!$ct) { &finish_page($client, "404"); return; }

	if ($ctconfig{$ct} =~
			m!([01]) (\d+) ([.\d]+) (\d+) (\d+) (\d+) ([01]) ([01]) ([01])!) {
      ($v,$e,$E,$M,$m,$n,$Z,$Pz,$Qz) = ($1,$2,$3,$4,$5,$6,$7,$8,$9);
	}
	if ($ctdetail{$ct} =~ m!(\d+) +(\d+) +(\d+) +(\d+)!) {
		($torrentsize,$piecelen,$timenow,$timeseed) = ($1,$2,$3,$4);
	} else { ($torrentsize,$piecelen,$timenow,$timeseed) = (0,0,0,0); }

	$v = ($page=~/[?&]v=(\d+)/) ? "1" : "0";
	$ez = 0;
	if ($page=~/[?&]e=(\d+)/ && $1>=0) {
		if (!$1) { $ez = 1; }
		else {
			$foo = $1 + ($timeseed ?
								sprintf("%.0f", ($timenow-$timeseed)/3600) : 0);
			$e = ($foo == $e) ? "." : $foo;
		}
	} else { $e = "."; }
	$Ep = ($page=~/[?&]E=(\d+[.\d]*)/) ? ( ($1==$E)?".":$1 ) : ".";
	$M = ($page=~/[?&]M=(\d+)/) ? ( ($1==$M)?".":$1 ) : ".";
	$m = ($page=~/[?&]m=(\d+)/) ? ( ($1==$m)?".":$1 ) : ".";
	$n = ($page=~/[?&]n=(\d+)/) ? ( ($1==$n)?".":$1 ) : ".";
	$Z = ($page=~/[?&]exitzero=(\d+)/) ? "1" : "0";
	$Pz = ($page=~/[?&]pause=(\d+)/) ? "1" : "0";

	$Qz = $Z * $Pz;
	if ($Qz) { $Z = $Pz = 0; }

	# Allow e=0 if E>0
	$E = $Ep if ($Ep ne ".");
	$e = 0 if ($ez && $E);
	$E = $Ep;

	if ($E =~ /^\.\d/) { $E = "0$E"; }
	&set_config($ct, $v, $e, $E, $M, $m, $n, $Z, $Pz, $Qz);

	$page =~ s/\?.*//;
#	print $cfh "HTTP/1.0 205 OK\n";
	print $cfh "HTTP/1.0 302 See Other\n";
	printf $cfh "Location: %s\n", $page;
	&finish_page($client, "");
}


sub change_tracker {
	my ($client,$page) = @_;
	my $cfh = $cfh{$client};
	my($id,$ct,$foo);
	my($v,$e,$E,$M,$n,$Z,$ez,$Ep,$Pz,$Qz);
	my($torrentsize,$piecelen,$timenow,$timeseed);

	$page =~ m!^/tracker/([^?]+)!;
	$id = &url_decode_data($1);
	$ct = "";
	foreach $foo (keys %torrents) {
		$ct = $foo if ($id eq $torrents{$foo});
	}
	if (!$ct) { &finish_page($client, "404"); return; }

	if ($page =~ /[?&]tracker=quit/) {
		&quit_torrent($client, $page);
		return;
	} elsif ($page =~ /[?&]tracker=restart/) {
		local *FH = $cfh{$ct};
		printf FH "CTRESTART\n";
	} else {	# update is default
		local *FH = $cfh{$ct};
		printf FH "CTUPDATE\n";
	}

	$page =~ s/\?.*//;
	$page =~ s!/tracker/!/torrent/!;
#	print $cfh "HTTP/1.0 205 OK\n";
	print $cfh "HTTP/1.0 302 See Other\n";
	printf $cfh "Location: %s\n", $page;
	&finish_page($client, "");
}


sub quit_torrent() {
	my ($client,$page) = @_;
	my $cfh = $cfh{$client};
	my($id,$ct,$foo);

	$page =~ m!^/tracker/([^?]+)!;
	$id = &url_decode_data($1);
	$ct = "";
	foreach $foo (keys %torrents) {
		$ct = $foo if ($id eq $torrents{$foo});
	}
	if ($ct) {
		local *FH = $cfh{$ct};
		printf FH "CTQUIT\n";

		print $cfh "HTTP/1.0 302 See Other/\n";
		print $cfh "Location: /\n";
	}
	&finish_page($client, "");
}


sub change_alimits() {
	my ($client,$page) = @_;
	my $cfh = $cfh{$client};
	my($ct, $addr,$dchoke,$uchoke,$dlrate,$ulrate,$dl,$ul,
			$pieces,$seeders,$leechers,$nhave,$ntotal,$navail,
			$dlimit,$ulimit,$peer,$drunit,$urunit,$dlunit,$ulunit,$ctclient);
	my($delay,$data,$foo,$tnum,$tid);

	# POST request
	$delay=0;
	do {
		if (defined($data = &getline($client))) {
			while ($data =~ /t(\d+)id=([^&]+)/ig) {
				($tnum,$tid) = ($1, &url_decode_data(&url_decode_data($2)));
				$ct = "";
				foreach $foo (keys %torrents) {
					$ct = $foo if ($tid eq $torrents{$foo});
				}
				next if (!$ct);
				if ($data =~ /t${tnum}xdlimit=\d/i &&
						$data =~ /t${tnum}dlimit=(\d+)/i) {
					&set_dl_limit($ct, $1*1024);
				}
				if ($data =~ /t${tnum}xulimit=\d/i &&
						$data =~ /t${tnum}ulimit=(\d+)/i) {
					&set_ul_limit($ct, $1*1024);
				}
				if ($data =~ /t${tnum}mindl=(\d+)/i) { $mindl{$ct} = $1*1024; }
				if ($data =~ /t${tnum}minul=(\d+)/i) { $minul{$ct} = $1*1024; }
				if ($data =~ /t${tnum}maxdl=(\d+)/i) { $maxdl{$ct} = $1*1024; }
				if ($data =~ /t${tnum}maxul=(\d+)/i) { $maxul{$ct} = $1*1024; }
				if ($data =~ /t${tnum}sharedl=(\d+)/i) { $sharedl{$ct} = 1; }
					else { $sharedl{$ct} = 0; }
				if ($data =~ /t${tnum}shareul=(\d+)/i) { $shareul{$ct} = 1; }
					else { $shareul{$ct} = 0; }
			}
		} else {
			++$delay;
			sleep 1;
		}
	} until ($data =~ /t1id=/ || $delay==$bwinterval);

	print $cfh "HTTP/1.0 302 See Other\n";
	printf $cfh "Location: %s\n", $page;
	&finish_page($client, "");
}


sub manage_bw {
	my ($seeders,$leechers,$nhave,$ntotal,$navail,$dlrate,$ulrate,$dl,$ul,
		$dlimit,$ulimit);
	my ($bumpfactor, $ntorrents, $avg_dl, $avg_ul, $ct);
	my ($avail_dl, $avail_ul, $bumpdl_want, $bumpul_want) = (0,0,0,0);
	my (%bumpdl_d, %bumpdl_u, %over_dl, %bumpul_d, %bumpul_u, %over_ul);
	my ($alldlimit, $allulimit);

	$bumpfactor = .05;
	$ntorrents = 0;
	foreach $ct (keys %torrents) { ++$ntorrents if ($sharedl{$ct}); }
	$avg_dl = $tdlimit / $ntorrents;
	$ntorrents = 0;
	foreach $ct (keys %torrents) { ++$ntorrents if ($shareul{$ct}); }
	$avg_ul = $tulimit / $ntorrents;
	$ntorrents = scalar(keys %torrents);

	$alldlimit = $allulimit = 0;
	$avail_dl = $avail_ul = 0;
	$bumpdl_want = $bumpul_want = 0;
	foreach $ct (keys %torrents) {
		if (defined $ctbw{$ct}) {
			$ctbw{$ct} =~ m!(\d+),(\d+) +(\d+),(\d+)!;
			($dlrate,$ulrate,$dlimit,$ulimit) = ($1,$2,$3,$4);
			$alldlimit += $dlimit;
			$allulimit += $ulimit;

			if ($tdlimit && $sharedl{$ct}) {
				&check_rate($ct, $dlrate, $dlimit, $bumpfactor, $avg_dl,
					$mindl{$ct}, $maxdl{$ct},
					\$avail_dl, \$bumpdl_want, \%bumpdl_d, \%bumpdl_u, \%over_dl);
			}
			if ($tulimit && $shareul{$ct}) {
				&check_rate($ct, $ulrate, $ulimit, $bumpfactor, $avg_ul,
					$minul{$ct}, $maxul{$ct},
					\$avail_ul, \$bumpul_want, \%bumpul_d, \%bumpul_u, \%over_ul);
			}
		}
	}
#	printf "Available DL:  %d\n", $avail_dl;
	if (keys %bumpdl_u || $avail_dl < 0) {
		&adjust_limits($dlimit, $bumpfactor,
			$avail_dl, $bumpdl_want, \%bumpdl_d, \%bumpdl_u, \%over_dl,
			\%mindl, \%maxdl, \&set_dl_limit, $alldlimit);
	}
#	printf "Available UL:  %d\n", $avail_ul;
	if (keys %bumpul_u || $avail_ul < 0) {
		&adjust_limits($ulimit, $bumpfactor,
			$avail_ul, $bumpul_want, \%bumpul_d, \%bumpul_u, \%over_ul,
			\%minul, \%maxul, \&set_ul_limit, $allulimit);
	}
}


sub check_rate {
	my($ct, $rate, $limit, $bumpfactor, $avg, $min, $max,
		$pavail, $pbump_want, $pbump_d, $pbump_u, $pover) = @_;

	if ($limit >= 1+$bumpfactor && $rate < $limit * (1-$bumpfactor)) {
		$pbump_d->{$ct} = $limit;
	} elsif ($rate >= $limit) {
		$pbump_u->{$ct} = $limit;
		${$pbump_want} += $limit;
#		Debugging:
#		$ctbw{$ct} =~ m!(\d+),(\d+) +(\d+),(\d+)!;
#		my($dlrate,$ulrate,$dlimit,$ulimit) = ($1,$2,$3,$4);
#		print(($rate == $dlrate) ? "DL" : "UL");
#		printf "   %s wants (%d / %d)\n", $torrents{$ct}, $rate, $limit;
	}
	if ( ($limit > $avg && ($min==0 || $limit > $min)) ||
			($max && $limit > $max) ) {
		$pover->{$ct} = $limit;
#		mess with this value if we need to give priority for a ct below min
	}
	if ($limit < $avg) {
		${$pavail} += ($avg - $limit);
	} else {
		${$pavail} -= ($limit - $avg);
	}
}


sub adjust_limits {
	my($limit, $bumpfactor,
		$avail, $bump_want, $pbump_d, $pbump_u, $pover,
		$pmin, $pmax, $pset_limit, $all_limit) = @_;
	my($ct, $bump, $maxct, $mybump_u);
	my(@foo);

	# Find spare bandwidth to fill demand:
	if ($avail < $bump_want * $bumpfactor || $avail < 0) {
#		printf "   avail/want: %d / %d\n", $avail, $bump_want * $bumpfactor;

		# First, take unused bandwidth from torrents.
		if (keys %$pbump_d) {
			foreach $ct (keys %$pbump_d) {
				# Take only what we need.
				$bump = &min( &max(1, $pbump_d->{$ct} * $bumpfactor),
					$bump_want * $bumpfactor - $avail );
				if ($bump) {
#					printf "   bump %s: -%d", $torrents{$ct}, $bump;
					&$pset_limit($ct, $pbump_d->{$ct} - $bump);
					delete $pover->{$ct};	# take only once
					$avail += $bump;
				}
			}
		}

		# Next, force down torrents that are above max.
		if ($avail < $bump_want * $bumpfactor || $avail < 0) {
#			printf "max: %d / %d\n", $avail, $bump_want * $bumpfactor;
			@foo = keys(%$pover);
			foreach $ct (@foo) {
				if ($pmax->{$ct} && $pover->{$ct} > $pmax->{$ct}) {
					$mybump_u = defined($pbump_u->{$ct}) ? $pbump_u->{$ct} : 0;
#					printf "  cand: %d > %d & wants %d\n",
#						$pover->{$ct}, $pmax->{$ct}, $mybump_u*$bumpfactor;
					if ($avail < ($bump_want - $mybump_u) * $bumpfactor) {
						# bump no lower than the ct's max limit
						$bump = &min( &min( &max(1, $pover->{$ct} * $bumpfactor),
										($bump_want - $mybump_u) * $bumpfactor - $avail ),
									$pover->{$ct} - $pmax->{$ct} );
#						printf "   bump %s: -%d", $torrents{$ct}, $bump;
						&$pset_limit($ct, $pover->{$ct} - $bump);
						$avail += $bump;
						delete $pover->{$ct};	# don't take twice
					}
					# If there's not enough, those over max don't get any.
					if (defined($pbump_u->{$ct})) {
						$bump_want -= $pbump_u->{$ct};
						delete $pbump_u->{$ct};	# give to the needy
					}
				}
			}
#			print "max done\n";
		}

		# Next, handle any remaining overcommitment issues.
		# This loop takes from the highest-limit torrent (each only once)
		# until the goal is met.
		while (keys %$pover && $avail < 0) {
			$maxct = "";
			foreach $ct (keys %$pover) {
				$maxct = $ct if (!$maxct || ($pover->{$ct} > $pover->{$maxct}));
			}
			# bump no lower than the ct's min limit
			$bump = &min( &max(1, $pover->{$maxct} * $bumpfactor),
				$pover->{$maxct} - $pmin->{$maxct} );
#			printf "   bump %s: -%d", $torrents{$maxct}, $bump;
			&$pset_limit($maxct, $pover->{$maxct} - $bump);
			if (defined($pbump_u->{$maxct})) {
				$bump_want -= $pbump_u->{$maxct};
				delete $pbump_u->{$maxct};	# don't give back if we take away
			}
			$avail += $bump;
			delete $pover->{$maxct};	# don't take twice
		}

		# Next, take once from the highest-limit torrent.
		# (but don't consider his own demand in the decision to take)
		if (keys %$pover && $avail < $bump_want * $bumpfactor) {
			$maxct = "";
			foreach $ct (keys %$pover) {
				$maxct = $ct if (!$maxct || ($pover->{$ct} > $pover->{$maxct}));
			}
			$mybump_u = defined($pbump_u->{$maxct}) ? $pbump_u->{$maxct} : 0;
			if ($avail < ($bump_want - $mybump_u) * $bumpfactor) {
				# bump no lower than the ct's min limit
				$bump = &min( &min( &max(1, $pover->{$maxct} * $bumpfactor),
									($bump_want - $mybump_u) * $bumpfactor - $avail ),
							$pover->{$maxct} - $pmin->{$maxct} );
#				printf "   bump %s: -%d", $torrents{$maxct}, $bump;
				&$pset_limit($maxct, $pover->{$maxct} - $bump);
				$avail += $bump;
			}
			if (defined($pbump_u->{$maxct})) {
				$bump_want -= $pbump_u->{$maxct};
				delete $pbump_u->{$maxct};	# give to the needy
			}
		}
	}

	# If we have any spare bandwidth, pass it out.
	if ($avail >= 1) {
#		printf "   avail: %d\n", $avail;
		if ($avail < $bump_want * $bumpfactor) {
			$bumpfactor = $avail / $bump_want;
		} else {
			# increase the increment if we have a lot available
			$bumpfactor = &max($bumpfactor, $avail/2 / $all_limit);
		}
		foreach $ct (keys %$pbump_u) {
			$bump = &max( 1, &min($avail, $pbump_u->{$ct} * $bumpfactor) );
#			printf "   bump %s: +%d", $torrents{$ct}, $bump;
			&$pset_limit($ct, $pbump_u->{$ct} + $bump);
			$avail -= $bump;
			last if ($avail < 1);
		}
	}
}


sub set_dl_limit {
	my($ct, $limit) = @_;
	local *FH = $cfh{$ct};
#	printf " [%.0f]\n", $limit;
	printf FH "SETDLIMIT %.0f\n", $limit;
}

sub set_ul_limit {
	my($ct, $limit) = @_;
	local *FH = $cfh{$ct};
#	printf " [%.0f]\n", $limit;
	printf FH "SETULIMIT %.0f\n", $limit;
}

sub set_config {
	my($ct, $v,$e,$E,$M,$m,$n,$Z,$Pz,$Qz) = @_;
	local *FH = $cfh{$ct};
	printf FH "CTCONFIG $v $e $E $M $m $n $Z $Pz $Qz\n";
}

sub send_protocol {
	my($ct) = @_;
	local *FH = $cfh{$ct};
   print FH "PROTOCOL $CTCS_PROTOCOL\n";
}

sub send_error {
	my($ct, $message) = @_;
	local *FH = $cfh{$ct};
   print FH "ERROR $message\n";
}

sub request_detail {
	my($ct) = @_;
	local *FH = $cfh{$ct};
   print FH "SENDDETAIL\n";
}

sub request_config {
	my($ct) = @_;
	local *FH = $cfh{$ct};
   print FH "SENDCONF\n";
}

sub request_peers {
	my($ct) = @_;
	local *FH = $cfh{$ct};
   print FH "SENDPEERS\n";
}

sub request_status {
	my($ct) = @_;
	local *FH = $cfh{$ct};
   print FH "SENDSTATUS\n";
}


sub html_safe {
	my($str) = @_;
	$str =~ s/\&/\&amp\;/g;
	$str =~ s/\</\&lt\;/g;
	$str =~ s/\>/\&gt\;/g;
	$str =~ s/\"/\&quot\;/g;
	return $str;
}

sub url_encode_data {
	my($str) = @_;
	$str =~ s/([^\w\-_.])/sprintf("%%%02X",ord($1))/eg;
	return $str;
}

sub url_decode_data {
	my($str) = @_;
	$str =~ s/%([\da-f]{2})/chr(hex($1))/eig;
	return $str;
}


sub min {
	my($a, $b) = @_;
	return ($a < $b) ? $a : $b;
}

sub max {
	my($a, $b) = @_;
	return ($a > $b) ? $a : $b;
}

sub unit {
	my($value) = @_;
	my $unit=($value>9999*1024) ? "M" : (($value>9999) ? "K" : "B");
	return $unit;
}

sub value {
	my($value,$unit) = @_;
	if ($unit eq "K"){ $value /= 1024; }
	elsif ($unit eq "M"){ $value /= (1024*1024); }
	return $value;
}

sub clienttype {
	my($peerid, $myid) = @_;
	my($ctclient,$ctversion);

	if ($peerid eq $myid) {
		$ctclient = "BitComet?";
		$ctversion = "(clone)";
	}
	elsif ($peerid =~ /(UDP0|55445030|HTTPBT|485454504254)$/) {
		$ctclient = "BitSpirit";
		if ($peerid =~ /^0x00(..)4253/) {  # 4253 = BS
			$ctversion = hex($1);
		} else { $ctversion = "(spoof)"; }
	}
	elsif ($peerid =~ /^-([A-Z][A-Z])(\d[\w.]{3,4})-/i) {
		$ctclient = $ctclients1{$1};
		$ctclient = "Unknown" if (!$ctclient);
		$ctversion = $2;
	}
	elsif ($peerid =~ /^([a-z])([\dA-F]{3})--/i) {
		$ctclient = $ctclients2{$1};
		$ctversion = $2;
	}
	elsif ($peerid =~ /^([a-z])0x([\dA-F]{6})00/i) {
		$ctclient = $ctclients2{$1};
		$ctversion = $2;
	}
	elsif ($peerid =~ /^M(\d-\d-\d)--/) {
		$ctclient = "BitTorrent";
		$ctversion = $1;
	}
	elsif ($peerid =~ /^exbc0x(..)(..)4C4F5244/) {
		$ctclient = "BitLord";
		$ctversion = hex($1) . "." . hex($2);
	}
	elsif ($peerid =~ /^exbc0x00(..)/) {
		$ctclient = "BitComet";
		$ctversion = "0." . hex($1);
	}
	elsif ($peerid =~ /^[xF]UTB0x00(..)/) {
		$ctclient = "FUTB BitComet";
		$ctversion = "0." . hex($1);
	}
	elsif ($peerid =~ /^XBT(\d{3})[d-]-/) {
		$ctclient = "XBT";
		$ctversion = $1;
	}
	elsif ($peerid =~ /^OP(\d{4})/) {
		$ctclient = "Opera";
		$ctversion = $1;
	}
	elsif ($peerid =~ /^-G3/) {
		$ctclient = "G3 Torrent";
		$ctversion = "";
	}
	elsif ($peerid =~ /^Mbrst(\d-\d-\d)/) {
		$ctclient = "Burst!";
		$ctversion = $1;
	}
	elsif ($peerid =~ /^Plus(\d\d[^-]*)-/) {
		$ctclient = "BitTorrentPlus";
		$ctversion = $1;
	}
	elsif ($peerid =~ /^-BOW([A-Z])0([A-Z])-/) {
		$ctclient = "BitsOnWheels";
		if ($1 eq "P") {
			$ctversion = "Pre";
		} else {
			$ctversion = ord($1)-ord("A")+1;
		}
		$ctversion .= ".0" . (ord($2)-ord("A")+1);
	}
	elsif ($peerid =~ /^BTM(\d+)BTuga/i) {
		$ctclient = "BTuga";
		$ctversion = $1;
	}
	elsif ($peerid =~ /^eX/i) {
		$ctclient = "eXeem";
		$ctversion = "";
	}
	else {
		$ctclient = "Unknown";
		$ctversion = "";
	}
	return "$ctclient $ctversion";
}


sub usage {
	print "Usage:  $0 [-d <dlimit>] [-u <ulimit>] [-i <interval>] [-p <port>] [-P]\n";
}