# ================================================================== # Gossamer List - enhanced mailing list management system # # Website : http://gossamer-threads.com/ # Support : http://gossamer-threads.com/scripts/support/ # CVS Info : # Revision : $Id: User.pm,v 1.47.2.1 2004/10/14 23:29:05 bao Exp $ # # Copyright (c) 2004 Gossamer Threads Inc. All Rights Reserved. # Redistribution in part or in whole strictly prohibited. Please # see LICENSE file for full details. # ================================================================== # package GList::User; # ================================================================== use strict; use GList qw/:objects :user_type $DEBUG/; use GT::AutoLoader; sub process { #------------------------------------------------------------------- # Determine what to do # my $do = shift; my $action = _determine_action($do) or die "Error: Invalid Action! ($do)"; my ($tpl, $results) = GT::Plugins->dispatch($CFG->{priv_path}.'/lib/GList/Plugins', $action, \&$action); $tpl ||= 'user_login.html'; GList::display($tpl, $results); } $COMPILE{user_click} = __LINE__ . <<'END_OF_SUB'; sub user_click { #-------------------------------------------------------------------- # Track number of clicks # my $id = $IN->param('mailing'); my $url = $IN->param('url') || "$CFG->{cgi_url}/glist.cgi"; my $db = $DB->table('MailingIndex'); if ($db->count({ mli_id => $id })) { $db->update({ mli_num_clicked => \'mli_num_clicked + 1' }, { mli_id => $id }); } print $IN->header( -url => $url ); return; } END_OF_SUB $COMPILE{user_open} = __LINE__ . <<'END_OF_SUB'; sub user_open { #-------------------------------------------------------------------- # Track number of users who open message # my $code = $IN->param('eml_code'); my $mailing = $IN->param('mailing'); my $db = $DB->table('EmailMailings'); if ($code and $mailing and $db->count({ eml_mailing_id_fk => $mailing, eml_code => $code, eml_opened => 0 })) { $db->update({ eml_opened => time }, { eml_mailing_id_fk => $mailing, eml_code => $code }); $DB->table('MailingIndex')->update({ mli_num_opened => \'mli_num_opened + 1' }, { mli_id => $mailing }); } if (open DATA, "$CFG->{image_path}/pics/1pixel.gif") { print $IN->header({ '-type' => 'image/gif', '-Content-Length' => -s "$CFG->{image_path}/pics/1pixel.gif", }); binmode STDOUT; binmode DATA; my $buffer; print $buffer while (read(DATA, $buffer, 50000)); close DATA; } return; } END_OF_SUB $COMPILE{user_signup} = __LINE__ . <<'END_OF_SUB'; sub user_signup { # ------------------------------------------------------------------- # User Sign-up # return ('user_login.html', { msg => GList::language('USR_SIGNUP_DISABLE') }) if (!$CFG->{signup_enable}); return ('user_signup.html') if ($IN->param('form')); my $cgi = $IN->get_hash(); my $error = _signup_check($cgi); return ('user_signup.html', { msg => $error }) if ($error); $cgi->{usr_password} = GList::encrypt($cgi->{usr_password}); $cgi->{usr_date_format}||= "%yyyy%-%mm%-%dd%"; $cgi->{usr_bounce_email} = $cgi->{usr_email}; $cgi->{usr_reply_email} = $cgi->{usr_email}; $cgi->{usr_limit_list} = $CFG->{signup_limit_list} || 10; $cgi->{usr_limit_sublist}= $CFG->{signup_limit_sublist} || 10; $cgi->{usr_limit_email30}= $CFG->{signup_limit_email30} || 100; $cgi->{usr_type} = (!$CFG->{signup_email_validate} and !$CFG->{signup_admin_validate}) ? LIMITED_USER : UNVALIDATED_USER; my $info = $cgi; # if it requires email validate if ($CFG->{signup_email_validate}) { my $val_code = join '', ('a'..'z', 'A'..'Z', 0..9)[map rand(62), 1 .. 30]; $cgi->{usr_validate_code} = "GT$val_code"; $info->{validate_code} = $val_code; } GList::add('Users', 'usr', $cgi); return ('user_signup.html', { msg => "$GList::error" }) if ($GList::error); # Send a validate email my $msg = GList::language('USR_SIGNUP_SUCCESSFUL'); if ($CFG->{signup_email_validate}) { foreach (keys %{$CFG->{admin}}) { next if (!$_); $info->{admin_email} = $CFG->{admin}->{$_}->[1]; last; } my ($head, $body) = _parse_file('account_validation.eml', $info); GList::send($head, { text => $body }); $msg = GList::language('USR_SIGNUP_EMAIL_SUCCESSFUL'); } return ('user_login.html', { msg => $msg }); } END_OF_SUB $COMPILE{user_account_validate} = __LINE__ . <<'END_OF_SUB'; sub user_account_validate { #---------------------------------------------------------- # User validate # my $id = $IN->param('id'); my $db = $DB->table('Users'); my $found= $db->count({ usr_validate_code => $id }); return ('user_login.html', { msg => GList::language('USR_VALIDATE_FAILED') }) unless ($found); # if it requires admin validate my %hash = (usr_validate_code => '', usr_type => LIMITED_USER); if ($CFG->{signup_admin_validate}) { $hash{usr_type} = UNVALIDATED_USER; } $db->update(\%hash, { usr_validate_code => $id }); return ('user_login.html', { msg => GList::language('USR_VALIDATE_SUCCESSFUL') }); } END_OF_SUB $COMPILE{user_login} = __LINE__ . <<'END_OF_SUB'; sub user_login { # -------------------------------------------------------- # Logs a user in, and creates a session ID. # if (!defined $IN->param('username') or !defined $IN->param('password')) { return ('user_login.html', { msg => GList::language('LOG_IN', GList::_load_global('site_title')) }); } my $username = $IN->param('username') || shift; my $password = $IN->param('password') || shift; # Make sure we have both a username and password. return ('user_login.html', { msg => GList::language('LOG_ERROR') }) if (!$username or !$password); unless (GList::test_connection()) { # Database connection is failed if (GList::Authenticate::auth('admin_valid_user', { username => $username, password => $password })) { my $session = GList::Authenticate::auth('admin_create_session', { username => $username }); if ($session) { $USER->{admin_user} = $username; $USER->{admin_pass} = $password; $USER->{session_id} = $session->{session_id}; $USER->{use_cookie} = $session->{use_cookie}; require GList::Admin; return GList::Admin::admin_initial_sql(); } } return ('user_login.html', { msg => GList::language('LOG_ERROR') }); } # Check that the user exists, and that the password is valid. my $user = GList::init_user($username, $password); return ('user_login.html', { msg => GList::language('LOG_DEACTIVATE') }) if ($user and $user == 1); return ('user_login.html', { msg => GList::language('LOG_NOT_EMAIL_VALIDATED') }) if ($user and $user == 2); return ('user_login.html', { msg => GList::language('LOG_NOT_ADMIN_VALIDATED') }) if ($user and $user == 3); return ('user_login.html', { msg => GList::language('LOG_ERROR') }) if (ref $user ne 'HASH'); # Store the session in either a cookie or url based. my $results = GList::Authenticate::auth('create_session', { username => $user->{usr_username} }); return ('user_login.html', { msg => "$results->{error}" }) if ($results->{error}); $USER->{session_id} = $results->{session_id}; $USER->{use_cookie} = $results->{use_cookie}; _cleanup_files(); if ($USER->{usr_updated}) { $MN_SELECTED = 1; require GList::Message; return GList::Message::msg_home(GList::language('LOG_WELCOME', "$USER->{pro_first_name} $USER->{pro_last_name}")); } else { $MN_SELECTED = 5; require GList::Profile; return GList::Profile::pro_profile(GList::language('LOG_UPDATE_REMIND')); } } END_OF_SUB $COMPILE{user_logout} = <<'END_OF_SUB'; sub user_logout { #----------------------------------------------------------- # require GList::Authenticate; GList::Authenticate::auth('delete_session'); return ('user_login.html', { msg => GList::language('LOG_LOGGED_OFF', GList::_load_global('site_title')) }); } END_OF_SUB $COMPILE{user_remind} = __LINE__ . <<'END_OF_SUB'; sub user_remind { #--------------------------------------------------------- # Send password to a user # #------------demo code----------- return ('user_remind_form.html') if (!defined $IN->param('email')); my $email = $IN->param('email'); return ('user_remind_form.html', { msg => GList::language('LOG_REM_ERROR') }) unless ($email); my $db = $DB->table('Users'); my $user = $db->get({ usr_email => $email }); return ('user_remind_form.html', { msg => GList::language('LOG_REM_NOT_FOUND') }) if (!$user); # Get Administrator info my $info; my $admin = $db->get({ usr_type => LIMITED_USER }); if ($admin) { $info->{admin_email} = $admin->{usr_email}; } my @letters = (0 .. 9, 'a' .. 'z', 'A' .. 'Z'); my $temp = ''; for (1 .. 6) { $temp .= $letters[rand @letters]; } my $temp_enc = GList::encrypt($temp); $db->update({ usr_password => $temp_enc }, { usr_username => $user->{usr_username} }); $info->{usr_username} = $user->{usr_username}; $info->{usr_email} = $user->{usr_email}; $info->{usr_password} = $temp; $info->{usr_name} = "$user->{pro_first_name} $user->{pro_last_name}"; $info->{usr_name} ||= $user->{usr_username}; my ($head, $body) = _parse_file('remindme.eml', $info); GList::send($head, { text => $body }); return ('user_login.html', { msg => GList::language('LOG_REM_SUCCESS', $email) }); } END_OF_SUB $COMPILE{user_validate} = __LINE__ . <<'END_OF_SUB'; sub user_validate { #----------------------------------------------------------- # Validate a subscriber # my $admin = $db->get({ usr_type => LIMITED_USER }); if ($admin) { $info->{admin_email} = $admin->{usr_email}; } my @letters = (0 .. 9, 'a' .. 'z', 'A' .. 'Z'); my $temp = ''; for (1 .. 6) { $temp .= $letters[rand @letters]; } my $temp_enc = GList::encrypt($temp); $db->update({ usr_password => $temp_enc }, { usr_username => $user->{usr_username} }); $info->{usr_username} = $user->{usr_username}; $info->{usr_email} = $user->{usr_email}; $info->{usr_password} = $temp; $info->{usr_name} = "$user->{pro_first_name} $user->{pro_last_name}"; $info->{usr_name} ||= $user->{usr_username}; my ($head, $body) = _parse_file('remindme.eml', $info); GList::send($head, { text => $body }); return ('user_login.html', { msg => GList::language('LOG_REM_SUCCESS', $email) }); } END_OF_SUB $COMPILE{user_validate} = __LINE__ . <<'END_OF_SUB'; sub user_validate { #----------------------------------------------------------- # Validate a subscriber # #------------demo code----------- my $id = $IN->param('id'); my $db = $DB->table('Subscribers'); my $info = $db->get({ sub_val_code => $id }); return ('error_form.html', { msg => GList::language('LOG_VAL_ERROR') }) if (!$info); return ('error_form.html', { msg => GList::language('LOG_VAL_ERROR2') }) if ($info->{sub_validated}); $db->update({ sub_validated => '1' }, { sub_val_code => $id }); my $lst_info = $DB->table('Lists')->get($info->{sub_list_id_fk}); return ('user_success_form.html', { msg => GList::language('LOG_VALIDATED') }) if (!$lst_info->{lst_url_validate_success}); print $IN->header( -url => $lst_info->{lst_url_validate_success} ); return; } END_OF_SUB $COMPILE{user_subscribe} = __LINE__ . <<'END_OF_SUB'; sub user_subscribe { #----------------------------------------------------------- # Subscribe a email address # my $url_success = "$CFG->{image_url}/page_subscribe_success.html"; my $url_failure = "$CFG->{image_url}/page_subscribe_failure.html"; my $cgi = $IN->get_hash(); my $demo = 0; return ('error_form.html', { msg => GList::language('LOG_SUBSCRIBE_ERROR') }) unless ($cgi->{lid}); #------------demo code----------- # $demo = 1; my $db_sub = $DB->table('Subscribers'); my $db_stl = $DB->table('StopLists'); my $wild_cards = GList::wild_cards(); my $email = lc $cgi->{email}; if (ref $cgi->{lid} eq 'ARRAY') { foreach my $id (@{$cgi->{lid}}) { my $info = $DB->table('Lists')->get($id); next unless ($info); my $error = _check_subscriber($email, $id, $db_stl, $wild_cards); next if ($error); # if it has been subscribed to the list next if ($db_sub->count({ sub_email => $email, sub_list_id_fk => $id })); my ($template, $data) = _generate_info($info, $email, $cgi->{name}); next unless ($data); $db_sub->insert($data); if ($template and !$demo) { # sending a confirmation or validation email GList::send($template->{head}, { text => $template->{body} }); } } } else { my $info = $DB->table('Lists')->get($cgi->{lid}); return ('error_form.html', { msg => GList::language('LOG_SUBSCRIBE_ERROR2', $cgi->{lid}, GList::_load_global('site_title')) }) if (!$info); $url_success = $info->{lst_url_subscribe_success} if ($info->{lst_url_subscribe_success}); $url_failure = $info->{lst_url_subscribe_failure} if ($info->{lst_url_subscribe_failure}); my $error = _check_subscriber($email, $info->{lst_id}, $db_stl, $wild_cards); return ('error_form.html', { msg => $error }) if ($error); # if it has been subscribed to the list if ($db_sub->count({ sub_email => $email, sub_list_id_fk => $cgi->{lid} })) { print $IN->header( -url => $url_failure ); return; } my ($template, $data) = _generate_info($info, $email, $cgi->{name}); unless ($data) { print $IN->header( -url => $url_failure ); return; } $db_sub->insert($data); if ($template and !$demo) { # sending a confirmation or validation email GList::send($template->{head}, { text => $template->{body} }); } } print $IN->header( -url => $url_success ); return; } END_OF_SUB $COMPILE{user_rm} = __LINE__ . <<'END_OF_SUB'; sub user_rm { user_unsubscribe(); } END_OF_SUB $COMPILE{user_unsubscribe} = __LINE__ . <<'END_OF_SUB'; sub user_unsubscribe { #----------------------------------------------------------- # Unsubscribe a email address # my $url_success = "$CFG->{image_url}/page_unsubscribe_success.html"; my $url_failure = "$CFG->{image_url}/page_unsubscribe_failure.html"; my ($info, $email); my $cgi = $IN->get_hash(); my $db_sub = $DB->table('Subscribers'); my $lists = (ref $cgi->{lid} eq 'ARRAY') ? $cgi->{lid} : [$cgi->{lid}]; if ($cgi->{eml_code}) { my $eml = $DB->table('EmailMailings')->get({ eml_code => $cgi->{eml_code} }); $email = lc $eml->{eml_email}; } else { $email = lc $cgi->{email}; } if (!$email or $#$lists < 0) { print $IN->header( -url => $url_failure ); return; } require GT::SQL::Condition; my $cd = GT::SQL::Condition->new(sub_email => '=' => $email); if ($#$lists == 0) { $info = $DB->table('Lists')->get($lists->[0]); return ('error_form.html', { msg => GList::language('LOG_SUBSCRIBE_ERROR2', $lists->[0]) }) if (!$info); $url_success = $info->{lst_url_unsubscribe_success} if ($info->{lst_url_unsubscribe_success}); $url_failure = $info->{lst_url_unsubscribe_failure} if ($info->{lst_url_unsubscribe_failure}); $cd->add(sub_list_id_fk => '=' => $lists->[0]); } else { $cd->add(sub_list_id_fk => 'IN' => $lists); } if (!$db_sub->count($cd)) { print $IN->header( -url => $url_failure ); return; } #------------demo code----------- # return ('user_success_form.html', { msg => GList::language('LOG_UNSUBS_SUCCESS', $info->{lst_title}) }); if ($db_sub->delete($cd)) { if ($info->{lst_unsubs_template}) { $info->{sub_email} = lc $cgi->{email}; my $unsubs_template = _parse($info, $info->{lst_unsubs_template}); GList::send($unsubs_template->{head}, { text => $unsubs_template->{body} }); } } print $IN->header( -url => $url_success ); return; } END_OF_SUB $COMPILE{_generate_info} = __LINE__ . <<'END_OF_SUB'; sub _generate_info { my ($info, $email, $name) = @_; my %data = ( sub_email => $email, sub_name => $name, sub_created => time, sub_list_id_fk => $info->{lst_id}, sub_user_id_fk => $info->{lst_user_id_fk} ); $info->{sub_email} = $email; $info->{sub_name} = $name; my $template; if ($info->{lst_opt}) { my $val_code = join '', ('a'..'z', 'A'..'Z', 0..9)[map rand(62), 1 .. 30]; $data{sub_validated} = '0'; $data{sub_val_code} = "GT$val_code"; $info->{validate_code} = $val_code; $template = _parse($info, $info->{lst_opt_template}); } elsif ($info->{lst_subs_template}) { $template = _parse($info, $info->{lst_subs_template}); } return ($template, \%data); } END_OF_SUB $COMPILE{_signup_check} = __LINE__ . <<'END_OF_SUB'; sub _signup_check { #------------------------------------------------------------------- # my $data = shift; my $db = $DB->table('Users'); my $refix = $CFG->{signup_username_regex} || '^[\w\-\.]{3,}$'; length $data->{usr_username} < 3 and return GList::language('USR_SIGNUP_USERNAME_INVALID'); $data->{usr_username} =~ /$refix/ or return GList::language('USR_INVALID'); $db->count({ usr_username => $data->{usr_username} }) and return GList::language('USR_SIGNUP_USERNAME_TAKEN'); length $data->{usr_password} < 4 and return GList::language('ADM_PWD_INVALID'); $data->{usr_password} ne $data->{con_password} and return GList::language('USR_SIGNUP_CONFIRM_PASS'); $data->{usr_email} =~ /.@\S+\.\S+$/ or return GList::language('USR_SIGNUP_EMAIL_INVALID', $data->{usr_email}); $db->count({ usr_email => $data->{usr_email} }) and return GList::language('USR_SIGNUP_EMAIL_INUSE', $data->{usr_email}); if ($CFG->{signup_restricted_email} and ref $CFG->{signup_restricted_email} eq 'ARRAY') { foreach my $e (@{$CFG->{signup_restricted_email}}) { $data->{usr_email} eq $e and return GList::language('USR_SIGNUP_EMAIL_RESTRICTED', $data->{usr_email}); } } return; } END_OF_SUB $COMPILE{_check_subscriber} = __LINE__ . <<'END_OF_SUB'; sub _check_subscriber { #----------------------------------------------------------------- # my ($email, $lst_id, $db_stl, $wild_cards) = @_; return GList::language('USR_SUB_OVERLIMIT') if (GList::check_limit('sublist', $lst_id)); return GList::language('USR_SUB_INVALID_EMAIL') if ($email !~ /^(?:(?:.+\@.+\..+)|\s*)$/ or $email =~ /\s/ ); return GList::language('USR_SUB_STOPLIST') if ($db_stl->count({ stl_email => $email })); foreach (@$wild_cards) { my $e = $_->[0]; my $re = quotemeta $e; $re =~ s/\\\*/.*/; $re =~ s/\\\?/./; return GList::language('USR_SUB_STOPLIST') if ($email =~ /$re/i); } } END_OF_SUB $COMPILE{_parse} = __LINE__ . <<'END_OF_SUB'; sub _parse { #----------------------------------------------------------- # Load email template # my ($info, $name) = @_; require GList::Template; my $db = $DB->table('EmailTemplates'); my $template = $db->get({ tpl_user_id_fk => $info->{lst_user_id_fk}, tpl_name => $name }); return if (!$template); my $sth = $DB->table('Users')->select({ usr_username => $info->{lst_user_id_fk} }); return unless $sth; my $uinfo = $sth->fetchrow_hashref; @{$info}{keys %$uinfo} = (values %$uinfo); foreach (keys %$template) { $template->{$_} = GList::Template->parse( "string", [$info], { string => $template->{$_}, disable => { functions => 1 } } ); } my $headers; if ($template->{tpl_extra}) { for (split /\s*\n\s*/, $template->{tpl_extra}) { # This will weed out any blank lines my ($key, $value) = split /\s*:\s*/, $_, 2; $headers->{$key} = $value if $key and $value; } } $headers->{From} = $template->{tpl_from}; $headers->{To} = $template->{tpl_to}; $headers->{Subject} = $template->{tpl_subject}; return { body => $template->{tpl_body}, head => $headers }; } END_OF_SUB $COMPILE{_parse_file} = __LINE__ . <<'END_OF_SUB'; sub _parse_file { my ($file, $info) = @_; require GT::Mail::Editor; require GList::Template; my $tpl = GT::Mail::Editor->new( dir => "$CFG->{priv_path}/templates", template => $CFG->{template_set} ); $tpl->load($file); my %head; my $headers = $tpl->headers; while (my ($k, $v) = each %$headers) { my $val = $v; $val = GList::Template->parse( "string", [$info], { string => $val, disable => { functions => 1 } } ); $head{$k} = $val; } my $body = GList::Template->parse( "string", [$info], { string => $tpl->{body}, disable => { functions => 1 } } ); return (\%head, $body); } END_OF_SUB $COMPILE{_cleanup_files} = __LINE__ . <<'END_OF_SUB'; sub _cleanup_files { #---------------------------------------------------------- # Clear out old temporary attachments. # my $second = $CFG->{session_exp} * 3600 || 3600; opendir (DIR, "$CFG->{priv_path}/tmp") or die GList::language('DIR_OPEN_ERR', "$CFG->{priv_path}/tmp"); my @files = readdir(DIR); closedir (DIR); foreach my $file (@files) { my $full_file = "$CFG->{priv_path}/tmp/$file"; next if ( -d $full_file ); if ( (-M _) * 86400 > $second ) { $full_file =~ /(.*)/; $full_file = $1; unlink $full_file; } } } END_OF_SUB $COMPILE{_todo} = __LINE__ . <<'END_OF_SUB'; sub _todo { #--------------------------------------------------------------------------- # my $do = shift; my %actions = ( user_open => 1, user_click => 1, user_signup => 1, user_remind => 1, user_validate => 1, user_subscribe => 1, user_rm => 1, user_unsubscribe=> 1, user_account_validate => 1 ); if (exists $actions{$do}) { return 1; } return; } END_OF_SUB $COMPILE{_determine_action} = __LINE__ . <<'END_OF_SUB'; sub _determine_action { #---------------------------------------------------------------------------- # Check valid action # my $action = shift || undef; return if ( !$action ); return 'user_login' if ( !$USER and !_todo($action) ); my %valid = ( map { $_ => 1 } qw( user_open user_click user_signup user_login user_logout user_remind user_validate user_subscribe user_rm user_unsubscribe user_account_validate ) ); exists $valid{$action} and return $action; return; } END_OF_SUB 1;