viewvc.cgi/mdap/mdap-server.pl

#!/usr/bin/perl

use strict;
use IO::Socket::Multicast;
use Data::Dump qw/dump/;

use constant GROUP => '224.0.0.103';
use constant PORT  => '3235';

my $debug = shift @ARGV;

my $resend_search_delay = 3;
my $tftp_path = '/srv/tftp/';

warn "search for ants every ${resend_search_delay}s\ntftp server path: $tftp_path\n";

sub fw {
        my ($board, $offset,$len) = @_;
        open(my $fh, "$tftp_path/$board") || die "Can't open image $tftp_path/$board: $!";
        my $b;
        seek($fh, $offset, 0) || die "can't seek to $offset: $!";
        read($fh, $b, $len) || die "can't read $len bytes from $offset: $!";
        close($fh);
        return $b;
}

sub fw_build {
        my $board_name = shift || return 0;
        my $v = join('.', unpack('CCCC',fw($board_name,0x20,4)) );
        print "# fw_build $board_name $v\n";
        return $v;
}

sub fw_exists {
        my $board = shift;
        return -e "$tftp_path/$board";
}

my $sock = IO::Socket::Multicast->new(LocalPort=>PORT,ReuseAddr=>1);
$sock->mcast_add(GROUP) || die "Couldn't set group: $!\n";
$sock->mcast_ttl(1);

sub ant2hash {
        my $data = shift;
        my $hash;
        map {
                if ( m/:/ ) {
                        my ($n,$v) = split(/:/,$_,2);
                        $hash->{$n} = $v;
                }
        } split(/[\n\r]/, $data);
        return $hash;
}

sub mdap_send {
        my $data = shift;
        $sock->mcast_send( "${data}", GROUP . ':' . PORT );
        if ($debug) {
                warn ">> ", dump( $data ), $/;
        } else {
                $data =~ s/\s+/ /gi;
                warn ">> ", substr($data,0,70), $/;
        }
}

local $SIG{ALRM} = sub {
        mdap_send("ANT-SEARCH MDAP/1.1\r\n46");
        alarm( $resend_search_delay );
};

alarm( $resend_search_delay );

mdap_send("ANT-SEARCH MDAP/1.1\r\n46");

