X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;ds=sidebyside;f=SL%2FForm.pm;h=f02c25abe26ff9d8fdb42c4dcfb7d314df90ae04;hb=d8a50ddefe779afb7c1f4f6299439b0757d4540b;hp=5f0fcd756ea7e0f570e24828718558fb20d098fd;hpb=53d06080bc6bc5cc978ab3351628cffcf0658029;p=kivitendo-erp.git diff --git a/SL/Form.pm b/SL/Form.pm index 5f0fcd756..f02c25abe 100644 --- a/SL/Form.pm +++ b/SL/Form.pm @@ -42,6 +42,7 @@ use Data::Dumper; use CGI; use CGI::Ajax; use Cwd; +use Encode; use IO::File; use SL::Auth; use SL::Auth::DB; @@ -56,17 +57,20 @@ use SL::User; use Template; use URI; use List::Util qw(first max min sum); -use List::MoreUtils qw(any); +use List::MoreUtils qw(any apply); use strict; my $standard_dbh; END { - if ($standard_dbh) { - $standard_dbh->disconnect(); - undef $standard_dbh; - } + disconnect_standard_dbh(); +} + +sub disconnect_standard_dbh { + return unless $standard_dbh; + $standard_dbh->disconnect(); + undef $standard_dbh; } sub _store_value { @@ -240,38 +244,33 @@ sub new { tie %{ $self }, 'SL::Watchdog'; } - read(STDIN, $_, $ENV{CONTENT_LENGTH}); + bless $self, $type; - if ($ENV{QUERY_STRING}) { - $_ = $ENV{QUERY_STRING}; - } + $self->_input_to_hash($ENV{QUERY_STRING}) if $ENV{QUERY_STRING}; + $self->_input_to_hash($ARGV[0]) if @ARGV && $ARGV[0]; - if ($ARGV[0]) { - $_ = $ARGV[0]; + if ($ENV{CONTENT_LENGTH}) { + my $content; + read STDIN, $content, $ENV{CONTENT_LENGTH}; + $self->_request_to_hash($content); } - bless $self, $type; - - $self->_request_to_hash($_); - my $db_charset = $main::dbcharset; $db_charset ||= Common::DEFAULT_CHARSET; - if ($self->{INPUT_ENCODING}) { - if (lc $self->{INPUT_ENCODING} ne lc $db_charset) { - require Text::Iconv; - my $iconv = Text::Iconv->new($self->{INPUT_ENCODING}, $db_charset); + my $encoding = $self->{INPUT_ENCODING} || $db_charset; + delete $self->{INPUT_ENCODING}; - _recode_recursively($iconv, $self); - } - - delete $self->{INPUT_ENCODING}; - } + _recode_recursively(SL::Iconv->new($encoding, $db_charset), $self); $self->{action} = lc $self->{action}; $self->{action} =~ s/( |-|,|\#)/_/g; - $self->{version} = "2.6.1"; + #$self->{version} = "2.6.1"; # Old hardcoded but secure style + open VERSION_FILE, "VERSION"; # New but flexible code reads version from VERSION-file + $self->{version} = ; + close VERSION_FILE; + $self->{version} =~ s/[^0-9A-Za-z\.\_\-]//g; # only allow numbers, letters, points, underscores and dashes. Prevents injecting of malicious code. $main::lxdebug->leave_sub(); @@ -381,6 +380,7 @@ sub escape { my ($self, $str) = @_; + $str = Encode::encode('utf-8-strict', $str) if $::locale->is_utf8; $str =~ s/([^a-zA-Z0-9_.-])/sprintf("%%%02x", ord($1))/ge; $main::lxdebug->leave_sub(2); @@ -455,8 +455,8 @@ sub error { $self->show_generic_error($msg); } else { - - die "Error: $msg\n"; + print STDERR "Error: $msg\n"; + ::end_of_request(); } $main::lxdebug->leave_sub(); @@ -472,13 +472,22 @@ sub info { if (!$self->{header}) { $self->header; - print qq| - |; + print qq||; } print qq| +

$msg

+ + -

$msg + |; } else { @@ -555,6 +564,20 @@ sub _get_request_uri { return $uri; } +sub _add_to_request_uri { + my $self = shift; + + my $relative_new_path = shift; + my $request_uri = shift || $self->_get_request_uri; + my $relative_new_uri = URI->new($relative_new_path); + my @request_segments = $request_uri->path_segments; + + my $new_uri = $request_uri->clone; + $new_uri->path_segments(@request_segments[0..scalar(@request_segments) - 2], $relative_new_uri->path_segments); + + return $new_uri; +} + sub create_http_response { $main::lxdebug->enter_sub(); @@ -566,12 +589,17 @@ sub create_http_response { my $session_cookie; if (defined $main::auth) { + my $uri = $self->_get_request_uri; + my @segments = $uri->path_segments; + pop @segments; + $uri->path_segments(@segments); + my $session_cookie_value = $main::auth->get_session_id(); $session_cookie_value ||= 'NO_SESSION'; $session_cookie = $cgi->cookie('-name' => $main::auth->get_session_cookie_name(), '-value' => $session_cookie_value, - '-path' => $self->_get_request_uri->path, + '-path' => $uri->path, '-secure' => $ENV{HTTPS}); } @@ -646,6 +674,20 @@ sub header { | if $self->{"fokus"}; + # if there is a title, we put some JavaScript in to the page, wich writes a + # meaningful title-tag for our frameset. + my $title_hack; + if ($self->{"title"}){ + $title_hack = qq| + + |; + } + #Set Calendar my $jsscript = ""; if ($self->{jsscript} == 1) { @@ -681,13 +723,12 @@ sub header { $favicon $jsscript $ajax - $fokus + $title_hack -