mdw@git.distorted.org.uk Git - sgt/putty/blob - 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;
 176         if ($type eq "tcpip-forward" or $type eq "cancel-tcpip-forward") {
 177             my ($addr, $port) = &parse("su", $data);
 178             printf " %s:%s", $addr, $port;
 179             push @$request, $port;
 180         }
 181         print "\n";
 182     },
 183 #define SSH2_MSG_REQUEST_SUCCESS                  81    /* 0x51 */
 184     'SSH2_MSG_REQUEST_SUCCESS' => sub {
 185         my ($direction, $seq, $data) = @_;
 186         my $otherdir = ($direction eq "i" ? "o" : "i");
 187         my $request = shift @{$globalreq{$otherdir}};
 188         if (defined $request) {
 189             printf "to %s", $request->[0];
 190             if ($request->[1] eq "tcpip-forward" and $request->[2] == 0) {
 191                 my ($port) = &parse("u", $data);
 192                 printf " port=%s", $port;
 193             }
 194         } else {
 195             print "(spurious?)";
 196         }
 197         print "\n";
 198     },
 199 #define SSH2_MSG_REQUEST_FAILURE                  82    /* 0x52 */
 200     'SSH2_MSG_REQUEST_FAILURE' => sub {
 201         my ($direction, $seq, $data) = @_;
 202         my $otherdir = ($direction eq "i" ? "o" : "i");
 203         my $request = shift @{$globalreq{$otherdir}};
 204         if (defined $request) {
 205             printf "to %s", $request->[0];
 206         } else {
 207             print "(spurious?)";
 208         }
 209         print "\n";
 210     },
 211 #define SSH2_MSG_CHANNEL_OPEN                     90    /* 0x5a */
 212     'SSH2_MSG_CHANNEL_OPEN' => sub {
 213         my ($direction, $seq, $data) = @_;
 214         my ($type, $sid, $winsize, $packet) = &parse("suuu", $data);
 215         # CHANNEL_OPEN tells the other side the _sender's_ id for the
 216         # channel, so this choice between "s" and "c" prefixes is
 217         # opposite to every other message in the protocol, which all
 218         # quote the _recipient's_ id of the channel.
 219         $sid = ($direction eq "i" ? "s" : "c") . $sid;
 220         my $chan = {'id'=>$sid, 'state'=>'halfopen'};
 221         push @channels, $chan;
 222         my $index = $#channels;
 223         $chan_by_id{$sid} = $index;
 224         printf "ch%d (%s) %s", $index, $chan->{'id'}, $type;
 225         if ($type eq "x11") {
 226             my ($addr, $port) = &parse("su", $data);
 227             printf " from %s:%s", $addr, $port;
 228         } elsif ($type eq "forwarded-tcpip") {
 229             my ($saddr, $sport, $paddr, $pport) = &parse("susu", $data);
 230             printf " to %s:%s from %s:%s", $saddr, $sport, $paddr, $pport;
 231         } elsif ($type eq "direct-tcpip") {
 232             my ($daddr, $dport, $saddr, $sport) = &parse("susu", $data);
 233             printf " to %s:%s from %s:%s", $daddr, $dport, $saddr, $sport;
 234         }
 235         print "\n";
 236     },
 237 #define SSH2_MSG_CHANNEL_OPEN_CONFIRMATION        91    /* 0x5b */
 238     'SSH2_MSG_CHANNEL_OPEN_CONFIRMATION' => sub {
 239         my ($direction, $seq, $data) = @_;
 240         my ($rid, $sid, $winsize, $packet) = &parse("uuuu", $data);
 241         $rid = ($direction eq "i" ? "c" : "s") . $rid;
 242         my $index = $chan_by_id{$rid};
 243         $sid = ($direction eq "i" ? "s" : "c") . $sid;
 244         $chan_by_id{$sid} = $index;
 245         my $chan = $channels[$index];
 246         $chan->{'id'} = ($direction eq "i" ? "$rid/$sid" : "$sid/$rid");
 247         $chan->{'state'} = 'open';
 248         printf "ch%d (%s)\n", $index, $chan->{'id'};
 249     },
 250 #define SSH2_MSG_CHANNEL_OPEN_FAILURE             92    /* 0x5c */
 251     'SSH2_MSG_CHANNEL_OPEN_FAILURE' => sub {
 252         my ($direction, $seq, $data) = @_;
 253         my ($rid, $reason, $desc, $lang) = &parse("uuss", $data);
 254         $rid = ($direction eq "i" ? "c" : "s") . $rid;
 255         my $index = $chan_by_id{$rid};
 256         my $chan = $channels[$index];
 257         $chan->{'state'} = 'rejected';
 258         printf "ch%d (%s) %s\n", $index, $chan->{'id'}, &str($reason);
 259     },
 260 #define SSH2_MSG_CHANNEL_WINDOW_ADJUST            93    /* 0x5d */
 261     'SSH2_MSG_CHANNEL_WINDOW_ADJUST' => sub {
 262         my ($direction, $seq, $data) = @_;
 263         my ($rid, $bytes) = &parse("uu", $data);
 264         $rid = ($direction eq "i" ? "c" : "s") . $rid;
 265         my $index = $chan_by_id{$rid};
 266         my $chan = $channels[$index];
 267         printf "ch%d (%s) +%s\n", $index, $chan->{'id'}, $bytes;
 268     },
 269 #define SSH2_MSG_CHANNEL_DATA                     94    /* 0x5e */
 270     'SSH2_MSG_CHANNEL_DATA' => sub {
 271         my ($direction, $seq, $data) = @_;
 272         my ($rid, $bytes) = &parse("uu", $data);
 273         $rid = ($direction eq "i" ? "c" : "s") . $rid;
 274         my $index = $chan_by_id{$rid};
 275         my $chan = $channels[$index];
 276         printf "ch%d (%s), %s bytes\n", $index, $chan->{'id'}, $bytes;
 277         if ($dumpdata) {
 278             my $filekey = $direction . "file";
 279             if (!defined $chan->{$filekey}) {
 280                 my $filename = sprintf "ch%d.%s", $index, $direction;
 281                 $chan->{$filekey} = FileHandle->new(">$filename");
 282                 if (!defined $chan->{$filekey}) {
 283                     die "$filename: $!\n";
 284                 }
 285             }
 286             my @realdata = splice @$data, 0, $bytes;
 287             die "channel data not present in $seq\n" if @realdata < $bytes;
 288             my $rawdata = pack "C*", @realdata;
 289             my $fh = $chan->{$filekey};
 290             print $fh $rawdata;
 291         }
 292     },
 293 #define SSH2_MSG_CHANNEL_EXTENDED_DATA            95    /* 0x5f */
 294     'SSH2_MSG_CHANNEL_EXTENDED_DATA' => sub {
 295         my ($direction, $seq, $data) = @_;
 296         my ($rid, $bytes) = &parse("uu", $data);
 297         $rid = ($direction eq "i" ? "c" : "s") . $rid;
 298         my $index = $chan_by_id{$rid};
 299         my $chan = $channels[$index];
 300         printf "ch%d (%s), %s bytes\n", $index, $chan->{'id'}, $bytes;
 301         if ($dumpdata) {
 302             # We treat EXTENDED_DATA as equivalent to DATA, for the
 303             # moment. It's not clear what else would be a better thing
 304             # to do with it, and this at least is the Right Answer if
 305             # the data is going to a terminal and the aim is to debug
 306             # the terminal emulator.
 307             my $filekey = $direction . "file";
 308             if (!defined $chan->{$filekey}) {
 309                 my $filename = sprintf "ch%d.%s", $index, $direction;
 310                 $chan->{$filekey} = FileHandle->new;
 311                 if (!$chan->{$filekey}->open(">", $filename)) {
 312                     die "$filename: $!\n";
 313                 }
 314             }
 315             my @realdata = splice @$data, 0, $bytes;
 316             die "channel data not present in $seq\n" if @realdata < $bytes;
 317             my $rawdata = pack "C*", @realdata;
 318             my $fh = $chan->{$filekey};
 319             print $fh $rawdata;
 320         }
 321     },
 322 #define SSH2_MSG_CHANNEL_EOF                      96    /* 0x60 */
 323     'SSH2_MSG_CHANNEL_EOF' => sub {
 324         my ($direction, $seq, $data) = @_;
 325         my ($rid) = &parse("uu", $data);
 326         $rid = ($direction eq "i" ? "c" : "s") . $rid;
 327         my $index = $chan_by_id{$rid};
 328         my $chan = $channels[$index];
 329         printf "ch%d (%s)\n", $index, $chan->{'id'};
 330     },
 331 #define SSH2_MSG_CHANNEL_CLOSE                    97    /* 0x61 */
 332     'SSH2_MSG_CHANNEL_CLOSE' => sub {
 333         my ($direction, $seq, $data) = @_;
 334         my ($rid) = &parse("uu", $data);
 335         $rid = ($direction eq "i" ? "c" : "s") . $rid;
 336         my $index = $chan_by_id{$rid};
 337         my $chan = $channels[$index];
 338         $chan->{'state'} = ($chan->{'state'} eq "open" ? "halfclosed" :
 339                             $chan->{'state'} eq "halfclosed" ? "closed" :
 340                             "confused");
 341         if ($chan->{'state'} eq "closed") {
 342             $chan->{'ifile'}->close if defined $chan->{'ifile'};
 343             $chan->{'ofile'}->close if defined $chan->{'ofile'};
 344         }
 345         printf "ch%d (%s)\n", $index, $chan->{'id'};
 346     },
 347 #define SSH2_MSG_CHANNEL_REQUEST                  98    /* 0x62 */
 348     'SSH2_MSG_CHANNEL_REQUEST' => sub {
 349         my ($direction, $seq, $data) = @_;
 350         my ($rid, $type, $wantreply) = &parse("usb", $data);
 351         $rid = ($direction eq "i" ? "c" : "s") . $rid;
 352         my $index = $chan_by_id{$rid};
 353         my $chan = $channels[$index];
 354         printf "ch%d (%s) %s (%s)",
 355             $index, $chan->{'id'}, $type, $wantreply eq "yes" ? "reply" : "noreply";
 356         push @{$chan->{'requests_'.$direction}}, [$seq, $type] if $wantreply;
 357         if ($type eq "pty-req") {
 358             my ($term, $w, $h, $pw, $ph, $modes) = &parse("suuuus", $data);
 359             printf " %s %sx%s", &str($term), $w, $h;
 360         } elsif ($type eq "x11-req") {
 361             my ($single, $xprot, $xcookie, $xscreen) = &parse("bssu", $data);
 362             print " one-off" if $single eq "yes";
 363             printf " %s :%s", $xprot, $xscreen;
 364         } elsif ($type eq "exec") {
 365             my ($command) = &parse("s", $data);
 366             printf " %s", &str($command);
 367         } elsif ($type eq "subsystem") {
 368             my ($subsys) = &parse("s", $data);
 369             printf " %s", &str($subsys);
 370         } elsif ($type eq "window-change") {
 371             my ($w, $h, $pw, $ph) = &parse("uuuu", $data);
 372             printf " %sx%s", $w, $h;
 373         } elsif ($type eq "xon-xoff") {
 374             my ($can) = &parse("b", $data);
 375             printf " %s", $can;
 376         } elsif ($type eq "signal") {
 377             my ($sig) = &parse("s", $data);
 378             printf " %s", &str($sig);
 379         } elsif ($type eq "exit-status") {
 380             my ($status) = &parse("u", $data);
 381             printf " %s", $status;
 382         } elsif ($type eq "exit-signal") {
 383             my ($sig, $core, $error, $lang) = &parse("sbss", $data);
 384             printf " %s", &str($sig);
 385             print " (core dumped)" if $core eq "yes";
 386         }
 387         print "\n";
 388     },
 389 #define SSH2_MSG_CHANNEL_SUCCESS                  99    /* 0x63 */
 390     'SSH2_MSG_CHANNEL_SUCCESS' => sub {
 391         my ($direction, $seq, $data) = @_;
 392         my ($rid) = &parse("uu", $data);
 393         $rid = ($direction eq "i" ? "c" : "s") . $rid;
 394         my $index = $chan_by_id{$rid};
 395         my $chan = $channels[$index];
 396         printf "ch%d (%s)", $index, $chan->{'id'};
 397         my $otherdir = ($direction eq "i" ? "o" : "i");
 398         my $request = shift @{$chan->{'requests_' . $otherdir}};
 399         if (defined $request) {
 400             printf " to %s", $request->[0];
 401         } else {
 402             print " (spurious?)";
 403         }
 404         print "\n";
 405     },
 406 #define SSH2_MSG_CHANNEL_FAILURE                  100   /* 0x64 */
 407     'SSH2_MSG_CHANNEL_FAILURE' => sub {
 408         my ($direction, $seq, $data) = @_;
 409         my ($rid) = &parse("uu", $data);
 410         $rid = ($direction eq "i" ? "c" : "s") . $rid;
 411         my $index = $chan_by_id{$rid};
 412         my $chan = $channels[$index];
 413         printf "ch%d (%s)", $index, $chan->{'id'};
 414         my $otherdir = ($direction eq "i" ? "o" : "i");
 415         my $request = shift @{$chan->{'requests_' . $otherdir}};
 416         if (defined $request) {
 417             printf " to %s", $request->[0];
 418         } else {
 419             print " (spurious?)";
 420         }
 421         print "\n";
 422     },
 423 #define SSH2_MSG_USERAUTH_GSSAPI_RESPONSE               60
 424     'SSH2_MSG_USERAUTH_GSSAPI_RESPONSE' => sub {
 425         my ($direction, $seq, $data) = @_;
 426         print "\n";
 427     },
 428 #define SSH2_MSG_USERAUTH_GSSAPI_TOKEN                  61
 429     'SSH2_MSG_USERAUTH_GSSAPI_TOKEN' => sub {
 430         my ($direction, $seq, $data) = @_;
 431         print "\n";
 432     },
 433 #define SSH2_MSG_USERAUTH_GSSAPI_EXCHANGE_COMPLETE      63
 434     'SSH2_MSG_USERAUTH_GSSAPI_EXCHANGE_COMPLETE' => sub {
 435         my ($direction, $seq, $data) = @_;
 436         print "\n";
 437     },
 438 #define SSH2_MSG_USERAUTH_GSSAPI_ERROR                  64
 439     'SSH2_MSG_USERAUTH_GSSAPI_ERROR' => sub {
 440         my ($direction, $seq, $data) = @_;
 441         print "\n";
 442     },
 443 #define SSH2_MSG_USERAUTH_GSSAPI_ERRTOK                 65
 444     'SSH2_MSG_USERAUTH_GSSAPI_ERRTOK' => sub {
 445         my ($direction, $seq, $data) = @_;
 446         print "\n";
 447     },
 448 #define SSH2_MSG_USERAUTH_GSSAPI_MIC                    66
 449     'SSH2_MSG_USERAUTH_GSSAPI_MIC' => sub {
 450         my ($direction, $seq, $data) = @_;
 451         print "\n";
 452     },
 453 );
 454
 455 my ($direction, $seq, $ourseq, $type, $data, $recording);
 456 my %ourseqs = ('i'=>0, 'o'=>0);
 457
 458 $recording = 0;
 459 while (<>) {
 460     if ($recording) {
 461         if (/^  [0-9a-fA-F]{8}  ((?:[0-9a-fA-F]{2} )*[0-9a-fA-F]{2})/) {
 462             push @$data, map { $_ eq "XX" ? -1 : hex $_ } split / /, $1;
 463         } else {
 464             $recording = 0;
 465             my $fullseq = "$direction$ourseq";
 466             print "$fullseq: $type ";
 467             if (defined $packets{$type}) {
 468                 $packets{$type}->($direction, $fullseq, $data);
 469             } else {
 470                 printf "raw %s\n", join "", map { sprintf "%02x", $_ } @$data;
 471             }
 472         }
 473     }
 474     if (/^(Incoming|Outgoing) packet #0x([0-9a-fA-F]+), type \d+ \/ 0x[0-9a-fA-F]+ \((.*)\)/) {
 475         $direction = ($1 eq "Incoming" ? 'i' : 'o');
 476         # $seq is the sequence number quoted in the log file. $ourseq
 477         # is our own count of the sequence number, which differs in
 478         # that it shouldn't wrap at 2^32, should anyone manage to run
 479         # this script over such a huge log file.
 480         $seq = hex $2;
 481         $ourseq = $ourseqs{$direction}++;
 482         $type = $3;
 483         $data = [];
 484         $recording = 1;
 485     }
 486 }
 487
 488 if ($dumpchannels) {
 489     my %stateorder = ('closed'=>0, 'rejected'=>1,
 490                       'halfclosed'=>2, 'open'=>3, 'halfopen'=>4);
 491     for my $index (0..$#channels) {
 492         my $chan = $channels[$index];
 493         my $so = $stateorder{$chan->{'state'}};
 494         $so = 1000 unless defined $so; # any state I've missed above comes last
 495         $chan->{'index'} = sprintf "ch%d", $index;
 496         $chan->{'order'} = sprintf "%08d %08d", $so, $index;
 497     }
 498     my @sortedchannels = sort { $a->{'order'} cmp $b->{'order'} } @channels;
 499     for my $chan (@sortedchannels) {
 500         printf "%s (%s): %s\n", $chan->{'index'}, $chan->{'id'}, $chan->{'state'};
 501     }
 502 }
 503
 504 sub parseone {
 505     my ($type, $data) = @_;
 506     if ($type eq "u") { # uint32
 507         my @bytes = splice @$data, 0, 4;
 508         return "<missing>" if @bytes < 4 or grep { $_<0 } @bytes;
 509         return unpack "N", pack "C*", @bytes;
 510     } elsif ($type eq "U") { # uint64
 511         my @bytes = splice @$data, 0, 4;
 512         return "<missing>" if @bytes < 8 or grep { $_<0 } @bytes;
 513         my @words = unpack "NN", pack "C*", @bytes;
 514         return ($words[0] << 32) + $words[1];
 515     } elsif ($type eq "b") { # boolean
 516         my $byte = shift @$data;
 517         return "<missing>" if !defined $byte or $byte < 0;
 518         return $byte ? "yes" : "no";
 519     } elsif ($type eq "B") { # byte
 520         my $byte = shift @$data;
 521         return "<missing>" if !defined $byte or $byte < 0;
 522         return $byte;
 523     } elsif ($type eq "s" or $type eq "m") { # string, mpint
 524         my @bytes = splice @$data, 0, 4;
 525         return "<missing>" if @bytes < 4 or grep { $_<0 } @bytes;
 526         my $len = unpack "N", pack "C*", @bytes;
 527         @bytes = splice @$data, 0, $len;
 528         return "<missing>" if @bytes < $len or grep { $_<0 } @bytes;
 529         if ($type eq "mpint") {
 530             my $str = "";
 531             if ($bytes[0] >= 128) {
 532                 # Take two's complement.
 533                 @bytes = map { 0xFF ^ $_ } @bytes;
 534                 for my $i (reverse 0..$#bytes) {
 535                     if ($bytes[$i] < 0xFF) {
 536                         $bytes[$i]++;
 537                         last;
 538                     } else {
 539                         $bytes[$i] = 0;
 540                     }
 541                 }
 542                 $str = "-";
 543             }
 544             $str .= "0x" . join "", map { sprintf "%02x", $_ } @bytes;
 545             return $str;
 546         } else {
 547             return pack "C*", @bytes;
 548         }
 549     }
 550 }
 551
 552 sub parse {
 553     my ($template, $data) = @_;
 554     return map { &parseone($_, $data) } split //, $template;
 555 }
 556
 557 sub str {
 558     # Quote as a string. If I get enthusiastic I might arrange for
 559     # strange characters inside the string to be quoted.
 560     my $str = shift @_;
 561     return "'$str'";
 562 }