frodovdr/vdr
1
0
Fork 0
mirror of https://github.com/VDR4Arch/vdr.git synced 2023-10-10 13:36:52 +02:00
Code Issues Releases Wiki Activity

Adapted to the new CONN command

Browse Source
This commit is contained in:
Klaus Schmidinger 2018-02-25 12:42:58 +01:00
parent 361d642660
commit bbbc36a1e6
1 changed files with 54 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

88
peerdemo
View File

@ -2,7 +2,12 @@
# VDR SVDRP Peer Demo # VDR SVDRP Peer Demo
# #
# (C) 2017 by Klaus Schmidinger <Klaus.Schmidinger@tvdr.de> # This script broadcasts an SVDRP discover datagram on the SVDRP UDP port and
# then listens for replies from peer VDRs on both the UDP and TCP port.
# It reacts properly to the SVDRP commands CONN, LSTT, POLL, PING and QUIT,
# and thus seems like a regular VDR to other VDRs.
#
# (C) 2018 by Klaus Schmidinger <Klaus.Schmidinger@tvdr.de>
use Getopt::Std; use Getopt::Std;
use IO::Socket; use IO::Socket;
@ -11,14 +16,12 @@ use IO::Select;
$Usage = qq{ $Usage = qq{
Usage: $0 options Usage: $0 options
Options: -c communicate with peer VDR Options: -v be verbose
-v be verbose
}; };
die $Usage if (!getopts("cv")); die $Usage if (!getopts("cv"));
$Communicate = $opt_c || 0; $Verbose = $opt_v || 0;
$Verbose = $opt_v || 0;
$SvdrpPort = 6419; $SvdrpPort = 6419;
$MyName = "peerdemo"; $MyName = "peerdemo";
@ -42,16 +45,9 @@ $BcastSocket->close();
while (1) { while (1) {
if ($UdpSocket->recv($Request, 1024)) { if ($UdpSocket->recv($Request, 1024)) {
if ($SkippedFirstUdpPacket++) { # the first one is the one we sent, so skip it if (Extract($Request, "name") ne $MyName) {
Log('<', $UdpSocket, $Request); Log('<', $UdpSocket, $Request);
$Request .= " "; # for easier parsing ReportVDR($Request, $UdpSocket->peerhost());
my $Name = Extract($Request, "name");
my $Port = Extract($Request, "port");
my $VdrVersion = Extract($Request, "vdrversion");
my $ApiVersion = Extract($Request, "apiversion");
my $Timeout = Extract($Request, "timeout");
my $PeerHost = $UdpSocket->peerhost();
print("found VDR '$Name' at $PeerHost with SVDRP port '$Port'\n");
} }
} }
if (my @Ready = $SvdrpSelect->can_read(0.01)) { if (my @Ready = $SvdrpSelect->can_read(0.01)) {
@ -63,30 +59,34 @@ while (1) {
# send mandatory response to simulate an SVDRP host: # send mandatory response to simulate an SVDRP host:
my $Prompt = "220 $MyName SVDRP VideoDiskRecorder 2.3.9; Wed Nov 29 17:00:29 2017; ISO-8859-1"; my $Prompt = "220 $MyName SVDRP VideoDiskRecorder 2.3.9; Wed Nov 29 17:00:29 2017; ISO-8859-1";
Log('>', $new, $Prompt); Log('>', $new, $Prompt);
print($new $Prompt); print($new "$Prompt\n");
if ($Communicate) { # add incoming connection to select:
# add incoming connection to select: $SvdrpSelect->add($new);
$SvdrpSelect->add($new);
}
else {
# close connection:
$new->close;
}
} }
else { else {
# process connection: # process connection:
my $Request; my $Request = "";
if ($fh->recv($Request, 1024)) { $fh->recv($Request, 1024);
Log('<', $fh, $Request); chomp($Request);
if ($Request =~ /^LSTT/) { Log('<', $fh, $Request);
my $Response = "550 No timers defined"; if ($Request =~ /^CONN/) {
Log('>', $fh, $Response); Reply($fh, "250 OK");
print($fh "$Response\n"); ReportVDR($Request, $fh->peerhost());
} }
elsif ($Request =~ /^LSTT/) {
Reply($fh, "550 No timers defined");
}
elsif ($Request =~ /^POLL/) {
Reply($fh, "250 OK");
}
elsif ($Request =~ /^PING/) {
Reply($fh, "250 $MyName is alive");
}
elsif ($Request =~ /^QUIT/) {
# close connection:
$SvdrpSelect->remove($fh);
$fh->close;
} }
# close connection:
$SvdrpSelect->remove($fh);
$fh->close;
} }
} }
} }
@ -94,6 +94,26 @@ while (1) {
# Tools: # Tools:
sub Reply
{
my ($fh, $s) = @_;
Log('>', $fh, $s);
print($fh "$s\n");
}
sub ReportVDR
{
my $s = shift;
my $PeerHost = shift;
$s .= " "; # for easier parsing
my $Name = Extract($s, "name");
my $Port = Extract($s, "port");
my $VdrVersion = Extract($s, "vdrversion");
my $ApiVersion = Extract($s, "apiversion");
my $Timeout = Extract($s, "timeout");
print("found VDR '$Name' at $PeerHost with SVDRP port '$Port'\n");
}
sub Extract sub Extract
{ {
my ($s, $n) = @_; my ($s, $n) = @_;