Aus VDR Wiki
#!/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, "" );