keiya · September 20, 2012 15:42
diff --git a/httpd.pl b/httpd.pl
 # [email protected]

 # thanks to
 # main socket program http://d.hatena.ne.jp/perlcodesample/20100512/1276960096
 # fork program http://x68000.q-e-d.net/~68user/net/

 use strict;
 use warnings;

 use Fcntl;
 use Socket;
 use Data::Dumper;

 $| = 1;

 our %config;
 &loadconfig();
 &listen();

 sub loadconfig {
 	%config = (
 		'docroot'=>'.',
 		'verbose'=>0,
 	);
 	my %shortstyle = (
 		'f'=>'docroot',
 		'v'=>'verbose',
 	);
 	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 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";
 	
 	my $sock_client;
 	
 	# 5. 接続を受け付けて応答する。
 	while(1) {
 		my $paddr = accept($sock_client, $sock_receive)
 				or warn "[$$]Accept Error $!\n";
 		
 		# ホスト名、IPアドレス、クライアントのポート番号を取得
 		my ($client_port, $client_iaddr) = unpack_sockaddr_in($paddr);
 	#	my $client_hostname = gethostbyaddr($client_iaddr, AF_INET);
 		my $client_ip = inet_ntoa($client_iaddr);
 		
 		#print '['.$$.']Connection from: '.$client_ip.':'.$client_port."\n";
 		
 		# forkで子プロセスを生成
 		if (my $pid = fork()){
 			# こちらは親プロセス
 			# 親プロセスはソケットをクローズ
 			close($sock_client);
 			next;
 		} elsif (defined $pid) {
 			# こっちは子プロセス
 			#print '['.$$."]Started child process\n";
 		
 			# クライアントに対してバッファリングしない
 			my $old_handle = select $sock_client;
 			$| = 1;
 			select $old_handle;

 #			my $flags = 0;
 #			fcntl($sock_client, F_GETFL, $flags)
 #			    or die "Couldn't get flags for HANDLE : $!\n";
 #			$flags |= O_NONBLOCK;
 #			fcntl($sock_client, F_SETFL, $flags)
 #			    or die "Couldn't set flags for HANDLE: $!\n";
 			my $req;
 			while (1) {
 				if (read($sock_client,my $receive_buf,1)) {
 				
 					$req .= $receive_buf;
 					if ($receive_buf eq "\n") {
 						last;
 					}
 				}
 				else {
 					die "[$$]Connection terminated.";
 				}
 			}
 			print "\r";

 			my @mfv = split(' ',$req);
 			my $status;
 			my %response;

 			$response{'Server'} = 'HydrogenServidor 1.0';

 			$mfv[1] =~ tr/+/ /;
 			$mfv[1] =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack('H2', $1)/eg;
 			my $file = $config{'docroot'} . $mfv[1] ;
 			#print $file."\n";
 			my $body = '';
 			if (-f $file) {
 				$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';
 				}
 			}
 			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';
 			}

 			my $head = '';
 			while (my ($k,$v) = each(%response)) {
 				$head .= $k.': '.$v."\r\n";
 			}

 			send($sock_client,$status."\r\n".$head."\r\n".$body,0);
 			close($sock_client);
 			#print '['.$$."]: Disconnect, process exit.\n";
 			# ポートの監視は親プロセスが行っているので、
 			# クライアントとのやりとりが終了すれば exit
 			exit;
 		} else {
 			warn "Failed to fork()\n";
 		}
 	}
 }

 __END__
	# [email protected]

	# thanks to
	# main socket program http://d.hatena.ne.jp/perlcodesample/20100512/1276960096
	# fork program http://x68000.q-e-d.net/~68user/net/

	use strict;
	use warnings;

	use Fcntl;
	use Socket;
	use Data::Dumper;

	$\| = 1;

	our %config;
	&loadconfig();
	&listen();

	sub loadconfig {
	%config = (
	'docroot'=>'.',
	'verbose'=>0,
	);
	my %shortstyle = (
	'f'=>'docroot',
	'v'=>'verbose',
	);
	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 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";

	my $sock_client;

	# 5. 接続を受け付けて応答する。
	while(1) {
	my $paddr = accept($sock_client, $sock_receive)
	or warn "[$$]Accept Error $!\n";

	# ホスト名、IPアドレス、クライアントのポート番号を取得
	my ($client_port, $client_iaddr) = unpack_sockaddr_in($paddr);
	# my $client_hostname = gethostbyaddr($client_iaddr, AF_INET);
	my $client_ip = inet_ntoa($client_iaddr);

	#print '['.$$.']Connection from: '.$client_ip.':'.$client_port."\n";

	# forkで子プロセスを生成
	if (my $pid = fork()){
	# こちらは親プロセス
	# 親プロセスはソケットをクローズ
	close($sock_client);
	next;
	} elsif (defined $pid) {
	# こっちは子プロセス
	#print '['.$$."]Started child process\n";

	# クライアントに対してバッファリングしない
	my $old_handle = select $sock_client;
	$\| = 1;
	select $old_handle;

	# my $flags = 0;
	# fcntl($sock_client, F_GETFL, $flags)
	# or die "Couldn't get flags for HANDLE : $!\n";
	# $flags \|= O_NONBLOCK;
	# fcntl($sock_client, F_SETFL, $flags)
	# or die "Couldn't set flags for HANDLE: $!\n";
	my $req;
	while (1) {
	if (read($sock_client,my $receive_buf,1)) {

	$req .= $receive_buf;
	if ($receive_buf eq "\n") {
	last;
	}
	}
	else {
	die "[$$]Connection terminated.";
	}
	}
	print "\r";

	my @mfv = split(' ',$req);
	my $status;
	my %response;

	$response{'Server'} = 'HydrogenServidor 1.0';

	$mfv[1] =~ tr/+/ /;
	$mfv[1] =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack('H2', $1)/eg;
	my $file = $config{'docroot'} . $mfv[1] ;
	#print $file."\n";
	my $body = '';
	if (-f $file) {
	$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';
	}
	}
	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';
	}

	my $head = '';
	while (my ($k,$v) = each(%response)) {
	$head .= $k.': '.$v."\r\n";
	}

	send($sock_client,$status."\r\n".$head."\r\n".$body,0);
	close($sock_client);
	#print '['.$$."]: Disconnect, process exit.\n";
	# ポートの監視は親プロセスが行っているので、
	# クライアントとのやりとりが終了すれば exit
	exit;
	} else {
	warn "Failed to fork()\n";
	}
	}
	}

	__END__
No results found