File Coverage

lib/OAuthomatic/Internal/MicroWeb.pm

Criterion	Covered	Total	%
statement	4	6	66.6
branch			n/a
condition			n/a
subroutine	2	2	100.0
pod			n/a
total	6	8	75.0

package OAuthomatic::Internal::MicroWeb;
# ABSTRACT: temporary embedded web server used internally


use namespace::sweep;
use Moose;
use MooseX::AttributeShortcuts;
use MooseX::Types::Path::Tiny qw/AbsDir AbsPath/;
use Path::Tiny qw/path/;
use threads;
use Thread::Queue;
use HTTP::Server::Brick;
use HTTP::Status;
use IO::Null;
use URI;
use URI::QueryParam;
use Template;
use Carp;
use Const::Fast;
use OAuthomatic::Internal::Util;
use OAuthomatic::Error;

const my $THREAD_START_TIMEOUT => 10;
const my $FORM_FILL_WARNING_TIMEOUT => 1 * 60;


has 'config' => (
    is => 'ro', isa => 'OAuthomatic::Config', required => 1,
    handles=>[ 'app_name', 'html_dir', 'debug' ]);


has 'server' => (
    is => 'ro', isa => 'OAuthomatic::Server', required => 1,
    handles => [
        'site_name',
        'site_client_creation_page',
        'site_client_creation_desc',
        'site_client_creation_help',
       ]);


has 'port' => (
    is=>'lazy', isa=>'Int', required=>1, default => sub {
        require Net::EmptyPort;
        return Net::EmptyPort::empty_port();
    });


has 'template_dir' => (
    is=>'lazy', isa=>AbsDir, required=>1, coerce=>1, default=>sub {
        return $_[0]->html_dir->child("templates");
    });


has 'static_dir' => (
    is=>'lazy', isa=>AbsDir, required=>1, coerce=>1, default=>sub {
        return $_[0]->html_dir->child("static");
    });


has 'verbose' => (is=>'ro', isa=>'Bool');


has 'callback_path' => (is=>'ro', isa=>'Str', default=>sub {"/oauth_granted"});


has 'client_key_path' => (is=>'ro', isa=>'Str', default=>sub {"/client_key"});

has 'root_url' => (is=>'lazy', default=>sub{ "http://localhost:". $_[0]->port });
has 'callback_url' => (is=>'lazy', default=>sub{ $_[0]->root_url . $_[0]->callback_path });
has 'client_key_url' => (is=>'lazy', default=>sub{ $_[0]->root_url . $_[0]->client_key_path });

has '_oauth_queue' => (is=>'ro', builder=>sub{Thread::Queue->new()});
has '_client_key_queue' => (is=>'ro', builder=>sub{Thread::Queue->new()});

has '_brick' => (is=>'lazy');

has '_template' => (is=>'lazy');

has 'is_running' => (is => 'rwp', isa => 'Bool');


sub start {
    my $self = shift;

    OAuthomatic::Error::Generic->throw(
        ident => "Server is already running")
        if $self->is_running;

    my $brick = $self->_brick;
    my $static_dir = $self->static_dir;
    my $callback_path = $self->callback_path
      or OAuthomatic::Error::Generic->throw(
          ident => "No callback_path");
    my $client_key_path = $self->client_key_path
      or OAuthomatic::Error::Generic->throw(
          ident => "No client_key_path");
    my $tt =  $self->_template;
    my $oauth_queue = $self->_oauth_queue;
    my $client_key_queue = $self->_client_key_queue;

    print "[OAuthomatic] Spawning embedded web server thread\n";

    $self->{thread} = threads->create(
        sub {
            my ($brick, $static_dir, $callback_path, $client_key_path, $tt,
                $oauth_queue, $client_key_queue) = @_;

            $brick->mount($callback_path => {
                handler => sub {
                    _handle_oauth_request($oauth_queue, $tt, @_);
                    return RC_OK;
                },
                wildcard => 1, # let's treat longer urls as erroneous replies
            });
            $brick->mount($client_key_path => {
                handler => sub {
                    _handle_client_key_request($client_key_queue, $tt, @_);
                    return RC_OK;
                },
            });
            $brick->mount("/favicon.ico" => {
                handler => sub { return RC_NOT_FOUND; },
            });
            $brick->mount("/static" => {
                path => $static_dir,
            });
            $brick->mount( '/' => {
                handler => sub {
                    _handle_generic_request($tt, @_);
                    return RC_NOT_FOUND;
                },
                wildcard => 1,
            });

            print "[OAuthomatic] Embedded web server listens to requests\n";

            # Signalling we started. This queue is as good as any
            $oauth_queue->enqueue({"started" => 1});

            $brick->start();
        },
        $brick, $static_dir, $callback_path, $client_key_path, $tt,
        $oauth_queue, $client_key_queue);

    # Reading start signal
    $oauth_queue->dequeue_timed($THREAD_START_TIMEOUT)
      or OAuthomatic::Error::Generic->throw(
          ident => "Failed to start embedded web",
          extra => "Failed to receive completion info in $THREAD_START_TIMEOUT seconds. Is system heavily overloaded?");

    $self->_set_is_running(1);
}


