commit 4d4e7fa016ab1e927703b0d574faf37f6ddab4b8
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 ae83cec58..5b09397cb 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 124c55918..ff5808de5 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 34be1b641..44337ea0b 100644
--- a/UI/setup/credentials.html
+++ b/UI/setup/credentials.html
@@ -31,6 +31,7 @@
                 <form id="loginform"
                       name="credentials"
                       style="margin-top:1em">
+                  <input type="hidden" name="csrf_token" value="[% csrf_token %]" />
                   <div class="login_form">
                     [% select_hint = text('Select or Enter User');
                        INCLUDE select element_data = {
diff --git a/UI/setup/edit_user.html b/UI/setup/edit_user.html
index 5132b5504..8fb281769 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 941704583..d25dfec28 100644
--- a/UI/setup/new_user.html
+++ b/UI/setup/new_user.html
@@ -9,6 +9,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 0466788e4..124ed47d7 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 8abbad090..20c40ad0c 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 af5b30b31..cb997c92e 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 b38e7ff91..e19b08abf 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;
@@ -292,6 +302,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 ca688e007..f038e0046 100644
--- a/lib/LedgerSMB/PSGI.pm
+++ b/lib/LedgerSMB/PSGI.pm
@@ -355,6 +355,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 04eaf0ec3..1ae7063ec 100644
--- a/lib/LedgerSMB/Scripts/setup.pm
+++ b/lib/LedgerSMB/Scripts/setup.pm
@@ -379,6 +379,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;
 
@@ -397,6 +400,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);
 }
@@ -409,6 +415,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);
 }
@@ -434,6 +443,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;
 
@@ -537,6 +549,9 @@ sub consistency {
 
 sub revert_migration {
     my ($request) = @_;
+    if (my $csrf = $request->verify_csrf) {
+        return $csrf;
+    }
     my ($reauth, $database) = _get_database($request);
     return $reauth if $reauth;
 
@@ -611,6 +626,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));
 }
@@ -864,6 +882,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;
 
@@ -1033,6 +1054,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;
 
@@ -1088,6 +1112,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;
 
@@ -1148,6 +1175,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;
 
@@ -1394,6 +1424,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));
@@ -1450,6 +1483,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;
 
@@ -1490,6 +1526,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;
 
@@ -1520,6 +1559,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;
 
@@ -1579,6 +1621,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;
     }
@@ -1593,6 +1638,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;
 
@@ -1612,6 +1660,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;
 
@@ -1635,7 +1686,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 b11fa74c0..fc76b4a6f 100644
--- a/lib/LedgerSMB/Template/UI.pm
+++ b/lib/LedgerSMB/Template/UI.pm
@@ -135,7 +135,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]); },
                 )},
