acl/acl-lib.pl

   1 =head1 acl-lib.pl
   2
   3 Library for editing webmin users, passwords and access rights.
   4
   5  foreign_require("acl", "acl-lib.pl");
   6  @users = acl::list_users();
   7  $newguy = { 'name' => 'newguy',
   8              'pass' => acl::encrypt_password('smeg'),
   9              'modules' => [ 'useradmin' ] };
  10  acl::create_user($newguy);
  11
  12 =cut
  13
  14 BEGIN { push(@INC, ".."); };
  15 use WebminCore;
  16 &init_config();
  17 do 'md5-lib.pl';
  18 %access = &get_module_acl();
  19 $access{'switch'} = 0 if (&is_readonly_mode());
  20
  21 =head2 list_users([&only-users])
  22
  23 Returns a list of hashes containing Webmin user details. Useful keys include :
  24
  25 =item name - Login name
  26
  27 =item pass - Encrypted password
  28
  29 =item modules - Array references of modules
  30
  31 =item theme - Custom theme, if any
  32
  33 If the only-users parameter is given, limit the list to just users with
  34 those usernames.
  35
  36 =cut
  37 sub list_users
  38 {
  39 my ($only) = @_;
  40 my (%miniserv, @rv, %acl, %logout);
  41 local %_;
  42 &read_acl(undef, \%acl);
  43 &get_miniserv_config(\%miniserv);
  44 foreach my $a (split(/\s+/, $miniserv{'logouttimes'})) {
  45         if ($a =~ /^([^=]+)=(\S+)$/) {
  46                 $logout{$1} = $2;
  47                 }
  48         }
  49 open(PWFILE, $miniserv{'userfile'});
  50 while(<PWFILE>) {
  51         s/\r|\n//g;
  52         local @user = split(/:/, $_);
  53         if (@user) {
  54                 my %user;
  55                 next if ($only && &indexof($user[0], @$only) < 0);
  56                 $user{'name'} = $user[0];
  57                 $user{'pass'} = $user[1];
  58                 $user{'sync'} = $user[2];
  59                 $user{'cert'} = $user[3];
  60                 if ($user[4] =~ /^(allow|deny)\s+(.*)/) {
  61                         $user{$1} = $2;
  62                         }
  63                 if ($user[5] =~ /days\s+(\S+)/) {
  64                         $user{'days'} = $1;
  65                         }
  66                 if ($user[5] =~ /hours\s+(\d+\.\d+)-(\d+\.\d+)/) {
  67                         $user{'hoursfrom'} = $1;
  68                         $user{'hoursto'} = $2;
  69                         }
  70                 $user{'lastchange'} = $user[6];
  71                 $user{'olds'} = [ split(/\s+/, $user[7]) ];
  72                 $user{'minsize'} = $user[8];
  73                 $user{'nochange'} = int($user[9]);
  74                 $user{'temppass'} = int($user[10]);
  75                 $user{'modules'} = $acl{$user[0]};
  76                 $user{'lang'} = $gconfig{"lang_$user[0]"};
  77                 $user{'notabs'} = $gconfig{"notabs_$user[0]"};
  78                 $user{'skill'} = $gconfig{"skill_$user[0]"};
  79                 $user{'risk'} = $gconfig{"risk_$user[0]"};
  80                 $user{'rbacdeny'} = $gconfig{"rbacdeny_$user[0]"};
  81                 if ($gconfig{"theme_$user[0]"}) {
  82                         ($user{'theme'}, $user{'overlay'}) =
  83                                 split(/\s+/, $gconfig{"theme_$user[0]"});
  84                         }
  85                 elsif (defined($gconfig{"theme_$user[0]"})) {
  86                         $user{'theme'} = "";
  87                         }
  88                 $user{'readonly'} = $gconfig{"readonly_$user[0]"};
  89                 $user{'ownmods'} = [ split(/\s+/,
  90                                            $gconfig{"ownmods_$user[0]"}) ];
  91                 $user{'logouttime'} = $logout{$user[0]};
  92                 $user{'real'} = $gconfig{"realname_$user[0]"};
  93                 push(@rv, \%user);
  94                 }
  95         }
  96 close(PWFILE);
  97
  98 # If a user DB is enabled, get users from it too
  99 if ($miniserv{'userdb'}) {
 100         my ($dbh, $proto, $prefix, $args) =&connect_userdb($miniserv{'userdb'});
 101         &error("Failed to connect to user database : $dbh") if (!ref($dbh));
 102         if ($proto eq "mysql" || $proto eq "postgresql") {
 103                 # Fetch users with SQL
 104                 my %userid;
 105                 my $cmd = $dbh->prepare(
 106                         "select id,name,pass from webmin_user".
 107                         ($only ? " where name in (".
 108                                  join(",", map { "'$_'" } @$only).")" : ""));
 109                 $cmd && $cmd->execute() ||
 110                         &error("Failed to query users : ".$dbh->errstr);
 111                 while(my ($id, $name, $pass) = $cmd->fetchrow()) {
 112                         my $u = { 'name' => $name,
 113                                   'pass' => $pass,
 114                                   'proto' => $proto,
 115                                   'id' => $id };
 116                         push(@rv, $u);
 117                         $userid{$id} = $u;
 118                         }
 119                 $cmd->finish();
 120
 121                 # Add user attributes
 122                 my $cmd = $dbh->prepare(
 123                         "select id,attr,value from webmin_user_attr ".
 124                         ($only && %userid ?
 125                          " where id in (".join(",", keys %userid).")" : ""));
 126                 $cmd && $cmd->execute() ||
 127                         &error("Failed to query user attrs : ".$dbh->errstr);
 128                 while(my ($id, $attr, $value) = $cmd->fetchrow()) {
 129                         if ($attr eq "olds" || $attr eq "modules" ||
 130                             $attr eq "ownmods") {
 131                                 $value = [ split(/\s+/, $value) ];
 132                                 }
 133                         $userid{$id}->{$attr} = $value;
 134                         }
 135                 $cmd->finish();
 136                 }
 137         elsif ($proto eq "ldap") {
 138                 # Find users with LDAP query
 139                 my $filter = '(objectClass='.$args->{'userclass'}.')';
 140                 if ($only) {
 141                         my $ufilter =
 142                                 "(|".join("", map { "(cn=$_)" } @$only).")";
 143                         $filter = "(&".$filter.$ufilter.")";
 144                         }
 145                 my $rv = $dbh->search(
 146                         base => $prefix,
 147                         filter => $filter,
 148                         scope => 'sub');
 149                 if (!$rv || $rv->code) {
 150                         &error("Failed to search users : ".
 151                                 ($rv ? $rv->error : "Unknown error"));
 152                         }
 153                 foreach my $l ($rv->all_entries) {
 154                         my $u = { 'name' => $l->get_value('cn'),
 155                                   'pass' => $l->get_value('webminPass'),
 156                                   'proto' => $proto,
 157                                   'id' => $l->dn() };
 158                         foreach my $la ($l->get_value('webminAttr')) {
 159                                 my ($attr, $value) = split(/=/, $la, 2);
 160                                 if ($attr eq "olds" || $attr eq "ownmods") {
 161                                         $value = [ split(/\s+/, $value) ];
 162                                         }
 163                                 $u->{$attr} = $value;
 164                                 }
 165                         $u->{'modules'} = [ $l->get_value('webminModule') ];
 166                         push(@rv, $u);
 167                         }
 168                 }
 169         &disconnect_userdb($miniserv{'userdb'}, $dbh);
 170         }
 171
 172 return @rv;
 173 }
 174
 175 =head2 get_user(username)
 176
 177 Returns a hash ref of details of the user with some name, in the same format
 178 as list_users. Returns undef if not found
 179
 180 =cut
 181 sub get_user
 182 {
 183 my ($username) = @_;
 184 my @rv = &list_users([ $username ]);
 185 my ($user) = grep { $_->{'name'} eq $username } @rv;
 186 return $user;
 187 }
 188
 189 =head2 list_groups([&only-groups])
 190
 191 Returns a list of hashes, one per Webmin group. Group membership is stored in
 192 /etc/webmin/webmin.groups, and other attributes in the config file. Useful
 193 keys include :
 194
 195 =item name - Group name
 196
 197 =item members - Array reference of member users
 198
 199 =item modules - Modules to grant to members
 200
 201 If the only-groups parameter is given, limit the list to just groups with
 202 those group names.
 203
 204 =cut
 205 sub list_groups
 206 {
 207 my ($only) = @_;
 208 my @rv;
 209 my %miniserv;
 210 &get_miniserv_config(\%miniserv);
 211
 212 # Add groups from local files
 213 open(GROUPS, "$config_directory/webmin.groups");
 214 while(<GROUPS>) {
 215         s/\r|\n//g;
 216         local @g = split(/:/, $_);
 217         if (@g) {
 218                 next if ($only && &indexof($g[0], @$only) < 0);
 219                 local $group = { 'name' => $g[0],
 220                                  'members' => [ split(/\s+/, $g[1]) ],
 221                                  'modules' => [ split(/\s+/, $g[2]) ],
 222                                  'desc' => $g[3],
 223                                  'ownmods' => [ split(/\s+/, $g[4]) ] };
 224                 push(@rv, $group);
 225                 }
 226         }
 227 close(GROUPS);
 228
 229 # If a user DB is enabled, get groups from it too
 230 if ($miniserv{'userdb'}) {
 231         my ($dbh, $proto, $prefix, $args) =&connect_userdb($miniserv{'userdb'});
 232         &error("Failed to connect to group database : $dbh") if (!ref($dbh));
 233         if ($proto eq "mysql" || $proto eq "postgresql") {
 234                 # Fetch groups with SQL
 235                 my %groupid;
 236                 my $cmd = $dbh->prepare(
 237                         "select id,name,description from webmin_group ".
 238                         ($only ? " where name in (".
 239                                  join(",", map { "'$_'" } @$only).")" : ""));
 240                 $cmd && $cmd->execute() ||
 241                         &error("Failed to query groups : ".$dbh->errstr);
 242                 while(my ($id, $name, $desc) = $cmd->fetchrow()) {
 243                         my $g = { 'name' => $name,
 244                                   'desc' => $desc,
 245                                   'proto' => $proto,
 246                                   'id' => $id };
 247                         push(@rv, $g);
 248                         $groupid{$id} = $g;
 249                         }
 250                 $cmd->finish();
 251
 252                 # Add group attributes
 253                 my $cmd = $dbh->prepare(
 254                         "select id,attr,value from webmin_group_attr ".
 255                         ($only && %userid ?
 256                          " where id in (".join(",", keys %userid).")" : ""));
 257                 $cmd && $cmd->execute() ||
 258                         &error("Failed to query group attrs : ".$dbh->errstr);
 259                 while(my ($id, $attr, $value) = $cmd->fetchrow()) {
 260                         if ($attr eq "members" || $attr eq "modules" ||
 261                             $attr eq "ownmods") {
 262                                 $value = [ split(/\s+/, $value) ];
 263                                 }
 264                         $groupid{$id}->{$attr} = $value;
 265                         }
 266                 $cmd->finish();
 267                 }
 268         elsif ($proto eq "ldap") {
 269                 # Find groups with LDAP query
 270                 my $filter = '(objectClass='.$args->{'groupclass'}.')';
 271                 if ($only) {
 272                         my $gfilter =
 273                                 "(|".join("", map { "(cn=$_)" } @$only).")";
 274                         $filter = "(&".$filter.$gfilter.")";
 275                         }
 276                 my $rv = $dbh->search(
 277                         base => $prefix,
 278                         filter => $filter,
 279                         scope => 'sub');
 280                 if (!$rv || $rv->code) {
 281                         &error("Failed to search groups : ".
 282                                 ($rv ? $rv->error : "Unknown error"));
 283                         }
 284                 foreach my $l ($rv->all_entries) {
 285                         my $g = { 'name' => $l->get_value('cn'),
 286                                   'desc' => $l->get_value('webminDesc'),
 287                                   'proto' => $proto,
 288                                   'id' => $l->dn() };
 289                         foreach my $la ($l->get_value('webminAttr')) {
 290                                 my ($attr, $value) = split(/=/, $la, 2);
 291                                 if ($attr eq "members" || $attr eq "ownmods") {
 292                                         $value = [ split(/\s+/, $value) ];
 293                                         }
 294                                 $g->{$attr} = $value;
 295                                 }
 296                         $g->{'modules'} = [ $l->get_value('webminModule') ];
 297                         push(@rv, $g);
 298                         }
 299                 }
 300         &disconnect_userdb($miniserv{'userdb'}, $dbh);
 301         }
 302
 303 return @rv;
 304 }
 305
 306 =head2 get_group(groupname)
 307
 308 Returns a hash ref of details of the group with some name, in the same format
 309 as list_groups. Returns undef if not found
 310
 311 =cut
 312 sub get_group
 313 {
 314 my ($groupname) = @_;
 315 my @rv = &list_groups([ $groupname ]);
 316 my ($group) = grep { $_->{'name'} eq $groupname } @rv;
 317 return $group;
 318 }
 319
 320 =head2 list_modules
 321
 322 Returns a list of the dirs of all modules available on this system.
 323
 324 =cut
 325 sub list_modules
 326 {
 327 return map { $_->{'dir'} } &list_module_infos();
 328 }
 329
 330 =head2 list_module_infos
 331
 332 Returns a list of the details of all modules that can be used on this system,
 333 each of which is a hash reference in the same format as their module.info files.
 334
 335 =cut
 336 sub list_module_infos
 337 {
 338 my @mods = grep { &check_os_support($_) } &get_all_module_infos();
 339 return sort { $a->{'desc'} cmp $b->{'desc'} } @mods;
 340 }
 341
 342 =head2 create_user(&details, [clone])
 343
 344 Creates a new Webmin user, based on the hash reference in the details parameter.
 345 This must be in the same format as those returned by list_users. If the clone
 346 parameter is given, it must be a username to copy detailed access control
 347 settings from for this new user.
 348
 349 =cut
 350 sub create_user
 351 {
 352 my %user = %{$_[0]};
 353 my $clone = $_[1];
 354 my %miniserv;
 355 my @mods = &list_modules();
 356
 357 &get_miniserv_config(\%miniserv);
 358
 359 if ($miniserv{'userdb'} && !$miniserv{'userdb_addto'}) {
 360         # Adding to user database
 361         my ($dbh, $proto, $prefix, $args) =&connect_userdb($miniserv{'userdb'});
 362         &error("Failed to connect to user database : $dbh") if (!ref($dbh));
 363         if ($proto eq "mysql" || $proto eq "postgresql") {
 364                 # Add user with SQL
 365                 my $cmd = $dbh->prepare("insert into webmin_user (name,pass) values (?, ?)");
 366                 $cmd && $cmd->execute($user{'name'}, $user{'pass'}) ||
 367                         &error("Failed to add user : ".$dbh->errstr);
 368                 $cmd->finish();
 369                 my $cmd = $dbh->prepare("select max(id) from webmin_user");
 370                 $cmd->execute();
 371                 my ($id) = $cmd->fetchrow();
 372                 $cmd->finish();
 373
 374                 # Add other attributes
 375                 my $cmd = $dbh->prepare("insert into webmin_user_attr (id,attr,value) values (?, ?, ?)");
 376                 foreach my $attr (keys %user) {
 377                         next if ($attr eq "name" || $attr eq "pass");
 378                         my $value = $user{$attr};
 379                         if ($attr eq "olds" || $attr eq "modules" ||
 380                             $attr eq "ownmods") {
 381                                 $value = join(" ", @$value);
 382                                 }
 383                         $cmd->execute($id, $attr, $value) ||
 384                                 &error("Failed to add user attribute : ".
 385                                         $dbh->errstr);
 386                         $cmd->finish();
 387                         }
 388                 $_[0]->{'id'} = $id;
 389                 $_[0]->{'proto'} = $proto;
 390                 }
 391         elsif ($proto eq "ldap") {
 392                 # Add user to LDAP
 393                 my $dn = "cn=".$user{'name'}.",".$prefix;
 394                 my @attrs = ( "objectClass", $args->{'userclass'},
 395                               "cn", $user{'name'},
 396                               "webminPass", $user{'pass'} );
 397                 my @webminattrs;
 398                 foreach my $attr (keys %user) {
 399                         next if ($attr eq "name" || $attr eq "pass" ||
 400                                  $attr eq "modules");
 401                         my $value = $user{$attr};
 402                         if ($attr eq "olds" || $attr eq "ownmods") {
 403                                 $value = join(" ", @$value);
 404                                 }
 405                         push(@webminattrs,
 406                              defined($value) ? $attr."=".$value : $attr);
 407                         }
 408                 if (@webminattrs) {
 409                         push(@attrs, "webminAttr", \@webminattrs);
 410                         }
 411                 if (@{$user{'modules'}}) {
 412                         push(@attrs, "webminModule", $user{'modules'});
 413                         }
 414                 my $rv = $dbh->add($dn, attr => \@attrs);
 415                 if (!$rv || $rv->code) {
 416                         &error("Failed to add user to LDAP : ".
 417                                ($rv ? $rv->error : "Unknown error"));
 418                         }
 419                 $_[0]->{'id'} = $dn;
 420                 $_[0]->{'proto'} = 'ldap';
 421                 }
 422         &disconnect_userdb($miniserv{'userdb'}, $dbh);
 423         $user{'proto'} = $proto;
 424         }
 425 else {
 426         # Adding to local files
 427         &lock_file($ENV{'MINISERV_CONFIG'});
 428         if ($user{'theme'}) {
 429                 $miniserv{"preroot_".$user{'name'}} =
 430                         $user{'theme'}.($user{'overlay'} ? " ".$user{'overlay'} : "");
 431                 }
 432         elsif (defined($user{'theme'})) {
 433                 $miniserv{"preroot_".$user{'name'}} = "";
 434                 }
 435         if (defined($user{'logouttime'})) {
 436                 my @logout = split(/\s+/, $miniserv{'logouttimes'});
 437                 push(@logout, "$user{'name'}=$user{'logouttime'}");
 438                 $miniserv{'logouttimes'} = join(" ", @logout);
 439                 }
 440         &put_miniserv_config(\%miniserv);
 441         &unlock_file($ENV{'MINISERV_CONFIG'});
 442
 443         my @times;
 444         push(@times, "days", $user{'days'}) if ($user{'days'} ne '');
 445         push(@times, "hours", $user{'hoursfrom'}."-".$user{'hoursto'})
 446                 if ($user{'hoursfrom'});
 447         &lock_file($miniserv{'userfile'});
 448         &open_tempfile(PWFILE, ">>$miniserv{'userfile'}");
 449         &print_tempfile(PWFILE,
 450                 "$user{'name'}:$user{'pass'}:$user{'sync'}:$user{'cert'}:",
 451                 ($user{'allow'} ? "allow $user{'allow'}" :
 452                  $user{'deny'} ? "deny $user{'deny'}" : ""),":",
 453                 join(" ", @times),":",
 454                 $user{'lastchange'},":",
 455                 join(" ", @{$user{'olds'}}),":",
 456                 $user{'minsize'},":",
 457                 $user{'nochange'},":",
 458                 $user{'temppass'},
 459                 "\n");
 460         &close_tempfile(PWFILE);
 461         &unlock_file($miniserv{'userfile'});
 462
 463         &lock_file(&acl_filename());
 464         &open_tempfile(ACL, ">>".&acl_filename());
 465         &print_tempfile(ACL, &acl_line(\%user, \@mods));
 466         &close_tempfile(ACL);
 467         &unlock_file(&acl_filename());
 468
 469         delete($gconfig{"lang_".$user{'name'}});
 470         $gconfig{"lang_".$user{'name'}} = $user{'lang'} if ($user{'lang'});
 471         delete($gconfig{"notabs_".$user{'name'}});
 472         $gconfig{"notabs_".$user{'name'}} = $user{'notabs'} if ($user{'notabs'});
 473         delete($gconfig{"skill_".$user{'name'}});
 474         $gconfig{"skill_".$user{'name'}} = $user{'skill'} if ($user{'skill'});
 475         delete($gconfig{"risk_".$user{'name'}});
 476         $gconfig{"risk_".$user{'name'}} = $user{'risk'} if ($user{'risk'});
 477         delete($gconfig{"rbacdeny_".$user{'name'}});
 478         $gconfig{"rbacdeny_".$user{'name'}} = $user{'rbacdeny'} if ($user{'rbacdeny'});
 479         delete($gconfig{"ownmods_".$user{'name'}});
 480         $gconfig{"ownmods_".$user{'name'}} = join(" ", @{$user{'ownmods'}})
 481                 if (@{$user{'ownmods'}});
 482         delete($gconfig{"theme_".$user{'name'}});
 483         if ($user{'theme'}) {
 484                 $gconfig{"theme_".$user{'name'}} =
 485                         $user{'theme'}.($user{'overlay'} ? " ".$user{'overlay'} : "");
 486                 }
 487         elsif (defined($user{'theme'})) {
 488                 $gconfig{"theme_".$user{'name'}} = '';
 489                 }
 490         $gconfig{"readonly_".$user{'name'}} = $user{'readonly'}
 491                 if (defined($user{'readonly'}));
 492         $gconfig{"realname_".$user{'name'}} = $user{'real'}
 493                 if (defined($user{'real'}));
 494         &write_file("$config_directory/config", \%gconfig);
 495         }
 496
 497 # Copy ACLs from user being cloned
 498 if ($clone) {
 499         &copy_acl_files($clone, $user{'name'}, [ "", @mods ]);
 500         }
 501 }
 502
 503 =head2 modify_user(old-name, &details)
 504
 505 Updates an existing Webmin user, identified by the old-name paramter. The
 506 details hash must be in the same format as returned by list_users or passed
 507 to create_user.
 508
 509 =cut
 510 sub modify_user
 511 {
 512 my $username = $_[0];
 513 my %user = %{$_[1]};
 514 my (%miniserv, @pwfile, @acl, @mods, $m);
 515 local $_;
 516 &get_miniserv_config(\%miniserv);
 517
 518 if ($user{'proto'}) {
 519         # In users and groups DB
 520         my ($dbh, $proto) = &connect_userdb($miniserv{'userdb'});
 521         &error("Failed to connect to user database : $dbh") if (!ref($dbh));
 522         if ($proto eq "mysql" || $proto eq "postgresql") {
 523                 # Get old password, for change detection
 524                 my $cmd = $dbh->prepare(
 525                         "select pass from webmin_user where id = ?");
 526                 $cmd && $cmd->execute($user{'id'}) ||
 527                         &error("Failed to get old password : ".$dbh->errstr);
 528                 my ($oldpass) = $cmd->fetchrow();
 529                 $cmd->finish();
 530                 &add_old_password(\%user, $oldpass, \%miniserv);
 531
 532                 # Update primary details
 533                 my $cmd = $dbh->prepare("update webmin_user set name = ?, ".
 534                                         "pass = ? where id = ?");
 535                 $cmd && $cmd->execute($user{'name'}, $user{'pass'},
 536                                       $user{'id'}) ||
 537                         &error("Failed to update user : ".$dbh->errstr);
 538                 $cmd->finish();
 539
 540                 # Re-save attributes
 541                 my $cmd = $dbh->prepare("delete from webmin_user_attr ".
 542                                         "where id = ?");
 543                 $cmd && $cmd->execute($user{'id'}) ||
 544                         &error("Failed to delete attrs : ".$dbh->errstr);
 545                 my $cmd = $dbh->prepare("insert into webmin_user_attr ".
 546                                         "(id,attr,value) values (?, ?, ?)");
 547                 foreach my $attr (keys %user) {
 548                         next if ($attr eq "name" || $attr eq "pass");
 549                         my $value = $user{$attr};
 550                         if ($attr eq "olds" || $attr eq "modules" ||
 551                             $attr eq "ownmods") {
 552                                 $value = join(" ", @$value);
 553                                 }
 554                         $cmd->execute($user{'id'}, $attr, $value) ||
 555                                 &error("Failed to add user attribute : ".
 556                                         $dbh->errstr);
 557                         $cmd->finish();
 558                         }
 559                 }
 560         elsif ($proto eq "ldap") {
 561                 # Rename in LDAP if needed
 562                 if ($user{'name'} ne $username) {
 563                         my $newdn = $user{'id'};
 564                         $newdn =~ s/^cn=\Q$username\E,/cn=$user{'name'},/;
 565                         my $rv = $dbh->moddn($user{'id'},
 566                                              newrdn => "cn=$user{'name'}");
 567                         if (!$rv || $rv->code) {
 568                                 &error("Failed to rename user : ".
 569                                        ($rv ? $rv->error : "Unknown error"));
 570                                 }
 571                         $user{'id'} = $newdn;
 572                         }
 573
 574                 # Re-save all the attributes
 575                 my @attrs = ( "cn", $user{'name'},
 576                               "webminPass", $user{'pass'} );
 577                 my @webminattrs;
 578                 foreach my $attr (keys %user) {
 579                         next if ($attr eq "name" || $attr eq "desc" ||
 580                                  $attr eq "modules");
 581                         my $value = $user{$attr};
 582                         if ($attr eq "olds" || $attr eq "ownmods") {
 583                                 $value = join(" ", @$value);
 584                                 }
 585                         push(@webminattrs,
 586                              defined($value) ? $attr."=".$value : $attr);
 587                         }
 588                 push(@attrs, "webminAttr", \@webminattrs);
 589                 push(@attrs, "webminModule", $user{'modules'});
 590                 my $rv = $dbh->modify($user{'id'}, replace => { @attrs });
 591                 if (!$rv || $rv->code) {
 592                         &error("Failed to modify user : ".
 593                                ($rv ? $rv->error : "Unknown error"));
 594                         }
 595                 }
 596         &disconnect_userdb($miniserv{'userdb'}, $dbh);
 597         }
 598 else {
 599         # In local files
 600         &lock_file($ENV{'MINISERV_CONFIG'});
 601         delete($miniserv{"preroot_".$username});
 602         if ($user{'theme'}) {
 603                 $miniserv{"preroot_".$user{'name'}} =
 604                   $user{'theme'}.($user{'overlay'} ? " ".$user{'overlay'} : "");
 605                 }
 606         elsif (defined($user{'theme'})) {
 607                 $miniserv{"preroot_".$user{'name'}} = "";
 608                 }
 609         local @logout = split(/\s+/, $miniserv{'logouttimes'});
 610         @logout = grep { $_ !~ /^$username=/ } @logout;
 611         if (defined($user{'logouttime'})) {
 612                 push(@logout, "$user{'name'}=$user{'logouttime'}");
 613                 }
 614         $miniserv{'logouttimes'} = join(" ", @logout);
 615         &put_miniserv_config(\%miniserv);
 616         &unlock_file($ENV{'MINISERV_CONFIG'});
 617
 618         local @times;
 619         push(@times, "days", $user{'days'}) if ($user{'days'} ne '');
 620         push(@times, "hours", $user{'hoursfrom'}."-".$user{'hoursto'})
 621                 if ($user{'hoursfrom'});
 622         &lock_file($miniserv{'userfile'});
 623         open(PWFILE, $miniserv{'userfile'});
 624         @pwfile = <PWFILE>;
 625         close(PWFILE);
 626         &open_tempfile(PWFILE, ">$miniserv{'userfile'}");
 627         foreach (@pwfile) {
 628                 if (/^([^:]+):([^:]*)/ && $1 eq $username) {
 629                         &add_old_password(\%user, "$2", \%miniserv);
 630                         &print_tempfile(PWFILE,
 631                                 "$user{'name'}:$user{'pass'}:",
 632                                 "$user{'sync'}:$user{'cert'}:",
 633                                 ($user{'allow'} ? "allow $user{'allow'}" :
 634                                  $user{'deny'} ? "deny $user{'deny'}" : ""),":",
 635                                 join(" ", @times),":",
 636                                 $user{'lastchange'},":",
 637                                 join(" ", @{$user{'olds'}}),":",
 638                                 $user{'minsize'},":",
 639                                 $user{'nochange'},":",
 640                                 $user{'temppass'},
 641                                 "\n");
 642                         }
 643                 else {
 644                         &print_tempfile(PWFILE, $_);
 645                         }
 646                 }
 647         &close_tempfile(PWFILE);
 648         &unlock_file($miniserv{'userfile'});
 649
 650         &lock_file(&acl_filename());
 651         @mods = &list_modules();
 652         open(ACL, &acl_filename());
 653         @acl = <ACL>;
 654         close(ACL);
 655         &open_tempfile(ACL, ">".&acl_filename());
 656         foreach (@acl) {
 657                 if (/^(\S+):/ && $1 eq $username) {
 658                         &print_tempfile(ACL, &acl_line($_[1], \@mods));
 659                         }
 660                 else {
 661                         &print_tempfile(ACL, $_);
 662                         }
 663                 }
 664         &close_tempfile(ACL);
 665         &unlock_file(&acl_filename());
 666
 667         delete($gconfig{"lang_".$username});
 668         $gconfig{"lang_".$user{'name'}} = $user{'lang'} if ($user{'lang'});
 669         delete($gconfig{"notabs_".$username});
 670         $gconfig{"notabs_".$user{'name'}} = $user{'notabs'}
 671                 if ($user{'notabs'});
 672         delete($gconfig{"skill_".$username});
 673         $gconfig{"skill_".$user{'name'}} = $user{'skill'} if ($user{'skill'});
 674         delete($gconfig{"risk_".$username});
 675         $gconfig{"risk_".$user{'name'}} = $user{'risk'} if ($user{'risk'});
 676         delete($gconfig{"rbacdeny_".$username});
 677         $gconfig{"rbacdeny_".$user{'name'}} = $user{'rbacdeny'}
 678                 if ($user{'rbacdeny'});
 679         delete($gconfig{"ownmods_".$username});
 680         $gconfig{"ownmods_".$user{'name'}} = join(" ", @{$user{'ownmods'}})
 681                 if (@{$user{'ownmods'}});
 682         delete($gconfig{"theme_".$username});
 683         if ($user{'theme'}) {
 684                 $gconfig{"theme_".$user{'name'}} =
 685                   $user{'theme'}.($user{'overlay'} ? " ".$user{'overlay'} : "");
 686                 }
 687         elsif (defined($user{'theme'})) {
 688                 $gconfig{"theme_".$user{'name'}} = '';
 689                 }
 690         delete($gconfig{"readonly_".$username});
 691         $gconfig{"readonly_".$user{'name'}} = $user{'readonly'}
 692                 if (defined($user{'readonly'}));
 693         delete($gconfig{"realname_".$username});
 694         $gconfig{"realname_".$user{'name'}} = $user{'real'}
 695                 if (defined($user{'real'}));
 696         &write_file("$config_directory/config", \%gconfig);
 697         }
 698
 699 if ($username ne $user{'name'} && !$user{'proto'}) {
 700         # Rename all .acl files if user renamed
 701         foreach $m (@mods, "") {
 702                 local $file = "$config_directory/$m/$username.acl";
 703                 if (-r $file) {
 704                         &rename_file($file,
 705                                 "$config_directory/$m/$user{'name'}.acl");
 706                         }
 707                 }
 708         local $file = "$config_directory/$username.acl";
 709         if (-r $file) {
 710                 &rename_file($file, "$config_directory/$user{'name'}.acl");
 711                 }
 712         }
 713
 714 if ($miniserv{'session'} && $username ne $user{'name'}) {
 715         # Modify all sessions for the renamed user
 716         &rename_session_user(\&miniserv, $username, $user{'name'});
 717         }
 718 }
 719
 720 =head2 add_old_password(&user, oldpass, &miniserv)
 721
 722 Internal function to update the olds list of old passwords for a user
 723
 724 =cut
 725 sub add_old_password
 726 {
 727 my ($user, $oldpass, $miniserv) = @_;
 728 if ($oldpass ne $user->{'pass'} &&
 729     "!".$oldpass ne $user->{'pass'} &&
 730     $oldpass ne "!".$user->{'pass'} &&
 731     $user->{'pass'} ne 'x' &&
 732     $user->{'pass'} ne 'e' &&
 733     $user->{'pass'} ne '*LK*') {
 734         # Password change detected .. update change time
 735         # and save the old one
 736         local $nolock = $oldpass;
 737         $nolock =~ s/^\!//;
 738         unshift(@{$user->{'olds'}}, $nolock);
 739         if ($miniserv->{'pass_oldblock'}) {
 740                 while(scalar(@{$user->{'olds'}}) >
 741                       $miniserv->{'pass_oldblock'}) {
 742                         pop(@{$user->{'olds'}});
 743                         }
 744                 }
 745         $user->{'lastchange'} = time();
 746         }
 747 }
 748
 749 =head2 delete_user(name)
 750
 751 Deletes the named user, including all .acl files for detailed module access
 752 control settings.
 753
 754 =cut
 755 sub delete_user
 756 {
 757 my ($username) = @_;
 758 my (@pwfile, @acl, %miniserv);
 759 local $_;
 760
 761 &lock_file($ENV{'MINISERV_CONFIG'});
 762 &get_miniserv_config(\%miniserv);
 763 delete($miniserv{"preroot_".$username});
 764 my @logout = split(/\s+/, $miniserv{'logouttimes'});
 765 @logout = grep { $_ !~ /^$username=/ } @logout;
 766 $miniserv{'logouttimes'} = join(" ", @logout);
 767 &put_miniserv_config(\%miniserv);
 768 &unlock_file($ENV{'MINISERV_CONFIG'});
 769
 770 &lock_file($miniserv{'userfile'});
 771 open(PWFILE, $miniserv{'userfile'});
 772 @pwfile = <PWFILE>;
 773 close(PWFILE);
 774 &open_tempfile(PWFILE, ">$miniserv{'userfile'}");
 775 foreach (@pwfile) {
 776         if (!/^([^:]+):/ || $1 ne $username) {
 777                 &print_tempfile(PWFILE, $_);
 778                 }
 779         }
 780 &close_tempfile(PWFILE);
 781 &unlock_file($miniserv{'userfile'});
 782
 783 &lock_file(&acl_filename());
 784 open(ACL, &acl_filename());
 785 @acl = <ACL>;
 786 close(ACL);
 787 &open_tempfile(ACL, ">".&acl_filename());
 788 foreach (@acl) {
 789         if (!/^([^:]+):/ || $1 ne $username) {
 790                 &print_tempfile(ACL, $_);
 791                 }
 792         }
 793 &close_tempfile(ACL);
 794 &unlock_file(&acl_filename());
 795
 796 delete($gconfig{"lang_".$username});
 797 delete($gconfig{"notabs_".$username});
 798 delete($gconfig{"skill_".$username});
 799 delete($gconfig{"risk_".$username});
 800 delete($gconfig{"ownmods_".$username});
 801 delete($gconfig{"theme_".$username});
 802 delete($gconfig{"readonly_".$username});
 803 &write_file("$config_directory/config", \%gconfig);
 804
 805 # Delete all module .acl files
 806 &unlink_file(map { "$config_directory/$_/$username.acl" } &list_modules());
 807 &unlink_file("$config_directory/$username.acl");
 808
 809 if ($miniserv{'session'}) {
 810         # Delete all sessions for the deleted user
 811         &delete_session_user(\%miniserv, $username);
 812         }
 813
 814 if ($miniserv{'userdb'}) {
 815         # Also delete from user database
 816         my ($dbh, $proto, $prefix, $args) =&connect_userdb($miniserv{'userdb'});
 817         &error("Failed to connect to user database : $dbh") if (!ref($dbh));
 818         if ($proto eq "mysql" || $proto eq "postgresql") {
 819                 # Find the user with SQL query
 820                 my $cmd = $dbh->prepare(
 821                         "select id from webmin_user where name = ?");
 822                 $cmd && $cmd->execute($username) ||
 823                         &error("Failed to find user : ".$dbh->errstr);
 824                 my ($id) = $cmd->fetchrow();
 825                 $cmd->finish();
 826
 827                 if (defined($id)) {
 828                         # Delete the user
 829                         my $cmd = $dbh->prepare(
 830                                 "delete from webmin_user where id = ?");
 831                         $cmd && $cmd->execute($id) ||
 832                                 &error("Failed to delete user : ".$dbh->errstr);
 833                         $cmd->finish();
 834
 835                         # Delete attributes
 836                         my $cmd = $dbh->prepare(
 837                                 "delete from webmin_user_attr where id = ?");
 838                         $cmd && $cmd->execute($id) ||
 839                                 &error("Failed to delete user attrs : ".
 840                                        $dbh->errstr);
 841                         $cmd->finish();
 842
 843                         # Delete ACLs
 844                         my $cmd = $dbh->prepare(
 845                                 "delete from webmin_user_acl where id = ?");
 846                         $cmd && $cmd->execute($id) ||
 847                                 &error("Failed to delete user acls : ".
 848                                        $dbh->errstr);
 849                         $cmd->finish();
 850                         }
 851                 }
 852         elsif ($proto eq "ldap") {
 853                 # Find user with LDAP query
 854                 my $rv = $dbh->search(
 855                         base => $prefix,
 856                         filter => '(&(cn='.$username.')(objectClass='.
 857                                   $args->{'userclass'}.'))',
 858                         scope => 'sub');
 859                 if (!$rv || $rv->code) {
 860                         &error("Failed to find user : ".
 861                                ($rv ? $rv->error : "Unknown error"));
 862                         }
 863                 my ($user) = $rv->all_entries;
 864
 865                 if ($user) {
 866                         # Delete sub-objects
 867                         my $rv = $dbh->search(
 868                                 base => $user->dn(),
 869                                 filter => '(objectClass=*)',
 870                                 scope => 'sub');
 871                         if (!$rv || $rv->code) {
 872                                 &error("Failed to delete LDAP user : ".
 873                                        ($rv ? $rv->error : "Unknown error"));
 874                                 }
 875                         foreach my $so ($rv->all_entries) {
 876                                 next if ($so->dn() eq $user->dn());
 877                                 my $drv = $dbh->delete($so->dn());
 878                                 if ($drv->code) {
 879                                         &error("Failed to delete LDAP ".
 880                                                "sub-object : ".$drv->error);
 881                                         }
 882                                 }
 883
 884                         # Delete the user from LDAP
 885                         my $rv = $dbh->delete($user->dn());
 886                         if (!$rv || $rv->code) {
 887                                 &error("Failed to delete LDAP user : ".
 888                                        ($rv ? $rv->error : "Unknown error"));
 889                                 }
 890                         }
 891                 }
 892         &disconnect_userdb($miniserv{'userdb'}, $dbh);
 893         }
 894 }
 895
 896 =head2 create_group(&group, [clone])
 897
 898 Add a new webmin group, based on the details in the group hash. The required
 899 keys are :
 900
 901 =item name - Unique name of the group
 902
 903 =item modules - An array reference of module names
 904
 905 =item members - An array reference of group member names. Sub-groups must have their names prefixed with an @.
 906
 907 =cut
 908 sub create_group
 909 {
 910 my %group = %{$_[0]};
 911 my $clone = $_[1];
 912 my %miniserv;
 913 &get_miniserv_config(\%miniserv);
 914
 915 if ($miniserv{'userdb'} && !$miniserv{'userdb_addto'}) {
 916         # Adding to group database
 917         my ($dbh, $proto, $prefix, $args) =&connect_userdb($miniserv{'userdb'});
 918         &error("Failed to connect to group database : $dbh") if (!ref($dbh));
 919         if ($proto eq "mysql" || $proto eq "postgresql") {
 920                 # Add group with SQL
 921                 my $cmd = $dbh->prepare("insert into webmin_group (name,description) values (?, ?)");
 922                 $cmd && $cmd->execute($group{'name'}, $group{'desc'}) ||
 923                         &error("Failed to add group : ".$dbh->errstr);
 924                 $cmd->finish();
 925                 my $cmd = $dbh->prepare("select max(id) from webmin_group");
 926                 $cmd->execute();
 927                 my ($id) = $cmd->fetchrow();
 928                 $cmd->finish();
 929
 930                 # Add other attributes
 931                 my $cmd = $dbh->prepare("insert into webmin_group_attr (id,attr,value) values (?, ?, ?)");
 932                 foreach my $attr (keys %group) {
 933                         next if ($attr eq "name" || $attr eq "desc");
 934                         my $value = $group{$attr};
 935                         if ($attr eq "members" || $attr eq "modules" ||
 936                             $attr eq "ownmods") {
 937                                 $value = join(" ", @$value);
 938                                 }
 939                         $cmd->execute($id, $attr, $value) ||
 940                                 &error("Failed to add group attribute : ".
 941                                         $dbh->errstr);
 942                         $cmd->finish();
 943                         }
 944                 $_[0]->{'id'} = $id;
 945                 $_[0]->{'proto'} = $proto;
 946                 }
 947         elsif ($proto eq "ldap") {
 948                 # Add group to LDAP
 949                 my $dn = "cn=".$group{'name'}.",".$prefix;
 950                 my @attrs = ( "objectClass", $args->{'groupclass'},
 951                               "cn", $group{'name'},
 952                               "webminDesc", $group{'desc'} );
 953                 my @webminattrs;
 954                 foreach my $attr (keys %group) {
 955                         next if ($attr eq "name" || $attr eq "desc" ||
 956                                  $attr eq "modules");
 957                         my $value = $group{$attr};
 958                         if ($attr eq "members" || $attr eq "ownmods") {
 959                                 $value = join(" ", @$value);
 960                                 }
 961                         push(@webminattrs, $attr."=".$value);
 962                         }
 963                 if (@webminattrs) {
 964                         push(@attrs, "webminAttr", \@webminattrs);
 965                         }
 966                 if (@{$group{'modules'}}) {
 967                         push(@attrs, "webminModule", $group{'modules'});
 968                         }
 969                 my $rv = $dbh->add($dn, attr => \@attrs);
 970                 if (!$rv || $rv->code) {
 971                         &error("Failed to add group to LDAP : ".
 972                                ($rv ? $rv->error : "Unknown error"));
 973                         }
 974                 $_[0]->{'id'} = $dn;
 975                 $_[0]->{'proto'} = 'ldap';
 976                 }
 977         &disconnect_userdb($miniserv{'userdb'}, $dbh);
 978         $group{'proto'} = $proto;
 979         }
 980 else {
 981         # Adding to local files
 982         &lock_file("$config_directory/webmin.groups");
 983         open(GROUP, ">>$config_directory/webmin.groups");
 984         print GROUP &group_line(\%group),"\n";
 985         close(GROUP);
 986         &unlock_file("$config_directory/webmin.groups");
 987         }
 988
 989 if ($clone) {
 990         # Clone ACLs from original group
 991         &copy_acl_files($clone, $group{'name'}, [ "", &list_modules() ],
 992                         "group", "group");
 993         }
 994 }
 995
 996 =head2 modify_group(old-name, &group)
 997
 998 Update a webmin group, identified by the name parameter. The group's new
 999 details are in the group hash ref, which must be in the same format as