sub stop {
    my $self = shift;

    print "[OAuthomatic] Shutting down embedded web server\n";

    $self->{thread}->kill('HUP');
    $self->{thread}->join;

    $self->_set_is_running(0);
}

has '_usage_counter' => (is=>'rw', isa=>'Int', default=>0);


sub start_using {
    my $self = shift;
    $self->start unless $self->is_running;
    $self->_usage_counter($self->_usage_counter + 1);
}


sub finish_using {
    my $self = shift;
    my $counter = $self->_usage_counter - 1;
    $self->_usage_counter($counter);
    if($counter <= 0 && $self->is_running) {
        $self->stop;
    }
}



sub wait_for_oauth_grant {
    my $self = shift;
    my $reply;
    while(1) {
        $reply = $self->_oauth_queue->dequeue_timed($FORM_FILL_WARNING_TIMEOUT);
        last if $reply;
        print "Callback still not received. Please, accept the authorization in the browser (or Ctrl-C me if you changed your mind)\n";
    }

    unless($reply->{verifier}) {

        # FIXME: provide http request

        if($reply->{oauth_problem}) {
            OAuthomatic::Error::Generic->throw(
                ident => "OAuth access rejected",
                extra => "Attempt to get OAuth authorization was rejected. Error code: $reply->{oauth_problem}",
               );
        } else {
            OAuthomatic::Error::Generic->throw(
                ident => "Invalid OAuth callback",
                extra => "Failed to read verifier. Most likely this means some error/omission in OAuthomatic code.\nI am so sorry...\n");
        }
    }

    return unless %$reply;
    return OAuthomatic::Types::Verifier->new($reply);
}


sub wait_for_client_cred {
    my $self = shift;
    my $reply;
    while(1) {
        $reply = $self->_client_key_queue->dequeue_timed($FORM_FILL_WARNING_TIMEOUT);
        last if $reply;
        print "Form  still not filled. Please, fill the form shown (or Ctrl-C me if you changed your mind)\n";
    }
    return unless %$reply;
    return return OAuthomatic::Types::ClientCred->new(
        data => $reply,
        remap => {"client_key" => "key", "client_secret" => "secret"});
}

sub _build__brick {
    my $self = shift;
    my @args = (port => $self->port);
    unless($self->verbose) {
        my $null = IO::Null->new;
        push @args, (error_log => $null, access_log => $null);
    }
    my $brick = HTTP::Server::Brick->new(@args);
    # URLs are mounted in start, to make it clear which thread references which
    # variables.
    return $brick;
}

sub _build__template {
    my $self = shift;

    my $tt_vars  = {
        app_name => $self->app_name,
        site_name => $self->site_name,
        site_client_creation_page => $self->site_client_creation_page,
        site_client_creation_desc => $self->site_client_creation_desc,
        site_client_creation_help => $self->site_client_creation_help,
        static_dir => $self->static_dir,
       };

    my $tt = Template->new({
        INCLUDE_PATH=>[$self->template_dir, $self->static_dir],
        VARIABLES=>$tt_vars,
        ($self->debug ? (CACHE_SIZE => 0) : ()),  # Disable caching during tests
        # STRICT=>1,
    }) or die "Failed to setup templates: $Template::ERROR\n";

    return $tt;
}

###########################################################################
# Methods below are called in worker thread
###########################################################################

sub _render_template {
    my ($resp, $tt, $template_name, $tt_par) = @_;

    unless( $tt->process($template_name,
                         $tt_par,
                         sub { $resp->add_content(@_); }) ) {
        my $err = $tt->error();
        # use Data::Dumper; print Dumper($err); print Dumper($err->info); print Dumper($err->type); print $err->as_string();
        use Data::Dumper; print Dumper($err->info);
        OAuthomatic::Error::Generic->throw(
            ident => "Template error",
            extra => $err->as_string());
    }
}

