useradmin/user-lib.pl

   1 =head1 user-lib.pl
   2
   3 Functions for Unix user and group management.
   4
   5  foreign_require("useradmin", "user-lib.pl");
   6  @users = useradmin::list_users();
   7  @groups = useradmin::list_groups();
   8  ($joe) = grep { $_->{'user'} eq 'joe' } @users;
   9  if ($joe) {
  10    $joe->{'pass'} = useradmin::encrypt_password('smeg');
  11    useradmin::making_changes()
  12    useradmin::modify_user($joe, $joe);
  13    useradmin::made_changes()
  14  }
  15
  16 =cut
  17
  18 BEGIN { push(@INC, ".."); };
  19 use WebminCore;
  20 &init_config();
  21 if ($gconfig{'os_type'} =~ /-linux$/) {
  22         do "linux-lib.pl";
  23         }
  24 else {
  25         do "$gconfig{'os_type'}-lib.pl";
  26         }
  27 do "md5-lib.pl";
  28 %access = &get_module_acl();
  29
  30 @random_password_chars = ( 'a' .. 'z', 'A' .. 'Z', '0' .. '9' );
  31 $disable_string = $config{'lock_prepend'} eq "" ? "!" : $config{'lock_prepend'};
  32
  33 # Search types
  34 $match_modes = [ [ 0, $text{'index_equals'} ], [ 4, $text{'index_contains'} ],
  35                  [ 1, $text{'index_matches'} ], [ 2, $text{'index_nequals'} ],
  36                  [ 5, $text{'index_ncontains'} ], [ 3, $text{'index_nmatches'}],
  37                  [ 6, $text{'index_lower'} ], [ 7, $text{'index_higher'} ] ];
  38
  39 =head2 password_file(file)
  40
  41 Returns true if some file looks like a valid Unix password file
  42
  43 =cut
  44 sub password_file
  45 {
  46 if (!$_[0]) { return 0; }
  47 elsif (&open_readfile(SHTEST, $_[0])) {
  48         local($line);
  49         $line = <SHTEST>;
  50         close(SHTEST);
  51         return $line =~ /^\S+:\S*:/;
  52         }
  53 else { return 0; }
  54 }
  55
  56 =head2 list_users
  57
  58 Returns an array of hash references, each containing info about one user. Each
  59 hash will always contain the keys :
  60
  61 =item user - The Unix username.
  62
  63 =item pass - Encrypted password, perhaps using MD5 or DES.
  64
  65 =item uid - User's ID.
  66
  67 =item gid - User's primary group's ID.
  68
  69 =item real - Real name for the user. May also contain office phone, home phone and office location, comma-separated.
  70
  71 =item home - User's home directory.
  72
  73 =item shell - Shell command to run when the user logs in.
  74
  75 In addition, if the system supports shadow passwords it may also have the keys :
  76
  77 =item change - Days since 1970 the password was last changed.
  78
  79 =item min - Days before password may be changed.
  80
  81 =item max - Days after which password must be changed.
  82
  83 =item warn - Days before password is to expire that user is warned.
  84
  85 =item inactive - Days after password expires that account is disabled.
  86
  87 =item expire - Days since Jan 1, 1970 that account is disabled.
  88
  89 Or if it supports FreeBSD master.passwd info, it will also have keys :
  90
  91 =item class - User's login class.
  92
  93 =item change - Unix time at which the password was last changed.
  94
  95 =item expire - Unix time at which the password will expire.
  96
  97 =cut
  98 sub list_users
  99 {
 100 return @list_users_cache if (scalar(@list_users_cache));
 101
 102 # read the password file
 103 local (@rv, $_, %idx, $lnum, @pw, $p, $i, $j);
 104 local $pft = &passfiles_type();
 105 if ($pft == 1) {
 106         # read the master.passwd file only
 107         $lnum = 0;
 108         &open_readfile(PASSWD, $config{'master_file'});
 109         while(<PASSWD>) {
 110                 s/\r|\n//g;
 111                 if (/\S/ && !/^[#\+\-]/) {
 112                         @pw = split(/:/, $_, -1);
 113                         push(@rv, { 'user' => $pw[0],   'pass' => $pw[1],
 114                                     'uid' => $pw[2],    'gid' => $pw[3],
 115                                     'class' => $pw[4],  'change' => $pw[5],
 116                                     'expire' => $pw[6], 'real' => $pw[7],
 117                                     'home' => $pw[8],   'shell' => $pw[9],
 118                                     'line' => $lnum,    'num' => scalar(@rv) });
 119                         }
 120                 $lnum++;
 121                 }
 122         close(PASSWD);
 123         }
 124 elsif ($pft == 6) {
 125         # Read netinfo dump
 126         &open_execute_command(PASSWD, "nidump passwd '$netinfo_domain'", 1);
 127         while(<PASSWD>) {
 128                 s/\r|\n//g;
 129                 if (/\S/ && !/^[#\+\-]/) {
 130                         @pw = split(/:/, $_, -1);
 131                         push(@rv, { 'user' => $pw[0],   'pass' => $pw[1],
 132                                     'uid' => $pw[2],    'gid' => $pw[3],
 133                                     'class' => $pw[4],  'change' => $pw[5],
 134                                     'expire' => $pw[6], 'real' => $pw[7],
 135                                     'home' => $pw[8],   'shell' => $pw[9],
 136                                     'num' => scalar(@rv) });
 137                         }
 138                 }
 139         close(PASSWD);
 140         }
 141 elsif ($pft == 7) {
 142         # Read directory services dump of users
 143         &open_execute_command(PASSWD,
 144                 "dscl '$netinfo_domain' readall /Users", 1);
 145         local $user;
 146         local $ls = $config{'lock_string'};
 147         while(<PASSWD>) {
 148                 s/\r|\n//g;
 149                 if ($_ eq "-") {
 150                         # End of the current user
 151                         $user = undef;
 152                         }
 153                 elsif (/^(\S+):\s*(.*)$/) {
 154                         # Value for a user
 155                         if (!$user) {
 156                                 $user = { 'num' => scalar(@rv) };
 157                                 push(@rv, $user);
 158                                 }
 159                         local ($n, $v) = ($1, $2);
 160                         if ($n ne 'RealName' && $v eq '') {
 161                                 # Multi-line value
 162                                 $v = <PASSWD>;
 163                                 $v =~ s/^ //;
 164                                 }
 165                         local $p = $user_properties_map{$n};
 166                         if ($p) {
 167                                 # Some OSX users have two names, like _foo foo
 168                                 $v =~ s/\s.*$// if ($p eq 'user');
 169                                 $user->{$p} = $v;
 170                                 }
 171                         elsif ($n eq "GeneratedUID") {
 172                                 # Given the UID, we can get the password hash
 173                                 $user->{'pass'} = &get_macos_password_hash($v);
 174                                 $user->{'uuid'} = $v;
 175                                 if (substr($user->{'pass'}, 0,
 176                                            length($ls)) eq $ls) {
 177                                         # Account locked
 178                                         $user->{'pass'} = $ls;
 179                                         }
 180                                 }
 181                         }
 182                 }
 183         close(PASSWD);
 184         }
 185 else {
 186         # start by reading /etc/passwd
 187         $lnum = 0;
 188         &open_readfile(PASSWD, $config{'passwd_file'});
 189         while(<PASSWD>) {
 190                 s/\r|\n//g;
 191                 if (/\S/ && !/^[#\+\-]/) {
 192                         @pw = split(/:/, $_, -1);
 193                         push(@rv, { 'user' => $pw[0],   'pass' => $pw[1],
 194                                     'uid' => $pw[2],    'gid' => $pw[3],
 195                                     'real' => $pw[4],   'home' => $pw[5],
 196                                     'shell' => $pw[6],  'line' => $lnum,
 197                                     'num' => scalar(@rv) });
 198                         $idx{$pw[0]} = $rv[$#rv];
 199                         }
 200                 $lnum++;
 201                 }
 202         close(PASSWD);
 203         if ($pft == 2 || $pft == 5) {
 204                 # read the shadow file data
 205                 $lnum = 0;
 206                 &open_readfile(SHADOW, $config{'shadow_file'});
 207                 while(<SHADOW>) {
 208                         s/\r|\n//g;
 209                         if (/\S/ && !/^[#\+\-]/) {
 210                                 @pw = split(/:/, $_, -1);
 211                                 $p = $idx{$pw[0]};
 212                                 $p->{'pass'} = $pw[1];
 213                                 $p->{'change'} = $pw[2] < 0 ? "" : $pw[2];
 214                                 $p->{'min'} = $pw[3] < 0 ? "" : $pw[3];
 215                                 $p->{'max'} = $pw[4] < 0 ? "" : $pw[4];
 216                                 $p->{'warn'} = $pw[5] < 0 ? "" : $pw[5];
 217                                 $p->{'inactive'} = $pw[6] < 0 ? "" : $pw[6];
 218                                 $p->{'expire'} = $pw[7] < 0 ? "" : $pw[7];
 219                                 $p->{'sline'} = $lnum;
 220                                 }
 221                         $lnum++;
 222                         }
 223                 close(SHADOW);
 224                 for($i=0; $i<@rv; $i++) {
 225                         if (!defined($rv[$i]->{'sline'})) {
 226                                 # not in shadow!
 227                                 for($j=$i; $j<@rv; $j++) { $rv[$j]->{'num'}--; }
 228                                 splice(@rv, $i--, 1);
 229                                 }
 230                         }
 231                 }
 232         elsif ($pft == 4) {
 233                 # read the AIX security passwd file
 234                 local $lastuser;
 235                 local $lnum = 0;
 236                 &open_readfile(SECURITY, $config{'shadow_file'});
 237                 while(<SECURITY>) {
 238                         s/\s*$//;
 239                         if (/^\s*(\S+):/) {
 240                                 $lastuser = $idx{$1};
 241                                 $lastuser->{'sline'} = $lnum;
 242                                 }
 243                         elsif (/^\s*([^=\s]+)\s*=\s*(.*)/) {
 244                                 if ($1 eq 'password') {
 245                                         $lastuser->{'pass'} = $2;
 246                                         }
 247                                 elsif ($1 eq 'lastupdate') {
 248                                         $lastuser->{'change'} = $2;
 249                                         }
 250                                 elsif ($1 eq 'flags') {
 251                                         map { $lastuser->{lc($_)}++ }
 252                                             split(/[,\s]+/, $2);
 253                                         }
 254                                 $lastuser->{'seline'} = $lnum;
 255                                 }
 256                         $lnum++;
 257                         }
 258                 close(SECURITY);
 259
 260                 # read the AIX security user file
 261                 &open_readfile(USER, $config{'aix_user_file'});
 262                 while(<USER>) {
 263                         s/\s*$//;
 264                         if (/^\s*(\S+):/) {
 265                                 $lastuser = $idx{$1};
 266                                 }
 267                         elsif (/^\s*([^=\s]+)\s*=\s*(.*)/) {
 268                                 if ($1 eq 'expires') {
 269                                         $lastuser->{'expire'} = $2;
 270                                         }
 271                                 elsif ($1 eq 'minage') {
 272                                         $lastuser->{'min'} = $2;
 273                                         }
 274                                 elsif ($1 eq 'maxage') {
 275                                         $lastuser->{'max'} = $2;
 276                                         }
 277                                 elsif ($1 eq 'pwdwarntime') {
 278                                         $lastuser->{'warn'} = $2;
 279                                         }
 280                                 }
 281                         }
 282                 close(USER);
 283                 }
 284         }
 285 @list_users_cache = @rv;
 286 return @rv;
 287 }
 288
 289 =head2 create_user(&details)
 290
 291 Creates a new user with the given details, supplied in a hash ref. This must
 292 be in the same format as returned by list_users, and must contain at a minimum
 293 the user, uid, gid, pass, shell, home and real keys.
 294
 295 =cut
 296 sub create_user
 297 {
 298 local $lref;
 299 local $pft = &passfiles_type();
 300 if ($pft == 1) {
 301         # just need to add to master.passwd
 302         $lref = &read_file_lines($config{'master_file'});
 303         $_[0]->{'line'} = &nis_index($lref);
 304         splice(@$lref, $_[0]->{'line'}, 0,
 305                "$_[0]->{'user'}:$_[0]->{'pass'}:$_[0]->{'uid'}:".
 306                "$_[0]->{'gid'}:$_[0]->{'class'}:$_[0]->{'change'}:".
 307                "$_[0]->{'expire'}:$_[0]->{'real'}:$_[0]->{'home'}:".
 308                "$_[0]->{'shell'}");
 309         if (scalar(@list_users_cache)) {
 310                 map { $_->{'line'}++ if ($_->{'line'} >= $_[0]->{'line'}) }
 311                     @list_users_cache;
 312                 }
 313         }
 314 elsif ($pft == 3) {
 315         # Just invoke the useradd command
 316         &system_logged("useradd -u $_[0]->{'uid'} -g $_[0]->{'gid'} -c \"$_[0]->{'real'}\" -d $_[0]->{'home'} -s $_[0]->{'shell'} $_[0]->{'user'}");
 317         # And set the password
 318         &system_logged("echo ".quotemeta($_[0]->{'pass'}).
 319                        " | /usr/lib/scoadmin/account/password.tcl ".
 320                        "$_[0]->{'user'} >/dev/null 2>&1");
 321         }
 322 elsif ($pft == 6) {
 323         # Use the niutil command
 324         &system_logged("niutil -create '$netinfo_domain' '/users/$_[0]->{'user'}'");
 325         &set_netinfo($_[0]);
 326         }
 327 elsif ($pft == 7) {
 328         # Add to directory services
 329         &execute_dscl_command("create", "/Users/$_[0]->{'user'}");
 330         local $out = &execute_dscl_command("read", "/Users/$_[0]->{'user'}");
 331         if ($out =~ /GeneratedUID:\s+(\S+)/) {
 332                 $_[0]->{'uuid'} = $1;
 333                 }
 334         &set_user_dirinfo($_[0]);
 335         }
 336 else {
 337         # add to /etc/passwd
 338         $lref = &read_file_lines($config{'passwd_file'});
 339         $_[0]->{'line'} = &nis_index($lref);
 340         if (scalar(@list_users_cache)) {
 341                 map { $_->{'line'}++ if ($_->{'line'} >= $_[0]->{'line'}) }
 342                     @list_users_cache;
 343                 }
 344         splice(@$lref, $_[0]->{'line'}, 0,
 345                "$_[0]->{'user'}:".
 346                ($pft == 2 || $pft == 5 ? "x" : $pft == 4 ? "!" :
 347                         $_[0]->{'pass'}).
 348                ":$_[0]->{'uid'}:$_[0]->{'gid'}:$_[0]->{'real'}:".
 349                "$_[0]->{'home'}:$_[0]->{'shell'}");
 350         if ($pft == 2 || $pft == 5) {
 351                 # Find correct place to insert in shadow file
 352                 $lref = &read_file_lines($config{'shadow_file'});
 353                 $_[0]->{'sline'} = &nis_index($lref);
 354                 if (scalar(@list_users_cache)) {
 355                         map { $_->{'sline'}++
 356                               if ($_->{'sline'} >= $_[0]->{'sline'}) }
 357                             @list_users_cache;
 358                         }
 359                 }
 360         if ($pft == 2) {
 361                 # add to shadow as well..
 362                 splice(@$lref, $_[0]->{'sline'}, 0,
 363                        "$_[0]->{'user'}:$_[0]->{'pass'}:$_[0]->{'change'}:".
 364                        "$_[0]->{'min'}:$_[0]->{'max'}:$_[0]->{'warn'}:".
 365                        "$_[0]->{'inactive'}:$_[0]->{'expire'}:");
 366                 }
 367         elsif ($pft == 5) {
 368                 # add to SCO shadow file
 369                 splice(@$lref, $_[0]->{'sline'}, 0,
 370                     "$_[0]->{'user'}:$_[0]->{'pass'}:$_[0]->{'change'}:".
 371                     "$_[0]->{'min'}:$_[0]->{'max'}");
 372                 }
 373         elsif ($pft == 4) {
 374                 # add to AIX security passwd file as well..
 375                 local @flags;
 376                 push(@flags, 'ADMIN') if ($_[0]->{'admin'});
 377                 push(@flags, 'ADMCHG') if ($_[0]->{'admchg'});
 378                 push(@flags, 'NOCHECK') if ($_[0]->{'nocheck'});
 379                 $lref = &read_file_lines($config{'shadow_file'});
 380                 push(@$lref, "", "$_[0]->{'user'}:",
 381                              "\tpassword = $_[0]->{'pass'}",
 382                              "\tlastupdate = $_[0]->{'change'}",
 383                              "\tflags = ".join(",", @flags));
 384
 385                 # add to AIX security user file as well..
 386                 $lref = &read_file_lines($config{'aix_user_file'});
 387                 if ($_[0]->{'expire'} || $_[0]->{'min'} ||
 388                     $_[0]->{'max'} || $_[0]->{'warn'} ) {
 389                         push(@$lref, "$_[0]->{'user'}:");
 390                         push(@$lref, "\texpires = $_[0]->{'expire'}")
 391                                 if ($_[0]->{'expire'});
 392                         push(@$lref, "\tminage = $_[0]->{'min'}")
 393                                 if ($_[0]->{'min'});
 394                         push(@$lref, "\tmaxage = $_[0]->{'max'}")
 395                                 if ($_[0]->{'max'});
 396                         push(@$lref, "\tpwdwarntime = $_[0]->{'warn'}")
 397                                 if ($_[0]->{'warn'});
 398                         push(@$lref, "");
 399                         }
 400                 }
 401         }
 402 &flush_file_lines() if (!$batch_mode);
 403 push(@list_users_cache, $_[0]) if (scalar(@list_users_cache));
 404 &refresh_nscd() if (!$batch_mode);
 405 }
 406
 407 =head2 modify_user(&old, &details)
 408
 409 Update an existing Unix user with new details. The user to change must be
 410 in &old, and the new values are in &details. These can be references to the
 411 same hash if you like.
 412
 413 =cut
 414 sub modify_user
 415 {
 416 $_[0] || &error("Missing parameter to modify_user");
 417 local(@passwd, @shadow, $lref);
 418 local $pft = &passfiles_type();
 419 if ($pft == 1) {
 420         # just need to update master.passwd
 421         $_[0]->{'line'} =~ /^\d+$/ || &error("Missing user line to modify");
 422         $lref = &read_file_lines($config{'master_file'});
 423         $lref->[$_[0]->{'line'}] =
 424               "$_[1]->{'user'}:$_[1]->{'pass'}:$_[1]->{'uid'}:".
 425               "$_[1]->{'gid'}:$_[1]->{'class'}:$_[1]->{'change'}:".
 426               "$_[1]->{'expire'}:$_[1]->{'real'}:$_[1]->{'home'}:".
 427               "$_[1]->{'shell'}";
 428         }
 429 elsif ($pft == 3) {
 430         # Just use the usermod command
 431         &system_logged("usermod -u $_[1]->{'uid'} -g $_[1]->{'gid'} -c \"$_[1]->{'real'}\" -d $_[1]->{'home'} -s $_[1]->{'shell'} $_[1]->{'user'}");
 432         &system_logged("echo ".quotemeta($_[1]->{'pass'})." | /usr/lib/scoadmin/account/password.tcl $_[1]->{'user'}");
 433         }
 434 elsif ($pft == 6) {
 435         # Just use the niutil command to update
 436         if ($_[0]->{'user'} && $_[0]->{'user'} ne $_[1]->{'user'}) {
 437                 # Need to delete and re-create!
 438                 &system_logged("niutil -destroy '$netinfo_domain' '/users/$_[0]->{'user'}'");
 439                 &system_logged("niutil -create '$netinfo_domain' '/users/$_[1]->{'user'}'");
 440                 }
 441         &set_netinfo($_[1]);
 442         }
 443 elsif ($pft == 7) {
 444         # Call directory services to update the user
 445         if ($_[0]->{'user'} && $_[0]->{'user'} ne $_[1]->{'user'}) {
 446                 # Need to rename
 447                 &execute_dscl_command("change", "/Users/$_[0]->{'user'}",
 448                               "RecordName", $_[0]->{'user'}, $_[1]->{'user'});
 449                 }
 450         $_[1]->{'uuid'} = $_[0]->{'uuid'};
 451         &set_user_dirinfo($_[1]);
 452         }
 453 else {
 454         # update /etc/passwd
 455         $lref = &read_file_lines($config{'passwd_file'});
 456         $_[0]->{'line'} =~ /^\d+$/ || &error("Missing user line to modify");
 457         $lref->[$_[0]->{'line'}] =
 458                 "$_[1]->{'user'}:".
 459                 ($pft == 2 || $pft == 5 ? "x" : $pft == 4 ? "!" :
 460                  $_[1]->{'pass'}).
 461                 ":$_[1]->{'uid'}:$_[1]->{'gid'}:$_[1]->{'real'}:".
 462                 "$_[1]->{'home'}:$_[1]->{'shell'}";
 463         if ($pft == 2) {
 464                 # update shadow file as well..
 465                 $_[0]->{'sline'} =~ /^\d+$/ ||
 466                         &error("Missing user line to modify");
 467                 $lref = &read_file_lines($config{'shadow_file'});
 468                 $lref->[$_[0]->{'sline'}] =
 469                         "$_[1]->{'user'}:$_[1]->{'pass'}:$_[1]->{'change'}:".
 470                         "$_[1]->{'min'}:$_[1]->{'max'}:$_[1]->{'warn'}:".
 471                         "$_[1]->{'inactive'}:$_[1]->{'expire'}:";
 472                 }
 473         elsif ($pft == 5) {
 474                 # update SCO shadow
 475                 $_[0]->{'sline'} =~ /^\d+$/ ||
 476                         &error("Missing user line to modify");
 477                 $lref = &read_file_lines($config{'shadow_file'});
 478                 $lref->[$_[0]->{'sline'}] =
 479                    "$_[1]->{'user'}:$_[1]->{'pass'}:$_[1]->{'change'}:".
 480                    "$_[1]->{'min'}:$_[1]->{'max'}";
 481                 }
 482         elsif ($pft == 4) {
 483                 # update AIX shadow passwd file as well..
 484                 if (defined($_[0]->{'sline'})) {
 485                         local @flags;
 486                         push(@flags, 'ADMIN') if ($_[1]->{'admin'});
 487                         push(@flags, 'ADMCHG') if ($_[1]->{'admchg'});
 488                         push(@flags, 'NOCHECK') if ($_[1]->{'nocheck'});
 489                         local $lref = &read_file_lines($config{'shadow_file'});
 490                         splice(@$lref, $_[0]->{'sline'},
 491                              $_[0]->{'seline'} - $_[0]->{'sline'} + 1,
 492                              "$_[1]->{'user'}:", "\tpassword = $_[1]->{'pass'}",
 493                              "\tlastupdate = $_[1]->{'change'}",
 494                              "\tflags = ".join(",", @flags));
 495                         &flush_file_lines();    # have to flush on AIX
 496                         }
 497
 498                 # update AIX security user file as well..
 499                 # use chuser command because it's easier than working
 500                 # with the complexity issues of the file.
 501                 &system_logged("chuser expires=$_[1]->{'expire'} minage=$_[1]->{'min'} maxage=$_[1]->{'max'} pwdwarntime=$_[1]->{'warn'} $_[1]->{'user'}");
 502                 }
 503         }
 504 if ($_[0] ne $_[1] && &indexof($_[0], @list_users_cache) != -1) {
 505         # Update old object in cache
 506         $_[1]->{'line'} = $_[0]->{'line'} if (defined($_[0]->{'line'}));
 507         $_[1]->{'uuid'} = $_[0]->{'uuid'} if (defined($_[0]->{'uuid'}));
 508         $_[1]->{'sline'} = $_[0]->{'sline'} if (defined($_[0]->{'sline'}));
 509         $_[1]->{'seline'} = $_[0]->{'seline'} if (defined($_[0]->{'seline'}));
 510         %{$_[0]} = %{$_[1]};
 511         }
 512 if (!$batch_mode) {
 513         &flush_file_lines();
 514         &refresh_nscd();
 515         }
 516 }
 517
 518 =head2 delete_user(&details)
 519
 520 Delete an existing user. The &details hash must be user information as
 521 returned by list_users.
 522
 523 =cut
 524 sub delete_user
 525 {
 526 local $lref;
 527 $_[0] || &error("Missing parameter to delete_user");
 528 local $pft = &passfiles_type();
 529 if ($pft == 1) {
 530         # Delete from BSD master.passwd file
 531         $_[0]->{'line'} =~ /^\d+$/ || &error("Missing user line to delete");
 532         $lref = &read_file_lines($config{'master_file'});
 533         splice(@$lref, $_[0]->{'line'}, 1);
 534         map { $_->{'line'}-- if ($_->{'line'} > $_[0]->{'line'}) }
 535             @list_users_cache;
 536         }
 537 elsif ($pft == 3) {
 538         # Just invoke the userdel command
 539         &system_logged("userdel -n0 $_[0]->{'user'}");
 540         }
 541 elsif ($pft == 4) {
 542         # Just invoke the rmuser command
 543         &system_logged("rmuser -p $_[0]->{'user'}");
 544         }
 545 elsif ($pft == 6) {
 546         # Just delete with the niutil command
 547         &system_logged("niutil -destroy '$netinfo_domain' '/users/$_[0]->{'user'}'");
 548         }
 549 elsif ($pft == 7) {
 550         # Delete from directory services
 551         &execute_dscl_command("delete", "/Users/$_[0]->{'user'}");
 552         }
 553 else {
 554         # XXX doesn't delete from AIX file!
 555         $_[0]->{'line'} =~ /^\d+$/ || &error("Missing user line to delete");
 556         $lref = &read_file_lines($config{'passwd_file'});
 557         splice(@$lref, $_[0]->{'line'}, 1);
 558         map { $_->{'line'}-- if ($_->{'line'} > $_[0]->{'line'}) }
 559             @list_users_cache;
 560         if ($pft == 2 || $pft == 5) {
 561                 if (defined($_[0]->{'sline'})) {
 562                         $lref = &read_file_lines($config{'shadow_file'});
 563                         splice(@$lref, $_[0]->{'sline'}, 1);
 564                         map { $_->{'sline'}--
 565                                 if ($_->{'sline'} > $_[0]->{'sline'}) }
 566                             @list_users_cache;
 567                         }
 568                 }
 569         }
 570 @list_users_cache = grep { $_->{'user'} ne $_[0]->{'user'} } @list_users_cache
 571         if (scalar(@list_users_cache));
 572 if (!$batch_mode) {
 573         &flush_file_lines();
 574         &refresh_nscd();
 575         }
 576 }
 577
 578 =head2 list_groups
 579
 580 Returns a list of all the local groups as an array of hashes. Each will
 581 contain the keys :
 582
 583 =item group - The group name.
 584
 585 =item pass - Rarely-used encrypted password, in DES or MD5 format.
 586
 587 =item gid - Unix ID for the group.
 588
 589 =item members - A comma-separated list of secondary group members.
 590
 591 =cut
 592 sub list_groups
 593 {
 594 return @list_groups_cache if (scalar(@list_groups_cache));
 595
 596 local(@rv, $lnum, $_, %idx, $g, $i, $j, @gr);
 597 $lnum = 0;
 598 local $gft = &groupfiles_type();
 599 if ($gft == 5) {
 600         # Get groups from netinfo
 601         &open_execute_command(GROUP, "nidump group '$netinfo_domain'", 1);
 602         while(<GROUP>) {
 603                 s/\r|\n//g;
 604                 if (/\S/ && !/^[#\+\-]/) {
 605                         @gr = split(/:/, $_, -1);
 606                         push(@rv, { 'group' => $gr[0],  'pass' => $gr[1],
 607                                     'gid' => $gr[2],
 608                                     'members' => join(",",split(/\s+/,$gr[3])),
 609                                     'num' => scalar(@rv) });
 610                         }
 611                 }
 612         close(GROUP);
 613         }
 614 elsif ($gft == 7) {
 615         # Read directory services dump of groups
 616         &open_execute_command(PASSWD,
 617                 "dscl '$netinfo_domain' readall /Groups", 1);
 618         local $group;
 619         while(<PASSWD>) {
 620                 s/\r|\n//g;
 621                 if ($_ eq "-") {
 622                         # End of the current group
 623                         $group = undef;
 624                         }
 625                 elsif (/^(\S+):\s*(.*)$/) {
 626                         # Value for a group
 627                         if (!$group) {
 628                                 $group = { 'num' => scalar(@rv) };
 629                                 push(@rv, $group);
 630                                 }
 631                         local ($n, $v) = ($1, $2);
 632                         if ($n ne 'GroupMembership' && $v eq '') {
 633                                 # Multi-line value
 634                                 $v = <PASSWD>;
 635                                 $v =~ s/^ //;
 636                                 }
 637                         local $p = $group_properties_map{$n};
 638                         if ($p) {
 639                                 # Convert spaces in members list to ,
 640                                 $v =~ s/ /,/g if ($p eq 'members');
 641                                 # Some OSX groups have two names, like _foo foo
 642                                 $v =~ s/\s.*$// if ($p eq 'group');
 643                                 $group->{$p} = $v;
 644                                 }
 645                         elsif ($n eq "GeneratedUID") {
 646                                 # Given the UUID, we can get the password hash
 647                                 $group->{'pass'} = &get_macos_password_hash($v);
 648                                 $group->{'uuid'} = $v;
 649                                 }
 650                         }
 651                 }
 652         close(PASSWD);
 653         }
 654 else {
 655         # Read the standard group file
 656         &open_readfile(GROUP, $config{'group_file'});
 657         while(<GROUP>) {
 658                 s/\r|\n//g;
 659                 if (/\S/ && !/^[#\+\-]/) {
 660                         @gr = split(/:/, $_, -1);
 661                         push(@rv, { 'group' => $gr[0],  'pass' => $gr[1],
 662                                     'gid' => $gr[2],    'members' => $gr[3],
 663                                     'line' => $lnum,    'num' => scalar(@rv) });
 664                         $idx{$gr[0]} = $rv[$#rv];
 665                         }
 666                 $lnum++;
 667                 }
 668         close(GROUP);
 669         }
 670 if ($gft == 2) {
 671         # read the gshadow file data
 672         $lnum = 0;
 673         &open_readfile(SHADOW, $config{'gshadow_file'});
 674         while(<SHADOW>) {
 675                 s/\r|\n//g;
 676                 if (/\S/ && !/^[#\+\-]/) {
 677                         @gr = split(/:/, $_, -1);
 678                         $g = $idx{$gr[0]};
 679                         $g->{'pass'} = $gr[1];
 680                         $g->{'sline'} = $lnum;
 681                         }
 682                 $lnum++;
 683                 }
 684         close(SHADOW);
 685         #for($i=0; $i<@rv; $i++) {
 686         #       if (!defined($rv[$i]->{'sline'})) {
 687         #               # not in shadow!
 688         #               for($j=$i; $j<@rv; $j++) { $rv[$j]->{'num'}--; }
 689         #               splice(@rv, $i--, 1);
 690         #               }
 691         #       }
 692         }
 693 elsif ($gft == 4) {
 694         # read the AIX group data
 695         local $lastgroup;
 696         local $lnum = 0;
 697         &open_readfile(SECURITY, $config{'gshadow_file'});
 698         while(<SECURITY>) {
 699                 s/\s*$//;
 700                 if (/^\s*(\S+):/) {
 701                         $lastgroup = $idx{$1};
 702                         $lastgroup->{'sline'} = $lnum;
 703                         $lastgroup->{'seline'} = $lnum;
 704                         }
 705                 elsif (/^\s*([^=\s]+)\s*=\s*(.*)/) {
 706                         $lastgroup->{'seline'} = $lnum;
 707                         }
 708                 $lnum++;
 709                 }
 710         close(SECURITY);
 711         }
 712 @list_groups_cache = @rv;
 713 return @rv;
 714 }
 715
 716 =head2 create_group(&details)
 717
 718 Create a new Unix group based on the given hash. Required keys are
 719 gid - Unix group ID
 720 group - Group name
 721 pass - Encrypted password
 722 members - Comma-separated list of members
 723
 724 =cut
 725 sub create_group
 726 {
 727 local $gft = &groupfiles_type();
 728 if ($gft == 5) {
 729         # Use niutil command
 730         &system_logged("niutil -create '$netinfo_domain' '/groups/$_[0]->{'group'}'");
 731         &set_group_netinfo($_[0]);
 732         }
 733 elsif ($gft == 7) {
 734         # Use the dscl directory services command
 735         &execute_dscl_command("create", "/Groups/$_[0]->{'group'}");
 736         &set_group_dirinfo($_[0]);
 737         }
 738 else {
 739         # Update group file(s)
 740         local $lref;
 741         $lref = &read_file_lines($config{'group_file'});
 742         $_[0]->{'line'} = &nis_index($lref);
 743         if (scalar(@list_groups_cache)) {
 744                 map { $_->{'line'}++ if ($_->{'line'} >= $_[0]->{'line'}) }
 745                     @list_groups_cache;
 746                 }
 747         splice(@$lref, $_[0]->{'line'}, 0,
 748                "$_[0]->{'group'}:".
 749                (&groupfiles_type() == 2 ? "x" : $_[0]->{'pass'}).
 750                ":$_[0]->{'gid'}:$_[0]->{'members'}");
 751         if ($gft == 2) {
 752                 $lref = &read_file_lines($config{'gshadow_file'});
 753                 $_[0]->{'sline'} = &nis_index($lref);
 754                 if (scalar(@list_groups_cache)) {
 755                         map { $_->{'sline'}++
 756                               if ($_->{'sline'} >= $_[0]->{'sline'}) }
 757                             @list_groups_cache;
 758                         }
 759                 splice(@$lref, $_[0]->{'sline'}, 0,
 760                        "$_[0]->{'group'}:$_[0]->{'pass'}::$_[0]->{'members'}");
 761                 }
 762         elsif ($gft == 4) {
 763                 $lref = &read_file_lines($config{'gshadow_file'});
 764                 $_[0]->{'sline'} = scalar(@$lref);
 765                 push(@$lref, "", "$_[0]->{'group'}:", "\tadmin = false");
 766                 }
 767         &flush_file_lines();
 768         }
 769 &refresh_nscd();
 770 push(@list_groups_cache, $_[0]) if (scalar(@list_groups_cache));
 771 }
 772
 773 =head2 modify_group(&old, &details)
 774
 775 Update an existing Unix group specified in old based on the given details hash.
 776 These can both be references to the same hash if you like. The hash must be
 777 in the same format as returned by list_groups.
 778
 779 =cut
 780 sub modify_group
 781 {
 782 $_[0] || &error("Missing parameter to modify_group");
 783 local $gft = &groupfiles_type();
 784 if ($gft == 5) {
 785         # Call niutil to update the group
 786         if ($_[0]->{'group'} && $_[0]->{'group'} ne $_[1]->{'group'}) {
 787                 # Need to delete and re-create!
 788                 &system_logged("niutil -destroy '$netinfo_domain' '/groups/$_[0]->{'group'}'");
 789                 &system_logged("niutil -create '$netinfo_domain' '/groups/$_[1]->{'group'}'");
 790                 }
 791         &set_group_netinfo($_[1]);
 792         }
 793 elsif ($gft == 7) {
 794         # Call dscl to update the group
 795         if ($_[0]->{'group'} && $_[0]->{'group'} ne $_[1]->{'group'}) {
 796                 # Need to rename
 797                 &execute_dscl_command("change", "/Groups/$_[0]->{'group'}",
 798                               "RecordName", $_[0]->{'group'}, $_[1]->{'group'});
 799                 }
 800         $_[1]->{'uuid'} = $_[0]->{'uuid'};
 801         &set_group_dirinfo($_[1]);
 802         }
 803 else {
 804         # Update in files
 805         local $gs = (&groupfiles_type() == 2 && $_[0]->{'sline'} ne '');
 806         &replace_file_line($config{'group_file'}, $_[0]->{'line'},
 807                    "$_[1]->{'group'}:".($gs ? "x" : $_[1]->{'pass'}).
 808                    ":$_[1]->{'gid'}:$_[1]->{'members'}\n");
 809         if ($gs) {
 810                 &replace_file_line($config{'gshadow_file'}, $_[0]->{'sline'},
 811                                    "$_[1]->{'group'}:$_[1]->{'pass'}::$_[1]->{'members'}\n");
 812                 }
 813         elsif (&groupfiles_type() == 4) {
 814                 &replace_file_line($config{'gshadow_file'},
 815                                    $_[0]->{'sline'},
 816                                    "$_[1]->{'group'}:\n");
 817                 }
 818         }
 819 if ($_[0] ne $_[1] && &indexof($_[0], @list_groups_cache) != -1) {
 820         $_[1]->{'line'} = $_[0]->{'line'} if (defined($_[0]->{'line'}));
 821         $_[1]->{'sline'} = $_[0]->{'sline'} if (defined($_[0]->{'sline'}));
 822         $_[1]->{'uuid'} = $_[0]->{'uuid'} if (defined($_[0]->{'uuid'}));
 823         %{$_[0]} = %{$_[1]};
 824         }
 825 &refresh_nscd();
 826 }
 827
 828 =head2 delete_group(&details)
 829
 830 Delete an existing Unix group, whose details are in the hash ref supplied.
 831
 832 =cut
 833 sub delete_group
 834 {
 835 $_[0] || &error("Missing parameter to delete_group");
 836 local $gft = &groupfiles_type();
 837 if ($gft == 5) {
 838         # Call niutil to delete
 839         &system_logged("niutil -destroy '$netinfo_domain' '/groups/$_[0]->{'group'}'");
 840         }
 841 elsif ($gft == 7) {
 842         # Delete from directory services
 843         &execute_dscl_command("delete", "/Groups/$_[0]->{'group'}");
 844         }
 845 else {
 846         # Remove from group file(s)
 847         &replace_file_line($config{'group_file'}, $_[0]->{'line'});
 848         map { $_->{'line'}-- if ($_->{'line'} > $_[0]->{'line'}) }
 849             @list_groups_cache;
 850         if ($gft == 2 && $_[0]->{'sline'} ne '') {
 851                 &replace_file_line($config{'gshadow_file'}, $_[0]->{'sline'});
 852                 map { $_->{'sline'}-- if ($_->{'sline'} > $_[0]->{'sline'}) }
 853                     @list_groups_cache;
 854                 }
 855         elsif ($gft == 4) {
 856                 local $lref = &read_file_lines($config{'gshadow_file'});
 857                 splice(@$lref, $_[0]->{'sline'},
 858                        $_[0]->{'seline'} - $_[0]->{'sline'} + 1);
 859                 &flush_file_lines();
 860                 }
 861         }
 862 @list_groups_cache = grep { $_ ne $_[0] } @list_groups_cache
 863         if (scalar(@list_groups_cache));
 864 &refresh_nscd();
 865 }
 866
 867
 868 =head2 recursive_change(dir, olduid, oldgid, newuid, newgid)
 869
 870 Change the UID or GID of a directory and all files in it, if they match the
 871 given old UID and/or GID. If either of the old IDs are -1, then they are
 872 ignored for match purposes.
 873
 874 =cut
 875 sub recursive_change
 876 {
 877 local(@list, $f, @stbuf);
 878 local $real = &translate_filename($_[0]);
 879 (@stbuf = stat($real)) || return;
 880 (-l $real) && return;
 881 if (($_[1] < 0 || $_[1] == $stbuf[4]) &&
 882     ($_[2] < 0 || $_[2] == $stbuf[5])) {
 883         # Found match..
 884         &set_ownership_permissions(
 885                 $_[3] < 0 ? $stbuf[4] : $_[3],
 886                 $_[4] < 0 ? $stbuf[5] : $_[4], undef, $_[0]);
 887         }
 888 if (-d $real) {
 889         opendir(DIR, $real);
 890         @list = readdir(DIR);
 891         closedir(DIR);
 892         foreach $f (@list) {
 893                 if ($f eq "." || $f eq "..") { next; }
 894                 &recursive_change("$_[0]/$f", $_[1], $_[2], $_[3], $_[4]);
 895                 }
 896         }
 897 }
 898
 899 =head2 making_changes
 900
 901 Must be called before changes are made to the password or group file.
 902
 903 =cut
 904 sub making_changes
 905 {
 906 if ($config{'pre_command'} =~ /\S/) {
 907         local $out = &backquote_logged("($config{'pre_command'}) 2>&1 </dev/null");
 908         return $? ? $out : undef;
 909         }
 910 return undef;
 911 }
 912
 913 =head2 made_changes
 914
 915 Must be called after the password or group file has been changed, to run the
 916 post-changes command.
 917
 918 =cut
 919 sub made_changes
 920 {
 921 if ($config{'post_command'} =~ /\S/) {
 922         local $out = &backquote_logged("($config{'post_command'}) 2>&1 </dev/null");
 923         return $? ? $out : undef;
 924         }
 925 return undef;
 926 }
 927
 928 =head2 other_modules(function, arg, ...)
 929
 930 Call some function in the useradmin_update.pl file in other modules. Should be
 931 called after creating, deleting or modifying a user.
 932
 933 =cut
 934 sub other_modules
 935 {
 936 return if (&is_readonly_mode());        # don't even try other modules
 937 local($m, %minfo);
 938 local $func = shift(@_);
 939 foreach $m (&get_all_module_infos()) {
 940         local $mdir = &module_root_directory($m->{'dir'});
 941         if (&check_os_support($m) &&
 942             -r "$mdir/useradmin_update.pl") {
 943                 &foreign_require($m->{'dir'}, "useradmin_update.pl");
 944                 local $pkg = $m->{'dir'};
 945                 $pkg =~ s/[^A-Za-z0-9]/_/g;
 946                 local $fullfunc = "${pkg}::${func}";
 947                 if (defined(&$fullfunc)) {
 948                         &foreign_call($m->{'dir'}, $func, @_);
 949                         }
 950                 }
 951         }
 952 }
 953
 954 =head2 can_edit_user(&acl, &user)
 955
 956 Returns 1 if the given user hash can be edited by a Webmin user whose access
 957 control permissions for this module are in the acl parameter.
 958
 959 =cut
 960 sub can_edit_user
 961 {
 962 local $m = $_[0]->{'uedit_mode'};
 963 local %u;
 964 if ($m == 0) { return 1; }
 965 elsif ($m == 1) { return 0; }
 966 elsif ($m == 2 || $m == 3 || $m == 5) {
 967         map { $u{$_}++ } &split_quoted_string($_[0]->{'uedit'});
 968         if ($m == 5 && $_[0]->{'uedit_sec'}) {
 969                 # Check secondary groups too
 970                 return 1 if ($u{$_[1]->{'gid'}});
 971                 foreach $g (&list_groups()) {
 972                         local @m = split(/,/, $g->{'members'});
 973                         return 1 if ($u{$g->{'gid'}} &&
 974                                      &indexof($_[1]->{'user'}, @m) >= 0);
 975                         }
 976                 return 0;
 977                 }
 978         else {
 979                 return $m == 2 ? $u{$_[1]->{'user'}} :
 980                        $m == 3 ? !$u{$_[1]->{'user'}} :
 981                                  $u{$_[1]->{'gid'}};
 982                 }
 983         }
 984 elsif ($m == 4) {
 985         return (!$_[0]->{'uedit'} || $_[1]->{'uid'} >= $_[0]->{'uedit'}) &&
 986                (!$_[0]->{'uedit2'} || $_[1]->{'uid'} <= $_[0]->{'uedit2'});
 987         }
 988 elsif ($m == 6) {
 989         return $_[1]->{'user'} eq $remote_user;
 990         }
 991 elsif ($m == 7) {
 992         return $_[1]->{'user'} =~ /$_[0]->{'uedit_re'}/;
 993         }
 994 return 0;
 995 }
 996
 997 =head2 can_edit_group(&acl, &group)
 998
 999 Returns 1 if the given group hash can be edited by a Webmin user whose access
1000 control permissions for this module are in the acl parameter.
1001
1002 =cut
1003 sub can_edit_group
1004 {
1005 local $m = $_[0]->{'gedit_mode'};
1006 local %g;
1007 if ($m == 0) { return 1; }
1008 elsif ($m == 1) { return 0; }
1009 elsif ($m == 2 || $m == 3) {
1010         map { $g{$_}++ } &split_quoted_string($_[0]->{'gedit'});
1011         return $m == 2 ? $g{$_[1]->{'group'}}
1012                        : !$g{$_[1]->{'group'}};
1013         }
1014 else { return (!$_[0]->{'gedit'} || $_[1]->{'gid'} >= $_[0]->{'gedit'}) &&
1015               (!$_[0]->{'gedit2'} || $_[1]->{'gid'} <= $_[0]->{'gedit2'}); }
1016 }
1017
1018 =head2 nis_index(&lines)
1019
1020 Internal function to return the line number on which NIS includes start
1021 in a password or group file.
1022
1023 =cut
1024 sub nis_index
1025 {
1026 local $i;
1027 for($i=0; $i<@{$_[0]}; $i++) {
1028         last if ($_[0]->[$i] =~ /^[\+\-]/);
1029         }
1030 return $i;
1031 }
1032
1033 =head2 get_skel_directory(&user, groupname)
1034
1035 Returns the skeleton files directory for some user. The groupname parameter
1036 must be the name of his primary group.
1037
1038 =cut
1039 sub get_skel_directory
1040 {
1041 local ($user, $groupname) = @_;
1042 local $uf = $config{'user_files'};
1043 local $shell = $user->{'shell'};
1044 $shell =~ s/^(.*)\///g;
1045 if ($groupname ne '') {
1046         $uf =~ s/\$group/$groupname/g;
1047         }
1048 $uf =~ s/\$gid/$user->{'gid'}/g;
1049 $uf =~ s/\$shell/$shell/g;
1050 return $uf;
1051 }
1052
1053 =head2 copy_skel_files(source, dest, uid, gid)
1054
1055 Copies skeleton files from some source directory (such as /etc/skel) to a
1056 destination directory, typically a new user's home. The uid and gid are the
1057 IDs of the new user, which determines file ownership.
1058
1059 =cut
1060 sub copy_skel_files
1061 {
1062 local ($f, $df);
1063 local @rv;
1064 foreach $f (split(/\s+/, $_[0])) {
1065         if (-d $f) {
1066                 # copy all files in a directory
1067                 opendir(DIR, $f);
1068                 foreach $df (readdir(DIR)) {
1069                         if ($df eq "." || $df eq "..") { next; }
1070                         push(@rv, &copy_file("$f/$df", $_[1], $_[2], $_[3]));
1071                         }
1072                 closedir(DIR);
1073                 }
1074         elsif (-r $f) {
1075                 # copy just one file
1076                 push(@rv, &copy_file($f, $_[1], $_[2], $_[3]));
1077                 }
1078         }
1079 return @rv;
1080 }
1081
1082 =head2 copy_file(file, destdir, uid, gid)
1083
1084 Copy a file or directory and chown it, preserving symlinks and special files.
1085 Mainly for internal use by copy_skel_files.
1086
1087 =cut
1088 sub copy_file
1089 {
1090 local($base, $subs);
1091 $_[0] =~ /\/([^\/]+)$/; $base = $1;
1092 if ($config{"files_remap_$base"}) {
1093         $base = $config{"files_remap_$base"};
1094         }
1095 $subs = $config{'files_remove'};
1096 $base =~ s/$subs//g if ($subs);
1097 local ($opts, $nochown);
1098 local @rv = ( "$_[1]/$base" );
1099 if (-b $_[0] || -c $_[0]) {
1100         # Looks like a device file .. re-create it
1101         local @st = stat($_[0]);
1102         local $maj = int($st[6] / 256);
1103         local $min = $st[6] % 256;
1104         local $typ = ($st[2] & 00170000) == 0020000 ? 'c' : 'b';
1105         &system_logged("mknod ".quotemeta("$_[1]/$base")." $typ $maj $min");
1106         &set_ownership_permissions($_[2], $_[3], undef, "$_[1]/$base");
1107         $nochown++;
1108         }
1109 elsif (-l $_[0] && !$config{'copy_symlinks'}) {
1110         # A symlink .. re-create it
1111         local $l = readlink($_[0]);
1112         &system_logged("ln -s ".quotemeta($l)." ".quotemeta("$_[1]/$base")." >/dev/null 2>/dev/null");
1113         $opts = "-h";
1114         }
1115 elsif (-d $_[0]) {
1116         # A directory .. copy it recursively
1117         &system_logged("cp -Rp ".quotemeta($_[0])." ".quotemeta("$_[1]/$base")." >/dev/null 2>/dev/null");
1118         local $glob = "$_[1]/$base/*";
1119         while(1) {
1120                 local @g = glob($glob);
1121                 if (@g && -r $g[0]) {
1122                         push(@rv, @g);
1123                         $glob .= "/*";
1124                         }
1125                 else {
1126                         last;
1127                         }
1128                 }
1129         }
1130 else {
1131         # Just a normal file .. copy it
1132         local @st = stat(&translate_filename($_[0]));
1133         &system_logged("cp ".quotemeta($_[0])." ".quotemeta("$_[1]/$base")." >/dev/null 2>/dev/null");
1134         &set_ownership_permissions($_[2], $_[3], $st[2], "$_[1]/$base");
1135         $nochown++;
1136         }
1137 &system_logged("chown $opts -R $_[2]:$_[3] ".quotemeta("$_[1]/$base").
1138                " >/dev/null 2>/dev/null") if (!$nochown);
1139 return @rv;
1140 }
1141
1142 =head2 lock_user_files
1143
1144 Lock all password, shadow and group files. Should be called before performing
1145 any user or group operations.
1146
1147 =cut
1148 sub lock_user_files
1149 {
1150 &lock_file($config{'passwd_file'});
1151 &lock_file($config{'group_file'});
1152 &lock_file($config{'shadow_file'});
1153 &lock_file($config{'gshadow_file'});
1154 &lock_file($config{'master_file'});
1155 }
1156
1157 =head2 unlock_user_files
1158
1159 Unlock all password, shadow and group files. Should be called after all user
1160 or group operations are complete.
1161
1162 =cut
1163 sub unlock_user_files
1164 {
1165 &unlock_file($config{'passwd_file'});
1166 &unlock_file($config{'group_file'});
1167 &unlock_file($config{'shadow_file'});
1168 &unlock_file($config{'gshadow_file'});
1169 &unlock_file($config{'master_file'});
1170 }
1171
1172 =head2 my_setpwent
1173
1174 The same as Perl's setpwent function, but may read from /etc/passwd directly.
1175
1176 =cut
1177 sub my_setpwent
1178 {
1179 if ($config{'from_files'}) {
1180         @setpwent_cache = &list_users();
1181         $setpwent_pos = 0;
1182         }
1183 else { return setpwent(); }
1184 }
1185
1186 =head2 my_getpwent
1187
1188 The same as Perl's getpwent function, but may read from /etc/passwd directly.
1189
1190 =cut
1191 sub my_getpwent
1192 {
1193 if ($config{'from_files'}) {
1194         my_setpwent() if (!@setpwent_cache);
1195         if ($setpwent_pos >= @setpwent_cache) {
1196                 return wantarray ? () : undef;
1197                 }
1198         else {
1199                 return &pw_user_rv($setpwent_cache[$setpwent_pos++],
1200                                    wantarray, 'user');
1201                 }
1202         }
1203 else { return getpwent(); }
1204 }
1205
1206 =head2 my_endpwent
1207
1208 Should be called when you are done with my_setpwent and my_getpwent.
1209
1210 =cut
1211 sub my_endpwent
1212 {
1213 if ($config{'from_files'}) {
1214         undef(@setpwent_cache);
1215         }
1216 elsif ($gconfig{'os_type'} eq 'hpux') {
1217         # On hpux, endpwent() can crash perl!
1218         return 0;
1219         }
1220 else { return endpwent(); }
1221 }
1222
1223 =head2 my_getpwnam(username)
1224
1225 Looks up a user by name, like the getpwnam Perl function, but may read
1226 /etc/passwd directly.
1227
1228 =cut
1229 sub my_getpwnam
1230 {
1231 if ($config{'from_files'}) {
1232         local $u;
1233         foreach $u (&list_users()) {
1234                 return &pw_user_rv($u, wantarray, 'uid')
1235                         if ($u->{'user'} eq $_[0]);
1236                 }
1237         return wantarray ? () : undef;
1238         }
1239 else { return getpwnam($_[0]); }
1240 }
1241
1242 =head2 my_getpwuid(uid)
1243
1244 Looks up a user by ID, like the getpwnam Perl function, but may read
1245 /etc/passwd directly.
1246
1247 =cut
1248 sub my_getpwuid
1249 {
1250 if ($config{'from_files'}) {
1251         foreach $u (&list_users()) {
1252                 return &pw_user_rv($u, wantarray, 'user')
1253                         if ($u->{'uid'} eq $_[0]);
1254                 }
1255         return wantarray ? () : undef;
1256         }
1257 else { return getpwuid($_[0]); }
1258 }
1259
1260 =head2 pw_user_rv(&user, want-array, username-field)
1261
1262 Internal function to convert a user hash reference into a list in the format
1263 return by the getpw* family of functions.
1264
1265 =cut
1266 sub pw_user_rv
1267 {
1268 return $_[1] ? ( $_[0]->{'user'}, $_[0]->{'pass'}, $_[0]->{'uid'},
1269                  $_[0]->{'gid'}, undef, undef, $_[0]->{'real'},
1270                  $_[0]->{'home'}, $_[0]->{'shell'}, undef ) : $_[0]->{$_[2]};
1271 }
1272
1273 =head2 my_setgrent
1274
1275 The same as Perl's setgrent function, but may read from /etc/group directly.
1276
1277 =cut
1278 sub my_setgrent
1279 {
1280 if ($config{'from_files'}) {
1281         @setgrent_cache = &list_groups();
1282         $setgrent_pos = 0;
1283         }
1284 else { return setgrent(); }
1285 }
1286
1287 =head2 my_getgrent
1288
1289 The same as Perl's getgrent function, but may read from /etc/group directly.
1290
1291 =cut
1292 sub my_getgrent
1293 {
1294 if ($config{'from_files'}) {
1295         my_setgrent() if (!@setgrent_cache);
1296         if ($setgrent_pos >= @setgrent_cache) {
1297                 return ();
1298                 }
1299         else {
1300                 return &gr_group_rv($setgrent_cache[$setgrent_pos++],
1301                                     wantarray, 'group');
1302                 }
1303         }
1304 else { return getgrent(); }
1305 }
1306
1307 =head2 my_endgrent
1308
1309 Should be called when you are done with my_setgrent and my_getgrent.
1310
1311 =cut
1312 sub my_endgrent
1313 {
1314 if ($config{'from_files'}) {
1315         undef(@setgrent_cache);
1316         }
1317 elsif ($gconfig{'os_type'} eq 'hpux') {
1318         # On hpux, endpwent() can crash perl!
1319         return 0;
1320         }
1321 else { return endgrent(); }
1322 }
1323
1324 =head2 my_getgrnam(group)
1325
1326 Looks up a group by name, like the Perl getgrnam function.
1327
1328 =cut
1329 sub my_getgrnam
1330 {
1331 if ($config{'from_files'}) {
1332         local $g;
1333         foreach $g (&list_groups()) {
1334                 return &gr_group_rv($g, wantarray, 'gid')
1335                         if ($g->{'group'} eq $_[0]);
1336                 }
1337         return wantarray ? () : undef;
1338         }
1339 else { return getgrnam($_[0]); }
1340 }
1341
1342 =head2 my_getgrgid(gid)
1343
1344 Looks up a group by GID, like the Perl getgrgid function.
1345
1346 =cut
1347 sub my_getgrgid
1348 {
1349 if ($config{'from_files'}) {
1350         foreach $g (&list_groups()) {
1351                 return &gr_group_rv($g, wantarray, 'group')
1352                         if ($g->{'gid'} eq $_[0]);
1353                 }
1354         return wantarray ? () : undef;
1355         }
1356 else { return getgrgid($_[0]); }
1357 }
1358
1359 sub gr_group_rv
1360 {
1361 return $_[1] ? ( $_[0]->{'group'}, $_[0]->{'pass'}, $_[0]->{'gid'},
1362                  $_[0]->{'members'} ) : $_[0]->{$_[2]};
1363 }
1364
1365 =head2 auto_home_dir(base, username, groupname)
1366
1367 Returns an automatically generated home directory, and creates needed
1368 parent dirs. The parameters are :
1369
1370 =item base - Base directory, like /home.
1371
1372 =item username - The user's login name.
1373
1374 =item groupname - The user's primary group name.
1375
1376 =cut
1377 sub auto_home_dir
1378 {
1379 local $pfx = $_[0] eq "/" ? "/" : $_[0]."/";
1380 if ($config{'home_style'} == 0) {
1381         return $pfx.$_[1];
1382         }
1383 elsif ($config{'home_style'} == 1) {
1384         &mkdir_if_needed($pfx.substr($_[1], 0, 1));
1385         return $pfx.substr($_[1], 0, 1)."/".$_[1];
1386         }
1387 elsif ($config{'home_style'} == 2) {
1388         &mkdir_if_needed($pfx.substr($_[1], 0, 1));
1389         &mkdir_if_needed($pfx.substr($_[1], 0, 1)."/".
1390                          substr($_[1], 0, 2));
1391         return $pfx.substr($_[1], 0, 1)."/".
1392                substr($_[1], 0, 2)."/".$_[1];
1393         }
1394 elsif ($config{'home_style'} == 3) {
1395         &mkdir_if_needed($pfx.substr($_[1], 0, 1));
1396         &mkdir_if_needed($pfx.substr($_[1], 0, 1)."/".
1397                          substr($_[1], 1, 1));
1398         return $pfx.substr($_[1], 0, 1)."/".
1399                substr($_[1], 1, 1)."/".$_[1];
1400         }
1401 elsif ($config{'home_style'} == 4) {
1402         return $_[0];
1403         }
1404 elsif ($config{'home_style'} == 5) {
1405         return $pfx.$_[2]."/".$_[1];
1406         }
1407 }
1408
1409 sub mkdir_if_needed
1410 {
1411 -d $_[0] || &make_dir($_[0], 0755);
1412 }
1413
1414 =head2 set_netinfo(&user)
1415
1416 Update a NetInfo user based on a Webmin user hash. Mainly for internal use.
1417
1418 =cut
1419 sub set_netinfo
1420 {
1421 local %u = %{$_[0]};
1422 &system_logged("niutil -createprop '$netinfo_domain' '/users/$u{'user'}' passwd '$u{'pass'}'");
1423 &system_logged("niutil -createprop '$netinfo_domain' '/users/$u{'user'}' uid '$u{'uid'}'");
1424 &system_logged("niutil -createprop '$netinfo_domain' '/users/$u{'user'}' gid '$u{'gid'}'");
1425 &system_logged("niutil -createprop '$netinfo_domain' '/users/$u{'user'}' class '$u{'class'}'");
1426 &system_logged("niutil -createprop '$netinfo_domain' '/users/$u{'user'}' change '$u{'change'}'");
1427 &system_logged("niutil -createprop '$netinfo_domain' '/users/$u{'user'}' expire '$u{'expire'}'");
1428 &system_logged("niutil -createprop '$netinfo_domain' '/users/$u{'user'}' realname '$u{'real'}'");
1429 &system_logged("niutil -createprop '$netinfo_domain' '/users/$u{'user'}' home '$u{'home'}'");
1430 &system_logged("niutil -createprop '$netinfo_domain' '/users/$u{'user'}' shell '$u{'shell'}'");
1431 }
1432
1433 =head2 set_group_netinfo(&group)
1434
1435 Update a NetInfo group based on a Webmin group hash. Mainly for internal use.
1436
1437 =cut
1438 sub set_group_netinfo
1439 {
1440 local %g = %{$_[0]};
1441 local $mems = join(" ", map { "'$_'" } split(/,/, $g{'members'}));
1442 &system_logged("niutil -createprop '$netinfo_domain' '/groups/$g{'group'}' gid '$g{'gid'}'");
1443 &system_logged("niutil -createprop '$netinfo_domain' '/groups/$g{'group'}' passwd '$g{'pass'}'");
1444 &system_logged("niutil -createprop '$netinfo_domain' '/groups/$g{'group'}' users $mems");
1445 }
1446
1447 =head2 set_user_dirinfo(&user)
1448
1449 Update a user in OSX directive services based on a Webmin user hash.
1450 Mainly for internal use.
1451
1452 =cut
1453 sub set_user_dirinfo
1454 {
1455 local %u = %{$_[0]};
1456 foreach my $k (keys %user_properties_map) {
1457         local $v = $u{$user_properties_map{$k}};
1458         if (defined($v)) {
1459                 &execute_dscl_command("create", "/Users/$u{'user'}", $k, $v);
1460                 }
1461         }
1462 if ($u{'passmode'} == 3 && defined($u{'plainpass'}) ||
1463     $u{'passmode'} == 0) {
1464         # A new plain password was given - use it
1465         &execute_dscl_command("passwd", "/Users/$u{'user'}", $u{'plainpass'});
1466         if ($user->{'uuid'}) {
1467                 $user->{'pass'} = &get_macos_password_hash($user->{'uuid'});
1468                 }
1469         }
1470 elsif ($u{'passmode'} == 4) {
1471         # Explicitly not changed, so do nothing
1472         }
1473 elsif ($u{'passmode'} == 1 || $u{'pass'} eq $config{'lock_string'}) {
1474         # Account locked - set hash to match
1475         &set_macos_password_hash($u{'uuid'}, $u{'pass'});
1476         }
1477 else {
1478         # Has the hash changed?
1479         local $oldpass = &get_macos_password_hash($u{'uuid'});
1480         if (defined($oldpass) && $u{'pass'} ne $oldpass) {
1481                 # Yes .. so set it
1482                 &set_macos_password_hash($u{'uuid'}, $u{'pass'});
1483                 }
1484         }
1485 }
1486
1487 =head2 set_group_dirinfo(&group)
1488
1489 Update a group in OSX directive services based on a Webmin group hash.
1490 Mainly for internal use.
1491
1492 =cut
1493 sub set_group_dirinfo
1494 {
1495 local %g = %{$_[0]};
1496 $g{'members'} =~ s/,/ /g;
1497 foreach my $k (keys %group_properties_map) {
1498         local $v = $g{$group_properties_map{$k}};
1499         if (defined($v)) {
1500                 &execute_dscl_command("create", "/Groups/$g{'group'}", $k, $v);
1501                 }
1502         }
1503 }
1504
1505 =head2 check_password_restrictions(pass, username)
1506
1507 Returns an error message if the given password fails length and other
1508 checks, or undef if it is OK.
1509
1510 =cut
1511 sub check_password_restrictions
1512 {
1513 return &text('usave_epasswd_min', $config{'passwd_min'})
1514         if (length($_[0]) < $config{'passwd_min'});
1515 local $re = $config{'passwd_re'};
1516 return &text('usave_epasswd_re', $re)
1517         if ($re && !eval { $_[0] =~ /^$re$/ });
1518 if ($config{'passwd_same'}) {
1519         return &text('usave_epasswd_same') if ($_[0] =~ /\Q$_[1]\E/i);
1520         }
1521 if ($config{'passwd_dict'} && $_[0] =~ /^[A-Za-z\'\-]+$/ &&
1522     (&has_command("ispell") || &has_command("spell"))) {
1523         # Call spell or ispell to check for dictionary words
1524         local $temp = &transname();
1525         open(TEMP, ">$temp");
1526         print TEMP $_[0],"\n";
1527         close(TEMP);
1528         if (&has_command("ispell")) {
1529                 open(SPELL, "ispell -a <$temp |");
1530                 while(<SPELL>) {
1531                         if (/^(#|\&|\?)/) {
1532                                 $unknown++;
1533                                 }
1534                         }
1535                 close(SPELL);
1536                 }
1537         else {
1538                 open(SPELL, "spell <$temp |");
1539                 local $line = <SPELL>;
1540                 $unknown++ if ($line);
1541                 close(SPELL);
1542                 }
1543         unlink($temp);
1544         return &text('usave_epasswd_dict') if (!$unknown);
1545         }
1546 if ($config{'passwd_prog'}) {
1547         local $out;
1548         if ($config{'passwd_progmode'} == 0) {
1549                 # Run external validation program with user and password as args
1550                 local $qu = quotemeta($_[1]);
1551                 local $qp = quotemeta($_[0]);
1552                 $out = &backquote_command(
1553                         "$config{'passwd_prog'} $qu $qp 2>&1 </dev/null");
1554                 }
1555         else {
1556                 # Run program with password as input on stdin
1557                 local $temp = &transname();
1558                 &open_tempfile(TEMP, ">$temp", 0, 1);
1559                 &print_tempfile(TEMP, $_[1],"\n");
1560                 &print_tempfile(TEMP, $_[0],"\n");
1561                 &close_tempfile(TEMP);
1562                 $out = &backquote_command("$config{'passwd_prog'} <$temp 2>&1");
1563                 }
1564         if ($?) {
1565                 return $out;
1566                 }
1567         }
1568 return undef;
1569 }
1570
1571 =head2 check_username_restrictions(username)
1572
1573 Returns an error message if a username fails some restriction, or undef if
1574 it is OK.
1575
1576 =cut
1577 sub check_username_restrictions
1578 {
1579 if ($config{'max_length'} && length($_[0]) > $config{'max_length'}) {
1580         return &text('usave_elength', $config{'max_length'});
1581         }
1582 local $re = $config{'username_re'};
1583 return &text('usave_ere', $re)
1584         if ($re && !eval { $_[0] =~ /^$re$/ });
1585 return undef;
1586 }
1587
1588 =head2 can_use_group(&acl, group)
1589
1590 Returns 1 if some group can be used as a primary or secondary, 0 if not.
1591
1592 =cut
1593 sub can_use_group
1594 {
1595 return 1 if ($_[0]->{'ugroups'} eq '*');
1596 local @sp = &split_quoted_string($_[0]->{'ugroups'});
1597 if ($_[0]->{'uedit_gmode'} == 3) {
1598         return &indexof($_[1], @sp) < 0;
1599         }
1600 elsif ($_[0]->{'uedit_gmode'} == 4) {
1601         local @ginfo = &my_getgrnam($_[1]);
1602         return (!$_[0]->{'ugroups'} || $ginfo[2] >= $_[0]->{'ugroups'}) &&
1603                (!$_[0]->{'ugroups2'} || $ginfo[2] <= $_[0]->{'ugroups2'});
1604         }
1605 else {
1606         return &indexof($_[1], @sp) >= 0;
1607         }
1608 }
1609
1610 =head2 refresh_nscd
1611
1612 Sends a HUP signal to the nscd process, so that any caches are reloaded.
1613
1614 =cut
1615 sub refresh_nscd
1616 {
1617 return if ($nscd_not_running);
1618 if (!&find_byname("nscd")) {
1619         $nscd_not_running++;
1620         }
1621 elsif ($config{'nscd_restart'}) {
1622         # Run the specified command
1623         &system_logged("$config{'nscd_restart'} >/dev/null 2>&1 </dev/null");
1624         }
1625 elsif (&has_command("nscd")) {
1626         # Use nscd -i to reload
1627         &system_logged("nscd -i group >/dev/null 2>&1 </dev/null");
1628         &system_logged("nscd -i passwd >/dev/null 2>&1 </dev/null");
1629         }
1630 else {
1631         # Send HUP signal
1632         local $rv = &kill_byname_logged("nscd", "HUP");
1633         if (!$rv) {
1634                 $nscd_not_running++;
1635                 }
1636         }
1637 sleep(1);       # Give ncsd time to react
1638 }
1639
1640 =head2 set_user_envs(&user, action, [plainpass], [secondaries], [&olduser], [oldplainpass])
1641
1642 Sets up the USERADMIN_ environment variables for a user update of some kind,
1643 prior to calling making_changes or made_changes. The parameters are :
1644
1645 =item user - User details hash reference, in the same format as returned by list_users.
1646
1647 =item action - Must be one of CREATE_USER, MODIFY_USER or DELETE_USER.
1648
1649 =item plainpass - The user's un-encrypted password, if available.
1650
1651 =item secondaries - An array reference of secondary group names the user is a member of.
1652
1653 =item olduser - When modifying a user, the hash reference of it's old details.
1654
1655 =item oldplainpass - When modifying a user, it's old un-encrypted password, if available.
1656
1657 =cut
1658 sub set_user_envs
1659 {
1660 local ($user, $action, $plainpass, $secs, $olduser, $oldpass) = @_;
1661 &clear_envs();
1662 $ENV{'USERADMIN_USER'} = $user->{'user'};
1663 $ENV{'USERADMIN_UID'} = $user->{'uid'};
1664 $ENV{'USERADMIN_REAL'} = $user->{'real'};
1665 $ENV{'USERADMIN_SHELL'} = $user->{'shell'};
1666 $ENV{'USERADMIN_HOME'} = $user->{'home'};
1667 $ENV{'USERADMIN_GID'} = $user->{'gid'};
1668 local $group = &my_getgrgid($user->{'gid'});
1669 if ($group) {
1670         $ENV{'USERADMIN_GROUP'} = $group;
1671         }
1672 $ENV{'USERADMIN_PASS'} = $plainpass if (defined($plainpass));
1673 $ENV{'USERADMIN_SECONDARY'} = join(",", @{$secs}) if (defined($secs));
1674 $ENV{'USERADMIN_ACTION'} = $action;
1675 $ENV{'USERADMIN_SOURCE'} = $main::module_name;
1676 if ($olduser) {
1677         $ENV{'USERADMIN_OLD_USER'} = $olduser->{'user'};
1678         $ENV{'USERADMIN_OLD_UID'} = $olduser->{'uid'};
1679         $ENV{'USERADMIN_OLD_REAL'} = $olduser->{'real'};
1680         $ENV{'USERADMIN_OLD_SHELL'} = $olduser->{'shell'};
1681         $ENV{'USERADMIN_OLD_HOME'} = $olduser->{'home'};
1682         $ENV{'USERADMIN_OLD_GID'} = $olduser->{'gid'};
1683         $ENV{'USERADMIN_OLD_PASS'} = $oldpass if (defined($oldpass));
1684         }
1685 }
1686
1687 =head2 set_group_envs(&group, action, [&oldgroup])
1688
1689 Sets up the USERADMIN_ environment variables for a group update of some kind,
1690 prior to calling making_changes or made_changes. The parameters are :
1691
1692 =item group - Group details hash reference, in the same format as returned by list_groups.
1693
1694 =item action - Must be one of CREATE_GROUP, MODIFY_GROUP or DELETE_GROUP.
1695
1696 =item oldgroup - When modifying a group, the hash reference of it's old details.
1697
1698 =cut
1699 sub set_group_envs
1700 {
1701 local ($group, $action, $oldgroup) = @_;
1702 &clear_envs();
1703 $ENV{'USERADMIN_GROUP'} = $group->{'group'};
1704 $ENV{'USERADMIN_GID'} = $group->{'gid'};
1705 $ENV{'USERADMIN_MEMBERS'} = $group->{'members'};
1706 $ENV{'USERADMIN_ACTION'} = $action;
1707 $ENV{'USERADMIN_SOURCE'} = $main::module_name;
1708 if ($oldgroup) {
1709         $ENV{'USERADMIN_OLD_GROUP'} = $oldgroup->{'group'};
1710         $ENV{'USERADMIN_OLD_GID'} = $oldgroup->{'gid'};
1711         $ENV{'USERADMIN_OLD_MEMBERS'} = $oldgroup->{'members'};
1712         }
1713 }
1714
1715 =head2 clear_envs
1716
1717 Removes all variables set by set_user_envs and set_group_envs.
1718
1719 =cut
1720 sub clear_envs
1721 {
1722 local $e;
1723 foreach $e (keys %ENV) {
1724         delete($ENV{$e}) if ($e =~ /^USERADMIN_/);
1725         }
1726 }
1727
1728 =head2 encrypt_password(password, [salt])
1729
1730 Encrypts a password using the encryption format configured for this system.
1731 If the salt parameter is given, it will be used for hashing the password -
1732 this is typically an already encrypted password, that you want to compare with
1733 the result of this function to check that passwords match. If missing, a salt
1734 will be randomly generated.
1735
1736 =cut
1737 sub encrypt_password
1738 {
1739 local ($pass, $salt) = @_;
1740 local $format = 0;
1741 if ($gconfig{'os_type'} eq 'macos' && &passfiles_type() == 7) {
1742         # New OSX directory service uses SHA1 for passwords!
1743         $salt ||= chr(int(rand(26))+65).chr(int(rand(26))+65).
1744                   chr(int(rand(26))+65).chr(int(rand(26))+65);
1745         if (&check_sha1()) {
1746                 # Use Digest::SHA1 perl module
1747                 return &encrypt_sha1_hash($pass, $salt);
1748                 }
1749         elsif (&has_command("openssl")) {
1750                 # Use openssl command
1751                 local $temp = &transname();
1752                 &open_execute_command(OPENSSL, "openssl dgst -sha1 >$temp", 0);
1753                 print OPENSSL $salt,$pass;
1754                 close(OPENSSL);
1755                 local $rv = &read_file_contents($temp);
1756                 &unlink_file($temp);
1757                 $rv =~ s/\r|\n//g;
1758                 return $rv;
1759                 }
1760         else {
1761                 &error("Either the Digest::SHA1 Perl module or openssl command is needed to hash passwords");
1762                 }
1763         }
1764 elsif ($config{'md5'} == 2) {
1765         # Always use MD5
1766         $format = 1;
1767         }
1768 elsif ($config{'md5'} == 3) {
1769         # Always use blowfish
1770         $format = 2;
1771         }
1772 elsif ($config{'md5'} == 4) {
1773         # Always use SHA512
1774         $format = 3;
1775         }
1776 elsif ($config{'md5'} == 1 && !$config{'skip_md5'}) {
1777         # Up to system
1778         $format = &use_md5() if (defined(&use_md5));
1779         }
1780
1781 if ($no_encrypt_password) {
1782         # Some operating systems don't do any encryption!
1783         return $pass;
1784         }
1785 elsif ($format == 1) {
1786         # MD5 encryption is selected .. use it if possible
1787         local $err = &check_md5();
1788         if ($err) {
1789                 &error(&text('usave_edigestmd5',
1790                     "/config.cgi?$module_name",
1791                     "/cpan/download.cgi?source=3&cpan=$err", $err));
1792                 }
1793         return &encrypt_md5($pass, $salt);
1794         }
1795 elsif ($format == 2) {
1796         # Blowfish is selected .. use it if possible
1797         local $err = &check_blowfish();
1798         if ($err) {
1799                 &error(&text('usave_edigestblowfish',
1800                     "/config.cgi?$module_name",
1801                     "/cpan/download.cgi?source=3&cpan=$err", $err));
1802                 }
1803         return &encrypt_blowfish($pass, $salt);
1804         }
1805 elsif ($format == 3) {
1806         # SHA512 is selected .. use it
1807         local $err = &check_sha512();
1808         if ($err) {
1809                 &error($text{'usave_edigestsha512'});
1810                 }
1811         return &encrypt_sha512($pass, $salt);
1812         }
1813 else {
1814         # Just do old-style crypt() DES encryption
1815         if ($salt !~ /^[a-z0-9]{2}/i) {
1816                 # Un-usable non-DES salt
1817                 $salt = undef;
1818                 }
1819         $salt ||= chr(int(rand(26))+65) . chr(int(rand(26))+65);
1820         return &unix_crypt($pass, $salt);
1821         }
1822 }
1823
1824 =head2 build_user_used([&uid-hash], [&shell-list], [&username-hash])
1825
1826 Fills in hashes with used UIDs, shells and usernames, based on existing users.
1827 Useful for allocating a new UID, with code like :
1828
1829   my %used;
1830   useradmin::build_user_used(\%used);
1831   $newuid = useradmin::allocate_uid(\%used);
1832
1833 =cut
1834 sub build_user_used
1835 {
1836 &my_setpwent();
1837 local @u;
1838 while(@u = &my_getpwent()) {
1839         $_[0]->{$u[2]}++ if ($_[0]);
1840         push(@{$_[1]}, $u[8]) if ($_[1] && $u[8]);
1841         $_[2]->{$u[0]}++ if ($_[2]);
1842         }
1843 &my_endpwent();
1844 local $u;
1845 foreach $u (&list_users()) {
1846         $_[0]->{$u->{'uid'}}++ if ($_[0]);
1847         push(@{$_[1]}, $u->{'shell'}) if ($_[1] && $u->{'shell'});
1848         $_[2]->{$u->{'user'}}++ if ($_[2]);
1849         }
1850 }
1851
1852 =head2 build_group_used([&gid-hash], [&groupname-hash])
1853
1854 Fills in hashes with used GIDs and group names, based on existing groups.
1855 Useful for allocating a new GID, with code like :
1856
1857   my %used;
1858   useradmin::build_group_used(\%used);
1859   $newgid = useradmin::allocate_gid(\%used);
1860
1861 =cut
1862 sub build_group_used
1863 {
1864 &my_setgrent();
1865 local @g;
1866 while(@g = &my_getgrent()) {
1867         $_[0]->{$g[2]}++ if ($_[0]);
1868         $_[1]->{$g[0]}++ if ($_[1]);
1869         }
1870 &my_endgrent();
1871 local $g;
1872 foreach $g (&list_groups()) {
1873         $_[0]->{$g->{'gid'}}++ if ($_[0]);
1874         $_[1]->{$g->{'group'}}++ if ($_[1]);
1875         }
1876 }
1877
1878 =head2 allocate_uid(&uids-used)
1879
1880 Given a hash reference whose keys are UIDs already in use, returns a free UID
1881 suitable for a new user.
1882
1883 =cut
1884 sub allocate_uid
1885 {
1886 local $rv = int($config{'base_uid'} > $access{'lowuid'} ?
1887                 $config{'base_uid'} : $access{'lowuid'});
1888 while($_[0]->{$rv}) {
1889         $rv++;
1890         }
1891 return $rv;
1892 }
1893
1894 =head2 allocate_gid(&gids-used)
1895
1896 Given a hash reference whose keys are GIDs already in use, returns a free GID
1897 suitable for a new group.
1898
1899 =cut
1900 sub allocate_gid
1901 {
1902 local $rv = int($config{'base_gid'} > $access{'lowgid'} ?
1903                 $config{'base_gid'} : $access{'lowgid'});
1904 while($_[0]->{$rv}) {
1905         $rv++;
1906         }
1907 return $rv;
1908 }
1909
1910 =head2 list_allowed_users(&access, &allusers)
1911
1912 Returns a list of users to whom access is allowed. The parameters are :
1913
1914 =item access - A hash reference of Webmin user permissions, such as returned by get_module_acl.
1915
1916 =item allusers - List of all users to filter down.
1917
1918 =cut
1919 sub list_allowed_users
1920 {
1921 local %access = %{$_[0]};
1922 local @ulist = @{$_[1]};
1923 if ($access{'uedit_mode'} == 1) {
1924         @ulist = ();
1925         }
1926 elsif ($access{'uedit_mode'} == 2) {
1927         local %canu;
1928         map { $canu{$_}++ } &split_quoted_string($access{'uedit'});
1929         @ulist = grep { $canu{$_->{'user'}} } @ulist;
1930         }
1931 elsif ($access{'uedit_mode'} == 3) {
1932         local %cannotu;
1933         map { $cannotu{$_}++ } &split_quoted_string($access{'uedit'});
1934         @ulist = grep { !$cannotu{$_->{'user'}} } @ulist;
1935         }
1936 elsif ($access{'uedit_mode'} == 4) {
1937         @ulist = grep {
1938                 (!$access{'uedit'} || $_->{'uid'} >= $access{'uedit'}) &&
1939                 (!$access{'uedit2'} || $_->{'uid'} <= $access{'uedit2'})
1940                         } @ulist;
1941         }
1942 elsif ($access{'uedit_mode'} == 5) {
1943         local %cangid;
1944         map { $cangid{$_}++ } &split_quoted_string($access{'uedit'});
1945         if ($access{'uedit_sec'}) {
1946                 # Match secondary groups too
1947                 local @glist = &list_groups();
1948                 local (@ucan, $g);
1949                 foreach $g (@glist) {
1950                         push(@ucan, split(/,/, $g->{'members'}))
1951                                 if ($cangid{$g->{'gid'}});
1952                         }
1953                 @ulist = grep { $cangid{$_->{'gid'}} ||
1954                                 &indexof($_->{'user'}, @ucan) >= 0 } @ulist;
1955                 }
1956         else {
1957                 @ulist = grep { $cangid{$_->{'gid'}} } @ulist;
1958                 }
1959         }
1960 elsif ($access{'uedit_mode'} == 6) {
1961         @ulist = grep { $_->{'user'} eq $remote_user } @ulist;
1962         }
1963 elsif ($access{'uedit_mode'} == 7) {
1964         @ulist = grep { $_->{'user'} =~ /$access{'uedit_re'}/ } @ulist;
1965         }
1966 elsif ($access{'uedit_mode'} == 8) {
1967         @ulist = grep {
1968                 (!$access{'uedit'} || $_->{'gid'} >= $access{'uedit'}) &&
1969                 (!$access{'uedit2'} || $_->{'gid'} <= $access{'uedit2'})
1970                         } @ulist;
1971         }
1972 if ($access{'view'}) {
1973         # Include non-editable users in results
1974         local @rv = @{$_[1]};
1975         local $u;
1976         foreach $u (@rv) {
1977                 if (&indexof($u, @ulist) < 0) {
1978                         $u->{'noedit'} = 1;
1979                         }
1980                 }
1981         return @rv;
1982         }
1983 else {
1984         return @ulist;
1985         }
1986 }
1987
1988 =head2 list_allowed_groups(&access, &allgroups)
1989
1990 Returns a list of groups to whom access is allowed. The parameters are :
1991
1992 =item access - A hash reference of Webmin user permissions, such as returned by get_module_acl.
1993
1994 =item allgroups - List of all Unix groups to filter down.
1995
1996 =cut
1997 sub list_allowed_groups
1998 {
1999 local %access = %{$_[0]};
2000 local @glist = @{$_[1]};
2001 if ($access{'gedit_mode'} == 1) {
2002         @glist = ();
2003         }
2004 elsif ($access{'gedit_mode'} == 2) {
2005         local %cang;
2006         map { $cang{$_}++ } &split_quoted_string($access{'gedit'});
2007         @glist = grep { $cang{$_->{'group'}} } @glist;
2008         }
2009 elsif ($access{'gedit_mode'} == 3) {
2010         local %cannotg;
2011         map { $cannotg{$_}++ } &split_quoted_string($access{'gedit'});
2012         @glist = grep { !$cannotg{$_->{'group'}} } @glist;
2013         }
2014 elsif ($access{'gedit_mode'} == 4) {
2015         @glist = grep {
2016                 (!$access{'gedit'} || $_->{'gid'} >= $access{'gedit'}) &&
2017                 (!$access{'gedit2'} || $_->{'gid'} <= $access{'gedit2'})
2018                         } @glist;
2019         }
2020 if ($access{'view'}) {
2021         # Include non-editable groups in results
2022         local @rv = @{$_[1]};
2023         local $g;
2024         foreach $g (@rv) {
2025                 if (&indexof($g, @glist) < 0) {
2026                         $g->{'noedit'} = 1;
2027                         }
2028                 }
2029         return @rv;
2030         }
2031 else {
2032         return @glist;
2033         }
2034 }
2035
2036 =head2 batch_start
2037
2038 Tells the create/modify/delete functions to only update files in memory,
2039 not on disk.
2040
2041 =cut
2042 sub batch_start
2043 {
2044 $batch_mode = 1;
2045 }
2046
2047 =head2 batch_end
2048
2049 Flushes any user file changes
2050
2051 =cut
2052 sub batch_end
2053 {
2054 $batch_mode = 0;
2055 &flush_file_lines();
2056 &refresh_nscd();
2057 }
2058
2059 #################################################################
2060
2061 sub mkuid
2062 {
2063 #################################################################
2064 ####
2065 #### Assumptions:
2066 ####
2067 #### This subroutine assumes the usernames are standardized
2068 #### using the format of 7 characters with 3 letters followed
2069 #### by 4 digits, or 4 letters followed by 3 digits.  If
2070 #### uppercase letters are used in the username, they will be
2071 #### converted to lowercase and this subroutine will generate
2072 #### a UID number identical to the usernames lowercase
2073 #### equivalent.
2074 ####
2075 #### 3 letters, 4 digits   Lowest possible UID (aaa0000) =   1,000,000
2076 #### 3 letters, 4 digits Hightest possible UID (zzz9999) = 176,759,999
2077 ####
2078 #### 4 letters, 3 digits   Lowest possible UID (aaaa000) = 176,760,000
2079 #### 4 letters, 3 digits Hightest possible UID (zzzz999) = 633,735,999
2080 ####
2081 #################################################################
2082     my ${num_let} = 0;
2083     foreach (split(//,$_[0])) {
2084       ++${num_let} if ( m/[a-z]/i );
2085     }
2086     if ( length($_[0]) ne 7 ) {
2087         print "ERROR: Number of characters in username $_[0] is not equal to 7\n";
2088         return -1;
2089     }
2090     if ( ${num_let} ne 3 && ${num_let} ne 4 ) {
2091         print "ERROR: Number of letters in username $_[0] is not equal to 3 or 4\n";
2092         return -1;
2093     }
2094     my ${mkuid_type} = 10 ** ( 7 - ${num_let} );
2095     my ${lowlimit} = 1000000;
2096     my %letters;
2097     my ${icnt} = -1;
2098     my ${lowuid};
2099     ${lowuid} = ( 26 ** ( ${num_let} - 1 ) * ${lowlimit}/100 ) + ${lowlimit};
2100     ${lowuid} = ${lowlimit} if ( ${num_let} eq 3 );
2101     my ${base} = 26;
2102
2103 #################################################################
2104 ####
2105 #### Establish an associative array containing all the
2106 #### letters of the alphabet and assign a numeric value
2107 #### to each letter from 1 - 26.
2108 ####
2109 #################################################################
2110     $letters{'a'} = ++${icnt};
2111     $letters{'b'} = ++${icnt};
2112     $letters{'c'} = ++${icnt};
2113     $letters{'d'} = ++${icnt};
2114     $letters{'e'} = ++${icnt};
2115     $letters{'f'} = ++${icnt};
2116     $letters{'g'} = ++${icnt};
2117     $letters{'h'} = ++${icnt};
2118     $letters{'i'} = ++${icnt};
2119     $letters{'j'} = ++${icnt};
2120     $letters{'k'} = ++${icnt};
2121     $letters{'l'} = ++${icnt};
2122     $letters{'m'} = ++${icnt};
2123     $letters{'n'} = ++${icnt};
2124     $letters{'o'} = ++${icnt};
2125     $letters{'p'} = ++${icnt};
2126     $letters{'q'} = ++${icnt};
2127     $letters{'r'} = ++${icnt};
2128     $letters{'s'} = ++${icnt};
2129     $letters{'t'} = ++${icnt};
2130     $letters{'u'} = ++${icnt};
2131     $letters{'v'} = ++${icnt};
2132     $letters{'w'} = ++${icnt};
2133     $letters{'x'} = ++${icnt};
2134     $letters{'y'} = ++${icnt};
2135     $letters{'z'} = ++${icnt};
2136
2137 #################################################################
2138 ####
2139 #### Initialize variables to be use while calculating the UID
2140 #### number associated with the login name.
2141 ####
2142 #### nvalue is used to store numeric characters that occurs
2143 ####     in the login name
2144 #### ecnt is used to keep track of the base 26 exponent for
2145 ####     each letter character that occurs in the login name
2146 #### subtot is the sum of the calculated value for each
2147 ####     character position in the login name
2148 #### mult is the total of the 26 ** ecnt at each iteration of
2149 ####     the loop
2150 ####
2151 #################################################################
2152     my ${kstring} = '';
2153     my ${nvalue} = '';
2154     my ${lvalue} = 0;
2155     my ${ecnt} = 0;
2156     my ${subtot} = 0;
2157     my ${tot} = 0;
2158     my ${mult} = 0;
2159 #################################################################
2160 ####
2161 #### each character position of the login name is split out
2162 #### and used as an iteration of the foreach loop
2163 ####
2164 #################################################################
2165
2166     foreach (split(//,$_[0])) {
2167
2168 #################################################################
2169 ####
2170 #### If the current character of the login name is a letter,
2171 #### convert it to lower case, and obtain it's numeric value
2172 #### from the associative array of letters, otherwise, if the
2173 #### current character is a number, append the number to the
2174 #### end of a buffer and save it for later processing.
2175 ####
2176 #################################################################
2177       if ( m/[a-z]/i ) {
2178         $kstring = "\L${_}";
2179         ${lvalue} = ${letters{${kstring}}};
2180       } else {
2181         ${lvalue} = 0;
2182         ${nvalue} = "${nvalue}${_}";
2183       }
2184 #################################################################
2185 #### Calculate the multiplier for a base 26 calculation using
2186 #### each iteration through the foreach loop as an increment
2187 #### of the exponent.  The base 26 exponent starting at 0.
2188 #################################################################
2189
2190       ${mult} = ${base} ** ${ecnt};
2191
2192 #################################################################
2193 ####
2194 #### Multiply the numeric value of the current character by
2195 #### the multiplier and add this result to a running subtotal
2196 #### of all characters of the login name.
2197 ####
2198 #################################################################
2199       ${subtot} = ${subtot} + ( ${lvalue} * ${mult} );
2200
2201 #################################################################
2202 ####
2203 #### Increment the base 26 exponent by one before iterating for
2204 #### the next character of the login name.
2205 ####
2206 #################################################################
2207       ++${ecnt}
2208     }
2209
2210 #################################################################
2211 ####
2212 #### After all characters of the login name have be processed,
2213 #### multiply the result by 1,000.  This is done because the
2214 #### username standard is 3 letters followed by 4 digits.  So
2215 #### each 3 letter combination can have 1,000 possible combinations.
2216 #### Then add the numeric values saved and any value to use
2217 #### as the lowest UID number allowed through this calculated method.
2218 ####
2219 #################################################################
2220
2221     ${tot} = ( ${subtot} * ${mkuid_type} ) + int(${nvalue}) + ${lowuid};
2222
2223 #################################################################
2224 ####
2225 #### Return the calculated UID number as the result of this
2226 #### subroutine.
2227 ####
2228 #################################################################
2229
2230     return ${tot};
2231 }
2232 ################################################################
2233 sub berkeley_cksum {
2234     my($crc) = my($len) = 0;
2235     my($buf,$num,$i);
2236     my($buflen) = 4096; # buffer is "4k", you can up it if you want...
2237
2238     $buf = $_[0];
2239     $num = length($buf);
2240
2241     $len += $num;
2242     foreach ( unpack("C*", $buf) ) {
2243         $crc |= 0x10000 if ( $crc & 1 ); # get ready for rotating the 1 below
2244         $crc = (($crc>>1)+$_) & 0xffff; # keep to 16-bit
2245     }
2246     return sprintf("%lu",${crc});;
2247 }
2248
2249 =head2 users_table(&users, [form], [no-last], [no-boxes], [&otherlinks], [&rightlinks])
2250
2251 Prints a table listing full user details, with checkboxes and buttons to
2252 delete or disable multiple at once.
2253
2254 =cut
2255 sub users_table
2256 {
2257 local ($users, $formno, $nolast, $noboxes, $links, $rightlinks) = @_;
2258
2259 local (@ginfo, %gidgrp);
2260 &my_setgrent();
2261 while(@ginfo = &my_getgrent()) {
2262         $gidgrp{$ginfo[2]} = $ginfo[0];
2263         }
2264 &my_endgrent();
2265
2266 # Work out if any users can be edited
2267 local $anyedit;
2268 foreach my $u (@$users) {
2269         if (!$u->{'noedit'}) {
2270                 $anyedit = 1;
2271                 last;
2272                 }
2273         }
2274 $anyedit = 0 if ($noboxes);
2275 local $lshow = !$nolast && $config{'last_show'};
2276
2277 local $buttons;
2278 $buttons .= &ui_submit($text{'index_mass'}, "delete") if ($access{'udelete'});
2279 $buttons .= &ui_submit($text{'index_mass2'}, "disable");
2280 $buttons .= &ui_submit($text{'index_mass3'}, "enable");
2281 $buttons .= "<br>" if ($buttons);
2282 local @linksrow;
2283 if ($anyedit) {
2284         print &ui_form_start("mass_delete_user.cgi", "post");
2285         push(@linksrow, &select_all_link("d", $_[1]),
2286                         &select_invert_link("d", $_[1]));
2287         }
2288 push(@linksrow, @$links);
2289 local @grid = ( &ui_links_row(\@linksrow), &ui_links_row($rightlinks) );
2290 print &ui_grid_table(\@grid, 2, 100, [ "align=left", "align=right" ]);
2291
2292 local @tds = $anyedit ? ( "width=5" ) : ( );
2293 push(@tds, "width=15%", "width=10%");
2294 print &ui_columns_start([
2295         $anyedit ? ( "" ) : ( ),
2296         $text{'user'},
2297         $text{'uid'},
2298         $text{'gid'},
2299         $text{'real'},
2300         $text{'home'},
2301         $text{'shell'},
2302         $lshow ? ( $text{'lastlogin'} ) : ( )
2303         ], 100, 0, \@tds);
2304 local $llogin;
2305 if ($lshow) {
2306         $llogin = &get_recent_logins();
2307         if (&foreign_check("mailboxes")) {
2308                 &foreign_require("mailboxes");
2309                 }
2310         }
2311 local $u;
2312 foreach $u (@$users) {
2313         $u->{'real'} =~ s/,.*$// if ($config{'extra_real'} ||
2314                                      $u->{'real'} =~ /,$/);
2315         local @cols;
2316         push(@cols, "") if ($anyedit && $u->{'noedit'});
2317         push(@cols, &user_link($u));
2318         push(@cols, $u->{'uid'});
2319         push(@cols, &html_escape($gidgrp{$u->{'gid'}} || $u->{'gid'}));
2320         push(@cols, &html_escape($u->{'real'}));
2321         push(@cols, &html_escape($u->{'home'}));
2322         push(@cols, &html_escape($u->{'shell'}));
2323         if ($lshow) {
2324                 # Show last login, in local format after Unix time conversion
2325                 my $ll = $llogin->{$u->{'user'}};
2326                 if (defined(&mailboxes::parse_mail_date)) {
2327                         my $tm = &mailboxes::parse_mail_date($ll);
2328                         if ($tm) {
2329                                 $ll = &make_date($tm);
2330                                 }
2331                         }
2332                 push(@cols, &html_escape($ll));
2333                 }
2334         if ($u->{'noedit'}) {
2335                 print &ui_columns_row(\@cols, \@tds);
2336                 }
2337         else {
2338                 print &ui_checked_columns_row(\@cols, \@tds, "d", $u->{'user'});
2339                 }
2340         }
2341 print &ui_columns_end();
2342 print &ui_links_row(\@linksrow);
2343 if ($anyedit) {
2344         print $buttons;
2345         print &ui_form_end();
2346         }
2347 }
2348
2349 =head2 groups_table(&groups, [form], [no-buttons], [&otherlinks], [&rightlinks])
2350
2351 Prints a table of groups, possibly with checkboxes and a delete button
2352
2353 =cut
2354 sub groups_table
2355 {
2356 local ($groups, $formno, $noboxes, $links, $rightlinks) = @_;
2357
2358 # Work out if any groups can be edited or have descriptions
2359 local $anyedit;
2360 local $anydesc;
2361 foreach my $g (@$groups) {
2362         if (!$g->{'noedit'}) {
2363                 $anyedit = 1;
2364                 }
2365         if ($g->{'desc'}) {
2366                 $anydesc = 1;
2367                 }
2368         }
2369 $anyedit = 0 if ($noboxes);
2370
2371 local @linksrow;
2372 if ($anyedit && $access{'gdelete'}) {
2373         print &ui_form_start("mass_delete_group.cgi", "post");
2374         push(@linksrow, &select_all_link("gd", $formno),
2375                         &select_invert_link("gd", $formno) );
2376         }
2377 push(@linksrow, @$links);
2378 local @grid = ( &ui_links_row(\@linksrow), &ui_links_row($rightlinks) );
2379 print &ui_grid_table(\@grid, 2, 100, [ "align=left", "align=right" ]);
2380
2381 local @tds = $anyedit ? ( "width=5" ) : ( );
2382 push(@tds, "width=15%", "width=10%");
2383 print &ui_columns_start([
2384         $anyedit ? ( "" ) : ( ),
2385         $text{'gedit_group'},
2386         $text{'gedit_gid'},
2387         $anydesc ? ( $text{'gedit_desc'} ) : ( ),
2388         $text{'gedit_members'} ], 100, 0, \@tds);
2389 local $g;
2390 foreach $g (@$groups) {
2391         local $members = join(" ", split(/,/, $g->{'members'}));
2392         local @cols;
2393         if ($anyedit && ($g->{'noedit'} || !$access{'gdelete'})) {
2394                 # Need an explicity blank first column
2395                 push(@cols, "");
2396                 }
2397         push(@cols, &group_link($g));
2398         push(@cols, $g->{'gid'});
2399         if ($anydesc) {
2400                 push(@cols, &html_escape($g->{'desc'}));
2401                 }
2402         push(@cols, &html_escape($members));
2403         if ($g->{'noedit'} || !$access{'gdelete'}) {
2404                 print &ui_columns_row(\@cols, \@tds);
2405                 }
2406         else {
2407                 print &ui_checked_columns_row(\@cols, \@tds, "gd",
2408                                               $g->{'group'});
2409                 }
2410         }
2411 print &ui_columns_end();
2412 print &ui_links_row(\@linksrow);
2413 if ($anyedit && $access{'gdelete'}) {
2414         print &ui_submit($text{'index_gmass'}, "delete"),"<br>\n";
2415         print &ui_form_end();
2416         }
2417 }
2418
2419 =head2 date_input(day, month, year, prefix)
2420
2421 Returns HTML for selecting a date
2422
2423 =cut
2424 sub date_input
2425 {
2426 local ($d, $m, $y, $prefix) = @_;
2427 local $rv;
2428 $rv .= &ui_textbox($prefix."d", $d, 3)."/";
2429 $rv .= &ui_select($prefix."m", $m,
2430                 [ map { [ $_, $text{"smonth_".$_} ] } (1..12) ])."/";
2431 $rv .= &ui_textbox($prefix."y", $y, 5);
2432 $rv .= &date_chooser_button($prefix."d", $prefix."m", $prefix."y");
2433 return $rv;
2434 }
2435
2436 =head2 list_last_logins([user], [max])
2437
2438 Returns a list of array references, each containing the details of a login.
2439
2440 =cut
2441 sub list_last_logins
2442 {
2443 local @rv;
2444 &open_last_command(LAST, $_[0]);
2445 while(@last = &read_last_line(LAST)) {
2446         push(@rv, [ @last ]);
2447         if ($_[1] && scalar(@rv) >= $_[1]) {
2448                 last;   # reached max
2449                 }
2450         }
2451 close(LAST);
2452 return @rv;
2453 }
2454
2455 =head2 get_recent_logins()
2456
2457 Returns a hash ref from username to most recent login time/date
2458
2459 =cut
2460 sub get_recent_logins
2461 {
2462 if (defined(&os_most_recent_logins)) {
2463         return &os_most_recent_logins();
2464         }
2465 else {
2466         my %rv;
2467         foreach my $l (&list_last_logins()) {
2468                 $rv{$l->[0]} ||= $l->[3];
2469                 }
2470         return \%rv;
2471         }
2472 }
2473
2474 =head2 user_link(&user)
2475
2476 Returns a link to a user editing form. Mainly for internal use.
2477
2478 =cut
2479 sub user_link
2480 {
2481 if ($_[0]->{'pass'} =~ /^\Q$disable_string\E/) {
2482         $dis = "<i>".&html_escape($_[0]->{'user'})."</i>";
2483         }
2484 else {
2485         $dis = &html_escape($_[0]->{'user'});
2486         }
2487 if ($_[0]->{'noedit'}) {
2488         return $dis;
2489         }
2490 elsif ($_[0]->{'dn'}) {
2491         return "<a href='edit_user.cgi?dn=".&urlize($_[0]->{'dn'})."'>".
2492                "$dis</a>";
2493         }
2494 else {
2495         return "<a href='edit_user.cgi?user=".&urlize($_[0]->{'user'})."'>".
2496                "$dis</a>";
2497         }
2498 }
2499
2500 =head2 group_link(&group)
2501
2502 Returns a link to a group editing form. Mainly for internal use.
2503
2504 =cut
2505 sub group_link
2506 {
2507 if ($_[0]->{'noedit'}) {
2508         return &html_escape($_[0]->{'group'});
2509         }
2510 elsif ($_[0]->{'dn'}) {
2511         return "<a href='edit_group.cgi?dn=".&urlize($_[0]->{'dn'})."'>".
2512                &html_escape($_[0]->{'group'})."</a>";
2513         }
2514 else {
2515         return "<a href='edit_group.cgi?group=".&urlize($_[0]->{'group'})."'>".
2516                &html_escape($_[0]->{'group'})."</a>";
2517         }
2518 }
2519
2520 =head2 sort_users(&users, mode)
2521
2522 Sorts a list of users according to the user's preference for this module,
2523 and returns the results.
2524
2525 =cut
2526 sub sort_users
2527 {
2528 local ($users, $mode) = @_;
2529 local @ulist = @$users;
2530 if ($mode == 1) {
2531         @ulist = sort { $a->{'user'} cmp $b->{'user'} } @ulist;
2532         }
2533 elsif ($mode == 2) {
2534         @ulist = sort { lc($a->{'real'}) cmp lc($b->{'real'}) } @ulist;
2535         }
2536 elsif ($mode == 3) {
2537         @ulist = sort { @wa = split(/\s+/, $a->{'real'});
2538                         @wb = split(/\s+/, $b->{'real'});
2539                         lc($wa[@wa-1]) cmp lc($wb[@wb-1]) } @ulist;
2540         }
2541 elsif ($mode == 4) {
2542         @ulist = sort { $a->{'shell'} cmp $b->{'shell'} } @ulist;
2543         }
2544 elsif ($mode == 5) {
2545         @ulist = sort { $a->{'uid'} <=> $b->{'uid'} } @ulist;
2546         }
2547 elsif ($mode == 6) {
2548         @ulist = sort { $a->{'home'} cmp $b->{'home'} } @ulist;
2549         }
2550 return @ulist;
2551 }
2552
2553 =head2 sort_groups(&groups, mode)
2554
2555 Sorts a list of groups according to the user's preference for this module,
2556 and returns the results.
2557
2558 =cut
2559 sub sort_groups
2560 {
2561 local ($groups, $mode) = @_;
2562 local @glist = @$groups;
2563 if ($mode == 5) {
2564         @glist = sort { $a->{'gid'} <=> $b->{'gid'} } @glist;
2565         }
2566 elsif ($mode == 1) {
2567         @glist = sort { $a->{'group'} cmp $b->{'group'} } @glist;
2568         }
2569 return @glist;
2570 }
2571
2572 =head2 create_home_directory(&user, [real-dir])
2573
2574 Creates and chmod's the home directory for a user, or calls error on failure.
2575
2576 =cut
2577 sub create_home_directory
2578 {
2579 local ($user, $home) = @_;
2580 $home ||= $user->{'home'};
2581 &lock_file($home);
2582 &make_dir($home, oct($config{'homedir_perms'}), 1) ||
2583         &error(&text('usave_emkdir', $!));
2584 &set_ownership_permissions($user->{'uid'}, $user->{'gid'},
2585                            oct($config{'homedir_perms'}), $home) ||
2586         &error(&text('usave_echmod', $!));
2587 if ($config{'selinux_con'} && &is_selinux_enabled() && &has_command("chcon")) {
2588         &system_logged("chcon ".quotemeta($config{'selinux_con'}).
2589                        " ".quotemeta($home)." >/dev/null 2>&1");
2590         }
2591 &unlock_file($home);
2592 }
2593
2594 =head2 delete_home_directory(&user)
2595
2596 Deletes some users home directory.
2597
2598 =cut
2599 sub delete_home_directory
2600 {
2601 local ($user) = @_;
2602 if ($user->{'home'} && -d $user->{'home'}) {
2603         local $realhome = &resolve_links($user->{'home'});
2604         local $qhome = quotemeta($realhome);
2605         if ($config{'delete_only'}) {
2606                 &system_logged("find $qhome ! -type d -user $user->{'uid'} | xargs rm -f >/dev/null 2>&1");
2607                 &system_logged("find $qhome -type d -user $user->{'uid'} | xargs rmdir >/dev/null 2>&1");
2608                 &unlink_file($realhome);
2609                 }
2610         else {
2611                 &system_logged("rm -rf $qhome >/dev/null 2>&1");
2612                 }
2613         unlink($user->{'home'});        # in case of links
2614         }
2615 }
2616
2617 =head2 supports_temporary_disable
2618
2619 Returns 1 if temporary locking of passwords (with an ! at the start of the
2620 hash) is supported on this OS.
2621
2622 =cut
2623 sub supports_temporary_disable
2624 {
2625 return &passfiles_type() != 7;    # Not on OSX, which has a fixed-size hash
2626 }
2627
2628 =head2 change_all_home_groups(old-gid, new-gid, &members)
2629
2630 Change the GID on all files in the home directories of users whose GID is the
2631 old GID.
2632
2633 =cut
2634 sub change_all_home_groups
2635 {
2636 local ($oldgid, $gid, $mems) = @_;
2637 &my_setpwent();
2638 while(my @uinfo = &my_getpwent()) {
2639         if ($uinfo[3] == $oldgid || &indexof($uinfo[0], @$mems) >= 0) {
2640                 &recursive_change($uinfo[7], -1, $oldgid, -1, $gid);
2641                 }
2642         }
2643 &my_endpwent();
2644 }
2645
2646 =head2 generate_random_password()
2647
2648 Returns a randomly generated 15 character password
2649
2650 =cut
2651 sub generate_random_password
2652 {
2653 &seed_random();
2654 my $rv;
2655 foreach (1 .. 15) {
2656         $rv .= $random_password_chars[rand(scalar(@random_password_chars))];
2657         }
2658 return $rv;
2659 }
2660
2661 1;