viewvc.cgi/mdap/mdap-server.pl

#!/usr/bin/perl

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

my $GROUP = '224.0.0.103';
my $PORT  = '3235';

my $debug = 0;
my $quiet = 1;
my $verbose = 0;
my $credentials = 0;

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

my $flashed_cmd = 'system config led=flash';

GetOptions(
        "port=i"        => \$PORT,
        "group=s"       => \$GROUP,
        "debug!"        => \$debug,
        "quiet!"        => \$quiet,
        "verbose!"      => \$verbose,
        "search=i"      => \$resend_search_delay,
        "tftp=s"        => \$tftp_path,
        "credentials"   => \$credentials,
        "exec=s"        => \$flashed_cmd,
);

$quiet = 0 if $verbose;
$credentials = 1 if $debug;

# tab-delimited list of user id/passwd to try on ants
my @try_accounts = ( "Administrator\t" );

my $passwd_path = $0;
$passwd_path =~ s/[^\/]+$/passwd/;

if (-e $passwd_path) {
        open(my $fh, $passwd_path) || die "can't open $passwd_path: $!";
        while(<$fh>) {
                chomp;
                next if /^#/ || /^$/ || /^\s+$/;
                if (/^\S+\s+\S+$/) {
                        push @try_accounts, $_;
                } else {
                        warn "invalid $passwd_path entry: $_\n";
                }
        }
        print "found ", $#try_accounts + 1, " accounts to try on password protected ants",
                $credentials ? " and display credentials" : "", "\n";
}

warn "search for ants every ${resend_search_delay}s\ntftp server path: $tftp_path\nflashed to current version: $flashed_cmd\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" unless $quiet;
        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;

        my $xor = 0;
        map { $xor ^= ord($_) } split(//,$data);
        $data .= sprintf('%02X', $xor);

        $sock->mcast_send( $data, "${GROUP}:${PORT}" );
        if ($debug) {
                warn ">> ${GROUP}:${PORT} >> ", dump( $data ), $/;
        } elsif( ! $quiet ) {
                $data =~ s/\s+/ /gi;
                warn ">> ", substr($data,0,70), $/;
        }
}

my $ant_passwd;
my $ant_unknown_password;
my $ant_ok_password;
my $ant_flashing;

sub ant_credentials {
        my $ant = shift || die "no ant?";
        my $i = $ant_passwd->{$ant} || 0;
        my ($user_id,$user_pwd) = split(/\t/, $try_accounts[$i]);
        #warn "ant $ant as [$i] $user_id / $user_pwd\n";
        return ($user_id,$user_pwd);
}

sub ant_unknown_password {
        my $ant = shift || die "no ant?";
        if ( $ant_unknown_password->{$ant} ) {
                $ant_unknown_password->{$ant}--;
        }
        return $ant_unknown_password->{$ant};
}

sub ant_another_passwd {
        my $ant = shift || die "no ant?";

        return 0 if ant_unknown_password( $ant );
        return 0 if $ant_ok_password->{$ant};

        $ant_passwd->{$ant}++;

        if ( $ant_passwd->{$ant} > $#try_accounts ) {
                print "$ant ant with unknown password\n";
                $ant_unknown_password->{$ant} = 10;
                $ant_passwd->{$ant} = 0;
                return 0;
        }
        return 1;
}

sub forget_ant {
        my $ant = shift || die "no ant?";
        delete $ant_unknown_password->{$ant};
        delete $ant_passwd->{$ant};
        delete $ant_ok_password->{$ant};
}

my $once;

sub once {
        my $m = join('', @_);
        $once->{$m}++;
        print $m if ($once->{$m} == 1);
}

my $status = '';

sub status {
        my $m = join('', @_);
        if ($m ne $status) {
                print $m;
                $status = $m;
        }
}

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

