site/cgi-bin/modules/BSE/TB/OtherParents.pm
site/cgi-bin/modules/BSE/TB/Product.pm
site/cgi-bin/modules/BSE/TB/Products.pm
-site/cgi-bin/modules/SiteUser.pm
-site/cgi-bin/modules/SiteUsers.pm
+site/cgi-bin/modules/BSE/TB/SiteUser.pm
+site/cgi-bin/modules/BSE/TB/SiteUsers.pm
site/cgi-bin/modules/Squirrel/GPG.pm
site/cgi-bin/modules/Squirrel/PGP5.pm
site/cgi-bin/modules/Squirrel/PGP6.pm
use base qw(BSE::UI::AdminDispatch BSE::UI::SiteuserCommon);
use BSE::Util::Tags qw(tag_error_img tag_hash);
use BSE::Util::HTML qw(:default popup_menu);
-use SiteUsers;
+use BSE::TB::SiteUsers;
use BSE::Util::Iterate;
use BSE::Util::DynSort qw(sorter tag_sorthelp);
use BSE::Util::SQL qw/now_datetime/;
use BSE::Template;
use DevHelp::Date qw(dh_parse_date_sql dh_parse_time_sql);
-our $VERSION = "1.014";
+our $VERSION = "1.015";
my %actions =
(
my $cgi = $req->cgi;
$msg = $req->message($msg);
- my @users = SiteUsers->all;
+ my @users = BSE::TB::SiteUsers->all;
my $id = $cgi->param('id');
defined $id or $id = '';
my $search_done = 0;
}
else {
my %fields;
- my @cols = grep !$nosearch{$_}, SiteUser->columns;
+ my @cols = grep !$nosearch{$_}, BSE::TB::SiteUser->columns;
for my $col (@cols, 'name') {
my $value = $cgi->param($col);
if (defined $value && $value =~ /\S/) {
my $userId = $cgi->param('userId');
my $siteuser;
if (defined $id) {
- $siteuser = SiteUsers->getByPkey($id)
+ $siteuser = BSE::TB::SiteUsers->getByPkey($id)
or return $class->req_list($req, "No site user id '$id' found");
}
elsif (defined $userId) {
- ($siteuser) = SiteUsers->getBy(userId => $userId)
+ ($siteuser) = BSE::TB::SiteUsers->getBy(userId => $userId)
or return $class->req_list($req, "No site user logon '$userId' found");
}
else {
$id && $id =~ /^\d+$/
or return $class->req_list($req, "No user id supplied");
- my $user = SiteUsers->getByPkey($id)
+ my $user = BSE::TB::SiteUsers->getByPkey($id)
or return $class->req_list($req, "No user $id found");
my %errors;
my $nopassword = $req->cfg->entry('site users', 'nopassword', 0);
- my @cols = grep !$donttouch{$_}, SiteUser->columns;
+ my @cols = grep !$donttouch{$_}, BSE::TB::SiteUser->columns;
my $custom = custom_class($cfg);
my @required = $custom->siteuser_edit_required($req, $user);
for my $col (@required) {
$conf_email =~ s/^\s+|\s+$//g;
if ($conf_email) {
if ($conf_email eq $email) {
- my $other = SiteUsers->getBy(userId=>$email);
+ my $other = BSE::TB::SiteUsers->getBy(userId=>$email);
if ($other) {
$errors{email} = "That email address is already in use";
}
}
}
unless ($errors{email}) {
- my $checkemail = SiteUser->generic_email($email);
+ my $checkemail = BSE::TB::SiteUser->generic_email($email);
require BSE::EmailBlacklist;
my $blackentry = BSE::EmailBlacklist->getEntry($checkemail);
if ($blackentry) {
if (defined $newpass && length $newpass) {
my @errors;
- my %other = map { $_ => $user->$_() } SiteUser->password_check_fields;
- if (!SiteUser->check_password_rules
+ my %other = map { $_ => $user->$_() } BSE::TB::SiteUser->password_check_fields;
+ if (!BSE::TB::SiteUser->check_password_rules
(
password => $newpass,
username => $user->userId,
$id && $id =~ /^\d+$/
or return $class->req_list($req, "No user id supplied");
- my $user = SiteUsers->getByPkey($id)
+ my $user = BSE::TB::SiteUsers->getByPkey($id)
or return $class->req_list($req, "No user $id found");
$req->audit
my $cfg = $req->cfg;
my %user;
- my @cols = SiteUser->columns;
+ my @cols = BSE::TB::SiteUser->columns;
shift @cols;
my $custom = custom_class($cfg);
elsif ($email ne $confemail) {
$errors{confirmemail} = "Confirmation email should match the Email Address";
}
- my $user = SiteUsers->getBy(userId=>$email);
+ my $user = BSE::TB::SiteUsers->getBy(userId=>$email);
if ($user) {
$errors{email} = "Sorry, email $email already exists as a user";
}
my $pass2 = $cgi->param('confirm_password');
$pass2 =~ s/\A\s+//, $pass2 =~ s/\s+\z// if defined $pass2;
my %other = map { $_ => scalar $cgi->param($_) }
- SiteUser->password_check_fields;
+ BSE::TB::SiteUser->password_check_fields;
my @errors;
if (!defined $pass || length $pass == 0) {
$errors{password} = "Please enter a password";
}
- elsif (!SiteUser->check_password_rules
+ elsif (!BSE::TB::SiteUser->check_password_rules
(
password => $pass,
username => $userid,
$errors{confirm_password} =
"The confirmation password is different from the password";
}
- my $user = SiteUsers->getBy(userId=>$userid);
+ my $user = BSE::TB::SiteUsers->getBy(userId=>$userid);
if ($user) {
# give the user a suggestion
my $workuser = $userid;
$workuser =~ s/\d+$//;
my $suffix = 1;
for my $suffix (1..100) {
- unless (SiteUsers->getBy(userId=>"$workuser$suffix")) {
+ unless (BSE::TB::SiteUsers->getBy(userId=>"$workuser$suffix")) {
$cgi->param(userid=>"$workuser$suffix");
last;
}
}
unless ($errors{email}) {
- my $checkemail = SiteUser->generic_email($email);
+ my $checkemail = BSE::TB::SiteUser->generic_email($email);
require 'BSE/EmailBlacklist.pm';
my $blackentry = BSE::EmailBlacklist->getEntry($checkemail);
if ($blackentry) {
my $user;
eval {
- $user = SiteUsers->make(%user);
+ $user = BSE::TB::SiteUsers->make(%user);
};
if ($user) {
my $subs = $class->save_subs($req, $user);
$id && $id =~ /^\d+$/
or return $class->req_list($req, "No user id supplied");
- my $user = SiteUsers->getByPkey($id)
+ my $user = BSE::TB::SiteUsers->getByPkey($id)
or return $class->req_list($req, "No user $id found");
$user->unlock(request => $req);
$aff_name =~ s/^\s+|\s+$//g;
if (length $aff_name) {
if ($aff_name =~ /^\w+$/) {
- my $other = SiteUsers->getBy(affiliate_name => $aff_name);
+ my $other = BSE::TB::SiteUsers->getBy(affiliate_name => $aff_name);
if ($other && (!$user || $other->{id} != $user->{id})) {
$errors->{affiliate_name} = "$display $aff_name is already in use";
}
$msg = $req->message($errors);
my %members = map { $_=> 1 } $group->member_ids;
- my @siteusers = SiteUsers->all;
+ my @siteusers = BSE::TB::SiteUsers->all;
my $user;
my %current_ids = map { $_ => 1 } $group->member_ids;
my @to_be_set = $cgi->param('set_is_member');
my %set_ids = map { $_ => 1 } $cgi->param('is_member');
- my %all_ids = map { $_ => 1 } SiteUsers->all_ids;
+ my %all_ids = map { $_ => 1 } BSE::TB::SiteUsers->all_ids;
my $custom = custom_class($req->cfg);
my $id = $cgi->param('id');
defined $id
or return $class->req_list($req, "No site user id supplied");
- my $siteuser = SiteUsers->getByPkey($id)
+ my $siteuser = BSE::TB::SiteUsers->getByPkey($id)
or return $class->req_list($req, "No such site user found");
$siteuser->{confirmed} = 1;
defined $id && $id =~ /^\d+$/
or do { $$msg = "Missing or invalid user id"; return };
require BSE::TB::SiteUserGroups;
- my $group = SiteUsers->getByPkey($id);
+ my $group = BSE::TB::SiteUsers->getByPkey($id);
$group
or do { $$msg = "Unknown user id"; return };
or return '';
my $id = $$rcurrent->siteuser_id;
exists $cache->{$id}
- or $cache->{$id} = SiteUsers->getByPkey($id);
+ or $cache->{$id} = BSE::TB::SiteUsers->getByPkey($id);
$cache->{$id}
or return "** No user $id";
or return '';
my $id = $$rcurrent->siteuser_id;
exists $cache->{$id}
- or $cache->{$id} = SiteUsers->getByPkey($id);
+ or $cache->{$id} = BSE::TB::SiteUsers->getByPkey($id);
return defined $cache->{$id};
}
require BSE::TB::SiteUserGroups;
my $owner;
- if ($owner_type eq SiteUser->file_owner_type) {
- if ($cache->{$owner_id} ||= SiteUsers->getByPkey($owner_id)) {
+ if ($owner_type eq BSE::TB::SiteUser->file_owner_type) {
+ if ($cache->{$owner_id} ||= BSE::TB::SiteUsers->getByPkey($owner_id)) {
$owner = $cache->{$owner_id}->data_only;
$owner->{desc} = "User: " . $owner->{userId};
}
my $siteuser_id = $cgi->param('siteuser_id');
my $user;
if ($siteuser_id && $siteuser_id =~ /^\d+$/) {
- $user = SiteUsers->getByPkey($siteuser_id);
+ $user = BSE::TB::SiteUsers->getByPkey($siteuser_id);
if ($user) {
push @filters, [ '=', siteuser_id => $siteuser_id ];
$page_args{siteuser_id} = $siteuser_id;
package BSE::CustomBase;
use strict;
-our $VERSION = "1.004";
+our $VERSION = "1.005";
sub new {
my ($class, %params) = @_;
sub siteuser_required {
my ($self, $req) = @_;
- require SiteUsers;
+ require BSE::TB::SiteUsers;
my $cfg = $req->cfg;
my @required = qw(email);
push @required, grep $cfg->entry('site users', "require_$_", 0),
- grep !$dont_touch{$_}, SiteUser->columns;
+ grep !$dont_touch{$_}, BSE::TB::SiteUser->columns;
return @required;
}
use base qw'BSE::Handler::Base BSE::UI::Page';
use BSE::Generate::Article;
use BSE::Template;
-use SiteUsers;
+use BSE::TB::SiteUsers;
use BSE::CfgInfo;
use BSE::TB::SiteUserGroups;
use BSE::Util::DynamicTags;
use BSE::Dynamic::Catalog;
use BSE::Dynamic::Seminar;
-our $VERSION = "1.001";
+our $VERSION = "1.002";
sub handler {
my ($r) = @_;
use BSE::ComposeMail;
use BSE::DB;
use BSE::TB::OwnedFiles;
-use SiteUsers;
+use BSE::TB::SiteUsers;
use BSE::Util::Tags qw(tag_hash_plain);
use DevHelp::Tags::Iterate;
use BSE::TB::SiteUserGroups;
use Carp qw(confess);
-our $VERSION = "1.000";
+our $VERSION = "1.001";
sub new {
my ($class, %opts) = @_;
my @orig_entries = BSE::DB->query(bseFileNotifyUserEntries => $user_id);
if (@orig_entries) {
- my $user = SiteUsers->getByPkey($user_id);
+ my $user = BSE::TB::SiteUsers->getByPkey($user_id);
if ($user) {
$self->_notify_user_low($user_id, $user, \@orig_entries);
}
use BSE::Util::HTML;
use Carp qw(cluck confess);
-our $VERSION = "1.029";
+our $VERSION = "1.030";
=head1 NAME
my $cfg = $req->cfg;
my $session = $req->session;
- require SiteUsers;
+ require BSE::TB::SiteUsers;
if ($cfg->entryBool('custom', 'user_auth')) {
require BSE::CfgInfo;
my $custom = BSE::CfgInfo::custom_class($cfg);
my $userid = $session->{userid}
or return;
- my $user = SiteUsers->getByPkey($userid)
+ my $user = BSE::TB::SiteUsers->getByPkey($userid)
or return;
$user->{disabled}
and return;
use vars qw/@ISA/;
@ISA = qw/Squirrel::Row/;
-our $VERSION = "1.007";
+our $VERSION = "1.008";
sub columns {
return qw/id name title description frequency keyword archive
sub recipients {
my ($sub) = @_;
- require 'SiteUsers.pm';
- SiteUsers->getSpecial('subRecipients', $sub->{id});
+ require BSE::TB::SiteUsers;
+ BSE::TB::SiteUsers->getSpecial('subRecipients', $sub->{id});
}
sub recipient_count {
use strict;
use base qw(Squirrel::Row);
-our $VERSION = "1.009";
+our $VERSION = "1.010";
=head1 NAME
}
}
elsif ($type eq "M") {
- require SiteUsers;
- my $user = SiteUsers->getByPkey($self->actor_id);
+ require BSE::TB::SiteUsers;
+ my $user = BSE::TB::SiteUsers->getByPkey($self->actor_id);
if ($user) {
return "Member: ".$user->userId;
}
}
}
elsif ($type eq "M") {
- require SiteUsers;
- my $user = SiteUsers->getByPkey($self->actor_id);
+ require BSE::TB::SiteUsers;
+ my $user = BSE::TB::SiteUsers->getByPkey($self->actor_id);
if ($user) {
return $user->link;
}
action => "order_detail",
format => "Order %d",
},
- "SiteUser" =>
+ "BSE::TB::SiteUser" =>
{
target => "siteusers",
action => "view",
format => "Member %d",
- class => "SiteUsers",
+ class => "BSE::TB::SiteUsers",
},
"BSE::TB::AdminUser" =>
{
use Carp 'confess';
use BSE::Shop::PaymentTypes;
-our $VERSION = "1.025";
+our $VERSION = "1.026";
sub columns {
return qw/id
my ($self) = @_;
if ($self->siteuser_id) {
- require SiteUsers;
- my $user = SiteUsers->getByPkey($self->siteuser_id);
+ require BSE::TB::SiteUsers;
+ my $user = BSE::TB::SiteUsers->getByPkey($self->siteuser_id);
$user and return $user;
}
$self->{userId} or return;
- require SiteUsers;
+ require BSE::TB::SiteUsers;
- return ( SiteUsers->getBy(userId=>$self->{userId}) )[0];
+ return ( BSE::TB::SiteUsers->getBy(userId=>$self->{userId}) )[0];
}
sub items {
use strict;
use base qw(Squirrel::Row);
-our $VERSION = "1.000";
+our $VERSION = "1.001";
sub columns {
qw/id session_id siteuser_id roll_present options customer_instructions
sub siteuser {
my ($self) = @_;
- require SiteUsers;
+ require BSE::TB::SiteUsers;
- return SiteUsers->getByPkey($self->{siteuser_id});
+ return BSE::TB::SiteUsers->getByPkey($self->{siteuser_id});
}
1;
use base qw(Squirrel::Row);
use BSE::Util::SQL qw(now_sqldatetime);
-our $VERSION = "1.000";
+our $VERSION = "1.001";
sub columns {
return qw/id seminar_id location_id when_at roll_taken/;
sub booked_users {
my ($self) = @_;
- require SiteUsers;
- return SiteUsers->getSpecial(sessionBookings => $self->{id});
+ require BSE::TB::SiteUsers;
+ return BSE::TB::SiteUsers->getSpecial(sessionBookings => $self->{id});
}
# perhaps this should allow removing old sessions with no bookings
--- /dev/null
+package BSE::TB::SiteUser;
+use strict;
+# represents a registered user
+use Squirrel::Row;
+use vars qw/@ISA/;
+@ISA = qw/Squirrel::Row/;
+use Constants qw($SHOP_FROM);
+use Carp qw(confess);
+use BSE::Util::SQL qw/now_datetime now_sqldate sql_normal_date sql_add_date_days/;
+
+=head1 NAME
+
+SiteUser - represent a site user (or member)
+
+=head1 METHODS
+
+=over
+
+=cut
+
+our $VERSION = "1.016";
+
+use constant MAX_UNACKED_CONF_MSGS => 3;
+use constant MIN_UNACKED_CONF_GAP => 2 * 24 * 60 * 60;
+use constant OWNER_TYPE => "U";
+
+sub columns {
+ return qw/id idUUID userId password password_type email whenRegistered
+ lastLogon
+ title name1 name2 street street2
+ suburb state postcode country
+ telephone facsimile mobile organization
+ confirmed confirmSecret waitingForConfirmation
+ textOnlyMail previousLogon
+ delivTitle delivEmail delivFirstName delivLastName delivStreet
+ delivStreet2 delivSuburb delivState delivPostCode delivCountry
+ delivTelephone delivFacsimile delivMobile delivOrganization
+ instructions adminNotes disabled flags
+ affiliate_name lost_today lost_date lost_id
+ customText1 customText2 customText3
+ customStr1 customStr2 customStr3
+ customInt1 customInt2 customWhen1
+ lockout_end
+ /;
+}
+
+sub table {
+ return "bse_siteusers";
+}
+
+sub defaults {
+ require BSE::Util::SQL;
+ return
+ (
+ # idUUID handled by default_idUUID()
+ # userId - required
+ # password - required (and generates password and password_type)
+ # password_type - generated
+ # email - required
+ whenRegistered => BSE::Util::SQL::now_datetime(),
+ lastLogon => BSE::Util::SQL::now_datetime(),
+ title => "",
+ name1 => "",
+ name2 => "",
+ street => "",
+ street2 => "",
+ suburb => "",
+ state => "",
+ postcode => "",
+ country => "",
+ telephone => "",
+ facsimile => "",
+ mobile => "",
+ organization => "",
+ confirmed => 0,
+ confirmSecret => "",
+ waitingForConfirmation => 0,
+ textOnlyMail => 0,
+ previousLogon => BSE::Util::SQL::now_datetime(),
+ delivTitle => "",
+ delivEmail => "",
+ delivFirstName => "",
+ delivLastName => "",
+ delivStreet => "",
+ delivStreet2 => "",
+ delivSuburb => "",
+ delivState => "",
+ delivPostCode => "",
+ delivCountry => "",
+ delivTelephone => "",
+ delivFacsimile => "",
+ delivMobile => "",
+ delivOrganization => "",
+ instructions => "",
+ adminNotes => "",
+ disabled => 0,
+ flags => "",
+ affiliate_name => "",
+ lost_today => 0,
+ lost_date => undef,
+ lost_id => undef,
+ customText1 => undef,
+ customText2 => undef,
+ customText3 => undef,
+ customStr1 => undef,
+ customStr2 => undef,
+ customStr3 => undef,
+ customInt1 => "",
+ customInt2 => "",
+ customWhen1 => "",
+ lockout_end => undef,
+ );
+}
+
+sub default_idUUID {
+ require Data::UUID;
+ my $ug = Data::UUID->new;
+ return $ug->create_str;
+}
+
+sub valid_fields {
+ my ($class, $cfg, $admin) = @_;
+
+ my %fields =
+ (
+ email => { rules=>'email', description=>'Email Address',
+ maxlen => 255},
+ title => { description => 'Title', rules => 'dh_one_line', maxlen => 127 },
+ name1 => { description=>'First Name', rules=>"dh_one_line", maxlen=>127 },
+ name2 => { description=>'Last Name', rules=>"dh_one_line", maxlen=>127 },
+ street => { description => 'Address', rules=>"dh_one_line", maxlen=>127 },
+ street2 => { description => 'Address', rules=>"dh_one_line", maxlen=>127 },
+ suburb => { description=>'City/Suburb', rules=>"dh_one_line", maxlen=>127 },
+ state => { description => 'State', rules=>"dh_one_line", maxlen=>40 },
+ postcode => { rules=>'postcode', description=>'Post Code', maxlen=>40 },
+ country => { description=>'Country', rules=>"dh_one_line", maxlen=>127 },
+ telephone => { rules=>'phone', description=>'Telephone', maxlen=>80 },
+ facsimile => { rules=>'phone', description=>'Facsimile', maxlen=>80 },
+ mobile => { description => "Mobile", rules=>"phone", maxlen => 80 },
+ organization => { description=>'Organization', rules=>"dh_one_line",
+ maxlen=>127 },
+ textOnlyEmail => { description => "Text Only Email", type=>"boolean" },
+ delivTitle => { description=>"Delivery Title",
+ rules=>"dh_one_line", maxlen=>127 },
+ delivEmail => { description => "Delivery Email", rules=>"email",
+ maxlen=>255 },
+ delivFirstName => { description=>"Delivery First Name",
+ rules=>"dh_one_line", maxlen=>127 },
+ delivLastName => { descriptin=>"Delivery Last Name", rules=>"dh_one_line" },
+ delivStreet => { description => "Delivery Street Address",
+ rules=>"dh_one_line", maxlen=>127 },
+ delivStreet2 => { description => 'Delivery Street Address 2',
+ rules => "dh_one_line", maxlen=> 127 },
+ delivSuburb => { description => "Delivery Suburb", rules=>"dh_one_line",
+ maxlen=>127 },
+ delivState => { description => "Delivery State", rules=>"dh_one_line",
+ maxlen=>40 },
+ delivPostCode => { description => "Delivery Post Code", rules=>"postcode",
+ maxlen=>40 },
+ delivCountry => { description => "Delivery Country", rules=>"dh_one_line",
+ maxlen=>127 },
+ delivTelephone => { description => "Delivery Phone", rules=>"phone",
+ maxlen=>80 },
+ delivFacsimile => { description => "Delivery Facsimie", rules=>"phone",
+ maxlen=>80 },
+ delivMobile => { description => "Delivery Mobile", rules=>"phone",
+ maxlen => 80 },
+ delivOrganization => { description => "Delivery Organization",
+ rules=>"dh_one_line", maxlen => 127 },
+ instructions => { description => "Delivery Instructions" },
+ customText1 => { description => "Custom Text 1" },
+ customText2 => { description => "Custom Text 2" },
+ customText3 => { description => "Custom Text 3" },
+ customStr1 => { description => "Custom String 1", rules=>"dh_one_line",
+ maxlen=>255 },
+ customStr2 => { description => "Custom String 2", rules=>"dh_one_line",
+ maxlen=>255 },
+ customStr3 => { description => "Custom String 3", rules=>"dh_one_line",
+ maxlen=>255 },
+ );
+
+ if ($admin) {
+ $fields{adminNotes} =
+ { description => "Administrator Notes" };
+ $fields{disabled} =
+ { description => "User Disabled", type=>"boolean" };
+ }
+
+ return %fields;
+}
+
+sub valid_rules {
+ return;
+}
+
+sub removeSubscriptions {
+ my ($self) = @_;
+
+ BSE::TB::SiteUsers->doSpecial('removeSubscriptions', $self->{id});
+}
+
+sub removeSubscription {
+ my ($self, $subid) = @_;
+
+ BSE::TB::SiteUsers->doSpecial('removeSub', $self->{id}, $subid);
+}
+
+sub generic_email {
+ my ($class, $checkemail) = @_;
+
+ # Build a generic form for the email - since an attacker could
+ # include comments or extra spaces or a bunch of other stuff.
+ # this isn't strictly correct, but it's good enough
+ 1 while $checkemail =~ s/\([^)]\)//g;
+ if ($checkemail =~ /<([^>]+)>/) {
+ $checkemail = $1;
+ }
+ $checkemail = lc $checkemail;
+ $checkemail =~ s/\s+//g;
+
+ $checkemail;
+}
+
+=item subscriptions
+
+The subscriptions the user is subscribed to.
+
+=cut
+
+sub subscriptions {
+ my ($self) = @_;
+
+ require BSE::SubscriptionTypes;
+ return BSE::SubscriptionTypes->getSpecial(userSubscribedTo => $self->{id});
+}
+
+sub send_conf_request {
+ my ($user, $cgi, $cfg, $rcode, $rmsg) = @_;
+
+ if ($user->is_disabled) {
+ $$rmsg = "User is disabled";
+ return;
+ }
+
+ my $nopassword = $cfg->entryBool('site users', 'nopassword', 0);
+
+ # check for existing in-progress confirmations
+ my $checkemail = $user->generic_email($user->{email});
+
+ # check the blacklist
+ require BSE::EmailBlacklist;
+
+ # check that the from address has been configured
+ my $from = $cfg->entry('confirmations', 'from') ||
+ $cfg->entry('shop', 'from')|| $SHOP_FROM;
+ unless ($from) {
+ $$rcode = 'config';
+ $$rmsg = "Configuration Error: The confirmations from address has not been configured";
+ return;
+ }
+
+ my $blackentry = BSE::EmailBlacklist->getEntry($checkemail);
+
+ if ($blackentry) {
+ $$rcode = "blacklist";
+ $$rmsg = $blackentry->{why};
+ return;
+ }
+
+ unless ($user->{confirmSecret}) {
+ use BSE::Util::Secure qw/make_secret/;
+ # print STDERR "Generating secret\n";
+ $user->{confirmSecret} = make_secret($cfg);
+ $user->save;
+ }
+
+ # check for existing confirmations
+ require BSE::EmailRequests;
+ my $confirm = BSE::EmailRequests->getBy(genEmail=>$checkemail);
+ if ($confirm) {
+ if ($confirm->{unackedConfMsgs} >= MAX_UNACKED_CONF_MSGS) {
+ $$rcode = 'toomany';
+ $$rmsg = "Too many confirmations have been sent to this email address";
+ return;
+ }
+ use BSE::Util::SQL qw/sql_datetime_to_epoch/;
+ my $lastSentEpoch = sql_datetime_to_epoch($confirm->{lastConfSent});
+ if ($lastSentEpoch + MIN_UNACKED_CONF_GAP > time) {
+ $$rcode = 'toosoon';
+ $$rmsg = "The last confirmation was sent too recently, please wait before trying again";
+ return;
+ }
+ }
+ else {
+ my %confirm;
+ my @cols = BSE::EmailRequest->columns;
+ shift @cols;
+ $confirm{email} = $user->{email};
+ $confirm{genEmail} = $checkemail;
+ # prevents silliness on error
+ use BSE::Util::SQL qw(sql_datetime);
+ $confirm{lastConfSent} = sql_datetime(time - MIN_UNACKED_CONF_GAP);
+ $confirm{unackedConfMsgs} = 0;
+ $confirm = BSE::EmailRequests->add(@confirm{@cols});
+ }
+
+ # ok, now we can send the confirmation request
+ my %confacts;
+ %confacts =
+ (
+ BSE::Util::Tags->basic(\%confacts, $cgi, $cfg),
+ user => sub { $user->{$_[0]} },
+ confirm => sub { $confirm->{$_[0]} },
+ remote_addr => sub { $ENV{REMOTE_ADDR} },
+ );
+ my $email_template =
+ $nopassword ? 'user/email_confirm_nop' : 'user/email_confirm';
+
+ require BSE::ComposeMail;
+ my $mail = BSE::ComposeMail->new(cfg => $cfg);
+
+ my $subject = $cfg->entry('confirmations', 'subject')
+ || 'Subscription Confirmation';
+ unless ($mail->send(template => $email_template,
+ acts => \%confacts,
+ from=>$from,
+ to=>$user,
+ subject=>$subject)) {
+ # a problem sending the mail
+ $$rcode = "mail";
+ $$rmsg = $mail->errstr;
+ return;
+ }
+ ++$confirm->{unackedConfMsgs};
+ $confirm->{lastConfSent} = now_datetime;
+ $confirm->save;
+
+ return 1;
+}
+
+=item orders
+
+The shop orders made by the user.
+
+=cut
+
+sub orders {
+ my ($self) = @_;
+
+ require BSE::TB::Orders;
+
+ return BSE::TB::Orders->getBy(userId => $self->{userId});
+}
+
+sub _user_sub_entry {
+ my ($self, $sub) = @_;
+
+ my ($entry) = BSE::DB->query(userSubscribedEntry => $self->{id},
+ $sub->{subscription_id})
+ or return;
+
+ return $entry;
+}
+
+=item subscribed_to
+
+return true if the user is subcribed to the given subscription.
+
+=cut
+
+# check if the user is subscribed to the given subscription
+sub subscribed_to {
+ my ($self, $sub) = @_;
+
+ my $entry = $self->_user_sub_entry($sub)
+ or return;
+
+ my $today = now_sqldate;
+ my $end_date = sql_normal_date($entry->{ends_at});
+ return $today le $end_date;
+}
+
+# check if the user is subscribed to the given subscription, and allow
+# for the max_lapsed grace period
+sub subscribed_to_grace {
+ my ($self, $sub) = @_;
+
+ my $entry = $self->_user_sub_entry($sub)
+ or return;
+
+ my $today = now_sqldate;
+ my $end_date = sql_add_date_days($entry->{ends_at}, $entry->{max_lapsed});
+ return $today le $end_date;
+}
+
+my @image_cols =
+ qw(siteuser_id image_id filename width height bytes content_type alt);
+
+sub images_cfg {
+ my ($self, $cfg) = @_;
+
+ my @images;
+ my %ids = $cfg->entries('BSE Siteuser Images');
+ for my $id (keys %ids) {
+ my %image = ( id => $id );
+
+ my $sect = "BSE Siteuser Image $id";
+ for my $key (qw(description help minwidth minheight maxwidth maxheight
+ minratio maxratio properror
+ widthsmallerror heightsmallerror smallerror
+ widthlargeerror heightlargeerror largeerror
+ maxspace spaceerror)) {
+ my $value = $cfg->entry($sect, $key);
+ if (defined $value) {
+ $image{$key} = $value;
+ }
+ }
+ push @images, \%image;
+ }
+
+ @images;
+}
+
+=item images
+
+Return images associated with the user.
+
+=cut
+
+sub images {
+ my ($self) = @_;
+
+ BSE::DB->query(getBSESiteuserImages => $self->{id});
+}
+
+sub get_image {
+ my ($self, $id) = @_;
+
+ my ($image) = BSE::DB->query(getBSESiteuserImage => $self->{id}, $id)
+ or return;
+
+ $image;
+}
+
+sub set_image {
+ my ($self, $cfg, $id, $image) = @_;
+
+ my %image = %$image;
+ $image{siteuser_id} = $self->{id};
+ my $old = $self->get_image($id);
+
+ if ($old) {
+ # replace it
+ BSE::DB->run(replaceBSESiteuserImage => @image{@image_cols});
+
+ # lose the old file
+ my $image_dir = $cfg->entryVar('paths', 'siteuser_images');
+ unlink "$image_dir/$old->{filename}";
+ }
+ else {
+ # add it
+ # replace it
+ BSE::DB->run(addBSESiteuserImage => @image{@image_cols});
+ }
+}
+
+sub remove_image {
+ my ($self, $cfg, $id) = @_;
+
+ if (my $old = $self->get_image($id)) {
+ # remove the entry
+ BSE::DB->run(deleteBSESiteuserImage => $self->{id}, $id);
+
+ # lose the old file
+ my $image_dir = $cfg->entryVar('paths', 'siteuser_images');
+ unlink "$image_dir/$old->{filename}";
+ }
+}
+
+sub recalculate_subscriptions {
+ my ($self, $cfg) = @_;
+
+ require BSE::TB::Subscriptions;
+ my @subs = BSE::TB::Subscriptions->all;
+ for my $sub (@subs) {
+ $sub->update_user_expiry($self, $cfg);
+ }
+}
+
+sub subscribed_services {
+ my ($self) = @_;
+
+ BSE::DB->query(siteuserSubscriptions => $self->{id});
+}
+
+=item is_disabled
+
+Return true if the user is disabled.
+
+=cut
+
+sub is_disabled {
+ my ($self) = @_;
+
+ return $self->{disabled};
+}
+
+sub seminar_sessions_booked {
+ my ($self, $seminar_id) = @_;
+
+ return map $_->{session_id},
+ BSE::DB->query(userSeminarSessionBookings => $seminar_id, $self->{id});
+}
+
+sub is_member_of {
+ my ($self, $group) = @_;
+
+ my $group_id = ref $group ? $group->{id} : $group;
+
+ my @result = BSE::DB->query(siteuserMemberOfGroup => $self->{id}, $group_id);
+
+ return scalar(@result);
+}
+
+sub group_ids {
+ my ($self) = @_;
+
+ map $_->{id}, BSE::DB->query(siteuserGroupsForUser => $self->{id});
+}
+
+sub allow_html_email {
+ my ($self) = @_;
+
+ !$self->{textOnlyMail};
+}
+
+sub seminar_bookings_detail {
+ my ($self) = @_;
+
+ BSE::DB->query(bse_siteuserSeminarBookingsDetail => $self->{id});
+}
+
+=item wishlist
+
+return the user's wishlist products.
+
+=cut
+
+sub wishlist {
+ my $self = shift;
+ require BSE::TB::Products;
+ return BSE::TB::Products->getSpecial(userWishlist => $self->{id});
+}
+
+sub wishlist_order {
+ my $self = shift;
+ return BSE::DB->query(bse_userWishlistOrder => $self->{id});
+}
+
+sub product_in_wishlist {
+ my ($self, $product) = @_;
+
+ grep $_->{product_id} == $product->{id}, $self->wishlist_order;
+}
+
+sub add_to_wishlist {
+ my ($self, $product) = @_;
+
+ return
+ eval {
+ BSE::DB->run(bse_addToWishlist => $self->{id}, $product->{id}, time());
+ 1;
+ };
+}
+
+sub remove_from_wishlist {
+ my ($self, $product) = @_;
+
+ BSE::DB->run(bse_removeFromWishlist => $self->{id}, $product->{id});
+}
+
+sub _set_wishlist_order {
+ my ($self, $product_id, $display_order) = @_;
+
+ print STDERR "_set_wishlist_order($product_id, $display_order)\n";
+
+ BSE::DB->run(bse_userWishlistReorder => $display_order, $self->{id}, $product_id);
+}
+
+sub _find_in_wishlist {
+ my ($self, $product_id) = @_;
+
+ my @order = $self->wishlist_order;
+
+ my ($index) = grep $order[$_]{product_id} == $product_id, 0 .. $#order
+ or return;
+
+ return \@order, $index;
+}
+
+sub move_to_wishlist_top {
+ my ($self, $product) = @_;
+
+ my ($order, $move_index) = $self->_find_in_wishlist($product->{id})
+ or return;
+ $move_index > 0
+ or return; # nothing to do
+
+ my $top_order = $order->[0]{display_order};
+ for my $index (0 .. $move_index-1) {
+ $self->_set_wishlist_order($order->[$index]{product_id}, $order->[$index+1]{display_order});
+ }
+ $self->_set_wishlist_order($product->{id}, $top_order);
+}
+
+sub move_to_wishlist_bottom {
+ my ($self, $product) = @_;
+
+ my ($order, $move_index) = $self->_find_in_wishlist($product->{id})
+ or return;
+ $move_index < $#$order
+ or return; # nothing to do
+
+ my $bottom_order = $order->[-1]{display_order};
+ for my $index (reverse($move_index+1 .. $#$order)) {
+ $self->_set_wishlist_order($order->[$index]{product_id}, $order->[$index-1]{display_order});
+ }
+ $self->_set_wishlist_order($product->{id}, $bottom_order);
+}
+
+sub move_down_wishlist {
+ my ($self, $product) = @_;
+
+ my ($order, $index) = $self->_find_in_wishlist($product->{id})
+ or return;
+ $index < $#$order
+ or return; # nothing to do
+
+ $self->_set_wishlist_order($product->{id}, $order->[$index+1]{display_order});
+ $self->_set_wishlist_order($order->[$index+1]{product_id}, $order->[$index]{display_order});
+}
+
+sub move_up_wishlist {
+ my ($self, $product) = @_;
+
+ my ($order, $index) = $self->_find_in_wishlist($product->{id})
+ or return;
+ $index > 0
+ or return; # nothing to do
+
+ $self->_set_wishlist_order($product->{id}, $order->[$index-1]{display_order});
+ $self->_set_wishlist_order($order->[$index-1]{product_id}, $order->[$index]{display_order});
+}
+
+# files owned specifically by this user
+sub files {
+ my ($self) = @_;
+
+ require BSE::TB::OwnedFiles;
+ return BSE::TB::OwnedFiles->getBy(owner_type => OWNER_TYPE,
+ owner_id => $self->id);
+}
+
+sub admin_group_files {
+ my ($self) = @_;
+
+ require BSE::TB::OwnedFiles;
+ return BSE::TB::OwnedFiles->getSpecial(userVisibleGroupFiles => $self->{id});
+}
+
+sub query_group_files {
+ my ($self, $cfg) = @_;
+
+ require BSE::TB::SiteUserGroups;
+ return
+ (
+ map $_->files, BSE::TB::SiteUserGroups->query_groups($cfg)
+ );
+}
+
+=item visible_files
+
+files the user can see, both owned and owned by groups
+
+=cut
+
+sub visible_files {
+ my ($self, $cfg) = @_;
+
+ return
+ (
+ $self->files,
+ $self->admin_group_files,
+ $self->query_group_files($cfg)
+ );
+}
+
+sub file_owner_type {
+ return OWNER_TYPE;
+}
+
+sub subscribed_file_categories {
+ my ($self) = @_;
+
+ return map $_->{category}, BSE::DB->query(siteuserSubscribedFileCategories => $self->{id});
+}
+
+sub set_subscribed_file_categories {
+ my ($self, $cfg, @new) = @_;
+
+ require BSE::TB::OwnedFiles;
+ my %current = map { $_ => 1 } $self->subscribed_file_categories;
+ my %new = map { $_ => 1 } @new;
+ my @all = BSE::TB::OwnedFiles->categories($cfg);
+ for my $cat (@all) {
+ if ($new{$cat->{id}} && !$current{$cat->{id}}) {
+ eval {
+ BSE::DB->run(siteuserAddFileCategory => $self->{id}, $cat->{id});
+ }; # a race condition might cause a duplicate key error here
+ }
+ elsif (!$new{$cat->{id}} && $current{$cat->{id}}) {
+ BSE::DB->run(siteuserRemoveFileCategory => $self->{id}, $cat->{id});
+ }
+ }
+}
+
+=item describe
+
+Returns a description of the user
+
+=cut
+
+sub describe {
+ my ($self) = @_;
+
+ return "Member: " . $self->userId;
+}
+
+=item paid_files
+
+Files that require payment that the user has paid for.
+
+=cut
+
+sub paid_files {
+ my ($self) = @_;
+
+ require BSE::TB::ArticleFiles;
+ return BSE::TB::ArticleFiles->getSpecial(userPaidFor => $self->id);
+}
+
+sub remove {
+ my ($self, $cfg) = @_;
+
+ $cfg or confess "Missing parameter cfg";
+
+ # remove any owned files
+ for my $file ($self->files) {
+ $file->remove($cfg);
+ }
+
+ # file subscriptions
+ BSE::DB->run(bseRemoveUserFileSubs => $self->id);
+
+ # file notifies
+ BSE::DB->run(bseRemoveUserFileNotifies => $self->id);
+
+ # download log
+ BSE::DB->run(bseMarkUserFileAccessesAnon => $self->id);
+
+ # mark any orders owned by the user as anonymous
+ BSE::DB->run(bseMarkOwnedOrdersAnon => $self->id);
+
+ # newsletter subscriptions
+ BSE::DB->run(bseRemoveUserSubs => $self->id);
+
+ # wishlist
+ BSE::DB->run(bseRemoveUserWishlist => $self->id);
+
+ # group memberships
+ BSE::DB->run(bseRemoveUserMemberships => $self->id);
+
+ # seminar bookings
+ BSE::DB->run(bseRemoveUserBookings => $self->id);
+
+ # paid subscriptions
+ BSE::DB->run(bseRemoveUserProdSubs => $self->id);
+
+ # images
+ for my $im ($self->images) {
+ $self->remove_image($cfg, $im->{image_id});
+ }
+
+ $self->SUPER::remove();
+}
+
+sub link {
+ my ($self) = @_;
+
+ return BSE::Cfg->single->admin_url(siteusers => { a_edit => 1, id => $self->id });
+}
+
+=item send_registration_notify(remote_addr => $ip_address)
+
+Send an email to the customer with registration information.
+
+Template: user/email_register
+
+Basic static tags and:
+
+=over
+
+=item *
+
+host - IP address of the machine that registered the user.
+
+=item *
+
+user - the user registered.
+
+=back
+
+=cut
+
+sub send_registration_notify {
+ my ($self, %opts) = @_;
+
+ defined $opts{remote_addr}
+ or confess "Missing remote_addr parameter";
+
+ require BSE::ComposeMail;
+ require BSE::Util::Tags;
+ BSE::ComposeMail->send_simple
+ (
+ id => 'notify_register_customer',
+ template => 'user/email_register',
+ subject => 'Thank you for registering',
+ to => $self,
+ extraacts =>
+ {
+ host => $opts{remote_addr},
+ user => [ \&BSE::Util::Tags::tag_hash_plain, $self ],
+ },
+ log_msg => "Send registration email to Site User (" . $self->email .")",
+ log_component => "member:register:notifyuser",
+ );
+}
+
+sub changepw {
+ my ($self, $password, $who, %log) = @_;
+
+ require BSE::Passwords;
+
+ my ($hash, $type) = BSE::Passwords->new_password_hash($password);
+
+ $self->set_password($hash);
+ $self->set_password_type($type);
+
+ require BSE::TB::AuditLog;
+ BSE::TB::AuditLog->log
+ (
+ component => "siteusers::changepw",
+ object => $self,
+ actor => $who,
+ level => "notice",
+ msg => "Site User '" . $self->userId . "' changed their password",
+ %log,
+ );
+
+ 1;
+}
+
+sub check_password {
+ my ($self, $password, $error) = @_;
+
+ require BSE::Passwords;
+ return BSE::Passwords->check_password_hash($self->password, $self->password_type, $password, $error);
+}
+
+=item lost_password
+
+Call to send a lost password email.
+
+=cut
+
+sub lost_password {
+ my ($self, $error) = @_;
+
+ my $cfg = BSE::Cfg->single;
+ require BSE::CfgInfo;
+ my $custom = BSE::CfgInfo::custom_class($cfg);
+ my $email_user = $self;
+ my $to = $self;
+ if ($custom->can('send_user_email_to')) {
+ eval {
+ $email_user = $custom->send_user_email_to($self, $cfg);
+ };
+ $to = $email_user->{email};
+ }
+ else {
+ require BSE::Util::SQL;
+ my $lost_limit = $cfg->entry("lost password", "daily_limit", 3);
+ my $today = BSE::Util::SQL::now_sqldate();
+ my $lost_today = 0;
+ if ($self->lost_date
+ && $self->lost_date eq $today) {
+ $lost_today = $self->lost_today;
+ }
+ if ($lost_today+1 > $lost_limit) {
+ $$error = "Too many password recovery attempts today, please try again tomorrow";
+ return;
+ }
+ $self->set_lost_date($today);
+ $self->set_lost_today($lost_today+1);
+ $self->set_lost_id(BSE::Util::Secure::make_secret($cfg));
+ }
+
+ require BSE::ComposeMail;
+ my $mail = BSE::ComposeMail->new(cfg => $cfg);
+
+ require BSE::Util::Tags;
+ my %mailacts;
+ %mailacts =
+ (
+ BSE::Util::Tags->mail_tags(),
+ user => [ \&BSE::Util::Tags::tag_object_plain, $self ],
+ host => $ENV{REMOTE_ADDR},
+ site => $cfg->entryErr('site', 'url'),
+ emailuser => [ \&BSE::Util::Tags::tag_hash_plain, $email_user ],
+ );
+ my $from = $cfg->entry('confirmations', 'from') ||
+ $cfg->entry('shop', 'from') || $SHOP_FROM;
+ my $nopassword = $cfg->entryBool('site users', 'nopassword', 0);
+ my $subject = $cfg->entry('basic', 'lostpasswordsubject')
+ || ($nopassword ? "Your options" : "Your password");
+ unless ($mail->send
+ (
+ template => 'user/lostpwdemail',
+ acts => \%mailacts,
+ from=>$from,
+ to => $to,
+ subject=>$subject,
+ log_msg => "Send password recovery email to Site User (" . $self->email . ")",
+ log_component => "siteusers:lost:send",
+ log_object => $self,
+ )) {
+ $$error = $mail->errstr;
+ return;
+ }
+ $self->save;
+
+ return $email_user;
+}
+
+sub check_password_rules {
+ my ($class, %opts) = @_;
+
+ require BSE::Util::PasswordValidate;
+
+ my %rules = BSE::Cfg->single->entries("siteuser passwords");
+
+ return BSE::Util::PasswordValidate->validate
+ (
+ %opts,
+ rules => \%rules,
+ );
+}
+
+sub password_check_fields {
+ return qw(name1 name2);
+}
+
+=item locked_out
+
+Return true if logons are disabled due to too many authentication
+failures.
+
+=cut
+
+sub locked_out {
+ my ($self) = @_;
+
+ return $self->lockout_end && $self->lockout_end gt now_datetime();
+}
+
+sub check_lockouts {
+ my ($class, %opts) = @_;
+
+ require BSE::Util::Lockouts;
+ BSE::Util::Lockouts->check_lockouts
+ (
+ %opts,
+ section => "site user lockouts",
+ component => "siteuser",
+ module => "logon",
+ type => $class->lockout_type,
+ );
+}
+
+sub unlock {
+ my ($self, %opts) = @_;
+
+ require BSE::Util::Lockouts;
+ BSE::Util::Lockouts->unlock_user
+ (
+ %opts,
+ user => $self,
+ component => "siteuser",
+ module => "logon",
+ );
+}
+
+sub unlock_ip_address {
+ my ($class, %opts) = @_;
+
+ require BSE::Util::Lockouts;
+ BSE::Util::Lockouts->unlock_ip_address
+ (
+ %opts,
+ component => "siteuser",
+ module => "logon",
+ type => $class->lockout_type,
+ );
+}
+
+sub lockout_type {
+ "S";
+}
+
+
+# for duck-type compatibility with BSE::TB::AdminUser
+sub logon {
+ my ($self) = @_;
+
+ return $self->userId;
+}
+
+=back
+
+=cut
+
+1;
use base 'Squirrel::Table';
use BSE::TB::SiteUserGroup;
-our $VERSION = "1.001";
+our $VERSION = "1.002";
use constant SECT_QUERY_GROUPS => "Query Groups";
use constant SECT_QUERY_GROUP_PREFIX => 'Query group ';
return @$values;
}
else {
- return grep $self->contains_user($_), SiteUsers->all_ids;
+ return grep $self->contains_user($_), BSE::TB::SiteUsers->all_ids;
}
}
--- /dev/null
+package BSE::TB::SiteUsers;
+use strict;
+use Squirrel::Table;
+use vars qw(@ISA $VERSION);
+@ISA = qw(Squirrel::Table);
+use BSE::TB::SiteUser;
+
+our $VERSION = "1.005";
+
+sub rowClass {
+ return 'BSE::TB::SiteUser';
+}
+
+sub all_subscribers {
+ my ($class) = @_;
+
+ $class->getSpecial('allSubscribers');
+}
+
+sub all_ids {
+ my ($class) = @_;
+
+ map $_->{id}, BSE::DB->query('siteuserAllIds');
+}
+
+sub make {
+ my ($self, %opts) = @_;
+
+ require BSE::Passwords;
+ my $password = delete $opts{password};
+ my ($hash, $type) = BSE::Passwords->new_password_hash($password);
+
+ $opts{password} = $hash;
+ $opts{password_type} = $type;
+
+ return $self->SUPER::make(%opts);
+}
+
+sub _lost_user {
+ my ($self, $id, $error) = @_;
+
+ my ($user) = BSE::TB::SiteUsers->getBy(lost_id => $id);
+ unless ($user) {
+ $$error = "unknownid";
+ return;
+ }
+
+ require BSE::Util::SQL;
+ my $lost_limit_days = BSE::Cfg->single->entry("lost password", "age_limit", 7);
+ my $check_date = BSE::Util::SQL::sql_add_date_days($user->lost_date, $lost_limit_days);
+
+ my $today = BSE::Util::SQL::now_sqldate();
+
+ if ($check_date lt $today) {
+ $$error = "expired";
+ return;
+ }
+
+ return $user;
+}
+
+sub lost_password_next {
+ my ($self, $id, $error) = @_;
+
+ my $user = $self->_lost_user($id, $error)
+ or return;
+
+ return $user;
+}
+
+sub lost_password_save {
+ my ($self, $id, $password, $error) = @_;
+
+ my $user = $self->_lost_user($id, $error)
+ or return;
+
+ $user->changepw($password, $user,
+ component => "siteusers:lost:changepw",
+ msg => "Site User '" . $user->userId . "' password changed");
+ $user->set_lost_id("");
+ $user->set_lockout_end(undef);
+ BSE::TB::AuditLog->log
+ (
+ object => $user,
+ component => "siteuser:logon:recover",
+ actor => "S",
+ level => "notice",
+ msg => "Site User '" . $user->userId . "' account recovered",
+ );
+ $user->save;
+
+ return 1;
+}
+
+1;
@ISA = qw(Squirrel::Table);
use BSE::TB::Subscription;
-our $VERSION = "1.000";
+our $VERSION = "1.001";
sub rowClass {
return 'BSE::TB::Subscription';
sub calculate_all_expiries {
my ($class, $cfg) = @_;
- require SiteUsers;
+ require BSE::TB::SiteUsers;
# get a list of all siteusers that have made an order with a subscription
- my @users = SiteUsers->all_subscribers;
+ my @users = BSE::TB::SiteUsers->all_subscribers;
my @subs = $class->all;
use Net::IP;
use BSE::Util::SQL qw(now_datetime);
-our $VERSION = "1.000";
+our $VERSION = "1.001";
my %actions =
(
if ($entry) {
if ($type eq "S") {
- require SiteUsers;
- SiteUser->unlock_ip_address
+ require BSE::TB::SiteUsers;
+ BSE::TB::SiteUser->unlock_ip_address
(
ip_address => $ip,
request => $req,
use BSE::Util::Iterate;
use base 'BSE::UI::AdminDispatch';
-our $VERSION = "1.005";
+our $VERSION = "1.006";
=head1 NAME
sub _dummy_user {
my %user;
- require SiteUsers;
- my @cols = SiteUser->columns;
+ require BSE::TB::SiteUsers;
+ my @cols = BSE::TB::SiteUser->columns;
@user{@cols} = ('') x @cols;
$user{id} = 0;
$user{userId} = "username";
my $testname = $q->param('testname');
my $testtextonly = $q->param('testtextonly');
- require SiteUsers;
+ require BSE::TB::SiteUsers;
my %recipient =
(
- (map { $_ => '' } SiteUser->columns),
+ (map { $_ => '' } BSE::TB::SiteUser->columns),
id => 999,
userId => 'username',
password => 'p455w0rd',
use BSE::CfgInfo 'product_options';
use DevHelp::Date qw(dh_strftime_sql_datetime);
-our $VERSION = "1.001";
+our $VERSION = "1.002";
my %rights =
(
defined $siteuser_id && $siteuser_id =~ /^\d+$/
or return $class->req_loclist($req, { siteuser_id =>
"Missing or invalid siteuser_id" });
- require SiteUsers;
- my $siteuser = SiteUsers->getByPkey($siteuser_id)
+ require BSE::TB::SiteUsers;
+ my $siteuser = BSE::TB::SiteUsers->getByPkey($siteuser_id)
or return $class->req_loclist($req, { siteuser_id => "Unknown siteuser_id" });
my $msg = $req->message($errors);
require BSE::TB::Seminars;
defined $siteuser_id && $siteuser_id =~ /^\d+$/
or return $class->req_loclist($req, { siteuser_id =>
"Missing or invalid siteuser_id" });
- require SiteUsers;
- my $siteuser = SiteUsers->getByPkey($siteuser_id)
+ require BSE::TB::SiteUsers;
+ my $siteuser = BSE::TB::SiteUsers->getByPkey($siteuser_id)
or return $class->req_loclist($req, { siteuser_id => "Unknown siteuser_id" });
# make sure we got a valid seminar
defined $siteuser_id && $siteuser_id =~ /^\d+$/
or return $class->req_loclist($req, { siteuser_id =>
"Missing or invalid siteuser_id" });
- require SiteUsers;
- my $siteuser = SiteUsers->getByPkey($siteuser_id)
+ require BSE::TB::SiteUsers;
+ my $siteuser = BSE::TB::SiteUsers->getByPkey($siteuser_id)
or return $class->req_loclist($req, { siteuser_id => "Unknown siteuser_id" });
# make sure we got a valid seminar
package BSE::UI::AdminSendEmail;
use strict;
use base 'BSE::UI::AdminDispatch';
-use SiteUsers;
+use BSE::TB::SiteUsers;
use BSE::Util::Tags qw(tag_hash_plain);
-our $VERSION = "1.001";
+our $VERSION = "1.002";
my %actions =
(
$req->user_can($secid, -1, \$msg)
or return $self->error($req, "You do not have access to send email $id");
- my $user = SiteUsers->getByPkey($user_id)
+ my $user = BSE::TB::SiteUsers->getByPkey($user_id)
or return $self->error($req, "Unknown user $user_id");
my %acts =
use BSE::Util::Tags qw(tag_hash);
use BSE::Util::HTML;
-our $VERSION = "1.000";
+our $VERSION = "1.001";
my %actions =
(
my $cgi = $req->cgi;
my $cfg = $req->cfg;
- require SiteUsers;
+ require BSE::TB::SiteUsers;
my $user;
my $id = $cgi->param('id');
my $lo = $cgi->param('lo');
my $co = $cgi->param('co');
if (defined $id && length $id && $id =~ /^\d+$/) {
- $user = SiteUsers->getByPkey($id);
+ $user = BSE::TB::SiteUsers->getByPkey($id);
}
elsif (defined $lo && length $lo && $lo =~ /^\w+$/) {
- $user = SiteUsers->getBy(userId => $lo);
+ $user = BSE::TB::SiteUsers->getBy(userId => $lo);
}
elsif (defined $co && length $co && $co =~ /^\w+$/) {
- $user = SiteUsers->getBy(affiliate_name => $co);
+ $user = BSE::TB::SiteUsers->getBy(affiliate_name => $co);
}
else {
return $class->req_none($req, "No identifier supplied");
use strict;
use base qw(BSE::UI::AdminDispatch);
use BSE::Template;
-use SiteUsers;
+use BSE::TB::SiteUsers;
use BSE::Util::Iterate;
use BSE::Util::Tags qw(tag_error_img);
use BSE::Util::HTML;
use BSE::SubscribedUsers;
use BSE::CfgInfo qw(custom_class);
-our $VERSION = "1.001";
+our $VERSION = "1.002";
my %rights =
(
$$error = "Fields list must contain id or userId\n";
return;
}
- my %valid_fields = map { $_ => 1 } SiteUser->columns;
+ my %valid_fields = map { $_ => 1 } BSE::TB::SiteUser->columns;
unless (@fields == grep($valid_fields{$_} || $_ eq "x", @fields)) {
$$error = "Unknown fields in field list for $name\n";
return;
for my $row (grep !$_->{errors}, @data) {
my $user;
if ($spec->{key} eq 'id') {
- $user = SiteUsers->getByPkey($row->{id});
+ $user = BSE::TB::SiteUsers->getByPkey($row->{id});
}
else {
- $user = SiteUsers->getBy(userId => $row->{userId});
+ $user = BSE::TB::SiteUsers->getBy(userId => $row->{userId});
}
unless ($user) {
$row->{errors}{$spec->{key}} = "Could not load user";
my $user;
unless ($errors{$key}) {
if ($key eq 'id') {
- $user = SiteUsers->getByPkey($data{$key});
+ $user = BSE::TB::SiteUsers->getByPkey($data{$key});
}
else {
- $user = SiteUsers->getBy(userId => $data{$key});
+ $user = BSE::TB::SiteUsers->getBy(userId => $data{$key});
}
unless ($user) {
$errors{$key} = "Could not find record for user $key=$data{$key}";
}
}
if ($user && !$errors{email} && $data{email}) {
- my $checkemail = SiteUser->generic_email($data{email});
+ my $checkemail = BSE::TB::SiteUser->generic_email($data{email});
require BSE::EmailBlacklist;
my $blackentry = BSE::EmailBlacklist->getEntry($checkemail);
$blackentry and
package BSE::Upgrade::Passwords;
use strict;
-use SiteUsers;
+use BSE::TB::SiteUsers;
use BSE::TB::AdminUsers;
-our $VERSION = "1.000";
+our $VERSION = "1.001";
sub upgrade {
my ($class, %opts) = @_;
sub _upgrade_siteusers {
my ($class, %opts) = @_;
- my @users = SiteUsers->getBy
+ my @users = BSE::TB::SiteUsers->getBy
(
password_type => "plain",
);
package BSE::UserReg;
use strict;
use base qw(BSE::UI::SiteuserCommon BSE::UI::Dispatch);
-use SiteUsers;
+use BSE::TB::SiteUsers;
use BSE::Util::Tags qw(tag_error_img tag_hash tag_hash_plain tag_article);
use BSE::Template;
use Constants qw($SHOP_FROM);
use base 'BSE::UI::UserCommon';
use Carp qw(confess);
-our $VERSION = "1.033";
+our $VERSION = "1.034";
use constant MAX_UNACKED_CONF_MSGS => 3;
use constant MIN_UNACKED_CONF_GAP => 2 * 24 * 60 * 60;
my $userid = $cgi->param("userid");
my $password = $cgi->param("password");
unless (keys %errors) {
- $user = SiteUsers->getBy(userId => $userid);
+ $user = BSE::TB::SiteUsers->getBy(userId => $userid);
if ($req->ip_locked_out("S")) {
$errors{_} = "msg:bse/user/iplockout:".$req->ip_address;
}
level => "warning",
msg => "Site User logon attempt failed",
);
- SiteUser->check_lockouts
+ BSE::TB::SiteUser->check_lockouts
(
request => $req,
user => $user,
my $userid = $newsession{userid};
my $user;
if ($userid) {
- $user = SiteUsers->getByPkey($userid);
+ $user = BSE::TB::SiteUsers->getByPkey($userid);
}
$self->_send_user_cookie($user);
}
my %user;
- my @cols = SiteUser->columns;
+ my @cols = BSE::TB::SiteUser->columns;
shift @cols;
my %errors;
- my %fields = SiteUser->valid_fields($cfg);
- my %rules = SiteUser->valid_rules($cfg);
+ my %fields = BSE::TB::SiteUser->valid_fields($cfg);
+ my %rules = BSE::TB::SiteUser->valid_rules($cfg);
$req->validate(errors => \%errors,
fields => \%fields,
rules => \%rules,
elsif ($email ne $confemail) {
$errors{confirmemail} = $msgs->(regbadconfemail => "Confirmation email must match the email address");
}
- my $user = SiteUsers->getBy(userId=>$email);
+ my $user = BSE::TB::SiteUsers->getBy(userId=>$email);
if ($user) {
$errors{email} = $msgs->(regemailexists=>
"Sorry, email $email already exists as a user",
$errors{userid} = $msgs->(reguser=>"Please enter your username");
}
my %others = map { $_ => scalar($cgi->param($_)) }
- SiteUser->password_check_fields;
+ BSE::TB::SiteUser->password_check_fields;
my $pass = $cgi->param('password');
my $pass2 = $cgi->param('confirm_password');
if (!defined $pass || length $pass == 0) {
$errors{password} = $msgs->(regpass=>"Please enter your password");
}
- elsif (!SiteUser->check_password_rules
+ elsif (!BSE::TB::SiteUser->check_password_rules
(
password => $pass,
username => $userid,
$errors{confirm_password} =
$msgs->(regconfmismatch=>"The confirmation password is different from the password");
}
- my $user = SiteUsers->getBy(userId=>$userid);
+ my $user = BSE::TB::SiteUsers->getBy(userId=>$userid);
if ($user) {
# give the user a suggestion
my $workuser = $userid;
$workuser =~ s/\d+$//;
my $suffix = 1;
for my $suffix (1..100) {
- unless (SiteUsers->getBy(userId=>"$workuser$suffix")) {
+ unless (BSE::TB::SiteUsers->getBy(userId=>"$workuser$suffix")) {
$cgi->param(userid=>"$workuser$suffix");
last;
}
my $user;
eval {
- $user = SiteUsers->make(%user);
+ $user = BSE::TB::SiteUsers->make(%user);
};
if ($user) {
my $custom = custom_class($cfg);
defined $uid && $uid =~ /^\d+$/ && defined $password
or do { refresh_to($ENV{SCRIPT}."?nopassword=1"); return };
- my $user = SiteUsers->getByPkey($uid)
+ my $user = BSE::TB::SiteUsers->getByPkey($uid)
or do { refresh_to($ENV{SCRIPT}."?nopassword=1"); return };
$user->{password} eq $password
my $session = $req->session;
if ($session->{partial_logon}
&& !$req->cfg->entryBool('custom', 'user_auth')) {
- my $user = SiteUsers->getByPkey($session->{partial_logon})
+ my $user = BSE::TB::SiteUsers->getByPkey($session->{partial_logon})
or return;
$user->{disabled}
and return;
my $conf_email = $cgi->param('confirmemail');
if ($conf_email) {
if ($conf_email eq $email) {
- my $other = SiteUsers->getBy(userId=>$email);
+ my $other = BSE::TB::SiteUsers->getBy(userId=>$email);
if ($other) {
$errors->{email} =
$msgs->(optsdupemail =>
else {
my @errors;
my %others;
- %others = map { $_ => $user->$_() } SiteUser->password_check_fields;
- if (!SiteUser->check_password_rules
+ %others = map { $_ => $user->$_() } BSE::TB::SiteUser->password_check_fields;
+ if (!BSE::TB::SiteUser->check_password_rules
(
password => $newpass,
errors => \@errors,
}
- my @cols = grep !$donttouch{$_}, SiteUser->columns;
+ my @cols = grep !$donttouch{$_}, BSE::TB::SiteUser->columns;
for my $col (@cols) {
my $value = $cgi->param($col);
if ($cfg->entryBool('site users', "require_$col")) {
my $userid = $session->{userid};
my $user;
if ($userid) {
- $user = SiteUsers->getByPkey($userid);
+ $user = BSE::TB::SiteUsers->getByPkey($userid);
}
$fileid ||= $cgi->param('file')
or return $self->req_show_logon($req,
my $user;
unless (keys %errors) {
- $user = SiteUsers->getBy(userId=>$userid)
+ $user = BSE::TB::SiteUsers->getBy(userId=>$userid)
or $errors{userid} = $msgs->(lostnosuch=> "Unknown username supplied", $userid);
}
keys %errors
return $self->req_show_logon($req,
$msgs->(confbaduser=>"Invalid or unknown user id supplied for confirmation"));
}
- my $user = SiteUsers->getByPkey($userid)
+ my $user = BSE::TB::SiteUsers->getByPkey($userid)
or return $self->req_show_logon($req,
$msgs->(confbaduser=>"Invalid or unknown user id supplied for confirmation"));
unless ($secret eq $user->{confirmSecret}) {
}
sub _generic_email {
-# SiteUser->generic_email(shift);
+# BSE::TB::SiteUser->generic_email(shift);
my ($checkemail) = @_;
# Build a generic form for the email - since an attacker could
return $self->req_show_logon($req,
$msgs->(unsubbaduser=>"Invalid or unknown username supplied for unsubscribe"));
}
- my $user = SiteUsers->getByPkey($userid)
+ my $user = BSE::TB::SiteUsers->getByPkey($userid)
or return $self->req_show_logon($req,
$msgs->(unsubbaduser=>"Invalid or unknown username supplied for unsubscribe"));
unless ($secret eq $user->{confirmSecret}) {
$aff_name =~ s/^\s+|\s+$//g;
if (length $aff_name) {
if ($aff_name =~ /^\w+$/) {
- my $other = SiteUsers->getBy(affiliate_name => $aff_name);
+ my $other = BSE::TB::SiteUsers->getBy(affiliate_name => $aff_name);
if ($other && (!$user || $other->{id} != $user->{id})) {
$errors->{affiliate_name} = $msgs->(dupaffiliatename =>
"$display '$aff_name' is already in use", $aff_name);
defined $u && $u =~ /^\d+$/ && defined $i && $i =~ /^\w+$/
or return $self->req_show_logon($req, "Missing or bad image parameter");
- my $user = SiteUsers->getByPkey($u)
+ my $user = BSE::TB::SiteUsers->getByPkey($u)
or return $self->req_show_logon($req, "Missing or bad image parameter");
my $image = $user->get_image($i)
or return $self->req_show_logon($req, "Unknown image id");
my $custom = custom_class($req->cfg);
- my $user = SiteUsers->getBy(userId => $user_id)
+ my $user = BSE::TB::SiteUsers->getBy(userId => $user_id)
or return $self->error($req, "No such user $user_id");
my $curr_user = $req->siteuser;
or return $self->req_show_logon($req, $req->catmsg("msg:bse/user/nolostid"));
my $error;
- my $user = SiteUsers->lost_password_next($id, \$error)
+ my $user = BSE::TB::SiteUsers->lost_password_next($id, \$error)
or return $self->req_show_logon($req, { _ => "msg:bse/user/lost/$error" });
my $message = $req->message($errors);
$req->validate(fields => \%lost_fields,
errors => \%errors);
my $password = $req->cgi->param("password");
- my $tmp_user = SiteUsers->lost_password_next($id);
+ my $tmp_user = BSE::TB::SiteUsers->lost_password_next($id);
unless ($errors{password}) {
my @errors;
my %others = $tmp_user
- ? map { $_ => $tmp_user->$_() } SiteUser->password_check_fields
+ ? map { $_ => $tmp_user->$_() } BSE::TB::SiteUser->password_check_fields
: ();
$DB::single = 1;
- unless (SiteUser->check_password_rules
+ unless (BSE::TB::SiteUser->check_password_rules
(
password => $password,
errors => \@errors,
my $error;
- my $user = SiteUsers->lost_password_save($id, $password, \$error)
+ my $user = BSE::TB::SiteUsers->lost_password_save($id, $password, \$error)
or return $self->req_show_logon($req, "msg:bse/user/lost/$error");
$req->flash("msg:bse/user/lostsaved");
+++ /dev/null
-package SiteUser;
-use strict;
-# represents a registered user
-use Squirrel::Row;
-use vars qw/@ISA/;
-@ISA = qw/Squirrel::Row/;
-use Constants qw($SHOP_FROM);
-use Carp qw(confess);
-use BSE::Util::SQL qw/now_datetime now_sqldate sql_normal_date sql_add_date_days/;
-
-=head1 NAME
-
-SiteUser - represent a site user (or member)
-
-=head1 METHODS
-
-=over
-
-=cut
-
-our $VERSION = "1.015";
-
-use constant MAX_UNACKED_CONF_MSGS => 3;
-use constant MIN_UNACKED_CONF_GAP => 2 * 24 * 60 * 60;
-use constant OWNER_TYPE => "U";
-
-sub columns {
- return qw/id idUUID userId password password_type email whenRegistered
- lastLogon
- title name1 name2 street street2
- suburb state postcode country
- telephone facsimile mobile organization
- confirmed confirmSecret waitingForConfirmation
- textOnlyMail previousLogon
- delivTitle delivEmail delivFirstName delivLastName delivStreet
- delivStreet2 delivSuburb delivState delivPostCode delivCountry
- delivTelephone delivFacsimile delivMobile delivOrganization
- instructions adminNotes disabled flags
- affiliate_name lost_today lost_date lost_id
- customText1 customText2 customText3
- customStr1 customStr2 customStr3
- customInt1 customInt2 customWhen1
- lockout_end
- /;
-}
-
-sub table {
- return "bse_siteusers";
-}
-
-sub defaults {
- require BSE::Util::SQL;
- return
- (
- # idUUID handled by default_idUUID()
- # userId - required
- # password - required (and generates password and password_type)
- # password_type - generated
- # email - required
- whenRegistered => BSE::Util::SQL::now_datetime(),
- lastLogon => BSE::Util::SQL::now_datetime(),
- title => "",
- name1 => "",
- name2 => "",
- street => "",
- street2 => "",
- suburb => "",
- state => "",
- postcode => "",
- country => "",
- telephone => "",
- facsimile => "",
- mobile => "",
- organization => "",
- confirmed => 0,
- confirmSecret => "",
- waitingForConfirmation => 0,
- textOnlyMail => 0,
- previousLogon => BSE::Util::SQL::now_datetime(),
- delivTitle => "",
- delivEmail => "",
- delivFirstName => "",
- delivLastName => "",
- delivStreet => "",
- delivStreet2 => "",
- delivSuburb => "",
- delivState => "",
- delivPostCode => "",
- delivCountry => "",
- delivTelephone => "",
- delivFacsimile => "",
- delivMobile => "",
- delivOrganization => "",
- instructions => "",
- adminNotes => "",
- disabled => 0,
- flags => "",
- affiliate_name => "",
- lost_today => 0,
- lost_date => undef,
- lost_id => undef,
- customText1 => undef,
- customText2 => undef,
- customText3 => undef,
- customStr1 => undef,
- customStr2 => undef,
- customStr3 => undef,
- customInt1 => "",
- customInt2 => "",
- customWhen1 => "",
- lockout_end => undef,
- );
-}
-
-sub default_idUUID {
- require Data::UUID;
- my $ug = Data::UUID->new;
- return $ug->create_str;
-}
-
-sub valid_fields {
- my ($class, $cfg, $admin) = @_;
-
- my %fields =
- (
- email => { rules=>'email', description=>'Email Address',
- maxlen => 255},
- title => { description => 'Title', rules => 'dh_one_line', maxlen => 127 },
- name1 => { description=>'First Name', rules=>"dh_one_line", maxlen=>127 },
- name2 => { description=>'Last Name', rules=>"dh_one_line", maxlen=>127 },
- street => { description => 'Address', rules=>"dh_one_line", maxlen=>127 },
- street2 => { description => 'Address', rules=>"dh_one_line", maxlen=>127 },
- suburb => { description=>'City/Suburb', rules=>"dh_one_line", maxlen=>127 },
- state => { description => 'State', rules=>"dh_one_line", maxlen=>40 },
- postcode => { rules=>'postcode', description=>'Post Code', maxlen=>40 },
- country => { description=>'Country', rules=>"dh_one_line", maxlen=>127 },
- telephone => { rules=>'phone', description=>'Telephone', maxlen=>80 },
- facsimile => { rules=>'phone', description=>'Facsimile', maxlen=>80 },
- mobile => { description => "Mobile", rules=>"phone", maxlen => 80 },
- organization => { description=>'Organization', rules=>"dh_one_line",
- maxlen=>127 },
- textOnlyEmail => { description => "Text Only Email", type=>"boolean" },
- delivTitle => { description=>"Delivery Title",
- rules=>"dh_one_line", maxlen=>127 },
- delivEmail => { description => "Delivery Email", rules=>"email",
- maxlen=>255 },
- delivFirstName => { description=>"Delivery First Name",
- rules=>"dh_one_line", maxlen=>127 },
- delivLastName => { descriptin=>"Delivery Last Name", rules=>"dh_one_line" },
- delivStreet => { description => "Delivery Street Address",
- rules=>"dh_one_line", maxlen=>127 },
- delivStreet2 => { description => 'Delivery Street Address 2',
- rules => "dh_one_line", maxlen=> 127 },
- delivSuburb => { description => "Delivery Suburb", rules=>"dh_one_line",
- maxlen=>127 },
- delivState => { description => "Delivery State", rules=>"dh_one_line",
- maxlen=>40 },
- delivPostCode => { description => "Delivery Post Code", rules=>"postcode",
- maxlen=>40 },
- delivCountry => { description => "Delivery Country", rules=>"dh_one_line",
- maxlen=>127 },
- delivTelephone => { description => "Delivery Phone", rules=>"phone",
- maxlen=>80 },
- delivFacsimile => { description => "Delivery Facsimie", rules=>"phone",
- maxlen=>80 },
- delivMobile => { description => "Delivery Mobile", rules=>"phone",
- maxlen => 80 },
- delivOrganization => { description => "Delivery Organization",
- rules=>"dh_one_line", maxlen => 127 },
- instructions => { description => "Delivery Instructions" },
- customText1 => { description => "Custom Text 1" },
- customText2 => { description => "Custom Text 2" },
- customText3 => { description => "Custom Text 3" },
- customStr1 => { description => "Custom String 1", rules=>"dh_one_line",
- maxlen=>255 },
- customStr2 => { description => "Custom String 2", rules=>"dh_one_line",
- maxlen=>255 },
- customStr3 => { description => "Custom String 3", rules=>"dh_one_line",
- maxlen=>255 },
- );
-
- if ($admin) {
- $fields{adminNotes} =
- { description => "Administrator Notes" };
- $fields{disabled} =
- { description => "User Disabled", type=>"boolean" };
- }
-
- return %fields;
-}
-
-sub valid_rules {
- return;
-}
-
-sub removeSubscriptions {
- my ($self) = @_;
-
- SiteUsers->doSpecial('removeSubscriptions', $self->{id});
-}
-
-sub removeSubscription {
- my ($self, $subid) = @_;
-
- SiteUsers->doSpecial('removeSub', $self->{id}, $subid);
-}
-
-sub generic_email {
- my ($class, $checkemail) = @_;
-
- # Build a generic form for the email - since an attacker could
- # include comments or extra spaces or a bunch of other stuff.
- # this isn't strictly correct, but it's good enough
- 1 while $checkemail =~ s/\([^)]\)//g;
- if ($checkemail =~ /<([^>]+)>/) {
- $checkemail = $1;
- }
- $checkemail = lc $checkemail;
- $checkemail =~ s/\s+//g;
-
- $checkemail;
-}
-
-=item subscriptions
-
-The subscriptions the user is subscribed to.
-
-=cut
-
-sub subscriptions {
- my ($self) = @_;
-
- require BSE::SubscriptionTypes;
- return BSE::SubscriptionTypes->getSpecial(userSubscribedTo => $self->{id});
-}
-
-sub send_conf_request {
- my ($user, $cgi, $cfg, $rcode, $rmsg) = @_;
-
- if ($user->is_disabled) {
- $$rmsg = "User is disabled";
- return;
- }
-
- my $nopassword = $cfg->entryBool('site users', 'nopassword', 0);
-
- # check for existing in-progress confirmations
- my $checkemail = $user->generic_email($user->{email});
-
- # check the blacklist
- require BSE::EmailBlacklist;
-
- # check that the from address has been configured
- my $from = $cfg->entry('confirmations', 'from') ||
- $cfg->entry('shop', 'from')|| $SHOP_FROM;
- unless ($from) {
- $$rcode = 'config';
- $$rmsg = "Configuration Error: The confirmations from address has not been configured";
- return;
- }
-
- my $blackentry = BSE::EmailBlacklist->getEntry($checkemail);
-
- if ($blackentry) {
- $$rcode = "blacklist";
- $$rmsg = $blackentry->{why};
- return;
- }
-
- unless ($user->{confirmSecret}) {
- use BSE::Util::Secure qw/make_secret/;
- # print STDERR "Generating secret\n";
- $user->{confirmSecret} = make_secret($cfg);
- $user->save;
- }
-
- # check for existing confirmations
- require BSE::EmailRequests;
- my $confirm = BSE::EmailRequests->getBy(genEmail=>$checkemail);
- if ($confirm) {
- if ($confirm->{unackedConfMsgs} >= MAX_UNACKED_CONF_MSGS) {
- $$rcode = 'toomany';
- $$rmsg = "Too many confirmations have been sent to this email address";
- return;
- }
- use BSE::Util::SQL qw/sql_datetime_to_epoch/;
- my $lastSentEpoch = sql_datetime_to_epoch($confirm->{lastConfSent});
- if ($lastSentEpoch + MIN_UNACKED_CONF_GAP > time) {
- $$rcode = 'toosoon';
- $$rmsg = "The last confirmation was sent too recently, please wait before trying again";
- return;
- }
- }
- else {
- my %confirm;
- my @cols = BSE::EmailRequest->columns;
- shift @cols;
- $confirm{email} = $user->{email};
- $confirm{genEmail} = $checkemail;
- # prevents silliness on error
- use BSE::Util::SQL qw(sql_datetime);
- $confirm{lastConfSent} = sql_datetime(time - MIN_UNACKED_CONF_GAP);
- $confirm{unackedConfMsgs} = 0;
- $confirm = BSE::EmailRequests->add(@confirm{@cols});
- }
-
- # ok, now we can send the confirmation request
- my %confacts;
- %confacts =
- (
- BSE::Util::Tags->basic(\%confacts, $cgi, $cfg),
- user => sub { $user->{$_[0]} },
- confirm => sub { $confirm->{$_[0]} },
- remote_addr => sub { $ENV{REMOTE_ADDR} },
- );
- my $email_template =
- $nopassword ? 'user/email_confirm_nop' : 'user/email_confirm';
-
- require BSE::ComposeMail;
- my $mail = BSE::ComposeMail->new(cfg => $cfg);
-
- my $subject = $cfg->entry('confirmations', 'subject')
- || 'Subscription Confirmation';
- unless ($mail->send(template => $email_template,
- acts => \%confacts,
- from=>$from,
- to=>$user,
- subject=>$subject)) {
- # a problem sending the mail
- $$rcode = "mail";
- $$rmsg = $mail->errstr;
- return;
- }
- ++$confirm->{unackedConfMsgs};
- $confirm->{lastConfSent} = now_datetime;
- $confirm->save;
-
- return 1;
-}
-
-=item orders
-
-The shop orders made by the user.
-
-=cut
-
-sub orders {
- my ($self) = @_;
-
- require BSE::TB::Orders;
-
- return BSE::TB::Orders->getBy(userId => $self->{userId});
-}
-
-sub _user_sub_entry {
- my ($self, $sub) = @_;
-
- my ($entry) = BSE::DB->query(userSubscribedEntry => $self->{id},
- $sub->{subscription_id})
- or return;
-
- return $entry;
-}
-
-=item subscribed_to
-
-return true if the user is subcribed to the given subscription.
-
-=cut
-
-# check if the user is subscribed to the given subscription
-sub subscribed_to {
- my ($self, $sub) = @_;
-
- my $entry = $self->_user_sub_entry($sub)
- or return;
-
- my $today = now_sqldate;
- my $end_date = sql_normal_date($entry->{ends_at});
- return $today le $end_date;
-}
-
-# check if the user is subscribed to the given subscription, and allow
-# for the max_lapsed grace period
-sub subscribed_to_grace {
- my ($self, $sub) = @_;
-
- my $entry = $self->_user_sub_entry($sub)
- or return;
-
- my $today = now_sqldate;
- my $end_date = sql_add_date_days($entry->{ends_at}, $entry->{max_lapsed});
- return $today le $end_date;
-}
-
-my @image_cols =
- qw(siteuser_id image_id filename width height bytes content_type alt);
-
-sub images_cfg {
- my ($self, $cfg) = @_;
-
- my @images;
- my %ids = $cfg->entries('BSE Siteuser Images');
- for my $id (keys %ids) {
- my %image = ( id => $id );
-
- my $sect = "BSE Siteuser Image $id";
- for my $key (qw(description help minwidth minheight maxwidth maxheight
- minratio maxratio properror
- widthsmallerror heightsmallerror smallerror
- widthlargeerror heightlargeerror largeerror
- maxspace spaceerror)) {
- my $value = $cfg->entry($sect, $key);
- if (defined $value) {
- $image{$key} = $value;
- }
- }
- push @images, \%image;
- }
-
- @images;
-}
-
-=item images
-
-Return images associated with the user.
-
-=cut
-
-sub images {
- my ($self) = @_;
-
- BSE::DB->query(getBSESiteuserImages => $self->{id});
-}
-
-sub get_image {
- my ($self, $id) = @_;
-
- my ($image) = BSE::DB->query(getBSESiteuserImage => $self->{id}, $id)
- or return;
-
- $image;
-}
-
-sub set_image {
- my ($self, $cfg, $id, $image) = @_;
-
- my %image = %$image;
- $image{siteuser_id} = $self->{id};
- my $old = $self->get_image($id);
-
- if ($old) {
- # replace it
- BSE::DB->run(replaceBSESiteuserImage => @image{@image_cols});
-
- # lose the old file
- my $image_dir = $cfg->entryVar('paths', 'siteuser_images');
- unlink "$image_dir/$old->{filename}";
- }
- else {
- # add it
- # replace it
- BSE::DB->run(addBSESiteuserImage => @image{@image_cols});
- }
-}
-
-sub remove_image {
- my ($self, $cfg, $id) = @_;
-
- if (my $old = $self->get_image($id)) {
- # remove the entry
- BSE::DB->run(deleteBSESiteuserImage => $self->{id}, $id);
-
- # lose the old file
- my $image_dir = $cfg->entryVar('paths', 'siteuser_images');
- unlink "$image_dir/$old->{filename}";
- }
-}
-
-sub recalculate_subscriptions {
- my ($self, $cfg) = @_;
-
- require BSE::TB::Subscriptions;
- my @subs = BSE::TB::Subscriptions->all;
- for my $sub (@subs) {
- $sub->update_user_expiry($self, $cfg);
- }
-}
-
-sub subscribed_services {
- my ($self) = @_;
-
- BSE::DB->query(siteuserSubscriptions => $self->{id});
-}
-
-=item is_disabled
-
-Return true if the user is disabled.
-
-=cut
-
-sub is_disabled {
- my ($self) = @_;
-
- return $self->{disabled};
-}
-
-sub seminar_sessions_booked {
- my ($self, $seminar_id) = @_;
-
- return map $_->{session_id},
- BSE::DB->query(userSeminarSessionBookings => $seminar_id, $self->{id});
-}
-
-sub is_member_of {
- my ($self, $group) = @_;
-
- my $group_id = ref $group ? $group->{id} : $group;
-
- my @result = BSE::DB->query(siteuserMemberOfGroup => $self->{id}, $group_id);
-
- return scalar(@result);
-}
-
-sub group_ids {
- my ($self) = @_;
-
- map $_->{id}, BSE::DB->query(siteuserGroupsForUser => $self->{id});
-}
-
-sub allow_html_email {
- my ($self) = @_;
-
- !$self->{textOnlyMail};
-}
-
-sub seminar_bookings_detail {
- my ($self) = @_;
-
- BSE::DB->query(bse_siteuserSeminarBookingsDetail => $self->{id});
-}
-
-=item wishlist
-
-return the user's wishlist products.
-
-=cut
-
-sub wishlist {
- my $self = shift;
- require BSE::TB::Products;
- return BSE::TB::Products->getSpecial(userWishlist => $self->{id});
-}
-
-sub wishlist_order {
- my $self = shift;
- return BSE::DB->query(bse_userWishlistOrder => $self->{id});
-}
-
-sub product_in_wishlist {
- my ($self, $product) = @_;
-
- grep $_->{product_id} == $product->{id}, $self->wishlist_order;
-}
-
-sub add_to_wishlist {
- my ($self, $product) = @_;
-
- return
- eval {
- BSE::DB->run(bse_addToWishlist => $self->{id}, $product->{id}, time());
- 1;
- };
-}
-
-sub remove_from_wishlist {
- my ($self, $product) = @_;
-
- BSE::DB->run(bse_removeFromWishlist => $self->{id}, $product->{id});
-}
-
-sub _set_wishlist_order {
- my ($self, $product_id, $display_order) = @_;
-
- print STDERR "_set_wishlist_order($product_id, $display_order)\n";
-
- BSE::DB->run(bse_userWishlistReorder => $display_order, $self->{id}, $product_id);
-}
-
-sub _find_in_wishlist {
- my ($self, $product_id) = @_;
-
- my @order = $self->wishlist_order;
-
- my ($index) = grep $order[$_]{product_id} == $product_id, 0 .. $#order
- or return;
-
- return \@order, $index;
-}
-
-sub move_to_wishlist_top {
- my ($self, $product) = @_;
-
- my ($order, $move_index) = $self->_find_in_wishlist($product->{id})
- or return;
- $move_index > 0
- or return; # nothing to do
-
- my $top_order = $order->[0]{display_order};
- for my $index (0 .. $move_index-1) {
- $self->_set_wishlist_order($order->[$index]{product_id}, $order->[$index+1]{display_order});
- }
- $self->_set_wishlist_order($product->{id}, $top_order);
-}
-
-sub move_to_wishlist_bottom {
- my ($self, $product) = @_;
-
- my ($order, $move_index) = $self->_find_in_wishlist($product->{id})
- or return;
- $move_index < $#$order
- or return; # nothing to do
-
- my $bottom_order = $order->[-1]{display_order};
- for my $index (reverse($move_index+1 .. $#$order)) {
- $self->_set_wishlist_order($order->[$index]{product_id}, $order->[$index-1]{display_order});
- }
- $self->_set_wishlist_order($product->{id}, $bottom_order);
-}
-
-sub move_down_wishlist {
- my ($self, $product) = @_;
-
- my ($order, $index) = $self->_find_in_wishlist($product->{id})
- or return;
- $index < $#$order
- or return; # nothing to do
-
- $self->_set_wishlist_order($product->{id}, $order->[$index+1]{display_order});
- $self->_set_wishlist_order($order->[$index+1]{product_id}, $order->[$index]{display_order});
-}
-
-sub move_up_wishlist {
- my ($self, $product) = @_;
-
- my ($order, $index) = $self->_find_in_wishlist($product->{id})
- or return;
- $index > 0
- or return; # nothing to do
-
- $self->_set_wishlist_order($product->{id}, $order->[$index-1]{display_order});
- $self->_set_wishlist_order($order->[$index-1]{product_id}, $order->[$index]{display_order});
-}
-
-# files owned specifically by this user
-sub files {
- my ($self) = @_;
-
- require BSE::TB::OwnedFiles;
- return BSE::TB::OwnedFiles->getBy(owner_type => OWNER_TYPE,
- owner_id => $self->id);
-}
-
-sub admin_group_files {
- my ($self) = @_;
-
- require BSE::TB::OwnedFiles;
- return BSE::TB::OwnedFiles->getSpecial(userVisibleGroupFiles => $self->{id});
-}
-
-sub query_group_files {
- my ($self, $cfg) = @_;
-
- require BSE::TB::SiteUserGroups;
- return
- (
- map $_->files, BSE::TB::SiteUserGroups->query_groups($cfg)
- );
-}
-
-=item visible_files
-
-files the user can see, both owned and owned by groups
-
-=cut
-
-sub visible_files {
- my ($self, $cfg) = @_;
-
- return
- (
- $self->files,
- $self->admin_group_files,
- $self->query_group_files($cfg)
- );
-}
-
-sub file_owner_type {
- return OWNER_TYPE;
-}
-
-sub subscribed_file_categories {
- my ($self) = @_;
-
- return map $_->{category}, BSE::DB->query(siteuserSubscribedFileCategories => $self->{id});
-}
-
-sub set_subscribed_file_categories {
- my ($self, $cfg, @new) = @_;
-
- require BSE::TB::OwnedFiles;
- my %current = map { $_ => 1 } $self->subscribed_file_categories;
- my %new = map { $_ => 1 } @new;
- my @all = BSE::TB::OwnedFiles->categories($cfg);
- for my $cat (@all) {
- if ($new{$cat->{id}} && !$current{$cat->{id}}) {
- eval {
- BSE::DB->run(siteuserAddFileCategory => $self->{id}, $cat->{id});
- }; # a race condition might cause a duplicate key error here
- }
- elsif (!$new{$cat->{id}} && $current{$cat->{id}}) {
- BSE::DB->run(siteuserRemoveFileCategory => $self->{id}, $cat->{id});
- }
- }
-}
-
-=item describe
-
-Returns a description of the user
-
-=cut
-
-sub describe {
- my ($self) = @_;
-
- return "Member: " . $self->userId;
-}
-
-=item paid_files
-
-Files that require payment that the user has paid for.
-
-=cut
-
-sub paid_files {
- my ($self) = @_;
-
- require BSE::TB::ArticleFiles;
- return BSE::TB::ArticleFiles->getSpecial(userPaidFor => $self->id);
-}
-
-sub remove {
- my ($self, $cfg) = @_;
-
- $cfg or confess "Missing parameter cfg";
-
- # remove any owned files
- for my $file ($self->files) {
- $file->remove($cfg);
- }
-
- # file subscriptions
- BSE::DB->run(bseRemoveUserFileSubs => $self->id);
-
- # file notifies
- BSE::DB->run(bseRemoveUserFileNotifies => $self->id);
-
- # download log
- BSE::DB->run(bseMarkUserFileAccessesAnon => $self->id);
-
- # mark any orders owned by the user as anonymous
- BSE::DB->run(bseMarkOwnedOrdersAnon => $self->id);
-
- # newsletter subscriptions
- BSE::DB->run(bseRemoveUserSubs => $self->id);
-
- # wishlist
- BSE::DB->run(bseRemoveUserWishlist => $self->id);
-
- # group memberships
- BSE::DB->run(bseRemoveUserMemberships => $self->id);
-
- # seminar bookings
- BSE::DB->run(bseRemoveUserBookings => $self->id);
-
- # paid subscriptions
- BSE::DB->run(bseRemoveUserProdSubs => $self->id);
-
- # images
- for my $im ($self->images) {
- $self->remove_image($cfg, $im->{image_id});
- }
-
- $self->SUPER::remove();
-}
-
-sub link {
- my ($self) = @_;
-
- return BSE::Cfg->single->admin_url(siteusers => { a_edit => 1, id => $self->id });
-}
-
-=item send_registration_notify(remote_addr => $ip_address)
-
-Send an email to the customer with registration information.
-
-Template: user/email_register
-
-Basic static tags and:
-
-=over
-
-=item *
-
-host - IP address of the machine that registered the user.
-
-=item *
-
-user - the user registered.
-
-=back
-
-=cut
-
-sub send_registration_notify {
- my ($self, %opts) = @_;
-
- defined $opts{remote_addr}
- or confess "Missing remote_addr parameter";
-
- require BSE::ComposeMail;
- require BSE::Util::Tags;
- BSE::ComposeMail->send_simple
- (
- id => 'notify_register_customer',
- template => 'user/email_register',
- subject => 'Thank you for registering',
- to => $self,
- extraacts =>
- {
- host => $opts{remote_addr},
- user => [ \&BSE::Util::Tags::tag_hash_plain, $self ],
- },
- log_msg => "Send registration email to Site User (" . $self->email .")",
- log_component => "member:register:notifyuser",
- );
-}
-
-sub changepw {
- my ($self, $password, $who, %log) = @_;
-
- require BSE::Passwords;
-
- my ($hash, $type) = BSE::Passwords->new_password_hash($password);
-
- $self->set_password($hash);
- $self->set_password_type($type);
-
- require BSE::TB::AuditLog;
- BSE::TB::AuditLog->log
- (
- component => "siteusers::changepw",
- object => $self,
- actor => $who,
- level => "notice",
- msg => "Site User '" . $self->userId . "' changed their password",
- %log,
- );
-
- 1;
-}
-
-sub check_password {
- my ($self, $password, $error) = @_;
-
- require BSE::Passwords;
- return BSE::Passwords->check_password_hash($self->password, $self->password_type, $password, $error);
-}
-
-=item lost_password
-
-Call to send a lost password email.
-
-=cut
-
-sub lost_password {
- my ($self, $error) = @_;
-
- my $cfg = BSE::Cfg->single;
- require BSE::CfgInfo;
- my $custom = BSE::CfgInfo::custom_class($cfg);
- my $email_user = $self;
- my $to = $self;
- if ($custom->can('send_user_email_to')) {
- eval {
- $email_user = $custom->send_user_email_to($self, $cfg);
- };
- $to = $email_user->{email};
- }
- else {
- require BSE::Util::SQL;
- my $lost_limit = $cfg->entry("lost password", "daily_limit", 3);
- my $today = BSE::Util::SQL::now_sqldate();
- my $lost_today = 0;
- if ($self->lost_date
- && $self->lost_date eq $today) {
- $lost_today = $self->lost_today;
- }
- if ($lost_today+1 > $lost_limit) {
- $$error = "Too many password recovery attempts today, please try again tomorrow";
- return;
- }
- $self->set_lost_date($today);
- $self->set_lost_today($lost_today+1);
- $self->set_lost_id(BSE::Util::Secure::make_secret($cfg));
- }
-
- require BSE::ComposeMail;
- my $mail = BSE::ComposeMail->new(cfg => $cfg);
-
- require BSE::Util::Tags;
- my %mailacts;
- %mailacts =
- (
- BSE::Util::Tags->mail_tags(),
- user => [ \&BSE::Util::Tags::tag_object_plain, $self ],
- host => $ENV{REMOTE_ADDR},
- site => $cfg->entryErr('site', 'url'),
- emailuser => [ \&BSE::Util::Tags::tag_hash_plain, $email_user ],
- );
- my $from = $cfg->entry('confirmations', 'from') ||
- $cfg->entry('shop', 'from') || $SHOP_FROM;
- my $nopassword = $cfg->entryBool('site users', 'nopassword', 0);
- my $subject = $cfg->entry('basic', 'lostpasswordsubject')
- || ($nopassword ? "Your options" : "Your password");
- unless ($mail->send
- (
- template => 'user/lostpwdemail',
- acts => \%mailacts,
- from=>$from,
- to => $to,
- subject=>$subject,
- log_msg => "Send password recovery email to Site User (" . $self->email . ")",
- log_component => "siteusers:lost:send",
- log_object => $self,
- )) {
- $$error = $mail->errstr;
- return;
- }
- $self->save;
-
- return $email_user;
-}
-
-sub check_password_rules {
- my ($class, %opts) = @_;
-
- require BSE::Util::PasswordValidate;
-
- my %rules = BSE::Cfg->single->entries("siteuser passwords");
-
- return BSE::Util::PasswordValidate->validate
- (
- %opts,
- rules => \%rules,
- );
-}
-
-sub password_check_fields {
- return qw(name1 name2);
-}
-
-=item locked_out
-
-Return true if logons are disabled due to too many authentication
-failures.
-
-=cut
-
-sub locked_out {
- my ($self) = @_;
-
- return $self->lockout_end && $self->lockout_end gt now_datetime();
-}
-
-sub check_lockouts {
- my ($class, %opts) = @_;
-
- require BSE::Util::Lockouts;
- BSE::Util::Lockouts->check_lockouts
- (
- %opts,
- section => "site user lockouts",
- component => "siteuser",
- module => "logon",
- type => $class->lockout_type,
- );
-}
-
-sub unlock {
- my ($self, %opts) = @_;
-
- require BSE::Util::Lockouts;
- BSE::Util::Lockouts->unlock_user
- (
- %opts,
- user => $self,
- component => "siteuser",
- module => "logon",
- );
-}
-
-sub unlock_ip_address {
- my ($class, %opts) = @_;
-
- require BSE::Util::Lockouts;
- BSE::Util::Lockouts->unlock_ip_address
- (
- %opts,
- component => "siteuser",
- module => "logon",
- type => $class->lockout_type,
- );
-}
-
-sub lockout_type {
- "S";
-}
-
-
-# for duck-type compatibility with BSE::TB::AdminUser
-sub logon {
- my ($self) = @_;
-
- return $self->userId;
-}
-
-=back
-
-=cut
-
-1;
+++ /dev/null
-package SiteUsers;
-use strict;
-use Squirrel::Table;
-use vars qw(@ISA $VERSION);
-@ISA = qw(Squirrel::Table);
-use SiteUser;
-
-our $VERSION = "1.004";
-
-sub rowClass {
- return 'SiteUser';
-}
-
-sub all_subscribers {
- my ($class) = @_;
-
- $class->getSpecial('allSubscribers');
-}
-
-sub all_ids {
- my ($class) = @_;
-
- map $_->{id}, BSE::DB->query('siteuserAllIds');
-}
-
-sub make {
- my ($self, %opts) = @_;
-
- require BSE::Passwords;
- my $password = delete $opts{password};
- my ($hash, $type) = BSE::Passwords->new_password_hash($password);
-
- $opts{password} = $hash;
- $opts{password_type} = $type;
-
- return $self->SUPER::make(%opts);
-}
-
-sub _lost_user {
- my ($self, $id, $error) = @_;
-
- my ($user) = SiteUsers->getBy(lost_id => $id);
- unless ($user) {
- $$error = "unknownid";
- return;
- }
-
- require BSE::Util::SQL;
- my $lost_limit_days = BSE::Cfg->single->entry("lost password", "age_limit", 7);
- my $check_date = BSE::Util::SQL::sql_add_date_days($user->lost_date, $lost_limit_days);
-
- my $today = BSE::Util::SQL::now_sqldate();
-
- if ($check_date lt $today) {
- $$error = "expired";
- return;
- }
-
- return $user;
-}
-
-sub lost_password_next {
- my ($self, $id, $error) = @_;
-
- my $user = $self->_lost_user($id, $error)
- or return;
-
- return $user;
-}
-
-sub lost_password_save {
- my ($self, $id, $password, $error) = @_;
-
- my $user = $self->_lost_user($id, $error)
- or return;
-
- $user->changepw($password, $user,
- component => "siteusers:lost:changepw",
- msg => "Site User '" . $user->userId . "' password changed");
- $user->set_lost_id("");
- $user->set_lockout_end(undef);
- BSE::TB::AuditLog->log
- (
- object => $user,
- component => "siteuser:logon:recover",
- actor => "S",
- level => "notice",
- msg => "Site User '" . $user->userId . "' account recovered",
- );
- $user->save;
-
- return 1;
-}
-
-1;
projects / bse.git / commitdiff