Issue #2127: introducing the methods Headers() and Header()

This allows to use the standard names for HTTP headers.
RotherOSS · Mar 7, 2023 · b64697c · b64697c
1 parent a1ffeae
commit b64697c
Show file tree

Hide file tree

Showing 15 changed files with 106 additions and 26 deletions.
diff --git a/Kernel/GenericInterface/Transport/HTTP/SOAP.pm b/Kernel/GenericInterface/Transport/HTTP/SOAP.pm
@@ -126,7 +126,7 @@ sub ProviderProcessRequest {
     # If the HTTP_TRANSFER_ENCODING environment variable is defined, check if is chunked.
     my $Chunked = 0;
     {
-        my $TransferEncoding = $ParamObject->HTTP('TRANSFER_ENCODING') // '';
+        my $TransferEncoding = $ParamObject->Header('Transfer-Encoding') // '';
         if ( $TransferEncoding =~ m/^chunked/ ) {
             $Chunked = 1;
         }
@@ -267,7 +267,7 @@ sub ProviderProcessRequest {
     # Under PSGI it is available in the Env hashref under the key 'HTTP_SOAPACTION'
     # The Perl module CGI::PSGI takes the setting and
     # make it available via the method HTTP().
-    my $SOAPAction = $ParamObject->HTTP('SOAPACTION');
+    my $SOAPAction = $ParamObject->Header('SOAPAction');
 
     # Check whether SOAPAction is configured and necessary.
     if (

diff --git a/Kernel/Modules/AdminProcessManagement.pm b/Kernel/Modules/AdminProcessManagement.pm
@@ -585,7 +585,7 @@ sub Run {
 
         my $SkinSelectedHostBased;
         my $DefaultSkinHostBased = $ConfigObject->Get('Loader::Agent::DefaultSelectedSkin::HostBased');
-        my $Host                 = $ParamObject->HTTP('HOST');
+        my $Host                 = $ParamObject->Header('Host');
         if ( $DefaultSkinHostBased && $Host ) {
             REGEXP:
             for my $RegExp ( sort keys %{$DefaultSkinHostBased} ) {

diff --git a/Kernel/Modules/Installer.pm b/Kernel/Modules/Installer.pm
@@ -1048,9 +1048,9 @@ sub Run {    ## no critic qw(Subroutines::RequireFinalReturn)
         # Another, maybe better, approach is to simple provide a relative link to '../index.pl'.
         # Fun fact: the FQDN can specified with a port.
         my $Host =
-            $ParamObject->HTTP('HTTP_X_FORWARDED_SERVER')    # for the HTTPS case, the hostname that nginx sees
-            || $ParamObject->HTTP('HOST')                    # should work in the HTTP case, in Docker or not in Docker
-            || $ConfigObject->Get('FQDN');                   # a fallback
+            $ParamObject->Header('X-Forwarded-Server')    # for the HTTPS case, the hostname that nginx sees
+            || $ParamObject->Header('Host')               # should work in the HTTP case, in Docker or not in Docker
+            || $ConfigObject->Get('FQDN');                # a fallback
 
         $LayoutObject->Block(
             Name => 'Finish',

diff --git a/Kernel/Modules/MigrateFromOTRS.pm b/Kernel/Modules/MigrateFromOTRS.pm
@@ -604,9 +604,9 @@ sub _Finish {
     # Another, maybe better, approach is to simple provide a relative link to '../index.pl'.
     # Fun fact: the FQDN can specified with a port.
     my $Host =
-        $ParamObject->HTTP('HTTP_X_FORWARDED_SERVER')    # for the HTTPS case, the hostname that nginx sees
-        || $ParamObject->HTTP('HOST')                    # should work in the HTTP case, in Docker or not in Docker
-        || $ConfigObject->Get('FQDN');                   # a fallback
+        $ParamObject->Header('X-Forwarded-Server')    # for the HTTPS case, the hostname that nginx sees
+        || $ParamObject->Header('Host')               # should work in the HTTP case, in Docker or not in Docker
+        || $ConfigObject->Get('FQDN');                # a fallback
 
     return {
         Webserver   => $Webserver,

diff --git a/Kernel/Output/HTML/Layout.pm b/Kernel/Output/HTML/Layout.pm
@@ -110,7 +110,7 @@ sub new {
     # Determine the language to use based on the browser setting, if there isn't one yet.
     my $ParamObject = $Kernel::OM->Get('Kernel::System::Web::Request');
     if ( !$Self->{UserLanguage} ) {
-        my @BrowserLanguages = split /\s*,\s*/, $Self->{Lang} || $ParamObject->HTTP('HTTP_ACCEPT_LANGUAGE') || '';
+        my @BrowserLanguages = split /\s*,\s*/, $Self->{Lang} || $ParamObject->Header('Accept-Language') || '';
         my %Data = %{ $ConfigObject->Get('DefaultUsedLanguages') };
 
         LANGUAGE:
@@ -218,7 +218,7 @@ EOF
     $Self->{BrowserJavaScriptSupport} = 1;
     $Self->{BrowserRichText}          = 1;
 
-    my $HttpUserAgent = lc( $ParamObject->HTTP('USER_AGENT') // '' );
+    my $HttpUserAgent = lc( $ParamObject->Header('User-Agent') // '' );
 
     if ( !$HttpUserAgent ) {
         $Self->{Browser} = 'Unknown - no $ENV{"HTTP_USER_AGENT"}';
@@ -384,7 +384,7 @@ EOF
 
     # force a theme based on host name
     my $DefaultThemeHostBased = $ConfigObject->Get('DefaultTheme::HostBased');
-    my $Host                  = $ParamObject->HTTP('HOST');
+    my $Host                  = $ParamObject->Header('Host');
     if ( $DefaultThemeHostBased && $Host ) {
 
         THEME:

diff --git a/Kernel/Output/HTML/Layout/Loader.pm b/Kernel/Output/HTML/Layout/Loader.pm
@@ -62,7 +62,7 @@ sub LoaderCreateAgentCSSCalls {
     my $SkinSelectedHostBased;
     my $DefaultSkinHostBased = $ConfigObject->Get('Loader::Agent::DefaultSelectedSkin::HostBased');
     my $ParamObject          = $Kernel::OM->Get('Kernel::System::Web::Request');
-    my $Host                 = $ParamObject->HTTP('HOST');
+    my $Host                 = $ParamObject->Header('Host');
     if ( $DefaultSkinHostBased && $Host ) {
         REGEXP:
         for my $RegExp ( sort keys %{$DefaultSkinHostBased} ) {
@@ -287,7 +287,7 @@ sub LoaderCreateJavaScriptTemplateData {
     # force a theme based on host name
     my $DefaultThemeHostBased = $ConfigObject->Get('DefaultTheme::HostBased');
     my $ParamObject           = $Kernel::OM->Get('Kernel::System::Web::Request');
-    my $Host                  = $ParamObject->HTTP('HOST');
+    my $Host                  = $ParamObject->Header('Host');
     if ( $DefaultThemeHostBased && $Host ) {
 
         THEME:
@@ -573,7 +573,7 @@ sub LoaderCreateCustomerCSSCalls {
     # force a skin based on host name
     my $DefaultSkinHostBased = $ConfigObject->Get('Loader::Customer::SelectedSkin::HostBased');
     my $ParamObject          = $Kernel::OM->Get('Kernel::System::Web::Request');
-    my $Host                 = $ParamObject->HTTP('HOST');
+    my $Host                 = $ParamObject->Header('Host');
     if ( $DefaultSkinHostBased && $Host ) {
         REGEXP:
         for my $RegExp ( sort keys %{$DefaultSkinHostBased} ) {

diff --git a/Kernel/System/Auth/HTTPBasicAuth.pm b/Kernel/System/Auth/HTTPBasicAuth.pm
@@ -77,7 +77,7 @@ sub Auth {
 
     # get params
     my $ParamObject = $Kernel::OM->Get('Kernel::System::Web::Request');
-    my $User        = $ParamObject->RemoteUser() || $ParamObject->HTTP('REMOTE_USER');
+    my $User        = $ParamObject->RemoteUser() || $ParamObject->Header('Remote-User');
     my $RemoteAddr  = $ParamObject->RemoteAddr() || 'Got no REMOTE_ADDR env!';
 
     # return on no user

diff --git a/Kernel/System/AuthSession/DB.pm b/Kernel/System/AuthSession/DB.pm
@@ -248,8 +248,8 @@ sub CreateSessionID {
 
     # get remote address and the http user agent
     my $ParamObject     = $Kernel::OM->Get('Kernel::System::Web::Request');
-    my $RemoteAddr      = $ParamObject->RemoteAddr()       || 'none';
-    my $RemoteUserAgent = $ParamObject->HTTP('USER_AGENT') || 'none';
+    my $RemoteAddr      = $ParamObject->RemoteAddr()         || 'none';
+    my $RemoteUserAgent = $ParamObject->Header('User-Agent') || 'none';
 
     # get main object
     my $MainObject = $Kernel::OM->Get('Kernel::System::Main');

diff --git a/Kernel/System/AuthSession/FS.pm b/Kernel/System/AuthSession/FS.pm
@@ -219,8 +219,8 @@ sub CreateSessionID {
 
     # get remote address and the http user agent
     my $ParamObject     = $Kernel::OM->Get('Kernel::System::Web::Request');
-    my $RemoteAddr      = $ParamObject->RemoteAddr()       || 'none';
-    my $RemoteUserAgent = $ParamObject->HTTP('USER_AGENT') || 'none';
+    my $RemoteAddr      = $ParamObject->RemoteAddr()          || 'none';
+    my $RemoteUserAgent = $ParamObject - Header('User-Agent') || 'none';
 
     my $MainObject = $Kernel::OM->Get('Kernel::System::Main');
 

diff --git a/Kernel/System/CustomerAuth/HTTPBasicAuth.pm b/Kernel/System/CustomerAuth/HTTPBasicAuth.pm
@@ -80,7 +80,7 @@ sub Auth {
 
     # get params
     my $ParamObject = $Kernel::OM->Get('Kernel::System::Web::Request');
-    my $User        = $ParamObject->RemoteUser() || $ParamObject->HTTP('REMOTE_USER');
+    my $User        = $ParamObject->RemoteUser() || $ParamObject->Header('Remote-User');
     my $RemoteAddr  = $ParamObject->RemoteAddr() || 'Got no REMOTE_ADDR env!';
 
     # return on on user

diff --git a/Kernel/System/Web/InterfaceAgent.pm b/Kernel/System/Web/InterfaceAgent.pm
@@ -142,7 +142,7 @@ sub Content {    ## no critic qw(Subroutines::RequireFinalReturn)
 
     # Check if https forcing is active, and redirect if needed.
     if ( $ConfigObject->Get('HTTPSForceRedirect') && !$ParamObject->HttpsIsOn ) {
-        my $Host         = $ParamObject->HTTP('HOST') || $ConfigObject->Get('FQDN');
+        my $Host         = $ParamObject->Header('Host') || $ConfigObject->Get('FQDN');
         my $RequestURI   = $ParamObject->RequestURI();
         my $LayoutObject = $Kernel::OM->Get('Kernel::Output::HTML::Layout');
 

diff --git a/Kernel/System/Web/InterfaceCustomer.pm b/Kernel/System/Web/InterfaceCustomer.pm
@@ -143,7 +143,7 @@ sub Content {    ## no critic qw(Subroutines::RequireFinalReturn)
 
     # Check if https forcing is active, and redirect if needed.
     if ( $ConfigObject->Get('HTTPSForceRedirect') && !$ParamObject->HttpsIsOn ) {
-        my $Host         = $ParamObject->HTTP('HOST') || $ConfigObject->Get('FQDN');
+        my $Host         = $ParamObject->Header('Host') || $ConfigObject->Get('FQDN');
         my $RequestURI   = $ParamObject->RequestURI();
         my $LayoutObject = $Kernel::OM->Get('Kernel::Output::HTML::Layout');
 

diff --git a/Kernel/System/Web/InterfacePublic.pm b/Kernel/System/Web/InterfacePublic.pm
@@ -132,7 +132,7 @@ sub Content {
 
     # Check if https forcing is active, and redirect if needed.
     if ( $ConfigObject->Get('HTTPSForceRedirect') && !$ParamObject->HttpsIsOn ) {
-        my $Host         = $ParamObject->HTTP('HOST') || $ConfigObject->Get('FQDN');
+        my $Host         = $ParamObject->Header('Host') || $ConfigObject->Get('FQDN');
         my $RequestURI   = $ParamObject->RequestURI();
         my $LayoutObject = $Kernel::OM->Get('Kernel::Output::HTML::Layout');
 

diff --git a/Kernel/System/Web/Request.pm b/Kernel/System/Web/Request.pm
@@ -400,7 +400,7 @@ sub SetArray {
 =head2 Content
 
 Returns the request content in a raw byte string for POST requests.
-This is a wrapper around C<Plack::Requests::address()>.
+This is a wrapper around C<Plack::Request::content()>.
 
     my $RawBody = $ParamObject->Content();
 
@@ -515,7 +515,7 @@ sub GetCookie {
 =head2 RemoteAddr()
 
 get the remote address of the HTTP client.
-This is a wrapper around C<Plack::Requests::address()>.
+This is a wrapper around C<Plack::Request::address()>.
 
     my $RemoteAddr = $ParamObject->RemoteAddr();
 
@@ -686,6 +686,36 @@ sub PathInfo {
     return $Self->{PlackRequest}->path_info;
 }
 
+=head2 Headers
+
+This is a wrapper around C<Plack::Request::headers()>.
+Returns an instance of C<HTTP::Headers::Fast> containing the request headers.
+That object was constructed from the I<HTTP_> fields of the PSGI environment.
+
+    my $Headers = $ParamObject->Headers();
+
+No parameters are handled.
+
+=cut
+
+sub Headers {
+    my ($Self) = @_;
+
+    return $Self->{PlackRequest}->headers;
+}
+
+=head2 Header
+
+This is a wrapper around C<Plack::Request::header()>.
+
+=cut
+
+sub Header {
+    my ( $Self, @Parameters ) = @_;
+
+    return $Self->{PlackRequest}->header(@Parameters);
+}
+
 =head2 HTTP()
 
 Called with a single argument, this method gets the value

diff --git a/scripts/test/HTTPRequest.t b/scripts/test/HTTPRequest.t
@@ -53,6 +53,14 @@ subtest 'GET without script name' => sub {
     is( $Request->GetParam( Param => 'aia' ), undef, 'SingleParam - not defined' );
     is( $Request->Content,                    '',    'no body in GET request' );
     is( $Request->ScriptName,                 '',    'no script name' );
+    is(
+        $Request->Headers->psgi_flatten,
+        [
+            'Host'           => 'www.example.com',
+            'Content-Length' => 0
+        ],
+        'flat list of headers'
+    );
 };
 
 subtest 'GET with script name' => sub {
@@ -72,6 +80,14 @@ subtest 'GET with script name' => sub {
     is( $Request->Content,                    '',            'no body in GET request' );
     is( $Request->ScriptName,                 'script.sh',   'script name script.sh' );
     is( $Request->PathInfo,                   '/some/where', 'script path /some/where' );
+    is(
+        $Request->Headers->psgi_flatten,
+        [
+            'Host'           => 'www.example.com',
+            'Content-Length' => 0
+        ],
+        'flat list of headers'
+    );
 };
 
 # TODO: test support for POST_MAX
@@ -117,6 +133,15 @@ subtest 'POST without URL params' => sub {
     is( $Request->Content,                         $Body,        'body in POST request' );
     is( $Request->GetParam( Param => 'POSTDATA' ), $Body,        'POSTDATA gets body' );
     is( $Request->ScriptName,                      'script.awk', 'script name script.awk' );
+    is(
+        $Request->Headers->psgi_flatten,
+        [
+            'Host'           => 'www.example.com',
+            'Content-Length' => 11,
+            'Content-Type'   => 'application/x-www-form-urlencoded'
+        ],
+        'flat list of headers'
+    );
 };
 
 subtest 'POST with URL params' => sub {
@@ -171,6 +196,15 @@ subtest 'POST with URL params' => sub {
     is( $Request->Content,                         $Body,       'body in mixed request' );
     is( $Request->GetParam( Param => 'POSTDATA' ), $Body,       'POSTDATA gets body' );
     is( $Request->ScriptName,                      'script.py', 'script name script.py' );
+    is(
+        $Request->Headers->psgi_flatten,
+        [
+            'Host'           => 'www.example.com',
+            'Content-Length' => 11,
+            'Content-Type'   => 'application/x-www-form-urlencoded'
+        ],
+        'flat list of headers'
+    );
 };
 
 subtest 'POST with file upload' => sub {
@@ -234,6 +268,14 @@ END_TXT
         },
         'upload info for File2',
     );
+    like(
+        $Request->Headers->psgi_flatten,
+        [
+            'Content-Length' => 387,
+            'Content-Type'   => 'multipart/form-data; boundary=xYzZY',
+        ],
+        'flat list of headers, ignoring the tempdir'
+    );
 };
 
 subtest 'SetArray' => sub {
@@ -312,6 +354,14 @@ subtest 'SetArray' => sub {
         [qw(b newA newB)],
         'GetParamNames: after removing newC'
     );
+    is(
+        $Request->Headers->psgi_flatten,
+        [
+            'Host'           => 'www.example.com',
+            'Content-Length' => 0,
+        ],
+        'flat list of headers'
+    );
 };
 
 done_testing;