+# END BPS TAGGED BLOCK }}}
+
+=head1 NAME
+
+ RT::User - RT User object
+
+=head1 SYNOPSIS
+
+ use RT::User;
+
+=head1 DESCRIPTION
+
+=head1 METHODS
+
+=cut
+
+
+package RT::User;
+
+use strict;
+use warnings;
+
+
+use base 'RT::Record';
+
+sub Table {'Users'}
+
+
+
+
+
+
+use Digest::SHA;
+use Digest::MD5;
+use RT::Principals;
+use RT::ACE;
+use RT::Interface::Email;
+use Encode;
+use Text::Password::Pronounceable;
+
+sub _OverlayAccessible {
+ {
+
+ Name => { public => 1, admin => 1 },
+ Password => { read => 0 },
+ EmailAddress => { public => 1 },
+ Organization => { public => 1, admin => 1 },
+ RealName => { public => 1 },
+ NickName => { public => 1 },
+ Lang => { public => 1 },
+ EmailEncoding => { public => 1 },
+ WebEncoding => { public => 1 },
+ ExternalContactInfoId => { public => 1, admin => 1 },
+ ContactInfoSystem => { public => 1, admin => 1 },
+ ExternalAuthId => { public => 1, admin => 1 },
+ AuthSystem => { public => 1, admin => 1 },
+ Gecos => { public => 1, admin => 1 },
+ PGPKey => { public => 1, admin => 1 },
+ PrivateKey => { admin => 1 },
+
+ }
+}
+
+
+
+=head2 Create { PARAMHASH }
+
+
+
+=cut
+
+
+sub Create {
+ my $self = shift;
+ my %args = (
+ Privileged => 0,
+ Disabled => 0,
+ EmailAddress => '',
+ _RecordTransaction => 1,
+ @_ # get the real argumentlist
+ );
+
+ # remove the value so it does not cripple SUPER::Create
+ my $record_transaction = delete $args{'_RecordTransaction'};
+
+ #Check the ACL
+ unless ( $self->CurrentUser->HasRight(Right => 'AdminUsers', Object => $RT::System) ) {
+ return ( 0, $self->loc('Permission Denied') );
+ }
+
+
+ unless ($self->CanonicalizeUserInfo(\%args)) {
+ return ( 0, $self->loc("Could not set user info") );
+ }
+
+ $args{'EmailAddress'} = $self->CanonicalizeEmailAddress($args{'EmailAddress'});
+
+ # if the user doesn't have a name defined, set it to the email address
+ $args{'Name'} = $args{'EmailAddress'} unless ($args{'Name'});
+
+
+
+ my $privileged = delete $args{'Privileged'};
+
+
+ if ($args{'CryptedPassword'} ) {
+ $args{'Password'} = $args{'CryptedPassword'};
+ delete $args{'CryptedPassword'};
+ } elsif ( !$args{'Password'} ) {
+ $args{'Password'} = '*NO-PASSWORD*';
+ } else {
+ my ($ok, $msg) = $self->ValidatePassword($args{'Password'});
+ return ($ok, $msg) if !$ok;
+
+ $args{'Password'} = $self->_GeneratePassword($args{'Password'});
+ }
+
+ #TODO Specify some sensible defaults.
+
+ unless ( $args{'Name'} ) {
+ return ( 0, $self->loc("Must specify 'Name' attribute") );
+ }
+
+ #SANITY CHECK THE NAME AND ABORT IF IT'S TAKEN
+ if (RT->SystemUser) { #This only works if RT::SystemUser has been defined
+ my $TempUser = RT::User->new(RT->SystemUser);
+ $TempUser->Load( $args{'Name'} );
+ return ( 0, $self->loc('Name in use') ) if ( $TempUser->Id );
+
+ my ($val, $message) = $self->ValidateEmailAddress( $args{'EmailAddress'} );
+ return (0, $message) unless ( $val );
+ } else {
+ $RT::Logger->warning( "$self couldn't check for pre-existing users");
+ }
+
+
+ $RT::Handle->BeginTransaction();
+ # Groups deal with principal ids, rather than user ids.
+ # When creating this user, set up a principal Id for it.
+ my $principal = RT::Principal->new($self->CurrentUser);
+ my $principal_id = $principal->Create(PrincipalType => 'User',
+ Disabled => $args{'Disabled'},
+ ObjectId => '0');
+ # If we couldn't create a principal Id, get the fuck out.
+ unless ($principal_id) {
+ $RT::Handle->Rollback();
+ $RT::Logger->crit("Couldn't create a Principal on new user create.");
+ $RT::Logger->crit("Strange things are afoot at the circle K");
+ return ( 0, $self->loc('Could not create user') );
+ }
+
+ $principal->__Set(Field => 'ObjectId', Value => $principal_id);
+ delete $args{'Disabled'};
+
+ $self->SUPER::Create(id => $principal_id , %args);
+ my $id = $self->Id;
+
+ #If the create failed.
+ unless ($id) {
+ $RT::Handle->Rollback();
+ $RT::Logger->error("Could not create a new user - " .join('-', %args));
+
+ return ( 0, $self->loc('Could not create user') );
+ }
+
+ my $aclstash = RT::Group->new($self->CurrentUser);
+ my $stash_id = $aclstash->_CreateACLEquivalenceGroup($principal);
+
+ unless ($stash_id) {
+ $RT::Handle->Rollback();
+ $RT::Logger->crit("Couldn't stash the user in groupmembers");
+ return ( 0, $self->loc('Could not create user') );
+ }
+
+
+ my $everyone = RT::Group->new($self->CurrentUser);
+ $everyone->LoadSystemInternalGroup('Everyone');
+ unless ($everyone->id) {
+ $RT::Logger->crit("Could not load Everyone group on user creation.");
+ $RT::Handle->Rollback();
+ return ( 0, $self->loc('Could not create user') );
+ }
+
+
+ my ($everyone_id, $everyone_msg) = $everyone->_AddMember( InsideTransaction => 1, PrincipalId => $self->PrincipalId);
+ unless ($everyone_id) {
+ $RT::Logger->crit("Could not add user to Everyone group on user creation.");
+ $RT::Logger->crit($everyone_msg);
+ $RT::Handle->Rollback();
+ return ( 0, $self->loc('Could not create user') );
+ }
+
+
+ my $access_class = RT::Group->new($self->CurrentUser);
+ if ($privileged) {
+ $access_class->LoadSystemInternalGroup('Privileged');
+ } else {
+ $access_class->LoadSystemInternalGroup('Unprivileged');
+ }
+
+ unless ($access_class->id) {
+ $RT::Logger->crit("Could not load Privileged or Unprivileged group on user creation");
+ $RT::Handle->Rollback();
+ return ( 0, $self->loc('Could not create user') );
+ }
+
+
+ my ($ac_id, $ac_msg) = $access_class->_AddMember( InsideTransaction => 1, PrincipalId => $self->PrincipalId);
+
+ unless ($ac_id) {
+ $RT::Logger->crit("Could not add user to Privileged or Unprivileged group on user creation. Aborted");
+ $RT::Logger->crit($ac_msg);
+ $RT::Handle->Rollback();
+ return ( 0, $self->loc('Could not create user') );
+ }
+
+
+ if ( $record_transaction ) {
+ $self->_NewTransaction( Type => "Create" );
+ }
+
+ $RT::Handle->Commit;
+
+ return ( $id, $self->loc('User created') );
+}
+
+=head2 ValidatePassword STRING
+
+Returns either (0, "failure reason") or 1 depending on whether the given
+password is valid.
+
+=cut
+
+sub ValidatePassword {
+ my $self = shift;
+ my $password = shift;
+
+ if ( length($password) < RT->Config->Get('MinimumPasswordLength') ) {
+ return ( 0, $self->loc("Password needs to be at least [_1] characters long", RT->Config->Get('MinimumPasswordLength')) );
+ }
+
+ return 1;
+}
+
+=head2 SetPrivileged BOOL
+
+If passed a true value, makes this user a member of the "Privileged" PseudoGroup.
+Otherwise, makes this user a member of the "Unprivileged" pseudogroup.
+
+Returns a standard RT tuple of (val, msg);
+
+
+=cut
+
+sub SetPrivileged {
+ my $self = shift;
+ my $val = shift;
+
+ #Check the ACL
+ unless ( $self->CurrentUser->HasRight(Right => 'AdminUsers', Object => $RT::System) ) {
+ return ( 0, $self->loc('Permission Denied') );
+ }
+
+ $self->_SetPrivileged($val);
+}
+
+sub _SetPrivileged {
+ my $self = shift;
+ my $val = shift;
+ my $priv = RT::Group->new($self->CurrentUser);
+ $priv->LoadSystemInternalGroup('Privileged');
+ unless ($priv->Id) {
+ $RT::Logger->crit("Could not find Privileged pseudogroup");
+ return(0,$self->loc("Failed to find 'Privileged' users pseudogroup."));
+ }
+
+ my $unpriv = RT::Group->new($self->CurrentUser);
+ $unpriv->LoadSystemInternalGroup('Unprivileged');
+ unless ($unpriv->Id) {
+ $RT::Logger->crit("Could not find unprivileged pseudogroup");
+ return(0,$self->loc("Failed to find 'Unprivileged' users pseudogroup"));
+ }
+
+ my $principal = $self->PrincipalId;
+ if ($val) {
+ if ($priv->HasMember($principal)) {
+ #$RT::Logger->debug("That user is already privileged");
+ return (0,$self->loc("That user is already privileged"));
+ }
+ if ($unpriv->HasMember($principal)) {
+ $unpriv->_DeleteMember($principal);
+ } else {
+ # if we had layered transactions, life would be good
+ # sadly, we have to just go ahead, even if something
+ # bogus happened
+ $RT::Logger->crit("User ".$self->Id." is neither privileged nor ".
+ "unprivileged. something is drastically wrong.");
+ }
+ my ($status, $msg) = $priv->_AddMember( InsideTransaction => 1, PrincipalId => $principal);
+ if ($status) {
+ return (1, $self->loc("That user is now privileged"));
+ } else {
+ return (0, $msg);
+ }
+ } else {
+ if ($unpriv->HasMember($principal)) {
+ #$RT::Logger->debug("That user is already unprivileged");
+ return (0,$self->loc("That user is already unprivileged"));
+ }
+ if ($priv->HasMember($principal)) {
+ $priv->_DeleteMember( $principal );
+ } else {
+ # if we had layered transactions, life would be good
+ # sadly, we have to just go ahead, even if something
+ # bogus happened
+ $RT::Logger->crit("User ".$self->Id." is neither privileged nor ".
+ "unprivileged. something is drastically wrong.");
+ }
+ my ($status, $msg) = $unpriv->_AddMember( InsideTransaction => 1, PrincipalId => $principal);
+ if ($status) {
+ return (1, $self->loc("That user is now unprivileged"));
+ } else {
+ return (0, $msg);
+ }
+ }
+}
+
+=head2 Privileged
+
+Returns true if this user is privileged. Returns undef otherwise.
+
+=cut
+
+sub Privileged {
+ my $self = shift;
+ if ( RT->PrivilegedUsers->HasMember( $self->id ) ) {
+ return(1);
+ } else {
+ return(undef);
+ }
+}
+
+#create a user without validating _any_ data.
+
+#To be used only on database init.
+# We can't localize here because it's before we _have_ a loc framework
+
+sub _BootstrapCreate {
+ my $self = shift;
+ my %args = (@_);
+
+ $args{'Password'} = '*NO-PASSWORD*';
+
+
+ $RT::Handle->BeginTransaction();
+
+ # Groups deal with principal ids, rather than user ids.
+ # When creating this user, set up a principal Id for it.
+ my $principal = RT::Principal->new($self->CurrentUser);
+ my $principal_id = $principal->Create(PrincipalType => 'User', ObjectId => '0');
+ $principal->__Set(Field => 'ObjectId', Value => $principal_id);
+
+ # If we couldn't create a principal Id, get the fuck out.
+ unless ($principal_id) {
+ $RT::Handle->Rollback();
+ $RT::Logger->crit("Couldn't create a Principal on new user create. Strange things are afoot at the circle K");
+ return ( 0, 'Could not create user' );
+ }
+ $self->SUPER::Create(id => $principal_id, %args);
+ my $id = $self->Id;
+ #If the create failed.
+ unless ($id) {
+ $RT::Handle->Rollback();
+ return ( 0, 'Could not create user' ) ; #never loc this
+ }
+
+ my $aclstash = RT::Group->new($self->CurrentUser);
+ my $stash_id = $aclstash->_CreateACLEquivalenceGroup($principal);
+
+ unless ($stash_id) {
+ $RT::Handle->Rollback();
+ $RT::Logger->crit("Couldn't stash the user in groupmembers");
+ return ( 0, $self->loc('Could not create user') );
+ }
+
+ $RT::Handle->Commit();
+
+ return ( $id, 'User created' );
+}
+
+sub Delete {
+ my $self = shift;
+
+ return ( 0, $self->loc('Deleting this object would violate referential integrity') );
+
+}
+
+=head2 Load
+
+Load a user object from the database. Takes a single argument.
+If the argument is numerical, load by the column 'id'. If a user
+object or its subclass passed then loads the same user by id.
+Otherwise, load by the "Name" column which is the user's textual
+username.
+
+=cut
+
+sub Load {
+ my $self = shift;
+ my $identifier = shift || return undef;
+
+ if ( $identifier !~ /\D/ ) {
+ return $self->SUPER::LoadById( $identifier );
+ } elsif ( UNIVERSAL::isa( $identifier, 'RT::User' ) ) {
+ return $self->SUPER::LoadById( $identifier->Id );
+ } else {
+ return $self->LoadByCol( "Name", $identifier );
+ }
+}
+
+=head2 LoadByEmail
+
+Tries to load this user object from the database by the user's email address.
+
+=cut
+
+sub LoadByEmail {
+ my $self = shift;
+ my $address = shift;
+
+ # Never load an empty address as an email address.
+ unless ($address) {
+ return (undef);
+ }
+
+ $address = $self->CanonicalizeEmailAddress($address);
+
+ #$RT::Logger->debug("Trying to load an email address: $address");
+ return $self->LoadByCol( "EmailAddress", $address );
+}
+
+=head2 LoadOrCreateByEmail ADDRESS
+
+Attempts to find a user who has the provided email address. If that fails, creates an unprivileged user with
+the provided email address and loads them. Address can be provided either as L<Email::Address> object
+or string which is parsed using the module.
+
+Returns a tuple of the user's id and a status message.
+0 will be returned in place of the user's id in case of failure.
+
+=cut
+
+sub LoadOrCreateByEmail {
+ my $self = shift;
+ my $email = shift;
+
+ my ($message, $name);
+ if ( UNIVERSAL::isa( $email => 'Email::Address' ) ) {
+ ($email, $name) = ($email->address, $email->phrase);
+ } else {
+ ($email, $name) = RT::Interface::Email::ParseAddressFromHeader( $email );
+ }
+
+ $self->LoadByEmail( $email );
+ $self->Load( $email ) unless $self->Id;
+ $message = $self->loc('User loaded');
+
+ unless( $self->Id ) {
+ my $val;
+ ($val, $message) = $self->Create(
+ Name => $email,
+ EmailAddress => $email,
+ RealName => $name,
+ Privileged => 0,
+ Comments => 'Autocreated when added as a watcher',
+ );
+ unless ( $val ) {
+ # Deal with the race condition of two account creations at once
+ $self->LoadByEmail( $email );
+ unless ( $self->Id ) {
+ sleep 5;
+ $self->LoadByEmail( $email );
+ }
+ if ( $self->Id ) {
+ $RT::Logger->error("Recovered from creation failure due to race condition");
+ $message = $self->loc("User loaded");
+ } else {
+ $RT::Logger->crit("Failed to create user ". $email .": " .$message);
+ }
+ }
+ }
+ return (0, $message) unless $self->id;
+ return ($self->Id, $message);
+}
+
+=head2 ValidateEmailAddress ADDRESS
+
+Returns true if the email address entered is not in use by another user or is
+undef or ''. Returns false if it's in use.
+
+=cut
+
+sub ValidateEmailAddress {
+ my $self = shift;
+ my $Value = shift;
+
+ # if the email address is null, it's always valid
+ return (1) if ( !$Value || $Value eq "" );
+
+ if ( RT->Config->Get('ValidateUserEmailAddresses') ) {
+ # We only allow one valid email address
+ my @addresses = Email::Address->parse($Value);
+ return ( 0, $self->loc('Invalid syntax for email address') ) unless ( ( scalar (@addresses) == 1 ) && ( $addresses[0]->address ) );
+ }
+
+
+ my $TempUser = RT::User->new(RT->SystemUser);
+ $TempUser->LoadByEmail($Value);
+
+ if ( $TempUser->id && ( !$self->id || $TempUser->id != $self->id ) )
+ { # if we found a user with that address
+ # it's invalid to set this user's address to it
+ return ( 0, $self->loc('Email address in use') );
+ } else { #it's a valid email address
+ return (1);
+ }
+}
+
+=head2 SetEmailAddress
+
+Check to make sure someone else isn't using this email address already
+so that a better email address can be returned
+
+=cut
+
+sub SetEmailAddress {
+ my $self = shift;
+ my $Value = shift;
+ $Value = '' unless defined $Value;
+
+ my ($val, $message) = $self->ValidateEmailAddress( $Value );
+ if ( $val ) {
+ return $self->_Set( Field => 'EmailAddress', Value => $Value );
+ } else {
+ return ( 0, $message )
+ }
+
+}
+
+=head2 EmailFrequency
+
+Takes optional Ticket argument in paramhash. Returns 'no email',
+'squelched', 'daily', 'weekly' or empty string depending on
+user preferences.
+
+=over 4
+
+=item 'no email' - user has no email, so can not recieve notifications.
+
+=item 'squelched' - returned only when Ticket argument is provided and
+notifications to the user has been supressed for this ticket.
+
+=item 'daily' - retruned when user recieve daily messages digest instead
+of immediate delivery.
+
+=item 'weekly' - previous, but weekly.
+
+=item empty string returned otherwise.
+
+=back
+
+=cut
+
+sub EmailFrequency {
+ my $self = shift;
+ my %args = (
+ Ticket => undef,
+ @_
+ );
+ return '' unless $self->id && $self->id != RT->Nobody->id
+ && $self->id != RT->SystemUser->id;
+ return 'no email address' unless my $email = $self->EmailAddress;
+ return 'email disabled for ticket' if $args{'Ticket'} &&
+ grep lc $email eq lc $_->Content, $args{'Ticket'}->SquelchMailTo;
+ my $frequency = RT->Config->Get( 'EmailFrequency', $self ) || '';
+ return 'daily' if $frequency =~ /daily/i;
+ return 'weekly' if $frequency =~ /weekly/i;
+ return '';
+}
+
+=head2 CanonicalizeEmailAddress ADDRESS
+
+CanonicalizeEmailAddress converts email addresses into canonical form.
+it takes one email address in and returns the proper canonical
+form. You can dump whatever your proper local config is in here. Note
+that it may be called as a static method; in this case the first argument
+is class name not an object.
+
+=cut
+
+sub CanonicalizeEmailAddress {
+ my $self = shift;
+ my $email = shift;
+ # Example: the following rule would treat all email
+ # coming from a subdomain as coming from second level domain
+ # foo.com
+ if ( my $match = RT->Config->Get('CanonicalizeEmailAddressMatch') and
+ my $replace = RT->Config->Get('CanonicalizeEmailAddressReplace') )
+ {
+ $email =~ s/$match/$replace/gi;
+ }
+ return ($email);
+}
+
+=head2 CanonicalizeUserInfo HASH of ARGS
+
+CanonicalizeUserInfo can convert all User->Create options.
+it takes a hashref of all the params sent to User->Create and
+returns that same hash, by default nothing is done.
+
+This function is intended to allow users to have their info looked up via
+an outside source and modified upon creation.
+
+=cut
+
+sub CanonicalizeUserInfo {
+ my $self = shift;
+ my $args = shift;
+ my $success = 1;
+
+ return ($success);
+}
+
+
+=head2 Password and authentication related functions
+
+=head3 SetRandomPassword
+
+Takes no arguments. Returns a status code and a new password or an error message.
+If the status is 1, the second value returned is the new password.
+If the status is anything else, the new value returned is the error code.
+
+=cut
+
+sub SetRandomPassword {
+ my $self = shift;
+
+ unless ( $self->CurrentUserCanModify('Password') ) {
+ return ( 0, $self->loc("Permission Denied") );
+ }
+
+
+ my $min = ( RT->Config->Get('MinimumPasswordLength') > 6 ? RT->Config->Get('MinimumPasswordLength') : 6);
+ my $max = ( RT->Config->Get('MinimumPasswordLength') > 8 ? RT->Config->Get('MinimumPasswordLength') : 8);
+
+ my $pass = $self->GenerateRandomPassword( $min, $max) ;
+
+ # If we have "notify user on
+
+ my ( $val, $msg ) = $self->SetPassword($pass);
+
+ #If we got an error return the error.
+ return ( 0, $msg ) unless ($val);
+
+ #Otherwise, we changed the password, lets return it.
+ return ( 1, $pass );
+
+}
+
+=head3 ResetPassword
+
+Returns status, [ERROR or new password]. Resets this user's password to
+a randomly generated pronouncable password and emails them, using a
+global template called "PasswordChange".
+
+This function is currently unused in the UI, but available for local scripts.
+
+=cut
+
+sub ResetPassword {
+ my $self = shift;
+
+ unless ( $self->CurrentUserCanModify('Password') ) {
+ return ( 0, $self->loc("Permission Denied") );
+ }
+ my ( $status, $pass ) = $self->SetRandomPassword();
+
+ unless ($status) {
+ return ( 0, "$pass" );
+ }
+
+ my $ret = RT::Interface::Email::SendEmailUsingTemplate(
+ To => $self->EmailAddress,
+ Template => 'PasswordChange',
+ Arguments => {
+ NewPassword => $pass,
+ },
+ );
+
+ if ($ret) {
+ return ( 1, $self->loc('New password notification sent') );
+ } else {
+ return ( 0, $self->loc('Notification could not be sent') );
+ }
+
+}
+
+=head3 GenerateRandomPassword MIN_LEN and MAX_LEN
+
+Returns a random password between MIN_LEN and MAX_LEN characters long.
+
+=cut
+
+sub GenerateRandomPassword {
+ my $self = shift; # just to drop it
+ return Text::Password::Pronounceable->generate(@_);
+}
+
+sub SafeSetPassword {
+ my $self = shift;
+ my %args = (
+ Current => undef,
+ New => undef,
+ Confirmation => undef,
+ @_,
+ );
+ return (1) unless defined $args{'New'} && length $args{'New'};
+
+ my %cond = $self->CurrentUserRequireToSetPassword;
+
+ unless ( $cond{'CanSet'} ) {
+ return (0, $self->loc('You can not set password.') .' '. $cond{'Reason'} );
+ }
+
+ my $error = '';
+ if ( $cond{'RequireCurrent'} && !$self->CurrentUser->IsPassword($args{'Current'}) ) {
+ if ( defined $args{'Current'} && length $args{'Current'} ) {
+ $error = $self->loc("Please enter your current password correctly.");
+ } else {
+ $error = $self->loc("Please enter your current password.");
+ }
+ } elsif ( $args{'New'} ne $args{'Confirmation'} ) {
+ $error = $self->loc("Passwords do not match.");
+ }
+
+ if ( $error ) {
+ $error .= ' '. $self->loc('Password has not been set.');
+ return (0, $error);
+ }
+
+ return $self->SetPassword( $args{'New'} );
+}
+
+=head3 SetPassword
+
+Takes a string. Checks the string's length and sets this user's password
+to that string.
+
+=cut
+
+sub SetPassword {
+ my $self = shift;
+ my $password = shift;
+
+ unless ( $self->CurrentUserCanModify('Password') ) {
+ return ( 0, $self->loc('Password: Permission Denied') );
+ }
+
+ if ( !$password ) {
+ return ( 0, $self->loc("No password set") );
+ } else {
+ my ($val, $msg) = $self->ValidatePassword($password);
+ return ($val, $msg) if !$val;
+
+ my $new = !$self->HasPassword;
+ $password = $self->_GeneratePassword($password);
+
+ ( $val, $msg ) = $self->_Set(Field => 'Password', Value => $password);
+ if ($val) {
+ return ( 1, $self->loc("Password set") ) if $new;
+ return ( 1, $self->loc("Password changed") );
+ } else {
+ return ( $val, $msg );
+ }
+ }
+
+}
+
+sub _GeneratePassword_sha512 {
+ my $self = shift;
+ my ($password, $salt) = @_;
+
+ # Generate a 16-character base64 salt
+ unless ($salt) {
+ $salt = "";
+ $salt .= ("a".."z", "A".."Z","0".."9", "+", "/")[rand 64]
+ for 1..16;
+ }
+
+ my $sha = Digest::SHA->new(512);
+ $sha->add($salt);
+ $sha->add(encode_utf8($password));
+ return join("!", "", "sha512", $salt, $sha->b64digest);
+}
+
+=head3 _GeneratePassword PASSWORD [, SALT]
+
+Returns a string to store in the database. This string takes the form:
+
+ !method!salt!hash
+
+By default, the method is currently C<sha512>.
+
+=cut
+
+sub _GeneratePassword {
+ my $self = shift;
+ return $self->_GeneratePassword_sha512(@_);
+}
projects / freeside.git / blobdiff