sub _handle_oauth_request {
    my ($queue, $tt, $req, $resp) = @_;

    my $params = $req->uri->query_form_hash();   # URI::QueryParam

    #if($self->debug) {
    #    use Data::Dumper;
    #    print "Parameters obtained in callback: ", Dumper($params);
    #}

    my $verifier = $params->{'oauth_verifier'};
    my $token = $params->{'oauth_token'};

    my $reply = {};
    my $template_name;


    if ($verifier && $token) {
        $reply = {
            verifier => $verifier,
            token => $token,
        };
        $template_name = "oauth_granted.thtml";
    } else {
        my $oauth_problem = $params->{'oauth_problem'} || '';
        $reply->{oauth_problem} = $oauth_problem if $oauth_problem;
        if($oauth_problem eq 'user_refused') {
            $template_name = "oauth_rejected.thtml";
        } else {
            $template_name = "oauth_bad_request.thtml";
        }
    }

    $resp->code(200);
    _render_template($resp, $tt, $template_name, $reply);

    $queue->enqueue($reply);
}

sub _handle_client_key_request {
    my ($queue, $tt, $req, $resp) = @_;

    $resp->code(200);

    unless($req->method eq 'POST') {
        # Just show input form
        _render_template($resp, $tt, "client_key_entry.thtml", {});
    } else {
        my $params = parse_httpmsg_form($req) || {};

        my %values;
        my %errors;
        # Validation
        foreach my $pname (qw(client_key client_secret)) {
            my $value = $params->{$pname};
            # Strip leading and final spaces (possible copy&paste)
            $value =~ s/^[\s\r\n]+//x;
            $value =~ s/[\s\r\n]+$//x;
            unless($value) {
                $errors{$pname} = "Missing value.";
            } elsif ($value !~ /^\S{10,1000}$/x) {
                $errors{$pname} = "Invalid value (suspiciously short, too long, or contaning invalid characters)";
            }
            $values{$pname} = $value;
        }

        unless(%errors) {
            _render_template($resp, $tt, "client_key_submitted.thtml", {});
            $queue->enqueue(\%values);
        } else {
            # Redisplay
            _render_template($resp, $tt, "client_key_entry.thtml", {
                errors_found => 1,
                error => \%errors,
                value => \%values  });
        }
    }

}

sub _handle_generic_request {
    my ($tt, $req, $resp) = @_;

    $resp->code(200);
    _render_template($resp, $tt, "default.thtml", {});
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

OAuthomatic::Internal::MicroWeb - temporary embedded web server used internally

=head1 VERSION

version 0.01

=head1 DESCRIPTION

Utility class used internally by OAuthomatic: temporary web server
spawned in separate thread, used to receive final redirect of OAuth
sequence, and to present additional pages to the user.

This module provides both implementation of this server, and methods
to communicate with it.

=head1 PARAMETERS

=head2 port

Port the helper runs at. By default allocated randomly.

=head2 template_dir

Directory containing page templates. By default, use templates
provided with OAuthomatic (according to C<html_dir> param).

=head2 static_dir

Directory containing static files referenced by templates. By default,
use templates provided with OAuthomatic (according to C<html_dir>
param).

=head2 verbose

Enable console logging of web server interactions.

=head2 callback_path

URL path used in OAuth callback (/oauth_granted by default).

=head2 callback_path

URL path used in user interactions (/client_key by default).

=head1 METHODS

=head2 start

Start embedded web server. To be called (from main thread) before any ineractions begin.

=head2 stop

Stop embedded web server. To be called (from main thread) after OAuth is properly configured.

=head2 start_using

Starts if not yet running. Increases usage counter.

=head2 finish_using

Decreass usage counter. Stops if it tropped to 0.

=head2 wait_for_oauth_grant

Wait until OAuth post-rights-grant callback arrives and return tokens it provided.
Blocks until then. Throws proper error if failed.

To be called from the main thread.

=head2 wait_for_client_cred

Wait until user entered application tokens. Blocks until then.

To be called from the main thread.

=head1 ATTRIBUTES

=head2 config

L<OAuthomatic::Config> object used to bundle various configuration params.

=head2 server

L<OAuthomatic::Server> object used to bundle server-related configuration params.

=head1 AUTHOR

Marcin Kasperski <[e-mail]>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2015 by Marcin Kasperski.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut