/[mdap]/mdap-server.pl
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Contents of /mdap-server.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 15 - (show annotations)
Mon Apr 23 00:04:26 2007 UTC (16 years, 11 months ago) by dpavlin
File MIME type: text/plain
File size: 3508 byte(s)
detect password protected ants
1 #!/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 my $debug = shift @ARGV;
11
12 my $resend_search_delay = 3;
13 my $tftp_path = '/srv/tftp/';
14
15 my $user_id = 'Administrator';
16 my $user_pwd = '';
17
18 warn "search for ants every ${resend_search_delay}s\ntftp server path: $tftp_path\n";
19
20 sub fw {
21 my ($board, $offset,$len) = @_;
22 open(my $fh, "$tftp_path/$board") || die "Can't open image $tftp_path/$board: $!";
23 my $b;
24 seek($fh, $offset, 0) || die "can't seek to $offset: $!";
25 read($fh, $b, $len) || die "can't read $len bytes from $offset: $!";
26 close($fh);
27 return $b;
28 }
29
30 sub fw_build {
31 my $board_name = shift || return 0;
32 my $v = join('.', unpack('CCCC',fw($board_name,0x20,4)) );
33 print "# fw_build $board_name $v\n";
34 return $v;
35 }
36
37 sub fw_exists {
38 my $board = shift;
39 return -e "$tftp_path/$board";
40 }
41
42 my $sock = IO::Socket::Multicast->new(LocalPort=>PORT,ReuseAddr=>1);
43 $sock->mcast_add(GROUP) || die "Couldn't set group: $!\n";
44 $sock->mcast_ttl(1);
45
46 sub ant2hash {
47 my $data = shift;
48 my $hash;
49 map {
50 if ( m/:/ ) {
51 my ($n,$v) = split(/:/,$_,2);
52 $hash->{$n} = $v;
53 }
54 } split(/[\n\r]/, $data);
55 return $hash;
56 }
57
58 sub mdap_send {
59 my $data = shift;
60
61 my $xor = 0;
62 map { $xor ^= ord($_) } split(//,$data);
63 $data .= sprintf('%02X', $xor);
64
65 $sock->mcast_send( $data, GROUP . ':' . PORT );
66 if ($debug) {
67 warn ">> ", dump( $data ), $/;
68 } else {
69 $data =~ s/\s+/ /gi;
70 warn ">> ", substr($data,0,70), $/;
71 }
72 }
73
74 local $SIG{ALRM} = sub {
75 mdap_send("ANT-SEARCH MDAP/1.1\r\n");
76 alarm( $resend_search_delay );
77 };
78
79 alarm( $resend_search_delay );
80
81 mdap_send("ANT-SEARCH MDAP/1.1\r\n");
82
83 while (1) {
84 my $data;
85 next unless $sock->recv($data,1024);
86
87 if ( $data =~ m#^(INFO|ANT-SEARCH|EXEC-CLI|REPLY-\S+)\s(MDAP)/(\d+\.\d+)# ) {
88
89 my ($type,$proto,$mdap_ver) = ($1,$2,$3);
90
91 my $h = ant2hash($data);
92
93 my $client_version = $h->{'MDAP-VERSION'};
94 $mdap_ver = $client_version if ($client_version);
95
96 print "<< $type $proto/$mdap_ver << ", length($data), " bytes\n";
97
98 warn dump($h),$/ if ($debug);
99
100 # we are getting our own INFO messages
101 next if ( $type =~ m#^(INFO|ANT-SEARCH|EXEC-CLI)# );
102
103 my $ant = $h->{'ANT-ID'} || die "no ANT-ID in ", dump( $h );
104
105 if ($type eq 'REPLY-ANT-SEARCH') {
106 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");
107 } elsif ($type eq 'REPLY-INFO') {
108
109 if ($h->{'SEQ-NR'} < 0) {
110 warn "!! password protected ant $ant, skipping\n";
111 next;
112 }
113
114 my $board = $h->{'_BOARD_NAME'} || die "no _BOARD_NAME?";
115 if ( fw_exists( $board ) ) {
116 my $build = $h->{'_BUILD'} || die "no _BUILD?";
117 my $new_build = fw_build( $board );
118 if ( $build ne $new_build ) {
119 print "UPDATE STEP 1 on ant $ant version $build -> $new_build\n";
120 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");
121 } else {
122 print "OK ant $ant allready updated...\n";
123 }
124 } else {
125 print "!! NO FIRMWARE for $board in $tftp_path for ant $ant, skipping update\n";
126 }
127 } elsif ( $type eq 'REPLY-EXEC-CLI' && $h->{'SEQ-NR'} == 1 ) {
128 print "UPDATE STEP 2 on ant $ant\n";
129 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");
130 } else {
131 print "!! reply ignored ", dump( $h ), $/;
132 }
133
134 } else {
135 warn "<=" x 15, "\n", $data, "\n", "<=" x 15, "\n";
136 }
137 }

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26