Table of Contents

概要

  • CGIで環境変数を表示します。
  • 「HTTPS」を表示するように修正。(2012/04/29)
  • 「GeoIP」を表示するように修正。(2012/09/06)

動作サンプル

形式 http https
HTML版 PrintEnv PrintEnv
Text版 PrintEnv PrintEnv

ソースコード

HTML版

#!/usr/bin/perl

use strict;
use warnings;
use utf8;
use Encode;
use CGI::Pretty qw( -no_xhtml *table );    # //HTML 4.01 Transitional//EN

my $charsetConsole	= 'UTF-8';
my $charsetFile		= 'UTF-8';

binmode( STDIN,  ":encoding($charsetConsole)" );
binmode( STDOUT, ":encoding($charsetConsole)" );
binmode( STDERR, ":encoding($charsetConsole)" );

my $q = new CGI;
$q->charset( $charsetFile );

my $cginame = 'PrintEnv';

printHeader();

print $q->start_table( { '-summary' => 'ENV', '-border' => 1 } );
print $q->Tr( $q->th( [ 'Key', 'Value' ] ) );
foreach ( sort( keys( %ENV ) ) ){
	if ( /^(GEOIP_|HTTPS|HTTP_|QUERY_|REMOTE_|REQUEST_|SERVER_(ADDR|NAME|PORT|PROTOCOL))/i ){
		print $q->Tr( $q->td( [ $_, $ENV{$_} ] ) );
	}
}
print $q->end_table();

printFooter();

exit;

sub printHeader
{
	print $q->header();
	print $q->start_html( 
		'-title'	=> $cginame, 
		'-lang'		=> 'ja-JP', 
		'-head'		=> [ 
			$q->meta( { '-http_equiv' => 'Content-style-type', '-content' => 'text/css' } ), 
			$q->meta( { '-http_equiv' => 'Content-script-type', '-content' => 'text/javascript' } ), 
		], 
		'-style'	=> [ { 'src' => '/take.css' }, ], 
	);
	print $q->h1( $cginame );
}

sub printFooter
{
	print $q->end_html . "\n";
}

# EOF

Text版

#!/usr/bin/perl
# 環境変数の表示(テキスト版)

use strict;
use warnings;
use utf8;

print "Content-type: text/plain; charset=UTF-8\n\n";

foreach ( sort( keys( %ENV ) ) ){
	if ( /^(GEOIP_|HTTPS|HTTP_|QUERY_|REMOTE_|REQUEST_|SERVER_(ADDR|NAME|PORT|PROTOCOL))/i ){
		print $_ . "\t" . $ENV{ $_ } . "\n";
	}
}

# EOF

IIS8用

#!/usr/bin/perl
# 環境変数の表示

use strict;
use warnings;
use utf8;
use Encode;
use CGI::Pretty qw( -no_xhtml *table );	# //HTML 4.01 Transitional//EN

my $charsetConsole	= 'UTF-8';
my $charsetFile		= 'UTF-8';

#binmode( STDIN,  ":encoding($charsetConsole)" );
#binmode( STDOUT, ":encoding($charsetConsole)" );
#binmode( STDERR, ":encoding($charsetConsole)" );

my $encoder = find_encoding( $charsetConsole );
if ( defined( $ENV{PERLXS} ) && $ENV{PERLXS} eq 'PerlIS' ){
	print $encoder->encode( "HTTP/1.0 200 OK\n" );
}

my $q = new CGI;
$q->charset( $charsetFile );

my $cginame = '環境変数の表示';

print $encoder->encode(makeHeader($q));

my $output = '';
$output .= $q->start_table( { '-summary' => 'ENV', '-border' => 1 } );
$output .= $q->Tr( $q->th( [ 'キー', '値' ] ) );
foreach ( sort( keys( %ENV ) ) ){
	if ( /^(GEOIP_|HTTPS|HTTP_|QUERY_|REMOTE_|REQUEST_|SERVER_(ADDR|NAME|PORT|PROTOCOL))/i ){
		$output .= $q->Tr( $q->td( [ $_, $ENV{$_} ] ) );
	}
}
$output .= $q->end_table();
print $encoder->encode($output);

print $encoder->encode(makeFooter($q));

exit;

sub makeHeader
{
	my $q = shift or return;
	my $ret = '';
	$ret .= $q->header();
	$ret .= $q->start_html(
		'-title'	=> $cginame,
		'-lang'		=> 'ja-JP',
		'-head'		=> [
			$q->meta( { '-http_equiv' => 'Content-style-type', '-content' => 'text/css' } ),
			$q->meta( { '-http_equiv' => 'Content-script-type', '-content' => 'text/javascript' } ),
		],
		'-style'	=> [ { 'src' => '/take.css' }, ],
	);
	$ret .= $q->h1( $cginame );
	return $ret;
}

sub makeFooter
{
	my $q = shift or return;
	my $ret = '';
	$ret .= $q->end_html . "\n";
	return $ret;
}

# EOF

IIS6用

#!/usr/bin/perl
# printEnv.pl
# Linuxの場合は、EUC-JP,LFで保存

print "Content-type: text/html\n\n";

print <<EOL;
<html>
<body>
%ENV
<table border="1">
<tr><th>key</th><th>value</th></tr>
EOL

foreach $key (sort keys(%ENV)){
	printf("<tr><td>%s</td><td>%s</td></tr>\n", $key, $ENV{$key});
}

print <<EOL;
</table>
<br>
%ALL_HTTP
<table border="1">
<tr><th>key</th><th>value</th></tr>
EOL

# IIS用
@ALL_HTTP = split( "\n", $ENV{ "ALL_HTTP" } );
%ALL_HTTP = ();
foreach $line ( @ALL_HTTP ){
	if ( $line =~ /([^:]+):(.*)\s*/){
		$ALL_HTTP{ $1 } = $2;
	}
}
foreach $key (sort keys(%ALL_HTTP)){
	printf("<tr><td>%s</td><td>%s</td></tr>\n", $key, $ALL_HTTP{$key});
}

print <<EOL;
</table>
</body>
</html>
EOL

exit();

# EOF

リンク

Perl