The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
 / 
OAuth-Lite-1.03
River stage one • 9 direct dependents • 9 total dependents
2 ++
/ OAuth::Lite::Server::mod_perl2

NAME

OAuth::Lite::Server::mod_perl2 - mod_perl2 OAuth server

SYNOPSIS

Inherit this class, build your service with mod_perl2. For example, write MyServiceWithOAuth.pm And the source-code of OAuth::Lite::Server::Test::Echo is nice example. See it.

    package MyServiceWithOAuth;
    use base 'OAuth::Lite::Server::mod_perl2';

    sub init {
        my $self = shift;
        $self->oauth->allow_extra_params(qw/file size/);
        $self->oauth->support_signature_methods(qw/HMAC-SHA1 PLAINTEXT/);
    }

    sub get_request_token_secret {
        my ($self, $token_string) = @_;
        my $token = MyDB::Scheme->resultset('RequestToken')->find($token_string);
        unless ($token
            &&  $token->is_authorized_by_user
            &&  !$token->is_exchanged_to_access_token
            &&  !$token->is_expired) {
            return $self->error(q{Invalid token});
        }
        return $token->secret; 
    }

    sub get_access_token_secret {
        my ($self, $token_string) = @_;
        my $token = MyDB::Scheme->resultset('AccessToken')->find($token_string);
        unless ($token
            && !$token->is_expired) {
            return $self->error(q{Invalid token});
        }
        return $token->secret; 
    }

    sub get_consumer_secret {
        my ($self, $consumer_key) = @_;
        my $consumer = MyDB::Shceme->resultset('Consumer')->find($consumer_key);
        unless ($consumer
             && $consumer->is_valid) {
            return $self->error(q{Inalid consumer_key});
        }
        return $consumer->secret;
    }

    sub publish_request_token {
        my ($self, $consumer_key) = @_;
        my $token = OAuth::Lite::Token->new_random;
        MyDB::Scheme->resultset('RequestToken')->create({
            token        => $token->token,
            secret       => $token->secret,
            realm        => $self->realm,
            consumer_key => $consumer_key,
            expired_on   => '',
        });
        return $token;
    }

    sub publish_access_token {
        my ($self, $consumer_key, $request_token_string) = @_;
        my $request_token = MyDB::Scheme->resultset('RequestToken')->find($request_Token_string);
        unless ($request_token
            &&  $request_token->is_authorized_by_user
            && !$request_token->is_exchanged_to_access_token
            && !$request_token->is_expired) {
            return $self->error(q{Invalid token});
        }
        my $access_token = OAuth::Lite::Token->new_random;
        MyDB::Scheme->resultset('AccessToken')->create({
            token        => $request_token->token, 
            realm        => $self->realm,
            secret       => $request_token->secret,
            consumer_key => $consumer_key,
            author       => $request_token->author,
            expired_on   => '',
        });

        $request_token->is_exchanged_to_access_token(1);
        $request_token->update();

        return $access_token;
    }

    sub check_nonce_and_timestamp {
        my ($self, $consumer_key, $nonce, $timestamp) = @_;
        my $request_log = MyDB::Scheme->resultset('RequestLog');
        # check against replay-attack
        my $count = $request_log->count({
            consumer_key => $consumer_key,
            -nest => [
                nonce     => $nonce,
                timestamp => { '>' => $timestamp }, 
            ], 
        });
        if ($count > 0) {
            return $self->error(q{Invalid timestamp or consumer});
        }
        # save new request log.
        $request_log->create({
            consumer_key => $consumer_key,
            nonce        => $nonce,
            timestamp    => $timestamp,
        });
        return 1;
    }

    sub service {
        my ($self, $params) = @_;
    }

in httpd.conf

    PerlSwitches -I/var/www/MyApp/lib
    PerlModule MyServiceWithOAuth

    <VirtualHost *>

        ServerName api.example.com
        DocumentRoot /var/www/MyApp/root

        PerlSetVar Realm "http://api.example.com/picture"

        <Location /picture/request_token>
            SetHandler perl-script
            PerlSetVar Mode REQUEST_TOKEN
            PerlResponseHandler MyServiceWithOAuth
        </Location>

        <Location /picture/access_token>
            SetHandler perl-script
            PerlSetVar Mode ACCESS_TOKEN
            PerlResponseHandler MyServiceWithOAuth
        </Location>

        <Location /picture/resource>
            SetHandler perl-script
            PerlSetVar Mode PROTECTED_RESOURCE
            PerlResponseHandler MyServiceWithOAuth
        </Location>

    </VirtualHost>

