#!perl
# EasyHost
# Built by CyberScript
# Website: http://www.cyberscript.net
# Email: rcampbell@cyberscript.net
# (C) Copyright 2001, All Rights Reserved.
#####################################################
# The following code may not be modified            #
# or redistributed by anyone other than CyberScript #
#####################################################

%tokens = %ENV;
%files = ();
%uploads = ();

&form();
&cookie_get();
&configure();

%blocks = (
	'T' => 1099511627776,
	'G' => 1073741824,
	'M' => 1048576,
	'K' => 1024,
	'B' => 1
);

$tokens{login_id} = (split(/,/,$tokens{login_id}))[0];
$tokens{c} = (split(/,/,$tokens{c}))[0];

&setup if (!$tokens{site_password} || !$tokens{data_dir});
&error("Data directory doesn't exisit") if (!-d "$tokens{data_dir}");

require ("$pwd/db-lib.pl");

sub configure {
	foreach my $line (split(/\n/,&file_read("$pwd/config.ini"))) {
		my @line = split(/=/,$line,2);
		$tokens{$line[0]} = $line[1];
	}
}

sub display {
	my ($directory)=@_;
	my $html;

	$tokens{c} ||= 'main';
	&error("Invalid command: $tokens{c}") if ($tokens{c} !~ /^[\w\_]+$/ || (!-f "$tokens{data_dir}/html/$directory/$tokens{c}.html" && !$files{"$tokens{data_dir}/html/$directory/$tokens{c}.html"} && !$files{"/html/$directory/$tokens{c}.html"}));

	$html = &file("$tokens{data_dir}/html/$directory/header.html","$tokens{data_dir}/html/header.html","/html/$directory/header.html") if ($tokens{c} !~ /^popup_/);
	$html .= &file("$tokens{data_dir}/html/$directory/$tokens{c}.html","/html/$directory/$tokens{c}.html");
	$html .= &file("$tokens{data_dir}/html/$directory/footer.html","$tokens{data_dir}/html/footer.html","/html/$directory/header.html") if ($tokens{c} !~ /^popup_/);

	return $html;
}

