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 =
  28       ( length( $h{Server} ) > 0 )
  29       ? $h{Server}
  30       : "Couldn't fetch headers from $HOST";
  31
  32     &::performStrictReply( $line || 'Unknown Error Condition' );
  33 }
  34
  35 1;
  36
  37 # vim:ts=4:sw=4:expandtab:tw=80