Vermeidung von SQL injection durch Verwendung parametrisierter Abfragen.

[kivitendo-erp.git] / SL / User.pm

diff --git a/SL/User.pm b/SL/User.pm
index 9fa0035..c992012 100644 (file)
--- a/SL/User.pm
+++ b/SL/User.pm
@@ -34,6 +34,8 @@
 
 package User;
 
 
 package User;
 

+use SL::DBUpgrade2;
+

 sub new {
   $main::lxdebug->enter_sub();
 
 sub new {
   $main::lxdebug->enter_sub();
 


@@ -57,7 +59,7 @@ sub new {
           # remove any trailing whitespace
           s/^\s*(.*?)\s*$/$1/;
 
           # remove any trailing whitespace
           s/^\s*(.*?)\s*$/$1/;
 

-          ($key, $value) = split /=/, $_, 2;
+          ($key, $value) = split(/=/, $_, 2);

 
           if (($key eq "stylesheet") && ($value eq "sql-ledger.css")) {
             $value = "lx-office-erp.css";
 
           if (($key eq "stylesheet") && ($value eq "sql-ledger.css")) {
             $value = "lx-office-erp.css";


@@ -114,8 +116,12 @@ sub login {
   if ($self->{login}) {
 
     if ($self->{password}) {
   if ($self->{login}) {
 
     if ($self->{password}) {

-      $form->{password} = crypt $form->{password},
-        substr($self->{login}, 0, 2);
+      if ($form->{hashed_password}) {
+        $form->{password} = $form->{hashed_password};
+      } else {
+        $form->{password} = crypt($form->{password},
+                                  substr($self->{login}, 0, 2));
+      }

       if ($self->{password} ne $form->{password}) {
         $main::lxdebug->leave_sub();
         return -1;
       if ($self->{password} ne $form->{password}) {
         $main::lxdebug->leave_sub();
         return -1;


@@ -158,23 +164,37 @@ sub login {
                  '$myconfig{tel}', 'user')|;
       $dbh->do($query);
     }
                  '$myconfig{tel}', 'user')|;
       $dbh->do($query);
     }

+
+    $self->create_schema_info_table($form, $dbh);
+

     $dbh->disconnect;
 
     $rc = 0;
 
     $dbh->disconnect;
 
     $rc = 0;
 

-    if ($form->{dbversion} ne $dbversion) {
+    my $controls =
+      parse_dbupdate_controls($form, $myconfig{"dbdriver"});

 
 

-      # update the tables
-      open FH, ">$userspath/nologin" or die "
-$!";
+    map({ $form->{$_} = $myconfig{$_} }
+        qw(dbname dbhost dbport dbdriver dbuser dbpasswd dbconnect));
+
+    if (update_available($myconfig{"dbdriver"}, $dbversion) ||
+        update2_available($form, $controls)) {

 
 

-      map { $form->{$_} = $myconfig{$_} }
-        qw(dbname dbhost dbport dbdriver dbuser dbpasswd);
+      $form->{"stylesheet"} = "lx-office-erp.css";
+      $form->{"title"} = $main::locale->text("Dataset upgrade");
+      $form->header();
+      print($form->parse_html_template("dbupgrade/header"));

 
       $form->{dbupdate} = "db$myconfig{dbname}";
       $form->{ $form->{dbupdate} } = 1;
 
 
       $form->{dbupdate} = "db$myconfig{dbname}";
       $form->{ $form->{dbupdate} } = 1;
 

-      $form->info("Upgrading Dataset $myconfig{dbname} ...");
+      if ($form->{"show_dbupdate_warning"}) {
+        print($form->parse_html_template("dbupgrade/warning"));
+        exit(0);
+      }
+
+      # update the tables
+      open(FH, ">$userspath/nologin") or die("$!");

 
       # required for Oracle
       $form->{dbdefault} = $sid;
 
       # required for Oracle
       $form->{dbdefault} = $sid;


@@ -184,11 +204,18 @@ $!";
       $SIG{QUIT} = 'IGNORE';
 
       $self->dbupdate($form);
       $SIG{QUIT} = 'IGNORE';
 
       $self->dbupdate($form);

+      $self->dbupdate2($form, $controls);

 
       # remove lock file
 
       # remove lock file

-      unlink "$userspath/nologin";
+      unlink("$userspath/nologin");
+
+      my $menufile =
+        $self->{"menustyle"} eq "v3" ? "menuv3.pl" :
+        $self->{"menustyle"} eq "neu" ? "menunew.pl" :
+        "menu.pl";

 
 

-      $form->info("... done");
+      print($form->parse_html_template("dbupgrade/footer",
+                                       { "menufile" => $menufile }));

 
       $rc = -2;
 
 
       $rc = -2;
 


@@ -272,7 +299,7 @@ sub dbsources {
 
   if ($form->{dbdriver} eq 'Pg') {
 
 
   if ($form->{dbdriver} eq 'Pg') {
 

-    $query = qq|SELECT datname FROM pg_database|;
+    $query = qq|SELECT datname FROM pg_database WHERE NOT ((datname = 'template0') OR (datname = 'template1'))|;

     $sth   = $dbh->prepare($query);
     $sth->execute || $form->dberror($query);
 
     $sth   = $dbh->prepare($query);
     $sth->execute || $form->dberror($query);
 


@@ -334,20 +361,33 @@ sub dbcreate {
 
   my ($self, $form) = @_;
 
 
   my ($self, $form) = @_;
 

+  $form->{sid} = $form->{dbdefault};
+  &dbconnect_vars($form, $form->{dbdefault});
+  my $dbh =
+    DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
+    or $form->dberror;
+

   my %dbcreate = (
     'Pg'     => qq|CREATE DATABASE "$form->{db}"|,
     'Oracle' =>
       qq|CREATE USER "$form->{db}" DEFAULT TABLESPACE USERS TEMPORARY TABLESPACE TEMP IDENTIFIED BY "$form->{db}"|
   );
 
   my %dbcreate = (
     'Pg'     => qq|CREATE DATABASE "$form->{db}"|,
     'Oracle' =>
       qq|CREATE USER "$form->{db}" DEFAULT TABLESPACE USERS TEMPORARY TABLESPACE TEMP IDENTIFIED BY "$form->{db}"|
   );
 

-  $dbcreate{Pg} .= " WITH ENCODING = '$form->{encoding}'" if $form->{encoding};
+  my %dboptions = (
+    'Pg' => [],
+  );
+
+  push(@{$dboptions{"Pg"}}, "ENCODING = " . $dbh->quote($form->{"encoding"}))
+    if ($form->{"encoding"});
+  if ($form->{"dbdefault"}) {
+    my $dbdefault = $form->{"dbdefault"};
+    $dbdefault =~ s/[^a-zA-Z0-9_\-]//g;
+    push(@{$dboptions{"Pg"}}, "TEMPLATE = $dbdefault");
+  }

 
 

-  $form->{sid} = $form->{dbdefault};
-  &dbconnect_vars($form, $form->{dbdefault});
-  my $dbh =
-    DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
-    or $form->dberror;

   my $query = qq|$dbcreate{$form->{dbdriver}}|;
   my $query = qq|$dbcreate{$form->{dbdriver}}|;

+  $query .= " WITH " . join(" ", @{$dboptions{"Pg"}}) if (@{$dboptions{"Pg"}});
+

   $dbh->do($query) || $form->dberror($query);
 
   if ($form->{dbdriver} eq 'Oracle') {
   $dbh->do($query) || $form->dberror($query);
 
   if ($form->{dbdriver} eq 'Oracle') {


@@ -380,20 +420,73 @@ sub dbcreate {
   $filename = qq|sql/$form->{chart}-chart.sql|;
   $self->process_query($form, $dbh, $filename);
 
   $filename = qq|sql/$form->{chart}-chart.sql|;
   $self->process_query($form, $dbh, $filename);
 

-  # create indices
-  # Indices sind auch in lx-office.sql
-  # $filename = qq|sql/$form->{dbdriver}-indices.sql|;
-  # $self->process_query($form, $dbh, $filename);
+  $query = "UPDATE defaults SET coa = " . $dbh->quote($form->{"chart"});
+  $dbh->do($query) || $form->dberror($query);

 
   $dbh->disconnect;
 
   $main::lxdebug->leave_sub();
 }
 
 
   $dbh->disconnect;
 
   $main::lxdebug->leave_sub();
 }
 

+# Process a Perl script which updates the database.
+# If the script returns 1 then the update was successful.
+# Return code "2" means "needs more interaction; remove
+# users/nologin and exit".
+# All other return codes are fatal errors.
+sub process_perl_script {
+  $main::lxdebug->enter_sub();
+
+  my ($self, $form, $dbh, $filename, $version_or_control) = @_;
+
+  open(FH, "$filename") or $form->error("$filename : $!\n");
+  my $contents = join("", <FH>);
+  close(FH);
+
+  $dbh->begin_work();
+
+  my %dbup_myconfig = ();
+  map({ $dbup_myconfig{$_} = $form->{$_}; }
+      qw(dbname dbuser dbpasswd dbhost dbport dbconnect));
+
+  my $nls_file = $filename;
+  $nls_file =~ s|.*/||;
+  $nls_file =~ s|.pl$||;
+  my $dbup_locale = Locale->new($main::language, $nls_file);
+
+  my $result = eval($contents);
+
+  if (1 != $result) {
+    $dbh->rollback();
+    $dbh->disconnect();
+  }
+
+  if (!defined($result)) {
+    print($form->parse_html_template("dbupgrade/error",
+                                     { "file" => $filename,
+                                       "error" => $@ }));
+    exit(0);
+  } elsif (1 != $result) {
+    unlink("users/nologin") if (2 == $result);
+    exit(0);
+  }
+
+  if (ref($version_or_control) eq "HASH") {
+    $dbh->do("INSERT INTO schema_info (tag, login) VALUES (" .
+             $dbh->quote($version_or_control->{"tag"}) . ", " .
+             $dbh->quote($form->{"login"}) . ")");
+  } elsif ($version_or_control) {
+    $dbh->do("UPDATE defaults SET version = " .
+             $dbh->quote($version_or_control));
+  }
+  $dbh->commit();
+
+  $main::lxdebug->leave_sub();
+}
+

 sub process_query {
   $main::lxdebug->enter_sub();
 
 sub process_query {
   $main::lxdebug->enter_sub();
 

-  my ($self, $form, $dbh, $filename) = @_;
+  my ($self, $form, $dbh, $filename, $version_or_control) = @_;

 
   #  return unless (-f $filename);
 
 
   #  return unless (-f $filename);
 


@@ -402,13 +495,15 @@ sub process_query {
   my $sth;
   my @quote_chars;
 
   my $sth;
   my @quote_chars;
 

+  $dbh->begin_work();
+

   while (<FH>) {
 
     # Remove DOS and Unix style line endings.
   while (<FH>) {
 
     # Remove DOS and Unix style line endings.

-    s/[\r\n]//g;
+    chomp;

 
 

-    # don't add comments or empty lines
-    next if /^(--.*|\s+)$/;
+    # remove comments
+    s/--.*$//;

 
     for (my $i = 0; $i < length($_); $i++) {
       my $char = substr($_, $i, 1);
 
     for (my $i = 0; $i < length($_); $i++) {
       my $char = substr($_, $i, 1);


@@ -429,8 +524,15 @@ sub process_query {
           # Query is complete. Send it.
 
           $sth = $dbh->prepare($query);
           # Query is complete. Send it.
 
           $sth = $dbh->prepare($query);

-          $sth->execute || $form->dberror($query);
-          $sth->finish;
+          if (!$sth->execute()) {
+            my $errstr = $dbh->errstr;
+            $sth->finish();
+            $dbh->rollback();
+            $form->dberror("The database update/creation did not succeed. The file ${filename} containing the following query failed:<br>${query}<br>" .
+                           "The error message was: ${errstr}<br>" .
+                           "All changes in that file have been reverted.");
+          }
+          $sth->finish();

 
           $char  = "";
           $query = "";
 
           $char  = "";
           $query = "";


@@ -441,6 +543,16 @@ sub process_query {
     }
   }
 
     }
   }
 

+  if (ref($version_or_control) eq "HASH") {
+    $dbh->do("INSERT INTO schema_info (tag, login) VALUES (" .
+             $dbh->quote($version_or_control->{"tag"}) . ", " .
+             $dbh->quote($form->{"login"}) . ")");
+  } elsif ($version_or_control) {
+    $dbh->do("UPDATE defaults SET version = " .
+             $dbh->quote($version_or_control));
+  }
+  $dbh->commit();
+

   close FH;
 
   $main::lxdebug->leave_sub();
   close FH;
 
   $main::lxdebug->leave_sub();


@@ -482,7 +594,7 @@ sub dbsources_unused {
 
   while (<FH>) {
     if (/^dbname=/) {
 
   while (<FH>) {
     if (/^dbname=/) {

-      my ($null, $item) = split /=/;
+      my ($null, $item) = split(/=/);

       push @dbexcl, $item;
     }
   }
       push @dbexcl, $item;
     }
   }


@@ -598,7 +710,7 @@ sub dbneedsupdate {
 
 ## LINET
 sub calc_version {
 
 ## LINET
 sub calc_version {

-  $main::lxdebug->enter_sub();
+  $main::lxdebug->enter_sub(2);

 
   my (@v, $version, $i);
 
 
   my (@v, $version, $i);
 


@@ -612,7 +724,7 @@ sub calc_version {
     $version += $v[$i];
   }
 
     $version += $v[$i];
   }
 

-  $main::lxdebug->leave_sub();
+  $main::lxdebug->leave_sub(2);

   return $version;
 }
 
   return $version;
 }
 


@@ -640,6 +752,36 @@ sub cmp_script_version {
 }
 ## /LINET
 
 }
 ## /LINET
 

+sub update_available {
+  my ($dbdriver, $cur_version) = @_;
+
+  opendir SQLDIR, "sql/${dbdriver}-upgrade" or &error("", "sql/${dbdriver}-upgrade: $!");
+  my @upgradescripts =
+    grep(/$form->{dbdriver}-upgrade-\Q$cur_version\E.*\.(sql|pl)$/, readdir(SQLDIR));
+  closedir SQLDIR;
+
+  return ($#upgradescripts > -1);
+}
+
+sub create_schema_info_table {
+  $main::lxdebug->enter_sub();
+
+  my ($self, $form, $dbh) = @_;
+
+  my $query = "SELECT tag FROM schema_info LIMIT 1";
+  if (!$dbh->do($query)) {
+    $query =
+      "CREATE TABLE schema_info (" .
+      "  tag text, " .
+      "  login text, " .
+      "  itime timestamp DEFAULT now(), " .
+      "  PRIMARY KEY (tag))";
+    $dbh->do($query) || $form->dberror($query);
+  }
+
+  $main::lxdebug->leave_sub();
+}
+

 sub dbupdate {
   $main::lxdebug->enter_sub();
 
 sub dbupdate {
   $main::lxdebug->enter_sub();
 


@@ -654,11 +796,11 @@ sub dbupdate {
   if ($form->{dbupdate}) {
 
     # read update scripts into memory
   if ($form->{dbupdate}) {
 
     # read update scripts into memory

-    opendir SQLDIR, "sql/." or $form - error($!);
+    opendir SQLDIR, "sql/" . $form->{dbdriver} . "-upgrade" or &error("", "sql/" . $form->{dbdriver} . "-upgrade : $!");

     ## LINET
     @upgradescripts =
       sort(cmp_script_version
     ## LINET
     @upgradescripts =
       sort(cmp_script_version

-           grep(/$form->{dbdriver}-upgrade-.*?\.sql$/, readdir(SQLDIR)));
+           grep(/$form->{dbdriver}-upgrade-.*?\.(sql|pl)$/, readdir(SQLDIR)));

     ## /LINET
     closedir SQLDIR;
   }
     ## /LINET
     closedir SQLDIR;
   }


@@ -693,9 +835,11 @@ sub dbupdate {
 
     foreach my $upgradescript (@upgradescripts) {
       my $a = $upgradescript;
 
     foreach my $upgradescript (@upgradescripts) {
       my $a = $upgradescript;

-      $a =~ s/^$form->{dbdriver}-upgrade-|\.sql$//g;
+      $a =~ s/^$form->{dbdriver}-upgrade-|\.(sql|pl)$//g;
+      my $file_type = $1;

 
       my ($mindb, $maxdb) = split /-/, $a;
 
       my ($mindb, $maxdb) = split /-/, $a;

+      my $str_maxdb = $maxdb;

       ## LINET
       $mindb = calc_version($mindb);
       $maxdb = calc_version($maxdb);
       ## LINET
       $mindb = calc_version($mindb);
       $maxdb = calc_version($maxdb);


@@ -707,7 +851,12 @@ sub dbupdate {
       last if ($version < $mindb);
 
       # apply upgrade
       last if ($version < $mindb);
 
       # apply upgrade

-      $self->process_query($form, $dbh, "sql/$upgradescript");
+      $main::lxdebug->message(DEBUG2, "Applying Update $upgradescript");
+      if ($file_type eq "sql") {
+        $self->process_query($form, $dbh, "sql/" . $form->{"dbdriver"} . "-upgrade/$upgradescript", $str_maxdb);
+      } else {
+        $self->process_perl_script($form, $dbh, "sql/" . $form->{"dbdriver"} . "-upgrade/$upgradescript", $str_maxdb);
+      }

 
       $version = $maxdb;
 
 
       $version = $maxdb;
 


@@ -723,6 +872,112 @@ sub dbupdate {
   return $rc;
 }
 
   return $rc;
 }
 

+sub dbupdate2 {
+  $main::lxdebug->enter_sub();
+
+  my ($self, $form, $controls) = @_;
+
+  $form->{sid} = $form->{dbdefault};
+
+  my @upgradescripts = ();
+  my ($query, $sth, $tag);
+  my $rc = -2;
+
+  @upgradescripts = sort_dbupdate_controls($controls);
+
+  foreach my $db (split / /, $form->{dbupdate}) {
+
+    next unless $form->{$db};
+
+    # strip db from dataset
+    $db =~ s/^db//;
+    &dbconnect_vars($form, $db);
+
+    my $dbh =
+      DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
+      or $form->dberror;
+
+    map({ $_->{"applied"} = 0; } @upgradescripts);
+
+    $query = "SELECT tag FROM schema_info";
+    $sth = $dbh->prepare($query);
+    $sth->execute() || $form->dberror($query);
+    while (($tag) = $sth->fetchrow_array()) {
+      $controls->{$tag}->{"applied"} = 1 if (defined($controls->{$tag}));
+    }
+    $sth->finish();
+
+    my $all_applied = 1;
+    foreach (@upgradescripts) {
+      if (!$_->{"applied"}) {
+        $all_applied = 0;
+        last;
+      }
+    }
+
+    next if ($all_applied);
+
+    foreach my $control (@upgradescripts) {
+      next if ($control->{"applied"});
+
+      $control->{"file"} =~ /\.(sql|pl)$/;
+      my $file_type = $1;
+
+      # apply upgrade
+      $main::lxdebug->message(DEBUG2, "Applying Update $control->{file}");
+      print($form->parse_html_template("dbupgrade/upgrade_message2",
+                                       $control));
+
+      if ($file_type eq "sql") {
+        $self->process_query($form, $dbh, "sql/" . $form->{"dbdriver"} .
+                             "-upgrade2/$control->{file}", $control);
+      } else {
+        $self->process_perl_script($form, $dbh, "sql/" . $form->{"dbdriver"} .
+                                   "-upgrade2/$control->{file}", $control);
+      }
+    }
+
+    $rc = 0;
+    $dbh->disconnect;
+
+  }
+
+  $main::lxdebug->leave_sub();
+
+  return $rc;
+}
+
+sub update2_available {
+  $main::lxdebug->enter_sub();
+
+  my ($form, $controls) = @_;
+
+  map({ $_->{"applied"} = 0; } values(%{$controls}));
+
+  dbconnect_vars($form, $form->{"dbname"});
+
+  my $dbh =
+    DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) ||
+    $form->dberror;
+
+  my ($query, $tag, $sth);
+
+  $query = "SELECT tag FROM schema_info";
+  $sth = $dbh->prepare($query);
+  $sth->execute() || $form->dberror($query);
+  while (($tag) = $sth->fetchrow_array()) {
+    $controls->{$tag}->{"applied"} = 1 if (defined($controls->{$tag}));
+  }
+  $sth->finish();
+  $dbh->disconnect();
+
+  map({ $main::lxdebug->leave_sub() and return 1 if (!$_->{"applied"}) }
+      values(%{$controls}));
+
+  $main::lxdebug->leave_sub();
+  return 0;
+}
+

 sub create_config {
   $main::lxdebug->enter_sub();
 
 sub create_config {
   $main::lxdebug->enter_sub();
 


@@ -841,7 +1096,8 @@ sub config_vars {
     currency dateformat dbconnect dbdriver dbhost dbport dboptions
     dbname dbuser dbpasswd email fax name numberformat password
     printer role sid signature stylesheet tel templates vclimit angebote bestellungen rechnungen
     currency dateformat dbconnect dbdriver dbhost dbport dboptions
     dbname dbuser dbpasswd email fax name numberformat password
     printer role sid signature stylesheet tel templates vclimit angebote bestellungen rechnungen

-    anfragen lieferantenbestellungen einkaufsrechnungen steuernummer ustid duns menustyle);
+    anfragen lieferantenbestellungen einkaufsrechnungen taxnumber co_ustid duns menustyle
+    template_format default_media default_printer_id copies show_form_details);

 
   $main::lxdebug->leave_sub();
 
 
   $main::lxdebug->leave_sub();