1000 returned by list_groups.
1001
1002 =cut
1003 sub modify_group
1004 {
1005 my $groupname = $_[0];
1006 my %group = %{$_[1]};
1007 my %miniserv;
1008 &get_miniserv_config(\%miniserv);
1009
1010 if ($group{'proto'}) {
1011         # In users and groups DB
1012         my ($dbh, $proto) = &connect_userdb($miniserv{'userdb'});
1013         &error("Failed to connect to group database : $dbh") if (!ref($dbh));
1014         if ($proto eq "mysql" || $proto eq "postgresql") {
1015                 # Update primary details
1016                 my $cmd = $dbh->prepare("update webmin_group set name = ?, ".
1017                                         "description = ? where id = ?");
1018                 $cmd && $cmd->execute($group{'name'}, $group{'desc'},
1019                                       $group{'id'}) ||
1020                         &error("Failed to update group : ".$dbh->errstr);
1021                 $cmd->finish();
1022
1023                 # Re-save attributes
1024                 my $cmd = $dbh->prepare("delete from webmin_group_attr ".
1025                                         "where id = ?");
1026                 $cmd && $cmd->execute($group{'id'}) ||
1027                         &error("Failed to delete attrs : ".$dbh->errstr);
1028                 my $cmd = $dbh->prepare("insert into webmin_group_attr ".
1029                                         "(id,attr,value) values (?, ?, ?)");
1030                 foreach my $attr (keys %group) {
1031                         next if ($attr eq "name" || $attr eq "desc");
1032                         my $value = $group{$attr};
1033                         if ($attr eq "members" || $attr eq "modules" ||
1034                             $attr eq "ownmods") {
1035                                 $value = join(" ", @$value);
1036                                 }
1037                         $cmd->execute($group{'id'}, $attr, $value) ||
1038                                 &error("Failed to add group attribute : ".
1039                                         $dbh->errstr);
1040                         $cmd->finish();
1041                         }
1042                 }
1043         elsif ($proto eq "ldap") {
1044                 # Rename in LDAP if needed
1045                 if ($group{'name'} ne $groupname) {
1046                         my $newdn = $group{'id'};
1047                         $newdn =~ s/^cn=\Q$groupname\E,/cn=$group{'name'},/;
1048                         my $rv = $dbh->moddn($group{'id'},
1049                                              newrdn => "cn=$group{'name'}");
1050                         if (!$rv || $rv->code) {
1051                                 &error("Failed to rename group : ".
1052                                        ($rv ? $rv->error : "Unknown error"));
1053                                 }
1054                         $group{'id'} = $newdn;
1055                         }
1056
1057                 # Re-save all the attributes
1058                 my @attrs = ( "cn", $group{'name'},
1059                               "webminDesc", $group{'desc'} );
1060                 my @webminattrs;
1061                 foreach my $attr (keys %group) {
1062                         next if ($attr eq "name" || $attr eq "desc" ||
1063                                  $attr eq "modules");
1064                         my $value = $group{$attr};
1065                         if ($attr eq "members" || $attr eq "ownmods") {
1066                                 $value = join(" ", @$value);
1067                                 }
1068                         push(@webminattrs, $attr."=".$value);
1069                         }
1070                 push(@attrs, "webminAttr", \@webminattrs);
1071                 push(@attrs, "webminModule", $group{'modules'});
1072                 my $rv = $dbh->modify($group{'id'}, replace => { @attrs });
1073                 if (!$rv || $rv->code) {
1074                         &error("Failed to modify group : ".
1075                                ($rv ? $rv->error : "Unknown error"));
1076                         }
1077                 }
1078         &disconnect_userdb($miniserv{'userdb'}, $dbh);
1079         }
1080 else {
1081         # Update local file
1082         &lock_file("$config_directory/webmin.groups");
1083         local $lref = &read_file_lines("$config_directory/webmin.groups");
1084         foreach $l (@$lref) {
1085                 if ($l =~ /^([^:]+):/ && $1 eq $groupname) {
1086                         $l = &group_line(\%group);
1087                         }
1088                 }
1089         &flush_file_lines("$config_directory/webmin.groups");
1090         &unlock_file("$config_directory/webmin.groups");
1091         }
1092
1093 if ($groupname ne $group{'name'} && !$group{'proto'}) {
1094         # Rename all .gacl files if group renamed
1095         foreach my $m (@{$group{'modules'}}, "") {
1096                 local $file = "$config_directory/$m/$groupname.gacl";
1097                 if (-r $file) {
1098                         &rename_file($file,
1099                              "$config_directory/$m/$group{'name'}.gacl");
1100                         }
1101                 }
1102         }
1103 }
1104
1105 =head2 delete_group(name)
1106
1107 Delete a webmin group, identified by the name parameter.
1108
1109 =cut
1110 sub delete_group
1111 {
1112 my ($groupname) = @_;
1113 my %miniserv;
1114 &get_miniserv_config(\%miniserv);
1115
1116 # Delete from local files
1117 &lock_file("$config_directory/webmin.groups");
1118 my $lref = &read_file_lines("$config_directory/webmin.groups");
1119 @$lref = grep { !/^([^:]+):/ || $1 ne $groupname } @$lref;
1120 &flush_file_lines();
1121 &unlock_file("$config_directory/webmin.groups");
1122 &unlink_file(map { "$config_directory/$_/$groupname.gacl" } &list_modules());
1123
1124 if ($miniserv{'userdb'}) {
1125         # Also delete from group database
1126         my ($dbh, $proto, $prefix, $args) =&connect_userdb($miniserv{'userdb'});
1127         &error("Failed to connect to group database : $dbh") if (!ref($dbh));
1128         if ($proto eq "mysql" || $proto eq "postgresql") {
1129                 # Find the group with SQL query
1130                 my $cmd = $dbh->prepare(
1131                         "select id from webmin_group where name = ?");
1132                 $cmd && $cmd->execute($groupname) ||
1133                         &error("Failed to find group : ".$dbh->errstr);
1134                 my ($id) = $cmd->fetchrow();
1135                 $cmd->finish();
1136
1137                 if (defined($id)) {
1138                         # Delete the group
1139                         my $cmd = $dbh->prepare(
1140                                 "delete from webmin_group where id = ?");
1141                         $cmd && $cmd->execute($id) ||
1142                             &error("Failed to delete group : ".$dbh->errstr);
1143                         $cmd->finish();
1144
1145                         # Delete attributes
1146                         my $cmd = $dbh->prepare(
1147                                 "delete from webmin_group_attr where id = ?");
1148                         $cmd && $cmd->execute($id) ||
1149                                 &error("Failed to delete group attrs : ".
1150                                        $dbh->errstr);
1151                         $cmd->finish();
1152
1153                         # Delete ACLs
1154                         my $cmd = $dbh->prepare(
1155                                 "delete from webmin_group_acl where id = ?");
1156                         $cmd && $cmd->execute($id) ||
1157                                 &error("Failed to delete group acls : ".
1158                                        $dbh->errstr);
1159                         $cmd->finish();
1160                         }
1161                 }
1162         elsif ($proto eq "ldap") {
1163                 # Find group with LDAP query
1164                 my $rv = $dbh->search(
1165                         base => $prefix,
1166                         filter => '(&(cn='.$groupname.')(objectClass='.
1167                                   $args->{'groupclass'}.'))',
1168                         scope => 'sub');
1169                 if (!$rv || $rv->code) {
1170                         &error("Failed to find group : ".
1171                                ($rv ? $rv->error : "Unknown error"));
1172                         }
1173                 my ($group) = $rv->all_entries;
1174
1175                 if ($group) {
1176                         # Delete sub-objects
1177                         my $rv = $dbh->search(
1178                                 base => $group->dn(),
1179                                 filter => '(objectClass=*)',
1180                                 scope => 'sub');
1181                         if (!$rv || $rv->code) {
1182                                 &error("Failed to delete LDAP group : ".
1183                                        ($rv ? $rv->error : "Unknown error"));
1184                                 }
1185                         foreach my $so ($rv->all_entries) {
1186                                 next if ($so->dn() eq $group->dn());
1187                                 my $drv = $dbh->delete($so->dn());
1188                                 if ($drv->code) {
1189                                         &error("Failed to delete LDAP ".
1190                                                "sub-object : ".$drv->error);
1191                                         }
1192                                 }
1193
1194                         # Delete the group from LDAP
1195                         my $rv = $dbh->delete($group->dn());
1196                         if (!$rv || $rv->code) {
1197                                 &error("Failed to delete LDAP group : ".
1198                                        ($rv ? $rv->error : "Unknown error"));
1199                                 }
1200                         }
1201                 }
1202         &disconnect_userdb($miniserv{'userdb'}, $dbh);
1203         }
1204
1205 }
1206
1207 =head2 group_line(&group)
1208
1209 Internal function to generate a group file line
1210
1211 =cut
1212 sub group_line
1213 {
1214 return join(":", $_[0]->{'name'},
1215                  join(" ", @{$_[0]->{'members'}}),
1216                  join(" ", @{$_[0]->{'modules'}}),
1217                  $_[0]->{'desc'},
1218                  join(" ", @{$_[0]->{'ownmods'}}) );
1219 }
1220
1221 =head2 acl_line(&user, &allmodules)
1222
1223 Internal function to generate an ACL file line.
1224
1225 =cut
1226 sub acl_line
1227 {
1228 my %user = %{$_[0]};
1229 return "$user{'name'}: ".join(' ', @{$user{'modules'}})."\n";
1230 }
1231
1232 =head2 can_edit_user(user, [&groups])
1233
1234 Returns 1 if the current Webmin user can edit some other user.
1235
1236 =cut
1237 sub can_edit_user
1238 {
1239 return 1 if ($access{'users'} eq '*');
1240 if ($access{'users'} eq '~') {
1241         return $base_remote_user eq $_[0];
1242         }
1243 my $glist = $_[1] ? $_[1] : [ &list_groups() ];
1244 foreach my $u (split(/\s+/, $access{'users'})) {
1245         if ($u =~ /^_(\S+)$/) {
1246                 foreach my $g (@$glist) {
1247                         return 1 if ($g->{'name'} eq $1 &&
1248                                      &indexof($_[0], @{$g->{'members'}}) >= 0);
1249                         }
1250                 }
1251         else {
1252                 return 1 if ($u eq $_[0]);
1253                 }
1254         }
1255 return 0;
1256 }
1257
1258 =head2 open_session_db(\%miniserv)
1259
1260 Opens the session database, and ties it to the sessiondb hash. Parameters are :
1261
1262 =item miniserv - The Webmin miniserv.conf file as a hash ref, as supplied by get_miniserv_config
1263
1264 =cut
1265 sub open_session_db
1266 {
1267 my $sfile = $_[0]->{'sessiondb'} ? $_[0]->{'sessiondb'} :
1268             $_[0]->{'pidfile'} =~ /^(.*)\/[^\/]+$/ ? "$1/sessiondb"
1269                                                      : return;
1270 eval "use SDBM_File";
1271 dbmopen(%sessiondb, $sfile, 0700);
1272 eval { $sessiondb{'1111111111'} = 'foo bar' };
1273 if ($@) {
1274         dbmclose(%sessiondb);
1275         eval "use NDBM_File";
1276         dbmopen(%sessiondb, $sfile, 0700);
1277         }
1278 else {
1279         delete($sessiondb{'1111111111'});
1280         }
1281 }
1282
1283 =head2 delete_session_id(\%miniserv, id)
1284
1285 Deletes one session from the database. Parameters are :
1286
1287 =item miniserv - The Webmin miniserv.conf file as a hash ref, as supplied by get_miniserv_config.
1288
1289 =item user - ID of the session to remove.
1290
1291 =cut
1292 sub delete_session_id
1293 {
1294 return 1 if (&is_readonly_mode());
1295 &open_session_db($_[0]);
1296 my $ex = exists($sessiondb{$_[1]});
1297 delete($sessiondb{$_[1]});
1298 dbmclose(%sessiondb);
1299 return $ex;
1300 }
1301
1302 =head2 delete_session_user(\%miniserv, user)
1303
1304 Deletes all sessions for some user. Parameters are :
1305
1306 =item miniserv - The Webmin miniserv.conf file as a hash ref, as supplied by get_miniserv_config.
1307
1308 =item user - Name of the user whose sessions get removed.
1309
1310 =cut
1311 sub delete_session_user
1312 {
1313 return 1 if (&is_readonly_mode());
1314 &open_session_db($_[0]);
1315 foreach my $s (keys %sessiondb) {
1316         local ($u,$t) = split(/\s+/, $sessiondb{$s});
1317         if ($u eq $_[1]) {
1318                 delete($sessiondb{$s});
1319                 }
1320         }
1321 dbmclose(%sessiondb);
1322 }
1323
1324 =head2 rename_session_user(\%miniserv, olduser, newuser)
1325
1326 Changes the username in all sessions for some user. Parameters are :
1327
1328 =item miniserv - The Webmin miniserv.conf file as a hash ref, as supplied by get_miniserv_config.
1329
1330 =item olduser - The original username.
1331
1332 =item newuser - The new username.
1333
1334 =cut
1335 sub rename_session_user
1336 {
1337 return 1 if (&is_readonly_mode());
1338 &open_session_db(\%miniserv);
1339 foreach my $s (keys %sessiondb) {
1340         local ($u,$t) = split(/\s+/, $sessiondb{$s});
1341         if ($u eq $_[1]) {
1342                 $sessiondb{$s} = "$_[2] $t";
1343                 }
1344         }
1345 dbmclose(%sessiondb);
1346 }
1347
1348 =head2 update_members(&allusers, &allgroups, &modules, &members)
1349
1350 Update the modules for members users and groups of some group. The parameters
1351 are :
1352
1353 =item allusers - An array ref of all Webmin users, as returned by list_users.
1354
1355 =item allgroups - An array ref of all Webmin groups.
1356
1357 =item modules - Modules to assign to members.
1358
1359 =item members - An array ref of member user and group names.
1360
1361 =cut
1362 sub update_members
1363 {
1364 foreach my $m (@{$_[3]}) {
1365         if ($m !~ /^\@(.*)$/) {
1366                 # Member is a user
1367                 my ($u) = grep { $_->{'name'} eq $m } @{$_[0]};
1368                 if ($u) {
1369                         $u->{'modules'} = [ @{$_[2]}, @{$u->{'ownmods'}} ];
1370                         &modify_user($u->{'name'}, $u);
1371                         }
1372                 }
1373         else {
1374                 # Member is a group
1375                 my $gname = substr($m, 1);
1376                 my ($g) = grep { $_->{'name'} eq $gname } @{$_[1]};
1377                 if ($g) {
1378                         $g->{'modules'} = [ @{$_[2]}, @{$g->{'ownmods'}} ];
1379                         &modify_group($g->{'name'}, $g);
1380                         &update_members($_[0], $_[1], $g->{'modules'},
1381                                         $g->{'members'});
1382                         }
1383                 }
1384         }
1385 }
1386
1387 =head2 copy_acl_files(from, to, &modules, [from-type], [to-type])
1388
1389 Copy all .acl files from some user to another user in a list of modules.
1390 The parameters are :
1391
1392 =item from - Source user or group name.
1393
1394 =item to - Destination user or group name.
1395
1396 =item modules - Array ref of module names.
1397
1398 =item from-type - Either "user" or "group", defaults to "user"
1399
1400 =item to-type - Either "user" or "group", defaults to "user"
1401
1402 =cut
1403 sub copy_acl_files
1404 {
1405 my ($from, $to, $mods, $fromtype, $totype) = @_;
1406 $fromtype ||= "user";
1407 $totype ||= "user";
1408 my ($dbh, $proto, $fromid, $toid);
1409
1410 # Check if the source user/group is in a DB
1411 my $userdb = &get_userdb_string();
1412 if ($userdb) {
1413         ($dbh, $proto, $prefix, $args) = &connect_userdb($userdb);
1414         &error($dbh) if (!ref($dbh));
1415         if ($proto eq "mysql" || $proto eq "postgresql") {
1416                 # Search in SQL DB
1417                 my $cmd = $dbh->prepare(
1418                         "select id from webmin_${fromtype} where name = ?");
1419                 $cmd && $cmd->execute($from) || &error($dbh->errstr);
1420                 ($fromid) = $cmd->fetchrow();
1421                 $cmd->finish();
1422                 my $cmd = $dbh->prepare(
1423                         "select id from webmin_${totype} where name = ?");
1424                 $cmd && $cmd->execute($to) || &error($dbh->errstr);
1425                 ($toid) = $cmd->fetchrow();
1426                 $cmd->finish();
1427                 }
1428         elsif ($proto eq "ldap") {
1429                 # Search in LDAP
1430                 my $fromclass = $fromtype eq "user" ? "userclass"
1431                                                     : "groupclass";
1432                 my $rv = $dbh->search(
1433                         base => $prefix,
1434                         filter => '(&(cn='.$from.')(objectClass='.
1435                                   $fromclass.'))',
1436                         scope => 'sub');
1437                 $rv->code && &error($rv->error);
1438                 my ($fromobj) = $rv->all_entries;
1439                 $fromid = $fromobj ? $fromobj->dn() : undef;
1440                 my $toclass = $totype eq "user" ? "userclass"
1441                                                 : "groupclass";
1442                 my $rv = $dbh->search(
1443                         base => $prefix,
1444                         filter => '(&(cn='.$to.')(objectClass='.
1445                                   $toclass.'))',
1446                         scope => 'sub');
1447                 $rv->code && &error($rv->error);
1448                 my ($toobj) = $rv->all_entries;
1449                 $toid = $toobj ? $toobj->dn() : undef;
1450                 }
1451         }
1452
1453 if (defined($fromid) && defined($toid) &&
1454     ($proto eq "mysql" || $proto eq "postgresql")) {
1455         # Copy from database to database
1456         my $delcmd = $dbh->prepare("delete from webmin_${totype}_acl where id = ? and module = ?");
1457         my $cmd = $dbh->prepare("insert into webmin_${totype}_acl select ?,module,attr,value from webmin_${fromtype}_acl where id = ? and module = ?");
1458         foreach my $m (@$mods) {
1459                 $delcmd && $delcmd->execute($toid, $m) ||
1460                         &error("Failed to clear ACLs : ".$dbh->errstr);
1461                 $delcmd->finish();
1462                 $cmd && $cmd->execute($toid, $fromid, $m) ||
1463                         &error("Failed to copy ACLs : ".$dbh->errstr);
1464                 $cmd->finish();
1465                 }
1466         }
1467 elsif (!defined($fromid) && !defined($toid)) {
1468         # Copy files
1469         my $fromsuffix = $fromtype eq "user" ? "acl" : "gacl";
1470         my $tosuffix = $totype eq "user" ? "acl" : "gacl";
1471         foreach my $m (@$mods) {
1472                 &unlink_file("$config_directory/$m/$to.$tosuffix");
1473                 my %acl;
1474                 if (&read_file("$config_directory/$m/$from.$fromsuffix",
1475                                \%acl)) {
1476                         &write_file("$config_directory/$m/$to.$tosuffix",
1477                                     \%acl);
1478                         }
1479                 }
1480         }
1481 else {
1482         # Source and dest use different storage types
1483         foreach my $m (@$mods) {
1484                 my %caccess;
1485                 if ($fromtype eq "user") {
1486                         %caccess = &get_module_acl($from, $m, 1, 1);
1487                         }
1488                 else {
1489                         %caccess = &get_group_module_acl($from, $m, 1);
1490                         }
1491                 if (%caccess) {
1492                         if ($totype eq "user") {
1493                                 &save_module_acl(\%caccess, $to, $m, 1);
1494                                 }
1495                         else {
1496                                 &save_group_module_acl(\%caccess, $to, $m, 1);
1497                                 }
1498                         }
1499                 }
1500         }
1501 if ($dbh) {
1502         &disconnect_userdb($userdb, $dbh);
1503         }
1504 }
1505
1506 =head2 copy_group_acl_files(from, to, &modules)
1507
1508 Copy all .gacl files from some group to another in a list of modules. Parameters
1509 are :
1510
1511 =item from - Source group name.
1512
1513 =item to - Destination group name.
1514
1515 =item modules - Array ref of module names.
1516
1517 =cut
1518 sub copy_group_acl_files
1519 {
1520 my ($from, $to, $mods) = @_;
1521 &copy_acl_files($from, $to, $mods, "group", "group");
1522 }
1523
1524 =head2 copy_group_user_acl_files(from, to, &modules)
1525
1526 Copy all .acl files from some group to a user in a list of modules. Parameters
1527 are :
1528
1529 =item from - Source group name.
1530
1531 =item to - Destination user name.
1532
1533 =item modules - Array ref of module names.
1534
1535 =cut
1536 sub copy_group_user_acl_files
1537 {
1538 my ($from, $to, $mods) = @_;
1539 &copy_acl_files($from, $to, $mods, "group", "user");
1540 }
1541
1542 =head2 set_acl_files(&allusers, &allgroups, module, &members, &access)
1543
1544 Recursively update the ACL for all sub-users and groups of a group, by copying
1545 detailed access control settings from the group down to users. Parameters are :
1546
1547 =item allusers - An array ref of Webmin users, as returned by list_users.
1548
1549 =item allgroups - An array ref of Webmin groups.
1550
1551 =item module - Name of the module to update ACL for.
1552
1553 =item members - Names of group members.
1554
1555 =item access - The module ACL hash ref to copy to users.
1556
1557 =cut
1558 sub set_acl_files
1559 {
1560 my ($allusers, $allgroups, $mod, $members, $access) = @_;
1561 foreach my $m (@$members) {
1562         if ($m !~ /^\@(.*)$/) {
1563                 # Member is a user
1564                 local ($u) = grep { $_->{'name'} eq $m } @$allusers;
1565                 if ($u) {
1566                         local $aclfile =
1567                                 "$config_directory/$mod/$u->{'name'}.acl";
1568                         &lock_file($aclfile);
1569                         &save_module_acl($access, $u->{'name'}, $mod, 1);
1570                         chmod(0640, $aclfile) if (-r $aclfile);
1571                         &unlock_file($aclfile);
1572                         }
1573                 }
1574         else {
1575                 # Member is a group
1576                 local $gname = substr($m, 1);
1577                 local ($g) = grep { $_->{'name'} eq $gname } @$allgroups;
1578                 if ($g) {
1579                         local $aclfile =
1580                                 "$config_directory/$mod/$g->{'name'}.gacl";
1581                         &lock_file($aclfile);
1582                         &save_group_module_acl($access, $g->{'name'}, $mod, 1);
1583                         chmod(0640, $aclfile) if (-r $aclfile);
1584                         &unlock_file($aclfile);
1585                         &set_acl_files($allusers, $allgroups, $mod,
1586                                        $g->{'members'}, $access);
1587                         }
1588                 }
1589         }
1590 }
1591
1592 =head2 get_ssleay
1593
1594 Returns the path to the openssl command (or equivalent) on this system.
1595
1596 =cut
1597 sub get_ssleay
1598 {
1599 if (&has_command($config{'ssleay'})) {
1600         return &has_command($config{'ssleay'});
1601         }
1602 elsif (&has_command("openssl")) {
1603         return &has_command("openssl");
1604         }
1605 elsif (&has_command("ssleay")) {
1606         return &has_command("ssleay");
1607         }
1608 else {
1609         return undef;
1610         }
1611 }
1612
1613 =head2 encrypt_password(password, [salt])
1614
1615 Encrypts and returns a Webmin user password. If the optional salt parameter
1616 is not given, a salt will be selected randomly.
1617
1618 =cut
1619 sub encrypt_password
1620 {
1621 my ($pass, $salt) = @_;
1622 if ($gconfig{'md5pass'}) {
1623         # Use MD5 encryption
1624         $salt ||= '$1$'.substr(time(), -8).'$xxxxxxxxxxxxxxxxxxxxxx';
1625         return &encrypt_md5($pass, $salt);
1626         }
1627 else {
1628         # Use Unix DES
1629         &seed_random();
1630         $salt ||= chr(int(rand(26))+65).chr(int(rand(26))+65);
1631         return &unix_crypt($pass, $salt);
1632         }
1633 }
1634
1635 =head2 get_unixauth(\%miniserv)
1636
1637 Returns a list of Unix users/groups/all and the Webmin user that they
1638 authenticate as, as array references.
1639
1640 =cut
1641 sub get_unixauth
1642 {
1643 my @rv;
1644 my @ua = split(/\s+/, $_[0]->{'unixauth'});
1645 foreach my $ua (@ua) {
1646         if ($ua =~ /^(\S+)=(\S+)$/) {
1647                 push(@rv, [ $1, $2 ]);
1648                 }
1649         else {
1650                 push(@rv, [ "*", $ua ]);
1651                 }
1652         }
1653 return @rv;
1654 }
1655
1656 =head2 save_unixauth(\%miniserv, &authlist)
1657
1658 Updates %miniserv with the given Unix auth list, which must be in the format
1659 returned by get_unixauth.
1660
1661 =cut
1662 sub save_unixauth
1663 {
1664 my @ua;
1665 foreach my $ua (@{$_[1]}) {
1666         if ($ua->[0] ne "*") {
1667                 push(@ua, "$ua->[0]=$ua->[1]");
1668                 }
1669         else {
1670                 push(@ua, $ua->[1]);
1671                 }
1672         }
1673 $_[0]->{'unixauth'} = join(" ", @ua);
1674 }
1675
1676 =head2 delete_from_groups(user|@group)
1677
1678 Removes the specified user from all groups.
1679
1680 =cut
1681 sub delete_from_groups
1682 {
1683 my ($user) = @_;
1684 foreach my $g (&list_groups()) {
1685         my @mems = @{$g->{'members'}};
1686         my $i = &indexof($user, @mems);
1687         if ($i >= 0) {
1688                 splice(@mems, $i, 1);
1689                 $g->{'members'} = \@mems;
1690                 &modify_group($g->{'name'}, $g);
1691                 }
1692         }
1693 }
1694
1695 =head2 check_password_restrictions(username, password)
1696
1697 Checks if some new password is valid for a user, and if not returns
1698 an error message.
1699
1700 =cut
1701 sub check_password_restrictions
1702 {
1703 my ($name, $pass) = @_;
1704 my %miniserv;
1705 &get_miniserv_config(\%miniserv);
1706 my ($user) = grep { $_->{'name'} eq $name } &list_users();
1707 my $minsize = $user ? $user->{'minsize'} : undef;
1708 $minsize ||= $miniserv{'pass_minsize'};
1709 if (length($pass) < $minsize) {
1710         return &text('cpass_minsize', $minsize);
1711         }
1712 foreach my $re (split(/\t+/, $miniserv{'pass_regexps'})) {
1713         if ($re =~ /^\!(.*)$/) {
1714                 $re = $1;
1715                 $pass !~ /$re/ || return ($miniserv{'pass_regdesc'} ||
1716                                           $text{'cpass_notre'});
1717                 }
1718         else {
1719                 $pass =~ /$re/ || return ($miniserv{'pass_regdesc'} ||
1720                                           $text{'cpass_re'});
1721                 }
1722         }
1723 if ($miniserv{'pass_nouser'}) {
1724         $pass =~ /\Q$name\E/i && return $text{'cpass_name'};
1725         }
1726 if ($miniserv{'pass_nodict'}) {
1727         local $temp = &transname();
1728         &open_tempfile(TEMP, ">$temp", 0, 1);
1729         &print_tempfile(TEMP, $pass,"\n");
1730         &close_tempfile(TEMP);
1731         local $unknown;
1732         if (&has_command("ispell")) {
1733                 open(SPELL, "ispell -a <$temp |");
1734                 while(<SPELL>) {
1735                         if (/^(#|\&|\?)/) {
1736                                 $unknown++;
1737                                 }
1738                         }
1739                 close(SPELL);
1740                 }
1741         elsif (&has_command("spell")) {
1742                 open(SPELL, "spell <$temp |");
1743                 local $line = <SPELL>;
1744                 $unknown++ if ($line);
1745                 close(SPELL);
1746                 }
1747         else {
1748                 return &text('cpass_spellcmd', "<tt>ispell</tt>",
1749                                                "<tt>spell</tt>");
1750                 }
1751         $unknown || return $text{'cpass_dict'};
1752         }
1753 if ($miniserv{'pass_oldblock'} && $user) {
1754         local $c = 0;
1755         foreach my $o (@{$user->{'olds'}}) {
1756                 local $enc = &encrypt_password($pass, $o);
1757                 $enc eq $o && return $text{'cpass_old'};
1758                 last if ($c++ > $miniserv{'pass_oldblock'});
1759                 }
1760         }
1761 return undef;
1762 }
1763
1764 =head2 hash_session_id(sid)
1765
1766 Returns an MD5 or Unix-crypted session ID.
1767
1768 =cut
1769 sub hash_session_id
1770 {
1771 my ($sid) = @_;
1772 my $use_md5 = &md5_perl_module();
1773 if (!$hash_session_id_cache{$sid}) {
1774         if ($use_md5) {
1775                 # Take MD5 hash
1776                 $hash_session_id_cache{$sid} = &hash_md5_session($sid);
1777                 }
1778         else {
1779                 # Unix crypt
1780                 $hash_session_id_cache{$sid} = &unix_crypt($sid, "XX");
1781                 }
1782         }
1783 return $hash_session_id_cache{$sid};
1784 }
1785
1786 =head2 hash_md5_session(string)
1787
1788 Returns a string encrypted in MD5 format.
1789
1790 =cut
1791 sub hash_md5_session
1792 {
1793 my $passwd = $_[0];
1794 my $use_md5 = &md5_perl_module();
1795
1796 # Add the password
1797 my $ctx = eval "new $use_md5";
1798 $ctx->add($passwd);
1799
1800 # Add some more stuff from the hash of the password and salt
1801 my $ctx1 = eval "new $use_md5";
1802 $ctx1->add($passwd);
1803 $ctx1->add($passwd);
1804 my $final = $ctx1->digest();
1805 for(my $pl=length($passwd); $pl>0; $pl-=16) {
1806         $ctx->add($pl > 16 ? $final : substr($final, 0, $pl));
1807         }
1808
1809 # This piece of code seems rather pointless, but it's in the C code that
1810 # does MD5 in PAM so it has to go in!
1811 my $j = 0;
1812 my ($i, $l);
1813 for(my $i=length($passwd); $i; $i >>= 1) {
1814         if ($i & 1) {
1815                 $ctx->add("\0");
1816                 }
1817         else {
1818                 $ctx->add(substr($passwd, $j, 1));
1819                 }
1820         }
1821 $final = $ctx->digest();
1822
1823 # Convert the 16-byte final string into a readable form
1824 my $rv;
1825 my @final = map { ord($_) } split(//, $final);
1826 $l = ($final[ 0]<<16) + ($final[ 6]<<8) + $final[12];
1827 $rv .= &to64($l, 4);
1828 $l = ($final[ 1]<<16) + ($final[ 7]<<8) + $final[13];
1829 $rv .= &to64($l, 4);
1830 $l = ($final[ 2]<<16) + ($final[ 8]<<8) + $final[14];
1831 $rv .= &to64($l, 4);
1832 $l = ($final[ 3]<<16) + ($final[ 9]<<8) + $final[15];
1833 $rv .= &to64($l, 4);
1834 $l = ($final[ 4]<<16) + ($final[10]<<8) + $final[ 5];
1835 $rv .= &to64($l, 4);
1836 $l = $final[11];
1837 $rv .= &to64($l, 2);
1838
1839 return $rv;
1840 }
1841
1842 =head2 md5_perl_module
1843
1844 Returns a Perl module for MD5 hashing, or undef if none.
1845
1846 =cut
1847 sub md5_perl_module
1848 {
1849 eval "use MD5";
1850 if (!$@) {
1851         $use_md5 = "MD5";
1852         }
1853 else {
1854         eval "use Digest::MD5";
1855         if (!$@) {
1856                 $use_md5 = "Digest::MD5";
1857                 }
1858         }
1859 }
1860
1861 =head2 session_db_key(sid)
1862
1863 Returns the session DB key for some session ID. Assumes that open_session_db
1864 has already been called.
1865
1866 =cut
1867 sub session_db_key
1868 {
1869 my ($sid) = @_;
1870 my $hash = &hash_session_id($sid);
1871 return $sessiondb{$hash} ? $hash : $sid;
1872 }
1873
1874 =head2 setup_anonymous_access(path, module)
1875
1876 Grants anonymous access to some path. By default, the user for other anonymous
1877 access will be used, or if there is none, a user named 'anonymous' will be
1878 created and granted access to the module.
1879
1880 =cut
1881 sub setup_anonymous_access
1882 {
1883 my ($path, $mod) = @_;
1884
1885 # Find out what users and paths we grant access to currently
1886 my %miniserv;
1887 &get_miniserv_config(\%miniserv);
1888 my @anon = split(/\s+/, $miniserv{'anonymous'});
1889 my $found = 0;
1890 my $user;
1891 foreach my $a (@anon) {
1892         my ($p, $u) = split(/=/, $a);
1893         $found++ if ($p eq $path);
1894         $user = $u;
1895         }
1896 return 1 if ($found);           # Already setup
1897
1898 if (!$user) {
1899         # Create a user if need be
1900         $user = "anonymous";
1901         local $uinfo = { 'name' => $user,
1902                          'pass' => '*LK*',
1903                          'modules' => [ $mod ],
1904                        };
1905         &create_user($uinfo);
1906         }
1907 else {
1908         # Make sure the user has the module
1909         local ($uinfo) = grep { $_->{'name'} eq $user } &list_users();
1910         if ($uinfo && &indexof($mod, @{$uinfo->{'modules'}}) < 0) {
1911                 push(@{$uinfo->{'modules'}}, $mod);
1912                 &modify_user($uinfo->{'name'}, $uinfo);
1913                 }
1914         else {
1915                 print STDERR "Anonymous access is granted to user $user, but he doesn't exist!\n";
1916                 }
1917         }
1918
1919 # Grant access to the user and path
1920 push(@anon, "$path=$user");
1921 $miniserv{'anonymous'} = join(" ", @anon);
1922 &put_miniserv_config(\%miniserv);
1923 &reload_miniserv();
1924 }
1925
1926 =head2 join_userdb_string(proto, user, pass, host, prefix, &args)
1927
1928 Creates a string in the format accepted by split_userdb_string
1929
1930 =cut
1931 sub join_userdb_string
1932 {
1933 my ($proto, $user, $pass, $host, $prefix, $args) = @_;
1934 return "" if (!$proto);
1935 my $argstr;
1936 if (keys %$args) {
1937         $argstr = "?".join("&", map { $_."=".$args->{$_} } (keys %$args));
1938         }
1939 return $proto."://".$user.":".$pass."\@".$host."/".$prefix.$argstr;
1940 }
1941
1942 =head2 validate_userdb(string, [no-table-check])
1943
1944 Checks if some user database is usable, and if not returns an error message
1945
1946 =cut
1947 sub validate_userdb
1948 {
1949 my ($str, $notablecheck) = @_;
1950 my ($proto, $user, $pass, $host, $prefix, $args) = &split_userdb_string($str);
1951 if ($proto eq "mysql" || $proto eq "postgresql") {
1952         # Load DBI driver
1953         eval 'use DBI;';
1954         return &text('sql_emod', 'DBI') if ($@);
1955         if ($proto eq "mysql") {
1956                 eval 'use DBD::mysql;';
1957                 return &text('sql_emod', 'DBD::mysql') if ($@);
1958                 my $drh = DBI->install_driver("mysql");
1959                 return $text{'sql_emysqldriver'} if (!$drh);
1960                 }
1961         else {
1962                 eval 'use DBD::Pg;';
1963                 return &text('sql_emod', 'DBD::Pg') if ($@);
1964                 my $drh = DBI->install_driver("Pg");
1965                 return $text{'sql_epostgresqldriver'} if (!$drh);
1966                 }
1967
1968         # Connect to the database
1969         my $dbh = &connect_userdb($str);
1970         ref($dbh) || return $dbh;
1971
1972         # Validate critical tables
1973         if (!$notablecheck) {
1974                 my %tables =
1975                   ( "webmin_user" => [ "id", "name", "pass" ],
1976                     "webmin_group" => [ "id", "name", "description" ],
1977                     "webmin_user_attr" => [ "id", "attr", "value" ],
1978                     "webmin_group_attr" => [ "id", "attr", "value" ],
1979                     "webmin_user_acl" => [ "id", "module", "attr", "value" ],
1980                     "webmin_group_acl" => [ "id", "module", "attr", "value"],
1981                   );
1982                 foreach my $t (keys %tables) {
1983                         my @cols = @{$tables{$t}};
1984                         my $sql = "select ".join(",", @cols)." from $t limit 1";
1985                         my $cmd = $dbh->prepare($sql);
1986                         if (!$cmd || !$cmd->execute()) {
1987                                 return &text('sql_etable', $t,
1988                                              &html_escape($dbh->errstr));
1989                                 }
1990                         $cmd->finish();
1991                         }
1992                 }
1993         &disconnect_userdb($str, $dbh);
1994         return undef;
1995         }
1996 elsif ($proto eq "ldap") {
1997         # Load LDAP module
1998         eval 'use Net::LDAP;';
1999         return &text('sql_emod', 'Net::LDAP') if ($@);
2000
2001         # Try to connect
2002         my $dbh = &connect_userdb($str);
2003         ref($dbh) || return $dbh;
2004
2005         # Check for Webmin object classes
2006         my $schema = $dbh->schema();
2007         my @allocs = map { $_->{'name'} }
2008                         $schema->all_objectclasses();
2009         &indexof($args->{'userclass'}, @allocs) >= 0 ||
2010                 return &text('sql_eclass', $args->{'userclass'});
2011         &indexof($args->{'groupclass'}, @allocs) >= 0 ||
2012                 return &text('sql_eclass', $args->{'groupclass'});
2013
2014         # Check that base DN exists
2015         if (!$notablecheck) {
2016                 my $superprefix = $prefix;
2017                 $superprefix =~ s/^[^,]+,//;    # Make parent DN
2018                 my $rv = $dbh->search(base => $superprefix,
2019                                       filter => '(objectClass=*)',
2020                                       scope => 'one');
2021                 my $niceprefix = lc($prefix);
2022                 $niceprefix =~ s/\s//g;
2023                 my $found = 0;
2024                 foreach my $d ($rv->all_entries) {
2025                         my $niced = lc($d->dn());
2026                         $niced =~ s/\s//g;
2027                         $found++ if ($niced eq $niceprefix);
2028                         }
2029                 $found || return &text('sql_eldapdn', $prefix);
2030                 }
2031         &disconnect_userdb($str, $dbh);
2032         return undef;
2033         }
2034 else {
2035         return "Unknown user database type $proto";
2036         }
2037 }
2038
2039 =head2 userdb_table_sql(string)
2040
2041 Returns SQL statements needed to create all required tables. Mainly for
2042 internal use.
2043
2044 =cut
2045 sub userdb_table_sql
2046 {
2047 my ($str) = @_;
2048 my ($key, $auto, $idattrkey);
2049 if ($str =~ /^mysql:/) {
2050         return ( "create table webmin_user ".
2051                    "(id int(20) not null primary key auto_increment, ".
2052                    "name varchar(255) not null, pass varchar(255))",
2053                  "create table webmin_group ".
2054                    "(id int(20) not null primary key auto_increment, ".
2055                    "name varchar(255) not null, ".
2056                    "description varchar(255))",
2057                  "create table webmin_user_attr ".
2058                    "(id int(20) not null, ".
2059                    "attr varchar(255) not null, ".
2060                    "value varchar(4096), ".
2061                    "primary key(id, attr))",
2062                  "create table webmin_group_attr ".
2063                    "(id int(20) not null, ".
2064                    "attr varchar(255) not null, ".
2065                    "value varchar(4096), ".
2066                    "primary key(id, attr))",
2067                  "create table webmin_user_acl ".
2068                    "(id int(20) not null, ".
2069                    "module varchar(32) not null, ".
2070                    "attr varchar(32) not null, ".
2071                    "value varchar(255), ".
2072                    "primary key(id, module, attr))",
2073                  "create table webmin_group_acl ".
2074                    "(id int(20) not null, ".
2075                    "module varchar(32) not null, ".
2076                    "attr varchar(32) not null, ".
2077                    "value varchar(255), ".
2078                    "primary key(id, module, attr))",
2079                 );
2080         }
2081 elsif ($str =~ /^postgresql:/) {
2082         return ( "create table webmin_user ".
2083                    "(id serial not null primary key, ".
2084                    "name varchar(255), ".
2085                    "pass varchar(255))",
2086                  "create table webmin_group ".
2087                    "(id serial not null primary key, ".
2088                    "name varchar(255), ".
2089                    "description varchar(255))",
2090                  "create table webmin_user_attr ".
2091                    "(id int8 not null, ".
2092                    "attr varchar(255) not null, ".
2093                    "value varchar(4096), ".
2094                    "primary key(id, attr))",
2095                  "create table webmin_group_attr ".
2096                    "(id int8 not null, ".
2097                    "attr varchar(255) not null, ".
2098                    "value varchar(4096), ".
2099                    "primary key(id, attr))",
2100                  "create table webmin_user_acl ".
2101                    "(id int8 not null, ".
2102                    "module varchar(255) not null, ".
2103                    "attr varchar(255) not null, ".
2104                    "value varchar(255), ".
2105                    "primary key(id, module, attr))",
2106                  "create table webmin_group_acl ".
2107                    "(id int8 not null, ".
2108                    "module varchar(255) not null, ".
2109                    "attr varchar(255) not null, ".
2110                    "value varchar(255), ".
2111                    "primary key(id, module, attr))",
2112                );
2113         }
2114 }
2115
2116 1;
2117