Skip to content

Instantly share code, notes, and snippets.

@chansen
Created April 17, 2010 11:21
Show Gist options
  • Save chansen/369483 to your computer and use it in GitHub Desktop.
Save chansen/369483 to your computer and use it in GitHub Desktop.
fastcgi-ping.pl
#!/usr/bin/perl
use strict;
use warnings;
use IO::Socket qw[];
use Net::FastCGI::Constant qw[ :type FCGI_NULL_REQUEST_ID FCGI_HEADER_LEN ];
use Net::FastCGI::Protocol qw[ build_record parse_header get_type_name ];
sub fatal ($;$);
sub timeout (&$$);
(@ARGV == 1)
|| fatal(qq/usage: <host:port>/);
my $remote = shift @ARGV;
my $socket = timeout {
(-S $remote ? 'IO::Socket::UNIX' : 'IO::Socket::INET')->new($remote)
or fatal(qq<Could not connect to '$remote': '$!'>);
} 5, q<Timeout while attempting to connect to the specified address>;
timeout {
print {$socket} build_record(FCGI_GET_VALUES, FCGI_NULL_REQUEST_ID, "\x00\x00")
or fatal(qq<Could not write record: '$!'>);
} 5, q<Timeout while attempting to write FCGI_Record>;
my $header = timeout {
my $r = read($socket, my $buf, FCGI_HEADER_LEN);
(defined $r && $r == FCGI_HEADER_LEN)
|| fatal(qq<Could not read FCGI_Header: '$!'>);
parse_header($buf);
} 5, q<Timeout while attempting to read FCGI_Header>;
if ($header->{type} == FCGI_GET_VALUES_RESULT) {
print "$remote: OK\n";
}
else {
printf "$remote: NOT OK (Application responed with an unexpected record type %s)\n",
get_type_name($header->{type});
}
sub fatal ($;$) {
my ($message, $status) = @_;
warn $0, ': ', $message, "\n";
exit ($status || 1);
}
sub awaken::DESTROY () { alarm(0) }
sub timeout (&$$) {
my ($code, $timeout, $message) = @_;
$SIG{ALRM} = sub {
fatal($message);
};
alarm($timeout);
my $awaken = bless \(my $x), 'awaken';
&$code;
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment