/ 
OAuth-Lite-1.35
River stage one • 9 direct dependents • 9 total dependents
/ 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, $consumer_key) = @_;
    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, $callback_url) = @_;
    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   => '',
        callback     => $callback_url,
    });
    return $token;
}

sub publish_access_token {
    my ($self, $consumer_key, $request_token_string, $verifier) = @_;
    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
        &&  $request_token->has_verifier
        &&  $request_token->verifier eq $verifier) {
        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 = shift;
}

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, $consumer_key)

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, $callback_url)

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

publish_access_token($consumer_key, $request_token_string, $verifier)

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.

verify_requestor_approval($consumer_key, $requestor_id)

When the request is for OpenSocial Reverse Phone Home, Check if the requestor has already given approval to consumer to access the requestor's data.

service

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

sub service {
    my $self = shift;
    my $params = $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->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_method

Request method (Upper Case). When the raw request method is POST and X-HTTP-Method-Override is define in header, return the value of X-HTTP-Method-Override.

request_uri

Returns request uri

request_body

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

set_authenticate_header

Set proper 'WWW-Authentication' response header

is_required_request_token

Check if current request requires request-token.

is_required_access_token

Check if current request requires access-token.

is_required_protected_resource

Check if current request requires protected-resource.

is_consumer_request

Chekc if the server accepts consumer-request and the request is for protected resource without token.

is_reverse_phone_home

Check if the server accepts open-social reverse-phone-home and the requests is for protected resource without token.

xrds_location

If you want to support OAuth Discovery, you need to prepare XRDS document, and set the location as XRDSLocation value. See below.

<Location /resource>
PerlSetVar Mode PROTECTED_RESOURCE
PerlSetVar XRDSLocation "http://myservice/discovery/xrdsdocument"
PerlResponseHandler MyServiceWithOAuth
</Location>

Then you can get this url in your script.

sub service {
  my $self = shift;
  my $xrds_location = $self->xrds_location;
}

But normalry all you have to do is write location on httpd.conf. And "errout" method automatically put it into response header properly.

build_xrds

In case client send request which includes application/xrds+xml in Accept header, if The server is set XRDSLocation as above, return resuponse with it in header. But you can also directly return XRDS-Document.

Override build_xrds document.

sub build_xrds {
  my $self = shift;
  my $xrds = q{
    <?xml version="1.0" encoding="UTF-8"?>
    <XRDS xmlns="xri://$xrds">
    ...
    </XRDS>
  };
  return $xrds;
}

If the server doesn't support both XRDSLocation and build_xrds overriding, The server doesn't support OAuth Discovery.

accepts_consumer_request

You can adopt OAuth Consumer Request 1.0.

See http://oauth.googlecode.com/svn/spec/ext/consumer_request/1.0/drafts/1/spec.html

To adopt this spec, you have to set var 'AcceptConsumerRequest' on httpd.conf

<Location /resource>
PerlSetVar Mode PROTECTED_RESOURCE
PerlSetVar AcceptConsumerRequest 1
PerlResponseHandler MyServiceWithOAuth
</Location>

Then override service method for protected resource.

	sub service {
		my $self = shift;
        my $params = $self->{params};

		my $resource_owner_id;

		if (exists $params->{oauth_token}) {

			my $access_token_value = $params->{oauth_token};
			$resource_owner_id = $self->get_user_id_of_access_token($access_token_value);

		} else {

			my $consumer_key = $params->{oauth_consumer_key};
			$resource_owner_id = $self->get_user_id_of_consumer_developer($consumer_key);

		}

		my @resources = MyDB::Scheme->resultset('SomeResource')->search({
				user_id => $resource_owner_id,	
		});

		# output resource data in the manner your api defines.
		...

		return Apache2::Const::OK;

	}

accepts_reverse_phone_home

You can adopt OpenSocial Reverse Phone Home.

<Location /resource>
PerlSetVar Mode PROTECTED_RESOURCE
PerlSetVar AcceptReversePhoneHome 1
PerlResponseHandler MyServiceWithOAuth
</Location>

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);
}

output(%params)

Simply output response. You can set 3 params, code, type and content.

return $self->output(
    code    => 200,
    type    => 'text/plain; charset=utf-8'
    content => 'success',
);

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.