List of sock/httpreq.cgi

Fri Apr 26 12:01:57 2024
#!/usr/local/bin/perl5
#-------------------------------------------------------------
# httpreq.cgi
#       http サーバーに対してリクエストし、応答を表示する
#
# (C) 1997,98 がま 
# E-mail addr : gama@mvg.biglobe.ne.jp
#
# 1997/11/27 Ver0.00
# 1997/12/08 Ver0.01
# 1998/02/08 Ver0.02
# 1998/02/16 Ver0.03 ホストの IP アドレスでの指定に対応。
# 1998/07/31 Ver0.04
# 1998/12/16 Ver0.05 HTTP1.1 へ対応
# 1999/02/23 Ver0.06
#
#-------------------------------------------------------------
$user_agent = "httpreq.cgi/0.06"
             ." (http://www2d.biglobe.ne.jp/~gama/cgi/)";
#-------------------------------------------------------------
use Socket;
#-------------------------------------------------------------
$|=1;           # STDOUT を バッファリングしないようにする
#-------------------------------------------------------------
print "Content-type: text/html\n\n";
print '<HTML><HEAD><META HTTP-EQUIV="Pragma" CONTENT="no-cache">';
print "<TITLE>$user_agent</TITLE></HEAD>\n";
print "<BODY>\n<HR><PRE>\n";
#-------------------------------------------------------------
($method,$url)=split("&",$ENV{'QUERY_STRING'}); # & で分離
$method =~ s/method=//;
$method =~ s/%(..)/pack('C',hex($1))/ge;        # decode
$url =~ s/url=//;
$url =~ s/%(..)/pack('C',hex($1))/ge;           # decode
#-------------------------------------------------------------
$url =~ s/^(http\:\/\/)//i;                     # http:// を削除
unless ( $1 ) {
    print "Format Error in httpreq\n";
    &tail;
    exit;
}
($hostname, $filename) = split('/', $url, 2);   # / で分割
$filename = '/'.$filename;
#-------------------------------------------------------------
# ホスト名からアドレスへ変換する
if ( $hostname =~ /^[0-9]+(\.[0-9]+)+$/) {
        ($addr1,$addr2,$addr3,$addr4)=split('\.', $hostname);
        $addr   = pack('C4',$addr1,$addr2,$addr3,$addr4)
} else {
        unless ($addr = gethostbyname($hostname)) {
                print "Can't get IP address of $hostname\n";
                &tail;
                exit;
        }
        ($addr1,$addr2,$addr3,$addr4)=unpack('C4',$addr);
}
if ($addr eq pack('C4',210,164,6,31)) {
    print "address exp 210.164.6.31 -> 210.164.6.4\n";
    $addr = pack('C4',210,164,6,4);
}

#-------------------------------------------------------------
$Inet   = &AF_INET;
$Stream = &SOCK_STREAM;
$Port   = 80;
$Proto  = getprotobyname("tcp"); # プロトコル名をプロトコル番号へ
#-------------------------------------------------------------
print "hostname : $hostname\n";
print "    addr : $addr1.$addr2.$addr3.$addr4\n";
print "filename : $filename\n";
print "    Inet : $Inet\n";
print "    Port : $Port\n";
print "  Stream : $Stream\n";
print "   Proto : $Proto\n";
#-------------------------------------------------------------
# soket を open して、FILEHANDLE SOCK を設定する
unless (socket(SOCK, $Inet, $Stream, $Proto)) {
        print "Can't socket\n";
        &tail;
        exit;
}
#-------------------------------------------------------------
# プロセスとのコネクションを確立
$proc = pack('S n a4 x8', $Inet, $Port, $addr);
unless (connect(SOCK, $proc)) {
        print "Can't connect\n";
        &tail;
        exit;
}
#-------------------------------------------------------------
select(SOCK);   # SOCK をセレクトする
$|=1;           # SOCK をバッファリングしないようにする
select(STDOUT); # STDOUT に戻す
#-------------------------------------------------------------
# リクエスト
$request        = "$method $filename HTTP/1.0\n"
                . "Host: $hostname\n"
#                . "Cache-Control: no-cache\n"
                . "User-Agent: $user_agent\n"
                . "\r\n";
print "<HR>-- Request --------\n";
print $request;
print SOCK $request;
#-------------------------------------------------------------
# レスポンス
print "<HR>-- Response -------\n";
$_=<SOCK>;
while (<SOCK>) {
        s/&/&amp;/g;
        s/</&lt;/g;
        s/>/&gt;/g;
        print ;
}
close(SOCK);
&tail;
exit;
#-------------------------------------------------------------
sub tail {
        print "</PRE><HR>\n";
        print "<CENTER><A HREF=\"httpreq.htm\">Back</A></CENTER>\n";
        print "</BODY></HTML>";
}
戻る