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 "xhH",\%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 $header{"Accept"}="application/xhtml+xml" if $opts{"x"};
  34 while (my($key,$val)=each(%header)) {
  35         print SOCK "$key: $val\r\n";
  36         }
  37 print SOCK "\r\n";
  38 if ($opts{"H"}) {
  39         while (<STDIN>) {
  40                 chomp;
  41                 last if /^$/;
  42                 print SOCK "$_\r\n";
  43                 }
  44         }
  45 SOCK->flush();
  46 while (<SOCK>) {
  47         print STDERR;
  48         chomp;
  49         last if /^\r?$/;
  50         }
  51 for (;;) {
  52         my $buf;
  53         my $got=read SOCK,$buf,BUFFER_LENGTH;
  54         defined $got or die "read: $!";
  55         last if !$got;
  56         die "read()=$got (<0)" if $got<0;
  57         print $buf;
  58         }
  59 exit 0;