X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FForm.pm;h=f3fe6e5d9b49de814da4b2c0251c812a50b7b66b;hb=6f2893dcf199d5e5147cc2020c2ab6984f4274dc;hp=8d1772061fa3c5f5862b528584121eac4a8bf467;hpb=8ab8cad9c06edcaa424a13cd6e23d39a02135f07;p=kivitendo-erp.git diff --git a/SL/Form.pm b/SL/Form.pm index 8d1772061..f3fe6e5d9 100644 --- a/SL/Form.pm +++ b/SL/Form.pm @@ -54,18 +54,22 @@ use SL::Menu; use SL::Template; 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 { @@ -239,38 +243,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); - - _recode_recursively($iconv, $self); - } + my $encoding = $self->{INPUT_ENCODING} || $db_charset; + delete $self->{INPUT_ENCODING}; - 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.0"; + #$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(); @@ -454,8 +453,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(); @@ -471,13 +470,22 @@ sub info { if (!$self->{header}) { $self->header; - print qq| - |; + print qq||; } print qq| +

$msg

$msg + + + |; } else { @@ -534,6 +542,40 @@ sub isblank { $main::lxdebug->leave_sub(); } +sub _get_request_uri { + my $self = shift; + + return URI->new($ENV{HTTP_REFERER})->canonical() if $ENV{HTTP_X_FORWARDED_FOR}; + + my $scheme = $ENV{HTTPS} && (lc $ENV{HTTPS} eq 'on') ? 'https' : 'http'; + my $port = $ENV{SERVER_PORT} || ''; + $port = undef if (($scheme eq 'http' ) && ($port == 80)) + || (($scheme eq 'https') && ($port == 443)); + + my $uri = URI->new("${scheme}://"); + $uri->scheme($scheme); + $uri->port($port); + $uri->host($ENV{HTTP_HOST} || $ENV{SERVER_ADDR}); + $uri->path_query($ENV{REQUEST_URI}); + $uri->query(''); + + 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(); @@ -543,25 +585,19 @@ sub create_http_response { my $cgi = $main::cgi; $cgi ||= CGI->new(''); - my $base_path; - - if ($ENV{HTTP_X_FORWARDED_FOR}) { - $base_path = $ENV{HTTP_REFERER}; - $base_path =~ s|^.*?://.*?/|/|; - } else { - $base_path = $ENV{REQUEST_URI}; - } - $base_path =~ s|[^/]+$||; - $base_path =~ s|/$||; - 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' => $base_path, + '-path' => $uri->path, '-secure' => $ENV{HTTPS}); } @@ -636,6 +672,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) { @@ -656,7 +706,7 @@ sub header { ? "$self->{title} - $self->{titlebar}" : $self->{titlebar}; my $ajax = ""; - foreach my $item (@ { $self->{AJAX} }) { + for my $item (@ { $self->{AJAX} || [] }) { $ajax .= $item->show_javascript(); } @@ -671,13 +721,12 @@ sub header { $favicon $jsscript $ajax - $fokus + $title_hack -