sub file {
	my $text = &file_read(@_);
	my $html;

	return () if (!$text);

	my @cs=split(/\{\{"/,$text);
	$cs[0]=~s/'/\\'/g;

	for (my $i=1;$i<=$#cs;$i++) {
		my ($cs,$beyond)=split(/"\}\}/,$cs[$i],2);

		$beyond =~ s/'/\\'/g;
		$cs=~s/\{(.+?)\}/\$tokens{'$1'}/gs;
		$cs[$i]="'; ".&csl($cs)." \$html.='".$beyond;
	}

	$text = "\$html.='".join(undef,@cs)."';";

	sub csl {
		my ($cs)=@_;

		my @cmds=split(/","/,(split(/"\:"/,$cs,2))[0]);
		my @argv=split(/","/,(split(/"\:"/,$cs,2))[1]);
		my $cmd;

		if (-f "$tokens{data_dir}/perl/$cmds[0]" || $files{"$tokens{data_dir}/perl/$cmds[0]"} || $files{"/perl/$cmds[0]"}) {
			my $perl = "\n".&file_read("$tokens{data_dir}/perl/$cmds[0]","/perl/$cmds[0]")."\n";
			$perl =~ s/\{\{"argv_([0-9]+)"\}\}/$argv[$1]/gi;

			return $perl;
		} else {
			return '$html.=$tokens{\''.$cmds[0].'\'};';
		}

		return $text;
	}

	eval($text);

	if ($tokens{login_id}) {
		$html =~ s/\Q$ENV{SCRIPT_NAME}\E(\?{0,1})([^"']*)/$ENV{SCRIPT_NAME}?login_id=$tokens{login_id}&$2/sig;
		$html =~ s/<\/form>/<input type="hidden" name="login_id" value="$tokens{login_id}"><\/form>/sig;
	}

	if ($tokens{debug}) { return $text; }
	else { return $html; }
}

sub file_read {
	foreach my $file (@_) {
		if ($files{$file}) {
			$tokens{file_text}=$text;
			return $files{$file};
		} elsif (open(FILE,$file)) {
			my $text=join(undef,(<FILE>));
			close(FILE);
			$files{$file}=$text;
			$tokens{file_text}=$text;
			return $text;
		}
	}
}

sub file_write {
	my ($file,$text) = @_;

	open(FILE,">$file") || &error("Can't write file ($file): $!");
	binmode(FILE);
	print FILE $text;
	close(FILE);

	chmod(0644,$file);

	$files{$file} = $text;
}

sub file_data {
	my ($file) = @_;

	my $text = &file_read($file);

	while($text =~ /FILE_START\((.+?)\)(.*?)FILE_END/sgi) {
		$files{"$tokens{data_dir}/$1"} = $2;
	}
}

sub dir_read {
	my ($directory) = @_;

	opendir(DIR,$directory) || &error("Can't open directory: $!");
	my @dir = sort { lc($a) cmp lc($b) } grep($_ !~ /^[\.]*$/,readdir(DIR));
	closedir(DIR);

	return @dir;
}

sub dir_remove {
	my ($dir)=@_;

	if (opendir(DIR,$dir)) {
		my @dir=readdir(DIR);
		closedir(DIR);

		foreach (@dir) {
			next if ($_ =~ /^\.+$/);

			if (-d "$dir/$_") { &dir_remove("$dir/$_"); }
			else { unlink("$dir/$_"); }
		}

		rmdir("$dir");
	}
}

sub form {
	my $form;
	&form_parse($ENV{QUERY_STRING});
	binmode(STDIN);
	binmode(STDOUT);
	binmode(STDERR);

	if ($ENV{REQUEST_METHOD} eq "POST" && $ENV{CONTENT_TYPE} =~ /multipart\/form\-data/i) {
		read(STDIN,$form,$ENV{CONTENT_LENGTH});

		my $boundary;
		if ($ENV{CONTENT_TYPE}=~/boundary="([^"]+)"/i) { $boundary=$1; } elsif ($ENV{CONTENT_TYPE}=~/boundary=(\S+)/i) { $boundary=$1; }

		foreach my $field (split(/$boundary/,$form)) {
			my $key;
			if ($field=~/\bname="([^"]+)"/i) { $key=$1; } elsif ($field=~/\bname=([^\s:;]+)/i) { $key=$1; }
			next if (length($key)==0);
			if ($field=~/\bfilename="(.+?)"/i) { $uploads{$key}=$1; } elsif ($field=~/\bfilename=([^"\s:;]+)/i) { $uploads{$key}=$1; }
			($tokens{$key})=$field=~/\r\n\r\n(.*)\r\n--/s;
		}
	} elsif ($ENV{REQUEST_METHOD} eq "POST") {
		read(STDIN,$form,$ENV{CONTENT_LENGTH});
		&form_parse($form);
	}
}

sub form_parse {
	my $form=shift;

	foreach my $field (split(/&/,$form)) {
		$field =~ s/\+/ /g;
		$field =~ s/%([A-Fa-f0-9]{2})/pack("c",hex($1))/ge;
		my ($key,$val)=split(/=/,$field,2);
		if (!$tokens{$key} && length($val)>0) { $tokens{$key}=$val; } elsif (length($val)>0) { $tokens{$key}.=','.$val; }
	}
}

sub cookie_set {
	my ($name,$value) = @_;
	$value =~ s/ /\+/g;

	my $time=time;
	$time = $time + 31536000;
	my @time=localtime($time);
	my @days = ("Sun","Mon","Tue","Wed","Thu","Fri","Sat");
	my @months = ("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec");
	$time[5]+=1900;
	if ($time[3] < 10) { $time[3] = "0".$time[3]; }

	print "Set-Cookie: $name=$value; expires=$days[$time[6]], $time[3]-$months[$time[4]]-$time[5] 00:00:00 GMT; path=/; domain=".($ENV{HTTP_HOST} =~ /^([^\:]+)/)[0]."\n";
	$tokens{$name}=$value;
}

sub cookie_get {
	my @cookies=split(/; /,$ENV{'HTTP_COOKIE'});

	foreach my $line (@cookies) {
		my @line=split(/=/,$line);
		$line[1] =~ s/\+/ /g;
		$tokens{$line[0]}=$line[1] if (!$tokens{$line[0]});
	}
}

sub ct {
	return "Content-type: $_[0]\n\n";
}

sub error {
	my ($message,$field)=@_;

	print STDERR "ERROR: $message\n";

	if ($field) {
		$tokens{error_message} = "Errors have occured, please review the form below.";
		$tokens{"error_$field"}=$message if (!$tokens{"error_$field"});
	} else {
		$tokens{error_message}=$message;

		print &ct("text/html").&file("$tokens{data_dir}/html/$directory/error.html","$tokens{data_dir}/html/error.html");
		exit (0);
	}
}

sub size_format {
	my ($size,$precision) = @_;
	my $sign = undef();

	if ($size < 0) {
		$size = substr($size,1);
		$sign = '-';
	}

	if ($size == 0) {
		$size = &number_format('0')." B";
	} else {
		foreach my $block (sort { $blocks{$b} <=> $blocks{$a} } keys(%blocks)) {
			if ($size >= $blocks{$block}) {
				$size = &number_format($size / ($blocks{$block} || 1))." $block";
				last;
			}
		}
	}

	return $sign . $size;
}


sub number_format {
	my ($number,$precision) = @_;
	my $sign = undef();

	$precision ||= 2;

	if ($size < 0) {
		$size = substr($size,1);
		$sign = '-';
	}

	$number = int($number * (10 ** $precision) + .5000001) / (10 ** $precision);

	my $interger = reverse(join(",",grep { length($_) > 0 } split(/(\d{3})/,reverse(int($number)))));
	my $decimal = substr($number,length(int($number)) + 1,$precision);

	for (my $i = length($decimal) + 1;$i <= $precision; $i++) {
		$decimal .= '0';
	}

	return $sign . $interger . "." . $decimal;
}

sub date_format {
	my ($date)=@_;

	$date ||= time();

	@date=localtime($date);

	$date[4]++;
	$date[5] += 1900;

	my $ampm;
	if ($date[2] < 12 || $date[2] == 24) { $ampm = 'AM'; } else { $ampm = 'PM'; }

	$date[2] -= 12 if ($date[2] > 12);

	$date[1] = '0'.$date[1] if ($date[1] < 10);
	$date[2] = '0'.$date[2] if ($date[2] < 10);
	$date[3] = '0'.$date[3] if ($date[3] < 10);
	$date[4] = '0'.$date[4] if ($date[4] < 10);	

	return "$date[4]/$date[3]/$date[5] $date[2]:$date[1] $ampm";
}

sub sock_connect {
	my ($them,$port)=@_;

	use Socket;

	my $hostname = `hostname`;

	my ($name, $aliases, $proto) = getprotobyname('tcp');
	my ($name, $aliases, $port) = getservbyname($port,'tcp') unless $port =~ /^\d+$/;

	my ($name,$aliases,$type,$len,$thisaddr) = gethostbyname($hostname);
	my ($name, $aliases,$type,$len,$thataddr) = gethostbyname($them);

	socket(S,AF_INET, SOCK_STREAM, $proto) || &error("Can't create socket: $!");

	my $sockaddr = 'S n a4 x8';
	my $this = pack($sockaddr, AF_INET, 0, $thisaddr);
	my $that = pack($sockaddr, AF_INET, $port, $thataddr);

	bind(S, $this) || &error("Can't bind: $!");
	connect(S, $that) || &error("Can't connect ($them,$port): $!");

	select(S);
	$| = 1;
	select(STDOUT);
}

sub sock_send {
	my ($text)=@_;
	print S $text;
}

sub sock_recv {
	my ($length)=@_;
	my $text;

	if ($length>0) {
		recv S,$text,$length,0;
	} else {
		while (<S>) {
			$text.=$_;
		}
	}

	return $text;
}

sub sock_disconnect {
	close S;
}

sub mail {
	my (%mail)=@_;

	$mail{from} ||= $ENV{SERVER_ADMIN};
	$tokens{mail_server} ||= 'localhost';

	use POSIX qw(strftime);
	$mail{Date}=strftime("%a, %d %b %Y %T %z (%Z)",localtime);

	&sock_connect($tokens{mail_server},'smtp');
	&sock_recv(512);

	my ($user,$domain)=split(/\@/,$mail{from});

	&sock_send("HELO $domain\r\n");
	&sock_recv(512);

	&sock_send("MAIL From: $mail{from}\r\n");
	&sock_recv(512);

	&sock_send("RCPT To: $mail{to}\r\n");
	&sock_recv(512);

	&sock_send("DATA\r\n");
	&sock_recv(512);

	foreach my $key (keys(%mail)) { &sock_send("$key: $mail{$key}\r\n") if ($key ne 'message'); }

	$mail{message} =~ s/\n/\r\n/g;
	&sock_send("\r\n$mail{message}\r\n.\r\n");

	&sock_send("QUIT\r\n");
	&sock_recv(512);

	&sock_disconnect;
}

sub cmd {
	my ($directory)=@_;

	$tokens{c} ||= 'main';

	&error("The command you entered contains invalid characters: $tokens{c}") if ($tokens{c} !~ /^[\w\_]+$/);

	my $cmd = &file_read("$tokens{data_dir}/perl/$directory/$tokens{c}");
	eval($cmd);

	if ($@) {
		print &ct("text/html");
		print "ERROR ($directory/$tokens{c}): $@\n";
		exit();
	}
}

sub config_modify {
	my (%data) = @_;

	my %config = ();

	foreach (split(/\n/,&file_read("$pwd/config.ini"))) {
		my @line=split(/=/,$_,2);
		$config{$line[0]}=$line[1];
	}

	foreach (keys(%data)) {
		$config{$_} = $data{$_};
	}

	open(CONF,">$pwd/config.ini") || &error("Can't write to config.ini: $! ($pwd/config.ini)");
	foreach (keys(%config)) {
		print CONF "$_=$config{$_}\n";
	}
	close(CONF);
}

sub redirect {
	my ($cmd) = @_;

	if ($tokens{login_id}) {
		print "Location: http://$ENV{HTTP_HOST}$ENV{SCRIPT_NAME}?login_id=$tokens{login_id}&c=$cmd\n\n";
	} else {
		print "Location: http://$ENV{HTTP_HOST}$ENV{SCRIPT_NAME}?c=$cmd\n\n";
	}

	exit(0);
}

sub setup {
	&file_data("$pwd/setup.data") if (!$tokens{data_dir} || !-d "$tokens{data_dir}/html");
	&cmd("setup");

	print &ct("text/html").&display("setup");
	exit(0);
}

sub notice {
	my ($action,$text) = @_;

	my %notices = ();

	foreach my $line (split(/\n/,&file_read("$tokens{data_dir}/text/notices"))) {
		my ($type,$list) = split(/=/,$line,2);
		$notices{$type} = $list;
	}

	if ($notices{email} =~ /(^|,)$action(,|$)/) {
		my %mail = ();
		$tokens{name} = $tokens{login_name} || $tokens{name};
		$tokens{action} = $text;
		$tokens{date} = &date_format();

		$mail{from} = $tokens{site_email};
		$mail{to} = $tokens{site_email};
		$mail{subject} = "$tokens{site_title} Notice";
		$mail{message} = &file("$tokens{data_dir}/mail/admin_notice");

		&mail(%mail);
	}

	if ($notices{log} =~ /(^|,)$action(,|$)/) {
		&file_write(">$tokens{data_dir}/text/log",&date_format()."\t".($tokens{login_name}||$tokens{name})."\t$ENV{REMOTE_ADDR}\t$text\n");
	}
}

1;