contrib/logparse.pl

   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_KEX_ECDH_INIT                    30    /* 0x1e */
 119     'SSH2_MSG_KEX_ECDH_INIT' => sub {
 120         my ($direction, $seq, $data) = @_;
 121         print "\n";
 122     },
 123 #define SSH2_MSG_KEX_ECDH_REPLY                   31    /* 0x1f */
 124     'SSH2_MSG_KEX_ECDH_REPLY' => sub {
 125         my ($direction, $seq, $data) = @_;
 126         print "\n";
 127     },
 128 #define SSH2_MSG_USERAUTH_REQUEST                 50    /* 0x32 */
 129     'SSH2_MSG_USERAUTH_REQUEST' => sub {
 130         my ($direction, $seq, $data) = @_;
 131         my ($user, $service, $method) = &parse("sss", $data);
 132         my $out = sprintf "%s %s %s",
 133             &str($user), &str($service), &str($method);
 134         if ($method eq "publickey") {
 135             my ($real) = &parse("b", $data);
 136             $out .= " real=$real";
 137         } elsif ($method eq "password") {
 138             my ($change) = &parse("b", $data);
 139             $out .= " change=$change";
 140         }
 141         print "$out\n";
 142     },
 143 #define SSH2_MSG_USERAUTH_FAILURE                 51    /* 0x33 */
 144     'SSH2_MSG_USERAUTH_FAILURE' => sub {
 145         my ($direction, $seq, $data) = @_;
 146         my ($options) = &parse("s", $data);
 147         printf "%s\n", &str($options);
 148     },
 149 #define SSH2_MSG_USERAUTH_SUCCESS                 52    /* 0x34 */
 150     'SSH2_MSG_USERAUTH_SUCCESS' => sub {
 151         my ($direction, $seq, $data) = @_;
 152         print "\n";
 153     },
 154 #define SSH2_MSG_USERAUTH_BANNER                  53    /* 0x35 */
 155     'SSH2_MSG_USERAUTH_BANNER' => sub {
 156         my ($direction, $seq, $data) = @_;
 157         print "\n";
 158     },
 159 #define SSH2_MSG_USERAUTH_PK_OK                   60    /* 0x3c */
 160     'SSH2_MSG_USERAUTH_PK_OK' => sub {
 161         my ($direction, $seq, $data) = @_;
 162         print "\n";
 163     },
 164 #define SSH2_MSG_USERAUTH_PASSWD_CHANGEREQ        60    /* 0x3c */
 165     'SSH2_MSG_USERAUTH_PASSWD_CHANGEREQ' => sub {
 166         my ($direction, $seq, $data) = @_;
 167         print "\n";
 168     },
 169 #define SSH2_MSG_USERAUTH_INFO_REQUEST            60    /* 0x3c */
 170     'SSH2_MSG_USERAUTH_INFO_REQUEST' => sub {
 171         my ($direction, $seq, $data) = @_;
 172         print "\n";
 173     },
 174 #define SSH2_MSG_USERAUTH_INFO_RESPONSE           61    /* 0x3d */
 175     'SSH2_MSG_USERAUTH_INFO_RESPONSE' => sub {
 176         my ($direction, $seq, $data) = @_;
 177         print "\n";
 178     },
 179 #define SSH2_MSG_GLOBAL_REQUEST                   80    /* 0x50 */
 180     'SSH2_MSG_GLOBAL_REQUEST' => sub {
 181         my ($direction, $seq, $data) = @_;
 182         my ($type, $wantreply) = &parse("sb", $data);
 183         printf "%s (%s)", $type, $wantreply eq "yes" ? "reply" : "noreply";
 184         my $request = [$seq, $type];
 185         push @{$globalreq{$direction}}, $request if $wantreply eq "yes";
 186         if ($type eq "tcpip-forward" or $type eq "cancel-tcpip-forward") {
 187             my ($addr, $port) = &parse("su", $data);
 188             printf " %s:%s", $addr, $port;
 189             push @$request, $port;
 190         }
 191         print "\n";
 192     },
 193 #define SSH2_MSG_REQUEST_SUCCESS                  81    /* 0x51 */
 194     'SSH2_MSG_REQUEST_SUCCESS' => sub {
 195         my ($direction, $seq, $data) = @_;
 196         my $otherdir = ($direction eq "i" ? "o" : "i");
 197         my $request = shift @{$globalreq{$otherdir}};
 198         if (defined $request) {
 199             printf "to %s", $request->[0];
 200             if ($request->[1] eq "tcpip-forward" and $request->[2] == 0) {
 201                 my ($port) = &parse("u", $data);
 202                 printf " port=%s", $port;
 203             }
 204         } else {
 205             print "(spurious?)";
 206         }
 207         print "\n";
 208     },
 209 #define SSH2_MSG_REQUEST_FAILURE                  82    /* 0x52 */
 210     'SSH2_MSG_REQUEST_FAILURE' => sub {
 211         my ($direction, $seq, $data) = @_;
 212         my $otherdir = ($direction eq "i" ? "o" : "i");
 213         my $request = shift @{$globalreq{$otherdir}};
 214         if (defined $request) {
 215             printf "to %s", $request->[0];
 216         } else {
 217             print "(spurious?)";
 218         }
 219         print "\n";
 220     },
 221 #define SSH2_MSG_CHANNEL_OPEN                     90    /* 0x5a */
 222     'SSH2_MSG_CHANNEL_OPEN' => sub {
 223         my ($direction, $seq, $data) = @_;
 224         my ($type, $sid, $winsize, $packet) = &parse("suuu", $data);
 225         # CHANNEL_OPEN tells the other side the _sender's_ id for the
 226         # channel, so this choice between "s" and "c" prefixes is
 227         # opposite to every other message in the protocol, which all
 228         # quote the _recipient's_ id of the channel.
 229         $sid = ($direction eq "i" ? "s" : "c") . $sid;
 230         my $chan = {'id'=>$sid, 'state'=>'halfopen',
 231                     'i'=>{'win'=>0, 'seq'=>0},
 232                     'o'=>{'win'=>0, 'seq'=>0}};
 233         $chan->{$direction}{'win'} = $winsize;
 234         push @channels, $chan;
 235         my $index = $#channels;
 236         $chan_by_id{$sid} = $index;
 237         printf "ch%d (%s) %s (--%d)", $index, $chan->{'id'}, $type,
 238             $chan->{$direction}{'win'};
 239         if ($type eq "x11") {
 240             my ($addr, $port) = &parse("su", $data);
 241             printf " from %s:%s", $addr, $port;
 242         } elsif ($type eq "forwarded-tcpip") {
 243             my ($saddr, $sport, $paddr, $pport) = &parse("susu", $data);
 244             printf " to %s:%s from %s:%s", $saddr, $sport, $paddr, $pport;
 245         } elsif ($type eq "direct-tcpip") {
 246             my ($daddr, $dport, $saddr, $sport) = &parse("susu", $data);
 247             printf " to %s:%s from %s:%s", $daddr, $dport, $saddr, $sport;
 248         }
 249         print "\n";
 250     },
 251 #define SSH2_MSG_CHANNEL_OPEN_CONFIRMATION        91    /* 0x5b */
 252     'SSH2_MSG_CHANNEL_OPEN_CONFIRMATION' => sub {
 253         my ($direction, $seq, $data) = @_;
 254         my ($rid, $sid, $winsize, $packet) = &parse("uuuu", $data);
 255         $rid = ($direction eq "i" ? "c" : "s") . $rid;
 256         my $index = $chan_by_id{$rid};
 257         if (!defined $index) {
 258             printf "UNKNOWN_CHANNEL (%s) (--%d)\n", $rid, $winsize;
 259             return;
 260         }
 261         $sid = ($direction eq "i" ? "s" : "c") . $sid;
 262         $chan_by_id{$sid} = $index;
 263         my $chan = $channels[$index];
 264         $chan->{'id'} = ($direction eq "i" ? "$rid/$sid" : "$sid/$rid");
 265         $chan->{'state'} = 'open';
 266         $chan->{$direction}{'win'} = $winsize;
 267         printf "ch%d (%s) (--%d)\n", $index, $chan->{'id'},
 268             $chan->{$direction}{'win'};
 269     },
 270 #define SSH2_MSG_CHANNEL_OPEN_FAILURE             92    /* 0x5c */
 271     'SSH2_MSG_CHANNEL_OPEN_FAILURE' => sub {
 272         my ($direction, $seq, $data) = @_;
 273         my ($rid, $reason, $desc, $lang) = &parse("uuss", $data);
 274         $rid = ($direction eq "i" ? "c" : "s") . $rid;
 275         my $index = $chan_by_id{$rid};
 276         if (!defined $index) {
 277             printf "UNKNOWN_CHANNEL (%s) %s\n", $rid, &str($reason);
 278             return;
 279         }
 280         my $chan = $channels[$index];
 281         $chan->{'state'} = 'rejected';
 282         printf "ch%d (%s) %s\n", $index, $chan->{'id'}, &str($reason);
 283     },
 284 #define SSH2_MSG_CHANNEL_WINDOW_ADJUST            93    /* 0x5d */
 285     'SSH2_MSG_CHANNEL_WINDOW_ADJUST' => sub {
 286         my ($direction, $seq, $data) = @_;
 287         my ($rid, $bytes) = &parse("uu", $data);
 288         $rid = ($direction eq "i" ? "c" : "s") . $rid;
 289         my $index = $chan_by_id{$rid};
 290         if (!defined $index) {
 291             printf "UNKNOWN_CHANNEL (%s) +%d\n", $rid, $bytes;
 292             return;
 293         }
 294         my $chan = $channels[$index];
 295         $chan->{$direction}{'win'} += $bytes;
 296         printf "ch%d (%s) +%d (--%d)\n", $index, $chan->{'id'}, $bytes,
 297             $chan->{$direction}{'win'};
 298     },
 299 #define SSH2_MSG_CHANNEL_DATA                     94    /* 0x5e */
 300     'SSH2_MSG_CHANNEL_DATA' => sub {
 301         my ($direction, $seq, $data) = @_;
 302         my ($rid, $bytes) = &parse("uu", $data);
 303         $rid = ($direction eq "i" ? "c" : "s") . $rid;
 304         my $index = $chan_by_id{$rid};
 305         if (!defined $index) {
 306             printf "UNKNOWN_CHANNEL (%s), %s bytes\n", $rid, $bytes;
 307             return;
 308         }
 309         my $chan = $channels[$index];
 310         $chan->{$direction}{'seq'} += $bytes;
 311         printf "ch%d (%s), %s bytes (%d--%d)\n", $index, $chan->{'id'}, $bytes,
 312             $chan->{$direction}{'seq'}-$bytes, $chan->{$direction}{'seq'};
 313         my @realdata = splice @$data, 0, $bytes;
 314         if ($dumpdata) {
 315             my $filekey = $direction . "file";
 316             if (!defined $chan->{$filekey}) {
 317                 my $filename = sprintf "ch%d.%s", $index, $direction;
 318                 $chan->{$filekey} = FileHandle->new(">$filename");
 319                 if (!defined $chan->{$filekey}) {
 320                     die "$filename: $!\n";
 321                 }
 322             }
 323             die "channel data not present in $seq\n" if @realdata < $bytes;
 324             my $rawdata = pack "C*", @realdata;
 325             my $fh = $chan->{$filekey};
 326             print $fh $rawdata;
 327         }
 328         if (@realdata == $bytes and defined $chan->{$direction."data"}) {
 329             my $rawdata = pack "C*", @realdata;
 330             $chan->{$direction."data"}->($chan, $index, $direction, $rawdata);
 331         }
 332     },
 333 #define SSH2_MSG_CHANNEL_EXTENDED_DATA            95    /* 0x5f */
 334     'SSH2_MSG_CHANNEL_EXTENDED_DATA' => sub {
 335         my ($direction, $seq, $data) = @_;
 336         my ($rid, $type, $bytes) = &parse("uuu", $data);
 337         if ($type == 1) {
 338             $type = "SSH_EXTENDED_DATA_STDERR";
 339         }
 340         $rid = ($direction eq "i" ? "c" : "s") . $rid;
 341         my $index = $chan_by_id{$rid};
 342         if (!defined $index) {
 343             printf "UNKNOWN_CHANNEL (%s), type %s, %s bytes\n", $rid,
 344                 $type, $bytes;
 345             return;
 346         }
 347         my $chan = $channels[$index];
 348         $chan->{$direction}{'seq'} += $bytes;
 349         printf "ch%d (%s), type %s, %s bytes (%d--%d)\n", $index,$chan->{'id'},
 350             $type, $bytes, $chan->{$direction}{'seq'}-$bytes,
 351             $chan->{$direction}{'seq'};
 352         my @realdata = splice @$data, 0, $bytes;
 353         if ($dumpdata) {
 354             # We treat EXTENDED_DATA as equivalent to DATA, for the
 355             # moment. It's not clear what else would be a better thing
 356             # to do with it, and this at least is the Right Answer if
 357             # the data is going to a terminal and the aim is to debug
 358             # the terminal emulator.
 359             my $filekey = $direction . "file";
 360             if (!defined $chan->{$filekey}) {
 361                 my $filename = sprintf "ch%d.%s", $index, $direction;
 362                 $chan->{$filekey} = FileHandle->new(">$filename");
 363                 if (!defined $chan->{$filekey}) {
 364                     die "$filename: $!\n";
 365                 }
 366             }
 367             die "channel data not present in $seq\n" if @realdata < $bytes;
 368             my $rawdata = pack "C*", @realdata;
 369             my $fh = $chan->{$filekey};
 370             print $fh $rawdata;
 371         }
 372         if (@realdata == $bytes and defined $chan->{$direction."data"}) {
 373             my $rawdata = pack "C*", @realdata;
 374             $chan->{$direction."data"}->($chan, $index, $direction, $rawdata);
 375         }
 376     },
 377 #define SSH2_MSG_CHANNEL_EOF                      96    /* 0x60 */
 378     'SSH2_MSG_CHANNEL_EOF' => sub {
 379         my ($direction, $seq, $data) = @_;
 380         my ($rid) = &parse("uu", $data);
 381         $rid = ($direction eq "i" ? "c" : "s") . $rid;
 382         my $index = $chan_by_id{$rid};
 383         if (!defined $index) {
 384             printf "UNKNOWN_CHANNEL (%s)\n", $rid;
 385             return;
 386         }
 387         my $chan = $channels[$index];
 388         printf "ch%d (%s)\n", $index, $chan->{'id'};
 389     },
 390 #define SSH2_MSG_CHANNEL_CLOSE                    97    /* 0x61 */
 391     'SSH2_MSG_CHANNEL_CLOSE' => sub {
 392         my ($direction, $seq, $data) = @_;
 393         my ($rid) = &parse("uu", $data);
 394         $rid = ($direction eq "i" ? "c" : "s") . $rid;
 395         my $index = $chan_by_id{$rid};
 396         if (!defined $index) {
 397             printf "UNKNOWN_CHANNEL (%s)\n", $rid;
 398             return;
 399         }
 400         my $chan = $channels[$index];
 401         $chan->{'state'} = ($chan->{'state'} eq "open" ? "halfclosed" :
 402                             $chan->{'state'} eq "halfclosed" ? "closed" :
 403                             "confused");
 404         if ($chan->{'state'} eq "closed") {
 405             $chan->{'ifile'}->close if defined $chan->{'ifile'};
 406             $chan->{'ofile'}->close if defined $chan->{'ofile'};
 407         }
 408         printf "ch%d (%s)\n", $index, $chan->{'id'};
 409     },
 410 #define SSH2_MSG_CHANNEL_REQUEST                  98    /* 0x62 */
 411     'SSH2_MSG_CHANNEL_REQUEST' => sub {
 412         my ($direction, $seq, $data) = @_;
 413         my ($rid, $type, $wantreply) = &parse("usb", $data);
 414         $rid = ($direction eq "i" ? "c" : "s") . $rid;
 415         my $index = $chan_by_id{$rid};
 416         my $chan;
 417         if (!defined $index) {
 418             printf "UNKNOWN_CHANNEL (%s) %s (%s)", $rid,
 419                 $type, $wantreply eq "yes" ? "reply" : "noreply";
 420         } else {
 421             $chan = $channels[$index];
 422             printf "ch%d (%s) %s (%s)", $index, $chan->{'id'},
 423                 $type, $wantreply eq "yes" ? "reply" : "noreply";
 424             push @{$chan->{'requests_'.$direction}}, [$seq, $type]
 425                 if $wantreply eq "yes";
 426         }
 427         if ($type eq "pty-req") {
 428             my ($term, $w, $h, $pw, $ph, $modes) = &parse("suuuus", $data);
 429             printf " %s %sx%s", &str($term), $w, $h;
 430         } elsif ($type eq "x11-req") {
 431             my ($single, $xprot, $xcookie, $xscreen) = &parse("bssu", $data);
 432             print " one-off" if $single eq "yes";
 433             printf " %s :%s", $xprot, $xscreen;
 434         } elsif ($type eq "exec") {
 435             my ($command) = &parse("s", $data);
 436             printf " %s", &str($command);
 437         } elsif ($type eq "subsystem") {
 438             my ($subsys) = &parse("s", $data);
 439             printf " %s", &str($subsys);
 440             if ($subsys eq "sftp") {
 441                 &sftp_setup($index);
 442             }
 443         } elsif ($type eq "window-change") {
 444             my ($w, $h, $pw, $ph) = &parse("uuuu", $data);
 445             printf " %sx%s", $w, $h;
 446         } elsif ($type eq "xon-xoff") {
 447             my ($can) = &parse("b", $data);
 448             printf " %s", $can;
 449         } elsif ($type eq "signal") {
 450             my ($sig) = &parse("s", $data);
 451             printf " %s", &str($sig);
 452         } elsif ($type eq "exit-status") {
 453             my ($status) = &parse("u", $data);
 454             printf " %s", $status;
 455         } elsif ($type eq "exit-signal") {
 456             my ($sig, $core, $error, $lang) = &parse("sbss", $data);
 457             printf " %s", &str($sig);
 458             print " (core dumped)" if $core eq "yes";
 459         }
 460         print "\n";
 461     },
 462 #define SSH2_MSG_CHANNEL_SUCCESS                  99    /* 0x63 */
 463     'SSH2_MSG_CHANNEL_SUCCESS' => sub {
 464         my ($direction, $seq, $data) = @_;
 465         my ($rid) = &parse("uu", $data);
 466         $rid = ($direction eq "i" ? "c" : "s") . $rid;
 467         my $index = $chan_by_id{$rid};
 468         if (!defined $index) {
 469             printf "UNKNOWN_CHANNEL (%s)\n", $rid;
 470             return;
 471         }
 472         my $chan = $channels[$index];
 473         printf "ch%d (%s)", $index, $chan->{'id'};
 474         my $otherdir = ($direction eq "i" ? "o" : "i");
 475         my $request = shift @{$chan->{'requests_' . $otherdir}};
 476         if (defined $request) {
 477             printf " to %s", $request->[0];
 478         } else {
 479             print " (spurious?)";
 480         }
 481         print "\n";
 482     },
 483 #define SSH2_MSG_CHANNEL_FAILURE                  100   /* 0x64 */
 484     'SSH2_MSG_CHANNEL_FAILURE' => sub {
 485         my ($direction, $seq, $data) = @_;
 486         my ($rid) = &parse("uu", $data);
 487         $rid = ($direction eq "i" ? "c" : "s") . $rid;
 488         my $index = $chan_by_id{$rid};
 489         if (!defined $index) {
 490             printf "UNKNOWN_CHANNEL (%s)\n", $rid;
 491             return;
 492         }
 493         my $chan = $channels[$index];
 494         printf "ch%d (%s)", $index, $chan->{'id'};
 495         my $otherdir = ($direction eq "i" ? "o" : "i");
 496         my $request = shift @{$chan->{'requests_' . $otherdir}};
 497         if (defined $request) {
 498             printf " to %s", $request->[0];
 499         } else {
 500             print " (spurious?)";
 501         }
 502         print "\n";
 503     },
 504 #define SSH2_MSG_USERAUTH_GSSAPI_RESPONSE               60
 505     'SSH2_MSG_USERAUTH_GSSAPI_RESPONSE' => sub {
 506         my ($direction, $seq, $data) = @_;
 507         print "\n";
 508     },
 509 #define SSH2_MSG_USERAUTH_GSSAPI_TOKEN                  61
 510     'SSH2_MSG_USERAUTH_GSSAPI_TOKEN' => sub {
 511         my ($direction, $seq, $data) = @_;
 512         print "\n";
 513     },
 514 #define SSH2_MSG_USERAUTH_GSSAPI_EXCHANGE_COMPLETE      63
 515     'SSH2_MSG_USERAUTH_GSSAPI_EXCHANGE_COMPLETE' => sub {
 516         my ($direction, $seq, $data) = @_;
 517         print "\n";
 518     },
 519 #define SSH2_MSG_USERAUTH_GSSAPI_ERROR                  64
 520     'SSH2_MSG_USERAUTH_GSSAPI_ERROR' => sub {
 521         my ($direction, $seq, $data) = @_;
 522         print "\n";
 523     },
 524 #define SSH2_MSG_USERAUTH_GSSAPI_ERRTOK                 65
 525     'SSH2_MSG_USERAUTH_GSSAPI_ERRTOK' => sub {
 526         my ($direction, $seq, $data) = @_;
 527         print "\n";
 528     },
 529 #define SSH2_MSG_USERAUTH_GSSAPI_MIC                    66
 530     'SSH2_MSG_USERAUTH_GSSAPI_MIC' => sub {
 531         my ($direction, $seq, $data) = @_;
 532         print "\n";
 533     },
 534 );
 535
 536 my %sftp_packets = (
 537 #define SSH_FXP_INIT                              1     /* 0x1 */
 538     0x1 => sub {
 539         my ($chan, $index, $direction, $id, $data) = @_;
 540         my ($ver) = &parse("u", $data);
 541         printf "SSH_FXP_INIT %d\n", $ver;
 542     },
 543 #define SSH_FXP_VERSION                           2     /* 0x2 */
 544     0x2 => sub {
 545         my ($chan, $index, $direction, $id, $data) = @_;
 546         my ($ver) = &parse("u", $data);
 547         printf "SSH_FXP_VERSION %d\n", $ver;
 548     },
 549 #define SSH_FXP_OPEN                              3     /* 0x3 */
 550     0x3 => sub {
 551         my ($chan, $index, $direction, $id, $data) = @_;
 552         my ($reqid, $path, $pflags) = &parse("usu", $data);
 553         &sftp_logreq($chan, $direction, $reqid, $id, "SSH_FXP_OPEN");
 554         printf " \"%s\" ", $path;
 555         if ($pflags eq 0) {
 556             print "0";
 557         } else {
 558             my $sep = "";
 559             if ($pflags & 1) { $pflags ^= 1; print "${sep}READ"; $sep = "|"; }
 560             if ($pflags & 2) { $pflags ^= 2; print "${sep}WRITE"; $sep = "|"; }
 561             if ($pflags & 4) { $pflags ^= 4; print "${sep}APPEND"; $sep = "|"; }
 562             if ($pflags & 8) { $pflags ^= 8; print "${sep}CREAT"; $sep = "|"; }
 563             if ($pflags & 16) { $pflags ^= 16; print "${sep}TRUNC"; $sep = "|"; }
 564             if ($pflags & 32) { $pflags ^= 32; print "${sep}EXCL"; $sep = "|"; }
 565             if ($pflags) { print "${sep}${pflags}"; }
 566         }
 567         print "\n";
 568     },
 569 #define SSH_FXP_CLOSE                             4     /* 0x4 */
 570     0x4 => sub {
 571         my ($chan, $index, $direction, $id, $data) = @_;
 572         my ($reqid, $handle) = &parse("us", $data);
 573         &sftp_logreq($chan, $direction, $reqid, $id, "SSH_FXP_CLOSE");
 574         printf " \"%s\"", &stringescape($handle);
 575         print "\n";
 576     },
 577 #define SSH_FXP_READ                              5     /* 0x5 */
 578     0x5 => sub {
 579         my ($chan, $index, $direction, $id, $data) = @_;
 580         my ($reqid, $handle, $offset, $len) = &parse("usUu", $data);
 581         &sftp_logreq($chan, $direction, $reqid, $id, "SSH_FXP_READ");
 582         printf " \"%s\" %d %d", &stringescape($handle), $offset, $len;
 583         print "\n";
 584     },
 585 #define SSH_FXP_WRITE                             6     /* 0x6 */
 586     0x6 => sub {
 587         my ($chan, $index, $direction, $id, $data) = @_;
 588         my ($reqid, $handle, $offset, $wdata) = &parse("usUs", $data);
 589         &sftp_logreq($chan, $direction, $reqid, $id, "SSH_FXP_WRITE");
 590         printf " \"%s\" %d [%d bytes]", &stringescape($handle), $offset, length $wdata;
 591         print "\n";
 592     },
 593 #define SSH_FXP_LSTAT                             7     /* 0x7 */
 594     0x7 => sub {
 595         my ($chan, $index, $direction, $id, $data) = @_;
 596         my ($reqid, $path) = &parse("us", $data);
 597         &sftp_logreq($chan, $direction, $reqid, $id, "SSH_FXP_LSTAT");
 598         printf " \"%s\"", $path;
 599         print "\n";
 600     },
 601 #define SSH_FXP_FSTAT                             8     /* 0x8 */
 602     0x8 => sub {
 603         my ($chan, $index, $direction, $id, $data) = @_;
 604         my ($reqid, $handle) = &parse("us", $data);
 605         &sftp_logreq($chan, $direction, $reqid, $id, "SSH_FXP_FSTAT");
 606         printf " \"%s\"", &stringescape($handle);
 607         print "\n";
 608     },
 609 #define SSH_FXP_SETSTAT                           9     /* 0x9 */
 610     0x9 => sub {
 611         my ($chan, $index, $direction, $id, $data) = @_;
 612         my ($reqid, $path) = &parse("us", $data);
 613         &sftp_logreq($chan, $direction, $reqid, $id, "SSH_FXP_SETSTAT");
 614         my $attrs = &sftp_parse_attrs($data);
 615         printf " \"%s\" %s", $path, $attrs;
 616         print "\n";
 617     },
 618 #define SSH_FXP_FSETSTAT                          10    /* 0xa */
 619     0xa => sub {
 620         my ($chan, $index, $direction, $id, $data) = @_;
 621         my ($reqid, $handle) = &parse("us", $data);
 622         &sftp_logreq($chan, $direction, $reqid, $id, "SSH_FXP_FSETSTAT");
 623         my $attrs = &sftp_parse_attrs($data);
 624         printf " \"%s\" %s", &stringescape($handle), $attrs;
 625         print "\n";
 626     },
 627 #define SSH_FXP_OPENDIR                           11    /* 0xb */
 628     0xb => sub {
 629         my ($chan, $index, $direction, $id, $data) = @_;
 630         my ($reqid, $path) = &parse("us", $data);
 631         &sftp_logreq($chan, $direction, $reqid, $id, "SSH_FXP_OPENDIR");
 632         printf " \"%s\"", $path;
 633         print "\n";
 634     },
 635 #define SSH_FXP_READDIR                           12    /* 0xc */
 636     0xc => sub {
 637         my ($chan, $index, $direction, $id, $data) = @_;
 638         my ($reqid, $handle) = &parse("us", $data);
 639         &sftp_logreq($chan, $direction, $reqid, $id, "SSH_FXP_READDIR");
 640         printf " \"%s\"", &stringescape($handle);
 641         print "\n";
 642     },
 643 #define SSH_FXP_REMOVE                            13    /* 0xd */
 644     0xd => sub {
 645         my ($chan, $index, $direction, $id, $data) = @_;
 646         my ($reqid, $path) = &parse("us", $data);
 647         &sftp_logreq($chan, $direction, $reqid, $id, "SSH_FXP_REMOVE");
 648         printf " \"%s\"", $path;
 649         print "\n";
 650     },
 651 #define SSH_FXP_MKDIR                             14    /* 0xe */
 652     0xe => sub {
 653         my ($chan, $index, $direction, $id, $data) = @_;
 654         my ($reqid, $path) = &parse("us", $data);
 655         &sftp_logreq($chan, $direction, $reqid, $id, "SSH_FXP_MKDIR");
 656         printf " \"%s\"", $path;
 657         print "\n";
 658     },
 659 #define SSH_FXP_RMDIR                             15    /* 0xf */
 660     0xf => sub {
 661         my ($chan, $index, $direction, $id, $data) = @_;
 662         my ($reqid, $path) = &parse("us", $data);
 663         &sftp_logreq($chan, $direction, $reqid, $id, "SSH_FXP_RMDIR");
 664         printf " \"%s\"", $path;
 665         print "\n";
 666     },
 667 #define SSH_FXP_REALPATH                          16    /* 0x10 */
 668     0x10 => sub {
 669         my ($chan, $index, $direction, $id, $data) = @_;
 670         my ($reqid, $path) = &parse("us", $data);
 671         &sftp_logreq($chan, $direction, $reqid, $id, "SSH_FXP_REALPATH");
 672         printf " \"%s\"", $path;
 673         print "\n";
 674     },
 675 #define SSH_FXP_STAT                              17    /* 0x11 */
 676     0x11 => sub {
 677         my ($chan, $index, $direction, $id, $data) = @_;
 678         my ($reqid, $path) = &parse("us", $data);
 679         &sftp_logreq($chan, $direction, $reqid, $id, "SSH_FXP_STAT");
 680         printf " \"%s\"", $path;
 681         print "\n";
 682     },
 683 #define SSH_FXP_RENAME                            18    /* 0x12 */
 684     0x12 => sub {
 685         my ($chan, $index, $direction, $id, $data) = @_;
 686         my ($reqid, $srcpath, $dstpath) = &parse("uss", $data);
 687         &sftp_logreq($chan, $direction, $reqid, $id, "SSH_FXP_RENAME");
 688         printf " \"%s\" \"%s\"", $srcpath, $dstpath;
 689         print "\n";
 690     },
 691 #define SSH_FXP_STATUS                            101   /* 0x65 */
 692     0x65 => sub {
 693         my ($chan, $index, $direction, $id, $data) = @_;
 694         my ($reqid, $status) = &parse("uu", $data);
 695         &sftp_logreply($chan, $direction, $reqid, $id, "SSH_FXP_STATUS");
 696         print " ";
 697         if ($status eq "0") { print "SSH_FX_OK"; }
 698         elsif ($status eq "1") { print "SSH_FX_EOF"; }
 699         elsif ($status eq "2") { print "SSH_FX_NO_SUCH_FILE"; }
 700         elsif ($status eq "3") { print "SSH_FX_PERMISSION_DENIED"; }
 701         elsif ($status eq "4") { print "SSH_FX_FAILURE"; }
 702         elsif ($status eq "5") { print "SSH_FX_BAD_MESSAGE"; }
 703         elsif ($status eq "6") { print "SSH_FX_NO_CONNECTION"; }
 704         elsif ($status eq "7") { print "SSH_FX_CONNECTION_LOST"; }
 705         elsif ($status eq "8") { print "SSH_FX_OP_UNSUPPORTED"; }
 706         else { printf "[unknown status %d]", $status; }
 707         print "\n";
 708     },
 709 #define SSH_FXP_HANDLE                            102   /* 0x66 */
 710     0x66 => sub {
 711         my ($chan, $index, $direction, $id, $data) = @_;
 712         my ($reqid, $handle) = &parse("us", $data);
 713         &sftp_logreply($chan, $direction, $reqid, $id, "SSH_FXP_HANDLE");
 714         printf " \"%s\"", &stringescape($handle);
 715         print "\n";
 716     },
 717 #define SSH_FXP_DATA                              103   /* 0x67 */
 718     0x67 => sub {
 719         my ($chan, $index, $direction, $id, $data) = @_;
 720         my ($reqid, $retdata) = &parse("us", $data);
 721         &sftp_logreply($chan, $direction, $reqid, $id, "SSH_FXP_DATA");
 722         printf " [%d bytes]", length $retdata;
 723         print "\n";
 724     },
 725 #define SSH_FXP_NAME                              104   /* 0x68 */
 726     0x68 => sub {
 727         my ($chan, $index, $direction, $id, $data) = @_;
 728         my ($reqid, $count) = &parse("uu", $data);
 729         &sftp_logreply($chan, $direction, $reqid, $id, "SSH_FXP_NAME");
 730         for my $i (1..$count) {
 731             my ($name, $longname) = &parse("ss", $data);
 732             my $attrs = &sftp_parse_attrs($data);
 733             print " [name=\"$name\", longname=\"$longname\", attrs=$attrs]";
 734         }
 735         print "\n";
 736     },
 737 #define SSH_FXP_ATTRS                             105   /* 0x69 */
 738     0x69 => sub {
 739         my ($chan, $index, $direction, $id, $data) = @_;
 740         my ($reqid) = &parse("u", $data);
 741         &sftp_logreply($chan, $direction, $reqid, $id, "SSH_FXP_ATTRS");
 742         my $attrs = &sftp_parse_attrs($data);
 743         printf " %s", $attrs;
 744         print "\n";
 745     },
 746 #define SSH_FXP_EXTENDED                          200   /* 0xc8 */
 747     0xc8 => sub {
 748         my ($chan, $index, $direction, $id, $data) = @_;
 749         my ($reqid, $type) = &parse("us", $data);
 750         &sftp_logreq($chan, $direction, $reqid, $id, "SSH_FXP_EXTENDED");
 751         printf " \"%s\"", $type;
 752         print "\n";
 753     },
 754 #define SSH_FXP_EXTENDED_REPLY                    201   /* 0xc9 */
 755     0xc9 => sub {
 756         my ($chan, $index, $direction, $id, $data) = @_;
 757         my ($reqid) = &parse("u", $data);
 758         print "\n";
 759         &sftp_logreply($chan, $direction, $reqid,$id,"SSH_FXP_EXTENDED_REPLY");
 760     },
 761 );
 762
 763 my ($direction, $seq, $ourseq, $type, $data, $recording);
 764 my %ourseqs = ('i'=>0, 'o'=>0);
 765
 766 $recording = 0;
 767 while (<>) {
 768     if ($recording) {
 769         if (/^  [0-9a-fA-F]{8}  ((?:[0-9a-fA-F]{2} )*[0-9a-fA-F]{2})/) {
 770             push @$data, map { $_ eq "XX" ? -1 : hex $_ } split / /, $1;
 771         } else {
 772             $recording = 0;
 773             my $fullseq = "$direction$ourseq";
 774             print "$fullseq: $type ";
 775             if (defined $packets{$type}) {
 776                 $packets{$type}->($direction, $fullseq, $data);
 777             } else {
 778                 printf "raw %s\n", join "", map { sprintf "%02x", $_ } @$data;
 779             }
 780         }
 781     }
 782     if (/^(Incoming|Outgoing) packet #0x([0-9a-fA-F]+), type \d+ \/ 0x[0-9a-fA-F]+ \((.*)\)/) {
 783         $direction = ($1 eq "Incoming" ? 'i' : 'o');
 784         # $seq is the sequence number quoted in the log file. $ourseq
 785         # is our own count of the sequence number, which differs in
 786         # that it shouldn't wrap at 2^32, should anyone manage to run
 787         # this script over such a huge log file.
 788         $seq = hex $2;
 789         $ourseq = $ourseqs{$direction}++;
 790         $type = $3;
 791         $data = [];
 792         $recording = 1;
 793     }
 794 }
 795
 796 if ($dumpchannels) {
 797     my %stateorder = ('closed'=>0, 'rejected'=>1,
 798                       'halfclosed'=>2, 'open'=>3, 'halfopen'=>4);
 799     for my $index (0..$#channels) {
 800         my $chan = $channels[$index];
 801         my $so = $stateorder{$chan->{'state'}};
 802         $so = 1000 unless defined $so; # any state I've missed above comes last
 803         $chan->{'index'} = sprintf "ch%d", $index;
 804         $chan->{'order'} = sprintf "%08d %08d", $so, $index;
 805     }
 806     my @sortedchannels = sort { $a->{'order'} cmp $b->{'order'} } @channels;
 807     for my $chan (@sortedchannels) {
 808         printf "%s (%s): %s\n", $chan->{'index'}, $chan->{'id'}, $chan->{'state'};
 809     }
 810 }
 811
 812 sub parseone {
 813     my ($type, $data) = @_;
 814     if ($type eq "u") { # uint32
 815         my @bytes = splice @$data, 0, 4;
 816         return "<missing>" if @bytes < 4 or grep { $_<0 } @bytes;
 817         return unpack "N", pack "C*", @bytes;
 818     } elsif ($type eq "U") { # uint64
 819         my @bytes = splice @$data, 0, 8;
 820         return "<missing>" if @bytes < 8 or grep { $_<0 } @bytes;
 821         my @words = unpack "NN", pack "C*", @bytes;
 822         return ($words[0] << 32) + $words[1];
 823     } elsif ($type eq "b") { # boolean
 824         my $byte = shift @$data;
 825         return "<missing>" if !defined $byte or $byte < 0;
 826         return $byte ? "yes" : "no";
 827     } elsif ($type eq "B") { # byte
 828         my $byte = shift @$data;
 829         return "<missing>" if !defined $byte or $byte < 0;
 830         return $byte;
 831     } elsif ($type eq "s" or $type eq "m") { # string, mpint
 832         my @bytes = splice @$data, 0, 4;
 833         return "<missing>" if @bytes < 4 or grep { $_<0 } @bytes;
 834         my $len = unpack "N", pack "C*", @bytes;
 835         @bytes = splice @$data, 0, $len;
 836         return "<missing>" if @bytes < $len or grep { $_<0 } @bytes;
 837         if ($type eq "mpint") {
 838             my $str = "";
 839             if ($bytes[0] >= 128) {
 840                 # Take two's complement.
 841                 @bytes = map { 0xFF ^ $_ } @bytes;
 842                 for my $i (reverse 0..$#bytes) {
 843                     if ($bytes[$i] < 0xFF) {
 844                         $bytes[$i]++;
 845                         last;
 846                     } else {
 847                         $bytes[$i] = 0;
 848                     }
 849                 }
 850                 $str = "-";
 851             }
 852             $str .= "0x" . join "", map { sprintf "%02x", $_ } @bytes;
 853             return $str;
 854         } else {
 855             return pack "C*", @bytes;
 856         }
 857     }
 858 }
 859
 860 sub parse {
 861     my ($template, $data) = @_;
 862     return map { &parseone($_, $data) } split //, $template;
 863 }
 864
 865 sub str {
 866     # Quote as a string. If I get enthusiastic I might arrange for
 867     # strange characters inside the string to be quoted.
 868     my $str = shift @_;
 869     return "'$str'";
 870 }
 871
 872 sub sftp_setup {
 873     my $index = shift @_;
 874     my $chan = $channels[$index];
 875     $chan->{'obuf'} = $chan->{'ibuf'} = '';
 876     $chan->{'ocnt'} = $chan->{'icnt'} = 0;
 877     $chan->{'odata'} = $chan->{'idata'} = \&sftp_data;
 878     $chan->{'sftpreqs'} = {};
 879 }
 880
 881 sub sftp_data {
 882     my ($chan, $index, $direction, $data) = @_;
 883     my $buf = \$chan->{$direction."buf"};
 884     my $cnt = \$chan->{$direction."cnt"};
 885     $$buf .= $data;
 886     while (length $$buf >= 4) {
 887         my $msglen = unpack "N", $$buf;
 888         last if length $$buf < 4 + $msglen;
 889         my $msg = substr $$buf, 4, $msglen;
 890         $$buf = substr $$buf, 4 + $msglen;
 891         $msg = [unpack "C*", $msg];
 892         my $type = shift @$msg;
 893         my $id = sprintf "ch%d_sftp_%s%d", $index, $direction, ${$cnt}++;
 894         print "$id: ";
 895         if (defined $sftp_packets{$type}) {
 896             $sftp_packets{$type}->($chan, $index, $direction, $id, $msg);
 897         } else {
 898             printf "unknown SFTP packet type %d\n", $type;
 899         }
 900     }
 901 }
 902
 903 sub sftp_logreq {
 904     my ($chan, $direction, $reqid, $id, $name) = @_;
 905     print "$name";
 906     if ($direction eq "o") { # requests coming _in_ are too weird to track
 907         $chan->{'sftpreqs'}->{$reqid} = $id;
 908     }
 909 }
 910
 911 sub sftp_logreply {
 912     my ($chan, $direction, $reqid, $id, $name) = @_;
 913     print "$name";
 914     if ($direction eq "i") { # replies going _out_ are too weird to track
 915         if (defined $chan->{'sftpreqs'}->{$reqid}) {
 916             print " to ", $chan->{'sftpreqs'}->{$reqid};
 917             $chan->{'sftpreqs'}->{$reqid} = undef;
 918         }
 919     }
 920 }
 921
 922 sub sftp_parse_attrs {
 923     my ($data) = @_;
 924     my ($flags) = &parse("u", $data);
 925     return $flags if $flags eq "<missing>";
 926     my $out = "{";
 927     my $sep = "";
 928     if ($flags & 0x00000001) { # SSH_FILEXFER_ATTR_SIZE
 929         $out .= $sep . sprintf "size=%d", &parse("U", $data);
 930         $sep = ", ";
 931     }
 932     if ($flags & 0x00000002) { # SSH_FILEXFER_ATTR_UIDGID
 933         $out .= $sep . sprintf "uid=%d", &parse("u", $data);
 934         $out .= $sep . sprintf "gid=%d", &parse("u", $data);
 935         $sep = ", ";
 936     }
 937     if ($flags & 0x00000004) { # SSH_FILEXFER_ATTR_PERMISSIONS
 938         $out .= $sep . sprintf "perms=%#o", &parse("u", $data);
 939         $sep = ", ";
 940     }
 941     if ($flags & 0x00000008) { # SSH_FILEXFER_ATTR_ACMODTIME
 942         $out .= $sep . sprintf "atime=%d", &parse("u", $data);
 943         $out .= $sep . sprintf "mtime=%d", &parse("u", $data);
 944         $sep = ", ";
 945     }
 946     if ($flags & 0x80000000) { # SSH_FILEXFER_ATTR_EXTENDED
 947         my $extcount = &parse("u", $data);
 948         while ($extcount-- > 0) {
 949             $out .= $sep . sprintf "\"%s\"=\"%s\"", &parse("ss", $data);
 950             $sep = ", ";
 951         }
 952     }
 953     $out .= "}";
 954     return $out;
 955 }
 956
 957 sub stringescape {
 958     my ($str) = @_;
 959     $str =~ s!\\!\\\\!g;
 960     $str =~ s![^ -~]!sprintf "\\x%02X", ord $&!eg;
 961     return $str;
 962 }