/[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

Annotation of /mdap-server.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 15 - (hide 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 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 14 my $user_id = 'Administrator';
16     my $user_pwd = '';
17    
18 dpavlin 9 warn "search for ants every ${resend_search_delay}s\ntftp server path: $tftp_path\n";
19    
20 dpavlin 7 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 dpavlin 2 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 dpavlin 14
61     my $xor = 0;
62     map { $xor ^= ord($_) } split(//,$data);
63     $data .= sprintf('%02X', $xor);
64    
65     $sock->mcast_send( $data, GROUP . ':' . PORT );
66 dpavlin 9 if ($debug) {
67     warn ">> ", dump( $data ), $/;
68     } else {
69     $data =~ s/\s+/ /gi;
70     warn ">> ", substr($data,0,70), $/;
71     }
72 dpavlin 2 }
73    
74     local $SIG{ALRM} = sub {
75 dpavlin 14 mdap_send("ANT-SEARCH MDAP/1.1\r\n");
76 dpavlin 2 alarm( $resend_search_delay );
77     };
78    
79     alarm( $resend_search_delay );
80    
81 dpavlin 14 mdap_send("ANT-SEARCH MDAP/1.1\r\n");
82 dpavlin 7
83 dpavlin 2 while (1) {
84     my $data;
85     next unless $sock->recv($data,1024);
86    
87 dpavlin 9 if ( $data =~ m#^(INFO|ANT-SEARCH|EXEC-CLI|REPLY-\S+)\s(MDAP)/(\d+\.\d+)# ) {
88 dpavlin 2
89 dpavlin 9 my ($type,$proto,$mdap_ver) = ($1,$2,$3);
90 dpavlin 2
91     my $h = ant2hash($data);
92    
93 dpavlin 9 my $client_version = $h->{'MDAP-VERSION'};
94     $mdap_ver = $client_version if ($client_version);
95 dpavlin 7
96 dpavlin 9 print "<< $type $proto/$mdap_ver << ", length($data), " bytes\n";
97 dpavlin 2
98 dpavlin 8 warn dump($h),$/ if ($debug);
99    
100 dpavlin 9 # 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 dpavlin 2 if ($type eq 'REPLY-ANT-SEARCH') {
106 dpavlin 14 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 dpavlin 2 } elsif ($type eq 'REPLY-INFO') {
108 dpavlin 15
109     if ($h->{'SEQ-NR'} < 0) {
110     warn "!! password protected ant $ant, skipping\n";
111     next;
112     }
113    
114 dpavlin 7 my $board = $h->{'_BOARD_NAME'} || die "no _BOARD_NAME?";
115     if ( fw_exists( $board ) ) {
116 dpavlin 14 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 dpavlin 7 } else {
122     print "OK ant $ant allready updated...\n";
123     }
124 dpavlin 2 } else {
125 dpavlin 7 print "!! NO FIRMWARE for $board in $tftp_path for ant $ant, skipping update\n";
126 dpavlin 2 }
127 dpavlin 3 } elsif ( $type eq 'REPLY-EXEC-CLI' && $h->{'SEQ-NR'} == 1 ) {
128 dpavlin 7 print "UPDATE STEP 2 on ant $ant\n";
129 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");
130 dpavlin 2 } else {
131 dpavlin 8 print "!! reply ignored ", dump( $h ), $/;
132 dpavlin 2 }
133    
134     } else {
135 dpavlin 8 warn "<=" x 15, "\n", $data, "\n", "<=" x 15, "\n";
136 dpavlin 2 }
137     }

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26