keiya · September 23, 2012 08:38
diff --git a/httprefork.pl b/httprefork.pl
 # [email protected]

 use strict;
 use warnings;

 #use Fcntl;
 use Socket;
 use FileHandle;
 use IPC::Open2;
 use File::Basename qw/dirname/;

 $| = 1;

 $SIG{CHLD} = 'IGNORE';
 our %CONFIG;
 &loadconfig();
 &listen();

 sub loadconfig {
 	%CONFIG = (
 		'docroot'=>'.',
 		'enable-cgi'=>0,
 		'server'=>'HydrogenServidor typeG/P 1.0',
 	);
 	my %shortstyle = (
 		'f'=>'docroot',
 		'c'=>'enable-cgi',
 	);
 	my $lastopt = undef;;
 	foreach my $arg (@ARGV) {
 		if ($arg =~ /^--(.+)/) {
 			$lastopt = $1;
 			$CONFIG{$lastopt} = 1 if $lastopt;
 		}
 		elsif ($arg =~ /^-(.+)/) {
 			$lastopt = $shortstyle{$1};
 			$CONFIG{$lastopt} = 1 if $lastopt;
 		}
 		else {
 			$CONFIG{$lastopt} = $arg;
 			$lastopt = undef;
 		}
 	}
 	$CONFIG{$lastopt} = 1 if $lastopt;
 }

 sub error_print {
 	my $status = shift;
 	return '<!DOCTYPE html><html><head><meta charset=\'utf-8\' /><title>'.
 		$status.'</title></head><body><h1>'.
 		$status.'</h1><hr /><address>'.
 		$CONFIG{'server'}.'</address></body></html>';
 }

 sub listen {
 	# 1. 受付用ソケットの作成
 	my $sock_receive;
 	socket( $sock_receive, PF_INET, SOCK_STREAM, getprotobyname( 'tcp' ) )
 	    or die "Cannot create socket: $!";
 	
 	# 2. 受付用ソケット情報の作成
 	my $local_port = 8080;
 	
 	my $pack_addr = sockaddr_in( $local_port, INADDR_ANY );
 	
 	# 3. 受付用ソケットと受付用ソケット情報を結びつける
 	bind( $sock_receive, $pack_addr )
 	    or die "Cannot bind: $!";
 	
 	# 4. 接続を受け付ける準備をする。
 	listen( $sock_receive, SOMAXCONN )
 	    or die "Cannot listen: $!";
 	
 	print '['.$$.']Started parent process on port '.$local_port."\n";
 	

 	# 4 childs to listen
 	for(my $procs = 0; $procs < 2; ++$procs) {
 		my $pid = fork();
 		warn "Failed to fork()\n" unless defined $pid;
 		if ($pid) {
 			print "[$$]is parent\n";
 		}
 		else {
 			close(STDIN);
 			#close(STDOUT);
 			#print "[$$]Started child process\n";
 			while(my $paddr = accept(my $sock_client, $sock_receive)) {
 				my $async;
 				# ホスト名、IPアドレス、クライアントのポート番号を取得
 				my ($client_port, $client_iaddr) = unpack_sockaddr_in($paddr);
 				my $client_ip = inet_ntoa($client_iaddr);
 				print "[$$]accepted from $client_ip\n";

 				my $old_handle = select $sock_client;
 				$| = 1;
 				select $old_handle;

 				my $req = '';
 				my $body_offset;
 				while (1) {
 					if (defined sysread($sock_client,my $receive_buf,1)) {
 						$req .= $receive_buf;
 						$body_offset = index($req,"\r\n\r\n");
 						last if $body_offset > 4;
 					}
 					else {
 						warn "[$$]Connection terminated.";
 						last;
 					}
 				}
 #				print $req;

 				my %request;
 				my @lines = split("\r\n",$req);
 				foreach my $line (@lines) {
 					chomp $line;
 					if ($line ne '') {
 						$line =~ m/^(.+?):\s?(.+?)$/;
 						my $k = $1 ? lc $1 : next;
 						$request{$k} = $2;
 					}
 				}
 				my @mfv = split(' ',$lines[0]);
 				my $status;
 				my %response;
 				my $contents = undef;

 				$response{'Server'} = $CONFIG{'server'};

 				$mfv[1] =~ tr/+/ /;
 				$mfv[1] =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack('H2', $1)/eg;
 				$mfv[1] =~ m/^(.+?)(?:\?(.+?))?$/;
 				my $requri = $1;
 				my $query = $2;
 				my $file = $CONFIG{'docroot'} . $requri ;
 				my $dir = dirname $file;
 				my $body = '';
 				if (-f $file) {
 					if ($CONFIG{'enable-cgi'} and -x $file) {
 						chdir $dir;
 						open my $fh,'<',$file;
 						my $line = readline $fh;
 						close $fh;
 						$line =~ /^#!(.+)$/;
 						my $runner = $1;
 						while (my ($k,$v) = each (%ENV)) {
 							if ($k ne ('PATH')) {
 								delete $ENV{$k};
 							}
 						}
 						$ENV{'PWD'} = $dir;
 						$ENV{'QUERY_STRING'} = $query;
 						$ENV{'REQUEST_METHOD'} = $mfv[0];
 						$ENV{'HTTP_COOKIE'} = $request{'cookie'};
 						$ENV{'SERVER_NAME'} = $request{'host'};
 						$ENV{'HTTP_HOST'} = $request{'host'};
 						#$ENV{'SCRIPT_FILENAME'} = $file;
 						$ENV{'REQUEST_URI'} = $requri;

 						my $pid = undef;
 						if ($mfv[0] eq 'POST') {
 							$ENV{'CONTENT_LENGTH'} = $request{'content-length'};
 							$pid = open2(*Reader,*Writer,$runner.' '.$file) or warn "[$$]faild to open2 $runner $file";
 							if ($pid and sysread($sock_client,my $receive_buf,$request{'content-length'})) {
 								syswrite(Writer,$receive_buf)
 									or warn "[$$]CGI syswrite failed";
 							}
 							close(Writer);
 						}
 						elsif ($mfv[0] eq 'GET') {
 							$pid = open(Reader,$runner.' '.$file.'|') or warn "[$$]failed to open $runner $file";
 						}
 						if ($pid) {
 							my $i = 0;
 							my $status_found = 0;
 							$async = 1;
 							my $cgi_out;
 							while (1) {
 								my $res = sysread(Reader,my $out,1);
 								last unless $res;
 								if ($i <= 7) {
 									$cgi_out .= $out;
 									if ($i == 7) {
 										my $status_offset = index($cgi_out,"Status:");
 										if ($status_offset > -1) {
 											syswrite($sock_client,"HTTP/1.0 ")
 												or warn "[$$]syswrite failed";
 										}
 										else {
 										
 										}
 									}
 								}
 								else {
 									syswrite($sock_client,$out)
 										or warn "[$$]syswrite failed";
 								}
 								++$i;
 							}
 							close(Reader);
 							close($sock_client);
 							if (not defined $status or $status eq '') {
 								$status = 'HTTP/1.0 200 OK';
 							}
 						}
 						else {
 							$status = 'HTTP/1.0 500 Internal Server Error';
 							$body = &error_print($status);
 						}
 					}
 					else {
 						$response{'Content-Length'} = -s $file;
 						if ($mfv[0] eq 'GET') {
 							open my $fh,'<',$file;
 							while (my $line = <$fh>) {
 								$body .= $line;
 							}
 							close $fh;
 							$status = 'HTTP/1.0 200 OK';
 						}
 						elsif ($mfv[0] eq 'HEAD') {
 						}
 						else {
 							$status = 'HTTP/1.0 501 Not Implemented';
 							$body = &error_print($status);
 						}
 					}
 				}
 				elsif (-d $file) {
 					$response{'Content-Type'} = 'text/html';
 					opendir(my $dh,$file);
 					$body .= '<!DOCTYPE html><html><head><meta charset="utf-8" /></head><body><ul>';
 					if ($mfv[1] =~ qw|(.*)/$|) {$mfv[1] = $1;}
 					my $base = '' ? $mfv[1] eq '/' : $mfv[1].'/';
 					foreach(readdir($dh)) {
 						next if $_ eq '.';
 						$body .= "<li><a href=\"$base$_\">$_</a></li>\n";
 					}
 					$body .= '</ul><hr /><address>'.$response{'Server'}.'</address></body></html>';
 					closedir($dh);
 					$status = 'HTTP/1.0 200 OK';
 				}
 				else {
 					$status = 'HTTP/1.0 404 Not Found';
 					$body = &error_print($status);
 				}

 				unless ($async) {
 					my $head = '';
 					while (my ($k,$v) = each(%response)) {
 						$head .= $k.': '.$v."\r\n";
 					}
 					if (not defined $contents) {$contents = $head . "\r\n" . $body;}

 					syswrite($sock_client,$status."\r\n".$contents)
 						or warn "[$$]syswrite failed";
 					close($sock_client);
 				}
 			}
 			exit;
 		}
 	}
 }

 __END__
	# [email protected]

	use strict;
	use warnings;

	#use Fcntl;
	use Socket;
	use FileHandle;
	use IPC::Open2;
	use File::Basename qw/dirname/;

	$\| = 1;

	$SIG{CHLD} = 'IGNORE';
	our %CONFIG;
	&loadconfig();
	&listen();

	sub loadconfig {
	%CONFIG = (
	'docroot'=>'.',
	'enable-cgi'=>0,
	'server'=>'HydrogenServidor typeG/P 1.0',
	);
	my %shortstyle = (
	'f'=>'docroot',
	'c'=>'enable-cgi',
	);
	my $lastopt = undef;;
	foreach my $arg (@ARGV) {
	if ($arg =~ /^--(.+)/) {
	$lastopt = $1;
	$CONFIG{$lastopt} = 1 if $lastopt;
	}
	elsif ($arg =~ /^-(.+)/) {
	$lastopt = $shortstyle{$1};
	$CONFIG{$lastopt} = 1 if $lastopt;
	}
	else {
	$CONFIG{$lastopt} = $arg;
	$lastopt = undef;
	}
	}
	$CONFIG{$lastopt} = 1 if $lastopt;
	}

	sub error_print {
	my $status = shift;
	return '<!DOCTYPE html><html><head><meta charset=\'utf-8\' /><title>'.
	$status.'</title></head><body><h1>'.
	$status.'</h1><hr /><address>'.
	$CONFIG{'server'}.'</address></body></html>';
	}

	sub listen {
	# 1. 受付用ソケットの作成
	my $sock_receive;
	socket( $sock_receive, PF_INET, SOCK_STREAM, getprotobyname( 'tcp' ) )
	or die "Cannot create socket: $!";

	# 2. 受付用ソケット情報の作成
	my $local_port = 8080;

	my $pack_addr = sockaddr_in( $local_port, INADDR_ANY );

	# 3. 受付用ソケットと受付用ソケット情報を結びつける
	bind( $sock_receive, $pack_addr )
	or die "Cannot bind: $!";

	# 4. 接続を受け付ける準備をする。
	listen( $sock_receive, SOMAXCONN )
	or die "Cannot listen: $!";

	print '['.$$.']Started parent process on port '.$local_port."\n";


	# 4 childs to listen
	for(my $procs = 0; $procs < 2; ++$procs) {
	my $pid = fork();
	warn "Failed to fork()\n" unless defined $pid;
	if ($pid) {
	print "[$$]is parent\n";
	}
	else {
	close(STDIN);
	#close(STDOUT);
	#print "[$$]Started child process\n";
	while(my $paddr = accept(my $sock_client, $sock_receive)) {
	my $async;
	# ホスト名、IPアドレス、クライアントのポート番号を取得
	my ($client_port, $client_iaddr) = unpack_sockaddr_in($paddr);
	my $client_ip = inet_ntoa($client_iaddr);
	print "[$$]accepted from $client_ip\n";

	my $old_handle = select $sock_client;
	$\| = 1;
	select $old_handle;

	my $req = '';
	my $body_offset;
	while (1) {
	if (defined sysread($sock_client,my $receive_buf,1)) {
	$req .= $receive_buf;
	$body_offset = index($req,"\r\n\r\n");
	last if $body_offset > 4;
	}
	else {
	warn "[$$]Connection terminated.";
	last;
	}
	}
	# print $req;

	my %request;
	my @lines = split("\r\n",$req);
	foreach my $line (@lines) {
	chomp $line;
	if ($line ne '') {
	$line =~ m/^(.+?):\s?(.+?)$/;
	my $k = $1 ? lc $1 : next;
	$request{$k} = $2;
	}
	}
	my @mfv = split(' ',$lines[0]);
	my $status;
	my %response;
	my $contents = undef;

	$response{'Server'} = $CONFIG{'server'};

	$mfv[1] =~ tr/+/ /;
	$mfv[1] =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack('H2', $1)/eg;
	$mfv[1] =~ m/^(.+?)(?:\?(.+?))?$/;
	my $requri = $1;
	my $query = $2;
	my $file = $CONFIG{'docroot'} . $requri ;
	my $dir = dirname $file;
	my $body = '';
	if (-f $file) {
	if ($CONFIG{'enable-cgi'} and -x $file) {
	chdir $dir;
	open my $fh,'<',$file;
	my $line = readline $fh;
	close $fh;
	$line =~ /^#!(.+)$/;
	my $runner = $1;
	while (my ($k,$v) = each (%ENV)) {
	if ($k ne ('PATH')) {
	delete $ENV{$k};
	}
	}
	$ENV{'PWD'} = $dir;
	$ENV{'QUERY_STRING'} = $query;
	$ENV{'REQUEST_METHOD'} = $mfv[0];
	$ENV{'HTTP_COOKIE'} = $request{'cookie'};
	$ENV{'SERVER_NAME'} = $request{'host'};
	$ENV{'HTTP_HOST'} = $request{'host'};
	#$ENV{'SCRIPT_FILENAME'} = $file;
	$ENV{'REQUEST_URI'} = $requri;

	my $pid = undef;
	if ($mfv[0] eq 'POST') {
	$ENV{'CONTENT_LENGTH'} = $request{'content-length'};
	$pid = open2(Reader,Writer,$runner.' '.$file) or warn "[$$]faild to open2 $runner $file";
	if ($pid and sysread($sock_client,my $receive_buf,$request{'content-length'})) {
	syswrite(Writer,$receive_buf)
	or warn "[$$]CGI syswrite failed";
	}
	close(Writer);
	}
	elsif ($mfv[0] eq 'GET') {
	$pid = open(Reader,$runner.' '.$file.'\|') or warn "[$$]failed to open $runner $file";
	}
	if ($pid) {
	my $i = 0;
	my $status_found = 0;
	$async = 1;
	my $cgi_out;
	while (1) {
	my $res = sysread(Reader,my $out,1);
	last unless $res;
	if ($i <= 7) {
	$cgi_out .= $out;
	if ($i == 7) {
	my $status_offset = index($cgi_out,"Status:");
	if ($status_offset > -1) {
	syswrite($sock_client,"HTTP/1.0 ")
	or warn "[$$]syswrite failed";
	}
	else {

	}
	}
	}
	else {
	syswrite($sock_client,$out)
	or warn "[$$]syswrite failed";
	}
	++$i;
	}
	close(Reader);
	close($sock_client);
	if (not defined $status or $status eq '') {
	$status = 'HTTP/1.0 200 OK';
	}
	}
	else {
	$status = 'HTTP/1.0 500 Internal Server Error';
	$body = &error_print($status);
	}
	}
	else {
	$response{'Content-Length'} = -s $file;
	if ($mfv[0] eq 'GET') {
	open my $fh,'<',$file;
	while (my $line = <$fh>) {
	$body .= $line;
	}
	close $fh;
	$status = 'HTTP/1.0 200 OK';
	}
	elsif ($mfv[0] eq 'HEAD') {
	}
	else {
	$status = 'HTTP/1.0 501 Not Implemented';
	$body = &error_print($status);
	}
	}
	}
	elsif (-d $file) {
	$response{'Content-Type'} = 'text/html';
	opendir(my $dh,$file);
	$body .= '<!DOCTYPE html><html><head><meta charset="utf-8" /></head><body><ul>';
	if ($mfv[1] =~ qw\|(.*)/$\|) {$mfv[1] = $1;}
	my $base = '' ? $mfv[1] eq '/' : $mfv[1].'/';
	foreach(readdir($dh)) {
	next if $_ eq '.';
	$body .= "<li><a href=\"$base$_\">$_</a></li>\n";
	}
	$body .= '</ul><hr /><address>'.$response{'Server'}.'</address></body></html>';
	closedir($dh);
	$status = 'HTTP/1.0 200 OK';
	}
	else {
	$status = 'HTTP/1.0 404 Not Found';
	$body = &error_print($status);
	}

	unless ($async) {
	my $head = '';
	while (my ($k,$v) = each(%response)) {
	$head .= $k.': '.$v."\r\n";
	}
	if (not defined $contents) {$contents = $head . "\r\n" . $body;}

	syswrite($sock_client,$status."\r\n".$contents)
	or warn "[$$]syswrite failed";
	close($sock_client);
	}
	}
	exit;
	}
	}
	}

	__END__
No results found