view release on metacpan or  search on metacpan

lib/App/MFILE/WWW/Resource.pm  view on Meta::CPAN

        $r .= 'sessionLastSeen: \'' . ( exists $self->session->{'last_seen'} ? $self->session->{'last_seen'} : 'never' ) . '\',';
    }

    # REST server URI
    if ( defined( $site->DOCHAZKA_WWW_BACKEND_URI ) ) {
        $r .= 'restURI: \'' . $site->DOCHAZKA_WWW_BACKEND_URI . '\',';
    }

    # dummyParam in last position so we don't have to worry about comma/no comma
    $r .= 'dummyParam: null,';

    # unit tests running?
    $r .= "testing: " . ( $testing ? 'true' : 'false' );

    $r .= '} } });';
    $r .= '</script>';
    return $r;
} 


=head2 login_status

Once the username and password are known (either from C<process_post> via the
login AJAX request generated by the login dialog, or from the site
configuration via the MFILE_WWW_BYPASS_LOGIN_DIALOG mechanism), the
C<validate_user_credentials> method is called. That method is implemented by
the derived application, so it can validate user credentials however it likes.
The C<validate_user_credentials> method is then expected to call this method -
C<login_status> - to generate a status object from the results of the user
credentials validation.

Now, C<App::MFILE::WWW> does expect the C<validate_user_credentials> method to
provide the results of user credentials validation in a peculiar format,
hinging on the argument C<$code>, where a value of 200 indicates successful
validation and any other value indicates a failure.

=cut

sub login_status {
    my ( $self, $code, $message, $body_json ) = @_;

    my $status;

    if ( $code == 200 ) {
        $self->session->{'ip_addr'} = $self->remote_addr;
        my $cu = $body_json->{'payload'}->{'emp'};
        delete $cu->{'passhash'};
        delete $cu->{'salt'};
        $self->session->{'currentUser'} = $cu;
        $self->session->{'currentUserPriv'} = $body_json->{'payload'}->{'priv'};
        $self->session->{'last_seen'} = time;
        $log->debug(
            "Login successful, currentUser is now " .
            Dumper( $body_json->{'payload'}->{'emp'} ) .
            " and privilege level is " . $body_json->{'payload'}->{'priv'}
        );
        $status = $CELL->status_ok( 'MFILE_WWW_LOGIN_OK', payload => $body_json->{'payload'} );
    } else {
        $self->session({});
        $log->debug( "Login unsuccessful, reset session" );
        $status = $CELL->status_not_ok(
            'MFILE_WWW_LOGIN_FAIL: %s',
            args => [ $code ],
            payload => { code => $code, message => $message },
        );
    }
    $self->response->header( 'Content-Type' => 'application/json' );
    $self->response->body( to_json( $status->expurgate ) );
    return $status;
}


=head2 ua

Returns the LWP::UserAgent object obtained from the lookup table.
Creates it first if necessary.

=cut

sub ua {
    my $self = shift;
    $log->debug( "Entering " . __PACKAGE__ . "::ua()" );
    my $id = $self->session_id;
    $log->debug( "ua: session_id is $id" );

    # already in lookup table
    if ( exists $ualt->{$id} ) {
         $log->debug( "Session $id already has a LWP::UserAgent object" );
         return $ualt->{$id};
    }

    # not in lookup table yet
    my $tf = "";
    ( undef, $tf ) = tempfile();
    $ualt->{$id} = LWP::UserAgent->new;
    $ualt->{$id}->cookie_jar({ file => $tf });
    $log->info("New user agent created with cookies in $tf");
    return $ualt->{$id};
}


=head2 rest_req

Algorithm: send request to REST server, get JSON response, decode it, return
it.

Takes a single _mandatory_ parameter: a LWP::UserAgent object

Optionally takes PARAMHASH:

    server => [URI OF REST SERVER]         default is 'http://0:5000'
    method => [HTTP METHOD TO USE]         default is 'GET'
    nick => [NICK FOR BASIC AUTH]          optional
    password => [PASSWORD FOR BASIC AUTH]  optional
    path => [PATH OF REST RESOURCE]        default is '/'
    req_body => [HASHREF]                  optional

Returns HASHREF containing:

    hr => HTTP::Response object (stripped of the body)
    body => [BODY OF HTTP RESPONSE, IF ANY]