Telefonní systém kosmické lodi Hipporion ze SKSP2019
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 

54 lines
1.4 KiB

#!/usr/bin/perl
# (c) Pali 2019, Perl license
use strict;
use warnings;
use Net::SIP;
use Net::SIP::Util qw(laddr4dst INETSOCK ip_sockaddr2parts);
use Socket;
die "Usage: $0 host line\n" unless @ARGV == 2;
my $host = $ARGV[0];
my $line = $ARGV[1];
my $ip = inet_aton($host);
die "ERROR: Cannot resolve host\n" unless defined $ip;
my $addr = inet_ntoa($ip);
my $laddr = laddr4dst($addr);
die "ERROR: No route to host\n" unless $laddr;
my $sock = INETSOCK(Proto => 'udp', LocalAddr => $laddr, LocalPort => 0);
die "ERROR: Cannot create socket: $!\n" unless $sock;
my $lport = (ip_sockaddr2parts(getsockname($sock)))[1];
my $leg = Net::SIP::Leg->new(sock => $sock);
die "ERROR: Cannot create leg: $!\n" unless $leg;
my $ua = Net::SIP::Simple->new(from => "<sip:root\@$laddr:$lport>", leg => $leg);
die "ERROR: Cannot create SIP user agent: $!\n" unless $ua;
my ($stop, $code, $text);
$ua->{endpoint}->new_request(
'NOTIFY',
{ from => $ua->{from}, to => "<sip:$line\@$host>" },
sub {
(undef, undef, undef, $code, my $packet) = @_;
(undef, $text) = $packet ? $packet->as_parts : ();
$stop = 1;
},
'',
uri => "sip:$line\@$addr",
Event => 'check-sync',
Contact => $ua->{from},
);
$ua->loop(3, \$stop);
$ua->cleanup();
die "ERROR: Timeout\n" unless $stop;
die "ERROR: Invalid response\n" unless $code and $text;
die "ERROR: SIP response: $code $text\n" unless $code eq '200';