487 lines
11 KiB
Perl
487 lines
11 KiB
Perl
|
#!/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>
|
||
|
|
: }
|
||
|
|
: }
|