src/Modules/HTTPDtype.pl

   1 # HTTPDtype.pl: retrieves http server headers
   2 #       Author: Joey Smith <joey@php.net>
   3 #    Licensing: Artistic License
   4 #      Version: v0.1 (20031110)
   5 #
   6 use strict;
   7
   8 package HTTPDtype;
   9
  10 sub HTTPDtype {
  11     my($HOST) = @_;
  12     my($line) = '';
  13     my($code, $mess, %h);
  14
  15     # TODO: remove leading http:// and trailing :port and /foo if found
  16     $HOST = 'joeysmith.com' unless length($HOST) > 0;
  17     return unless &::loadPerlModule("Net::HTTP::NB");
  18     return unless &::loadPerlModule("IO::Select");
  19
  20         my $s = Net::HTTP::NB->new(Host => $HOST) || return;
  21         $s->write_request(HEAD => "/");
  22
  23         my $sel = IO::Select->new($s);
  24         $line = 'Header timeout' unless $sel->can_read(10);
  25         ($code, $mess, %h) = $s->read_response_headers;
  26
  27         $line = (length($h{Server}) > 0) ? $h{Server} :
  28           "Couldn't fetch headers from $HOST";
  29
  30     &::performStrictReply($line||'Unknown Error Condition');
  31 }
  32
  33 1;
  34
  35 # vim:ts=4:sw=4:expandtab:tw=80