/[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 8 - (hide annotations)
Sun Apr 22 16:06:03 2007 UTC (16 years, 11 months ago) by dpavlin
File MIME type: text/plain
File size: 2757 byte(s)
any option added to invocation will turn debug on
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 $local_port = 1000;
13    
14     my $resend_search_delay = 3;
15 dpavlin 7 my $tftp_path = '/srv/tftp/';
16 dpavlin 2
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 dpavlin 8 warn ">> $data\n>>----------\n" if ($debug);
58 dpavlin 2 $sock->mcast_send( "${data}", GROUP . ':' . PORT );
59     }
60    
61     local $SIG{ALRM} = sub {
62     mdap_send("ANT-SEARCH MDAP/1.1\r\n46");
63     alarm( $resend_search_delay );
64     };
65    
66     alarm( $resend_search_delay );
67    
68 dpavlin 7 mdap_send("ANT-SEARCH MDAP/1.1\r\n46");
69    
70 dpavlin 2 while (1) {
71     my $data;
72     next unless $sock->recv($data,1024);
73    
74     if ( $data =~ m#^(REPLY-\S+)\s(MDAP/\d+\.\d+)# ) {
75    
76     my ($type,$proto) = ($1,$2);
77    
78     my $h = ant2hash($data);
79    
80 dpavlin 7 my $ant = $h->{'ANT-ID'} || die "no ANT-ID in ", dump( $h );
81    
82 dpavlin 8 print "<< $type $proto ", length($data), " bytes\n";
83 dpavlin 2
84 dpavlin 8 warn dump($h),$/ if ($debug);
85    
86 dpavlin 2 if ($type eq 'REPLY-ANT-SEARCH') {
87 dpavlin 7 mdap_send("INFO MDAP/1.2\r\nSEQ-NR:1\r\nTO-ANT:$ant\r\nUSER-ID:Administrator\r\nUSER-PWD:\r\n22");
88 dpavlin 2 } elsif ($type eq 'REPLY-INFO') {
89 dpavlin 7 my $board = $h->{'_BOARD_NAME'} || die "no _BOARD_NAME?";
90     if ( fw_exists( $board ) ) {
91     if ( $h->{'_BUILD'} ne fw_build( $board ) ) {
92     print "UPDATE STEP 1 on ant $ant\n";
93     mdap_send("EXEC-CLI MDAP/1.2\r\nCLI-CMD:software upgrade\r\nSEQ-NR:1\r\nTO-ANT:$ant\r\nUSER-ID:Administrator\r\nUSER-PWD:\r\n1F");
94     } else {
95     print "OK ant $ant allready updated...\n";
96     }
97 dpavlin 2 } else {
98 dpavlin 7 print "!! NO FIRMWARE for $board in $tftp_path for ant $ant, skipping update\n";
99 dpavlin 2 }
100 dpavlin 3 } elsif ( $type eq 'REPLY-EXEC-CLI' && $h->{'SEQ-NR'} == 1 ) {
101 dpavlin 7 print "UPDATE STEP 2 on ant $ant\n";
102 dpavlin 8 mdap_send("EXEC-CLI MDAP/1.2\r\nSEQ-NR:2\r\nTO-ANT:$ant\r\nUSER-ID:Administrator\r\nUSER-PWD:\r\n5F");
103 dpavlin 2 } else {
104 dpavlin 8 print "!! reply ignored ", dump( $h ), $/;
105 dpavlin 2 }
106    
107     } else {
108 dpavlin 8 warn "<=" x 15, "\n", $data, "\n", "<=" x 15, "\n";
109 dpavlin 2 }
110     }

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26