beb62006 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | use FileHandle; |
6 | |
7 | my $dumpchannels = 0; |
8 | my $dumpdata = 0; |
9 | while ($ARGV[0] =~ /^-/) { |
10 | my $opt = shift @ARGV; |
11 | if ($opt eq "--") { |
12 | last; # stop processing options |
13 | } elsif ($opt eq "-c") { |
14 | $dumpchannels = 1; |
15 | } elsif ($opt eq "-d") { |
16 | $dumpdata = 1; |
17 | } else { |
18 | die "unrecognised option '$opt'\n"; |
19 | } |
20 | } |
21 | |
22 | my @channels = (); # ultimate channel ids are indices in this array |
23 | my %chan_by_id = (); # indexed by 'c%d' or 's%d' for client and server ids |
24 | my %globalreq = (); # indexed by 'i' or 'o' |
25 | |
26 | my %packets = ( |
27 | #define SSH2_MSG_DISCONNECT 1 /* 0x1 */ |
28 | 'SSH2_MSG_DISCONNECT' => sub { |
29 | my ($direction, $seq, $data) = @_; |
30 | my ($reason, $description, $lang) = &parse("uss", $data); |
31 | printf "%s\n", &str($description); |
32 | }, |
33 | #define SSH2_MSG_IGNORE 2 /* 0x2 */ |
34 | 'SSH2_MSG_IGNORE' => sub { |
35 | my ($direction, $seq, $data) = @_; |
36 | my ($str) = &parse("s", $data); |
37 | printf "(%d bytes)\n", length $str; |
38 | }, |
39 | #define SSH2_MSG_UNIMPLEMENTED 3 /* 0x3 */ |
40 | 'SSH2_MSG_UNIMPLEMENTED' => sub { |
41 | my ($direction, $seq, $data) = @_; |
42 | my ($rseq) = &parse("u", $data); |
43 | printf "i%d\n", $rseq; |
44 | }, |
45 | #define SSH2_MSG_DEBUG 4 /* 0x4 */ |
46 | 'SSH2_MSG_DEBUG' => sub { |
47 | my ($direction, $seq, $data) = @_; |
48 | my ($disp, $message, $lang) = &parse("bss", $data); |
49 | printf "%s\n", &str($message); |
50 | }, |
51 | #define SSH2_MSG_SERVICE_REQUEST 5 /* 0x5 */ |
52 | 'SSH2_MSG_SERVICE_REQUEST' => sub { |
53 | my ($direction, $seq, $data) = @_; |
54 | my ($service) = &parse("s", $data); |
55 | printf "%s\n", &str($service); |
56 | }, |
57 | #define SSH2_MSG_SERVICE_ACCEPT 6 /* 0x6 */ |
58 | 'SSH2_MSG_SERVICE_ACCEPT' => sub { |
59 | my ($direction, $seq, $data) = @_; |
60 | my ($service) = &parse("s", $data); |
61 | printf "%s\n", &str($service); |
62 | }, |
63 | #define SSH2_MSG_KEXINIT 20 /* 0x14 */ |
64 | 'SSH2_MSG_KEXINIT' => sub { |
65 | my ($direction, $seq, $data) = @_; |
66 | print "\n"; |
67 | }, |
68 | #define SSH2_MSG_NEWKEYS 21 /* 0x15 */ |
69 | 'SSH2_MSG_NEWKEYS' => sub { |
70 | my ($direction, $seq, $data) = @_; |
71 | print "\n"; |
72 | }, |
73 | #define SSH2_MSG_KEXDH_INIT 30 /* 0x1e */ |
74 | 'SSH2_MSG_KEXDH_INIT' => sub { |
75 | my ($direction, $seq, $data) = @_; |
76 | print "\n"; |
77 | }, |
78 | #define SSH2_MSG_KEXDH_REPLY 31 /* 0x1f */ |
79 | 'SSH2_MSG_KEXDH_REPLY' => sub { |
80 | my ($direction, $seq, $data) = @_; |
81 | print "\n"; |
82 | }, |
83 | #define SSH2_MSG_KEX_DH_GEX_REQUEST 30 /* 0x1e */ |
84 | 'SSH2_MSG_KEX_DH_GEX_REQUEST' => sub { |
85 | my ($direction, $seq, $data) = @_; |
86 | print "\n"; |
87 | }, |
88 | #define SSH2_MSG_KEX_DH_GEX_GROUP 31 /* 0x1f */ |
89 | 'SSH2_MSG_KEX_DH_GEX_GROUP' => sub { |
90 | my ($direction, $seq, $data) = @_; |
91 | print "\n"; |
92 | }, |
93 | #define SSH2_MSG_KEX_DH_GEX_INIT 32 /* 0x20 */ |
94 | 'SSH2_MSG_KEX_DH_GEX_INIT' => sub { |
95 | my ($direction, $seq, $data) = @_; |
96 | print "\n"; |
97 | }, |
98 | #define SSH2_MSG_KEX_DH_GEX_REPLY 33 /* 0x21 */ |
99 | 'SSH2_MSG_KEX_DH_GEX_REPLY' => sub { |
100 | my ($direction, $seq, $data) = @_; |
101 | print "\n"; |
102 | }, |
103 | #define SSH2_MSG_KEXRSA_PUBKEY 30 /* 0x1e */ |
104 | 'SSH2_MSG_KEXRSA_PUBKEY' => sub { |
105 | my ($direction, $seq, $data) = @_; |
106 | print "\n"; |
107 | }, |
108 | #define SSH2_MSG_KEXRSA_SECRET 31 /* 0x1f */ |
109 | 'SSH2_MSG_KEXRSA_SECRET' => sub { |
110 | my ($direction, $seq, $data) = @_; |
111 | print "\n"; |
112 | }, |
113 | #define SSH2_MSG_KEXRSA_DONE 32 /* 0x20 */ |
114 | 'SSH2_MSG_KEXRSA_DONE' => sub { |
115 | my ($direction, $seq, $data) = @_; |
116 | print "\n"; |
117 | }, |
118 | #define SSH2_MSG_USERAUTH_REQUEST 50 /* 0x32 */ |
119 | 'SSH2_MSG_USERAUTH_REQUEST' => sub { |
120 | my ($direction, $seq, $data) = @_; |
121 | my ($user, $service, $method) = &parse("sss", $data); |
122 | my $out = sprintf "%s %s %s", |
123 | &str($user), &str($service), &str($method); |
124 | if ($method eq "publickey") { |
125 | my ($real) = &parse("b", $data); |
126 | $out .= " real=$real"; |
127 | } elsif ($method eq "password") { |
128 | my ($change) = &parse("b", $data); |
129 | $out .= " change=$change"; |
130 | } |
131 | print "$out\n"; |
132 | }, |
133 | #define SSH2_MSG_USERAUTH_FAILURE 51 /* 0x33 */ |
134 | 'SSH2_MSG_USERAUTH_FAILURE' => sub { |
135 | my ($direction, $seq, $data) = @_; |
136 | my ($options) = &parse("s", $data); |
137 | printf "%s\n", &str($options); |
138 | }, |
139 | #define SSH2_MSG_USERAUTH_SUCCESS 52 /* 0x34 */ |
140 | 'SSH2_MSG_USERAUTH_SUCCESS' => sub { |
141 | my ($direction, $seq, $data) = @_; |
142 | print "\n"; |
143 | }, |
144 | #define SSH2_MSG_USERAUTH_BANNER 53 /* 0x35 */ |
145 | 'SSH2_MSG_USERAUTH_BANNER' => sub { |
146 | my ($direction, $seq, $data) = @_; |
147 | print "\n"; |
148 | }, |
149 | #define SSH2_MSG_USERAUTH_PK_OK 60 /* 0x3c */ |
150 | 'SSH2_MSG_USERAUTH_PK_OK' => sub { |
151 | my ($direction, $seq, $data) = @_; |
152 | print "\n"; |
153 | }, |
154 | #define SSH2_MSG_USERAUTH_PASSWD_CHANGEREQ 60 /* 0x3c */ |
155 | 'SSH2_MSG_USERAUTH_PASSWD_CHANGEREQ' => sub { |
156 | my ($direction, $seq, $data) = @_; |
157 | print "\n"; |
158 | }, |
159 | #define SSH2_MSG_USERAUTH_INFO_REQUEST 60 /* 0x3c */ |
160 | 'SSH2_MSG_USERAUTH_INFO_REQUEST' => sub { |
161 | my ($direction, $seq, $data) = @_; |
162 | print "\n"; |
163 | }, |
164 | #define SSH2_MSG_USERAUTH_INFO_RESPONSE 61 /* 0x3d */ |
165 | 'SSH2_MSG_USERAUTH_INFO_RESPONSE' => sub { |
166 | my ($direction, $seq, $data) = @_; |
167 | print "\n"; |
168 | }, |
169 | #define SSH2_MSG_GLOBAL_REQUEST 80 /* 0x50 */ |
170 | 'SSH2_MSG_GLOBAL_REQUEST' => sub { |
171 | my ($direction, $seq, $data) = @_; |
172 | my ($type, $wantreply) = &parse("sb", $data); |
173 | printf "%s (%s)", $type, $wantreply eq "yes" ? "reply" : "noreply"; |
174 | my $request = [$seq, $type]; |
175 | push @{$globalreq{$direction}}, $request if $wantreply; |
176 | if ($type eq "tcpip-forward" or $type eq "cancel-tcpip-forward") { |
177 | my ($addr, $port) = &parse("su", $data); |
178 | printf " %s:%s", $addr, $port; |
179 | push @$request, $port; |
180 | } |
181 | print "\n"; |
182 | }, |
183 | #define SSH2_MSG_REQUEST_SUCCESS 81 /* 0x51 */ |
184 | 'SSH2_MSG_REQUEST_SUCCESS' => sub { |
185 | my ($direction, $seq, $data) = @_; |
186 | my $otherdir = ($direction eq "i" ? "o" : "i"); |
187 | my $request = shift @{$globalreq{$otherdir}}; |
188 | if (defined $request) { |
189 | printf "to %s", $request->[0]; |
190 | if ($request->[1] eq "tcpip-forward" and $request->[2] == 0) { |
191 | my ($port) = &parse("u", $data); |
192 | printf " port=%s", $port; |
193 | } |
194 | } else { |
195 | print "(spurious?)"; |
196 | } |
197 | print "\n"; |
198 | }, |
199 | #define SSH2_MSG_REQUEST_FAILURE 82 /* 0x52 */ |
200 | 'SSH2_MSG_REQUEST_FAILURE' => sub { |
201 | my ($direction, $seq, $data) = @_; |
202 | my $otherdir = ($direction eq "i" ? "o" : "i"); |
203 | my $request = shift @{$globalreq{$otherdir}}; |
204 | if (defined $request) { |
205 | printf "to %s", $request->[0]; |
206 | } else { |
207 | print "(spurious?)"; |
208 | } |
209 | print "\n"; |
210 | }, |
211 | #define SSH2_MSG_CHANNEL_OPEN 90 /* 0x5a */ |
212 | 'SSH2_MSG_CHANNEL_OPEN' => sub { |
213 | my ($direction, $seq, $data) = @_; |
214 | my ($type, $sid, $winsize, $packet) = &parse("suuu", $data); |
215 | # CHANNEL_OPEN tells the other side the _sender's_ id for the |
216 | # channel, so this choice between "s" and "c" prefixes is |
217 | # opposite to every other message in the protocol, which all |
218 | # quote the _recipient's_ id of the channel. |
219 | $sid = ($direction eq "i" ? "s" : "c") . $sid; |
220 | my $chan = {'id'=>$sid, 'state'=>'halfopen'}; |
221 | push @channels, $chan; |
222 | my $index = $#channels; |
223 | $chan_by_id{$sid} = $index; |
224 | printf "ch%d (%s) %s", $index, $chan->{'id'}, $type; |
225 | if ($type eq "x11") { |
226 | my ($addr, $port) = &parse("su", $data); |
227 | printf " from %s:%s", $addr, $port; |
228 | } elsif ($type eq "forwarded-tcpip") { |
229 | my ($saddr, $sport, $paddr, $pport) = &parse("susu", $data); |
230 | printf " to %s:%s from %s:%s", $saddr, $sport, $paddr, $pport; |
231 | } elsif ($type eq "direct-tcpip") { |
232 | my ($daddr, $dport, $saddr, $sport) = &parse("susu", $data); |
233 | printf " to %s:%s from %s:%s", $daddr, $dport, $saddr, $sport; |
234 | } |
235 | print "\n"; |
236 | }, |
237 | #define SSH2_MSG_CHANNEL_OPEN_CONFIRMATION 91 /* 0x5b */ |
238 | 'SSH2_MSG_CHANNEL_OPEN_CONFIRMATION' => sub { |
239 | my ($direction, $seq, $data) = @_; |
240 | my ($rid, $sid, $winsize, $packet) = &parse("uuuu", $data); |
241 | $rid = ($direction eq "i" ? "c" : "s") . $rid; |
242 | my $index = $chan_by_id{$rid}; |
243 | $sid = ($direction eq "i" ? "s" : "c") . $sid; |
244 | $chan_by_id{$sid} = $index; |
245 | my $chan = $channels[$index]; |
246 | $chan->{'id'} = ($direction eq "i" ? "$rid/$sid" : "$sid/$rid"); |
247 | $chan->{'state'} = 'open'; |
248 | printf "ch%d (%s)\n", $index, $chan->{'id'}; |
249 | }, |
250 | #define SSH2_MSG_CHANNEL_OPEN_FAILURE 92 /* 0x5c */ |
251 | 'SSH2_MSG_CHANNEL_OPEN_FAILURE' => sub { |
252 | my ($direction, $seq, $data) = @_; |
253 | my ($rid, $reason, $desc, $lang) = &parse("uuss", $data); |
254 | $rid = ($direction eq "i" ? "c" : "s") . $rid; |
255 | my $index = $chan_by_id{$rid}; |
256 | my $chan = $channels[$index]; |
257 | $chan->{'state'} = 'rejected'; |
258 | printf "ch%d (%s) %s\n", $index, $chan->{'id'}, &str($reason); |
259 | }, |
260 | #define SSH2_MSG_CHANNEL_WINDOW_ADJUST 93 /* 0x5d */ |
261 | 'SSH2_MSG_CHANNEL_WINDOW_ADJUST' => sub { |
262 | my ($direction, $seq, $data) = @_; |
263 | my ($rid, $bytes) = &parse("uu", $data); |
264 | $rid = ($direction eq "i" ? "c" : "s") . $rid; |
265 | my $index = $chan_by_id{$rid}; |
266 | my $chan = $channels[$index]; |
267 | printf "ch%d (%s) +%s\n", $index, $chan->{'id'}, $bytes; |
268 | }, |
269 | #define SSH2_MSG_CHANNEL_DATA 94 /* 0x5e */ |
270 | 'SSH2_MSG_CHANNEL_DATA' => sub { |
271 | my ($direction, $seq, $data) = @_; |
272 | my ($rid, $bytes) = &parse("uu", $data); |
273 | $rid = ($direction eq "i" ? "c" : "s") . $rid; |
274 | my $index = $chan_by_id{$rid}; |
275 | my $chan = $channels[$index]; |
276 | printf "ch%d (%s), %s bytes\n", $index, $chan->{'id'}, $bytes; |
277 | if ($dumpdata) { |
278 | my $filekey = $direction . "file"; |
279 | if (!defined $chan->{$filekey}) { |
280 | my $filename = sprintf "ch%d.%s", $index, $direction; |
281 | $chan->{$filekey} = FileHandle->new(">$filename"); |
282 | if (!defined $chan->{$filekey}) { |
283 | die "$filename: $!\n"; |
284 | } |
285 | } |
286 | my @realdata = splice @$data, 0, $bytes; |
287 | die "channel data not present in $seq\n" if @realdata < $bytes; |
288 | my $rawdata = pack "C*", @realdata; |
289 | my $fh = $chan->{$filekey}; |
290 | print $fh $rawdata; |
291 | } |
292 | }, |
293 | #define SSH2_MSG_CHANNEL_EXTENDED_DATA 95 /* 0x5f */ |
294 | 'SSH2_MSG_CHANNEL_EXTENDED_DATA' => sub { |
295 | my ($direction, $seq, $data) = @_; |
296 | my ($rid, $bytes) = &parse("uu", $data); |
297 | $rid = ($direction eq "i" ? "c" : "s") . $rid; |
298 | my $index = $chan_by_id{$rid}; |
299 | my $chan = $channels[$index]; |
300 | printf "ch%d (%s), %s bytes\n", $index, $chan->{'id'}, $bytes; |
301 | if ($dumpdata) { |
302 | # We treat EXTENDED_DATA as equivalent to DATA, for the |
303 | # moment. It's not clear what else would be a better thing |
304 | # to do with it, and this at least is the Right Answer if |
305 | # the data is going to a terminal and the aim is to debug |
306 | # the terminal emulator. |
307 | my $filekey = $direction . "file"; |
308 | if (!defined $chan->{$filekey}) { |
309 | my $filename = sprintf "ch%d.%s", $index, $direction; |
310 | $chan->{$filekey} = FileHandle->new; |
311 | if (!$chan->{$filekey}->open(">", $filename)) { |
312 | die "$filename: $!\n"; |
313 | } |
314 | } |
315 | my @realdata = splice @$data, 0, $bytes; |
316 | die "channel data not present in $seq\n" if @realdata < $bytes; |
317 | my $rawdata = pack "C*", @realdata; |
318 | my $fh = $chan->{$filekey}; |
319 | print $fh $rawdata; |
320 | } |
321 | }, |
322 | #define SSH2_MSG_CHANNEL_EOF 96 /* 0x60 */ |
323 | 'SSH2_MSG_CHANNEL_EOF' => sub { |
324 | my ($direction, $seq, $data) = @_; |
325 | my ($rid) = &parse("uu", $data); |
326 | $rid = ($direction eq "i" ? "c" : "s") . $rid; |
327 | my $index = $chan_by_id{$rid}; |
328 | my $chan = $channels[$index]; |
329 | printf "ch%d (%s)\n", $index, $chan->{'id'}; |
330 | }, |
331 | #define SSH2_MSG_CHANNEL_CLOSE 97 /* 0x61 */ |
332 | 'SSH2_MSG_CHANNEL_CLOSE' => sub { |
333 | my ($direction, $seq, $data) = @_; |
334 | my ($rid) = &parse("uu", $data); |
335 | $rid = ($direction eq "i" ? "c" : "s") . $rid; |
336 | my $index = $chan_by_id{$rid}; |
337 | my $chan = $channels[$index]; |
338 | $chan->{'state'} = ($chan->{'state'} eq "open" ? "halfclosed" : |
339 | $chan->{'state'} eq "halfclosed" ? "closed" : |
340 | "confused"); |
341 | if ($chan->{'state'} eq "closed") { |
342 | $chan->{'ifile'}->close if defined $chan->{'ifile'}; |
343 | $chan->{'ofile'}->close if defined $chan->{'ofile'}; |
344 | } |
345 | printf "ch%d (%s)\n", $index, $chan->{'id'}; |
346 | }, |
347 | #define SSH2_MSG_CHANNEL_REQUEST 98 /* 0x62 */ |
348 | 'SSH2_MSG_CHANNEL_REQUEST' => sub { |
349 | my ($direction, $seq, $data) = @_; |
350 | my ($rid, $type, $wantreply) = &parse("usb", $data); |
351 | $rid = ($direction eq "i" ? "c" : "s") . $rid; |
352 | my $index = $chan_by_id{$rid}; |
353 | my $chan = $channels[$index]; |
354 | printf "ch%d (%s) %s (%s)", |
355 | $index, $chan->{'id'}, $type, $wantreply eq "yes" ? "reply" : "noreply"; |
356 | push @{$chan->{'requests_'.$direction}}, [$seq, $type] if $wantreply; |
357 | if ($type eq "pty-req") { |
358 | my ($term, $w, $h, $pw, $ph, $modes) = &parse("suuuus", $data); |
359 | printf " %s %sx%s", &str($term), $w, $h; |
360 | } elsif ($type eq "x11-req") { |
361 | my ($single, $xprot, $xcookie, $xscreen) = &parse("bssu", $data); |
362 | print " one-off" if $single eq "yes"; |
363 | printf " %s :%s", $xprot, $xscreen; |
364 | } elsif ($type eq "exec") { |
365 | my ($command) = &parse("s", $data); |
366 | printf " %s", &str($command); |
367 | } elsif ($type eq "subsystem") { |
368 | my ($subsys) = &parse("s", $data); |
369 | printf " %s", &str($subsys); |
370 | } elsif ($type eq "window-change") { |
371 | my ($w, $h, $pw, $ph) = &parse("uuuu", $data); |
372 | printf " %sx%s", $w, $h; |
373 | } elsif ($type eq "xon-xoff") { |
374 | my ($can) = &parse("b", $data); |
375 | printf " %s", $can; |
376 | } elsif ($type eq "signal") { |
377 | my ($sig) = &parse("s", $data); |
378 | printf " %s", &str($sig); |
379 | } elsif ($type eq "exit-status") { |
380 | my ($status) = &parse("u", $data); |
381 | printf " %s", $status; |
382 | } elsif ($type eq "exit-signal") { |
383 | my ($sig, $core, $error, $lang) = &parse("sbss", $data); |
384 | printf " %s", &str($sig); |
385 | print " (core dumped)" if $core eq "yes"; |
386 | } |
387 | print "\n"; |
388 | }, |
389 | #define SSH2_MSG_CHANNEL_SUCCESS 99 /* 0x63 */ |
390 | 'SSH2_MSG_CHANNEL_SUCCESS' => sub { |
391 | my ($direction, $seq, $data) = @_; |
392 | my ($rid) = &parse("uu", $data); |
393 | $rid = ($direction eq "i" ? "c" : "s") . $rid; |
394 | my $index = $chan_by_id{$rid}; |
395 | my $chan = $channels[$index]; |
396 | printf "ch%d (%s)", $index, $chan->{'id'}; |
397 | my $otherdir = ($direction eq "i" ? "o" : "i"); |
398 | my $request = shift @{$chan->{'requests_' . $otherdir}}; |
399 | if (defined $request) { |
400 | printf " to %s", $request->[0]; |
401 | } else { |
402 | print " (spurious?)"; |
403 | } |
404 | print "\n"; |
405 | }, |
406 | #define SSH2_MSG_CHANNEL_FAILURE 100 /* 0x64 */ |
407 | 'SSH2_MSG_CHANNEL_FAILURE' => sub { |
408 | my ($direction, $seq, $data) = @_; |
409 | my ($rid) = &parse("uu", $data); |
410 | $rid = ($direction eq "i" ? "c" : "s") . $rid; |
411 | my $index = $chan_by_id{$rid}; |
412 | my $chan = $channels[$index]; |
413 | printf "ch%d (%s)", $index, $chan->{'id'}; |
414 | my $otherdir = ($direction eq "i" ? "o" : "i"); |
415 | my $request = shift @{$chan->{'requests_' . $otherdir}}; |
416 | if (defined $request) { |
142228d2 |
417 | printf " to %s", $request->[0]; |
beb62006 |
418 | } else { |
419 | print " (spurious?)"; |
420 | } |
421 | print "\n"; |
422 | }, |
423 | #define SSH2_MSG_USERAUTH_GSSAPI_RESPONSE 60 |
424 | 'SSH2_MSG_USERAUTH_GSSAPI_RESPONSE' => sub { |
425 | my ($direction, $seq, $data) = @_; |
426 | print "\n"; |
427 | }, |
428 | #define SSH2_MSG_USERAUTH_GSSAPI_TOKEN 61 |
429 | 'SSH2_MSG_USERAUTH_GSSAPI_TOKEN' => sub { |
430 | my ($direction, $seq, $data) = @_; |
431 | print "\n"; |
432 | }, |
433 | #define SSH2_MSG_USERAUTH_GSSAPI_EXCHANGE_COMPLETE 63 |
434 | 'SSH2_MSG_USERAUTH_GSSAPI_EXCHANGE_COMPLETE' => sub { |
435 | my ($direction, $seq, $data) = @_; |
436 | print "\n"; |
437 | }, |
438 | #define SSH2_MSG_USERAUTH_GSSAPI_ERROR 64 |
439 | 'SSH2_MSG_USERAUTH_GSSAPI_ERROR' => sub { |
440 | my ($direction, $seq, $data) = @_; |
441 | print "\n"; |
442 | }, |
443 | #define SSH2_MSG_USERAUTH_GSSAPI_ERRTOK 65 |
444 | 'SSH2_MSG_USERAUTH_GSSAPI_ERRTOK' => sub { |
445 | my ($direction, $seq, $data) = @_; |
446 | print "\n"; |
447 | }, |
448 | #define SSH2_MSG_USERAUTH_GSSAPI_MIC 66 |
449 | 'SSH2_MSG_USERAUTH_GSSAPI_MIC' => sub { |
450 | my ($direction, $seq, $data) = @_; |
451 | print "\n"; |
452 | }, |
453 | ); |
454 | |
455 | my ($direction, $seq, $ourseq, $type, $data, $recording); |
456 | my %ourseqs = ('i'=>0, 'o'=>0); |
457 | |
458 | $recording = 0; |
459 | while (<>) { |
460 | if ($recording) { |
461 | if (/^ [0-9a-fA-F]{8} ((?:[0-9a-fA-F]{2} )*[0-9a-fA-F]{2})/) { |
462 | push @$data, map { $_ eq "XX" ? -1 : hex $_ } split / /, $1; |
463 | } else { |
464 | $recording = 0; |
465 | my $fullseq = "$direction$ourseq"; |
466 | print "$fullseq: $type "; |
467 | if (defined $packets{$type}) { |
468 | $packets{$type}->($direction, $fullseq, $data); |
469 | } else { |
470 | printf "raw %s\n", join "", map { sprintf "%02x", $_ } @$data; |
471 | } |
472 | } |
473 | } |
474 | if (/^(Incoming|Outgoing) packet #0x([0-9a-fA-F]+), type \d+ \/ 0x[0-9a-fA-F]+ \((.*)\)/) { |
475 | $direction = ($1 eq "Incoming" ? 'i' : 'o'); |
476 | # $seq is the sequence number quoted in the log file. $ourseq |
477 | # is our own count of the sequence number, which differs in |
478 | # that it shouldn't wrap at 2^32, should anyone manage to run |
479 | # this script over such a huge log file. |
480 | $seq = hex $2; |
481 | $ourseq = $ourseqs{$direction}++; |
482 | $type = $3; |
483 | $data = []; |
484 | $recording = 1; |
485 | } |
486 | } |
487 | |
488 | if ($dumpchannels) { |
489 | my %stateorder = ('closed'=>0, 'rejected'=>1, |
490 | 'halfclosed'=>2, 'open'=>3, 'halfopen'=>4); |
491 | for my $index (0..$#channels) { |
492 | my $chan = $channels[$index]; |
8a202ff9 |
493 | my $so = $stateorder{$chan->{'state'}}; |
494 | $so = 1000 unless defined $so; # any state I've missed above comes last |
beb62006 |
495 | $chan->{'index'} = sprintf "ch%d", $index; |
496 | $chan->{'order'} = sprintf "%08d %08d", $so, $index; |
497 | } |
498 | my @sortedchannels = sort { $a->{'order'} cmp $b->{'order'} } @channels; |
499 | for my $chan (@sortedchannels) { |
500 | printf "%s (%s): %s\n", $chan->{'index'}, $chan->{'id'}, $chan->{'state'}; |
501 | } |
502 | } |
503 | |
504 | sub parseone { |
505 | my ($type, $data) = @_; |
506 | if ($type eq "u") { # uint32 |
507 | my @bytes = splice @$data, 0, 4; |
508 | return "<missing>" if @bytes < 4 or grep { $_<0 } @bytes; |
509 | return unpack "N", pack "C*", @bytes; |
510 | } elsif ($type eq "U") { # uint64 |
511 | my @bytes = splice @$data, 0, 4; |
512 | return "<missing>" if @bytes < 8 or grep { $_<0 } @bytes; |
513 | my @words = unpack "NN", pack "C*", @bytes; |
514 | return ($words[0] << 32) + $words[1]; |
515 | } elsif ($type eq "b") { # boolean |
516 | my $byte = shift @$data; |
517 | return "<missing>" if !defined $byte or $byte < 0; |
518 | return $byte ? "yes" : "no"; |
519 | } elsif ($type eq "B") { # byte |
520 | my $byte = shift @$data; |
521 | return "<missing>" if !defined $byte or $byte < 0; |
522 | return $byte; |
523 | } elsif ($type eq "s" or $type eq "m") { # string, mpint |
524 | my @bytes = splice @$data, 0, 4; |
525 | return "<missing>" if @bytes < 4 or grep { $_<0 } @bytes; |
526 | my $len = unpack "N", pack "C*", @bytes; |
527 | @bytes = splice @$data, 0, $len; |
528 | return "<missing>" if @bytes < $len or grep { $_<0 } @bytes; |
529 | if ($type eq "mpint") { |
530 | my $str = ""; |
531 | if ($bytes[0] >= 128) { |
532 | # Take two's complement. |
533 | @bytes = map { 0xFF ^ $_ } @bytes; |
534 | for my $i (reverse 0..$#bytes) { |
535 | if ($bytes[$i] < 0xFF) { |
536 | $bytes[$i]++; |
537 | last; |
538 | } else { |
539 | $bytes[$i] = 0; |
540 | } |
541 | } |
542 | $str = "-"; |
543 | } |
544 | $str .= "0x" . join "", map { sprintf "%02x", $_ } @bytes; |
545 | return $str; |
546 | } else { |
547 | return pack "C*", @bytes; |
548 | } |
549 | } |
550 | } |
551 | |
552 | sub parse { |
553 | my ($template, $data) = @_; |
554 | return map { &parseone($_, $data) } split //, $template; |
555 | } |
556 | |
557 | sub str { |
558 | # Quote as a string. If I get enthusiastic I might arrange for |
559 | # strange characters inside the string to be quoted. |
560 | my $str = shift @_; |
561 | return "'$str'"; |
562 | } |