bin/httpgetdumb

   1 #! /usr/bin/perl
   2 #
   3 #       $Id$
   4
   5 use strict;
   6 use warnings;
   7
   8 use Socket;
   9 use IO::Handle;
  10 use Getopt::Std;
  11
  12 use constant DEFAULT_PORT=>80;
  13 use constant BUFFER_LENGTH=>0x1000;
  14
  15 my %opts;
  16 getopts "hH",\%opts or die "getopts()";
  17 @ARGV==1 && $ARGV[0]=~m#^http://([^/:]+)(?::(\d+))?(/.*)$#
  18                 or die "Syntax: $0 [-hH] http://hostname/pathname";
  19 my($host,$port,$path)=($1,$2,$3);
  20 defined $port or $port=DEFAULT_PORT;
  21
  22 my $proto=getprotobyname "tcp" or die "getprotobyname \"tcp\": $!";
  23 socket SOCK,PF_INET,SOCK_STREAM,$proto or die "socket PF_INET,SOCK_STREAM,\"tcp\": $!";
  24 my $hostaddr=gethostbyname $host or die "hostname \"$host\": $!";
  25 my $sockaddr=sockaddr_in $port,$hostaddr or die "sockaddr_in(".inet_ntoa($hostaddr).":$port): $!";
  26 connect SOCK,$sockaddr or die "connect \"$host\"(".inet_ntoa($hostaddr).":$port): $!";
  27
  28 print SOCK ($opts{"h"} ? "HEAD" : "GET")." $path HTTP/1.0\r\nHost: $host\r\n\r\n";
  29 if ($opts{"H"}) {
  30         while (<STDIN>) {
  31                 chomp;
  32                 last if /^$/;
  33                 print SOCK "$_\r\n";
  34                 }
  35         }
  36 SOCK->flush();
  37 while (<SOCK>) {
  38         print STDERR;
  39         chomp;
  40         last if /^\r?$/;
  41         }
  42 for (;;) {
  43         my $buf;
  44         my $got=read SOCK,$buf,BUFFER_LENGTH;
  45         defined $got or die "read: $!";
  46         last if !$got;
  47         die "read()=$got (<0)" if $got<0;
  48         print $buf;
  49         }
  50 exit 0;