From: <de...@de...> - 2010-01-28 21:07:55
|
Author: IanKluft Date: 2010-01-28 15:07:44 -0600 (Thu, 28 Jan 2010) New Revision: 18307 Trac url: http://develop.twiki.org/trac/changeset/18307 Added: twiki/trunk/OpenIdRpContrib/lib/TWiki/Contrib/OpenIdRpContrib/ twiki/trunk/OpenIdRpContrib/lib/TWiki/Contrib/OpenIdRpContrib/DBLockPerAccess.pm Removed: twiki/trunk/OpenIdRpContrib/lib/TWiki/Contrib/DBLockPerAccess.pm Modified: twiki/trunk/OpenIdRpContrib/lib/TWiki/LoginManager/OpenID.pm twiki/trunk/OpenIdRpContrib/lib/TWiki/Users/OpenIDMapping.pm Log: Item6390: multiple fixes: * rename Contrib::DBLockPerAccess to Contrib::OpenIdRpContrib::DBLockPerAccess as suggested by Peter * fix exception code in Contrib::OpenIdRpContrib::DBLockPerAccess * remove warnings & dead code in TWiki::LoginManager::OpenID Deleted: twiki/trunk/OpenIdRpContrib/lib/TWiki/Contrib/DBLockPerAccess.pm =================================================================== --- twiki/trunk/OpenIdRpContrib/lib/TWiki/Contrib/DBLockPerAccess.pm 2010-01-28 13:37:06 UTC (rev 18306) +++ twiki/trunk/OpenIdRpContrib/lib/TWiki/Contrib/DBLockPerAccess.pm 2010-01-28 21:07:44 UTC (rev 18307) @@ -1,284 +0,0 @@ -#!/usr/bin/perl -# TWiki::Contrib::DBLockPerAccess -# by Ian Kluft -# Copyright (C) 2010 TWiki Inc -# -# This program is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation; either version 2 -# of the License, or (at your option) any later version. For -# more details read LICENSE in the root of this distribution. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -# -# As per the GPL, removal of this notice is prohibited. - -package TWiki::Contrib::DBLockPerAccess; -use strict; - -use Tie::Hash; # included with Perl -use DB_File::Lock; # CPAN dependency - -use base "Tie::Hash"; - -# class variables -our $debug = 0; - -# print debugging statements -sub debug -{ - $debug and print STDERR "debug: ".join( " ", @_ )."\n"; -} - -# new classname, LIST - initialize -sub new -{ - my $class = shift; - debug "new", @_; - - my $self = {}; - bless $self, $class; - $self->initialize( @_ ); - return $self; -} - -# initialize -sub initialize -{ - my $self = shift; - - # save the parameters - we'll use them for DB_File::Lock with each access - $self->{filename} = shift; - $self->{flags} = shift; - $self->{mode} = shift; - $self->{db_type} = shift; - $self->{exception} = shift; - - # determine flags for read and write operations - $self->{rwflags} = {}; - $self->{rwflags}{read} = O_RDONLY; - if ( $self->{flags} & O_ACCMODE == O_RDONLY ) { - $self->{rwflags}{write} = undef; - } else { - $self->{rwflags}{write} = $self->{flags}; - } - - debug "init: filename=".$self->{filename}, "flags=".$self->{flags}, - "mode=".$self->{mode}, "db_type=".$self->{db_type}, - "exception=".$self->{exception}, "\n"; -} - -# throw an exception -sub exception -{ - my $self = shift; - my $id = shift; - my $desc = shift; - debug "exception", $id, $desc; - - # hopefully new() was provided with an exception callback... - if ( ref $self->{exception} eq "CODE" ) { - # throw the exception - $self->{exception}->( $id, $desc ); - } else { - # otherwise punt - die "$desc ($id)\n"; - } -} - -# lock/tie -sub lock_tie -{ - my $self = shift; - my $rw = shift; - debug "lock"; - - # determine read/write flags for tie - if ( !exists $self->{rwflags}{$rw}) { - $self->exception( "db_bad_rwflags", - "attempt to open for '$rw' failed: mode does not exist" ); - } - my $flags = $self->{rwflags}{$rw}; - if ( !defined $flags ) { - $self->exception( "db_rw_flags", - "attempt to open for '$rw' failed: mode note defined " - ."(usually attempt to write after declaring read-only)" ); - } - - # tie the DB - $self->{hash} = {}; - $self->{hash_obj} = tie %{$self->{hash}}, 'DB_File::Lock', - $self->{filename}, $flags, $self->{mode}, $self->{db_type}, $rw - or $self->exception( "db_tie_failed", - "failed to open DB file for $rw" ); - - # if we're writing, set flag to prepare to mark it dirty afterward - if ( $rw eq "write" ) { - $self->{writing} = 1; - } -} - -# untie/unlock -sub unlock_untie -{ - my $self = shift; - debug "unlock"; - - # remove references with untie - see the "untie gotcha" in perltie(1) - delete $self->{hash_obj}; # remove reference so DESTROY can happen - untie %{$self->{hash}}; - delete $self->{hash}; - - # if we were writing, mark it dirty - if ( $self->{writing}) { - $self->{dirty} = 1; - delete $self->{writing}; - } -} - -# TIEHASH classname, filename, flags, mode, db_type, rw, exception -sub TIEHASH -{ - my $class = shift; - - return $class->new( @_ ); -} - -# STORE this, key, value - store data -sub STORE -{ - my $self = shift; - my $key = shift; - my $value = shift; - debug "store", $key, $value; - - # lock, write, unlock - $self->lock_tie( "write" ); - $self->{hash_obj}->STORE( $key, $value ); - $self->unlock_untie; -} - -# FETCH this, key - read data -sub FETCH -{ - my $self = shift; - my $key = shift; - debug "fetch", $key; - - # lock, read, unlock - $self->lock_tie( "read" ); - my $value = $self->{hash_obj}->FETCH( $key ); - $self->unlock_untie; - return $value; -} - -# FIRSTKEY this -sub FIRSTKEY -{ - my $self = shift; - debug "firstkey"; - - # lock, check existence, unlock - $self->lock_tie( "read" ); - my $key = $self->{hash_obj}->FIRSTKEY(); - $self->unlock_untie; - return $key; -} - -# NEXTKEY this, lastkey -sub NEXTKEY -{ - my $self = shift; - my $lastkey = shift; - debug "nextkey", $lastkey; - - # lock, check existence, unlock - $self->lock_tie( "read" ); - - # we need to reset the search cursor after untying lost the data - my ( $key, $value ); - $key = $lastkey; - my $status = $self->{hash_obj}->get( $key, $value ); # get the value - ( $status == 1 ) and return undef; # key doesn't exist - $status = $self->{hash_obj}->find_dup ( $key, $value ); # set the cursor - - # now NEXTKEY from DB_File will work - $key = $self->{hash_obj}->NEXTKEY( $lastkey ); - $self->unlock_untie; - return $key; -} - -# EXISTS this, key -sub EXISTS -{ - my $self = shift; - my $key = shift; - debug "exists", $key; - - # lock, check existence, unlock - $self->lock_tie( "read" ); - my $value = $self->{hash_obj}->EXISTS( $key ); - $self->unlock_untie; - return $value; -} - -# DELETE this, key -sub DELETE -{ - my $self = shift; - my $key = shift; - debug "delete", $key; - - # lock, delete, unlock - $self->lock_tie( "write" ); - $self->{hash_obj}->DELETE( $key ); - $self->unlock_untie; -} - -# CLEAR this -sub CLEAR -{ - my $self = shift; - debug "clear"; - - # lock, clear, unlock - $self->lock_tie( "write" ); - foreach my $key ( keys %{$self->{hash}}) { - delete $self->{hash}{$key}; - } - $self->unlock_untie; -} - -# UNTIE this - untie/close -sub UNTIE -{ - my $self = shift; - debug "untie"; - - if ( exists $self->{hash}) { - $self->unlock_untie; - warn "DB was still locked at untie time\n"; - } -} - -1; -__END__ - -=head1 NAME - -TWiki::Contrib::DBLockPerAccess - DB_File wrapper which locks the file only per-access - -=head1 SYNOPSIS - - use TWiki::Contrib::DBLockPerAccess; - - [$X =] tie %hash, "TWiki::Contrib::DBLockPerAccess", $filename, $flags, $mode, $DB_HASH; - [$X =] tie %hash, 'DB_File::Lock', $filename, $flags, $mode, $DB_BTREE, $locking; - - ...use the same way as DB_File for the rest of the interface... - -=head1 DESCRIPTION - - Copied: twiki/trunk/OpenIdRpContrib/lib/TWiki/Contrib/OpenIdRpContrib/DBLockPerAccess.pm (from rev 18304, twiki/trunk/OpenIdRpContrib/lib/TWiki/Contrib/DBLockPerAccess.pm) =================================================================== --- twiki/trunk/OpenIdRpContrib/lib/TWiki/Contrib/OpenIdRpContrib/DBLockPerAccess.pm (rev 0) +++ twiki/trunk/OpenIdRpContrib/lib/TWiki/Contrib/OpenIdRpContrib/DBLockPerAccess.pm 2010-01-28 21:07:44 UTC (rev 18307) @@ -0,0 +1,282 @@ +#!/usr/bin/perl +# TWiki::Contrib::OpenIdRpContrib::DBLockPerAccess +# by Ian Kluft +# Copyright (C) 2010 TWiki Inc +# +# This program is free software; you can redistribute it and/or +# modify it under the terms of the GNU General Public License +# as published by the Free Software Foundation; either version 2 +# of the License, or (at your option) any later version. For +# more details read LICENSE in the root of this distribution. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. +# +# As per the GPL, removal of this notice is prohibited. + +package TWiki::Contrib::OpenIdRpContrib::DBLockPerAccess; +use strict; + +use Tie::Hash; # included with Perl +use DB_File::Lock; # CPAN dependency + +use base "Tie::Hash"; + +# class variables +our $debug = 0; + +# print debugging statements +sub debug +{ + $debug and print STDERR "debug: ".join( " ", @_ )."\n"; +} + +# new classname, LIST - initialize +sub new +{ + my $class = shift; + debug "new", @_; + + my $self = {}; + bless $self, $class; + $self->initialize( @_ ); + return $self; +} + +# initialize +sub initialize +{ + my $self = shift; + + # save the parameters - we'll use them for DB_File::Lock with each access + $self->{filename} = shift; + $self->{flags} = shift; + $self->{mode} = shift; + $self->{db_type} = shift; + $self->{exception} = shift; + + # determine flags for read and write operations + $self->{rwflags} = {}; + $self->{rwflags}{read} = O_RDONLY; + if ( $self->{flags} & O_ACCMODE == O_RDONLY ) { + $self->{rwflags}{write} = undef; + } else { + $self->{rwflags}{write} = $self->{flags}; + } + + debug "init: filename=".$self->{filename}, "flags=".$self->{flags}, + "mode=".$self->{mode}, "db_type=".$self->{db_type}, + "exception=".$self->{exception}, "\n"; +} + +# throw an exception +sub exception +{ + my $self = shift; + my @params = @_; + debug "exception", @params; + + # hopefully new() was provided with an exception callback... + if ( ref $self->{exception} eq "CODE" ) { + # throw the exception + $self->{exception}->( @params ); + } else { + # otherwise punt + die join( "\n", @params )."\n"; + } +} + +# lock/tie +sub lock_tie +{ + my $self = shift; + my $rw = shift; + debug "lock"; + + # determine read/write flags for tie + if ( !exists $self->{rwflags}{$rw}) { + $self->exception( + "attempt to open for '$rw' failed: mode does not exist" ); + } + my $flags = $self->{rwflags}{$rw}; + if ( !defined $flags ) { + $self->exception( + "attempt to open for '$rw' failed: mode note defined " + ."(usually attempt to write after declaring read-only)" ); + } + + # tie the DB + $self->{hash} = {}; + $self->{hash_obj} = tie %{$self->{hash}}, 'DB_File::Lock', + $self->{filename}, $flags, $self->{mode}, $self->{db_type}, $rw + or $self->exception( "failed to open DB file for $rw" ); + + # if we're writing, set flag to prepare to mark it dirty afterward + if ( $rw eq "write" ) { + $self->{writing} = 1; + } +} + +# untie/unlock +sub unlock_untie +{ + my $self = shift; + debug "unlock"; + + # remove references with untie - see the "untie gotcha" in perltie(1) + delete $self->{hash_obj}; # remove reference so DESTROY can happen + untie %{$self->{hash}}; + delete $self->{hash}; + + # if we were writing, mark it dirty + if ( $self->{writing}) { + $self->{dirty} = 1; + delete $self->{writing}; + } +} + +# TIEHASH classname, filename, flags, mode, db_type, rw, exception +sub TIEHASH +{ + my $class = shift; + + return $class->new( @_ ); +} + +# STORE this, key, value - store data +sub STORE +{ + my $self = shift; + my $key = shift; + my $value = shift; + debug "store", $key, $value; + + # lock, write, unlock + $self->lock_tie( "write" ); + $self->{hash_obj}->STORE( $key, $value ); + $self->unlock_untie; +} + +# FETCH this, key - read data +sub FETCH +{ + my $self = shift; + my $key = shift; + debug "fetch", $key; + + # lock, read, unlock + $self->lock_tie( "read" ); + my $value = $self->{hash_obj}->FETCH( $key ); + $self->unlock_untie; + return $value; +} + +# FIRSTKEY this +sub FIRSTKEY +{ + my $self = shift; + debug "firstkey"; + + # lock, check existence, unlock + $self->lock_tie( "read" ); + my $key = $self->{hash_obj}->FIRSTKEY(); + $self->unlock_untie; + return $key; +} + +# NEXTKEY this, lastkey +sub NEXTKEY +{ + my $self = shift; + my $lastkey = shift; + debug "nextkey", $lastkey; + + # lock, check existence, unlock + $self->lock_tie( "read" ); + + # we need to reset the search cursor after untying lost the data + my ( $key, $value ); + $key = $lastkey; + my $status = $self->{hash_obj}->get( $key, $value ); # get the value + ( $status == 1 ) and return undef; # key doesn't exist + $status = $self->{hash_obj}->find_dup ( $key, $value ); # set the cursor + + # now NEXTKEY from DB_File will work + $key = $self->{hash_obj}->NEXTKEY( $lastkey ); + $self->unlock_untie; + return $key; +} + +# EXISTS this, key +sub EXISTS +{ + my $self = shift; + my $key = shift; + debug "exists", $key; + + # lock, check existence, unlock + $self->lock_tie( "read" ); + my $value = $self->{hash_obj}->EXISTS( $key ); + $self->unlock_untie; + return $value; +} + +# DELETE this, key +sub DELETE +{ + my $self = shift; + my $key = shift; + debug "delete", $key; + + # lock, delete, unlock + $self->lock_tie( "write" ); + $self->{hash_obj}->DELETE( $key ); + $self->unlock_untie; +} + +# CLEAR this +sub CLEAR +{ + my $self = shift; + debug "clear"; + + # lock, clear, unlock + $self->lock_tie( "write" ); + foreach my $key ( keys %{$self->{hash}}) { + delete $self->{hash}{$key}; + } + $self->unlock_untie; +} + +# UNTIE this - untie/close +sub UNTIE +{ + my $self = shift; + debug "untie"; + + if ( exists $self->{hash}) { + $self->unlock_untie; + warn "DB was still locked at untie time\n"; + } +} + +1; +__END__ + +=head1 NAME + +TWiki::Contrib::OpenIdRpContrib::DBLockPerAccess - DB_File wrapper which locks the file only per-access + +=head1 SYNOPSIS + + use TWiki::Contrib::OpenIdRpContrib::DBLockPerAccess; + + [$X =] tie %hash, "TWiki::Contrib::OpenIdRpContrib::DBLockPerAccess", $filename, $flags, $mode, $DB_HASH; + [$X =] tie %hash, 'DB_File::Lock', $filename, $flags, $mode, $DB_BTREE, $locking; + + ...use the same way as DB_File for the rest of the interface... + +=head1 DESCRIPTION + + Modified: twiki/trunk/OpenIdRpContrib/lib/TWiki/LoginManager/OpenID.pm =================================================================== --- twiki/trunk/OpenIdRpContrib/lib/TWiki/LoginManager/OpenID.pm 2010-01-28 13:37:06 UTC (rev 18306) +++ twiki/trunk/OpenIdRpContrib/lib/TWiki/LoginManager/OpenID.pm 2010-01-28 21:07:44 UTC (rev 18307) @@ -84,12 +84,7 @@ sub finish { my $this = shift; $this->complete(); # call to flush the session if not already done - undef $this->{_cookies}; - undef $this->{_authScripts}; - undef $this->{_cgisession}; - undef $this->{_haveCookie}; - undef $this->{_MYSCRIPTURL}; - undef $this->{twiki}; + $this->SUPER::finish(); } @@ -121,7 +116,7 @@ # add CSS to the HTML head section my $head = $twiki->templates->expandTemplate('openidcss') .$twiki->templates->expandTemplate('leftbarlogincss'); - $twiki->addToHEAD('OpenIDConsumer_openidcss', $head ); + $twiki->addToHEAD('OpenIdRpContrib', $head ); # return the text for the LOGIN tag return $twiki->templates->expandTemplate('leftbarlogin'); @@ -159,17 +154,19 @@ if ( defined $val ) { $openid_p{$p_suffix} = $val; } - } + } } # get OpenID configuration info - my $ua_class = $TWiki::cfg{OpenIDConsumer}{ua_class} - or "LWP::UserAgent"; - my $required_root = (( exists $TWiki::cfg{OpenIDConsumer}{required_root}) - ? $TWiki::cfg{OpenIDConsumer}{required_root} - : $TWiki::cfg{DefaultUrlHost}).'/', - my $nonce_pattern = $TWiki::cfg{OpenIDConsumer}{nonce_pattern} - or "GJvxv_%s"; + my $ua_class = ( exists $TWiki::cfg{OpenIdRpContrib}{ua_class}) + ? $TWiki::cfg{OpenIdRpContrib}{ua_class} + : "LWP::UserAgent"; + my $required_root = (( exists $TWiki::cfg{OpenIdRpContrib}{required_root}) + ? $TWiki::cfg{OpenIdRpContrib}{required_root} + : $TWiki::cfg{DefaultUrlHost}).'/', + my $nonce_pattern = ( exists $TWiki::cfg{OpenIdRpContrib}{nonce_pattern}) + ? $TWiki::cfg{OpenIdRpContrib}{nonce_pattern} + : "GJvxv_%s"; my $consumer_secret = sub { sprintf($nonce_pattern, shift^0xCAFEFEED )}; my $cache = Cache::FileCache->new({ namespace => 'OpenIdRpContrib' }); @@ -195,17 +192,17 @@ if (my $setup_url = $csr->user_setup_url) { # the OpenID request failed, requiring the user to perform setup throw TWiki::OopsException( - 'openid_setup_required', - web => $web, - topic => $topic, + 'generic', + web => $twiki->{web}, + topic => $twiki->{topic}, params => [ 'OpenID Provider <a href="'.$setup_url .'">requires setup</a>' ]); } elsif ($csr->user_cancel) { # the user or provider canceled the request throw TWiki::OopsException( - 'openid_cancel', - web => $web, - topic => $topic, + 'generic', + web => $twiki->{web}, + topic => $twiki->{topic}, params => [ 'cancel received from OpenID Provider' ]); } elsif (my $vident = $csr->verified_identity) { # success, redirect back as the logged-in user @@ -215,9 +212,9 @@ } else { # catch-all reporting for other errors throw TWiki::OopsException( - 'openid_response_error', - web => $web, - topic => $topic, + 'generic', + web => $twiki->{web}, + topic => $twiki->{topic}, params => [ 'OpenID error: '.$csr->errcode() ]); } } elsif ( defined $loginName ) { @@ -247,9 +244,9 @@ TWiki::Func::redirectCgiQuery( $query, $check_url, 0 ); } else { throw TWiki::OopsException( - 'openid_claimed_identity_error', - web => $web, - topic => $topic, + 'generic', + web => $twiki->{web}, + topic => $twiki->{topic}, params => [ 'error in OpenID claimed identity: ' .$csr->errcode() ]); } Modified: twiki/trunk/OpenIdRpContrib/lib/TWiki/Users/OpenIDMapping.pm =================================================================== --- twiki/trunk/OpenIdRpContrib/lib/TWiki/Users/OpenIDMapping.pm 2010-01-28 13:37:06 UTC (rev 18306) +++ twiki/trunk/OpenIdRpContrib/lib/TWiki/Users/OpenIDMapping.pm 2010-01-28 21:07:44 UTC (rev 18307) @@ -34,12 +34,13 @@ use strict; use base 'TWiki::Users::TWikiUserMapping'; -use Error qw( :try ); # included with Perl -use Assert; # included with TWiki -use TWiki::Func; # included with TWiki -use DB_File::Lock; # included with OpenIdRpContrib -use TWiki::LoginManager::OpenID; # included with OpenIdRpContrib -use Net::OpenID::Consumer; # CPAN dependency +use Error qw( :try ); # included with Perl +use DB_File; # included with Perl +use Assert; # included with TWiki +use TWiki::Func; # included with TWiki +use TWiki::Contrib::OpenIdRpContrib::DBLockPerAccess; # included with OpenIdRpContrib +use TWiki::LoginManager::OpenID; # included with OpenIdRpContrib +use Net::OpenID::Consumer; # CPAN dependency #use Monitor; #Monitor::MonitorMethod('TWiki::Users::OpenIDMapping'); @@ -163,13 +164,16 @@ # initialize DB tied hashes my $mode; + my $session = $this->{session}; + my $exception = sub { throw TWiki::OopsException( 'generic', + web => $session->{web}, topic => $session->{topic}, + params => [ @_ ]); }; foreach $mode ( "L2U", "U2W", "W2U" ) { # derive DB file name my $db_filename = $TWiki::cfg{DataDir}."/OpenID-$mode.db"; # open DB file - #tie(%{$this->{$mode}}, 'DB_File::Lock', $db_filename, O_RDONLY, 0600, $DB_HASH, 'read'); - tie(%{$this->{$mode}}, 'DB_File', $db_filename, O_RDONLY, 0600, $DB_HASH, 'read'); + tie(%{$this->{$mode}}, 'TWiki::Contrib::OpenIdRpContrib::DBLockPerAccess', $db_filename, O_RDWR|O_CREAT, 0600, $DB_HASH, $exception ); } } |