alarm( $resend_search_delay );

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

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" unless $quiet;

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

                # we are getting our own messages (since our source port
                # is same as destination)
                next if ( $type =~ m#^(INFO|ANT-SEARCH|EXEC-CLI)# );

                my $ant = $h->{'ANT-ID'} || die "no ANT-ID in ", dump( $h );
                my $seq_nr = $h->{'SEQ-NR'};
                #warn "SEQ-NR: $seq_nr ok: ",$ant_ok_password->{$ant},"\n" if ($seq_nr);

                my ($user_id,$user_pwd) = ant_credentials( $ant );

                if ($type eq 'REPLY-ANT-SEARCH') {
                        mdap_send("INFO MDAP/$mdap_ver\r\nSEQ-NR:1\r\nTO-ANT:$ant\r\nUSER-ID:$user_id\r\nUSER-PWD:$user_pwd\r\n") unless ant_unknown_password( $ant );
                } elsif ($type eq 'REPLY-INFO') {

                        if ( $seq_nr < 0 ) {
#                               if ( $ant_ok_password ) {
#                                       $ant_ok_password->{$ant} = 0;
#                               } elsif ( ant_another_passwd( $ant ) ) {
                                if ( ant_another_passwd( $ant ) ) {
                                        ($user_id,$user_pwd) = ant_credentials( $ant );
                                        mdap_send("INFO MDAP/$mdap_ver\r\nSEQ-NR:1\r\nTO-ANT:$ant\r\nUSER-ID:$user_id\r\nUSER-PWD:$user_pwd\r\n");
                                }
                                next;
                        } else {
                                $ant_ok_password->{$ant}++;
                                print "$ant credentials $user_id $user_pwd\n" if ( $credentials && $ant_ok_password->{$ant} == 1 ) || $debug;
                        }

                        my $board = $h->{'_BOARD_NAME'} || die "no _BOARD_NAME?";
                        if ( fw_exists( $board ) ) {
                                my $build = $h->{'_BUILD'} || die "no _BUILD?";
                                my $new_build = fw_build( $board );
                                if ( $build ne $new_build ) {
                                        print "+ $ant version $build -> $new_build\n";
                                        mdap_send("EXEC-CLI MDAP/$mdap_ver\r\nCLI-CMD:software upgrade\r\nSEQ-NR:1\r\nTO-ANT:$ant\r\nUSER-ID:$user_id\r\nUSER-PWD:$user_pwd\r\n");
                                        $ant_flashing->{$ant}++;
                                } else {
                                        once "$ant OK version $build",
                                                $ant_unknown_password->{$ant} ? ' with unknown password' :
                                                $ant_passwd->{$ant} ? ' password protected' :
                                                '',
                                                "\n";

                                        $ant_flashing->{$ant} = 0;
                                        # green|red|orange|flash|off
                                        mdap_send("EXEC-CLI MDAP/$mdap_ver\r\nCLI-CMD:$flashed_cmd\r\nSEQ-NR:1\r\nTO-ANT:$ant\r\nUSER-ID:$user_id\r\nUSER-PWD:$user_pwd\r\n");
                                        my $waiting = 0;
                                        my $count = 0;
                                        map {
                                                $waiting++ if ($ant_flashing->{$_});
                                                $count++;
                                        } keys %$ant_flashing;
                                        if ($waiting == 0) {
                                                status "ALL $count ANTS FLASHED to $build\n";
                                                $ant_flashing = undef;
                                        } else {
                                                status "$waiting of $count ants still flasing upto $build\n";
                                        }
                                }
                        } else {
                                once "!! NO FIRMWARE for $board in $tftp_path for ant $ant, skipping update\n";
                        }
                } elsif ( $type eq 'REPLY-EXEC-CLI' ) {
                        print "+ $type\n$data\n" if ($verbose);
                        if ( $seq_nr == 1 ) {
                                mdap_send("EXEC-CLI MDAP/$mdap_ver\r\nSEQ-NR:2\r\nTO-ANT:$ant\r\nUSER-ID:$user_id\r\nUSER-PWD:$user_pwd\r\n");
                                forget_ant( $ant ) if ( $ant_flashing->{$ant} );
                        }

                } else {
                        print "!! reply $type 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	dpavlin	19	use Getopt::Long;
7	dpavlin	2
8	dpavlin	19	my $GROUP = '224.0.0.103';
9			my $PORT = '3235';
10	dpavlin	2
11	dpavlin	19	my $debug = 0;
12			my $quiet = 1;
13			my $verbose = 0;
14	dpavlin	31	my $credentials = 0;
15	dpavlin	8
16	dpavlin	2	my $resend_search_delay = 3;
17	dpavlin	7	my $tftp_path = '/srv/tftp/';
18	dpavlin	2
19	dpavlin	39	my $flashed_cmd = 'system config led=flash';
20
21	dpavlin	19	GetOptions(
22			"port=i" => \$PORT,
23			"group=s" => \$GROUP,
24			"debug!" => \$debug,
25			"quiet!" => \$quiet,
26			"verbose!" => \$verbose,
27			"search=i" => \$resend_search_delay,
28			"tftp=s" => \$tftp_path,
29	dpavlin	31	"credentials" => \$credentials,
30	dpavlin	39	"exec=s" => \$flashed_cmd,
31	dpavlin	19	);
32
33			$quiet = 0 if $verbose;
34	dpavlin	32	$credentials = 1 if $debug;
35	dpavlin	19
36	dpavlin	17	# tab-delimited list of user id/passwd to try on ants
37			my @try_accounts = ( "Administrator\t" );
38	dpavlin	14
39	dpavlin	17	my $passwd_path = $0;
40			$passwd_path =~ s/[^\/]+$/passwd/;
41
42			if (-e $passwd_path) {
43			open(my $fh, $passwd_path) \|\| die "can't open $passwd_path: $!";
44			while(<$fh>) {
45			chomp;
46			next if /^#/ \|\| /^$/ \|\| /^\s+$/;
47	dpavlin	37	if (/^\S+\s+\S+$/) {
48	dpavlin	17	push @try_accounts, $_;
49			} else {
50			warn "invalid $passwd_path entry: $_\n";
51			}
52			}
53	dpavlin	39	print "found ", $#try_accounts + 1, " accounts to try on password protected ants",
54			$credentials ? " and display credentials" : "", "\n";
55	dpavlin	17	}
56
57	dpavlin	39	warn "search for ants every ${resend_search_delay}s\ntftp server path: $tftp_path\nflashed to current version: $flashed_cmd\n";
58	dpavlin	9
59	dpavlin	7	sub fw {
60			my ($board, $offset,$len) = @_;
61			open(my $fh, "$tftp_path/$board") \|\| die "Can't open image $tftp_path/$board: $!";
62			my $b;
63			seek($fh, $offset, 0) \|\| die "can't seek to $offset: $!";
64			read($fh, $b, $len) \|\| die "can't read $len bytes from $offset: $!";
65			close($fh);
66			return $b;
67			}
68
69			sub fw_build {
70			my $board_name = shift \|\| return 0;
71			my $v = join('.', unpack('CCCC',fw($board_name,0x20,4)) );
72	dpavlin	19	print "# fw_build $board_name $v\n" unless $quiet;
73	dpavlin	7	return $v;
74			}
75
76			sub fw_exists {
77			my $board = shift;
78			return -e "$tftp_path/$board";
79			}
80
81	dpavlin	19	my $sock = IO::Socket::Multicast->new(LocalPort=>$PORT,ReuseAddr=>1);
82			$sock->mcast_add($GROUP) \|\| die "Couldn't set group: $!\n";
83	dpavlin	2	$sock->mcast_ttl(1);
84
85			sub ant2hash {
86			my $data = shift;
87			my $hash;
88			map {
89			if ( m/:/ ) {
90			my ($n,$v) = split(/:/,$_,2);
91			$hash->{$n} = $v;
92			}
93			} split(/[\n\r]/, $data);
94			return $hash;
95			}
96
97			sub mdap_send {
98			my $data = shift;
99	dpavlin	14
100			my $xor = 0;
101			map { $xor ^= ord($_) } split(//,$data);
102			$data .= sprintf('%02X', $xor);
103
104	dpavlin	19	$sock->mcast_send( $data, "${GROUP}:${PORT}" );
105	dpavlin	9	if ($debug) {
106	dpavlin	32	warn ">> ${GROUP}:${PORT} >> ", dump( $data ), $/;
107	dpavlin	19	} elsif( ! $quiet ) {
108	dpavlin	9	$data =~ s/\s+/ /gi;
109			warn ">> ", substr($data,0,70), $/;
110			}
111	dpavlin	2	}
112
113	dpavlin	20	my $ant_passwd;
114	dpavlin	28	my $ant_unknown_password;
115			my $ant_ok_password;
116			my $ant_flashing;
117	dpavlin	17
118			sub ant_credentials {
119			my $ant = shift \|\| die "no ant?";
120	dpavlin	20	my $i = $ant_passwd->{$ant} \|\| 0;
121	dpavlin	17	my ($user_id,$user_pwd) = split(/\t/, $try_accounts[$i]);
122			#warn "ant $ant as [$i] $user_id / $user_pwd\n";
123			return ($user_id,$user_pwd);
124			}
125
126	dpavlin	25	sub ant_unknown_password {
127			my $ant = shift \|\| die "no ant?";
128			if ( $ant_unknown_password->{$ant} ) {
129			$ant_unknown_password->{$ant}--;
130			}
131			return $ant_unknown_password->{$ant};
132			}
133
134	dpavlin	17	sub ant_another_passwd {
135			my $ant = shift \|\| die "no ant?";
136	dpavlin	20
137	dpavlin	25	return 0 if ant_unknown_password( $ant );
138	dpavlin	28	return 0 if $ant_ok_password->{$ant};
139	dpavlin	25
140	dpavlin	20	$ant_passwd->{$ant}++;
141
142			if ( $ant_passwd->{$ant} > $#try_accounts ) {
143	dpavlin	23	print "$ant ant with unknown password\n";
144	dpavlin	26	$ant_unknown_password->{$ant} = 10;
145	dpavlin	24	$ant_passwd->{$ant} = 0;
146	dpavlin	20	return 0;
147			}
148			return 1;
149	dpavlin	17	}
150
151	dpavlin	27	sub forget_ant {
152			my $ant = shift \|\| die "no ant?";
153			delete $ant_unknown_password->{$ant};
154			delete $ant_passwd->{$ant};
155			delete $ant_ok_password->{$ant};
156			}
157
158	dpavlin	20	my $once;
159
160			sub once {
161	dpavlin	23	my $m = join('', @_);
162	dpavlin	20	$once->{$m}++;
163			print $m if ($once->{$m} == 1);
164			}
165
166	dpavlin	30	my $status = '';
167
168			sub status {
169			my $m = join('', @_);
170			if ($m ne $status) {
171			print $m;
172			$status = $m;
173			}
174			}
175
176	dpavlin	2	local $SIG{ALRM} = sub {
177	dpavlin	14	mdap_send("ANT-SEARCH MDAP/1.1\r\n");
178	dpavlin	2	alarm( $resend_search_delay );
179			};
180
181			alarm( $resend_search_delay );
182
183	dpavlin	14	mdap_send("ANT-SEARCH MDAP/1.1\r\n");
184	dpavlin	7
185	dpavlin	2	while (1) {
186			my $data;
187			next unless $sock->recv($data,1024);
188
189	dpavlin	9	if ( $data =~ m#^(INFO\|ANT-SEARCH\|EXEC-CLI\|REPLY-\S+)\s(MDAP)/(\d+\.\d+)# ) {
190	dpavlin	2
191	dpavlin	9	my ($type,$proto,$mdap_ver) = ($1,$2,$3);
192	dpavlin	2
193			my $h = ant2hash($data);
194
195	dpavlin	9	my $client_version = $h->{'MDAP-VERSION'};
196			$mdap_ver = $client_version if ($client_version);
197	dpavlin	7
198	dpavlin	19	print "<< $type $proto/$mdap_ver << ", length($data), " bytes\n" unless $quiet;
199	dpavlin	2
200	dpavlin	32	warn dump( $data, $h ),$/ if ($debug);
201	dpavlin	8
202	dpavlin	17	# we are getting our own messages (since our source port
203			# is same as destination)
204	dpavlin	9	next if ( $type =~ m#^(INFO\|ANT-SEARCH\|EXEC-CLI)# );
205
206			my $ant = $h->{'ANT-ID'} \|\| die "no ANT-ID in ", dump( $h );
207	dpavlin	24	my $seq_nr = $h->{'SEQ-NR'};
208			#warn "SEQ-NR: $seq_nr ok: ",$ant_ok_password->{$ant},"\n" if ($seq_nr);
209	dpavlin	9
210	dpavlin	17	my ($user_id,$user_pwd) = ant_credentials( $ant );
211
212	dpavlin	2	if ($type eq 'REPLY-ANT-SEARCH') {
213	dpavlin	25	mdap_send("INFO MDAP/$mdap_ver\r\nSEQ-NR:1\r\nTO-ANT:$ant\r\nUSER-ID:$user_id\r\nUSER-PWD:$user_pwd\r\n") unless ant_unknown_password( $ant );
214	dpavlin	2	} elsif ($type eq 'REPLY-INFO') {
215	dpavlin	15
216	dpavlin	24	if ( $seq_nr < 0 ) {
217	dpavlin	27	# if ( $ant_ok_password ) {
218			# $ant_ok_password->{$ant} = 0;
219			# } elsif ( ant_another_passwd( $ant ) ) {
220			if ( ant_another_passwd( $ant ) ) {
221	dpavlin	24	($user_id,$user_pwd) = ant_credentials( $ant );
222	dpavlin	20	mdap_send("INFO MDAP/$mdap_ver\r\nSEQ-NR:1\r\nTO-ANT:$ant\r\nUSER-ID:$user_id\r\nUSER-PWD:$user_pwd\r\n");
223			}
224	dpavlin	15	next;
225	dpavlin	24	} else {
226			$ant_ok_password->{$ant}++;
227	dpavlin	32	print "$ant credentials $user_id $user_pwd\n" if ( $credentials && $ant_ok_password->{$ant} == 1 ) \|\| $debug;
228	dpavlin	15	}
229
230	dpavlin	7	my $board = $h->{'_BOARD_NAME'} \|\| die "no _BOARD_NAME?";
231			if ( fw_exists( $board ) ) {
232	dpavlin	14	my $build = $h->{'_BUILD'} \|\| die "no _BUILD?";
233			my $new_build = fw_build( $board );
234			if ( $build ne $new_build ) {
235	dpavlin	23	print "+ $ant version $build -> $new_build\n";
236	dpavlin	14	mdap_send("EXEC-CLI MDAP/$mdap_ver\r\nCLI-CMD:software upgrade\r\nSEQ-NR:1\r\nTO-ANT:$ant\r\nUSER-ID:$user_id\r\nUSER-PWD:$user_pwd\r\n");
237	dpavlin	33	$ant_flashing->{$ant}++;
238	dpavlin	7	} else {
239	dpavlin	23	once "$ant OK version $build",
240	dpavlin	24	$ant_unknown_password->{$ant} ? ' with unknown password' :
241	dpavlin	33	$ant_passwd->{$ant} ? ' password protected' :
242	dpavlin	24	'',
243	dpavlin	23	"\n";
244	dpavlin	32
245	dpavlin	28	$ant_flashing->{$ant} = 0;
246	dpavlin	32	# green\|red\|orange\|flash\|off
247	dpavlin	39	mdap_send("EXEC-CLI MDAP/$mdap_ver\r\nCLI-CMD:$flashed_cmd\r\nSEQ-NR:1\r\nTO-ANT:$ant\r\nUSER-ID:$user_id\r\nUSER-PWD:$user_pwd\r\n");
248	dpavlin	28	my $waiting = 0;
249	dpavlin	29	my $count = 0;
250	dpavlin	28	map {
251			$waiting++ if ($ant_flashing->{$_});
252	dpavlin	29	$count++;
253	dpavlin	28	} keys %$ant_flashing;
254	dpavlin	30	if ($waiting == 0) {
255			status "ALL $count ANTS FLASHED to $build\n";
256			$ant_flashing = undef;
257			} else {
258			status "$waiting of $count ants still flasing upto $build\n";
259	dpavlin	29	}
260	dpavlin	7	}
261	dpavlin	2	} else {
262	dpavlin	20	once "!! NO FIRMWARE for $board in $tftp_path for ant $ant, skipping update\n";
263	dpavlin	2	}
264	dpavlin	32	} elsif ( $type eq 'REPLY-EXEC-CLI' ) {
265	dpavlin	39	print "+ $type\n$data\n" if ($verbose);
266	dpavlin	32	if ( $seq_nr == 1 ) {
267	dpavlin	14	mdap_send("EXEC-CLI MDAP/$mdap_ver\r\nSEQ-NR:2\r\nTO-ANT:$ant\r\nUSER-ID:$user_id\r\nUSER-PWD:$user_pwd\r\n");
268	dpavlin	33	forget_ant( $ant ) if ( $ant_flashing->{$ant} );
269	dpavlin	32	}
270	dpavlin	39
271	dpavlin	2	} else {
272	dpavlin	32	print "!! reply $type ignored ", dump( $h ), $/;
273	dpavlin	2	}
274
275			} else {
276	dpavlin	8	warn "<=" x 15, "\n", $data, "\n", "<=" x 15, "\n";
277	dpavlin	2	}
278			}