DESCRIPTION

This module is for mod_perl2 PerlResponseHandler, and allows you to build services with OAuth easily.

TUTORIAL

All you have to do is to make a package inheritting this module, and override some methods, and in httpd.conf file, write three configuration, each configuration needs to be set Mode value. The each value must be REQUEST_TOKEN, ACCESS_TOKEN, or PROTECTED_RESOURCE. And the Realm value is needed for each resource.

The methods you have to override is bellow.

METHODS YOU HAVE TO OVERRIDE

init

In this method, you can do some initialization. For example, set what signature method your service supports, and what extra-param is allowed.

    sub init {
        my $self = shift;
        $self->oauth->support_signature_method(qw/HMAC-SHA1 PLAINTEXT/);
        $self->oauth->allow_extra_params(qw/file size/);
    }

get_request_token_secret($token_string)

In this method, you should check if the request-token-string is valid, and returns token-secret value corresponds to the token value passed as argument. If the token is invalid, you should call 'error' method.

get_access_token_secret($token_string)

In this method, you should check if the access-token-string is valid, and returns token-secret value corresponds to the token value passed as argument. If the token is invalid, you should call 'error' method.

get_consumer_secret($consumer_key)

In this method, you should check if the consumer_key is valid, and returns consumer_secret value corresponds to the consumer_key passed as argument. If the consumer is invalid, you should call 'error' method.

check_nonce_and_timestamp($consumer_key, $nonce, $timestamp)

Check passed nonce and timestamp. Among requests the consumer send service-provider, there shouldn't be same nonce, and new timestamp should be greater than old ones. If they are valid, returns 1, or returns 0.

publish_request_token($consumer_key)

Create new request-token, and save it, and returns it as OAuth::Lite::Token object.

publish_access_token($consumer_key, $request_token_string)

If the passed request-token is valid, create new access-token, and save it, and returns it as OAuth::Lite::Token object. And disables the exchanged request-token.

service($params)

Handle protected resource. This method should returns Apache2::Const::OK.

    sub service {
        my ($self, $params) = @_;
        my $token_string = $params->{oauth_token};
        my $access_token = MyDB::Scheme->resultset('RequestToken')->find($token_string);
        my $user = $access_token->author;

        my $resource = $user->get_my_some_resource();

        $self->request->status(200);
        $self->set_authenticate_header();
        $self->request->content_type(q{text/html; charset=utf-8});
        $self->print($resource);
        return Apache2::Const::OK;
    }

API

handler

Trigger method as response handler.

new

Constructor

request

Returns Apache request object. See Apache2::RequestRec, Apache2::RequestIO, and etc...

    $self->request;

realm

The realm value you set in httpd.conf by PerlSetVar.

oauth

Returns l<OAuth::Lite::ServerUtil> object.

allow_extra_param

allow_extra_params

support_signature_method

support_signature_methods

These methods are just only delegate methods. For example,

    $self->allow_extra_param('foo');

is same as

    $self->oauth->allow_extra_param('foo');

request_body

Requets body data when the request's http-method is POST or PUT

set_authenticate_header

Set proper 'WWW-Authentication' response header

error

Class::ErrorHandler method. In some check-method, when you find invalid request value, call this method with error message and return it.

    sub check_nonce_and_timestamp {
        my ($self, $consumer_key, $nonce, $timestamp) = @_;
        if ($timestamp ...) {
            return $self->error(q{Invalid timestamp});
        }
        return 1;
    }

errstr

Class::ErrorHandler method. You can get error message that you set with error method.

    my $valid = $self->check_nonce_and_timestamp($consumer_key, $nonce, $timestamp);
    if (!$valid) {
        return $self->errout(401, $self->errstr);
    }

errout($code, $message)

Output error message. This returns Apache2::Const::OK, so, don't forget 'return';

    return $self->errout(400, q{Bad request});

And you can override this and put some function into this process. For example, logging.

    sub errout {
        my ($self, $code, $message) = @_;
        $self->my_log_process($code, $message);
        return $self->SUPER::errout($code, $message);
    }

    sub my_log_process {
        my ($self, $code, $message) = @_;
        warn ...
    }

SEE ALSO

OAuth::Lite::ServerUtil OAuth::Lite::Server::Test::Echo

AUTHOR

Lyo Kato, lyo.kato _at_ gmail.com

COPYRIGHT AND LICENSE

This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.6 or, at your option, any later version of Perl 5 you may have available.