geturl 1.83 KB
Newer Older
Nico Schottelius's avatar
init  
Nico Schottelius committed
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53
#!/usr/bin/perl -w
#
# Simple utility to fetch an HTML page from a server
# (Utility for TWiki Collaboration Platform, http://TWiki.org/)
#
# Copyright (C) 1999 Jon Udell, BYTE
# Copyright (C) 2000-2003 Peter Thoeny, peter@thoeny.com
#
# For licensing info read license.txt file in the TWiki root.
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details, published at 
# http://www.gnu.org/copyleft/gpl.html

use Socket;

if( ! $ARGV[1] ) {
    print "Usage:    geturl <host> <path> [<port> [<header>]]\n";
    print "Example:  geturl some.domain /some/dir/file.html 80\n";
    print "will get: http://some.domain:80/some/dir/file.html\n";
    exit 1;
}
my $host   = $ARGV[0];
my $url    = $ARGV[1];
my $port   = $ARGV[2] || "80";
my $header = $ARGV[3] || "Host: $host";
print getUrl( $host, $port, $url, $header );

# =========================
sub getUrl
{
    my ( $theHost, $thePort, $theUrl, $theHeader ) = @_;
    my $result = '';
    my $req = "GET $theUrl HTTP/1.1\r\n$theHeader\r\n\r\n";
    my ( $iaddr, $paddr, $proto );
    $iaddr   = inet_aton( $theHost );
    $paddr   = sockaddr_in( $thePort, $iaddr );
    $proto   = getprotobyname( 'tcp' );
    socket( SOCK, PF_INET, SOCK_STREAM, $proto )  or die "socket: $!";
    connect( SOCK, $paddr ) or die "connect: $!";
    select SOCK; $| = 1;
    print SOCK $req;
    while( <SOCK> ) { $result .= $_; }
    close( SOCK )  or die "close: $!";
    select STDOUT;
    return $result;
}