site/cgi-bin/modules/BSE/UserReg.pm

   1 package BSE::UserReg;
   2 use strict;
   3 use base qw(BSE::UI::SiteuserCommon BSE::UI::Dispatch);
   4 use SiteUsers;
   5 use BSE::Util::Tags qw(tag_error_img tag_hash tag_hash_plain tag_article);
   6 use BSE::Template;
   7 use Constants qw($SHOP_FROM);
   8 use BSE::Message;
   9 use BSE::SubscriptionTypes;
  10 use BSE::SubscribedUsers;
  11 use BSE::Mail;
  12 use BSE::EmailRequests;
  13 use BSE::Util::SQL qw/now_datetime/;
  14 use BSE::Util::HTML;
  15 use BSE::CfgInfo qw(custom_class);
  16 use BSE::WebUtil qw/refresh_to/;
  17 use BSE::Util::Iterate;
  18 use base 'BSE::UI::UserCommon';
  19 use Carp qw(confess);
  20
  21 our $VERSION = "1.015";
  22
  23 use constant MAX_UNACKED_CONF_MSGS => 3;
  24 use constant MIN_UNACKED_CONF_GAP => 2 * 24 * 60 * 60;
  25
  26 my %actions =
  27   (
  28    show_logon => 'show_logon',
  29    show_register => 'show_register',
  30    register => 'register',
  31    show_opts => 'show_opts',
  32    saveopts=>'saveopts',
  33    logon => 'logon',
  34    logoff => 'logoff',
  35    userpage=>'userpage',
  36    download=>'download',
  37    download_file=>'download_file',
  38    show_lost_password => 'show_lost_password',
  39    lost_password => 'lost_password',
  40    lost => 1,
  41    lost_save => 1,
  42    subinfo => 'subinfo',
  43    blacklist => 'blacklist',
  44    confirm => 'confirm',
  45    unsub => 'unsub',
  46    setcookie => 'set_cookie',
  47    nopassword => 'nopassword',
  48    image => 'req_image',
  49    orderdetail => 'req_orderdetail',
  50    orderdetaila => 'req_orderdetaila',
  51    oda => 1,
  52    wishlist => 'req_wishlist',
  53    downufile => 'req_downufile',
  54    file_metadata => "req_file_metadata",
  55    file_cmetadata => "req_file_cmetadata",
  56   );
  57
  58 sub actions { \%actions }
  59
  60 sub action_prefix { '' }
  61
  62 sub default_action { 'userpage' }
  63
  64 my @donttouch = qw(id userId password email confirmed confirmSecret waitingForConfirmation disabled flags affiliate_name previousLogon);
  65 my %donttouch = map { $_, $_ } @donttouch;
  66
  67 sub _refresh_userpage ($$) {
  68   my ($cfg, $msg) = @_;
  69
  70   my $url = $cfg->entryErr('site', 'url') . "/cgi-bin/user.pl?userpage=1";
  71   if (defined $msg) {
  72     $url .= '&message='.escape_uri($msg);
  73   }
  74   refresh_to($url);
  75 }
  76
  77 # returns true if the userid cookie should be created
  78 sub _should_make_user_cookie {
  79   return BSE::Cfg->single->entry("basic", "make_userid_cookie", 1);
  80 }
  81
  82 sub _send_user_cookie {
  83   my ($self, $user) = @_;
  84
  85   $self->_should_make_user_cookie or return;
  86
  87   my $value = $user ? $user->userId : "";
  88
  89   BSE::Session->send_cookie
  90       (BSE::Session->make_cookie(BSE::Cfg->single, userid => $value));
  91 }
  92
  93 sub req_show_logon {
  94   my ($self, $req, $message) = @_;
  95
  96   my $cfg = $req->cfg;
  97   my $cgi = $req->cgi;
  98   my $session = $req->session;
  99
 100   my $nopassword = $cfg->entryBool('site users', 'nopassword', 0);
 101
 102   if ($nopassword) {
 103     return $self->req_nopassword($req);
 104   }
 105
 106   $message ||= $cgi->param('message') || '';
 107   if (my $msgid = $cgi->param('mid')) {
 108     my $temp = $cfg->entry("messages", $msgid);
 109     $message = $temp if $temp;
 110   }
 111   my $errors;
 112   if (ref $message) {
 113     $errors = $message;
 114     $message = $req->message($errors);
 115   }
 116   elsif ($message) {
 117     $message = escape_html($message);
 118     $errors = {};
 119   }
 120   else {
 121     $message = $req->message();
 122   }
 123   my %acts;
 124   %acts =
 125     (
 126      $req->dyn_user_tags(),
 127      message => $message,
 128      error_img => [ \&tag_error_img, $cfg, $errors ],
 129     );
 130
 131   return $req->response('user/logon', \%acts);
 132 }
 133
 134 my %logon_fields =
 135   (
 136    userid =>
 137    {
 138     description => "Logon name",
 139     rules => "required",
 140    },
 141    password =>
 142    {
 143     description => "Password",
 144     rules => "required",
 145    },
 146   );
 147
 148 sub req_logon {
 149   my ($self, $req) = @_;
 150
 151   my $cfg = $req->cfg;
 152   my $cgi = $req->cgi;
 153   my $session = $req->session;
 154
 155   my $nopassword = $cfg->entryBool('site users', 'nopassword', 0);
 156
 157   if ($nopassword) {
 158     return $self->req_nopassword($req);
 159   }
 160   my $msgs = BSE::Message->new(cfg=>$cfg, section=>'user');
 161   my %errors;
 162   $req->validate(fields => \%logon_fields,
 163                  errors => \%errors,
 164                  section => "Logon Fields");
 165   my $user;
 166   my $userid = $cgi->param("userid");
 167   my $password = $cgi->param("password");
 168   unless (keys %errors) {
 169     $user = SiteUsers->getBy(userId => $userid);
 170     my $error = "INVALID";
 171     unless ($user && $user->check_password($password, \$error)) {
 172       if ($error eq "INVALID") {
 173         $errors{_} = $msgs->(baduserpass=>"Invalid username or password");
 174       }
 175       else {
 176         $errors{_} = $msgs->(passwordload => "Error loading password module");
 177       }
 178     }
 179   }
 180   if (!keys %errors && $user->{disabled}) {
 181     $errors{_} = $msgs->(disableduser=>"Account $userid has been disabled");
 182   }
 183
 184   keys %errors
 185     and return $self->req_show_logon($req, \%errors);
 186
 187   my %fields = $user->valid_fields($cfg);
 188   my $custom = custom_class($cfg);
 189
 190   for my $field ($custom->siteuser_edit_required($req, $user)) {
 191     $fields{$field}{required} = 1;
 192   }
 193   my %rules = $user->valid_rules($cfg);
 194
 195   $req->validate_hash(data => $user,
 196                       errors => \%errors,
 197                       fields => \%fields,
 198                       rules => \%rules,
 199                       section => 'site user validation');
 200   _validate_affiliate_name($cfg, $user->{affiliate_name}, \%errors, $msgs, $user);
 201   if (keys %errors) {
 202     delete $session->{userid};
 203     $session->{partial_logon} = $user->id;
 204     return $self->req_show_opts($req, undef, \%errors);
 205   }
 206
 207   $session->{userid} = $user->id;
 208   $user->{previousLogon} = $user->{lastLogon};
 209   $user->{lastLogon} = now_datetime;
 210   $user->save;
 211
 212   if ($custom->can('siteuser_login')) {
 213     $custom->siteuser_login($session->{_session_id}, $session->{userid},
 214                             $cfg, $session);
 215   }
 216   $self->_send_user_cookie($user);
 217
 218   _got_user_refresh($session, $cgi, $cfg);
 219 }
 220
 221 sub _got_user_refresh {
 222   my ($session, $cgi, $cfg) = @_;
 223
 224   my $baseurl = $cfg->entryVar('site', 'url');
 225   my $securl = $cfg->entryVar('site', 'secureurl');
 226   my $need_magic = $baseurl ne $securl;
 227   my $onbase = 1;
 228   my $debug = $cfg->entryBool('debug', 'logon_cookies', 0);
 229   if ($need_magic) {
 230     print STDERR "Logon Cookies Debug\n" if $debug;
 231
 232     # which host are we on?
 233     # first get info about the 2 possible hosts
 234     my ($baseprot, $basehost, $baseport) =
 235       $baseurl =~ m!^(\w+)://([\w.-]+)(?::(\d+))?!;
 236     $baseport ||= $baseprot eq 'http' ? 80 : 443;
 237     print STDERR "Base: prot: $baseprot  Host: $basehost  Port: $baseport\n"
 238       if $debug;
 239
 240     #my ($secprot, $sechost, $secport) =
 241     #  $securl =~ m!^(\w+)://([\w.-]+)(?::(\d+))?!;
 242
 243     # get info about the current host
 244     my $port = $ENV{SERVER_PORT} || 80;
 245     my $ishttps = exists $ENV{HTTPS} || exists $ENV{SSL_CIPHER};
 246     print STDERR "\$ishttps: $ishttps\n" if $debug;
 247     my $protocol = $ishttps ? 'https' : 'http';
 248
 249     if (lc $ENV{SERVER_NAME} ne lc $basehost
 250        || lc $protocol ne $baseprot
 251        || $baseport != $port) {
 252       print STDERR "not on base host ('$ENV{SERVER_NAME}' cmp '$basehost' '$protocol cmp '$baseprot'  $baseport cmp $port\n";
 253       $onbase = 0;
 254     }
 255   }
 256   my $refresh = $cgi->param('r');
 257   unless ($refresh) {
 258     if ($session->{userid}) {
 259       $refresh = "$ENV{SCRIPT_NAME}?userpage=1";
 260     }
 261     else {
 262       $refresh = "$ENV{SCRIPT_NAME}?show_logon=1";
 263     }
 264   }
 265   if ($need_magic) {
 266     my $url = $onbase ? $securl : $baseurl;
 267     my $finalbase = $onbase ? $baseurl : $securl;
 268     $refresh = $finalbase . $refresh unless $refresh =~ /^\w+:/;
 269     print STDERR "Heading to $url to setcookie\n" if $debug;
 270     $url .= "$ENV{SCRIPT_NAME}?setcookie=".$session->{_session_id};
 271     $url .= "&r=".escape_uri($refresh);
 272     refresh_to($url);
 273   }
 274   else {
 275     refresh_to($refresh);
 276   }
 277
 278   return;
 279 }
 280
 281 sub req_setcookie {
 282   my ($self, $req) = @_;
 283
 284   my $cfg = $req->cfg;
 285   my $cgi = $req->cgi;
 286   my $session = $req->session;
 287
 288   my $debug = $cfg->entryBool('debug', 'logon_cookies', 0);
 289   my $msgs = BSE::Message->new(cfg=>$cfg, section=>'user');
 290   my $cookie = $cgi->param('setcookie')
 291     or return $self->req_show_logon($req,
 292                                 $msgs->(nocookie=>"No cookie provided"));
 293   print STDERR "Setting sessionid to $cookie for $ENV{HTTP_HOST}\n";
 294   my %newsession;
 295   BSE::Session->change_cookie($session, $cfg, $cookie, \%newsession);
 296   if (exists $session->{cart} && !exists $newsession{cart}) {
 297     $newsession{cart} = $session->{cart};
 298     $newsession{custom} = $session->{custom} if exists $session->{custom};
 299   }
 300   my $refresh = $cgi->param('r')
 301     or return $self->req_show_logon($req,
 302                                 $msgs->(norefresh=>"No refresh provided"));
 303   my $userid = $newsession{userid};
 304   my $user;
 305   if ($userid) {
 306     $user = SiteUsers->getBy(userId => $userid);
 307   }
 308   $self->_send_user_cookie($user);
 309
 310   refresh_to($refresh);
 311
 312   return;
 313 }
 314
 315 sub req_logoff {
 316   my ($self, $req) = @_;
 317
 318   my $cfg = $req->cfg;
 319   my $cgi = $req->cgi;
 320   my $session = $req->session;
 321
 322   my $nopassword = $cfg->entryBool('site users', 'nopassword', 0);
 323
 324   if ($nopassword) {
 325     return $self->req_nopassword($req);
 326   }
 327
 328   my $msgs = BSE::Message->new(cfg=>$cfg, section=>'user');
 329   my $userid = $session->{userid}
 330     or return $self->req_show_logon($req,
 331                                 $msgs->(notloggedon=>"You aren't logged on"));
 332
 333   delete $session->{userid};
 334   $session->{cart} = [];
 335   $self->_send_user_cookie();
 336
 337   my $custom = custom_class($cfg);
 338   if ($custom->can('siteuser_logout')) {
 339     $custom->siteuser_logout($session->{_session_id}, $cfg);
 340   }
 341
 342   _got_user_refresh($session, $cgi, $cfg);
 343
 344   return;
 345 }
 346
 347 sub tag_if_subscribed_register {
 348   my ($cgi, $cfg, $subs, $rsub_index) = @_;
 349
 350   return 0 if $$rsub_index < 0 or $$rsub_index >= @$subs;
 351   my $sub = $subs->[$$rsub_index];
 352   if ($cgi->param('checkedsubs')) {
 353     my @checked = $cgi->param('subscription');
 354     return grep($sub->{id} == $_, @checked) != 0;
 355   }
 356   else {
 357     my $def = $cfg->entryBool('site users', 'subscribe_all', 0);
 358
 359     return $cfg->entryBool('site users', "subscribe_$sub->{id}", $def);
 360   }
 361 }
 362
 363 sub tag_if_required {
 364   my ($cfg, $args) = @_;
 365
 366   return $cfg->entryBool('site users', "require_$args", 0);
 367 }
 368
 369 sub req_show_register {
 370   my ($self, $req, $message, $errors) = @_;
 371
 372   my $cfg = $req->cfg;
 373   my $cgi = $req->cgi;
 374   my $session = $req->session;
 375
 376   my $user_register = $cfg->entryBool('site users', 'user_register', 1);
 377   my $nopassword = $cfg->entryBool('site users', 'nopassword', 0);
 378   unless ($user_register) {
 379     if ($nopassword) {
 380       return $self->req_show_lost_password($req,
 381                                        "Registration disabled");
 382     }
 383     else {
 384       return $self->req_show_logon($req,
 385                                "Registration disabled");
 386     }
 387   }
 388   $errors ||= {};
 389   $message ||= $cgi->param('message');
 390   if (defined $message) {
 391     $message = escape_html($message);
 392   }
 393   else {
 394     if (keys %$errors) {
 395       my @keys = $cgi->param();
 396       my %errors_copy = %$errors;
 397       my @errors = grep defined, delete @errors_copy{@keys};
 398       push @errors, values %errors_copy;
 399       $message = join("<br />", map escape_html($_), @errors);
 400     }
 401     else {
 402       $message = '';
 403     }
 404   }
 405
 406   my @subs = grep $_->{visible}, BSE::SubscriptionTypes->all;
 407   my $sub_index = -1;
 408   my %acts;
 409   %acts =
 410     (
 411      $req->dyn_user_tags(),
 412      old =>
 413      sub {
 414        my $value = $cgi->param($_[0]);
 415        defined $value or $value = '';
 416        escape_html($value);
 417      },
 418      message => $message,
 419      BSE::Util::Tags->make_iterator(\@subs, 'subscription', 'subscriptions',
 420                                    \$sub_index),
 421      ifSubscribed =>
 422      [ \&tag_if_subscribed_register, $cgi, $cfg, \@subs, \$sub_index ],
 423      ifRequired =>
 424      [ \&tag_if_required, $cfg ],
 425      error_img => [ \&tag_error_img, $cfg, $errors ],
 426     );
 427
 428   my $template = 'user/register';
 429   return $req->dyn_response($template, \%acts);
 430 }
 431
 432 sub _get_user {
 433   my ($self, $req, $name, $result) = @_;
 434
 435   defined $result or confess "Missing result parameter";
 436
 437   my $cfg = $req->cfg;
 438   my $cgi = $req->cgi;
 439   my $session = $req->session;
 440   my $nopassword = $cfg->entryBool('site users', 'nopassword', 0);
 441   if ($nopassword) {
 442     my $password;
 443     $password = $cgi->param($name) if $name;
 444     $password ||= $cgi->param('p');
 445     my $uid = $cgi->param('u');
 446     defined $uid && $uid =~ /^\d+$/ && defined $password
 447       or do { refresh_to($ENV{SCRIPT}."?nopassword=1"); return };
 448
 449     my $user = SiteUsers->getByPkey($uid)
 450       or do { refresh_to($ENV{SCRIPT}."?nopassword=1"); return };
 451
 452     $user->{password} eq $password
 453       or do { refresh_to($ENV{SCRIPT}."?nopassword=1"); return };
 454
 455     return $user;
 456   }
 457   else {
 458     if ($cfg->entryBool('custom', 'user_auth')) {
 459       my $custom = custom_class($cfg);
 460
 461       return $custom->siteuser_auth($session, $cgi, $cfg);
 462     }
 463     else {
 464       my $user = $req->siteuser;
 465       unless ($user) {
 466         $$result = $self->req_show_logon($req);
 467         return;
 468       }
 469       if ($user->{disabled}) {
 470         $$result = $self->req_show_logon($req, "Account disabled");
 471         return;
 472       }
 473
 474       return $user;
 475     }
 476   }
 477 }
 478
 479 sub tag_ifSubscribedTo {
 480   my ($user, $args) = @_;
 481
 482   require BSE::TB::Subscriptions;
 483   my $sub = BSE::TB::Subscriptions->getBy(text_id=>$args)
 484     or return 0;
 485
 486   $user->subscribed_to($sub);
 487 }
 488
 489 sub _partial_logon {
 490   my ($self, $req) = @_;
 491
 492   my $session = $req->session;
 493   if ($session->{partial_logon}
 494       && !$req->cfg->entryBool('custom', 'user_auth')) {
 495     my $user = SiteUsers->getByPkey($session->{partial_logon})
 496       or return;
 497     $user->{disabled}
 498       and return;
 499     return $user;
 500   }
 501   return;
 502 }
 503
 504 sub req_show_opts {
 505   my ($self, $req, $message, $errors) = @_;
 506
 507   my $cfg = $req->cfg;
 508   my $cgi = $req->cgi;
 509   my $session = $req->session;
 510
 511   my $partial_logon = 0;
 512   my $user = $self->_partial_logon($req)
 513     and ++$partial_logon;
 514
 515   if ($partial_logon) {
 516     $cgi->param('t' => undef);
 517   }
 518
 519   unless ($user) {
 520     my $result;
 521     $user = $self->_get_user($req, 'show_opts', \$result)
 522       or return $result;
 523   }
 524
 525   my @subs = grep $_->{visible}, BSE::SubscriptionTypes->all;
 526   my @usersubs = BSE::SubscribedUsers->getBy(userId=>$user->{id});
 527   my %usersubs = map { $_->{subId}, $_ } @usersubs;
 528
 529   my $sub_index;
 530   $errors ||= {};
 531   $message ||= $cgi->param('message');
 532   if (defined $message) {
 533     $message = escape_html($message);
 534   }
 535   else {
 536     if (keys %$errors) {
 537       $message = $req->message($errors);
 538     }
 539     else {
 540       $message = '';
 541     }
 542   }
 543   require BSE::TB::OwnedFiles;
 544   my @file_cats = BSE::TB::OwnedFiles->categories($cfg);
 545   my %subbed = map { $_ => 1 } $user->subscribed_file_categories;
 546   for my $cat (@file_cats) {
 547     $cat->{subscribed} = exists $subbed{$cat->{id}} ? 1 : 0;
 548   }
 549
 550   my $it = BSE::Util::Iterate->new;
 551   my %acts;
 552   %acts =
 553     (
 554      $self->_common_tags($req, $user),
 555      last =>
 556      sub {
 557        my $value = $cgi->param($_[0]);
 558        defined $value or $value = $user->{$_[0]};
 559        defined $value or $value = '';
 560        escape_html($value);
 561      },
 562      message => $message,
 563      BSE::Util::Tags->make_iterator(\@subs, 'subscription', 'subscriptions',
 564                                     \$sub_index),
 565      ifSubscribed=>sub { $usersubs{$subs[$sub_index]{id}} },
 566      ifAnySubs => sub { @usersubs },
 567      ifRequired =>
 568      [ \&tag_if_required, $cfg ],
 569      error_img => [ \&tag_error_img, $cfg, $errors ],
 570      $self->_edit_tags($user, $cfg),
 571      ifSubscribedTo => [ \&tag_ifSubscribedTo, $user ],
 572      partial_logon => $partial_logon,
 573      $it->make
 574      (
 575       data => \@file_cats,
 576       single => "filecat",
 577       plural => "filecats"
 578      ),
 579     );
 580
 581   my $base = 'user/options';
 582
 583   return $req->dyn_response($base, \%acts);
 584 }
 585
 586 sub _checkemail {
 587   my ($user, $errors, $email, $cgi, $msgs, $nopassword) = @_;
 588
 589   if (!$email) {
 590     $errors->{email} = $msgs->(optsnoemail => "Please enter an email address");
 591   }
 592   elsif ($email !~  /.@./) {
 593     $errors->{email} = $msgs->(optsbademail=>
 594                                "Please enter a valid email address");
 595   }
 596   else {
 597     if ($nopassword && $email ne $user->{email}) {
 598       my $conf_email = $cgi->param('confirmemail');
 599       if ($conf_email) {
 600         if ($conf_email eq $email) {
 601           my $other = SiteUsers->getBy(userId=>$email);
 602           if ($other) {
 603             $errors->{email} =
 604               $msgs->(optsdupemail =>
 605                       "That email address is already in use");
 606           }
 607         }
 608         else {
 609           $errors->{confirmemail} =
 610             $msgs->(optsconfemailnw=>
 611                     "Confirmation email address doesn't match email address");
 612         }
 613       }
 614       else {
 615         $errors->{confirmemail} =
 616           $msgs->(optsnoconfemail=> "Please enter a confirmation email address");
 617       }
 618
 619     }
 620   }
 621   if (!$errors->{email}) {
 622     my $checkemail = _generic_email($email);
 623     require 'BSE/EmailBlacklist.pm';
 624     my $blackentry = BSE::EmailBlacklist->getEntry($checkemail);
 625     if ($blackentry) {
 626       $errors->{email} =
 627         $msgs->(optsblackemail =>
 628                 "Email $email is blacklisted: $blackentry->{why}",
 629                 $email, $blackentry->{why});
 630     }
 631   }
 632 }
 633
 634 sub req_saveopts {
 635   my ($self, $req) = @_;
 636
 637   my $cfg = $req->cfg;
 638   my $cgi = $req->cgi;
 639   my $session = $req->session;
 640
 641   my $msgs = BSE::Message->new(cfg=>$cfg, section=>'user');
 642
 643   my $partial_logon = 0;
 644   my $user = $self->_partial_logon($req)
 645     and ++$partial_logon;
 646
 647   unless ($user) {
 648     my $result;
 649     $user = $self->_get_user($req, undef, \$result)
 650       or return $result;
 651   }
 652
 653   my $custom = custom_class($cfg);
 654   if ($cfg->entry('custom', 'saveopts')) {
 655     local $SIG{__DIE__};
 656     eval {
 657       $custom->siteuser_saveopts($user, $req);
 658     };
 659     if ($@) {
 660       return $self->req_show_opts($req, $@);
 661     }
 662   }
 663
 664   my $nopassword = $cfg->entryBool('site users', 'nopassword', 0);
 665   my %errors;
 666   my $newpass;
 667   unless ($nopassword) {
 668     my $oldpass = $cgi->param('old_password');
 669     $newpass = $cgi->param('password');
 670     my $confirm = $cgi->param('confirm_password');
 671
 672     if (defined $newpass && length $newpass) {
 673       if ($oldpass) {
 674         my $error;
 675         if (!$user->check_password($oldpass, \$error)) {
 676           sleep 5; # yeah, it's ugly
 677           $errors{old_password} = $msgs->(optsbadold=>"You need to enter your old password to change your password")
 678         }
 679         else {
 680           my $error;
 681           if (!SiteUser->check_password_rules($newpass, \$error)) {
 682             my ($code, @more) = @$error;
 683             $errors{password} = $req->catmsg("msg:bse/user/$code", \@more)
 684           }
 685           elsif (!defined $confirm || length $confirm == 0) {
 686             $errors{confirm_password} = $msgs->(optsconfpass=>"Please enter a confirmation password");
 687           }
 688           elsif ($newpass ne $confirm) {
 689             $errors{confirm_password} = $msgs->(optsconfmismatch=>"The confirmation password is different from the password");
 690           }
 691         }
 692       }
 693       else {
 694         $errors{old_password} =
 695           $msgs->(optsoldpass=>"You need to enter your old password to change your password")
 696       }
 697     }
 698   }
 699   my $email = $cgi->param('email');
 700   my $saveemail;
 701   if (defined $email) {
 702     ++$saveemail;
 703     _checkemail($user, \%errors, $email, $cgi, $msgs, $nopassword);
 704   }
 705
 706
 707   my @cols = grep !$donttouch{$_}, SiteUser->columns;
 708   for my $col (@cols) {
 709     my $value = $cgi->param($col);
 710     if ($cfg->entryBool('site users', "require_$col")) {
 711       if (defined $value && $value eq '') {
 712         my $disp = $cfg->entry('site users', "display_$col", "\u$col");
 713         $errors{$col} = $msgs->("optsrequired" =>
 714                                 "$disp is a required field", $col, $disp);
 715       }
 716     }
 717   }
 718   my %fields = $user->valid_fields($cfg);
 719   unless ($partial_logon) {
 720     # only test fields for values supplied
 721     my @remove = grep !defined $cgi->param($_), keys %fields;
 722     delete @fields{@remove};
 723   }
 724   my %rules = $user->valid_rules($cfg);
 725   $req->validate(errors => \%errors,
 726                  fields => \%fields,
 727                  rules => \%rules,
 728                  section => 'site user validation');
 729
 730   my $aff_name = $cgi->param('affiliate_name');
 731   $aff_name = _validate_affiliate_name($cfg, $aff_name, \%errors, $msgs, $user);
 732
 733   $self->_save_images($cfg, $cgi, $user, \%errors);
 734
 735   keys %errors
 736     and return $self->req_show_opts($req, undef, \%errors);
 737   my $newemail;
 738   if ($saveemail && $email ne $user->{email}) {
 739     $user->{confirmed} = 0;
 740     $user->{confirmSecret} = '';
 741     $user->{email} = $email;
 742     $user->{userId} = $email if $nopassword;
 743     ++$newemail;
 744   }
 745   if (!$nopassword && $newpass) {
 746     $user->changepw($newpass, $user);
 747   }
 748
 749   $user->{affiliate_name} = $aff_name if defined $aff_name;
 750
 751   for my $col (@cols) {
 752     my $value = $cgi->param($col);
 753     if (defined $value) {
 754       $user->{$col} = $value;
 755     }
 756   }
 757
 758   $user->{textOnlyMail} = 0
 759     if $cgi->param('saveTextOnlyMail') && !defined $cgi->param('textOnlyMail');
 760   $user->{keepAddress} = 0
 761     if $cgi->param('saveKeepAddress') && !defined $cgi->param('keepAddress');
 762   $user->save;
 763
 764   # subscriptions
 765   my $subs;
 766   if ($cgi->param('saveSubscriptions')) {
 767     $subs = $self->_save_subs($user, $session, $cfg, $cgi);
 768   }
 769
 770   $custom->can('siteuser_edit')
 771     and $custom->siteuser_edit($user, 'user', $cfg);
 772
 773   if ($nopassword) {
 774     return $self->send_conf_request($req, $user)
 775       if $newemail;
 776   }
 777   else {
 778     $subs = () = $user->subscriptions unless defined $subs;
 779     return $self->send_conf_request($req, $user)
 780       if $subs && !$user->{confirmed};
 781   }
 782
 783   if ($cgi->param('save_file_subs')) {
 784     my @new_subs = $cgi->param("file_subscriptions");
 785     $user->set_subscribed_file_categories($cfg, @new_subs);
 786   }
 787
 788   if ($partial_logon) {
 789     $user->{previousLogon} = $user->{lastLogon};
 790     $user->{lastLogon} = now_datetime;
 791     $session->{userid} = $user->id;
 792     delete $session->{partial_logon};
 793     $user->save;
 794
 795     my $custom = custom_class($cfg);
 796     if ($custom->can('siteuser_login')) {
 797       $custom->siteuser_login($session->{_session_id}, $session->{userid}, $cfg);
 798     }
 799
 800     $self->_send_user_cookie($user);
 801
 802     _got_user_refresh($session, $cgi, $cfg);
 803     return;
 804   }
 805
 806   my $url = $cgi->param('r');
 807   unless ($url) {
 808     $url = $cfg->entryErr('site', 'url') . "$ENV{SCRIPT_NAME}?userpage=1";
 809     if ($nopassword) {
 810       $url =~ s/1$/$user->{password}/;
 811       $url .= "&u=$user->{id}";
 812     }
 813     my $t = $cgi->param('t');
 814     if ($t && $t =~ /^\w+$/) {
 815       $url .= "&_t=$t";
 816     }
 817   }
 818
 819   $custom->siteusers_changed($cfg);
 820
 821   refresh_to($url);
 822
 823   return;
 824 }
 825
 826 # returns true if the caller needs to send output
 827 sub _save_subs {
 828   my ($self, $user, $session, $cfg, $cgi) = @_;
 829
 830   my @subids = $cgi->param('subscription');
 831   $user->removeSubscriptions;
 832   if (@subids) {
 833     my @usersubs;
 834     my @subs;
 835     my @cols = BSE::SubscribedUser->columns;
 836     shift @cols; # don't set id
 837     my $found = 0;
 838     for my $subid (@subids) {
 839       $subid =~ /^\d+$/ or next;
 840       my $sub = BSE::SubscriptionTypes->getByPkey($subid)
 841         or next;
 842       ++$found;
 843       my %usersub;
 844       $usersub{subId} = $subid;
 845       $usersub{userId} = $user->{id};
 846
 847       push(@usersubs, BSE::SubscribedUsers->add(@usersub{@cols}));
 848       push(@subs, $sub);
 849     }
 850     return $found;
 851   }
 852   return 0;
 853 }
 854
 855 sub req_register {
 856   my ($self, $req) = @_;
 857
 858   my $cfg = $req->cfg;
 859   my $cgi = $req->cgi;
 860   my $session = $req->session;
 861
 862   my $msgs = BSE::Message->new(cfg=>$cfg, section=>'user');
 863
 864   my $user_register = $cfg->entryBool('site users', 'user_register', 1);
 865   my $nopassword = $cfg->entryBool('site users', 'nopassword', 0);
 866   unless ($user_register) {
 867     my $msg = $msgs->(regdisabled => "Registration disabled");
 868     if ($nopassword) {
 869       return $self->req_show_lost_password($req, $msg);
 870     }
 871     else {
 872       return $self->req_show_logon($req, $msg);
 873     }
 874   }
 875
 876   my %user;
 877   my @cols = SiteUser->columns;
 878   shift @cols;
 879   for my $field (@cols) {
 880     $user{$field} = '';
 881   }
 882
 883   my %errors;
 884   my %fields = SiteUser->valid_fields($cfg);
 885   my %rules = SiteUser->valid_rules($cfg);
 886   $req->validate(errors => \%errors,
 887                  fields => \%fields,
 888                  rules => \%rules,
 889                  section => 'site user validation');
 890
 891   my $email = $cgi->param('email');
 892   if (!defined $email or !length $email) {
 893     $errors{email} = $msgs->(regnoemail => "Please enter an email address");
 894     $email = ''; # prevent undefined value warnings later
 895   }
 896   elsif ($email !~ /.\@./) {
 897     $errors{email} = $msgs->(regbademail => "Please enter a valid email address");
 898   }
 899   if ($nopassword) {
 900     my $confemail = $cgi->param('confirmemail');
 901     if (!defined $confemail or !length $confemail) {
 902       $errors{confirmemail} = $msgs->(regnoconfemail => "Please enter a confirmation email address");
 903     }
 904     elsif ($email ne $confemail) {
 905       $errors{confirmemail} = $msgs->(regbadconfemail => "Confirmation email must match the email address");
 906     }
 907     my $user = SiteUsers->getBy(userId=>$email);
 908     if ($user) {
 909       $errors{email} = $msgs->(regemailexists=>
 910                                 "Sorry, email $email already exists as a user",
 911                                 $email);
 912     }
 913     $user{userId} = $email;
 914     $user{password} = '';
 915   }
 916   else {
 917     my $min_pass_length = $cfg->entry('basic', 'minpassword') || 4;
 918     my $userid = $cgi->param('userid');
 919     if (!defined $userid || length $userid == 0) {
 920       $errors{userid} = $msgs->(reguser=>"Please enter your username");
 921     }
 922     my $pass = $cgi->param('password');
 923     my $pass2 = $cgi->param('confirm_password');
 924     if (!defined $pass || length $pass == 0) {
 925       $errors{password} = $msgs->(regpass=>"Please enter your password");
 926     }
 927     elsif (length $pass < $min_pass_length) {
 928       $errors{password} = $msgs->(regpasslen=>"The password must be at least $min_pass_length characters");
 929     }
 930     elsif (!defined $pass2 || length $pass2 == 0) {
 931       $errors{confirm_password} =
 932         $msgs->(regconfpass=>"Please enter a confirmation password");
 933     }
 934     elsif ($pass ne $pass2) {
 935       $errors{confirm_password} =
 936         $msgs->(regconfmismatch=>"The confirmation password is different from the password");
 937     }
 938     my $user = SiteUsers->getBy(userId=>$userid);
 939     if ($user) {
 940       # give the user a suggestion
 941       my $workuser = $userid;
 942       $workuser =~ s/\d+$//;
 943       my $suffix = 1;
 944       for my $suffix (1..100) {
 945         unless (SiteUsers->getBy(userId=>"$workuser$suffix")) {
 946           $cgi->param(userid=>"$workuser$suffix");
 947           last;
 948         }
 949       }
 950       $errors{userid} = $msgs->(regexists=>
 951                                 "Sorry, username $userid already exists",
 952                                 $userid);
 953     }
 954     $user{userId} = $userid;
 955     $user{password} = $pass;
 956   }
 957
 958   unless ($errors{email}) {
 959     my $checkemail = _generic_email($email);
 960     require 'BSE/EmailBlacklist.pm';
 961     my $blackentry = BSE::EmailBlacklist->getEntry($checkemail);
 962     if ($blackentry) {
 963       $errors{email} = $msgs->(regblackemail =>
 964                                "Email $email is blacklisted: $blackentry->{why}",
 965                                $email, $blackentry->{why});
 966     }
 967   }
 968
 969   my @mod_cols = grep !$donttouch{$_}, @cols;
 970   for my $col (@mod_cols) {
 971     my $value = $cgi->param($col);
 972     if ($cfg->entryBool('site users', "require_$col")) {
 973       unless (defined $value && $value ne '') {
 974         my $disp = $cfg->entry('site users', "display_$col", "\u$col");
 975
 976         $errors{$col} = $msgs->(regrequired => "$disp is a required field",
 977                                 $col, $disp);
 978       }
 979     }
 980     if (defined $value) {
 981       $user{$col} = $value;
 982     }
 983   }
 984   my $aff_name = $cgi->param('affiliate_name');
 985   $aff_name = _validate_affiliate_name($cfg, $aff_name, \%errors, $msgs);
 986   defined $aff_name or $aff_name = '';
 987
 988   if (keys %errors) {
 989     return $self->req_show_register($req, undef, \%errors);
 990   }
 991
 992   $user{email} = $email;
 993   $user{lastLogon} = $user{whenRegistered} =
 994     $user{previousLogon} = now_datetime;
 995   $user{keepAddress} = 0;
 996   $user{wantLetter} = 0;
 997   $user{affiliate_name} = $aff_name;
 998   if ($nopassword) {
 999     use BSE::Util::Secure qw/make_secret/;
1000     $user{password} = make_secret($cfg);
1001   }
1002
1003   my $user;
1004   eval {
1005     $user = SiteUsers->make(%user);
1006   };
1007   if ($user) {
1008     my $custom = custom_class($cfg);
1009     $custom->can('siteuser_add')
1010       and $custom->siteuser_add($user, 'user', $cfg);
1011
1012     $req->audit
1013       (
1014        actor => $user,
1015        object => $user,
1016        component => "member:register:created",
1017        msg => "New user created",
1018        level => "info",
1019       );
1020
1021     $self->_send_user_cookie($user);
1022     unless ($nopassword) {
1023       $session->{userid} = $user->id;
1024       my $custom = custom_class($cfg);
1025       if ($custom->can('siteuser_login')) {
1026         $custom->siteuser_login($session->{_session_id}, $session->{userid}, $cfg);
1027       }
1028     }
1029
1030     my $subs = $self->_save_subs($user, $session, $cfg, $cgi);
1031     if ($nopassword) {
1032       return $self->send_conf_request($req, $user);
1033     }
1034     elsif ($subs) {
1035       return if $self->send_conf_request($req, $user, 1);
1036     }
1037     elsif ($cfg->entry('site users', 'notify_register_customer')) {
1038       $user->send_registration_notify
1039         (
1040          remote_addr => $req->ip_address
1041         );
1042     }
1043
1044     _got_user_refresh($session, $cgi, $cfg);
1045
1046     $custom->siteusers_changed($cfg);
1047
1048     if ($cfg->entry('site users', 'notify_register', 0)) {
1049       $self->_notify_registration($req, $user);
1050     }
1051   }
1052   else {
1053     $self->req_show_register($req, $msgs->(regdberr=> "Database error $@"));
1054   }
1055
1056   return;
1057 }
1058
1059 sub iter_usersubs {
1060   my ($user) = @_;
1061
1062   $user->subscribed_services;
1063 }
1064
1065 sub iter_sembookings {
1066   my ($user) = @_;
1067
1068   $user->seminar_bookings_detail;
1069 }
1070
1071 sub tag_order_item_options {
1072   my ($self, $req, $ritem) = @_;
1073
1074   $$ritem
1075     or return "** only usable in the items iterator **";
1076
1077   my $item = $$ritem;
1078   require BSE::Shop::Util;
1079   BSE::Shop::Util->import(qw/order_item_opts nice_options/);
1080   my @options;
1081   if ($item->{options}) {
1082     # old order
1083     require Products;
1084     my $product = Products->getByPkey($item->{productId});
1085
1086     @options = order_item_opts($req, $item, $product);
1087   }
1088   else {
1089     @options = order_item_opts($req, $item);
1090   }
1091
1092   return nice_options(@options);
1093 }
1094
1095 sub iter_orders {
1096   my ($self, $user) = @_;
1097
1098   require BSE::TB::Orders;
1099   return sort { $b->{orderDate} cmp $a->{orderDate}
1100                   || $b->{id} <=> $a->{id} }
1101     grep $_->complete, BSE::TB::Orders->getBy(userId=>$user->{userId});
1102 }
1103
1104 sub iter_order_items {
1105   my ($self, $rorder) = @_;
1106
1107   $$rorder or return "** Not in the order iterator **";
1108
1109   return $$rorder->items;
1110 }
1111
1112 sub iter_orderfiles {
1113   my ($self, $rorder) = @_;
1114
1115   $$rorder or return;
1116
1117   return BSE::DB->query(orderFiles => $$rorder->id);
1118 }
1119
1120 sub _common_tags {
1121   my ($self, $req, $user) = @_;
1122
1123   my $cfg = $req->cfg;
1124
1125   #my $order_index;
1126   #my $item_index;
1127   #my @items;
1128   my $item;
1129   my $product;
1130   #my @files;
1131   #my $file_index;
1132   my $file;
1133   my @orders;
1134   my $order;
1135
1136   my $must_be_paid = $cfg->entryBool('downloads', 'must_be_paid', 0);
1137   my $must_be_filled = $cfg->entryBool('downloads', 'must_be_filled', 0);
1138
1139   my $it = BSE::Util::Iterate->new(req => $req);
1140   return
1141     (
1142      $req->dyn_user_tags(),
1143      user => [ \&tag_hash, $user ],
1144      $it->make
1145      (
1146       data => \@orders,
1147       single => 'order',
1148       plural => 'orders',
1149       #index => \$order_index,
1150       code => [ iter_orders => $self, $user ],
1151       store => \$order,
1152      ),
1153      $it->make
1154      (
1155       single => "item",
1156       plural => "items",
1157       code => [ iter_order_items => $self, \$order ],
1158       store => \$item,
1159       changed => sub {
1160         my ($item) = @_;
1161         if ($item) {
1162           $product = $item->product
1163             or print STDERR "No product found for item $item->{id}\n";
1164         }
1165         else {
1166           undef $product;
1167         }
1168         $req->set_article(product => $product);
1169       },
1170       nocache => 1,
1171      ),
1172      $it->make
1173      (
1174       single => "orderfile",
1175       plural => "orderfiles",
1176       code => [ iter_orderfiles => $self, \$order ],
1177       store => \$file,
1178       nocache => 1,
1179      ),
1180      product => sub {
1181        $item or return "* Not in item iterator *";
1182        $product or return "* No current product *";
1183        return tag_article($product, $cfg, $_[0]);
1184      },
1185      $it->make
1186      (
1187       single => "prodfile",
1188       plural => "prodfiles",
1189       code => [ files => $product ],
1190       store => \$file,
1191       nocache => 1,
1192      ),
1193      ifFileAvail =>
1194      sub {
1195        if ($file) {
1196          return 1 if !$file->{forSale};
1197        }
1198        return 0 if $must_be_paid && !$order->paidFor;
1199        return 0 if $must_be_filled && !$order->filled;
1200        return 1;
1201      },
1202      options => [ tag_order_item_options => $self, $req, \$item ],
1203     );
1204 }
1205
1206 sub req_userpage {
1207   my ($self, $req, $message) = @_;
1208
1209   my $cfg = $req->cfg;
1210   my $cgi = $req->cgi;
1211   my $session = $req->session;
1212
1213   if ($message) {
1214     $message = escape_html($message);
1215   }
1216   else {
1217     $message = $req->message;
1218   }
1219
1220   my $result;
1221   my $user = $self->_get_user($req, 'userpage', \$result)
1222     or return $result;
1223   $message ||= $cgi->param('message') || '';
1224
1225   my $it = BSE::Util::Iterate->new;
1226   my %acts =
1227     (
1228      $self->_common_tags($req, $user),
1229      message => $message,
1230      $it->make_iterator([ \&iter_usersubs, $user ],
1231                         'subscription', 'subscriptions'),
1232      $it->make_iterator([ \&iter_sembookings, $user ],
1233                         'booking', 'bookings'),
1234     );
1235   my $base_template = 'user/userpage';
1236
1237   return $req->dyn_response($base_template, \%acts);
1238 }
1239
1240 sub tag_detail_product {
1241   my ($ritem, $products, $field) = @_;
1242
1243   $$ritem or return '';
1244   my $product = $products->{$$ritem->{productId}}
1245     or return '';
1246
1247   defined $product->{$field} or return '';
1248
1249   return escape_html($product->{$field});
1250 }
1251
1252 sub iter_detail_productfiles {
1253   my ($ritem, $files) = @_;
1254
1255   $$ritem or return;
1256
1257   grep $$ritem->{productId} == $_->{articleId}, @$files;
1258 }
1259
1260 sub tag_detail_ifFileAvail {
1261   my ($order, $rfile, $must_be_paid, $must_be_filled) = @_;
1262
1263   $$rfile or return 0;
1264   $$rfile->{forSale} or return 1;
1265
1266   return 0 if $must_be_paid && !$order->{paidFor};
1267   return 0 if $must_be_filled && !$order->{filled};
1268
1269   return 1;
1270 }
1271
1272 =item orderdetail
1273
1274 Display an order detail for an order for the currently logged in user.
1275
1276 Parameters:
1277
1278 =over
1279
1280 =item *
1281
1282 id - order id (the logged in user must own this order)
1283
1284 =back
1285
1286 See _orderdetail_low for tags.
1287
1288 Template: user/orderdetail
1289
1290 =cut
1291
1292 sub req_orderdetail {
1293   my ($self, $req, $message) = @_;
1294
1295   my $cgi = $req->cgi;
1296
1297   my $result;
1298   my $user = $self->_get_user($req, 'userpage', \$result)
1299     or return $result;
1300   my $order_id = $cgi->param('id');
1301   my $order;
1302   if (defined $order_id && $order_id =~ /^\d+$/) {
1303     require BSE::TB::Orders;
1304     $order = BSE::TB::Orders->getByPkey($order_id);
1305   }
1306   $order->{userId} eq $user->{userId} || $order->{siteuser_id} == $user->{id}
1307     or undef $order;
1308   $order
1309     or return $self->req_userpage($req, "No such order");
1310
1311   return $self->_orderdetail_low($req, $order, $message, "user/orderdetail", 0);
1312 }
1313
1314 =item orderdetaila
1315
1316 =item oda
1317
1318 Display an order detail for an order identified by the order's
1319 randomId.
1320
1321 Parameters:
1322
1323 =over
1324
1325 =item *
1326
1327 id - order randomId
1328
1329 =back
1330
1331 See _orderdetail_low for tags.
1332
1333 Template: user/orderdetaila
1334
1335 =cut
1336
1337 sub req_orderdetaila {
1338   my ($self, $req, $message) = @_;
1339
1340   my $cgi = $req->cgi;
1341
1342   my $result;
1343   my $order_id = $cgi->param('id');
1344   my $order;
1345   if (defined $order_id && $order_id =~ /^[a-f0-9]{32,}$/) {
1346     require BSE::TB::Orders;
1347     ($order) = BSE::TB::Orders->getBy(randomId => $order_id);
1348   }
1349   $order
1350     or return $self->req_show_logon($req, "No such order");
1351
1352   return $self->_orderdetail_low($req, $order, $message, "user/orderdetaila", 1);
1353 }
1354
1355 *req_oda = \&req_orderdetaila;
1356
1357 =item _orderdetail_low
1358
1359 Common tags for orderdetail and orderdetaila.
1360
1361 =over
1362
1363 =item *
1364
1365 order I<field> - field from the order.
1366
1367 =item *
1368
1369 iterator items
1370
1371 =item *
1372
1373 item I<field> - access to the items in the order
1374
1375 =item *
1376
1377 iterator orderfiles
1378
1379 orderfile I<field> - access to files bought in the order.  Note: the
1380 user will need to logon to download forSale files, even from the
1381 anonymous order detail page.
1382
1383 =back
1384
1385 =cut
1386
1387 sub _orderdetail_low {
1388   my ($self, $req, $order, $message, $template, $anon) = @_;
1389
1390   my $cfg = $req->cfg;
1391   my $cgi = $req->cgi;
1392
1393   $message ||= $cgi->param('message') || '';
1394
1395   my $must_be_paid = $cfg->entryBool('downloads', 'must_be_paid', 0);
1396   my $must_be_filled = $cfg->entryBool('downloads', 'must_be_filled', 0);
1397
1398   my @items = $order->items;
1399   my @files = $order->files;
1400   my @products = $order->products;
1401   my %products = map { $_->{id} => $_ } @products;
1402   my $current_item;
1403   my $current_file;
1404
1405   my $it = BSE::Util::Iterate->new;
1406
1407   my %acts;
1408   %acts =
1409     (
1410      $req->dyn_user_tags(),
1411      $order->tags(),
1412      message => sub { escape_html($message) },
1413      ifAnon => !!$anon,
1414     );
1415
1416   return $req->dyn_response($template, \%acts);
1417 }
1418
1419 sub req_download {
1420   my ($self, $req) = @_;
1421
1422   my $cfg = $req->cfg;
1423   my $cgi = $req->cgi;
1424   my $session = $req->session;
1425
1426   my $msgs = BSE::Message->new(cfg=>$cfg, section=>'user');
1427   my $result;
1428   my $user = $self->_get_user($req, 'show_opts', \$result)
1429     or return $result;
1430
1431   my $orderid = $cgi->param('order')
1432     or return _refresh_userpage($cfg, $msgs->('noorderid', "No order id supplied"));
1433   require BSE::TB::Orders;
1434   my $order = BSE::TB::Orders->getByPkey($orderid)
1435     or return _refresh_userpage($cfg, $msgs->('nosuchorder',
1436                                         "No such order $orderid", $orderid));
1437   unless (length $order->{userId}
1438           && $order->{userId} eq $user->{userId}) {
1439     return _refresh_userpage($cfg, $msgs->("notyourorder",
1440                                      "Order $orderid isn't yours", $orderid));
1441   }
1442   my $itemid = $cgi->param('item')
1443     or return _refresh_userpage($cfg, $msgs->('noitemid', "No item id supplied"));
1444   require BSE::TB::OrderItems;
1445   my ($item) = grep $_->{id} == $itemid,
1446   BSE::TB::OrderItems->getBy(orderId=>$order->{id})
1447     or return _refresh_userpage($cfg, $msgs->(notinorder=>"Not part of that order"));
1448   require BSE::TB::ArticleFiles;
1449   my @files = BSE::TB::ArticleFiles->getBy(articleId=>$item->{productId})
1450     or return _refresh_userpage($cfg, $msgs->(nofilesonline=>"No files in this line"));
1451   my $fileid = $cgi->param('file')
1452     or return _refresh_userpage($cfg, $msgs->(nofileid=>"No file id supplied"));
1453   my ($file) = grep $_->{id} == $fileid, @files
1454     or return _refresh_userpage($cfg, $msgs->(nosuchfile=>"No such file in that line item"));
1455
1456   my $must_be_paid = $cfg->entryBool('downloads', 'must_be_paid', 0);
1457   my $must_be_filled = $cfg->entryBool('downloads', 'must_be_filled', 0);
1458   if ($must_be_paid && !$order->{paidFor} && $file->{forSale}) {
1459     return _refresh_userpage($cfg, $msgs->("paidfor",
1460                                      "Order not marked as paid for"));
1461   }
1462   if ($must_be_filled && !$order->{filled} && $file->{forSale}) {
1463     return _refresh_userpage($cfg, $msgs->("filled",
1464                                      "Order not marked as filled"));
1465   }
1466
1467   my $filebase = $cfg->entryVar('paths', 'downloads');
1468   my $filename = "$filebase/$file->{filename}";
1469   -r $filename
1470     or return _refresh_userpage($cfg,
1471                $msgs->(openfile =>
1472                        "Sorry, cannot open that file.  Contact the webmaster.",
1473                        $!));
1474   my %result =
1475     (
1476      # downloads over https of non-HTML to IE causes a confusing error
1477      # if cache-control is "no-cache".  Avoid setting that.
1478      no_cache_dynamic => 0,
1479     );
1480   my @headers;
1481   $result{content_filename} = $filename;
1482   push @headers, "Content-Length: $file->{sizeInBytes}";
1483   if ($file->{download}) {
1484     $result{type} = "application/octet-stream";
1485     push @headers,
1486       qq/Content-Disposition: attachment; filename=$file->{displayName}/;
1487   }
1488   else {
1489     $result{type} = $file->{contentType};
1490     push @headers,
1491       qq/Content-Disposition: inline; filename=$file->{displayName}/;
1492   }
1493   $result{headers} = \@headers;
1494
1495   return \%result;
1496 }
1497
1498 sub req_download_file {
1499   my ($self, $req) = @_;
1500
1501   my ($fileid) = split '/', $self->rest;
1502
1503   my $cfg = $req->cfg;
1504   my $cgi = $req->cgi;
1505   my $session = $req->session;
1506
1507   my $msgs = BSE::Message->new(cfg=>$cfg, section=>'user');
1508   my $userid = $session->{userid};
1509   my $user;
1510   if ($userid) {
1511     $user = SiteUsers->getByPkey($userid);
1512   }
1513   $fileid ||= $cgi->param('file')
1514     or return $self->req_show_logon($req,
1515                          $msgs->('nofileid', "No file id supplied"));
1516   require BSE::TB::ArticleFiles;
1517   my $file;
1518   my $article;
1519   my $article_id = $cgi->param('page');
1520   if ($article_id) {
1521     require Articles;
1522     if ($article_id eq '-1') {
1523       ($file) = grep $_->{name} eq $fileid, Articles->global_files;
1524     }
1525     elsif ($article_id =~ /\A\d+\z/) {
1526       $article = Articles->getByPkey($article_id)
1527         or return $self->req_show_logon($req,
1528                                         $msgs->('nosucharticle', "No such article"));
1529     }
1530     elsif ($article_id =~ /\A[a-zA-Z0-9-_]+\z/) {
1531       ($article) = Articles->getBy(linkAlias => $article_id)
1532         or return $self->req_show_logon($req,
1533                                         $msgs->('nosucharticle', "No such article"));
1534     }
1535     else {
1536       return $self->req_show_logon($req, $msgs->('invalidarticle', "Invalid article id"));
1537     }
1538
1539     ($file) = grep $_->{name} eq $fileid, $article->files;
1540   }
1541   else {
1542     $file = BSE::TB::ArticleFiles->getByPkey($fileid);
1543   }
1544   $file
1545     or return $self->req_show_logon($req,
1546                                       $msgs->('nosuchfile', "No such download"));
1547   $cfg->entryBool('downloads', 'require_logon', 0) && !$user
1548     and return $self->req_show_logon($req,
1549                           $msgs->('downloadlogonall',
1550                                   "You must be logged on to download files"));
1551
1552   $file->{requireUser} && !$user
1553     and return $self->req_show_logon($req,
1554                           $msgs->('downloadlogon',
1555                                   "You must be logged on to download this file"));
1556   if ($file->forSale) {
1557     unless ($user && $file->downloadable_by($user)) {
1558       return $self->req_show_logon($req,
1559                                    $msgs->('downloadforsale',
1560                                            "This file can only be downloaded as part of an order"));
1561     }
1562   }
1563
1564   # check the user has access to this file (RT#531)
1565   if ($file->{articleId} != -1) {
1566     require Articles;
1567     $article ||= Articles->getByPkey($file->{articleId})
1568       or return $self->req_show_logon($req,
1569                                   $msgs->('downloadarticle',
1570                                           "Could not load article for file"));
1571     if ($article->is_dynamic && !$req->siteuser_has_access($article)) {
1572       if ($req->siteuser) {
1573         return $self->req_userpage($req, $msgs->('downloadnoaccess',
1574                                              "You do not have access to this article"));
1575       }
1576       else {
1577         my $cfg = $req->cfg;
1578         my $refresh = "/cgi-bin/user.pl?file=$fileid";
1579         my $logon =
1580           $cfg->entry('site', 'url') . "/cgi-bin/user.pl?show_logon=1&r=".escape_uri($refresh)."&message=You+need+to+logon+download+this+file";
1581         refresh_to($logon);
1582         return;
1583       }
1584     }
1585   }
1586
1587   # this this file is on an external storage, and qualifies for
1588   # external storage send the user to get it from there
1589   if ($file->{src} && $file->{storage} ne 'local'
1590       && !$file->{forSale} && !$file->{requireUser}
1591       && (!$article || !$article->is_access_controlled)) {
1592     refresh_to($file->{src});
1593     return;
1594   }
1595
1596   my $filebase = $cfg->entryVar('paths', 'downloads');
1597   my $filename = "$filebase/$file->{filename}";
1598   -r $filename
1599     or return $self->req_show_logon($req,
1600                $msgs->(openfile =>
1601                        "Sorry, cannot open that file.  Contact the webmaster.",
1602                        $!));
1603
1604   my %result =
1605     (
1606      # downloads over https of non-HTML to IE causes a confusing error
1607      # if cache-control is "no-cache".  Avoid setting that.
1608      no_cache_dynamic => 0,
1609     );
1610   my @headers;
1611   $result{content_filename} = $filename;
1612   push @headers, "Content-Length: $file->{sizeInBytes}";
1613   if ($file->{download}) {
1614     $result{type} = "application/octet-stream";
1615     push @headers,
1616       qq/Content-Disposition: attachment; filename=$file->{displayName}/;
1617   }
1618   else {
1619     $result{type} = $file->{contentType};
1620     push @headers,
1621       qq/Content-Disposition: inline; filename=$file->{displayName}/;
1622   }
1623   $result{headers} = \@headers;
1624
1625   return \%result;
1626 }
1627
1628 sub req_file_metadata {
1629   my ($self, $req) = @_;
1630
1631   my ($fileid, $metaname) = split '/', $self->rest;
1632
1633   my $user = $req->siteuser;
1634   my $cgi = $req->cgi;
1635   $fileid ||= $cgi->param('file')
1636     or return $self->req_show_logon($req, $req->text(nofileid => "No file id supplied"));
1637   $metaname ||= $cgi->param('name')
1638     or return $self->req_show_logon($req, $req->text(nometaname => "No metaname supplied"));
1639   require BSE::TB::ArticleFiles;
1640   my $file = BSE::TB::ArticleFiles->getByPkey($fileid)
1641     or return $self->req_show_logon($req, $req->text(nosuchfile => "No such file"));
1642
1643   if ($file->articleId != -1) {
1644     # check the user has access
1645     my $article = $file->article
1646       or return $self->req_show_logon($req, $req->text(nofilearticle => "No article found for this file"));
1647     if ($article->is_dynamic && !$req->siteuser_has_access($article)) {
1648       if ($req->siteuser) {
1649         return $self->req_userpage($req, $req->text(downloadnoacces => "You do not have access to this article"));
1650       }
1651       else {
1652         return $self->req_show_logon($req, $req->text(needlogon => "You need to logon to download this file"));
1653       }
1654     }
1655   }
1656   my $meta = $file->meta_by_name($metaname)
1657     or return $self->req_show_logon($req, $req->text(nosuchmeta => "There is no metadata by that name for this file"));
1658
1659   my %result =
1660     (
1661      # downloads over https of non-HTML to IE causes a confusing error
1662      # if cache-control is "no-cache".  Avoid setting that.
1663      no_cache_dynamic => 0,
1664
1665      type => $meta->content_type,
1666      content => $meta->value,
1667     );
1668
1669   return \%result;
1670 }
1671
1672 sub req_file_cmetadata {
1673   my ($self, $req) = @_;
1674
1675   my ($fileid, $metaname) = split '/', $self->rest;
1676
1677   my $user = $req->siteuser;
1678   my $cgi = $req->cgi;
1679   $fileid ||= $cgi->param('file')
1680     or return $self->req_show_logon($req, $req->text(nofileid => "No file id supplied"));
1681   $metaname ||= $cgi->param('name')
1682     or return $self->req_show_logon($req, $req->text(nometaname => "No metaname supplied"));
1683   require BSE::TB::ArticleFiles;
1684   my $file = BSE::TB::ArticleFiles->getByPkey($fileid)
1685     or return $self->req_show_logon($req, $req->text(nosuchfile => "No such file"));
1686
1687   if ($file->articleId != -1) {
1688     # check the user has access
1689     my $article = $file->article
1690       or return $self->req_show_logon($req, $req->text(nofilearticle => "No article found for this file"));
1691     if ($article->is_dynamic && !$req->siteuser_has_access($article)) {
1692       if ($req->siteuser) {
1693         return $self->req_userpage($req, $req->text(downloadnoacces => "You do not have access to this article"));
1694       }
1695       else {
1696         return $self->req_show_logon($req, $req->text(needlogon => "You need to logon to download this file"));
1697       }
1698     }
1699   }
1700   my $meta = $file->metacontent(cfg => $req->cfg, name => $metaname)
1701     or return $self->req_show_logon($req, $req->text(nosuchmeta => "There is no metadata by that name for this file"));
1702
1703   return $meta;
1704 }
1705
1706 sub req_show_lost_password {
1707   my ($self, $req, $message) = @_;
1708
1709   my $cfg = $req->cfg;
1710   my $cgi = $req->cgi;
1711   my $session = $req->session;
1712
1713   $message ||= $cgi->param('message') || '';
1714   my $errors;
1715   if (ref $message) {
1716     $errors = $message;
1717     $message = $req->message($errors);
1718   }
1719   elsif ($message) {
1720     $message = escape_html($message);
1721     $errors = {};
1722   }
1723
1724   my %acts;
1725   %acts =
1726     (
1727      $req->dyn_user_tags(),
1728      message => $message,
1729      error_img => [ \&tag_error_img, $cfg, $errors ],
1730     );
1731   BSE::Template->show_page('user/lostpassword', $cfg, \%acts);
1732
1733   return;
1734 }
1735
1736 sub req_lost_password {
1737   my ($self, $req, $message) = @_;
1738
1739   my $cfg = $req->cfg;
1740   my $cgi = $req->cgi;
1741   my $session = $req->session;
1742
1743   my $msgs = BSE::Message->new(cfg=>$cfg, section=>'user');
1744   my $userid = $cgi->param('userid');
1745   my %errors;
1746
1747   unless (defined $userid && length $userid) {
1748     $errors{userid} = $msgs->(lostnouserid=> "Please enter your username");
1749   }
1750
1751   my $user;
1752   unless (keys %errors) {
1753     $user = SiteUsers->getBy(userId=>$userid)
1754       or $errors{userid} = $msgs->(lostnosuch=> "Unknown username supplied", $userid);
1755   }
1756   keys %errors
1757     and return $self->req_show_lost_password($req, \%errors);
1758
1759   my $error;
1760   my $email_user = $user->lost_password(\$error)
1761     or return $self->req_show_lost_password
1762       ($req, $msgs->(lostmailerror=> "Email error: .$error", $error));
1763   $message = $message ? escape_html($message) : $req->message;
1764   my %acts;
1765   %acts =
1766     (
1767      message => $message,
1768      $req->dyn_user_tags(),
1769      user => sub { escape_html($user->{$_[0]}) },
1770      emailuser => [ \&tag_hash, $email_user ],
1771     );
1772   BSE::Template->show_page('user/lostemailsent', $cfg, \%acts);
1773
1774   return;
1775 }
1776
1777 sub req_subinfo {
1778   my ($self, $req) = @_;
1779
1780   my $cfg = $req->cfg;
1781   my $cgi = $req->cgi;
1782   my $session = $req->session;
1783
1784   my $id = $cgi->param('id')
1785     or return $self->show_opts($req, "No subscription id parameter");
1786   my $sub = BSE::SubscriptionTypes->getByPkey($id)
1787     or return $self->show_opts($req, "Unknown subscription id");
1788   my %acts;
1789   %acts =
1790     (
1791      $req->dyn_user_tags(),
1792      subscription=>sub { escape_html($sub->{$_[0]}) },
1793     );
1794   BSE::Template->show_page('user/subdetail', $cfg, \%acts);
1795
1796   return;
1797 }
1798
1799 sub req_nopassword {
1800   my ($self, $req) = @_;
1801
1802   my $cfg = $req->cfg;
1803   my $cgi = $req->cgi;
1804   my $session = $req->session;
1805
1806   my %acts;
1807   %acts =
1808     (
1809      $req->dyn_user_tags(),
1810     );
1811   BSE::Template->show_page('user/nopassword', $cfg, \%acts);
1812
1813   return;
1814 }
1815
1816 sub req_blacklist {
1817   my ($self, $req) = @_;
1818
1819   my $cfg = $req->cfg;
1820   my $cgi = $req->cgi;
1821   my $session = $req->session;
1822
1823   my $msgs = BSE::Message->new(cfg=>$cfg, section=>'user');
1824   my $email = $cgi->param('blacklist')
1825     or return $self->req_show_logon($req,
1826                                 $msgs->(blnoemail=>"No email supplied"));
1827   my $genemail = _generic_email($email);
1828
1829   my %acts;
1830   %acts =
1831     (
1832      $req->dyn_user_tags(),
1833      email => sub { escape_html($email) },
1834     );
1835   require BSE::EmailBlacklist;
1836   my $black = BSE::EmailBlacklist->getEntry($genemail);
1837   if ($black) {
1838     BSE::Template->show_page('user/alreadyblacklisted', $cfg, \%acts);
1839     return;
1840   }
1841   my %black;
1842   my @cols = BSE::EmailBlackEntry->columns;
1843   shift @cols;
1844   $black{email} = $genemail;
1845   $black{why} = "Web request from $ENV{REMOTE_ADDR}";
1846   $black = BSE::EmailBlacklist->add(@black{@cols});
1847   BSE::Template->show_page('user/blacklistdone', $cfg, \%acts);
1848
1849   return;
1850 }
1851
1852 sub req_confirm {
1853   my ($self, $req) = @_;
1854
1855   my $cfg = $req->cfg;
1856   my $cgi = $req->cgi;
1857   my $session = $req->session;
1858
1859   my $msgs = BSE::Message->new(cfg=>$cfg, section=>'user');
1860   my $secret = $cgi->param('confirm')
1861     or return $self->req_show_logon($req,
1862                                 $msgs->(confnosecret=>"No secret supplied for confirmation"));
1863   my $userid = $cgi->param('u')
1864     or return $self->req_show_logon($req,
1865                                 $msgs->(confnouser=>"No user id supplied for confirmation"));
1866   if ($userid + 0 != $userid || $userid < 1) {
1867     return $self->req_show_logon($req,
1868                              $msgs->(confbaduser=>"Invalid or unknown user id supplied for confirmation"));
1869   }
1870   my $user = SiteUsers->getByPkey($userid)
1871     or return $self->req_show_logon($req,
1872                              $msgs->(confbaduser=>"Invalid or unknown user id supplied for confirmation"));
1873   unless ($secret eq $user->{confirmSecret}) {
1874     return $self->req_show_logon($req,
1875                              $msgs->(confbadsecret=>"Sorry, the confirmation secret does not match"));
1876   }
1877
1878   $user->{confirmed} = 1;
1879   # I used to reset this, but it doesn't really make sense
1880   # $user->{confirmSecret} = '';
1881   $user->save;
1882   my $genEmail = _generic_email($user->{email});
1883   my $request = BSE::EmailRequests->getBy(genEmail=>$genEmail);
1884   $request and $request->remove();
1885   my %acts;
1886   %acts =
1887     (
1888      $req->dyn_user_tags(),
1889      user=>sub { escape_html($user->{$_[0]}) },
1890     );
1891   BSE::Template->show_page('user/confirmed', $cfg, \%acts);
1892
1893   return;
1894 }
1895
1896 sub _generic_email {
1897 #  SiteUser->generic_email(shift);
1898   my ($checkemail) = @_;
1899
1900   # Build a generic form for the email - since an attacker could
1901   # include comments or extra spaces or a bunch of other stuff.
1902   # this isn't strictly correct, but it's good enough
1903   1 while $checkemail =~ s/\([^)]\)//g;
1904   if ($checkemail =~ /<([^>]+)>/) {
1905     $checkemail = $1;
1906   }
1907   $checkemail = lc $checkemail;
1908   $checkemail =~ s/\s+//g;
1909
1910   $checkemail;
1911 }
1912
1913 # returns non-zero if a page was generated
1914 sub send_conf_request {
1915   my ($self, $req, $user, $suppress_success) = @_;
1916
1917   my $cfg = $req->cfg;
1918   my $cgi = $req->cgi;
1919   my $session = $req->session;
1920
1921   my $nopassword = $cfg->entryBool('site users', 'nopassword', 0);
1922
1923   # check for existing in-progress confirmations
1924   my $checkemail = _generic_email($user->{email});
1925
1926   # check the blacklist
1927   require 'BSE/EmailBlacklist.pm';
1928
1929   my %acts;
1930   %acts =
1931     (
1932      $req->dyn_user_tags(),
1933      user=>sub { escape_html($user->{$_[0]}) },
1934     );
1935
1936   # check that the from address has been configured
1937   my $from = $cfg->entry('confirmations', 'from') ||
1938     $cfg->entry('basic', 'emailfrom')|| $SHOP_FROM;
1939   unless ($from) {
1940     $acts{mailerror} = sub { escape_html("Configuration Error: The confirmations from address has not been configured") };
1941     BSE::Template->show_page('user/email_conferror', $cfg, \%acts);
1942     return 1;
1943   }
1944
1945   my $blackentry = BSE::EmailBlacklist->getEntry($checkemail);
1946
1947   if ($blackentry) {
1948     $acts{black} = sub { escape_html($blackentry->{$_[0]}) },
1949     BSE::Template->show_page('user/blacklisted', $cfg, \%acts);
1950     return 1;
1951   }
1952
1953   unless ($user->{confirmSecret}) {
1954     use BSE::Util::Secure qw/make_secret/;
1955     # print STDERR "Generating secret\n";
1956     $user->{confirmSecret} = make_secret($cfg);
1957     $user->save;
1958   }
1959
1960   # check for existing confirmations
1961   my $confirm = BSE::EmailRequests->getBy(genEmail=>$checkemail);
1962   if ($confirm) {
1963     $acts{confirm} = sub { escape_html($confirm->{$_[0]}) };
1964     my $too_many = $confirm->{unackedConfMsgs} >= MAX_UNACKED_CONF_MSGS;
1965     $acts{ifTooMany} = sub { $too_many };
1966     use BSE::Util::SQL qw/sql_datetime_to_epoch/;
1967     my $lastSentEpoch = sql_datetime_to_epoch($confirm->{lastConfSent});
1968     my $too_soon = $lastSentEpoch + MIN_UNACKED_CONF_GAP > time;
1969     $acts{ifTooSoon} = sub { $too_soon };
1970     # check how many
1971     if ($too_many) {
1972       BSE::Template->show_page('user/toomany', $cfg, \%acts);
1973       return 1;
1974     }
1975     if ($too_soon) {
1976       BSE::Template->show_page('user/toosoon', $cfg, \%acts);
1977       return 1;
1978     }
1979   }
1980   else {
1981     my %confirm;
1982     my @cols = BSE::EmailRequest->columns;
1983     shift @cols;
1984     $confirm{email} = $user->{email};
1985     $confirm{genEmail} = $checkemail;
1986     # prevents silliness on error
1987     use BSE::Util::SQL qw(sql_datetime);
1988     $confirm{lastConfSent} = sql_datetime(time - MIN_UNACKED_CONF_GAP);
1989     $confirm{unackedConfMsgs} = 0;
1990     $confirm = BSE::EmailRequests->add(@confirm{@cols});
1991   }
1992
1993   # ok, now we can send the confirmation request
1994   my %confacts;
1995   %confacts =
1996     (
1997      BSE::Util::Tags->basic(\%acts, $cgi, $cfg),
1998      user => sub { $user->{$_[0]} },
1999      confirm => sub { $confirm->{$_[0]} },
2000      remote_addr => sub { $ENV{REMOTE_ADDR} },
2001     );
2002   my $email_template =
2003     $nopassword ? 'user/email_confirm_nop' : 'user/email_confirm';
2004
2005   require BSE::ComposeMail;
2006   my $mail = BSE::ComposeMail->new(cfg => $cfg);
2007
2008   my $subject = $cfg->entry('confirmations', 'subject')
2009     || 'Subscription Confirmation';
2010   unless ($mail->send(template => $email_template,
2011         acts => \%confacts,
2012         from=>$from,
2013         to=>$user->{email},
2014         subject=>$subject)) {
2015     # a problem sending the mail
2016     $acts{mailerror} = sub { escape_html($mail->errstr) };
2017     BSE::Template->show_page('user/email_conferror', $cfg, \%acts);
2018     return;
2019   }
2020   ++$confirm->{unackedConfMsgs};
2021   $confirm->{lastConfSent} = now_datetime;
2022   $confirm->save;
2023   return 0 if $suppress_success;
2024   BSE::Template->show_page($nopassword ? 'user/confsent_nop' : 'user/confsent', $cfg, \%acts);
2025
2026   return 1;
2027 }
2028
2029 sub req_unsub {
2030   my ($self, $req) = @_;
2031
2032   my $cfg = $req->cfg;
2033   my $cgi = $req->cgi;
2034   my $session = $req->session;
2035
2036   my $msgs = BSE::Message->new(cfg=>$cfg, section=>'user');
2037   my $secret = $cgi->param('unsub')
2038     or return $self->req_show_logon($req,
2039                                 $msgs->(unsubnosecret=>"No secret supplied for unsubscribe"));
2040   my $userid = $cgi->param('u')
2041     or return $self->req_show_logon($req,
2042                                 $msgs->(unsubnouser=>"No user supplied for unsubscribe"));
2043   if ($userid + 0 != $userid || $userid < 1) {
2044     return $self->req_show_logon($req,
2045                              $msgs->(unsubbaduser=>"Invalid or unknown username supplied for unsubscribe"));
2046   }
2047   my $user = SiteUsers->getByPkey($userid)
2048     or return $self->req_show_logon($req,
2049                              $msgs->(unsubbaduser=>"Invalid or unknown username supplied for unsubscribe"));
2050   unless ($secret eq $user->{confirmSecret}) {
2051     return $self->req_show_logon($req,
2052                              $msgs->(unsubbadsecret=>"Sorry, the ubsubscribe secret does not match"));
2053
2054   }
2055
2056   my %acts;
2057   %acts =
2058     (
2059      $req->dyn_user_tags(),
2060      user => sub { escape_html($user->{$_[0]}) },
2061     );
2062   my $subid = $cgi->param('s');
2063   my $sub;
2064   if ($subid eq 'all') {
2065     $user->removeSubscriptions();
2066     BSE::Template->show_page('user/unsuball', $cfg, \%acts);
2067   }
2068   elsif (0+$subid eq $subid
2069          and $sub = BSE::SubscriptionTypes->getByPkey($subid)) {
2070     $acts{subscription} = sub { escape_html($sub->{$_[0]}) };
2071     $user->removeSubscription($subid);
2072     BSE::Template->show_page('user/unsubone', $cfg, \%acts);
2073   }
2074   else {
2075     BSE::Template->show_page('user/cantunsub', $cfg, \%acts);
2076   }
2077
2078   return;
2079 }
2080
2081 sub _validate_affiliate_name {
2082   my ($cfg, $aff_name, $errors, $msgs, $user) = @_;
2083
2084   my $display = $cfg->entry('site users', 'display_affiliate_name',
2085                             "Affiliate name");
2086   my $required = $cfg->entry('site users', 'require_affiliate_name', 0);
2087
2088   if (defined $aff_name) {
2089     $aff_name =~ s/^\s+|\s+$//g;
2090     if (length $aff_name) {
2091       if ($aff_name =~ /^\w+$/) {
2092         my $other = SiteUsers->getBy(affiliate_name => $aff_name);
2093         if ($other && (!$user || $other->{id} != $user->{id})) {
2094           $errors->{affiliate_name} = $msgs->(dupaffiliatename =>
2095                                             "$display '$aff_name' is already in use", $aff_name);
2096         }
2097         else {
2098           return $aff_name;
2099         }
2100       }
2101       else {
2102         $errors->{affiliate_name} = $msgs->(badaffiliatename =>
2103                                           "Invalid $display, no spaces or special characters are allowed");
2104       }
2105     }
2106     elsif ($required) {
2107       $errors->{affiliate_name} = $msgs->("optsrequired" =>
2108                                           "$display is a required field",
2109                                           "affiliate_name", $display);
2110     }
2111     else {
2112       return '';
2113     }
2114   }
2115
2116   # always required if making a new user
2117   if (!$errors->{affiliate_name} && $required && !$user) {
2118     $errors->{affiliate_name} = $msgs->("optsrequired" =>
2119                                         "$display is a required field",
2120                                         "affiliate_name", $display);
2121   }
2122
2123   return;
2124 }
2125
2126 sub req_image {
2127   my ($self, $req) = @_;
2128
2129   my $cfg = $req->cfg;
2130   my $cgi = $req->cgi;
2131   my $session = $req->session;
2132
2133   my $u = $cgi->param('u');
2134   my $i = $cgi->param('i');
2135   defined $u && $u =~ /^\d+$/ && defined $i && $i =~ /^\w+$/
2136     or return $self->req_show_logon($req, "Missing or bad image parameter");
2137
2138   my $user = SiteUsers->getByPkey($u)
2139     or return $self->req_show_logon($req, "Missing or bad image parameter");
2140   my $image = $user->get_image($i)
2141     or return $self->req_show_logon($req, "Unknown image id");
2142   my $image_dir = $cfg->entryVar('paths', 'siteuser_images');
2143
2144   my $filename = "$image_dir/$image->{filename}";
2145   -r $filename
2146     or return $self->req_show_logon($req, "Image file missing");
2147   my %result =
2148     (
2149      type => $image->{content_type},
2150      content_filename => $filename,
2151      headers =>
2152      [
2153       "Content-Length: $image->{bytes}",
2154      ],
2155     );
2156
2157   return \%result;
2158 }
2159
2160 sub _notify_registration {
2161   my ($self, $req, $user) = @_;
2162
2163   my $cfg = $req->cfg;
2164
2165   my $email = $cfg->entry('site users', 'notify_register_email',
2166                           $Constants::SHOP_FROM);
2167   $email ||= $cfg->entry('shop', 'from');
2168   unless ($email) {
2169     print STDERR "No email configured for notify_register, set [site users].notify_register_email\n";
2170     return;
2171   }
2172   print STDERR "email $email\n";
2173
2174   my $subject = $cfg->entry('site users', 'notify_register_subject',
2175                             "New user {userId} registered");
2176
2177   $subject =~ s/\{(\w+)\}/defined $user->{$1} ? $user->{$1} : "** $1 unknown **"/ge;
2178   $subject =~ tr/ -~//cd;
2179   substr($subject, 80) = '...' if length $subject > 80;
2180
2181   my %acts;
2182   %acts =
2183     (
2184      $req->dyn_user_tags(),
2185      user => [ \&tag_hash_plain, $user ],
2186     );
2187
2188   require BSE::ComposeMail;
2189   my $mailer = BSE::ComposeMail->new(cfg => $cfg);
2190   $mailer->send(template => 'admin/registeremail',
2191                 acts => \%acts,
2192                 to => $email,
2193                 from => $email,
2194                 subject => $subject,
2195                 log_object => $user,
2196                 log_msg => "Notify admin of user registration to $email",
2197                 log_component => "member:register:notifyadmin");
2198 }
2199
2200 #sub error {
2201 #  my ($self, $req, $error) = @_;
2202 #
2203 #  my $result = $self->SUPER::error($req, $error);
2204 #
2205 #  BSE::Template->output_result($req, $result);
2206 #}
2207
2208 =item req_wishlist
2209
2210 =target a_wishlist
2211
2212 Display a given user's wishlist.
2213
2214 Parameters:
2215
2216 =over
2217
2218 =item *
2219
2220 user - user logon of the user to display the wishlist for
2221
2222 =back
2223
2224 Template: user/wishlist.tmpl
2225
2226 Tags:
2227
2228 =cut
2229
2230 sub req_wishlist {
2231   my ($self, $req) = @_;
2232
2233   my $user_id = $req->cgi->param('user');
2234
2235   defined $user_id && length $user_id
2236     or return $self->error($req, "Invalid or missing user id");
2237
2238   my $custom = custom_class($req->cfg);
2239
2240   my $user = SiteUsers->getBy(userId => $user_id)
2241     or return $self->error($req, "No such user $user_id");
2242
2243   my $curr_user = $req->siteuser;
2244
2245   $custom->can_user_see_wishlist($user, $curr_user, $req)
2246     or return $self->error($req, "Sorry, you cannot see ${user_id}'s wishlist");
2247
2248   my @wishlist = $user->wishlist;
2249
2250   my %acts;
2251   my $it = BSE::Util::Iterate::Article->new(req => $req);
2252   %acts =
2253     (
2254      $req->dyn_user_tags(),
2255      $it->make_iterator(undef, 'uwishlistentry', 'uwishlist', \@wishlist),
2256      wuser => [ \&tag_hash, $user ],
2257     );
2258
2259   my $template = 'user/wishlist';
2260   my $t = $req->cgi->param('_t');
2261   if ($t && $t =~ /^\w+$/ && $t ne 'base') {
2262     $template .= "_$t";
2263   }
2264
2265   BSE::Template->show_page($template, $req->cfg, \%acts);
2266
2267   return;
2268 }
2269
2270 =item req_downufile
2271
2272 =target a_downufile
2273
2274 Download a user file.
2275
2276 =cut
2277
2278 sub req_downufile {
2279   my ($self, $req) = @_;
2280
2281   require BSE::TB::OwnedFiles;
2282   my $cgi = $req->cgi;
2283   my $cfg = $req->cfg;
2284   my $id = $cgi->param("id");
2285   defined $id && $id =~ /^\d+$/
2286     or return $self->error($req, "Invalid or missing file id");
2287
2288   # return the same error to avoid giving someone a mechanism to find
2289   # which files are in use
2290   my $file = BSE::TB::OwnedFiles->getByPkey($id)
2291     or return $self->error($req, "Invalid or missing file id");
2292
2293   my $result;
2294   my $user = $self->_get_user($req, 'downufile', \$result)
2295     or return $result;
2296
2297   require BSE::TB::SiteUserGroups;
2298   my $accessible = 0;
2299   if ($file->owner_type eq $user->file_owner_type) {
2300     $accessible = $user->id == $file->owner_id;
2301   }
2302   elsif ($file->owner_type eq BSE::TB::SiteUserGroup->file_owner_type) {
2303     my $owner_id = $file->owner_id;
2304     my $group = $owner_id < 0
2305       ? BSE::TB::SiteUserGroups->getQueryGroup($cfg, $owner_id)
2306       : BSE::TB::SiteUserGroups->getByPkey($owner_id);
2307     if ($group) {
2308       $accessible = $group->contains_user($user);
2309     }
2310     else {
2311       print STDERR "** downufile: unknown group id ", $file->owner_id, " in file ", $file->id, "\n";
2312     }
2313   }
2314   else {
2315     print STDERR "** downufile: Unknown file owner type ", $file->owner_type, " in file ", $file->id, "\n";
2316     $accessible = 0;
2317   }
2318
2319   $accessible
2320     or return $self->error($req, "Sorry, you don't have access to this file");
2321
2322   my $msg;
2323   return $file->download_result
2324     (
2325      cfg => $req->cfg,
2326      download => scalar($cgi->param("force_download")),
2327      msg => \$msg,
2328      user => $user,
2329     )
2330       or return $self->error($req, $msg);
2331 }
2332
2333 sub req_lost {
2334   my ($self, $req, $errors) = @_;
2335
2336   my ($id) = $self->rest;
2337   $id ||= $req->cgi->param("id");
2338   $id
2339     or return $self->req_show_logon($req, $req->catmsg("msg:bse/user/nolostid"));
2340
2341   my $error;
2342   my $user = SiteUsers->lost_password_next($id, \$error)
2343     or return $self->req_show_logon($req, { _ => "msg:bse/user/lost/$error" });
2344
2345   my $message = $req->message($errors);
2346
2347   my %acts =
2348     (
2349      $req->dyn_user_tags,
2350      lostid => $id,
2351      error_img => [ \&tag_error_img, $req->cfg, $errors ],
2352      message => $message,
2353     );
2354
2355   return $req->response("user/lost_prompt", \%acts);
2356 }
2357
2358 my %lost_fields =
2359   (
2360    password =>
2361    {
2362     description => "New Password",
2363     required => 1,
2364    },
2365    confirm =>
2366    {
2367     description => "Confirm Password",
2368     rules => "confirm",
2369     required => 1,
2370    },
2371   );
2372
2373 sub req_lost_save {
2374   my ($self, $req) = @_;
2375
2376   my ($id) = $self->rest;
2377   $id ||= $req->cgi->param("id");
2378   $id
2379     or return $self->req_show_logon($req, $req->catmsg("msg:bse/user/nolostid"));
2380
2381   my %errors;
2382   $req->validate(fields => \%lost_fields,
2383                  errors => \%errors);
2384   my $password = $req->cgi->param("password");
2385   unless ($errors{password}) {
2386     my $error;
2387     unless (SiteUser->check_password_rules($password, \$error)) {
2388       my ($errorid, @more) = @$error;
2389       $errors{password} = $req->catmsg("msg:bse/user/$errorid", \@more)
2390     }
2391   }
2392
2393   keys %errors
2394     and return $self->req_lost($req, \%errors);
2395
2396   my $error;
2397
2398   my $user = SiteUsers->lost_password_save($id, $password, \$error)
2399     or return $self->req_show_logon($req, "msg:bse/user/lost/$error");
2400
2401   $req->flash("msg:bse/user/lostsaved");
2402
2403   return $req->get_refresh($req->cfg->user_url("user", "show_logon"));
2404 }
2405
2406
2407
2408 1;