From af9340f908dcca0852d2c3f05809f6f2d44a9ffd Mon Sep 17 00:00:00 2001 From: Yorhel Date: Wed, 30 Apr 2025 15:00:21 +0200 Subject: [PATCH] DebugInfo: Styling + add request/response body and fu obj contents Formatting is still shit. --- FU.pm | 14 +++-- FU/DebugImpl.pm | 139 ++++++++++++++++++++++++++++++++++-------------- 2 files changed, 110 insertions(+), 43 deletions(-) diff --git a/FU.pm b/FU.pm index 11c58ff..316f273 100644 --- a/FU.pm +++ b/FU.pm @@ -3,7 +3,7 @@ use v5.36; use Carp 'confess', 'croak'; use IO::Socket; use POSIX (); -use Time::HiRes 'clock_gettime', 'CLOCK_MONOTONIC'; +use Time::HiRes 'time', 'clock_gettime', 'CLOCK_MONOTONIC'; use FU::Log 'log_write'; use FU::Util; use FU::Validate; @@ -318,7 +318,11 @@ sub _log_err($e) { } sub _do_req($c) { - local $REQ = { hdr => {}, trace_start => clock_gettime(CLOCK_MONOTONIC), trace_id => sprintf('%010x%08x%04x', int time, $$, int rand 1<<16) }; + local $REQ = { + hdr => {}, + trace_start => clock_gettime(CLOCK_MONOTONIC), + trace_id => sprintf('%012x%06x%04x', int(time*10000) % (1<<(12*4)), $$ % (1<<(6*4)), int rand 1<<16) + }; local $fu = bless {}, 'FU::obj'; $REQ->{ip} = $c->{client_sock} isa 'IO::Socket::INET' ? $c->{client_sock}->peerhost : '127.0.0.1'; @@ -648,8 +652,8 @@ sub log_verbose($,$msg) { length $r->{body} ? do { my $b = substr $r->{body}, 0, 4096; my $trunc = length $r->{body} > 4096 ? ', truncated' : ''; - utf8::decode($b) ? ("Body (utf8$trunc)", _fmt_section($b =~ s/\r//rg =~ s/\n{4,}/\n[..]\n/rg)) - : ("Body (hex$trunc)", _fmt_section(unpack('H*', $b) =~ s/(.{128})/$1\n/rg)) + utf8::decode($b) ? ("Body (utf8$trunc):", _fmt_section($b =~ s/\r//rg =~ s/\n{4,}/\n[..]\n/rg)) + : ("Body (hex$trunc):", _fmt_section(unpack('H*', $b) =~ s/(.{128})/$1\n/rg)) } : (), 'Message:', _fmt_section $msg ); @@ -898,10 +902,12 @@ sub _finalize { ) { push @vary, 'accept-encoding'; if ($hasbrotli && ($r->{hdr}{'accept-encoding'}||'') =~ /\bbr\b/) { + $r->{resbody_orig} = $r->{resbody}; $r->{resbody} = FU::Util::brotli_compress(6, $r->{resbody}); $r->{reshdr}{'content-encoding'} = 'br'; } elsif ($hasgzip && ($r->{hdr}{'accept-encoding'}||'') =~ /\bgzip\b/) { + $r->{resbody_orig} = $r->{resbody}; $r->{resbody} = FU::Util::gzip_compress(6, $r->{resbody}); $r->{reshdr}{'content-encoding'} = 'gzip'; } diff --git a/FU/DebugImpl.pm b/FU/DebugImpl.pm index a0de7ea..f02ceed 100644 --- a/FU/DebugImpl.pm +++ b/FU/DebugImpl.pm @@ -16,27 +16,32 @@ sub loc_($loc) { my $l = $loc->[$_]; my $f = $_ == $#$loc ? '(main)' : $loc->[$_+1][3]; $f = "$l->[0]::$f" if $f !~ /^\Q$l->[0]/; - txt_ "$f @ $l->[1]:$l->[2]"; + txt_ $f; + small_ " @ $l->[1]:$l->[2]"; } } -sub fmtpre_($code) { - lit_ xml_escape($code) =~ s/^\s+//r =~ s/\s+$//r =~ s/\n/
/rg; -} - sub clean_re($str) { # Regex formatting isn't stable, but this cleans up the crap I'm seeing a little bit. "$str" =~ s/^\(\?\^u:\^\(\?\^u://r =~ s/\)\$\)$//r; } -my @tabs = ( +sub raw_data($str) { + my $d = substr $str, 0, 32*1024; + my $trunc = length $str > 32*1024 ? ', truncated' : ''; + return utf8::decode($d) ? ("utf8$trunc", $d) + : ("hex$trunc", unpack('H*', $d) =~ s/(.{128})/$1\n/rg =~ s/(.{16})/$1 /rg); +} + +my @sections = ( req => sub { + my $r = $FU::REQ; table_ sub { tr_ sub { td_ 'Method'; td_ fu->method }; tr_ sub { td_ 'Path'; td_ fu->path }; tr_ sub { td_ 'Query'; td_ fu->query }; tr_ sub { td_ 'Client IP'; td_ fu->ip }; - tr_ sub { td_ 'Received'; td_ fmtts(time - (($FU::REQ->{trace_end}||clock_gettime(CLOCK_MONOTONIC)) - $FU::REQ->{trace_start})) }; + tr_ sub { td_ 'Received'; td_ fmtts(time - (($r->{trace_end}||clock_gettime(CLOCK_MONOTONIC)) - $r->{trace_start})) }; }; h2_ 'Headers'; table_ sub { @@ -45,7 +50,38 @@ my @tabs = ( td_ fu->headers->{$_}; } for sort keys fu->headers->%*; }; - # TODO: Body? Certainly useful for JSON + if ((fu->header('content-length')||0) > 0) { + h2_ 'Body'; + section_ class => 'tabs', sub { + my $json = eval { fu->json({type=>'any'}) }; + details_ name => 'reqbody', open => !0, sub { + summary_ 'JSON'; + pre_ FU::Util::json_format($json, pretty => 1, canonical => 1); + } if $json; + my $formdata = eval { fu->formdata({type=>'hash'}) }; + details_ name => 'reqbody', open => !0, sub { + summary_ 'Form data'; + table_ sub { + for my $k (sort keys %$formdata) { + tr_ sub { + td_ $k; + td_ $_; + } for ref $formdata->{$k} ? $formdata->{$k}->@* : ($formdata->{$k}); + } + }; + } if $formdata; + my $multipart = eval { fu->multipart }; + details_ name => 'reqbody', open => !0, sub { + summary_ 'Multipart'; + pre_ join "\n", map $_->describe, @$multipart; + } if $multipart; + details_ name => 'reqbody', open => !0,sub { + my($lbl, $data) = raw_data $r->{body}; + summary_ "Raw ($lbl)"; + pre_ $data; + }; + } + } ('Request') }, @@ -84,11 +120,28 @@ my @tabs = ( } for !defined $v ? () : ref $v ? @$v : ($v); } }; + my $body = $r->{resbody_orig} // $r->{resbody}; + if (length $body) { + h2_ 'Body'; + section_ class => 'tabs', sub { + my $json = ($r->{reshdr}{'content-type'}||'') =~ /^application\/json/ && eval { FU::Util::json_parse($body, utf8 => 1) }; + details_ name => 'resbody', open => !0, sub { + summary_ 'JSON'; + pre_ FU::Util::json_format($json, pretty => 1, canonical => 1); + } if $json; + details_ name => 'resbody', open => !0,sub { + my($lbl, $data) = raw_data $body; + summary_ "Raw ($lbl)"; + pre_ $data; + }; + } + } ('Response') }, sql => sub { return () if !$FU::REQ->{trace_sql}; + # TODO: Summarize main table, expand to display full query, params table, interpolated query table_ sub { thead_ sub { tr_ sub { td_ class => 'num', 'Exec'; @@ -100,8 +153,7 @@ my @tabs = ( td_ class => 'num', sprintf '%.1f ms', $_->{exec_time}*1000; td_ class => 'num', !defined $_->{prepare_time} ? '-' : $_->{prepare_time} ? sprintf '%.1f ms', $_->{prepare_time}*1000 : 'cache'; td_ class => 'num', $_->{nrows}; - td_ class => 'code', sub { fmtpre_ $_->{query} }; - # TODO: Params, both separate and interpolated + td_ class => 'code', $_->{query}; } for $FU::REQ->{trace_sql}->@*; }; ('Queries', scalar $FU::REQ->{trace_sql}->@*) @@ -109,7 +161,11 @@ my @tabs = ( fu => sub { return () if !keys fu->%*; - # TODO: Contents of the 'fu' object + # TODO: This is kinda lazy, an expandable table might be nicer. + require Data::Dumper; + pre_ sub { + lit_ Data::Dumper->new([fu])->Sortkeys(1)->Terse(1)->Dump; + }; ('fu obj') }, @@ -186,7 +242,7 @@ my @tabs = ( } }; tr_ sub { td_ $_->[0]; - td_ class => 'code', sub { fmtpre_ $_->[1] }; + td_ class => 'code', $_->[1]; } for @$lst; }; ('Prepared statements', scalar @$lst) @@ -196,9 +252,10 @@ my @tabs = ( sub collect { my @t; - for my ($id, $sub) (@tabs) { + for my ($id, $sub) (@sections) { my($title, $num); my $html = fragment { ($title, $num) = $sub->() }; + utf8::decode($html); push @t, { id => $id, title => $title, num => $num, html => $html } if $title; } \@t @@ -215,42 +272,47 @@ sub framework_($data) { *, *:before, *:after { box-sizing: inherit } * { margin: 0; padding: 0; font: inherit; color: inherit } - body { display: grid; grid: 45px 400px / 220px auto; } - header { grid-column: 1 / 3; grid-row: 1 / 2 } - nav { grid-column: 1 / 2; grid-row: 2 / 3 } - main { grid-column: 2 / 3; grid-row: 2 / 3 } + /* Ugh, fixed positioning */ + header { position: fixed; top: 0; left: 0; width: 100%; height: 40px; z-index: 2 } + nav { position: fixed; top: 38px; left: 0; width: 200px; z-index: 2 } + main { margin: 0 0 0 200px } header, nav { background: #eee } - main { border-top: 2px solid #009; border-left: 2px solid #009 } - nav { border-bottom: 2px solid #009 } + header { border-bottom: 2px solid #009 } + nav { border-bottom: 2px solid #009; border-right: 2px solid #009 } - header { display: flex; justify-content: space-between; padding: 10px } - header h1 { font-size: 20px; font-weight: bold } + header { display: flex; justify-content: space-between; align-items: baseline; padding: 5px 10px } + header h1 { font-size: 120%; font-weight: bold } header menu { list-style-type: none; display: flex; gap: 15px } body > input { display: none } nav { padding-top: 20px } nav menu { list-style-type: none } - nav label { display: block; width: 100%; padding: 2px 10px; cursor: pointer; white-space: nowrap } - nav label:hover { background-color: #fff } - nav label span { float: right; font-size: 80% } + nav a { display: block; width: 100%; text-decoration: none; padding: 2px 10px; cursor: pointer; white-space: nowrap } + nav a:hover { background-color: #fff } + nav a span { float: right; font-size: 80% } - main { padding: 10px 20px } - main h2 { margin: 30px 0 5px -10px; font-size: 20px; font-weight: bold } - main h2:first-child { margin-top: 0 } + main { padding: 0 10px 30px 10px } + main h1 { background: #eee; padding: 5px 10px 5px 205px; margin: 40px -10px 10px -210px; scroll-margin-top: 40px; font-size: 130%; font-weight: bold } + main h2 { margin: 20px 0 5px 0; font-size: 120%; font-weight: bold } - p, pre, table { margin: 5px 0 } - pre, .code { font-family: monospace; white-space: pre } + p, table, pre { margin: 5px 0 } + pre { font-family: monospace; white-space: pre; overflow-x: auto; padding-bottom: 15px; /* for the scrollbar, kinda browser-specific */ } table { border-collapse: collapse } td { padding: 1px 10px 1px 0; font-size: 12px; vertical-align: top } + td.code { font-family: monospace } tr:hover { background-color: #eee } thead { font-weight: bold } .num { text-align: right; white-space: nowrap } + + section.tabs { position: relative; display: flex; flex-wrap: wrap; z-index: 1; } + section.tabs summary { cursor: pointer; order: 0; display: block; padding: 3px 5px; margin-right: 10px; background: #ddd } + section.tabs summary:hover, section.tabs details[open] summary { background: #eee } + section.tabs details { display: contents } + section.tabs details *:nth-child(2) { order: 1; width: 100% } + + small { color: #555; font-size: 90% } _ - style_ type => 'text/css', join "\n", map +( - "#tab_$_:checked ~ nav menu li label[for=tab_$_] { background-color: #fff }", - "#tab_$_:not(:checked) ~ main #tabc_$_ { display: none }", - ), map $_->{id}, @$data; }; body_ sub { header_ sub { @@ -261,22 +323,21 @@ sub framework_($data) { li_ sub { a_ href => '?', 'Listing' }; }; }; - input_ type => 'radio', name => 'tab', id => "tab_$_->{id}", checked => $_ eq $data->[0] ? 'checked' : undef for @$data; nav_ sub { menu_ sub { li_ sub { - label_ for => "tab_$_->{id}", sub { + a_ href => "#$_->{id}", sub { txt_ $_->{title}; span_ $_->{num} if defined $_->{num}; - } + }; } for @$data; }; } if @$data; main_ sub { - div_ id => "tabc_$_->{id}", sub { - h2_ $_->{title}; + for (@$data) { + h1_ id => $_->{id}, $_->{title}; lit_ $_->{html}; - } for @$data; + } }; }; };