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($hostport,$host,$port,$path)=($1,$2,$3,$4);
  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\n";
  29 my %header=(
  30         "Host"=>$hostport,
  31         "X-httpgetdumb"=>'$Id$',
  32         );
  33 while (my($key,$val)=each(%header)) {
  34         print SOCK "$key: $val\r\n";
  35         }
  36 print SOCK "\r\n";
  37 if ($opts{"H"}) {
  38         while (<STDIN>) {
  39                 chomp;
  40                 last if /^$/;
  41                 print SOCK "$_\r\n";
  42                 }
  43         }
  44 SOCK->flush();
  45 while (<SOCK>) {
  46         print STDERR;
  47         chomp;
  48         last if /^\r?$/;
  49         }
  50 for (;;) {
  51         my $buf;
  52         my $got=read SOCK,$buf,BUFFER_LENGTH;
  53         defined $got or die "read: $!";
  54         last if !$got;
  55         die "read()=$got (<0)" if $got<0;
  56         print $buf;
  57         }
  58 exit 0;