#!/usr/bin/perl
#This file is copyright of Web Orientated Technologies Ltd. and may not be copied, duplicated or modified without the permission of Web Orientated Technologies Ltd.
sub validate_email
{
#returns -1 if email is incorrect
#returns 0 if email is correct
    my ($email) = @_;
    $email = uc($email);
    my ($out,$temp,$i) = '';
    $out = 0;
    my(@NameExclusions) = ("\n","\r","\t","\s",'(',')','<','>','@',',',';',':',"\\",'<','>','|',"\`",'[',']',"\f","\a","\e","\c[");
    $email =~ s/^\s+//;
    $email =~ s/\s+$//;
    if ($email !~ /\@/) {
	$out = -1;
    } else {
	my ($name,$domain) = split(/\@/, $email);
	if ($domain =~ /\_/ || $domain !~ /\./) {
	    $out = -1;
	} else {
	    my (@subdomains) = split (/\./, $domain);
	    foreach $temp (@subdomains) {
		for ($i=0; $i < (length($temp)); $i++) {
		    if (substr($temp,$i,1) =~ /\W/ && substr($temp,$i,1) ne '-') {
			$out = -1;
		    }
		}
	    }
	    foreach $temp (@NameExclusions) {
		for ($i=0; $i < (length($name)); $i++) {
		    if ($temp eq substr($name,$i,1)) {
			$out = -1;
		    }
		}
	    }
	}
    }
    return ($out);
}
sub set_cookies_to_zero
{
    my($path) = @_;
    my ($temp)='';
    my (%CookieKeyValues) = ();
    my (@KeyValuesPairs) = split (/\;\ /, $ENV{HTTP_COOKIE});
    foreach $temp(sort(@KeyValuesPairs)) {
	my ($key,$value) = split (/\=/, $temp);
	$key =~ s/^\ //g;
	print &set_cookie($key,'','',$path);
    }
}
sub set_cookie
{
    my($cookiekey, $cookievalue, $expires, $path) = @_;
    my ($out)='';
    $out = 'Set-cookie: '.$cookiekey.'='.$cookievalue;
    if ($expires) {
	$out .= '; expires='.$expires;
    }
    if ($path) {
	$out .= '; path='.$path;
    }
    $out .= "\n";
    return ($out);
}
sub read_cookie
{
    my ($cookiekey) = @_;
    my ($out,$temp)='';
    my (%CookieKeyValues) = ();
    my (@KeyValuesPairs) = split (/\;\ /, $ENV{HTTP_COOKIE});
    foreach $temp(sort(@KeyValuesPairs)) {
	my ($key,$value) = split (/\=/, $temp);
	$key =~ s/^\ //g;
	$CookieKeyValues{$key} = $value;
    }
    $out = $CookieKeyValues{$cookiekey};
    return ($out);
}
sub text_to_html
{
    my ($out) = @_;
    $out =~ s/\r//g;
    $out =~ s/\&/\&amp\;/g;
    $out =~ s/\+/\&\#43\;/g;
    $out =~ s/\!/\&\#33\;/g;
    $out =~ s/\</\&lt\;/g;
    $out =~ s/\>/\&gt\;/g;
    $out =~ s/\"/\&quot\;/g;
    $out =~ s/\//\&frasl\;/g;
    $out =~ s/\ /\&nbsp\;/g;
    $out =~ s/\£/\&pound\;/g;
    $out =~ s/\©/\&copy\;/g;
    $out =~ s/\t/\&nbsp\;\&nbsp\;/g;
    $out =~ s/\n/\<br\>/g;
    $out  =~ s/(\&nbsp\;)\1/xXzZcC111/g;
    $out =~ s/\&nbsp\;/\ /g;
    $out =~ s/xXzZcC111/\&nbsp\;\&nbsp\;/g;
    return ($out);
} 
sub html_to_text
{
    my ($out) = @_;
    $out =~ s/\r//g;
    $out =~ s/\<br\>/\n/g;
    $out =~ s/\&copy\;/\©/g;
    $out =~ s/\&pound\;/\£/g;
    $out =~ s/\&nbsp\;/\ /g;
    $out =~ s/\&frasl\;/\//g;
    $out =~ s/\&quot\;/\"/g;
    $out =~ s/\&gt\;/\>/g;
    $out =~ s/\&lt\;/\</g;
    $out =~ s/\&\#33\;/\!/g;
    $out =~ s/\&\#43\;/\+/g;
    $out =~ s/\&amp\;/\&/g;
    return ($out);
} 
sub send_mail
{
    my ($to,$from,$subject,$message)=@_;
    my ($command);
    $to = &strip_unix_commands($to);
    $from = &strip_unix_commands($from);
    $subject = &strip_unix_commands($subject);
    $message = &strip_unix_commands($message);
    if ($to =~ /\@/) {
        $command = '/usr/sbin/sendmail -oem -oi -t -f \'<>\' <<EOF
From: '.$from.'
Subject: '.$subject.'
To: '.$to.'
 
'.$message.'
EOF
';
        system ($command);
	`sleep 2`;
    }
}
sub send_multi_mail
{
#Note the Bcc string is in this format: name1@abc.com,name2@abc.com,name3@abc.com...
#$from should be 'name <>'
    my ($bcc,$from,$subject,$message)=@_;
    my ($mailer);
    $mailer = '/usr/sbin/sendmail';
    if ($bcc =~ /\@/) {
	open(EmailFH, "| $mailer -t");
	print EmailFH 'From: '.$from.'
Bcc: '.$bcc.'
Subject: '.$subject.'

'.$message;
	close(EmailFH); 
	`sleep 2`;
    }
}
sub send_multi1_mail
{
#Note the Bcc string is in this format: name1@abc.com,name2@abc.com,name3@abc.com...
#$from should be 'name <>'
    my ($bcc,$from,$subject,$message)=@_;
    my ($mailer);
    $mailer = '/usr/sbin/sendmail';
    if ($bcc =~ /\@/) {
	open(EmailFH, "| $mailer -t");
	print EmailFH 'From: '.$from.'
Bcc: '.$bcc.'
Subject: '.$subject.'
Content-Type: text/html; charset="us-ascii"
Content-Transfer-Encoding: 7bit

'.$message;
	close(EmailFH); 
	`sleep 2`;
    }
}
sub parse_form_data
{
    my ($request_method, $query_string, @key_value_pairs, $key_value, $key, $value);
    $request_method = $ENV{'REQUEST_METHOD'};
    if ($request_method eq "GET") {
	$query_string = $ENV{'QUERY_STRING'};
    } elsif ($request_method eq "POST"){
	read(STDIN,$query_string,$ENV{'CONTENT_LENGTH'});
    } else {
	&return_error (500, "HTML Error", "Error in your form method, the \U$request_method\E is unknown!");
    }
    @key_value_pairs = split (/&/, $query_string);
    foreach $key_value (@key_value_pairs) {
	($key, $value) = split (/=/, $key_value);
	$value =~ tr/+/ /;
	$value =~ s/%([\dA-Fa-f][\dA-Fa-f])/pack ("C", hex ($1))/eg;
	$value =~ s/\x3c\x21\x2d\x2d *\x23/\x21\x2d\x2dSSI warning\x21 /g;
	if (defined($form_data{$key})) {
	    $form_data{$key} = join ("\0", $FORM_DATA{$key}, $value);
	} else {
	    $form_data{$key} = $value;
	}
    }
}
sub return_error
{
    my ($status, $keyword, $message) = @_;
    print &http_protocol;
    print "Status: ", $status, " ", $keyword, "\n\n";
    print '<HTML><BODY><TITLE>CGI Program: Form Error!</TITLE>
<h1>'.$keyword.'</h1>
<hr>'.$message.'<hr>
Please contact '.$webmaster.' for more information.
</BODY></HTML>';
    exit(1);
}
sub http_protocol
{
    my($protocol);
    $protocol="HTTP:/1.1 200 Document follows\r\nContent-type: text/html\r\n\r\n";
    return ($protocol); 
}
sub location_protocol
{
    my ($location,$target) = @_;
    my ($out,$left,$right,$temp,$k,$v);
    my (@keys, @values, @items) =();
    ($left,$right) = split (/\?/, $location);
    push (@items, split (/\&/, $right));
    $right= '';
    foreach $temp(@items){
        ($k,$v) = split (/\=/, $temp);
        $k = &convert_to_HTTP($k);
        $v = &convert_to_HTTP($v);
        $right .= $k.'='.$v.'&';
    }
    chop ($right);
    $out = 'Location: '.$left.'?'.$right;
    if ($target) {
        $out .= "Window-target: ".$target.' ';
    }
    $out .= "\n\n";
    return ($out);
}
sub strip_unix_commands
{
    my($in)=@_;
    my ($temp);
    my (@commands)=("rm","cat","ls","rmdir","mkdir","sendmail","elm","cp","mail","vi",'\|',"&&");
    foreach $temp (@commands){
	$in =~ s/\ +$temp\ +/\{UNIX COMMAND \- IP\=$ENV{REMOTE_ADDR}\}/gm;
    }
    return($in);
}
sub convert_to_HTTP
{
    my($In)=@_[0];
    my($Out)="";
    my($n);
    for($n=0; $n<length($In); $n++)
        {
        if (substr($In, $n, 1)=~m/[a-z]/ |
            substr($In, $n, 1)=~m/[A-Z]/ |
            substr($In, $n, 1)=~m/[0-9]/)
            {
            $Out=$Out.substr($In, $n, 1);
            }
        else
            {
            $Out=$Out.sprintf("%%%2.2x", ord(substr($In, $n, 1)));
            }
        }
    return $Out;
} 
1;