#!/usr/bin/perl
#
# IIS 5.0 simulator, written by rain forest puppy / rfp(at)wiretrip.net
#
# Yes, my perl-foo can be quite gross at times; I suggest perltidy. :)
# This is actually a full web server, but it's designed to act just like
# IIS 5.0--including all non-RFC-compliant nuances and response quirks.


use FindBin qw{$Bin};
use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK);

chdir($Bin);

# buffering problems, ignore for now
if (0)
{
    select(STDIN); $|++;
    select(STDOUT); $|++;
    select(STDERR); $|++;
    
    my $flags;

    $flags = 0;
    $flags = fcntl(STDIN, F_GETFL, $flags);
    $flags = fcntl(STDIN, F_SETFL, $flags | O_NONBLOCK);

    $flags = 0;
    $flags = fcntl(STDOUT, F_GETFL, $flags);
    $flags = fcntl(STDOUT, F_SETFL, $flags | O_NONBLOCK);

    $flags = 0;
    $flags = fcntl(STDERR, F_GETFL, $flags);
    $flags = fcntl(STDERR, F_SETFL, $flags | O_NONBLOCK);
}


my (%C,%V,%CODES,%MIME);

#### CONFIGURATION VALUES ###########################################

$C{'docroot'}   =   './wwwroot/';		# where HTML docs are
$C{'errorpages'}=   './iis_data/';	# where HTML error pages are
$C{'asp_cookie'}=   'GGQGQQXC';		# ASP cookie system ID

$C{'dnVersion'} =   'Microsoft .NET Framework Version:1.0.3705.209; ASP.NET Version:1.0.3705.0';
$C{'fakeroot'} = 'C:\Inetpub\WWWRoot';
$C{'dnerrorpages'} = './iis_data/'; # templates for the .NET error messages

#### END CONFIG VALUES ##############################################

my %HANDLERS; # handlers to various file extensions
my %VIRTUAL;  # virtual mappings; take priority over handlers

init();

do { # here's the main logic loop

	parse_request();
	handle_request() if($V{'handle'});
	send_response();

} while( $V{'state'}==1 );

exit;


######################################################################
# support functions

sub init { # initialize things
	$V{'state'}=1;

	$CODES{'200'}="OK";
	$CODES{'404'}="Object Not Found";
	$CODES{'400'}="Bad Request";
	$CODES{'401'}="Access Denied";
	$CODES{'403'}="Access Forbidden";
	$CODES{'500'}="Server Error";

	$MIME{'gif'}='image/gif';
	$MIME{'txt'}='text/plain';
	$MIME{'htm'}='text/html';
    
	$HANDLERS{'asp'}=\&handler_asp;
	$HANDLERS{'asa'}=\&handler_asa;
    $HANDLERS{'cer'}=\&handler_asp;
    $HANDLERS{'cdx'}=\&handler_asp;
    
	$HANDLERS{'stm'}=\&handler_shtml;
	$HANDLERS{'shtm'}=\&handler_shtml;
	$HANDLERS{'shtml'}=\&handler_shtml;

	$HANDLERS{'htw'}=\&handler_htw;
    
    $HANDLERS{'idq'}=\&handler_idq;
    $HANDLERS{'ida'}=\&handler_idq;
    
    $HANDLERS{'htr'}=\&handler_htr;
    
    $HANDLERS{'pl'}=\&handler_pl;
    $HANDLERS{'plx'}=\&handler_pl;

    $HANDLERS{"asax"} = \&handler_dnErr;
    $HANDLERS{"ascx"} = \&handler_dnErr;
    
    $HANDLERS{"ashx"} = \&handler_ashx;
    $HANDLERS{"asmx"} = \&handler_asmx;
    $HANDLERS{"aspx"} = \&handler_aspx;   
    
    # XXX - Need to finish bleh.axd and trace.axd handlers
    #$HANDLERS{"axd"} = \&handler_axd;
    
    # XXX - Need to finish the .vsdisco handler
    #$HANDLERS{"vsdisco"} = \&handler_vdisco;
    
    $HANDLERS{"rem"} = \&handler_soap;
    $HANDLERS{"soap"} = \&handler_soap;
    
    $HANDLERS{"config"} = \&handler_dnErr;
    $HANDLERS{"cs"} = \&handler_dnErr;
    $HANDLERS{"csproj"} = \&handler_dnErr;
    $HANDLERS{"vb"} = \&handler_dnErr;
    $HANDLERS{"vbproj"} = \&handler_dnErr;
    $HANDLERS{"webinfo"} = \&handler_dnErr;
    $HANDLERS{"licx"} = \&handler_dnErr;
    $HANDLERS{"resx"} = \&handler_dnErr;
    $HANDLERS{"resources"} = \&handler_dnErr;

	$VIRTUAL{'/iisadmin/'}=\&handler_iisadmin;
	$VIRTUAL{'/msadc/'}=\&handler_msadc;
	$VIRTUAL{'/_private/'}=\&handler_vti;
	$VIRTUAL{'/_vti_cnf/'}=\&handler_vti;
	$VIRTUAL{'/_vti_log/'}=\&handler_vti;
	$VIRTUAL{'/_vti_pvt/'}=\&handler_vti;
	$VIRTUAL{'/_vti_txt/'}=\&handler_vti;
	$VIRTUAL{'/printers/'}=\&handler_auth;
}

