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/;
use File::Find;

my $debug = 0;

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

my $magic = 'BLI223Q';

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;
}

sub firmware {
        my $path = shift;
        open(my $fh, $path) || die "Can't open $path: $!";
        my $b;
        read($fh, $b, length($magic));
        if ($b ne $magic) {
                warn "# $path not a firmware image\n";
                return;
        }
        my $version     = get_from($fh, 32, 4);
        my $board       = get_from($fh, 0x136, 6);
        my $name        = get_from($fh, 0x144, 15);
        chomp($name);
        $name =~ s/\W+/ /gs;
        $version = join('.',unpack('CCCC', $version));
        printf("%-8s %6s %-16s %s\n", $version, $board, $name, $path);
}

for my $path ( @images ) {
        warn "# ? $path\n" if $debug;
        if ( -d $path ) {
                find( sub {
                        my $path = $File::Find::name;
                        warn "# ?? $path\n" if $debug;
                        firmware( $path ) if -f $path;
                }, $path );
        } elsif ( -f $path ) {
                firmware( $path );
        } else {
                warn "# unknown: $path\n";
        }
}
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	dpavlin	74	use File::Find;
10	dpavlin	5
11	dpavlin	74	my $debug = 0;
12
13	dpavlin	34	my @images = @ARGV;
14			push @images, '/srv/tftp/BANT-R' unless @images;
15	dpavlin	5
16	dpavlin	75	my $magic = 'BLI223Q';
17	dpavlin	18
18	dpavlin	59	sub get_from {
19			my ($fh,$seek,$len) = @_;
20			my $b;
21			seek($fh, $seek, 0) \|\| die "can't seek to $seek: $!";
22			read($fh, $b, $len) \|\| die "can't read $len bytes: $!";
23			return $b;
24			}
25
26	dpavlin	74	sub firmware {
27			my $path = shift;
28	dpavlin	34	open(my $fh, $path) \|\| die "Can't open $path: $!";
29			my $b;
30			read($fh, $b, length($magic));
31	dpavlin	74	if ($b ne $magic) {
32			warn "# $path not a firmware image\n";
33			return;
34			}
35	dpavlin	59	my $version = get_from($fh, 32, 4);
36			my $board = get_from($fh, 0x136, 6);
37			my $name = get_from($fh, 0x144, 15);
38			chomp($name);
39	dpavlin	87	$name =~ s/\W+/ /gs;
40	dpavlin	74	$version = join('.',unpack('CCCC', $version));
41	dpavlin	77	printf("%-8s %6s %-16s %s\n", $version, $board, $name, $path);
42	dpavlin	74	}
43	dpavlin	59
44	dpavlin	74	for my $path ( @images ) {
45			warn "# ? $path\n" if $debug;
46			if ( -d $path ) {
47			find( sub {
48			my $path = $File::Find::name;
49			warn "# ?? $path\n" if $debug;
50			firmware( $path ) if -f $path;
51			}, $path );
52			} elsif ( -f $path ) {
53			firmware( $path );
54			} else {
55			warn "# unknown: $path\n";
56			}
57	dpavlin	34	}