define the notequal validation rule type
[bse.git] / site / cgi-bin / modules / BSE / Request / Base.pm
CommitLineData
70789617
TC
1package BSE::Request::Base;
2use strict;
3use CGI ();
4use BSE::Cfg;
5use DevHelp::HTML;
61138170 6use Carp qw(cluck confess);
70789617
TC
7
8sub new {
9 my ($class, %opts) = @_;
10
5ac2ad24
TC
11 BSE::DB->startup();
12
70789617
TC
13 $opts{cfg} ||= BSE::Cfg->new;
14 $opts{cgi} ||= $class->_make_cgi;
8062fbd7 15 $opts{fastcgi} ||= 0;
70789617
TC
16
17 my $self = bless \%opts, $class;
18 if ($self->cfg->entry('html', 'utf8decodeall')) {
19 $self->_encode_utf8();
20 }
21 elsif ($self->cfg->entry('html', 'ajaxcharset', 0)
61138170 22 && $self->is_ajax) {
70789617
TC
23 # convert the values of each parameter from UTF8 to iso-8859-1
24 $self->_convert_utf8_cgi_to_charset();
25 }
26
27 $self;
28}
29
30sub _make_cgi {
6361fafb
TC
31 my $q = CGI->new;
32 my $error = $q->cgi_error;
33 if ($error) {
34 print STDERR "CGI ERROR: $error\n";
35 }
36
37 return $q;
70789617
TC
38}
39
40sub cgi {
41 return $_[0]{cgi};
42}
43
44sub cfg {
45 return $_[0]{cfg};
46}
47
48sub session {
49 $_[0]{session} or die "Session has been deleted already\n";
50
51 return $_[0]{session};
52}
53
8062fbd7
TC
54sub is_fastcgi {
55 $_[0]{fastcgi};
56}
57
70789617
TC
58sub end_request {
59 delete $_[0]{session};
60}
61
62sub extra_headers { return }
63
64sub user {
65 return $_[0]{adminuser};
66}
67
68sub setuser {
69 $_[0]{adminuser} = $_[1];
70}
71
72sub getuser {
73 $_[0]{adminuser};
74}
75
76# this needs to become non-admin specific
77sub url {
78 my ($self, $action, $params, $name) = @_;
79
80 require BSE::CfgInfo;
81 my $url = BSE::CfgInfo::admin_base_url($self->{cfg});
82 $url .= "/cgi-bin/admin/$action.pl";
83 if ($params && keys %$params) {
84 $url .= "?" . join("&", map { "$_=".escape_uri($params->{$_}) } keys %$params);
85 }
86 $url .= "#$name" if $name;
87
88 $url;
89}
90
91sub check_admin_logon {
92 my ($self) = @_;
93
94 require BSE::Permissions;
95 return BSE::Permissions->check_logon($self);
96}
97
98sub template_sets {
99 my ($self) = @_;
100
101 return () unless $self->access_control;
102
103 my $user = $self->user
104 or return;
105
106 return grep $_ ne '', map $_->{template_set}, $user->groups;
107}
108
109my $site_article =
110 {
111 id => -1,
112 title => "unknown",
113 parentid => 0,
114 generator => 'Generate::Article',
115 level => 0,
116 };
117
118sub user_can {
119 my ($self, $perm, $object, $rmsg) = @_;
120
121 require BSE::Permissions;
122 $object ||= $site_article;
123 $self->{perms} ||= BSE::Permissions->new($self->cfg);
124 if ($self->cfg->entry('basic', 'access_control', 0)) {
125 unless (ref $object) {
126 require Articles;
127 my $art = $object == -1 ? $site_article : Articles->getByPkey($object);
128 if ($art) {
129 $object = $art;
130 }
131 else {
132 print STDERR "** Cannot find article id $object\n";
133 require Carp;
134 Carp::cluck "Cannot find article id $object";
135 return 0;
136 }
137 }
138 return $self->{perms}->user_has_perm($self->user, $object, $perm, $rmsg);
139 }
140 else {
141 # some checks need to happen even if we don't want logons
142 return $self->{perms}->user_has_perm({ id=>-1 }, $object, $perm, $rmsg);
143 }
144}
145
146# a stub for now
147sub get_object {
148 return;
149}
150
151sub access_control {
152 $_[0]->{cfg}->entry('basic', 'access_control', 0);
153}
154
155sub output_result {
156 my ($req, $result) = @_;
157
158 require BSE::Template;
159 BSE::Template->output_result($req, $result);
160}
161
e63c3728
TC
162sub flash {
163 my ($self, @msg) = @_;
164
165 my $msg = "@msg";
166 my @flash;
167 @flash = @{$self->session->{flash}} if $self->session->{flash};
168 push @flash, $msg;
169 $self->session->{flash} = \@flash;
170}
171
70789617
TC
172sub message {
173 my ($req, $errors) = @_;
174
175 my $msg = '';
e63c3728 176 my @lines;
70789617
TC
177 if ($errors and keys %$errors) {
178 my @fields = $req->cgi->param;
179 my %work = %$errors;
70789617
TC
180 for my $field (@fields) {
181 if (my $entry = delete $work{$field}) {
182 push @lines, ref($entry) ? grep $_, @$entry : $entry;
183 }
184 }
185 for my $entry (values %work) {
186 if (ref $entry) {
187 push @lines, grep $_, @$entry;
188 }
189 else {
190 push @lines, $entry;
191 }
192 }
193 my %seen;
194 @lines = grep !$seen{$_}++, @lines; # don't need duplicates
70789617 195 }
e63c3728
TC
196 if ($req->session->{flash}) {
197 push @lines, @{$req->session->{flash}};
198 delete $req->session->{flash};
199 }
200 $msg = join "<br />", map escape_html($_), @lines;
70789617
TC
201 if (!$msg && $req->cgi->param('m')) {
202 $msg = join(' ', $req->cgi->param('m'));
203 $msg = escape_html($msg);
204 }
205
206 return $msg;
207}
208
209sub dyn_response {
4c4d3c3f 210 my ($req, $template, $acts, $modifier) = @_;
70789617
TC
211
212 my @search = $template;
213 my $base_template = $template;
214 my $t = $req->cgi->param('t');
215 $t or $t = $req->cgi->param('_t');
4c4d3c3f 216 $t or $t = $modifier;
70789617
TC
217 if ($t && $t =~ /^\w+$/) {
218 $template .= "_$t";
219 unshift @search, $template;
220 }
221
222 require BSE::Template;
223 my @sets;
224 if ($template =~ m!^admin/!) {
225 @sets = $req->template_sets;
226 }
227
228 return BSE::Template->get_response($template, $req->cfg, $acts,
229 $base_template, \@sets);
230}
231
232sub response {
233 my ($req, $template, $acts) = @_;
234
235 require BSE::Template;
236 my @sets;
237 if ($template =~ m!^admin/!) {
238 @sets = $req->template_sets;
239 }
240
241 return BSE::Template->get_response($template, $req->cfg, $acts,
242 $template, \@sets);
243}
244
245# get the current site user if one is logged on
246sub siteuser {
247 my ($req) = @_;
248
249 ++$req->{siteuser_calls};
250 if (exists $req->{_siteuser}) {
251 ++$req->{siteuser_cached};
252 return $req->{_siteuser};
253 }
254
255 my $cfg = $req->cfg;
256 my $session = $req->session;
257 require SiteUsers;
258 if ($cfg->entryBool('custom', 'user_auth')) {
259 require BSE::CfgInfo;
260 my $custom = BSE::CfgInfo::custom_class($cfg);
261
262 return $custom->siteuser_auth($session, $req->cgi, $cfg);
263 }
264 else {
265 $req->{_siteuser} = undef;
266
267 my $userid = $session->{userid}
268 or return;
269 my $user = SiteUsers->getBy(userId=>$userid)
270 or return;
271 $user->{disabled}
272 and return;
273
274 $req->{_siteuser} = $user;
275
276 return $user;
277 }
278}
279
280sub validate {
281 my ($req, %options) = @_;
282
283 $options{rules} ||= {};
284
285 require BSE::Validate;
286 BSE::Validate::bse_validate($req->cgi, $options{errors},
287 {
288 fields => $options{fields},
289 rules => $options{rules},
290 },
291 $req->cfg, $options{section});
292}
293
294sub validate_hash {
295 my ($req, %options) = @_;
296
297 $options{rules} ||= {};
298
299 require BSE::Validate;
300 BSE::Validate::bse_validate_hash($options{data}, $options{errors},
301 {
302 fields=>$options{fields},
303 rules => $options{rules},
304 },
305 $req->cfg, $options{section});
306}
307
308sub configure_fields {
309 my ($self, $fields, $section) = @_;
310
311 my $cfg = $self->cfg;
312 require BSE::Validate;
313 my $cfg_fields = BSE::Validate::bse_configure_fields($fields, $cfg, $section);
314
315 for my $name (keys %$fields) {
316 for my $cfg_name (qw/htmltype type width height size maxlength/) {
317 my $value = $cfg->entry($section, "${name}_${cfg_name}");
318 defined $value and $cfg_fields->{$name}{$cfg_name} = $value;
319 }
320 }
321
322 $cfg_fields;
323}
324
325sub _have_group_access {
326 my ($req, $user, $group_ids, $membership) = @_;
327
328 if (grep $_ > 0, @$group_ids) {
329 $membership->{filled}
330 or %$membership = map { $_ => 1 } 'filled', $user->group_ids;
331 return 1
332 if grep $membership->{$_}, @$group_ids;
333 }
334 for my $query_id (grep $_ < 0, @$group_ids) {
335 require BSE::TB::SiteUserGroups;
336 my $group = BSE::TB::SiteUserGroups->getQueryGroup($req->cfg, $query_id)
337 or next;
338 my $rows = BSE::DB->single->dbh->selectall_arrayref($group->{sql}, { MaxRows=>1 }, $user->{id});
339 $rows && @$rows
340 and return 1;
341 }
342
343 return 0;
344}
345
346sub _siteuser_has_access {
347 my ($req, $article, $user, $default, $membership) = @_;
348
349 defined $default or $default = 1;
350 defined $membership or $membership = {};
351
1b73ea7e
TC
352 unless ($article) {
353 # this shouldn't happen
354 cluck("_siteuser_has_access() called without an article parameter!");
355 return 0;
356 }
357
70789617
TC
358 my @group_ids = $article->group_ids;
359 if ($article->{inherit_siteuser_rights}
360 && $article->{parentid} != -1) {
361 if (@group_ids) {
362 $user ||= $req->siteuser
363 or return 0;
364 if ($req->_have_group_access($user, \@group_ids, $membership)) {
365 return 1;
366 }
367 else {
368 return $req->siteuser_has_access($article->parent, $user, 0);
369 }
370 }
371 else {
372 # ask parent
373 return $req->siteuser_has_access($article->parent, $user, $default);
374 }
375 }
376 else {
377 if (@group_ids) {
378 $user ||= $req->siteuser
379 or return 0;
380 if ($req->_have_group_access($user, \@group_ids, $membership)) {
381 return 1;
382 }
383 else {
384 return 0;
385 }
386 }
387 else {
388 return $default;
389 }
390 }
391}
392
393sub siteuser_has_access {
394 my ($req, $article, $user, $default, $membership) = @_;
395
396 $user ||= $req->siteuser;
397
398 ++$req->{has_access_total};
399 if ($req->{_siteuser} && $user && $user->{id} == $req->{_siteuser}{id}
400 && exists $req->{_access_cache}{$article->{id}}) {
401 ++$req->{has_access_cached};
402 return $req->{_access_cache}{$article->{id}};
403 }
404
405 my $result = $req->_siteuser_has_access($article, $user, $default, $membership);
406
407 if ($user && $req->{_siteuser} && $user->{id} == $req->{_siteuser}{id}) {
408 $req->{_access_cache}{$article->{id}} = $result;
409 }
410
411 return $result;
412}
413
414sub dyn_user_tags {
415 my ($self) = @_;
416
417 require BSE::Util::DynamicTags;
418 return BSE::Util::DynamicTags->new($self)->tags;
419}
420
421sub DESTROY {
422 my ($self) = @_;
423
424 if ($self->{cache_stats}) {
425 print STDERR "Siteuser cache: $self->{siteuser_calls} Total, $self->{siteuser_cached} Cached\n"
426 if $self->{siteuser_calls};
427 print STDERR "Access cache: $self->{has_access_total} Total, $self->{has_access_cached} Cached\n"
428 if $self->{has_access_total};
429 }
430
431 if ($self->{session}) {
432 undef $self->{session};
433 }
434}
435
436sub set_article {
437 my ($self, $name, $article) = @_;
438
439 if ($article) {
440 $self->{articles}{$name} = $article;
441 }
442 else {
443 delete $self->{articles}{$name};
444 }
445}
446
447sub get_article {
448 my ($self, $name) = @_;
449
450 exists $self->{articles}{$name}
451 or return;
452
453 my $article = $self->{articles}{$name};
454 if (ref $article eq 'SCALAR') {
455 $article = $$article;
456 }
457 $article
458 or return;
459
460 $article;
461}
462
463sub text {
464 my ($self, $id, $default) = @_;
465
56f87a80 466 return $self->cfg->entry('messages', $id, $default);
70789617
TC
467}
468
469sub _convert_utf8_cgi_to_charset {
470 my ($self) = @_;
471
472 require Encode;
473 my $cgi = $self->cgi;
474 my $workset = $self->cfg->entry('html', 'charset', 'iso-8859-1');
475 my $decoded = $self->cfg->entry('html', 'cgi_decoded', 1);
476
477 # avoids param decoding the data
478 $cgi->charset($workset);
479
480 print STDERR "Converting parameters from UTF8 to $workset\n"
481 if $self->cfg->entry('debug', 'convert_charset');
482
483 if ($decoded) {
484 # CGI.pm has already converted it from utf8 to perl's internal encoding
485 # so we just need to encode to the working encoding
486 # I don't see a reliable way to detect this without configuring it
487 for my $name ($cgi->param) {
488 my @values = map Encode::encode($workset, $_), $cgi->param($name);
489
490 $cgi->param($name => @values);
491 }
492 }
493 else {
494 for my $name ($cgi->param) {
495 my @values = $cgi->param($name);
496 Encode::from_to($_, $workset, 'utf8') for @values;
497 $cgi->param($name => @values);
498 }
499 }
500}
501
502sub _encode_utf8 {
503 my ($self) = @_;
504
505 my $cgi = $self->cgi;
506
507 require Encode;
508 for my $name ($cgi->param) {
509 my @values = map Encode::encode('utf8', $_), $cgi->param($name);
510 $cgi->param($name => @values);
511 }
512}
513
f5505b76
TC
514sub user_url {
515 my ($req, $script, $target, @options) = @_;
516
517 my $cfg = $req->cfg;
518 my $base = $script eq 'shop' ? $cfg->entryVar('site', 'secureurl') : '';
519 my $template;
796809d1
TC
520 if ($target) {
521 if ($script eq 'nuser') {
522 $template = "/cgi-bin/nuser.pl/user/TARGET";
523 }
524 else {
525 $template = "$base/cgi-bin/$script.pl?a_TARGET=1";
526 }
527 $template = $cfg->entry('targets', $script, $template);
528 $template =~ s/TARGET/$target/;
f5505b76
TC
529 }
530 else {
796809d1
TC
531 if ($script eq 'nuser') {
532 $template = "/cgi-bin/nuser.pl/user";
533 }
534 else {
535 $template = "$base/cgi-bin/$script.pl";
536 }
537 $template = $cfg->entry('targets', $script.'_n', $template);
f5505b76 538 }
f5505b76
TC
539 if (@options) {
540 $template .= $template =~ /\?/ ? '&' : '?';
541 my @entries;
542 while (my ($key, $value) = splice(@options, 0, 2)) {
543 push @entries, "$key=" . escape_uri($value);
544 }
545 $template .= join '&', @entries;
546 }
547
548 return $template;
549}
550
61138170
TC
551sub admin_tags {
552 my ($req) = @_;
553
554 require BSE::Util::Tags;
555 return
556 (
557 BSE::Util::Tags->common($req),
558 BSE::Util::Tags->admin(undef, $req->cfg),
559 BSE::Util::Tags->secure($req),
560 );
561}
562
563=item is_ajax
564
565Return true if the current request is an ajax request.
566
567=cut
568
569sub is_ajax {
570 my ($self) = @_;
571
572 defined $ENV{HTTP_X_REQUESTED_WITH}
573 && $ENV{HTTP_X_REQUESTED_WITH} =~ /XMLHttpRequest/
574 and return 1;
575
576 my $under = () = $self->cgi->param('_');
577 $under
578 and return 1;
579
580 return;
581}
582
583=item send_email
584
585Send a simple email.
586
587=cut
588
589sub send_email {
590 my ($self, %opts) = @_;
591
592 require BSE::ComposeMail;
593 my $mailer = BSE::ComposeMail->new(cfg => $self->cfg);
594
595 my $id = $opts{id}
596 or confess "No mail id provided";
597
598 my $section = "email $id";
599
600 for my $key (qw/subject template html_template allow_html from from_name/) {
601 my $value = $self->{cfg}->entry($section, $key);
602 defined $value and $opts{$key} = $value;
603 }
604 unless (defined $opts{acts}) {
605 require BSE::Util::Tags;
606 BSE::Util::Tags->import(qw/tag_hash_plain/);
607 my %acts =
608 (
609 $self->dyn_user_tags
610 );
6c83a514
TC
611 if ($opts{extraacts}) {
612 %acts = ( %acts, %{$opts{extraacts}} );
613 }
614 $opts{acts} = \%acts;
61138170
TC
615 }
616
617 $mailer->send(%opts)
618 or print STDERR "Error sending mail $id: ", $mailer->errstr, "\n";
619
620 return 1;
621}
622
70789617 6231;