indieauth-client/indieauth-client.pl
2024-11-26 22:28:43 -05:00

486 lines
11 KiB
Perl
Executable file

#!/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>
: }
: }