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 ".&quote_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." ".&quote_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 ".&quote_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 ".&quote_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 ".&quote_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&copy_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&copy_source_dest($key, $miniserv{'keyfile'});
2547&unlock_file($miniserv{'keyfile'});
2548
2549&lock_file($miniserv{'certfile'});
2550&copy_source_dest($cert, $miniserv{'certfile'});
2551&unlock_file($miniserv{'certfile'});
2552
2553if ($chain) {
2554	&lock_file($miniserv{'extracas'});
2555	&copy_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