#!/usr/bin/env perl

use strict;
use warnings;
use 5.010;

use CGI::Tiny;
use Text::Xslate;
use Data::Section::Simple 'get_data_section';
use HTML::TokeParser;
use LWP::UserAgent;
use URL::Encode qw(url_encode_utf8 url_decode_utf8);
use Storable;
use File::Temp qw( tempfile );
use String::Urandom;
use Crypt::Digest::SHA256 'sha256_b64u';
use JSON;
use MIME::Base64;
use Data::Validate::URI qw(is_web_uri);
use URL::XS qw(parse_url);

use Data::Dumper;

our $PROGRAM_NAME = 'jakes-indieauth-thing';

my $client_id = 'https://jakesthoughts.xyz';
my $scope = 'profile'; # specifiy more with + eg 'profile+email' (profile is required for email)

# compaired with 'script_name' eg 'https://example.net/indieauth-client/indieauth-client.cgi'
my $prefix = '/indieauth-client';
# these 'paths' below need to exist
# ln -s <this_program> <path>
my %paths = (
	'show_form' => "$prefix/indieauth-client.cgi",
	'start' => "$prefix/indieauth-start.cgi",
	'redirect' => "$prefix/indieauth-redirect.cgi",
	'logged_in' => "$prefix/indieauth-logged-in.cgi",
	'log_out' => "$prefix/indieauth-log-out.cgi",
);

my $timeout = 5;

cgi {
	my $cgi = $_;
	$cgi->set_error_handler(sub {
		my ($cgi, $error, $rendered) = @_;
		warn $error;
		unless ($rendered) {
			$cgi->render(text => $error. ' '. $cgi->script_name); # want it to spit out errors
		}
	});

	my $tx = Text::Xslate->new(path => [get_data_section], cache => 0);

	## routing begins...
	if ($cgi->script_name eq $paths{show_form}) {
		my $data = get_our_cookie_data($cgi->cookies);
		if ($data->{me}) {
			$cgi->render(redirect => $client_id. $paths{logged_in})
		}
		else {
			$cgi->render(html => $tx->render('show_form.tx', {script_name => $cgi->script_name }));
		}
	}
	elsif ($cgi->script_name eq $paths{start}) {
		my $url = scalar $cgi->param('url');
		
		die_if_not_valid_with_indie_auth_spec( validate_url_with_indie_auth_spec($url), $url );

		my $meta = get_authenication_endpoint($url);
		if (! $meta) {
			return $cgi->render(html => $tx->render('start.tx', {
					script_name => $cgi->script_name,
					nothing => 1,
				}));
		}

		my $rand = String::Urandom->new(LENGTH => 50);
		my $code_veri = $rand->rand_string;
		my $base64_chal = sha256_b64u($code_veri);

		# store important info to disk
		my ($fh, $fn) = tempfile();
		close $fh;
		
		$cgi->add_response_cookie(
			$PROGRAM_NAME => to_cookie_data(
				'state' => $fn,
			),
			'Max-Age' => '120',
		);

		my %table = (
			user_url => $url,
			code_verifiy => $code_veri,
			authorization_endpoint => $meta->{authorization_endpoint},
			state => $fn,   # to be retrieved later
		);
		store \%table, $fn;

		# need to redirect users
		$cgi->render(redirect => 
			$meta->{authorization_endpoint}.
			'?response_type=code'.
			'&client_id='. url_encode_utf8($client_id).
			'&redirect_uri='. url_encode_utf8($client_id . $paths{redirect}).
			'&state='. $fn.
			'&code_challenge='. $base64_chal.
			'&code_challenge_method=S256'.
			'&me='. url_encode_utf8($url).
			'&scope='. $scope
		);
	}
	elsif ($cgi->script_name eq $paths{redirect}) {
		my $query = $cgi->query_string;
		my %q;
		for my $e ( split '&', $query ) {
			my ($key, $value) = split '=', $e;
			$q{$key} = url_decode_utf8($value);
		}
		#die Dumper(\%q);
		
		my $table_hashref;

		if (-e $q{state} and -r $q{state}) {
			$table_hashref = retrieve($q{state});
			if ($table_hashref->{state} ne $q{state}) {
				return $cgi->render(text => 
					'Your shit is all fucked up - somehow loaded a state but not yours.'
				);
			}
		}
		else {
			return $cgi->render(text => 'Your shit is all fucked up.');
		}
		
		# looks good, send our codes
		my $ua = LWP::UserAgent->new;
		my $post_link;

		if ($table_hashref->{authorization_endpoint} =~ m/^http/) {
			$post_link = $table_hashref->{authorization_endpoint};
		}
		else {
			if ($table_hashref->{user_url} =~ m/^http/) {
				$post_link = $table_hashref->{user_url}. $table_hashref->{authorization_endpoint};
			}
			else {
				die 'They sent a reply but nothing we can use.'. Dumper($table_hashref). Dumper(%q)
			}
		}

		my $res = $ua->post( $post_link, 
			[
				grant_type => 'authorization_code',
				client_id => $client_id,
				redirect_uri => $client_id. $paths{redirect},
				code => $q{code},
				code_verifier => $table_hashref->{code_verifiy},
			]
		);
	
		my $j;
		eval {
			$j = decode_json($res->decoded_content);
		};
		if ($@) {
			die Dumper($res->decoded_content). Dumper($table_hashref). Dumper(\%q) ;
		}
		if ($j->{me} ne $table_hashref->{user_url}) {
			my $ae = get_authenication_endpoint($j->{me});
			if ($ae ne $table_hashref->{authorization_endpoint}) {
				return $cgi->render(text => 'Your \'me\' parameter doesn\t match our records.');
			}
		}
		my $name;
		my $url;
		my $photo;
		if ($j->{profile}{name}) { $name = $j->{profile}{name} }
		if ($j->{profile}{url}) { $url = $j->{profile}{url} }
		if ($j->{profile}{photo}) { $photo = $j->{profile}{photo} }
		$name // 0;
		$url // 0;
		$photo // 0;
		#die Dumper($j);
	
		#$cgi->reset_response_headers;
		$cgi->add_response_cookie( 
			$PROGRAM_NAME => to_cookie_data( 
				'me' => $j->{me},
				'name' => $name,
				'url' => $url,
				'photo' => $photo
			),
		'Max-Age' => '1000',
		);
		$cgi->render(redirect => $client_id. $paths{logged_in});
	}
	elsif ($cgi->script_name eq $paths{logged_in}) {

		my $data = get_our_cookie_data($cgi->cookies);
		my $logged = 0;

		if ($data and exists $data->{me}) {
			$logged = 1;
		}
		$cgi->render(html => $tx->render('logged_in.tx', {
				script_name => $cgi->script_name ,
				logged => $logged,
				me => $data->{me},
				name => $data->{name},
				url => $data->{url},
				photo => $data->{photo},
				show_form => $paths{show_form},
				logout => $paths{log_out},
			}));
	}
	elsif ($cgi->script_name eq $paths{log_out}) {
		$cgi->add_response_cookie( $PROGRAM_NAME => 'cleared', 'Max-Age' => 0);
		$cgi->render(redirect => $client_id. $paths{show_form});
	}
};

