1=head1 webmin-lib.pl 2 3Common functions for configuring miniserv and adjusting global Webmin settings. 4 5=cut 6 7BEGIN { push(@INC, ".."); }; 8use strict; 9use warnings; 10no warnings 'redefine'; 11use WebminCore; 12&init_config(); 13our ($module_root_directory, %text, %gconfig, $root_directory, %config, 14 $module_name, $remote_user, $base_remote_user, $gpgpath, 15 $module_config_directory, @lang_order_list, @root_directories, 16 $module_var_directory); 17do "$module_root_directory/gnupg-lib.pl"; 18do "$module_root_directory/letsencrypt-lib.pl"; 19do "$module_root_directory/twofactor-funcs-lib.pl"; 20use Socket; 21 22our @cs_codes = ( 'cs_page', 'cs_text', 'cs_table', 'cs_header', 'cs_link' ); 23our @cs_names = map { $text{$_} } @cs_codes; 24 25our $osdn_host = "prdownloads.sourceforge.net"; 26our $osdn_port = 80; 27 28our $update_host = "download.webmin.com"; 29our $update_port = 80; 30our $update_page = "/updates/updates.txt"; 31our $update_url = "http://$update_host:$update_port$update_page"; 32our $redirect_host = "www.webmin.com"; 33our $redirect_url = "http://$redirect_host/cgi-bin/redirect.cgi"; 34our $update_cache = "$module_config_directory/update-cache"; 35if (!-r $update_cache) { 36 $update_cache = "$module_var_directory/update-cache"; 37 } 38 39our $primary_host = "www.webmin.com"; 40our $primary_port = 80; 41 42our $webmin_key_email = "jcameron\@webmin.com"; 43our $webmin_key_fingerprint = "1719 003A CE3E 5A41 E2DE 70DF D97A 3AE9 11F6 3C51"; 44 45our $authentic_key_email = "ilia\@rostovtsev.io"; 46our $authentic_key_email_old = "ilia\@rostovtsev.ru"; 47our $authentic_key_fingerprint = "EC60 F3DA 9CB7 9ADC CF56 0D1F 121E 166D D9C8 21AB"; 48 49our $standard_host = $primary_host; 50our $standard_port = $primary_port; 51our $standard_page = "/download/modules/standard.txt"; 52our $standard_ssl = 0; 53 54our $third_host = $primary_host; 55our $third_port = $primary_port; 56our $third_page = "/cgi-bin/third.cgi"; 57our $third_ssl = 0; 58 59our $default_key_size = "2048"; 60 61# Obsolete, but still defined so it can be deleted 62our $cron_cmd = "$module_config_directory/update.pl"; 63 64our $os_info_address = "os\@webmin.com"; 65 66our $detect_operating_system_cache = "$module_config_directory/oscache"; 67if (!-r $detect_operating_system_cache) { 68 $detect_operating_system_cache = "$module_var_directory/oscache"; 69 } 70 71our @webmin_date_formats = ( "dd/mon/yyyy", "dd/mm/yyyy", 72 "mm/dd/yyyy", "yyyy/mm/dd", 73 "d. mon yyyy", "dd.mm.yyyy", "yyyy-mm-dd" ); 74 75our @debug_what_events = ( 'start', 'read', 'write', 'ops', 'procs', 'diff', 'cmd', 'net', 'sql' ); 76 77our $record_login_cmd = "$config_directory/login.pl"; 78our $record_logout_cmd = "$config_directory/logout.pl"; 79our $record_failed_cmd = "$config_directory/failed.pl"; 80 81our $strong_ssl_ciphers = "ECDHE-RSA-AES256-SHA384:AES256-SHA256:AES256-SHA256:RC4:HIGH:MEDIUM:+TLSv1:+TLSv1.1:+TLSv1.2:!MD5:!ADH:!aNULL:!eNULL:!NULL:!DH:!ADH:!EDH:!AESGCM"; 82our $pfs_ssl_ciphers = "EECDH+AES:EDH+AES:-SHA1:EECDH+RC4:EDH+RC4:RC4-SHA:EECDH+AES256:EDH+AES256:AES256-SHA:!aNULL:!eNULL:!EXP:!LOW:!MD5"; 83 84our $newmodule_users_file = "$config_directory/newmodules"; 85 86our $first_install_file = "$config_directory/first-install"; 87 88our $hidden_announce_file = "$module_config_directory/announce-hidden"; 89 90our $postpone_reboot_required = "$module_var_directory/postpone-reboot-required"; 91 92our $password_change_mod = "passwd"; 93our $password_change_path = "/".$password_change_mod."/change_passwd.cgi"; 94 95=head2 setup_ca 96 97Internal function to create all the configuration files needed for the Webmin 98client SSL certificate CA. 99 100=cut 101sub setup_ca 102{ 103my ($miniserv) = @_; 104my $adir = &module_root_directory("acl"); 105my $conf = &read_file_contents("$adir/openssl.cnf"); 106my $acl = "$config_directory/acl"; 107$conf =~ s/DIRECTORY/$acl/g; 108 109&lock_file("$acl/openssl.cnf"); 110my $cfh = "CONF"; 111&open_tempfile($cfh, ">$acl/openssl.cnf"); 112&print_tempfile($cfh, $conf); 113&close_tempfile($cfh); 114chmod(0600, "$acl/openssl.cnf"); 115&unlock_file("$acl/openssl.cnf"); 116 117&lock_file("$acl/index.txt"); 118my $ifh = "INDEX"; 119&open_tempfile($ifh, ">$acl/index.txt"); 120&close_tempfile($ifh); 121chmod(0600, "$acl/index.txt"); 122&unlock_file("$acl/index.txt"); 123 124&lock_file("$acl/serial"); 125my $sfh = "SERIAL"; 126&open_tempfile($sfh, ">$acl/serial"); 127&print_tempfile($sfh, "011E\n"); 128&close_tempfile($sfh); 129chmod(0600, "$acl/serial"); 130&unlock_file("$acl/serial"); 131 132&lock_file("$acl/newcerts"); 133mkdir("$acl/newcerts", 0700); 134chmod(0700, "$acl/newcerts"); 135&unlock_file("$acl/newcerts"); 136$miniserv->{'ca'} = "$acl/ca.pem"; 137} 138 139=head2 install_webmin_module(file, unlink, nodeps, &users|groups) 140 141Installs a webmin module or theme, and returns either an error message 142or references to three arrays for descriptions, directories and sizes. 143On success or failure, the file is deleted if the unlink parameter is set. 144Unless the nodeps parameter is set to 1, any missing dependencies will cause 145installation to fail. 146 147Any new modules will be granted to the users and groups named in the fourth 148parameter, which must be an array reference. 149 150=cut 151sub install_webmin_module 152{ 153my ($file, $need_unlink, $nodeps, $grant) = @_; 154my (@mdescs, @mdirs, @msizes); 155my (@newmods, @newthemes, $m); 156my $install_root_directory = $gconfig{'install_root'} || $root_directory; 157 158# Uncompress the module file if needed 159my $two; 160open(MFILE, "<".$file); 161read(MFILE, $two, 2); 162close(MFILE); 163if ($two eq "\037\235") { 164 if (!&has_command("uncompress")) { 165 unlink($file) if ($need_unlink); 166 return &text('install_ecomp', "<tt>uncompress</tt>"); 167 } 168 my $temp = $file =~ /\/([^\/]+)\.Z/i ? &transname("$1") 169 : &transname(); 170 my $out = &backquote_command("uncompress -c "."e_path($file). 171 " 2>&1 >$temp"); 172 unlink($file) if ($need_unlink); 173 if ($?) { 174 unlink($temp); 175 return &text('install_ecomp2', $out); 176 } 177 $file = $temp; 178 $need_unlink = 1; 179 } 180elsif ($two eq "\037\213") { 181 if (!&has_command("gunzip") && !&has_command("gzip")) { 182 unlink($file) if ($need_unlink); 183 return &text('install_egzip', "<tt>gunzip</tt>"); 184 } 185 my $temp = $file =~ /\/([^\/]+)\.gz/i ? &transname("$1") 186 : &transname(); 187 my $cmd = &has_command("gunzip") ? "gunzip -c" : "gzip -d -c"; 188 my $out = &backquote_command($cmd." "."e_path($file). 189 " 2>&1 >$temp"); 190 unlink($file) if ($need_unlink); 191 if ($? || !-s $temp) { 192 unlink($temp); 193 return &text('install_egzip2', $out); 194 } 195 $file = $temp; 196 $need_unlink = 1; 197 } 198elsif ($two eq "BZ") { 199 if (!&has_command("bunzip2")) { 200 unlink($file) if ($need_unlink); 201 return &text('install_ebunzip', "<tt>bunzip2</tt>"); 202 } 203 my $temp = $file =~ /\/([^\/]+)\.gz/i ? &transname("$1") 204 : &transname(); 205 my $out = &backquote_command("bunzip2 -c "."e_path($file). 206 " 2>&1 >$temp"); 207 unlink($file) if ($need_unlink); 208 if ($?) { 209 unlink($temp); 210 return &text('install_ebunzip2', $out); 211 } 212 $file = $temp; 213 $need_unlink = 1; 214 } 215 216# Check if this is an RPM webmin module or theme 217my ($type, $redirect_to); 218$type = &read_file_contents("$root_directory/install-type"); 219chop($type) if ($type); 220my $out; 221if ($type eq 'rpm' && $file =~ /\.rpm$/i && 222 ($out = &backquote_command("rpm -qp $file 2>/dev/null"))) { 223 # Looks like an RPM of some kind, hopefully an RPM webmin module 224 # or theme 225 my (%minfo, %tinfo, $name); 226 if ($out !~ /(^|\n)(wbm|wbt)-([a-z\-]+[a-z])/) { 227 unlink($file) if ($need_unlink); 228 return $text{'install_erpm'}; 229 } 230 $redirect_to = $name = $3; 231 $out = &backquote_logged("rpm -U \"$file\" 2>&1"); 232 if ($?) { 233 unlink($file) if ($need_unlink); 234 return &text('install_eirpm', "<tt>$out</tt>"); 235 } 236 &flush_webmin_caches(); 237 238 $mdirs[0] = &module_root_directory($name); 239 if (%minfo = &get_module_info($name)) { 240 # Get the new module info 241 $mdescs[0] = $minfo{'desc'}; 242 $msizes[0] = &disk_usage_kb($mdirs[0]); 243 @newmods = ( $name ); 244 245 # Update the ACL for this user 246 &grant_user_module($grant, [ $name ]); 247 &webmin_log("install", undef, $name, 248 { 'desc' => $mdescs[0] }); 249 } 250 elsif (%tinfo = &get_theme_info($name)) { 251 # Get the theme info 252 $mdescs[0] = $tinfo{'desc'}; 253 $msizes[0] = &disk_usage_kb($mdirs[0]); 254 @newthemes = ( $name ); 255 &webmin_log("tinstall", undef, $name, 256 { 'desc' => $mdescs[0] }); 257 } 258 else { 259 unlink($file) if ($need_unlink); 260 return $text{'install_eneither'}; 261 } 262 } 263else { 264 # Check if this is a valid module (a tar file of multiple module or 265 # theme directories) 266 my (%mods, %hasfile); 267 &has_command("tar") || return $text{'install_enotar'}; 268 my $tar = &backquote_command("tar tf "."e_path($file)." 2>&1"); 269 if ($?) { 270 unlink($file) if ($need_unlink); 271 return &text('install_etar', $tar); 272 } 273 foreach my $f (split(/\n/, $tar)) { 274 if ($f =~ /^\.\/([^\/]+)\/(.*)$/ || $f =~ /^([^\/]+)\/(.*)$/) { 275 $redirect_to = $1 if (!$redirect_to); 276 $mods{$1}++; 277 $hasfile{$1,$2}++; 278 } 279 } 280 foreach $m (keys %mods) { 281 if (!$hasfile{$m,"module.info"} && !$hasfile{$m,"theme.info"}) { 282 unlink($file) if ($need_unlink); 283 return &text('install_einfo', "<tt>$m</tt>"); 284 } 285 } 286 if (!%mods) { 287 unlink($file) if ($need_unlink); 288 return $text{'install_enone'}; 289 } 290 291 # Get the module.info or theme.info files to check dependencies 292 my $ver = &get_webmin_version(); 293 my $tmpdir = &transname(); 294 mkdir($tmpdir, 0700); 295 my $err; 296 my @realmods; 297 foreach $m (keys %mods) { 298 next if (!$hasfile{$m,"module.info"} && 299 !$hasfile{$m,"theme.info"}); 300 push(@realmods, $m); 301 my %minfo; 302 system("cd $tmpdir ; tar xf \"$file\" $m/module.info ./$m/module.info $m/theme.info ./$m/theme.info >/dev/null 2>&1"); 303 if (!&read_file("$tmpdir/$m/module.info", \%minfo) && 304 !&read_file("$tmpdir/$m/theme.info", \%minfo)) { 305 $err = &text('install_einfo', "<tt>$m</tt>"); 306 } 307 elsif (!&check_os_support(\%minfo)) { 308 $err = &text('install_eos', "<tt>$m</tt>", 309 $gconfig{'real_os_type'}, 310 $gconfig{'real_os_version'}); 311 } 312 elsif ($minfo{'usermin'} && !$minfo{'webmin'}) { 313 $err = &text('install_eusermin', "<tt>$m</tt>"); 314 } 315 elsif (!$nodeps) { 316 my $deps = $minfo{'webmin_depends'} || 317 $minfo{'depends'} || ""; 318 foreach my $dep (split(/\s+/, $deps)) { 319 if ($dep =~ /^[0-9\.]+$/) { 320 # Depends on some version of webmin 321 if ($dep > $ver) { 322 $err = &text('install_ever', 323 "<tt>$m</tt>", 324 "<tt>$dep</tt>"); 325 } 326 } 327 elsif ($dep =~ /^(\S+)\/([0-9\.]+)$/) { 328 # Depends on a specific version of 329 # some other module 330 my ($dmod, $dver) = ($1, $2); 331 my %dinfo = &get_module_info($dmod); 332 if (!$mods{$dmod} && 333 (!%dinfo || 334 $dinfo{'version'} < $dver)) { 335 $err = &text('install_edep2', 336 "<tt>$m</tt>", 337 "<tt>$dmod</tt>", 338 "<tt>$dver</tt>"); 339 } 340 } 341 elsif (!&foreign_exists($dep) && 342 !$mods{$dep}) { 343 # Depends on some other module 344 $err = &text('install_edep', 345 "<tt>$m</tt>", "<tt>$dep</tt>"); 346 } 347 } 348 foreach my $dep (split(/\s+/, $minfo{'perldepends'} || "")) { 349 eval "use $dep"; 350 if ($@) { 351 $err = &text('install_eperldep', 352 "<tt>$m</tt>", "<tt>$dep</tt>", 353 "$gconfig{'webprefix'}/cpan/download.cgi?source=3&cpan=$dep"); 354 } 355 } 356 } 357 last if ($err); 358 } 359 system("rm -rf $tmpdir >/dev/null 2>&1"); 360 if ($err) { 361 unlink($file) if ($need_unlink); 362 return $err; 363 } 364 365 # Delete modules or themes being replaced 366 my $oldpwd = &get_current_dir(); 367 chdir($root_directory); 368 my @grantmods; 369 foreach $m (@realmods) { 370 push(@grantmods, $m) if (!&foreign_exists($m)); 371 if ($m ne "webmin") { 372 system("rm -rf ".quotemeta("$install_root_directory/$m")." 2>&1 >/dev/null"); 373 } 374 } 375 376 # Extract all the modules and update perl path and ownership 377 my $out = &backquote_command( 378 "cd $install_root_directory ; tar xf "."e_path($file). 379 " 2>&1 >/dev/null"); 380 chdir($oldpwd); 381 if ($?) { 382 unlink($file) if ($need_unlink); 383 return &text('install_eextract', $out); 384 } 385 if ($need_unlink) { unlink($file); } 386 my $perl = &get_perl_path(); 387 my @st = stat("$module_root_directory/index.cgi"); 388 foreach my $moddir (keys %mods) { 389 my $pwd = &module_root_directory($moddir); 390 if ($hasfile{$moddir,"module.info"}) { 391 my %minfo = &get_module_info($moddir); 392 push(@mdescs, $minfo{'desc'}); 393 push(@mdirs, $pwd); 394 push(@msizes, &disk_usage_kb($pwd)); 395 &webmin_log("install", undef, $moddir, 396 { 'desc' => $minfo{'desc'} }); 397 push(@newmods, $moddir); 398 } 399 else { 400 my %tinfo = &get_theme_info($moddir); 401 push(@mdescs, $tinfo{'desc'}); 402 push(@mdirs, $pwd); 403 push(@msizes, &disk_usage_kb($pwd)); 404 push(@newthemes, $moddir); 405 &webmin_log("tinstall", undef, $moddir, 406 { 'desc' => $tinfo{'desc'} }); 407 } 408 system("cd $install_root_directory ; (find $pwd -name '*.cgi' ; find $pwd -name '*.pl') 2>/dev/null | $perl $root_directory/perlpath.pl $perl -"); 409 system("cd $install_root_directory ; chown -R $st[4]:$st[5] $pwd"); 410 } 411 412 # Copy appropriate config file from modules to /etc/webmin 413 my @permmods = grep { !-d "$config_directory/$_" } @newmods; 414 system("cd $root_directory && $perl $root_directory/copyconfig.pl ". 415 quotemeta("$gconfig{'os_type'}/$gconfig{'real_os_type'}")." ". 416 quotemeta("$gconfig{'os_version'}/$gconfig{'real_os_version'}")." ". 417 quotemeta($install_root_directory)." ". 418 quotemeta($config_directory)." ". 419 join(' ', @realmods)." >/dev/null"); 420 421 # Set correct permissions on *new* config directory 422 if (&supports_users()) { 423 my @mydir = stat($module_config_directory); 424 my $myuser = @mydir ? $mydir[4] : "root"; 425 my $mygroup = @mydir ? $mydir[5] : "bin"; 426 my $myperms = @mydir ? sprintf("%o", $mydir[2] & 0777) : "og-rw"; 427 foreach my $m (@permmods) { 428 system("chown -R $myuser $config_directory/$m"); 429 system("chgrp -R $mygroup $config_directory/$m"); 430 system("chmod -R $myperms $config_directory/$m"); 431 } 432 } 433 434 # Set reasonable permissions on install directory 435 if (&supports_users()) { 436 foreach my $m (@newmods) { 437 system("chmod -R o-w $root_directory/$m"); 438 } 439 } 440 441 # Update ACL for this user so they can access the new modules 442 &grant_user_module($grant, \@grantmods); 443 } 444&flush_webmin_caches(); 445 446# Run post-install scripts 447foreach $m (@newmods, @newthemes) { 448 next if (!-r &module_root_directory($m)."/postinstall.pl"); 449 eval { 450 local $main::error_must_die = 1; 451 &foreign_require($m, "postinstall.pl"); 452 &foreign_call($m, "module_install"); 453 }; 454 } 455 456return [ \@mdescs, \@mdirs, \@msizes ]; 457} 458 459=head2 grant_user_module(&users/groups, &modules) 460 461Grants users or groups access to a set of modules. The users parameter must 462be an array ref of usernames or group names, and modules must be an array 463ref of module names. 464 465=cut 466sub grant_user_module 467{ 468# Grant to appropriate users 469my %acl; 470&read_acl(undef, \%acl); 471my $fh = "GRANTS"; 472&open_tempfile($fh, ">".&acl_filename()); 473my $u; 474foreach $u (keys %acl) { 475 my @mods = @{$acl{$u}}; 476 if (!$_[0] || &indexof($u, @{$_[0]}) >= 0) { 477 @mods = &unique(@mods, @{$_[1]}); 478 } 479 &print_tempfile($fh, "$u: ",join(' ', @mods),"\n"); 480 } 481&close_tempfile($fh); 482 483# Grant to appropriate groups 484if ($_[1] && &foreign_check("acl")) { 485 &foreign_require("acl", "acl-lib.pl"); 486 my @groups = &acl::list_groups(); 487 my @users = &acl::list_users(); 488 foreach my $g (@groups) { 489 if (&indexof($g->{'name'}, @{$_[0]}) >= 0) { 490 $g->{'modules'} = [ &unique(@{$g->{'modules'}}, 491 @{$_[1]}) ]; 492 &acl::modify_group($g->{'name'}, $g); 493 &acl::update_members(\@users, \@groups, $g->{'modules'}, 494 $g->{'members'}); 495 } 496 } 497 } 498} 499 500=head2 delete_webmin_module(module, [delete-acls]) 501 502Deletes some webmin module, clone or theme, and return a description of 503the thing deleted. If the delete-acls flag is set, all .acl files are 504removed too. 505 506=cut 507sub delete_webmin_module 508{ 509my $m = $_[0]; 510return undef if (!$m); 511my %minfo = &get_module_info($m); 512%minfo = &get_theme_info($m) if (!%minfo); 513return undef if (!%minfo); 514my ($mdesc, @aclrm); 515@aclrm = ( $m ) if ($_[1]); 516if ($minfo{'clone'}) { 517 # Deleting a clone 518 my %cinfo; 519 &read_file("$config_directory/$m/clone", \%cinfo); 520 unlink(&module_root_directory($m)); 521 system("rm -rf $config_directory/$m"); 522 if ($gconfig{'theme'}) { 523 unlink("$root_directory/$gconfig{'theme'}/$m"); 524 } 525 $mdesc = &text('delete_desc1', $minfo{'desc'}, $minfo{'clone'}); 526 } 527else { 528 # Delete any clones of this module 529 my @clones; 530 my $mdir = &module_root_directory($m); 531 my @mst = stat($mdir); 532 foreach my $r (@root_directories) { 533 opendir(DIR, $r); 534 foreach my $l (readdir(DIR)) { 535 my @lst = stat("$r/$l"); 536 if (-l "$r/$l" && $lst[1] == $mst[1]) { 537 unlink("$r/$l"); 538 system("rm -rf $config_directory/$l"); 539 push(@clones, $l); 540 } 541 } 542 closedir(DIR); 543 } 544 545 my $type = ''; 546 if (open(TYPE, "<$mdir/install-type")) { 547 chop($type = <TYPE>); 548 close(TYPE); 549 } 550 551 # Run the module's uninstall script 552 if (&check_os_support(\%minfo) && 553 -r "$mdir/uninstall.pl") { 554 eval { 555 &foreign_require($m, "uninstall.pl"); 556 &foreign_call($m, "module_uninstall"); 557 }; 558 } 559 560 # Deleting the real module 561 my $size = &disk_usage_kb($mdir); 562 $mdesc = &text('delete_desc2', "<b>$minfo{'desc'}</b>", 563 "<tt>$mdir</tt>", $size); 564 if ($type eq 'rpm') { 565 # This module was installed from an RPM .. rpm -e it 566 &system_logged("rpm -e wbm-$m"); 567 } 568 else { 569 # Module was installed from a .wbm file .. just rm it 570 &system_logged("rm -rf ".quotemeta($mdir)); 571 } 572 573 if ($_[1]) { 574 # Delete any .acl files 575 &system_logged("rm -f $config_directory/$m/*.acl"); 576 push(@aclrm, @clones); 577 } 578 } 579 580# Delete from all users and groups 581if (@aclrm) { 582 &foreign_require("acl", "acl-lib.pl"); 583 my ($u, $g, $m); 584 foreach $u (&acl::list_users()) { 585 my $changed; 586 foreach $m (@aclrm) { 587 my $mi = &indexof($m, @{$u->{'modules'}}); 588 my $oi = &indexof($m, @{$u->{'ownmods'}}); 589 splice(@{$u->{'modules'}}, $mi, 1) if ($mi >= 0); 590 splice(@{$u->{'ownmods'}}, $oi, 1) if ($oi >= 0); 591 $changed++ if ($mi >= 0 || $oi >= 0); 592 } 593 &acl::modify_user($u->{'name'}, $u) if ($changed); 594 } 595 foreach $g (&acl::list_groups()) { 596 my $changed; 597 foreach $m (@aclrm) { 598 my $mi = &indexof($m, @{$g->{'modules'}}); 599 my $oi = &indexof($m, @{$g->{'ownmods'}}); 600 splice(@{$g->{'modules'}}, $mi, 1) if ($mi >= 0); 601 splice(@{$g->{'ownmods'}}, $oi, 1) if ($oi >= 0); 602 $changed++ if ($mi >= 0 || $oi >= 0); 603 } 604 &acl::modify_group($g->{'name'}, $g) if ($changed); 605 } 606 } 607 608&webmin_log("delete", undef, $m, { 'desc' => $minfo{'desc'} }); 609return $mdesc; 610} 611 612=head2 file_basename(name) 613 614Returns the part of a filename after the last /. 615 616=cut 617sub file_basename 618{ 619my $rv = $_[0]; 620$rv =~ s/^.*[\/\\]//; 621return $rv; 622} 623 624=head2 gnupg_setup 625 626Setup gnupg so that rpms and .tar.gz files can be verified. 627Returns 0 if ok, 1 if gnupg is not installed, or 2 if something went wrong 628Assumes that gnupg-lib.pl is available 629 630=cut 631sub gnupg_setup 632{ 633return ( 1, &text('enogpg', "<tt>gpg</tt>") ) if (!&has_command($gpgpath)); 634 635my ($ok, $err) = &import_gnupg_key( 636 $webmin_key_email, $webmin_key_fingerprint, 637 "$module_root_directory/jcameron-key.asc"); 638return ($ok, $err) if ($ok); 639 640($ok, $err) = &import_gnupg_key( 641 $authentic_key_email."|".$authentic_key_email_old, 642 $authentic_key_fingerprint, 643 "$root_directory/authentic-theme/THEME.pgp"); 644return ($ok, $err) if ($ok); 645 646return (0); 647} 648 649=head2 import_gnupg_key(email, fingerprint, keyfile) 650 651Imports the given key if not already in the key list 652 653=cut 654sub import_gnupg_key 655{ 656my ($email, $finger, $path) = @_; 657return (0) if (!-r $path); 658 659# Check if we already have the key 660my @keys = &list_keys(); 661foreach my $k (@keys) { 662 my $fp = &key_fingerprint($k); 663 return ( 0 ) if ($k->{'email'}->[0] =~ /^$email$/ && 664 $fp && $fp eq $finger); 665 } 666 667# Import it if not 668&list_keys(); 669my $out = &backquote_logged("$gpgpath --import $path 2>&1"); 670if ($?) { 671 return (2, $out); 672 } 673return (0); 674} 675 676=head2 list_standard_modules 677 678Returns a list containing the short names, URLs and descriptions of the 679standard Webmin modules from www.webmin.com. If an error occurs, returns the 680message instead. 681 682=cut 683sub list_standard_modules 684{ 685my $temp = &transname(); 686my $error; 687my ($host, $port, $page, $ssl); 688if ($config{'standard_url'}) { 689 ($host, $port, $page, $ssl) = &parse_http_url($config{'standard_url'}); 690 return $text{'standard_eurl'} if (!$host); 691 } 692else { 693 ($host, $port, $page, $ssl) = ($standard_host, $standard_port, 694 $standard_page, $standard_ssl); 695 } 696&http_download($host, $port, $page, $temp, \$error, undef, $ssl); 697return $error if ($error); 698my @rv; 699open(TEMP, "<".$temp); 700while(<TEMP>) { 701 s/\r|\n//g; 702 my @l = split(/\t+/, $_); 703 push(@rv, \@l); 704 } 705close(TEMP); 706unlink($temp); 707return \@rv; 708} 709 710=head2 standard_chooser_button(input, [form]) 711 712Returns HTML for a popup button for choosing a standard module. 713 714=cut 715sub standard_chooser_button 716{ 717return &popup_window_button("standard_chooser.cgi", 800, 500, 1, 718 [ [ "ifield", $_[0], "mod" ] ]); 719} 720 721=head2 list_third_modules 722 723Returns a list containing the names, versions, URLs and descriptions of the 724third-party Webmin modules from thirdpartymodules.webmin.com. If an error 725occurs, returns the message instead. 726 727=cut 728sub list_third_modules 729{ 730my $temp = &transname(); 731my $error; 732my ($host, $port, $page, $ssl); 733if ($config{'third_url'}) { 734 ($host, $port, $page, $ssl) = &parse_http_url($config{'third_url'}); 735 return $text{'third_eurl'} if (!$host); 736 } 737else { 738 ($host, $port, $page, $ssl) = ($third_host, $third_port, 739 $third_page, $third_ssl); 740 } 741&http_download($host, $port, $page, $temp, \$error, undef, $ssl); 742return $error if ($error); 743my @rv; 744open(TEMP, "<".$temp); 745while(<TEMP>) { 746 s/\r|\n//g; 747 my @l = split(/\t+/, $_); 748 push(@rv, \@l); 749 } 750close(TEMP); 751unlink($temp); 752return \@rv; 753} 754 755=head2 third_chooser_button(input, [form]) 756 757Returns HTML for a popup button for choosing a third-party module. 758 759=cut 760sub third_chooser_button 761{ 762return &popup_window_button("third_chooser.cgi", 800, 500, 1, 763 [ [ "ifield", $_[0], "mod" ] ]); 764} 765 766=head2 get_webmin_base_version 767 768Gets the webmin version, rounded to the nearest .01 769 770=cut 771sub get_webmin_base_version 772{ 773return &base_version(&get_webmin_version()); 774} 775 776=head2 base_version 777 778Rounds a version number down to the nearest .01 779 780=cut 781sub base_version 782{ 783my ($ver) = @_; 784#remove waning about (possible) postfixes from update-from-repo.sh 785$ver =~ s/[-a-z:_].*//gi; 786if ($ver =~ /^((\d+)\.(\d+))\.*/) { 787 $ver = $1; 788 } 789return sprintf("%.2f0", $ver); 790} 791 792=head2 get_newmodule_users 793 794Returns a ref to an array of users to whom new modules are granted by default, 795or undef if the admin hasn't chosen any yet. 796 797=cut 798sub get_newmodule_users 799{ 800if (open(NEWMODS, "<".$newmodule_users_file)) { 801 my @rv; 802 while(<NEWMODS>) { 803 s/\r|\n//g; 804 push(@rv, $_) if (/\S/); 805 } 806 close(NEWMODS); 807 return \@rv; 808 } 809else { 810 return undef; 811 } 812} 813 814=head2 save_newmodule_users(&users) 815 816Saves the list of users to whom new modules are granted. If undef is given, 817the default behaviour (of using root or admin) is used. 818 819=cut 820sub save_newmodule_users 821{ 822&lock_file($newmodule_users_file); 823if ($_[0]) { 824 my $fh = "NEWUSERS"; 825 &open_tempfile($fh, ">$newmodule_users_file"); 826 foreach my $u (@{$_[0]}) { 827 &print_tempfile($fh, "$u\n"); 828 } 829 &close_tempfile($fh); 830 } 831else { 832 unlink($newmodule_users_file); 833 } 834&unlock_file($newmodule_users_file); 835} 836 837=head2 get_miniserv_sockets(&miniserv) 838 839Returns an array of tuple refs, each of which contains an IP address and port 840number that Webmin listens on. The IP can be * (meaning any), and the port can 841be * (meaning the primary port). 842 843=cut 844sub get_miniserv_sockets 845{ 846my @sockets; 847push(@sockets, [ $_[0]->{'bind'} || "*", $_[0]->{'port'} ]); 848foreach my $s (split(/\s+/, $_[0]->{'sockets'} || "")) { 849 if ($s =~ /^(\d+)$/) { 850 # Just listen on another port on the main IP 851 push(@sockets, [ $sockets[0]->[0], $s ]); 852 } 853 elsif ($s =~ /^(\S+):(\d+)$/) { 854 # Listen on a specific port and IP 855 push(@sockets, [ $1, $2 ]); 856 } 857 elsif ($s =~ /^([0-9\.]+):\*$/ || $s =~ /^([0-9\.]+)$/ || 858 $s =~ /^([a-f0-9:]+):\*$/ || $s =~ /^([a-f0-9:]+)$/) { 859 # Listen on the main port on another IP 860 push(@sockets, [ $1, "*" ]); 861 } 862 } 863return @sockets; 864} 865 866=head2 fetch_updates(url, [login, pass], [sig-mode]) 867 868Returns a list of updates from some URL, or calls &error. Each element is an 869array reference containing : 870 871=item Module directory name. 872 873=item Version number. 874 875=item Absolute or relative download URL. 876 877=item Operating systems the update is relevant for, in the same format as the os_support line in a module.info file. 878 879=item Human-readable description of the update. 880 881The parameters are : 882 883=item url - Full URL to download updates from. 884 885=item login - Optional login for the URL. 886 887=item pass - Optional password for the URL. 888 889=item sig-mode - 0=No check, 1=Check if possible, 2=Must check 890 891=cut 892sub fetch_updates 893{ 894my ($url, $user, $pass, $sigmode) = @_; 895my ($host, $port, $page, $ssl) = &parse_http_url($url); 896$host || &error($text{'update_eurl'}); 897 898# Download the file 899my $temp = &transname(); 900&retry_http_download($host, $port, $page, $temp, undef, undef, $ssl, $user, $pass, 901 0, 0, 1); 902 903# Download the signature, if we can check it 904my ($ec, $emsg) = &gnupg_setup(); 905if (!$ec && $sigmode) { 906 my $err; 907 my $sig; 908 &retry_http_download($host, $port, $page."-sig.asc", \$sig, 909 \$err, undef, $ssl, $user, $pass, 0, 0, 1); 910 if ($err) { 911 $sigmode == 2 && &error(&text('update_enosig', $err)); 912 } 913 else { 914 my $data = &read_file_contents($temp); 915 my ($vc, $vmsg) = &verify_data($data, $sig); 916 if ($vc > 1) { 917 &error(&text('update_ebadsig', 918 &text('upgrade_everify'.$vc, $vmsg))); 919 } 920 } 921 } 922 923my @updates; 924open(UPDATES, "<".$temp); 925while(<UPDATES>) { 926 if (/^([^\t]+)\t+([^\t]+)\t+([^\t]+)\t+([^\t]+)\t+(.*)/) { 927 push(@updates, [ $1, $2, $3, $4, $5 ]); 928 } 929 } 930close(UPDATES); 931unlink($temp); 932@updates || &error($text{'update_efile'}); 933 934return ( \@updates, $host, $port, $page, $ssl ); 935} 936 937=head2 check_update_signature(host, port, page, ssl, user, pass, file, sig-mode) 938 939Given a downloaded module update file, fetch the signature from the same URL 940with -sig.asc appended, and check that it is valid. Parameters are : 941 942=item host - Module download host 943 944=item port - Module download port 945 946=item page - Module download URL path 947 948=item ssl - Use SSL to download? 949 950=item user - Login for module download 951 952=item pass - Password for module download 953 954=item file - File containing module to check 955 956=item sig-mode - 0=No check, 1=Check if possible, 2=Must check 957 958=cut 959sub check_update_signature 960{ 961my ($host, $port, $page, $ssl, $user, $pass, $file, $sigmode) = @_; 962 963my ($ec, $emsg) = &gnupg_setup(); 964if (!$ec && $sigmode) { 965 my $err; 966 my $sig; 967 &http_download($host, $port, $page."-sig.asc", \$sig, 968 \$err, undef, $ssl, $user, $pass); 969 if ($err) { 970 $sigmode == 2 && return &text('update_enomodsig', $err); 971 } 972 else { 973 my $data = &read_file_contents($file); 974 my ($vc, $vmsg) = &verify_data($data, $sig); 975 if ($vc > 1) { 976 return &text('update_ebadmodsig', 977 &text('upgrade_everify'.$vc, $vmsg)); 978 } 979 } 980 } 981return undef; 982} 983 984=head2 find_cron_job(\@jobs) 985 986Finds the cron job for Webmin updates, given an array ref of cron jobs 987as returned by cron::list_cron_jobs 988 989=cut 990sub find_cron_job 991{ 992my ($jobs) = @_; 993my ($job) = grep { $_->{'user'} eq 'root' && 994 $_->{'command'} eq $cron_cmd } @$jobs; 995return $job; 996} 997 998=head2 get_ipkeys(&miniserv) 999 1000Returns a list of IP address to key file mappings from a miniserv.conf entry. 1001 1002=cut 1003sub get_ipkeys 1004{ 1005my @rv; 1006foreach my $k (keys %{$_[0]}) { 1007 if ($k =~ /^ipkey_(\S+)/) { 1008 my $ipkey = { 'ips' => [ split(/,/, $1) ], 1009 'key' => $_[0]->{$k}, 1010 'index' => scalar(@rv) }; 1011 $ipkey->{'cert'} = $_[0]->{'ipcert_'.$1}; 1012 $ipkey->{'extracas'} = $_[0]->{'ipextracas_'.$1}; 1013 push(@rv, $ipkey); 1014 } 1015 } 1016return @rv; 1017} 1018 1019=head2 save_ipkeys(&miniserv, &keys) 1020 1021Updates miniserv.conf entries from the given list of keys. 1022 1023=cut 1024sub save_ipkeys 1025{ 1026my $k; 1027foreach $k (keys %{$_[0]}) { 1028 if ($k =~ /^(ipkey_|ipcert_|ipextracas_)/) { 1029 delete($_[0]->{$k}); 1030 } 1031 } 1032foreach $k (@{$_[1]}) { 1033 my $ips = join(",", @{$k->{'ips'}}); 1034 $_[0]->{'ipkey_'.$ips} = $k->{'key'}; 1035 if ($k->{'cert'}) { 1036 $_[0]->{'ipcert_'.$ips} = $k->{'cert'}; 1037 } 1038 else { 1039 delete($_[0]->{'ipcert_'.$ips}); 1040 } 1041 if ($k->{'extracas'}) { 1042 $_[0]->{'ipextracas_'.$ips} = $k->{'extracas'}; 1043 } 1044 else { 1045 delete($_[0]->{'ipextracas_'.$ips}); 1046 } 1047 } 1048} 1049 1050=head2 validate_key_cert(key, [cert]) 1051 1052Call &error if some key and cert file don't look correct, based on the BEGIN 1053line. 1054 1055=cut 1056sub validate_key_cert 1057{ 1058my ($keyfile, $certfile) = @_; 1059-r $keyfile || return &error(&text('ssl_ekey', $keyfile)); 1060my $key = &read_file_contents($keyfile); 1061$key =~ /BEGIN (RSA |EC )?PRIVATE KEY/i || 1062 &error(&text('ssl_ekey2', $keyfile)); 1063if (!$certfile) { 1064 $key =~ /BEGIN CERTIFICATE/ || &error(&text('ssl_ecert2', $keyfile)); 1065 } 1066else { 1067 -r $certfile || return &error(&text('ssl_ecert', $certfile)); 1068 my $cert = &read_file_contents($certfile); 1069 $cert =~ /BEGIN CERTIFICATE/ || &error(&text('ssl_ecert2', $certfile)); 1070 } 1071} 1072 1073=head2 detect_operating_system([os-list-file], [with-cache]) 1074 1075Returns a hash containing os_type, os_version, real_os_type and 1076real_os_version, suitable for the current system. 1077 1078=cut 1079sub detect_operating_system 1080{ 1081my $file = $_[0] || "$root_directory/os_list.txt"; 1082my $cache = $_[1]; 1083if ($cache) { 1084 # Check the cache file, and only re-check the OS if older than 1085 # 1 day, or if we have rebooted recently 1086 my %cache; 1087 my $uptime = &get_system_uptime(); 1088 my $lastreboot = $uptime ? time()-$uptime : undef; 1089 if (&read_file($detect_operating_system_cache, \%cache) && 1090 $cache{'os_type'} && $cache{'os_version'} && 1091 $cache{'real_os_type'} && $cache{'real_os_version'}) { 1092 if ($cache{'time'} > time()-24*60*60 && 1093 $cache{'time'} > $lastreboot) { 1094 return %cache; 1095 } 1096 } 1097 } 1098my $temp = &transname(); 1099my $perl = &get_perl_path(); 1100system("$root_directory/oschooser.pl $file $temp 1"); 1101my %rv; 1102&read_env_file($temp, \%rv); 1103$rv{'time'} = time(); 1104&write_file($detect_operating_system_cache, \%rv); 1105return %rv; 1106} 1107 1108=head2 show_webmin_notifications([no-updates]) 1109 1110Print various notifications for the current user, if any. These can include 1111password expiry, Webmin updates and more. 1112 1113=cut 1114sub show_webmin_notifications 1115{ 1116my ($noupdates) = @_; 1117my @notifs = &get_webmin_notifications($noupdates); 1118if (@notifs) { 1119 print "<center>\n",join("<hr>\n", @notifs),"</center>\n"; 1120 } 1121} 1122 1123=head2 get_webmin_notifications([no-updates]) 1124 1125Returns a list of Webmin notification messages, each of which is a string of 1126HTML. If the no-updates flag is set, Webmin version / module updates are 1127not included. 1128 1129=cut 1130sub get_webmin_notifications 1131{ 1132my ($noupdates) = @_; 1133$noupdates = 1 if (&shared_root_directory()); 1134my @notifs; 1135my %miniserv; 1136&get_miniserv_config(\%miniserv); 1137&load_theme_library(); # So that UI functions work 1138 1139# Need OS upgrade 1140my %realos = &detect_operating_system(undef, 1); 1141if (($realos{'os_version'} ne $gconfig{'os_version'} || 1142 $realos{'real_os_version'} ne $gconfig{'real_os_version'} || 1143 $realos{'os_type'} ne $gconfig{'os_type'}) && 1144 $realos{'os_version'} && $realos{'os_type'} && 1145 &foreign_available("webmin")) { 1146 1147 # Tell the user that OS version was updated 1148 push(@notifs, 1149 &ui_form_start("$gconfig{'webprefix'}/webmin/fix_os.cgi"). 1150 &text('os_incorrect', $realos{'real_os_type'}, 1151 $realos{'real_os_version'})."<p>\n". 1152 &ui_form_end([ [ undef, $text{'os_fix'} ] ]) 1153 ); 1154 } 1155 1156# Password close to expiry 1157my $warn_days = $config{'warn_days'}; 1158if (&foreign_check("acl")) { 1159 # Get the Webmin user 1160 &foreign_require("acl", "acl-lib.pl"); 1161 my @users = &acl::list_users(); 1162 my ($uinfo) = grep { $_->{'name'} eq $base_remote_user } @users; 1163 if ($uinfo && $uinfo->{'pass'} eq 'x' && &foreign_check("useradmin")) { 1164 # Unix auth .. check password in Users and Groups 1165 &foreign_require("useradmin", "user-lib.pl"); 1166 ($uinfo) = grep { $_->{'user'} eq $remote_user } 1167 &useradmin::list_users(); 1168 if ($uinfo && $uinfo->{'warn'} && $uinfo->{'change'} && 1169 $uinfo->{'max'}) { 1170 my $daysago = int(time()/(24*60*60)) - 1171 $uinfo->{'change'}; 1172 my $cdate = &make_date( 1173 $uinfo->{'change'}*24*60*60, 1); 1174 if ($daysago > $uinfo->{'max'}) { 1175 # Passed expiry date 1176 push(@notifs, &text('notif_unixexpired', 1177 $cdate)); 1178 } 1179 elsif ($daysago > $uinfo->{'max'}-$uinfo->{'warn'}) { 1180 # Passed warning date 1181 push(@notifs, &text('notif_unixwarn', 1182 $cdate, 1183 $uinfo->{'max'}-$daysago)); 1184 } 1185 } 1186 } 1187 elsif ($uinfo && $uinfo->{'lastchange'}) { 1188 # Webmin auth .. check password in Webmin 1189 my $daysold = (time() - $uinfo->{'lastchange'})/(24*60*60); 1190 my $link = &foreign_available("change-user") ? 1191 &text('notif_changenow', 1192 "$gconfig{'webprefix'}/change-user/")."<p>\n" : ""; 1193 if ($miniserv{'pass_maxdays'} && 1194 $daysold > $miniserv{'pass_maxdays'}) { 1195 # Already expired 1196 push(@notifs, &text('notif_passexpired')."<p>\n".$link); 1197 } 1198 elsif ($miniserv{'pass_maxdays'} && 1199 $daysold > $miniserv{'pass_maxdays'} - $warn_days) { 1200 # About to expire 1201 push(@notifs, &text('notif_passchange', 1202 &make_date($uinfo->{'lastchange'}, 1), 1203 int($miniserv{'pass_maxdays'} - $daysold)). 1204 "<p>\n".$link); 1205 } 1206 elsif ($miniserv{'pass_lockdays'} && 1207 $daysold > $miniserv{'pass_lockdays'} - $warn_days) { 1208 # About to lock out 1209 push(@notifs, &text('notif_passlock', 1210 &make_date($uinfo->{'lastchange'}, 1), 1211 int($miniserv{'pass_maxdays'} - $daysold)). 1212 "<p>\n".$link); 1213 } 1214 } 1215 } 1216 1217# New Webmin version is available, but only once per day 1218my $now = time(); 1219my %raccess = &get_module_acl('root'); 1220my %rdisallow = map { $_, 1 } split(/\s+/, $raccess{'disallow'}); 1221my %access = &get_module_acl(); 1222my %disallow = map { $_, 1 } split(/\s+/, $access{'disallow'}); 1223my %allow = map { $_, 1 } split(/\s+/, $access{'allow'}); 1224my %role = map { $_, 1 } split(/\s+/, $access{'role'}); 1225if (&foreign_available($module_name) && !$gconfig{'nowebminup'} && !$noupdates && 1226 ( 1227 $allow{'upgrade'} || $role{'upgrader'} || 1228 (!$disallow{'upgrade'} && !$rdisallow{'upgrade'}) 1229 ) 1230) { 1231 if (!$config{'last_version_check'} || 1232 $now - $config{'last_version_check'} > 24*60*60) { 1233 # Cached last version has expired .. re-fetch 1234 my ($ok, $version, $release) = &get_latest_webmin_version(); 1235 if ($ok) { 1236 $config{'last_version_check'} = $now; 1237 $config{'last_version_number'} = $version; 1238 $config{'last_version_release'} = $release; 1239 $config{'last_version_full'} = 1240 $version.($release ? "-".$release : ""); 1241 &save_module_config(); 1242 } 1243 } 1244 my $ver = &get_webmin_version(); 1245 my $rel = &get_webmin_version_release(); 1246 my $full = $ver.($rel ? "-".$rel : ""); 1247 if ($config{'last_version_number'} && 1248 ($config{'last_version_number'} > $ver || 1249 $config{'last_version_number'} == $ver && 1250 $config{'last_version_release'} > $rel)) { 1251 # New version is out there .. offer to upgrade 1252 my $mode = &get_install_type(); 1253 my $checksig = 0; 1254 if ((!$mode || $mode eq "rpm") && &foreign_check("proc")) { 1255 my ($ec, $emsg) = &gnupg_setup(); 1256 if (!$ec) { 1257 $checksig = 1; 1258 } 1259 } 1260 push(@notifs, 1261 &ui_form_start("$gconfig{'webprefix'}/webmin/upgrade.cgi", 1262 "form-data"). 1263 &ui_hidden("source", 2). 1264 &ui_hidden("sig", $checksig). 1265 &ui_hidden("mode", $mode). 1266 &text('notif_upgrade', $config{'last_version_full'}, 1267 $full)."<p>\n". 1268 &ui_form_end([ [ undef, $text{'notif_upgradeok'} ] ])); 1269 } 1270 } 1271 1272# Reboot needed 1273if (&foreign_check("package-updates") && &foreign_available("init")) { 1274 &foreign_require("package-updates"); 1275 my $allow_reboot_required = 1; 1276 if (-r $postpone_reboot_required) { 1277 my $uptime = &get_system_uptime(); 1278 my $lastreboot = $uptime ? time()-$uptime : undef; 1279 if ($lastreboot) { 1280 my @prr = stat($postpone_reboot_required); 1281 if ($lastreboot < $prr[9]) { 1282 $allow_reboot_required = 0; 1283 } 1284 } 1285 } 1286 if (&package_updates::check_reboot_required() && $allow_reboot_required) { 1287 push(@notifs, 1288 &ui_form_start("$gconfig{'webprefix'}/init/reboot.cgi"). 1289 $text{'notif_reboot'}."<p>\n". 1290 &ui_form_end([ [ undef, $text{'notif_rebootok'} ], 1291 [ 'removenotify', $text{'alert_hide'} ] ])); 1292 } 1293 } 1294 1295return @notifs; 1296} 1297 1298=head2 get_system_uptime 1299 1300Returns the number of seconds the system has been up, or undef if un-available. 1301 1302=cut 1303sub get_system_uptime 1304{ 1305# Try Linux /proc/uptime first 1306if (open(UPTIME, "</proc/uptime")) { 1307 my $line = <UPTIME>; 1308 close(UPTIME); 1309 my ($uptime, $dummy) = split(/\s+/, $line); 1310 if ($uptime > 0) { 1311 return int($uptime); 1312 } 1313 } 1314 1315# Try to parse uptime command output 1316if ($gconfig{'os_type'} ne 'windows') { 1317 my $out = &backquote_command("uptime"); 1318 if ($out =~ /up\s+(\d+)\s+day/) { 1319 return $1*24*60*60; 1320 } 1321 elsif ($out =~ /up\s+(\d+)\s+min/) { 1322 return $1*60; 1323 } 1324 elsif ($out =~ /up\s+(\d+)\s+hour/) { 1325 return $1*60*60; 1326 } 1327 elsif ($out =~ /up\s+(\d+):(\d+)/) { 1328 return $1*60*60 + $2*60; 1329 } 1330 } 1331 1332return undef; 1333} 1334 1335=head2 list_operating_systems([os-list-file]) 1336 1337Returns a list of known OSs, each of which is a hash ref with keys : 1338 1339=item realtype - A human-readable OS name, like Ubuntu Linux. 1340 1341=item realversion - A human-readable version, like 8.04. 1342 1343=item type - Webmin's internal OS code, like debian-linux. 1344 1345=item version - Webmin's internal version number, like 3.1. 1346 1347=item code - A fragment of Perl that will return true if evaluated on this OS. 1348 1349=cut 1350sub list_operating_systems 1351{ 1352my $file = $_[0] || "$root_directory/os_list.txt"; 1353my @rv; 1354open(OSLIST, "<".$file); 1355while(<OSLIST>) { 1356 if (/^([^\t]+)\t+([^\t]+)\t+([^\t]+)\t+([^\t]+)\t+(.*)/) { 1357 push(@rv, { 'realtype' => $1, 1358 'realversion' => $2, 1359 'type' => $3, 1360 'version' => $4, 1361 'code' => $5 }); 1362 } 1363 } 1364close(OSLIST); 1365return @rv; 1366} 1367 1368=head2 shared_root_directory 1369 1370Returns 1 if the Webmin root directory is shared with another system, such as 1371via NFS, or in a Solaris zone. If so, updates and module installs are not 1372allowed. 1373 1374=cut 1375sub shared_root_directory 1376{ 1377if (exists($gconfig{'shared_root'}) && $gconfig{'shared_root'} eq '1') { 1378 # Always shared 1379 return 1; 1380 } 1381elsif (exists($gconfig{'shared_root'}) && $gconfig{'shared_root'} eq '0') { 1382 # Definitely not shared 1383 return 0; 1384 } 1385if (&running_in_zone()) { 1386 # In a Solaris zone .. is the root directory loopback mounted? 1387 if (&foreign_exists("mount")) { 1388 &foreign_require("mount", "mount-lib.pl"); 1389 my @rst = stat($root_directory); 1390 my $m; 1391 foreach $m (&mount::list_mounted()) { 1392 my @mst = stat($m->[0]); 1393 if ($mst[0] == $rst[0] && 1394 &is_under_directory($m->[0], $root_directory)) { 1395 # Found the mount! 1396 if ($m->[2] eq "lofs" || $m->[2] eq "nfs") { 1397 return 1; 1398 } 1399 } 1400 } 1401 } 1402 } 1403return 0; 1404} 1405 1406=head2 submit_os_info(id) 1407 1408Send via email a message about this system's OS and Perl version. Returns 1409undef if OK, or an error message. 1410 1411=cut 1412sub submit_os_info 1413{ 1414if (!&foreign_installed("mailboxes", 1)) { 1415 return $text{'submit_emailboxes'}; 1416 } 1417&foreign_require("mailboxes", "mailboxes-lib.pl"); 1418my $mail = { 'headers' => [ [ 'From', &mailboxes::get_from_address() ], 1419 [ 'To', $os_info_address ], 1420 [ 'Subject', 'Webmin OS Information' ] ], 1421 'attach' => [ { 1422 'headers' => [ [ 'Content-type', 'text/plain' ] ], 1423 'data' => "OS: $gconfig{'real_os_type'}\n". 1424 "Version: $gconfig{'real_os_version'}\n". 1425 "OS code: $gconfig{'os_type'}\n". 1426 "Version code: $gconfig{'os_version'}\n". 1427 "Perl: $]\n". 1428 "Webmin: ".&get_webmin_version()."\n". 1429 "ID: ".&get_webmin_id()."\n" } ], 1430 }; 1431eval { &mailboxes::send_mail($mail); }; 1432return $@ ? $@ : undef; 1433} 1434 1435=head2 get_webmin_id 1436 1437Returns a (hopefully) unique ID for this Webmin install. 1438 1439=cut 1440sub get_webmin_id 1441{ 1442if (!$config{'webminid'}) { 1443 my $salt = substr(time(), -2); 1444 $config{'webminid'} = &unix_crypt(&get_system_hostname(), $salt); 1445 &save_module_config(); 1446 } 1447return $config{'webminid'}; 1448} 1449 1450=head2 ip_match(ip, [match]+) 1451 1452Checks an IP address against a list of IPs, networks and networks/masks, and 1453returns 1 if a match is found. 1454 1455=cut 1456sub ip_match 1457{ 1458my @io = &check_ip6address($_[0]) ? split(/:/, $_[0]) 1459 : split(/\./, $_[0]); 1460 1461# Resolve to hostname and check that it forward resolves again 1462my $hn = &to_hostname($_[0]); 1463if (&check_ip6address($_[0])) { 1464 $hn = "" if (&to_ip6address($hn) ne $_[0]); 1465 } 1466else { 1467 $hn = "" if (&to_ipaddress($hn) ne $_[0]); 1468 } 1469 1470for(my $i=1; $i<@_; $i++) { 1471 my $mismatch = 0; 1472 my $ip = $_[$i]; 1473 if ($ip =~ /^([0-9\.]+)\/(\d+)$/) { 1474 # Convert CIDR to netmask format 1475 $ip = $1."/".&prefix_to_mask($2); 1476 } 1477 if ($ip =~ /^([0-9\.]+)\/([0-9\.]+)$/) { 1478 # Compare with IPv4 network/mask 1479 my @mo = split(/\./, $1); 1480 my @ms = split(/\./, $2); 1481 for(my $j=0; $j<4; $j++) { 1482 if ((int($io[$j]) & int($ms[$j])) != (int($mo[$j]) & int($ms[$j]))) { 1483 $mismatch = 1; 1484 } 1485 } 1486 } 1487 elsif ($_[$i] =~ /^([0-9\.]+)-([0-9\.]+)$/) { 1488 # Compare with an IPv4 range (separated by a hyphen -) 1489 my ($remote, $min, $max); 1490 my @low = split(/\./, $1); 1491 my @high = split(/\./, $2); 1492 for(my $j=0; $j<4; $j++) { 1493 $remote += $io[$j] << ((3-$j)*8); 1494 $min += $low[$j] << ((3-$j)*8); 1495 $max += $high[$j] << ((3-$j)*8); 1496 } 1497 if ($remote < $min || $remote > $max) { 1498 $mismatch = 1; 1499 } 1500 } 1501 elsif ($ip =~ /^\*(\.\S+)$/) { 1502 # Compare with hostname regexp 1503 $mismatch = 1 if ($hn !~ /^.*\Q$1\E$/i); 1504 } 1505 elsif ($ip eq 'LOCAL') { 1506 # Just assume OK for now 1507 } 1508 elsif ($_[$i] =~ /^[0-9\.]+$/) { 1509 # Compare with IPv4 address or network 1510 my @mo = split(/\./, $_[$i]); 1511 while(@mo && !$mo[$#mo]) { pop(@mo); } 1512 for(my $j=0; $j<@mo; $j++) { 1513 if ($mo[$j] != $io[$j]) { 1514 $mismatch = 1; 1515 } 1516 } 1517 } 1518 elsif ($_[$i] =~ /^[a-f0-9:]+$/) { 1519 # Compare with a full IPv6 address 1520 if (&canonicalize_ip6($_[$i]) ne canonicalize_ip6($_[0])) { 1521 $mismatch = 1; 1522 } 1523 } 1524 elsif ($_[$i] =~ /^([a-f0-9:]+)\/(\d+)$/) { 1525 # Compare with an IPv6 network 1526 my $v6size = $2; 1527 my $v6addr = &canonicalize_ip6($1); 1528 my $bytes = $v6size / 8; 1529 my @mo = &expand_ipv6_bytes($v6addr); 1530 my @io = &expand_ipv6_bytes(&canonicalize_ip6($_[0])); 1531 for(my $j=0; $j<$bytes; $j++) { 1532 if ($mo[$j] ne $io[$j]) { 1533 $mismatch = 1; 1534 } 1535 } 1536 } 1537 elsif ($_[$i] !~ /^[0-9\.]+$/) { 1538 # Compare with hostname 1539 $mismatch = 1 if ($_[0] ne &to_ipaddress($_[$i])); 1540 } 1541 return 1 if (!$mismatch); 1542 } 1543return 0; 1544} 1545 1546=head2 expand_ipv6_bytes(address) 1547 1548Given a canonical IPv6 address, split it into an array of bytes 1549 1550=cut 1551sub expand_ipv6_bytes 1552{ 1553my ($addr) = @_; 1554my @rv; 1555foreach my $w (split(/:/, $addr)) { 1556 $w =~ /^(..)(..)$/ || return ( ); 1557 push(@rv, hex($1), hex($2)); 1558 } 1559return @rv; 1560} 1561 1562 1563 1564=head2 prefix_to_mask(prefix) 1565 1566Converts a number like 24 to a mask like 255.255.255.0. 1567 1568=cut 1569sub prefix_to_mask 1570{ 1571return $_[0] >= 24 ? "255.255.255.".(256-(2 ** (32-$_[0]))) : 1572 $_[0] >= 16 ? "255.255.".(256-(2 ** (24-$_[0]))).".0" : 1573 $_[0] >= 8 ? "255.".(256-(2 ** (16-$_[0]))).".0.0" : 1574 (256-(2 ** (8-$_[0]))).".0.0.0"; 1575} 1576 1577=head2 valid_allow(text) 1578 1579Returns undef if some text is a valid IP, hostname or network for use in 1580allowed IPs, or an error message if not 1581 1582=cut 1583sub valid_allow 1584{ 1585my ($h) = @_; 1586if ($h =~ /^([0-9\.]+)\/(\d+)$/) { 1587 # IPv4 address/cidr 1588 &check_ipaddress($1) || 1589 return &text('access_enet', "$1"); 1590 $2 >= 0 && $2 <= 32 || 1591 return &text('access_ecidr', "$2"); 1592 } 1593elsif ($h =~ /^([0-9\.]+)\/([0-9\.]+)$/) { 1594 # IPv4 address/netmask 1595 &check_ipaddress($1) || 1596 return &text('access_enet', "$1"); 1597 &check_ipaddress($2) || 1598 return &text('access_emask', "$2"); 1599 } 1600elsif ($h =~ /^([0-9\.]+)\-([0-9\.]+)$/) { 1601 # IPv4 address 1602 &check_ipaddress("$1") || 1603 return &text('access_eip', "$1"); 1604 &check_ipaddress("$2") || 1605 return &text('access_eip', "$2"); 1606 } 1607elsif ($h =~ /^[0-9\.]+$/) { 1608 # IPv4 address 1609 &check_ipaddress($h) || 1610 return &text('access_eip', $h); 1611 } 1612elsif ($h =~ /^([a-f0-9:]+)\/(\d+)$/) { 1613 # IPv6 address/prefix 1614 &check_ip6address($1) || 1615 return &text('access_eip6', $1); 1616 $2 >= 0 && $2 <= 128 || 1617 return &text('access_ecidr6', "$2"); 1618 $2 % 8 == 0 || 1619 return &text('access_ecidr8', "$2"); 1620 } 1621elsif ($h =~ /^[a-f0-9:]+$/) { 1622 # IPv6 address 1623 &check_ip6address($h) || 1624 return &text('access_eip6', $h); 1625 } 1626elsif ($h =~ /^\*\.(\S+)$/) { 1627 # *.domain is OK 1628 } 1629elsif ($h eq 'LOCAL') { 1630 # Local means any on local nets 1631 } 1632elsif (&to_ipaddress($h) || &to_ip6address($h)) { 1633 # Resolvable hostname 1634 } 1635else { 1636 return &text('access_ehost', $h); 1637 } 1638return undef; 1639} 1640 1641=head2 get_preloads(&miniserv) 1642 1643Returns a list of module names and files to pre-load, based on a Webmin 1644miniserv configuration hash. Each is a two-element array ref containing 1645a package name and the relative path of the .pl file to pre-load. 1646 1647=cut 1648sub get_preloads 1649{ 1650my @rv = map { [ split(/=/, $_) ] } split(/\s+/, $_[0]->{'preload'} || ""); 1651return @rv; 1652} 1653 1654=head2 save_preloads(&miniserv, &preloads) 1655 1656Updates a Webmin miniserv configuration hash from a list of preloads, in 1657the format returned by get_preloads. 1658 1659=cut 1660sub save_preloads 1661{ 1662$_[0]->{'preload'} = join(" ", map { "$_->[0]=$_->[1]" } @{$_[1]}); 1663} 1664 1665=head2 get_tempdirs(&gconfig) 1666 1667Returns a list of per-module temp directories, each of which is an array 1668ref containing a module name and directory. 1669 1670=cut 1671sub get_tempdirs 1672{ 1673my ($gconfig) = @_; 1674my @rv; 1675foreach my $k (keys %$gconfig) { 1676 if ($k =~ /^tempdir_(.*)$/) { 1677 push(@rv, [ $1, $gconfig->{$k} ]); 1678 } 1679 } 1680return sort { $a->[0] cmp $b->[0] } @rv; 1681} 1682 1683=head2 save_tempdirs(&gconfig, &tempdirs) 1684 1685Updates the global config with a list of per-module temp dirs 1686 1687=cut 1688sub save_tempdirs 1689{ 1690my ($gconfig, $dirs) = @_; 1691foreach my $k (keys %$gconfig) { 1692 if ($k =~ /^tempdir_(.*)$/) { 1693 delete($gconfig->{$k}); 1694 } 1695 } 1696foreach my $d (@$dirs) { 1697 $gconfig->{'tempdir_'.$d->[0]} = $d->[1]; 1698 } 1699} 1700 1701=head2 get_module_install_type(dir) 1702 1703Returns the installation method used for some module (such as 'rpm'), or undef 1704if it was installed from a .wbm. 1705 1706=cut 1707sub get_module_install_type 1708{ 1709my ($mod) = @_; 1710my $it = &module_root_directory($mod)."/install-type"; 1711open(TYPE, "<".$it) || return undef; 1712my $type = <TYPE>; 1713chop($type); 1714close(TYPE); 1715return $type; 1716} 1717 1718=head2 get_install_type 1719 1720Returns the package type Webmin was installed form (rpm, deb, solaris-pkg 1721or undef for tar.gz). 1722 1723=cut 1724sub get_install_type 1725{ 1726my $mode; 1727if (open(MODE, "<$root_directory/install-type")) { 1728 chop($mode = <MODE>); 1729 close(MODE); 1730 } 1731else { 1732 if ($root_directory eq "/usr/libexec/webmin") { 1733 $mode = "rpm"; 1734 } 1735 elsif ($root_directory eq "/usr/share/webmin") { 1736 $mode = "deb"; 1737 } 1738 elsif ($root_directory eq "/opt/webmin") { 1739 $mode = "solaris-pkg"; 1740 } 1741 elsif (&has_command("eix") && 1742 &backquote_command("eix webmin 2>/dev/null") =~ /Installed/i) { 1743 $mode = "portage"; 1744 } 1745 else { 1746 $mode = undef; 1747 } 1748 } 1749return $mode; 1750} 1751 1752=head2 list_cached_files 1753 1754Returns a list of cached filenames for downloads made by Webmin, as array refs 1755containing a full path and url. 1756 1757=cut 1758sub list_cached_files 1759{ 1760my @rv; 1761opendir(DIR, $main::http_cache_directory); 1762foreach my $cfile (readdir(DIR)) { 1763 next if ($cfile eq "." || $cfile eq ".."); 1764 my $curl = $cfile; 1765 $curl =~ s/_/\//g; 1766 push(@rv, [ $cfile, "$main::http_cache_directory/$cfile", $curl ]); 1767 } 1768closedir(DIR); 1769return @rv; 1770} 1771 1772=head2 show_restart_page([title, msg]) 1773 1774Output a page with header and footer about Webmin needing to restart. 1775 1776=cut 1777sub show_restart_page 1778{ 1779my ($title, $msg) = @_; 1780$title ||= $text{'restart_title'}; 1781$msg ||= $text{'restart_done'}; 1782&ui_print_header(undef, $title, ""); 1783 1784print "$msg<p>\n"; 1785 1786&ui_print_footer("", $text{'index_return'}); 1787&restart_miniserv(1); 1788} 1789 1790=head2 cert_info(file) 1791 1792Returns a hash of details of a cert in some file. 1793 1794=cut 1795sub cert_info 1796{ 1797my %rv; 1798local $_; 1799open(OUT, "openssl x509 -in ".quotemeta($_[0])." -issuer -subject -enddate -text |"); 1800while(<OUT>) { 1801 s/\r|\n//g; 1802 if (/subject=.*CN\s*=\s*([^\/,]+)/) { 1803 $rv{'cn'} = $1; 1804 } 1805 if (/subject=.*O\s*=\s*([^\/,]+)/) { 1806 $rv{'o'} = $1; 1807 } 1808 if (/subject=.*Email\s*=\s*([^\/,]+)/) { 1809 $rv{'email'} = $1; 1810 } 1811 if (/issuer=.*CN\s*=\s*([^\/,]+)/) { 1812 $rv{'issuer_cn'} = $1; 1813 } 1814 if (/issuer=.*O\s*=\s*([^\/,]+)/) { 1815 $rv{'issuer_o'} = $1; 1816 } 1817 if (/issuer=.*Email\s*=\s*([^\/,]+)/) { 1818 $rv{'issuer_email'} = $1; 1819 } 1820 if (/notAfter\s*=\s*(.*)/) { 1821 $rv{'notafter'} = $1; 1822 } 1823 if (/Subject\s+Alternative\s+Name/i) { 1824 my $alts = <OUT>; 1825 $alts =~ s/^\s+//; 1826 foreach my $a (split(/[, ]+/, $alts)) { 1827 if ($a =~ /^DNS:(\S+)/) { 1828 push(@{$rv{'alt'}}, $1); 1829 } 1830 } 1831 } 1832 } 1833close(OUT); 1834if ($rv{'o'} && $rv{'issuer_o'}) { 1835 $rv{'type'} = $rv{'o'} eq $rv{'issuer_o'} ? $text{'ssl_typeself'} 1836 : $text{'ssl_typereal'}; 1837 } 1838return \%rv; 1839} 1840 1841=head2 cert_pem_data(file) 1842 1843Returns a cert in PEM format, from a file containing the PEM and possibly 1844other keys. 1845 1846=cut 1847sub cert_pem_data 1848{ 1849my ($d) = @_; 1850my $data = &read_file_contents($_[0]); 1851if ($data =~ /(-----BEGIN\s+CERTIFICATE-----\n([A-Za-z0-9\+\/=\n\r]+)-----END\s+CERTIFICATE-----)/) { 1852 return $1; 1853 } 1854return undef; 1855} 1856 1857=head2 cert_pkcs12_data(keyfile, [certfile]) 1858 1859Returns a cert in PKCS12 format. 1860 1861=cut 1862sub cert_pkcs12_data 1863{ 1864my ($keyfile, $certfile) = @_; 1865if ($certfile) { 1866 open(OUT, "openssl pkcs12 -in ".quotemeta($certfile). 1867 " -inkey ".quotemeta($keyfile). 1868 " -export -passout pass: -nokeys |"); 1869 } 1870else { 1871 open(OUT, "openssl pkcs12 -in ".quotemeta($keyfile). 1872 " -export -passout pass: -nokeys |"); 1873 } 1874my $data; 1875while(<OUT>) { 1876 $data .= $_; 1877 } 1878close(OUT); 1879return $data; 1880} 1881 1882=head2 cert_file_split(file) 1883 1884Returns a list of certs in some file 1885 1886=cut 1887sub cert_file_split 1888{ 1889my ($file) = @_; 1890my @rv; 1891my $lref = &read_file_lines($file, 1); 1892foreach my $l (@$lref) { 1893 my $cl = $l; 1894 $cl =~ s/^#.*//; 1895 if ($cl =~ /^-----BEGIN/) { 1896 push(@rv, $cl."\n"); 1897 } 1898 elsif ($cl =~ /\S/ && @rv) { 1899 $rv[$#rv] .= $cl."\n"; 1900 } 1901 } 1902return @rv; 1903} 1904 1905=head2 get_blocked_users_hosts(&miniserv) 1906 1907Returns a list of blocked users and hosts from the file written by Webmin 1908at run-time. 1909 1910=cut 1911sub get_blocked_users_hosts 1912{ 1913my ($miniserv) = @_; 1914my $bf = $miniserv->{'blockedfile'}; 1915if (!$bf) { 1916 $miniserv->{'pidfile'} =~ /^(.*)\/[^\/]+$/; 1917 $bf = "$1/blocked"; 1918 } 1919my @rv; 1920my $fh = "BLOCKED"; 1921&open_readfile($fh, $bf) || return (); 1922while(<$fh>) { 1923 s/\r|\n//g; 1924 my ($type, $who, $fails, $when) = split(/\s+/, $_); 1925 push(@rv, { 'type' => $type, 1926 $type => $who, 1927 'fails' => $fails, 1928 'when' => $when }); 1929 } 1930close($fh); 1931return @rv; 1932} 1933 1934=head2 show_ssl_key_form([defhost], [defemail], [deforg]) 1935 1936Returns HTML for inputs to generate a new self-signed cert. 1937 1938=cut 1939sub show_ssl_key_form 1940{ 1941my ($defhost, $defemail, $deforg) = @_; 1942my $rv; 1943 1944$rv .= &ui_table_row($text{'ssl_cn'}, 1945 &ui_opt_textbox("commonName", $defhost, 50, 1946 $text{'ssl_all'})); 1947 1948$rv .= &ui_table_row($text{'ca_email'}, 1949 &ui_textbox("emailAddress", $defemail, 30)); 1950 1951$rv .= &ui_table_row($text{'ca_ou'}, 1952 &ui_textbox("organizationalUnitName", undef, 30)); 1953 1954$rv .= &ui_table_row($text{'ca_o'}, 1955 &ui_textbox("organizationName", $deforg, 30)); 1956 1957$rv .= &ui_table_row($text{'ca_city'}, 1958 &ui_textbox("cityName", undef, 30)); 1959 1960$rv .= &ui_table_row($text{'ca_sp'}, 1961 &ui_textbox("stateOrProvinceName", undef, 15)); 1962 1963$rv .= &ui_table_row($text{'ca_c'}, 1964 &ui_textbox("countryName", undef, 2)); 1965 1966$rv .= &ui_table_row($text{'ssl_size'}, 1967 &ui_opt_textbox("size", undef, 6, 1968 "$text{'default'} ($default_key_size)"). 1969 " ".$text{'ssl_bits'}); 1970 1971$rv .= &ui_table_row($text{'ssl_days'}, 1972 &ui_textbox("days", 1825, 8)); 1973 1974return $rv; 1975} 1976 1977=head2 parse_ssl_key_form(&in, keyfile, [certfile]) 1978 1979Parses the key generation form, and creates new key and cert files. 1980Returns undef on success or an error message on failure. 1981 1982=cut 1983sub parse_ssl_key_form 1984{ 1985my ($in, $keyfile, $certfile) = @_; 1986my %in = %$in; 1987 1988# Validate inputs 1989my @cns; 1990if (!$in{'commonName_def'}) { 1991 @cns = split(/\s+/, $in{'commonName'}); 1992 @cns || return $text{'newkey_ecns'}; 1993 foreach my $cn (@cns) { 1994 $cn =~ /^[A-Za-z0-9\.\-\*]+$/ || return $text{'newkey_ecn'}; 1995 } 1996 } 1997$in{'size_def'} || $in{'size'} =~ /^\d+$/ || return $text{'newkey_esize'}; 1998$in{'days'} =~ /^\d+$/ || return $text{'newkey_edays'}; 1999$in{'countryName'} =~ /^\S\S$/ || return $text{'newkey_ecountry'}; 2000 2001# Work out SSL command 2002my %aclconfig = &foreign_config('acl'); 2003&foreign_require("acl", "acl-lib.pl"); 2004my $cmd = &acl::get_ssleay(); 2005if (!$cmd) { 2006 return &text('newkey_ecmd', "<tt>$aclconfig{'ssleay'}</tt>", 2007 "$gconfig{'webprefix'}/config.cgi?acl"); 2008 } 2009 2010# Run openssl and feed it key data 2011my $ctemp = &transname(); 2012my $ktemp = &transname(); 2013my $size = $in{'size_def'} ? $default_key_size : quotemeta($in{'size'}); 2014my $subject = &build_ssl_subject($in{'countryName'}, 2015 $in{'stateOrProvinceName'}, 2016 $in{'cityName'}, 2017 $in{'organizationName'}, 2018 $in{'organizationalUnitName'}, 2019 \@cns, 2020 $in{'emailAddress'}); 2021my $conf = &build_ssl_config(\@cns); 2022my $out = &backquote_logged( 2023 "$cmd req -newkey rsa:$size -x509 -sha256 -nodes -out $ctemp -keyout $ktemp ". 2024 "-days ".quotemeta($in{'days'})." -subj ".quotemeta($subject)." ". 2025 "-config $conf -reqexts v3_req -utf8 2>&1"); 2026if (!-r $ctemp || !-r $ktemp || $?) { 2027 return $text{'newkey_essl'}."<br>"."<pre>".&html_escape($out)."</pre>"; 2028 } 2029 2030# Write to the final files 2031my $certout = &read_file_contents($ctemp); 2032my $keyout = &read_file_contents($ktemp); 2033unlink($ctemp, $ktemp); 2034 2035my ($kfh, $cfh) = ("KEY", "CERT"); 2036&open_lock_tempfile($kfh, ">$keyfile"); 2037&print_tempfile($kfh, $keyout); 2038if ($certfile) { 2039 # Separate files 2040 &open_lock_tempfile($cfh, ">$certfile"); 2041 &print_tempfile($cfh, $certout); 2042 &close_tempfile($cfh); 2043 &set_ownership_permissions(undef, undef, 0600, $certfile); 2044 } 2045else { 2046 # Both go in the same file 2047 &print_tempfile($kfh, $certout); 2048 } 2049&close_tempfile($kfh); 2050&set_ownership_permissions(undef, undef, 0600, $keyfile); 2051 2052return undef; 2053} 2054 2055=head2 parse_ssl_csr_form(&in, keyfile, csrfile) 2056 2057Parses the CSR generation form, and creates new key and CSR files. 2058Returns undef on success or an error message on failure. 2059 2060=cut 2061sub parse_ssl_csr_form 2062{ 2063my ($in, $keyfile, $csrfile) = @_; 2064my %in = %$in; 2065 2066# Validate inputs 2067my @cns; 2068if (!$in{'commonName_def'}) { 2069 @cns = split(/\s+/, $in{'commonName'}); 2070 @cns || return $text{'newkey_ecns'}; 2071 foreach my $cn (@cns) { 2072 $cn =~ /^[A-Za-z0-9\.\-\*]+$/ || return $text{'newkey_ecn'}; 2073 } 2074 } 2075else { 2076 @cns = ( "*" ); 2077 } 2078$in{'size_def'} || $in{'size'} =~ /^\d+$/ || return $text{'newkey_esize'}; 2079$in{'days'} =~ /^\d+$/ || return $text{'newkey_edays'}; 2080$in{'countryName'} =~ /^\S\S$/ || return $text{'newkey_ecountry'}; 2081 2082# Work out SSL command 2083my %aclconfig = &foreign_config('acl'); 2084&foreign_require("acl"); 2085my $cmd = &acl::get_ssleay(); 2086if (!$cmd) { 2087 return &text('newkey_ecmd', "<tt>$aclconfig{'ssleay'}</tt>", 2088 "$gconfig{'webprefix'}/config.cgi?acl"); 2089 } 2090 2091# Generate the key 2092my $ktemp = &transname(); 2093my $size = $in{'size_def'} ? $default_key_size : quotemeta($in{'size'}); 2094my $out = &backquote_command("$cmd genrsa -out ".quotemeta($ktemp)." $size 2>&1 </dev/null"); 2095if (!-r $ktemp || $?) { 2096 return $text{'newkey_essl'}."<br>"."<pre>".&html_escape($out)."</pre>"; 2097 } 2098 2099# Run openssl and feed it key data 2100my ($ok, $ctemp) = &generate_ssl_csr( 2101 $ktemp, 2102 $in{'countryName'}, 2103 $in{'stateOrProvinceName'}, 2104 $in{'cityName'}, 2105 $in{'organizationName'}, 2106 $in{'organizationalUnitName'}, 2107 \@cns, 2108 $in{'emailAddress'}); 2109if (!$ok) { 2110 return $text{'newkey_essl'}."<br>". 2111 "<pre>".&html_escape($ctemp)."</pre>"; 2112 } 2113 2114# Write to the final files 2115my $csrout = &read_file_contents($ctemp); 2116my $keyout = &read_file_contents($ktemp); 2117unlink($ctemp, $ktemp); 2118 2119my ($kfh, $cfh); 2120&open_lock_tempfile($kfh, ">$keyfile"); 2121&print_tempfile($kfh, $keyout); 2122&close_tempfile($kfh); 2123&set_ownership_permissions(undef, undef, 0600, $keyfile); 2124&open_lock_tempfile($cfh, ">$csrfile"); 2125&print_tempfile($cfh, $csrout); 2126&close_tempfile($cfh); 2127&set_ownership_permissions(undef, undef, 0600, $csrfile); 2128 2129return undef; 2130} 2131 2132# build_ssl_subject(country, state, city, org, orgunit, cname|&cnames, email) 2133# Generate a full subject line suitable for use with the -subj parameter 2134sub build_ssl_subject 2135{ 2136my ($country, $state, $city, $org, $orgunit, $cn, $email) = @_; 2137$org =~ s/[\177-\377]//g if ($org); # Remove non-ascii chars 2138$orgunit =~ s/[\177-\377]//g if ($orgunit); 2139my @cns = ref($cn) ? @$cn : ( $cn ); 2140my $subject; 2141$city = substr($city, 0, 64) if ($city && length($city) > 64); 2142$org = substr($org, 0, 64) if ($org && length($org) > 64); 2143$orgunit = substr($orgunit, 0, 64) if ($orgunit && length($orgunit) > 64); 2144$email = substr($email, 0, 64) if ($email && length($email) > 64); 2145$subject .= "/C=$country" if ($country); 2146$subject .= "/ST=$state" if ($state); 2147$subject .= "/L=$city" if ($city); 2148$subject .= "/O=$org" if ($org); 2149$subject .= "/OU=$orgunit" if ($orgunit); 2150$subject .= "/CN=$cns[0]"; 2151$subject .= "/emailAddress=$email" if ($email); 2152return $subject; 2153} 2154 2155# build_ssl_config(cname|&cnames) 2156# Create a temporary openssl config file that is setup to include altnames, if needed 2157sub build_ssl_config 2158{ 2159my ($cn) = @_; 2160my @cns = ref($cn) ? @$cn : ( $cn ); 2161my $conf = &find_openssl_config_file(); 2162$conf || &error("No OpenSSL configuration file found on this system!"); 2163if (@cns <= 1) { 2164 # No special handling needed 2165 return $conf; 2166 } 2167my $temp = &transname(); 2168©_source_dest($conf, $temp); 2169shift(@cns); # First one is part of the CN= 2170 2171# Make sure subjectAltNames is set in .cnf file, in the right places 2172my $lref = &read_file_lines($temp); 2173my $i = 0; 2174my $found_req = 0; 2175my $found_ca = 0; 2176my $altline = "subjectAltName=".join(",", map { "DNS:$_" } @cns); 2177foreach my $l (@$lref) { 2178 if ($l =~ /^\s*\[\s*v3_req\s*\]/ && !$found_req) { 2179 splice(@$lref, $i+1, 0, $altline); 2180 $found_req = 1; 2181 } 2182 if ($l =~ /^\s*\[\s*v3_ca\s*\]/ && !$found_ca) { 2183 splice(@$lref, $i+1, 0, $altline); 2184 $found_ca = 1; 2185 } 2186 $i++; 2187 } 2188# If v3_req or v3_ca sections are missing, add at end 2189if (!$found_req) { 2190 push(@$lref, "[ v3_req ]", $altline); 2191 } 2192if (!$found_ca) { 2193 push(@$lref, "[ v3_ca ]", $altline); 2194 } 2195 2196# Add copyall line if needed 2197$i = 0; 2198my $found_copy = 0; 2199my $copyline = "copy_extensions=copyall"; 2200foreach my $l (@$lref) { 2201 if ($l =~ /^\s*\#*\s*copy_extensions\s*=/) { 2202 $l = $copyline; 2203 $found_copy = 1; 2204 last; 2205 } 2206 elsif ($l =~ /^\s*\[\s*CA_default\s*\]/) { 2207 $found_ca = $i; 2208 } 2209 $i++; 2210 } 2211if (!$found_copy) { 2212 if ($found_ca) { 2213 splice(@$lref, $found_ca+1, 0, $copyline); 2214 } 2215 else { 2216 push(@$lref, "[ CA_default ]", $copyline); 2217 } 2218 } 2219 2220&flush_file_lines($temp); 2221return $temp; 2222} 2223 2224# generate_ssl_csr(keyfile, country, state, city, org, orgunit, cname|&cnames, 2225# email, ["sha1"|"sha2"]) 2226# Generates a new CSR, and returns either 1 and the temp file path, or 0 and 2227# an error message 2228sub generate_ssl_csr 2229{ 2230my ($ktemp, $country, $state, $city, $org, $orgunit, $cn, $email, $ctype) = @_; 2231$ctype ||= "sha2"; 2232&foreign_require("acl"); 2233my $ctemp = &transname(); 2234my $cmd = &acl::get_ssleay(); 2235my $subject = &build_ssl_subject($country, $state, $city, $org, $orgunit, $cn,$email); 2236my $conf = &build_ssl_config($cn); 2237my $ctypeflag = $ctype eq "sha2" ? "-sha256" : ""; 2238my $out = &backquote_command( 2239 "$cmd req -new -key $ktemp -out $ctemp $ctypeflag ". 2240 "-subj ".quotemeta($subject)." -config $conf -reqexts v3_req ". 2241 "-utf8 2>&1"); 2242if (!-r $ctemp || $?) { 2243 return (0, $out); 2244 } 2245else { 2246 return (1, $ctemp); 2247 } 2248} 2249 2250=head2 build_installed_modules(force-all, force-mod) 2251 2252Calls each module's install_check function, and updates the cache of 2253modules whose underlying servers are installed. 2254 2255=cut 2256sub build_installed_modules 2257{ 2258my ($force, $mod) = @_; 2259my %installed; 2260my $changed; 2261&read_file_cached("$config_directory/installed.cache", \%installed); 2262my @changed; 2263foreach my $minfo (&get_all_module_infos()) { 2264 next if ($mod && $minfo->{'dir'} ne $mod); 2265 next if (defined($installed{$minfo->{'dir'}}) && !$force && !$mod); 2266 next if (!&check_os_support($minfo)); 2267 $@ = undef; 2268 my $o = $installed{$minfo->{'dir'}} || 0; 2269 my $pid = fork(); 2270 if (!$pid) { 2271 # Check in a sub-process 2272 my $rv; 2273 eval { 2274 local $main::error_must_die = 1; 2275 $rv = &foreign_installed($minfo->{'dir'}, 0) ? 1 : 0; 2276 }; 2277 if ($@) { 2278 # Install check failed .. but assume the module is OK 2279 $rv = 1; 2280 } 2281 exit($rv); 2282 } 2283 waitpid($pid, 0); 2284 $installed{$minfo->{'dir'}} = $? / 256; 2285 push(@changed, $minfo->{'dir'}) if ($installed{$minfo->{'dir'}} && 2286 $installed{$minfo->{'dir'}} ne $o); 2287 } 2288&write_file("$config_directory/installed.cache", \%installed); 2289return wantarray ? (\%installed, \@changed) : \%installed; 2290} 2291 2292=head2 get_latest_webmin_version 2293 2294Returns 1 and the latest version of Webmin available on www.webmin.com, or 22950 and an error message 2296 2297=cut 2298sub get_latest_webmin_version 2299{ 2300my $file = &transname(); 2301my ($error, $version, $release); 2302&http_download($primary_host, $primary_port, '/', $file, \$error, undef, 0, 2303 undef, undef, 5); 2304return (0, $error) if ($error); 2305open(FILE, "<".$file); 2306while(<FILE>) { 2307 if (/webmin-([0-9\.]+)-(\d+)\.tar\.gz/ || 2308 /webmin-([0-9\.]+)\.tar\.gz/) { 2309 $version = $1; 2310 $release = $2; 2311 last; 2312 } 2313 } 2314close(FILE); 2315unlink($file); 2316return $version ? (1, $version, $release) 2317 : (0, "No version number found at $primary_host"); 2318} 2319 2320=head2 filter_updates(&updates, [version], [include-third], [include-missing]) 2321 2322Given a list of updates, filters them to include only those that are 2323suitable for this system. The parameters are : 2324 2325=item updates - Array ref of updates, as returned by fetch_updates. 2326 2327=item version - Webmin version number to use in comparisons. 2328 2329=item include-third - Set to 1 to include non-core modules in the results. 2330 2331=item include-missing - Set to 1 to include modules not currently installed. 2332 2333=cut 2334sub filter_updates 2335{ 2336my ($allupdates, $version, $third, $missing) = @_; 2337$version ||= &get_webmin_version(); 2338my $bversion = &base_version($version); 2339my $updatestemp = &transname(); 2340my @updates; 2341foreach my $u (@$allupdates) { 2342 my %minfo = &get_module_info($u->[0]); 2343 my %tinfo = &get_theme_info($u->[0]); 2344 my %info = %minfo ? %minfo : %tinfo; 2345 2346 # Skip if wrong version of Webmin, unless this is non-core module and 2347 # we are handling them too 2348 my $nver = $u->[1]; 2349 $nver =~ s/^(\d+\.\d+)\..*$/$1/; 2350 next if (($nver >= $bversion + .01 || 2351 $nver <= $bversion || 2352 $nver <= $version) && 2353 (!%info || $info{'longdesc'} || !$third)); 2354 2355 # Skip if not installed, unless installing new 2356 next if (!%info && !$missing); 2357 2358 # Skip if module has a version, and we already have it 2359 next if (%info && $info{'version'} && $info{'version'} >= $nver); 2360 2361 # Skip if not supported on this OS 2362 my $osinfo = { 'os_support' => $u->[3] }; 2363 next if (!&check_os_support($osinfo)); 2364 2365 # Skip if installed from RPM or Deb and update was not 2366 my $itype = &get_module_install_type($u->[0]); 2367 next if ($itype && $u->[2] !~ /\.$itype$/i); 2368 2369 push(@updates, $u); 2370 } 2371return \@updates; 2372} 2373 2374# get_clone_source(dir) 2375# Given a module dir, returns the dir of its original 2376sub get_clone_source 2377{ 2378my ($dir) = @_; 2379my $lnk = readlink(&module_root_directory($dir)); 2380return undef if (!$lnk); 2381if ($lnk =~ /\/([^\/]+)$/) { 2382 return $1; 2383 } 2384elsif ($lnk =~ /^[^\/ ]+$/) { 2385 return $lnk; 2386 } 2387return undef; 2388} 2389 2390# retry_http_download(host, port, etc..) 2391# Calls http_download until it succeeds 2392sub retry_http_download 2393{ 2394my ($host, $port, $page, $dest, $error, $cbfunc, $ssl, $user, $pass, 2395 $timeout, $osdn, $nocache, $headers) = @_; 2396my $tries = 5; 2397my $i = 0; 2398my $tryerror; 2399while($i < $tries) { 2400 $tryerror = undef; 2401 &http_download($host, $port, $page, $dest, \$tryerror, $cbfunc, $ssl, $user, 2402 $pass, $timeout, $osdn, $nocache, $headers); 2403 if (!$tryerror) { 2404 last; 2405 } 2406 $i++; 2407 sleep($i); 2408 } 2409if ($tryerror) { 2410 # Failed every time 2411 if (ref($error)) { 2412 $$error = $tryerror; 2413 } 2414 else { 2415 &error($tryerror); 2416 } 2417 } 2418} 2419 2420# canonicalize_ip6(address) 2421# Converts an address to its full long form. Ie. 2001:db8:0:f101::20 to 2422# 2001:0db8:0000:f101:0000:0000:0000:0020 2423sub canonicalize_ip6 2424{ 2425my ($addr) = @_; 2426return $addr if (!&check_ip6address($addr)); 2427my @w = split(/:/, $addr); 2428my $idx = &indexof("", @w); 2429if ($idx >= 0) { 2430 # Expand :: 2431 my $mis = 8 - scalar(@w); 2432 my @nw = @w[0..$idx]; 2433 for(my $i=0; $i<$mis; $i++) { 2434 push(@nw, 0); 2435 } 2436 push(@nw, @w[$idx+1 .. $#w]); 2437 @w = @nw; 2438 } 2439foreach my $w (@w) { 2440 while(length($w) < 4) { 2441 $w = "0".$w; 2442 } 2443 } 2444return lc(join(":", @w)); 2445} 2446 2447# list_visible_themes([current-theme]) 2448# Lists all themes the user should be able to use, possibly including their 2449# current theme if one is set. 2450sub list_visible_themes 2451{ 2452my ($curr) = @_; 2453my @rv; 2454my %done; 2455foreach my $theme (&list_themes()) { 2456 my $iscurr = $curr && $theme->{'dir'} eq $curr; 2457 my $lnk = readlink($root_directory."/".$theme->{'dir'}); 2458 next if ($lnk && $lnk !~ /^\// && $lnk !~ /^\.\.\// && !$iscurr); 2459 next if ($done{$theme->{'desc'}}++ && !$iscurr); 2460 push(@rv, $theme); 2461 } 2462return @rv; 2463} 2464 2465# apply_new_os_version(&info) 2466# Update the Webmin and Usermin detected OS name and version 2467sub apply_new_os_version 2468{ 2469my %osinfo = %{$_[0]}; 2470 2471# Do Webmin 2472&lock_file("$config_directory/config"); 2473$gconfig{'real_os_type'} = $osinfo{'real_os_type'}; 2474$gconfig{'real_os_version'} = $osinfo{'real_os_version'}; 2475$gconfig{'os_type'} = $osinfo{'os_type'}; 2476$gconfig{'os_version'} = $osinfo{'os_version'}; 2477&write_file("$config_directory/config", \%gconfig); 2478&unlock_file("$config_directory/config"); 2479 2480# Do Usermin too, if installed and running an equivalent version 2481if (&foreign_installed("usermin")) { 2482 &foreign_require("usermin"); 2483 my %miniserv; 2484 &usermin::get_usermin_miniserv_config(\%miniserv); 2485 my @ust = stat("$miniserv{'root'}/os_list.txt"); 2486 my @wst = stat("$root_directory/os_list.txt"); 2487 if ($ust[7] == $wst[7]) { 2488 # os_list.txt is the same, so we can assume the same OS codes 2489 # are supported 2490 my %uconfig; 2491 &lock_file($usermin::usermin_config); 2492 &usermin::get_usermin_config(\%uconfig); 2493 $uconfig{'real_os_type'} = $osinfo{'real_os_type'}; 2494 $uconfig{'real_os_version'} = $osinfo{'real_os_version'}; 2495 $uconfig{'os_type'} = $osinfo{'os_type'}; 2496 $uconfig{'os_version'} = $osinfo{'os_version'}; 2497 &usermin::put_usermin_config(\%uconfig); 2498 &unlock_file($usermin::usermin_config); 2499 } 2500 } 2501} 2502 2503sub find_letsencrypt_cron_job 2504{ 2505if (&foreign_check("webmincron")) { 2506 &foreign_require("webmincron"); 2507 return &webmincron::find_webmin_cron($module_name, 2508 'renew_letsencrypt_cert'); 2509 } 2510return undef; 2511} 2512 2513# renew_letsencrypt_cert() 2514# Called by cron to renew the last requested cert 2515sub renew_letsencrypt_cert 2516{ 2517my @doms = split(/\s+/, $config{'letsencrypt_doms'}); 2518my $webroot = $config{'letsencrypt_webroot'}; 2519my $mode = $config{'letsencrypt_mode'} || "web"; 2520my $size = $config{'letsencrypt_size'}; 2521if (!@doms) { 2522 print "No domains saved to renew cert for!\n"; 2523 return; 2524 } 2525if (!$webroot) { 2526 print "No webroot saved to renew cert for!\n"; 2527 return; 2528 } 2529elsif (!-d $webroot) { 2530 print "Webroot $webroot does not exist!\n"; 2531 return; 2532 } 2533my ($ok, $cert, $key, $chain) = &request_letsencrypt_cert(\@doms, $webroot, 2534 undef, $size, $mode); 2535if (!$ok) { 2536 print "Failed to renew certificate : $cert\n"; 2537 return; 2538 } 2539 2540# Copy into place 2541my %miniserv; 2542&lock_file($ENV{'MINISERV_CONFIG'}); 2543&get_miniserv_config(\%miniserv); 2544 2545&lock_file($miniserv{'keyfile'}); 2546©_source_dest($key, $miniserv{'keyfile'}); 2547&unlock_file($miniserv{'keyfile'}); 2548 2549&lock_file($miniserv{'certfile'}); 2550©_source_dest($cert, $miniserv{'certfile'}); 2551&unlock_file($miniserv{'certfile'}); 2552 2553if ($chain) { 2554 &lock_file($miniserv{'extracas'}); 2555 ©_source_dest($chain, $miniserv{'extracas'}); 2556 &unlock_file($miniserv{'extracas'}); 2557 } 2558else { 2559 delete($miniserv{'extracas'}); 2560 } 2561&put_miniserv_config(\%miniserv); 2562&unlock_file($ENV{'MINISERV_CONFIG'}); 2563&restart_miniserv(1); 2564} 2565 2566# find_openssl_config_file() 2567# Returns the full path to the OpenSSL config file, or undef if not found 2568sub find_openssl_config_file 2569{ 2570my %vconfig = &foreign_config("virtual-server"); 2571foreach my $p ($vconfig{'openssl_cnf'}, # Virtualmin module config 2572 "/etc/ssl/openssl.cnf", # Debian and FreeBSD 2573 "/etc/openssl.cnf", 2574 "/usr/local/etc/openssl.cnf", 2575 "/etc/pki/tls/openssl.cnf", # Redhat 2576 "/opt/csw/ssl/openssl.cnf", # Solaris CSW 2577 "/opt/csw/etc/ssl/openssl.cnf", # Solaris CSW 2578 "/System/Library/OpenSSL/openssl.cnf", # OSX 2579 ) { 2580 return $p if ($p && -r $p); 2581 } 2582return undef; 2583} 2584 25851; 2586