| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package Web::Solid::Auth; | 
| 2 |  |  |  |  |  |  |  | 
| 3 | 1 |  |  | 1 |  | 113373 | use Moo; | 
|  | 1 |  |  |  |  | 13178 |  | 
|  | 1 |  |  |  |  | 7 |  | 
| 4 | 1 |  |  | 1 |  | 3740 | use Crypt::JWT; | 
|  | 1 |  |  |  |  | 93270 |  | 
|  | 1 |  |  |  |  | 87 |  | 
| 5 | 1 |  |  | 1 |  | 841 | use Data::Dumper; | 
|  | 1 |  |  |  |  | 8456 |  | 
|  | 1 |  |  |  |  | 107 |  | 
| 6 | 1 |  |  | 1 |  | 1388 | use Data::UUID; | 
|  | 1 |  |  |  |  | 2748 |  | 
|  | 1 |  |  |  |  | 120 |  | 
| 7 | 1 |  |  | 1 |  | 1298 | use Digest::SHA; | 
|  | 1 |  |  |  |  | 5953 |  | 
|  | 1 |  |  |  |  | 117 |  | 
| 8 | 1 |  |  | 1 |  | 1287 | use HTTP::Link; | 
|  | 1 |  |  |  |  | 12958 |  | 
|  | 1 |  |  |  |  | 71 |  | 
| 9 | 1 |  |  | 1 |  | 637 | use HTTP::Request; | 
|  | 1 |  |  |  |  | 23093 |  | 
|  | 1 |  |  |  |  | 46 |  | 
| 10 | 1 |  |  | 1 |  | 781 | use HTTP::Server::PSGI; | 
|  | 1 |  |  |  |  | 66806 |  | 
|  | 1 |  |  |  |  | 45 |  | 
| 11 | 1 |  |  | 1 |  | 660 | use Log::Any (); | 
|  | 1 |  |  |  |  | 9623 |  | 
|  | 1 |  |  |  |  | 31 |  | 
| 12 | 1 |  |  | 1 |  | 951 | use LWP::UserAgent; | 
|  | 1 |  |  |  |  | 15430 |  | 
|  | 1 |  |  |  |  | 52 |  | 
| 13 | 1 |  |  | 1 |  | 16 | use JSON; | 
|  | 1 |  |  |  |  | 4 |  | 
|  | 1 |  |  |  |  | 13 |  | 
| 14 | 1 |  |  | 1 |  | 877 | use MIME::Base64; | 
|  | 1 |  |  |  |  | 793 |  | 
|  | 1 |  |  |  |  | 71 |  | 
| 15 | 1 |  |  | 1 |  | 2865 | use Path::Tiny; | 
|  | 1 |  |  |  |  | 12451 |  | 
|  | 1 |  |  |  |  | 76 |  | 
| 16 | 1 |  |  | 1 |  | 15 | use URI::Escape; | 
|  | 1 |  |  |  |  | 3 |  | 
|  | 1 |  |  |  |  | 50 |  | 
| 17 | 1 |  |  | 1 |  | 727 | use Plack::Request; | 
|  | 1 |  |  |  |  | 62994 |  | 
|  | 1 |  |  |  |  | 46 |  | 
| 18 | 1 |  |  | 1 |  | 674 | use Plack::Response; | 
|  | 1 |  |  |  |  | 1386 |  | 
|  | 1 |  |  |  |  | 40 |  | 
| 19 | 1 |  |  | 1 |  | 508 | use Web::Solid::Auth::Listener; | 
|  | 1 |  |  |  |  | 5 |  | 
|  | 1 |  |  |  |  | 50 |  | 
| 20 | 1 |  |  | 1 |  | 1420 | use Web::Solid::Auth::Util; | 
|  | 1 |  |  |  |  | 3 |  | 
|  | 1 |  |  |  |  | 3469 |  | 
| 21 |  |  |  |  |  |  |  | 
| 22 |  |  |  |  |  |  | our $VERSION = "0.8"; | 
| 23 |  |  |  |  |  |  |  | 
| 24 |  |  |  |  |  |  | has webid => ( | 
| 25 |  |  |  |  |  |  | is => 'ro' , | 
| 26 |  |  |  |  |  |  | required => 1 | 
| 27 |  |  |  |  |  |  | ); | 
| 28 |  |  |  |  |  |  | has redirect_uri => ( | 
| 29 |  |  |  |  |  |  | is => 'ro' | 
| 30 |  |  |  |  |  |  | ); | 
| 31 |  |  |  |  |  |  | has cache => ( | 
| 32 |  |  |  |  |  |  | is => 'ro' , | 
| 33 |  |  |  |  |  |  | default => sub { $ENV{HOME} . "/.solid"} | 
| 34 |  |  |  |  |  |  | ); | 
| 35 |  |  |  |  |  |  | has log => ( | 
| 36 |  |  |  |  |  |  | is => 'ro', | 
| 37 |  |  |  |  |  |  | default => sub { Log::Any->get_logger }, | 
| 38 |  |  |  |  |  |  | ); | 
| 39 |  |  |  |  |  |  | has agent => ( | 
| 40 |  |  |  |  |  |  | is => 'lazy' | 
| 41 |  |  |  |  |  |  | ); | 
| 42 |  |  |  |  |  |  | has listener => ( | 
| 43 |  |  |  |  |  |  | is => 'lazy' | 
| 44 |  |  |  |  |  |  | ); | 
| 45 |  |  |  |  |  |  | has issuer => ( | 
| 46 |  |  |  |  |  |  | is => 'lazy' | 
| 47 |  |  |  |  |  |  | ); | 
| 48 |  |  |  |  |  |  | has client_id => ( | 
| 49 |  |  |  |  |  |  | is => 'ro', | 
| 50 |  |  |  |  |  |  | ); | 
| 51 |  |  |  |  |  |  |  | 
| 52 |  |  |  |  |  |  | sub _build_agent { | 
| 53 | 0 |  |  | 0 |  |  | my $ua = LWP::UserAgent->new(agent => "Web::Solid::Auth/$VERSION"); | 
| 54 | 0 |  |  |  |  |  | $ua; | 
| 55 |  |  |  |  |  |  | } | 
| 56 |  |  |  |  |  |  |  | 
| 57 |  |  |  |  |  |  | sub _build_listener { | 
| 58 | 0 |  |  | 0 |  |  | Web::Solid::Auth::Listener->new; | 
| 59 |  |  |  |  |  |  | } | 
| 60 |  |  |  |  |  |  |  | 
| 61 |  |  |  |  |  |  | sub _build_issuer { | 
| 62 | 0 |  |  | 0 |  |  | shift->get_openid_provider(); | 
| 63 |  |  |  |  |  |  | } | 
| 64 |  |  |  |  |  |  |  | 
| 65 |  |  |  |  |  |  | sub BUILD { | 
| 66 | 0 |  |  | 0 | 0 |  | my $self = shift; | 
| 67 | 0 |  | 0 |  |  |  | $self->{redirect_uri} //= $self->listener->redirect_uri; | 
| 68 |  |  |  |  |  |  | } | 
| 69 |  |  |  |  |  |  |  | 
| 70 |  |  |  |  |  |  | sub listen { | 
| 71 | 0 |  |  | 0 | 1 |  | my $self = shift; | 
| 72 | 0 |  |  |  |  |  | $self->listener->run($self); | 
| 73 |  |  |  |  |  |  | } | 
| 74 |  |  |  |  |  |  |  | 
| 75 |  |  |  |  |  |  | sub has_access_token { | 
| 76 | 0 |  |  | 0 | 1 |  | my $self = shift; | 
| 77 | 0 |  |  |  |  |  | my $cache_dir = $self->get_cache_dir; | 
| 78 | 0 |  |  |  |  |  | my $access = path($cache_dir)->child("access.json"); | 
| 79 | 0 |  |  |  |  |  | $access->exists; | 
| 80 |  |  |  |  |  |  | } | 
| 81 |  |  |  |  |  |  |  | 
| 82 |  |  |  |  |  |  | sub make_clean { | 
| 83 | 0 |  |  | 0 | 1 |  | my $self = shift; | 
| 84 | 0 |  |  |  |  |  | my $cache_dir = $self->get_cache_dir; | 
| 85 |  |  |  |  |  |  |  | 
| 86 | 0 |  |  |  |  |  | $self->log->info("cleaning cache directory $cache_dir"); | 
| 87 |  |  |  |  |  |  |  | 
| 88 | 0 |  |  |  |  |  | my $openid = path($cache_dir)->child("openid.json"); | 
| 89 | 0 | 0 |  |  |  |  | $openid->remove if $openid->exists; | 
| 90 |  |  |  |  |  |  |  | 
| 91 | 0 |  |  |  |  |  | my $client = path($cache_dir)->child("client.json"); | 
| 92 | 0 | 0 |  |  |  |  | $client->remove if $client->exists; | 
| 93 |  |  |  |  |  |  |  | 
| 94 | 0 |  |  |  |  |  | my $access = path($cache_dir)->child("access.json"); | 
| 95 | 0 | 0 |  |  |  |  | $access->remove if $access->exists; | 
| 96 |  |  |  |  |  |  |  | 
| 97 | 0 |  |  |  |  |  | $self; | 
| 98 |  |  |  |  |  |  | } | 
| 99 |  |  |  |  |  |  |  | 
| 100 |  |  |  |  |  |  | sub make_authorization_request { | 
| 101 | 0 |  |  | 0 | 1 |  | my $self = shift; | 
| 102 |  |  |  |  |  |  |  | 
| 103 | 0 |  |  |  |  |  | my $redirect_uri      = $self->redirect_uri; | 
| 104 |  |  |  |  |  |  |  | 
| 105 | 0 |  |  |  |  |  | my $registration_conf = $self->get_client_configuration; | 
| 106 | 0 |  |  |  |  |  | my $openid_conf       = $self->get_openid_configuration; | 
| 107 |  |  |  |  |  |  |  | 
| 108 | 0 |  |  |  |  |  | my $authorization_endpoint = $openid_conf->{authorization_endpoint}; | 
| 109 | 0 |  |  |  |  |  | my $client_id              = $registration_conf->{client_id}; | 
| 110 |  |  |  |  |  |  |  | 
| 111 | 0 |  |  |  |  |  | my $code_verifier  = $self->make_random_string; | 
| 112 | 0 |  |  |  |  |  | my $code_challenge = MIME::Base64::encode_base64url(Digest::SHA::sha256($code_verifier),''); | 
| 113 | 0 |  |  |  |  |  | $code_challenge  =~ s{=}{}; | 
| 114 | 0 |  |  |  |  |  | my $state          = $self->make_random_string; | 
| 115 |  |  |  |  |  |  |  | 
| 116 | 0 |  |  |  |  |  | my $url = $self->make_url( | 
| 117 |  |  |  |  |  |  | $authorization_endpoint, { | 
| 118 |  |  |  |  |  |  | code_challenge          => $code_challenge , | 
| 119 |  |  |  |  |  |  | code_challenge_method   => 'S256' , | 
| 120 |  |  |  |  |  |  | state                   => $state , | 
| 121 |  |  |  |  |  |  | scope                   => 'openid profile offline_access' , | 
| 122 |  |  |  |  |  |  | client_id               => $client_id , | 
| 123 |  |  |  |  |  |  | response_type           => 'code' , | 
| 124 |  |  |  |  |  |  | redirect_uri            => $redirect_uri , | 
| 125 |  |  |  |  |  |  | }); | 
| 126 |  |  |  |  |  |  |  | 
| 127 | 0 |  |  |  |  |  | $self->{state}         = $state; | 
| 128 | 0 |  |  |  |  |  | $self->{code_verifier} = $code_verifier; | 
| 129 |  |  |  |  |  |  |  | 
| 130 | 0 |  |  |  |  |  | $self->log->info("generating authorization request: $url"); | 
| 131 |  |  |  |  |  |  |  | 
| 132 | 0 |  |  |  |  |  | return $url; | 
| 133 |  |  |  |  |  |  | } | 
| 134 |  |  |  |  |  |  |  | 
| 135 |  |  |  |  |  |  | sub make_access_token { | 
| 136 | 0 |  |  | 0 | 1 |  | my ($self,$code) = @_; | 
| 137 |  |  |  |  |  |  |  | 
| 138 | 0 | 0 |  |  |  |  | die "need code" unless $code; | 
| 139 |  |  |  |  |  |  |  | 
| 140 | 0 |  |  |  |  |  | my $redirect_uri      = $self->redirect_uri; | 
| 141 |  |  |  |  |  |  |  | 
| 142 | 0 |  |  |  |  |  | my $openid_conf       = $self->get_openid_configuration; | 
| 143 | 0 |  |  |  |  |  | my $registration_conf = $self->get_client_configuration; | 
| 144 |  |  |  |  |  |  |  | 
| 145 | 0 |  |  |  |  |  | my $token_endpoint    = $openid_conf->{token_endpoint}; | 
| 146 | 0 |  | 0 |  |  |  | my $token_endpoint_auth_methods_supported = $openid_conf->{token_endpoint_auth_methods_supported} // []; | 
| 147 |  |  |  |  |  |  |  | 
| 148 |  |  |  |  |  |  | # Make an array out of an string... | 
| 149 | 0 | 0 |  |  |  |  | $token_endpoint_auth_methods_supported = | 
| 150 |  |  |  |  |  |  | ref($token_endpoint_auth_methods_supported) eq 'ARRAY' ? | 
| 151 |  |  |  |  |  |  | $token_endpoint_auth_methods_supported : | 
| 152 |  |  |  |  |  |  | [$token_endpoint_auth_methods_supported]; | 
| 153 |  |  |  |  |  |  |  | 
| 154 | 0 |  |  |  |  |  | my $client_id         = $registration_conf->{client_id}; | 
| 155 | 0 |  |  |  |  |  | my $client_secret     = $registration_conf->{client_secret}; | 
| 156 |  |  |  |  |  |  |  | 
| 157 | 0 |  |  |  |  |  | my $dpop_token = $self->make_token_for($token_endpoint,'POST'); | 
| 158 |  |  |  |  |  |  |  | 
| 159 | 0 |  |  |  |  |  | $self->log->info("requesting access token at $token_endpoint"); | 
| 160 |  |  |  |  |  |  |  | 
| 161 |  |  |  |  |  |  | my $token_request  = { | 
| 162 |  |  |  |  |  |  | grant_type    => 'authorization_code' , | 
| 163 |  |  |  |  |  |  | client_id     => $client_id , | 
| 164 |  |  |  |  |  |  | redirect_uri  => $redirect_uri , | 
| 165 |  |  |  |  |  |  | code          => $code , | 
| 166 |  |  |  |  |  |  | code_verifier => $self->{code_verifier} | 
| 167 | 0 |  |  |  |  |  | }; | 
| 168 |  |  |  |  |  |  |  | 
| 169 | 0 |  |  |  |  |  | my %headers = ( | 
| 170 |  |  |  |  |  |  | 'Content-Type' => 'application/x-www-form-urlencoded' , | 
| 171 |  |  |  |  |  |  | DPoP => $dpop_token | 
| 172 |  |  |  |  |  |  | ); | 
| 173 |  |  |  |  |  |  |  | 
| 174 | 0 | 0 |  |  |  |  | if (grep(/^client_secret_basic/, @$token_endpoint_auth_methods_supported)) { | 
|  |  | 0 |  |  |  |  |  | 
| 175 | 0 |  |  |  |  |  | $self->log->info('using client_secret_basic'); | 
| 176 | 0 |  |  |  |  |  | $headers{'Authorization'} = 'Basic ' . MIME::Base64::encode_base64url("$client_id:$client_secret"); | 
| 177 |  |  |  |  |  |  | } | 
| 178 |  |  |  |  |  |  | elsif (grep(/^client_secret_post/, @$token_endpoint_auth_methods_supported)) { | 
| 179 | 0 |  |  |  |  |  | $self->log->info('using client_secret_post'); | 
| 180 | 0 |  |  |  |  |  | $token_request->{client_secret} = $client_secret; | 
| 181 |  |  |  |  |  |  | } | 
| 182 |  |  |  |  |  |  |  | 
| 183 | 0 |  |  |  |  |  | my $data = $self->post( $token_endpoint, $token_request , %headers ); | 
| 184 |  |  |  |  |  |  |  | 
| 185 | 0 | 0 |  |  |  |  | return undef unless $data; | 
| 186 |  |  |  |  |  |  |  | 
| 187 | 0 |  |  |  |  |  | $data = decode_json($data); | 
| 188 |  |  |  |  |  |  |  | 
| 189 | 0 |  |  |  |  |  | $self->log->infof("received: %s", $data); | 
| 190 |  |  |  |  |  |  |  | 
| 191 | 0 |  |  |  |  |  | my $cache_dir = $self->get_cache_dir; | 
| 192 | 0 | 0 |  |  |  |  | path($cache_dir)->mkpath unless -d $cache_dir; | 
| 193 |  |  |  |  |  |  |  | 
| 194 | 0 |  |  |  |  |  | my $cache_file = path($cache_dir)->child("access.json")->stringify; | 
| 195 | 0 |  |  |  |  |  | path($cache_file)->spew(encode_json($data)); | 
| 196 |  |  |  |  |  |  |  | 
| 197 | 0 |  |  |  |  |  | return $data; | 
| 198 |  |  |  |  |  |  | } | 
| 199 |  |  |  |  |  |  |  | 
| 200 |  |  |  |  |  |  | sub make_authentication_headers { | 
| 201 | 0 |  |  | 0 | 0 |  | my ($self, $uri, $method) = @_; | 
| 202 |  |  |  |  |  |  |  | 
| 203 | 0 |  |  |  |  |  | my $access  = $self->get_access_token; | 
| 204 |  |  |  |  |  |  |  | 
| 205 | 0 | 0 |  |  |  |  | return undef unless $access; | 
| 206 |  |  |  |  |  |  |  | 
| 207 |  |  |  |  |  |  | my $headers =  { | 
| 208 |  |  |  |  |  |  | Authorization => 'DPoP ' . $access->{access_token} , | 
| 209 | 0 |  |  |  |  |  | DPoP          => $self->make_token_for($uri,$method) | 
| 210 |  |  |  |  |  |  | }; | 
| 211 |  |  |  |  |  |  |  | 
| 212 | 0 |  |  |  |  |  | return $headers; | 
| 213 |  |  |  |  |  |  | } | 
| 214 |  |  |  |  |  |  |  | 
| 215 |  |  |  |  |  |  | sub get_cache_dir { | 
| 216 | 0 |  |  | 0 | 0 |  | my $self = shift; | 
| 217 | 0 |  |  |  |  |  | my $webid      = $self->webid; | 
| 218 | 0 |  |  |  |  |  | my $webid_sha  = Digest::SHA::sha1_hex($webid); | 
| 219 | 0 |  |  |  |  |  | my $cache_dir  = sprintf "%s/%s" | 
| 220 |  |  |  |  |  |  | , $self->cache | 
| 221 |  |  |  |  |  |  | , Digest::SHA::sha1_hex($webid); | 
| 222 | 0 |  |  |  |  |  | return $cache_dir; | 
| 223 |  |  |  |  |  |  | } | 
| 224 |  |  |  |  |  |  |  | 
| 225 |  |  |  |  |  |  | sub get_access_token { | 
| 226 | 0 |  |  | 0 | 1 |  | my $self = shift; | 
| 227 |  |  |  |  |  |  |  | 
| 228 | 0 |  |  |  |  |  | my $cache_dir = $self->get_cache_dir; | 
| 229 |  |  |  |  |  |  |  | 
| 230 | 0 | 0 |  |  |  |  | return undef unless path($cache_dir)->child("access.json")->exists; | 
| 231 |  |  |  |  |  |  |  | 
| 232 | 0 |  |  |  |  |  | my $cache_file = path($cache_dir)->child("access.json")->stringify; | 
| 233 |  |  |  |  |  |  |  | 
| 234 | 0 |  |  |  |  |  | $self->log->debug("reading $cache_file"); | 
| 235 |  |  |  |  |  |  |  | 
| 236 | 0 |  |  |  |  |  | my $json = path("$cache_file")->slurp; | 
| 237 |  |  |  |  |  |  |  | 
| 238 | 0 | 0 |  |  |  |  | return undef unless $json; | 
| 239 |  |  |  |  |  |  |  | 
| 240 | 0 |  |  |  |  |  | return decode_json($json); | 
| 241 |  |  |  |  |  |  | } | 
| 242 |  |  |  |  |  |  |  | 
| 243 |  |  |  |  |  |  | sub get_openid_provider { | 
| 244 | 0 |  |  | 0 | 0 |  | my ($self, $webid) = @_; | 
| 245 | 0 |  | 0 |  |  |  | $webid //= $self->webid; | 
| 246 |  |  |  |  |  |  |  | 
| 247 | 0 |  |  |  |  |  | my $res = $self->options($webid); | 
| 248 |  |  |  |  |  |  |  | 
| 249 | 0 | 0 |  |  |  |  | return undef unless $res; | 
| 250 |  |  |  |  |  |  |  | 
| 251 | 0 |  |  |  |  |  | my $link = $res->header('Link'); | 
| 252 |  |  |  |  |  |  |  | 
| 253 | 0 |  |  |  |  |  | my @links = HTTP::Link->parse($link); | 
| 254 |  |  |  |  |  |  |  | 
| 255 | 0 |  |  |  |  |  | my $issuer; | 
| 256 |  |  |  |  |  |  |  | 
| 257 | 0 |  |  |  |  |  | for (@links) { | 
| 258 | 0 | 0 |  |  |  |  | if ($_->{relation} eq 'http://openid.net/specs/connect/1.0/issuer') { | 
| 259 | 0 |  |  |  |  |  | $issuer = $_->{iri}; | 
| 260 |  |  |  |  |  |  | } | 
| 261 |  |  |  |  |  |  | } | 
| 262 |  |  |  |  |  |  |  | 
| 263 | 0 | 0 |  |  |  |  | if ($issuer) { | 
| 264 | 0 |  |  |  |  |  | return $issuer; | 
| 265 |  |  |  |  |  |  | } | 
| 266 |  |  |  |  |  |  | else { | 
| 267 |  |  |  |  |  |  | # Try the webid to find the issuer | 
| 268 | 0 |  |  |  |  |  | return $self->get_webid_openid_provider($webid); | 
| 269 |  |  |  |  |  |  | } | 
| 270 |  |  |  |  |  |  | } | 
| 271 |  |  |  |  |  |  |  | 
| 272 |  |  |  |  |  |  | sub get_webid_openid_provider { | 
| 273 | 0 |  |  | 0 | 0 |  | my ($self, $webid) = @_; | 
| 274 | 0 |  | 0 |  |  |  | $webid //= $self->webid; | 
| 275 |  |  |  |  |  |  |  | 
| 276 |  |  |  |  |  |  | # Lets try plain JSON parsing for fun.. | 
| 277 | 0 |  |  |  |  |  | my $res = $self->get($webid, 'Accept' => 'text/turtle'); | 
| 278 |  |  |  |  |  |  |  | 
| 279 | 0 | 0 |  |  |  |  | return undef unless $res; | 
| 280 |  |  |  |  |  |  |  | 
| 281 | 0 |  |  |  |  |  | my $util  = Web::Solid::Auth::Util->new; | 
| 282 | 0 |  |  |  |  |  | my $model = $util->parse_turtle($res); | 
| 283 |  |  |  |  |  |  |  | 
| 284 | 0 |  |  |  |  |  | my $sparql =<<EOF; | 
| 285 |  |  |  |  |  |  | SELECT ?oidcIssuer { | 
| 286 |  |  |  |  |  |  | ?subject <http://www.w3.org/ns/solid/terms#oidcIssuer> ?oidcIssuer . | 
| 287 |  |  |  |  |  |  | } | 
| 288 |  |  |  |  |  |  | EOF | 
| 289 |  |  |  |  |  |  |  | 
| 290 | 0 |  |  |  |  |  | my $issuer; | 
| 291 |  |  |  |  |  |  | $util->sparql($model, $sparql, sub { | 
| 292 | 0 |  |  | 0 |  |  | my $res = shift; | 
| 293 | 0 |  |  |  |  |  | $issuer = $res->value('oidcIssuer')->as_string; | 
| 294 | 0 |  |  |  |  |  | }); | 
| 295 |  |  |  |  |  |  |  | 
| 296 | 0 |  |  |  |  |  | return $issuer; | 
| 297 |  |  |  |  |  |  | } | 
| 298 |  |  |  |  |  |  |  | 
| 299 |  |  |  |  |  |  | sub get_client_configuration { | 
| 300 | 0 |  |  | 0 | 0 |  | my $self = shift; | 
| 301 |  |  |  |  |  |  |  | 
| 302 | 0 |  |  |  |  |  | my $cache_dir = $self->get_cache_dir; | 
| 303 | 0 | 0 |  |  |  |  | path($cache_dir)->mkpath unless -d $cache_dir; | 
| 304 |  |  |  |  |  |  |  | 
| 305 | 0 |  |  |  |  |  | my $openid_conf           = $self->get_openid_configuration; | 
| 306 | 0 |  |  |  |  |  | my $redirect_uri          = $self->redirect_uri; | 
| 307 | 0 |  |  |  |  |  | my $registration_endpoint = $openid_conf->{registration_endpoint}; | 
| 308 |  |  |  |  |  |  |  | 
| 309 | 0 |  |  |  |  |  | my $cache_file = path($cache_dir)->child("client.json")->stringify; | 
| 310 |  |  |  |  |  |  |  | 
| 311 | 0 | 0 |  |  |  |  | unless (-f $cache_file) { | 
| 312 | 0 | 0 |  |  |  |  | if ($self->client_id) { | 
| 313 | 0 |  |  |  |  |  | $self->log->info("using client document at " . $self->client_id); | 
| 314 |  |  |  |  |  |  |  | 
| 315 | 0 |  |  |  |  |  | my $data = $self->get_json($self->client_id); | 
| 316 | 0 |  |  |  |  |  | $self->log->debug("generating $cache_file"); | 
| 317 |  |  |  |  |  |  |  | 
| 318 | 0 |  |  |  |  |  | path("$cache_file")->spew(encode_json($data)); | 
| 319 |  |  |  |  |  |  | } | 
| 320 |  |  |  |  |  |  | else { | 
| 321 | 0 |  |  |  |  |  | $self->log->info("registering client at $registration_endpoint"); | 
| 322 |  |  |  |  |  |  |  | 
| 323 |  |  |  |  |  |  | # Dynamic register the client. We request the openid and profile | 
| 324 |  |  |  |  |  |  | # scopes that are default for OpenID. The offline_access is | 
| 325 |  |  |  |  |  |  | # to be able to request refresh_tokens (not yet implemented). | 
| 326 |  |  |  |  |  |  | # The only safe response type is 'code' all other options send | 
| 327 |  |  |  |  |  |  | # sensitive data over the front channel and shouldn't be used. | 
| 328 | 0 |  |  |  |  |  | my $data = $self->post_json($registration_endpoint, { | 
| 329 |  |  |  |  |  |  | grant_types      => ["authorization_code", "refresh_token"], | 
| 330 |  |  |  |  |  |  | redirect_uris    => [ $redirect_uri ] , | 
| 331 |  |  |  |  |  |  | scope            => "openid profile offline_access" , | 
| 332 |  |  |  |  |  |  | response_types   => ["code"] | 
| 333 |  |  |  |  |  |  | }); | 
| 334 |  |  |  |  |  |  |  | 
| 335 | 0 | 0 |  |  |  |  | return undef unless $data; | 
| 336 |  |  |  |  |  |  |  | 
| 337 | 0 |  |  |  |  |  | $self->log->infof("received %s", $data); | 
| 338 |  |  |  |  |  |  |  | 
| 339 | 0 |  |  |  |  |  | $self->log->debug("generating $cache_file"); | 
| 340 |  |  |  |  |  |  |  | 
| 341 | 0 |  |  |  |  |  | path("$cache_file")->spew(encode_json($data)); | 
| 342 |  |  |  |  |  |  | } | 
| 343 |  |  |  |  |  |  | } | 
| 344 |  |  |  |  |  |  |  | 
| 345 | 0 |  |  |  |  |  | $self->log->debug("reading $cache_file"); | 
| 346 |  |  |  |  |  |  |  | 
| 347 | 0 |  |  |  |  |  | my $json = path("$cache_file")->slurp; | 
| 348 |  |  |  |  |  |  |  | 
| 349 | 0 | 0 |  |  |  |  | return undef unless $json; | 
| 350 |  |  |  |  |  |  |  | 
| 351 | 0 |  |  |  |  |  | return decode_json($json); | 
| 352 |  |  |  |  |  |  | } | 
| 353 |  |  |  |  |  |  |  | 
| 354 |  |  |  |  |  |  | sub get_openid_configuration { | 
| 355 | 0 |  |  | 0 | 0 |  | my ($self) = @_; | 
| 356 |  |  |  |  |  |  |  | 
| 357 | 0 |  |  |  |  |  | my $issuer    = $self->issuer; | 
| 358 |  |  |  |  |  |  |  | 
| 359 | 0 |  |  |  |  |  | my $cache_dir = $self->get_cache_dir; | 
| 360 | 0 | 0 |  |  |  |  | path($cache_dir)->mkpath unless -d $cache_dir; | 
| 361 |  |  |  |  |  |  |  | 
| 362 | 0 |  |  |  |  |  | my $cache_file = path($cache_dir)->child("openid.json")->stringify; | 
| 363 |  |  |  |  |  |  |  | 
| 364 | 0 | 0 |  |  |  |  | unless (-f $cache_file) { | 
| 365 | 0 |  |  |  |  |  | my $url = "$issuer/.well-known/openid-configuration"; | 
| 366 |  |  |  |  |  |  |  | 
| 367 | 0 |  |  |  |  |  | $self->log->info("reading openid configruation from $url"); | 
| 368 |  |  |  |  |  |  |  | 
| 369 |  |  |  |  |  |  | # Get the well known openid | 
| 370 | 0 |  |  |  |  |  | my $data = $self->get_json($url); | 
| 371 |  |  |  |  |  |  |  | 
| 372 | 0 | 0 |  |  |  |  | return undef unless $data; | 
| 373 |  |  |  |  |  |  |  | 
| 374 | 0 |  |  |  |  |  | $self->log->infof("received %s", $data); | 
| 375 |  |  |  |  |  |  |  | 
| 376 | 0 |  |  |  |  |  | $self->log->debug("generating $cache_file"); | 
| 377 |  |  |  |  |  |  |  | 
| 378 | 0 |  |  |  |  |  | path($cache_file)->spew(encode_json($data)); | 
| 379 |  |  |  |  |  |  | } | 
| 380 |  |  |  |  |  |  |  | 
| 381 | 0 |  |  |  |  |  | $self->log->debug("reading $cache_file"); | 
| 382 |  |  |  |  |  |  |  | 
| 383 | 0 |  |  |  |  |  | my $json = path($cache_file)->slurp; | 
| 384 |  |  |  |  |  |  |  | 
| 385 | 0 | 0 |  |  |  |  | return undef unless $json; | 
| 386 |  |  |  |  |  |  |  | 
| 387 | 0 |  |  |  |  |  | return decode_json($json); | 
| 388 |  |  |  |  |  |  | } | 
| 389 |  |  |  |  |  |  |  | 
| 390 |  |  |  |  |  |  | sub get_key_configuration { | 
| 391 | 0 |  |  | 0 | 0 |  | my ($self) = @_; | 
| 392 |  |  |  |  |  |  |  | 
| 393 | 0 |  |  |  |  |  | my $cache_dir = $self->get_cache_dir; | 
| 394 | 0 | 0 |  |  |  |  | path($cache_dir)->mkpath unless -d $cache_dir; | 
| 395 |  |  |  |  |  |  |  | 
| 396 | 0 |  |  |  |  |  | my $cache_file = path($cache_dir)->child("key.json")->stringify; | 
| 397 |  |  |  |  |  |  |  | 
| 398 | 0 | 0 |  |  |  |  | unless (-f $cache_file) { | 
| 399 |  |  |  |  |  |  | # Create an P-256 elliptic curve key we will use in DPoP | 
| 400 |  |  |  |  |  |  | # headers. | 
| 401 | 0 |  |  |  |  |  | my $pk = Crypt::PK::ECC->new(); | 
| 402 | 0 |  |  |  |  |  | $pk->generate_key('secp256r1'); | 
| 403 |  |  |  |  |  |  |  | 
| 404 | 0 |  |  |  |  |  | $self->log->debug("generating $cache_file"); | 
| 405 |  |  |  |  |  |  |  | 
| 406 | 0 |  |  |  |  |  | path($cache_file)->spew(encode_json({ | 
| 407 |  |  |  |  |  |  | public  => $pk->export_key_jwk('public') , | 
| 408 |  |  |  |  |  |  | private => $pk->export_key_jwk('private') | 
| 409 |  |  |  |  |  |  | })); | 
| 410 |  |  |  |  |  |  | } | 
| 411 |  |  |  |  |  |  |  | 
| 412 | 0 |  |  |  |  |  | $self->log->debug("reading $cache_file"); | 
| 413 |  |  |  |  |  |  |  | 
| 414 | 0 |  |  |  |  |  | my $json = path($cache_file)->slurp; | 
| 415 |  |  |  |  |  |  |  | 
| 416 | 0 | 0 |  |  |  |  | return undef unless $json; | 
| 417 |  |  |  |  |  |  |  | 
| 418 | 0 |  |  |  |  |  | my $pk   = Crypt::PK::ECC->new(); | 
| 419 | 0 |  |  |  |  |  | my $priv = decode_json($json)->{private}; | 
| 420 | 0 |  |  |  |  |  | $pk->import_key(\$priv); | 
| 421 |  |  |  |  |  |  |  | 
| 422 | 0 |  |  |  |  |  | return $pk; | 
| 423 |  |  |  |  |  |  | } | 
| 424 |  |  |  |  |  |  |  | 
| 425 |  |  |  |  |  |  | ## Networking | 
| 426 |  |  |  |  |  |  |  | 
| 427 |  |  |  |  |  |  | sub get { | 
| 428 | 0 |  |  | 0 | 0 |  | my ($self, $url, %opts) = @_; | 
| 429 |  |  |  |  |  |  |  | 
| 430 | 0 |  |  |  |  |  | my $response = $self->agent->get($url, %opts); | 
| 431 |  |  |  |  |  |  |  | 
| 432 | 0 | 0 |  |  |  |  | unless ($response->is_success) { | 
| 433 | 0 |  |  |  |  |  | $self->log->errorf("failed to GET($url): %s" , $response); | 
| 434 | 0 |  |  |  |  |  | return undef; | 
| 435 |  |  |  |  |  |  | } | 
| 436 |  |  |  |  |  |  |  | 
| 437 | 0 |  |  |  |  |  | return $response->decoded_content; | 
| 438 |  |  |  |  |  |  | } | 
| 439 |  |  |  |  |  |  |  | 
| 440 |  |  |  |  |  |  | sub get_json { | 
| 441 | 0 |  |  | 0 | 0 |  | my ($self, $url, %opts) = @_; | 
| 442 | 0 |  |  |  |  |  | return decode_json($self->get($url, %opts)); | 
| 443 |  |  |  |  |  |  | } | 
| 444 |  |  |  |  |  |  |  | 
| 445 |  |  |  |  |  |  | sub post { | 
| 446 | 0 |  |  | 0 | 0 |  | my ($self, $url, $data, %opts) = @_; | 
| 447 |  |  |  |  |  |  |  | 
| 448 | 0 |  |  |  |  |  | my $response = $self->agent->post($url, | 
| 449 |  |  |  |  |  |  | %opts, | 
| 450 |  |  |  |  |  |  | Content => $data | 
| 451 |  |  |  |  |  |  | ); | 
| 452 |  |  |  |  |  |  |  | 
| 453 | 0 | 0 |  |  |  |  | unless ($response->is_success) { | 
| 454 | 0 |  |  |  |  |  | $self->log->errorf("failed to POST($url): %s",$response); | 
| 455 | 0 |  |  |  |  |  | return undef; | 
| 456 |  |  |  |  |  |  | } | 
| 457 |  |  |  |  |  |  |  | 
| 458 | 0 |  |  |  |  |  | return $response->decoded_content; | 
| 459 |  |  |  |  |  |  | } | 
| 460 |  |  |  |  |  |  |  | 
| 461 |  |  |  |  |  |  | sub post_json { | 
| 462 | 0 |  |  | 0 | 0 |  | my ($self, $url, $data, %opts) = @_; | 
| 463 |  |  |  |  |  |  |  | 
| 464 | 0 |  | 0 |  |  |  | $opts{'Content-Type'} //= 'application/json'; | 
| 465 |  |  |  |  |  |  |  | 
| 466 | 0 |  |  |  |  |  | my $response = $self->agent->post($url, | 
| 467 |  |  |  |  |  |  | %opts , | 
| 468 |  |  |  |  |  |  | Content => encode_json($data) | 
| 469 |  |  |  |  |  |  | ); | 
| 470 |  |  |  |  |  |  |  | 
| 471 | 0 | 0 |  |  |  |  | unless ($response->is_success) { | 
| 472 | 0 |  |  |  |  |  | $self->log->errorf("failed to POST($url): %s",$response); | 
| 473 | 0 |  |  |  |  |  | return undef; | 
| 474 |  |  |  |  |  |  | } | 
| 475 |  |  |  |  |  |  |  | 
| 476 | 0 |  |  |  |  |  | return decode_json($response->decoded_content); | 
| 477 |  |  |  |  |  |  | } | 
| 478 |  |  |  |  |  |  |  | 
| 479 |  |  |  |  |  |  | sub options { | 
| 480 | 0 |  |  | 0 | 0 |  | my ($self, $url) = @_; | 
| 481 |  |  |  |  |  |  |  | 
| 482 | 0 |  |  |  |  |  | my $response = $self->agent->request( | 
| 483 |  |  |  |  |  |  | HTTP::Request->new(OPTIONS => $url) | 
| 484 |  |  |  |  |  |  | ); | 
| 485 |  |  |  |  |  |  |  | 
| 486 | 0 | 0 |  |  |  |  | unless ($response->is_success) { | 
| 487 | 0 |  |  |  |  |  | $self->log->errorf("failed to OPTIONS($url): %s" , $response); | 
| 488 | 0 |  |  |  |  |  | return undef; | 
| 489 |  |  |  |  |  |  | } | 
| 490 |  |  |  |  |  |  |  | 
| 491 | 0 |  |  |  |  |  | return $response; | 
| 492 |  |  |  |  |  |  | } | 
| 493 |  |  |  |  |  |  |  | 
| 494 |  |  |  |  |  |  | sub make_url { | 
| 495 | 0 |  |  | 0 | 0 |  | my ($self, $url,$params) = @_; | 
| 496 |  |  |  |  |  |  |  | 
| 497 | 0 |  |  |  |  |  | my @qparam = (); | 
| 498 |  |  |  |  |  |  |  | 
| 499 | 0 |  | 0 |  |  |  | for my $key (keys %{$params // {} }) { | 
|  | 0 |  |  |  |  |  |  | 
| 500 | 0 |  |  |  |  |  | my $value = URI::Escape::uri_escape($params->{$key}); | 
| 501 | 0 |  |  |  |  |  | push @qparam , "$key=$value"; | 
| 502 |  |  |  |  |  |  | } | 
| 503 |  |  |  |  |  |  |  | 
| 504 | 0 | 0 |  |  |  |  | if (@qparam) { | 
| 505 | 0 |  |  |  |  |  | $url .= "?" . join("&", @qparam); | 
| 506 |  |  |  |  |  |  | } | 
| 507 |  |  |  |  |  |  |  | 
| 508 | 0 |  |  |  |  |  | $url; | 
| 509 |  |  |  |  |  |  | } | 
| 510 |  |  |  |  |  |  |  | 
| 511 |  |  |  |  |  |  | # Crypto | 
| 512 |  |  |  |  |  |  |  | 
| 513 |  |  |  |  |  |  | sub make_random_string { | 
| 514 | 0 |  |  | 0 | 0 |  | my $self = shift; | 
| 515 | 0 |  |  |  |  |  | my $str = MIME::Base64::encode_base64url( | 
| 516 |  |  |  |  |  |  | Data::UUID->new->create() . | 
| 517 |  |  |  |  |  |  | Data::UUID->new->create() . | 
| 518 |  |  |  |  |  |  | Data::UUID->new->create() | 
| 519 |  |  |  |  |  |  | ); | 
| 520 | 0 |  |  |  |  |  | $str; | 
| 521 |  |  |  |  |  |  | } | 
| 522 |  |  |  |  |  |  |  | 
| 523 |  |  |  |  |  |  | sub make_token_for { | 
| 524 | 0 |  |  | 0 | 0 |  | my ($self, $uri, $method) = @_; | 
| 525 |  |  |  |  |  |  |  | 
| 526 |  |  |  |  |  |  | # With DPoP headers access_tokens can be protected. When requesting | 
| 527 |  |  |  |  |  |  | # an access_token from a token_endpoint a DPoP headers is included | 
| 528 |  |  |  |  |  |  | # which contains our public key (inside the signed token header). | 
| 529 |  |  |  |  |  |  | # Our public key will then be part of the returned access_token. | 
| 530 |  |  |  |  |  |  | # | 
| 531 |  |  |  |  |  |  | # When later on you will send the access_token to a resource provider | 
| 532 |  |  |  |  |  |  | # it can check the signed DPoP header in combination with our public | 
| 533 |  |  |  |  |  |  | # key in the access_token that you are in posession of the private key | 
| 534 |  |  |  |  |  |  | # that matches the public key in the access_token. | 
| 535 |  |  |  |  |  |  | # | 
| 536 |  |  |  |  |  |  | # In this way, when some evil resource provider steals your access_token | 
| 537 |  |  |  |  |  |  | # it can't be reused without your private key. | 
| 538 |  |  |  |  |  |  |  | 
| 539 | 0 |  |  |  |  |  | my $pk = $self->get_key_configuration; | 
| 540 |  |  |  |  |  |  |  | 
| 541 | 0 |  |  |  |  |  | my $header = { | 
| 542 |  |  |  |  |  |  | typ => 'dpop+jwt' , | 
| 543 |  |  |  |  |  |  | alg => 'ES256' , | 
| 544 |  |  |  |  |  |  | jwk => JSON::decode_json($pk->export_key_jwk('public')) , | 
| 545 |  |  |  |  |  |  | }; | 
| 546 |  |  |  |  |  |  |  | 
| 547 | 0 |  |  |  |  |  | $self->log->debugf("DPoP(header) %s" , $header); | 
| 548 |  |  |  |  |  |  |  | 
| 549 | 0 |  |  |  |  |  | my $payload = { | 
| 550 |  |  |  |  |  |  | # A jti is a random string that protects the token_endpoint server | 
| 551 |  |  |  |  |  |  | # against replay attacks | 
| 552 |  |  |  |  |  |  | jti => $self->make_random_string, | 
| 553 |  |  |  |  |  |  | # Limits the DPoP token only to this method | 
| 554 |  |  |  |  |  |  | htm => $method , | 
| 555 |  |  |  |  |  |  | # Limits the DPop token only to this uri | 
| 556 |  |  |  |  |  |  | htu => $uri , | 
| 557 |  |  |  |  |  |  | # The time this token was issued | 
| 558 |  |  |  |  |  |  | iat => time , | 
| 559 |  |  |  |  |  |  | }; | 
| 560 |  |  |  |  |  |  |  | 
| 561 | 0 |  |  |  |  |  | $self->log->debugf("DPoP(payload) %s" , $payload); | 
| 562 |  |  |  |  |  |  |  | 
| 563 | 0 |  |  |  |  |  | my $token = Crypt::JWT::encode_jwt( | 
| 564 |  |  |  |  |  |  | payload => $payload , | 
| 565 |  |  |  |  |  |  | key => $pk , | 
| 566 |  |  |  |  |  |  | alg => 'ES256' , | 
| 567 |  |  |  |  |  |  | extra_headers => $header | 
| 568 |  |  |  |  |  |  | ); | 
| 569 |  |  |  |  |  |  |  | 
| 570 | 0 |  |  |  |  |  | return $token; | 
| 571 |  |  |  |  |  |  | } | 
| 572 |  |  |  |  |  |  |  | 
| 573 |  |  |  |  |  |  | 1; | 
| 574 |  |  |  |  |  |  |  | 
| 575 |  |  |  |  |  |  | __END__ | 
| 576 |  |  |  |  |  |  |  | 
| 577 |  |  |  |  |  |  | =head1 NAME | 
| 578 |  |  |  |  |  |  |  | 
| 579 |  |  |  |  |  |  | Web::Solid::Auth - A Perl Solid Web Client | 
| 580 |  |  |  |  |  |  |  | 
| 581 |  |  |  |  |  |  | =head1 SYNOPSIS | 
| 582 |  |  |  |  |  |  |  | 
| 583 |  |  |  |  |  |  | # On the command line | 
| 584 |  |  |  |  |  |  |  | 
| 585 |  |  |  |  |  |  | # Set your default webid | 
| 586 |  |  |  |  |  |  | export SOLID_WEBID=https://hochstenbach.inrupt.net/profile/card#me | 
| 587 |  |  |  |  |  |  |  | 
| 588 |  |  |  |  |  |  | # Authentication to a pod | 
| 589 |  |  |  |  |  |  | solid_auth.pl authenticate | 
| 590 |  |  |  |  |  |  |  | 
| 591 |  |  |  |  |  |  | # Get the http headers for a authenticated request | 
| 592 |  |  |  |  |  |  | solid_auth.pl headers GET https://hochstenbach.inrupt.net/inbox/ | 
| 593 |  |  |  |  |  |  |  | 
| 594 |  |  |  |  |  |  | # Act like a curl command and fetch authenticated content | 
| 595 |  |  |  |  |  |  | solid_auth.pl curl -X GET https://hochstenbach.inrupt.net/inbox/ | 
| 596 |  |  |  |  |  |  |  | 
| 597 |  |  |  |  |  |  | # Add some data | 
| 598 |  |  |  |  |  |  | solid_auth.pl curl -X POST \ | 
| 599 |  |  |  |  |  |  | -H "Content-Type: text/plain" \ | 
| 600 |  |  |  |  |  |  | -d "abc" \ | 
| 601 |  |  |  |  |  |  | https://hochstenbach.inrupt.net/public/ | 
| 602 |  |  |  |  |  |  |  | 
| 603 |  |  |  |  |  |  | # Add a file | 
| 604 |  |  |  |  |  |  | solid_auth.pl curl -X PUT \ | 
| 605 |  |  |  |  |  |  | -H "Content-Type: application/ld+json" \ | 
| 606 |  |  |  |  |  |  | -d "@myfile.jsonld" \ | 
| 607 |  |  |  |  |  |  | https://hochstenbach.inrupt.net/public/myfile.jsonld | 
| 608 |  |  |  |  |  |  |  | 
| 609 |  |  |  |  |  |  | # Set a solid base url | 
| 610 |  |  |  |  |  |  | export SOLID_REMOTE_BASE=https://hochstenbach.inrupt.net | 
| 611 |  |  |  |  |  |  |  | 
| 612 |  |  |  |  |  |  | # List all resources on some Pod path | 
| 613 |  |  |  |  |  |  | solid_auth.pl list /public/ | 
| 614 |  |  |  |  |  |  |  | 
| 615 |  |  |  |  |  |  | # Get some data | 
| 616 |  |  |  |  |  |  | solid_auth.pl get /inbox/ | 
| 617 |  |  |  |  |  |  |  | 
| 618 |  |  |  |  |  |  | # Post some data | 
| 619 |  |  |  |  |  |  | solid_auth.pl post /inbox/ myfile.jsonld | 
| 620 |  |  |  |  |  |  |  | 
| 621 |  |  |  |  |  |  | # Put some data | 
| 622 |  |  |  |  |  |  | solid_auth.pl put /public/myfile.txt myfile.txt | 
| 623 |  |  |  |  |  |  |  | 
| 624 |  |  |  |  |  |  | # Create a folder | 
| 625 |  |  |  |  |  |  | solid_auth.pl put /public/mytestfolder/ | 
| 626 |  |  |  |  |  |  |  | 
| 627 |  |  |  |  |  |  | # Delete some data | 
| 628 |  |  |  |  |  |  | solid_auth.pl delete /public/myfile.txt | 
| 629 |  |  |  |  |  |  |  | 
| 630 |  |  |  |  |  |  | # Mirror a resource, container or tree | 
| 631 |  |  |  |  |  |  | solid_auth.pl mirror /public/ ./my_copy | 
| 632 |  |  |  |  |  |  |  | 
| 633 |  |  |  |  |  |  | # Upload a directory to the pod | 
| 634 |  |  |  |  |  |  | #  Add the -x option to do it for real (only a test without this option) | 
| 635 |  |  |  |  |  |  | solid_auth.pl -r upload /data/my_copy /public/ | 
| 636 |  |  |  |  |  |  |  | 
| 637 |  |  |  |  |  |  | # Clean all files in a container | 
| 638 |  |  |  |  |  |  | #  Add the -x option to do it for real (only a test without this option) | 
| 639 |  |  |  |  |  |  | solid_auth.pl --keep clean /demo/ | 
| 640 |  |  |  |  |  |  |  | 
| 641 |  |  |  |  |  |  | # Clean a complete container | 
| 642 |  |  |  |  |  |  | #  Add the -x option to do it for real (only a test without this option) | 
| 643 |  |  |  |  |  |  | solid_auth.pl -r clean /demo/ | 
| 644 |  |  |  |  |  |  |  | 
| 645 |  |  |  |  |  |  | # In a perl program | 
| 646 |  |  |  |  |  |  | use Web::Solid::Auth; | 
| 647 |  |  |  |  |  |  | use Web::Solid::Auth::Listener; | 
| 648 |  |  |  |  |  |  |  | 
| 649 |  |  |  |  |  |  | # Create a new authenticator for a pod | 
| 650 |  |  |  |  |  |  | my $auth = Web::Solid::Auth->new(webid => $webid); | 
| 651 |  |  |  |  |  |  |  | 
| 652 |  |  |  |  |  |  | # Or tune a listerner | 
| 653 |  |  |  |  |  |  | my $auth = Web::Solid::Auth->new( | 
| 654 |  |  |  |  |  |  | webid     => $webid , | 
| 655 |  |  |  |  |  |  | listener => Web::Solid::Auth::Listener->new( | 
| 656 |  |  |  |  |  |  | scheme => 'https' | 
| 657 |  |  |  |  |  |  | host   => 'my.server.org' | 
| 658 |  |  |  |  |  |  | port   => '443' , | 
| 659 |  |  |  |  |  |  | path   => '/mycallback' | 
| 660 |  |  |  |  |  |  | ) | 
| 661 |  |  |  |  |  |  | ); | 
| 662 |  |  |  |  |  |  |  | 
| 663 |  |  |  |  |  |  | # Or, in case you have your own callback server | 
| 664 |  |  |  |  |  |  | my $auth = Web::Solid::Auth->new( | 
| 665 |  |  |  |  |  |  | webid         => $webid, | 
| 666 |  |  |  |  |  |  | redirect_uri => 'https://my.server.org/mycallback' | 
| 667 |  |  |  |  |  |  | ); | 
| 668 |  |  |  |  |  |  |  | 
| 669 |  |  |  |  |  |  | # Generate a url for the user to authenticate | 
| 670 |  |  |  |  |  |  | my $auth_url = $auth->make_authorization_request; | 
| 671 |  |  |  |  |  |  |  | 
| 672 |  |  |  |  |  |  | # Listen for the oauth server to return tokens | 
| 673 |  |  |  |  |  |  | # the built-in listener for feedback from the openid provider | 
| 674 |  |  |  |  |  |  | # Check the code of Web::Solid::Auth::Listener how to | 
| 675 |  |  |  |  |  |  | # do this inside your own Plack application | 
| 676 |  |  |  |  |  |  | $auth->listen; | 
| 677 |  |  |  |  |  |  |  | 
| 678 |  |  |  |  |  |  | #### | 
| 679 |  |  |  |  |  |  |  | 
| 680 |  |  |  |  |  |  | # If you already have access_tokens from previous step | 
| 681 |  |  |  |  |  |  | if ($auth->has_access_token) { | 
| 682 |  |  |  |  |  |  | # Fetch the Authentication and DPoP HTTP headers for a | 
| 683 |  |  |  |  |  |  | # request to an authorized resource | 
| 684 |  |  |  |  |  |  | my $headers = $auth->make_authentication_headers($resource_url,$http_method); | 
| 685 |  |  |  |  |  |  |  | 
| 686 |  |  |  |  |  |  | #..do you curl..lwp::agent..or what ever with the headers | 
| 687 |  |  |  |  |  |  | } | 
| 688 |  |  |  |  |  |  |  | 
| 689 |  |  |  |  |  |  | =head1 INSTALLATION | 
| 690 |  |  |  |  |  |  |  | 
| 691 |  |  |  |  |  |  | See the L<https://metacpan.org/dist/Web-Solid-Auth/source/INSTALL> file in the | 
| 692 |  |  |  |  |  |  | distribution. | 
| 693 |  |  |  |  |  |  |  | 
| 694 |  |  |  |  |  |  | =head1 DESCRIPTION | 
| 695 |  |  |  |  |  |  |  | 
| 696 |  |  |  |  |  |  | This is a Solid-OIDC implementation of a connection class for the Solid | 
| 697 |  |  |  |  |  |  | server. Use the C<bin/solid_auth.pl> command as a command line implementation. | 
| 698 |  |  |  |  |  |  | Check out the C<example> directory for a demo web application. | 
| 699 |  |  |  |  |  |  |  | 
| 700 |  |  |  |  |  |  | =head1 CONFIGURATION | 
| 701 |  |  |  |  |  |  |  | 
| 702 |  |  |  |  |  |  | =over | 
| 703 |  |  |  |  |  |  |  | 
| 704 |  |  |  |  |  |  | =item webid | 
| 705 |  |  |  |  |  |  |  | 
| 706 |  |  |  |  |  |  | The Solid Webid to authenticate. | 
| 707 |  |  |  |  |  |  |  | 
| 708 |  |  |  |  |  |  | =item cache | 
| 709 |  |  |  |  |  |  |  | 
| 710 |  |  |  |  |  |  | The location of the cache directory with connection parameters. | 
| 711 |  |  |  |  |  |  |  | 
| 712 |  |  |  |  |  |  | =back | 
| 713 |  |  |  |  |  |  |  | 
| 714 |  |  |  |  |  |  | =head1 METHODS | 
| 715 |  |  |  |  |  |  |  | 
| 716 |  |  |  |  |  |  | =over | 
| 717 |  |  |  |  |  |  |  | 
| 718 |  |  |  |  |  |  | =item has_access_token() | 
| 719 |  |  |  |  |  |  |  | 
| 720 |  |  |  |  |  |  | Returns a true value when a cache contains an access token for the C<webid>. | 
| 721 |  |  |  |  |  |  |  | 
| 722 |  |  |  |  |  |  | =item make_clean() | 
| 723 |  |  |  |  |  |  |  | 
| 724 |  |  |  |  |  |  | Clear the cache directory. | 
| 725 |  |  |  |  |  |  |  | 
| 726 |  |  |  |  |  |  | =item make_authorization_request() | 
| 727 |  |  |  |  |  |  |  | 
| 728 |  |  |  |  |  |  | Return an authorization URL that the use should open to authenticate this | 
| 729 |  |  |  |  |  |  | application. | 
| 730 |  |  |  |  |  |  |  | 
| 731 |  |  |  |  |  |  | =item make_access_token($code) | 
| 732 |  |  |  |  |  |  |  | 
| 733 |  |  |  |  |  |  | When on the redirect url you get a C<code> from the authentication server you | 
| 734 |  |  |  |  |  |  | can use this method to get an access_token for the code. | 
| 735 |  |  |  |  |  |  |  | 
| 736 |  |  |  |  |  |  | =item listen() | 
| 737 |  |  |  |  |  |  |  | 
| 738 |  |  |  |  |  |  | Create a small built-in web server to listen for token responses from the | 
| 739 |  |  |  |  |  |  | authentication server. | 
| 740 |  |  |  |  |  |  |  | 
| 741 |  |  |  |  |  |  | =item get_access_token() | 
| 742 |  |  |  |  |  |  |  | 
| 743 |  |  |  |  |  |  | Return the cached access_token. | 
| 744 |  |  |  |  |  |  |  | 
| 745 |  |  |  |  |  |  | =back | 
| 746 |  |  |  |  |  |  |  | 
| 747 |  |  |  |  |  |  | =head1 SEE ALSO | 
| 748 |  |  |  |  |  |  |  | 
| 749 |  |  |  |  |  |  | L<solid_auth.pl> | 
| 750 |  |  |  |  |  |  |  | 
| 751 |  |  |  |  |  |  | =head1 INSPIRATION | 
| 752 |  |  |  |  |  |  |  | 
| 753 |  |  |  |  |  |  | This was very much inspired by the Python solid-flask code by | 
| 754 |  |  |  |  |  |  | Rai L<http://agentydragon.com> at L<https://gitlab.com/agentydragon/solid-flask>, | 
| 755 |  |  |  |  |  |  | and Jeff Zucker's <https://github.com/jeff-zucker> Solid-Shell at L<https://www.npmjs.com/package/solid-shell>. | 
| 756 |  |  |  |  |  |  |  | 
| 757 |  |  |  |  |  |  | =head1 COPYRIGHT AND LICENSE | 
| 758 |  |  |  |  |  |  |  | 
| 759 |  |  |  |  |  |  | This software is copyright (c) 2021 by Patrick Hochstenbach. | 
| 760 |  |  |  |  |  |  |  | 
| 761 |  |  |  |  |  |  | This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. | 
| 762 |  |  |  |  |  |  |  | 
| 763 |  |  |  |  |  |  | =encoding utf8 | 
| 764 |  |  |  |  |  |  |  | 
| 765 |  |  |  |  |  |  | =cut |