sub make_date { # returns date in IIS date format
	my @days=qw(Sun Mon Tue Wed Thu Fri Sat);
	my @mons=qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
	my @tp=localtime(shift);
	$tp[6]=$days[$tp[6]];	$tp[4]=$mons[$tp[4]];	$tp[5]=1900+$tp[5];
	my $t=sprintf("%02i:%02i:%02i",$tp[2],$tp[1],$tp[0]);
	return "$tp[6], $tp[3] $tp[4] $tp[5] $t GMT";
}


sub make_banner { # construct the response headers in outgoing queue
	my $code=$V{'current_code'};
	$V{'outqueue'}.="HTTP/1.1 $code $CODES{$code}\r\n";
	$V{'outqueue'}.="Server: Microsoft-IIS/5.0\r\n";

	foreach $h (@{$V{hout_order}}){
		$V{hout}->{$h}=make_date(time()) if($h eq 'Date');
		if($h eq 'Connection'){
			if(!defined $V{hout}->{Connection}){
				next if($V{connection} eq 'close' && $V{'version'} eq '1.0');
				next if($V{connection} eq 'keep-alive' && $V{'version'} ne '1.0');
			}
			next if(defined $V{hout}->{Connection} &&
				lc($V{hout}->{Connection}) eq lc($V{connection}));
			$V{hout}->{$h}=$V{connection} if(!defined
				$V{hout}->{Connection});
		}
		$V{'outqueue'}.="$h: $V{hout}->{$h}\r\n";
	}
}

