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