###PERL;

# proxy.pl is generated from proxy.1.pl
# 29.08.2016
#
# This is the proxy software. It's launched as a CGI program by the http server.
#
# The proxy:
# - determines information about the http(s) request,
# - checks if user is allowed to use it,
# - forwards the requests using curl,
# - sends the response back to the user,
# - saves a redundant copy of the response.
#
# It's run with SETUID to have accesss to some files where the www server
# should not. That's why it has a C wrapper. In modern systems running scripts
# directly with SETUID is considered unsafe and not allowed.
# When running with SETUID the program also has to deal with Perl's built-in
# securuity.
#
# Any data comming from standard input, files, environment variables, command
# line is treated by Perl as unsafe. Any data created by operations on unsafe
# data is also unsafe. Perl will not allow to use such data to open files (for
# writing), launch programs, etc.
# That's why the data has to be validated and made safe, like this:
# if ($variable =~/^(some-regex)$/) {
#   $variable = $1;
# }
#
# see also:
# http://perldoc.perl.org/perlsec.html#Taint-mode
# https://tools.ietf.org/html/rfc2616
# https://tools.ietf.org/html/rfc3875
# https://tools.ietf.org/html/rfc2396
#
#    Copyright (C) 2015-2016  Balthasar Szczepański
#
#    This program is free software: you can redistribute it and/or modify
#    it under the terms of the GNU Affero General Public License as
#    published by the Free Software Foundation, either version 3 of the
#    License, or (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU Affero General Public License for more details.
#
#    You should have received a copy of the GNU Affero General Public License
#    along with this program.  If not, see <http://www.gnu.org/licenses/>.


use strict;
#use warnings;

###LIB;
use proxy_lib qw(urldecode divideurl entityencode urldiv2path getcgi formatheader access);
use POSIX qw(strftime);

###UNLOCK_LOG;
###UNLOCK_LOG;
###CURL_PATH;
###PASS_PATH;
###ARCH_PATH;
###ACCESS_PATH;
###UNLOCK_PROXY_URL;
###UNLOCK_PROXY_URL_S;
###UNLOCK_PROXY_HOST;
###UNLOCK_PROXY_PATH;
###TIMEOUT_UNLOCK;
###TIMEOUT_INACT;
###BLOCK_HOST;
###BLOCK_PORT;
###TEMP_PATH;

use constant REQUEST_HEADER_BLOCK => qr/^(accept-encoding|connection|te|transfer-encoding|via)$/;
use constant RESPONSE_HEADER_BLOCK => qr/^(connection|content-encoding|content-length|trailer|transfer-encoding)$/;

my $accesstime = time();

my $URL='';
my $IP;
my $prot='';
my $host='';
my $port='';
my $path='';
my $query='';

delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
###PATH;

# If the special URL is used, instaed of proxying there will be proxy unlocking.
if (($ENV{'HTTP_HOST'} =~ UNLOCK_PROXY_HOST) and (urldecode($ENV{'PATH_INFO'}) =~ UNLOCK_PROXY_PATH)){
	unlock();
}
else {
	# proxy will work only if unlocked
	if(access($accesstime,$ENV{'REMOTE_ADDR'},$ENV{'HTTP_HOST'})) {
		proxy();
	}
	else {
		noaccess();
	}
}