sub parse_request { # parse user's request
	my $run=1;
	my $state=$V{'state'};
	%V=();
	$V{'state'}=$state;
	$V{'handle'}=1;
	$V{'raw'}='';
	do {
	  my $l=<STDIN>;
	  $V{'raw'}.=$l;
	  $l=~s/[\r]{0,1}\n$//;
	  if($l eq ''){	$run=0; 
	  } else {
	    if(!defined $V{'request'}){
		$V{'request'}=$l;
		if($l!~m# HTTP/[0-9.]{3}$#){
			$run=0;
			$V{'version'}='0.9';
			$V{'state'}=0;
		}
	    } else {
		my $l2=index($l,':'); # faster than regex
		my ($a,$b)=(substr($l,0,$l2),substr($l,$l2+1));
		$b=~s/^[ \t]+//;
		$V{'headers'}->{$a}=$b;
	    }
	  }
	} while($run);

	my $error=0;
	if(!defined $V{'version'}){
	    if($V{request}!~m#([a-z0-9]+)[ ]+([^ ]+)[ ]+HTTP/([0-9.]{3})#i){
		$error++;
	    } else {
		$V{'method'}=$1;
		$V{'uri'}=$2;
		$V{'version'}=$3;
	    }
	} else { # 0.9 handling
	    if($V{request}!~m#([a-z0-9]+)[ ]+([^ ]+)$#){
		$error++;
	    } else {
		$V{'method'}=$1;
		$V{'uri'}=$2;
		$V{'state'}=0;
		$V{'connection'}='Keep-Alive';
	    }
	}

	$V{'skip_body'}++ if($V{'method'} eq 'HEAD');
	$V{'current_code'}=200;

	my %headers = %{$V{headers}};
	my ($k,$v); # we need to lowercase all headers/values
	while( ($k,$v)=each %headers){
		delete $headers{$k};
		$headers{lc($k)}=lc($v);
	}

	# now all the funky connection logic
	$V{connection}='close';
	if($V{'version'} eq '1.0' ||$V{'version'} eq '0.9'){
		$headers{connection}='close' 
			if(!defined $headers{'connection'});
		$V{'state'}=0; # close by default
		if($headers{connection}=~/keep-alive/){
			$V{'state'}=1;
			$V{'connection'}='keep-alive';
		}
	} else {
		$headers{connection}='keep-alive' 
			if(!defined $headers{'connection'});
		$V{connection}='keep-alive';
		$V{'state'}=1; # close by default
		if($headers{connection}=~/close/){
			$V{'state'}=0;
			$V{'connection'}='close';
		}
	}

	$error=0;
	$error=1 if($V{'version'} eq '1.1' && !defined $headers{'host'});

	if($error){
		$V{'handle'}=0;
		$V{'current_code'}=400;
		$V{'state'}=0;
		$V{'connection'}='close';

		if(-e "$C{errorpages}/400.htm"){
			my @s=stat("$C{errorpages}/400.htm");
			ph('Content-Length',$s[7]);
			ph('Content-Type','text/html');
			$V{'outfile'}="$C{errorpages}/400.htm";
		}
	}


	# OPTIONS has special '*' URL
	if($V{method} eq 'OPTIONS' && $V{uri} eq '*'){
		$V{'handle'}=0;
		handler_options();
		return;
	}

	if($V{uri}=~m#^http://#){
		$error++ if($V{uri}!~m#^http://[^/]+/#i);
	} else { $error++ if(index($V{uri},'/') != 0); }

	if($error){
		$V{'handle'}=0;
		$V{'state'}=0;
		internal_error(400,'The parameter is incorrect.');
		return;
	}

	if($V{'method'} eq 'TRACE'){
		$V{'current_code'}=200;
		$V{'handle'}=0;
		ph('Date');
		ph('Connection');
		ph('Content-Type','message/http');
		ph('Content-Length',length($V{raw}));
		$V{'outdata'}=$V{'raw'};
		return;
	}

}

sub handler_options {
	my $allow=shift||'OPTIONS, TRACE, GET, HEAD, DELETE, PUT, POST, COPY, MOVE, MKCOL, PROPFIND, PROPPATCH, LOCK, UNLOCK, SEARCH';
	$V{'current_code'}=200;
	ph('Date');
	ph('Connection');
	ph('Content-Length','0');
	ph('Accept-Ranges','bytes');
	ph('DASL','<DAV:sql>');
	ph('DAV','1, 2');
	ph('Public','OPTIONS, TRACE, GET, HEAD, DELETE, PUT, POST, COPY, MOVE, MKCOL, PROPFIND, PROPPATCH, LOCK, UNLOCK, SEARCH');
	ph('Allow',$allow);
	ph('Cache-Control','private');
}

sub send_response {
	make_banner();
	print STDOUT $V{'outqueue'},"\r\n";
	
	if(!defined $V{'skip_body'}){
		print STDOUT $V{'outdata'} if(defined $V{'outdata'});
		if(defined $V{'outfile'}){
			open(IN,"<$V{'outfile'}");
			print STDOUT <IN>;
			close(IN);
		}
	}
}

sub handle_request { # this dispatches the request to the correct handler
	my ($w,$file)=(index($V{uri},'?'),$V{uri});
	if($w>=0){	$file=substr($V{uri},0,$w); }

	if(index($file,'%')>=0){
		# NOTE: this needs to be redone...
		$file=~s/%u([a-fA-F0-9]{2})([a-fA-F0-9]{2})/pack("CC",hex($1),hex($2))/eg;
		$file=~s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
	}

	$file=utils_unidecode_uri($file);
	my $normal=utils_normalize_uri(lc($file),1);

	# safety check to make sure *this* script isn't hackable
	exit if($normal=~m#\.\.#);

	$V{'uri_decoded'}=$file;
	$V{'uri_normalized'}=$normal;

	if($normal=~m#\.([a-z0-9]+)$#i){
		$V{'ext'}=$1; }

	my $isdir=0;
	if(-d "$C{docroot}/$normal"){
		$isdir=1;
		$normal.='/' if(substr($normal,-1,1) ne '/'); }

	map { return &{$VIRTUAL{$_}} if($normal=~m#^$_#) } keys %VIRTUAL;

	if(defined $V{'ext'} && defined $HANDLERS{$V{'ext'}}){
		return &{$HANDLERS{$V{'ext'}}};}

	if(!defined $V{'ext'} || $isdir) {
		return &handler_dir;}

	&handler_generic; # leftovers go here
}


sub methods { # quick little function to compare methods
	map { return 1 if($V{method} eq $_) } @_;
	return 0;
}

sub handler_vti {

	# execute error
	if($V{'uri_normalized'}=~m#\.as[ap]$#){
	    if(-e "$C{errorpages}/403-1.htm"){
		ph('Date');
		ph('Connection','close') if($V{version} ne '1.0');
		output_file("$C{errorpages}/403-1.htm");
		ph('Content-Type','text/html');
	    }		
  	    return;
	}

	# read error
	if(-e "$C{errorpages}/403-2.htm"){
		ph('Date');
		ph('Connection','close') if($V{version} ne '1.0');
		output_file("$C{errorpages}/403-2.htm");
		ph('Content-Type','text/html');
	}
}


sub handler_dir { # called when uri is a directory
	return &handler_generic if(!-d "$C{docroot}/$V{'uri_normalized'}");

	# check for default pages
	if(-e "$C{docroot}/$V{'uri_normalized'}/default.asp"){
		$V{'uri_normalized'}.='/default.asp';
		return &handler_asp; }
	if(-e "$C{docroot}/$V{'uri_normalized'}/default.htm"){
		$V{'uri_normalized'}.='/default.htm';
		return &handler_generic; }
	if(-e "$C{docroot}/$V{'uri_normalized'}/iisstart.asp"){
		$V{'uri_normalized'}.='/iisstart.asp';
		return &handler_asp; }

	# there are two responses to forbidden dir listings...

	my $type=0;
	my @special=qw(/scripts/ /images/ /iishelp/ /msadc/ /_vti_bin/);
	map { $type=1 if($V{'uri_normalized'}=~m#^$_#) } @special;

	$V{'current_code'}=403;
	ph('Date');
	ph('Connection','close') if($V{'version'} ne '1.0');
	if($type){
		ph('Content-Type','text/html');
		ph('Content-Length','172');
		$V{'outdata'}="<html><head><title>Directory Listing Denied</title></head>\r\n<body><h1>Directory Listing Denied</h1>This Virtual Directory does not allow contents to be listed.</body></html>";
		return;
	} else {
		if(-e "$C{errorpages}/403-2.htm"){
			output_file("$C{errorpages}/403-2.htm");
			ph('Content-Type','text/html');
		}
	}
}

sub handler_iisadmin {
	$V{'current_code'}=403;
	ph('Date');
	if(-e "$C{errorpages}/403-iisadmin.htm"){
		ph('Connection','close') if($V{version} ne '1.0');
		output_file("$C{errorpages}/403-iisadmin.htm");
		ph('Content-Type','text/html');
	}
}

sub handler_msadc { # this handles all content in /msadc/ directory

	return &handler_asp if($V{'uri_normalized'}=~/\.asp$/);
	return &handler_generic if($V{'uri_normalized'}!~/\.dll$/);

	if(!methods('GET','POST','HEAD')){
		generic_not_found(0);
		return;
	}

	if($V{'uri_normalized'} eq '/msadc/msadcs.dll'){
		ph('Date');
		$V{'outdata'} ="Content-Type: application/x-varg\r\n";
		$V{'outdata'}.="Content-Length: 6\r\n";
		$V{'outdata'}.="\r\n\x0a\x00\x57\x00\x07\x80";
		return; 
	}

	my $type=0;
	my @type1=qw(msadce msadco msadds msdaprst msdarem msdfmap);
	my @type2=qw(msadcer msadcf msadcfr msadcor msaddstr msdaprsr msdaremr);

	map { $type=1 if($V{'uri_normalized'}=~/$_\.dll$/) } @type1;
	map { $type=2 if($V{'uri_normalized'}=~/$_\.dll$/) } @type2;

	$V{'current_code'}=500;
	if($type==1){
		ph('Date');
		ph('Content-Type','text/html');
		ph('Content-Length','44');
		$V{'outdata'}="<html>-2147467259 (0x80004005)</body></html>";
		return;
	}

	if($type==2){
		internal_error(500,'The specified procedure could not be found.');
		return;
	}

	internal_error(500,'The specified module could not be found.');
}


sub internal_error {
	my ($code,$phrase)=@_;
	$V{'current_code'}=$code;
	ph('Date');
	ph('Connection','close') if($V{'version'} ne '1.0');
	ph('Content-Type','text/html');
	$V{'outdata'}="<html><head><title>Error</title></head><body>$phrase </body></html>";
	ph('Content-Length',length($V{'outdata'}));
}

sub handler_shtml { # SHTML page handler
	if(methods('GET','POST')){
		$V{'current_code'}=404;
		ph('Date');
		ph('Connection','close') if($V{'version'} ne '1.0');
		ph('Content-Type','text/html');
		$V{'state'}=0;
		$V{'outdata'}='<body><h1>404 Object Not Found</h1></body>';
		return;
	}

	$V{'current_code'}=403;
	ph('Date');
	ph('Connection','close') if($V{'version'} ne '1.0');
	ph('Content-Type','text/html');
	ph('Content-Length','44');
	$V{'state'}=0;
	$V{'outdata'}="<body><h2>HTTP/$V{'version'} 403 Forbidden</h2></body>";
	return;
}


sub handler_asa { # ASA page handler
	if($V{'uri_normalized'} ne '/global.asa'){
		generic_not_found(0);
		return;
	}

	if(!methods('GET','POST','HEAD')){
		generic_not_found(0);
		return;
	}

	$V{'current_code'}=500;
	$V{'skip_body'}=0;
	ph('Date');
	ph('Connection','close') if($V{'version'} ne '1.0');

	if(-e "$C{errorpages}/500-15.htm"){
		ph('Content-Type','text/html');
		output_file("$C{errorpages}/500-15.htm");
	}
}

sub handler_asp { # ASP page handler
	if(!methods('GET','POST','HEAD')){
		$V{'current_code'}=403;
		$V{'state'}=0;
		ph('Date');
		ph('Connection','close');
		ph('Content-Type','text/html');
		ph('Content-Length','44');
		$V{'outdata'}="<body><h2>HTTP/$V{version} 403 Forbidden</h2></body>";
		return;
	}

	if(-e "$C{docroot}/$V{uri_normalized}"){
		ph('Date');

		if($V{'version'} eq '1.0'){
			if($V{connection} eq 'close'){
				ph('Connection','Keep-Alive');
			} else {
				ph('Connection',"keep-alive\r\nConnection: Keep-Alive");
			}
		} else {
			ph('Connection');
		}
		output_file("$C{docroot}/$V{uri_normalized}");
		ph('Content-Type', 'text/html');
		my $cookie="ASPSESSIONID$C{'asp_cookie'}=";
		my $t=sprintf("%08x",time());
		$t=~tr/0-9a-f/A-P/;
		$cookie.=reverse(split(//,$t)).utils_randstr(16,'ABCDEFGHIJKLMNOP');
		$cookie.='; path=/';
		ph('Set-Cookie', $cookie);
		ph('Cache-control','private');

	} else {
		delete $V{'skip_body'}; # ASP ignores HEAD on errors
		generic_not_found(0);
	}
}

sub handler_auth {
	my $basic_realm=shift;
	$V{'current_code'}=401;
	ph('Date');
	if(defined $basic_realm){
		ph('WWW-Authenticate',"Negotiate\r\nWWW-Authenticate: NTLM");
	} else {
		ph('WWW-Authenticate',"Negotiate\r\nWWW-Authenticate: NTLM");
	}	
	output_file("$C{errorpages}/401-2.htm");
	ph('Content-Type','text/html');
}

##
# Begin .NET, ISAPI, Perl Handlers (hdm - 04.19.02)
##


# XXX - Need to parse the QUERY_STRING and emulate functionality of webhits.dll
# XXX - Webhits.dll doesn't allow HTTP/1.1, Keep-Alives, Cookies
sub handler_htw { # HTW page handler
	if(!methods('GET','POST','HEAD')){
		$V{'current_code'}=403;
		$V{'state'}=0;
		ph('Date');
		ph('Connection','close');
		ph('Content-Type','text/html');
		ph('Content-Length','44');
		$V{'outdata'}="<body><h2>HTTP/$V{version} 403 Forbidden</h2></body>";
		return;
	}

    my $RawResponse =  "HTTP/1.0 200 OK\r\nContent-Type: text/html\r\n\r\n<HTML>\r\n<BODY>\r\n";
    if(methods('HEAD'))
    {
        $RawResponse .= "<p><h3><center>REQUEST_METHOD is neither GET nor POST<BR></center></h3><BR></BODY>\r\n</HTML>";
    } else {
        $RawResponse .= "<p><h3><center>The format of QUERY_STRING is invalid.<BR></center></h3><BR></BODY>\r\n</HTML>";
    }
    
    # Send the $RawResponse and exit!
    print STDOUT $RawResponse; 
    exit(0);    
}

sub handler_idq { # IDQ page handler
	if(!methods('GET','POST','HEAD')){
		$V{'current_code'}=403;
		$V{'state'}=0;
		ph('Date');
		ph('Connection','close');
		ph('Content-Type','text/html');
		ph('Content-Length','44');
		$V{'outdata'}="<body><h2>HTTP/$V{version} 403 Forbidden</h2></body>";
		return;
	}

    
    $V{'outdata'}="<HTML>The IDQ file ".$V{uri_normalized}." could not be found.";
    
	$V{'current_code'}=200;
	$V{'state'}=0;
	ph('Date');
	ph('Connection','close');
	ph('Content-Type','text/html');
	ph('Content-Length',length($V{'outdata'}));
	
    return;
}

# XXX - Need to implement TRACE!
sub handler_htr { # HTR page handler
	if(!methods('GET','HEAD', 'POST','TRACE')){
		$V{'current_code'}=403;
		$V{'state'}=0;
		ph('Date');
		ph('Connection','close');
		ph('Content-Type','text/html');
		ph('Content-Length','44');
		$V{'outdata'}="<body><h2>HTTP/$V{version} 403 Forbidden</h2></body>";
		return;
	}
    
    if(methods('HEAD'))
    {
        # HEAD returns a wierd C-L and no data
		$V{'current_code'}=403;
		$V{'state'}=0;
		ph('Date');
		ph('Connection','close');
		ph('Content-Type','text/html');
		ph('Content-Length','3338');
		$V{'outdata'}="";
		return;    
    }
    
 	$V{'current_code'}=404;
	$V{'state'}=0;
	ph('Date');
	ph('Content-Type','text/html');
	$V{'outdata'}="<html>Error: The requested file could not be found. </html>";
	return;    
}

# .PL/.PLX returns 403 in non-exec and 404 in exec directories
# For now, I am going to cheat and just return 404's
# XXX - Return different messages for exec and non-exec directories
sub handler_pl { # PL page handler
	if(!methods('GET','HEAD','POST')){
		$V{'current_code'}=403;
		$V{'state'}=0;
		ph('Date');
		ph('Connection','close');
		ph('Content-Type','text/html');
		ph('Content-Length','44');
		$V{'outdata'}="<body><h2>HTTP/$V{version} 403 Forbidden</h2></body>";
		return;
	}

	$V{'current_code'}=404;
	$V{'state'}=0;
	ph('Date');
	ph('Connection','close');
	ph('Content-Type','text/html');

    # XXX - Need to return the friendly 404 page still...
	$V{'outdata'}="";
	return;    
}

# XXX - This page returns the physical path to the directory
# XXX   which changes if the files is requested from a virtual
# XXX   directory. For now, I am going to cheat and just append
# XXX   the uri_normalized to $C{'fakeroot'}

sub handler_ashx { # ASHX page handler
	if(!methods('GET','HEAD','POST','DEBUG')){
		$V{'current_code'}=403;
		$V{'state'}=0;
		ph('Date');
		ph('Connection','close');
		ph('Content-Type','text/html');
		ph('Content-Length','44');
		$V{'outdata'}="<body><h2>HTTP/$V{version} 403 Forbidden</h2></body>";
		return;
	}
    
    if(methods('DEBUG'))
    {
        $V{'outdata'}= $V{uri_normalized} . " application debugging not enabled.";
		$V{'current_code'}=403;
		$V{'state'}=0;
		ph('Date');
        ph('Cache-Control', 'private');
		ph('Connection','close');
		ph('Content-Type','text/html; charset=utf-8');
		ph('Content-Length',length($V{'outdata'}));
		
		return;    
    }
    
    # Bleh. This type of request sucks. There are too many places
    # where we need to regurgiate either the directory, the name,
    # or the physical path of where this file is requested.
    
    # XXX - Determine directory and replace "<H1>Server Error in '/' Application."
    # XXX   with the directory name. If an existing page is requested, then we
    # XXX   get a completely different error message. Fun.
    
    
    my $PhysicalPath = $C{'fakeroot'} . $V{'uri_normalized'};
    $PhysicalPath =~ s/\//\\/g;
    $PhysicalPath =~ s/\\\\/\\/g;
    
    
    local *TPL;
    open (TPL, "<" . $C{'dnerrorpages'} . "/ashx.tpl")
        || die "Ack! Could not find the .NET error template.";
    
    while (<TPL>) { $V{'outdata'} .= $_; }
    close (TPL);
    
    # fill in the templates
    $V{'outdata'} =~ s/::DIRECTORY::/\//g;
    $V{'outdata'} =~ s/::URL::/$V{'uri_normalized'}/g;
    $V{'outdata'} =~ s/::PHYSICALPATH::/$PhysicalPath/g;
    $V{'outdata'} =~ s/::dnVersion::/$C{'dnVersion'}/g;
    
    
 	$V{'current_code'}=404;
	$V{'state'}=0;
	ph('Date');
    ph('Cache-Control', 'private');
	ph('Content-Type','text/html; charset=utf-8');
    ph('Content-Length', length($V{'outdata'}));
	return;    
}

# XXX - This page returns the physical path to the directory
# XXX   which changes if the files is requested from a virtual
# XXX   directory. For now, I am going to cheat and just append
# XXX   the uri_normalized to $C{'fakeroot'}

sub handler_aspx { # ASPX page handler
	if(!methods('GET','HEAD','POST','DEBUG')){
		$V{'current_code'}=403;
		$V{'state'}=0;
		ph('Date');
		ph('Connection','close');
		ph('Content-Type','text/html');
		ph('Content-Length','44');
		$V{'outdata'}="<body><h2>HTTP/$V{version} 403 Forbidden</h2></body>";
		return;
	}
    
    if(methods('DEBUG'))
    {
        $V{'outdata'}= $V{uri_normalized} . " application debugging not enabled.";
		$V{'current_code'}=403;
		$V{'state'}=0;
		ph('Date');
        ph('Cache-Control', 'private');
		ph('Connection','close');
		ph('Content-Type','text/html; charset=utf-8');
		ph('Content-Length',length($V{'outdata'}));
		
		return;    
    }
    
    # Bleh. This type of request sucks. There are too many places
    # where we need to regurgiate either the directory, the name,
    # or the physical path of where this file is requested.
    
    # XXX - Determine directory and replace "<H1>Server Error in '/' Application."
    # XXX   with the directory name. If an existing page is requested, then we
    # XXX   get a completely different error message. Fun.
    
    
    my $PhysicalPath = $C{'fakeroot'} . $V{'uri_normalized'};
    $PhysicalPath =~ s/\//\\/g;
    $PhysicalPath =~ s/\\\\/\\/g;
    
    
    local *TPL;
    open (TPL, "<" . $C{'dnerrorpages'} . "/aspx.tpl")
        || die "Ack! Could not find the .NET error template.";
    
    while (<TPL>) { $V{'outdata'} .= $_; }
    close (TPL);
    
    # fill in the templates
    $V{'outdata'} =~ s/::DIRECTORY::/\//g;
    $V{'outdata'} =~ s/::URL::/$V{'uri_normalized'}/g;
    $V{'outdata'} =~ s/::PHYSICALPATH::/$PhysicalPath/g;
    $V{'outdata'} =~ s/::dnVersion::/$C{'dnVersion'}/g;
    
    
 	$V{'current_code'}=404;
	$V{'state'}=0;
	ph('Date');
    ph('Cache-Control', 'private');
	ph('Content-Type','text/html; charset=utf-8');
    ph('Content-Length', length($V{'outdata'}));
	return;    
}


# XXX - This page returns the physical path to the directory
# XXX   which changes if the files is requested from a virtual
# XXX   directory. For now, I am going to cheat and just append
# XXX   the uri_normalized to $C{'fakeroot'}

sub handler_asmx { # ASMX page handler
	if(!methods('GET','HEAD','POST','DEBUG')){
		$V{'current_code'}=403;
		$V{'state'}=0;
		ph('Date');
		ph('Connection','close');
		ph('Content-Type','text/html');
		ph('Content-Length','44');
		$V{'outdata'}="<body><h2>HTTP/$V{version} 403 Forbidden</h2></body>";
		return;
	}
    
    if(methods('DEBUG'))
    {
        $V{'outdata'}= $V{uri_normalized} . " application debugging not enabled.";
		$V{'current_code'}=403;
		$V{'state'}=0;
		ph('Date');
        ph('Cache-Control', 'private');
		ph('Connection','close');
		ph('Content-Type','text/html; charset=utf-8');
		ph('Content-Length',length($V{'outdata'}));
		
		return;    
    }
    
    # Bleh. This type of request sucks. There are too many places
    # where we need to regurgiate either the directory, the name,
    # or the physical path of where this file is requested.
    
    # XXX - Determine directory and replace "<H1>Server Error in '/' Application."
    # XXX   with the directory name. If an existing page is requested, then we
    # XXX   get a completely different error message. Fun.
    
    
    my $PhysicalPath = $C{'fakeroot'} . $V{'uri_normalized'};
    $PhysicalPath =~ s/\//\\/g;
    $PhysicalPath =~ s/\\\\/\\/g;
    
    
    local *TPL;
    open (TPL, "<" . $C{'dnerrorpages'} . "/asmx.tpl")
        || die "Ack! Could not find the .NET error template.";
    
    while (<TPL>) { $V{'outdata'} .= $_; }
    close (TPL);
    
    # fill in the templates
    $V{'outdata'} =~ s/::DIRECTORY::/\//g;
    $V{'outdata'} =~ s/::URL::/$V{'uri_normalized'}/g;
    $V{'outdata'} =~ s/::PHYSICALPATH::/$PhysicalPath/g;
    $V{'outdata'} =~ s/::dnVersion::/$C{'dnVersion'}/g;
    
    
 	$V{'current_code'}=404;
	$V{'state'}=0;
	ph('Date');
    ph('Cache-Control', 'private');
	ph('Content-Type','text/html; charset=utf-8');
    ph('Content-Length', length($V{'outdata'}));
	return;    
}

# XXX - Need to get the correct directory for ::DIRECTORY:: still...
sub handler_dnErr { # generic .NET page handler
	if(!methods('GET','HEAD','POST','DEBUG')){
		$V{'current_code'}=403;
		$V{'state'}=0;
		ph('Date');
		ph('Connection','close');
		ph('Content-Type','text/html');
		ph('Content-Length','44');
		$V{'outdata'}="<body><h2>HTTP/$V{version} 403 Forbidden</h2></body>";
		return;
	}
    
    if(methods('DEBUG'))
    {
        $V{'outdata'}= $V{uri_normalized} . " application debugging not enabled.";
		$V{'current_code'}=403;
		$V{'state'}=0;
		ph('Date');
        ph('Cache-Control', 'private');
		ph('Connection','close');
		ph('Content-Type','text/html; charset=utf-8');
		ph('Content-Length',length($V{'outdata'}));
		
		return;    
    }

    local *TPL;
    open (TPL, "<" . $C{'dnerrorpages'} . "/dnErr.tpl")
        || die "Ack! Could not find the .NET error template.";
    
    while (<TPL>) { $V{'outdata'} .= $_; }
    close (TPL);
    
    # fill in the templates
    $V{'outdata'} =~ s/::DIRECTORY::/\//g;
    $V{'outdata'} =~ s/::URL::/$V{'uri_normalized'}/g;
    $V{'outdata'} =~ s/::dnVersion::/$C{'dnVersion'}/g;
    
 	$V{'current_code'}=404;
	$V{'state'}=0;
	ph('Date');
    ph('Cache-Control', 'private');
	ph('Content-Type','text/html; charset=utf-8');
    ph('Content-Length', length($V{'outdata'}));
	return;    
}

sub handler_soap { # .soap and .rem handler
	if(!methods('GET','HEAD','POST','DEBUG')){
		$V{'current_code'}=403;
		$V{'state'}=0;
		ph('Date');
		ph('Connection','close');
		ph('Content-Type','text/html');
		ph('Content-Length','44');
		$V{'outdata'}="<body><h2>HTTP/$V{version} 403 Forbidden</h2></body>";
		return;
	}
    
    if(methods('DEBUG'))
    {
        $V{'outdata'}= $V{uri_normalized} . " application debugging not enabled.";
		$V{'current_code'}=403;
		$V{'state'}=0;
		ph('Date');
        ph('Cache-Control', 'private');
		ph('Connection','close');
		ph('Content-Type','text/html; charset=utf-8');
		ph('Content-Length',length($V{'outdata'}));
		
		return;    
    }
    
    local *TPL;
    
    # XXX - GET/HEAD _always_ return HTTP/1.1 here.
    if(methods('GET','HEAD'))
    {
        open (TPL, "<" . $C{'dnerrorpages'} . "/SoapGET.tpl")
            || die "Ack! Could not find the .NET error template.";

        while (<TPL>) { $V{'outdata'} .= $_; }
        close (TPL);

 	    $V{'current_code'}=500;
	    $V{'state'}=0;
	    ph('Date');
        ph('Connection', 'close');
        ph('Cache-Control', 'private');
	    ph('Content-Type','text/plain');
        ph('Content-Length', length($V{'outdata'}));
	    return;
    }
    
    # XXX - This gets nasty, were just going to pretend that
    # XXX   no SoapAction: header was sent with this request
    # XXX   because otherwise this would get huge quick.
    
    # XXX - The template file has hard-coded .NET versions in it ;(
    
    # XXX - Just like GET/HEAD, this always returns HTTP/1.1
    
    # XXX - An extra Server header is added after Date: "Server: MS .NET Remoting, MS .NET CLR 1.0.3705.209"

    open (TPL, "<" . $C{'dnerrorpages'} . "/SoapPOST.tpl")
        || die "Ack! Could not find the .NET error template.";

    while (<TPL>) { $V{'outdata'} .= $_; }
    close (TPL);

    $V{'current_code'}=500;
    $V{'state'}=0;
    ph('Date');
    ph('Connection', 'close');
    ph('Cache-Control', 'private');

    # Yes, for the first time they use dbl quotes around charset value..
    ph('Content-Type','text/xml; charset="utf-8"');
    ph('Content-Length', length($V{'outdata'}));
    
    return;
}


##
# END .NET mods
##


sub output_file {
	my $file=shift;
	return if(!-e $file);
	$V{outfile}=$file;
	my @s=stat($file);
	ph('Content-Length',$s[7]);
}

sub handler_generic { # generic handler for static content
	if(-e "$C{docroot}/$V{uri_normalized}"){
		my @s=stat("$C{docroot}/$V{uri_normalized}");
		my $etag=sprintf("%x%x%x:%x0",$s[1],$s[9],$s[2],$s[12]);
		ph('Connection');
		ph('Date');
		ph('Content-Type',   $MIME{$V{'ext'}});
		ph('Accept-Ranges',  'bytes');
		ph('Last-Modified',  make_date($s[9]));
		ph('ETag',           $etag);
		ph('Content-Length', $s[7]);
		$V{'outfile'}="$C{docroot}/$V{uri_normalized}";
	} else {
		generic_not_found(1);
	}
}

sub generic_not_found {
	my $o=shift||0; # 0=Type/Len   1=Len/Type
	$V{'current_code'}='404';
	if(-e "$C{errorpages}/404b.htm"){
		my @s=stat("$C{errorpages}/404b.htm");
		ph('Date');
		ph('Connection');
		ph('Content-Length',$s[7]) if($o>0);
		ph('Content-Type', 'text/html');
		ph('Content-Length',$s[7]) if($o==0);
		$V{'outfile'}="$C{errorpages}/404b.htm";
	}
}


sub ph { # short for "push header"; sets up headers for send_response()
	my ($name,$value)=@_;
	$V{hout}->{$name}=$value if(defined $value);
	push( @{$V{'hout_order'}}, $name);
}

sub logger {

}


###################################################################
# Following functions pulled from libwhisker

sub utils_normalize_uri {
	my ($uri, $win)=@_;
	$uri=~tr#\\#/# if(defined $win && $win>0);
	$uri=~s#^(http|https|ftp)+://[^/]+##i;
	return '/' if($uri eq '');
	# fast path check
	return $uri if(index($uri,'/.')==-1);
	my @final=();
	my @dirs=split('/',$uri);
	foreach (@dirs){
		next if($_ eq '.');
		next if($_ eq '');
		if($_ eq '..'){
			pop(@final);
		} else {
			push(@final,$_);
	} }
	return '/'.join('/',@final);
}


sub utils_unidecode_uri {
	my $str = $_[0];
	return $str if($str!~tr/!-~//c); # fastpath
	my ($lead,$count,$idx);
	my $out='';
	my $len = length($str);
	my ($ptr,$no,$nu)=(0,0,0);

	while($ptr < $len){
		my $c=substr($str,$ptr,1);
		if( ord($c) >= 0xc0 && ord($c) <= 0xfd){
			$count=0;
			$c=ord($c)<<1;
			while( ($c & 0x80) == 0x80){
				$c<<=1;
				last if($count++ ==4);
			}
			$c = ($c & 0xff);
			for( $idx=1; $idx<$count; $idx++){
				my $o=ord(substr($str,$ptr+$idx,1));
				$no=1 if($o != 0x80);
				$nu=1 if($o <0x80 || $o >0xbf);
			}
			my $o=ord(substr($str,$ptr+$idx,1));
			$nu=1 if( $o < 0x80 || $o > 0xbf);
			if($nu){
				$out.=substr($str,$ptr++,1);
			} else {
				if($no){
					$out.="\xff"; # generic replacement char
				} else {
					my $prior=ord(substr($str,$ptr+$count-1,1))<<6;
					$out.= pack("C", (ord(substr($str,$ptr+$count,1) )&0x7f)+$prior);
				}
				$ptr += $count+1;
			}
			$no=$nu=0;
		} else {
			$out.=$c;
			$ptr++;
		}
	}
	return $out;
}

sub utils_randstr {
        my $str;
        my $drift=shift||((rand() * 10) % 10)+10;
	# 'a'..'z' doesn't seem to work on string assignment :(
	my $CHARS = shift || 'abcdefghijklmnopqrstuvwxyz' .
			'ABCDEFGHIJKLMNOPQRSTUVWXYZ' .
			'0123456789';
	my $L = length($CHARS);
        for(1..$drift){
	        $str .= substr($CHARS,((rand() * $L) % $L),1);
	}
        return $str;
}
