https://github.com/ap/net-oauth2server-oidc

An OpenID Connect server on top of Net::OAuth2Server
https://github.com/ap/net-oauth2server-oidc

oauth2 oidc open-id-connect openid-connect openidconnect perl

Last synced: 1 day ago
JSON representation

An OpenID Connect server on top of Net::OAuth2Server

• Host: GitHub
• URL: https://github.com/ap/net-oauth2server-oidc
• Owner: ap
• Created: 2020-05-30T16:43:36.000Z (over 4 years ago)
• Default Branch: master
• Last Pushed: 2022-08-09T21:38:22.000Z (over 2 years ago)
• Last Synced: 2024-11-06T03:03:57.962Z (about 2 months ago)
• Topics: oauth2, oidc, open-id-connect, openid-connect, openidconnect, perl
• Language: Perl
• Homepage: https://metacpan.org/release/Net-OAuth2Server-OIDC
• Size: 18.6 KB
• Stars: 1
• Watchers: 3
• Forks: 0
• Open Issues: 0
• Metadata Files:
  • Readme: README.pod
  • Changelog: Changes

Awesome Lists containing this project

README

        
use strict; use warnings;

package Net::OAuth2Server::OIDC;

our $VERSION = '0.006';

package Net::OAuth2Server::Request::Authorization::Role::OIDC;

our $VERSION = '0.006';

use Role::Tiny;

use Class::Method::Modifiers 'fresh';

sub fresh__response_type_requiring_nonce { qw( token id_token ) }

sub fresh__valid_parameter_values { (

	display => [qw( page popup touch wap )],

	prompt  => [qw( none login consent select_account )],

) }

fresh response_type_requiring_nonce => \&fresh__response_type_requiring_nonce;

fresh valid_parameter_values => \&fresh__valid_parameter_values;

undef *fresh__response_type_requiring_nonce;

undef *fresh__valid_parameter_values;

sub around__new {

	my $orig = shift;

	my $class = shift;

	my $self = $class->$orig( @_ );

	return $self if $self->error;

	if ( $self->scope->contains( 'openid' ) ) {

		return $self->set_error_invalid_request( 'missing parameter: nonce' )

			if ( not defined $self->param('nonce') )

			and $self->response_type->contains( $self->response_type_requiring_nonce );

		my %validate = $self->valid_parameter_values;

		my @invalid = sort grep {

			my $name = $_;

			my $value = $self->param( $name );

			defined $value and not grep $value eq $_, @{ $validate{ $name } };

		} keys %validate;

		return $self->set_error_invalid_request( "invalid value for parameter: @invalid" ) if @invalid;

	}

	else {

		return $self->set_error_invalid_request( 'id_token requested outside of openid scope' )

			if $self->response_type->contains( 'id_token' );

	}

	$self;

}

around 'new' => \&around__new;

undef *around__new;

package Net::OAuth2Server::Response::Role::OIDC;

our $VERSION = '0.006';

use Role::Tiny;

use Class::Method::Modifiers 'fresh';

use MIME::Base64 ();

use JSON::WebToken ();

use Digest::SHA ();

use Carp ();

# copy-paste from newer MIME::Base64 for older versions without it

my $b64url_enc = MIME::Base64->can( 'encode_base64url' ) || sub {

	my $e = MIME::Base64::encode_base64( shift, '' );

	$e =~ s/=+\z//;

	$e =~ tr[+/][-_];

	return $e;

};

sub fresh__supported_response_types { qw( code id_token token ) }

fresh supported_response_types => \&fresh__supported_response_types;

undef *fresh__supported_response_types;

sub around__for_authorization {

	my $orig = shift;

	my ( $class, $req, $grant ) = ( shift, @_ );

	my $self = $class->$orig( @_ );

	return $self if $self->is_error or not $grant;

	$grant->create_id_token( $self, 1 ) if $req->response_type->contains( 'id_token' );

	$self;

}

around for_authorization => \&around__for_authorization;

undef *around__for_authorization;

sub around__for_token {

	my $orig = shift;

	my ( $class, $req, $grant ) = ( shift, @_ );

	my $self = $class->$orig( @_ );

	return $self if $self->is_error or not $grant;

	$grant->create_id_token( $self, 0 ) if $grant->scope->contains( 'openid' );

	$self;

}

around for_token => \&around__for_token;

undef *around__for_token;

my %hashed = qw( code c_hash access_token at_hash );

sub fresh__add_id_token {

	my ( $self, $nonce, $pay, $head, $key ) = ( shift, @_ );

	Carp::croak 'missing payload' unless $pay;

	Carp::croak 'header and payload must be hashes' if grep 'HASH' ne ref, $pay, $head || ();

	$pay->{'nonce'} = $nonce if $nonce;

	my $alg = ( $head && $head->{'alg'} ) || 'none';

	if ( $alg =~ /\A[A-Za-z]{2}([0-9]+)\z/ ) {

		my $sha = Digest::SHA->new( "$1" );

		while ( my ( $k, $k_hash ) = each %hashed ) {

			next unless $self->has_param( $k );

			my $digest = $sha->reset->add( $self->param( $k ) )->digest;

			$pay->{ $k_hash } = $b64url_enc->( substr $digest, 0, length( $digest ) / 2 );

		}

	}

	$self->add_token( id_token => JSON::WebToken->encode( $pay, $key, $alg, $head ) );

}

fresh add_id_token => \&fresh__add_id_token;

undef *fresh__add_id_token;

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Net::OAuth2Server::OIDC - An OpenID Connect server on top of Net::OAuth2Server

=head1 DISCLAIMER

B

For that reason, no documentation is provided.


=head1 DESCRIPTION

A usable but tiny implementation of OpenID Connect.

This is also a demonstration of the L design.

=head1 SEE ALSO

This is a very distant descendant of the server portion of L.

=cut