# The proxying function
sub proxy {
	# The required information is stored in environment variables (rfc3875).
	# The HTTPS variable is not defined in rfc3875 (might be a portability
	# problem?)
	
	my $archive=0;  # if this http request should be archived
	my $postdata=0; # if there is data to pe posted
	my $archpath=0;
	
	my $respheadpath='';
	my $respcontpath='';
	my $postheadpath='';
	my $postcontpath='';
	
	my $respheadfile;
	my $respcontfile;
	my $postheadfile;
	my $postcontfile;
	
	my $postcontopen=0;
	my $respcontopen=0;
	my $respheadopen=0;
	
	my $safelength=1;    # if Content-length is safe to be forwarded 
	my $definedlength=0; # if Content-length is defined
	my $safeerror=1;     # if it's safe to send an error message.
	my $lastskipped=1;   # if the previous header field was not forwarded
	my $forceexit=0;     # if the proxy should exit with error
	my $errormsg;
	my $rangestart;      # first byte of partial content
	my $rangelength;     # total length when partial content
	
	my $contentlength;
	
	my @curl_arg=(CURL_PATH,'-i','-#','--compressed'); # the command line arguments for curl
	my @reqhead;                        # the HTTP request header
	my @resphead;
	
	#pipes
	my $curloutrd;
	my $curloutwr;
	my $curlinrd;
	my $curlinwr;
	my $curlerrrd;
	my $curlerrwr;
	
	my $curlpid;
	
	my $buffer;
	my $buffer2;
	
	# The proxy will not support request methods  other than GET, POST, HEAD.
	# There is no need for it. 
	if ($ENV{'REQUEST_METHOD'} !~ /^(HEAD|GET|POST)$/) {
		return fail("Status: 405 Method Not Allowed\nAllow: GET, POST, HEAD\n","405 Method Not Allowed","The proxy does not support the $ENV{'REQUEST_METHOD'} method.");
	}
	
	# The proxy may be presented with either a complete URL (when it's a HTTP
	# proxy) or just the path (when it's a HTTPS proxy).
	# In this case the  URL has to be reconstructed.
	if ($ENV{'REQUEST_URI'} =~ /^[a-z]*(:[0-9]*)?:\/\/.*$/){
		$URL=$ENV{'REQUEST_URI'};
	}
	else{
		$URL=($ENV{'HTTPS'} eq 'on' ? 'https://' : 'http://').$ENV{'HTTP_HOST'}.$ENV{'REQUEST_URI'};
	}
	
	# The URL will now be validated.
	# Additionally it will be divided in parts which will be stored in variables:
	# $prot (protocol), $host, $port, $path, $query.
	if (($prot, $host, $port, $path, $query)=divideurl($URL)) {
		$URL =~ /^(.*)$/;
		$URL = $1;
	}
	else {
		return fail("Status: 400 Bad Request\n","400 Bad Request","Invalid URL: $URL.");
	}
	
	# If port not defined default value is used.
	if ($port eq ''){
		$port=($ENV{'HTTPS'} eq 'on' ? '443' : '80');
	}
	
	# The host can be a hostname or IP.
	# A request to a private IP number gives users access to the proxy's local
	# network. This should not be allowed.
	if ($host =~ /^[0-9]+\.[0-9]+\.[0-9]+\.[0-9]+$/) {
		if ($host =~ /^((0*10\..*)|(0*127\..*)|(0*172\.0*((1[6-9])|(2[0-9])|(3[0-1]))\..*)|(0*192\.0*168\..*))$/) {
			return fail("Status: 403 Forbidden\n","403 Forbidden","The proxy does not accept a private IP address $host as hostname.");
		}
	}
	
	# Of course, if there is a web server inside the local network and is accessed
	# by its hostname it can be accessible. But the server which runs the proxy
	# can have some hostnames defined that point to computers in local network
	# that are not available from outside. These should be blocked as well.
	if ($host =~ BLOCK_HOST) {
		return fail("Status: 403 Forbidden\n","403 Forbidden","The proxy does not accept $host as hostname.");
	}
	
	# The proxy will block any access with a port number that is used by the
	# proxy. Otherwise it would be possible to create an infinite loop in which
	# the request is proxied back to the proxy again. Of course, to create such a
	# loop not only the port number but also the host name is required. But is not
	# always easy (or possible) to predict if a hostname will point to the proxy
	# or not. Blocking port numbers is easier.
	# That's why the proxy should not be installed on the default port numbers, 80
	# or 443 because then it will not work!
	if ($port =~ BLOCK_PORT) {
		return fail("Status: 403 Forbidden\n","403 Forbidden","The proxy does not accept port number $port because of infinite loop prevention.");
	}
	
	foreach my $envk (keys %ENV) { 
		# The relevant http variables either start with HTTP_ or CONTENT_.
		my $headarg='';
		my $headval='';
		my $headname='';
		
		if ($envk =~ /^(HTTP_[A-Z0-9_]+)$/) {
			$headname=formatheader($1);
		}
		elsif ($envk =~ /^(CONTENT_[A-Z0-9_]+)$/) {
			$headname=formatheader($1);
		}
		else {
			next;
		}
		# test against illegal characters
		if ($ENV{$envk} =~ /^([\x20-\x7e]*)$/) {
			$headval=$1;
		}
		else {
			next;
		}
		
		# Some header fields should not be forwarded.
		if(lc($headname) =~ REQUEST_HEADER_BLOCK) {
			next;
		}
		
		$headarg=$headname.(($headval eq '')?';':': '.$headval);
		
		push @curl_arg, '-H';
		push @curl_arg, $headarg;
		push @reqhead, $headarg;
	}
	
	# curl uses its default values of User-agent and Accept header fields unless
	# they are defined in the command line.
	# If the original request doesn't contain these fields this will undefine them:
	unless (exists $ENV{'HTTP_USER_AGENT'}) {
		push @curl_arg, '-H';
		push @curl_arg, 'User-Agent:';
	}
	unless (exists $ENV{'HTTP_ACCEPT'}) {
		push @curl_arg, '-H';
		push @curl_arg, 'ACCEPT:';
	}
	
	if ($ENV{'REQUEST_METHOD'} eq 'HEAD'){
		push @curl_arg, '-I';
	}
	
	if ($ENV{'REQUEST_METHOD'} eq 'POST'){
		$postdata=1;     # if there is data to pe posted
		push @curl_arg, '--data-binary';
		push @curl_arg, '@-';
	}
	
	# The path for archiving the HTTP request is made, the required directories
	# are created.
	# If this fails the request will not be archived but will still be proxied.
	$archpath = urldiv2path($prot, $host, $port, $path, $query, 1);
	if ($archpath) {
		$archive = 1;
		if ($postdata) {
			# If this is a POST request the URL is not enough to identify it. To the
			# path will be added a number. Also the request header and post data will
			# be archived and not only the response header and response data.
			for (my $i = 0; ;++$i) {
				$respcontpath=$archpath.'@v-'.$i;
				$respheadpath=$archpath.'@h-'.$i;
				$postheadpath=$archpath.'@g-'.$i;
				$postcontpath=$archpath.'@u-'.$i;
				
				if ((! -e $respcontpath) and (! -e $respheadpath) and (! -e $postheadpath) and (! -e $postcontpath)) {
					last;
				}
			}
			
			# The request header is written.
			if (open ($postheadfile, ">", $postheadpath)) {
				foreach my $line (@reqhead) {
					print $postheadfile "$line\n";
				}
				print $postheadfile "\n";
				close ($postheadfile);
			}
		
		}
		else {
			$respcontpath=$archpath.'@v';
			$respheadpath=$archpath.'@h';
		}
	}
	else {
		$archive = 0;
	}
	
	push @curl_arg, $URL;
	
	# The pipes for communication with curl are created.
	pipe ($curloutrd, $curloutwr) or return fail("Status: 500 Internal Server Error\n","500 Internal Server Error","Failed to create stdout pipe.");
	pipe ($curlerrrd, $curlerrwr) or return fail("Status: 500 Internal Server Error\n","500 Internal Server Error","Failed to create stderr pipe.");
	if ($postdata){
		pipe ($curlinrd, $curlinwr) or return fail("Status: 500 Internal Server Error\n","500 Internal Server Error","Failed to create stdin pipe.");
	}
	
	# curl, the program that will send the forwarded request is launched here
	$curlpid = fork();
	unless (defined $curlpid) {
		return fail("Status: 500 Internal Server Error\n","500 Internal Server Error","fork() failed.");
	}
	unless ($curlpid) {
		close ($curloutrd);
		close ($curlerrrd);
		
		# The input and outputs of curl are redirected to pipes.
		open(STDERR, ">&=" . fileno($curlerrwr)) or die "Failed to open stderr pipe.\n";
		open(STDOUT, ">&=" . fileno($curloutwr)) or die "Failed to open stdout pipe.\n";
		
		if ($postdata) {
			close ($curlinwr);
			open(STDIN, "<&=" . fileno($curlinrd)) or die "Failed to open stdin pipe.\n";
		}
		
		exec @curl_arg;
		exit 1;
	}
	
	close ($curloutwr);
	close ($curlerrwr);
	
	if($postdata) {
		# If this  is a POST request the post data is available on the standard
		# input. It will be piped to curl and written to a file (if successfully
		# opened).
		# Originally this part would be in a separate thread but:
		# 1. It didn't work. Not sure why.
		# 2. It was not necaessary.
		
		# $curlpidin = fork();
		# unless (defined $curlpidin) {
			# $forceexit=1;
		# }
		# unless ($curlpidin) {

			close($curlinrd);
			binmode($curlinwr) or die "Failed to switch stdin pipe to binary mode.\n";
			binmode(STDIN) or die "Failed to switch STDIN to binary mode.\n";
			
			$postcontopen = open($postcontfile, ">", $postcontpath);
			if ($postcontopen){
				unless (binmode($postcontfile)) {
					close($postcontfile);
					$postcontopen=0;
				}
			}
			
			while (read (STDIN,$buffer2,1024)) {
				unless (print ($curlinwr $buffer2)) {
					#$forceexit = 1;
				}
				if ($postcontopen) {
					print $postcontfile $buffer2;
				}
			}
			close ($curlinwr);
			if ($postcontopen) {
				close($postcontfile);
			}

			# exit 0;
		# }
		# close ($curinwr);
		# close ($curlinrd);
	}
	
	if (defined (my $line = <$curloutrd>)) {
		$line =~ s/\r?\n$//;
		# The first line is the status. 
		if ($line =~ /^HTTP\/[0-9]+\.[0-9]+ ([0-9]+ .*)$/) {
			my $status =$1;
			@resphead=('Status: '.$status);
			
			# If the status is not 2XX and this URL was already archived before it
			# should not be overwritten.
			# Otherwise it can happen that, for example, after refreshing the content
			# previously downloaded will be overwritten with a "304 Not Modified" and
			# lost.
			
			if(($status !~ /^2[0-9][0-9]/) and (-e $respcontpath)){
				$archive=0;
			}
			
			# now read the header lines
			while (defined($line = <$curloutrd>)) {
				$line =~ s/[\r\n]$//g;
				my $headname='';
				my $headval='';
				
				# empty line (double \n) meane the end of the header.
				if($line eq ''){
					last;
				}
				
				# If line starts with space or tab, it's a continuation of the previous
				# line.
				if($line =~ /^[ \t](.*)$/){
					# Continuation of a skipped line should be skipped too.
					if ($lastskipped) {
						next;
					}
					else {
						#$lastline = pop @resphead;
						#push @resphead, $lastline.$1;
						push @resphead, $line;
						}
					}
				
				if ($line =~ /^([^:]*):(.*)$/) {
					$headname=lc($1);
					$headval=$2;
				}
				else {
					$lastskipped=1;
					next;
				}
				
				# If one of these header fields is present it can not be assumed that
				# the received value of Content-length is also correct for the forwarded
				# content.
				if($headname eq 'transfer-encoding') {
					$safelength = 0;
				}
				if($headname eq 'content-encoding') {
					if($headval !~ /^[\r\n \t]*identity[\r\n \t]*$/) {
						$safelength = 0;
					}
				}
				if($headname eq 'content-length') {
					$definedlength=1;
					$headval =~ s/^[\r\n \t]*//;
					$headval =~ s/[\r\n \t]*$//;
					$contentlength = int($headval);
				}
				
				# Only part of the content is transmitted in this request
				if(($status =~ /^206/)&&($headname eq 'content-range')) {
					if (lc($headval) =~ /^[\r\n \t]*bytes ([0-9]+)\-[0-9]\/([0-9]*)/) {
						$rangestart = int($1);
						$rangelength = int($2);
					}
				}
				
				# Some header fields should not be forwarded.
				if($headname =~ RESPONSE_HEADER_BLOCK) {
					$lastskipped =1;
					next;
				}
				$lastskipped=0;
				push @resphead, $line;
			}
			
			# Only add the Content-length header if it's safe to do so.
			if ($definedlength and ($safelength or ($contentlength==0))) {
				push @resphead, 'Content-length: '.(($rangelength ne '')?$rangelength:$contentlength);
			}
			
			# After forwarding the response header it's too late to send any error
			# messages.
			$safeerror=0;
			
			# Forward the header and safe it to file if possible and allowed.
			if ($archive) {
				if($rangestart ne '') {
					$respheadopen = open($respheadfile, ">>", $respheadpath);
				}
				else{
					$respheadopen = open($respheadfile, ">", $respheadpath);
				}
			}
			foreach $line (@resphead) {
				print $line."\n";
				if($respheadopen) {
					print $respheadfile $line."\n";
				}
			}
			print "\n";
			if($respheadopen) {
				print $respheadfile "\n";
				close $respheadfile;
			}
			
			# Now forward the actual content and safe it to file if possible and
			# allowed.
			if ( ! binmode ($curloutrd)) {
				$forceexit=1;
			}
			elsif ( ! binmode (STDOUT) ) {
				$forceexit=1;
			}
			else {
				# Create the file only if there was content received. No 0-byte files.
				my $firstline=1;
				while (read ($curloutrd,$buffer,1024)) {
					unless (print (STDOUT $buffer)) {
						$forceexit=1;
					}
					if ($firstline) {
						if ($archive) {
							if($rangestart ne '') {
								if(-f $respcontpath) {
									$respcontopen = open($respcontfile, "+<", $respcontpath);
								}
								else {
									$respcontopen = open($respcontfile, ">", $respcontpath);
								}
							}
							else {
								$respcontopen = open($respcontfile, ">", $respcontpath);
							}
						}
						if ($respcontopen){
							unless (binmode($respcontfile)) {
								close($respcontfile);
								$respcontopen=0;
							}
							else {
								if($rangestart ne '') {
									seek($respcontfile,0,$rangestart);
								}
							}
						}
					}
					$firstline=0;
					if ($respcontopen) {
						print $respcontfile $buffer;
					}
				}
				if($respcontopen) {
					if($rangelength ne '') {
						truncate($respcontfile,$rangelength);
					}
					close ($respcontfile);
				}
			}
		}
		else {
			$errormsg="Server respose is not HTTP: $line";
		}
	}
	
	# Ok, done. Now wait for curl to exit. (Should have already happened).
	
	waitpid($curlpid,0);
	if ($? != 0) {
		# Generate error message if possible.
		if ($safeerror) {
			$errormsg='';
				while (defined(my $line = <$curlerrrd>)) {
					$line =~ s/\r?\n/<br>/g;
					$errormsg=$errormsg.$line;
			}
		}
		else {
			$forceexit=1;
		}
	}
	close($curloutrd);
	close($curlerrrd);
	
	# if ($postdata) {
		# waitpid($curlpidin,0);
		# if ($? != 0) {
			# $forceexit=1;
		# }
	# }
	
	# Send error message if it;s safe to do so.
	if($safeerror){
		return fail("Status: 500 Internal Server Error\n","500 Internal Server Error",$errormsg);
	}
	elsif ($forceexit) {
		exit 1;
	}
	
}

# Function to unlock the proxy.
sub unlock {
	my %CGI;
	my $passpath;
	my $passfile;
	my $logfile;
	my $pass;
	my $accessfile;
	my $accesspath;
	
	if ($ENV{'REMOTE_ADDR'} =~ /^([0-9]+\.[0-9]+\.[0-9]+\.[0-9]+)$/) {
		$IP=$1;
	}
	
	# If the request method is GET the CGI parameters must be taken from the
	# query string (part of URL).
	if ($ENV{'REQUEST_METHOD'} eq 'GET') {
		%CGI=getcgi($ENV{'QUERY_STRING'});
	}
	# If request method is POST the CGI parameters must be taken from standard
	# input.
	elsif ($ENV{'REQUEST_METHOD'} eq 'POST'){
		#Check content-type. Multipart is not supported.
		if ($ENV{'CONTENT_TYPE'} eq 'application/x-www-form-urlencoded'){
			%CGI=getcgi( <STDIN> );
		}
		else{
			return unlockpage("Unsupported Content-type: $ENV{'CONTENT_TYPE'}.","Status: 415 Unsupported Media Type\n");
		}
	}
	else{
		return unlockpage("Unsupported method: $ENV{'REQUEST_METHOD'}.","Status: 405 Method Not Allowed\nAllow: GET, POST\n");
	}
	
	# If there was an IP in the form it must be used instead.
	if ($CGI{'ip'} =~ /^([0-9]+\.[0-9]+\.[0-9]+\.[0-9]+)$/) {
		$IP=$1;
	}
	
	if ($IP eq '') {
		return unlockpage("Invalid IP.","Status: 403 Forbidden\n");
	}
	
	if ($CGI{'username'} eq ''){
		return unlockpage();
	}
	
	if ($CGI{'password'} eq ''){
		return unlockpage('Password missing.',"Status: 403 Forbidden\n");
	}
	
	if ($CGI{'username'} !~ /^[A-Za-z0-9_]+$/){
		return unlockpage('Wrong username or password.',"Status: 403 Forbidden\n");
	}
	
	$passpath = PASS_PATH.$CGI{'username'};
	# Open file to read user's password.
	open($passfile, "<", $passpath) or return unlockpage('Wrong username or password.',"Status: 403 Forbidden\n");
	$pass = <$passfile>;
	close($passfile);
	$pass =~ s/[\r\n]//g;
	# The password is stored in URL-encoded form.
	$pass = urldecode($pass);
	
	if ($pass ne $CGI{'password'}){
		return unlockpage('Wrong username or password.',"Status: 403 Forbidden\n");
	}
	
	# All unlocking access must be logged: time, IP, user. The server owner must
	# be able to know who did what with the proxy (in  case of legal problems).
	open ($logfile, ">>", UNLOCK_LOG) or return unlockpage("Couldn't log your action.","Status: 500 Internal Server Error\n");
	print $logfile strftime('%d.%m.%Y %H:%M:%S', gmtime($accesstime))."  $IP  $CGI{'username'}\n";
	close($logfile);
	
	# Ok, unlocked. Create access file.
	$accesspath=ACCESS_PATH.$IP;
	open ($accessfile,">",$accesspath) or return unlockpage("$accesspath","Status: 403 Forbidden\n");
	print $accessfile "$accesstime\n$accesstime\n";
	close ($accessfile);
	
	return unlockedpage();
	
}