sub to_cookie_data {
	my (%data) = @_;
	return encode_base64(encode_json(\%data), ''); # no '\n' or cookies fail
}

sub from_cookie_data {
	my ($s) = @_;
	return decode_json(decode_base64($s));
}

# this looks for indieauth-metadata which it pokes for auth. endpoint and other details
# barring an indieauth-metadata, if an authorization_endpoint is present, just use that
sub get_authenication_endpoint {
	my ($uri) = @_;
	my $ua = LWP::UserAgent->new;
	$ua->timeout($timeout);
	my $res = $ua->get($uri);

	return unless $res->is_success;

	my $ae;
	my $te;
	my $aer = '';
	my @head_links;
	my $meta;

	# head
	for ($res->header('Link')) {
		if ($_ =~ m{^<(.*)>; rel="((indieauth-metadata)|(authorization_endpoint))"}) {
			$ae = $1;
			$aer = $2;
			if ($aer eq 'indieauth-metadata') {
				last;
			}
			else {
				push @head_links, [$ae, $aer];
			} 
		}
	}

	# html
	if ($aer ne 'indieauth-metadata') {
		if ($head_links[0][0]) {
			$ae = $head_links[0][0];
			undef @head_links;
		}

		my $p = HTML::TokeParser->new( \$res->decoded_content );
		while (my $token = $p->get_tag('link') ) {
			my $href = $token->[1]{href};
			my $rel = $token->[1]{rel};
			next unless $rel eq 'indieauth-metadata' 
				or $rel eq 'authorization_endpoint';

			if ($href) {
				if (($rel eq 'indieauth-metadata') or ($rel eq 'authorization_endpoint' and $aer eq '')) {
					$ae = $href;
					$aer = $rel;
					last;
				}
			}
		}
	}

	if ($aer eq 'indieauth-metadata') {
		if (is_web_uri($ae)) {
			$res = $ua->get($ae)
		}
		else {
			my $pu;
			eval {
				$pu = parse_url($uri);
			};
			if ($@) {
				die;
			}
			if (substr($ae,0,1) eq '/') {
				$res = $ua->get("$pu->{scheme}://$pu->{host}$ae");
			}
			else {
				$res = $ua->get("$pu->{scheme}://$pu->{host}/$ae");
			}
		}
		if ($res->is_success) {
			$meta = decode_json($res->decoded_content);
		}
	}
	else {
		$meta->{authorization_endpoint} = $ae;
	}
	return $meta;
}

