0.14_29 commit
[bse.git] / site / cgi-bin / modules / SiteUser.pm
CommitLineData
589b789c
TC
1package SiteUser;
2use strict;
3# represents a registered user
4use Squirrel::Row;
5use vars qw/@ISA/;
6@ISA = qw/Squirrel::Row/;
9063386f
TC
7use Constants qw($SHOP_FROM);
8use BSE::Util::SQL qw/now_datetime/;
9
10use constant MAX_UNACKED_CONF_MSGS => 3;
11use constant MIN_UNACKED_CONF_GAP => 2 * 24 * 60 * 60;
589b789c
TC
12
13sub columns {
14 return qw/id userId password email keepAddress whenRegistered lastLogon
15 name1 name2 address city state postcode telephone facsimile
b19047a6
TC
16 country wantLetter confirmed confirmSecret waitingForConfirmation
17 textOnlyMail title organization referral otherReferral
9063386f
TC
18 prompt otherPrompt profession otherProfession previousLogon
19 billFirstName billLastName billStreet billSuburb billState
20 billPostCode billCountry instructions billTelephone billFacsimile
4175638b
TC
21 billEmail adminNotes disabled flags
22 customText1 customText2 customText3
dfdeb4fe
TC
23 customStr1 customStr2 customStr3
24 affiliate_name/;
b19047a6
TC
25}
26
27sub removeSubscriptions {
28 my ($self) = @_;
29
30 SiteUsers->doSpecial('removeSubscriptions', $self->{id});
589b789c
TC
31}
32
531fb3bc
TC
33sub removeSubscription {
34 my ($self, $subid) = @_;
35
36 SiteUsers->doSpecial('removeSub', $self->{id}, $subid);
37}
38
9063386f
TC
39sub generic_email {
40 my ($class, $checkemail) = @_;
41
42 # Build a generic form for the email - since an attacker could
43 # include comments or extra spaces or a bunch of other stuff.
44 # this isn't strictly correct, but it's good enough
45 1 while $checkemail =~ s/\([^)]\)//g;
46 if ($checkemail =~ /<([^>]+)>/) {
47 $checkemail = $1;
48 }
49 $checkemail = lc $checkemail;
50 $checkemail =~ s/\s+//g;
51
52 $checkemail;
53}
54
55sub subscriptions {
56 my ($self) = @_;
57
58 require BSE::SubscriptionTypes;
59 return BSE::SubscriptionTypes->getSpecial(userSubscribedTo => $self->{id});
60}
61
62sub send_conf_request {
63 my ($user, $cgi, $cfg, $rcode, $rmsg) = @_;
64
65 my $nopassword = $cfg->entryBool('site users', 'nopassword', 0);
66
67 # check for existing in-progress confirmations
68 my $checkemail = $user->generic_email($user->{email});
69
70 # check the blacklist
71 require BSE::EmailBlacklist;
72
73 # check that the from address has been configured
74 my $from = $cfg->entry('confirmations', 'from') ||
75 $cfg->entry('basic', 'emailfrom')|| $SHOP_FROM;
76 unless ($from) {
77 $$rcode = 'config';
78 $$rmsg = "Configuration Error: The confirmations from address has not been configured";
79 return;
80 }
81
82 my $blackentry = BSE::EmailBlacklist->getEntry($checkemail);
83
84 if ($blackentry) {
85 $$rcode = "blacklist";
86 $$rmsg = $blackentry->{why};
87 return;
88 }
89
90 unless ($user->{confirmSecret}) {
91 use BSE::Util::Secure qw/make_secret/;
92 # print STDERR "Generating secret\n";
93 $user->{confirmSecret} = make_secret($cfg);
94 $user->save;
95 }
96
97 # check for existing confirmations
220c179a 98 require BSE::EmailRequests;
9063386f
TC
99 my $confirm = BSE::EmailRequests->getBy(genEmail=>$checkemail);
100 if ($confirm) {
101 if ($confirm->{unackedConfMsgs} >= MAX_UNACKED_CONF_MSGS) {
102 $$rcode = 'toomany';
103 $$rmsg = "Too many confirmations have been sent to this email address";
104 return;
105 }
106 use BSE::Util::SQL qw/sql_datetime_to_epoch/;
107 my $lastSentEpoch = sql_datetime_to_epoch($confirm->{lastConfSent});
108 if ($lastSentEpoch + MIN_UNACKED_CONF_GAP > time) {
109 $$rcode = 'toosoon';
110 $$rmsg = "The last confirmation was sent too recently, please wait before trying again";
111 return;
112 }
113 }
114 else {
115 my %confirm;
116 my @cols = BSE::EmailRequest->columns;
117 shift @cols;
118 $confirm{email} = $user->{email};
119 $confirm{genEmail} = $checkemail;
120 # prevents silliness on error
121 use BSE::Util::SQL qw(sql_datetime);
122 $confirm{lastConfSent} = sql_datetime(time - MIN_UNACKED_CONF_GAP);
123 $confirm{unackedConfMsgs} = 0;
124 $confirm = BSE::EmailRequests->add(@confirm{@cols});
125 }
126
127 # ok, now we can send the confirmation request
128 my %confacts;
129 %confacts =
130 (
131 BSE::Util::Tags->basic(\%confacts, $cgi, $cfg),
132 user => sub { $user->{$_[0]} },
133 confirm => sub { $confirm->{$_[0]} },
134 remote_addr => sub { $ENV{REMOTE_ADDR} },
135 );
136 my $email_template =
137 $nopassword ? 'user/email_confirm_nop' : 'user/email_confirm';
138 my $body = BSE::Template->get_page($email_template, $cfg, \%confacts);
220c179a
TC
139
140 require BSE::Mail;
9063386f
TC
141 my $mail = BSE::Mail->new(cfg=>$cfg);
142 my $subject = $cfg->entry('confirmations', 'subject')
143 || 'Subscription Confirmation';
144 unless ($mail->send(from=>$from, to=>$user->{email}, subject=>$subject,
145 body=>$body)) {
146 # a problem sending the mail
147 $$rcode = "mail";
148 $$rmsg = $mail->errstr;
149 return;
150 }
151 ++$confirm->{unackedConfMsgs};
152 $confirm->{lastConfSent} = now_datetime;
153 $confirm->save;
154
155 return 1;
156}
157
6a8a205a
TC
158sub orders {
159 my ($self) = @_;
160
3c32512d 161 require BSE::TB::Orders;
6a8a205a 162
3c32512d 163 return BSE::TB::Orders->getBy(userId => $self->{userId});
6a8a205a
TC
164}
165
0ec4ac8a
TC
166# check if the user is subscribed to the given subscription
167sub subscribed_to {
168 my ($self, $sub) = @_;
169
170 return; # PH for now, not subscribed
171}
172
173# check if the user is subscribed to the given subscription, and allow
174# for the max_lapsed grace period
175sub subscribed_to_grace {
176 my ($self, $sub) = @_;
177
178 return; # PH for now, not subscribed
179}
180
dfdeb4fe
TC
181my @image_cols =
182 qw(siteuser_id image_id filename width height bytes content_type alt);
183
184sub images_cfg {
185 my ($self, $cfg) = @_;
186
187 my @images;
188 my %ids = $cfg->entries('BSE Siteuser Images');
189 for my $id (keys %ids) {
190 my %image = ( id => $id );
191
192 my $sect = "BSE Siteuser Image $id";
193 for my $key (qw(description help minwidth minheight maxwidth maxheight
194 minratio maxratio properror
195 widthsmallerror heightsmallerror smallerror
196 widthlargeerror heightlargeerror largeerror
197 maxspace spaceerror)) {
198 my $value = $cfg->entry($sect, $key);
199 if (defined $value) {
200 $image{$key} = $value;
201 }
202 }
203 push @images, \%image;
204 }
205
206 @images;
207}
208
209sub images {
210 my ($self) = @_;
211
212 BSE::DB->query(getBSESiteuserImages => $self->{id});
213}
214
215sub get_image {
216 my ($self, $id) = @_;
217
218 my ($image) = BSE::DB->query(getBSESiteuserImage => $self->{id}, $id)
219 or return;
220
221 $image;
222}
223
224sub set_image {
225 my ($self, $cfg, $id, $image) = @_;
226
227 my %image = %$image;
228 $image{siteuser_id} = $self->{id};
229 my $old = $self->get_image($id);
230
231 if ($old) {
232 # replace it
233 BSE::DB->run(replaceBSESiteuserImage => @image{@image_cols});
234
235 # lose the old file
236 my $image_dir = $cfg->entryVar('paths', 'siteuser_images');
237 unlink "$image_dir/$old->{filename}";
238 }
239 else {
240 # add it
241 # replace it
242 BSE::DB->run(addBSESiteuserImage => @image{@image_cols});
243 }
244}
245
246sub remove_image {
247 my ($self, $cfg, $id) = @_;
248
249 if (my $old = $self->get_image($id)) {
250 # remove the entry
251 BSE::DB->run(deleteBSESiteuserImage => $self->{id}, $id);
252
253 # lose the old file
254 my $image_dir = $cfg->entryVar('paths', 'siteuser_images');
255 unlink "$image_dir/$old->{filename}";
256 }
257}
258
259
589b789c 2601;