--- googlecode.com/svn/trunk/Meteor/Document.pm	2006/11/20 17:59:30	3
+++ googlecode.com/svn/trunk/Meteor/Document.pm	2007/12/20 21:24:24	32
@@ -46,6 +46,8 @@
 	my $relPath=shift;
 	my $client=shift;
 	
+	&::syslog('debug',"Meteor::Document: Request received for '%s'",$relPath);
+	
 	my $doc=$class->documentForPath($relPath);
 	
 	unless(defined($doc))
@@ -57,6 +59,8 @@
 	
 	$doc->serveTo($client);
 	
+	$::Statistics->{'documents_served'}++;
+	
 	$doc;
 }
 
@@ -64,27 +68,12 @@
 	my $self=shift;
 	my $client=shift;
 	my $status=shift;
+	my $length=shift;
+	my $contenttype=shift;
+	$length = 0 unless ($length);
+	$contenttype = "text/html" unless ($contenttype);
 	
-	my $header=$::CONF{'DocumentHeaderTemplate'};
-	
-	$header=~s/~([^~]+)~/
-		if(!defined($1) || $1 eq '')
-		{
-			'~';
-		}
-		elsif($1 eq 'server')
-		{
-			$::PGM;
-		}
-		elsif($1 eq 'status')
-		{
-			$status;
-		}
-		else
-		{
-			'';
-		}
-	/gex;
+	my $header="HTTP/1.1 ".$status."\r\nServer: ".$::PGM."\r\nContent-Type: ".$contenttype."; charset=utf-8\r\nPragma: no-cache\r\nCache-Control: no-cache, no-store, must-revalidate\r\nExpires: Thu, 1 Jan 1970 00:00:00 GMT\r\nContent-length: ".$length."\r\n\r\n";
 	
 	$client->write($header);
 }
@@ -133,27 +122,65 @@
 	$relPath=~s/^[\/]*//;
 	$relPath=~s/[\/]*$//;
 	
-	# split into path components
-	my @pathComponents=split(/[\/]+/,$relPath);
 	
-	# Check components
-	foreach (@pathComponents)
+	# NOTE: With the right strings the code below triggers a bug in
+	# perl (5.8.6 currently) that will result in messages like
+	#
+	# 	Attempt to free unreferenced scalar
+	#
+	# and an eventual crash.
+	#
+	# So it was replaced with the more naive code following this
+	# commented out code.
+	#
+	# # split into path components
+	# my @pathComponents=split(/[\/]+/,$relPath);
+	# 
+	# # Check components
+	# foreach (@pathComponents)
+	# {
+	# 	# Very strict: We only allow alphanumeric characters, dash and
+	# 	# underscore, followed by any number of extensions that also
+	# 	# only allow the above characters.
+	# 	unless(/^[a-z0-9\-\_][a-z0-9\-\_\.]*$/i)
+	# 	{
+	# 		&::syslog('debug',
+	# 			"Meteor::Document: Rejecting path '%s' due to invalid component '%s'",
+	# 			$relPath,$_
+	# 		);
+	# 		
+	# 		return undef;
+	# 	}
+	# }
+	#
+	#my $path=$::CONF{'SubscriberDocumentRoot'}.'/'.join('/',@pathComponents);
+	
+	#
+	# Check for all alphanumeric or dash, underscore, dot and slash
+	#
+	unless($relPath=~/^[a-z0-9\-\_\.\/]*$/i)
 	{
-		# Very strict: We only allow alphanumric characters, dash and
-		# underscore, followed by any number of extensions that also
-		# only allow the above characters.
-		unless(/^[a-z0-9\-\_][a-z0-9\-\_\.]*$/i)
-		{
-			&::syslog('debug',
-				"Meteor::Document: Rejecting path '%s' due to invalid component '%s'",
-				$relPath,$_
-			);
-			
-			return undef;
-		}
+		&::syslog('debug',
+			"Meteor::Document: Rejecting path '%s' due to invalid characters",
+			$relPath
+		);
+		
+		return undef;
+	}
+	#
+	# Don't allow '..'
+	#
+	if(index($relPath,'..')>=0)
+	{
+		&::syslog('debug',
+			"Meteor::Document: Rejecting path '%s' due to invalid sequence '..'",
+			$relPath
+		);
+		
+		return undef;
 	}
 	
-	my $path=$::CONF{'SubscriberDocumentRoot'}.'/'.join('/',@pathComponents);
+	my $path=$::CONF{'SubscriberDocumentRoot'}.'/'.$relPath;
 	
 	# If it is a directory, append DirectoryIndex config value
 	$path.='/'.$::CONF{'DirectoryIndex'} if(-d $path);
@@ -206,10 +233,15 @@
 sub serveTo {
 	my $self=shift;
 	my $client=shift;
+	my $ct = "text/html";
+	if ($self->{'path'} =~/\.(js)$/) {
+		$ct = "text/javascript";
+	}
 	
-	$self->emitHeaderToClient($client,'200 OK');
+	$self->emitHeaderToClient($client,'200 OK',$self->{'size'}, $ct);
 	
 	$client->write($self->{'document'});
+
 }
 
 sub path {
@@ -217,4 +249,4 @@
 }
 
 1;
-############################################################################EOF
\ No newline at end of file
+############################################################################EOF