commit dde2e35742b4b5bc5f71639ee854310b76917f52
Author: Erik Huelsmann <ehuels@gmail.com>
Date:   Sat Jan 20 16:03:34 2024 +0100

    Fix missing CSRF mitigation

diff --git a/UI/setup/begin_backup.html b/UI/setup/begin_backup.html
index 01735324d..1fdf541e1 100644
--- a/UI/setup/begin_backup.html
+++ b/UI/setup/begin_backup.html
@@ -9,6 +9,7 @@ include_stylesheet=["system/setup.css"] %]
 [% # notice, message, and operation are all localized. %]
 <div id="notice">[% notice %]</div>
 <form data-dojo-type="lsmb/SimpleForm" action="setup.pl" method="POST" name="confirm_operation">
+  <input type="hidden" name="csrf_token" value="[% csrf_token %]" />
 [% INCLUDE input element_data = {
     name = 'database'
     type = 'hidden'
diff --git a/UI/setup/confirm_operation.html b/UI/setup/confirm_operation.html
index ebfc90e21..a1a54efc2 100644
--- a/UI/setup/confirm_operation.html
+++ b/UI/setup/confirm_operation.html
@@ -15,6 +15,7 @@ include_stylesheet=["system/setup.css"] %]
       action="setup.pl"
       method="POST"
       name="confirm_operation">
+  <input type="hidden" name="csrf_token" value="[% csrf_token %]" />
 [% INCLUDE input element_data = {
     name = 'database'
     type = 'hidden'
diff --git a/UI/setup/credentials.html b/UI/setup/credentials.html
index 70d0516f0..b30258da3 100644
--- a/UI/setup/credentials.html
+++ b/UI/setup/credentials.html
@@ -35,6 +35,7 @@
                 <form id="loginform"
                     name="credentials"
                     style="margin-top:1em">
+                    <input type="hidden" name="csrf_token" value="[% csrf_token %]" />
                     <div class="login_form">
                         <div class="tabular col-1">
                             <div id="userpass">
diff --git a/UI/setup/edit_user.html b/UI/setup/edit_user.html
index 0e2ee6002..ea4c9d001 100644
--- a/UI/setup/edit_user.html
+++ b/UI/setup/edit_user.html
@@ -20,6 +20,7 @@ include_stylesheet=["system/setup.css"];
         </div>
 
     <form data-dojo-type="lsmb/SimpleForm" method="POST" action="[% request.script %]">
+      <input type="hidden" name="csrf_token" value="[% csrf_token %]" />
       <input type="hidden" name="id" value="[% request.id %]" />
       <input type="hidden" name="database" value="[% request.database %]" />
         <table id="user-data">
@@ -110,6 +111,7 @@ include_stylesheet=["system/setup.css"];
     [% IF user.user_id and not request.pls_import%]
         <hr />
         <form data-dojo-type="lsmb/SimpleForm" name="groups" method="POST" action="[% request.script %]">
+          <input type="hidden" name="csrf_token" value="[% csrf_token %]" />
             <input type="hidden" name="database" value="[% request.database %]" />
             [% PROCESS input element_data = {
                type="hidden"
diff --git a/UI/setup/migration_step.html b/UI/setup/migration_step.html
index 056ba51af..59edcc3a9 100644
--- a/UI/setup/migration_step.html
+++ b/UI/setup/migration_step.html
@@ -13,6 +13,7 @@
           method="post"
           action="[% form.script %]"
           id="migration-step-dynatable">
+      <input type="hidden" name="csrf_token" value="[% csrf_token %]" />
     [% FOREACH header IN headers %]<div class="listtop">
              [% INCLUDE decorated_text element_data = {
                     msg => header };
diff --git a/UI/setup/new_user.html b/UI/setup/new_user.html
index 3d248d402..5bfc6fa87 100644
--- a/UI/setup/new_user.html
+++ b/UI/setup/new_user.html
@@ -8,6 +8,7 @@ include_stylesheet=["system/setup.css"] %]
 <div class="listtop">[% text('Enter User') %]</div>
 <form data-dojo-type="lsmb/SimpleForm"
       action="setup.pl" method="POST" name="new_user">
+  <input type="hidden" name="csrf_token" value="[% csrf_token %]" />
 [% INCLUDE input element_data = {
     name = 'database'
     type = 'hidden'
diff --git a/UI/setup/select_coa.html b/UI/setup/select_coa.html
index 74212e7a9..6d11a771d 100644
--- a/UI/setup/select_coa.html
+++ b/UI/setup/select_coa.html
@@ -7,6 +7,7 @@ include_stylesheet=["system/setup.css"] %]
 <h2>[% text('Database Management Console') %]</h2>
 <div><div class="listtop">[% title %]</div>
 <form data-dojo-type="lsmb/SimpleForm" action="setup.pl" method="POST" name="credentials">
+  <input type="hidden" name="csrf_token" value="[% csrf_token %]" />
   <div id="sep" class="listheading">
     Pre-defined Chart-of-Accounts selection
   </div>
diff --git a/UI/setup/template_info.html b/UI/setup/template_info.html
index 822fed815..15a915324 100644
--- a/UI/setup/template_info.html
+++ b/UI/setup/template_info.html
@@ -6,6 +6,7 @@
 <div><div class="setupconsole">
 <h2>[% text('Database Management Console') %]</h2>
 <form data-dojo-type="lsmb/SimpleForm" action="setup.pl" method="post">
+  <input type="hidden" name="csrf_token" value="[% csrf_token %]" />
 <div class="listtop">[% text('Select Templates to Load') %]</div>
 [%
 PROCESS input element_data = {
diff --git a/UI/setup/upgrade_info.html b/UI/setup/upgrade_info.html
index c3fce238d..762d2dae6 100644
--- a/UI/setup/upgrade_info.html
+++ b/UI/setup/upgrade_info.html
@@ -9,6 +9,7 @@ include_stylesheet=["system/setup.css"] %]
 <form data-dojo-type="lsmb/SimpleForm"
       action="setup.pl" method="POST"
       name="upgrade_info">
+  <input type="hidden" name="csrf_token" value="[% csrf_token %]" />
 [% INCLUDE input element_data = {
     name = 'database'
     type = 'hidden'
diff --git a/lib/LedgerSMB.pm b/lib/LedgerSMB.pm
index 5e6516338..901001999 100644
--- a/lib/LedgerSMB.pm
+++ b/lib/LedgerSMB.pm
@@ -20,6 +20,16 @@ This method creates a new base request instance. It also validates the
 session/user credentials, as appropriate for the run mode.  Finally, it sets up
 the database connections for the user.
 
+=item verify_csrf()
+
+This method verifies the C<csrf_token> value in request parameters (held in
+C<$self->{csrf_token}>) against the value in the session object.  When one is
+not defined or they are not equal, this function returns a PSGI triplet to be
+used as the response resulting in a 400 -- Bad Request.
+
+When the CSRF token matches, C<undef> is returned indicating processing is to
+continue.
+
 =item open_form()
 
 This sets a $self->{form_id} to be used in later form validation (anti-XSRF
@@ -228,7 +238,7 @@ use Carp;
 use DateTime::Format::Duration::ISO8601;
 use Encode qw(perlio_ok);
 use HTTP::Headers::Fast;
-use HTTP::Status qw( HTTP_OK );
+use HTTP::Status qw( HTTP_OK HTTP_BAD_REQUEST );
 use List::Util qw( pairgrep );
 use Locale::CLDR;
 use Locales unicode => 1;
@@ -293,6 +303,20 @@ sub new {
     return $self;
 }
 
+
+sub verify_csrf {
+    my ($self) = @_;
+    my $got = $self->{csrf_token};
+    my $want = $self->{_req}->env->{'lsmb.session'}->{csrf_token};
+    if (not ($got and $want and $got eq $want)) {
+        $logger->debug( "CSRF have '$got'; want '$want'" );
+        return [ HTTP_BAD_REQUEST,
+                 [ 'Content-Type' => 'text/plain; charset=ascii' ],
+                 [ 'Bad request: CSRF token failure' ] ];
+    }
+    return undef;
+}
+
 sub open_form {
     my ($self) = @_;
     my @vars = $self->call_procedure(procname => 'form_open',
diff --git a/lib/LedgerSMB/Middleware/SessionStorage.pm b/lib/LedgerSMB/Middleware/SessionStorage.pm
index 5493f30ed..862073e08 100644
--- a/lib/LedgerSMB/Middleware/SessionStorage.pm
+++ b/lib/LedgerSMB/Middleware/SessionStorage.pm
@@ -33,6 +33,7 @@ use Plack::Util;
 use Plack::Util::Accessor
     qw( cookie cookie_path domain duration inner_serialize secret store );
 use Session::Storage::Secure;
+use String::Random;
 
 use LedgerSMB::PSGI::Util;
 
@@ -101,8 +102,9 @@ sub call {
     my ($env) = @_;
     my $req = Plack::Request->new($env);
 
-    my $cookie      = $req->cookies->{$self->cookie};
-    my $session     = $self->store->decode($cookie);
+    my $cookie             = $req->cookies->{$self->cookie};
+    my $session            = $self->store->decode($cookie);
+    $session->{csrf_token} //= String::Random->new->randpattern('.' x 23);
 
     my $secure = defined($env->{HTTPS}) && $env->{HTTPS} eq 'ON';
     my $path =
diff --git a/lib/LedgerSMB/PSGI.pm b/lib/LedgerSMB/PSGI.pm
index c3349e261..d5dd8b610 100644
--- a/lib/LedgerSMB/PSGI.pm
+++ b/lib/LedgerSMB/PSGI.pm
@@ -354,6 +354,12 @@ sub setup_url_space {
                 script => 'setup.pl';
             enable '+LedgerSMB::Middleware::Log4perl',
                 script => 'setup.pl';
+            enable '+LedgerSMB::Middleware::SessionStorage',
+                domain      => 'setup',
+                cookie      => "$cookie~setup",
+                cookie_path => '/',
+                secret      => $secret,
+                duration    => 60*60*24*90;
             enable '+LedgerSMB::Middleware::SetupAuthentication';
             enable '+LedgerSMB::Middleware::DisableBackButton';
             $psgi_app;
diff --git a/lib/LedgerSMB/Scripts/setup.pm b/lib/LedgerSMB/Scripts/setup.pm
index e9b1fd797..131371e9b 100644
--- a/lib/LedgerSMB/Scripts/setup.pm
+++ b/lib/LedgerSMB/Scripts/setup.pm
@@ -373,6 +373,9 @@ Copies db to the name of $request->{new_name}
 
 sub copy_db {
     my ($request) = @_;
+    if (my $csrf = $request->verify_csrf) {
+        return $csrf;
+    }
     my ($reauth, $database) = _get_database($request);
     return $reauth if $reauth;
 
@@ -391,6 +394,9 @@ Backs up a full db
 
 sub backup_db {
     my $request = shift @_;
+    if (my $csrf = $request->verify_csrf) {
+        return $csrf;
+    }
     $request->{backup} = 'db';
     return _begin_backup($request);
 }
@@ -403,6 +409,9 @@ Backs up roles only (for all db's)
 
 sub backup_roles {
     my $request = shift @_;
+    if (my $csrf = $request->verify_csrf) {
+        return $csrf;
+    }
     $request->{backup} = 'roles';
     return _begin_backup($request);
 }
@@ -428,6 +437,9 @@ Runs the backup.  If backup_type is set to email, emails the
 
 sub run_backup {
     my $request = shift @_;
+    if (my $csrf = $request->verify_csrf) {
+        return $csrf;
+    }
     my ($reauth, $database) = _get_database($request);
     return $reauth if $reauth;
 
@@ -506,6 +518,9 @@ sub run_backup {
 
 sub revert_migration {
     my ($request) = @_;
+    if (my $csrf = $request->verify_csrf) {
+        return $csrf;
+    }
     my ($reauth, $database) = _get_database($request);
     return $reauth if $reauth;
 
@@ -580,6 +595,9 @@ sub _save_templates {
 sub load_templates {
     my ($request) = @_;
 
+    if (my $csrf = $request->verify_csrf) {
+        return $csrf;
+    }
     return (_save_templates($request, 'load_templates')
             or login($request));
 }
@@ -788,6 +806,9 @@ sub _load_templates {
 
 sub upgrade {
     my ($request) = @_;
+    if (my $csrf = $request->verify_csrf) {
+        return $csrf;
+    }
     my ($reauth, $database) = _init_db($request);
     return $reauth if $reauth;
 
@@ -956,6 +977,9 @@ script.
 sub fix_tests {
     my ($request) = @_;
 
+    if (my $csrf = $request->verify_csrf) {
+        return $csrf;
+    }
     my ($reauth, $database) = _init_db($request);
     return $reauth if $reauth;
 
@@ -1009,6 +1033,9 @@ sub fix_tests {
 sub create_db {
     my ($request) = @_;
 
+    if (my $csrf = $request->verify_csrf) {
+        return $csrf;
+    }
     my ($reauth, $database) = _get_database($request);
     return $reauth if $reauth;
 
@@ -1069,6 +1096,9 @@ sub select_coa {
         }
 
         if ($request->{chart}) {
+            if (my $csrf = $request->verify_csrf) {
+                return $csrf;
+            }
             my ($reauth, $database) = _get_database($request);
             return $reauth if $reauth;
 
@@ -1315,6 +1345,9 @@ sub _create_initial_user {
 
 sub add_user {
     my ($request) = @_;
+    if (my $csrf = $request->verify_csrf) {
+        return $csrf;
+    }
 
     return (_create_initial_user($request)
             or login($request));
@@ -1368,6 +1401,9 @@ sub edit_user_roles {
 sub save_user_roles {
     my ($request) = @_;
 
+    if (my $csrf = $request->verify_csrf) {
+        return $csrf;
+    }
     my ($reauth) = _init_db($request);
     return $reauth if $reauth;
 
@@ -1390,6 +1426,9 @@ sub save_user_roles {
 sub reset_password {
     my ($request) = @_;
 
+    if (my $csrf = $request->verify_csrf) {
+        return $csrf;
+    }
     my ($reauth) = _init_db($request);
     return $reauth if $reauth;
 
@@ -1420,6 +1459,9 @@ Force work.  Forgets unmatching tests, applies a curing statement and move on.
 
 sub force {
     my ($request) = @_;
+    if (my $csrf = $request->verify_csrf) {
+        return $csrf;
+    }
     my ($reauth, $database) = _init_db($request);
     return $reauth if $reauth;
 
@@ -1479,6 +1521,9 @@ sub _rebuild_modules {
 sub rebuild_modules {
     my ($request) = @_;
 
+    if (my $csrf = $request->verify_csrf) {
+        return $csrf;
+    }
     if (my $rv = _rebuild_modules($request, 'rebuild_modules')) {
         return $rv;
     }
@@ -1493,6 +1538,9 @@ Gets the statistics info and shows the complete screen.
 
 sub _complete {
     my ($request) = @_;
+    if (my $csrf = $request->verify_csrf) {
+        return $csrf;
+    }
     my ($reauth, $database) = _init_db($request);
     return $reauth if $reauth;
 
@@ -1512,6 +1560,9 @@ Asks the various modules for system and version info, showing the result
 
 sub system_info {
     my ($request) = @_;
+    if (my $csrf = $request->verify_csrf) {
+        return $csrf;
+    }
     my ($reauth, $database) = _init_db($request);
     return $reauth if $reauth;
 
@@ -1535,7 +1586,7 @@ sub system_info {
 
 =head1 LICENSE AND COPYRIGHT
 
-Copyright (C) 2011-2022 The LedgerSMB Core Team
+Copyright (C) 2011-2024 The LedgerSMB Core Team
 
 This file is licensed under the GNU General Public License version 2, or at your
 option any later version.  A copy of the license should have been included with
diff --git a/lib/LedgerSMB/Template/UI.pm b/lib/LedgerSMB/Template/UI.pm
index d3a9fd67e..3bb826be8 100644
--- a/lib/LedgerSMB/Template/UI.pm
+++ b/lib/LedgerSMB/Template/UI.pm
@@ -133,7 +133,8 @@ sub render_string {
                     },
                     dojo_theme => (
                         $request->{_company_config}->{dojo_theme} || 'claro'
-                        )
+                        ),
+                    csrf_token => $request->{_req}->env->{'lsmb.session'}->{csrf_token},
                 },
                 sub { return escape_html($_[0]); },
                 )},
