Using Perl to Ping an AJP Service (Jetty)

One of my recent Citrix KB articles was about creating a Netscaler user monitor (which are Perl based) to allow for a more intelligent type of monitoring for AJP based services than a standard TCP based socket open/close check.  The AJP Protocol Reference is good enough to provide a method for doing a simple and lightweight PING/PONG request/response.  Unfortunately, the format of the packets is such that they cannot (currently) be added as a TCP-ECV monitor, essentially because of restrictions on non-printable characters being inserted into those monitors (believe me, I tried multiple ways to insert the required characters).

So, I set off to write the Perl version of such a monitor, but before I did I needed a simple script outside the Netscaler for debugging purposes – having to rely on the monitor for testing is needlessly cumbersome, better to get it functioning first and then add it to the monitor code later.  Also, because of that approach, the script is perfectly usable as a generic test and is written almost entirely as a self-contained sub-routine (anyone that has seen the user monitor structure on the Netscaler will instantly recognize that also).  Hence, I think it would be very easy to add the subroutine to a syslog or other monitoring type script.  Therefore I decided to share the more generic version here.  The full code is after the jump, if you prefer a more discrete or forkable version, you can find it on github here: ajp.pl

I have the acknowledgements in the code also, but to get them in before the jump, they were invaluable:

Perl Code:

#!/usr/bin/perl -w


# This is a simple Perl Script to ping and AJP server and print the response
# written as a sub-routine for easy embedding elsewhere
#

# Author: Adam Comerford (http://comerford.cc)
#
# For more information see: The Apache Tomcat Connector - AJP Protocol Reference - http://tomcat.apache.org/connectors-doc/ajp/ajpv13a.html

# Acknowledgements:
# The hex values are based on the information from http://tomcat.apache.org/connectors-doc/ajp/ajpv13a.html#Packet%20Headers
# Actual pack code to create the hex packets is from http://it-nonwhizzos.blogspot.com/2009/05/ajp-ping-in-perl.html

use strict;
use IO::Socket::INET;

my $result = ajp_probe($ARGV[0], $ARGV[1], $ARGV[2], $ARGV[3]);
print "$result \n";

sub ajp_probe {

        # flush after every write
        $| = 1;

        ## There must be at least 3 arguments to this function.
        ##      1. First argument is the IP that has to be probed.
        ##      2. Second argument is the port to connect to.
        ##      3. Timeout

        if(scalar(@ARGV) < 3)
        {   
                return "Insufficient number of arguments, there should be three, something like:\n\nperl ajp.pl 192.168.1.1 8009 3\n";
    
        }   

        my $server_ip = $ARGV[0];
        my $port = $ARGV[1];
        my $timeout = $ARGV[2];
    
        my $errcode = 0;
    
        my $sendhex = pack 'C5' # Format template (pack the next 5 unsigned char (octet) values)
            , 0x12, 0x34        # Magic number for server->container packets.
            , 0x00, 0x01        # 2 byte int length of payload.
            , 0x0A              # Type of packet. 10 = CPing.
        ;   

        my $recvhex = pack 'C5'     # Format template.
            , 0x41, 0x42            # Magic number for container->server packets.
            , 0x00, 0x01            # 2 byte int length of payload.
            , 0x09                  # Type of packet. 9 = CPong reply.
        ;   
my $socket = new IO::Socket::INET (
        PeerHost => $server_ip,
        PeerPort => $port,
        Proto => 'tcp',
        Timeout => $timeout,
        ) or die "ERROR in Socket Creation : $!\n";

        $socket->send($sendhex);

        my $read;

        $socket->recv($read, 1024);

        ## Probe completed.
        $socket->shutdown(2);

        if ($recvhex eq $read) {
                # a successful probe should return a line like this:
                # success - AB
                # (from a test Jetty instance) 
                return "success - $read";
        } else {
                return "Mismatch on Response - malformed PONG or other error";
        }

}