Index: test/unit/ClientTests.pm
===================================================================
--- test/unit/ClientTests.pm (revision 0)
+++ test/unit/ClientTests.pm (revision 0)
@@ -0,0 +1,140 @@
+use strict;
+
+package ClientTests;
+
+# This is woefully incomplete, but it does at least check that
+# Client.pm compiles okay.
+
+use base qw(TWikiTestCase);
+BEGIN {
+ unshift @INC, '../../bin';
+ require 'setlib.cfg';
+};
+
+use CGI;
+use Error qw( :try );
+
+use TWiki;
+use TWiki::Client;
+use TWiki::UI::View;
+use TWiki::UI::Edit;
+
+my $session;
+my $twikiRegistrationAgent = 'TWikiRegistrationAgent';
+my ( $joe, $agent, $userTopic );
+
+sub new {
+ my $this = shift()->SUPER::new(@_);
+ return $this;
+}
+
+sub list_tests {
+ my $this = shift;
+ my @set = $this->SUPER::list_tests();
+
+ my $clz = new Devel::Symdump(qw(ClientTests));
+ for my $i ($clz->functions()) {
+ next unless $i =~ /::verify_/;
+ foreach my $impl qw( TemplateLogin ApacheLogin NoLogin) {
+ my $fn = $i;
+ $fn =~ s/\W/_/g;
+ my $sfn = 'ClientTests::test_'.$fn.$impl;
+ no strict 'refs';
+ *$sfn = sub {
+ my $this = shift;
+ $TWiki::cfg{LoginManager} = 'TWiki::Client::'.$impl;
+ &$i($this);
+ };
+ use strict 'refs';
+ push(@set, $sfn);
+ }
+ }
+ return @set;
+}
+
+sub set_up {
+ my $this = shift;
+ $this->SUPER::set_up();
+
+ $session = new TWiki();
+
+ $TWiki::cfg{UseClientSessions} = 1;
+ $TWiki::cfg{PasswordManager} = "TWiki::Users::HtPasswdUser";
+ $TWiki::cfg{Htpasswd}{FileName} = "/tmp/htpasswd";
+ $TWiki::cfg{AuthScripts} = "edit";
+
+ # $this->setup_user();
+}
+
+sub set_up_user {
+ $joe = $session->{users}->findUser( "joe", "Main.JoeDoe" );
+ $agent = $session->{users}->findUser( $twikiRegistrationAgent,
+ $twikiRegistrationAgent);
+ $userTopic =
+ $session->{users}->addUserToTWikiUsersTopic( $joe, $agent);
+}
+
+sub tear_down {
+ my $this = shift;
+ $this->SUPER::tear_down();
+}
+
+sub testClient {
+ my $this = shift;
+
+ # make sure it compiles, at least.
+ $this->assert($TWiki::Client::VERSION >= 1.0, "version");
+}
+
+sub capture {
+ my $this = shift;
+ my( $proc, $session ) = @_;
+ $session->{client}->checkAccess();
+ $this->SUPER::capture( @_ );
+}
+
+sub verify_edit {
+ my $this = shift;
+ my ( $query, $text );
+
+ $query = new CGI ({});
+ $query->path_info( "/Main/WebHome" );
+ $ENV{SCRIPT_NAME} = "view";
+ $session = new TWiki( undef, $query );
+ try {
+ $text = $this->capture( \&TWiki::UI::View::view, $session );
+ } catch TWiki::OopsException with {
+ $this->assert(0,shift->stringify());
+ } catch Error::Simple with {
+ $this->assert(0,shift->stringify());
+ };
+
+ $query = new CGI ({});
+ $query->path_info( "/Main/WebHome" );
+ $ENV{SCRIPT_NAME} = "edit";
+ $session = new TWiki( undef, $query );
+
+ try {
+ $text = $this->capture( \&TWiki::UI::Edit::edit, $session );
+ } catch TWiki::AccessControlException with {
+ } catch Error::Simple with {
+ $this->assert(0,shift->stringify());
+ } otherwise {
+ $this->assert(0, "expected an oops redirect");
+ };
+
+ $query = new CGI ({});
+ $query->path_info( "/Main/WebHome" );
+ $ENV{SCRIPT_NAME} = "edit";
+ $session = new TWiki( "joe", $query );
+
+ try {
+ $text = $this->capture( \&TWiki::UI::Edit::edit, $session );
+ } catch TWiki::OopsException with {
+ $this->assert(0,shift->stringify());
+ } catch Error::Simple with {
+ $this->assert(0,shift->stringify());
+ };
+}
+
+1;
Index: lib/TWiki.pm
===================================================================
--- lib/TWiki.pm (revision 4649)
+++ lib/TWiki.pm (working copy)
@@ -424,6 +424,7 @@
use TWiki::Access; # access control
use TWiki::Attach; # file attachments
use TWiki::Attrs; # tag attribute handling
+use TWiki::Client; # client session handling
use TWiki::Form; # forms
use TWiki::Net; # SMTP, get URL
use TWiki::Plugins; # plugins handler
@@ -626,7 +627,11 @@
$hopts->{'Content-Type'} = $contentType;
# New (since 1.026)
- $this->{plugins}->modifyHeaderHandler($hopts);
+ $this->{plugins}->modifyHeaderHandler( $hopts );
+
+ # add cookie(s)
+ $this->{client}->modifyHeader( $hopts );
+
my $hdr = CGI::header( $hopts );
print $hdr;
@@ -660,6 +665,7 @@
if ( $query && $query->param( 'noredirect' )) {
my $content = join(' ', @_) . " \n";
$this->writeCompletePage( $query, $content );
+ } elsif ( $this->{client}->redirectCgiQuery( $query, $url ) ) {
} elsif ( $query ) {
print $query->redirect( $url );
}
@@ -971,6 +977,7 @@
$this->{search} = new TWiki::Search( $this );
$this->{templates} = new TWiki::Templates( $this );
$this->{attach} = new TWiki::Attach( $this );
+ $this->{client} = new TWiki::Client( $this );
# cache CGI information in the session object
$this->{cgiQuery} = $query;
$this->{remoteUser} = $remoteUser;
@@ -1088,12 +1095,18 @@
} else {
$this->{urlHost} = $TWiki::cfg{DefaultUrlHost};
}
+
+ # setup the cgi session, from a cookie or the url. this may return
+ # the login, but even if it does, plugins will get the chance to override
+ # it below.
+ my $login = $this->{client}->load();
+
# initialize preferences, first part for site and web level
$this->{prefs} = new TWiki::Prefs( $this );
# SMELL: there should be a way for the plugin to specify
# the WikiName of the user as well as the login.
- my $login = $this->{plugins}->load( $TWiki::cfg{DisableAllPlugins} );
+ $login = $this->{plugins}->load( $TWiki::cfg{DisableAllPlugins} ) || $login;
unless( $login ) {
$login = $this->{users}->initializeRemoteUser( $remoteUser );
}
@@ -1138,6 +1151,21 @@
=pod
+---++ ObjectMethod finish
+Complete processing after the client's HTTP request has been responded
+to. Right now this only entails one activity: calling TWiki::Client to
+flushing the user's
+session (if any) to disk.
+
+=cut
+
+sub finish {
+ my $this = shift;
+ $this->{client}->finish();
+}
+
+=pod
+
---++ ObjectMethod writeLog ( $action, $webTopic, $extra, $user )
* =$action= - what happened, e.g. view, save, rename
* =$wbTopic= - what it happened to
@@ -2073,7 +2101,7 @@
=pod
----++ StaticMethod registerTagHandler( $fnref )
+---++ StaticMethod registerTagHandler( $tag, $fnref )
STATIC Add a tag handler to the function tag handlers.
* =$tag= name of the tag e.g. MYTAG
Index: lib/TWiki.cfg
===================================================================
--- lib/TWiki.cfg (revision 4649)
+++ lib/TWiki.cfg (working copy)
@@ -105,8 +105,8 @@
$cfg{RemoteUserFileName} = "$cfg{DataDir}/remoteusers.txt";
# **SELECT TWiki::Users::HtPasswdUser,TWiki::Users::NoPasswdUser**
-# TWiki doesn't do its own authentication, but instead works closely
-# with the web server that does the authentication. The following
+# TWiki can do its own authentication or work closely
+# with the web server to do it. The following
# settings are used in the TWiki registration scripts to help maintain
# users and passwords in the web server's authentication environment.
# Name of the password handler implementation. TWiki ships with two
@@ -122,6 +122,23 @@
# to your package from here.
$cfg{PasswordManager} = 'TWiki::Users::HtPasswdUser';
+# **SELECT TWiki::Client::ApacheLogin,TWiki::Client::TemplateLogin,TWiki::Client::NoLogin**
+# TWiki supports different ways of responding when the user asks to log
+# in (or is required to log in). They are:
+#
-
+# TWiki::Client::TemplateLogin - Redirect to the login template, which
+# asks for a username and password in a form instead of in a browser-specific
+# dialog box. This is the same behavior as AuthPagePlugin.
+#
-
+# TWiki::Client::ApacheLogin - Redirect to an '...auth' script for which
+# Apache can be configured to ask for authorization information.
+#
-
+# TWiki::Client::NoLogin - Don't support logging in.
+#
+# You can provide your own alternative by implementing the authenticate method
+# in a new package, and pointing to your package from here.
+$cfg{LoginManager} = 'TWiki::Client::NoLogin';
+
# **PATH**
# Path to the file that stores passwords, for TWiki::Users::HtPasswdUser.
# You can use the htpasswd Apache program to create a new
@@ -169,6 +186,26 @@
# use TWiki to manually rename the existing topic
$cfg{UsersTopicName} = 'TWikiUsers';
+# **BOOLEAN**
+# Use persistent CGI session tracking?
+$cfg{UseClientSessions} = 1;
+
+# **STRING 20**
+# Name of the "sticky skin" client session variable
+$cfg{StickSkinVar} = "stickskin";
+
+# **STRING 20**
+# Value for StickSkinVar that resets the user's skin preference to
+# the TWiki default.
+$cfg{StickSkinOffValue} = "default";
+
+# **STRING 80**
+# Regular expression to describe which scripts require the user to authenticate.
+# If you're doing authentication, a good value is "attach, edit, manage,
+# passwd, rename, resetpasswd, save, upload, viewauth, rdiffauth". If
+# you don't want to require authentication, then leave this blank.
+$cfg{AuthScripts} = "";
+
# **PATH**
# Path control. If set, overrides the default PATH setting to control
# where TWiki looks for programs. Check notes for your operating
Index: lib/TWiki/UI.pm
===================================================================
--- lib/TWiki/UI.pm (revision 4649)
+++ lib/TWiki/UI.pm (working copy)
@@ -65,7 +65,6 @@
if( $ENV{'GATEWAY_INTERFACE'} ) {
# script is called by browser
$query = new CGI;
- $user = $query->remote_user();
} else {
# script is called by cron job or user
$scripted = 1;
@@ -104,56 +103,21 @@
# end of comment out in production version
try {
+ $session->{client}->checkAccess();
&$method( $session );
} catch TWiki::AccessControlException with {
my $e = shift;
- # Had an access control violation. See if there is an 'auth' version
- # of this script, may be a result of not being logged in.
- my $url;
- $script =~ s/^(.*\/)([^\/]+)($TWiki::cfg{ScriptSuffix})?$/$1/;
- my $scriptPath = $1;
- my $scriptName = $2;
- $script .= "$scriptPath${scriptName}auth$TWiki::cfg{ScriptSuffix}";
- if( ! $query->remote_user() && -e $script ) {
- $url = $ENV{REQUEST_URI};
- if( $url && $url =~ s/\/$scriptName/\/${scriptName}auth/ ) {
- # $url i.e. is "twiki/bin/view.cgi/Web/Topic?cms1=val1&cmd2=val2"
- $url = $session->{urlHost}.$url;
- } else {
- # If REQUEST_URI is rewritten and does not contain the script
- # name, try looking at the CGI environment variable
- # SCRIPT_NAME.
- #
- # Assemble the new URL using the host, the changed script name,
- # the path info, and the query string. All three query
- # variables are in the list of the canonical request meta
- # variables in CGI 1.1.
- $scriptPath = $ENV{'SCRIPT_NAME'};
- my $pathInfo = $ENV{'PATH_INFO'};
- my $queryString = $ENV{'QUERY_STRING'};
- $pathInfo = '/' . $pathInfo if ($pathInfo);
- $queryString = '?' . $queryString if ($queryString);
- if( $scriptPath && $scriptPath =~ s/\/$scriptName/\/${scriptName}auth/ ) {
- $url = $session->{urlHost}.$scriptPath;
- } else {
- # If SCRIPT_NAME does not contain the script name
- # the last hope is to try building up the URL using
- # the SCRIPT_FILENAME.
- $url = $session->{urlhost}.$session->{scriptUrlPath}.'/'.
- ${scriptName}.$TWiki::cfg{ScriptSuffix};
- }
- $url .= $pathInfo.$queryString;
- }
- $session->redirect( $url );
+ if( $session->{client}->authenticate() ) {
+ # okay
} else {
- $url = $session->getOopsUrl( 'accessdenied',
+ my $url = $session->getOopsUrl( 'accessdenied',
def => 'topic_access',
web => $e->{web},
topic => $e->{topic},
params => [ $e->{mode},
$e->{reason} ] );
+ $session->redirect( $url );
}
- $session->redirect( $url );
} catch TWiki::OopsException with {
my $e = shift;
@@ -174,6 +138,8 @@
print "Content-type: text/plain\n\n";
print $e->stringify();
};
+
+ $session->finish();
}
=pod twiki
Index: lib/TWiki/Client.pm
===================================================================
--- lib/TWiki/Client.pm (revision 0)
+++ lib/TWiki/Client.pm (revision 0)
@@ -0,0 +1,775 @@
+# TWiki Enterprise Collaboration Platform, http://TWiki.org/
+#
+# Copyright (C) 2005 Peter Thoeny, peter@thoeny.com
+# and TWiki Contributors. All Rights Reserved. TWiki Contributors
+# are listed in the AUTHORS file in the root of this distribution.
+# NOTE: Please extend that file, not this notice.
+#
+# Additional copyrights apply to some or all of the code in this
+# file as follows:
+# Copyright (C) 2000-2003 Andrea Sterbini, a.sterbini@flashnet.it
+# Copyright (C) 2005 Garage Games
+# Copyright (C) 2005 Crawford Currie http://c-dot.co.uk
+# Copyright (C) 2005 Greg Abbas, twiki@abbas.org
+#
+# 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.
+
+=pod
+
+---+ package TWiki::Client
+This module defines the object that handles Client session
+management. It's based heavily on SessionPlugin & AuthPagePlugin.
+
+=cut
+
+package TWiki::Client;
+
+use strict;
+use Assert;
+use Error qw( :try );
+
+# if you want to turn on ip matching, change the "use CGI::Session"
+# statement below to "use CGI::Session qw/-ip_match/".
+#
+# ip matching used to be the recommended approach, but it isn't anymore
+# because it has a bunch of drawbacks. specifically:
+# * it doesn't help much if clients are behind a NAT firewall
+# * it doesn't help much because if a hacker can steal a session id, they
+# can steal your password too
+# * it breaks clients that get their IP addresses reassigned by DHCP
+# * it breaks clients that change their apparent IP address (e.g. VPN)
+use CGI::Session;
+use CGI::Cookie;
+
+BEGIN {
+ # suppress stupid warning in CGI::Cookie
+ if ( exists $ENV{MOD_PERL} ) {
+ if ( !defined( $ENV{MOD_PERL_API_VERSION} )) {
+ $ENV{MOD_PERL_API_VERSION} = 1;
+ }
+ }
+}
+
+=pod
+
+---++ ClassMethod new( $session )
+
+Construct new client object.
+
+=cut
+
+sub new {
+ my ( $class, $session ) = @_;
+ my $this = bless( {}, $class );
+ ASSERT($session->isa( 'TWiki')) if DEBUG;
+ $this->{twiki} = $session;
+
+ $this->{cookies} = [];
+ @{$this->{authScripts}} = split( /[\s,]+/, $TWiki::cfg{AuthScripts} );
+
+ return $this;
+}
+
+=pod
+
+---++ ObjectMethod load()
+
+Get the client session data, using the cookie and/or the request URL.
+
+=cut
+
+sub load {
+ my $this = shift;
+
+ return unless( $TWiki::cfg{UseClientSessions} );
+
+ eval "use $TWiki::cfg{LoginManager}";
+ throw Error::Simple( 'Login Manager: '.$@) if $@;
+
+ my $query = $this->{twiki}->{cgiQuery};
+
+ my $twiki = $this->{twiki};
+
+ # Initialize the session (you may wish to change this directory,
+ # but /tmp is probably best)
+ #
+ # Borrowing from the previous version of TWiki, perhaps using:
+ #
+ # TWiki::Func::getDataDir() . '/.session'
+ #
+ # would work well for you. Just be sure to create data/.session
+ # and make it writable by the webserver.
+ #
+ # Another experiment might be to change your serializer. Storable
+ # is a good option. See CGI::Session on http://search.cpan.org/
+ # for more information on adding ';initializer:Storable' after the
+ # 'driver:File' below (other serializers are available as well).
+
+ $this->{haveCookie} = defined($query->raw_cookie( $CGI::Session::NAME ));
+
+ my $cgisession = new CGI::Session( 'driver:File', $query,
+ { Directory=>'/tmp' } );
+
+ $this->{cgisession} = $cgisession;
+
+ my $sessionId = $cgisession->id();
+ $this->{sessionId} = $sessionId;
+
+ my $guest = $TWiki::cfg{DefaultUserLogin};
+
+ # For added security, every time a user logs in and gives
+ # us a user to check, verify that the user we're
+ # about to flush to the session file is the same as the
+ # user already stored in the session file.
+ #
+ # If there is another valid username stored in the session file,
+ # then someone has somehow just borrowed a session ID from someone
+ # else. To prevent further havoc, clear this session ID (perhaps
+ # in the future it'd be better just to dispatch a new session ID
+ # to this user; however, if they already have the session ID of
+ # another user, it's probably best to get rid of it since it has
+ # been compromised).
+ #
+ $TWiki::cfg{LoginManager}->checkSession( $this );
+
+ # See whether the user was logged in (first webserver, then
+ # session, then default)
+ my $authUser = $TWiki::cfg{LoginManager}->getUser( $this );
+ $authUser ||= $cgisession->param( 'AUTHUSER' );
+
+ # if we couldn't get the login manager or the http session to tell
+ # us who the user is, then let's use the CGI "remote user"
+ # variable (which may have been set manually by a unit test,
+ # or it might have come from Apache).
+ $authUser ||= $twiki->{remoteUser}; # $guest
+
+ #if ( $ENV{'REDIRECT_STATUS'} eq '401' ) {
+ # # invalidating session due to 401 status
+ # $cgisession->clear();
+ # return 1;
+ #}
+
+ # Save the user's information again if they do not appear to be a guest
+ my $sessionIsAuthenticated = ( $authUser ne $guest );
+
+ my $do_logout = defined( $query ) && $query->param( 'logout' );
+ if( $do_logout ) {
+ $sessionIsAuthenticated = 0;
+ $authUser = undef;
+ }
+ if( ( $do_logout || $sessionIsAuthenticated )) {
+ $cgisession->param( 'AUTHUSER', $authUser );
+ $cgisession->flush();
+ }
+ if( $do_logout ) {
+ my $origurl = $query->url() . $query->path_info();
+ #my $url = $twiki->getScriptUrl( $web, $topic, '' ).
+ # '?origurl='.$origurl;
+ $this->redirectCgiQuery( $query, $origurl );
+
+ # mod_perl is okay with calling exit (it patches it) but
+ # the unit tests aren't. so doing a "redirect abort" should
+ # probably terminate processing using an exception.
+ # exit 0;
+ }
+
+ # SMELL: $TWiki::cfg{UseTransSessionId} is not set in TWiki.cfg,
+ # and it isn't clear what it should be set to even if it is.
+ # $useTransSID sets whether or not to use
+ # transparent CGI session IDs. If cookies are working, turn
+ # this off. Otherwise, set it to whatever the user set in
+ # $useTransSessionId. Still report to the user though that
+ # %USE_TRANS_SESSIONID% is set to $useTransSessionId
+ my $useTransSID = (defined($query) &&
+ $query->cookie( $CGI::Session::NAME ))
+ ? 0 : $TWiki::cfg{UseTransSessionId};
+
+ # Save our state to member variables, because we'll need them later.
+ $this->{authUser} = $authUser;
+ $this->{sessionIsAuthenticated} = $sessionIsAuthenticated;
+ $this->{useTransSID} = $useTransSID;
+
+ # register tag handlers and values
+ TWiki::registerTagHandler('SESSIONLOGONURL', \&_SESSIONLOGONURL );
+ TWiki::registerTagHandler('SESSIONLOGONURLPATH', \&_SESSIONLOGONURLPATH );
+ TWiki::registerTagHandler('LOGIN', \&_LOGIN );
+ TWiki::registerTagHandler('LOGOUT',\&_LOGOUT );
+ TWiki::registerTagHandler('SESSION_VARIABLE', \&_SESSION_VARIABLE );
+ TWiki::registerTagHandler('AUTHENTICATED', \&_AUTHENTICATED );
+
+ $twiki->{SESSION_TAGS}{SESSIONID} = ( $sessionId || '');
+ $twiki->{SESSION_TAGS}{SESSIONVAR} = ( $CGI::Session::NAME || '');
+ $twiki->{SESSION_TAGS}{SESSION_IS_AUTHENTICATED} =
+ ( $sessionIsAuthenticated || '');
+ $twiki->{SESSION_TAGS}{STICKSKIN} =
+ ( defined($query) && $query->param( $TWiki::cfg{StickSkinVar} )) || '';
+ $twiki->{SESSION_TAGS}{AUTHUSER_SESSIONVAR} = 'AUTHUSER';
+ $twiki->{SESSION_TAGS}{DO_SESSION_IP_MATCHING} =
+ ( $CGI::Session::IP_MATCH ? 1 : 0 );
+ $twiki->{SESSION_TAGS}{USE_TRANS_SESSIONID} = ( $useTransSID || '');
+ $twiki->{SESSION_TAGS}{STICKSKINVAR} =
+ ( $TWiki::cfg{StickSkinVar} || '' );
+ $twiki->{SESSION_TAGS}{STICKSKINOFFVALUE} =
+ ( $TWiki::cfg{StickSkinOffValue} || '' );
+
+ return $authUser;
+}
+
+=pod
+
+---++ ObjectMethod checkAccess
+
+=cut
+
+sub checkAccess {
+
+ return unless( $TWiki::cfg{UseClientSessions} );
+
+ my $this = shift;
+
+ if( !$this->{sessionIsAuthenticated} ) {
+ my $script = $ENV{'SCRIPT_NAME'} || $ENV{'SCRIPT_FILENAME'};
+ $script =~ s@^.*/([^/]+)@$1@g;
+
+ if( defined $script) {
+ my $found = 0;
+ for (@{$this->{authScripts}}) {
+ $found = 1 if( $script eq $_ );
+ }
+
+ if( $found ) {
+ my $topic = $this->{twiki}->{topicName};
+ my $web = $this->{twiki}->{webName};
+ throw TWiki::AccessControlException(
+ $script, $this->{twiki}->{user}, $web, $topic,
+ "authorization required");
+ }
+ }
+ }
+}
+
+=pod
+
+---++ ObjectMethod finish
+Complete processing after the client's HTTP request has been responded
+to. Flush the user's session (if any) to disk.
+
+=cut
+
+sub finish {
+ return unless( $TWiki::cfg{UseClientSessions} );
+ my $this = shift;
+ my $cgisession = $this->{cgisession};
+
+ # this predicate used to be
+ # $this->{sessionIsAuthenticated} && defined($cgisession),
+ # but that had the problem that sometimes an unauthenticated version
+ # of the session would overwrite the more recent authenticated version
+ # on disk. that's because with mod_perl, an unflushed session object
+ # would sometimes hang around. then when the apache server was
+ # terminated, it would get flushed. this way, if we didn't get a
+ # cookie then we'll tell the session manager that we don't want
+ # it to _ever_ flush the session.
+ if($this->{haveCookie}) {
+ $cgisession->flush();
+ } else {
+ # this is drastic and not really necessary, but unfortunately
+ # CGI::Session makes it impossible for us to say "don't
+ # _bother_ writing it to disk if you haven't already". :-(
+ $cgisession->delete();
+ }
+}
+
+=pod
+
+---++ ObjectMethod userLoggedIn()
+
+Call this when the user logs in. It's invoked from TWiki::UI::Register::finish
+for instance, when the user follows the link in their verification email
+message.
+
+=cut
+
+sub userLoggedIn {
+ my ( $this, $authUser, $wikiName ) = @_;
+
+ my $cgisession = $this->{cgisession};
+ my $sessionIsAuthenticated = defined($authUser) ? 1 : 0;
+
+ if( $TWiki::cfg{DefaultUserLogin} ne $authUser ) {
+ $cgisession->param( 'AUTHUSER', $authUser );
+ $cgisession->flush();
+ }
+
+ $this->{authUser} = $authUser;
+ $this->{sessionIsAuthenticated} = $sessionIsAuthenticated;
+}
+
+=pod
+
+---++ ObjectMethod endRenderingHandler()
+SMELL: this method uses the plugins endRenderingHandler method which is
+deprecated, and stunningly inefficient. It badly needs to be refactored.
+
+=cut
+
+sub endRenderingHandler {
+ return unless( $TWiki::cfg{UseClientSessions} );
+
+ my $this = shift;
+
+ my $useTransSID = $this->{useTransSID};
+ my $sessionId = $this->{sessionId};
+
+ # This handler is called by getRenderedVersion just after the line loop, that is,
+ # after almost all XHTML rendering of a topic. tags are removed after this.
+
+ # If cookies are not turned on and transparent CGI session IDs are,
+ # grab every URL that is an internal link and pass a CGI variable
+ # with the session ID
+ if( $useTransSID ) {
+ # Internal links are specified by forms, hrefs, or onclicks that either
+ # point to a link with no colons in it or links that match links that
+ # would bve returned by getScriptUrl. Internal links are additionally
+ # specified by forms that have no target.
+
+ # Gather the URLs one would expect to be returned by getScriptUrl if a URL
+ # was inside of quotes (A) or outside of quotes (B) or inside of single quotes
+ # for javascript (C).
+ #
+ # Use these later in all the regex's below.
+ my $myScriptUrlA = quotemeta($this->{twiki}->getScriptUrl( "ZZZZ", "ZZZZ", "ZZZZ" ));
+ my $myScriptUrlB = $myScriptUrlA;
+ my $myScriptUrlC = $myScriptUrlA;
+ $myScriptUrlA =~ s/ZZZZ/[^"#]*?/g;
+ $myScriptUrlB =~ s/ZZZZ/[^\\s#>]*?/g;
+ $myScriptUrlC =~ s/ZZZZ/[^'#>]*?/g;
+
+ #
+ # NOTE: Lots of the defined's here are to quiet down the highly overrated perl -w
+ #
+
+ # Catch hyperlinks with targets containing no colon
+ $_[0] =~ s/(]*?(?<=\s)href=)(?:(")([^:]*?)([#"])|([^:]*?(?=[#\s>])))/@{[ defined($5) ? "$1$5" : "$1$2$3" ]}@{[ ( (defined($3) && ($3=~m!\?!))||(defined($5) && ($5=~m!\?!)) ) ? "&" : "?" ]}$CGI::Session::NAME=$sessionId@{[defined($4) ? "$4" : ""]}/goi;
+
+ # Catch hyperlinks with targets that could be returned by getScriptUrl
+ $_[0] =~ s/(]*?(?<=\s)href=)(?:(")((?-i:$myScriptUrlA[^"#]*?))([#"])|((?-i:$myScriptUrlB[^\s#>]*?).*?(?=[#\s>])))/@{[ defined($5) ? "$1$5" : "$1$2$3"]}@{[( (defined($3) && ($3=~m!\?!))||(defined($5) && ($5=~m!\?!)) )? "&" : "?" ]}$CGI::Session::NAME=$sessionId@{[ defined($4) ? "$4" : ""]}/goi;
+
+ # Catch onclicks that trigger changes of location.href to targets with no colon
+ $_[0] =~ s/(<[^>]*?\sonclick=(?:"[^"]*?|)(?=(?:javascript:|))location\.href=)(')([^:]*?)([#'])/$1$2$3@{[ ($3=~m!\?!) ? "&" :"?" ]}$CGI::Session::NAME=$sessionId$4/goi;
+
+ # Catch onclicks that trigger changes of location.href to targets that could be returned by getScriptUrl
+ $_[0] =~ s/(<[^>]*?\sonclick=(?:"[^"]*?|)(?=(?:javascript:|))location\.href=)(')((?-i:$myScriptUrlC[^'#]*?))([#'])/$1$2$3@{[ ($3=~m!\?!) ? "&" : "?" ]}$CGI::Session::NAME=$sessionId$4/goi;
+
+
+ # Catch all FORM elements and add a hidden Session ID variable
+ #
+ # Only do this if the form is pointing to an internal link. This occurs if there are no
+ # colons in its target, if it has no target, or if its target matches a getScriptUrl URL.
+ #
+ $_[0] =~ s%(