Merge branch 'b-3.6.1' of ../kivitendo-erp_20220811

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

diff --git a/SL/Request.pm b/SL/Request.pm
index f72694d..7c4fa71 100644 (file)
--- a/SL/Request.pm
+++ b/SL/Request.pm
@@ -10,15 +10,17 @@ use List::MoreUtils qw(all any apply);
 use Exporter qw(import);
 
 use SL::Common;
 use Exporter qw(import);
 
 use SL::Common;

+use SL::JSON;

 use SL::MoreCommon qw(uri_encode uri_decode);
 use SL::Layout::None;
 use SL::Presenter;
 
 use SL::MoreCommon qw(uri_encode uri_decode);
 use SL::Layout::None;
 use SL::Presenter;
 

-our @EXPORT_OK = qw(flatten unflatten read_cgi_input);
+our @EXPORT_OK = qw(flatten unflatten);

 
 use Rose::Object::MakeMethods::Generic
 (
 
 use Rose::Object::MakeMethods::Generic
 (

-  'scalar --get_set_init' => [ qw(cgi layout presenter is_ajax type) ],
+  scalar                  => [ qw(applying_database_upgrades post_data) ],
+  'scalar --get_set_init' => [ qw(cgi layout presenter is_ajax is_mobile type) ],

 );
 
 sub init_cgi {
 );
 
 sub init_cgi {


@@ -37,10 +39,20 @@ sub init_is_ajax {
   return ($ENV{HTTP_X_REQUESTED_WITH} || '') eq 'XMLHttpRequest' ? 1 : 0;
 }
 
   return ($ENV{HTTP_X_REQUESTED_WITH} || '') eq 'XMLHttpRequest' ? 1 : 0;
 }
 

+sub init_is_mobile {
+  # mobile clients will change their user agent when the user requests
+  # desktop version so user agent is the most reliable way to identify
+  return ($ENV{HTTP_USER_AGENT} || '') =~ /Mobi/ ? 1 : 0;
+}
+

 sub init_type {
   return 'html';
 }
 
 sub init_type {
   return 'html';
 }
 

+sub is_https {
+  $ENV{HTTPS} && 'on' eq lc $ENV{HTTPS};
+}
+

 sub cache {
   my ($self, $topic, $default) = @_;
 
 sub cache {
   my ($self, $topic, $default) = @_;
 


@@ -227,6 +239,12 @@ sub _parse_multipart_formdata {
   $::lxdebug->leave_sub(2);
 }
 
   $::lxdebug->leave_sub(2);
 }
 

+sub _parse_json_formdata {
+  my ($content) = @_;
+
+  return $content ? SL::JSON::decode_json($content) : undef;
+}
+

 sub _recode_recursively {
   $::lxdebug->enter_sub;
   my ($iconv, $from, $to) = @_;
 sub _recode_recursively {
   $::lxdebug->enter_sub;
   my ($iconv, $from, $to) = @_;


@@ -265,7 +283,7 @@ sub _recode_recursively {
 sub read_cgi_input {
   $::lxdebug->enter_sub;
 
 sub read_cgi_input {
   $::lxdebug->enter_sub;
 

-  my ($target) = @_;
+  my ($self, $target) = @_;

 
   # yes i know, copying all those values around isn't terribly efficient, but
   # the old version of dumping everything into form and then launching a
 
   # yes i know, copying all those values around isn't terribly efficient, but
   # the old version of dumping everything into form and then launching a


@@ -274,29 +292,38 @@ sub read_cgi_input {
   # this way the data can at least be recoded on the fly as soon as we get to
   # know the source encoding and only in the cases where encoding may be hidden
   # among the payload we take the hit of copying the request around
   # this way the data can at least be recoded on the fly as soon as we get to
   # know the source encoding and only in the cases where encoding may be hidden
   # among the payload we take the hit of copying the request around

-  my $temp_target = { };
+  $self->post_data(undef);
+  my $data_to_decode = { };
+  my $iconv          = SL::Iconv->new('UTF-8', 'UTF-8');

 
 

-  # since both of these can potentially bring their encoding in INPUT_ENCODING
-  # they get dumped into temp_target
-  _input_to_hash($temp_target, $ENV{QUERY_STRING}, 1) if $ENV{QUERY_STRING};
-  _input_to_hash($temp_target, $ARGV[0],           1) if @ARGV && $ARGV[0];
+  _input_to_hash($data_to_decode, $ENV{QUERY_STRING}, 1) if $ENV{QUERY_STRING};
+  _input_to_hash($data_to_decode, $ARGV[0],           1) if @ARGV && $ARGV[0];

 
   if ($ENV{CONTENT_LENGTH}) {
     my $content;
     read STDIN, $content, $ENV{CONTENT_LENGTH};
 
   if ($ENV{CONTENT_LENGTH}) {
     my $content;
     read STDIN, $content, $ENV{CONTENT_LENGTH};

+

     if ($ENV{'CONTENT_TYPE'} && $ENV{'CONTENT_TYPE'} =~ /multipart\/form-data/) {
     if ($ENV{'CONTENT_TYPE'} && $ENV{'CONTENT_TYPE'} =~ /multipart\/form-data/) {

+      $self->post_data({});
+      my $post_data_to_decode = { };
+

       # multipart formdata can bring it's own encoding, so give it both
       # and let it decide on it's own
       # multipart formdata can bring it's own encoding, so give it both
       # and let it decide on it's own

-      _parse_multipart_formdata($target, $temp_target, $content, 1);
+      _parse_multipart_formdata($self->post_data, $post_data_to_decode, $content, 1);
+      _recode_recursively($iconv, $post_data_to_decode, $self->post_data) if keys %$post_data_to_decode;
+
+      $target->{$_} = $self->post_data->{$_} for keys %{ $self->post_data };
+
+    } elsif (($ENV{CONTENT_TYPE} // '') =~ m{^application/json}i) {
+      $self->post_data(_parse_json_formdata($content));
+

     } else {
       # normal encoding must be recoded
     } else {
       # normal encoding must be recoded

-      _input_to_hash($temp_target, $content, 1);
+      _input_to_hash($data_to_decode, $content, 1);

     }
   }
 
     }
   }
 

-  my $encoding     = delete $temp_target->{INPUT_ENCODING} || 'UTF-8';
-
-  _recode_recursively(SL::Iconv->new($encoding, 'UTF-8'), $temp_target => $target) if keys %$target;
+  _recode_recursively($iconv, $data_to_decode, $target) if keys %$data_to_decode;

 
   if ($target->{RESTORE_FORM_FROM_SESSION_ID}) {
     my %temp_form;
 
   if ($target->{RESTORE_FORM_FROM_SESSION_ID}) {
     my %temp_form;


@@ -376,10 +403,10 @@ This module handles unpacking of CGI parameters. It also gives
 information about the request, such as whether or not it was done via AJAX,
 or the requested content type.
 
 information about the request, such as whether or not it was done via AJAX,
 or the requested content type.
 

-  use SL::Request qw(read_cgi_input);
+  use SL::Request;

 
   # read cgi input depending on request type, unflatten and recode
 
   # read cgi input depending on request type, unflatten and recode

-  read_cgi_input($target_hash_ref);
+  $::request->read_cgi_input($target_hash_ref);

 
   # $hashref and $new_hashref should be identical
   my $new_arrayref = flatten($hashref);
 
   # $hashref and $new_hashref should be identical
   my $new_arrayref = flatten($hashref);


@@ -559,6 +586,26 @@ its initial value is set to C<$default>. If C<$default> is not given
 
 Returns the cached item.
 
 
 Returns the cached item.
 

+=item C<post_data>
+
+If the client sends data in the request body with the content type of
+either C<application/json> or C<multipart/form-data>, the content will
+be stored in the global request object, too. It can be retrieved via
+the C<post_data> function.
+
+For content type C<multipart/form-data> the same data is additionally
+stored in the global C<$::form> instance, potentially overwriting
+parameters given in the URL. This is done primarily for compatibility
+purposes with existing code that expects all parameters to be present
+in C<$::form>.
+
+For content type C<application/json> the data is only available in
+C<$::request>. The reason is that the top-level data in a JSON
+documents doesn't have to be an object which could be mapped to the
+hash C<$::form>. Instead, the top-level data can also be an
+array. Additionally keeping the namespaces of URL and POST parameters
+separate is cleaner and allows for fewer accidental conflicts.
+

 =back
 
 =head1 SPECIAL FUNCTIONS
 =back
 
 =head1 SPECIAL FUNCTIONS