sub get_our_cookie_data {
	my ($pairs) = @_;
	my $data;

	for my $e (@$pairs) {
		if ($e->[0] eq $PROGRAM_NAME) {
			$data = from_cookie_data($e->[1]);
			last;
		}
	}
	return $data;
}

sub validate_url_with_indie_auth_spec {
	my ($url) = @_;

	my $pu;
	eval {
		$pu = parse_url($url);
	};
	if ($@) { return 10; }

	if (! $pu->{scheme}) { return 2; }
	if ($pu->{scheme} !~ m/^https?/) { return 3; }
	if (! $pu->{host}) { return 4; }
	if ($pu->{username}) { return 5; }
	if ($pu->{path} =~ m/[..]/) { return 6; }
	if ($pu->{port} != 0) { return 7; }
	if ($pu->{fragment}) { return 8; }
	
	#die Dumper($pu). Dumper($url);

	if (! (is_web_uri($url)) ) {
		if (! ($pu->{host} eq '127.0.0.1' or
				# parse_url cannot handle IPv6 addresses
				($pu->{host} eq '[' and $url =~ m{^http[s]://\[::1]})))
		{
			return 9;
		}
	}

	return 1;
}

sub die_if_not_valid_with_indie_auth_spec {
	my ($n, $url) = @_;

	return 1 if ($n == 1);
		
	if ($n == 2) {
		die 'This, \''. $url. '\', is missing a scheme (E.G. https)';
	} elsif ($n == 3) {
		die 'This, \''. $url. '\', scheme is not http or https.';
	} elsif ($n == 4) {
		die 'This, \''. $url. '\', is missing a host.';
	} elsif ($n == 5) {
		die 'This, \''. $url. '\', has a username component.';
	} elsif ($n == 6) {
		die 'This, \''. $url. '\', has a double-dot path segment.';
	} elsif ($n == 7) {
		die 'This, \''. $url. '\', has a port listed';
	} elsif ($n == 8) {
		die 'This, \''. $url. '\', has a fragment.';
	} elsif ($n == 9) {
		die 'This, \''. $url. '\', is not a valid URL (malformed or IPv4/IPv6 address)';
	} elsif ($n == 10) {
		# occurs when parse_url dies
		die 'This, \''. $url. '\', is malformed.';
	}

	return $n;
}

1;

__DATA__
@@ wrapper.tx
<html>
<head>
	<title>
	: block title -> { }
	</title>
	<style>
	.wrapper {
		margin-left: auto;
		margin-right: auto;
		width: 500px;
		text-align: center;
	}
	</style>
</head>
<body>
<div class="wrapper">
		<: block content -> { } :>
</div>
</body>
</html>

@@ show_form.tx
: cascade wrapper;  
: override title -> {
	Login
: }
: override content -> {
	<h1>Jake's IndieLogin Thing</h1>
	<h2><: $script_name; :></h2>
	<h3>Web-Sign in</h3>
	<form action="indieauth-start.cgi"  method="post">
		<input type="url" name="url" placeholder="https://example.net">
		<br>
		<button type="submit">Login</button>
	</form>
	<p>(At this moment, only an IndieAuth server is supported)</p>
: }

@@ start.tx
: cascade wrapper;
: override title -> {
	Searching...	
: }
: override content -> {
	<h1>Jake's IndieLogin Thing</h1>
	<h2><: $script_name; :></h2>
	: if ($nothing) {
		<p>No 'link' tag with rel attribute of 'authorization_endpoint'</p>
	: }
	: else {
		<p>Please wait... :)</p>
		<p>If waiting a long time, something bad has happenend!</p>
	: }
: }

@@ logged_in.tx
: cascade wrapper;
: override title -> {
	Logged In
: }
: override content -> {
	<h1>Jake's IndieLogin Thing</h1>
	<h2><: $script_name; :></h2>
	: if ($logged) {
		<p>Nice!  You're authenticated, Mr. <: $me :> </p>
		: if ($photo) {
			<img src="<: $photo :>" alt="A photo of you!" title="A photo of you!"/>
		: }
		: else {
			<p>Your authorization server didn't give me a link to your photo.</p>
		: }
		: if ($name) {
			<p>Aren't you glad you signed up, <: $name :>?</p>
		: }
		: else {
			<p>Your authorization server didn't give me your name.</p>
		: }
		: if ($url) {
			<p>Nice! Your URL is: <: $url :></p>
		: }
		: else {
			<p>Your authorization server didn't give me your URL.</p>
		: }
		<p>Enjoy this picture:</p>
		<img src="/img/cat1.jpg" alt="A picture of a smelly cat." title="A picture of a smelly cat."/>
		<p>Logout do this all over again?</p>
		<p><a href="<: $logout :>">Click here to logout.</a></p>
	: }
	: else {
		<p>To login, please login.</p>
		<p><a href="<: $show_form :>">Click here to login.</a></p>
	: }
: }