1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
|
#!/usr/bin/perl
# VDR SVDRP Peer Demo
#
# 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 IO::Socket;
use IO::Select;
$Usage = qq{
Usage: $0 options
Options: -v be verbose
};
die $Usage if (!getopts("cv"));
$Verbose = $opt_v || 0;
$SvdrpPort = 6419;
$MyName = "peerdemo";
# Open TCP and UDP sockets:
$TcpSocket = new IO::Socket::INET(Listen => 5, LocalPort => $SvdrpPort, Proto => "tcp", ReusePort => 1) || die "$!";
$UdpSocket = new IO::Socket::INET( LocalPort => $SvdrpPort, Proto => "udp", ReusePort => 1) || die "$!";
$SvdrpSelect = new IO::Select($TcpSocket);
setsockopt($UdpSocket, SOL_SOCKET, SO_RCVTIMEO, pack('L!L!', 0, 1000)); # 1ms timeout on UDP socket
# Send UDP broadcast:
$BcastSocket = new IO::Socket::INET(PeerAddr => '255.255.255.255', PeerPort => $SvdrpPort, Proto => "udp", Broadcast => 1) || die "$!";
$BcastMsg = "SVDRP:discover name:$MyName port:6419 vdrversion:20309 apiversion:20309 timeout:300";
Log('>', $BcastSocket, $BcastMsg);
print($BcastSocket $BcastMsg);
$BcastSocket->close();
# Listen on UDP and TCP socket:
while (1) {
if ($UdpSocket->recv($Request, 1024)) {
if (Extract($Request, "name") ne $MyName) {
Log('<', $UdpSocket, $Request);
ReportVDR($Request, $UdpSocket->peerhost());
}
}
if (my @Ready = $SvdrpSelect->can_read(0.01)) {
for my $fh (@Ready) {
if ($fh == $TcpSocket) {
# accept connection:
my $new = $TcpSocket->accept();
Log('<', $new, "incoming TCP connection");
# 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";
Log('>', $new, $Prompt);
print($new "$Prompt\n");
# add incoming connection to select:
$SvdrpSelect->add($new);
}
else {
# process connection:
my $Request = "";
$fh->recv($Request, 1024);
chomp($Request);
Log('<', $fh, $Request);
if ($Request =~ /^CONN/) {
Reply($fh, "250 OK");
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;
}
}
}
}
}
# 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
{
my ($s, $n) = @_;
return ($s =~ / $n:([^ ]*) /)[0];
}
sub Log
{
return unless ($Verbose);
my ($Dir, $Socket, $Msg) = @_;
printf("SVDRP %s [%s:%s] %s\n", $Dir, $Socket->peerhost(), $Socket->peerport(), $Msg);
}
|
