mdap/bin/fw-info.pl

#!/usr/bin/perl -w

# fw-info.pl
#
# 04/22/07 16:33:13 CEST Dobrica Pavlinusic <dpavlin@rot13.org>

use strict;
use Data::Dump qw/dump/;

my @images = @ARGV;
push @images, '/srv/tftp/BANT-R' unless @images;

my $magic = 'BLI223QH0';

sub get_from {
        my ($fh,$seek,$len) = @_;
        my $b;
        seek($fh, $seek, 0) || die "can't seek to $seek: $!";
        read($fh, $b, $len) || die "can't read $len bytes: $!";
        return $b;
}

for my $path ( @images ) {
        next unless -f $path;
        open(my $fh, $path) || die "Can't open $path: $!";
        my $b;
        read($fh, $b, length($magic));
        warn "# $path not a firmware image\n" unless ($b eq $magic);
        my $version     = get_from($fh, 32, 4);
        my $board       = get_from($fh, 0x136, 6);
        my $name        = get_from($fh, 0x144, 15);
        chomp($name);

        printf("%8s %6s %s\t%s\n", join('.',unpack('CCCC', $version)), $board, $name, $path);
}
1	dpavlin	5	#!/usr/bin/perl -w
2
3			# fw-info.pl
4			#
5			# 04/22/07 16:33:13 CEST Dobrica Pavlinusic <dpavlin@rot13.org>
6
7			use strict;
8			use Data::Dump qw/dump/;
9
10	dpavlin	34	my @images = @ARGV;
11			push @images, '/srv/tftp/BANT-R' unless @images;
12	dpavlin	5
13	dpavlin	18	my $magic = 'BLI223QH0';
14
15	dpavlin	59	sub get_from {
16			my ($fh,$seek,$len) = @_;
17			my $b;
18			seek($fh, $seek, 0) \|\| die "can't seek to $seek: $!";
19			read($fh, $b, $len) \|\| die "can't read $len bytes: $!";
20			return $b;
21			}
22
23	dpavlin	34	for my $path ( @images ) {
24	dpavlin	59	next unless -f $path;
25	dpavlin	34	open(my $fh, $path) \|\| die "Can't open $path: $!";
26			my $b;
27			read($fh, $b, length($magic));
28			warn "# $path not a firmware image\n" unless ($b eq $magic);
29	dpavlin	59	my $version = get_from($fh, 32, 4);
30			my $board = get_from($fh, 0x136, 6);
31			my $name = get_from($fh, 0x144, 15);
32			chomp($name);
33
34			printf("%8s %6s %s\t%s\n", join('.',unpack('CCCC', $version)), $board, $name, $path);
35	dpavlin	34	}