]>
Commit | Line | Data |
---|---|---|
29048bce PE |
1 | #!/usr/bin/env perl |
2 | # ---------------------------------------------------------------------- | |
3 | # knlinfo by Phil Elwell for Raspberry Pi | |
4 | # | |
5 | # (c) 2014,2015 Raspberry Pi (Trading) Limited <info@raspberrypi.org> | |
6 | # | |
7 | # Licensed under the terms of the GNU General Public License. | |
8 | # ---------------------------------------------------------------------- | |
9 | ||
10 | use strict; | |
11 | use integer; | |
12 | ||
13 | use Fcntl ":seek"; | |
14 | ||
15 | my $trailer_magic = 'RPTL'; | |
16 | ||
17 | my %atom_formats = | |
18 | ( | |
19 | 'DDTK' => \&format_bool, | |
20 | 'DTOK' => \&format_bool, | |
21 | 'KVer' => \&format_string, | |
22 | '270X' => \&format_bool, | |
23 | '283X' => \&format_bool, | |
24 | '283x' => \&format_bool, | |
25 | ); | |
26 | ||
27 | if (@ARGV != 1) | |
28 | { | |
29 | print ("Usage: knlinfo <kernel image>\n"); | |
30 | exit(1); | |
31 | } | |
32 | ||
33 | my $kernel_file = $ARGV[0]; | |
34 | ||
35 | ||
36 | my ($atoms, $pos) = read_trailer($kernel_file); | |
37 | ||
38 | exit(1) if (!$atoms); | |
39 | ||
40 | printf("Kernel trailer found at %d/0x%x:\n", $pos, $pos); | |
41 | ||
42 | foreach my $atom (@$atoms) | |
43 | { | |
44 | printf(" %s: %s\n", $atom->[0], format_atom($atom)); | |
45 | } | |
46 | ||
47 | exit(0); | |
48 | ||
49 | sub read_trailer | |
50 | { | |
51 | my ($kernel_file) = @_; | |
52 | my $fh; | |
53 | ||
54 | if (!open($fh, '<', $kernel_file)) | |
55 | { | |
56 | print ("* Failed to open '$kernel_file'\n"); | |
57 | return undef; | |
58 | } | |
59 | ||
60 | if (!seek($fh, -12, SEEK_END)) | |
61 | { | |
62 | print ("* seek error in '$kernel_file'\n"); | |
63 | return undef; | |
64 | } | |
65 | ||
66 | my $last_bytes; | |
67 | sysread($fh, $last_bytes, 12); | |
68 | ||
69 | my ($trailer_len, $data_len, $magic) = unpack('VVa4', $last_bytes); | |
70 | ||
71 | if (($magic ne $trailer_magic) || ($data_len != 4)) | |
72 | { | |
73 | print ("* no trailer\n"); | |
74 | return undef; | |
75 | } | |
76 | if (!seek($fh, -12, SEEK_END)) | |
77 | { | |
78 | print ("* seek error in '$kernel_file'\n"); | |
79 | return undef; | |
80 | } | |
81 | ||
82 | $trailer_len -= 12; | |
83 | ||
84 | while ($trailer_len > 0) | |
85 | { | |
86 | if ($trailer_len < 8) | |
87 | { | |
88 | print ("* truncated atom header in trailer\n"); | |
89 | return undef; | |
90 | } | |
91 | if (!seek($fh, -8, SEEK_CUR)) | |
92 | { | |
93 | print ("* seek error in '$kernel_file'\n"); | |
94 | return undef; | |
95 | } | |
96 | $trailer_len -= 8; | |
97 | ||
98 | my $atom_hdr; | |
99 | sysread($fh, $atom_hdr, 8); | |
100 | my ($atom_len, $atom_type) = unpack('Va4', $atom_hdr); | |
101 | ||
102 | if ($trailer_len < $atom_len) | |
103 | { | |
104 | print ("* truncated atom data in trailer\n"); | |
105 | return undef; | |
106 | } | |
107 | ||
108 | my $rounded_len = (($atom_len + 3) & ~3); | |
109 | if (!seek($fh, -(8 + $rounded_len), SEEK_CUR)) | |
110 | { | |
111 | print ("* seek error in '$kernel_file'\n"); | |
112 | return undef; | |
113 | } | |
114 | $trailer_len -= $rounded_len; | |
115 | ||
116 | my $atom_data; | |
117 | sysread($fh, $atom_data, $atom_len); | |
118 | ||
119 | if (!seek($fh, -$atom_len, SEEK_CUR)) | |
120 | { | |
121 | print ("* seek error in '$kernel_file'\n"); | |
122 | return undef; | |
123 | } | |
124 | ||
125 | push @$atoms, [ $atom_type, $atom_data ]; | |
126 | } | |
127 | ||
128 | if (($$atoms[-1][0] eq "\x00\x00\x00\x00") && | |
129 | ($$atoms[-1][1] eq "")) | |
130 | { | |
131 | pop @$atoms; | |
132 | } | |
133 | else | |
134 | { | |
135 | print ("* end marker missing from trailer\n"); | |
136 | } | |
137 | ||
138 | return ($atoms, tell($fh)); | |
139 | } | |
140 | ||
141 | sub format_atom | |
142 | { | |
143 | my ($atom) = @_; | |
144 | ||
145 | my $format_func = $atom_formats{$atom->[0]} || \&format_hex; | |
146 | return $format_func->($atom->[1]); | |
147 | } | |
148 | ||
149 | sub format_bool | |
150 | { | |
151 | my ($data) = @_; | |
152 | return unpack('V', $data) ? 'y' : 'n'; | |
153 | } | |
154 | ||
155 | sub format_int | |
156 | { | |
157 | my ($data) = @_; | |
158 | return unpack('V', $data); | |
159 | } | |
160 | ||
161 | sub format_string | |
162 | { | |
163 | my ($data) = @_; | |
164 | return '"'.$data.'"'; | |
165 | } | |
166 | ||
167 | sub format_hex | |
168 | { | |
169 | my ($data) = @_; | |
170 | return unpack('H*', $data); | |
171 | } |