1 rizwank 1.1 #!/usr/bin/perl -w
 2             #
 3             # Simple utility to fetch an HTML page from a server
 4             # (Utility for TWiki Collaboration Platform, http://TWiki.org/)
 5             #
 6             # Copyright (C) 1999 Jon Udell, BYTE
 7             # Copyright (C) 2000-2003 Peter Thoeny, peter@thoeny.com
 8             #
 9             # For licensing info read license.txt file in the TWiki root.
10             # This program is free software; you can redistribute it and/or
11             # modify it under the terms of the GNU General Public License
12             # as published by the Free Software Foundation; either version 2
13             # of the License, or (at your option) any later version.
14             #
15             # This program is distributed in the hope that it will be useful,
16             # but WITHOUT ANY WARRANTY; without even the implied warranty of
17             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18             # GNU General Public License for more details, published at 
19             # http://www.gnu.org/copyleft/gpl.html
20             
21             use Socket;
22 rizwank 1.1 
23             if( ! $ARGV[1] ) {
24                 print "Usage:    geturl <host> <path> [<port> [<header>]]\n";
25                 print "Example:  geturl some.domain /some/dir/file.html 80\n";
26                 print "will get: http://some.domain:80/some/dir/file.html\n";
27                 exit 1;
28             }
29             my $host   = $ARGV[0];
30             my $url    = $ARGV[1];
31             my $port   = $ARGV[2] || "80";
32             my $header = $ARGV[3] || "Host: $host";
33             print getUrl( $host, $port, $url, $header );
34             
35             # =========================
36             sub getUrl
37             {
38                 my ( $theHost, $thePort, $theUrl, $theHeader ) = @_;
39                 my $result = '';
40                 my $req = "GET $theUrl HTTP/1.0\r\n$theHeader\r\n\r\n";
41                 my ( $iaddr, $paddr, $proto );
42                 $iaddr   = inet_aton( $theHost );
43 rizwank 1.1     $paddr   = sockaddr_in( $thePort, $iaddr );
44                 $proto   = getprotobyname( 'tcp' );
45                 socket( SOCK, PF_INET, SOCK_STREAM, $proto )  or die "socket: $!";
46                 connect( SOCK, $paddr ) or die "connect: $!";
47                 select SOCK; $| = 1;
48                 print SOCK $req;
49                 while( <SOCK> ) { $result .= $_; }
50                 close( SOCK )  or die "close: $!";
51                 select STDOUT;
52                 return $result;
53             }