while (1) {
        my $data;
        next unless $sock->recv($data,1024);

        if ( $data =~ m#^(INFO|ANT-SEARCH|EXEC-CLI|REPLY-\S+)\s(MDAP)/(\d+\.\d+)# ) {

                my ($type,$proto,$mdap_ver) = ($1,$2,$3);

                my $h = ant2hash($data);

                my $client_version = $h->{'MDAP-VERSION'};
                $mdap_ver = $client_version if ($client_version);

                print "<< $type $proto/$mdap_ver << ", length($data), " bytes\n";

                warn dump($h),$/ if ($debug);

                # we are getting our own INFO messages
                next if ( $type =~ m#^(INFO|ANT-SEARCH|EXEC-CLI)# );

                my $ant = $h->{'ANT-ID'} || die "no ANT-ID in ", dump( $h );

                if ($type eq 'REPLY-ANT-SEARCH') {
                        mdap_send("INFO MDAP/$mdap_ver\r\nSEQ-NR:1\r\nTO-ANT:$ant\r\nUSER-ID:Administrator\r\nUSER-PWD:\r\n22");
                } elsif ($type eq 'REPLY-INFO') {
                        my $board = $h->{'_BOARD_NAME'} || die "no _BOARD_NAME?";
                        if ( fw_exists( $board ) ) {
                                if ( $h->{'_BUILD'} ne fw_build( $board ) ) {
                                        print "UPDATE STEP 1 on ant $ant\n";
                                        mdap_send("EXEC-CLI MDAP/$mdap_ver\r\nCLI-CMD:software upgrade\r\nSEQ-NR:1\r\nTO-ANT:$ant\r\nUSER-ID:Administrator\r\nUSER-PWD:\r\n1F");
                                } else {
                                        print "OK ant $ant allready updated...\n";
                                }
                        } else {
                                print "!! NO FIRMWARE for $board in $tftp_path for ant $ant, skipping update\n";
                        }
                } elsif ( $type eq 'REPLY-EXEC-CLI' && $h->{'SEQ-NR'} == 1 ) {
                                print "UPDATE STEP 2 on ant $ant\n";
                                mdap_send("EXEC-CLI MDAP/$mdap_ver\r\nSEQ-NR:2\r\nTO-ANT:$ant\r\nUSER-ID:Administrator\r\nUSER-PWD:\r\n5F");
                } else {
                        print "!! reply ignored ", dump( $h ), $/;
                }

        } else {
                warn "<=" x 15, "\n", $data, "\n", "<=" x 15, "\n";
        }
}
1	dpavlin	2	#!/usr/bin/perl
2
3			use strict;
4			use IO::Socket::Multicast;
5			use Data::Dump qw/dump/;
6
7			use constant GROUP => '224.0.0.103';
8			use constant PORT => '3235';
9
10	dpavlin	8	my $debug = shift @ARGV;
11
12	dpavlin	2	my $resend_search_delay = 3;
13	dpavlin	7	my $tftp_path = '/srv/tftp/';
14	dpavlin	2
15	dpavlin	9	warn "search for ants every ${resend_search_delay}s\ntftp server path: $tftp_path\n";
16
17	dpavlin	7	sub fw {
18			my ($board, $offset,$len) = @_;
19			open(my $fh, "$tftp_path/$board") \|\| die "Can't open image $tftp_path/$board: $!";
20			my $b;
21			seek($fh, $offset, 0) \|\| die "can't seek to $offset: $!";
22			read($fh, $b, $len) \|\| die "can't read $len bytes from $offset: $!";
23			close($fh);
24			return $b;
25			}
26
27			sub fw_build {
28			my $board_name = shift \|\| return 0;
29			my $v = join('.', unpack('CCCC',fw($board_name,0x20,4)) );
30			print "# fw_build $board_name $v\n";
31			return $v;
32			}
33
34			sub fw_exists {
35			my $board = shift;
36			return -e "$tftp_path/$board";
37			}
38
39	dpavlin	2	my $sock = IO::Socket::Multicast->new(LocalPort=>PORT,ReuseAddr=>1);
40			$sock->mcast_add(GROUP) \|\| die "Couldn't set group: $!\n";
41			$sock->mcast_ttl(1);
42
43			sub ant2hash {
44			my $data = shift;
45			my $hash;
46			map {
47			if ( m/:/ ) {
48			my ($n,$v) = split(/:/,$_,2);
49			$hash->{$n} = $v;
50			}
51			} split(/[\n\r]/, $data);
52			return $hash;
53			}
54
55			sub mdap_send {
56			my $data = shift;
57			$sock->mcast_send( "${data}", GROUP . ':' . PORT );
58	dpavlin	9	if ($debug) {
59			warn ">> ", dump( $data ), $/;
60			} else {
61			$data =~ s/\s+/ /gi;
62			warn ">> ", substr($data,0,70), $/;
63			}
64	dpavlin	2	}
65
66			local $SIG{ALRM} = sub {
67			mdap_send("ANT-SEARCH MDAP/1.1\r\n46");
68			alarm( $resend_search_delay );
69			};
70
71			alarm( $resend_search_delay );
72
73	dpavlin	7	mdap_send("ANT-SEARCH MDAP/1.1\r\n46");
74
75	dpavlin	2	while (1) {
76			my $data;
77			next unless $sock->recv($data,1024);
78
79	dpavlin	9	if ( $data =~ m#^(INFO\|ANT-SEARCH\|EXEC-CLI\|REPLY-\S+)\s(MDAP)/(\d+\.\d+)# ) {
80	dpavlin	2
81	dpavlin	9	my ($type,$proto,$mdap_ver) = ($1,$2,$3);
82	dpavlin	2
83			my $h = ant2hash($data);
84
85	dpavlin	9	my $client_version = $h->{'MDAP-VERSION'};
86			$mdap_ver = $client_version if ($client_version);
87	dpavlin	7
88	dpavlin	9	print "<< $type $proto/$mdap_ver << ", length($data), " bytes\n";
89	dpavlin	2
90	dpavlin	8	warn dump($h),$/ if ($debug);
91
92	dpavlin	9	# we are getting our own INFO messages
93			next if ( $type =~ m#^(INFO\|ANT-SEARCH\|EXEC-CLI)# );
94
95			my $ant = $h->{'ANT-ID'} \|\| die "no ANT-ID in ", dump( $h );
96
97	dpavlin	2	if ($type eq 'REPLY-ANT-SEARCH') {
98	dpavlin	9	mdap_send("INFO MDAP/$mdap_ver\r\nSEQ-NR:1\r\nTO-ANT:$ant\r\nUSER-ID:Administrator\r\nUSER-PWD:\r\n22");
99	dpavlin	2	} elsif ($type eq 'REPLY-INFO') {
100	dpavlin	7	my $board = $h->{'_BOARD_NAME'} \|\| die "no _BOARD_NAME?";
101			if ( fw_exists( $board ) ) {
102			if ( $h->{'_BUILD'} ne fw_build( $board ) ) {
103			print "UPDATE STEP 1 on ant $ant\n";
104	dpavlin	9	mdap_send("EXEC-CLI MDAP/$mdap_ver\r\nCLI-CMD:software upgrade\r\nSEQ-NR:1\r\nTO-ANT:$ant\r\nUSER-ID:Administrator\r\nUSER-PWD:\r\n1F");
105	dpavlin	7	} else {
106			print "OK ant $ant allready updated...\n";
107			}
108	dpavlin	2	} else {
109	dpavlin	7	print "!! NO FIRMWARE for $board in $tftp_path for ant $ant, skipping update\n";
110	dpavlin	2	}
111	dpavlin	3	} elsif ( $type eq 'REPLY-EXEC-CLI' && $h->{'SEQ-NR'} == 1 ) {
112	dpavlin	7	print "UPDATE STEP 2 on ant $ant\n";
113	dpavlin	9	mdap_send("EXEC-CLI MDAP/$mdap_ver\r\nSEQ-NR:2\r\nTO-ANT:$ant\r\nUSER-ID:Administrator\r\nUSER-PWD:\r\n5F");
114	dpavlin	2	} else {
115	dpavlin	8	print "!! reply ignored ", dump( $h ), $/;
116	dpavlin	2	}
117
118			} else {
119	dpavlin	8	warn "<=" x 15, "\n", $data, "\n", "<=" x 15, "\n";
120	dpavlin	2	}
121			}