Add sampling-based trace logging

This is intended to get some stats about resource usage (which
pages/modules are requested often, how much time do they take, etc) to
reduce server load and find pages to optimize, and to track usage of Elm
modules in order to see how many pageviews actually need them so that I
can (hopefully) create smaller JS bundles for most pages.

The logging *should* not include any personally identifiable
information, but paths and query strings could still reveal more
information than necessary. Trace logging is intended to only be enabled
for short periods of time or with low sample rates in order to avoid
slowing down the server with too much logging. I also don't intend to
keep the data around for longer than necessary.

I'm not providing SQL migration scripts for these, this feature is going
to require custom querying anyway.

5 files changed, 66 insertions, 11 deletions

diff --git a/lib/VNDB/Config.pm b/lib/VNDB/Config.pm
index 1a426030..b187251a 100644
--- a/lib/VNDB/Config.pm
+++ b/lib/VNDB/Config.pm
@@ -27,6 +27,7 @@ my $config = {
     board_edit_time   => 7*24*3600, # Time after which posts become immutable
     poll_options      => 20, # max number of options in discussion board polls
     graphviz_path     => '/usr/bin/dot',
+    trace_log         => 0,
 
     dlsite_url   => 'https://www.dlsite.com/%s/work/=/product_id/%%s.html',
     denpa_url    => 'https://denpasoft.com/products/%s',
diff --git a/lib/VNWeb/HTML.pm b/lib/VNWeb/HTML.pm
index 09e598ad..4231b3c1 100644
--- a/lib/VNWeb/HTML.pm
+++ b/lib/VNWeb/HTML.pm
@@ -35,10 +35,6 @@ our @EXPORT = qw/
 /;
 
 
-# Encoded as JSON and appended to the end of the page, to be read by pagevars.js.
-our %pagevars;
-
-
 # Ugly hack to move rendering down below the float object.
 sub clearfloat_ { div_ class => 'clearfloat', '' }
 
@@ -115,9 +111,8 @@ sub rdate_ {
 # Instantiate an Elm module
 sub elm_ {
     my($mod, $schema, $data, $placeholder) = @_;
-    $pagevars{elm} ||= [];
-    push $pagevars{elm}->@*, [ $mod, $data ? ($schema ? $schema->analyze->coerce_for_json($data, unknown => 'remove') : $data) : () ];
-    div_ id => "elm$#{$pagevars{elm}}", $placeholder//'';
+    push tuwf->req->{pagevars}{elm}->@*, [ $mod, $data ? ($schema ? $schema->analyze->coerce_for_json($data, unknown => 'remove') : $data) : () ];
+    div_ id => sprintf('elm%d', $#{ tuwf->req->{pagevars}{elm} }), $placeholder//'';
 }
 
 
@@ -314,7 +309,7 @@ sub _footer_ {
         my $modules = uri_escape join "\n", sort keys %INC;
         a_ href => 'data:text/plain,'.$modules, 'Modules';
         lit_ ' | ';
-        debug_ \%pagevars;
+        debug_ tuwf->req->{pagevars};
     }
 }
 
@@ -411,8 +406,8 @@ sub _hidden_msg_ {
 sub v2rwjs_ { # Also used by VNDB::Util::LayoutHTML.
     script_ type => 'application/json', id => 'pagevars', sub {
         # Escaping rules for a JSON <script> context are kinda weird, but more efficient than regular xml_escape().
-        lit_(JSON::XS->new->canonical->encode(\%pagevars) =~ s{</}{<\\/}rg =~ s/<!--/<\\u0021--/rg);
-    } if keys %pagevars;
+        lit_(JSON::XS->new->canonical->encode(tuwf->req->{pagevars}) =~ s{</}{<\\/}rg =~ s/<!--/<\\u0021--/rg);
+    } if keys tuwf->req->{pagevars}->%*;
     script_ type => 'application/javascript', src => config->{url_static}.'/f/v2rw.js?'.config->{version}, '';
 }
 
@@ -433,7 +428,7 @@ sub v2rwjs_ { # Also used by VNDB::Util::LayoutHTML.
 sub framework_ {
     my $cont = pop;
     my %o = @_;
-    %pagevars = $o{pagevars} ? $o{pagevars}->%* : ();
+    tuwf->req->{pagevars} = { $o{pagevars}->%* } if $o{pagevars};
 
     html_ lang => 'en', sub {
         head_ sub { _head_ \%o };
diff --git a/sql/perms.sql b/sql/perms.sql
index 7dd765c7..406cb344 100644
--- a/sql/perms.sql
+++ b/sql/perms.sql
@@ -59,6 +59,7 @@ GRANT SELECT, INSERT, UPDATE, DELETE ON threads_boards           TO vndb_site;
 GRANT SELECT, INSERT, UPDATE, DELETE ON threads_poll_options     TO vndb_site;
 GRANT SELECT, INSERT, UPDATE, DELETE ON threads_poll_votes       TO vndb_site;
 GRANT SELECT, INSERT, UPDATE, DELETE ON threads_posts            TO vndb_site;
+GRANT         INSERT                 ON trace_log                TO vndb_site;
 GRANT SELECT, INSERT, UPDATE, DELETE ON traits                   TO vndb_site;
 GRANT SELECT, INSERT, UPDATE, DELETE ON traits_chars             TO vndb_site;
 GRANT SELECT, INSERT, UPDATE, DELETE ON traits_parents           TO vndb_site;
diff --git a/sql/schema.sql b/sql/schema.sql
index 292b55b3..2e10006d 100644
--- a/sql/schema.sql
+++ b/sql/schema.sql
@@ -701,6 +701,21 @@ CREATE TABLE threads_boards (
   PRIMARY KEY(tid, type, iid)
 );
 
+-- trace_log
+CREATE TABLE trace_log (
+  date      timestamptz NOT NULL DEFAULT NOW(),
+  method    text NOT NULL,
+  path      text NOT NULL,
+  query     text NOT NULL DEFAULT '',
+  module    text,
+  line      integer,
+  sql_num   integer,
+  sql_time  float,
+  perl_time float,
+  loggedin  boolean,
+  elm_mods  text[]
+);
+
 -- traits
 CREATE TABLE traits (
   id SERIAL PRIMARY KEY, -- [pub]
diff --git a/util/vndb.pl b/util/vndb.pl
index 3eafe5af..5c6d5a6a 100755
--- a/util/vndb.pl
+++ b/util/vndb.pl
@@ -4,6 +4,7 @@ use v5.24;
 use warnings;
 use Cwd 'abs_path';
 use TUWF ':html_';
+use Time::HiRes 'time';
 
 $|=1; # Disable buffering on STDOUT, otherwise vndb-dev-server.pl won't pick up our readyness notification.
 
@@ -64,6 +65,8 @@ TUWF::hook before => sub {
     # Use a 'SameSite=Strict' cookie to determine whether this page was loaded from internal or external.
     # Ought to be more reliable than checking the Referer header, but it's unfortunately a bit uglier.
     tuwf->resCookie(samesite => 1, httponly => 1, samesite => 'Strict') if !tuwf->samesite;
+
+    tuwf->req->{trace_start} = time if config->{trace_log};
 };
 
 
@@ -109,8 +112,48 @@ sub TUWF::Object::resDenied {
 }
 
 
+# Intercept TUWF::any() and TUWF::register() to figure out which module is processing the request.
+if(config->{trace_log}) {
+    my sub wrap {
+        my $f = shift;
+        sub {
+            my $i = 0;
+            my $loc = ['',0];
+            while(my($pack, undef, $line) = caller($i++)) {
+                if($pack !~ '^(?:main|TUWF|VNWeb::Elm)') {
+                    $loc = [$pack,$line];
+                    last;
+                }
+            }
+            my sub subwrap { my $sub = shift; sub { tuwf->req->{trace_loc} = $loc; $sub->(@_) } }
+            $f->(map ref($_) eq 'CODE' ? subwrap($_) : $_, @_)
+        }
+    }
+    no warnings 'redefine';
+    my $x = \&TUWF::register; *TUWF::register = wrap($x);# sub { $x->(map ref($_) eq 'CODE' ? wrap($_) : $_, @_) };
+    my $y = \&TUWF::any;      *TUWF::any      = wrap($y);# sub { $y->(map ref($_) eq 'CODE' ? wrap($_) : $_, @_) };
+}
+
 TUWF::load_recursive('VNDB::Util', 'VNDB::DB', 'VNDB::Handler');
 TUWF::set import_modules => 0;
 TUWF::load_recursive('VNWeb');
 
+TUWF::hook after => sub {
+    return if rand() > config->{trace_log} || !tuwf->req->{trace_start};
+    my $sqlt = List::Util::sum(map $_->[2], tuwf->{_TUWF}{DB}{queries}->@*);
+    my %elm = map +($_->[0], 1), tuwf->req->{pagevars}{elm}->@*;
+    tuwf->dbExeci('INSERT INTO trace_log', {
+        method    => tuwf->reqMethod(),
+        path      => tuwf->reqPath(),
+        query     => tuwf->reqQuery(),
+        module    => tuwf->req->{trace_loc}[0],
+        line      => tuwf->req->{trace_loc}[1],
+        sql_num   => scalar grep($_->[0] ne 'ping/rollback' && $_->[0] ne 'commit', tuwf->{_TUWF}{DB}{queries}->@*),
+        sql_time  => $sqlt,
+        perl_time => time() - tuwf->req->{trace_start},
+        loggedin  => auth?1:0,
+        elm_mods  => '{'.join(',', sort keys %elm).'}'
+    });
+} if config->{trace_log};
+
 TUWF::run if !tuwf->{elmgen};