home *** CD-ROM | disk | FTP | other *** search
/ rtsi.com / 2014.01.www.rtsi.com.tar / www.rtsi.com / OS9 / FAQ / discus_admin_1357211388 / source / fcn-acct.pl < prev    next >
Text File  |  2009-11-06  |  15KB  |  444 lines
  1. # FILE: fcn-acct.pl
  2. # DESCRIPTION: Account (moderator and user) management functions
  3. #-------------------------------------------------------------------------------
  4. # DISCUS COPYRIGHT NOTICE
  5. #
  6. # Discus is copyright (c) 2002 by DiscusWare, LLC, all rights reserved.
  7. # The use of Discus is governed by the Discus License Agreement which is
  8. # available from the Discus WWW site at:
  9. #    http://www.discusware.com/discus/license
  10. #
  11. # Pursuant to the Discus License Agreement, this copyright notice may not be
  12. # removed or altered in any way.
  13. #-------------------------------------------------------------------------------
  14.  
  15. use strict;
  16. use vars qw($GLOBAL_OPTIONS $DCONF $PARAMS);
  17.  
  18. ###
  19. ### update_registered_users_file
  20. ###
  21. ### Updates the total number of registered users on the board
  22. ###
  23.  
  24. sub update_registered_users_file {
  25.     my ($newcount) = @_;
  26.     if ($newcount =~ /^\+(\d+)/) {
  27.         return undef if $1 == 0;
  28.         my $plus = $1;
  29.         my $o = readfile("$DCONF->{admin_dir}/data/regusers.txt", "update_registered_users_file", { no_unlock => 1, create => 1 });
  30.         my $c = $o->[0]; $c += $plus;
  31.         writefile("$DCONF->{admin_dir}/data/regusers.txt", [ $c ], "update_registered_users_file", { no_lock => 1, create => 1 });
  32.     } elsif ($newcount =~ /^\-(\d+)/) {
  33.         return undef if $1 == 0;
  34.         my $minus = $1;
  35.         my $o = readfile("$DCONF->{admin_dir}/data/regusers.txt", "update_registered_users_file", { no_unlock => 1, create => 1 });
  36.         my $c = $o->[0]; $c -= $minus;
  37.         writefile("$DCONF->{admin_dir}/data/regusers.txt", [ $c ], "update_registered_users_file", { no_lock => 1, create => 1 });
  38.     } elsif ($newcount >= 0) {
  39.         writefile("$DCONF->{admin_dir}/data/regusers.txt", [ $newcount ], "update_registered_users_file", { no_unlock => 1, no_lock => 1, create => 1 });
  40.     }
  41. }
  42.  
  43. ###
  44. ### write_account_file
  45. ###
  46. ### Writes out users.txt, passwd.txt, or databases.  Use of this routine to write
  47. ### the user base makes the rest of the functions independent of whether you are
  48. ### using the MySQL back end, flat text files, or separated text files.
  49. ###
  50.  
  51. sub write_account_file {
  52.     my ($database, $array_ref, $param_ref) = @_;
  53.     $database = ( $database eq "passwd" ? "passwd" : "users" );
  54.     my $ca = 0;
  55.     if (-e "$DCONF->{admin_dir}/source/custom-acct.pl") {
  56.         dreq("custom-acct");
  57.         $ca = 1;
  58.     }
  59.     if ($DCONF->{pro} && $GLOBAL_OPTIONS->{database} == 1) {
  60.         dreq("sql-acct-PRO");
  61.         my @u = sql_write_account_file($database, $array_ref, $param_ref);
  62.         custom_write_account_file($database, $array_ref, $param_ref) if $ca;
  63.         return @u;
  64.     }
  65.     my @successes = (); my @failures = ();
  66.     my @files = ("$DCONF->{admin_dir}/$database.txt");
  67.     if ($DCONF->{pro} && $GLOBAL_OPTIONS->{split_user_files} && $database =~ m|users|) {
  68.         dreq("userfile");
  69.         @files = userfile_build_from_array($array_ref, $database);
  70.     }
  71.     undef my $cat_ref;
  72.     my $upd_or_del = undef;
  73.     my $add_rec = undef;
  74.     foreach my $record (@{ $array_ref }) {
  75.         my $u = $record->{user};
  76.         my $f = $files[0];
  77.         if ($DCONF->{pro} && $GLOBAL_OPTIONS->{split_user_files} && $database =~ m|users|) {
  78.             $f = userfile_which_file($database, $u);
  79.         }
  80.         if ($record->{action} eq "delete") {
  81.             $cat_ref->{$u}->{action} = "D";
  82.             $upd_or_del->{$f}++;
  83.         } elsif ($record->{action} eq "update") {
  84.             $cat_ref->{$u}->{action} = "U";
  85.             $cat_ref->{$u}->{data} = $record;
  86.             $upd_or_del->{$f}++;
  87.         } elsif ($record->{action} eq "add") {
  88.             push(@{ $add_rec->{$f} }, $record);
  89.         }
  90.     }
  91.     while (my $fn =    shift @files) {
  92.         undef my $username_exists;
  93.         if ($upd_or_del->{$fn}) {
  94.             my $rf = readfile($fn, "write_account_file", { no_unlock => 1, zero_ok => 1, create => 1 }) if ! $param_ref->{fastupdate};
  95.             $rf = readfile($fn, "write_account_file", { no_lock => 1, no_unlock => 1, zero_ok => 1, create => 1 }) if $param_ref->{fastupdate};
  96.             my @nf = ();
  97.             foreach my $rec (@{ $rf }) {
  98.                 my $h = user_line_as_hash($rec);
  99.                 $h->{database} = $fn =~ /passwd/ ? "passwd" : "users";
  100.                 if (! defined $cat_ref->{ $h->{user} }) {
  101.                     push @nf, $rec;
  102.                     next;
  103.                 }
  104.                 $username_exists->{$h->{user}} = 1;
  105.                 my $u = $h->{user};
  106.                 if ($cat_ref->{$u}->{action} eq "D") {
  107.                     push (@successes, $h);
  108.                     next;
  109.                 } elsif ($cat_ref->{$u}->{action} eq "U") {
  110.                     foreach my $dk (keys(%{ $cat_ref->{$u}->{data} })) {
  111.                         $h->{$dk} = $cat_ref->{$u}->{data}->{$dk} if defined $cat_ref->{$u}->{data}->{$dk};
  112.                     }
  113.                     $rec = generate_user_line($h);
  114.                     push (@successes, $h);
  115.                     push (@nf, $rec);
  116.                 } else {                    
  117.                     push (@nf, $rec);
  118.                 }
  119.             }
  120.             writefile($fn, \@nf, "write_account_file", { no_lock => 1, zero_ok => 1, create => 1 }) if ! $param_ref->{fastupdate};
  121.             writefile($fn, \@nf, "write_account_file", { no_unlock => 1, no_lock => 1, zero_ok => 1, create => 1 }) if $param_ref->{fastupdate};
  122.         } else {
  123.             my $rf = readfile($fn, "write_account_file", { zero_ok => 1, create => 1 });
  124.             foreach my $rec (@{ $rf }) {
  125.                 my $h = user_line_as_hash($rec);
  126.                 $username_exists->{$h->{user}} = 1;
  127.             }
  128.         }
  129.         if (defined $add_rec->{$fn}) {
  130.             my @add_lines = ();
  131.             foreach my $uref (@{ $add_rec->{$fn} }) {
  132.                 my $un = prepare_userpass($uref->{user});
  133.                 if ($username_exists->{$un}) {
  134.                     $uref->{error_code} = 1;
  135.                     push @failures, $uref;
  136.                     next;
  137.                 }
  138.                 $username_exists->{$un} = 1;
  139.                 push @add_lines, generate_user_line($uref);
  140.                 push @successes, $uref;
  141.             }
  142.             if (scalar(@add_lines)) {
  143.                 appendfile($fn, \@add_lines, "write_account_file", { no_lock => 1, zero_ok => 1, create => 1 }) if ! $param_ref->{fastupdate};
  144.                 appendfile($fn, \@add_lines, "write_account_file", { no_unlock => 1, no_lock => 1, zero_ok => 1, create => 1 }) if $param_ref->{fastupdate};
  145.             }
  146.         }
  147.     }
  148.     custom_write_account_file($database, $array_ref, $param_ref) if $ca;
  149.     return (\@successes, \@failures);
  150. }
  151.  
  152. ###
  153. ### delete_account
  154. ###
  155. ### Deletes one or more moderator or user accounts, and returns arrays of
  156. ### accounts successfully deleted and accounts that couldn't be deleted.
  157. ###
  158.  
  159. sub delete_account {
  160.     my ($reff, $dbh_orig, $database) = @_;
  161.     dreq("authpass");
  162.     $database = "users" if $database eq "";
  163.     my @array = ();
  164.     foreach my $acct (keys(%{ $reff })) {
  165.         push @array, { user => $acct, action => 'delete' };
  166.     }
  167.     my ($success, $failure) = write_account_file($database, \@array, { dbh_orig => $dbh_orig });
  168.     update_registered_users_file(join("", "-", scalar(@{$success})));
  169.     if ($DCONF->{pro}) {
  170.         dreq("fcn-prfl-PRO");
  171.         delete_enhanced_profile_record( $reff, $database );
  172.     }
  173.     return ($success, $failure);
  174. }
  175.  
  176. ###
  177. ### update_account
  178. ###
  179. ### Prepares one or more updates for the user or moderator database.  Also performs
  180. ### some simple error checking on the fields (require that e-mail address is valid,
  181. ### etc.).
  182. ###
  183.  
  184. sub update_account {
  185.     my ($updates, $database, $param_ref) = @_;
  186.     my $timecache = time;
  187.     $database = ($database eq "" ? "users" : $database);
  188.     my @updates = ( ref $updates eq "ARRAY" ? @{ $updates } : ( $updates ) );
  189.     undef my $ud;
  190.     foreach my $u (@updates) {
  191.         $u->{pass} = defined $u->{new_password} ? crypt($u->{new_password}, pick_random_salt()) : undef;
  192.         $u->{pass} = $u->{force_pass} if defined $u->{force_pass};
  193.         if (defined $u->{email}) {
  194.             $u->{email} = trim($u->{email});
  195.             $u->{email} = "" if $u->{email} !~ m|^([\w\-\+\.]+)\@([\w\-\+\.]+)$|;
  196.         }
  197.         if ($u->{fullname} ne "") {
  198.             $u->{fullname} =~ s/[<>:]//g;
  199.             $u->{fullname} =~ s/\s+/ /g;
  200.             $u->{fullname} = undef if $u->{fullname} eq "";
  201.         }
  202.         $u->{action} = "update";
  203.         $u->{database} = $database;
  204.     }
  205.     return write_account_file($database, \@updates, $param_ref);
  206. }
  207.  
  208. ###
  209. ### add_account
  210. ###
  211. ### Adds one or more user or moderator accounts to the system, returning the successes
  212. ### and failures as array references.  The first argument, $ah, is an array of hash
  213. ### references, with each hash ref being one new account.  Some of the notable entries
  214. ### in each hash are:
  215. ###        user =>                    Username of account being created
  216. ###
  217. ###        pass1 & pass2 =>        Unencrypted passwords, generally from form input
  218. ###     OR pass =>                    Unencrypted final password
  219. ###     OR    encrypted_password =>    Encrypted password
  220. ###     OR    givepassword =>            Makes Discus assign a random password
  221. ###
  222. ###        email =>                E-mail address
  223. ###        fullname =>                Full name of users
  224. ###        groups =>                Slash-delimited group list
  225. ###
  226. ### You must set $args->{database} to either "users" (for users) or "passwd" (for
  227. ### moderators).  Discus figures out the right file or database table to read/write.
  228. ###
  229. ### Within returns, Discus will also set for you:
  230. ###        encrypted_password =>    Encrypted password
  231. ###        final_password =>        Unencrypted password, for if you used random password
  232. ###
  233.  
  234. sub add_account {
  235.     my ($ah, $args) = @_;
  236.     my $timecache = time; srand($timecache);
  237.     dreq("authpass");
  238.     undef my @newlines;
  239.     undef my @failed;
  240.     undef my @successes;
  241.     my @ah = ref $ah eq "HASH" ? ( $ah ) : @{ $ah };
  242. H:    foreach my $hash (@ah) {
  243.         undef my $newhash;
  244.         my $username = prepare_userpass($hash->{'user'});
  245.         if (length($username) > 100 || length($username) < 1) {
  246.             $hash->{error_code} = 2;
  247.             $hash->{'final_password'} = $hash->{'pass'} if defined $hash->{'pass'};
  248.             push @failed, \%{$hash};
  249.             next H;
  250.         }
  251.         $newhash->{'user'} = $username;
  252.         if ($hash->{'pass1'} ne "") {
  253.             ($hash->{'pass1'}, $hash->{'pass2'}) = prepare_userpass_p($hash->{'pass1'}, $hash->{'pass2'});
  254.             if ($hash->{'pass1'} ne $hash->{'pass2'}) {
  255.                 $hash->{error_code} = 3;
  256.                 push (@failed, $hash);
  257.                 next H;
  258.             }
  259.             my ($text, $salt) = pick_random_password();
  260.             my $password = crypt($hash->{'pass1'}, $salt);
  261.             $newhash->{'final_password'} = $hash->{'pass1'};
  262.             $newhash->{'encrypted_password'} = $password;
  263.         } elsif ($hash->{'pass'} ne "") {
  264.             ($hash->{'pass'}) = prepare_userpass_p($hash->{pass});
  265.             if (length($hash->{pass}) < 1) {
  266.                 $hash->{error_code} = 3;
  267.                 push (@failed, $hash);
  268.                 next H;
  269.             }
  270.             my $password = crypt($hash->{'pass'}, pick_random_salt());
  271.             $newhash->{'final_password'} = $hash->{'pass'};
  272.             $newhash->{'encrypted_password'} = $password;
  273.         } elsif ($hash->{'exactpass'} ne "") {
  274.             $newhash->{'final_password'} = $hash->{'exactpass'};
  275.             $newhash->{'encrypted_password'} = $hash->{'exactpass'};
  276.         } else {
  277.             if ($args->{'givepassword'} == 0) {
  278.                 $hash->{error_code} = 4;
  279.                 push (@failed, $hash);
  280.                 next H;
  281.             }
  282.             my ($text, $salt) = pick_random_password();
  283.             ($text) = prepare_userpass_p($text);
  284.             my $password = crypt($text, $salt);
  285.             $newhash->{'final_password'} = $text;
  286.             $newhash->{'encrypted_password'} = $password;
  287.         }
  288.         $newhash->{'pass'} = $newhash->{'encrypted_password'};
  289.         $newhash->{'pass'} = "*$newhash->{pass}||*!" if $hash->{forcechange};
  290.         $newhash->{'encrypted_password'} = undef;
  291.         if ($hash->{'email'} =~ m|^([\w\-\+\.]+)\@([\w\-\+\.]+)$|) {
  292.             $newhash->{'email'} = $hash->{'email'};
  293.         } else {
  294.             $newhash->{'email'} = "email";
  295.         }
  296.         if ($hash->{'fullname'} eq "") {
  297.             $newhash->{'fullname'} = "fullname";
  298.         } else {
  299.             $newhash->{'fullname'} = $hash->{'fullname'};
  300.             $newhash->{'fullname'} =~ s/\n//g;
  301.             $newhash->{'fullname'} =~ s/[:<>\\]//g;
  302.         }
  303.         $newhash->{'edit'} = $hash->{'edit'} eq "" ? 1 : $hash->{'edit'};
  304.         $newhash->{'ctime'} = $hash->{'ctime'} == 0 ? $timecache : $hash->{'ctime'};
  305.         $newhash->{'atime'} = ! defined $hash->{'atime'} ? 0 : $hash->{'atime'};
  306.         $newhash->{'stime'} = ! defined $hash->{'stime'} ? 0 : $hash->{'stime'};
  307.         $newhash->{'notify'} = $hash->{'notify'} eq "" ? $GLOBAL_OPTIONS->{'default_notify_string'} : $hash->{'notify'};
  308.         $newhash->{'groups'} = $hash->{'groups'} eq "" ? "/" : $hash->{'groups'};
  309.         $newhash->{'action'} = "add";
  310.         $newhash->{additional} = $hash->{additional};
  311.         push (@newlines, $newhash);
  312.     }
  313.     my ($success, $failure) = write_account_file($args->{database}, \@newlines);
  314.     my @u = @{$failure}; push @u, @failed; $failure = \@u;
  315.     update_registered_users_file(join("", "+", scalar(@{$success})));
  316.     return ($success, $failure) if $args->{no_enhanced};
  317.     if ($DCONF->{pro}) {
  318.         my @a = ();
  319.         my %failures = map { $_->{user}, 1 } @{$failure};
  320.         foreach my $x (@newlines) {
  321.             next if defined $failures{$x->{user}};
  322.             my $u = {};
  323.             $u->{username} = $x->{user};
  324.             $u->{database} = $args->{database};
  325.             $u->{personal} = $x->{additional};
  326.             $u->{status} = $args->{database} eq "passwd" ? 9 : 3;
  327.             $u->{posts} = 0;
  328.             my %j = map { $_, 1 } split(//, $GLOBAL_OPTIONS->{default_prefs}); $u->{pref} = \%j;
  329.             push @a, $u;
  330.         }
  331.         if (scalar @a) {
  332.             dreq("fcn-prfl-PRO");
  333.             update_enhanced_profile_file(\@a);
  334.         }
  335.     }
  336.     return ($success, $failure);
  337. }
  338.  
  339. ###
  340. ### pick_random_password
  341. ###
  342. ### Chooses a 4-10 letter password randomly.
  343. ###
  344.  
  345. sub pick_random_password {
  346.     my ($arg) = @_;
  347.     my $salt = pick_random_salt() if $arg == 0;
  348.     my $text = "";
  349.     for (my $i = 1; $i <= (6 + int(rand(3))); $i++) {
  350.         my $char = int(rand(36));
  351.         if ($char > 26) {
  352.             $char -= 26;
  353.             $text .= $char;
  354.         } else {
  355.             $text .= ('A' .. 'Z')[$char];
  356.         }
  357.     }
  358.     return ($text, $salt) if $arg == 0;
  359.     return $text if $arg == 1;
  360. }
  361.  
  362. ###
  363. ### pick_random_salt
  364. ###
  365. ### Picks a 2-letter salt
  366. ###
  367.  
  368. sub pick_random_salt {
  369.     my @salt = ();
  370.     for (my $i=1; $i<=2; $i++) {
  371.         push (@salt, int(rand(26))+65);
  372.     }
  373.     my $salt = pack('c2', @salt);
  374.     return $salt;
  375. }
  376.  
  377. ###
  378. ### user_copy
  379. ###
  380. ### Copies one or more users from one group to another
  381. ###
  382.  
  383. sub user_copy {
  384.     my ($oldgroup, $newgroup, $users, $move) = @_;
  385.     dreq("authpass");
  386.     my $p = undef;
  387.     if ($users ne "" && $users ne "*" && $users ne "0") {
  388.         foreach my $x (split(/,/, $users)) {
  389.             $p->{$x} = 1;
  390.         }
  391.     }
  392.     my $raf = read_account_file("users", $p, { returnformat => 'single_array', no_lock => 1, no_unlock => 1 });
  393.     my @u = ();
  394.     foreach my $x (@{$raf}) {
  395.         next if $x->{groups} !~ m|/$oldgroup/|;
  396.         next if $x->{groups} =~ m|/$newgroup/|;
  397.         my @g = grep(/\S/, split(/\//, $x->{groups}));
  398.         push @g, $newgroup;
  399.         my %i = map { $_, 1 } @g;
  400.         $i{$oldgroup} = 0 if $move;
  401.         my $j = join("/", grep($i{$_} == 1, keys(%i)));
  402.         $j = "/$j" if $j !~ m|^/|;
  403.         $j = "$j/" if $j !~ m|/$|;
  404.         push @u, { user => $x->{user}, groups => $j };
  405.     }
  406.     update_account(\@u, "users") if scalar(@u);
  407.     return { copied => scalar(@u) };
  408. }
  409.  
  410. ###
  411. ### remove_account_group
  412. ###
  413. ### Removes accounts from a particular group
  414. ###
  415.  
  416. sub remove_account_group {
  417.     my ($reff, $dbh_orig, $database, $group) = @_;
  418.     dreq("authpass");
  419.     my $deletes = {};
  420.     my $raf = read_account_file("users", $reff, { returnformat => 'single_array', no_lock => 1, no_unlock => 1 });
  421.     my @u = ();
  422.     foreach my $x (@{$raf}) {
  423.         next if $x->{groups} !~ m|/$group/|;
  424.         if ($x->{groups} eq "/$group/") {
  425.             $deletes->{$x->{user}} += 1;
  426.             next;
  427.         }
  428.         my @g = grep(/\S/, split(/\//, $x->{groups}));
  429.         my %i = map { $_, 1 } @g;
  430.         $i{$group} = 0;
  431.         my $j = join("/", grep($i{$_} == 1, keys(%i)));
  432.         $j = "/$j" if $j !~ m|^/|;
  433.         $j = "$j/" if $j !~ m|/$|;
  434.         push @u, { user => $x->{user}, groups => $j };
  435.     }
  436.     update_account(\@u, "users") if scalar(@u);
  437.     if (scalar keys %{$deletes}) {
  438.         delete_account($deletes, $dbh_orig, $database);
  439.     }
  440. }
  441.  
  442.  
  443. 1;
  444.