Quelltext von Seite Svdrp-control ansehen

<pre>
#!/usr/bin/perl -w
#
# $Id: vdr-control.pl,v 1.4 2003/08/10 10:01:20 ville Exp $
#
# Script for sending SVDRP commands to remote VDR host
#

use strict;
use IO::Socket;

require 5.006_000;



##########
# Settings
#

# Default configuration settings
#  These are used if not overridden by command line options.
my %conf;
$conf{'vdrhost'}   = "jeppe.poliisi.iki.fi";
$conf{'vdrport'}   = "2001";
#$conf{'bindaddr'}  = "poliisi.iki.fi";
#$conf{'logfile'}   = "./vdr-control.log";
#$conf{'cmdfile'}   = "./vdr-commands.txt";

# The process name of this script
my $me = substr( $0, rindex( $0, '/' ) + 1 );

my $DEBUG = 1;

$SIG{INT}  = \&cleanup;
$SIG{TERM} = \&cleanup;
$SIG{PIPE} = 'IGNORE';



##########
# Functions
#


# svdrp_connect() - Connect TCP socket to SVDRP service,
#                   check initial response,
#                   return socket handle.
sub svdrp_connect()
{
    $DEBUG && print STDERR "D: Entering svdrp_connect()... \n";
    # Create socket.
    $DEBUG && print STDERR "D: Creating socket...";
    my $socket = new IO::Socket::INET->new(
      Proto     => 'tcp',
      LocalAddr => defined( $conf{'bind'} )  ?  $conf{'bind'}  :  undef,
      PeerAddr  => $conf{'vdrhost'},
      PeerPort  => $conf{'vdrport'}
      )
      or die ( "ERROR: Connecting to $conf{'vdrhost'}:$conf{'vdrport'}: $!\n" );
    $DEBUG && print STDERR " OK.\n";

    # Check VDR host initial response.
    if ( $socket ) {
        $DEBUG && print STDERR "D: Reading VDR response...";
        #defined( my $input = readline $socket ) or
        #  &cleanup( $socket, "ERROR: Socket read error: $!\n" );
        my $input = readline $socket;
        $DEBUG && print STDERR " OK.\n";
        $DEBUG && print STDERR "D: Checking response validity...";
        if ( (! $input) || ($input !~ /^220 /) ) { # VDR host response not OK.
            &cleanup( $socket, "ERROR: From VDR host: $input\n" );
        }
        $DEBUG && print STDERR " OK.\n";
    } else { # Socket not OK.
        &cleanup( undef, "ERROR: Socket error: $!\n" );
    }

    $DEBUG && print STDERR "D: Returning svdrp_connect()... \n";
    return $socket;
}


# send_commands() - Writes SVDRP commands to socket.
sub send_commands
{
    my( $socket, @commands ) = @_;
    my $response;

    # Send SVDRP commands.
    foreach ( @commands ) {
        print $socket $_, "\n";
	$response = readline $socket;
	if ( $response !~ /^250 / ) {	# VDR host response not OK.
           &cleanup( $socket,
             "ERROR: Response to command \'$_\': $response\n" );
        }
    }
}


# cleanup() - Clean up and exit.
sub cleanup
{
    my( $socket, $message ) = @_;

    # Print error message if any.
    print STDERR $message;

    if ( $socket ) {
        # Close the SVDRP connection.
        print $socket "quit\n";
	my $reply = readline $socket;

        # Close the socket.
        close $socket or die "ERROR: Failed closing socket: $!\n";

	if ( !defined( $reply ) || $reply !~ /^221 / ) { # VDR reply not OK.
            print STDERR
              "WARNING: SVDRP connection uncleanly closed, expect VDR crash!\n";
        }
    }
    exit;
}


# usage() - Prints usage information
sub usage
{
    print STDERR "Usage: $me {OPTIONS} <SVDRP command>\n",
      "Options:\n",
      "--host <host>\tRemote host IP address or hostname\n",
      "--port <port>\tRemote host SVDRP service port\n",
      "--bind <host>\tLocal hostname or address to bind to.\n",
      "--file <file>\tFile name to read SVDRP commands from, use \n",
      "             \t\'-\' to read command list from standard input\n";
    exit;
}



##########
# Main
#

# Parse command line. This really should be made more elegantly...
my @cmds;
if ( @ARGV == 0 ) { usage(); }
foreach (@ARGV) {

    # Options
    if ( $_ eq "--help" ) { usage(); }
    if ( $_ eq "--host" ) { shift; $conf{'vdrhost'} = $ARGV[0]; shift; next }
    if ( $_ eq "--port" ) { shift; $conf{'vdrport'} = $ARGV[0]; shift; next }
    if ( $_ eq "--bind" ) { shift; $conf{'bind'}    = $ARGV[0]; shift; next }
    if ( $_ eq "--file" ) { shift; $conf{'cmdfile'} = $ARGV[0]; shift; next }
    push ( @cmds, join ( ' ', @ARGV ) );
}


# Read command file.
if ( defined $conf{'cmdfile'} ) {
    open( CMD, "<$conf{'cmdfile'}" ) or
      die "Unable read command from file $conf{'cmdfile'}: $!\n";
    if ( "$conf{'cmdfile'}" eq "-" ) {
        print STDERR "Connected OK. ",
                     "Insert commands one by line, ",
                     "EOF (ctrl+d) to finish.\n";
    }
    while ( <CMD> ) {
      chomp;
      next if /^#/;	# Skip comments.
      next if /^$/;	# Skip empty lines.
      push @cmds, $_;
    }
}

# Initialize connection.
my $socket = svdrp_connect();

# Energize.
send_commands( $socket, @cmds );

# Try to exit cleanly.
&cleanup( $socket, 0, "" );
</pre>