336 lines
8.0 KiB
Perl
336 lines
8.0 KiB
Perl
package Lemonldap::NG::Common::PSGI::Request;
|
|
|
|
use strict;
|
|
use Mouse;
|
|
use JSON;
|
|
use URI::Escape;
|
|
|
|
our $VERSION = '1.9.0';
|
|
|
|
# http :// server / path ? query # fragment
|
|
# m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?|;
|
|
|
|
has HTTP_ACCEPT => ( is => 'ro', reader => 'accept' );
|
|
has HTTP_ACCEPT_ENCODING => ( is => 'ro', reader => 'encodings' );
|
|
has HTTP_ACCEPT_LANGUAGE => ( is => 'ro', reader => 'languages' );
|
|
has HTTP_COOKIE => ( is => 'ro', reader => 'cookies' );
|
|
has HTTP_HOST => ( is => 'ro', reader => 'hostname' );
|
|
has REMOTE_ADDR => ( is => 'ro', isa => 'Str', reader => 'remote_ip' );
|
|
has REMOTE_PORT => ( is => 'ro', isa => 'Int', reader => 'port' );
|
|
has REQUEST_METHOD => ( is => 'ro', isa => 'Str', reader => 'method' );
|
|
has SCRIPT_NAME => ( is => 'ro', isa => 'Str', reader => 'scriptname' );
|
|
has SERVER_PORT => ( is => 'ro', isa => 'Int', reader => 'get_server_port' );
|
|
has PATH_INFO => (
|
|
is => 'ro',
|
|
reader => 'path',
|
|
lazy => 1,
|
|
default => '',
|
|
trigger => sub {
|
|
my $tmp = $_[0]->{SCRIPT_NAME};
|
|
$_[0]->{PATH_INFO} =~ s|^$tmp|/|;
|
|
$_[0]->{PATH_INFO} =~ s|//+|/|g;
|
|
},
|
|
);
|
|
has REQUEST_URI => (
|
|
is => 'ro',
|
|
reader => 'uri',
|
|
trigger => sub {
|
|
$_[0]->{unparsed_uri} = $_[0]->{REQUEST_URI};
|
|
$_[0]->{REQUEST_URI} = uri_unescape( $_[0]->{REQUEST_URI} );
|
|
$_[0]->{REQUEST_URI} =~ s|//+|/|g;
|
|
},
|
|
);
|
|
has unparsed_uri => ( is => 'rw', isa => 'Str' );
|
|
|
|
has 'psgi.errors' => ( is => 'rw', reader => 'stderr' );
|
|
|
|
# Authentication
|
|
|
|
has REMOTE_USER => (
|
|
is => 'ro',
|
|
reader => 'user',
|
|
trigger => sub {
|
|
$_[0]->{userData} = { _whatToTrace => $_[0]->{REMOTE_USER}, };
|
|
},
|
|
);
|
|
has userData => ( is => 'rw', isa => 'HashRef', default => sub { {} } );
|
|
|
|
# Query parameters
|
|
has _params => ( is => 'rw', isa => 'HashRef', default => sub { {} } );
|
|
has QUERY_STRING => (
|
|
is => 'ro',
|
|
reader => 'query',
|
|
trigger => sub {
|
|
my $self = shift;
|
|
$self->{QUERY_STRING} = uri_unescape( $self->{QUERY_STRING} );
|
|
my @tmp =
|
|
$self->{QUERY_STRING}
|
|
? split /&/, $self->{QUERY_STRING}
|
|
: ();
|
|
foreach my $s (@tmp) {
|
|
if ( $s =~ /^(.+?)=(.+)$/ ) { $self->{_params}->{$1} = $2; }
|
|
else { $self->{_params}->{$s} = 1; }
|
|
}
|
|
},
|
|
);
|
|
|
|
sub params {
|
|
my ( $self, $key, $value ) = @_;
|
|
return $self->_params unless ($key);
|
|
$self->_params->{$key} = $value if ( defined $value );
|
|
return $self->_params->{$key};
|
|
}
|
|
|
|
# POST management
|
|
#
|
|
# When CONTENT_LENGTH is set, store body in memory in `body` key
|
|
has 'psgix.input.buffered' => ( is => 'ro', reader => '_psgixBuffered', );
|
|
has 'psgi.input' => ( is => 'ro', reader => '_psgiInput', );
|
|
has body => ( is => 'rw', isa => 'Str', default => '' );
|
|
has CONTENT_TYPE => ( is => 'ro', isa => 'Str', reader => 'contentType', );
|
|
has CONTENT_LENGTH => (
|
|
is => 'ro',
|
|
isa => 'Int',
|
|
reader => 'contentLength',
|
|
lazy => 1,
|
|
default => 0,
|
|
trigger => sub {
|
|
my $self = shift;
|
|
if ( $self->method eq 'GET' ) { $self->{body} = undef; }
|
|
elsif ( $self->method =~ /^(?:POST|PUT)$/ ) {
|
|
$self->{body} = '';
|
|
if ( $self->_psgixBuffered ) {
|
|
my $length = $self->{CONTENT_LENGTH};
|
|
while ( $length > 0 ) {
|
|
my $buffer;
|
|
$self->_psgiInput->read( $buffer,
|
|
( $length < 8192 ) ? $length : 8192 );
|
|
$length -= length($buffer);
|
|
$self->{body} .= $buffer;
|
|
}
|
|
}
|
|
else {
|
|
$self->_psgiInput->read( $self->{body},
|
|
$self->{CONTENT_LENGTH}, 0 );
|
|
}
|
|
utf8::upgrade( $self->{body} );
|
|
}
|
|
}
|
|
);
|
|
has error => ( is => 'rw', isa => 'Str', default => '' );
|
|
|
|
has respHeaders => ( is => 'rw', isa => 'HashRef' );
|
|
|
|
# JSON parser
|
|
sub jsonBodyToObj {
|
|
my $self = shift;
|
|
unless ( $self->contentType =~ /application\/json/ ) {
|
|
$self->error('Data is not JSON');
|
|
return undef;
|
|
}
|
|
unless ( $self->body ) {
|
|
$self->error('No data');
|
|
return undef;
|
|
}
|
|
return $self->body if ( ref( $self->body ) );
|
|
my $j = eval { from_json( $self->body ) };
|
|
if ($@) {
|
|
$self->error("$@$!");
|
|
return undef;
|
|
}
|
|
return $self->{body} = $j;
|
|
}
|
|
|
|
1;
|
|
__END__
|
|
|
|
=head1 NAME
|
|
|
|
=encoding utf8
|
|
|
|
Lemonldap::NG::Common::PSGI::Request - HTTP request object for Lemonldap::NG
|
|
PSGIs
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
package My::PSGI;
|
|
|
|
use base Lemonldap::NG::Common::PSGI;
|
|
|
|
# See Lemonldap::NG::Common::PSGI
|
|
...
|
|
|
|
sub router {
|
|
my ( $self, $req ) = @_;
|
|
# Do something and return a PSGI response
|
|
# NB: $req is a Lemonldap::NG::Common::PSGI::Request object
|
|
if ( $req->accept eq 'text/plain' ) { ... }
|
|
|
|
return [ 200, [ 'Content-Type' => 'text/plain' ], [ 'Body lines' ] ];
|
|
}
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
This package provides HTTP request objects used by Lemonldap::NG PSGIs. It
|
|
contains common accessors to work with request
|
|
|
|
=head1 METHODS
|
|
|
|
=head2 Accessors
|
|
|
|
=head3 accept
|
|
|
|
'Accept' header content.
|
|
|
|
=head3 encodings
|
|
|
|
'Accept-Encoding' header content.
|
|
|
|
=head3 languages
|
|
|
|
'Accept-Language header content.
|
|
|
|
=head3 cookies
|
|
|
|
'Cookie' header content.
|
|
|
|
=head3 hostname
|
|
|
|
'Host' header content.
|
|
|
|
=head3 remote_ip
|
|
|
|
Client IP address.
|
|
|
|
=head3 port
|
|
|
|
Client TCP port.
|
|
|
|
=head3 method
|
|
|
|
HTTP method asked by client (GET/POST/PUT/DELETE).
|
|
|
|
=head3 scriptname
|
|
|
|
SCRIPT_NAME environment variable provided by HTTP server.
|
|
|
|
=head3 get_server_port
|
|
|
|
Server port.
|
|
|
|
=head3 path
|
|
|
|
PATH_INFO content which has been substracted `scriptname`. So it's the relative
|
|
path_info for REST calls.
|
|
|
|
=head3 uri
|
|
|
|
REQUEST_URI environment variable.
|
|
|
|
=head3 unparsed_uri
|
|
|
|
Same as `uri` but without decoding.
|
|
|
|
=head3 user
|
|
|
|
REMOTE_USER environment variable. It contains username when a server authentication
|
|
is done.
|
|
|
|
=head3 userData
|
|
|
|
Hash reference to be used by Lemonldap::NG::Handler::PSGI. If a server authentication
|
|
is done, it contains:
|
|
|
|
{ _whatToTrace => `user()` }
|
|
|
|
=head3 params
|
|
|
|
GET parameters.
|
|
|
|
=head3 body
|
|
|
|
Content of POST requests
|
|
|
|
=head3 error
|
|
|
|
Set if an error occurs
|
|
|
|
=head3 contentType
|
|
|
|
Content type of posted datas.
|
|
|
|
=head3 contentLength
|
|
|
|
Length of posted datas.
|
|
|
|
=head2 Private accessors
|
|
|
|
=head3 _psgixBuffered
|
|
|
|
PSGI psgix.input.buffered variable.
|
|
|
|
=head3 _psgiInput
|
|
|
|
PSGI psgix.input variable.
|
|
|
|
=head2 Methods
|
|
|
|
=head3 jsonBodyToObj()
|
|
|
|
Get the content of a JSON POST request as Perl object.
|
|
|
|
=head1 SEE ALSO
|
|
|
|
L<http://lemonldap-ng.org/>, L<Lemonldap::NG::Portal>, L<Lemonldap::NG::Handler>,
|
|
L<Plack>, L<PSGI>, L<Lemonldap::NG::Common::PSGI>,
|
|
L<Lemonldap::NG::Common::PSGI::Router>, L<HTML::Template>,
|
|
|
|
=head1 AUTHORS
|
|
|
|
=over
|
|
|
|
=item Clement Oudot, E<lt>clem.oudot@gmail.comE<gt>
|
|
|
|
=item François-Xavier Deltombe, E<lt>fxdeltombe@gmail.com.E<gt>
|
|
|
|
=item Xavier Guimard, E<lt>x.guimard@free.frE<gt>
|
|
|
|
=item Thomas Chemineau, E<lt>thomas.chemineau@gmail.comE<gt>
|
|
|
|
=back
|
|
|
|
=head1 BUG REPORT
|
|
|
|
Use OW2 system to report bug or ask for features:
|
|
L<http://jira.ow2.org>
|
|
|
|
=head1 DOWNLOAD
|
|
|
|
Lemonldap::NG is available at
|
|
L<http://forge.objectweb.org/project/showfiles.php?group_id=274>
|
|
|
|
=head1 COPYRIGHT AND LICENSE
|
|
|
|
=over
|
|
|
|
=item Copyright (C) 2015-2016 by Xavier Guimard, E<lt>x.guimard@free.frE<gt>
|
|
|
|
=item Copyright (C) 2015-2016 by Clément Oudot, E<lt>clem.oudot@gmail.comE<gt>
|
|
|
|
=back
|
|
|
|
This library is free software; you can redistribute it and/or modify
|
|
it under the terms of the GNU General Public License as published by
|
|
the Free Software Foundation; either version 2, or (at your option)
|
|
any later version.
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
GNU General Public License for more details.
|
|
|
|
You should have received a copy of the GNU General Public License
|
|
along with this program. If not, see L<http://www.gnu.org/licenses/>.
|
|
|
|
=cut
|