# Function for showing the proxy unlock form page.
# arguments: 1 - additional message (optional), 2 - additional header fields
# (optional)
sub unlockpage {
	(my $message, my $header)=@_;
	if($header ne ''){
		print $header;
	}
	print "Content-type: text/html\n\n";
	print '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "">';
	print '<html lang="en"><head>';
	print '<title>Unlock the proxy</title>';
	print '<meta http-equiv="Content-type" content="text/html; charset=UTF-8">';
	print '</head><body>';
	print '<h1>Unlock the proxy</h1>';
	if($message ne ''){
		print '<p>'.entityencode($message).'</p>';
	}
	print '<form method="post" action="'.UNLOCK_PROXY_URL_S.'">';
	print '<b>Username: </b><input type="text" name="username"><br>';
	print '<b>Password: </b><input type="password" name="password"><br>';
	print '<b>IP: </b><input type="text" name="ip" value="'.$IP.'"><br>';
	print '<input type="submit" value="unlock">';
	print '</form><br>';
	print 'WARNING: The proxy will be unlocked for some time, for you and every ';
	print 'computer in your local network which has the same public IP. Any ';
	print 'action from your IP will be assumed to be your action.<br>';
	print 'Everything you download or upload (including your passwords) will be ';
	print "saved on the proxy's filesystem for some time and may be available ";
	print ' for bots.<br>By submitting this form you agree to this.<br><br>';
	print 'The proxy will be locked again: <ul>';
	print '<li>'.TIMEOUT_UNLOCK.' minutes after unlocking</li>';
	print '<li>after '.TIMEOUT_INACT.' minutes of inactivity</li>';
	print '<li>when the proxy removes its temporary files</li>';
	print "</ul></body></html>\n";
}

