#!c:/perl/bin/Perl.exe
use Socket;
$HOST = '127.0.0.1';
$PORT = '80';
$PATH = '/cgi-bin/formsend.cgi';
$TIMEOUT = '10';
$QUERY = 'abcd=123'; # 適当に入れてください。
print "Content-Type: text/xml¥n¥n";
print Header_Cut(Location_Post($HOST, $PORT, $PATH, $QUERY));
exit;
#
#==============================================//
# Postで送信する //
# $host ホスト名 //
# $port ポート番号 //
# $path ホストのHomeからのパス(/で始まる) //
# $msg 送信内容 //
# 返り値:ヘッダーつきデータ //
#==============================================//
sub Location_Post($$$$)
{
my($host, $port, $file, $query) = @_;
my($len) = length($query);
# ソケットのオープン
if (!socket(SOCK, PF_INET, SOCK_STREAM, getprotobyname('tcp')))
{
return "error:open socket";
}
# ポートへの接続
if (!connect(SOCK, sockaddr_in($port,inet_aton($host))))
{
close(SOCK);
return "error:connect socket";
}
# ソケットのバッファリングを停止
select(SOCK);
$| = 1;
select(STDOUT);
# HTTP 要求ヘッダー
# POST メソッドで要求します。
print SOCK "POST $file HTTP/1.0" . "¥r¥n";
# Content-Length: を送る(クエリーのバイト数)
# ヘッダーの最後は2回改行する
print SOCK "Content-Length: $len" . "¥r¥n¥r¥n";
# POST 内容送信
print SOCK "$query";
# タイムアウトアラーム開始
$SIG{'ALRM'} = ¥&_socket_timeout;
alarm($TIMEOUT);
# 受信
$ret = "";
while(<SOCK>)
{
$ret = $ret . $_;
}
# タイムアウトアラーム解除
alarm(0);
# ソケットを閉じる
close(SOCK);
return $ret;
}
#===============================================//
# ソケット通信タイムアウト時の処理 //
#==============================================//
sub _socket_timeout
{
close(SOCK);
exit;
}
#==============================================//
# ヘッダーをきる //
# $buf :ヘッダーつきデータ //
# 返り値:ヘッダをカットした本文 //
#==============================================//
sub Header_Cut($)
{
my($msg) = @_;
$pos = index($msg,"¥r¥n¥r¥n");
if ( $pos >= 0 )
{
$pos += 4;
}
else
{
$pos = index($msg,"¥n¥n");
if ( $pos >= 0 )
{
$pos += 2;
}
}
if ( $pos < 0 )
{
return "error";
}
return substr($msg,$pos);
}
|