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]; |
c7730e2d |
175 | push @{$globalreq{$direction}}, $request if $wantreply eq "yes"; |
beb62006 |
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; |
1f7a2b70 |
277 | my @realdata = splice @$data, 0, $bytes; |
beb62006 |
278 | if ($dumpdata) { |
279 | my $filekey = $direction . "file"; |
280 | if (!defined $chan->{$filekey}) { |
281 | my $filename = sprintf "ch%d.%s", $index, $direction; |
282 | $chan->{$filekey} = FileHandle->new(">$filename"); |
283 | if (!defined $chan->{$filekey}) { |
284 | die "$filename: $!\n"; |
285 | } |
286 | } |
beb62006 |
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 | } |
1f7a2b70 |
292 | if (@realdata == $bytes and defined $chan->{$direction."data"}) { |
293 | my $rawdata = pack "C*", @realdata; |
294 | $chan->{$direction."data"}->($chan, $index, $direction, $rawdata); |
295 | } |
beb62006 |
296 | }, |
297 | #define SSH2_MSG_CHANNEL_EXTENDED_DATA 95 /* 0x5f */ |
298 | 'SSH2_MSG_CHANNEL_EXTENDED_DATA' => sub { |
299 | my ($direction, $seq, $data) = @_; |
300 | my ($rid, $bytes) = &parse("uu", $data); |
301 | $rid = ($direction eq "i" ? "c" : "s") . $rid; |
302 | my $index = $chan_by_id{$rid}; |
303 | my $chan = $channels[$index]; |
304 | printf "ch%d (%s), %s bytes\n", $index, $chan->{'id'}, $bytes; |
1f7a2b70 |
305 | my @realdata = splice @$data, 0, $bytes; |
beb62006 |
306 | if ($dumpdata) { |
307 | # We treat EXTENDED_DATA as equivalent to DATA, for the |
308 | # moment. It's not clear what else would be a better thing |
309 | # to do with it, and this at least is the Right Answer if |
310 | # the data is going to a terminal and the aim is to debug |
311 | # the terminal emulator. |
312 | my $filekey = $direction . "file"; |
313 | if (!defined $chan->{$filekey}) { |
314 | my $filename = sprintf "ch%d.%s", $index, $direction; |
315 | $chan->{$filekey} = FileHandle->new; |
316 | if (!$chan->{$filekey}->open(">", $filename)) { |
317 | die "$filename: $!\n"; |
318 | } |
319 | } |
beb62006 |
320 | die "channel data not present in $seq\n" if @realdata < $bytes; |
321 | my $rawdata = pack "C*", @realdata; |
322 | my $fh = $chan->{$filekey}; |
323 | print $fh $rawdata; |
324 | } |
1f7a2b70 |
325 | if (@realdata == $bytes and defined $chan->{$direction."data"}) { |
326 | my $rawdata = pack "C*", @realdata; |
327 | $chan->{$direction."data"}->($chan, $index, $direction, $rawdata); |
328 | } |
beb62006 |
329 | }, |
330 | #define SSH2_MSG_CHANNEL_EOF 96 /* 0x60 */ |
331 | 'SSH2_MSG_CHANNEL_EOF' => sub { |
332 | my ($direction, $seq, $data) = @_; |
333 | my ($rid) = &parse("uu", $data); |
334 | $rid = ($direction eq "i" ? "c" : "s") . $rid; |
335 | my $index = $chan_by_id{$rid}; |
336 | my $chan = $channels[$index]; |
337 | printf "ch%d (%s)\n", $index, $chan->{'id'}; |
338 | }, |
339 | #define SSH2_MSG_CHANNEL_CLOSE 97 /* 0x61 */ |
340 | 'SSH2_MSG_CHANNEL_CLOSE' => sub { |
341 | my ($direction, $seq, $data) = @_; |
342 | my ($rid) = &parse("uu", $data); |
343 | $rid = ($direction eq "i" ? "c" : "s") . $rid; |
344 | my $index = $chan_by_id{$rid}; |
345 | my $chan = $channels[$index]; |
346 | $chan->{'state'} = ($chan->{'state'} eq "open" ? "halfclosed" : |
347 | $chan->{'state'} eq "halfclosed" ? "closed" : |
348 | "confused"); |
349 | if ($chan->{'state'} eq "closed") { |
350 | $chan->{'ifile'}->close if defined $chan->{'ifile'}; |
351 | $chan->{'ofile'}->close if defined $chan->{'ofile'}; |
352 | } |
353 | printf "ch%d (%s)\n", $index, $chan->{'id'}; |
354 | }, |
355 | #define SSH2_MSG_CHANNEL_REQUEST 98 /* 0x62 */ |
356 | 'SSH2_MSG_CHANNEL_REQUEST' => sub { |
357 | my ($direction, $seq, $data) = @_; |
358 | my ($rid, $type, $wantreply) = &parse("usb", $data); |
359 | $rid = ($direction eq "i" ? "c" : "s") . $rid; |
360 | my $index = $chan_by_id{$rid}; |
361 | my $chan = $channels[$index]; |
362 | printf "ch%d (%s) %s (%s)", |
363 | $index, $chan->{'id'}, $type, $wantreply eq "yes" ? "reply" : "noreply"; |
c7730e2d |
364 | push @{$chan->{'requests_'.$direction}}, [$seq, $type] |
365 | if $wantreply eq "yes"; |
beb62006 |
366 | if ($type eq "pty-req") { |
367 | my ($term, $w, $h, $pw, $ph, $modes) = &parse("suuuus", $data); |
368 | printf " %s %sx%s", &str($term), $w, $h; |
369 | } elsif ($type eq "x11-req") { |
370 | my ($single, $xprot, $xcookie, $xscreen) = &parse("bssu", $data); |
371 | print " one-off" if $single eq "yes"; |
372 | printf " %s :%s", $xprot, $xscreen; |
373 | } elsif ($type eq "exec") { |
374 | my ($command) = &parse("s", $data); |
375 | printf " %s", &str($command); |
376 | } elsif ($type eq "subsystem") { |
377 | my ($subsys) = &parse("s", $data); |
378 | printf " %s", &str($subsys); |
1f7a2b70 |
379 | if ($subsys eq "sftp") { |
380 | &sftp_setup($index); |
381 | } |
beb62006 |
382 | } elsif ($type eq "window-change") { |
383 | my ($w, $h, $pw, $ph) = &parse("uuuu", $data); |
384 | printf " %sx%s", $w, $h; |
385 | } elsif ($type eq "xon-xoff") { |
386 | my ($can) = &parse("b", $data); |
387 | printf " %s", $can; |
388 | } elsif ($type eq "signal") { |
389 | my ($sig) = &parse("s", $data); |
390 | printf " %s", &str($sig); |
391 | } elsif ($type eq "exit-status") { |
392 | my ($status) = &parse("u", $data); |
393 | printf " %s", $status; |
394 | } elsif ($type eq "exit-signal") { |
395 | my ($sig, $core, $error, $lang) = &parse("sbss", $data); |
396 | printf " %s", &str($sig); |
397 | print " (core dumped)" if $core eq "yes"; |
398 | } |
399 | print "\n"; |
400 | }, |
401 | #define SSH2_MSG_CHANNEL_SUCCESS 99 /* 0x63 */ |
402 | 'SSH2_MSG_CHANNEL_SUCCESS' => sub { |
403 | my ($direction, $seq, $data) = @_; |
404 | my ($rid) = &parse("uu", $data); |
405 | $rid = ($direction eq "i" ? "c" : "s") . $rid; |
406 | my $index = $chan_by_id{$rid}; |
407 | my $chan = $channels[$index]; |
408 | printf "ch%d (%s)", $index, $chan->{'id'}; |
409 | my $otherdir = ($direction eq "i" ? "o" : "i"); |
410 | my $request = shift @{$chan->{'requests_' . $otherdir}}; |
411 | if (defined $request) { |
412 | printf " to %s", $request->[0]; |
413 | } else { |
414 | print " (spurious?)"; |
415 | } |
416 | print "\n"; |
417 | }, |
418 | #define SSH2_MSG_CHANNEL_FAILURE 100 /* 0x64 */ |
419 | 'SSH2_MSG_CHANNEL_FAILURE' => sub { |
420 | my ($direction, $seq, $data) = @_; |
421 | my ($rid) = &parse("uu", $data); |
422 | $rid = ($direction eq "i" ? "c" : "s") . $rid; |
423 | my $index = $chan_by_id{$rid}; |
424 | my $chan = $channels[$index]; |
425 | printf "ch%d (%s)", $index, $chan->{'id'}; |
426 | my $otherdir = ($direction eq "i" ? "o" : "i"); |
427 | my $request = shift @{$chan->{'requests_' . $otherdir}}; |
428 | if (defined $request) { |
142228d2 |
429 | printf " to %s", $request->[0]; |
beb62006 |
430 | } else { |
431 | print " (spurious?)"; |
432 | } |
433 | print "\n"; |
434 | }, |
435 | #define SSH2_MSG_USERAUTH_GSSAPI_RESPONSE 60 |
436 | 'SSH2_MSG_USERAUTH_GSSAPI_RESPONSE' => sub { |
437 | my ($direction, $seq, $data) = @_; |
438 | print "\n"; |
439 | }, |
440 | #define SSH2_MSG_USERAUTH_GSSAPI_TOKEN 61 |
441 | 'SSH2_MSG_USERAUTH_GSSAPI_TOKEN' => sub { |
442 | my ($direction, $seq, $data) = @_; |
443 | print "\n"; |
444 | }, |
445 | #define SSH2_MSG_USERAUTH_GSSAPI_EXCHANGE_COMPLETE 63 |
446 | 'SSH2_MSG_USERAUTH_GSSAPI_EXCHANGE_COMPLETE' => sub { |
447 | my ($direction, $seq, $data) = @_; |
448 | print "\n"; |
449 | }, |
450 | #define SSH2_MSG_USERAUTH_GSSAPI_ERROR 64 |
451 | 'SSH2_MSG_USERAUTH_GSSAPI_ERROR' => sub { |
452 | my ($direction, $seq, $data) = @_; |
453 | print "\n"; |
454 | }, |
455 | #define SSH2_MSG_USERAUTH_GSSAPI_ERRTOK 65 |
456 | 'SSH2_MSG_USERAUTH_GSSAPI_ERRTOK' => sub { |
457 | my ($direction, $seq, $data) = @_; |
458 | print "\n"; |
459 | }, |
460 | #define SSH2_MSG_USERAUTH_GSSAPI_MIC 66 |
461 | 'SSH2_MSG_USERAUTH_GSSAPI_MIC' => sub { |
462 | my ($direction, $seq, $data) = @_; |
463 | print "\n"; |
464 | }, |
465 | ); |
466 | |
1f7a2b70 |
467 | my %sftp_packets = ( |
468 | #define SSH_FXP_INIT 1 /* 0x1 */ |
469 | 0x1 => sub { |
470 | my ($chan, $index, $direction, $id, $data) = @_; |
471 | my ($ver) = &parse("u", $data); |
472 | printf "SSH_FXP_INIT %d\n", $ver; |
473 | }, |
474 | #define SSH_FXP_VERSION 2 /* 0x2 */ |
475 | 0x2 => sub { |
476 | my ($chan, $index, $direction, $id, $data) = @_; |
477 | my ($ver) = &parse("u", $data); |
478 | printf "SSH_FXP_VERSION %d\n", $ver; |
479 | }, |
480 | #define SSH_FXP_OPEN 3 /* 0x3 */ |
481 | 0x3 => sub { |
482 | my ($chan, $index, $direction, $id, $data) = @_; |
483 | my ($reqid, $path, $pflags) = &parse("usu", $data); |
484 | &sftp_logreq($chan, $direction, $reqid, $id, "SSH_FXP_OPEN"); |
485 | printf " \"%s\" ", $path; |
486 | if ($pflags eq 0) { |
487 | print "0"; |
488 | } else { |
489 | my $sep = ""; |
490 | if ($pflags & 1) { $pflags ^= 1; print "${sep}READ"; $sep = "|"; } |
491 | if ($pflags & 2) { $pflags ^= 2; print "${sep}WRITE"; $sep = "|"; } |
492 | if ($pflags & 4) { $pflags ^= 4; print "${sep}APPEND"; $sep = "|"; } |
493 | if ($pflags & 8) { $pflags ^= 8; print "${sep}CREAT"; $sep = "|"; } |
494 | if ($pflags & 16) { $pflags ^= 16; print "${sep}TRUNC"; $sep = "|"; } |
495 | if ($pflags & 32) { $pflags ^= 32; print "${sep}EXCL"; $sep = "|"; } |
496 | if ($pflags) { print "${sep}${pflags}"; } |
497 | } |
498 | print "\n"; |
499 | }, |
500 | #define SSH_FXP_CLOSE 4 /* 0x4 */ |
501 | 0x4 => sub { |
502 | my ($chan, $index, $direction, $id, $data) = @_; |
503 | my ($reqid, $handle) = &parse("us", $data); |
504 | &sftp_logreq($chan, $direction, $reqid, $id, "SSH_FXP_CLOSE"); |
505 | printf " \"%s\"", &stringescape($handle); |
506 | print "\n"; |
507 | }, |
508 | #define SSH_FXP_READ 5 /* 0x5 */ |
509 | 0x5 => sub { |
510 | my ($chan, $index, $direction, $id, $data) = @_; |
511 | my ($reqid, $handle, $offset, $len) = &parse("usUu", $data); |
512 | &sftp_logreq($chan, $direction, $reqid, $id, "SSH_FXP_READ"); |
513 | printf " \"%s\" %d %d", &stringescape($handle), $offset, $len; |
514 | print "\n"; |
515 | }, |
516 | #define SSH_FXP_WRITE 6 /* 0x6 */ |
517 | 0x6 => sub { |
518 | my ($chan, $index, $direction, $id, $data) = @_; |
519 | my ($reqid, $handle, $offset, $wdata) = &parse("usUs", $data); |
520 | &sftp_logreq($chan, $direction, $reqid, $id, "SSH_FXP_WRITE"); |
521 | printf " \"%s\" %d [%d bytes]", &stringescape($handle), $offset, length $wdata; |
522 | print "\n"; |
523 | }, |
524 | #define SSH_FXP_LSTAT 7 /* 0x7 */ |
525 | 0x7 => sub { |
526 | my ($chan, $index, $direction, $id, $data) = @_; |
527 | my ($reqid, $path) = &parse("us", $data); |
528 | &sftp_logreq($chan, $direction, $reqid, $id, "SSH_FXP_LSTAT"); |
529 | printf " \"%s\"", $path; |
530 | print "\n"; |
531 | }, |
532 | #define SSH_FXP_FSTAT 8 /* 0x8 */ |
533 | 0x8 => sub { |
534 | my ($chan, $index, $direction, $id, $data) = @_; |
535 | my ($reqid, $handle) = &parse("us", $data); |
536 | &sftp_logreq($chan, $direction, $reqid, $id, "SSH_FXP_FSTAT"); |
537 | printf " \"%s\"", &stringescape($handle); |
538 | print "\n"; |
539 | }, |
540 | #define SSH_FXP_SETSTAT 9 /* 0x9 */ |
541 | 0x9 => sub { |
542 | my ($chan, $index, $direction, $id, $data) = @_; |
543 | my ($reqid, $path) = &parse("us", $data); |
544 | &sftp_logreq($chan, $direction, $reqid, $id, "SSH_FXP_SETSTAT"); |
545 | my $attrs = &sftp_parse_attrs($data); |
546 | printf " \"%s\" %s", $path, $attrs; |
547 | print "\n"; |
548 | }, |
549 | #define SSH_FXP_FSETSTAT 10 /* 0xa */ |
550 | 0xa => sub { |
551 | my ($chan, $index, $direction, $id, $data) = @_; |
552 | my ($reqid, $handle) = &parse("us", $data); |
553 | &sftp_logreq($chan, $direction, $reqid, $id, "SSH_FXP_FSETSTAT"); |
554 | my $attrs = &sftp_parse_attrs($data); |
555 | printf " \"%s\" %s", &stringescape($handle), $attrs; |
556 | print "\n"; |
557 | }, |
558 | #define SSH_FXP_OPENDIR 11 /* 0xb */ |
559 | 0xb => sub { |
560 | my ($chan, $index, $direction, $id, $data) = @_; |
561 | my ($reqid, $path) = &parse("us", $data); |
562 | &sftp_logreq($chan, $direction, $reqid, $id, "SSH_FXP_OPENDIR"); |
563 | printf " \"%s\"", $path; |
564 | print "\n"; |
565 | }, |
566 | #define SSH_FXP_READDIR 12 /* 0xc */ |
567 | 0xc => sub { |
568 | my ($chan, $index, $direction, $id, $data) = @_; |
569 | my ($reqid, $handle) = &parse("us", $data); |
570 | &sftp_logreq($chan, $direction, $reqid, $id, "SSH_FXP_READDIR"); |
571 | printf " \"%s\"", &stringescape($handle); |
572 | print "\n"; |
573 | }, |
574 | #define SSH_FXP_REMOVE 13 /* 0xd */ |
575 | 0xd => sub { |
576 | my ($chan, $index, $direction, $id, $data) = @_; |
577 | my ($reqid, $path) = &parse("us", $data); |
578 | &sftp_logreq($chan, $direction, $reqid, $id, "SSH_FXP_REMOVE"); |
579 | printf " \"%s\"", $path; |
580 | print "\n"; |
581 | }, |
582 | #define SSH_FXP_MKDIR 14 /* 0xe */ |
583 | 0xe => sub { |
584 | my ($chan, $index, $direction, $id, $data) = @_; |
585 | my ($reqid, $path) = &parse("us", $data); |
586 | &sftp_logreq($chan, $direction, $reqid, $id, "SSH_FXP_MKDIR"); |
587 | printf " \"%s\"", $path; |
588 | print "\n"; |
589 | }, |
590 | #define SSH_FXP_RMDIR 15 /* 0xf */ |
591 | 0xf => sub { |
592 | my ($chan, $index, $direction, $id, $data) = @_; |
593 | my ($reqid, $path) = &parse("us", $data); |
594 | &sftp_logreq($chan, $direction, $reqid, $id, "SSH_FXP_RMDIR"); |
595 | printf " \"%s\"", $path; |
596 | print "\n"; |
597 | }, |
598 | #define SSH_FXP_REALPATH 16 /* 0x10 */ |
599 | 0x10 => sub { |
600 | my ($chan, $index, $direction, $id, $data) = @_; |
601 | my ($reqid, $path) = &parse("us", $data); |
602 | &sftp_logreq($chan, $direction, $reqid, $id, "SSH_FXP_REALPATH"); |
603 | printf " \"%s\"", $path; |
604 | print "\n"; |
605 | }, |
606 | #define SSH_FXP_STAT 17 /* 0x11 */ |
607 | 0x11 => sub { |
608 | my ($chan, $index, $direction, $id, $data) = @_; |
609 | my ($reqid, $path) = &parse("us", $data); |
610 | &sftp_logreq($chan, $direction, $reqid, $id, "SSH_FXP_STAT"); |
611 | printf " \"%s\"", $path; |
612 | print "\n"; |
613 | }, |
614 | #define SSH_FXP_RENAME 18 /* 0x12 */ |
615 | 0x12 => sub { |
616 | my ($chan, $index, $direction, $id, $data) = @_; |
617 | my ($reqid, $srcpath, $dstpath) = &parse("uss", $data); |
618 | &sftp_logreq($chan, $direction, $reqid, $id, "SSH_FXP_RENAME"); |
619 | printf " \"%s\" \"%s\"", $srcpath, $dstpath; |
620 | print "\n"; |
621 | }, |
622 | #define SSH_FXP_STATUS 101 /* 0x65 */ |
623 | 0x65 => sub { |
624 | my ($chan, $index, $direction, $id, $data) = @_; |
625 | my ($reqid, $status) = &parse("uu", $data); |
626 | &sftp_logreply($chan, $direction, $reqid, $id, "SSH_FXP_STATUS"); |
627 | print " "; |
628 | if ($status eq "0") { print "SSH_FX_OK"; } |
629 | elsif ($status eq "1") { print "SSH_FX_EOF"; } |
630 | elsif ($status eq "2") { print "SSH_FX_NO_SUCH_FILE"; } |
631 | elsif ($status eq "3") { print "SSH_FX_PERMISSION_DENIED"; } |
632 | elsif ($status eq "4") { print "SSH_FX_FAILURE"; } |
633 | elsif ($status eq "5") { print "SSH_FX_BAD_MESSAGE"; } |
634 | elsif ($status eq "6") { print "SSH_FX_NO_CONNECTION"; } |
635 | elsif ($status eq "7") { print "SSH_FX_CONNECTION_LOST"; } |
636 | elsif ($status eq "8") { print "SSH_FX_OP_UNSUPPORTED"; } |
637 | else { printf "[unknown status %d]", $status; } |
638 | print "\n"; |
639 | }, |
640 | #define SSH_FXP_HANDLE 102 /* 0x66 */ |
641 | 0x66 => sub { |
642 | my ($chan, $index, $direction, $id, $data) = @_; |
643 | my ($reqid, $handle) = &parse("us", $data); |
644 | &sftp_logreply($chan, $direction, $reqid, $id, "SSH_FXP_HANDLE"); |
645 | printf " \"%s\"", &stringescape($handle); |
646 | print "\n"; |
647 | }, |
648 | #define SSH_FXP_DATA 103 /* 0x67 */ |
649 | 0x67 => sub { |
650 | my ($chan, $index, $direction, $id, $data) = @_; |
651 | my ($reqid, $retdata) = &parse("us", $data); |
652 | &sftp_logreply($chan, $direction, $reqid, $id, "SSH_FXP_DATA"); |
653 | printf " [%d bytes]", length $retdata; |
654 | print "\n"; |
655 | }, |
656 | #define SSH_FXP_NAME 104 /* 0x68 */ |
657 | 0x68 => sub { |
658 | my ($chan, $index, $direction, $id, $data) = @_; |
659 | my ($reqid, $count) = &parse("uu", $data); |
660 | &sftp_logreply($chan, $direction, $reqid, $id, "SSH_FXP_NAME"); |
661 | for my $i (1..$count) { |
662 | my ($name, $longname) = &parse("ss", $data); |
663 | my $attrs = &sftp_parse_attrs($data); |
664 | print " [name=\"$name\", longname=\"$longname\", attrs=$attrs]"; |
665 | } |
666 | print "\n"; |
667 | }, |
668 | #define SSH_FXP_ATTRS 105 /* 0x69 */ |
669 | 0x69 => sub { |
670 | my ($chan, $index, $direction, $id, $data) = @_; |
671 | my ($reqid) = &parse("u", $data); |
672 | &sftp_logreply($chan, $direction, $reqid, $id, "SSH_FXP_ATTRS"); |
673 | my $attrs = &sftp_parse_attrs($data); |
674 | printf " %s", $attrs; |
675 | print "\n"; |
676 | }, |
677 | #define SSH_FXP_EXTENDED 200 /* 0xc8 */ |
678 | 0xc8 => sub { |
679 | my ($chan, $index, $direction, $id, $data) = @_; |
680 | my ($reqid, $type) = &parse("us", $data); |
681 | &sftp_logreq($chan, $direction, $reqid, $id, "SSH_FXP_EXTENDED"); |
682 | printf " \"%s\"", $type; |
683 | print "\n"; |
684 | }, |
685 | #define SSH_FXP_EXTENDED_REPLY 201 /* 0xc9 */ |
686 | 0xc9 => sub { |
687 | my ($chan, $index, $direction, $id, $data) = @_; |
688 | my ($reqid) = &parse("u", $data); |
689 | print "\n"; |
690 | &sftp_logreply($chan, $direction, $reqid,$id,"SSH_FXP_EXTENDED_REPLY"); |
691 | }, |
692 | ); |
693 | |
beb62006 |
694 | my ($direction, $seq, $ourseq, $type, $data, $recording); |
695 | my %ourseqs = ('i'=>0, 'o'=>0); |
696 | |
697 | $recording = 0; |
698 | while (<>) { |
699 | if ($recording) { |
700 | if (/^ [0-9a-fA-F]{8} ((?:[0-9a-fA-F]{2} )*[0-9a-fA-F]{2})/) { |
701 | push @$data, map { $_ eq "XX" ? -1 : hex $_ } split / /, $1; |
702 | } else { |
703 | $recording = 0; |
704 | my $fullseq = "$direction$ourseq"; |
705 | print "$fullseq: $type "; |
706 | if (defined $packets{$type}) { |
707 | $packets{$type}->($direction, $fullseq, $data); |
708 | } else { |
709 | printf "raw %s\n", join "", map { sprintf "%02x", $_ } @$data; |
710 | } |
711 | } |
712 | } |
713 | if (/^(Incoming|Outgoing) packet #0x([0-9a-fA-F]+), type \d+ \/ 0x[0-9a-fA-F]+ \((.*)\)/) { |
714 | $direction = ($1 eq "Incoming" ? 'i' : 'o'); |
715 | # $seq is the sequence number quoted in the log file. $ourseq |
716 | # is our own count of the sequence number, which differs in |
717 | # that it shouldn't wrap at 2^32, should anyone manage to run |
718 | # this script over such a huge log file. |
719 | $seq = hex $2; |
720 | $ourseq = $ourseqs{$direction}++; |
721 | $type = $3; |
722 | $data = []; |
723 | $recording = 1; |
724 | } |
725 | } |
726 | |
727 | if ($dumpchannels) { |
728 | my %stateorder = ('closed'=>0, 'rejected'=>1, |
729 | 'halfclosed'=>2, 'open'=>3, 'halfopen'=>4); |
730 | for my $index (0..$#channels) { |
731 | my $chan = $channels[$index]; |
8a202ff9 |
732 | my $so = $stateorder{$chan->{'state'}}; |
733 | $so = 1000 unless defined $so; # any state I've missed above comes last |
beb62006 |
734 | $chan->{'index'} = sprintf "ch%d", $index; |
735 | $chan->{'order'} = sprintf "%08d %08d", $so, $index; |
736 | } |
737 | my @sortedchannels = sort { $a->{'order'} cmp $b->{'order'} } @channels; |
738 | for my $chan (@sortedchannels) { |
739 | printf "%s (%s): %s\n", $chan->{'index'}, $chan->{'id'}, $chan->{'state'}; |
740 | } |
741 | } |
742 | |
743 | sub parseone { |
744 | my ($type, $data) = @_; |
745 | if ($type eq "u") { # uint32 |
746 | my @bytes = splice @$data, 0, 4; |
747 | return "<missing>" if @bytes < 4 or grep { $_<0 } @bytes; |
748 | return unpack "N", pack "C*", @bytes; |
749 | } elsif ($type eq "U") { # uint64 |
1f7a2b70 |
750 | my @bytes = splice @$data, 0, 8; |
beb62006 |
751 | return "<missing>" if @bytes < 8 or grep { $_<0 } @bytes; |
752 | my @words = unpack "NN", pack "C*", @bytes; |
753 | return ($words[0] << 32) + $words[1]; |
754 | } elsif ($type eq "b") { # boolean |
755 | my $byte = shift @$data; |
756 | return "<missing>" if !defined $byte or $byte < 0; |
757 | return $byte ? "yes" : "no"; |
758 | } elsif ($type eq "B") { # byte |
759 | my $byte = shift @$data; |
760 | return "<missing>" if !defined $byte or $byte < 0; |
761 | return $byte; |
762 | } elsif ($type eq "s" or $type eq "m") { # string, mpint |
763 | my @bytes = splice @$data, 0, 4; |
764 | return "<missing>" if @bytes < 4 or grep { $_<0 } @bytes; |
765 | my $len = unpack "N", pack "C*", @bytes; |
766 | @bytes = splice @$data, 0, $len; |
767 | return "<missing>" if @bytes < $len or grep { $_<0 } @bytes; |
768 | if ($type eq "mpint") { |
769 | my $str = ""; |
770 | if ($bytes[0] >= 128) { |
771 | # Take two's complement. |
772 | @bytes = map { 0xFF ^ $_ } @bytes; |
773 | for my $i (reverse 0..$#bytes) { |
774 | if ($bytes[$i] < 0xFF) { |
775 | $bytes[$i]++; |
776 | last; |
777 | } else { |
778 | $bytes[$i] = 0; |
779 | } |
780 | } |
781 | $str = "-"; |
782 | } |
783 | $str .= "0x" . join "", map { sprintf "%02x", $_ } @bytes; |
784 | return $str; |
785 | } else { |
786 | return pack "C*", @bytes; |
787 | } |
788 | } |
789 | } |
790 | |
791 | sub parse { |
792 | my ($template, $data) = @_; |
793 | return map { &parseone($_, $data) } split //, $template; |
794 | } |
795 | |
796 | sub str { |
797 | # Quote as a string. If I get enthusiastic I might arrange for |
798 | # strange characters inside the string to be quoted. |
799 | my $str = shift @_; |
800 | return "'$str'"; |
801 | } |
1f7a2b70 |
802 | |
803 | sub sftp_setup { |
804 | my $index = shift @_; |
805 | my $chan = $channels[$index]; |
806 | $chan->{'obuf'} = $chan->{'ibuf'} = ''; |
807 | $chan->{'ocnt'} = $chan->{'icnt'} = 0; |
808 | $chan->{'odata'} = $chan->{'idata'} = \&sftp_data; |
809 | $chan->{'sftpreqs'} = {}; |
810 | } |
811 | |
812 | sub sftp_data { |
813 | my ($chan, $index, $direction, $data) = @_; |
814 | my $buf = \$chan->{$direction."buf"}; |
815 | my $cnt = \$chan->{$direction."cnt"}; |
816 | $$buf .= $data; |
817 | while (length $$buf >= 4) { |
818 | my $msglen = unpack "N", $$buf; |
819 | last if length $$buf < 4 + $msglen; |
820 | my $msg = substr $$buf, 4, $msglen; |
821 | $$buf = substr $$buf, 4 + $msglen; |
822 | $msg = [unpack "C*", $msg]; |
823 | my $type = shift @$msg; |
824 | my $id = sprintf "ch%d_sftp_%s%d", $index, $direction, ${$cnt}++; |
825 | print "$id: "; |
826 | if (defined $sftp_packets{$type}) { |
827 | $sftp_packets{$type}->($chan, $index, $direction, $id, $msg); |
828 | } else { |
829 | printf "unknown SFTP packet type %d\n", $type; |
830 | } |
831 | } |
832 | } |
833 | |
834 | sub sftp_logreq { |
835 | my ($chan, $direction, $reqid, $id, $name) = @_; |
836 | print "$name"; |
837 | if ($direction eq "o") { # requests coming _in_ are too weird to track |
838 | $chan->{'sftpreqs'}->{$reqid} = $id; |
839 | } |
840 | } |
841 | |
842 | sub sftp_logreply { |
843 | my ($chan, $direction, $reqid, $id, $name) = @_; |
844 | print "$name"; |
845 | if ($direction eq "i") { # replies going _out_ are too weird to track |
846 | if (defined $chan->{'sftpreqs'}->{$reqid}) { |
847 | print " to ", $chan->{'sftpreqs'}->{$reqid}; |
848 | $chan->{'sftpreqs'}->{$reqid} = undef; |
849 | } |
850 | } |
851 | } |
852 | |
853 | sub sftp_parse_attrs { |
854 | my ($data) = @_; |
855 | my ($flags) = &parse("u", $data); |
856 | return $flags if $flags eq "<missing>"; |
857 | my $out = "{"; |
858 | my $sep = ""; |
859 | if ($flags & 0x00000001) { # SSH_FILEXFER_ATTR_SIZE |
860 | $out .= $sep . sprintf "size=%d", &parse("U", $data); |
861 | $sep = ", "; |
862 | } |
863 | if ($flags & 0x00000002) { # SSH_FILEXFER_ATTR_UIDGID |
864 | $out .= $sep . sprintf "uid=%d", &parse("u", $data); |
865 | $out .= $sep . sprintf "gid=%d", &parse("u", $data); |
866 | $sep = ", "; |
867 | } |
868 | if ($flags & 0x00000004) { # SSH_FILEXFER_ATTR_PERMISSIONS |
869 | $out .= $sep . sprintf "perms=%#o", &parse("u", $data); |
870 | $sep = ", "; |
871 | } |
872 | if ($flags & 0x00000008) { # SSH_FILEXFER_ATTR_ACMODTIME |
873 | $out .= $sep . sprintf "atime=%d", &parse("u", $data); |
874 | $out .= $sep . sprintf "mtime=%d", &parse("u", $data); |
875 | $sep = ", "; |
876 | } |
877 | if ($flags & 0x80000000) { # SSH_FILEXFER_ATTR_EXTENDED |
878 | my $extcount = &parse("u", $data); |
879 | while ($extcount-- > 0) { |
880 | $out .= $sep . sprintf "\"%s\"=\"%s\"", &parse("ss", $data); |
881 | $sep = ", "; |
882 | } |
883 | } |
884 | $out .= "}"; |
885 | return $out; |
886 | } |
887 | |
888 | sub stringescape { |
889 | my ($str) = @_; |
890 | $str =~ s!\\!\\\\!g; |
891 | $str =~ s![^ -~]!sprintf "\\x%02X", ord $&!eg; |
892 | return $str; |
893 | } |