1 # HTTPDtype.pl: retrieves http server headers
2 # Author: Joey Smith <joey@php.net>
3 # Licensing: Artistic License
4 # Version: v0.1 (20031110)
13 my ( $code, $mess, %h );
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");
20 my $s = Net::HTTP::NB->new( Host => $HOST ) || return;
21 $s->write_request( HEAD => "/" );
23 my $sel = IO::Select->new($s);
24 $line = 'Header timeout' unless $sel->can_read(10);
25 ( $code, $mess, %h ) = $s->read_response_headers;
28 ( length( $h{Server} ) > 0 )
30 : "Couldn't fetch headers from $HOST";
32 &::performStrictReply( $line || 'Unknown Error Condition' );
37 # vim:ts=4:sw=4:expandtab:tw=80