webmin/webmin-lib.pl

   1 =head1 webmin-lib.pl
   2
   3 Common functions for configuring miniserv and adjusting global Webmin settings.
   4
   5 =cut
   6
   7 BEGIN { push(@INC, ".."); };
   8 use strict;
   9 use warnings;
  10 use WebminCore;
  11 &init_config();
  12 our ($module_root_directory, %text, %gconfig, $root_directory, %config,
  13      $module_name, $remote_user, $base_remote_user, $gpgpath,
  14      $module_config_directory, @lang_order_list, @root_directories);
  15 do "$module_root_directory/gnupg-lib.pl";
  16 use Socket;
  17
  18 our @cs_codes = ( 'cs_page', 'cs_text', 'cs_table', 'cs_header', 'cs_link' );
  19 our @cs_names = map { $text{$_} } @cs_codes;
  20
  21 our $osdn_host = "prdownloads.sourceforge.net";
  22 our $osdn_port = 80;
  23
  24 our $update_host = "www.webmin.com";
  25 our $update_port = 80;
  26 our $update_page = "/updates/updates.txt";
  27 our $update_url = "http://$update_host:$update_port$update_page";
  28 our $redirect_url = "http://$update_host/cgi-bin/redirect.cgi";
  29 our $update_cache = "$module_config_directory/update-cache";
  30
  31 our $webmin_key_email = "jcameron\@webmin.com";
  32 our $webmin_key_fingerprint = "1719 003A CE3E 5A41 E2DE  70DF D97A 3AE9 11F6 3C51";
  33
  34 our $standard_host = $update_host;
  35 our $standard_port = $update_port;
  36 our $standard_page = "/download/modules/standard.txt";
  37 our $standard_ssl = 0;
  38
  39 our $third_host = $update_host;
  40 our $third_port = $update_port;
  41 our $third_page = "/cgi-bin/third.cgi";
  42 our $third_ssl = 0;
  43
  44 our $default_key_size = "2048";
  45
  46 our $cron_cmd = "$module_config_directory/update.pl";
  47
  48 our $os_info_address = "os\@webmin.com";
  49
  50 our $detect_operating_system_cache = "$module_config_directory/oscache";
  51
  52 our @webmin_date_formats = ( "dd/mon/yyyy", "dd/mm/yyyy",
  53                              "mm/dd/yyyy", "yyyy/mm/dd",
  54                              "d. mon yyyy", "dd.mm.yyyy", "yyyy-mm-dd" );
  55
  56 our @debug_what_events = ( 'start', 'read', 'write', 'ops', 'procs', 'diff', 'cmd', 'net', 'sql' );
  57
  58 our $record_login_cmd = "$config_directory/login.pl";
  59 our $record_logout_cmd = "$config_directory/logout.pl";
  60
  61 our $strong_ssl_ciphers = "ALL:!aNULL:!ADH:!eNULL:!LOW:!EXP:!SSLv2:RC4+RSA:+HIGH:+MEDIUM";
  62
  63 our $newmodule_users_file = "$config_directory/newmodules";
  64
  65 =head2 setup_ca
  66
  67 Internal function to create all the configuration files needed for the Webmin
  68 client SSL certificate CA.
  69
  70 =cut
  71 sub setup_ca
  72 {
  73 my ($miniserv) = @_;
  74 my $adir = &module_root_directory("acl");
  75 my $conf = &read_file_contents("$adir/openssl.cnf");
  76 my $acl = "$config_directory/acl";
  77 $conf =~ s/DIRECTORY/$acl/g;
  78
  79 &lock_file("$acl/openssl.cnf");
  80 my $cfh;
  81 &open_tempfile($cfh, ">$acl/openssl.cnf");
  82 &print_tempfile($cfh, $conf);
  83 &close_tempfile($cfh);
  84 chmod(0600, "$acl/openssl.cnf");
  85 &unlock_file("$acl/openssl.cnf");
  86
  87 &lock_file("$acl/index.txt");
  88 my $ifh;
  89 &open_tempfile($ifh, ">$acl/index.txt");
  90 &close_tempfile($ifh);
  91 chmod(0600, "$acl/index.txt");
  92 &unlock_file("$acl/index.txt");
  93
  94 &lock_file("$acl/serial");
  95 my $sfh;
  96 &open_tempfile($sfh, ">$acl/serial");
  97 &print_tempfile($sfh, "011E\n");
  98 &close_tempfile($sfh);
  99 chmod(0600, "$acl/serial");
 100 &unlock_file("$acl/serial");
 101
 102 &lock_file("$acl/newcerts");
 103 mkdir("$acl/newcerts", 0700);
 104 chmod(0700, "$acl/newcerts");
 105 &unlock_file("$acl/newcerts");
 106 $miniserv->{'ca'} = "$acl/ca.pem";
 107 }
 108
 109 =head2 install_webmin_module(file, unlink, nodeps, &users|groups)
 110
 111 Installs a webmin module or theme, and returns either an error message
 112 or references to three arrays for descriptions, directories and sizes.
 113 On success or failure, the file is deleted if the unlink parameter is set.
 114 Unless the nodeps parameter is set to 1, any missing dependencies will cause
 115 installation to fail.
 116
 117 Any new modules will be granted to the users and groups named in the fourth
 118 paramter, which must be an array reference.
 119
 120 =cut
 121 sub install_webmin_module
 122 {
 123 my ($file, $need_unlink, $nodeps, $grant) = @_;
 124 my (@mdescs, @mdirs, @msizes);
 125 my (@newmods, $m);
 126 my $install_root_directory = $gconfig{'install_root'} || $root_directory;
 127
 128 # Uncompress the module file if needed
 129 my $two;
 130 open(MFILE, $file);
 131 read(MFILE, $two, 2);
 132 close(MFILE);
 133 if ($two eq "\037\235") {
 134         if (!&has_command("uncompress")) {
 135                 unlink($file) if ($need_unlink);
 136                 return &text('install_ecomp', "<tt>uncompress</tt>");
 137                 }
 138         my $temp = $file =~ /\/([^\/]+)\.Z/i ? &transname("$1")
 139                                                 : &transname();
 140         my $out = `uncompress -c "$file" 2>&1 >$temp`;
 141         unlink($file) if ($need_unlink);
 142         if ($?) {
 143                 unlink($temp);
 144                 return &text('install_ecomp2', $out);
 145                 }
 146         $file = $temp;
 147         $need_unlink = 1;
 148         }
 149 elsif ($two eq "\037\213") {
 150         if (!&has_command("gunzip") && !&has_command("gzip")) {
 151                 unlink($file) if ($need_unlink);
 152                 return &text('install_egzip', "<tt>gunzip</tt>");
 153                 }
 154         my $temp = $file =~ /\/([^\/]+)\.gz/i ? &transname("$1")
 155                                                  : &transname();
 156         my $cmd = &has_command("gunzip") ? "gunzip -c" : "gzip -d -c";
 157         my $out = &backquote_command($cmd." ".&quote_path($file).
 158                                         "  2>&1 >$temp");
 159         unlink($file) if ($need_unlink);
 160         if ($? || !-s $temp) {
 161                 unlink($temp);
 162                 return &text('install_egzip2', $out);
 163                 }
 164         $file = $temp;
 165         $need_unlink = 1;
 166         }
 167 elsif ($two eq "BZ") {
 168         if (!&has_command("bunzip2")) {
 169                 unlink($file) if ($need_unlink);
 170                 return &text('install_ebunzip', "<tt>bunzip2</tt>");
 171                 }
 172         my $temp = $file =~ /\/([^\/]+)\.gz/i ? &transname("$1")
 173                                                  : &transname();
 174         my $out = `bunzip2 -c "$file" 2>&1 >$temp`;
 175         unlink($file) if ($need_unlink);
 176         if ($?) {
 177                 unlink($temp);
 178                 return &text('install_ebunzip2', $out);
 179                 }
 180         $file = $temp;
 181         $need_unlink = 1;
 182         }
 183
 184 # Check if this is an RPM webmin module or theme
 185 my ($type, $redirect_to);
 186 $type = "";
 187 if (open(TYPE, "$root_directory/install-type")) {
 188         chop($type = <TYPE>);
 189         close(TYPE);
 190         }
 191 my $out;
 192 if ($type eq 'rpm' && $file =~ /\.rpm$/i &&
 193     ($out = &backquote_command("rpm -qp $file 2>/dev/null"))) {
 194         # Looks like an RPM of some kind, hopefully an RPM webmin module
 195         # or theme
 196         my (%minfo, %tinfo, $name);
 197         if ($out !~ /(^|\n)(wbm|wbt)-([a-z\-]+[a-z])/) {
 198                 unlink($file) if ($need_unlink);
 199                 return $text{'install_erpm'};
 200                 }
 201         $redirect_to = $name = $3;
 202         $out = &backquote_logged("rpm -U \"$file\" 2>&1");
 203         if ($?) {
 204                 unlink($file) if ($need_unlink);
 205                 return &text('install_eirpm', "<tt>$out</tt>");
 206                 }
 207         unlink("$config_directory/module.infos.cache");
 208         &flush_webmin_caches();
 209
 210         $mdirs[0] = &module_root_directory($name);
 211         if (%minfo = &get_module_info($name)) {
 212                 # Get the new module info
 213                 $mdescs[0] = $minfo{'desc'};
 214                 $msizes[0] = &disk_usage_kb($mdirs[0]);
 215                 @newmods = ( $name );
 216
 217                 # Update the ACL for this user
 218                 &grant_user_module($grant, [ $name ]);
 219                 &webmin_log("install", undef, $name,
 220                             { 'desc' => $mdescs[0] });
 221                 }
 222         elsif (%tinfo = &get_theme_info($name)) {
 223                 # Get the theme info
 224                 $mdescs[0] = $tinfo{'desc'};
 225                 $msizes[0] = &disk_usage_kb($mdirs[0]);
 226                 &webmin_log("tinstall", undef, $name,
 227                             { 'desc' => $mdescs[0] });
 228                 }
 229         else {
 230                 unlink($file) if ($need_unlink);
 231                 return $text{'install_eneither'};
 232                 }
 233         }
 234 else {
 235         # Check if this is a valid module (a tar file of multiple module or
 236         # theme directories)
 237         my (%mods, %hasfile);
 238         &has_command("tar") || return $text{'install_enotar'};
 239         my $tar = &backquote_command("tar tf ".&quote_path($file)." 2>&1");
 240         if ($?) {
 241                 unlink($file) if ($need_unlink);
 242                 return &text('install_etar', $tar);
 243                 }
 244         foreach my $f (split(/\n/, $tar)) {
 245                 if ($f =~ /^\.\/([^\/]+)\/(.*)$/ || $f =~ /^([^\/]+)\/(.*)$/) {
 246                         $redirect_to = $1 if (!$redirect_to);
 247                         $mods{$1}++;
 248                         $hasfile{$1,$2}++;
 249                         }
 250                 }
 251         foreach $m (keys %mods) {
 252                 if (!$hasfile{$m,"module.info"} && !$hasfile{$m,"theme.info"}) {
 253                         unlink($file) if ($need_unlink);
 254                         return &text('install_einfo', "<tt>$m</tt>");
 255                         }
 256                 }
 257         if (!%mods) {
 258                 unlink($file) if ($need_unlink);
 259                 return $text{'install_enone'};
 260                 }
 261
 262         # Get the module.info or theme.info files to check dependancies
 263         my $ver = &get_webmin_version();
 264         my $tmpdir = &transname();
 265         mkdir($tmpdir, 0700);
 266         my $err;
 267         my @realmods;
 268         foreach $m (keys %mods) {
 269                 next if (!$hasfile{$m,"module.info"} &&
 270                          !$hasfile{$m,"theme.info"});
 271                 push(@realmods, $m);
 272                 my %minfo;
 273                 system("cd $tmpdir ; tar xf \"$file\" $m/module.info ./$m/module.info $m/theme.info ./$m/theme.info >/dev/null 2>&1");
 274                 if (!&read_file("$tmpdir/$m/module.info", \%minfo) &&
 275                     !&read_file("$tmpdir/$m/theme.info", \%minfo)) {
 276                         $err = &text('install_einfo', "<tt>$m</tt>");
 277                         }
 278                 elsif (!&check_os_support(\%minfo)) {
 279                         $err = &text('install_eos', "<tt>$m</tt>",
 280                                      $gconfig{'real_os_type'},
 281                                      $gconfig{'real_os_version'});
 282                         }
 283                 elsif ($minfo{'usermin'} && !$minfo{'webmin'}) {
 284                         $err = &text('install_eusermin', "<tt>$m</tt>");
 285                         }
 286                 elsif (!$nodeps) {
 287                         my $deps = $minfo{'webmin_depends'} ||
 288                                    $minfo{'depends'} || "";
 289                         foreach my $dep (split(/\s+/, $deps)) {
 290                                 if ($dep =~ /^[0-9\.]+$/) {
 291                                         # Depends on some version of webmin
 292                                         if ($dep > $ver) {
 293                                                 $err = &text('install_ever',
 294                                                         "<tt>$m</tt>",
 295                                                         "<tt>$dep</tt>");
 296                                                 }
 297                                         }
 298                                 elsif ($dep =~ /^(\S+)\/([0-9\.]+)$/) {
 299                                         # Depends on a specific version of
 300                                         # some other module
 301                                         my ($dmod, $dver) = ($1, $2);
 302                                         my %dinfo = &get_module_info($dmod);
 303                                         if (!$mods{$dmod} &&
 304                                             (!%dinfo ||
 305                                              $dinfo{'version'} < $dver)) {
 306                                                 $err = &text('install_edep2',
 307                                                         "<tt>$m</tt>",
 308                                                         "<tt>$dmod</tt>",
 309                                                         "<tt>$dver</tt>");
 310                                                 }
 311                                         }
 312                                 elsif (!&foreign_exists($dep) &&
 313                                        !$mods{$dep}) {
 314                                         # Depends on some other module
 315                                         $err = &text('install_edep',
 316                                                 "<tt>$m</tt>", "<tt>$dep</tt>");
 317                                         }
 318                                 }
 319                         foreach my $dep (split(/\s+/, $minfo{'perldepends'} || "")) {
 320                                 eval "use $dep";
 321                                 if ($@) {
 322                                         $err = &text('install_eperldep',
 323                                              "<tt>$m</tt>", "<tt>$dep</tt>",
 324                                              "$gconfig{'webprefix'}/cpan/download.cgi?source=3&cpan=$dep");
 325                                         }
 326                                 }
 327                         }
 328                 last if ($err);
 329                 }
 330         system("rm -rf $tmpdir >/dev/null 2>&1");
 331         if ($err) {
 332                 unlink($file) if ($need_unlink);
 333                 return $err;
 334                 }
 335
 336         # Delete modules or themes being replaced
 337         my $oldpwd = &get_current_dir();
 338         chdir($root_directory);
 339         my @grantmods;
 340         foreach $m (@realmods) {
 341                 push(@grantmods, $m) if (!&foreign_exists($m));
 342                 if ($m ne "webmin") {
 343                         system("rm -rf ".quotemeta("$install_root_directory/$m")." 2>&1 >/dev/null");
 344                         }
 345                 }
 346
 347         # Extract all the modules and update perl path and ownership
 348         my $out = `cd $install_root_directory ; tar xf "$file" 2>&1 >/dev/null`;
 349         chdir($oldpwd);
 350         if ($?) {
 351                 unlink($file) if ($need_unlink);
 352                 return &text('install_eextract', $out);
 353                 }
 354         if ($need_unlink) { unlink($file); }
 355         my $perl = &get_perl_path();
 356         my @st = stat("$module_root_directory/index.cgi");
 357         foreach my $moddir (keys %mods) {
 358                 my $pwd = &module_root_directory($moddir);
 359                 if ($hasfile{$moddir,"module.info"}) {
 360                         my %minfo = &get_module_info($moddir);
 361                         push(@mdescs, $minfo{'desc'});
 362                         push(@mdirs, $pwd);
 363                         push(@msizes, &disk_usage_kb($pwd));
 364                         &webmin_log("install", undef, $moddir,
 365                                     { 'desc' => $minfo{'desc'} });
 366                         push(@newmods, $moddir);
 367                         }
 368                 else {
 369                         my %tinfo = &get_theme_info($moddir);
 370                         push(@mdescs, $tinfo{'desc'});
 371                         push(@mdirs, $pwd);
 372                         push(@msizes, &disk_usage_kb($pwd));
 373                         &webmin_log("tinstall", undef, $moddir,
 374                                     { 'desc' => $tinfo{'desc'} });
 375                         }
 376                 system("cd $install_root_directory ; (find $pwd -name '*.cgi' ; find $pwd -name '*.pl') 2>/dev/null | $perl $root_directory/perlpath.pl $perl -");
 377                 system("cd $install_root_directory ; chown -R $st[4]:$st[5] $pwd");
 378                 }
 379
 380         # Copy appropriate config file from modules to /etc/webmin
 381         my @permmods = grep { !-d "$config_directory/$_" } @newmods;
 382         system("cd $root_directory ; $perl $root_directory/copyconfig.pl '$gconfig{'os_type'}/$gconfig{'real_os_type'}' '$gconfig{'os_version'}/$gconfig{'real_os_version'}' '$install_root_directory' '$config_directory' ".join(' ', @realmods)." >/dev/null");
 383
 384         # Set correct permissions on *new* config directory
 385         if (&supports_users()) {
 386                 foreach my $m (@permmods) {
 387                         system("chown -R root $config_directory/$m");
 388                         system("chgrp -R bin $config_directory/$m");
 389                         system("chmod -R og-rw $config_directory/$m");
 390                         }
 391                 }
 392
 393         # Update ACL for this user so they can access the new modules
 394         &grant_user_module($grant, \@grantmods);
 395         }
 396 &flush_webmin_caches();
 397
 398 # Run post-install scripts
 399 foreach $m (@newmods) {
 400         next if (!-r &module_root_directory($m)."/postinstall.pl");
 401         eval {
 402                 local $main::error_must_die = 1;
 403                 &foreign_require($m, "postinstall.pl");
 404                 &foreign_call($m, "module_install");
 405                 };
 406         }
 407
 408 return [ \@mdescs, \@mdirs, \@msizes ];
 409 }
 410
 411 =head2 grant_user_module(&users/groups, &modules)
 412
 413 Grants users or groups access to a set of modules. The users parameter must
 414 be an array ref of usernames or group names, and modules must be an array
 415 ref of module names.
 416
 417 =cut
 418 sub grant_user_module
 419 {
 420 # Grant to appropriate users
 421 my %acl;
 422 &read_acl(undef, \%acl);
 423 my $fh = "GRANTS";
 424 &open_tempfile($fh, ">".&acl_filename());
 425 my $u;
 426 foreach $u (keys %acl) {
 427         my @mods = @{$acl{$u}};
 428         if (!$_[0] || &indexof($u, @{$_[0]}) >= 0) {
 429                 @mods = &unique(@mods, @{$_[1]});
 430                 }
 431         &print_tempfile($fh, "$u: ",join(' ', @mods),"\n");
 432         }
 433 &close_tempfile($fh);
 434
 435 # Grant to appropriate groups
 436 if ($_[1] && &foreign_check("acl")) {
 437         &foreign_require("acl", "acl-lib.pl");
 438         my @groups = &acl::list_groups();
 439         my @users = &acl::list_users();
 440         foreach my $g (@groups) {
 441                 if (&indexof($g->{'name'}, @{$_[0]}) >= 0) {
 442                         $g->{'modules'} = [ &unique(@{$g->{'modules'}},
 443                                                     @{$_[1]}) ];
 444                         &acl::modify_group($g->{'name'}, $g);
 445                         &acl::update_members(\@users, \@groups, $g->{'modules'},
 446                                              $g->{'members'});
 447                         }
 448                 }
 449         }
 450 }
 451
 452 =head2 delete_webmin_module(module, [delete-acls])
 453
 454 Deletes some webmin module, clone or theme, and return a description of
 455 the thing deleted. If the delete-acls flag is set, all .acl files are
 456 removed too.
 457
 458 =cut
 459 sub delete_webmin_module
 460 {
 461 my $m = $_[0];
 462 return undef if (!$m);
 463 my %minfo = &get_module_info($m);
 464 %minfo = &get_theme_info($m) if (!%minfo);
 465 return undef if (!%minfo);
 466 my ($mdesc, @aclrm);
 467 @aclrm = ( $m ) if ($_[1]);
 468 if ($minfo{'clone'}) {
 469         # Deleting a clone
 470         my %cinfo;
 471         &read_file("$config_directory/$m/clone", \%cinfo);
 472         unlink(&module_root_directory($m));
 473         system("rm -rf $config_directory/$m");
 474         if ($gconfig{'theme'}) {
 475                 unlink("$root_directory/$gconfig{'theme'}/$m");
 476                 }
 477         $mdesc = &text('delete_desc1', $minfo{'desc'}, $minfo{'clone'});
 478         }
 479 else {
 480         # Delete any clones of this module
 481         my @clones;
 482         my $mdir = &module_root_directory($m);
 483         my @mst = stat($mdir);
 484         foreach my $r (@root_directories) {
 485                 opendir(DIR, $r);
 486                 foreach my $l (readdir(DIR)) {
 487                         my @lst = stat("$r/$l");
 488                         if (-l "$r/$l" && $lst[1] == $mst[1]) {
 489                                 unlink("$r/$l");
 490                                 system("rm -rf $config_directory/$l");
 491                                 push(@clones, $l);
 492                                 }
 493                         }
 494                 closedir(DIR);
 495                 }
 496
 497         my $type;
 498         open(TYPE, "$mdir/install-type");
 499         chop($type = <TYPE>);
 500         close(TYPE);
 501
 502         # Run the module's uninstall script
 503         if (&check_os_support(\%minfo) &&
 504             -r "$mdir/uninstall.pl") {
 505                 eval {
 506                         &foreign_require($m, "uninstall.pl");
 507                         &foreign_call($m, "module_uninstall");
 508                         };
 509                 }
 510
 511         # Deleting the real module
 512         my $size = &disk_usage_kb($mdir);
 513         $mdesc = &text('delete_desc2', "<b>$minfo{'desc'}</b>",
 514                            "<tt>$mdir</tt>", $size);
 515         if ($type eq 'rpm') {
 516                 # This module was installed from an RPM .. rpm -e it
 517                 &system_logged("rpm -e wbm-$m");
 518                 }
 519         else {
 520                 # Module was installed from a .wbm file .. just rm it
 521                 &system_logged("rm -rf ".quotemeta($mdir));
 522                 }
 523
 524         if ($_[1]) {
 525                 # Delete any .acl files
 526                 &system_logged("rm -f $config_directory/$m/*.acl");
 527                 push(@aclrm, @clones);
 528                 }
 529         }
 530
 531 # Delete from all users and groups
 532 if (@aclrm) {
 533         &foreign_require("acl", "acl-lib.pl");
 534         my ($u, $g, $m);
 535         foreach $u (&acl::list_users()) {
 536                 my $changed;
 537                 foreach $m (@aclrm) {
 538                         my $mi = &indexof($m, @{$u->{'modules'}});
 539                         my $oi = &indexof($m, @{$u->{'ownmods'}});
 540                         splice(@{$u->{'modules'}}, $mi, 1) if ($mi >= 0);
 541                         splice(@{$u->{'ownmods'}}, $oi, 1) if ($oi >= 0);
 542                         $changed++ if ($mi >= 0 || $oi >= 0);
 543                         }
 544                 &acl::modify_user($u->{'name'}, $u) if ($changed);
 545                 }
 546         foreach $g (&acl::list_groups()) {
 547                 my $changed;
 548                 foreach $m (@aclrm) {
 549                         my $mi = &indexof($m, @{$g->{'modules'}});
 550                         my $oi = &indexof($m, @{$g->{'ownmods'}});
 551                         splice(@{$g->{'modules'}}, $mi, 1) if ($mi >= 0);
 552                         splice(@{$g->{'ownmods'}}, $oi, 1) if ($oi >= 0);
 553                         $changed++ if ($mi >= 0 || $oi >= 0);
 554                         }
 555                 &acl::modify_group($g->{'name'}, $g) if ($changed);
 556                 }
 557         }
 558
 559 &webmin_log("delete", undef, $m, { 'desc' => $minfo{'desc'} });
 560 return $mdesc;
 561 }
 562
 563 =head2 file_basename(name)
 564
 565 Returns the part of a filename after the last /.
 566
 567 =cut
 568 sub file_basename
 569 {
 570 my $rv = $_[0];
 571 $rv =~ s/^.*[\/\\]//;
 572 return $rv;
 573 }
 574
 575 =head2 gnupg_setup
 576
 577 Setup gnupg so that rpms and .tar.gz files can be verified.
 578 Returns 0 if ok, 1 if gnupg is not installed, or 2 if something went wrong
 579 Assumes that gnupg-lib.pl is available
 580
 581 =cut
 582 sub gnupg_setup
 583 {
 584 return ( 1, &text('enogpg', "<tt>gpg</tt>") ) if (!&has_command($gpgpath));
 585
 586 # Check if we already have the key
 587 my @keys = &list_keys();
 588 foreach my $k (@keys) {
 589         return ( 0 ) if ($k->{'email'}->[0] eq $webmin_key_email &&
 590                          &key_fingerprint($k) eq $webmin_key_fingerprint);
 591         }
 592
 593 # Import it if not
 594 &list_keys();
 595 my $out = &backquote_logged(
 596         "$gpgpath --import $module_root_directory/jcameron-key.asc 2>&1");
 597 if ($?) {
 598         return (2, $out);
 599         }
 600 return 0;
 601 }
 602
 603 =head2 list_standard_modules
 604
 605 Returns a list containing the short names, URLs and descriptions of the
 606 standard Webmin modules from www.webmin.com. If an error occurs, returns the
 607 message instead.
 608
 609 =cut
 610 sub list_standard_modules
 611 {
 612 my $temp = &transname();
 613 my $error;
 614 my ($host, $port, $page, $ssl);
 615 if ($config{'standard_url'}) {
 616         ($host, $port, $page, $ssl) = &parse_http_url($config{'standard_url'});
 617         return $text{'standard_eurl'} if (!$host);
 618         }
 619 else {
 620         ($host, $port, $page, $ssl) = ($standard_host, $standard_port,
 621                                        $standard_page, $standard_ssl);
 622         }
 623 &http_download($host, $port, $page, $temp, \$error, undef, $ssl);
 624 return $error if ($error);
 625 my @rv;
 626 open(TEMP, $temp);
 627 while(<TEMP>) {
 628         s/\r|\n//g;
 629         my @l = split(/\t+/, $_);
 630         push(@rv, \@l);
 631         }
 632 close(TEMP);
 633 unlink($temp);
 634 return \@rv;
 635 }
 636
 637 =head2 standard_chooser_button(input, [form])
 638
 639 Returns HTML for a popup button for choosing a standard module.
 640
 641 =cut
 642 sub standard_chooser_button
 643 {
 644 return &popup_window_button("standard_chooser.cgi", 800, 500, 1,
 645         [ [ "ifield", $_[0], "mod" ] ]);
 646 }
 647
 648 =head2 list_third_modules
 649
 650 Returns a list containing the names, versions, URLs and descriptions of the
 651 third-party Webmin modules from thirdpartymodules.webmin.com. If an error
 652 occurs, returns the message instead.
 653
 654 =cut
 655 sub list_third_modules
 656 {
 657 my $temp = &transname();
 658 my $error;
 659 my ($host, $port, $page, $ssl);
 660 if ($config{'third_url'}) {
 661         ($host, $port, $page, $ssl) = &parse_http_url($config{'third_url'});
 662         return $text{'third_eurl'} if (!$host);
 663         }
 664 else {
 665         ($host, $port, $page, $ssl) = ($third_host, $third_port,
 666                                        $third_page, $third_ssl);
 667         }
 668 &http_download($host, $port, $page, $temp, \$error, undef, $ssl);
 669 return $error if ($error);
 670 my @rv;
 671 open(TEMP, $temp);
 672 while(<TEMP>) {
 673         s/\r|\n//g;
 674         my @l = split(/\t+/, $_);
 675         push(@rv, \@l);
 676         }
 677 close(TEMP);
 678 unlink($temp);
 679 return \@rv;
 680 }
 681
 682 =head2 third_chooser_button(input, [form])
 683
 684 Returns HTML for a popup button for choosing a third-party module.
 685
 686 =cut
 687 sub third_chooser_button
 688 {
 689 return &popup_window_button("third_chooser.cgi", 800, 500, 1,
 690         [ [ "ifield", $_[0], "mod" ] ]);
 691 }
 692
 693 =head2 get_webmin_base_version
 694
 695 Gets the webmin version, rounded to the nearest .01
 696
 697 =cut
 698 sub get_webmin_base_version
 699 {
 700 return &base_version(&get_webmin_version());
 701 }
 702
 703 =head2 base_version
 704
 705 Rounds a version number down to the nearest .01
 706
 707 =cut
 708 sub base_version
 709 {
 710 return sprintf("%.2f0", $_[0] - 0.005);
 711 }
 712
 713 =head2 get_newmodule_users
 714
 715 Returns a ref to an array of users to whom new modules are granted by default,
 716 or undef if the admin hasn't chosen any yet.
 717
 718 =cut
 719 sub get_newmodule_users
 720 {
 721 if (open(NEWMODS, $newmodule_users_file)) {
 722         my @rv;
 723         while(<NEWMODS>) {
 724                 s/\r|\n//g;
 725                 push(@rv, $_) if (/\S/);
 726                 }
 727         close(NEWMODS);
 728         return \@rv;
 729         }
 730 else {
 731         return undef;
 732         }
 733 }
 734
 735 =head2 save_newmodule_users(&users)
 736
 737 Saves the list of users to whom new modules are granted. If undef is given,
 738 the default behaviour (of using root or admin) is used.
 739
 740 =cut
 741 sub save_newmodule_users
 742 {
 743 &lock_file($newmodule_users_file);
 744 if ($_[0]) {
 745         my $fh = "NEWUSERS";
 746         &open_tempfile($fh, ">$newmodule_users_file");
 747         foreach my $u (@{$_[0]}) {
 748                 &print_tempfile($fh, "$u\n");
 749                 }
 750         &close_tempfile($fh);
 751         }
 752 else {
 753         unlink($newmodule_users_file);
 754         }
 755 &unlock_file($newmodule_users_file);
 756 }
 757
 758 =head2 get_miniserv_sockets(&miniserv)
 759
 760 Returns an array of tuple refs, each of which contains an IP address and port
 761 number that Webmin listens on. The IP can be * (meaning any), and the port can
 762 be * (meaning the primary port).
 763
 764 =cut
 765 sub get_miniserv_sockets
 766 {
 767 my @sockets;
 768 push(@sockets, [ $_[0]->{'bind'} || "*", $_[0]->{'port'} ]);
 769 foreach my $s (split(/\s+/, $_[0]->{'sockets'} || "")) {
 770         if ($s =~ /^(\d+)$/) {
 771                 # Just listen on another port on the main IP
 772                 push(@sockets, [ $sockets[0]->[0], $s ]);
 773                 }
 774         elsif ($s =~ /^(\S+):(\d+)$/) {
 775                 # Listen on a specific port and IP
 776                 push(@sockets, [ $1, $2 ]);
 777                 }
 778         elsif ($s =~ /^([0-9\.]+):\*$/ || $s =~ /^([0-9\.]+)$/ ||
 779                $s =~ /^([a-f0-9:]+):\*$/ || $s =~ /^([a-f0-9:]+)$/) {
 780                 # Listen on the main port on another IP
 781                 push(@sockets, [ $1, "*" ]);
 782                 }
 783         }
 784 return @sockets;
 785 }
 786
 787 =head2 fetch_updates(url, [login, pass], [sig-mode])
 788
 789 Returns a list of updates from some URL, or calls &error. Each element is an
 790 array reference containing :
 791
 792 =item Module directory name.
 793
 794 =item Version number.
 795
 796 =item Absolute or relative download URL.
 797
 798 =item Operating systems the update is relevant for, in the same format as the os_support line in a module.info file.
 799
 800 =item Human-readable description of the update.
 801
 802 The parameters are :
 803
 804 =item url - Full URL to download updates from.
 805
 806 =item login - Optional login for the URL.
 807
 808 =item pass - Optional password for the URL.
 809
 810 =item sig-mode - 0=No check, 1=Check if possible, 2=Must check
 811
 812 =cut
 813 sub fetch_updates
 814 {
 815 my ($url, $user, $pass, $sigmode) = @_;
 816 my ($host, $port, $page, $ssl) = &parse_http_url($url);
 817 $host || &error($text{'update_eurl'});
 818
 819 # Download the file
 820 my $temp = &transname();
 821 &http_download($host, $port, $page, $temp, undef, undef, $ssl, $user, $pass,
 822                0, 0, 1);
 823
 824 # Download the signature, if we can check it
 825 my ($ec, $emsg) = &gnupg_setup();
 826 if (!$ec && $sigmode) {
 827         my $err;
 828         my $sig;
 829         &http_download($host, $port, $page."-sig.asc", \$sig,
 830                        \$err, undef, $ssl, $user, $pass, 0, 0, 1);
 831         if ($err) {
 832                 $sigmode == 2 && &error(&text('update_enosig', $err));
 833                 }
 834         else {
 835                 my $data = &read_file_contents($temp);
 836                 my ($vc, $vmsg) = &verify_data($data, $sig);
 837                 if ($vc > 1) {
 838                         &error(&text('update_ebadsig',
 839                                 &text('upgrade_everify'.$vc, $vmsg)));
 840                         }
 841                 }
 842         }
 843
 844 my @updates;
 845 open(UPDATES, $temp);
 846 while(<UPDATES>) {
 847         if (/^([^\t]+)\t+([^\t]+)\t+([^\t]+)\t+([^\t]+)\t+(.*)/) {
 848                 push(@updates, [ $1, $2, $3, $4, $5 ]);
 849                 }
 850         }
 851 close(UPDATES);
 852 unlink($temp);
 853 @updates || &error($text{'update_efile'});
 854
 855 return ( \@updates, $host, $port, $page, $ssl );
 856 }
 857
 858 =head2 check_update_signature(host, port, page, ssl, user, pass, file, sig-mode)
 859
 860 Given a downloaded module update file, fetch the signature from the same URL
 861 with -sig.asc appended, and check that it is valid. Parameters are :
 862
 863 =item host - Module download host
 864
 865 =item port - Module download port
 866
 867 =item page - Module download URL path
 868
 869 =item ssl - Use SSL to download?
 870
 871 =item user - Login for module download
 872
 873 =item pass - Password for module download
 874
 875 =item file - File containing module to check
 876
 877 =item sig-mode - 0=No check, 1=Check if possible, 2=Must check
 878
 879 =cut
 880 sub check_update_signature
 881 {
 882 my ($host, $port, $page, $ssl, $user, $pass, $file, $sigmode) = @_;
 883
 884 my ($ec, $emsg) = &gnupg_setup();
 885 if (!$ec && $sigmode) {
 886         my $err;
 887         my $sig;
 888         &http_download($host, $port, $page."-sig.asc", \$sig,
 889                        \$err, undef, $ssl, $user, $pass);
 890         if ($err) {
 891                 $sigmode == 2 && return &text('update_enomodsig', $err);
 892                 }
 893         else {
 894                 my $data = &read_file_contents($file);
 895                 my ($vc, $vmsg) = &verify_data($data, $sig);
 896                 if ($vc > 1) {
 897                         return &text('update_ebadmodsig',
 898                                 &text('upgrade_everify'.$vc, $vmsg));
 899                         }
 900                 }
 901         }
 902 return undef;
 903 }
 904
 905 =head2 find_cron_job(\@jobs)
 906
 907 Finds the cron job for Webmin updates, given an array ref of cron jobs
 908 as returned by cron::list_cron_jobs
 909
 910 =cut
 911 sub find_cron_job
 912 {
 913 my ($job) = grep { $_->{'user'} eq 'root' &&
 914                    $_->{'command'} eq $cron_cmd } @{$_[0]};
 915 return $job;
 916 }
 917
 918 =head2 get_ipkeys(&miniserv)
 919
 920 Returns a list of IP address to key file mappings from a miniserv.conf entry.
 921
 922 =cut
 923 sub get_ipkeys
 924 {
 925 my @rv;
 926 foreach my $k (keys %{$_[0]}) {
 927         if ($k =~ /^ipkey_(\S+)/) {
 928                 my $ipkey = { 'ips' => [ split(/,/, $1) ],
 929                               'key' => $_[0]->{$k},
 930                               'index' => scalar(@rv) };
 931                 $ipkey->{'cert'} = $_[0]->{'ipcert_'.$1};
 932                 $ipkey->{'extracas'} = $_[0]->{'ipextracas_'.$1};
 933                 push(@rv, $ipkey);
 934                 }
 935         }
 936 return @rv;
 937 }
 938
 939 =head2 save_ipkeys(&miniserv, &keys)
 940
 941 Updates miniserv.conf entries from the given list of keys.
 942
 943 =cut
 944 sub save_ipkeys
 945 {
 946 my $k;
 947 foreach $k (keys %{$_[0]}) {
 948         if ($k =~ /^(ipkey_|ipcert_)/) {
 949                 delete($_[0]->{$k});
 950                 }
 951         }
 952 foreach $k (@{$_[1]}) {
 953         my $ips = join(",", @{$k->{'ips'}});
 954         $_[0]->{'ipkey_'.$ips} = $k->{'key'};
 955         if ($k->{'cert'}) {
 956                 $_[0]->{'ipcert_'.$ips} = $k->{'cert'};
 957                 }
 958         else {
 959                 delete($_[0]->{'ipcert_'.$ips});
 960                 }
 961         if ($k->{'extracas'}) {
 962                 $_[0]->{'ipextracas_'.$ips} = $k->{'extracas'};
 963                 }
 964         else {
 965                 delete($_[0]->{'ipextracas_'.$ips});
 966                 }
 967         }
 968 }
 969
 970 =head2 validate_key_cert(key, [cert])
 971
 972 Call &error if some key and cert file don't look correct, based on the BEGIN
 973 line.
 974
 975 =cut
 976 sub validate_key_cert
 977 {
 978 my $key = &read_file_contents($_[0]);
 979 $key =~ /BEGIN RSA PRIVATE KEY/i ||
 980     $key =~ /BEGIN PRIVATE KEY/i ||
 981         &error(&text('ssl_ekey', $_[0]));
 982 if (!$_[1]) {
 983         $key =~ /BEGIN CERTIFICATE/ || &error(&text('ssl_ecert', $_[0]));
 984         }
 985 else {
 986         my $cert = &read_file_contents($_[1]);
 987         $cert =~ /BEGIN CERTIFICATE/ || &error(&text('ssl_ecert', $_[1]));
 988         }
 989 }
 990
 991 =head2 detect_operating_system([os-list-file], [with-cache])
 992
 993 Returns a hash containing os_type, os_version, real_os_type and
 994 real_os_version, suitable for the current system.
 995
 996 =cut
 997 sub detect_operating_system
 998 {
 999 my $file = $_[0] || "$root_directory/os_list.txt";
1000 my $cache = $_[1];
1001 if ($cache) {
1002         # Check the cache file, and only re-check the OS if older than
1003         # 1 day, or if we have rebooted recently
1004         my %cache;
1005         my $uptime = &get_system_uptime();
1006         my $lastreboot = $uptime ? time()-$uptime : undef;
1007         if (&read_file($detect_operating_system_cache, \%cache) &&
1008             $cache{'os_type'} && $cache{'os_version'} &&
1009             $cache{'real_os_type'} && $cache{'real_os_version'}) {
1010                 if ($cache{'time'} > time()-24*60*60 &&
1011                     $cache{'time'} > $lastreboot) {
1012                         return %cache;
1013                         }
1014                 }
1015         }
1016 my $temp = &transname();
1017 my $perl = &get_perl_path();
1018 system("$perl $root_directory/oschooser.pl $file $temp 1");
1019 my %rv;
1020 &read_env_file($temp, \%rv);
1021 $rv{'time'} = time();
1022 &write_file($detect_operating_system_cache, \%rv);
1023 return %rv;
1024 }
1025
1026 =head2 show_webmin_notifications([no-updates])
1027
1028 Print various notifications for the current user, if any. These can include
1029 password expiry, Webmin updates and more.
1030
1031 =cut
1032 sub show_webmin_notifications
1033 {
1034 my ($noupdates) = @_;
1035 my @notifs = &get_webmin_notifications($noupdates);
1036 if (@notifs) {
1037         print "<center>\n",join("<hr>\n", @notifs),"</center>\n";
1038         }
1039 }
1040
1041 =head2 get_webmin_notifications([no-updates])
1042
1043 Returns a list of Webmin notification messages, each of which is a string of
1044 HTML. If the no-updates flag is set, Webmin version / module updates are
1045 not included.
1046
1047 =cut
1048 sub get_webmin_notifications
1049 {
1050 my ($noupdates) = @_;
1051 $noupdates = 1 if (&shared_root_directory());
1052 my @notifs;
1053 my %miniserv;
1054 &get_miniserv_config(\%miniserv);
1055 &load_theme_library();  # So that UI functions work
1056
1057 # Need OS upgrade
1058 my %realos = &detect_operating_system(undef, 1);
1059 if (($realos{'os_version'} ne $gconfig{'os_version'} ||
1060      $realos{'os_type'} ne $gconfig{'os_type'}) &&
1061     &foreign_available("webmin")) {
1062         push(@notifs,
1063                 &ui_form_start("$gconfig{'webprefix'}/webmin/fix_os.cgi").
1064                 &text('os_incorrect', $realos{'real_os_type'},
1065                                     $realos{'real_os_version'})."<p>\n".
1066                 &ui_form_end([ [ undef, $text{'os_fix'} ] ])
1067                 );
1068         }
1069
1070 # Password close to expiry
1071 my $warn_days = $config{'warn_days'};
1072 if (&foreign_check("acl")) {
1073         # Get the Webmin user
1074         &foreign_require("acl", "acl-lib.pl");
1075         my @users = &acl::list_users();
1076         my ($uinfo) = grep { $_->{'name'} eq $base_remote_user } @users;
1077         if ($uinfo && $uinfo->{'pass'} eq 'x' && &foreign_check("useradmin")) {
1078                 # Unix auth .. check password in Users and Groups
1079                 &foreign_require("useradmin", "user-lib.pl");
1080                 ($uinfo) = grep { $_->{'user'} eq $remote_user }
1081                                 &useradmin::list_users();
1082                 if ($uinfo && $uinfo->{'warn'} && $uinfo->{'change'} &&
1083                     $uinfo->{'max'}) {
1084                         my $daysago = int(time()/(24*60*60)) -
1085                                          $uinfo->{'change'};
1086                         my $cdate = &make_date(
1087                                 $uinfo->{'change'}*24*60*60, 1);
1088                         if ($daysago > $uinfo->{'max'}) {
1089                                 # Passed expiry date
1090                                 push(@notifs, &text('notif_unixexpired',
1091                                                     $cdate));
1092                                 }
1093                         elsif ($daysago > $uinfo->{'max'}-$uinfo->{'warn'}) {
1094                                 # Passed warning date
1095                                 push(@notifs, &text('notif_unixwarn',
1096                                                     $cdate,
1097                                                     $uinfo->{'max'}-$daysago));
1098                                 }
1099                         }
1100                 }
1101         elsif ($uinfo && $uinfo->{'lastchange'}) {
1102                 # Webmin auth .. check password in Webmin
1103                 my $daysold = (time() - $uinfo->{'lastchange'})/(24*60*60);
1104                 my $link = &foreign_available("change-user") ?
1105                         &text('notif_changenow',
1106                              "$gconfig{'webprefix'}/change-user/")."<p>\n" : "";
1107                 if ($miniserv{'pass_maxdays'} &&
1108                     $daysold > $miniserv{'pass_maxdays'}) {
1109                         # Already expired
1110                         push(@notifs, &text('notif_passexpired')."<p>\n".$link);
1111                         }
1112                 elsif ($miniserv{'pass_maxdays'} &&
1113                        $daysold > $miniserv{'pass_maxdays'} - $warn_days) {
1114                         # About to expire
1115                         push(@notifs, &text('notif_passchange',
1116                                 &make_date($uinfo->{'lastchange'}, 1),
1117                                 int($miniserv{'pass_maxdays'} - $daysold)).
1118                                 "<p>\n".$link);
1119                         }
1120                 elsif ($miniserv{'pass_lockdays'} &&
1121                        $daysold > $miniserv{'pass_lockdays'} - $warn_days) {
1122                         # About to lock out
1123                         push(@notifs, &text('notif_passlock',
1124                                 &make_date($uinfo->{'lastchange'}, 1),
1125                                 int($miniserv{'pass_maxdays'} - $daysold)).
1126                                 "<p>\n".$link);
1127                         }
1128                 }
1129         }
1130
1131 # New Webmin version is available, but only once per day
1132 my $now = time();
1133 if (&foreign_available($module_name) && !$noupdates &&
1134     !$gconfig{'nowebminup'}) {
1135         if (!$config{'last_version_check'} ||
1136             $now - $config{'last_version_check'} > 24*60*60) {
1137                 # Cached last version has expired .. re-fetch
1138                 my ($ok, $version) = &get_latest_webmin_version();
1139                 if ($ok) {
1140                         $config{'last_version_check'} = $now;
1141                         $config{'last_version_number'} = $version;
1142                         &save_module_config();
1143                         }
1144                 }
1145         if ($config{'last_version_number'} > &get_webmin_version()) {
1146                 # New version is out there .. offer to upgrade
1147                 my $mode = &get_install_type();
1148                 my $checksig = 0;
1149                 if ((!$mode || $mode eq "rpm") && &foreign_check("proc")) {
1150                         my ($ec, $emsg) = &gnupg_setup();
1151                         if (!$ec) {
1152                                 $checksig = 1;
1153                                 }
1154                         }
1155                 push(@notifs,
1156                      &ui_form_start("$gconfig{'webprefix'}/webmin/upgrade.cgi",
1157                                     "form-data").
1158                      &ui_hidden("source", 2).
1159                      &ui_hidden("sig", $checksig).
1160                      &ui_hidden("mode", $mode).
1161                      &text('notif_upgrade', $config{'last_version_number'},
1162                            &get_webmin_version())."<p>\n".
1163                      &ui_form_end([ [ undef, $text{'notif_upgradeok'} ] ]));
1164                 }
1165         }
1166
1167 # Webmin module updates
1168 if (&foreign_available($module_name) && !$noupdates &&
1169     !$gconfig{'nomoduleup'}) {
1170         my @st = stat($update_cache);
1171         my $allupdates = [ ];
1172         my @urls = $config{'upsource'} ?
1173                 split(/\t+/, $config{'upsource'}) : ( $update_url );
1174         if (!@st || $now - $st[9] > 24*60*60) {
1175                 # Need to re-fetch cache
1176                 foreach my $url (@urls) {
1177                         my $checksig = $config{'upchecksig'} ? 2 :
1178                                        $url eq $update_url ? 2 : 1;
1179                         eval {
1180                                 local $main::error_must_die = 1;
1181                                 my ($updates) = &fetch_updates($url,
1182                                         $config{'upuser'}, $config{'uppass'},
1183                                         $checksig);
1184                                 push(@$allupdates, @$updates);
1185                                 };
1186                         }
1187                 my $fh = "CACHE";
1188                 &open_tempfile($fh, ">$update_cache", 1);
1189                 &print_tempfile($fh, &serialise_variable($allupdates));
1190                 &close_tempfile($fh);
1191                 }
1192         else {
1193                 # Just use cache
1194                 my $cdata = &read_file_contents($update_cache);
1195                 $allupdates = &unserialise_variable($cdata);
1196                 }
1197
1198         # All a table of them, and a form to install
1199         $allupdates = &filter_updates($allupdates);
1200         if (@$allupdates) {
1201                 my $msg = &ui_form_start(
1202                         "$gconfig{'webprefix'}/webmin/update.cgi");
1203                 $msg .= &text('notif_updatemsg', scalar(@$allupdates))."<p>\n";
1204                 $msg .= &ui_columns_start(
1205                         [ $text{'notify_updatemod'},
1206                           $text{'notify_updatever'},
1207                           $text{'notify_updatedesc'} ]);
1208                 foreach my $u (@$allupdates) {
1209                         my %minfo = &get_module_info($u->[0]);
1210                         my %tinfo = &get_theme_info($u->[0]);
1211                         my %info = %minfo ? %minfo : %tinfo;
1212                         $msg .= &ui_columns_row([
1213                                 $info{'desc'},
1214                                 $u->[1],
1215                                 $u->[4] ]);
1216                         }
1217                 $msg .= &ui_columns_end();
1218                 $msg .= &ui_hidden("source", 1);
1219                 $msg .= &ui_hidden("other", join("\n", @urls));
1220                 $msg .= &ui_hidden("upuser", $config{'upuser'});
1221                 $msg .= &ui_hidden("uppass", $config{'uppass'});
1222                 $msg .= &ui_hidden("third", $config{'upthird'});
1223                 $msg .= &ui_hidden("checksig", $config{'upchecksig'});
1224                 $msg .= &ui_form_end([ [ undef, $text{'notif_updateok'} ] ]);
1225                 push(@notifs, $msg);
1226                 }
1227         }
1228
1229 return @notifs;
1230 }
1231
1232 =head2 get_system_uptime
1233
1234 Returns the number of seconds the system has been up, or undef if un-available.
1235
1236 =cut
1237 sub get_system_uptime
1238 {
1239 # Try Linux /proc/uptime first
1240 if (open(UPTIME, "/proc/uptime")) {
1241         my $line = <UPTIME>;
1242         close(UPTIME);
1243         my ($uptime, $dummy) = split(/\s+/, $line);
1244         if ($uptime > 0) {
1245                 return int($uptime);
1246                 }
1247         }
1248
1249 # Try to parse uptime command output
1250 if ($gconfig{'os_type'} ne 'windows') {
1251         my $out = &backquote_command("uptime");
1252         if ($out =~ /up\s+(\d+)\s+day/) {
1253                 return $1*24*60*60;
1254                 }
1255         elsif ($out =~ /up\s+(\d+)\s+min/) {
1256                 return $1*60;
1257                 }
1258         elsif ($out =~ /up\s+(\d+)\s+hour/) {
1259                 return $1*60*60;
1260                 }
1261         elsif ($out =~ /up\s+(\d+):(\d+)/) {
1262                 return $1*60*60 + $2*60;
1263                 }
1264         }
1265
1266 return undef;
1267 }
1268
1269 =head2 list_operating_systems([os-list-file])
1270
1271 Returns a list of known OSs, each of which is a hash ref with keys :
1272
1273 =item realtype - A human-readable OS name, like Ubuntu Linux.
1274
1275 =item realversion - A human-readable version, like 8.04.
1276
1277 =item type - Webmin's internal OS code, like debian-linux.
1278
1279 =item version - Webmin's internal version number, like 3.1.
1280
1281 =item code - A fragment of Perl that will return true if evaluated on this OS.
1282
1283 =cut
1284 sub list_operating_systems
1285 {
1286 my $file = $_[0] || "$root_directory/os_list.txt";
1287 my @rv;
1288 open(OSLIST, $file);
1289 while(<OSLIST>) {
1290         if (/^([^\t]+)\t+([^\t]+)\t+([^\t]+)\t+([^\t]+)\t+(.*)/) {
1291                 push(@rv, { 'realtype' => $1,
1292                             'realversion' => $2,
1293                             'type' => $3,
1294                             'version' => $4,
1295                             'code' => $5 });
1296                 }
1297         }
1298 close(OSLIST);
1299 return @rv;
1300 }
1301
1302 =head2 shared_root_directory
1303
1304 Returns 1 if the Webmin root directory is shared with another system, such as
1305 via NFS, or in a Solaris zone. If so, updates and module installs are not
1306 allowed.
1307
1308 =cut
1309 sub shared_root_directory
1310 {
1311 if (exists($gconfig{'shared_root'}) && $gconfig{'shared_root'} eq '1') {
1312         # Always shared
1313         return 1;
1314         }
1315 elsif (exists($gconfig{'shared_root'}) && $gconfig{'shared_root'} eq '0') {
1316         # Definately not shared
1317         return 0;
1318         }
1319 if (&running_in_zone()) {
1320         # In a Solaris zone .. is the root directory loopback mounted?
1321         if (&foreign_exists("mount")) {
1322                 &foreign_require("mount", "mount-lib.pl");
1323                 my @rst = stat($root_directory);
1324                 my $m;
1325                 foreach $m (&mount::list_mounted()) {
1326                         my @mst = stat($m->[0]);
1327                         if ($mst[0] == $rst[0] &&
1328                             &is_under_directory($m->[0], $root_directory)) {
1329                                 # Found the mount!
1330                                 if ($m->[2] eq "lofs" || $m->[2] eq "nfs") {
1331                                         return 1;
1332                                         }
1333                                 }
1334                         }
1335                 }
1336         }
1337 return 0;
1338 }
1339
1340 =head2 submit_os_info(id)
1341
1342 Send via email a message about this system's OS and Perl version. Returns
1343 undef if OK, or an error message.
1344
1345 =cut
1346 sub submit_os_info
1347 {
1348 if (!&foreign_installed("mailboxes", 1)) {
1349         return $text{'submit_emailboxes'};
1350         }
1351 &foreign_require("mailboxes", "mailboxes-lib.pl");
1352 my $mail = {    'headers' => [ [ 'From', &mailboxes::get_from_address() ],
1353                                [ 'To', $os_info_address ],
1354                                [ 'Subject', 'Webmin OS Information' ] ],
1355                 'attach' => [ {
1356                    'headers' => [ [ 'Content-type', 'text/plain' ] ],
1357                    'data' => "OS: $gconfig{'real_os_type'}\n".
1358                              "Version: $gconfig{'real_os_version'}\n".
1359                              "OS code: $gconfig{'os_type'}\n".
1360                              "Version code: $gconfig{'os_version'}\n".
1361                              "Perl: $]\n".
1362                              "Webmin: ".&get_webmin_version()."\n".
1363                              "ID: ".&get_webmin_id()."\n" } ],
1364                 };
1365 eval { &mailboxes::send_mail($mail); };
1366 return $@ ? $@ : undef;
1367 }
1368
1369 =head2 get_webmin_id
1370
1371 Returns a (hopefully) unique ID for this Webmin install.
1372
1373 =cut
1374 sub get_webmin_id
1375 {
1376 if (!$config{'webminid'}) {
1377         my $salt = substr(time(), -2);
1378         $config{'webminid'} = &unix_crypt(&get_system_hostname(), $salt);
1379         &save_module_config();
1380         }
1381 return $config{'webminid'};
1382 }
1383
1384 =head2 ip_match(ip, [match]+)
1385
1386 Checks an IP address against a list of IPs, networks and networks/masks, and
1387 returns 1 if a match is found.
1388
1389 =cut
1390 sub ip_match
1391 {
1392 my @io = &check_ip6address($_[0]) ? split(/:/, $_[0])
1393                                   : split(/\./, $_[0]);
1394
1395 # Resolve to hostname and check that it forward resolves again
1396 my $hn = &to_hostname($_[0]);
1397 if (&check_ip6address($_[0])) {
1398         $hn = "" if (&to_ip6address($hn) ne $_[0]);
1399         }
1400 else {
1401         $hn = "" if (&to_ipaddress($hn) ne $_[0]);
1402         }
1403
1404 for(my $i=1; $i<@_; $i++) {
1405         my $mismatch = 0;
1406         my $ip = $_[$i];
1407         if ($ip =~ /^(\S+)\/(\d+)$/) {
1408                 # Convert CIDR to netmask format
1409                 $ip = $1."/".&prefix_to_mask($2);
1410                 }
1411         if ($ip =~ /^(\S+)\/(\S+)$/) {
1412                 # Compare with IPv4 network/mask
1413                 my @mo = split(/\./, $1);
1414                 my @ms = split(/\./, $2);
1415                 for(my $j=0; $j<4; $j++) {
1416                         if ((int($io[$j]) & int($ms[$j])) != int($mo[$j])) {
1417                                 $mismatch = 1;
1418                                 }
1419                         }
1420                 }
1421         elsif ($ip =~ /^\*(\.\S+)$/) {
1422                 # Compare with hostname regexp
1423                 $mismatch = 1 if ($hn !~ /$1$/);
1424                 }
1425         elsif ($ip eq 'LOCAL') {
1426                 # Just assume OK for now
1427                 }
1428         elsif ($_[$i] =~ /^[0-9\.]+$/) {
1429                 # Compare with IPv4 address or network
1430                 my @mo = split(/\./, $_[$i]);
1431                 while(@mo && !$mo[$#mo]) { pop(@mo); }
1432                 for(my $j=0; $j<@mo; $j++) {
1433                         if ($mo[$j] != $io[$j]) {
1434                                 $mismatch = 1;
1435                                 }
1436                         }
1437                 }
1438         elsif ($_[$i] =~ /^[a-f0-9:]+$/) {
1439                 # Compare with IPv6 address or network
1440                 my @mo = split(/:/, $_[$i]);
1441                 while(@mo && !$mo[$#mo]) { pop(@mo); }
1442                 for(my $j=0; $j<@mo; $j++) {
1443                         if ($mo[$j] ne $io[$j]) {
1444                                 $mismatch = 1;
1445                                 }
1446                         }
1447                 }
1448         elsif ($_[$i] !~ /^[0-9\.]+$/) {
1449                 # Compare with hostname
1450                 $mismatch = 1 if ($_[0] ne &to_ipaddress($_[$i]));
1451                 }
1452         return 1 if (!$mismatch);
1453         }
1454 return 0;
1455 }
1456
1457 =head2 prefix_to_mask(prefix)
1458
1459 Converts a number like 24 to a mask like 255.255.255.0.
1460
1461 =cut
1462 sub prefix_to_mask
1463 {
1464 return $_[0] >= 24 ? "255.255.255.".(256-(2 ** (32-$_[0]))) :
1465        $_[0] >= 16 ? "255.255.".(256-(2 ** (24-$_[0]))).".0" :
1466        $_[0] >= 16 ? "255.".(256-(2 ** (16-$_[0]))).".0.0" :
1467                      (256-(2 ** (8-$_[0]))).".0.0.0";
1468 }
1469
1470 =head2 valid_allow(text)
1471
1472 Returns undef if some text is a valid IP, hostname or network for use in
1473 allowed IPs, or an error message if not
1474
1475 =cut
1476 sub valid_allow
1477 {
1478 my ($h) = @_;
1479 if ($h =~ /^([0-9\.]+)\/(\d+)$/) {
1480         &check_ipaddress($1) ||
1481                 return &text('access_enet', "$1");
1482         $2 >= 0 && $2 <= 32 ||
1483                 return &text('access_ecidr', "$2");
1484         }
1485 elsif ($h =~ /^([0-9\.]+)\/([0-9\.]+)$/) {
1486         &check_ipaddress($1) ||
1487                 return &text('access_enet', "$1");
1488         &check_ipaddress($2) ||
1489                 return &text('access_emask', "$2");
1490         }
1491 elsif ($h =~ /^[0-9\.]+$/) {
1492         &check_ipaddress($h) ||
1493                 return &text('access_eip', $h);
1494         }
1495 elsif ($h =~ /^[a-f0-9:]+$/) {
1496         &check_ip6address($h) ||
1497                 return &text('access_eip6', $h);
1498         }
1499 elsif ($h =~ /^\*\.(\S+)$/) {
1500         # *.domain is OK
1501         }
1502 elsif ($h eq 'LOCAL') {
1503         # Local means any on local nets
1504         }
1505 elsif (&to_ipaddress($h) || &to_ip6address($h)) {
1506         # Resolvable hostname
1507         }
1508 else {
1509         return &text('access_ehost', $h);
1510         }
1511 return undef;
1512 }
1513
1514 =head2 get_preloads(&miniserv)
1515
1516 Returns a list of module names and files to pre-load, based on a Webmin
1517 miniserv configuration hash. Each is a two-element array ref containing
1518 a package name and the relative path of the .pl file to pre-load.
1519
1520 =cut
1521 sub get_preloads
1522 {
1523 my @rv = map { [ split(/=/, $_) ] } split(/\s+/, $_[0]->{'preload'});
1524 return @rv;
1525 }
1526
1527 =head2 save_preloads(&miniserv, &preloads)
1528
1529 Updates a Webmin miniserv configuration hash from a list of preloads, in
1530 the format returned by get_preloads.
1531
1532 =cut
1533 sub save_preloads
1534 {
1535 $_[0]->{'preload'} = join(" ", map { "$_->[0]=$_->[1]" } @{$_[1]});
1536 }
1537
1538 =head2 get_tempdirs(&gconfig)
1539
1540 Returns a list of per-module temp directories, each of which is an array
1541 ref containing a module name and directory.
1542
1543 =cut
1544 sub get_tempdirs
1545 {
1546 my ($gconfig) = @_;
1547 my @rv;
1548 foreach my $k (keys %$gconfig) {
1549         if ($k =~ /^tempdir_(.*)$/) {
1550                 push(@rv, [ $1, $gconfig->{$k} ]);
1551                 }
1552         }
1553 return sort { $a->[0] cmp $b->[0] } @rv;
1554 }
1555
1556 =head2 save_tempdirs(&gconfig, &tempdirs)
1557
1558 Updates the global config with a list of per-module temp dirs
1559
1560 =cut
1561 sub save_tempdirs
1562 {
1563 my ($gconfig, $dirs) = @_;
1564 foreach my $k (keys %$gconfig) {
1565         if ($k =~ /^tempdir_(.*)$/) {
1566                 delete($gconfig->{$k});
1567                 }
1568         }
1569 foreach my $d (@$dirs) {
1570         $gconfig->{'tempdir_'.$d->[0]} = $d->[1];
1571         }
1572 }
1573
1574 =head2 get_module_install_type(dir)
1575
1576 Returns the installation method used for some module (such as 'rpm'), or undef
1577 if it was installed from a .wbm.
1578
1579 =cut
1580 sub get_module_install_type
1581 {
1582 my ($mod) = @_;
1583 my $it = &module_root_directory($mod)."/install-type";
1584 open(TYPE, $it) || return undef;
1585 my $type = <TYPE>;
1586 chop($type);
1587 close(TYPE);
1588 return $type;
1589 }
1590
1591 =head2 get_install_type
1592
1593 Returns the package type Webmin was installed form (rpm, deb, solaris-pkg
1594 or undef for tar.gz).
1595
1596 =cut
1597 sub get_install_type
1598 {
1599 my $mode;
1600 if (open(MODE, "$root_directory/install-type")) {
1601         chop($mode = <MODE>);
1602         close(MODE);
1603         }
1604 else {
1605         if ($root_directory eq "/usr/libexec/webmin") {
1606                 $mode = "rpm";
1607                 }
1608         elsif ($root_directory eq "/usr/shard/webmin") {
1609                 $mode = "deb";
1610                 }
1611         elsif ($root_directory eq "/opt/webmin") {
1612                 $mode = "solaris-pkg";
1613                 }
1614         else {
1615                 $mode = undef;
1616                 }
1617         }
1618 return $mode;
1619 }
1620
1621 =head2 list_cached_files
1622
1623 Returns a list of cached filenames for downloads made by Webmin, as array refs
1624 containing a full path and url.
1625
1626 =cut
1627 sub list_cached_files
1628 {
1629 my @rv;
1630 opendir(DIR, $main::http_cache_directory);
1631 foreach my $cfile (readdir(DIR)) {
1632         next if ($cfile eq "." || $cfile eq "..");
1633         my $curl = $cfile;
1634         $curl =~ s/_/\//g;
1635         push(@rv, [ $cfile, "$main::http_cache_directory/$cfile", $curl ]);
1636         }
1637 closedir(DIR);
1638 return @rv;
1639 }
1640
1641 =head2 show_restart_page([title, msg])
1642
1643 Output a page with header and footer about Webmin needing to restart.
1644
1645 =cut
1646 sub show_restart_page
1647 {
1648 my ($title, $msg) = @_;
1649 $title ||= $text{'restart_title'};
1650 $msg ||= $text{'restart_done'};
1651 &ui_print_header(undef, $title, "");
1652
1653 print "$msg<p>\n";
1654
1655 &ui_print_footer("", $text{'index_return'});
1656 &restart_miniserv(1);
1657 }
1658
1659 =head2 cert_info(file)
1660
1661 Returns a hash of details of a cert in some file.
1662
1663 =cut
1664 sub cert_info
1665 {
1666 my %rv;
1667 local $_;
1668 open(OUT, "openssl x509 -in ".quotemeta($_[0])." -issuer -subject -enddate |");
1669 while(<OUT>) {
1670         s/\r|\n//g;
1671         if (/subject=.*CN=([^\/]+)/) {
1672                 $rv{'cn'} = $1;
1673                 }
1674         if (/subject=.*O=([^\/]+)/) {
1675                 $rv{'o'} = $1;
1676                 }
1677         if (/subject=.*Email=([^\/]+)/) {
1678                 $rv{'email'} = $1;
1679                 }
1680         if (/issuer=.*CN=([^\/]+)/) {
1681                 $rv{'issuer_cn'} = $1;
1682                 }
1683         if (/issuer=.*O=([^\/]+)/) {
1684                 $rv{'issuer_o'} = $1;
1685                 }
1686         if (/issuer=.*Email=([^\/]+)/) {
1687                 $rv{'issuer_email'} = $1;
1688                 }
1689         if (/notAfter=(.*)/) {
1690                 $rv{'notafter'} = $1;
1691                 }
1692         }
1693 close(OUT);
1694 $rv{'type'} = $rv{'o'} eq $rv{'issuer_o'} ? $text{'ssl_typeself'}
1695                                           : $text{'ssl_typereal'};
1696 return \%rv;
1697 }
1698
1699 =head2 cert_pem_data(file)
1700
1701 Returns a cert in PEM format, from a file containing the PEM and possibly
1702 other keys.
1703
1704 =cut
1705 sub cert_pem_data
1706 {
1707 my ($d) = @_;
1708 my $data = &read_file_contents($_[0]);
1709 if ($data =~ /(-----BEGIN\s+CERTIFICATE-----\n([A-Za-z0-9\+\/=\n\r]+)-----END\s+CERTIFICATE-----)/) {
1710         return $1;
1711         }
1712 return undef;
1713 }
1714
1715 =head2 cert_pkcs12_data(keyfile, [certfile])
1716
1717 Returns a cert in PKCS12 format.
1718
1719 =cut
1720 sub cert_pkcs12_data
1721 {
1722 my ($keyfile, $certfile) = @_;
1723 if ($certfile) {
1724         open(OUT, "openssl pkcs12 -in ".quotemeta($certfile).
1725                   " -inkey ".quotemeta($keyfile).
1726                   " -export -passout pass: -nokeys |");
1727         }
1728 else {
1729         open(OUT, "openssl pkcs12 -in ".quotemeta($keyfile).
1730                   " -export -passout pass: -nokeys |");
1731         }
1732 my $data;
1733 while(<OUT>) {
1734         $data .= $_;
1735         }
1736 close(OUT);
1737 return $data;
1738 }
1739
1740 =head2 get_blocked_users_hosts(&miniserv)
1741
1742 Returns a list of blocked users and hosts from the file written by Webmin
1743 at run-time.
1744
1745 =cut
1746 sub get_blocked_users_hosts
1747 {
1748 my ($miniserv) = @_;
1749 my $bf = $miniserv->{'blockedfile'};
1750 if (!$bf) {
1751         $miniserv->{'pidfile'} =~ /^(.*)\/[^\/]+$/;
1752         $bf = "$1/blocked";
1753         }
1754 my @rv;
1755 my $fh = "BLOCKED";
1756 &open_readfile($fh, $bf) || return ();
1757 while(<$fh>) {
1758         s/\r|\n//g;
1759         my ($type, $who, $fails, $when) = split(/\s+/, $_);
1760         push(@rv, { 'type' => $type,
1761                     $type => $who,
1762                     'fails' => $fails,
1763                     'when' => $when });
1764         }
1765 close($fh);
1766 return @rv;
1767 }
1768
1769 =head2 show_ssl_key_form([defhost], [defemail], [deforg])
1770
1771 Returns HTML for inputs to generate a new self-signed cert.
1772
1773 =cut
1774 sub show_ssl_key_form
1775 {
1776 my ($defhost, $defemail, $deforg) = @_;
1777 my $rv;
1778
1779 $rv .= &ui_table_row($text{'ssl_cn'},
1780                     &ui_opt_textbox("commonName", $defhost, 30,
1781                                     $text{'ssl_all'}));
1782
1783 $rv .= &ui_table_row($text{'ca_email'},
1784                     &ui_textbox("emailAddress", $defemail, 30));
1785
1786 $rv .= &ui_table_row($text{'ca_ou'},
1787                     &ui_textbox("organizationalUnitName", undef, 30));
1788
1789 $rv .= &ui_table_row($text{'ca_o'},
1790                     &ui_textbox("organizationName", $deforg, 30));
1791
1792 $rv .= &ui_table_row($text{'ca_city'},
1793                     &ui_textbox("cityName", undef, 30));
1794
1795 $rv .= &ui_table_row($text{'ca_sp'},
1796                     &ui_textbox("stateOrProvinceName", undef, 15));
1797
1798 $rv .= &ui_table_row($text{'ca_c'},
1799                     &ui_textbox("countryName", undef, 2));
1800
1801 $rv .= &ui_table_row($text{'ssl_size'},
1802                     &ui_opt_textbox("size", undef, 6,
1803                                     "$text{'default'} ($default_key_size)").
1804                         " ".$text{'ssl_bits'});
1805
1806 $rv .= &ui_table_row($text{'ssl_days'},
1807                     &ui_textbox("days", 1825, 8));
1808
1809 return $rv;
1810 }
1811
1812 =head2 parse_ssl_key_form(&in, keyfile, [certfile])
1813
1814 Parses the key generation form, and creates new key and cert files.
1815 Returns undef on success or an error message on failure.
1816
1817 =cut
1818 sub parse_ssl_key_form
1819 {
1820 my ($in, $keyfile, $certfile) = @_;
1821 my %in = %$in;
1822
1823 # Validate inputs
1824 $in{'commonName_def'} || $in{'commonName'} =~ /^[A-Za-z0-9\.\-\*]+$/ ||
1825         return $text{'newkey_ecn'};
1826 $in{'size_def'} || $in{'size'} =~ /^\d+$/ || return $text{'newkey_esize'};
1827 $in{'days'} =~ /^\d+$/ || return $text{'newkey_edays'};
1828 $in{'countryName'} =~ /^\S\S$/ || return $text{'newkey_ecountry'};
1829
1830 # Work out SSL command
1831 my %aclconfig = &foreign_config('acl');
1832 &foreign_require("acl", "acl-lib.pl");
1833 my $cmd = &acl::get_ssleay();
1834 if (!$cmd) {
1835         return &text('newkey_ecmd', "<tt>$aclconfig{'ssleay'}</tt>",
1836                      "$gconfig{'webprefix'}/config.cgi?acl");
1837         }
1838
1839 # Run openssl and feed it key data
1840 my $ctemp = &transname();
1841 my $ktemp = &transname();
1842 my $outtemp = &transname();
1843 my $size = $in{'size_def'} ? $default_key_size : quotemeta($in{'size'});
1844 open(CA, "| $cmd req -newkey rsa:$size -x509 -nodes -out $ctemp -keyout $ktemp -days ".quotemeta($in{'days'})." >$outtemp 2>&1");
1845 print CA ($in{'countryName'} || "."),"\n";
1846 print CA ($in{'stateOrProvinceName'} || "."),"\n";
1847 print CA ($in{'cityName'} || "."),"\n";
1848 print CA ($in{'organizationName'} || "."),"\n";
1849 print CA ($in{'organizationalUnitName'} || "."),"\n";
1850 print CA ($in{'commonName_def'} ? "*" : $in{'commonName'}),"\n";
1851 print CA ($in{'emailAddress'} || "."),"\n";
1852 close(CA);
1853 my $rv = $?;
1854 my $out = &read_file_contents($outtemp);
1855 unlink($outtemp);
1856 if (!-r $ctemp || !-r $ktemp || $?) {
1857         return $text{'newkey_essl'}."<br>"."<pre>".&html_escape($out)."</pre>";
1858         }
1859
1860 # Write to the final files
1861 my $certout = &read_file_contents($ctemp);
1862 my $keyout = &read_file_contents($ktemp);
1863 unlink($ctemp, $ktemp);
1864
1865 my ($kfh, $cfh);
1866 &open_lock_tempfile($kfh, ">$keyfile");
1867 &print_tempfile($kfh, $keyout);
1868 if ($certfile) {
1869         # Separate files
1870         &open_lock_tempfile($cfh, ">$certfile");
1871         &print_tempfile($cfh, $certout);
1872         &close_tempfile($cfh);
1873         &set_ownership_permissions(undef, undef, 0600, $certfile);
1874         }
1875 else {
1876         # Both go in the same file
1877         &print_tempfile($kfh, $certout);
1878         }
1879 &close_tempfile($kfh);
1880 &set_ownership_permissions(undef, undef, 0600, $keyfile);
1881
1882 return undef;
1883 }
1884
1885 =head2 build_installed_modules(force-all, force-mod)
1886
1887 Calls each module's install_check function, and updates the cache of
1888 modules whose underlying servers are installed.
1889
1890 =cut
1891 sub build_installed_modules
1892 {
1893 my ($force, $mod) = @_;
1894 my %installed;
1895 my $changed;
1896 &read_file_cached("$config_directory/installed.cache", \%installed);
1897 my @changed;
1898 foreach my $minfo (&get_all_module_infos()) {
1899         next if ($mod && $minfo->{'dir'} ne $mod);
1900         next if (defined($installed{$minfo->{'dir'}}) && !$force && !$mod);
1901         next if (!&check_os_support($minfo));
1902         $@ = undef;
1903         my $o = $installed{$minfo->{'dir'}} || 0;
1904         my $pid = fork();
1905         if (!$pid) {
1906                 # Check in a sub-process
1907                 my $rv;
1908                 eval {
1909                         local $main::error_must_die = 1;
1910                         $rv = &foreign_installed($minfo->{'dir'}, 0) ? 1 : 0;
1911                         };
1912                 if ($@) {
1913                         # Install check failed .. but assume the module is OK
1914                         $rv = 1;
1915                         }
1916                 exit($rv);
1917                 }
1918         waitpid($pid, 0);
1919         $installed{$minfo->{'dir'}} = $? / 256;
1920         push(@changed, $minfo->{'dir'}) if ($installed{$minfo->{'dir'}} &&
1921                                             $installed{$minfo->{'dir'}} ne $o);
1922         }
1923 &write_file("$config_directory/installed.cache", \%installed);
1924 return wantarray ? (\%installed, \@changed) : \%installed;
1925 }
1926
1927 =head2 get_latest_webmin_version
1928
1929 Returns 1 and the latest version of Webmin available on www.webmin.com, or
1930 0 and an error message
1931
1932 =cut
1933 sub get_latest_webmin_version
1934 {
1935 my $file = &transname();
1936 my ($error, $version);
1937 &http_download($update_host, $update_port, '/', $file, \$error);
1938 return (0, $error) if ($error);
1939 open(FILE, $file);
1940 while(<FILE>) {
1941         if (/webmin-([0-9\.]+)\.tar\.gz/) {
1942                 $version = $1;
1943                 last;
1944                 }
1945         }
1946 close(FILE);
1947 unlink($file);
1948 return $version ? (1, $version)
1949                 : (0, "No version number found at $update_host");
1950 }
1951
1952 =head2 filter_updates(&updates, [version], [include-third], [include-missing])
1953
1954 Given a list of updates, filters them to include only those that are
1955 suitable for this system. The parameters are :
1956
1957 =item updates - Array ref of updates, as returned by fetch_updates.
1958
1959 =item version - Webmin version number to use in comparisons.
1960
1961 =item include-third - Set to 1 to include non-core modules in the results.
1962
1963 =item include-missing - Set to 1 to include modules not currently installed.
1964
1965 =cut
1966 sub filter_updates
1967 {
1968 my ($allupdates, $version, $third, $missing) = @_;
1969 $version ||= &get_webmin_version();
1970 my $bversion = &base_version($version);
1971 my $updatestemp = &transname();
1972 my @updates;
1973 foreach my $u (@$allupdates) {
1974         my %minfo = &get_module_info($u->[0]);
1975         my %tinfo = &get_theme_info($u->[0]);
1976         my %info = %minfo ? %minfo : %tinfo;
1977
1978         # Skip if wrong version of Webmin, unless this is non-core module and
1979         # we are handling them too
1980         my $nver = $u->[1];
1981         $nver =~ s/^(\d+\.\d+)\..*$/$1/;
1982         next if (($nver >= $bversion + .01 ||
1983                   $nver <= $bversion ||
1984                   $nver <= $version) &&
1985                  (!%info || $info{'longdesc'} || !$third));
1986
1987         # Skip if not installed, unless installing new
1988         next if (!%info && !$missing);
1989
1990         # Skip if module has a version, and we already have it
1991         next if (%info && $info{'version'} && $info{'version'} >= $nver);
1992
1993         # Skip if not supported on this OS
1994         my $osinfo = { 'os_support' => $u->[3] };
1995         next if (!&check_os_support($osinfo));
1996
1997         # Skip if installed from RPM or Deb and update was not
1998         my $itype = &get_module_install_type($u->[0]);
1999         next if ($itype && $u->[2] !~ /\.$itype$/i);
2000
2001         push(@updates, $u);
2002         }
2003 return \@updates;
2004 }
2005
2006 1;