#!/usr/bin/perl -w

# rtsp check module

# Version: $Revision: 0.2 $
# Author: Matt Selsky
# Date: $Date: 2003/06/20 00:31:41 $
#
# Copyright (c) 2003
# The Trustees of Columbia University in the City of New York
# Academic Information Systems
# 
# License restrictions apply, see doc/license.html for details.

# MODEXEC_OK      if response code is 200
# MODEXEC_WARNING if RTSP response status code class is not recognized        
# MODEXEC_NOTICE  if RTSP response status code is class 1xx or 3xx
# MODEXEC_PROBLEM if RTSP response status code is class 4xx or 5xx
#
# scalar value returned is RTSP response status code
#
# text comment returned is RTSP response reason phrase.  If status code class 
#                 is not recognized then message so indicating is returned.

use strict;
use FindBin;
use lib "$FindBin::Bin/../common";
use Survivor::Check;

use IO::Socket;
use URI 1.20;

my %argfmt = ('scheme' => 'optional string any(rtsp,rtspu) default(rtsp)',
	      'hostname' => 'optional string',
	      'port' => 'optional number default(554)',
	      'path' => 'string');

my $sc = new Survivor::Check();

$sc->GetOpt(\%argfmt, \&RtspValidate);

$sc->Arg('path') =~ m!^/! or
    $sc->ExitError(MODEXEC_MISCONFIG, 0, "Argument 'path' must begin with '/'");

my $r = $sc->Exec( \&RtspCheck);

exit($r);

sub RtspValidate {
    return(MODEXEC_OK, 0, 'Rtsp OK');
}

sub RtspCheck {
    my $self = shift;
    my $host = shift;

    # Construct URI with correct scheme/hostname/path
    my $uri = new URI($self->Arg('scheme') . '://' .
		      ($self->Arg('hostname') ? $self->Arg('hostname') : $host) .
		      ':' . $self->Arg('port'). $self->Arg('path'));

    # get response code
    my($client,$responseCode, $responsePhrase, $cseq);

    $client = IO::Socket::INET->new( PeerAddr => $host,
				     PeerPort => $uri->port(),
				     Proto    => ($uri->scheme() eq 'rtspu' ? 'udp' : 'tcp')
				     );

    unless( $client ) {
	return(MODEXEC_PROBLEM, 0, 'Unable to connect');
    }

    $client->autoflush(1);

    # set timeout value, otherwise use IO::Socket->timeout() default
    $client->timeout($self->Timeout()) if $self->Timeout();

    # change input record separator since RTSP response lines are terminated differently
    $/ = "\r\n";

    $client->send( "OPTIONS $uri RTSP/1.0\r\n" );
    $client->send( "CSeq: 1\r\n" );
    $client->send( "\r\n" );

    ##print "OPTIONS $uri RTSP/1.0\r\n";

    while( <$client> ) {
	chomp;
	last unless length;
        if(m!^RTSP/\d\.\d (\d{3}) (.*)$!) {
	    # good code or error
	    $responseCode = $1;
	    $responsePhrase = $2;
	    my($r,$s,$c) = &check_response( $responseCode, $responsePhrase);
	    return($r,$s,$c) unless ($r == MODEXEC_OK);
	} elsif(m!^CSeq: (\d+)!) {
	    # complain about bogus cseq
	    $cseq = $1;
	    return(MODEXEC_PROBLEM, 0, "Unexpected sequence number - expected 1, got $cseq")
		unless($cseq == 1);
	}
    }

    $client->send( "DESCRIBE $uri RTSP/1.0\r\n" );
    $client->send( "CSeq: 2\r\n" );
    $client->send( "\r\n" );

    ##print "DESCRIBE $uri RTSP/1.0\r\n";

    while( <$client> ) {
	chomp;
	last unless length;
        if(m!^RTSP/\d\.\d (\d{3}) (.*)$!) {
	    # good code or error
	    $responseCode = $1;
	    $responsePhrase = $2;
	    my($r,$s,$c) = &check_response( $responseCode, $responsePhrase);
	    return($r,$s,$c) unless ($r == MODEXEC_OK);
	} elsif(m!^CSeq: (\d+)!) {
	    # complain about bogus cseq
	    $cseq = $1;
	    return(MODEXEC_PROBLEM, 0, "Unexpected sequence number - expected 2, got $cseq")
		unless($cseq == 2);
	}
    }

    $client->close();
    
    return(MODEXEC_OK, $responseCode, $responsePhrase);
}

# accept response code, phrase; returns return code, scalar, and
# comment
sub check_response {
    my $code = shift;
    my $phrase = shift;

    my($rc,$scalar,$comment);

    ##########################################################################################
    # RFC 2326 (RTSP 1.0): RTSP response classes
    #      - 1xx: Informational - Request received, continuing process
    #      - 2xx: Success - The action was successfully received, understood, and accepted
    #      - 3xx: Redirection - Further action must be taken in order to complete the request
    #      - 4xx: Client Error - The request contains bad syntax or cannot be fulfilled
    #      - 5xx: Server Error - The server failed to fulfill an apparently valid request
    ##########################################################################################
    # map RTSP status code class to Survivor check module return code
    my %rc_map = ( 
		   1 => MODEXEC_NOTICE,
		   2 => MODEXEC_OK,
		   3 => MODEXEC_NOTICE,
		   4 => MODEXEC_PROBLEM,
		   5 => MODEXEC_PROBLEM
		   );

    my $class = substr($code, 0, 1);
    if (exists($rc_map{$class})) {
	# assign return values
	$rc = $rc_map{$class};
	$scalar = $code;
	$comment = $phrase;
    } else {
	# class of status code not recognized
	$rc = MODEXEC_WARNING;
	$scalar = -1;
	$comment = "RTSP response class '${class}xx' not recognized";
    }

    return($rc, $scalar, $comment);
}
