^sub \w+\( results from the CPAN

Net-MitDK
use JSON::XS qw(decode_json);
use Net::MitDK;


$|++;

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

unless ( defined $profile ) {
	print "Creating default profile...";
	$profile = 'default';
	my ( $ok, $error ) = $mgr->create($profile);
	if ( $ok ) {
		print "ok\n";
	} else {
		print "error: $error\n";
		exit 1;
	}
}

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 setfrom   { '<p><a href="/setfrom">Set "From:" email address</a>'  }
sub mailcheck { '<p><a href="/testmail">Test MitDK login</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 profile   { '<p><a href="/profile">Change profile (' . $profile . ')</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 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 NemID ticket" unless $resp->content =~ /name="(SAMLResponse)" value="(.*?)"/;
	my $saml = "$1=" . uri_escape($2);

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

	$resp = $ua->request( HTTP::Request::Common::POST(
		'https://gateway.mit.dk/view/client/authorization/token?'.
			'grant_type=authorization_code&'.
			"redirect_uri=$1&".
			'client_id=view-client-id-mobile-prod-1-id&'.
			"code=$2&".
			"code_verifier=$code_verifier"
		))->wait;
	return error("NemID ticket is received but cannot authorize to MitDK") unless
		$resp->is_success && $resp->header('Content-Type') eq 'application/json';

	my $json;
	eval { $json = decode_json( $resp->content ); };
	return error("Got bad response from MitDK") unless $json && $json->{access_token};

	my ($ok, $error) = Net::MitDK->new(profile => $profile)->first_login($json)->wait;
	return error("Cannot get first re-authorization: $error") unless $ok;

	return html '<h2>Logged in to MidDK!</h2><p>Now you can start the mitdk server' . mailcheck . setfrom . main . quit;
}

sub params
{
	map {
		m/^(\w+)=(.*)$/;
		my ($k,$v) = ($1,$2);
		$v =~ s/%(..)/chr(hex($1))/ge;
		($k, $v);
	} split '&', $_[0];
}

my %routes;
%routes = (
	'/profile' => sub {
		my $combo = '';
		for ($mgr->list) {
			$combo .= "<option value='$_' " .
				(($_ eq $profile) ? ' selected="selected"' : '').
				">$_</option>\n";
		}
		html <<PROFILE . main
<h2>Change profile</h2>
<p>
( run in 1.566 second using v1.01-cache-2.11-cpan-4ab04211f4c )