Keine großen GET-Requests via HTTP-Redirect erfordern

[mfinanz.git] / SL / Auth.pm

diff --git a/SL/Auth.pm b/SL/Auth.pm
index 784b185b459d3412f62f65461d26484893eec62c..b1e4b25e93d57887d33412eff207b777c0982141 100644 (file)
--- a/SL/Auth.pm
+++ b/SL/Auth.pm
@@ -11,6 +11,7 @@ use YAML;
 use SL::Auth::Constants qw(:all);
 use SL::Auth::DB;
 use SL::Auth::LDAP;
+use SL::Auth::Password;
 
 use SL::SessionFile;
 use SL::User;
@@ -136,12 +137,10 @@ sub _read_auth_config {
 sub authenticate_root {
   $main::lxdebug->enter_sub();
 
-  my $self           = shift;
-  my $password       = shift;
-  my $is_crypted     = shift;
+  my ($self, $password) = @_;
 
-  $password          = crypt $password, 'ro' if (!$password || !$is_crypted);
-  my $admin_password = crypt "$self->{admin_password}", 'ro';
+  $password             = SL::Auth::Password->hash_if_unhashed(login => 'root', password => $password);
+  my $admin_password    = SL::Auth::Password->hash_if_unhashed(login => 'root', password => $self->{admin_password});
 
   $main::lxdebug->leave_sub();
 
@@ -163,6 +162,21 @@ sub authenticate {
   return $result;
 }
 
+sub store_credentials_in_session {
+  my ($self, %params) = @_;
+
+  $params{password} = SL::Auth::Password->hash_if_unhashed(login => $params{login}, password => $params{password})
+    unless $self->{authenticator}->requires_cleartext_password;
+
+  $self->set_session_value(login => $params{login}, password => $params{password});
+}
+
+sub store_root_credentials_in_session {
+  my ($self, $rpw) = @_;
+
+  $self->set_session_value(rpw => SL::Auth::Password->hash_if_unhashed(login => 'root', password => $rpw));
+}
+
 sub dbconnect {
   $main::lxdebug->enter_sub(2);
 
@@ -659,12 +673,23 @@ sub set_session_value {
   $main::lxdebug->enter_sub();
 
   my $self   = shift;
-  my %params = @_;
+  my @params = @_;
 
   $self->{SESSION} ||= { };
 
-  while (my ($key, $value) = each %params) {
-    $self->{SESSION}->{ $key } = YAML::Dump(ref($value) eq 'HASH' ? { data => $value } : $value);
+  while (@params) {
+    my $key = shift @params;
+
+    if (ref $key eq 'HASH') {
+      my $value = { data         => $key->{value},
+                    auto_restore => $key->{auto_restore},
+                  };
+      $self->{SESSION}->{ $key->{key} } = YAML::Dump($value);
+
+    } else {
+      my $value = shift @params;
+      $self->{SESSION}->{ $key } = YAML::Dump(ref($value) eq 'HASH' ? { data => $value } : $value);
+    }
   }
 
   $main::lxdebug->leave_sub();
@@ -841,7 +866,6 @@ sub all_rights_full {
     ["customer_vendor_edit",           $locale->text("Create and edit customers and vendors")],
     ["part_service_assembly_edit",     $locale->text("Create and edit parts, services, assemblies")],
     ["project_edit",                   $locale->text("Create and edit projects")],
-    ["license_edit",                   $locale->text("Manage license keys")],
     ["--ar",                           $locale->text("AR")],
     ["sales_quotation_edit",           $locale->text("Create and edit sales quotations")],
     ["sales_order_edit",               $locale->text("Create and edit sales orders")],
@@ -1173,11 +1197,30 @@ SL::Auth - Authentication and session handling
 
 =over 4
 
+=item C<set_session_value @values>
 =item C<set_session_value %values>
 
-Store all key/value pairs in C<%values> in the session. All of these
-values are copied back into C<$::form> in the next request
-automatically.
+Store all values of C<@values> or C<%values> in the session. Each
+member of C<@values> is tested if it is a hash reference. If it is
+then it must contain the keys C<key> and C<value> and can optionally
+contain the key C<auto_restore>. In this case C<value> is associated
+with C<key> and restored to C<$::form> upon the next request
+automatically if C<auto_restore> is trueish or if C<value> is a scalar
+value.
+
+If the current member of C<@values> is not a hash reference then it
+will be used as the C<key> and the next entry of C<@values> is used as
+the C<value> to store. In this case setting C<auto_restore> is not
+possible.
+
+Therefore the following two invocations are identical:
+
+  $::auth-E<gt>set_session_value(name =E<gt> "Charlie");
+  $::auth-E<gt>set_session_value({ key =E<gt> "name", value =E<gt> "Charlie" });
+
+All of these values are copied back into C<$::form> for the next
+request automatically if they're scalar values or if they have
+C<auto_restore> set to trueish.
 
 The values can be any Perl structure. They are stored as YAML dumps.