#!/usr/bin/perl -w
# Copyright © 2000 Jamie Zawinski <jwz@dnalounge.com>
#
# Permission to use, copy, modify, distribute, and sell this software and its
# documentation for any purpose is hereby granted without fee, provided that
# the above copyright notice appear in all copies and that both that
# copyright notice and this permission notice appear in supporting
# documentation.  No representations are made about the suitability of this
# software for any purpose.  It is provided "as is" without express or 
# implied warranty.
#
# Created: 16-Jul-2000
# rtsp-ping.pl --- see if a RealVideo stream is active.

require 5;
use diagnostics;
use strict;

use Socket;
require POSIX;

my $progname = $0; $progname =~ s@.*/@@g;
my $version = q{ $Revision: 1.4 $ }; $version =~ s/^[^0-9]+([0-9.]+).*$/$1/;

my $timeout = 30;    # if no data read for this many seconds, exit.

my $verbose = 0;

sub error {
  ($_) = @_;
  s/\r\n/\n/sg;
  s/\n+$//s;
  print STDERR "$progname: $_\n";
  exit 1;
}

sub error_alarm {
  error "timeout: $timeout seconds with no data!\n";
}

sub rtsp_cmd {
  foreach my $cmd (@_) {
    print SERVER "$cmd\r\n";
    print STDERR "    >>> $cmd\n" if ($verbose > 1);
  }
}

sub rtsp_reply {
  my $reply = <SERVER>;
  $reply =~ s/\r?\n$//;
  print STDERR "    <<< $reply\n" if ($verbose > 1);
  return $reply;
}


sub ping {
  my ($url) = @_;

  $SIG{ALRM} = \&error_alarm;
  alarm $timeout;

  my($url_proto, $dummy, $serverstring, $path) = split(/\//, $url, 4);
  if (! ($url_proto && $url_proto =~ m/^rtsp:$/i)) {
    print STDERR "$progname: not an RTSP URL: $url\n";
    exit 1;
  }

  $path = "" unless $path;

  my ($them,$port) = split(/:/, $serverstring);
  $port = 80 unless $port;
  my $oport = $port;

  print STDERR "$progname: connecting to $serverstring...\n" if $verbose;

  my ($remote, $iaddr, $paddr, $proto, $line);
  $remote = $them;
  if ($port =~ /\D/) { $port = getservbyname($port, 'tcp') }
  $port || error "unknown service: $oport/tcp";
  $iaddr = inet_aton($remote) || error "unknown host: $remote";
  $paddr = sockaddr_in($port, $iaddr);

  $proto   = getprotobyname('tcp');
  socket(SERVER, PF_INET, SOCK_STREAM, $proto) || error "socket: $!\n";
  connect(SERVER, $paddr) || error "connect: $serverstring: $!\n";

  select(SERVER); $| = 1; select(STDOUT);

  print "$progname: logging in to rtsp:$serverstring...\n" if $verbose;
  rtsp_cmd ("OPTIONS rtsp:$serverstring RTSP/1.0",
            "CSep: 1",
            "");
  my $rtsp = rtsp_reply();
  $rtsp =~ m@^RTSP/1.\d+ 2\d\d\b@ || error "error: $rtsp\n";

  my $head = "";
  while (1) {
    $_ = rtsp_reply();
    last if ($_ eq "");
    s/\r\n$/\n/;
    $head .= $_;
    last if m@^\n@;
  }

  print "$progname: checking $url...\n" if $verbose;
  rtsp_cmd ("DESCRIBE $url RTSP/1.0",
            "");
  $rtsp = rtsp_reply();
  if (! ($rtsp =~ m@^RTSP/1.\d+ 2\d\d\b@)) {
    $rtsp =~ s@^RTSP/1.\d+ @@;
    error "error: $url: $rtsp\n";
  }

  $rtsp =~ s@^RTSP/1.\d+ @@;
  print "$progname: $url: $rtsp\n" if $verbose;

  close SERVER;
}


my $usage = "usage: $progname [--verbose] rtsp_url\n";

sub main {
  my ($url);

  while ($_ = $ARGV[0]) {
    shift @ARGV;
    if ($_ eq "-verbose") { $verbose++; }
    elsif (m/^-v+$/) { $verbose += length($_)-1; }
    elsif (m/^-/) { print STDERR $usage; exit 1; }
    elsif (!defined($url)) {
      if (! m@^rtsp://@) { print STDERR $usage; exit 1; }
      $url = $_;
    } else {
      print STDERR $usage; exit 1;
    }
  }

  if (!$url) {
    print STDERR $usage;
    exit 1;
  }

  ping ($url);
}

main;
exit (0);