1use strict; 2use Carp (); 3 4############################################################################ 5package Net::OpenID::Association; 6$Net::OpenID::Association::VERSION = '1.18'; 7use fields ( 8 'server', # author-identity identity provider endpoint 9 'secret', # the secret for this association 10 'handle', # the 255-character-max ASCII printable handle (33-126) 11 'expiry', # unixtime, adjusted, of when this association expires 12 'type', # association type 13 ); 14 15use Storable (); 16use Digest::SHA (); 17use Net::OpenID::Common; 18use URI::Escape qw(uri_escape); 19 20################################################################ 21# Association and Session Types 22 23# session type hash 24# name - by which session type appears in URI parameters (required) 25# len - number of bytes in digest (undef => accommodates any length) 26# fn - DH hash function (undef => secret passed in the clear) 27# https - must use encrypted connection (boolean) 28# 29my %_session_types = (); 30# {versionkey}{name} -> session type 31# {NO}{versionkey} -> no-encryption stype for this version 32# {MAX}{versionkey} -> strongest encryption stype for this version 33 34# association type hash 35# name - by which assoc. type appears in URI parameters (required) 36# len - number of bytes in digest (required) 37# macfn - MAC hash function (required) 38# 39my %_assoc_types = (); 40# {versionkey}{name} -> association type 41# {MAX}{versionkey} -> strongest encryption atype for this version 42 43my %_assoc_macfn = (); 44# {name} -> hmac function 45# ... since association types in the cache are only listed by name 46# and don't say what version they're from. Which should not matter 47# as long as the macfn associated with a given association type 48# name does not change in future versions. 49 50# (floating point version numbers scare me) 51# (also version key can stay the same if the 52# set of hash functions available does not change) 53# ('NO' and 'MAX' should never be used as version keys) 54sub _version_key_from_numeric { 55 my ($numeric_protocol_version) = @_; 56 return $numeric_protocol_version < 2 ? 'v1' : 'v2'; 57} 58# can SESSION_TYPE be used with ASSOC_TYPE? 59sub _compatible_stype_atype { 60 my ($s_type, $a_type) = @_; 61 return !$s_type->{len} || $s_type->{len} == $a_type->{len}; 62} 63 64{ 65 # Define the no-encryption session types. 66 # In version 1.1/1.0, the no-encryption session type 67 # is the default and never explicitly specified 68 $_session_types{$_->[0]}{$_->[1]} 69 = $_session_types{NO}{$_->[0]} 70 = { 71 name => $_->[1], 72 https => 1, 73 } 74 foreach ([v1 => ''], [v2 => 'no-encryption']); 75 76 # Define SHA-based session and association types 77 my %_sha_fns = 78 ( 79 SHA1 => { minv => 'v1', # first version group in which this appears 80 v1max => 1, # best encryption for v1 81 len => 20, # number of bytes in digest 82 fn => \&Digest::SHA::sha1, 83 macfn => \&Digest::SHA::hmac_sha1, }, 84 SHA256 => { minv => 'v2', 85 v2max => 1, # best encryption for v2 86 len => 32, 87 fn => \&Digest::SHA::sha256, 88 macfn => \&Digest::SHA::hmac_sha256, }, 89 # doubtless there will be more... 90 ); 91 foreach my $SHAX (keys %_sha_fns) { 92 my $s = $_sha_fns{$SHAX}; 93 my $a_type = { name => "HMAC-${SHAX}", map {$_,$s->{$_}} qw(len macfn) }; 94 my $s_type = { name => "DH-${SHAX}", map {$_,$s->{$_}} qw(len fn) }; 95 my $seen_minv = 0; 96 foreach my $v (qw(v1 v2)) { 97 $seen_minv = 1 if $v eq $s->{minv}; 98 next unless $seen_minv; 99 $_assoc_types{$v}{$a_type->{name}} = $a_type; 100 $_session_types{$v}{$s_type->{name}} = $s_type; 101 if ($s->{"${v}max"}) { 102 $_assoc_types{MAX}{$v} = $a_type; 103 $_session_types{MAX}{$v} = $s_type; 104 } 105 } 106 $_assoc_macfn{$a_type->{name}} = $a_type->{macfn}; 107 } 108} 109################################################################ 110 111sub new { 112 my Net::OpenID::Association $self = shift; 113 $self = fields::new( $self ) unless ref $self; 114 my %opts = @_; 115 for my $f (qw( server secret handle expiry type )) { 116 $self->{$f} = delete $opts{$f}; 117 } 118 Carp::croak("unknown options: " . join(", ", keys %opts)) if %opts; 119 return $self; 120} 121 122sub handle { 123 my $self = shift; 124 die if @_; 125 $self->{'handle'}; 126} 127 128sub secret { 129 my $self = shift; 130 die if @_; 131 $self->{'secret'}; 132} 133 134sub type { 135 my $self = shift; 136 die if @_; 137 $self->{'type'}; 138} 139 140sub generate_signature { 141 my Net::OpenID::Association $self = shift; 142 my $string = shift; 143 return OpenID::util::b64($_assoc_macfn{$self->type}->($string, $self->secret)); 144} 145 146sub server { 147 my Net::OpenID::Association $self = shift; 148 Carp::croak("Too many parameters") if @_; 149 return $self->{server}; 150} 151 152sub expired { 153 my Net::OpenID::Association $self = shift; 154 return time() > $self->{'expiry'}; 155} 156 157sub usable { 158 my Net::OpenID::Association $self = shift; 159 return 0 unless $self->{'handle'} =~ /^[\x21-\x7e]{1,255}$/; 160 return 0 unless $self->{'expiry'} =~ /^\d+$/; 161 return 0 unless $self->{'secret'}; 162 return 0 if $self->expired; 163 return 1; 164} 165 166 167# server_assoc(CSR, SERVER, FORCE_REASSOCIATE, OPTIONS...) 168# 169# Return an association for SERVER (provider), whether already 170# cached and not yet expired, or freshly negotiated. 171# Return undef if no local storage/cache is available 172# or negotiation fails for whatever reason, 173# in which case the caller goes into dumb consumer mode. 174# FORCE_REASSOCIATE true => ignore the cache 175# OPTIONS... are passed to new_server_assoc() 176# 177sub server_assoc { 178 my ($csr, $server, $force_reassociate, @opts) = @_; 179 180 # closure to return undef (dumb consumer mode) and log why 181 my $dumb = sub { 182 $csr->_debug("server_assoc: dumb mode: $_[0]"); 183 return undef; 184 }; 185 186 my $cache = $csr->cache; 187 return $dumb->("no_cache") unless $cache; 188 189 unless ($force_reassociate) { 190 # try first from cached association handle 191 if (my $handle = $cache->get("shandle:$server")) { 192 my $assoc = handle_assoc($csr, $server, $handle); 193 194 if ($assoc && $assoc->usable) { 195 $csr->_debug("Found association from cache (handle=$handle)"); 196 return $assoc; 197 } 198 } 199 } 200 201 # make a new association 202 my ($assoc, $err, $retry) = new_server_assoc($csr, $server, @opts); 203 return $dumb->($err) 204 if $err; 205 ($assoc, $err) = new_server_assoc($csr, $server, @opts, %$retry) 206 if $retry; 207 return $dumb->($err || 'second_retry') 208 unless $assoc; 209 210 my $ahandle = $assoc->handle; 211 $cache->set("hassoc:$server:$ahandle", Storable::freeze({%$assoc})); 212 $cache->set("shandle:$server", $ahandle); 213 214 # now we test that the cache object given to us actually works. if it 215 # doesn't, it'll also fail later, making the verify fail, so let's 216 # go into stateless (dumb mode) earlier if we can detect this. 217 $cache->get("shandle:$server") 218 or return $dumb->("cache_broken"); 219 220 return $assoc; 221} 222 223# new_server_assoc(CSR, SERVER, OPTIONS...) 224# 225# Attempts to negotiate a fresh association from C<$server> (provider) 226# with session and association types determined by OPTIONS... 227# (accepts protocol_version and all assoc_options from Consumer, 228# however max_encrypt and session_no_encrypt_https are ignored 229# if assoc_type and session_type are passed directly as hashes) 230# Returns 231# ($association) on success 232# (undef, $error_message) on unrecoverable failure 233# (undef, undef, {retry...}) if identity provider suggested 234# alternate session/assoc types in an error response 235# 236sub new_server_assoc { 237 my ($csr, $server, %opts) = @_; 238 my $server_is_https = lc($server) =~ m/^https:/; 239 my $protocol_version = delete $opts{protocol_version} || 1; 240 my $version_key = _version_key_from_numeric($protocol_version); 241 my $allow_eavesdropping = (delete $opts{allow_eavesdropping} || 0) && $protocol_version < 2; 242 243 my $a_maxencrypt = delete $opts{max_encrypt} || 0; 244 my $s_noencrypt = delete $opts{session_no_encrypt_https} && $server_is_https; 245 246 my $s_type = delete $opts{session_type} || "DH-SHA1"; 247 unless (ref $s_type) { 248 if ($s_noencrypt) { 249 $s_type = $_session_types{NO}{$version_key}; 250 } 251 elsif ($a_maxencrypt) { 252 $s_type = $_session_types{MAX}{$version_key}; 253 } 254 } 255 256 my $a_type = delete $opts{assoc_type} || "HMAC-SHA1"; 257 unless (ref $a_type) { 258 $a_type = $_assoc_types{MAX}{$version_key} 259 if $a_maxencrypt; 260 } 261 262 Carp::croak("unknown options: " . join(", ", keys %opts)) if %opts; 263 264 $a_type = $_assoc_types{$version_key}{$a_type} unless ref $a_type; 265 Carp::croak("unknown association type") unless $a_type; 266 267 $s_type = $_session_types{$version_key}{$s_type} unless ref $s_type; 268 Carp::croak("unknown session type") unless $s_type; 269 270 my $error = sub { return (undef, $_[0].($_[1]?" ($_[1])":'')); }; 271 272 return $error->("incompatible_session_type") 273 unless _compatible_stype_atype($s_type, $a_type); 274 275 return $error->("https_required") 276 if $s_type->{https} && !$server_is_https && !$allow_eavesdropping; 277 278 my %post = ( "openid.mode" => "associate" ); 279 $post{'openid.ns'} = OpenID::util::version_2_namespace() 280 if $protocol_version == 2; 281 $post{'openid.assoc_type'} = $a_type->{name}; 282 $post{'openid.session_type'} = $s_type->{name} if $s_type->{name}; 283 284 my $dh; 285 if ($s_type->{fn}) { 286 $dh = OpenID::util::get_dh(); 287 $post{'openid.dh_consumer_public'} = OpenID::util::int2arg($dh->pub_key); 288 } 289 290 my $req = HTTP::Request->new(POST => $server); 291 $req->header("Content-Type" => "application/x-www-form-urlencoded"); 292 $req->content(join("&", map { "$_=" . uri_escape($post{$_}) } keys %post)); 293 294 $csr->_debug("Associate mode request: " . $req->content); 295 296 my $ua = $csr->ua; 297 my $res = $ua->request($req); 298 299 return $error->("http_no_response") unless $res; 300 301 my $recv_time = time(); 302 my $content = $res->content; 303 my %args = OpenID::util::parse_keyvalue($content); 304 $csr->_debug("Response to associate mode: [$content] parsed = " . join(",", %args)); 305 306 my $r_a_type = $_assoc_types{$version_key}{$args{'assoc_type'}}; 307 my $r_s_type = $_session_types{$version_key}{$args{'session_type'}||''}; 308 309 unless ($res->is_success) { 310 # direct error 311 return $error->("http_failure_no_associate") 312 if ($protocol_version < 2); 313 return $error->("http_direct_error") 314 unless $args{'error_code'} eq 'unsupported_type'; 315 return (undef,undef,{assoc_type => $r_a_type, session_type => $r_s_type}) 316 if $r_a_type && $r_s_type && ($r_a_type != $a_type || $r_s_type != $s_type); 317 return $error->("unsupported_type"); 318 } 319 return $error->("unknown_assoc_type",$args{'assoc_type'}) 320 unless $r_a_type; 321 return $error->("unknown_session_type",$args{'session_type'}) 322 unless $r_s_type; 323 return $error->("wrong_assoc_type",$r_a_type->{name}) 324 unless $a_type == $r_a_type; 325 return $error->("wrong_session_type",$r_s_type->{name}) 326 unless $s_type == $r_s_type || ($protocol_version < 2); 327 328 # protocol version 1.1 329 my $expires_in = $args{'expires_in'}; 330 331 # protocol version 1.0 (DEPRECATED) 332 if (! $expires_in) { 333 if (my $issued = OpenID::util::w3c_to_time($args{'issued'})) { 334 my $expiry = OpenID::util::w3c_to_time($args{'expiry'}); 335 my $replace_after = OpenID::util::w3c_to_time($args{'replace_after'}); 336 337 # seconds ahead (positive) or behind (negative) the provider is 338 $expires_in = ($replace_after || $expiry) - $issued; 339 } 340 } 341 342 # between 1 second and 2 years 343 return $error->("bogus_expires_in") 344 unless $expires_in > 0 && $expires_in < 63072000; 345 346 my $ahandle = $args{'assoc_handle'}; 347 348 my $secret; 349 unless ($r_s_type->{fn}) { 350 $secret = OpenID::util::d64($args{'mac_key'}); 351 } 352 else { 353 my $server_pub = OpenID::util::arg2int($args{'dh_server_public'}); 354 my $dh_sec = $dh->compute_secret($server_pub); 355 $secret = OpenID::util::d64($args{'enc_mac_key'}) 356 ^ $r_s_type->{fn}->(OpenID::util::int2bytes($dh_sec)); 357 } 358 return $error->("bad_secret_length") 359 if $r_s_type->{len} && length($secret) != $r_s_type->{len}; 360 361 my %assoc = ( 362 handle => $ahandle, 363 server => $server, 364 secret => $secret, 365 type => $r_a_type->{name}, 366 expiry => $recv_time + $expires_in, 367 ); 368 369 return Net::OpenID::Association->new( %assoc ); 370} 371 372# returns association, or undef if it can't be found 373sub handle_assoc { 374 my ($csr, $server, $handle) = @_; 375 376 # closure to return undef (dumb consumer mode) and log why 377 my $dumb = sub { 378 $csr->_debug("handle_assoc: dumb mode: $_[0]"); 379 return undef; 380 }; 381 382 return $dumb->("no_handle") unless $handle; 383 384 my $cache = $csr->cache; 385 return $dumb->("no_cache") unless $cache; 386 387 my $frozen = $cache->get("hassoc:$server:$handle"); 388 return $dumb->("not_in_cache") unless $frozen; 389 390 my $param = eval { Storable::thaw($frozen) }; 391 return $dumb->("not_a_hashref") unless ref $param eq "HASH"; 392 393 return Net::OpenID::Association->new( %$param ); 394} 395 396sub invalidate_handle { 397 my ($csr, $server, $handle) = @_; 398 my $cache = $csr->cache 399 or return; 400 $cache->set("hassoc:$server:$handle", ""); 401} 402 4031; 404 405__END__ 406 407=head1 NAME 408 409Net::OpenID::Association - A relationship with an identity provider 410 411=head1 VERSION 412 413version 1.18 414 415=head1 DESCRIPTION 416 417Internal class. 418 419=head1 COPYRIGHT, WARRANTY, AUTHOR 420 421See L<Net::OpenID::Consumer> for author, copyright and licensing information. 422 423=head1 SEE ALSO 424 425L<Net::OpenID::Consumer> 426 427L<Net::OpenID::VerifiedIdentity> 428 429L<Net::OpenID::Server> 430 431Website: L<http://openid.net/> 432