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