send.pl

#!/usr/local/bin/perl

# send.pl - SocketでPostするテスト（送信側）
# (C) Takashi Utsunomiya.
# http://uttsu.com/
# 2002.11.19-

# Description:
# ・HTTPでアクセスできないサーバーにある情報（ファイルなど）を
#   HTTPでアクセスできるサーバーに送って、ブラウザなどから
#   アクセスできるようにするのが目的です。
# ・receive.plは異なるサーバーにあっても構いません。
# ・実行すると、receive.plがデータを受け取って、aというファイルに保存します。

# Usage: send.pl

use strict;

my $url = 'http://path/to/receive.pl';
my $query = 'body=hogehoge';

main();
exit;

sub main {
    do_post($url, $query);
}

sub do_post {
    my ($url, $query) = @_;
    $url =~ m|^(?:http://)?(.*?)(/.*)|;
    my $host = $1;
    my $uri = $2;
    my $len = length($query);

    my $addr = (gethostbyname($host))[4];
    my $name = pack("S n a4 x8", 2, 80, $addr);
    socket(SOCKET, 2, 1, 0);
    connect(SOCKET, $name);
    binmode(SOCKET);
    select(SOCKET); $| = 1; select(STDOUT);

    print SOCKET <<END;
POST $uri HTTP/1.0
Host: $host
Content-Length: $len

$query
END

    while (<SOCKET>) {
        print;
    }

    close(SOCKET);
}