# Function for showing error messages.
# Arguments: 1 - header fields, 2 - page title, 3 - error message text.
sub fail {
	(my $header, my $title, my $message)=@_;
	if($header ne ''){
		print $header;
	}
	print "Content-type: text/html\n\n";
	print '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "">';
	print '<html lang="en"><head>';
	if($title ne ''){
		print '<title>'.entityencode($title).'</title>';
	}
	print '<meta http-equiv="Content-type" content="text/html; charset=UTF-8">';
	print '</head><body>';
	if($title ne ''){
		print '<h1>'.entityencode($title).'</h1>';
	}
	if($message ne ''){
		print '<p>'.entityencode($message).'</p>';
	}
	print "</body></html>\n";
}

# Function to show the message after unlocking the proxy.
sub unlockedpage {
	print "Content-type: text/html\n\n";
	print '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "">';
	print '<html lang="en"><head>';
	print '<title>Unlocked</title>';
	print '<meta http-equiv="Content-type" content="text/html; charset=UTF-8">';
	print '</head><body>';
	print '<h1>Unlocked</h1>';
	print "The proxy is now unlocked for IP $IP.<br><br>";
	print 'The proxy will be locked again: <ul>';
	print '<li>'.TIMEOUT_UNLOCK.' minutes after unlocking</li>';
	print '<li>after '.TIMEOUT_INACT.' minutes of inactivity</li>';
	print '<li>when the proxy removes its temporary files</li>';
	print "</ul></body></html>\n";
}

# Function to show the message when proxy not unlocked.
sub noaccess {
	print "Status: 403 Forbidden\n;";
	print "Content-type: text/html\n\n";
	print '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "">';
	print '<html lang="en"><head>';
	print '<title>Proxy not unlocked</title>';
	print '<meta http-equiv="Content-type" content="text/html; charset=UTF-8">';
	print '</head><body>';
	print '<h1>Proxy not unlocked</h1>';
	print 'The proxy is not unlocked for your IP.<br>';
	print 'Follow this link to unlock the proxy:<br>';
	print '<a href="'.UNLOCK_PROXY_URL.'">'.UNLOCK_PROXY_URL.'</a>';
	print "</body></html>\n";
}
