^sub \w+\( results from the CPAN

^sub \w+\(
Net-Eboks
view release on metacpan or search on metacpan
use URI::Escape;
use HTTP::Request;
use HTTP::Request::Common;
use HTTP::Response;
use MIME::Base64 qw(encode_base64url);
use Digest::SHA qw(sha256);
use JSON::XS qw(decode_json encode_json);
use Net::Eboks;


$|++;

my $win32_install = (( $ARGV[0] // '' ) eq '--win32-install');
my $port = 9999;
my ($server, $error);
my ($state, $code_challenge, $code_verifier, $nonce);
my $ua = IO::Lambda::HTTP::UserAgent->new;
my $e  = Net::Eboks->new;

sub socket_check
{
	return IO::Socket::INET-> new(
		PeerAddr => '127.0.0.1',
		PeerPort => shift,
		Proto    => 'tcp',
	);
}

sub randstr($) { encode_base64url(join('', map { chr rand(255) } 1..$_[0])) }
sub init_oauth
{
	$state          = randstr(23);
	$nonce          = randstr(93);
	$code_verifier  = randstr(93);
	$code_challenge = encode_base64url(sha256($code_verifier));
}

sub mailcheck { '<p><a href="/testmail">Test MitDK login'.(($e->{cpr} =~ /^0+$/) ? '' : " for CPR $e->{cpr}").'</a>'  }
sub quit      { '<p><a href="/abort">Quit the wizard</a><p>' }
sub main      { '<p><a href="/">Go back to the start</a><p>' }

sub html($)
{
	my $html = $_[0];
	$html = "<html><body>$html</body></html>";
	HTTP::Response->new( 200, "OK", [
		'Content-Type'   => 'text/html',
		'Content-Length' => length($html),
	], $html)
}

sub pop3
{
	return IO::Socket::INET-> new(
		PeerAddr => '127.0.0.1',
		PeerPort => 8110,
		Proto    => 'tcp',
	);
}

sub h2($)      { html "<h2>$_[0]</h2>" . main . quit }
sub h2x($$)    { html "<h2>$_[0]</h2><p>$_[1]" . main . quit } 
sub error($)   { h2x( 'Error', $_[0] ) }

sub handle_saml
{
	my $resp = shift;

	return error "Cannot get MitID ticket's SAMLResponse" unless $resp->content =~ /name="(SAMLResponse)" value="(.*?)"/;
	my $saml = "$1=" . uri_escape($2);
	return error "Cannot get MitID ticket's RelayState" unless $resp->content =~ /name="(RelayState)" value="(.*?)"/;
	my $rest = "$1=" . uri_escape($2);

	$resp = $ua->request( HTTP::Request::Common::POST(
		'https://gateway.digitalpost.dk/auth/s9/e-boks-nemlogin/ssoack',
		Content => "$rest&$saml",
	))->wait;
	return error("MitID ticket is received but cannot login. Did you register at <a href='https://mit.dk'>Digital Post</a>?")
		unless ($resp->header('Location') // '') =~ m[(eboksdk://ngdpoidc/callback)\?.*code=([^\&]+)];

	my ( $uri, $code ) = ($1, $2);
	my $git_guardian_is_too_smart =
		'ZS1ib2tzLW1vYmls'.
		'ZTp5MHZLUktvVnZx'.
		'TyVOM0hCREswVDVi'.
		'Ynpxb19lWnNJMA';
	$resp = $ua->request( HTTP::Request::Common::POST(
		'https://digitalpost.dk/auth/oauth/token?'.
			'grant_type=authorization_code&'.
			"redirect_uri=$uri&".
			'client_id=e-boks-mobile&'.
			"code=$code&".
			"code_verifier=$code_verifier",
		Authorization => "Basic $git_guardian_is_too_smart==",
	))->wait;
	return error("MitID ticket is received but cannot authorize to Eboks") unless
		$resp->is_success && $resp->header('Content-Type') =~ m[application/json];
	my $json;
	eval { $json = decode_json( $resp->content ); };
	return error("Got bad response from Digitalpost") unless $json && $json->{access_token};

	my $bearer = $json->{access_token};
	$resp = $ua->request( HTTP::Request::Common::POST(
		'https://digitalpostproxy.e-boks.dk/loginservice/v2/connect/usertoken',
		'X-Operation-ID' => 'LoginService_UserToken',
		Authorization    => "Bearer $bearer",
		'Content-Type'   => 'application/json-patch+json',
	))->wait;
	return error("MitID ticket is received but cannot get login token") unless
		$resp->is_success && $resp->header('Content-Type') =~ m[application/json];
	undef $json;
	eval { $json = decode_json( $resp->content ); };
	return error("Got bad response from login service") unless $json && $json->{userToken};

	$resp = $ua->request( HTTP::Request::Common::POST(
		'https://oauth-dk.e-boks.com/1/connect/token', [
			usertoken     => $json->{userToken},
			grant_type    => 'usertoken',
			scope         => 'mobileapi offline_access',
			client_id     => 'MobileApp-Short-Custom-id',
			client_secret => ''.reverse('5FzjwwYeM6WNEamQ'),
( run in 1.570 second using v1.01-cache-2.11-cpan-13bb782fe5a )