lib/TWiki/UI/Register.pm
changeset 0 414e01d06fd5
child 1 e2915a7cbdfa
     1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/lib/TWiki/UI/Register.pm	Sat Jan 26 15:50:53 2008 +0100
     1.3 @@ -0,0 +1,1320 @@
     1.4 +# Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/
     1.5 +#
     1.6 +# Copyright (C) 1999-2007 Peter Thoeny, peter@thoeny.org
     1.7 +# and TWiki Contributors. All Rights Reserved. TWiki Contributors
     1.8 +# are listed in the AUTHORS file in the root of this distribution.
     1.9 +# NOTE: Please extend that file, not this notice.
    1.10 +#
    1.11 +# Additional copyrights apply to some or all of the code in this
    1.12 +# file as follows:
    1.13 +# Copyright (c) 1999-2004 Peter Thoeny, peter@thoeny.com
    1.14 +#           (c) 2001 Kevin Atkinson, kevin twiki at atkinson dhs org
    1.15 +#           (c) 2003 SvenDowideit
    1.16 +#           (c) 2003 Graeme Pyle graeme@raspberry dot co dot za
    1.17 +#           (c) 2004 Martin Cleaver, Martin.Cleaver@BCS.org.uk
    1.18 +#           (c) 2004 Gilles-Eric Descamps twiki at descamps.org
    1.19 +#           (c) 2004-2007 Crawford Currie c-dot.co.uk
    1.20 +#
    1.21 +# This program is free software; you can redistribute it and/or
    1.22 +# modify it under the terms of the GNU General Public License
    1.23 +# as published by the Free Software Foundation; either version 2
    1.24 +# of the License, or (at your option) any later version. For
    1.25 +# more details read LICENSE in the root of this distribution.
    1.26 +#
    1.27 +# This program is distributed in the hope that it will be useful,
    1.28 +# but WITHOUT ANY WARRANTY; without even the implied warranty of
    1.29 +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
    1.30 +#
    1.31 +# As per the GPL, removal of this notice is prohibited.
    1.32 +
    1.33 +=pod
    1.34 +
    1.35 +---+ package TWiki::UI::Register
    1.36 +
    1.37 +User registration handling.
    1.38 +
    1.39 +=cut
    1.40 +
    1.41 +package TWiki::UI::Register;
    1.42 +
    1.43 +use strict;
    1.44 +use Assert;
    1.45 +use Error qw( :try );
    1.46 +
    1.47 +require TWiki;
    1.48 +require TWiki::OopsException;
    1.49 +require TWiki::Sandbox;
    1.50 +
    1.51 +my $agent = 'TWikiRegistrationAgent';
    1.52 +
    1.53 +# Keys from the user data that should *not* be included in
    1.54 +# the user topic.
    1.55 +my %SKIPKEYS = (
    1.56 +    'Photo' => 1,
    1.57 +    'WikiName' => 1,
    1.58 +    'LoginName' => 1,
    1.59 +    'Password' => 1,
    1.60 +    'Email' => 1
    1.61 +   );
    1.62 +
    1.63 +=pod
    1.64 +
    1.65 +---++ StaticMethod register_cgi( $session )
    1.66 +
    1.67 +=register= command handler.
    1.68 +This method is designed to be
    1.69 +invoked via the =UI::run= method.
    1.70 +
    1.71 +=cut
    1.72 +
    1.73 +sub register_cgi {
    1.74 +    my $session = shift;
    1.75 +
    1.76 +    # absolute URL context for email generation
    1.77 +    $session->enterContext('absolute_urls');
    1.78 +
    1.79 +    my $needApproval = 0;
    1.80 +
    1.81 +    # Register -> Verify -> Approve -> Finish
    1.82 +
    1.83 +    # NB. bulkRegister invoked from ManageCgiScript.
    1.84 +
    1.85 +    my $action = $session->{cgiQuery}->param('action') || '';
    1.86 +
    1.87 +    if ($action eq 'register') {
    1.88 +      if (!$session->inContext('registration_supported')) {
    1.89 +        throw TWiki::OopsException( 'attention',
    1.90 +                                    web => $session->{webName},
    1.91 +                                    topic => $session->{topicName},
    1.92 +                                    def => 'registration_not_supported' );
    1.93 +      }
    1.94 +      if (!$TWiki::cfg{Register}{EnableNewUserRegistration}) {
    1.95 +        throw TWiki::OopsException( 'attention',
    1.96 +                                    web => $session->{webName},
    1.97 +                                    topic => $session->{topicName},
    1.98 +                                    def => 'registration_disabled' );
    1.99 +      }
   1.100 +      registerAndNext($session);
   1.101 +    }
   1.102 +    elsif ($action eq 'verify') {
   1.103 +        verifyEmailAddress( $session );
   1.104 +        if ($needApproval) {
   1.105 +            throw Error::Simple('Approval code has not been written!');
   1.106 +        }
   1.107 +        complete( $session);
   1.108 +    }
   1.109 +    elsif ($action eq 'resetPassword') {
   1.110 +        resetPassword( $session );
   1.111 +    }
   1.112 +    elsif ($action eq 'approve') {
   1.113 +        complete($session );
   1.114 +    }
   1.115 +    else {
   1.116 +        registerAndNext($session);
   1.117 +    }
   1.118 +
   1.119 +    $session->leaveContext('absolute_urls');
   1.120 +
   1.121 +    # Output of register:
   1.122 +    #    UnsavedUser, accessible by username.$verificationCode
   1.123 +
   1.124 +    # Output of reset password:
   1.125 +    #    unaffected user, accessible by username.$verificationCode
   1.126 +
   1.127 +    # Output of verify:
   1.128 +    #    UnsavedUser, accessible by username.$approvalCode (only sent to administrator)
   1.129 +
   1.130 +    # Output of approve:
   1.131 +    #    RegisteredUser, all related UnsavedUsers deleted
   1.132 +}
   1.133 +
   1.134 +my $b1 = "\t* ";
   1.135 +my $b2 ="\t$b1";
   1.136 +
   1.137 +=pod
   1.138 +
   1.139 +---++ StaticMethod bulkRegister($session)
   1.140 +
   1.141 +  Called by ManageCgiScript::bulkRegister (requires authentication) with topic = the page with the entries on it.
   1.142 +
   1.143 +=cut
   1.144 +
   1.145 +sub bulkRegister {
   1.146 +    my $session = shift;
   1.147 +
   1.148 +    my $user = $session->{user};
   1.149 +    my $topic = $session->{topicName};
   1.150 +    my $web = $session->{webName};
   1.151 +    my $userweb = $TWiki::cfg{UsersWebName};
   1.152 +    my $query = $session->{cgiQuery};
   1.153 +
   1.154 +    # absolute URL context for email generation
   1.155 +    $session->enterContext('absolute_urls');
   1.156 +
   1.157 +    my $settings = {};
   1.158 +    # This gets set from the value in the BulkRegistrations topic
   1.159 +    $settings->{doOverwriteTopics} =
   1.160 +      $query->param('OverwriteHomeTopics') || 0;
   1.161 +    $settings->{doEmailUserDetails} =
   1.162 +      $query->param('EmailUsersWithDetails') || 0;
   1.163 +
   1.164 +    unless( $session->{users}->isAdmin( $user ) ) {
   1.165 +        throw TWiki::OopsException(
   1.166 +            'accessdenied', def => 'only_group',
   1.167 +            web => $web, topic => $topic,
   1.168 +            params => [ $TWiki::cfg{SuperAdminGroup} ] );
   1.169 +    }
   1.170 +
   1.171 +    #-- Read the topic containing the table of people to be registered
   1.172 +
   1.173 +    my ($meta, $text) = $session->{store}->readTopic(
   1.174 +        undef, $web, $topic, undef );
   1.175 +    my @fields;
   1.176 +    my @data;
   1.177 +    my $gotHdr = 0;
   1.178 +    foreach my $line ( split( /\r?\n/, $text ) ) {
   1.179 +        if( $line =~ /^\s*\|\s*(.*?)\s*\|\s*$/) {
   1.180 +            if( $gotHdr ) {
   1.181 +                my $i = 0;
   1.182 +                my %row = map { $fields[$i++] => $_ } split( /\s*\|\s*/, $1 );
   1.183 +                push(@data, \%row);
   1.184 +            } else {
   1.185 +                foreach my $field ( split( /\s*\|\s*/, $1 )) {
   1.186 +                    $field =~ s/^[\s*]*(.*?)[\s*]*$/$1/;
   1.187 +                    push( @fields, $field);
   1.188 +                }
   1.189 +                $gotHdr = 1;
   1.190 +            }
   1.191 +        }
   1.192 +    }
   1.193 +
   1.194 +    my $log = "---+ Report for Bulk Register\n";
   1.195 +
   1.196 +    #-- Process each row, generate a log as we go
   1.197 +    for( my $n = 0; $n < scalar(@data); $n++) {
   1.198 +        my $row = $data[$n];
   1.199 +        $row->{webName} = $userweb;
   1.200 +
   1.201 +        #-- Following two lines untaint WikiName as required and verify it is
   1.202 +        #-- not zero length
   1.203 +        if (!$row->{WikiName}) {
   1.204 +            $log .= "---++ Failed to register user on row $n: no !WikiName\n";
   1.205 +            next;
   1.206 +        }
   1.207 +        $row->{WikiName} = TWiki::Sandbox::untaintUnchecked($row->{WikiName});
   1.208 +        $row->{LoginName} = $row->{WikiName} unless $row->{LoginName};
   1.209 +
   1.210 +        $log .= _registerSingleBulkUser(
   1.211 +            $session, \@fields, $row, $settings );
   1.212 +    }
   1.213 +
   1.214 +    $log .= "----\n";
   1.215 +
   1.216 +    my $logWeb;
   1.217 +    my $logTopic =  $query->param('LogTopic') || $topic.'Result';
   1.218 +    ( $logWeb, $logTopic ) = $session->normalizeWebTopicName( '', $logTopic );
   1.219 +
   1.220 +    #-- Save the LogFile as designated, link back to the source topic 
   1.221 +    $meta->put( 'TOPICPARENT', { name => $web.'.'.$topic } );
   1.222 +    my $err = $session->{store}->saveTopic($user, $logWeb, $logTopic, $log, $meta );
   1.223 +
   1.224 +    $session->leaveContext('absolute_urls');
   1.225 +
   1.226 +    $session->redirect($session->getScriptUrl( 1, 'view', $web, $logTopic ));
   1.227 +}
   1.228 +
   1.229 +# Register a single user during a bulk registration process
   1.230 +sub _registerSingleBulkUser {
   1.231 +    my ($session, $fieldNames, $row, $settings) = @_;
   1.232 +    ASSERT( $row ) if DEBUG;
   1.233 +
   1.234 +    my $doOverwriteTopics = defined $settings->{doOverwriteTopics} ||
   1.235 +      throw Error::Simple( 'No doOverwriteTopics' );
   1.236 +
   1.237 +    my $log = "---++ Registering $row->{WikiName}\n";
   1.238 +
   1.239 +    try {
   1.240 +        _validateRegistration( $session, $row, 0 );
   1.241 +    } catch TWiki::OopsException with {
   1.242 +        my $e = shift;
   1.243 +        $log .= '<blockquote>'.$e->stringify( $session )."</blockquote>\n";
   1.244 +        return $log."$b1 Registration failed\n";
   1.245 +    };
   1.246 +
   1.247 +    #-- call to the registrationHandler (to amend fields) should
   1.248 +    # really happen in here.
   1.249 +
   1.250 +    #-- Ensure every required field exists
   1.251 +    # NB. LoginName is OPTIONAL
   1.252 +    my @requiredFields = qw(WikiName FirstName LastName);
   1.253 +    if (_missingElements( $fieldNames, \@requiredFields )) {
   1.254 +        $log .= $b1.join(' ', @{$settings->{fieldNames}}).
   1.255 +          ' does not contain the full set of required fields '.
   1.256 +            join(' ', @requiredFields)."\n";
   1.257 +        return (undef, $log);
   1.258 +    }
   1.259 +
   1.260 +    #-- Generation of the page is done from the {form} subhash,
   1.261 +    # so align the two
   1.262 +    $row->{form} = _makeFormFieldOrderMatch( $fieldNames, $row);
   1.263 +
   1.264 +    my $users = $session->{users};
   1.265 +
   1.266 +    try {
   1.267 +        # Add the user to the user management system. May throw an exception
   1.268 +        my $cUID = $users->addUser(
   1.269 +            $row->{LoginName}, $row->{WikiName},
   1.270 +            $row->{Password}, $row->{Email} );
   1.271 +        $log .= "$b1 $row->{WikiName} has been added to the password and user mapping managers\n";
   1.272 +        
   1.273 +	    if( $settings->{doOverwriteTopics} ||
   1.274 +	          !$session->{store}->topicExists( $row->{webName},
   1.275 +	                                           $row->{WikiName} ) ) {
   1.276 +	        $log .= _createUserTopic($session, $row);
   1.277 +	    } else {
   1.278 +	        $log .= "$b1 Not writing user topic $row->{WikiName}\n";
   1.279 +	    }
   1.280 +        $users->setEmails($cUID, $row->{Email});
   1.281 +
   1.282 +        $session->writeLog('bulkregister',
   1.283 +                           $row->{webName}.'.'.$row->{WikiName},
   1.284 +                           $row->{Email}, $row->{WikiName} );
   1.285 +    } catch Error::Simple with {
   1.286 +        my $e = shift;
   1.287 +        $log .= "$b1 Failed to add user: ".$e->stringify()."\n";
   1.288 +    };
   1.289 +
   1.290 +    #if ($TWiki::cfg{EmailUserDetails}) {
   1.291 +    # If you want it, write it.
   1.292 +    # _sendEmail($session, 'registernotifybulk', $data );
   1.293 +    #    $log .= $b1.' Password email disabled\n';
   1.294 +    #}
   1.295 +
   1.296 +    return $log;
   1.297 +}
   1.298 +
   1.299 +#ensures all named fields exist in hash
   1.300 +#returns array containing any that are missing
   1.301 +sub _missingElements {
   1.302 +    my ($presentArrRef, $requiredArrRef) = @_;
   1.303 +    my %present;
   1.304 +    my @missing;
   1.305 +
   1.306 +    $present{$_} = 1 for @$presentArrRef;
   1.307 +    foreach my $required (@$requiredArrRef) {
   1.308 +        if (! $present{$required}) {
   1.309 +            push @missing, $required;
   1.310 +        }
   1.311 +    }
   1.312 +    return @missing;
   1.313 +}
   1.314 +
   1.315 +# rearranges the fields in $data so that they match settings
   1.316 +# returns a new ordered form
   1.317 +sub _makeFormFieldOrderMatch {
   1.318 +    my( $fieldNames, $data ) = @_;
   1.319 +    my @form = ();
   1.320 +    foreach my $field ( @$fieldNames ) {
   1.321 +        push @form, {name => $field, value => $data->{$field}};
   1.322 +    }
   1.323 +    return \@form;
   1.324 +}
   1.325 +
   1.326 +=pod
   1.327 +
   1.328 +---++ StaticMethod registerAndNext($session) 
   1.329 +
   1.330 +This is called when action = register or action = ""
   1.331 +
   1.332 +It calls register and either Verify or Finish.
   1.333 +
   1.334 +Hopefully we will get workflow integrated and rewrite this to be table driven
   1.335 +
   1.336 +=cut
   1.337 +
   1.338 +sub registerAndNext {
   1.339 +  my ($session) = @_;
   1.340 +  register( $session );
   1.341 +  if ($TWiki::cfg{Register}{NeedVerification}) {
   1.342 +     _requireVerification($session);
   1.343 +  } else {
   1.344 +     complete($session);
   1.345 +  }
   1.346 +}
   1.347 +
   1.348 +=pod
   1.349 +
   1.350 +---++ StaticMethod register($session)
   1.351 +
   1.352 +This is called through: TWikiRegistration -> RegisterCgiScript -> here
   1.353 +
   1.354 +=cut
   1.355 +
   1.356 +sub register {
   1.357 +    my( $session ) = @_;
   1.358 +
   1.359 +    my $query = $session->{cgiQuery};
   1.360 +    my $data = _getDataFromQuery( $query, $query->param() );
   1.361 +
   1.362 +    $data->{webName} = $session->{webName};
   1.363 +    $data->{debug} = 1;
   1.364 +
   1.365 +    # SMELL: should perform basic checks that we have e.g. a WikiName
   1.366 +
   1.367 +    _validateRegistration( $session, $data, 1 );
   1.368 +}
   1.369 +
   1.370 +# Generate a registration record, and mail the registrant with the code.
   1.371 +# Redirects the browser to the confirmation screen.
   1.372 +sub _requireVerification {
   1.373 +    my ($session) = @_;
   1.374 +
   1.375 +    my $query = $session->{cgiQuery};
   1.376 +    my $topic = $session->{topicName};
   1.377 +    my $web = $session->{webName};
   1.378 +
   1.379 +    my $data = _getDataFromQuery( $query, $query->param() );
   1.380 +    $data->{LoginName} ||= $data->{WikiName};
   1.381 +    $data->{webName} = $web;
   1.382 +
   1.383 +    require TWiki::Users;
   1.384 +    $data->{VerificationCode} =
   1.385 +      $data->{WikiName}.'.'.TWiki::Users::randomPassword();
   1.386 +
   1.387 +    require Data::Dumper;
   1.388 +
   1.389 +    my $file = _codeFile( $data->{VerificationCode} );
   1.390 +    open( F, ">$file" ) or throw Error::Simple( 'Failed to open file: '.$! );
   1.391 +    print F '# Verification code',"\n";
   1.392 +    # SMELL: wierd jiggery-pokery required, otherwise Data::Dumper screws
   1.393 +    # up the form fields when it saves. Perl bug? Probably to do with
   1.394 +    # chucking around arrays, instead of references to them.
   1.395 +    my $form = $data->{form};
   1.396 +    $data->{form} = undef;
   1.397 +    print F Data::Dumper->Dump( [ $data, $form ], [ 'data', 'form' ] );
   1.398 +    $data->{form} = $form;
   1.399 +    close( F );
   1.400 +
   1.401 +    $session->writeLog(
   1.402 +        'regstart', $TWiki::cfg{UsersWebName}.'.'.$data->{WikiName},
   1.403 +        $data->{Email}, $data->{WikiName} );
   1.404 +
   1.405 +    my $em = $data->{Email};
   1.406 +
   1.407 +    if($TWiki::cfg{EnableEmail}) {
   1.408 +        my $err = _sendEmail( $session, 'registerconfirm', $data );
   1.409 +
   1.410 +        if($err) {
   1.411 +            throw TWiki::OopsException(
   1.412 +                'attention',
   1.413 +                def => 'registration_mail_failed',
   1.414 +                web => $data->{webName},
   1.415 +                topic => $topic,
   1.416 +                params => [ $em, $err ]);
   1.417 +        };
   1.418 +    } else {
   1.419 +        my $err=$session->i18n->maketext(
   1.420 +                  'Email has been disabled for this TWiki installation');
   1.421 +
   1.422 +        throw TWiki::OopsException(
   1.423 +            'attention',
   1.424 +            def => 'send_mail_error',
   1.425 +            web => $data->{webName},
   1.426 +            topic => $topic,
   1.427 +            params => [ $em, $err ]);
   1.428 +    }
   1.429 +
   1.430 +
   1.431 +    throw TWiki::OopsException(
   1.432 +        'attention',
   1.433 +        def => 'confirm',
   1.434 +        web => $data->{webName},
   1.435 +        topic => $topic,
   1.436 +        params => [ $em ] );
   1.437 +}
   1.438 +
   1.439 +=pod
   1.440 +
   1.441 +---++ StaticMethod resetPassword($session)
   1.442 +
   1.443 +Generates a password. Mails it to them and asks them to change it. Entry
   1.444 +point intended to be called from UI::run
   1.445 +
   1.446 +=cut
   1.447 +
   1.448 +sub resetPassword {
   1.449 +    my $session = shift;
   1.450 +    my $query = $session->{cgiQuery};
   1.451 +    my $topic = $session->{topicName};
   1.452 +    my $web = $session->{webName};
   1.453 +    my $user = $session->{user};
   1.454 +
   1.455 +    unless( $TWiki::cfg{EnableEmail} ) {
   1.456 +        my $err=$session->i18n->maketext(
   1.457 +                  'Email has been disabled for this TWiki installation');
   1.458 +        throw TWiki::OopsException( 'attention',
   1.459 +                                    topic => $TWiki::cfg{UsersTopicName},
   1.460 +                                    def => 'reset_bad',
   1.461 +                                    params => [ $err ] );
   1.462 +    }
   1.463 +
   1.464 +    my @userNames = $query->param( 'LoginName' ) ;
   1.465 +    unless( @userNames ) {
   1.466 +        throw TWiki::OopsException( 'attention',
   1.467 +                                    def => 'no_users_to_reset' );
   1.468 +    }
   1.469 +    my $introduction = $query->param( 'Introduction' ) || '';
   1.470 +    # need admin priv if resetting bulk, or resetting another user
   1.471 +    my $isBulk = ( scalar( @userNames ) > 1 );
   1.472 +
   1.473 +    if ( $isBulk ) {
   1.474 +        # Only admin is able to reset more than one password or
   1.475 +        # another user's password.
   1.476 +        unless( $session->{users}->isAdmin( $user )) {
   1.477 +            throw TWiki::OopsException
   1.478 +              ( 'accessdenied', def => 'only_group',
   1.479 +                web => $web, topic => $topic,
   1.480 +                params => [ $TWiki::cfg{SuperAdminGroup} ] );
   1.481 +        }
   1.482 +    } else {
   1.483 +        # Anyone can reset a single password - important because by definition
   1.484 +        # the user cannot authenticate
   1.485 +        # Note that the passwd script must NOT authenticate!
   1.486 +    }
   1.487 +
   1.488 +    # Collect all messages into one string
   1.489 +    my $message = '';
   1.490 +    my $good = 1;
   1.491 +    foreach my $userName (@userNames) {
   1.492 +        $good = $good &&
   1.493 +          _resetUsersPassword( $session, $userName, $introduction, \$message );
   1.494 +    }
   1.495 +
   1.496 +    my $action = '';
   1.497 +    # Redirect to a page that tells what happened
   1.498 +    if( $good ) {
   1.499 +        unless( $isBulk ) {
   1.500 +            # one user; refine the change password link to include their
   1.501 +            # username (can't use logged in user - by definition this won't
   1.502 +            # be them!)
   1.503 +            $action = '?username='. $userNames[0];
   1.504 +        }
   1.505 +
   1.506 +        throw TWiki::OopsException( 'attention',
   1.507 +                                    topic => $TWiki::cfg{UsersTopicName},
   1.508 +                                    def => 'reset_ok',
   1.509 +                                    params => [ $message ] );
   1.510 +    } else {
   1.511 +        throw TWiki::OopsException( 'attention',
   1.512 +                                    topic => $TWiki::cfg{UsersTopicName},
   1.513 +                                    def => 'reset_bad',
   1.514 +                                    params => [ $message ] );
   1.515 +    }
   1.516 +}
   1.517 +
   1.518 +# return status
   1.519 +sub _resetUsersPassword {
   1.520 +    my( $session, $login, $introduction, $pMess ) = @_;
   1.521 +
   1.522 +    my $users = $session->{users};
   1.523 +
   1.524 +    unless( $login ) {
   1.525 +        $$pMess .= $session->inlineAlert( 'alertsnohtml', 'bad_user', '' );
   1.526 +        return 0;
   1.527 +    }
   1.528 +
   1.529 +    my $user = $users->getCanonicalUserID( $login );
   1.530 +    my $message = '';
   1.531 +    unless( $user && $users->userExists( $user )) {
   1.532 +        # Not an error.
   1.533 +        $$pMess .= $session->inlineAlert(
   1.534 +            'alertsnohtml', 'missing_user', $login);
   1.535 +        return 0;
   1.536 +    }
   1.537 +
   1.538 +    require TWiki::Users;
   1.539 +    my $password = TWiki::Users::randomPassword();
   1.540 +
   1.541 +    unless( $users->setPassword( $user, $password, 1 )) {
   1.542 +        $$pMess .= $session->inlineAlert(
   1.543 +            'alertsnohtml', 'reset_bad', $user);
   1.544 +        return 0;
   1.545 +    }
   1.546 +
   1.547 +    # absolute URL context for email generation
   1.548 +    $session->enterContext('absolute_urls');
   1.549 +
   1.550 +    my @em = $users->getEmails($user);
   1.551 +    my $sent = 0;
   1.552 +    if (!scalar(@em)) {
   1.553 +        $$pMess .= $session->inlineAlert(
   1.554 +            'alertsnohtml', 'no_email_for', $user);
   1.555 +    } else {
   1.556 +        my $ln = $users->getLoginName($user);
   1.557 +        my $wn = $users->getWikiName($user);
   1.558 +        foreach my $email ( @em ) {
   1.559 +            my $err = _sendEmail(
   1.560 +                $session,
   1.561 +                'mailresetpassword',
   1.562 +                {
   1.563 +                    webName => $TWiki::cfg{UsersWebName},
   1.564 +                    LoginName => $ln,
   1.565 +                    Name => TWiki::spaceOutWikiWord($wn),
   1.566 +                    WikiName => $wn,
   1.567 +                    Email => $email,
   1.568 +                    PasswordA => $password,
   1.569 +                    Introduction => $introduction,
   1.570 +                } );
   1.571 +
   1.572 +            if( $err ) {
   1.573 +                $$pMess .= $session->inlineAlert(
   1.574 +                    'alertsnohtml', 'generic', $err );
   1.575 +            } else {
   1.576 +                $sent = 1;
   1.577 +            }
   1.578 +        }
   1.579 +    }
   1.580 +
   1.581 +    $session->leaveContext('absolute_urls');
   1.582 +
   1.583 +    if ($sent ) {
   1.584 +        $$pMess .= $session->inlineAlert(
   1.585 +            'alertsnohtml',
   1.586 +            'new_sys_pass',
   1.587 +            $users->getLoginName($user),
   1.588 +            $users->getWikiName( $user ));
   1.589 +    }
   1.590 +
   1.591 +    return $sent;
   1.592 +}
   1.593 +
   1.594 +=pod
   1.595 +
   1.596 +---++ StaticMethod changePassword( $session )
   1.597 +
   1.598 +Change the user's password and/or email. Details of the user and password
   1.599 +are passed in CGI parameters.
   1.600 +
   1.601 +   1 Checks required fields have values
   1.602 +   2 get wikiName and userName from getUserByEitherLoginOrWikiName(username)
   1.603 +   3 check passwords match each other, and that the password is correct, otherwise 'wrongpassword'
   1.604 +   4 TWiki::User::updateUserPassword
   1.605 +   5 'oopschangepasswd'
   1.606 +
   1.607 +The NoPasswdUser case is not handled.
   1.608 +
   1.609 +An admin user can change other user's passwords.
   1.610 +
   1.611 +=cut
   1.612 +
   1.613 +sub changePassword {
   1.614 +    my $session = shift;
   1.615 +
   1.616 +    my $topic = $session->{topicName};
   1.617 +    my $webName = $session->{webName};
   1.618 +    my $query = $session->{cgiQuery};
   1.619 +    my $requestUser = $session->{user};
   1.620 +
   1.621 +    my $oldpassword = $query->param( 'oldpassword' );
   1.622 +    my $user = $query->param( 'username' );
   1.623 +    my $passwordA = $query->param( 'password' );
   1.624 +    my $passwordB = $query->param( 'passwordA' );
   1.625 +    my $email = $query->param( 'email' );
   1.626 +    my $topicName = $query->param( 'TopicName' );
   1.627 +
   1.628 +    # check if required fields are filled in
   1.629 +    unless( $user ) {
   1.630 +        throw TWiki::OopsException( 'attention',
   1.631 +                                    web => $webName,
   1.632 +                                    topic => $topic,
   1.633 +                                    def => 'missing_fields',
   1.634 +                                    params => [ 'username' ] );
   1.635 +    }
   1.636 +
   1.637 +    my $users = $session->{users};
   1.638 +
   1.639 +    unless ($user) {
   1.640 +        throw TWiki::OopsException( 'attention',
   1.641 +                                    web => $webName,
   1.642 +                                    topic => $topic,
   1.643 +                                    def => 'notwikiuser',
   1.644 +                                    params => [ $user ] );
   1.645 +    }
   1.646 +
   1.647 +    my $changePass = 0;
   1.648 +    if( defined $passwordA || defined $passwordB ) {
   1.649 +        unless( defined $passwordA ) {
   1.650 +            throw TWiki::OopsException( 'attention',
   1.651 +                                        web => $webName,
   1.652 +                                        topic => $topic,
   1.653 +                                        def => 'missing_fields',
   1.654 +                                        params => [ 'password' ] );
   1.655 +        }
   1.656 +
   1.657 +        # check if passwords are identical
   1.658 +        if( $passwordA ne $passwordB ) {
   1.659 +            throw TWiki::OopsException( 'attention',
   1.660 +                                        web => $webName,
   1.661 +                                        topic => $topic,
   1.662 +                                        def => 'password_mismatch' );
   1.663 +        }
   1.664 +        $changePass = 1;
   1.665 +    }
   1.666 +
   1.667 +    # check if required fields are filled in
   1.668 +    unless( defined $oldpassword || $users->isAdmin( $requestUser )) {
   1.669 +        throw TWiki::OopsException( 'attention',
   1.670 +                                    web => $webName,
   1.671 +                                    topic => $topic,
   1.672 +                                    def => 'missing_fields',
   1.673 +                                    params => [ 'oldpassword' ] );
   1.674 +    }
   1.675 +
   1.676 +    unless( $users->isAdmin( $requestUser ) ||
   1.677 +              $users->checkPassword( $user, $oldpassword)) {
   1.678 +        throw TWiki::OopsException( 'attention',
   1.679 +                                    web => $webName,
   1.680 +                                    topic => $topic,
   1.681 +                                    def => 'wrong_password');
   1.682 +    }
   1.683 +
   1.684 +    if( defined $email ) {
   1.685 +        my $cUID = $users->getCanonicalUserID($user);
   1.686 +        my $return = $users->setEmails($cUID, split(/\s+/, $email) );
   1.687 +    }
   1.688 +
   1.689 +    # OK - password may be changed
   1.690 +    if( $changePass ) {
   1.691 +        if (length($passwordA) < $TWiki::cfg{MinPasswordLength}) {
   1.692 +            throw TWiki::OopsException(
   1.693 +                'attention',
   1.694 +                web => $webName,
   1.695 +                topic => $topic,
   1.696 +                def => 'bad_password',
   1.697 +                params => [ $TWiki::cfg{MinPasswordLength} ] );
   1.698 +        }
   1.699 +
   1.700 +        unless( $users->setPassword( $user, $passwordA, $oldpassword )) {
   1.701 +            throw TWiki::OopsException( 'attention',
   1.702 +                                        web => $webName,
   1.703 +                                        topic => $topic,
   1.704 +                                        def => 'password_not_changed');
   1.705 +        } else {
   1.706 +            $session->writeLog('changepasswd', $user);
   1.707 +        }
   1.708 +        # OK - password changed
   1.709 +        throw TWiki::OopsException( 'attention',
   1.710 +                                    web => $webName, topic => $topic,
   1.711 +                                    def => 'password_changed' );
   1.712 +    }
   1.713 +
   1.714 +    # must be just email
   1.715 +    throw TWiki::OopsException( 'attention',
   1.716 +                                 web => $webName, topic => $topic,
   1.717 +                                 def => 'email_changed',
   1.718 +                                 params => [ $email ] );
   1.719 +}
   1.720 +
   1.721 +=pod
   1.722 +
   1.723 +---++ StaticMethod verifyEmailAddress($session)
   1.724 +
   1.725 +This is called: on receipt of the activation password -> RegisterCgiScript -> here
   1.726 +   1 calls _loadPendingRegistration(activation password)
   1.727 +   2 throws oops if appropriate
   1.728 +   3 calls emailRegistrationConfirmations
   1.729 +   4 still calls 'oopssendmailerr' if a problem, but this is not done uniformly
   1.730 +
   1.731 +=cut
   1.732 +
   1.733 +sub verifyEmailAddress {
   1.734 +    my( $session ) = @_;
   1.735 +
   1.736 +    my $code = $session->{cgiQuery}->param('code');
   1.737 +    unless( $code ) {
   1.738 +        throw Error::Simple( 'verifyEmailAddress: no verification code!');
   1.739 +    }
   1.740 +    my $data = _loadPendingRegistration( $session, $code );
   1.741 +
   1.742 +    if (! exists $data->{Email}) {
   1.743 +        throw Error::Simple( 'verifyEmailAddress: no email address!');
   1.744 +    }
   1.745 +
   1.746 +    my $topic = $session->{topicName};
   1.747 +    my $web = $session->{webName};
   1.748 +
   1.749 +}
   1.750 +
   1.751 +# Complete a registration
   1.752 +sub complete {
   1.753 +    my( $session) = @_;
   1.754 +
   1.755 +    my $topic = $session->{topicName};
   1.756 +    my $web = $session->{webName};
   1.757 +    my $query = $session->{cgiQuery};
   1.758 +	my $code = $query->param('code');
   1.759 +
   1.760 +	my $data;
   1.761 +	if ($TWiki::cfg{Register}{NeedVerification}) {
   1.762 +		$data = _loadPendingRegistration( $session, $code );
   1.763 +		_clearPendingRegistrationsForUser( $code );
   1.764 +	} else {
   1.765 +	    $data = _getDataFromQuery( $query, $query->param() );
   1.766 +	    $data->{webName} = $web;
   1.767 +	}
   1.768 +
   1.769 +    if (! exists $data->{WikiName}) {
   1.770 +        throw Error::Simple( 'no WikiName after reload');
   1.771 +    }
   1.772 +
   1.773 +    if (! exists $data->{LoginName}) {
   1.774 +        if( $TWiki::cfg{Register}{AllowLoginName} ) {
   1.775 +            # This should have been populated
   1.776 +            throw Error::Simple( 'no LoginName after reload');
   1.777 +        }
   1.778 +        $data->{LoginName} ||= $data->{WikiName};
   1.779 +    }
   1.780 +
   1.781 +    my $users = $session->{users};
   1.782 +    try {
   1.783 +        my $cUID = $users->addUser( $data->{LoginName}, $data->{WikiName},
   1.784 +                         $data->{Password}, $data->{Email} );
   1.785 +        my $log = _createUserTopic($session, $data);
   1.786 +        $users->setEmails($cUID, $data->{Email});
   1.787 +    } catch Error::Simple with {
   1.788 +        my $e = shift;
   1.789 +        # Log the error
   1.790 +        $session->writeWarning( 'Registration failed: '.$e->stringify() );
   1.791 +        throw TWiki::OopsException( 'attention',
   1.792 +                                    web => $data->{webName},
   1.793 +                                    topic => $topic,
   1.794 +                                    def => 'problem_adding',
   1.795 +                                    params => [ $data->{WikiName},
   1.796 +                                                $e->stringify() ] );
   1.797 +    };
   1.798 +
   1.799 +    #only change the session's identity _if_ the registration was done by TWikiGuest
   1.800 +    if ( $session->{user} eq $session->{users}->getCanonicalUserID( $TWiki::cfg{DefaultUserLogin}) ) {
   1.801 +        # Plugin callback to set cookies.
   1.802 +        $session->{plugins}->registrationHandler( $data->{WebName},
   1.803 +                                                  $data->{WikiName},
   1.804 +                                                  $data->{LoginName} );
   1.805 +    
   1.806 +        # let the client session know that we're logged in. (This probably
   1.807 +        # eliminates the need for the registrationHandler call above,
   1.808 +        # but we'll leave them both in here for now.)
   1.809 +        $users->{loginManager}->userLoggedIn( $data->{LoginName}, $data->{WikiName} );
   1.810 +    }
   1.811 +
   1.812 +    my $status;
   1.813 +
   1.814 +    if($TWiki::cfg{EnableEmail}) {
   1.815 +
   1.816 +        # inform user and admin about the registration.
   1.817 +        $status = _emailRegistrationConfirmations( $session, $data );
   1.818 +
   1.819 +        # write log entry
   1.820 +        if ($TWiki::cfg{Log}{register}) {
   1.821 +            $session->writeLog(
   1.822 +                'register', $TWiki::cfg{UsersWebName}.'.'.$data->{WikiName},
   1.823 +                $data->{Email}, $data->{WikiName} );
   1.824 +        }
   1.825 +
   1.826 +        if( $status ) {
   1.827 +            $status = $session->i18n->maketext(
   1.828 +                'Warning: Could not send confirmation email')."\n\n$status";
   1.829 +        } else {
   1.830 +            $status = $session->i18n->maketext(
   1.831 +                'A confirmation e-mail has been sent to [_1]', $data->{Email} );
   1.832 +        }
   1.833 +    } else {
   1.834 +        $status = $session->i18n->maketext(
   1.835 +                'Warning: Could not send confirmation email, email has been disabled');
   1.836 +    }
   1.837 +
   1.838 +    # and finally display thank you page
   1.839 +    throw TWiki::OopsException( 'attention',
   1.840 +                                web => $TWiki::cfg{UsersWebName},
   1.841 +                                topic => $data->{WikiName},
   1.842 +                                def => 'thanks',
   1.843 +                                params => [ $status, $data->{WikiName} ] );
   1.844 +}
   1.845 +
   1.846 +#Given a template and a hash, creates a new topic for a user
   1.847 +#   1 reads the template topic
   1.848 +#   2 calls RegistrationHandler::register with the row details, so that a plugin can augment/delete/change the entries
   1.849 +#
   1.850 +#I use RegistrationHandler::register to prevent certain fields (like password) 
   1.851 +#appearing in the homepage and to fetch photos into the topic
   1.852 +sub _createUserTopic {
   1.853 +    my ($session, $row) = @_;
   1.854 +    my $store = $session->{store};
   1.855 +    my $template = 'NewUserTemplate';
   1.856 +    my( $meta, $text );
   1.857 +    if( $store->topicExists( $TWiki::cfg{UsersWebName}, $template )) {
   1.858 +        # Use the local customised version
   1.859 +        ( $meta, $text ) = $store->readTopic(
   1.860 +            undef, $TWiki::cfg{UsersWebName}, $template );
   1.861 +    } else {
   1.862 +        # Use the default read-only version
   1.863 +        ( $meta, $text ) = $store->readTopic(
   1.864 +            undef, $TWiki::cfg{SystemWebName}, $template );
   1.865 +    }
   1.866 +
   1.867 +    my $log = $b1 . ' Writing topic '.$TWiki::cfg{UsersWebName} . '.'
   1.868 +      . $row->{WikiName}."\n"
   1.869 +        . "$b1 !RegistrationHandler:\n"
   1.870 +          . _writeRegistrationDetailsToTopic( $session, $row, $meta, $text );
   1.871 +    return $log;
   1.872 +}
   1.873 +
   1.874 +# Writes the registration details passed as a hash to either BulletFields
   1.875 +# or FormFields on the user's topic.
   1.876 +#
   1.877 +sub _writeRegistrationDetailsToTopic {
   1.878 +    my ($session, $data, $meta, $text) = @_;
   1.879 +
   1.880 +    ASSERT($data->{WikiName}) if DEBUG;
   1.881 +
   1.882 +    # TODO - there should be some way of overwriting meta without
   1.883 +    # blatting the content.
   1.884 +
   1.885 +    my( $before, $repeat, $after ) = split( /%SPLIT%/, $text, 3 );
   1.886 +    $before = '' unless defined( $before );
   1.887 +    $after = '' unless defined( $after );
   1.888 +
   1.889 +    my $log;
   1.890 +    my $addText;
   1.891 +    my $form = $meta->get( 'FORM' );
   1.892 +    if( $form ) {
   1.893 +        ( $meta, $addText ) =
   1.894 +          _populateUserTopicForm( $session, $form->{name}, $meta, $data );
   1.895 +        $log = "$b2 Using Form Fields\n";
   1.896 +    } else {
   1.897 +        $addText = _getRegFormAsTopicContent( $data );
   1.898 +        $log = "$b2 Using Bullet Fields\n";
   1.899 +    }
   1.900 +    $text = $before . $addText . $after;
   1.901 +
   1.902 +    my $user = $data->{WikiName};
   1.903 +    $text = $session->expandVariablesOnTopicCreation( $text, $user, $TWiki::cfg{UsersWebName}, $user );
   1.904 +
   1.905 +    $meta->put( 'TOPICPARENT', { 'name' => $TWiki::cfg{UsersTopicName}} );
   1.906 +
   1.907 +    $session->{store}->saveTopic($session->{users}->getCanonicalUserID($agent), $TWiki::cfg{UsersWebName},
   1.908 +                                 $user, $text, $meta );
   1.909 +    return $log;
   1.910 +}
   1.911 +
   1.912 +# Puts form fields into the topic form
   1.913 +sub _populateUserTopicForm {
   1.914 +    my ( $session, $formName, $meta, $data ) = @_;
   1.915 +
   1.916 +    my %inform;
   1.917 +    require TWiki::Form;
   1.918 +
   1.919 +    my $form =
   1.920 +      new TWiki::Form( $session, $TWiki::cfg{UsersWebName}, $formName );
   1.921 +
   1.922 +    return ($meta, '' ) unless $form;
   1.923 +
   1.924 +    foreach my $field ( @{$form->getFields()} ) {
   1.925 +        foreach my $fd (@{$data->{form}}) {
   1.926 +            next unless $fd->{name} eq $field->{name};
   1.927 +            next if $SKIPKEYS{$fd->{name}};
   1.928 +            my $item = $meta->get( 'FIELD', $fd->{name} );
   1.929 +            $item->{value} = $fd->{value};
   1.930 +            $meta->putKeyed( 'FIELD', $item );
   1.931 +            $inform{$fd->{name}} = 1;
   1.932 +            last;
   1.933 +        }
   1.934 +    }
   1.935 +    my $leftoverText = '';
   1.936 +    foreach my $fd (@{$data->{form}}) {
   1.937 +        unless( $inform{$fd->{name}} || $SKIPKEYS{$fd->{name}} ) {
   1.938 +            $leftoverText .= "   * $fd->{name}: $fd->{value}\n";
   1.939 +        }
   1.940 +    }
   1.941 +    return ( $meta, $leftoverText );
   1.942 +}
   1.943 +
   1.944 +# Registers a user using the old bullet field code
   1.945 +sub _getRegFormAsTopicContent {
   1.946 +    my $data = shift;
   1.947 +    my $text;
   1.948 +    foreach my $fd ( @{ $data->{form} } ) {
   1.949 +        next if $SKIPKEYS{$fd->{name}};
   1.950 +        my $title = $fd->{name};
   1.951 +        $title =~ s/([a-z0-9])([A-Z0-9])/$1 $2/go;    # Spaced
   1.952 +        my $value = $fd->{value};
   1.953 +        $value =~ s/[\n\r]//go;
   1.954 +        $text .= "   * $title\: $value\n";
   1.955 +    }
   1.956 +    return $text;
   1.957 +}
   1.958 +
   1.959 +#Sends to both the WIKIWEBMASTER and the USER notice of the registration
   1.960 +#emails both the admin 'registernotifyadmin' and the user 'registernotify', 
   1.961 +#in separate emails so they both get targeted information (and no password to the admin).
   1.962 +sub _emailRegistrationConfirmations {
   1.963 +    my ( $session, $data ) = @_;
   1.964 +
   1.965 +    my $skin = $session->getSkin();
   1.966 +    my $template =
   1.967 +      $session->templates->readTemplate( 'registernotify', $skin );
   1.968 +    my $email =
   1.969 +      _buildConfirmationEmail( $session,
   1.970 +                               $data,
   1.971 +                               $template,
   1.972 +                               $TWiki::cfg{Register}{HidePasswd}
   1.973 +                             );
   1.974 +
   1.975 +    my $warnings = $session->net->sendEmail( $email);
   1.976 +
   1.977 +    $template =
   1.978 +      $session->templates->readTemplate( 'registernotifyadmin', $skin );
   1.979 +    $email =
   1.980 +      _buildConfirmationEmail( $session,
   1.981 +                               $data,
   1.982 +                               $template,
   1.983 +                               1 );
   1.984 +
   1.985 +    my $err = $session->net->sendEmail( $email );
   1.986 +    if( $err ) {
   1.987 +        # don't tell the user about this one
   1.988 +        $session->writeWarning('Could not confirm registration: '.$err);
   1.989 +    }
   1.990 +
   1.991 +    return $warnings;
   1.992 +}
   1.993 +
   1.994 +#The template dictates the to: field
   1.995 +sub _buildConfirmationEmail {
   1.996 +    my ( $session, $data, $templateText, $hidePassword ) = @_;
   1.997 +
   1.998 +    $data->{Name} ||= $data->{WikiName};
   1.999 +    $templateText =~ s/%FIRSTLASTNAME%/$data->{Name}/go;
  1.1000 +    $templateText =~ s/%WIKINAME%/$data->{WikiName}/go;
  1.1001 +    $templateText =~ s/%EMAILADDRESS%/$data->{Email}/go;
  1.1002 +
  1.1003 +    my ( $before, $after ) = split( /%FORMDATA%/, $templateText );
  1.1004 +    foreach my $fd ( @{ $data->{form} } ) {
  1.1005 +        my $name  = $fd->{name};
  1.1006 +        my $value = $fd->{value};
  1.1007 +        if ( ( $name eq 'Password' ) && ($hidePassword) ) {
  1.1008 +            $value = '*******';
  1.1009 +        }
  1.1010 +        if ( $name ne 'Confirm' ) {
  1.1011 +            $before .= $b1.' '.$name.': '.$value."\n";
  1.1012 +        }
  1.1013 +    }
  1.1014 +    $templateText = $before.($after||'');
  1.1015 +    $templateText = $session->handleCommonTags(
  1.1016 +        $templateText, $TWiki::cfg{UsersWebName}, $data->{WikiName} );
  1.1017 +    $templateText =~ s/( ?) *<\/?(nop|noautolink)\/?>\n?/$1/gois;
  1.1018 +    # remove <nop> and <noautolink> tags
  1.1019 +
  1.1020 +    return $templateText;
  1.1021 +}
  1.1022 +
  1.1023 +# Throws an Oops exception if there is a problem.
  1.1024 +sub _validateRegistration {
  1.1025 +    my ( $session, $data, $requireForm ) = @_;
  1.1026 +
  1.1027 +    if( !defined( $data->{LoginName} ) &&
  1.1028 +          $TWiki::cfg{Register}{AllowLoginName} ) {
  1.1029 +        # Login name is required, barf
  1.1030 +        throw TWiki::OopsException( 'attention',
  1.1031 +                                    web => $data->{webName},
  1.1032 +                                    topic => $session->{topicName},
  1.1033 +                                    def => 'bad_loginname',
  1.1034 +                                    params => [ 'undefined' ] );
  1.1035 +    } elsif( !defined( $data->{LoginName} ) ) {
  1.1036 +        # Login name is optional, default to the wikiname
  1.1037 +        $data->{LoginName} = $data->{WikiName};
  1.1038 +    }
  1.1039 +
  1.1040 +    # Check if login name matches expectations
  1.1041 +    unless( $data->{LoginName} =~ /$TWiki::cfg{LoginNameFilterIn}/ ) {
  1.1042 +        throw TWiki::OopsException( 'attention',
  1.1043 +                                    web => $data->{webName},
  1.1044 +                                    topic => $session->{topicName},
  1.1045 +                                    def => 'bad_loginname',
  1.1046 +                                    params => [ $data->{LoginName} ] );
  1.1047 +    }
  1.1048 +
  1.1049 +    # Check if the login name is already registered
  1.1050 +    # luckily, we're only considering TWikiUserMapping cfg's
  1.1051 +    # there are several possible interpretations of 'already registered'
  1.1052 +    # --- For setups with a PasswordManager...
  1.1053 +    # on twiki.org, (allowloginname=off) means that if the user has an
  1.1054 +    #      entry in the htpasswd file, they are already registered.
  1.1055 +    # onmost systems using (allowloginname=off) already registered could mean
  1.1056 +    #      user topic exists, or, Main.UserList mapping exists
  1.1057 +    # on any system using (allowloginname=on) already registered could mean
  1.1058 +    #      user topic exists, or, Main.UserList mapping exists
  1.1059 +    #NOTE: it is important that _any_ user can register any random third party
  1.1060 +    #      this is not only how TWikiGuest registers as someone else, but often
  1.1061 +    #      how users pre-register others.
  1.1062 +    my $users = $session->{users};
  1.1063 +    my $user = $users->getCanonicalUserID( $data->{LoginName} );
  1.1064 +    my $wikiname = $users->getWikiName( $user);
  1.1065 +
  1.1066 +    my $store = $session->{store};
  1.1067 +    if( $user &&
  1.1068 +       #in the pwd system
  1.1069 +       # OR already logged in (shortcircuit to reduce perf impact)
  1.1070 +       # returns undef if passwordmgr=none
  1.1071 +       (
  1.1072 +        ($users->userExists( $user ))) &&
  1.1073 +       #user has an entry in the mapping system (if AllowLoginName == off, then entry is automatic)
  1.1074 +       (
  1.1075 +            (! $TWiki::cfg{Register}{AllowLoginName}) ||
  1.1076 +            $store->topicExists($TWiki::cfg{UsersWebName} , $wikiname)   #mapping from new login exists
  1.1077 +            )      
  1.1078 +       ) {
  1.1079 +        throw TWiki::OopsException( 'attention',
  1.1080 +                                    web => $data->{webName},
  1.1081 +                                    topic => $session->{topicName},
  1.1082 +                                    def => 'already_exists',
  1.1083 +                                    params => [ $data->{LoginName} ] );
  1.1084 +    }
  1.1085 +    #new user's topic already exists
  1.1086 +    if ($store->topicExists($TWiki::cfg{UsersWebName} , $data->{WikiName})) {
  1.1087 +        throw TWiki::OopsException( 'attention',
  1.1088 +                                    web => $data->{webName},
  1.1089 +                                    topic => $session->{topicName},
  1.1090 +                                    def => 'already_exists',
  1.1091 +                                    params => [ $data->{WikiName} ] );
  1.1092 +    }
  1.1093 +
  1.1094 +    # Check if WikiName is a WikiName
  1.1095 +    if ( !TWiki::isValidWikiWord( $data->{WikiName} ) ) {
  1.1096 +        throw TWiki::OopsException( 'attention',
  1.1097 +                                    web => $data->{webName},
  1.1098 +                                    topic => $session->{topicName},
  1.1099 +                                    def => 'bad_wikiname',
  1.1100 +                                    params => [ $data->{WikiName} ] );
  1.1101 +    }
  1.1102 +
  1.1103 +    if (exists $data->{passwordA}) {
  1.1104 +        # check password length
  1.1105 +        my $doCheckPasswordLength  =
  1.1106 +          ( $TWiki::cfg{PasswordManager} ne 'none'  &&
  1.1107 +              $TWiki::cfg{MinPasswordLength} );
  1.1108 +
  1.1109 +        if ($doCheckPasswordLength &&
  1.1110 +            length($data->{passwordA}) < $TWiki::cfg{MinPasswordLength}) {
  1.1111 +            throw TWiki::OopsException(
  1.1112 +                'attention',
  1.1113 +                web => $data->{webName},
  1.1114 +                topic => $session->{topicName},
  1.1115 +                def => 'bad_password',
  1.1116 +                params => [ $TWiki::cfg{MinPasswordLength} ] );
  1.1117 +        }
  1.1118 +
  1.1119 +        # check if passwords are identical
  1.1120 +        if ( $data->{passwordA} ne $data->{passwordB} ) {
  1.1121 +            throw TWiki::OopsException( 'attention',
  1.1122 +                                        web => $data->{webName},
  1.1123 +                                        topic => $session->{topicName},
  1.1124 +                                        def => 'password_mismatch' );
  1.1125 +        }
  1.1126 +    }
  1.1127 +
  1.1128 +    # check valid email address
  1.1129 +    if ( $data->{Email} !~ $TWiki::regex{emailAddrRegex} ) {
  1.1130 +        throw TWiki::OopsException(
  1.1131 +            'attention',
  1.1132 +            web => $data->{webName},
  1.1133 +            topic => $session->{topicName},
  1.1134 +            def => 'bad_email',
  1.1135 +            params => [ $data->{Email} ] );
  1.1136 +    }
  1.1137 +
  1.1138 +    return unless $requireForm;
  1.1139 +
  1.1140 +    # check if required fields are filled in
  1.1141 +    unless ( $data->{form} && ( $#{ $data->{form} } > 1 ) ) {
  1.1142 +        throw TWiki::OopsException( 'attention',
  1.1143 +                                    web => $data->{webName},
  1.1144 +                                    topic => $session->{topicName},
  1.1145 +                                    def => 'missing_fields',
  1.1146 +                                    params => [ 'form' ] );
  1.1147 +    }
  1.1148 +    my @missing = ();
  1.1149 +    foreach my $fd ( @{ $data->{form} } ) {
  1.1150 +        if ( ( $fd->{required} ) && ( !$fd->{value} ) ) {
  1.1151 +            push( @missing, $fd->{name} );
  1.1152 +        }
  1.1153 +    }
  1.1154 +
  1.1155 +    if( scalar( @missing )) {
  1.1156 +        throw TWiki::OopsException( 'attention',
  1.1157 +                                    web => $data->{webName},
  1.1158 +                                    topic => $session->{topicName},
  1.1159 +                                    def => 'missing_fields',
  1.1160 +                                    params => [ join(', ', @missing) ] );
  1.1161 +    }
  1.1162 +}
  1.1163 +
  1.1164 +# sends $p->{template} to $p->{Email} with a bunch of substitutions.
  1.1165 +sub _sendEmail {
  1.1166 +    my( $session, $template, $p ) = @_;
  1.1167 +
  1.1168 +    my $text = $session->templates->readTemplate( $template );
  1.1169 +    $p->{Introduction} ||= '';
  1.1170 +    $p->{Name} ||= $p->{WikiName};
  1.1171 +    $text =~ s/%LOGINNAME%/$p->{LoginName}/geo;
  1.1172 +    $text =~ s/%FIRSTLASTNAME%/$p->{WikiName}/go;
  1.1173 +    $text =~ s/%WIKINAME%/$p->{Name}/geo;
  1.1174 +    $text =~ s/%EMAILADDRESS%/$p->{Email}/go;
  1.1175 +    $text =~ s/%INTRODUCTION%/$p->{Introduction}/go;
  1.1176 +    $text =~ s/%VERIFICATIONCODE%/$p->{VerificationCode}/go;
  1.1177 +    $text =~ s/%PASSWORD%/$p->{PasswordA}/go;
  1.1178 +    $text = $session->handleCommonTags(
  1.1179 +        $text, $TWiki::cfg{UsersWebName}, $p->{WikiName} );
  1.1180 +
  1.1181 +    return $session->net->sendEmail($text);
  1.1182 +}
  1.1183 +
  1.1184 +sub _codeFile {
  1.1185 +    my ( $code ) = @_;
  1.1186 +    ASSERT( $code ) if DEBUG;
  1.1187 +    throw Error::Simple("bad code") unless $code =~ /^(\w+)\.(\d+)$/;
  1.1188 +    return "$TWiki::cfg{WorkingDir}/registration_approvals/$1.$2";
  1.1189 +}
  1.1190 +
  1.1191 +sub _codeWikiName {
  1.1192 +    my ( $code ) = @_;
  1.1193 +    ASSERT( $code ) if DEBUG;
  1.1194 +    $code =~ s/\.\d+$//;
  1.1195 +    return $code;
  1.1196 +}
  1.1197 +
  1.1198 +sub _clearPendingRegistrationsForUser {
  1.1199 +    my $code = shift;
  1.1200 +    my $file = _codeFile( $code );
  1.1201 +    # Remove the integer code to leave just the wikiname
  1.1202 +    $file =~ s/\.\d+$//;
  1.1203 +    foreach my $f (<$file.*>) {
  1.1204 +        unlink( TWiki::Sandbox::untaintUnchecked( $f ));
  1.1205 +    }
  1.1206 +}
  1.1207 +
  1.1208 +use vars qw( $data $form );
  1.1209 +
  1.1210 +# Redirects user and dies if cannot load.
  1.1211 +# Dies if loads and does not match.
  1.1212 +# Returns the users data hash if succeeded.
  1.1213 +# Returns () if not found.
  1.1214 +# Assumptions: In error handling we assume that the verification code
  1.1215 +#              starts with the wikiname under consideration, and that the
  1.1216 +#              random code does not contain a '.'.
  1.1217 +sub _loadPendingRegistration {
  1.1218 +    my( $session, $code ) = @_;
  1.1219 +
  1.1220 +    ASSERT($code) if DEBUG;
  1.1221 +
  1.1222 +    my $file;
  1.1223 +    try {
  1.1224 +        $file = _codeFile( $code );
  1.1225 +    } catch Error::Simple with {
  1.1226 +        throw TWiki::OopsException(
  1.1227 +            'attention',
  1.1228 +            def => 'bad_ver_code',
  1.1229 +            params => [ $code, 'Invalid code' ],
  1.1230 +           );
  1.1231 +    };
  1.1232 +
  1.1233 +    unless( -f $file ){
  1.1234 +        my $wikiName = _codeWikiName( $code );
  1.1235 +        my $users = $session->{users}->findUserByWikiName( $wikiName );
  1.1236 +        if( scalar( @{$users} ) &&
  1.1237 +              $session->{users}->userExists( $users->[0] )) {
  1.1238 +            throw TWiki::OopsException(
  1.1239 +                'attention',
  1.1240 +                def => 'duplicate_activation',
  1.1241 +                params => [ $wikiName ],
  1.1242 +               );
  1.1243 +        }
  1.1244 +        throw TWiki::OopsException(
  1.1245 +            'attention',
  1.1246 +            def => 'bad_ver_code',
  1.1247 +            params => [ $code, 'Code is not recognised' ],
  1.1248 +           );
  1.1249 +    }
  1.1250 +
  1.1251 +    do $file;
  1.1252 +    $data->{form} = $form if $form;
  1.1253 +    throw TWiki::OopsException(
  1.1254 +        'attention',
  1.1255 +        def => 'bad_ver_code',
  1.1256 +        params => [ $code, 'Bad activation code' ] ) if $!;
  1.1257 +    throw TWiki::OopsException(
  1.1258 +        'attention',
  1.1259 +        def => 'bad_ver_code',
  1.1260 +        params => [ $code, 'Invalid activation code ' ] )
  1.1261 +      unless $data->{VerificationCode} eq $code;
  1.1262 +
  1.1263 +    return $data;
  1.1264 +}
  1.1265 +
  1.1266 +sub _getDataFromQuery {
  1.1267 +    my $query = shift;
  1.1268 +    # get all parameters from the form
  1.1269 +    my $data = {};
  1.1270 +    foreach( $query->param() ) {
  1.1271 +        if (/^(Twk)([0-9])(.*)/) {
  1.1272 +            my $form = {};
  1.1273 +            $form->{required} = $2;
  1.1274 +            my $name = $3;
  1.1275 +            my @values = $query->param($1.$2.$3);
  1.1276 +            my $value = join(',', @values); #deal with multivalue fields like checkboxen
  1.1277 +            $form->{name} = $name;
  1.1278 +            $form->{value} = $value;
  1.1279 +            if ( $name eq 'Password' ) {
  1.1280 +                #TODO: get rid of this; move to removals and generalise.
  1.1281 +                $data->{passwordA} = $value;
  1.1282 +            } elsif ( $name eq 'Confirm' ) {
  1.1283 +                $data->{passwordB} = $value;
  1.1284 +            }
  1.1285 +
  1.1286 +            # 'WikiName' omitted because they can't
  1.1287 +            # change it, and 'Confirm' is a duplicate
  1.1288 +            push( @{$data->{form}}, $form )
  1.1289 +              unless ($name eq 'WikiName' || $name eq 'Confirm');
  1.1290 +
  1.1291 +            #TODO: need to change this to be untainting the data correctly
  1.1292 +            #      for eg, for {Emails} only accept real email addresses.
  1.1293 +            $data->{$name} = TWiki::Sandbox::untaintUnchecked($value);
  1.1294 +        }
  1.1295 +    }
  1.1296 +    $data->{WikiName} = TWiki::Sandbox::untaintUnchecked($data->{WikiName});
  1.1297 +    if( !$data->{Name} &&
  1.1298 +          defined $data->{FirstName} && defined $data->{LastName}) {
  1.1299 +        $data->{Name} = $data->{FirstName}.' '.$data->{LastName};
  1.1300 +    }
  1.1301 +    return $data;
  1.1302 +}
  1.1303 +
  1.1304 +# We delete only the field in the {form} array - this leaves
  1.1305 +# the original value still there should  we want it i.e. it must
  1.1306 +# still be available via $row->{$key} even though $row-{form}[]
  1.1307 +# does not contain it
  1.1308 +sub _deleteKey {
  1.1309 +    my ($row, $key) = @_;
  1.1310 +    my @formArray = @{$row->{form}};
  1.1311 +
  1.1312 +    foreach my $index (0..$#formArray) {
  1.1313 +        my $a = $formArray[$index];
  1.1314 +        my $name = $a->{name};
  1.1315 +        my $value = $a->{value};
  1.1316 +        if ($name eq $key) {
  1.1317 +            splice (@{$row->{form}}, $index, 1);
  1.1318 +            last;
  1.1319 +        }
  1.1320 +    }
  1.1321 +};
  1.1322 +
  1.1323 +1;