better front-end proxy handling
[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 7use Constants qw($SHOP_FROM);
9d576c12 8use BSE::Util::SQL qw/now_datetime now_sqldate sql_normal_date sql_add_date_days/;
9063386f
TC
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 23 customStr1 customStr2 customStr3
37dd20ad
TC
24 affiliate_name delivMobile billMobile
25 delivStreet2 billStreet2
26 billOrganization/;
b19047a6
TC
27}
28
829c9ed9
TC
29sub valid_fields {
30 my ($class, $cfg, $admin) = @_;
31
32 my %fields =
33 (
34 email => { rules=>'email;required', description=>'Email Address',
35 maxlen => 255},
36 name1 => { description=>'First Name', rules=>"dh_one_line", maxlen=>127 },
37 name2 => { description=>'Surname', rules=>"dh_one_line", maxlen=>127 },
38 address => { description => 'Address', rules=>"dh_one_line", maxlen=>127 },
39 city => { description=>'City/Suburb', rules=>"dh_one_line", maxlen=>127 },
40 state => { description => 'State', rules=>"dh_one_line", maxlen=>40 },
41 postcode => { rules=>'postcode', description=>'Post Code', maxlen=>40 },
42 telephone => { rules=>'phone', description=>'Telephone', maxlen=>80 },
43 facsimile => { rules=>'phone', description=>'Facsimile', maxlen=>80 },
44 country => { description=>'Country', rules=>"dh_one_line", maxlen=>127 },
45 title => { description=>'Title', rules=>"dh_one_line", maxlen=>127 },
46 organization => { description=>'Organization', rules=>"dh_one_line",
47 maxlen=>127 },
e3d242f7
TC
48 delivMobile => { description => "Mobile", rules=>"phone",
49 maxlen => 80 },
37dd20ad
TC
50 delivStreet2 => { description => 'Address2', rules => "dh_one_line",
51 maxlen=> 127 },
829c9ed9
TC
52 textOnlyEmail => { description => "Text Only Email", type=>"boolean" },
53 referral => { description=>'Referral', rules=>"natural" },
54 otherReferral => { description=>'Other Referral', rules=>"dh_one_line",
55 maxlen=>127},
56 prompt => { description=>'Prompt', rules=>"natural" },
57 otherPrompt => { description => 'Other Prompt', rules=>"dh_one_line",
58 maxlen=>127 },
59 profession => { description => 'Profession', rules=>"natural" },
60 otherProfession => { description=>'Other Profession',
61 rules=>"dh_one_line", maxlen=>127 },
62 billFirstName => { description=>"Billing First Name",
63 rules=>"dh_one_line", maxlen=>127 },
64 billLastName => { descriptin=>"Billing Last Name", rules=>"dh_one_line" },
65 billStreet => { description => "Billing Street Address",
66 rules=>"dh_one_line", maxlen=>127 },
37dd20ad
TC
67 billStreet2 => { description => 'Billing Street Address 2',
68 rules => "dh_one_line", maxlen=> 127 },
829c9ed9
TC
69 billSuburb => { description => "Billing Suburb", rules=>"dh_one_line",
70 maxlen=>127 },
71 billState => { description => "Billing State", rules=>"dh_one_line",
72 maxlen=>40 },
73 billPostCode => { description => "Billing Post Code", rules=>"postcode",
74 maxlen=>40 },
75 billCountry => { description => "Billing Country", rules=>"dh_one_line",
76 maxlen=>127 },
77 instructions => { description => "Delivery Instructions" },
78 billTelephone => { description => "Billing Phone", rules=>"phone",
79 maxlen=>80 },
80 billFacsimile => { description => "Billing Facsimie", rules=>"phone",
81 maxlen=>80 },
82 billEmail => { description => "Billing Email", rules=>"email",
83 maxlen=>255 },
e3d242f7
TC
84 billMobile => { description => "Billing Mobile", rules=>"phone",
85 maxlen => 80 },
37dd20ad
TC
86 billOrganization => { description => "Billing Organization",
87 rules=>"dh_one_line", maxlen => 127 },
829c9ed9
TC
88 customText1 => { description => "Custom Text 1" },
89 customText2 => { description => "Custom Text 2" },
90 customText3 => { description => "Custom Text 3" },
91 customStr1 => { description => "Custom String 1", rules=>"dh_one_line",
92 maxlen=>255 },
93 customStr2 => { description => "Custom String 2", rules=>"dh_one_line",
94 maxlen=>255 },
95 customStr3 => { description => "Custom String 3", rules=>"dh_one_line",
96 maxlen=>255 },
97 );
98
99 if ($admin) {
100 $fields{adminNotes} =
101 { description => "Administrator Notes" };
102 $fields{disabled} =
103 { description => "User Disabled", type=>"boolean" };
104 }
105
106 for my $field_name (keys %fields) {
107 $fields{$field_name}{required} ||= $cfg->entry("site users", "require_$field_name", 0);
108 if (my $desc = $cfg->entry("site users", "display_$field_name")) {
109 $fields{$field_name}{description} = $desc;
110 }
111 }
112
113 return %fields;
114}
115
116sub valid_rules {
117 return;
118}
119
b19047a6
TC
120sub removeSubscriptions {
121 my ($self) = @_;
122
123 SiteUsers->doSpecial('removeSubscriptions', $self->{id});
589b789c
TC
124}
125
531fb3bc
TC
126sub removeSubscription {
127 my ($self, $subid) = @_;
128
129 SiteUsers->doSpecial('removeSub', $self->{id}, $subid);
130}
131
9063386f
TC
132sub generic_email {
133 my ($class, $checkemail) = @_;
134
135 # Build a generic form for the email - since an attacker could
136 # include comments or extra spaces or a bunch of other stuff.
137 # this isn't strictly correct, but it's good enough
138 1 while $checkemail =~ s/\([^)]\)//g;
139 if ($checkemail =~ /<([^>]+)>/) {
140 $checkemail = $1;
141 }
142 $checkemail = lc $checkemail;
143 $checkemail =~ s/\s+//g;
144
145 $checkemail;
146}
147
148sub subscriptions {
149 my ($self) = @_;
150
151 require BSE::SubscriptionTypes;
152 return BSE::SubscriptionTypes->getSpecial(userSubscribedTo => $self->{id});
153}
154
155sub send_conf_request {
156 my ($user, $cgi, $cfg, $rcode, $rmsg) = @_;
6a8a6ac5
TC
157
158 if ($user->is_disabled) {
159 $$rmsg = "User is disabled";
160 return;
161 }
9063386f
TC
162
163 my $nopassword = $cfg->entryBool('site users', 'nopassword', 0);
164
165 # check for existing in-progress confirmations
166 my $checkemail = $user->generic_email($user->{email});
167
168 # check the blacklist
169 require BSE::EmailBlacklist;
170
171 # check that the from address has been configured
172 my $from = $cfg->entry('confirmations', 'from') ||
173 $cfg->entry('basic', 'emailfrom')|| $SHOP_FROM;
174 unless ($from) {
175 $$rcode = 'config';
176 $$rmsg = "Configuration Error: The confirmations from address has not been configured";
177 return;
178 }
179
180 my $blackentry = BSE::EmailBlacklist->getEntry($checkemail);
181
182 if ($blackentry) {
183 $$rcode = "blacklist";
184 $$rmsg = $blackentry->{why};
185 return;
186 }
187
188 unless ($user->{confirmSecret}) {
189 use BSE::Util::Secure qw/make_secret/;
190 # print STDERR "Generating secret\n";
191 $user->{confirmSecret} = make_secret($cfg);
192 $user->save;
193 }
194
195 # check for existing confirmations
220c179a 196 require BSE::EmailRequests;
9063386f
TC
197 my $confirm = BSE::EmailRequests->getBy(genEmail=>$checkemail);
198 if ($confirm) {
199 if ($confirm->{unackedConfMsgs} >= MAX_UNACKED_CONF_MSGS) {
200 $$rcode = 'toomany';
201 $$rmsg = "Too many confirmations have been sent to this email address";
202 return;
203 }
204 use BSE::Util::SQL qw/sql_datetime_to_epoch/;
205 my $lastSentEpoch = sql_datetime_to_epoch($confirm->{lastConfSent});
206 if ($lastSentEpoch + MIN_UNACKED_CONF_GAP > time) {
207 $$rcode = 'toosoon';
208 $$rmsg = "The last confirmation was sent too recently, please wait before trying again";
209 return;
210 }
211 }
212 else {
213 my %confirm;
214 my @cols = BSE::EmailRequest->columns;
215 shift @cols;
216 $confirm{email} = $user->{email};
217 $confirm{genEmail} = $checkemail;
218 # prevents silliness on error
219 use BSE::Util::SQL qw(sql_datetime);
220 $confirm{lastConfSent} = sql_datetime(time - MIN_UNACKED_CONF_GAP);
221 $confirm{unackedConfMsgs} = 0;
222 $confirm = BSE::EmailRequests->add(@confirm{@cols});
223 }
224
225 # ok, now we can send the confirmation request
226 my %confacts;
227 %confacts =
228 (
229 BSE::Util::Tags->basic(\%confacts, $cgi, $cfg),
230 user => sub { $user->{$_[0]} },
231 confirm => sub { $confirm->{$_[0]} },
232 remote_addr => sub { $ENV{REMOTE_ADDR} },
233 );
234 my $email_template =
235 $nopassword ? 'user/email_confirm_nop' : 'user/email_confirm';
236 my $body = BSE::Template->get_page($email_template, $cfg, \%confacts);
220c179a
TC
237
238 require BSE::Mail;
9063386f
TC
239 my $mail = BSE::Mail->new(cfg=>$cfg);
240 my $subject = $cfg->entry('confirmations', 'subject')
241 || 'Subscription Confirmation';
242 unless ($mail->send(from=>$from, to=>$user->{email}, subject=>$subject,
243 body=>$body)) {
244 # a problem sending the mail
245 $$rcode = "mail";
246 $$rmsg = $mail->errstr;
247 return;
248 }
249 ++$confirm->{unackedConfMsgs};
250 $confirm->{lastConfSent} = now_datetime;
251 $confirm->save;
252
253 return 1;
254}
255
6a8a205a
TC
256sub orders {
257 my ($self) = @_;
258
3c32512d 259 require BSE::TB::Orders;
6a8a205a 260
3c32512d 261 return BSE::TB::Orders->getBy(userId => $self->{userId});
6a8a205a
TC
262}
263
af74f0b4
TC
264sub _user_sub_entry {
265 my ($self, $sub) = @_;
266
267 my ($entry) = BSE::DB->query(userSubscribedEntry => $self->{id},
268 $sub->{subscription_id})
269 or return;
270
271 return $entry;
272}
273
0ec4ac8a
TC
274# check if the user is subscribed to the given subscription
275sub subscribed_to {
276 my ($self, $sub) = @_;
277
af74f0b4
TC
278 my $entry = $self->_user_sub_entry($sub)
279 or return;
280
281 my $today = now_sqldate;
829c9ed9 282 my $end_date = sql_normal_date($entry->{ends_at});
af74f0b4 283 return $today le $end_date;
0ec4ac8a
TC
284}
285
286# check if the user is subscribed to the given subscription, and allow
287# for the max_lapsed grace period
288sub subscribed_to_grace {
289 my ($self, $sub) = @_;
290
af74f0b4
TC
291 my $entry = $self->_user_sub_entry($sub)
292 or return;
293
294 my $today = now_sqldate;
9d576c12 295 my $end_date = sql_add_date_days($entry->{ends_at}, $entry->{max_lapsed});
af74f0b4 296 return $today le $end_date;
0ec4ac8a
TC
297}
298
dfdeb4fe
TC
299my @image_cols =
300 qw(siteuser_id image_id filename width height bytes content_type alt);
301
302sub images_cfg {
303 my ($self, $cfg) = @_;
304
305 my @images;
306 my %ids = $cfg->entries('BSE Siteuser Images');
307 for my $id (keys %ids) {
308 my %image = ( id => $id );
309
310 my $sect = "BSE Siteuser Image $id";
311 for my $key (qw(description help minwidth minheight maxwidth maxheight
312 minratio maxratio properror
313 widthsmallerror heightsmallerror smallerror
314 widthlargeerror heightlargeerror largeerror
315 maxspace spaceerror)) {
316 my $value = $cfg->entry($sect, $key);
317 if (defined $value) {
318 $image{$key} = $value;
319 }
320 }
321 push @images, \%image;
322 }
323
324 @images;
325}
326
327sub images {
328 my ($self) = @_;
329
330 BSE::DB->query(getBSESiteuserImages => $self->{id});
331}
332
333sub get_image {
334 my ($self, $id) = @_;
335
336 my ($image) = BSE::DB->query(getBSESiteuserImage => $self->{id}, $id)
337 or return;
338
339 $image;
340}
341
342sub set_image {
343 my ($self, $cfg, $id, $image) = @_;
344
345 my %image = %$image;
346 $image{siteuser_id} = $self->{id};
347 my $old = $self->get_image($id);
348
349 if ($old) {
350 # replace it
351 BSE::DB->run(replaceBSESiteuserImage => @image{@image_cols});
352
353 # lose the old file
354 my $image_dir = $cfg->entryVar('paths', 'siteuser_images');
355 unlink "$image_dir/$old->{filename}";
356 }
357 else {
358 # add it
359 # replace it
360 BSE::DB->run(addBSESiteuserImage => @image{@image_cols});
361 }
362}
363
364sub remove_image {
365 my ($self, $cfg, $id) = @_;
366
367 if (my $old = $self->get_image($id)) {
368 # remove the entry
369 BSE::DB->run(deleteBSESiteuserImage => $self->{id}, $id);
370
371 # lose the old file
372 my $image_dir = $cfg->entryVar('paths', 'siteuser_images');
373 unlink "$image_dir/$old->{filename}";
374 }
375}
376
af74f0b4
TC
377sub recalculate_subscriptions {
378 my ($self, $cfg) = @_;
379
380 require BSE::TB::Subscriptions;
381 my @subs = BSE::TB::Subscriptions->all;
382 for my $sub (@subs) {
383 $sub->update_user_expiry($self, $cfg);
384 }
385}
dfdeb4fe 386
9d576c12
TC
387sub subscribed_services {
388 my ($self) = @_;
389
390 BSE::DB->query(siteuserSubscriptions => $self->{id});
391}
392
6a8a6ac5
TC
393sub is_disabled {
394 my ($self) = @_;
395
396 return $self->{disabled};
397}
398
718a070d
TC
399sub seminar_sessions_booked {
400 my ($self, $seminar_id) = @_;
401
402 return map $_->{session_id},
403 BSE::DB->query(userSeminarSessionBookings => $seminar_id, $self->{id});
404}
405
efcc5a30
TC
406sub is_member_of {
407 my ($self, $group) = @_;
408
409 my $group_id = ref $group ? $group->{id} : $group;
410
411 my @result = BSE::DB->query(siteuserMemberOfGroup => $self->{id}, $group_id);
412
413 return scalar(@result);
414}
415
416sub group_ids {
417 my ($self) = @_;
418
419 map $_->{id}, BSE::DB->query(siteuserGroupsForUser => $self->{id});
420}
421
7aa0262a
TC
422sub allow_html_email {
423 my ($self) = @_;
424
425 !$self->{textOnlyMail};
426}
427
2076966c
TC
428sub seminar_bookings_detail {
429 my ($self) = @_;
430
431 BSE::DB->query(bse_siteuserSeminarBookingsDetail => $self->{id});
432}
433
589b789c 4341;