· 10 years ago · Jun 26, 2016, 05:24 AM
1
2use Time::Local;
3use POSIX;
4
5# Work out where our extra -lib.pl files are, and load them
6$virtual_server_root = $module_root_directory;
7if (!$virtual_server_root) {
8 foreach my $i (keys %INC) {
9 if ($i =~ /^(.*)\/virtual-server-lib-funcs.pl$/) {
10 $virtual_server_root = $1;
11 }
12 }
13 }
14if (!$virtual_server_root) {
15 $0 =~ /^(.*)\//;
16 $virtual_server_root = "$1/virtual-server";
17 }
18foreach my $lib ("scripts", "resellers", "admins", "simple", "s3", "styles",
19 "php", "ruby", "vui", "dynip", "collect", "maillog",
20 "balancer", "newfeatures", "resources", "backups",
21 "domainname", "commands", "connectivity", "plans",
22 "postgrey", "wizard", "security", "json", "redirects", "ftp",
23 "dkim", "provision", "stats", "bkeys", "rs", "cron",
24 "ratelimit", "cloud", "google", "gcs", "dropbox") {
25 do "$virtual_server_root/$lib-lib.pl";
26 if ($@ && -r "$virtual_server_root/$lib-lib.pl") {
27 print STDERR "failed to load $lib-lib.pl : $@\n";
28 }
29 }
30
31# require_useradmin([no-quotas])
32sub require_useradmin
33{
34if (!$require_useradmin++) {
35 &foreign_require("useradmin");
36 %uconfig = &foreign_config("useradmin");
37 $home_base = &resolve_links($config{'home_base'} || $uconfig{'home_base'});
38 $cannot_rehash_password = 0;
39 if ($config{'ldap'}) {
40 &foreign_require("ldap-useradmin");
41 $usermodule = "ldap-useradmin";
42 if ($ldap_useradmin::config{'md5'} == 3 ||
43 $ldap_useradmin::config{'md5'} == 4) {
44 $cannot_rehash_password = 1;
45 }
46 }
47 else {
48 $usermodule = "useradmin";
49 }
50 }
51if (!&has_quota_commands() && !$_[0] && !$require_useradmin_quota++) {
52 &foreign_require("quota");
53 }
54}
55
56# Bring in libraries used for migrating from other servers
57sub require_migration
58{
59foreach my $m (@migration_types) {
60 do "$module_root_directory/migration-$m.pl";
61 }
62}
63
64# list_domains()
65# Returns a list of structures containing information about hosted domains
66sub list_domains
67{
68local (@rv, $d);
69local @files;
70local @st = stat($domains_dir);
71if (scalar(@main::list_domains_cache) &&
72 $st[9] == $main::list_domains_cache_time) {
73 # Use cache of domain IDs in RAM
74 @files = @main::list_domains_cache;
75 }
76else {
77 # Re-scan the directory, if un-changed
78 opendir(DIR, $domains_dir);
79 @files = readdir(DIR);
80 closedir(DIR);
81 @main::list_domains_cache = @files;
82 $main::list_domains_cache_time = $st[9];
83 }
84foreach $d (@files) {
85 if ($d !~ /^\./ && $d !~ /\.(lock|bak|rpmsave|sav|swp|webmintmp|~)$/i) {
86 push(@rv, &get_domain($d));
87 }
88 }
89return @rv;
90}
91
92# list_visible_domains()
93# Returns a list of domain structures the current user can see, for use in
94# domain menus. Excludes those that he doesn't have access to, and perhaps
95# alias domains.
96sub list_visible_domains
97{
98my @rv = grep { &can_edit_domain($_) } &list_domains();
99if ($config{'hide_alias'}) {
100 @rv = grep { !$_->{'alias'} } @rv;
101 }
102return @rv;
103}
104
105# sort_indent_domains(&domains)
106# Returns a list of all domains sorted according to the module config setting.
107# Those that should be indented have the 'indent' field set to some number.
108sub sort_indent_domains
109{
110local @doms = @{$_[0]};
111local $sortfield = $config{'domains_sort'} || "user";
112local %sortkey;
113if ($sortfield eq 'dom' || $sortfield eq 'sub') {
114 %sortkey = map { $_->{'id'}, &show_domain_name($_) } @doms;
115 }
116else {
117 %sortkey = map { $_->{'id'}, $_->{$sortfield} } @doms;
118 }
119@doms = sort { $sortkey{$a->{'id'}} cmp $sortkey{$b->{'id'}} ||
120 $a->{'created'} <=> $b->{'created'} } @doms;
121foreach my $d (@doms) {
122 $d->{'indent'} = 0;
123 }
124if ($sortfield eq 'user' || $sortfield eq 'sub') {
125 # Re-categorize by owner, with sub-servers indented one and alias
126 # servers indented two under their targets
127 local @catdoms;
128 foreach my $d (grep { !$_->{'parent'} } @doms) {
129 push(@catdoms, $d);
130 foreach my $ad (grep { $_->{'alias'} eq $d->{'id'} } @doms) {
131 $ad->{'indent'} = 2;
132 push(@catdoms, $ad);
133 }
134 foreach my $sd (grep { $_->{'parent'} eq $d->{'id'} &&
135 !$_->{'alias'} } @doms) {
136 $sd->{'indent'} = 1;
137 push(@catdoms, $sd);
138 foreach my $ad (grep { $_->{'alias'} eq $sd->{'id'} }
139 @doms) {
140 $ad->{'indent'} = 2;
141 push(@catdoms, $ad);
142 }
143 }
144 }
145 # Any domains that we missed due to their parent not being included
146 # should appear at the top level
147 my %incatdoms = map { $_->{'id'}, $_ } @catdoms;
148 foreach my $d (@doms) {
149 if (!$incatdoms{$d->{'id'}}) {
150 push(@catdoms, $d);
151 }
152 }
153 @doms = @catdoms;
154 }
155return @doms;
156}
157
158# get_domain(id, [file], [force-reread])
159# Looks up a domain object by ID
160sub get_domain
161{
162local ($id, $file, $force) = @_;
163return undef if (!$id && !$file);
164if ($id && defined($main::get_domain_cache{$id}) && !$force) {
165 return $main::get_domain_cache{$id};
166 }
167local %dom;
168$file ||= "$domains_dir/$id";
169&read_file($file, \%dom) || return undef;
170$dom{'file'} = "$domains_dir/$id";
171$dom{'id'} ||= $id;
172&complete_domain(\%dom);
173if (!defined($dom->{'created'})) {
174 # compat - creation date can be inferred from ID
175 $dom->{'id'} =~ /^(\d{10})/;
176 $dom->{'created'} = $1;
177 }
178delete($dom->{'missing'}); # never set in a saved domain
179if ($id) {
180 if ($main::get_domain_cache{$id} && $force) {
181 # In forced re-read mode, update existing object in cache
182 local $cache = $main::get_domain_cache{$id};
183 %$cache = %dom;
184 }
185 else {
186 # Add to cache
187 $main::get_domain_cache{$id} = \%dom;
188 }
189 }
190return \%dom;
191}
192
193# complete_domain(&domain)
194# Fills in any missing fields in a domain object
195sub complete_domain
196{
197local ($dom) = @_;
198$dom->{'mail'} = 1 if (!defined($dom->{'mail'})); # compat - assume mail is on
199if (!defined($dom->{'ugid'})) {
200 # compat - assume user's group is domain's group
201 $dom->{'ugid'} = $dom->{'gid'}
202 }
203if (!defined($dom->{'ugroup'}) && defined($dom->{'ugid'})) {
204 $dom->{'ugroup'} = getgrgid($dom->{'ugid'});
205 }
206if ($dom->{'disabled'} eq '1') {
207 # compat - assume everything was disabled
208 $dom->{'disabled'} = "unix,web,dns,mail,mysql,postgres";
209 }
210elsif ($dom->{'disabled'}) {
211 # compat - user disabled has changed to unix
212 $dom->{'disabled'} =~ s/user/unix/g;
213 }
214if ($dom->{'disabled'}) {
215 # Manually disabled
216 $dom->{'disabled_reason'} ||= 'manual';
217 }
218if (!defined($dom->{'gid'}) && defined($dom->{'group'})) {
219 # compat - get GID from group name
220 $dom->{'gid'} = getgrnam($dom->{'group'});
221 }
222if (!defined($dom->{'unix'}) && !$dom->{'parent'}) {
223 # compat - unix is always on for parent domains
224 $dom->{'unix'} = 1;
225 }
226if (!defined($dom->{'dir'})) {
227 # if unix is on, so is home
228 $dom->{'dir'} = $dom->{'unix'};
229 if ($dom->{'parent'}) {
230 # if server has a parent, it never has a Unix user
231 $dom->{'unix'} = 0;
232 }
233 }
234if (!defined($dom->{'limit_unix'})) {
235 # compat - unix is always available for subdomains
236 $dom->{'limit_unix'} = 1;
237 }
238if (!defined($dom->{'limit_dir'})) {
239 # compat - home is always available for subdomains
240 $dom->{'limit_dir'} = 1;
241 }
242if (!defined($dom->{'virt'})) {
243 # compat - assume virtual IP if interface assigned
244 $dom->{'virt'} = $dom->{'iface'} ? 1 : 0;
245 }
246if (!defined($dom->{'web_port'}) && $dom->{'web'}) {
247 # compat - assume web port is current setting
248 $dom->{'web_port'} = $default_web_port;
249 }
250if (!defined($dom->{'web_sslport'}) && $dom->{'ssl'}) {
251 # compat - assume SSL port is current setting
252 $dom->{'web_sslport'} = $web_sslport;
253 }
254if (!defined($dom->{'prefix'})) {
255 # compat - assume that prefix is same as group
256 $dom->{'prefix'} = $dom->{'group'};
257 }
258if (!defined($dom->{'home'})) {
259 local @u = getpwnam($dom->{'user'});
260 $dom->{'home'} = $u[7];
261 }
262if (!defined($dom->{'proxy_pass_mode'}) && $dom->{'proxy_pass'}) {
263 # assume that proxy pass mode is proxy-based if not set
264 $dom->{'proxy_pass_mode'} = 1;
265 }
266if (!defined($dom->{'template'})) {
267 # assume default parent or sub-server template
268 $dom->{'template'} = $dom->{'parent'} ? 1 : 0;
269 }
270if (!defined($dom->{'plan'}) && !$main::no_auto_plan) {
271 # assume first plan
272 local @plans = sort { $a->{'id'} <=> $b->{'id'} } &list_plans();
273 $dom->{'plan'} = $plans[0]->{'id'};
274 }
275if ($dom->{'db'} eq '') {
276 $dom->{'db'} = &database_name($dom);
277 }
278if (!defined($dom->{'db_mysql'}) && $dom->{'mysql'}) {
279 # Assume just one MySQL DB
280 $dom->{'db_mysql'} = $dom->{'db'};
281 }
282$dom->{'db_mysql'} = join(" ", &unique(split(/\s+/, $dom->{'db_mysql'})));
283if (!defined($dom->{'db_postgres'}) && $dom->{'postgres'}) {
284 # Assume just one PostgreSQL DB
285 $dom->{'db_postgres'} = $dom->{'db'};
286 }
287$dom->{'db_postgres'} = join(" ", &unique(split(/\s+/, $dom->{'db_postgres'})));
288
289# Emailto is a computed field
290&compute_emailto($dom);
291
292# Also compute first actual email address
293if (!$dom->{'emailto_addr'} ||
294 $dom->{'emailto_src'} ne $dom->{'emailto'}) {
295 if ($dom->{'emailto'} =~ /^[a-z0-9\.\_\-\+]+\@[a-z0-9\.\_\-]+$/i) {
296 $dom->{'emailto_addr'} = $dom->{'emailto'};
297 }
298 else {
299 ($dom->{'emailto_addr'}) =
300 &extract_address_parts($dom->{'emailto'});
301 }
302 $dom->{'emailto_src'} = $dom->{'emailto'};
303 }
304
305# Set edit limits based on ability to edit domains
306local %acaps = map { $_, 1 } &list_automatic_capabilities($dom->{'domslimit'});
307foreach my $ed (@edit_limits) {
308 if (!defined($dom->{'edit_'.$ed})) {
309 $dom->{'edit_'.$ed} = $acaps{$ed} || 0;
310 }
311 }
312delete($dom->{'pass_set'}); # Only set by callers for modify_* functions
313}
314
315# compute_emailto(&domain)
316# Populate the emailto field based on the email field
317sub compute_emailto
318{
319local ($dom) = @_;
320local $parent;
321if ($dom->{'email'}) {
322 $dom->{'emailto'} = $dom->{'email'};
323 }
324elsif ($dom->{'parent'} && ($parent = &get_domain($dom->{'parent'}))) {
325 $dom->{'emailto'} = $parent->{'emailto'};
326 }
327elsif ($dom->{'mail'}) {
328 $dom->{'emailto'} = $dom->{'user'}.'@'.$dom->{'dom'};
329 }
330else {
331 $dom->{'emailto'} = $dom->{'user'}.'@'.&get_system_hostname();
332 }
333}
334
335# list_automatic_capabilities(can-create-domains)
336# Returns a list of default capabilities for a domain owner or plan
337sub list_automatic_capabilities
338{
339local ($cancreate) = @_;
340if ($cancreate) {
341 return @edit_limits;
342 }
343else {
344 return ( 'users', 'aliases', 'html', 'passwd' );
345 }
346}
347
348# get_domain_by(field, value, [field, value, ...])
349# Looks up a domain by some field(s). For each field, we either use the quick
350# map to find relevant domains, or check though all that we have left.
351# The special value _ANY_ matches any domains where the field is non-empty
352sub get_domain_by
353{
354local @rv;
355for(my $i=0; $i<@_; $i+=2) {
356 local $mf = $get_domain_by_maps{$_[$i]};
357 local @possible;
358 local %map;
359 if ($mf && &read_file_cached($mf, \%map)) {
360 # The map knows relevant domains
361 if ($_[$i+1] eq "_ANY_") {
362 # Find domains where the field is non-empty
363 foreach my $k (keys %map) {
364 next if ($k eq '');
365 foreach my $did (split(" ", $map{$k})) {
366 local $d = &get_domain($did);
367 push(@possible, $d) if ($d);
368 }
369 }
370 }
371 else {
372 # Check for a match
373 foreach my $did (split(" ", $map{$_[$i+1]})) {
374 local $d = &get_domain($did);
375 push(@possible, $d) if ($d);
376 }
377 }
378 }
379 else {
380 # Need to check manually
381 @possible = grep { $_->{$_[$i]} eq $_[$i+1] ||
382 $_->{$_[$i]} ne "" && $_[$i+1] eq "_ANY_" }
383 &list_domains();
384 }
385 if ($i == 0) {
386 # First field, so matches are the result
387 @rv = @possible;
388 }
389 else {
390 # Later field, so winnow down prevent results with new set
391 local %possible = map { $_->{'id'}, $_ } @possible;
392 @rv = grep { $possible{$_->{'id'}} } @rv;
393 }
394 }
395return wantarray ? @rv : $rv[0];
396}
397
398# get_domains_by_names_users(&dnames, &usernames, &errorfunc, &plans)
399# Given a list of domain names, usernames and plans, returns all matching
400# domains (unioned). May callback to the error function if one cannot be found
401sub get_domains_by_names_users
402{
403local ($dnames, $users, $efunc, $plans) = @_;
404foreach my $domain (@$dnames) {
405 local $d = &get_domain_by("dom", $domain);
406 $d || &$efunc("Virtual server $domain does not exist");
407 push(@doms, $d);
408 }
409foreach my $uname (@$users) {
410 local $dinfo = &get_domain_by("user", $uname, "parent", "");
411 if ($dinfo) {
412 push(@doms, $dinfo);
413 push(@doms, &get_domain_by("parent", $dinfo->{'id'}));
414 }
415 else {
416 &$efunc("No top-level domain owned by $uname exists");
417 }
418 }
419foreach my $plan (@$plans) {
420 foreach my $dinfo (&get_domain_by("plan", $plan->{'id'})) {
421 push(@doms, $dinfo);
422 push(@doms, &get_domain_by("parent", $dinfo->{'id'}));
423 }
424 }
425local %donedomain;
426@doms = grep { !$donedomain{$_->{'id'}}++ } @doms;
427return @doms;
428}
429
430# get_domain_by_user(username)
431# Given a domain owner's Webmin login, return his top-level domain
432sub get_domain_by_user
433{
434local ($user) = @_;
435if ($access{'admin'}) {
436 # Extra admin
437 local $d = &get_domain($access{'admin'});
438 if ($d && $d->{'parent'}) {
439 $d = &get_domain($d->{'parent'});
440 }
441 return $d;
442 }
443else {
444 # Domain owner
445 local $d = &get_domain_by("user", $user, "parent", "");
446 return $d;
447 }
448}
449
450# get_domains_by_names(name, ...)
451# Given a list of domain names, returns the domain objects (where they exist)
452sub get_domains_by_names
453{
454local @rv;
455foreach my $dname (@_) {
456 my $d = &get_domain_by("dom", $dname);
457 push(@rv, $d) if ($d);
458 }
459return @rv;
460}
461
462# domain_id()
463# Returns a new unique domain ID
464sub domain_id
465{
466local $rv = time().$$.$main::domain_id_count;
467$main::domain_id_count++;
468return $rv;
469}
470
471# save_domain(&domain, [creating])
472# Write domain information to disk
473sub save_domain
474{
475local ($d, $creating) = @_;
476if (!$creating && $d->{'id'} && !-r "$domains_dir/$d->{'id'}") {
477 # Deleted from under us! Don't save
478 print STDERR "Domain was deleted before saving!\n";
479 return 0;
480 }
481&make_dir($domains_dir, 0700);
482&lock_file("$domains_dir/$d->{'id'}");
483local $oldd = { };
484&read_file("$domains_dir/$d->{'id'}", $oldd);
485if (!$d->{'created'}) {
486 $d->{'created'} = time();
487 $d->{'creator'} ||= $remote_user;
488 $d->{'creator'} ||= getpwuid($<);
489 }
490$d->{'id'} ||= &domain_id();
491$d->{'lastsave'} = time();
492&write_file("$domains_dir/$d->{'id'}", $d);
493&unlock_file("$domains_dir/$d->{'id'}");
494$main::get_domain_cache{$d->{'id'}} = $d;
495if (scalar(@main::list_domains_cache)) {
496 @main::list_domains_cache =
497 &unique(@main::list_domains_cache, $d->{'id'});
498 }
499# Only rebuild maps if something relevant changed
500local $mchanged = 0;
501foreach my $m (keys %get_domain_by_maps) {
502 $mchanged++ if ($d->{$m} ne $oldd->{$m});
503 }
504if ($mchanged) {
505 &build_domain_maps();
506 }
507&set_ownership_permissions(undef, undef, 0700, "$domains_dir/$d->{'id'}");
508return 1;
509}
510
511# delete_domain(&domain)
512# Delete all of Virtualmin's internal information about a domain
513sub delete_domain
514{
515my ($d) = @_;
516my $id = $d->{'id'};
517&unlink_logged("$domains_dir/$id");
518
519# And the bandwidth and plain-text password files
520&unlink_file("$bandwidth_dir/$id");
521&unlink_file("$plainpass_dir/$id");
522&unlink_file("$hashpass_dir/$id");
523&unlink_file("$nospam_dir/$id");
524
525if (defined(&get_autoreply_file_dir)) {
526 # Delete any autoreply file links
527 local $dir = &get_autoreply_file_dir();
528 opendir(AUTODIR, $dir);
529 foreach my $f (readdir(AUTODIR)) {
530 next if ($f eq "." || $f eq "..");
531 if ($f =~ /^\Q$id-\E/) {
532 unlink("$dir/$f");
533 }
534 }
535 closedir(AUTODIR);
536 }
537
538# Delete scheduled backups
539foreach my $sched (&list_scheduled_backups()) {
540 if ($sched->{'owner'} eq $id) {
541 &delete_scheduled_backup($sched);
542 }
543 }
544
545# Delete any script notifications logs
546if (-r $script_warnings_file) {
547 &read_file($script_warnings_file, \%warnsent);
548 foreach my $key (keys %warnsent) {
549 my ($keyid) = split(/\//, $key);
550 delete($warnsent{$key}) if ($keyid eq $id);
551 }
552 &write_file($script_warnings_file, \%warnsent);
553 }
554
555# Delete script install logs
556&unlink_file("$script_log_directory/$id");
557
558# Delete incremental backup file
559&unlink_file("$incremental_backups_dir/$id");
560
561# Delete cached links for the domain
562&clear_links_cache($d);
563
564# Delete any saved aliases
565&unlink_file("$saved_aliases_dir/$id");
566
567# Release any lock on the name
568&unlock_file("$domainnames_dir/$d->{'dom'}.lock");
569
570# Remove from caches
571delete($main::get_domain_cache{$d->{'id'}});
572if (scalar(@main::list_domains_cache)) {
573 @main::list_domains_cache = grep { $_ ne $d->{'id'} }
574 @main::list_domains_cache;
575 }
576&build_domain_maps();
577}
578
579# build_domain_maps()
580# Create the files used by get_domain_by to quickly lookup domains by user
581# or parent
582sub build_domain_maps
583{
584local @doms = &list_domains();
585foreach my $m (keys %get_domain_by_maps) {
586 local %map;
587 foreach my $d (@doms) {
588 local $v = $d->{$m};
589 #next if ($v eq '');
590 if (!defined($map{$v})) {
591 $map{$v} = $d->{'id'};
592 }
593 else {
594 $map{$v} .= " ".$d->{'id'};
595 }
596 }
597 &write_file($get_domain_by_maps{$m}, \%map);
598 }
599}
600
601# list_domain_users([&domain], [skipunix], [no-virts], [no-quotas], [no-dbs])
602# List all Unix users who are in the domain's primary group.
603# If domain is omitted, returns local users.
604sub list_domain_users
605{
606local ($d, $skipunix, $novirts, $noquotas, $nodbs) = @_;
607
608# Get all aliases (and maybe generics) to look for those that match users
609local (%aliases, %generics);
610if ($config{'mail'} && !$novirts) {
611 &require_mail();
612 if ($config{'mail_system'} == 1) {
613 # Find Sendmail aliases for users
614 %aliases = map { $_->{'name'}, $_ } grep { $_->{'enabled'} }
615 &sendmail::list_aliases($sendmail_afiles);
616 }
617 elsif ($config{'mail_system'} == 0) {
618 # Find Postfix aliases for users
619 %aliases = map { $_->{'name'}, $_ }
620 &$postfix_list_aliases($postfix_afiles);
621 }
622 elsif ($config{'mail_system'} == 5) {
623 # Find VPOPMail aliases to match with users
624 %valiases = map { $_->{'from'}, $_ } &list_virtusers();
625 }
626 if ($config{'generics'}) {
627 %generics = &get_generics_hash();
628 }
629 }
630
631# Get all virtusers to look for those for users
632local @virts;
633if (!$_[2]) {
634 @virts = &list_virtusers();
635 }
636
637# Are we setting quotas individually?
638local $ind_quota = 0;
639if (&has_quota_commands() && $config{'quota_get_user_command'} && $_[0]) {
640 $ind_quota = 1;
641 }
642
643local @users = &list_all_users_quotas($noquotas || $ind_quota);
644if ($_[0]) {
645 # Limit to domain users.
646 @users = grep { $_[0]->{'gid'} ne '' &&
647 $_->{'gid'} == $_[0]->{'gid'} ||
648 $_->{'user'} eq $_[0]->{'user'} } @users;
649 foreach my $u (@users) {
650 if ($u->{'user'} eq $_[0]->{'user'} && $u->{'unix'}) {
651 # Virtual server owner
652 $u->{'domainowner'} = 1;
653 if ($config{'mail_system'} == 5) {
654 $u->{'noprimary'} = 1;
655 }
656 if ($d->{'hashpass'}) {
657 $u->{'pass_crypt'} = $d->{'crypt_enc_pass'};
658 $u->{'pass_md5'} = $d->{'md5_enc_pass'};
659 $u->{'pass_mysql'} = $d->{'mysql_enc_pass'};
660 $u->{'pass_digest'} = $d->{'digest_enc_pass'};
661 }
662 }
663 elsif ($u->{'uid'} == $_[0]->{'uid'} && $u->{'unix'}) {
664 # Web management user
665 $u->{'webowner'} = 1;
666 $u->{'noquota'} = 1;
667 $u->{'noprimary'} = 1;
668 $u->{'noextra'} = 1;
669 $u->{'noalias'} = 1;
670 $u->{'nocreatehome'} = 1;
671 $u->{'nomailfile'} = 1;
672 delete($u->{'email'});
673 }
674 if ($ind_quota && !$noquotas) {
675 # Call quota getting command for each user
676 local $out = &run_quota_command(
677 "get_user", $u->{'user'});
678 local ($used, $soft, $hard) = split(/\s+/, $out);
679 $u->{'softquota'} = $soft;
680 $u->{'hardquota'} = $hard;
681 $u->{'uquota'} = $used;
682 }
683 }
684 local @subdoms;
685 if ($_[0]->{'parent'}) {
686 # This is a subdomain - exclude parent domain users
687 @users = grep { $_->{'home'} =~ /^$_[0]->{'home'}\// } @users;
688 }
689 elsif (@subdoms = &get_domain_by("parent", $_[0]->{'id'})) {
690 # This domain has subdomains - exclude their users
691 @users = grep { $_->{'home'} !~ /^$_[0]->{'home'}\/domains\// } @users;
692 }
693 @users = grep { !$_->{'domainowner'} } @users
694 if ($_[1] || $_[0]->{'parent'});
695
696 # Remove users with @ in their names for whom a user with the @ replace
697 # already exists (for Postfix)
698 if ($config{'mail_system'} == 0) {
699 local %umap = map { &replace_atsign($_->{'user'}), $_ }
700 grep { $_->{'user'} =~ /\@/ } @users;
701 @users = grep { !$umap{$_->{'user'}} } @users;
702 }
703
704 if ($config{'mail_system'} == 4) {
705 # Add Qmail LDAP users (who have same GID?)
706 local $ldap = &connect_qmail_ldap();
707 local $rv = $ldap->search(base => $config{'ldap_base'},
708 filter => "(&(objectClass=qmailUser)(|(qmailGID=$_[0]->{'gid'})(gidNumber=$_[0]->{'gid'})))");
709 &error($rv->error) if ($rv->code);
710 foreach $u ($rv->all_entries) {
711 local %uinfo = &qmail_dn_to_hash($u);
712 next if (!$uinfo{'mailstore'}); # alias only
713 $uinfo{'ldap'} = $u;
714 if ($_[0]->{'parent'}) {
715 # In sub-domain, exclude parent domain users
716 next if ($_->{'home'} !~ /^$_[0]->{'home'}\//);
717 }
718 elsif (@subdoms) {
719 # In parent domain exclude sub-domain users
720 next if ($_->{'home'} =~ /^$_[0]->{'home'}\/doma
721ins\//);
722 }
723 @users = grep { $_->{'user'} ne $uinfo{'user'} } @users;
724 push(@users, \%uinfo);
725 }
726 $ldap->unbind();
727 }
728 elsif ($config{'mail_system'} == 5) {
729 # Add VPOPMail users for this domain
730 local %attr_map = ( 'name' => 'user',
731 'passwd' => 'pass',
732 'clear passwd' => 'plainpass',
733 'comment/gecos' => 'real',
734 'dir' => 'home',
735 'quota' => 'qquota',
736 );
737 local $user;
738 local $_;
739 open(UINFO, "$vpopbin/vuserinfo -D $_[0]->{'dom'} |");
740 while(<UINFO>) {
741 s/\r|\n//g;
742 if (/^([^:]+):\s+(.*)$/) {
743 local ($attr, $value) = ($1, $2);
744 if ($attr eq "name") {
745 # Start of a new user
746 $user = { 'vpopmail' => 1,
747 'mailquota' => 1,
748 'person' => 1,
749 'fixedhome' => 1,
750 'noappend' => 1,
751 'noprimary' => 1,
752 'alwaysplain' => 1 };
753 push(@users, $user);
754 }
755 local $amapped = $attr_map{$attr};
756 $user->{$amapped} = $value if ($amapped);
757 if ($amapped eq "qquota") {
758 # Convert quota to virtualmin format
759 if ($value eq "NOQUOTA") {
760 $user->{$amapped} = 0;
761 }
762 else {
763 $user->{$amapped} = int($value);
764 }
765 }
766 if ($amapped eq "user") {
767 # Email is fixed with vpopmail
768 $user->{'email'} =
769 $value."\@".$_[0]->{'dom'};
770 }
771 }
772 }
773 close(UINFO);
774 }
775
776 # Find users with broken home dir (not under homes, or
777 # domain's home, or public_html (for web ftp users))
778 local $phd = &public_html_dir($d);
779 foreach my $u (@users) {
780 if (!$u->{'webowner'} && $u->{'home'} &&
781 $u->{'home'} !~ /^$d->{'home'}\/$config{'homes_dir'}\// &&
782 !&is_under_directory($d->{'home'}, $u->{'home'})) {
783 # Home dir is outside domain's home base somehow
784 $u->{'brokenhome'} = 1;
785 }
786 elsif ($u->{'webowner'} && $u->{'home'} &&
787 !&is_under_directory($phd, $u->{'home'})) {
788 # Website FTP user's home dir must be under public_html
789 $u->{'brokenhome'} = 1;
790 }
791 elsif ($u->{'home'} eq $d->{'home'}) {
792 # Home dir is equal to domain's dir, which is invalid
793 $u->{'brokenhome'} = 1;
794 }
795 }
796
797 if ($d->{'hashpass'}) {
798 # Merge in encrypted passwords
799 &read_file_cached("$hashpass_dir/$d->{'id'}", \%hash);
800 foreach my $u (@users) {
801 foreach my $s (@hashpass_types) {
802 $u->{'pass_'.$s} = $hash{$u->{'user'}.' '.$s};
803 }
804 }
805 }
806 else {
807 # Merge in plain text passwords
808 local (%plain, $need_plainpass_save);
809 &read_file_cached("$plainpass_dir/$d->{'id'}", \%plain);
810 foreach my $u (@users) {
811 if ($u->{'domainowner'}) {
812 # The domain owner's password is always known
813 $u->{'plainpass'} = $d->{'pass'};
814 }
815 elsif (!defined($u->{'plainpass'}) &&
816 defined($plain{$u->{'user'}})) {
817 # Check if the plain password is valid, in case
818 # the crypted password was changed behind
819 # our back
820 if ($plain{$u->{'user'}." encrypted"} eq
821 $u->{'pass'} ||
822 &encrypt_user_password(
823 $u, $plain{$u->{'user'}}) eq
824 $u->{'pass'} ||
825 &safe_unix_crypt($plain{$u->{'user'}},
826 $u->{'pass'})
827 eq $u->{'pass'}) {
828 # Valid - we can use it
829 $u->{'plainpass'} =$plain{$u->{'user'}};
830 if (!defined($plain{$u->{'user'}.
831 " encrypted"})) {
832 # Save the correct crypted
833 # version now
834 $plain{$u->{'user'}.
835 " encrypted"} =
836 $u->{'pass'};
837 $need_plainpass_save = 1;
838 }
839 }
840 else {
841 # We know it is wrong, so remove from
842 # the plain password cache file
843 delete($plain{$u->{'user'}});
844 delete($plain{$u->{'user'}." encrypted"});
845 $need_plainpass_save = 1;
846 }
847 }
848 }
849 if ($need_plainpass_save) {
850 &write_file("$plainpass_dir/$d->{'id'}", \%plain);
851 }
852 }
853 }
854else {
855 # Limit to local users
856 local @lg = getgrnam($config{'localgroup'});
857 @users = grep { $_->{'gid'} == $lg[2] } @users;
858 }
859
860# Set appropriate quota field
861local $tmpl = &get_template($_[0] ? $_[0]->{'template'} : 0);
862local $qtype = $tmpl->{'quotatype'};
863local $u;
864foreach $u (@users) {
865 $u->{'quota'} = $u->{$qtype.'quota'} if (!defined($u->{'quota'}));
866 $u->{'mquota'} = $u->{$qtype.'mquota'} if (!defined($u->{'mquota'}));
867 }
868
869# Check if spamc is being used
870local $spamc;
871if ($_[0] && $_[0]->{'spam'}) {
872 local $spamclient = &get_domain_spam_client($_[0]);
873 $spamc = 1 if ($spamclient =~ /spamc/);
874 }
875
876# Detect user who are close to their quota
877if (&has_home_quotas()) {
878 local $bsize = "a_bsize("home");
879 foreach $u (@users) {
880 local $diff = $u->{'quota'}*$bsize - $u->{'uquota'}*$bsize;
881 if ($u->{'quota'} && $diff < $quota_spam_margin &&
882 $_[0]->{'spam'} && !$spamc) {
883 # Close to quota, which will block spamassassin ..
884 $u->{'spam_quota'} = 1;
885 $u->{'spam_quota_diff'} = $diff < 0 ? 0 : $diff;
886 }
887 if ($u->{'quota'} && $u->{'uquota'} >= $u->{'quota'}) {
888 # At or over quota
889 $u->{'over_quota'} = 1;
890 }
891 elsif ($u->{'quota'} && $u->{'uquota'} >= $u->{'quota'}*0.95) {
892 # Over 95% of quota
893 $u->{'warn_quota'} = 1;
894 }
895 }
896 }
897
898# Add user-configured recovery addresses
899foreach my $u (@users) {
900 if (!defined($u->{'recovery'})) {
901 my $recovery = &write_as_mailbox_user($u,
902 sub { &read_file_contents(
903 "$u->{'home'}/.usermin/changepass/recovery") });
904 $recovery =~ s/\r|\n//g;
905 $u->{'recovery'} = $recovery;
906 }
907 }
908
909if (!$_[2]) {
910 # Add email addresses and forwarding addresses to user structures
911 foreach my $u (@users) {
912 next if ($u->{'qmail'}); # got from LDAP already
913 $u->{'email'} = $u->{'virt'} = undef;
914 $u->{'alias'} = $u->{'to'} = $u->{'generic'} = undef;
915 $u->{'extraemail'} = $u->{'extravirt'} = undef;
916 local ($al, $va);
917 if ($al = $aliases{&escape_alias($u->{'user'})}) {
918 $u->{'alias'} = $al;
919 $u->{'to'} = $al->{'values'};
920 }
921 elsif ($va = $valiases{"$u->{'user'}\@$_[0]->{'dom'}"}) {
922 $u->{'valias'} = $va;
923 $u->{'to'} = $va->{'to'};
924 }
925 elsif ($config{'mail_system'} == 2 ||
926 $config{'mail_system'} == 5) {
927 # Find .qmail file
928 local $alias = &get_dotqmail(&dotqmail_file($u));
929 if ($alias) {
930 $u->{'alias'} = $alias;
931 $u->{'to'} = $u->{'alias'}->{'values'};
932 }
933 }
934 $u->{'generic'} = $generics{$u->{'user'}};
935 local $pop3 = $_[0] ? &remove_userdom($u->{'user'}, $_[0])
936 : $u->{'user'};
937 local $email = $_[0] ? "$pop3\@$_[0]->{'dom'}" : undef;
938 local $escuser = &escape_user($u->{'user'});
939 local $escalias = &escape_alias($u->{'user'});
940 local $v;
941 foreach $v (@virts) {
942 if (@{$v->{'to'}} == 1 &&
943 ($v->{'to'}->[0] eq $escuser ||
944 $v->{'to'}->[0] eq $escalias ||
945 ($v->{'to'}->[0] eq $email &&
946 $config{'mail_system'} != 5) ||
947 $v->{'from'} eq $email &&
948 $v->{'to'}->[0] =~ /^BOUNCE/) &&
949 (!$_[0] || $v->{'from'} ne $_[0]->{'dom'})) {
950 if ($v->{'from'} eq $email) {
951 if ($v->{'to'}->[0] !~ /^BOUNCE/) {
952 $u->{'email'} = $email;
953 }
954 $u->{'virt'} = $v;
955 }
956 else {
957 push(@{$u->{'extraemail'}},
958 $v->{'from'});
959 push(@{$u->{'extravirt'}}, $v);
960 }
961 }
962 }
963 }
964 }
965
966if (!$_[4] && $_[0]) {
967 # Add accessible databases
968 local @dbs = &domain_databases($_[0]);
969 local $db;
970 local %dbdone;
971 foreach $db (@dbs) {
972 local @dbu;
973 local $ufunc;
974 if (&indexof($db->{'type'}, &list_database_plugins()) < 0) {
975 # Core database
976 local $dfunc = "list_".$db->{'type'}."_database_users";
977 next if (!defined(&$dfunc));
978 $ufunc = $db->{'type'}."_username";
979 @dbu = &$dfunc($_[0], $db->{'name'});
980 }
981 else {
982 # Plugin database
983 next if (!&plugin_defined($db->{'type'},
984 "database_users"));
985 @dbu = &plugin_call($db->{'type'}, "database_users",
986 $_[0], $db->{'name'});
987 }
988 local %dbu = map { $_->[0], $_->[1] } @dbu;
989 local $u;
990 local $domufunc = $db->{'type'}.'_user';
991 local $domu = defined(&$domufunc) ? &$domufunc($_[0]) : undef;
992 foreach $u (@users) {
993 # Domain owner always gets all databases
994 next if ($u->{'user'} eq $_[0]->{'user'} &&
995 $u->{'unix'});
996
997 # For each user, add this DB to his list if there
998 # is a user for it with the same name. Unless this
999 # is the same as the domain owner's DB username.
1000 local $uname = $ufunc ? &$ufunc($u->{'user'}) :
1001 &plugin_call($db->{'type'}, "database_user",
1002 $u->{'user'});
1003 if (exists($dbu{$uname}) &&
1004 $uname ne $domu &&
1005 !$dbdone{$db->{'type'},$db->{'name'},$uname}++) {
1006 push(@{$u->{'dbs'}}, $db);
1007 $u->{$db->{'type'}."_user"} = $uname;
1008 $u->{$db->{'type'}."_pass"} = $dbu{$uname};
1009 }
1010 }
1011 }
1012
1013 # Add plugin databases
1014 local @dbs = &domain_databases($_[0]);
1015 foreach $db (@dbs) {
1016 next if (&indexof($db->{'type'}, &list_database_plugins()) == -1);
1017 }
1018 }
1019
1020# Add any secondary groups in the template
1021local @sgroups = &allowed_secondary_groups($_[0]);
1022if (@sgroups) {
1023 local @groups = &list_all_groups();
1024 foreach my $u (@users) {
1025 $u->{'secs'} = [ ];
1026 }
1027 foreach my $g (@sgroups) {
1028 local ($group) = grep { $_->{'group'} eq $g } @groups;
1029 if ($group) {
1030 local %mems = map { $_, 1 }
1031 split(/,/, $group->{'members'});
1032 foreach my $u (@users) {
1033 if ($mems{$u->{'user'}}) {
1034 push(@{$u->{'secs'}}, $g);
1035 }
1036 }
1037 }
1038 }
1039 }
1040
1041# Add no-spam flags
1042if ($_[0]) {
1043 local %nospam;
1044 &read_file_cached("$nospam_dir/$_[0]->{'id'}", \%nospam);
1045 foreach my $u (@users) {
1046 if (!defined($u->{'nospam'})) {
1047 $u->{'nospam'} = $nospam{$u->{'user'}};
1048 }
1049 }
1050 }
1051
1052return @users;
1053}
1054
1055# safe_unix_crypt(pass, salt)
1056# Tries to call unix_crypt, returns undef if it fails
1057sub safe_unix_crypt
1058{
1059local ($pass, $salt) = @_;
1060local $uc;
1061eval {
1062 local $main::error_must_die = 1;
1063 $uc = &unix_crypt($pass, $salt);
1064 };
1065return $uc;
1066}
1067
1068# get_user_database_url()
1069# Returns a string to identify the remote system for storing users
1070sub get_user_database_url
1071{
1072&require_useradmin(1);
1073if ($usermodule eq "ldap-useradmin") {
1074 my $ldap = &ldap_useradmin::ldap_connect();
1075 my $rv;
1076 eval {
1077 $rv = "ldap://".$ldap->host();
1078 };
1079 if ($@) {
1080 # Fall back to host from config
1081 $rv = $ldap_useradmin::config{'ldap_host'} || "localhost";
1082 }
1083 $ldap->unbind();
1084 return $rv;
1085 }
1086return undef; # Local files
1087}
1088
1089# list_all_users_quotas([no-quotas])
1090# Returns a list of all Unix users, with quota info
1091sub list_all_users_quotas
1092{
1093# Get quotas for all users
1094&require_useradmin($_[0]);
1095local $hascmds = &has_quota_commands();
1096if ($hascmds) {
1097 # Get from user quota command
1098 if (!%main::soft_home_quota && !$_[0]) {
1099 local $out = &run_quota_command("list_users");
1100 foreach my $l (split(/\r?\n/, $out)) {
1101 local ($user, $used, $soft, $hard) = split(/\s+/, $l);
1102 $main::soft_home_quota{$user} = $soft;
1103 $main::hard_home_quota{$user} = $hard;
1104 $main::used_home_quota{$user} = $used;
1105 }
1106 }
1107 }
1108else {
1109 # Get from real quota system
1110 if (!%main::soft_home_quota && &has_home_quotas() && !$_[0]) {
1111 local $n = "a::filesystem_users($config{'home_quotas'});
1112 local $i;
1113 for($i=0; $i<$n; $i++) {
1114 $main::soft_home_quota{$quota::user{$i,'user'}} =
1115 $quota::user{$i,'sblocks'};
1116 $main::hard_home_quota{$quota::user{$i,'user'}} =
1117 $quota::user{$i,'hblocks'};
1118 $main::used_home_quota{$quota::user{$i,'user'}} =
1119 $quota::user{$i,'ublocks'};
1120 }
1121 }
1122 if (!%main::soft_mail_quota && &has_mail_quotas() && !$_[0]) {
1123 local $n = "a::filesystem_users($config{'mail_quotas'});
1124 local $i;
1125 for($i=0; $i<$n; $i++) {
1126 $main::soft_mail_quota{$quota::user{$i,'user'}} =
1127 $quota::user{$i,'sblocks'};
1128 $main::hard_mail_quota{$quota::user{$i,'user'}} =
1129 $quota::user{$i,'hblocks'};
1130 $main::used_mail_quota{$quota::user{$i,'user'}} =
1131 $quota::user{$i,'ublocks'};
1132 }
1133 }
1134 }
1135
1136# Get user list and add in quota info
1137local @users = &foreign_call($usermodule, "list_users");
1138local %uidmap;
1139foreach my $u (@users) {
1140 $u->{'module'} = $usermodule;
1141 local $sameu = $uidmap{$u->{'uid'}};
1142 if ($sameu && !$hascmds) {
1143 # Quotas are set on a per-uid basis, so copy from previously
1144 # seem user with same ID
1145 $u->{'softquota'} = $sameu->{'softquota'};
1146 $u->{'hardquota'} = $sameu->{'hardquota'};
1147 $u->{'uquota'} = $sameu->{'uquota'};
1148 $u->{'softmquota'} = $sameu->{'softmquota'};
1149 $u->{'hardmquota'} = $sameu->{'hardmquota'};
1150 $u->{'umquota'} = $sameu->{'umquota'};
1151 }
1152 else {
1153 # Set quotas based on quota commands
1154 $u->{'softquota'} = $main::soft_home_quota{$u->{'user'}};
1155 $u->{'hardquota'} = $main::hard_home_quota{$u->{'user'}};
1156 $u->{'uquota'} = $main::used_home_quota{$u->{'user'}};
1157 $u->{'softmquota'} = $main::soft_mail_quota{$u->{'user'}};
1158 $u->{'hardmquota'} = $main::hard_mail_quota{$u->{'user'}};
1159 $u->{'umquota'} = $main::used_mail_quota{$u->{'user'}};
1160 }
1161 $u->{'unix'} = 1;
1162 $u->{'person'} = 1;
1163 $uidmap{$u->{'uid'}} ||= $u;
1164 }
1165return @users;
1166}
1167
1168# list_all_groups_quotas([no-quotas])
1169# Returns a list of all Unix groups, with quota info
1170sub list_all_groups_quotas
1171{
1172# Get quotas for all groups
1173&require_useradmin($_[0]);
1174if (&has_quota_commands()) {
1175 # Get from user quota command
1176 if (!%main::gsoft_home_quota && !$_[0]) {
1177 local $out = &run_quota_command("list_groups");
1178 foreach my $l (split(/\r?\n/, $out)) {
1179 local ($group, $used, $soft, $hard) = split(/\s+/, $l);
1180 $main::gsoft_home_quota{$group} = $soft;
1181 $main::ghard_home_quota{$group} = $hard;
1182 $main::gused_home_quota{$group} = $used;
1183 }
1184 }
1185 }
1186else {
1187 # Get from real quota system
1188 if (!%main::gsoft_home_quota && &has_home_quotas() && !$_[0]) {
1189 local $n = "a::filesystem_groups($config{'home_quotas'});
1190 local $i;
1191 for($i=0; $i<$n; $i++) {
1192 $main::gsoft_home_quota{$quota::group{$i,'group'}} =
1193 $quota::group{$i,'sblocks'};
1194 $main::ghard_home_quota{$quota::group{$i,'group'}} =
1195 $quota::group{$i,'hblocks'};
1196 $main::gused_home_quota{$quota::group{$i,'group'}} =
1197 $quota::group{$i,'ublocks'};
1198 }
1199 }
1200 if (!%main::gsoft_mail_quota && &has_mail_quotas() && !$_[0]) {
1201 local $n = "a::filesystem_groups($config{'mail_quotas'});
1202 local $i;
1203 for($i=0; $i<$n; $i++) {
1204 $main::gsoft_mail_quota{$quota::group{$i,'group'}} =
1205 $quota::group{$i,'sblocks'};
1206 $main::ghard_mail_quota{$quota::group{$i,'group'}} =
1207 $quota::group{$i,'hblocks'};
1208 $main::gused_mail_quota{$quota::group{$i,'group'}} =
1209 $quota::group{$i,'ublocks'};
1210 }
1211 }
1212 }
1213
1214# Get group list and add in quota info
1215local @groups = &foreign_call($usermodule, "list_groups");
1216local $u;
1217foreach $u (@groups) {
1218 $u->{'module'} = $usermodule;
1219 $u->{'softquota'} = $main::gsoft_home_quota{$u->{'group'}};
1220 $u->{'hardquota'} = $main::ghard_home_quota{$u->{'group'}};
1221 $u->{'uquota'} = $main::gused_home_quota{$u->{'group'}};
1222 $u->{'softmquota'} = $main::gsoft_mail_quota{$u->{'group'}};
1223 $u->{'hardmquota'} = $main::ghard_mail_quota{$u->{'group'}};
1224 $u->{'umquota'} = $main::gused_mail_quota{$u->{'group'}};
1225 }
1226return @groups;
1227}
1228
1229# create_user(&user, [&domain])
1230# Create a mailbox or local user, his virtuser and possibly his alias
1231sub create_user
1232{
1233local $pop3 = &remove_userdom($_[0]->{'user'}, $_[1]);
1234&require_useradmin();
1235&require_mail();
1236
1237if ($_[0]->{'qmail'}) {
1238 # Create user in Qmail LDAP
1239 local $ldap = &connect_qmail_ldap();
1240 local $_[0]->{'dn'} = "uid=$_[0]->{'user'},$config{'ldap_base'}";
1241 local @oc = ( "qmailUser" );
1242 push(@oc, "posixAccount") if ($_[0]->{'unix'});
1243 push(@oc, split(/\s+/, $config{'ldap_classes'}));
1244 local $attrs = &qmail_user_to_dn($_[0], \@oc, $_[1]);
1245 push(@$attrs, "objectClass" => \@oc);
1246 local $rv = $ldap->add($_[0]->{'dn'}, attr => $attrs);
1247 &error($rv->error) if ($rv->code);
1248 $ldap->unbind();
1249 }
1250elsif ($_[0]->{'vpopmail'}) {
1251 # Create user in VPOPMail
1252 local $quser = quotemeta($_[0]->{'user'});
1253 local $qdom = $_[1]->{'dom'};
1254 local $qreal = quotemeta($_[0]->{'real'}) || '""';
1255 local $quota = $_[0]->{'qquota'} ? "-q $_[0]->{'qquota'}" : "-q NOQUOTA";
1256 local $qpass = quotemeta($_[0]->{'plainpass'}) || '""';
1257 local $cmd = "$vpopbin/vadduser $quota -c $qreal $quser\@$qdom $qpass";
1258 local $out = &backquote_logged("$cmd 2>&1");
1259 &error("<tt>$cmd</tt> failed: <pre>$out</pre>") if ($?);
1260 $_[0]->{'home'} = &domain_vpopmail_dir($_[1])."/".$_[0]->{'user'};
1261 }
1262else {
1263 # Add the Unix user
1264 if ($config{'ldap_mail'}) {
1265 $_[0]->{'ldap_attrs'} = [ ];
1266 if ($_[0]->{'email'}) {
1267 push(@{$_[0]->{'ldap_attrs'}}, "mail",$_[0]->{'email'});
1268 }
1269 local $ea = $config{'ldap_mail'} == 2 ?
1270 'mailAlternateAddress' : 'mail';
1271 push(@{$_[0]->{'ldap_attrs'}},
1272 map { ( $ea, $_ ) } @{$_[0]->{'extraemail'}});
1273 }
1274 &foreign_call($usermodule, "set_user_envs", $_[0], 'CREATE_USER',
1275 $_[0]->{'plainpass'}, [ ]);
1276 &set_virtualmin_user_envs($_[0], $_[1]);
1277 &foreign_call($usermodule, "making_changes");
1278 &userdom_substitutions($_[0], $_[1]);
1279 &foreign_call($usermodule, "create_user", $_[0]);
1280 &foreign_call($usermodule, "made_changes");
1281 }
1282
1283# If we are running Postfix and the username has an @ in it, create an extra
1284# Unix user without the @ but all the other details the same
1285local $extrauser;
1286if ($config{'mail_system'} == 0 && $_[0]->{'user'} =~ /\@/ &&
1287 !$_[0]->{'webowner'}) {
1288 $extrauser = { %{$_[0]} };
1289 $extrauser->{'user'} = &replace_atsign($extrauser->{'user'});
1290 &foreign_call($usermodule, "set_user_envs", $extrauser, 'CREATE_USER', $extrauser->{'plainpass'}, [ ]);
1291 &set_virtualmin_user_envs($_[0], $_[1]);
1292 &foreign_call($usermodule, "making_changes");
1293 &userdom_substitutions($extrauser, $_[1]);
1294 &foreign_call($usermodule, "create_user", $extrauser);
1295 &foreign_call($usermodule, "made_changes");
1296 }
1297
1298local $firstemail;
1299local @to = @{$_[0]->{'to'}};
1300if (!$_[0]->{'qmail'}) {
1301 # Add his virtusers for non Qmail+LDAP users
1302 local $vto = @to ? &escape_alias($_[0]->{'user'}) :
1303 $extrauser ? $extrauser->{'user'} :
1304 &escape_user($_[0]->{'user'});
1305 if ($_[0]->{'email'}) {
1306 local $virt = { 'from' => $_[0]->{'email'},
1307 'to' => [ $vto ] };
1308 &create_virtuser($virt);
1309 $_[0]->{'virt'} = $virt;
1310 $firstemail ||= $_[0]->{'email'};
1311 }
1312 elsif ($can_alias_types{9} && $_[1] && !$_[0]->{'noprimary'} &&
1313 $_[1]->{'mail'}) {
1314 # Add bouncer if email disabled
1315 local $virt = { 'from' => "$pop3\@$_[1]->{'dom'}",
1316 'to' => [ "BOUNCE" ] };
1317 &create_virtuser($virt);
1318 $_[0]->{'virt'} = $virt;
1319 }
1320 local @extravirt;
1321 local $e;
1322 foreach $e (&unique(@{$_[0]->{'extraemail'}})) {
1323 local $virt = { 'from' => $e,
1324 'to' => [ $vto ] };
1325 &create_virtuser($virt);
1326 push(@extravirt, $virt);
1327 $firstemail ||= $e;
1328 }
1329 $_[0]->{'extravirt'} = \@extravirt;
1330 }
1331
1332if (!$_[0]->{'qmail'}) {
1333 # Add his alias, if any, for non Qmail+LDAP users
1334 if (@to) {
1335 local $alias = { 'name' => &escape_alias($_[0]->{'user'}),
1336 'enabled' => 1,
1337 'values' => $_[0]->{'to'} };
1338 &check_alias_clash($_[0]->{'user'}) &&
1339 &error(&text('alias_eclash2', $_[0]->{'user'}));
1340 if ($config{'mail_system'} == 1) {
1341 &sendmail::lock_alias_files($sendmail_afiles);
1342 &sendmail::create_alias($alias, $sendmail_afiles);
1343 &sendmail::unlock_alias_files($sendmail_afiles);
1344 }
1345 elsif ($config{'mail_system'} == 0) {
1346 &postfix::lock_alias_files($postfix_afiles);
1347 &$postfix_create_alias($alias, $postfix_afiles);
1348 &postfix::unlock_alias_files($postfix_afiles);
1349 &postfix::regenerate_aliases();
1350 }
1351 elsif ($config{'mail_system'} == 2 ||
1352 $config{'mail_system'} == 5) {
1353 # Set up user's .qmail file
1354 local $dqm = &dotqmail_file($_[0]);
1355 &lock_file($dqm);
1356 &save_dotqmail($alias, $dqm, $pop3);
1357 &unlock_file($dqm);
1358 }
1359 $_[0]->{'alias'} = $alias;
1360 }
1361
1362 if ($config{'generics'} && $firstemail) {
1363 # Add genericstable entry too
1364 &create_generic($_[0]->{'user'}, $firstemail);
1365 }
1366 }
1367
1368if ($_[0]->{'unix'} && !$_[0]->{'noquota'}) {
1369 # Set his initial quotas
1370 &set_user_quotas($_[0]->{'user'}, $_[0]->{'quota'}, $_[0]->{'mquota'},
1371 $_[1]);
1372 }
1373
1374# Grant access to databases (unless this is the domain owner)
1375if ($_[1] && !$_[0]->{'domainowner'}) {
1376 local $dt;
1377 foreach $dt (&unique(map { $_->{'type'} } &domain_databases($_[1]))) {
1378 local @dbs = map { $_->{'name'} }
1379 grep { $_->{'type'} eq $dt } @{$_[0]->{'dbs'}};
1380 if (@dbs && &indexof($dt, &list_database_plugins()) < 0) {
1381 # Create in core database
1382 local $crfunc = "create_${dt}_database_user";
1383 &$crfunc($_[1], \@dbs, $_[0]->{'user'},
1384 $_[0]->{'plainpass'}, $_[0]->{$dt.'_pass'});
1385 }
1386 elsif (@dbs && &indexof($dt, &list_database_plugins()) >= 0) {
1387 # Create in plugin database
1388 &plugin_call($dt, "database_create_user",
1389 $_[1], \@dbs, $_[0]->{'user'},
1390 $_[0]->{'plainpass'},$_[0]->{$dt.'_pass'});
1391 }
1392 }
1393 }
1394
1395# Add user to any secondary groups
1396local @groups;
1397@groups = &list_all_groups() if (@{$_[0]->{'secs'}});
1398foreach my $g (@{$_[0]->{'secs'}}) {
1399 local ($group) = grep { $_->{'group'} eq $g } @groups;
1400 if ($group) {
1401 local @mems = split(/,/, $group->{'members'});
1402 push(@mems, $_[0]->{'user'});
1403 $group->{'members'} = join(",", @mems);
1404 &foreign_call($group->{'module'}, "modify_group",
1405 $group, $group);
1406 }
1407 }
1408
1409# Update secondary groups for mail/FTP/db users
1410&update_secondary_groups($_[1]) if ($_[1]);
1411
1412# Update spamassassin whitelist
1413if ($_[1]) {
1414 &obtain_lock_spam($_[1]);
1415 &update_spam_whitelist($_[1]);
1416 &release_lock_spam($_[1]);
1417 }
1418
1419if ($_[1]->{'hashpass'}) {
1420 # Save hashed passwords, if plain is known
1421 if (!-d $hashpass_dir) {
1422 mkdir($hashpass_dir, 0700);
1423 }
1424 if (defined($_[0]->{'plainpass'})) {
1425 local %hash;
1426 &read_file_cached("$hashpass_dir/$_[1]->{'id'}", \%hash);
1427 local $g = &generate_password_hashes(
1428 $_[0], $_[0]->{'plainpass'}, $_[1]);
1429 foreach my $s (@hashpass_types) {
1430 $hash{$_[0]->{'user'}.' '.$s} = $g->{$s};
1431 }
1432 &write_file("$hashpass_dir/$_[1]->{'id'}", \%hash);
1433 }
1434 }
1435else {
1436 # Save the plain-text password, if known
1437 if (!-d $plainpass_dir) {
1438 mkdir($plainpass_dir, 0700);
1439 }
1440 if (defined($_[0]->{'plainpass'})) {
1441 local %plain;
1442 &read_file_cached("$plainpass_dir/$_[1]->{'id'}", \%plain);
1443 $plain{$_[0]->{'user'}} = $_[0]->{'plainpass'};
1444 $plain{$_[0]->{'user'}." encrypted"} = $_[0]->{'pass'};
1445 &write_file("$plainpass_dir/$_[1]->{'id'}", \%plain);
1446 }
1447 }
1448
1449# Save the no-spam-check flag
1450if (!-d $nospam_dir) {
1451 mkdir($nospam_dir, 0700);
1452 }
1453if ($_[0]->{'nospam'}) {
1454 local %nospam;
1455 &read_file_cached("$nospam_dir/$_[1]->{'id'}", \%nospam);
1456 $nospam{$_[0]->{'user'}} = 1;
1457 &write_file("$nospam_dir/$_[1]->{'id'}", \%nospam);
1458 }
1459
1460# Set the user's Usermin IMAP password
1461if ($_[0]->{'email'} || @{$_[0]->{'extraemail'}}) {
1462 &set_usermin_imap_password($_[0]);
1463 }
1464
1465# Save the recovery address
1466&set_usermin_recovery_address($_[0]);
1467
1468# Update cache of existing usernames
1469$unix_user{&escape_alias($_[0]->{'user'})}++;
1470
1471# Copy virtusers into alias domains
1472if ($_[1]) {
1473 &sync_alias_virtuals($_[1]);
1474 }
1475
1476# Create everyone file for domain
1477if ($_[1] && $_[1]->{'mail'}) {
1478 &create_everyone_file($_[1]);
1479 }
1480}
1481
1482# modify_user(&user, &old, &domain, [noaliases])
1483# Update a mail / FTP user
1484sub modify_user
1485{
1486# Rename any of his cron jobs
1487if ($_[0]->{'unix'}) {
1488 &rename_unix_cron_jobs($_[0]->{'user'}, $_[1]->{'user'});
1489 }
1490
1491local $pop3 = &remove_userdom($_[0]->{'user'}, $_[2]);
1492local $extrauser;
1493if ($_[1]->{'qmail'}) {
1494 # Update user in Qmail LDAP
1495 local $ldap = &connect_qmail_ldap();
1496 local ($attrs, $delattrs) = &qmail_user_to_dn($_[0],
1497 [ $_[1]->{'ldap'}->get_value("objectClass") ], $_[2]);
1498 @$delattrs = grep { defined($_[1]->{'ldap'}->get_value($_))} @$delattrs;
1499 local (%attrs, $i);
1500 for($i=0; $i<@$attrs; $i+=2) {
1501 $attrs{$attrs->[$i]} = $attrs->[$i+1];
1502 }
1503 local $newdn = "uid=$_[0]->{'user'},$config{'ldap_base'}";
1504 if (!&same_dn($newdn, $_[1]->{'dn'})) {
1505 # Renamed, so change DN
1506 $rv = $ldap->moddn($_[1]->{'dn'},
1507 newrdn => "uid=$_[0]->{'user'}");
1508 &error($rv->error) if ($rv->code);
1509 $_[0]->{'dn'} = $newdn;
1510 }
1511 # Update other attributes
1512 local $rv = $ldap->modify($_[0]->{'dn'},
1513 replace => \%attrs,
1514 delete => $delattrs);
1515 &error($rv->error) if ($rv->code);
1516 $ldap->unbind();
1517 }
1518elsif ($_[1]->{'vpopmail'}) {
1519 # Update VPOPMail user
1520 local $quser = quotemeta($_[1]->{'user'});
1521 local $qdom = $_[2]->{'dom'};
1522 local $qreal = quotemeta($_[0]->{'real'}) || '""';
1523 local $qpass = quotemeta($_[0]->{'plainpass'});
1524 local $qquota = $_[0]->{'qquota'} ? $_[0]->{'qquota'} : "NOQUOTA";
1525 local $cmd = "$vpopbin/vmoduser -c $qreal ".
1526 ($_[0]->{'passmode'} == 3 ? " -C $qpass" : "").
1527 " -q $qquota $quser\@$qdom";
1528 local $out = &backquote_logged("$cmd 2>&1");
1529 if ($?) {
1530 &error("<tt>$cmd</tt> failed: <pre>$out</pre>");
1531 }
1532 if ($_[0]->{'user'} ne $_[1]->{'user'}) {
1533 # Need to rename manually
1534 local $vdomdir = &domain_vpopmail_dir($_[2]);
1535 &rename_logged("$vdomdir/$_[1]->{'user'}", "$vdomdir/$_[0]->{'user'}");
1536 &lock_file("$vdomdir/vpasswd");
1537 local $lref = &read_file_lines("$vdomdir/vpasswd");
1538 local $l;
1539 foreach $l (@$lref) {
1540 local @u = split(/:/, $l);
1541 if ($u[0] eq $_[1]->{'user'}) {
1542 $u[0] = $_[0]->{'user'};
1543 $u[5] =~ s/$_[1]->{'user'}$/$_[0]->{'user'}/;
1544 $l = join(":", @u);
1545 }
1546 }
1547 &flush_file_lines();
1548 &unlock_file("$vdomdir/vpasswd");
1549 &system_logged("$vpopbin/vmkpasswd $qdom");
1550 }
1551 }
1552else {
1553 # Modifying Unix user
1554 &require_useradmin();
1555 &require_mail();
1556
1557 # Update the unix user
1558 if ($config{'ldap_mail'}) {
1559 $_[0]->{'ldap_attrs'} = [ ];
1560 if ($_[0]->{'email'}) {
1561 push(@{$_[0]->{'ldap_attrs'}}, "mail",$_[0]->{'email'});
1562 }
1563 local $ea = $config{'ldap_mail'} == 2 ?
1564 'mailAlternateAddress' : 'mail';
1565 push(@{$_[0]->{'ldap_attrs'}},
1566 map { ( $ea, $_ ) } @{$_[0]->{'extraemail'}});
1567 }
1568 &foreign_call($usermodule, "set_user_envs", $_[0], 'MODIFY_USER',
1569 $_[0]->{'plainpass'}, undef, $_[1], $_[1]->{'plainpass'});
1570 &set_virtualmin_user_envs($_[0], $_[2]);
1571 &foreign_call($usermodule, "making_changes");
1572 &userdom_substitutions($_[0], $_[2]);
1573 &foreign_call($usermodule, "modify_user", $_[1], $_[0]);
1574 &foreign_call($usermodule, "made_changes");
1575
1576 if ($config{'mail_system'} == 0 && $_[1]->{'user'} =~ /\@/) {
1577 local $esc = &replace_atsign($_[1]->{'user'});
1578 local @allusers = &list_all_users_quotas(1);
1579 local ($oldextrauser) = grep { $_->{'user'} eq $esc } @allusers;
1580 if ($oldextrauser) {
1581 # Found him .. fix up
1582 $extrauser = { %{$_[0]} };
1583 $extrauser->{'user'} = &replace_atsign($_[0]->{'user'});
1584 $extrauser->{'dn'} = $oldextrauser->{'dn'};
1585 &foreign_call($usermodule, "set_user_envs", $extrauser,
1586 'MODIFY_USER', $_[0]->{'plainpass'},
1587 undef, $oldextrauser,
1588 $_[1]->{'plainpass'});
1589 &set_virtualmin_user_envs($_[0], $_[2]);
1590 &foreign_call($usermodule, "making_changes");
1591 &userdom_substitutions($extrauser, $_[2]);
1592 &foreign_call($usermodule, "modify_user",
1593 $oldextrauser, $extrauser);
1594 &foreign_call($usermodule, "made_changes");
1595 }
1596 }
1597
1598 goto NOALIASES if ($_[3]); # no need to touch aliases and virtusers
1599 }
1600
1601# Check if email has changed
1602local $echanged;
1603if (!$_[0]->{'email'} && $_[1]->{'virt'} && # disabling
1604 $_[1]->{'virt'}->{'to'}->[0] !~ /^BOUNCE/ ||
1605 $_[0]->{'email'} && !$_[1]->{'virt'} || # enabling
1606 $_[0]->{'email'} && $_[1]->{'virt'} && # changing
1607 $_[0]->{'email'} ne $_[1]->{'virt'}->{'from'} ||
1608 $_[0]->{'email'} && $_[1]->{'virt'} && # also enabling
1609 $_[1]->{'virt'}->{'to'}->[0] =~ /^BOUNCE/
1610 ) {
1611 # Primary has changed
1612 $echanged = 1;
1613 }
1614local $oldextra = join(" ", map { $_->{'from'} } @{$_[1]->{'extravirt'}});
1615local $newextra = join(" ", @{$_[0]->{'extraemail'}});
1616if ($oldextra ne $newextra) {
1617 # Extra has changed
1618 $echanged = 1;
1619 }
1620if ($_[0]->{'user'} ne $_[1]->{'user'}) {
1621 # Always update on a rename
1622 $echanged = 1;
1623 }
1624local $oldto = join(" ", @{$_[1]->{'to'}});
1625local $newto = join(" ", @{$_[0]->{'to'}});
1626if ($oldto ne $newto) {
1627 # Always update if forwarding dest has changed
1628 $echanged = 1;
1629 }
1630
1631local $firstemail;
1632local @to = @{$_[0]->{'to'}};
1633local @oldto = @{$_[1]->{'to'}};
1634if (!$_[0]->{'qmail'} && $echanged) {
1635 # Take away all virtusers and add new ones, for non Qmail+LDAP users
1636 &delete_virtuser($_[1]->{'virt'}) if ($_[1]->{'virt'});
1637 local %oldcmt;
1638 foreach my $e (@{$_[1]->{'extravirt'}}) {
1639 $oldcmt{$e->{'from'}} = $e->{'cmt'};
1640 &delete_virtuser($e);
1641 }
1642 local $vto = @to ? &escape_alias($_[0]->{'user'}) :
1643 $extrauser ? $extrauser->{'user'} :
1644 &escape_user($_[0]->{'user'});
1645 if ($_[0]->{'email'}) {
1646 local $virt = { 'from' => $_[0]->{'email'},
1647 'to' => [ $vto ],
1648 'cmt' => $oldcmt{$_[0]->{'email'}} };
1649 &create_virtuser($virt);
1650 $_[0]->{'virt'} = $virt;
1651 $firstemail ||= $_[0]->{'email'};
1652 }
1653 elsif ($can_alias_types{9} && $_[2] && !$_[0]->{'noprimary'} &&
1654 $_[2]->{'mail'}) {
1655 # Add bouncer if email disabled
1656 local $virt = { 'from' => "$pop3\@$_[2]->{'dom'}",
1657 'to' => [ "BOUNCE" ],
1658 'cmt' => $oldcmt{"$pop3\@$_[2]->{'dom'}"} };
1659 &create_virtuser($virt);
1660 $_[0]->{'virt'} = $virt;
1661 }
1662 local @extravirt;
1663 foreach my $e (&unique(@{$_[0]->{'extraemail'}})) {
1664 local $virt = { 'from' => $e,
1665 'to' => [ $vto ],
1666 'cmt' => $oldcmt{$e} };
1667 &create_virtuser($virt);
1668 push(@extravirt, $virt);
1669 $firstemail ||= $e;
1670 }
1671 $_[0]->{'extravirt'} = \@extravirt;
1672 }
1673else {
1674 # Just work out primary email address, for use by generics
1675 if ($_[0]->{'email'}) {
1676 $firstemail ||= $_[0]->{'email'};
1677 }
1678 foreach my $e (@{$_[0]->{'extraemail'}}) {
1679 $firstemail ||= $e;
1680 }
1681 }
1682
1683if (!$_[0]->{'qmail'}) {
1684 # Update, create or delete alias, for non Qmail+LDAP users
1685 if (@to && !@oldto) {
1686 # Need to add alias
1687 local $alias = { 'name' => &escape_alias($_[0]->{'user'}),
1688 'enabled' => 1,
1689 'values' => $_[0]->{'to'} };
1690 &check_alias_clash($_[0]->{'user'}) &&
1691 &error(&text('alias_eclash2', $_[0]->{'user'}));
1692 if ($config{'mail_system'} == 1) {
1693 # Create Sendmail alias with same name as user
1694 &sendmail::lock_alias_files($sendmail_afiles);
1695 &sendmail::create_alias($alias, $sendmail_afiles);
1696 &sendmail::unlock_alias_files($sendmail_afiles);
1697 }
1698 elsif ($config{'mail_system'} == 0) {
1699 # Create Postfix alias with same name as user
1700 &postfix::lock_alias_files($postfix_afiles);
1701 &$postfix_create_alias($alias, $postfix_afiles);
1702 &postfix::unlock_alias_files($postfix_afiles);
1703 &postfix::regenerate_aliases();
1704 }
1705 elsif ($config{'mail_system'} == 2 ||
1706 $config{'mail_system'} == 5) {
1707 # Set up user's .qmail file
1708 local $dqm = &dotqmail_file($_[0]);
1709 &lock_file($dqm);
1710 &save_dotqmail($alias, $dqm, $pop3);
1711 &unlock_file($dqm);
1712 }
1713 $_[0]->{'alias'} = $alias;
1714 }
1715 elsif (!@to && @oldto) {
1716 # Need to delete alias
1717 if ($config{'mail_system'} == 1) {
1718 # Delete Sendmail alias
1719 &lock_file($_[0]->{'alias'}->{'file'});
1720 &sendmail::delete_alias($_[0]->{'alias'});
1721 &unlock_file($_[0]->{'alias'}->{'file'});
1722 }
1723 elsif ($config{'mail_system'} == 0) {
1724 # Delete Postfix alias
1725 &lock_file($_[0]->{'alias'}->{'file'});
1726 &$postfix_delete_alias($_[0]->{'alias'});
1727 &unlock_file($_[0]->{'alias'}->{'file'});
1728 &postfix::regenerate_aliases();
1729 }
1730 elsif ($config{'mail_system'} == 2 ||
1731 $config{'mail_system'} == 5) {
1732 # Remove user's .qmail file
1733 local $dqm = &dotqmail_file($_[0]);
1734 &unlink_logged($dqm);
1735 }
1736 }
1737 elsif (@to && @oldto && join(" ", @to) ne join(" ", @oldto)) {
1738 # Need to update the alias
1739 local $alias = { 'name' => &escape_alias($_[0]->{'user'}),
1740 'enabled' => 1,
1741 'values' => $_[0]->{'to'} };
1742 if ($config{'mail_system'} == 1) {
1743 # Update Sendmail alias
1744 &lock_file($_[1]->{'alias'}->{'file'});
1745 &sendmail::modify_alias($_[1]->{'alias'}, $alias);
1746 &unlock_file($_[1]->{'alias'}->{'file'});
1747 }
1748 elsif ($config{'mail_system'} == 0) {
1749 # Update Postfix alias
1750 &lock_file($_[1]->{'alias'}->{'file'});
1751 &$postfix_modify_alias($_[1]->{'alias'}, $alias);
1752 &unlock_file($_[1]->{'alias'}->{'file'});
1753 &postfix::regenerate_aliases();
1754 }
1755 elsif ($config{'mail_system'} == 2 ||
1756 $config{'mail_system'} == 5) {
1757 # Set up user's .qmail file
1758 local $dqm = &dotqmail_file($_[0]);
1759 &lock_file($dqm);
1760 &save_dotqmail($alias, $dqm, $pop3);
1761 &unlock_file($dqm);
1762 }
1763 $_[0]->{'alias'} = $alias;
1764 }
1765
1766 if ($config{'generics'} && $echanged) {
1767 # Update genericstable entry too
1768 if ($_[1]->{'generic'}) {
1769 &delete_generic($_[1]->{'generic'});
1770 }
1771 if ($firstemail) {
1772 &create_generic($_[0]->{'user'}, $firstemail);
1773 }
1774 }
1775 }
1776&sync_alias_virtuals($_[2]);
1777NOALIASES:
1778
1779# Save his quotas if changed (unless this is the domain owner)
1780if ($_[0]->{'unix'} && $_[2] && $_[0]->{'user'} ne $_[2]->{'user'} &&
1781 !$_[0]->{'noquota'} &&
1782 ($_[0]->{'quota'} != $_[1]->{'quota'} ||
1783 $_[0]->{'mquota'} != $_[1]->{'mquota'})) {
1784 &set_user_quotas($_[0]->{'user'}, $_[0]->{'quota'}, $_[0]->{'mquota'},
1785 $_[2]);
1786 }
1787
1788# Update the plain-text password file, except for a domain owner
1789if (!$_[0]->{'domainowner'} && $_[2] && !$_[2]->{'hashpass'}) {
1790 local %plain;
1791 mkdir($plainpass_dir, 0700);
1792 &read_file_cached("$plainpass_dir/$_[2]->{'id'}", \%plain);
1793 if ($_[0]->{'user'} ne $_[1]->{'user'}) {
1794 $plain{$_[0]->{'user'}} = $plain{$_[1]->{'user'}};
1795 delete($plain{$_[1]->{'user'}});
1796 $plain{$_[0]->{'user'}." encrypted"} =
1797 $plain{$_[1]->{'user'}." encrypted"};
1798 delete($plain{$_[1]->{'user'}." encrypted"});
1799 }
1800 if (defined($_[0]->{'plainpass'})) {
1801 $plain{$_[0]->{'user'}} = $_[0]->{'plainpass'};
1802 $plain{$_[0]->{'user'}." encrypted"} = $_[0]->{'pass'};
1803 }
1804 &write_file("$plainpass_dir/$_[2]->{'id'}", \%plain);
1805 }
1806
1807# Update hashed passwords file, except for domain owner
1808if (!$_[0]->{'domainowner'} && $_[2] && $_[2]->{'hashpass'}) {
1809 local %hash;
1810 mkdir($hashpass_dir, 0700);
1811 &read_file_cached("$hashpass_dir/$_[2]->{'id'}", \%hash);
1812 if ($_[0]->{'user'} ne $_[1]->{'user'}) {
1813 foreach my $s (@hashpass_types) {
1814 $hash{$_[0]->{'user'}.' '.$s} =
1815 $hash{$_[1]->{'user'}.' '.$s};
1816 delete($hash{$_[1]->{'user'}.' '.$s});
1817 }
1818 }
1819 if (defined($_[0]->{'plainpass'})) {
1820 # Re-hash new password
1821 local $g = &generate_password_hashes(
1822 $_[0], $_[0]->{'plainpass'}, $_[2]);
1823 foreach my $s (@hashpass_types) {
1824 $hash{$_[0]->{'user'}.' '.$s} = $g->{$s};
1825 $_[0]->{'pass_'.$s} = $g->{$s};
1826 }
1827 }
1828 &write_file("$hashpass_dir/$_[2]->{'id'}", \%hash);
1829 }
1830
1831# Update his allowed databases (unless this is the domain owner), if any
1832# have been added or removed.
1833local $newdbstr = join(" ", map { $_->{'type'}."_".$_->{'name'} }
1834 @{$_[0]->{'dbs'}});
1835local $olddbstr = join(" ", map { $_->{'type'}."_".$_->{'name'} }
1836 @{$_[1]->{'dbs'}});
1837if ($_[2] && !$_[0]->{'domainowner'} &&
1838 ($newdbstr ne $olddbstr ||
1839 $_[0]->{'pass'} ne $_[1]->{'pass'} ||
1840 $_[0]->{'user'} ne $_[1]->{'user'})) {
1841 local $dt;
1842 foreach $dt (&unique(map { $_->{'type'} } &domain_databases($_[2]))) {
1843 local @dbs = map { $_->{'name'} }
1844 grep { $_->{'type'} eq $dt } @{$_[0]->{'dbs'}};
1845 local @olddbs = map { $_->{'name'} }
1846 grep { $_->{'type'} eq $dt } @{$_[1]->{'dbs'}};
1847 local $plugin = &indexof($dt, &list_database_plugins()) >= 0;
1848 if (@dbs && !@olddbs) {
1849 # Need to add database user
1850 if (!$plugin) {
1851 local $crfunc = "create_${dt}_database_user";
1852 &$crfunc($_[2], \@dbs, $_[0]->{'user'},
1853 $_[0]->{'plainpass'},
1854 $_[0]->{'pass_'.$dt});
1855 }
1856 else {
1857 &plugin_call($dt, "database_create_user",
1858 $_[2], \@dbs, $_[0]->{'user'},
1859 $_[0]->{'plainpass'},
1860 $_[0]->{'pass_'.$dt});
1861 }
1862 }
1863 elsif (@dbs && @olddbs) {
1864 # Need to update database user
1865 if (!$plugin) {
1866 local $mdfunc = "modify_${dt}_database_user";
1867 &$mdfunc($_[2], \@olddbs, \@dbs,
1868 $_[1]->{'user'}, $_[0]->{'user'},
1869 $_[0]->{'plainpass'},
1870 $_[0]->{'pass_'.$dt});
1871 }
1872 else {
1873 &plugin_call($dt, "database_modify_user",
1874 $_[2], \@olddbs, \@dbs,
1875 $_[1]->{'user'}, $_[0]->{'user'},
1876 $_[0]->{'plainpass'},
1877 $_[0]->{'pass_'.$dt});
1878 }
1879 }
1880 elsif (!@dbs && @olddbs) {
1881 # Need to delete database user
1882 if (!$plugin) {
1883 local $dlfunc = "delete_${dt}_database_user";
1884 &$dlfunc($_[2], $_[1]->{'user'});
1885 }
1886 else {
1887 &plugin_call($dt, "database_delete_user",
1888 $_[2], $_[1]->{'user'});
1889 }
1890 }
1891 }
1892 }
1893
1894# Rename user in secondary groups, and update membership
1895local @groups = &list_all_groups();
1896local %secs = map { $_, 1 } @{$_[0]->{'secs'}};
1897local @sgroups = &allowed_secondary_groups($_[2]);
1898foreach my $group (@groups) {
1899 local @mems = split(/,/, $group->{'members'});
1900 local $idx = &indexof($_[1]->{'user'}, @mems);
1901 local $changed;
1902 if ($idx >= 0) {
1903 # User is currently in group
1904 if ($_[0]->{'user'} ne $_[1]->{'user'}) {
1905 # Just rename in group, if needed
1906 $changed = 1;
1907 $mems[$idx] = $_[0]->{'user'};
1908 }
1909 elsif (!$secs{$group->{'group'}}) {
1910 # Remove from group, if this is a secondary managed
1911 # by Virtualmin
1912 if (&indexof($group->{'group'}, @sgroups) >= 0) {
1913 splice(@mems, $idx, 1);
1914 $changed = 1;
1915 }
1916 }
1917 }
1918 elsif ($secs{$group->{'group'}}) {
1919 # User is not in group, but needs to be
1920 push(@mems, $_[0]->{'user'});
1921 $changed = 1;
1922 }
1923 if ($changed) {
1924 # Only save group if members were changed
1925 $group->{'members'} = join(",", @mems);
1926 &foreign_call($group->{'module'}, "modify_group",
1927 $group, $group);
1928 }
1929 }
1930
1931# Update mail/FTP/db groups
1932&update_secondary_groups($_[2]) if ($_[2]);
1933
1934# Update spamassassin whitelist
1935if ($_[2]) {
1936 &obtain_lock_spam($_[2]);
1937 &update_spam_whitelist($_[2]);
1938 &release_lock_spam($_[2]);
1939 }
1940
1941# Update the no-spam-check flag
1942if ($_[2]) {
1943 if (!-d $nospam_dir) {
1944 mkdir($nospam_dir, 0700);
1945 }
1946 if (defined($_[0]->{'nospam'})) {
1947 local %nospam;
1948 &read_file_cached("$nospam_dir/$_[2]->{'id'}", \%nospam);
1949 if ($_[0]->{'user'} ne $_[1]->{'user'}) {
1950 delete($nospam{$_[1]->{'user'}});
1951 }
1952 $nospam{$_[0]->{'user'}} = $_[0]->{'nospam'};
1953 &write_file("$nospam_dir/$_[2]->{'id'}", \%nospam);
1954 }
1955 }
1956
1957# Update the last logins file
1958if ($_[0]->{'user'} ne $_[1]->{'user'}) {
1959 &lock_file($mail_login_file);
1960 my %logins;
1961 &read_file_cached($mail_login_file, \%logins);
1962 if ($logins{$_[1]->{'user'}}) {
1963 $logins{$_[1]->{'user'}} = $logins{$_[1]->{'user'}};
1964 delete($logins{$_[1]->{'user'}});
1965 &write_file($mail_login_file, \%logins);
1966 }
1967 &unlock_file($mail_login_file);
1968 }
1969
1970# Clear quota cache for this user
1971if (defined(&clear_lookup_domain_cache) && $_[2]) {
1972 &clear_lookup_domain_cache($_[2], $_[0]);
1973 }
1974
1975# Set the user's Usermin IMAP password
1976if ($_[0]->{'email'} || @{$_[0]->{'extraemail'}}) {
1977 &set_usermin_imap_password($_[0]);
1978 }
1979
1980# Save the recovery address
1981&set_usermin_recovery_address($_[0]);
1982
1983# Update cache of existing usernames
1984if ($_[0]->{'user'} ne $_[1]->{'user'}) {
1985 $unix_user{&escape_alias($_[0]->{'user'})}++;
1986 $unix_user{&escape_alias($_[1]->{'user'})} = 0;
1987 }
1988
1989if ($_[0]->{'shell'} ne $_[1]->{'shell'}) {
1990 # Rebuild denied user list, by shell
1991 &build_denied_ssh_group();
1992 }
1993
1994# Rebuild group of domain owners
1995if ($_[0]->{'domainowner'}) {
1996 &update_domain_owners_group();
1997 }
1998
1999# Create everyone file for domain
2000if ($_[2] && $_[2]->{'mail'}) {
2001 &create_everyone_file($_[2]);
2002 }
2003}
2004
2005# delete_user(&user, &domain)
2006# Delete a mailbox user and all associated virtusers and aliases
2007sub delete_user
2008{
2009# Zero out his quotas
2010if ($_[0]->{'unix'} && !$_[0]->{'noquota'}) {
2011 &set_user_quotas($_[0]->{'user'}, 0, 0, $_[1]);
2012 }
2013
2014# Delete any of his cron jobs
2015if ($_[0]->{'unix'}) {
2016 &delete_unix_cron_jobs($_[0]->{'user'});
2017 }
2018
2019if ($_[0]->{'qmail'}) {
2020 # Delete user in Qmail LDAP
2021 local $ldap = &connect_qmail_ldap();
2022 local $rv = $ldap->delete($_[0]->{'dn'});
2023 &error($rv->error) if ($rv->code);
2024 $ldap->unbind();
2025 }
2026elsif ($_[0]->{'vpopmail'}) {
2027 # Call VPOPMail delete user program
2028 local $quser = quotemeta($_[0]->{'user'});
2029 local $qdom = $_[1]->{'dom'};
2030 local $cmd = "$vpopbin/vdeluser $quser\@$qdom";
2031 local $out = &backquote_logged("$cmd 2>&1");
2032 if ($?) {
2033 &error("<tt>$cmd</tt> failed: <pre>$out</pre>");
2034 }
2035 }
2036else {
2037 # Delete Unix user
2038 $_[0]->{'user'} eq 'root' && &error("Cannot delete root user!");
2039 $_[0]->{'uid'} == 0 && &error("Cannot delete UID 0 user!");
2040 &require_useradmin();
2041 &require_mail();
2042
2043 # Delete the user
2044 &foreign_call($usermodule, "set_user_envs", $_[0], 'DELETE_USER');
2045 &set_virtualmin_user_envs($_[0], $_[1]);
2046 &foreign_call($usermodule, "making_changes");
2047 &foreign_call($usermodule, "delete_user", $_[0]);
2048 &foreign_call($usermodule, "made_changes");
2049
2050 # Record the old UID to prevent re-use
2051 &record_old_uid($_[0]->{'uid'});
2052 }
2053
2054if ($config{'mail_system'} == 0 && $_[0]->{'user'} =~ /\@/) {
2055 # Find the Unix user with the @ escaped and delete it too
2056 local $esc = &replace_atsign($_[0]->{'user'});
2057 local @allusers = &list_all_users_quotas(1);
2058 local ($extrauser) = grep { $_->{'user'} eq $esc } @allusers;
2059 if ($extrauser) {
2060 &foreign_call($usermodule, "set_user_envs", $extrauser, 'DELETE_USER');
2061 &set_virtualmin_user_envs($_[0], $_[1]);
2062 &foreign_call($usermodule, "making_changes");
2063 &foreign_call($usermodule, "delete_user", $extrauser);
2064 &foreign_call($usermodule, "made_changes");
2065 }
2066 }
2067
2068if (!$_[0]->{'qmail'}) {
2069 # Delete any virtusers (extra email addresses for this user)
2070 &delete_virtuser($_[0]->{'virt'}) if ($_[0]->{'virt'});
2071 local $e;
2072 foreach $e (@{$_[0]->{'extravirt'}}) {
2073 &delete_virtuser($e);
2074 }
2075 }
2076
2077if (!$_[0]->{'qmail'}) {
2078 # Delete his alias (for forwarding), if any
2079 if ($_[0]->{'alias'}) {
2080 if ($config{'mail_system'} == 1) {
2081 # Delete Sendmail alias with same name as user
2082 if (!$_[0]->{'alias'}->{'deleted'}) {
2083 &lock_file($_[0]->{'alias'}->{'file'});
2084 &sendmail::delete_alias($_[0]->{'alias'});
2085 &unlock_file($_[0]->{'alias'}->{'file'});
2086 $_[0]->{'alias'}->{'deleted'} = 1;
2087 }
2088 }
2089 elsif ($config{'mail_system'} == 0) {
2090 # Delete Postfix alias with same name as user
2091 if (!$_[0]->{'alias'}->{'deleted'}) {
2092 &lock_file($_[0]->{'alias'}->{'file'});
2093 &$postfix_delete_alias($_[0]->{'alias'});
2094 &unlock_file($_[0]->{'alias'}->{'file'});
2095 &postfix::regenerate_aliases();
2096 $_[0]->{'alias'}->{'deleted'} = 1;
2097 }
2098 }
2099 elsif ($config{'mail_system'} == 2 ||
2100 $config{'mail_system'} == 5) {
2101 # .qmail will be deleted when user is
2102 }
2103 }
2104
2105 if ($config{'generics'} && $_[0]->{'generic'}) {
2106 # Delete genericstable entry too
2107 &delete_generic($_[0]->{'generic'});
2108 }
2109 }
2110
2111# Delete database access (unless this is the domain owner)
2112if ($_[1] && !$_[0]->{'domainowner'}) {
2113 local $dt;
2114 foreach $dt (&unique(map { $_->{'type'} } &domain_databases($_[1]))) {
2115 local @dbs = map { $_->{'name'} }
2116 grep { $_->{'type'} eq $dt } @{$_[0]->{'dbs'}};
2117 if (@dbs && &indexof($dt, &list_database_plugins()) < 0) {
2118 # Delete from core database
2119 local $dlfunc = "delete_${dt}_database_user";
2120 &$dlfunc($_[1], $_[0]->{'user'});
2121 }
2122 elsif (@dbs && &indexof($dt, &list_database_plugins()) >= 0) {
2123 # Delete from plugin database
2124 &plugin_call($dt, "delete_database_user",
2125 $_[1], $_[0]->{'user'});
2126 }
2127 }
2128 }
2129
2130# Take the user out of any secondary groups
2131local @groups = &list_all_groups();
2132foreach my $group (@groups) {
2133 local @mems = split(/,/, $group->{'members'});
2134 local $idx = &indexof($_[0]->{'user'}, @mems);
2135 if ($idx >= 0) {
2136 splice(@mems, $idx, 1);
2137 $group->{'members'} = join(",", @mems);
2138 &foreign_call($group->{'module'}, "modify_group",
2139 $group, $group);
2140 }
2141 }
2142
2143# Update mail/FTP/db groups to remove user
2144&update_secondary_groups($_[1]) if ($_[1]);
2145
2146# Update spamassassin whitelist
2147if ($_[1]) {
2148 &obtain_lock_spam($_[1]);
2149 &update_spam_whitelist($_[1]);
2150 &release_lock_spam($_[1]);
2151 }
2152
2153# Remove the plain-text password
2154local %plain;
2155if (!-d $plainpass_dir) {
2156 mkdir($plainpass_dir, 0700);
2157 }
2158&read_file_cached("$plainpass_dir/$_[1]->{'id'}", \%plain);
2159delete($plain{$_[0]->{'user'}});
2160delete($plain{$_[0]->{'user'}." encrypted"});
2161&write_file("$plainpass_dir/$_[1]->{'id'}", \%plain);
2162
2163# Remove the hashed password
2164local %hash;
2165if (!-d $hashpass_dir) {
2166 mkdir($hashpass_dir, 0700);
2167 }
2168&read_file_cached("$hashpass_dir/$_[1]->{'id'}", \%hash);
2169foreach my $s (@hashpass_types) {
2170 delete($hash{$_[0]->{'user'}.' '.$s});
2171 }
2172&write_file("$hashpass_dir/$_[1]->{'id'}", \%hash);
2173
2174# Clear the no-spam flag
2175local %spam;
2176if (!-d $nospam_dir) {
2177 mkdir($nospam_dir, 0700);
2178 }
2179&read_file_cached("$nospam_dir/$_[1]->{'id'}", \%spam);
2180delete($spam{$_[0]->{'user'}});
2181&write_file("$nospam_dir/$_[1]->{'id'}", \%spam);
2182
2183# Update cache of existing usernames
2184$unix_user{&escape_alias($_[0]->{'user'})} = 0;
2185
2186# Delete from last logins file
2187&lock_file($mail_login_file);
2188my %logins;
2189&read_file_cached($mail_login_file, \%logins);
2190if ($logins{$_[0]->{'user'}}) {
2191 delete($logins{$_[0]->{'user'}});
2192 &write_file($mail_login_file, \%logins);
2193 }
2194&unlock_file($mail_login_file);
2195
2196# Create everyone file for domain, minus the user
2197if ($_[1] && $_[1]->{'mail'}) {
2198 &create_everyone_file($_[1]);
2199 }
2200
2201&sync_alias_virtuals($_[1]);
2202}
2203
2204# set_usermin_imap_password(&user)
2205# If Usermin is setup to use an IMAP inbox on localhost, set this user's
2206# IMAP password
2207sub set_usermin_imap_password
2208{
2209local ($user) = @_;
2210return 0 if (!$user->{'unix'} || !$user->{'home'});
2211return 0 if (!$user->{'plainpass'});
2212
2213# Make sure Usermin is installed, and the mailbox module is setup for IMAP
2214return 0 if (!&foreign_check("usermin"));
2215&foreign_require("usermin");
2216return 0 if (!&usermin::get_usermin_module_info("mailbox"));
2217local %mconfig;
2218&read_file("$usermin::config{'usermin_dir'}/mailbox/config", \%mconfig);
2219return 0 if ($mconfig{'mail_system'} != 4);
2220return 0 if ($mconfig{'pop3_server'} ne '' &&
2221 $mconfig{'pop3_server'} ne 'localhost' &&
2222 $mconfig{'pop3_server'} ne '127.0.0.1' &&
2223 &to_ipaddress($mconfig{'pop3_server'}) ne &to_ipaddress(&get_system_hostname()));
2224
2225# Set the password
2226&create_usermin_module_directory($user, "mailbox");
2227if (-d "$user->{'home'}/.usermin/mailbox") {
2228 local %inbox;
2229 local $imapfile = "$user->{'home'}/.usermin/mailbox/inbox.imap";
2230 &read_file($imapfile, \%inbox);
2231 if (&usermin::get_usermin_version() >= 1.323) {
2232 $inbox{'user'} = '*';
2233 }
2234 else {
2235 $inbox{'user'} = $user->{'user'};
2236 }
2237 $inbox{'pass'} = $user->{'plainpass'};
2238 $inbox{'nologout'} = 1;
2239 eval {
2240 # Ignore errors here, in case user is over quota
2241 local $main::error_must_die = 1;
2242 &write_as_mailbox_user($user,
2243 sub { &write_file($imapfile, \%inbox);
2244 &set_ownership_permissions(undef, undef,
2245 $imapfile, 0600) });
2246 };
2247 }
2248}
2249
2250# create_usermin_module_directory(&user, module)
2251# Creates the Usermin config directories for a user
2252sub create_usermin_module_directory
2253{
2254my ($user, $mod) = @_;
2255foreach my $dir ($user->{'home'}, "$user->{'home'}/.usermin", "$user->{'home'}/.usermin/$mod") {
2256 next if ($user->{'webowner'} && $dir eq $user->{'home'});
2257 next if ($user->{'domainowner'} && $dir eq $user->{'home'});
2258 if (!-e $dir) {
2259 if ($dir eq $user->{'home'}) {
2260 &make_dir($dir, 0700);
2261 &set_ownership_permissions(
2262 $user->{'uid'}, $user->{'gid'}, 0700, $dir);
2263 }
2264 else {
2265 &write_as_mailbox_user($user,
2266 sub { &make_dir($dir, 0700);
2267 &set_ownership_permissions(undef, undef,
2268 0700, $dir) });
2269 }
2270 }
2271 }
2272}
2273
2274# set_usermin_recovery_address(&user)
2275# Updates the password recovery file for a user
2276sub set_usermin_recovery_address
2277{
2278my ($user) = @_;
2279return 0 if (!$user->{'unix'} || !$user->{'home'});
2280&create_usermin_module_directory($user, "changepass");
2281if (-d "$user->{'home'}/.usermin/changepass") {
2282 my $rfile = "$user->{'home'}/.usermin/changepass/recovery";
2283 eval {
2284 # Ignore errors here, in case user is over quota
2285 local $main::error_must_die = 1;
2286 &write_as_mailbox_user($user,
2287 sub { open(RECOVERY, ">$rfile");
2288 if ($user->{'recovery'}) {
2289 print RECOVERY $user->{'recovery'},"\n";
2290 }
2291 close(RECOVERY);
2292 &set_ownership_permissions(undef, undef,
2293 $rfile, 0600) });
2294 };
2295 return 1;
2296 }
2297return 0;
2298}
2299
2300# delete_unix_cron_jobs(username)
2301# Delete all Cron jobs belonging to some Unix user
2302sub delete_unix_cron_jobs
2303{
2304local ($username) = @_;
2305&foreign_require("cron");
2306local @jobs = &cron::list_cron_jobs();
2307local $cronfile;
2308foreach my $j (@jobs) {
2309 if ($j->{'user'} eq $username) {
2310 $cronfile ||= &cron::cron_file($j);
2311 &lock_file($cronfile);
2312 &cron::delete_cron_job($j);
2313 }
2314 }
2315if ($cron::config{'cron_dir'} && $username) {
2316 # Make sure file is gone
2317 &unlink_file($cron::config{'cron_dir'}."/".$username);
2318 }
2319&unlock_file($cronfile) if ($cronfile);
2320}
2321
2322# rename_unix_cron_jobs(username, oldusername)
2323# Change the name of the user who owns any cron jobs
2324sub rename_unix_cron_jobs
2325{
2326local ($username, $oldusername) = @_;
2327return if ($username eq $oldusername);
2328&foreign_require("cron");
2329if (-r "$cron::config{'cron_dir'}/$oldusername") {
2330 # Rename user's crontab directory file
2331 &rename_logged("$cron::config{'cron_dir'}/$oldusername",
2332 "$cron::config{'cron_dir'}/$username");
2333 }
2334# Rename jobs in other files
2335local @jobs = &cron::list_cron_jobs();
2336local $cronfile;
2337foreach my $j (@jobs) {
2338 if ($j->{'user'} eq $oldusername) {
2339 $cronfile ||= &cron::cron_file($j);
2340 &lock_file($cronfile);
2341 $j->{'user'} = $username;
2342 &cron::change_cron_job($j);
2343 }
2344 }
2345&unlock_file($cronfile) if ($cronfile);
2346}
2347
2348# copy_unix_cron_jobs(username, oldusername)
2349# Duplicate all cron jobs for some domain user
2350sub copy_unix_cron_jobs
2351{
2352local ($username, $oldusername) = @_;
2353return if ($username eq $oldusername);
2354&foreign_require("cron");
2355local @jobs = &cron::list_cron_jobs();
2356foreach my $j (@jobs) {
2357 if ($j->{'user'} eq $oldusername) {
2358 local $newj = { %$j };
2359 $newj->{'user'} = $username;
2360 &cron::create_cron_job($newj);
2361 }
2362 }
2363}
2364
2365# disable_unix_cron_jobs(username)
2366# Disable all Cron jobs belonging to some Unix user
2367sub disable_unix_cron_jobs
2368{
2369local ($username) = @_;
2370&foreign_require("cron");
2371local @jobs = &cron::list_cron_jobs();
2372local $cronfile;
2373foreach my $j (@jobs) {
2374 if ($j->{'user'} eq $username && $j->{'active'} && !$j->{'name'}) {
2375 $cronfile ||= &cron::cron_file($j);
2376 &lock_file($cronfile);
2377 $j->{'active'} = 0;
2378 if ($j->{'command'} !~ /#\s+VIRTUALMIN\s+DISABLE/) {
2379 $j->{'command'} .= " # VIRTUALMIN DISABLE";
2380 }
2381 &cron::change_cron_job($j);
2382 }
2383 }
2384&unlock_file($cronfile) if ($cronfile);
2385}
2386
2387# enable_unix_cron_jobs(username)
2388# Enable all Cron jobs belonging to some Unix user
2389sub enable_unix_cron_jobs
2390{
2391local ($username) = @_;
2392&foreign_require("cron");
2393local @jobs = &cron::list_cron_jobs();
2394local $cronfile;
2395foreach my $j (@jobs) {
2396 if ($j->{'user'} eq $username && !$j->{'active'} && !$j->{'name'} &&
2397 $j->{'command'} =~ /#\s+VIRTUALMIN\s+DISABLE/) {
2398 $cronfile ||= &cron::cron_file($j);
2399 &lock_file($cronfile);
2400 $j->{'active'} = 1;
2401 $j->{'command'} =~ s/\s+#\s+VIRTUALMIN\s+DISABLE//g;
2402 &cron::change_cron_job($j);
2403 }
2404 }
2405&unlock_file($cronfile) if ($cronfile);
2406}
2407
2408# validate_user(&domain, &user, [&olduser])
2409# Called before a user is saved, to validate it. Must return undef on success,
2410# or an error message on failure
2411sub validate_user
2412{
2413local ($d, $user, $old) = @_;
2414if ($d && @{$user->{'dbs'}} && (!$old || !@{$old->{'dbs'}})) {
2415 # Enabling database access .. make sure a password was given
2416 if (!$user->{'plainpass'} && !$user->{'pass_mysql'}) {
2417 return $text{'user_edbpass'};
2418 }
2419 # Check for username clash
2420 foreach my $dt (&unique(map { $_->{'type'} } &domain_databases($d))) {
2421 local $cfunc = "check_".$dt."_user_clash";
2422 next if (!defined(&$cfunc));
2423 local $ufunc = $dt."_username";
2424 if (&$cfunc($d, &$ufunc($user->{'user'}))) {
2425 # Found a clash!
2426 return $text{'user_edbclash'};
2427 }
2428 }
2429 }
2430return undef;
2431}
2432
2433# set_user_quotas(username, home-quota, mail-quota, [&domain])
2434# Sets the quotas for a mailbox user
2435sub set_user_quotas
2436{
2437local $tmpl = &get_template($_[3] ? $_[3]->{'template'} : 0);
2438if (&has_quota_commands()) {
2439 # Call the external quota program
2440 &run_quota_command("set_user", $_[0],
2441 $tmpl->{'quotatype'} eq 'hard' ? ( int($_[1]), int($_[1]) )
2442 : ( int($_[1]), 0 ));
2443 }
2444else {
2445 # Call through to quotas module
2446 if (&has_home_quotas()) {
2447 &set_quota($_[0], $config{'home_quotas'}, $_[1],
2448 $tmpl->{'quotatype'} eq 'hard');
2449 }
2450 if (&has_mail_quotas()) {
2451 &set_quota($_[0], $config{'mail_quotas'}, $_[2],
2452 $tmpl->{'quotatype'} eq 'hard');
2453 }
2454 }
2455}
2456
2457# run_quota_command(config-suffix, arg, ...)
2458# Run some external quota set/get command. On failure calls error, otherwise
2459# returns the output.
2460sub run_quota_command
2461{
2462local ($cfg, @args) = @_;
2463local $cmd = $config{'quota_'.$cfg.'_command'}." ".
2464 join(" ", map { quotemeta($_) } @args);
2465local $out = &backquote_logged("$cmd 2>&1 </dev/null");
2466if ($?) {
2467 &error(&text('equotacommand', "<tt>$cmd</tt>",
2468 "<pre>".&html_escape($out)."</pre>"));
2469 }
2470else {
2471 return $out;
2472 }
2473}
2474
2475# encrypt_user_password(&user, text)
2476# Given a plain text password, returns a suitable encrypted form for
2477# a mailbox user.
2478sub encrypt_user_password
2479{
2480&require_useradmin();
2481local ($user, $pass) = @_;
2482if ($user->{'qmail'}) {
2483 # Force crypt mode for Qmail+LDAP
2484 local $salt = $user->{'pass'} || &random_salt();
2485 $salt =~ s/^\!//;
2486 return &unix_crypt($pass, $salt);
2487 }
2488else {
2489 local $salt = $user->{'pass'};
2490 $salt =~ s/^\!//;
2491 return &foreign_call($usermodule, "encrypt_password", $pass, $salt);
2492 }
2493}
2494
2495# generate_password_hashes(&user, text, &domain)
2496# Given a password, returns a hash ref of it hashed into different formats.
2497# Keys returned are :
2498# md5 - MD5 hash
2499# crypt - Unix crypt
2500# unix - Appropriate hash for Unix user
2501# mysql - MySQL password hash
2502# digest - Web digest authentication hash
2503sub generate_password_hashes
2504{
2505local ($user, $pass, $d) = @_;
2506local $tmpl = &get_template($d->{'template'});
2507if ($tmpl->{'hashtypes'} eq 'none') {
2508 # Don't return any hash types
2509 return { };
2510 }
2511&require_useradmin();
2512local %rv;
2513local $salt = $user->{'pass'} && $user->{'pass'} !~ /\$/ ? $user->{'pass'}
2514 : &random_salt();
2515$salt =~ s/^\!// if ($salt);
2516$rv{'crypt'} = &unix_crypt($pass, $salt);
2517if (!&useradmin::check_md5()) {
2518 local $salt = $user->{'pass'} &&
2519 $user->{'pass'} =~ /\$1\$/ ? $user->{'pass'} : undef;
2520 $salt =~ s/^\!// if ($salt);
2521 $rv{'md5'} = &useradmin::encrypt_md5($pass);
2522 }
2523$rv{'unix'} = &encrypt_user_password($user, $pass);
2524if ($config{'mysql'}) {
2525 &require_mysql();
2526 local $qpass = &mysql_escape($pass);
2527 local $d = &mysql::execute_sql_safe($mysql::master_db,
2528 "select $password_func('$qpass')");
2529 $rv{'mysql'} = $d->{'data'}->[0]->[0];
2530 }
2531if (&foreign_check("htaccess-htpasswd")) {
2532 &foreign_require("htaccess-htpasswd");
2533 $rv{'digest'} = &htaccess_htpasswd::digest_password(
2534 $user->{'user'}, $d->{'dom'}, $pass);
2535 }
2536if ($tmpl->{'hashtypes'} ne '' && $tmpl->{'hashtypes'} ne '*') {
2537 # Remove disabled types
2538 local %newrv;
2539 foreach my $t (split(/\s+/, $tmpl->{'hashtypes'})) {
2540 $newrv{$t} = $rv{$t} if (defined($rv{$t}));
2541 }
2542 return \%newrv;
2543 }
2544else {
2545 # Just return all types
2546 return \%rv;
2547 }
2548}
2549
2550# list_password_hash_types()
2551# Returns a list of all supported hashing types and their descriptions
2552sub list_password_hash_types
2553{
2554return ( map { [ $_, $text{'hashtype_'.$_} ] } @hashpass_types );
2555}
2556
2557# generate_domain_password_hashes(&domain, new-domain?)
2558# Updates a domain object with the appropriate password hash fields. For use
2559# when creating a new domain.
2560sub generate_domain_password_hashes
2561{
2562local ($d, $newdom) = @_;
2563local $parent = $d->{'parent'} ? &get_domain($d->{'parent'}) : undef;
2564if ($newdom) {
2565 if ($parent) {
2566 # Inherit from parent
2567 $d->{'hashpass'} ||= $parent->{'hashpass'};
2568 }
2569 else {
2570 # Inherit from template
2571 local $tmpl = &get_template($d->{'template'});
2572 $d->{'hashpass'} ||= $tmpl->{'hashpass'};
2573 }
2574 }
2575return if (!$d->{'hashpass'}); # Hashing disabled
2576if ($d->{'parent'}) {
2577 # Just copy from parent
2578 $parent = &get_domain($d->{'parent'});
2579 foreach my $k ('enc_pass', 'mysql_enc_pass', 'crypt_enc_pass',
2580 'md5_enc_pass', 'digest_enc_pass') {
2581 $d->{$k} = $parent->{$k};
2582 }
2583 }
2584else {
2585 # Hash and store
2586 return if (!$d->{'pass'}); # Plaintext password unknown
2587 local $fakeuinfo = { 'user' => $d->{'user'} };
2588 local $hashes = &generate_password_hashes(
2589 $fakeuinfo, $d->{'pass'}, $d);
2590 $d->{'enc_pass'} = $hashes->{'unix'};
2591 if (!$d->{'mysql_pass'}) {
2592 $d->{'mysql_enc_pass'} = $hashes->{'mysql'};
2593 }
2594 $d->{'crypt_enc_pass'} = $hashes->{'crypt'};
2595 $d->{'md5_enc_pass'} = $hashes->{'md5'};
2596 $d->{'digest_enc_pass'} = $hashes->{'digest'};
2597 }
2598$d->{'hashpass'} = 1;
2599delete($d->{'pass'});
2600}
2601
2602# create_user_home(&uinfo, &domain, always-chown)
2603# Creates the home directory for a new mail user, and copies skel files into it
2604sub create_user_home
2605{
2606local ($user, $d, $always) = @_;
2607local $home = $user->{'home'};
2608if ($home) {
2609 # Create his homedir
2610 local @st = $d ? stat($d->{'home'}) : ( undef, undef, 0755 );
2611 if (!-e $home || $always) {
2612 &lock_file($home);
2613 &make_dir($home, $st[2] & 0777);
2614 &set_ownership_permissions($user->{'uid'}, $user->{'gid'},
2615 $st[2] & 0777, $home);
2616 &system_logged("chown -R $user->{'uid'}:$user->{'gid'} ".
2617 quotemeta($home));
2618 &unlock_file($home);
2619 }
2620
2621 # Copy files into homedir. Don't die if this fails for quota issues
2622 eval {
2623 local $main::error_must_die = 1;
2624 ©_skel_files(
2625 &substitute_domain_template($config{'mail_skel'}, $d),
2626 $user, $home);
2627 };
2628 }
2629}
2630
2631# delete_user_home(&user, &domain)
2632# Deletes the home directory of a user, if valid
2633sub delete_user_home
2634{
2635local ($user, $d) = @_;
2636if ($user->{'unix'} && -d $user->{'home'} && $user->{'home'} ne "/") {
2637 &system_logged("rm -rf ".quotemeta($user->{'home'}));
2638 }
2639}
2640
2641# domain_title(&domain)
2642sub domain_title
2643{
2644print "<center><font size=+1>",&domain_in($_[0]),"</font></center>\n";
2645}
2646
2647# domain_in(&domain)
2648sub domain_in
2649{
2650return &text('indom', "<tt>".&show_domain_name($_[0])."</tt>");
2651}
2652
2653# copy_skel_files(basedir, &user, home, [group], [&for-domain])
2654# Copy files to the home directory of some new user
2655sub copy_skel_files
2656{
2657local ($uf, $user, $home, $group, $d) = @_;
2658return if (!$uf);
2659
2660# Find all files under the skeleton dir
2661my @files = &find_skel_files($uf);
2662my @copied;
2663foreach my $f (@files) {
2664 local $src = "$uf/$f"; # Needs to be local, for subs
2665 local $dst = "$home/$f";
2666 my $func;
2667
2668 # Get file info as root before copying
2669 local @st = stat($src);
2670 local $data;
2671 if (-f $src) {
2672 $data = &read_file_contents($src);
2673 }
2674 local $lnk = readlink($src);
2675
2676 if (-l $src) {
2677 # Re-create symlink
2678 $func = sub { &symlink_file($lnk, $dst) };
2679 }
2680 elsif (-d $src) {
2681 # Re-create directory
2682 $func = sub { $st[2] ||= 0755;
2683 &make_dir($dst, $st[2] & 07777) };
2684 }
2685 else {
2686 # Copy file contents
2687 $func = sub { return if (!defined($data));
2688 &open_tempfile(SKEL, ">$dst", 0, 1);
2689 &print_tempfile(SKEL, $data);
2690 &close_tempfile(SKEL);
2691 &set_ownership_permissions(
2692 undef, undef, $st[2], $dst) };
2693 }
2694 if ($user) {
2695 &write_as_mailbox_user($user, $func);
2696 }
2697 else {
2698 &$func();
2699 }
2700 push(@copied, $dst);
2701 }
2702
2703# Perform variable substition on the files, if requested
2704if ($d) {
2705 local $tmpl = &get_template($d->{'template'});
2706 if ($tmpl->{'skel_subs'}) {
2707 foreach my $c (@copied) {
2708 if (-r $c && !-d $c && !-l $c &&
2709 (!$tmpl->{'skel_onlysubs'} ||
2710 &match_skel_subs($c, $tmpl->{'skel_onlysubs'})) &&
2711 !&match_skel_subs($c, $tmpl->{'skel_nosubs'}) &&
2712 &guess_mime_type($c) !~ /^image\//) {
2713 local $data =
2714 &read_file_contents_as_domain_user($d, $c);
2715 &open_tempfile_as_domain_user($d, OUT, ">$c");
2716 &print_tempfile(OUT,
2717 &substitute_domain_template($data, $d));
2718 &close_tempfile_as_domain_user($d, OUT);
2719 }
2720 }
2721 }
2722 }
2723}
2724
2725# match_skel_subs(path, nosubs-list)
2726# Returns 1 if some filename matches the space-separated list of patterns given
2727sub match_skel_subs
2728{
2729my ($path, $nosubs_str) = @_;
2730return 0 if ($nosubs_str !~ /\S/);
2731my @nosubs = &split_quoted_string($nosubs_str);
2732foreach my $ns (@nosubs) {
2733 $path =~ /^(\S+)\/([^\/]+)$/ || next;
2734 my ($dir, $file) = ($1, $2);
2735 my @matches = glob("$dir/$ns");
2736 if (&indexof($path, @matches) >= 0) {
2737 return 1;
2738 }
2739 }
2740return 0;
2741}
2742
2743# find_skel_files(dir)
2744# Given a directory, recursively finds all files and directories under it and
2745# returns their relative paths
2746sub find_skel_files
2747{
2748my ($dir) = @_;
2749opendir(SKELDIR, $dir);
2750my @files = grep { $_ ne '.' && $_ ne '..' } readdir(SKELDIR);
2751closedir(SKELDIR);
2752my @rv;
2753foreach my $f (@files) {
2754 my $path = "$dir/$f";
2755 if (-l $path || !-d $path) {
2756 push(@rv, $f);
2757 }
2758 elsif (-d $path) {
2759 push(@rv, $f);
2760 push(@rv, map { "$f/$_" } &find_skel_files($path));
2761 }
2762 }
2763return @rv;
2764}
2765
2766# can_edit_domain(&domain)
2767# Returns 1 if the current user can edit some domain (ie. change users, aliases
2768# databases, and so on)
2769sub can_edit_domain
2770{
2771if ($access{'reseller'}) {
2772 # User is a reseller .. is this one of his domains?
2773 if ($_[0]->{'parent'}) {
2774 # Parent domain permissions apply
2775 return &can_edit_domain(&get_domain($_[0]->{'parent'}));
2776 }
2777 else {
2778 return &indexof($base_remote_user,
2779 split(/\s+/, $_[0]->{'reseller'})) >= 0;
2780 }
2781 }
2782else {
2783 return 1 if ($access{'domains'} eq "*");
2784 return 0 if (!$_[0]->{'id'});
2785 local $d;
2786 foreach $d (split(/\s+/, $access{'domains'})) {
2787 return 1 if ($d eq $_[0]->{'id'});
2788 }
2789 return 0;
2790 }
2791}
2792
2793# can_delete_domain(&domain)
2794sub can_delete_domain
2795{
2796local ($d) = @_;
2797return &can_edit_domain($d) &&
2798 (&master_admin() || &reseller_admin() ||
2799 $_[0]->{'parent'} && $access{'edit_delete'});
2800}
2801
2802# can_associate_domain(&domain)
2803# Only the master admin is allowed to disconnect or connect features
2804sub can_associate_domain
2805{
2806return &master_admin();
2807}
2808
2809sub can_move_domain
2810{
2811local ($d) = @_;
2812return &can_edit_domain($d) &&
2813 (&master_admin() || &reseller_admin());
2814}
2815
2816sub can_transfer_domain
2817{
2818return &master_admin();
2819}
2820
2821# Returns 1 if the current user is the master Virtualmin admin
2822sub master_admin
2823{
2824return !$access{'noconfig'};
2825}
2826
2827# Returns 1 if the current user is a reseller
2828sub reseller_admin
2829{
2830return $access{'reseller'};
2831}
2832
2833# Returns the domain ID if the current user is an extra admin
2834sub extra_admin
2835{
2836return $access{'admin'};
2837}
2838
2839# Returns 1 if the current user can stop and start servers
2840sub can_stop_servers
2841{
2842return $access{'stop'};
2843}
2844
2845# Returns 1 if templates, plugins, fields, ips and resellers can be edited
2846sub can_edit_templates
2847{
2848return &master_admin();
2849}
2850
2851# Returns 1 if the user can view installed plugins and system status
2852sub can_view_status
2853{
2854return &master_admin();
2855}
2856
2857# Returns 1 if the user can view software versions and other info
2858sub can_view_sysinfo
2859{
2860return 0 if (!$virtualmin_pro);
2861return $config{'show_sysinfo'} == 1 ||
2862 $config{'show_sysinfo'} == 2 && &master_admin() ||
2863 $config{'show_sysinfo'} == 3 && (&master_admin() || &reseller_admin());
2864}
2865
2866# Returns 1 if the user can re-check the licence status
2867sub can_recheck_licence
2868{
2869return 0 if (!$virtualmin_pro);
2870return &master_admin();
2871}
2872
2873# Returns 1 if the user can edit local users
2874sub can_edit_local
2875{
2876return $access{'local'};
2877}
2878
2879# Returns 1 if the user can create new top-level servers or child servers
2880sub can_create_master_servers
2881{
2882return $access{'create'} == 1;
2883}
2884
2885# Returns 1 if the user can create new child servers
2886sub can_create_sub_servers
2887{
2888return $access{'create'};
2889}
2890
2891sub can_create_sub_domains
2892{
2893return 0 if (!&can_create_sub_servers());
2894if ($config{'allow_subdoms'} eq '1') {
2895 return 1;
2896 }
2897elsif ($config{'allow_subdoms'} eq '0') {
2898 return 0;
2899 }
2900else {
2901 local @subdoms = grep { $_->{'subdom'} } &list_domains();
2902 return @subdoms ? 1 : 0;
2903 }
2904}
2905
2906sub can_create_batch
2907{
2908return &master_admin() || &reseller_admin() || $config{'batch_create'};
2909}
2910
2911# Returns 1 if the user can migrate servers from other control panels
2912sub can_migrate_servers
2913{
2914return $access{'import'};
2915}
2916
2917# Returns 1 if the user can import existing servers and databases
2918sub can_import_servers
2919{
2920return $access{'import'};
2921}
2922
2923# Returns 1 if an existing group can be chosen for new domain Unix users
2924sub can_choose_ugroup
2925{
2926return $config{'show_ugroup'} && &master_admin();
2927}
2928
2929# can_use_feature(feature)
2930# Returns 1 if the current user can use some feature at domain creation time,
2931# or enable or disable it for existing domains
2932sub can_use_feature
2933{
2934local ($f) = @_;
2935if (&master_admin()) {
2936 # Master admin can use anything
2937 return 1;
2938 }
2939elsif (&reseller_admin()) {
2940 # Resellers can use features they have been granted, or features
2941 # that are forced on
2942 return $config{$f} == 3 || $access{"feature_".$f};
2943 }
2944else {
2945 # Domain owners can use granted features (but never change the Unix
2946 # account, which will be always on)
2947 if ($f eq 'unix') {
2948 return 0;
2949 }
2950 else {
2951 return $config{$f} == 3 || $access{"feature_".$f};
2952 }
2953 }
2954}
2955
2956# Returns 1 if the current user is allowed to select a private or shared
2957# IP for a virtual server
2958sub can_select_ip
2959{
2960local @shared = &list_shared_ips();
2961return $config{'all_namevirtual'} || &can_use_feature("virt") ||
2962 @shared && &can_edit_sharedips();
2963}
2964
2965# Returns 1 if the current user is allowed to select a private or shared
2966# IPv6 address for a virtual server
2967sub can_select_ip6
2968{
2969local @shared = &list_shared_ip6s();
2970return &can_use_feature("virt6") ||
2971 @shared && &can_edit_sharedips();
2972}
2973
2974# can_edit_limits(&domain)
2975# Returns 1 if owner limits can be edited in some domain
2976sub can_edit_limits
2977{
2978return &master_admin() ||
2979 &reseller_admin() && &can_edit_domain($_[0]);
2980}
2981
2982# can_edit_res(&domain)
2983# Returns 1 if memory / process limits can be edited in some domain
2984sub can_edit_res
2985{
2986return &master_admin() ||
2987 &reseller_admin() && &can_edit_domain($_[0]);
2988}
2989
2990# can_config_domain(&domain)
2991# Returns 1 if the current user can change the settings for a domain (like the
2992# password, real name and so on)
2993sub can_config_domain
2994{
2995return $access{'edit'} && &can_edit_domain($_[0]);
2996}
2997
2998# Returns 1 if the current user can change quotas for an owned domain
2999sub can_edit_quotas
3000{
3001return $access{'edit'} == 1;
3002}
3003
3004# Returns 1 if the current user can rename domains, 2 if he can rename and
3005# select a new username
3006sub can_rename_domains
3007{
3008return $access{'norename'} ? 0 :
3009 &master_admin() || &reseller_admin() ? 2 : 1;
3010}
3011
3012# Returns 1 if the current user can change the home directory of a domain,
3013# 2 if he can change it to anything
3014sub can_rehome_domains
3015{
3016return $access{'norename'} ? 0 :
3017 &master_admin() ? 2 : 1;
3018}
3019
3020sub can_edit_users
3021{
3022return &master_admin() || &reseller_admin() || $access{'edit_users'};
3023}
3024
3025sub can_edit_aliases
3026{
3027return &master_admin() || &reseller_admin() || $access{'edit_aliases'};
3028}
3029
3030# Returns 1 if the current user can edit databases
3031sub can_edit_databases
3032{
3033return &master_admin() || &reseller_admin() || $access{'edit_dbs'};
3034}
3035
3036# Returns 1 if the current user can change this name of his default DB
3037sub can_edit_database_name
3038{
3039return &master_admin() || &reseller_admin() || !$access{'nodbname'};
3040}
3041
3042sub can_edit_admins
3043{
3044local ($d) = @_;
3045return $d->{'webmin'} &&
3046 (&master_admin() || &reseller_admin() || $access{'edit_admins'});
3047}
3048
3049sub can_edit_spam
3050{
3051return &master_admin() || &reseller_admin() || $access{'edit_spam'};
3052}
3053
3054# Returns 2 if all website options can be edited, 1 if only non-suexec related
3055# settings, 0 if nothing
3056sub can_edit_phpmode
3057{
3058return &master_admin() ? 2 :
3059 &reseller_admin() ? 1 :
3060 $access{'edit_phpmode'} ? 1 : 0;
3061}
3062
3063sub can_edit_phpver
3064{
3065return &master_admin() || &reseller_admin() || $access{'edit_phpver'};
3066}
3067
3068sub can_edit_sharedips
3069{
3070return &master_admin() ||
3071 &reseller_admin() && !$access{'nosharedips'} ||
3072 $access{'edit_sharedips'};
3073}
3074
3075sub can_edit_catchall
3076{
3077return &master_admin() || &reseller_admin() || $access{'edit_catchall'};
3078}
3079
3080sub can_edit_html
3081{
3082return &master_admin() || &reseller_admin() || $access{'edit_html'};
3083}
3084
3085sub can_edit_scripts
3086{
3087return &master_admin() || &reseller_admin() || $access{'edit_scripts'};
3088}
3089
3090sub can_unsupported_scripts
3091{
3092return &master_admin();
3093}
3094
3095sub can_edit_forward
3096{
3097return &master_admin() || &reseller_admin() || $access{'edit_forward'};
3098}
3099
3100sub can_edit_redirect
3101{
3102return &master_admin() || &reseller_admin() || $access{'edit_redirect'};
3103}
3104
3105sub can_edit_ssl
3106{
3107return &master_admin() || &reseller_admin() || $access{'edit_ssl'};
3108}
3109
3110sub can_edit_letsencrypt
3111{
3112return &master_admin() ||
3113 &reseller_admin() && $config{'can_letsencrypt'} <= 1 ||
3114 $config{'can_letsencrypt'} == 0;
3115}
3116
3117# Returns 1 if the current user can setup bandwidth limits for a domain
3118sub can_edit_bandwidth
3119{
3120return &master_admin() || &reseller_admin();
3121}
3122
3123# Returns 1 if the current user can see historical system data
3124sub can_show_history
3125{
3126return $virtualmin_pro && &master_admin();
3127}
3128
3129# Returns 1 if the user can change the UI language
3130sub can_change_language
3131{
3132return 1;
3133}
3134
3135sub can_edit_exclude
3136{
3137return !$access{'admin'}; # Any except extra admins
3138}
3139
3140# can_edit_spf(&domain)
3141# Allow master admin, resellers, domain owners with DNS options permissions
3142sub can_edit_spf
3143{
3144local ($d) = @_;
3145return &master_admin() || &reseller_admin() || $access{'edit_spf'};
3146}
3147
3148# can_edit_dmarc(&domain)
3149# Allow master admin, resellers, domain owners with DNS options permissions
3150sub can_edit_dmarc
3151{
3152local ($d) = @_;
3153return &master_admin() || &reseller_admin() || $access{'edit_spf'};
3154}
3155
3156# can_edit_records(&domain)
3157# Allow master admin, resellers, domain owners with DNS records permission
3158sub can_edit_records
3159{
3160local ($d) = @_;
3161return &master_admin() || &reseller_admin() || $access{'edit_records'};
3162}
3163
3164sub can_edit_mail
3165{
3166return &master_admin() || &reseller_admin() || $access{'edit_mail'};
3167}
3168
3169# Returns 1 if the current user can disable and enable the given domain
3170sub can_disable_domain
3171{
3172local ($d) = @_;
3173return &can_edit_domain($d) &&
3174 (&master_admin() || &reseller_admin() ||
3175 $d->{'parent'} && !$d->{'alias'} && $access{'edit_disable'});
3176}
3177
3178# Returns 1 if the configuration can be checked
3179sub can_check_config
3180{
3181return &master_admin();
3182}
3183
3184# Returns 1 if address, autoreply and filter files can be edited
3185sub can_edit_afiles
3186{
3187return $config{'edit_afiles'} || &master_admin();
3188}
3189
3190# can_change_ip(&domain)
3191# Returns 1 if the current user can change the IP of a domain
3192sub can_change_ip
3193{
3194local $tmpl = &get_template($_[0]->{'template'});
3195return &master_admin() ||
3196 $access{'edit_ip'} && &can_use_feature("virt") &&
3197 $tmpl->{'ranges'} ne "none";
3198}
3199
3200# can_mailbox_home(&user)
3201# Returns 1 if the current Webmin user can choose the home directory of some
3202# mailbox user
3203sub can_mailbox_home
3204{
3205local ($user) = @_;
3206return &master_admin() ||
3207 $config{'edit_homes'} == 1 ||
3208 $config{'edit_homes'} == 2 && $user->{'webowner'};
3209}
3210
3211# Returns 1 if the current user can create FTP mailboxes
3212sub can_mailbox_ftp
3213{
3214return &master_admin() || $config{'edit_ftp'};
3215}
3216
3217# Returns 1 if the current user can set the quota for mailboxes
3218sub can_mailbox_quota
3219{
3220return &master_admin() || $config{'edit_quota'};
3221}
3222
3223# can_use_template(&template)
3224# Returns 1 if some template can be used by the current user, or his reseller
3225sub can_use_template
3226{
3227local ($tmpl) = @_;
3228if (&master_admin()) {
3229 # Root can use all templates
3230 return 1;
3231 }
3232if ($tmpl->{'resellers'} ne '*') {
3233 # Template has a reseller restriction, check it
3234 local %resels = map { $_, 1 } split(/\s+/, $tmpl->{'resellers'});
3235 if (&reseller_admin()) {
3236 # Is current user in the reseller list?
3237 return 0 if (!$resels{$base_remote_user});
3238 }
3239 else {
3240 # Is user's reseller in list?
3241 local $dom = &get_domain_by("user", $base_remote_user,
3242 "parent", undef);
3243 if (!($dom && $dom->{'reseller'} &&
3244 $resels{$dom->{'reseller'}})) {
3245 return 0;
3246 }
3247 }
3248 }
3249if ($tmpl->{'owners'} ne '*' && !&reseller_admin()) {
3250 # Template has owner restrictions, check them
3251 local %owners = map { $_, 1 } split(/\s+/, $tmpl->{'owners'});
3252 return 0 if (!$owners{$base_remote_user});
3253 }
3254return 1;
3255}
3256
3257# Returns 1 if the current user can execute remote commands
3258sub can_remote
3259{
3260return &master_admin();
3261}
3262
3263# Returns 1 if the current user can grant extra modules to server owners
3264sub can_webmin_modules
3265{
3266return &master_admin();
3267}
3268
3269# Returns 1 if the current user can change a domain's shell
3270sub can_edit_shell
3271{
3272return &master_admin();
3273}
3274
3275# can_switch_user(&domain, [extra-admin])
3276# Returns 1 if the current user can switch to the Webmin login for some domain
3277sub can_switch_user
3278{
3279local ($d, $admin) = @_;
3280return $virtualmin_pro && # Only Pro supports this
3281 $main::session_id && # When using session auth
3282 !$access{'admin'} && # Not for extra admins
3283 (&master_admin() || # Master can switch, or domain owner to extras
3284 &reseller_admin() && &can_edit_domain($d) ||
3285 $admin && &can_edit_domain($d));
3286}
3287
3288# can_switch_usermin(&domain, &user)
3289# Returns 1 if the current user is allowed to switch to Usermin
3290sub can_switch_usermin
3291{
3292local ($d, $user) = @_;
3293return &can_edit_domain($d) &&
3294 &master_admin() || $config{'usermin_switch'};
3295}
3296
3297# Returns 1 if the user can view mail logs for some domain (or all domains if
3298# none was given). Also returns 0 if mail logs are not enabled.
3299sub can_view_maillog
3300{
3301local ($d) = @_;
3302return 0 if ($config{'maillog_hide'} == 2 ||
3303 $config{'maillog_hide'} == 1 && !&master_admin());
3304return 0 if (!&procmail_logging_enabled());
3305if ($d) {
3306 return &can_edit_domain($d);
3307 }
3308else {
3309 return &master_admin();
3310 }
3311}
3312
3313# Returns 1 if the current user can see the preview website link
3314sub can_use_preview
3315{
3316return $config{'show_preview'} == 2 ||
3317 $config{'show_preview'} == 1 && &master_admin();
3318}
3319
3320# domains_table(&domains, [checkboxes], [return-html], [exclude-cols])
3321# Display a list of domains in a table, with links for editing
3322sub domains_table
3323{
3324local ($doms, $checks, $noprint, $exclude) = @_;
3325$exclude ||= [ ];
3326local %emap = map { $_, 1 } @$exclude;
3327local $usercounts = &count_domain_users();
3328local $aliascounts = &count_domain_aliases(1);
3329local @table_features = grep { $config{$_} } split(/,/, $config{'index_fcols'});
3330local $showchecks = $checks && &can_config_domain($_[0]->[0]);
3331
3332# Generate headers
3333local @heads;
3334if ($showchecks) {
3335 push(@heads, "");
3336 }
3337my @colnames = split(/,/, $config{'index_cols'});
3338if (!@colnames) {
3339 @colnames = ( 'dom', 'user', 'owner', 'users', 'aliases');
3340 }
3341if (!&has_home_quotas()) {
3342 @colnames = grep { $_ ne 'quota' && $_ ne 'uquota' } @colnames;
3343 }
3344@colnames = grep { !$emap{$_} } @colnames;
3345if (!defined(&list_resellers)) {
3346 @colnames = grep { $_ ne 'reseller' } @colnames;
3347 }
3348push(@heads, map { $text{'index_'.$_} } @colnames);
3349foreach my $f (&list_custom_fields()) {
3350 if ($f->{'show'} && ($f->{'visible'} < 2 || &master_admin())) {
3351 push(@colnames, 'field_'.$f->{'name'});
3352 my ($desc, $tip) = split(/;/, $f->{'desc'});
3353 push(@heads, $desc);
3354 }
3355 }
3356push(@heads, map { $text{'index_'.$_} } @table_features);
3357
3358# Generate the table contents
3359local @table;
3360foreach my $d (&sort_indent_domains($doms)) {
3361 $done{$d->{'id'}}++;
3362 local $pfx = " " x ($d->{'indent'} * 2);
3363 local @cols;
3364
3365 # Add configured columns
3366 foreach my $c (@colnames) {
3367 if ($c eq "dom") {
3368 # Domain name, with link
3369 my $prog = &can_config_domain($d) ? "edit_domain.cgi"
3370 : "view_domain.cgi";
3371 my $dn = &shorten_domain_name($d);
3372 $dn = $d->{'disabled'} ? "<i>$dn</i>" : $dn;
3373 my $proxy = $d->{'proxy_pass_mode'} == 2 ?
3374 " <a href='frame_form.cgi?dom=$d->{'id'}'>(F)</a>" :
3375 $d->{'proxy_pass_mode'} == 1 ?
3376 " <a href='proxy_form.cgi?dom=$d->{'id'}'>(P)</a>" :"";
3377 push(@cols, "$pfx<a href='$prog?".
3378 "dom=$d->{'id'}'>$dn</a>$proxy");
3379 }
3380 elsif ($c eq "user") {
3381 # Username
3382 push(@cols, &html_escape($d->{'user'}));
3383 }
3384 elsif ($c eq "owner") {
3385 # Domain description / owner
3386 if ($d->{'alias'}) {
3387 my $aliasdom = &get_domain($d->{'alias'});
3388 my $of = &text('index_aliasof',
3389 $aliasdom->{'dom'});
3390 push(@cols, &html_escape($d->{'owner'} || $of));
3391 }
3392 else {
3393 push(@cols, &html_escape($d->{'owner'}));
3394 }
3395 }
3396 elsif ($c eq "emailto") {
3397 # Email address
3398 push(@cols, &html_escape($d->{'emailto'}));
3399 }
3400 elsif ($c eq "reseller") {
3401 # Reseller name
3402 push(@cols, &html_escape($d->{'reseller'}));
3403 }
3404 elsif ($c eq "admins") {
3405 # Extra admin names
3406 my @admins = map { $_->{'name'} }
3407 &list_extra_admins($d);
3408 if (&can_edit_admins($d)) {
3409 @admins = map { "<a href='edit_admin.cgi?".
3410 "dom=$d->{'id'}&name=".
3411 &urlize($_)."'>".
3412 &html_escape($_)."</a>" }
3413 @admins;
3414 }
3415 push(@cols, join(' ', @admins));
3416 }
3417 elsif ($c eq "users") {
3418 # User count
3419 if (&can_domain_have_users($d)) {
3420 # Link to users
3421 my $uc = int($usercounts->{$d->{'id'}});
3422 if (&can_edit_users()) {
3423 push(@cols, $uc." ".
3424 "(<a href='list_users.cgi?".
3425 "dom=$d->{'id'}'>".
3426 $text{'index_list'}."</a>)");
3427 }
3428 else {
3429 push(@cols, $uc);
3430 }
3431 }
3432 else {
3433 push(@cols, "");
3434 }
3435 }
3436 elsif ($c eq "aliases") {
3437 # Alias count, with link
3438 if ($d->{'mail'}) {
3439 my $ac = int($aliascounts->{$d->{'id'}});
3440 if (&can_edit_aliases() && !$d->{'aliascopy'}) {
3441 push(@cols, $ac." ".
3442 "(<a href='list_aliases.cgi?".
3443 "dom=$d->{'id'}'>".
3444 $text{'index_list'}."</a>)");
3445 }
3446 else {
3447 push(@cols, scalar(@aliases));
3448 }
3449 }
3450 else {
3451 push(@cols, $text{'index_nomail'});
3452 }
3453 }
3454 elsif ($c eq "quota") {
3455 # Quota assigned
3456 my $qd = $d->{'parent'} ? &get_domain($d->{'parent'})
3457 : $d;
3458 push(@cols, $qd->{'quota'} ?
3459 "a_show($qd->{'quota'}, "home") :
3460 $text{'form_unlimit'});
3461 }
3462 elsif ($c eq "uquota") {
3463 # Quota used
3464 if ($d->{'alias'} || $d->{'parent'}) {
3465 # Alias and sub-servers have no usage
3466 push(@cols, &nice_size(0));
3467 }
3468 else {
3469 # Show total usage for domain
3470 my $qmax = $d->{'quota'} ?
3471 $d->{'quota'}*"a_bsize("home") : undef;
3472 my ($hq, $mq, $dbq) = &get_domain_quota($d, 1);
3473 my $ut = $hq*"a_bsize("home") +
3474 $mq*"a_bsize("mail") + $dbq;
3475 local $txt = &nice_size($ut);
3476 if ($qmax && $bytes > $qmax) {
3477 $txt ="<font color=#ff0000>$txt</font>";
3478 }
3479 push(@cols, $txt);
3480 }
3481 }
3482 elsif ($c eq "created") {
3483 # Creation date
3484 push(@cols, &make_date($d->{'created'}, 1));
3485 }
3486 elsif ($c =~ /^field_/) {
3487 # Some custom field
3488 push(@cols, &html_escape($d->{$c}));
3489 }
3490 }
3491 foreach $f (@table_features) {
3492 push(@cols, $d->{$f} ? $text{'yes'} : $text{'no'});
3493 }
3494 if (&can_config_domain($d) && $showchecks) {
3495 unshift(@cols, { 'type' => 'checkbox',
3496 'name' => 'd', 'value' => $d->{'id'} });
3497 }
3498 push(@table, \@cols);
3499 }
3500
3501# Output the table
3502local $rv = &ui_columns_table(\@heads, 100, \@table);
3503if ($noprint) {
3504 return $rv;
3505 }
3506else {
3507 print $rv;
3508 }
3509}
3510
3511# userdom_name(name, &domain, [force-append-style])
3512# Returns a username with the domain prefix (usually group) appended somehow
3513sub userdom_name
3514{
3515local ($name, $d, $append_style) = @_;
3516if (!defined($append_style)) {
3517 local $tmpl = &get_template($d->{'template'});
3518 $append_style = $tmpl->{'append_style'};
3519 }
3520if ($append_style == 0) {
3521 return $name.".".$d->{'prefix'};
3522 }
3523elsif ($append_style == 1) {
3524 return $name."-".$d->{'prefix'};
3525 }
3526elsif ($append_style == 2) {
3527 return $d->{'prefix'}.".".$name;
3528 }
3529elsif ($append_style == 3) {
3530 return $d->{'prefix'}."-".$name;
3531 }
3532elsif ($append_style == 4) {
3533 return $name."_".$d->{'prefix'};
3534 }
3535elsif ($append_style == 5) {
3536 return $d->{'prefix'}."_".$name;
3537 }
3538elsif ($append_style == 6) {
3539 return $name."\@".$d->{'dom'};
3540 }
3541elsif ($append_style == 7) {
3542 return $name."\%".$d->{'prefix'};
3543 }
3544else {
3545 &error("Unknown append_style $append_style");
3546 }
3547}
3548
3549# guess_append_style(username, &domain)
3550# Returns the append_style number used for some username, or undef if unknown
3551sub guess_append_style
3552{
3553local ($name, $d) = @_;
3554local $p = $d->{'prefix'};
3555local $dom = $d->{'dom'};
3556return $name =~ /\.\Q$p\E$/ ? 0 :
3557 $name =~ /\-\Q$p\E$/ ? 1 :
3558 $name =~ /^\Q$p\E\./ ? 2 :
3559 $name =~ /^\Q$p\E\-/ ? 3 :
3560 $name =~ /_\Q$p\E$/ ? 4 :
3561 $name =~ /^\Q$p\E_/ ? 5 :
3562 $name =~ /\@\Q$dom\E$/ ? 6 :
3563 $name =~ /\%\Q$p\E$/ ? 7 : undef;
3564}
3565
3566# remove_userdom(name, &domain)
3567# Returns a username with the domain prefix (group) stripped off
3568sub remove_userdom
3569{
3570return $_[0] if (!$_[1]); # No domain
3571return $_[0] if ($_[0] eq $_[1]->{'user'}); # Domain owner has no prefix
3572local $g = $_[1]->{'prefix'};
3573local $d = $_[1]->{'dom'};
3574local $rv = $_[0];
3575($rv =~ s/\@(\Q$d\E)$//) || ($rv =~ s/(\.|\-|_|\%)\Q$g\E$//) || ($rv =~ s/^\Q$g\E(\.|\-|_|\%)//);
3576return $rv;
3577}
3578
3579# too_long(name)
3580# Returns an error message if a username is too long for this Unix variant
3581sub too_long
3582{
3583local $max = &max_username_length();
3584if ($max && length($_[0]) > $max) {
3585 return &text('user_elong', "<tt>$_[0]</tt>", $max);
3586 }
3587else {
3588 return undef;
3589 }
3590}
3591
3592# valid_alias_name(name)
3593# Returns an error message if an alias name contains bogus characters
3594sub valid_alias_name
3595{
3596local ($name) = @_;
3597if ($name !~ /^[^ \t:\&\(\)\|\;\<\>\*\?\!]+$/) {
3598 return $text{'user_euser'};
3599 }
3600return undef;
3601}
3602
3603# valid_mailbox_name(name)
3604# Returns an error message if a mailbox name contains bogus characters, or uses
3605# a reserved name
3606sub valid_mailbox_name
3607{
3608local ($name) = @_;
3609&require_useradmin();
3610local $err = &valid_alias_name($name);
3611return $err if ($err);
3612if ($name eq "domains" || $name eq "logs" || $name eq "virtualmin-backup") {
3613 return &text('user_ereserved', $name);
3614 }
3615$err = &useradmin::check_username_restrictions($name);
3616if ($err) {
3617 return $err;
3618 }
3619return undef;
3620}
3621
3622sub max_username_length
3623{
3624&require_useradmin();
3625return $uconfig{'max_length'};
3626}
3627
3628# get_default_ip([reseller-list])
3629# Returns this system's primary IP address. If a reseller is given and he
3630# has a custom IP, use that.
3631sub get_default_ip
3632{
3633local ($reselname) = @_;
3634if ($reselname && defined(&get_reseller)) {
3635 # Check if the reseller has an IP
3636 foreach my $r (split(/\s+/, $reselname)) {
3637 local $resel = &get_reseller($r);
3638 if ($resel && $resel->{'acl'}->{'defip'}) {
3639 return $resel->{'acl'}->{'defip'};
3640 }
3641 }
3642 }
3643if ($config{'defip'}) {
3644 # Explicitly set on module config page
3645 return $config{'defip'};
3646 }
3647elsif (&running_in_zone()) {
3648 # From zone's interface
3649 &foreign_require("net");
3650 local ($iface) = grep { $_->{'up'} &&
3651 &net::iface_type($_->{'name'}) =~ /ethernet/i }
3652 &net::active_interfaces();
3653 return $iface ? $iface->{'address'} : undef;
3654 }
3655else {
3656 # From interface detected at check time
3657 &foreign_require("net");
3658 local $ifacename = $config{'iface'} || &first_ethernet_iface();
3659 local ($iface) = grep { $_->{'fullname'} eq $ifacename }
3660 &net::active_interfaces();
3661 if ($iface) {
3662 return $iface->{'address'};
3663 }
3664 else {
3665 return undef;
3666 }
3667 }
3668}
3669
3670# get_default_ip6([reseller-name])
3671# Returns this system's primary IPv6 address. If a reseller is given and he
3672# has a custom IP, use that.
3673sub get_default_ip6
3674{
3675local ($reselname) = @_;
3676if ($reselname && defined(&get_reseller)) {
3677 # Check if the reseller has an IP
3678 local $resel = &get_reseller($reselname);
3679 if ($resel && $resel->{'acl'}->{'defip6'}) {
3680 return $resel->{'acl'}->{'defip6'};
3681 }
3682 }
3683if ($config{'defip6'}) {
3684 # Explicitly set on module config page
3685 return $config{'defip6'};
3686 }
3687else {
3688 # From interface detected at check time
3689 &foreign_require("net");
3690 local $ifacename = $config{'iface'} || &first_ethernet_iface();
3691 local ($iface) = grep { $_->{'fullname'} eq $ifacename }
3692 &net::boot_interfaces();
3693 if ($iface && @{$iface->{'address6'}}) {
3694 # Use address on the boot interface if possible, as active
3695 # IPv6 addresses can get re-ordered
3696 return $iface->{'address6'}->[0];
3697 }
3698 # Otherwise, fall back to first active address
3699 ($iface) = grep { $_->{'fullname'} eq $ifacename }
3700 &net::active_interfaces();
3701 if ($iface) {
3702 return $iface->{'address6'} && @{$iface->{'address6'}} ?
3703 $iface->{'address6'}->[0] : undef;
3704 }
3705 else {
3706 return undef;
3707 }
3708 }
3709}
3710
3711# first_ethernet_iface()
3712# Returns the name of the first active ethernet interface
3713sub first_ethernet_iface
3714{
3715&foreign_require("net");
3716my @active = &net::active_interfaces();
3717
3718# First try to find a non-virtual Ethernet interface
3719foreach my $a (@active) {
3720 if ($a->{'up'} && $a->{'virtual'} eq '' &&
3721 $a->{'address'} ne '127.0.0.1' &&
3722 (&net::iface_type($a->{'name'}) =~ /ethernet/i ||
3723 $a->{'name'} =~ /^bond/)) {
3724 return $a->{'fullname'};
3725 }
3726 }
3727
3728# Failing that, look for a virtual interface. On some VPS systems, the
3729# main interface is actually venet0:0
3730foreach my $a (@active) {
3731 if ($a->{'up'} &&
3732 $a->{'address'} ne '127.0.0.1' &&
3733 (&net::iface_type($a->{'name'}) =~ /ethernet/i ||
3734 $a->{'name'} =~ /^venet/)) {
3735 return $a->{'fullname'};
3736 }
3737 }
3738
3739return undef;
3740}
3741
3742# get_address_iface(address)
3743# Given an IPv4 or v6 address, returns the interface name
3744sub get_address_iface
3745{
3746local ($a) = @_;
3747&foreign_require("net");
3748local ($iface) = grep { $_->{'address'} eq $a ||
3749 &indexof($a, @{$_->{'address6'}}) >= 0 }
3750 &net::active_interfaces();
3751return $iface ? $iface->{'fullname'} : undef;
3752}
3753
3754# check_apache_directives([directives])
3755# Returns an error string if the default Apache directives don't look valid
3756sub check_apache_directives
3757{
3758local ($d, $gotname, $gotdom, $gotdoc, $gotproxy);
3759local @dirs = split(/\t+/, defined($_[0]) ? $_[0] : $config{'apache_config'});
3760foreach $d (@dirs) {
3761 $d =~ s/#.*$//;
3762 if ($d =~ /^\s*ServerName\s+(\S+)$/i) {
3763 $gotname++;
3764 $gotdom++ if ($1 =~ /\$DOM|\$\{DOM\}/);
3765 }
3766 if ($d =~ /^\s*ServerAlias\s+(.*)$/i) {
3767 $gotdom++ if ($1 =~ /\$DOM|\$\{DOM\}/);
3768 }
3769 $gotdoc++ if ($d =~ /^\s*(DocumentRoot|VirtualDocumentRoot)\s+(.*)$/i);
3770 $gotproxy++ if ($d =~ /^\s*ProxyPass\s+(.*)$/i);
3771 }
3772$gotname || return $text{'acheck_ename'};
3773$gotdom || return $text{'acheck_edom'};
3774$gotdoc || $gotproxy || return $text{'acheck_edoc'};
3775return undef;
3776}
3777
3778# Return optional javascript to force scroll to the botton
3779sub bottom_scroll_js
3780{
3781if ($main::force_bottom_scroll) {
3782 return "<script>".
3783 "window.scrollTo(0, document.body.scrollHeight)".
3784 "</script>\n";
3785 }
3786else {
3787 return "";
3788 }
3789}
3790
3791# Print functions for HTML output
3792sub first_html_print { print_and_capture(@_,"<br>\n");
3793 print bottom_scroll_js(); }
3794sub second_html_print { print_and_capture(@_,"<p>\n");
3795 print bottom_scroll_js(); }
3796sub indent_html_print { print_and_capture("<ul>\n");
3797 print bottom_scroll_js(); }
3798sub outdent_html_print { print_and_capture("</ul>\n");
3799 print bottom_scroll_js(); }
3800
3801# Print functions for text output
3802sub first_text_print
3803{
3804print_and_capture($indent_text,
3805 (map { &html_tags_to_text(&entities_to_ascii($_)) } @_),"\n");
3806}
3807sub second_text_print
3808{
3809print_and_capture($indent_text,
3810 (map { &html_tags_to_text(&entities_to_ascii($_)) } @_),"\n\n");
3811}
3812sub indent_text_print { $indent_text .= " "; }
3813sub outdent_text_print { $indent_text = substr($indent_text, 4); }
3814sub html_tags_to_text
3815{
3816local ($rv) = @_;
3817$rv =~ s/<tt>|<\/tt>//g;
3818$rv =~ s/<b>|<\/b>//g;
3819$rv =~ s/<i>|<\/i>//g;
3820$rv =~ s/<u>|<\/u>//g;
3821$rv =~ s/<a[^>]*>|<\/a>//g;
3822$rv =~ s/<pre>|<\/pre>//g;
3823$rv =~ s/<br>|<br\s[^>]*>/\n/g;
3824$rv =~ s/<p>|<p\s[^>]*>/\n\n/g;
3825$rv = &entities_to_ascii($rv);
3826return $rv;
3827}
3828
3829# Print functions for caturing output
3830sub first_capture_print
3831{
3832$print_output .= $indent_text.
3833 join("", (map { &html_tags_to_text(&entities_to_ascii($_)) } @_))."\n";
3834}
3835sub second_capture_print
3836{
3837$print_output .= $indent_text.
3838 join("", (map { &html_tags_to_text(&entities_to_ascii($_)) } @_))."\n\n";
3839}
3840
3841sub null_print { }
3842
3843sub set_all_null_print
3844{
3845$first_print = $second_print = $indent_print = $outdent_print = \&null_print;
3846}
3847sub set_all_text_print
3848{
3849$first_print = \&first_text_print;
3850$second_print = \&second_text_print;
3851$indent_print = \&indent_text_print;
3852$outdent_print = \&outdent_text_print;
3853}
3854sub set_all_html_print
3855{
3856$first_print = \&first_html_print;
3857$second_print = \&second_html_print;
3858$indent_print = \&indent_html_print;
3859$outdent_print = \&outdent_html_print;
3860}
3861sub set_all_capture_print
3862{
3863$first_print = \&first_capture_print;
3864$second_print = \&second_capture_print;
3865$indent_print = \&indent_text_print;
3866$outdent_print = \&outdent_text_print;
3867}
3868
3869# These functions store and retrieve the current print commands
3870sub push_all_print
3871{
3872push(@print_function_stack, [ $first_print, $second_print,
3873 $indent_print, $outdent_print ]);
3874&set_all_null_print();
3875}
3876sub pop_all_print
3877{
3878local $p = pop(@print_function_stack);
3879($first_print, $second_print, $indent_print, $outdent_print) = @$p;
3880}
3881
3882# Start capturing output
3883sub start_print_capture
3884{
3885$print_capture = 1;
3886$print_output = undef;
3887}
3888
3889# Stop capturing output, and return what we have
3890sub stop_print_capture
3891{
3892$print_capture = 1;
3893return $print_output;
3894}
3895
3896sub print_and_capture
3897{
3898print @_;
3899if ($print_capture) {
3900 $print_output .= join("", @_);
3901 }
3902}
3903
3904# will_send_domain_email(&domain)
3905# Returns 1 if email would be sent to this domain at signup time
3906sub will_send_domain_email
3907{
3908local $tmpl = &get_template($_[0]->{'template'});
3909return $tmpl->{'mail_on'} ne 'none';
3910}
3911
3912# send_domain_email(&domain, [force-to], [password])
3913# Sends the signup email to a new domain owner. Returns a pair containing a
3914# number (0=failed, 1=success) and an optional message. Also outputs status
3915# messages.
3916sub send_domain_email
3917{
3918local ($d, $forceto, $pass) = @_;
3919local $tmpl = &get_template($d->{'template'});
3920local $mail = $tmpl->{'mail'};
3921local $subject = $tmpl->{'mail_subject'};
3922local $cc = $tmpl->{'mail_cc'};
3923local $bcc = $tmpl->{'mail_bcc'};
3924if ($tmpl->{'mail_on'} eq 'none') {
3925 return (1, undef);
3926 }
3927&$first_print($text{'setup_email'});
3928
3929local %hash = &make_domain_substitions($d, 1);
3930$hash{'pass'} = $pass if ($pass);
3931local @erv = &send_template_email($mail, $forceto || $d->{'emailto'},
3932 \%hash, $subject, $cc, $bcc, undef,
3933 &get_global_from_address($d));
3934if ($erv[0]) {
3935 &$second_print(&text('setup_emailok', $erv[1]));
3936 }
3937else {
3938 &$second_print(&text('setup_emailfailed', $erv[1]));
3939 }
3940}
3941
3942# make_domain_substitions(&domain, [nice-sizes])
3943# Returns a hash of substitions for email to a virtual server
3944sub make_domain_substitions
3945{
3946local ($d, $nice_sizes) = @_;
3947local %hash = %$d;
3948local $tmpl = &get_template($d->{'template'});
3949
3950delete($hash{''});
3951$hash{'idndom'} = &show_domain_name($d->{'dom'}); # With unicode
3952
3953# Convert disabled_time to timestamp
3954if ($d->{'disabled_time'}) {
3955 $hash{'disabled_time'} = &make_date($d->{'disabled_time'});
3956 }
3957
3958# Add parent domain info
3959if ($d->{'parent'}) {
3960 local $parent = &get_domain($d->{'parent'});
3961 foreach my $k (keys %$parent) {
3962 $hash{'parent_domain_'.$k} = $parent->{$k};
3963 }
3964 delete($hash{'parent_domain_'});
3965 }
3966
3967# Add alias target domain info
3968if ($d->{'alias'}) {
3969 local $alias = &get_domain($d->{'alias'});
3970 foreach my $k (keys %$alias) {
3971 $hash{'alias_domain_'.$k} = $alias->{$k};
3972 }
3973 delete($hash{'alias_domain_'});
3974 }
3975
3976# Add (first) reseller details
3977if ($d->{'reseller'} && defined(&get_reseller)) {
3978 my @r = split(/\s+/, $d->{'reseller'});
3979 local $resel = &get_reseller($r[0]);
3980 local $acl = $resel->{'acl'};
3981 $hash{'reseller_name'} = $resel->{'name'};
3982 $hash{'reseller_theme'} = $resel->{'theme'};
3983 $hash{'reseller_modules'} = join(" ", @{$resel->{'modules'}});
3984 foreach my $a (keys %$acl) {
3985 $hash{'reseller_'.$a} = $acl->{$a};
3986 }
3987 }
3988
3989# Add plan details, if any
3990local $plan = &get_plan($d->{'plan'});
3991if ($plan) {
3992 foreach my $k (keys %$plan) {
3993 $hash{'plan_'.$k} = $plan->{$k};
3994 }
3995 }
3996
3997# Add DNS serial number, for use in DNS templates
3998if ($config{'dns'}) {
3999 &require_bind();
4000 if ($bind8::config{'soa_style'} == 1) {
4001 $hash{'dns_serial'} = &bind8::date_serial().
4002 sprintf("%2.2d", $bind8::config{'soa_start'});
4003 }
4004 else {
4005 # Use Unix time for date and running number serials
4006 $hash{'dns_serial'} = time();
4007 }
4008 }
4009else {
4010 # BIND not installed, so default to using unix time for serial
4011 $hash{'dns_serial'} = time();
4012 }
4013
4014# Add webmin and usermin ports
4015$hash{'virtualmin_url'} = &get_virtualmin_url($d);
4016local %miniserv;
4017&get_miniserv_config(\%miniserv);
4018$hash{'webmin_port'} = $miniserv{'port'};
4019$hash{'webmin_proto'} = $miniserv{'ssl'} ? 'https' : 'http';
4020if (&foreign_installed('usermin')) {
4021 &foreign_require('usermin');
4022 local %uminiserv;
4023 &usermin::get_usermin_miniserv_config(\%uminiserv);
4024 $hash{'usermin_port'} = $uminiserv{'port'};
4025 $hash{'usermin_proto'} = $uminiserv{'ssl'} ? 'https' : 'http';
4026 }
4027
4028# Make quotas nicer, if needed
4029if ($nice_sizes) {
4030 if ($hash{'quota'}) {
4031 $hash{'quota'} = &nice_size($d->{'quota'}*"a_bsize("home"));
4032 }
4033 if ($hash{'uquota'}) {
4034 $hash{'uquota'} = &nice_size($d->{'uquota'}*"a_bsize("home"));
4035 }
4036 if ($hash{'bw_limit'}) {
4037 $hash{'bw_limit'} = &nice_size($d->{'bw_limit'});
4038 }
4039 if ($hash{'bw_usage'}) {
4040 $hash{'bw_usage'} = &nice_size($d->{'bw_usage'});
4041 }
4042 if ($config{'bw_period'}) {
4043 $hash{'bw_period'} = $config{'bw_period'};
4044 $hash{'bw_past'} = '';
4045 }
4046 else {
4047 $hash{'bw_past'} = $config{'bw_past'};
4048 $hash{'bw_period'} = '';
4049 }
4050 }
4051
4052# Set mysql_pass to blank if missing, so that it can be used if $IF
4053$hash{'mysql_pass'} ||= '';
4054$hash{'postgres_pass'} ||= '';
4055
4056# Setup MySQL and PostgreSQL usernames if not set yet
4057if ($d->{'mysql'} && !$hash{'mysql_user'}) {
4058 $hash{'mysql_user'} = &mysql_user($d);
4059 }
4060if ($d->{'postgres'} && !$hash{'postgres_user'}) {
4061 $hash{'postgres_user'} = &postgres_user($d);
4062 }
4063
4064# Add random numbers length 1-10
4065&seed_random();
4066for(my $i=1; $i<=10; $i++) {
4067 my $r;
4068 do {
4069 $r = int(rand()*(10**$i));
4070 } while(length($r) != $i);
4071 $hash{"RANDOM$i"} = $r;
4072 }
4073
4074# Add secondary mail servers
4075local %ids = map { $_, 1 } split(/\s+/, $d->{'mx_servers'});
4076local @servers = grep { $ids{$_->{'id'}} } &list_mx_servers();
4077$hash{'mx_slaves'} = join(" ", map { $_->{'host'} } @servers);
4078
4079# Add secondary nameservers
4080if ($config{'dns'}) {
4081 local %on = map { $_, 1 } split(/\s+/, $d->{'dns_slaves'});
4082 local @servers = grep { $on{$_->{'host'}} || $on{$_->{'nsname'}} }
4083 &bind8::list_slave_servers();
4084 $hash{'dns_server'} = &get_master_nameserver($tmpl);
4085 $hash{'dns_slaves'} = join(" ", map { $_->{'nsname'} || $_->{'host'} }
4086 @servers);
4087 }
4088
4089# If any website feature is enabled (like Nginx), set the web variable
4090if (&domain_has_website($d)) {
4091 $hash{'web'} = 1;
4092 }
4093
4094# Add domain parts
4095my @parts = split(/\./, $d->{'dom'});
4096for(my $i=0; $i<@parts; $i++) {
4097 $hash{'dompart'.$i} = $parts[$i];
4098 }
4099
4100return %hash;
4101}
4102
4103# will_send_user_email([&domain], [new-flag])
4104# Returns 1 if a new mailbox email would be sent to a user in this domain.
4105# Will return 0 if no template is defined, or if sending mail to the mailbox
4106# has been deactivated, or if the domain doesn't even have email
4107sub will_send_user_email
4108{
4109local ($d, $isnew) = @_;
4110local $tmode = !$d ? "local" : $isnew ? "user" : "update";
4111if ($config{$tmode.'_template'} eq 'none' ||
4112 $tmode eq "user" && !$config{'new'.$tmode.'_to_mailbox'}) {
4113 return 0;
4114 }
4115else {
4116 return 1;
4117 }
4118}
4119
4120# send_user_email([&domain], &user, [mailbox-to|'none'], [update-mode])
4121# Sends email to a new mailbox user, and possibly the domain owner, reseller
4122# and master admin. Returns a pair containing a number (0=failed, 1=success)
4123# and an optional message
4124sub send_user_email
4125{
4126local ($d, $user, $userto, $mode) = @_;
4127local $tmode = $mode ? "update" : $d ? "user" : "local";
4128local $subject = $config{'new'.$tmode.'_subject'};
4129
4130# Work out who we CC to
4131local @ccs;
4132push(@ccs, $config{'new'.$tmode.'_cc'}) if ($config{'new'.$tmode.'_cc'});
4133push(@ccs, $d->{'emailto'}) if ($config{'new'.$tmode.'_to_owner'});
4134if ($config{'new'.$tmode.'_to_reseller'} && $d->{'reseller'} &&
4135 defined(&get_reseller)) {
4136 foreach my $r (split(/\s+/, $d->{'reseller'})) {
4137 local $resel = &get_reseller($r);
4138 if ($resel && $resel->{'acl'}->{'email'}) {
4139 push(@ccs, $resel->{'acl'}->{'email'});
4140 }
4141 }
4142 }
4143local $cc = join(",", @ccs);
4144local $bcc = $config{'new'.$tmode.'_bcc'};
4145
4146&ensure_template($tmode."-template");
4147return (1, undef) if ($config{$tmode.'_template'} eq 'none');
4148local $tmpl = $config{$tmode.'_template'} eq 'default' ?
4149 "$module_config_directory/$tmode-template" :
4150 $config{$tmode.'_template'};
4151local %hash = &make_user_substitutions($user, $d);
4152local $email = $d ? $hash{'mailbox'}.'@'.$hash{'dom'}
4153 : $hash{'user'}.'@'.&get_system_hostname();
4154
4155# Work out who we send to
4156if ($userto) {
4157 $email = $userto eq 'none' ? undef : $userto;
4158 }
4159if (($tmode eq 'user' || $tmode eq 'update') &&
4160 !$config{'new'.$tmode.'_to_mailbox'}) {
4161 # Don't email domain owner if disabled
4162 $email = undef;
4163 }
4164return (1, undef) if (!$email && !$cc && !$bcc);
4165
4166return &send_template_email(&cat_file($tmpl), $email, \%hash,
4167 $subject ||
4168 &entities_to_ascii($mode ? $text{'mail_upsubject'}
4169 : $text{'mail_usubject'}),
4170 $cc, $bcc, $d);
4171}
4172
4173# make_user_substitutions(&user, &domain)
4174# Create a hash of email substitions for a user in some domain
4175sub make_user_substitutions
4176{
4177local ($user, $d) = @_;
4178local %hash;
4179if ($d) {
4180 %hash = ( %$d, %$user );
4181 $hash{'mailbox'} = &remove_userdom($user->{'user'}, $d);
4182 }
4183else {
4184 %hash = ( %$user );
4185 $hash{'mailbox'} = $hash{'user'};
4186 }
4187$hash{'plainpass'} ||= "";
4188$hash{'extra'} = join(" ", @{$user->{'extraemail'}});
4189
4190# Check SSH and FTP shells
4191local ($shell) = grep { $_->{'shell'} eq $user->{'shell'} }
4192 &list_available_shells();
4193if ($shell) {
4194 $hash{'ftp'} = $shell->{'id'} eq 'nologin' ? 0 : 1;
4195 $hash{'ssh'} = $shell->{'id'} eq 'ssh' ? 1 : 0;
4196 }
4197else {
4198 # Assume FTP but no SSH if unknown shell
4199 $hash{'ftp'} = 1;
4200 $hash{'ssh'} = 0;
4201 }
4202
4203# Make quotas use nice units
4204if ($hash{'quota'}) {
4205 $hash{'quota'} = &nice_size($user->{'quota'}*"a_bsize("home"));
4206 }
4207if ($hash{'uquota'}) {
4208 $hash{'uquota'} = &nice_size($user->{'uquota'}*"a_bsize("home"));
4209 }
4210if ($hash{'mquota'}) {
4211 $hash{'mquota'} = &nice_size($user->{'mquota'}*"a_bsize("mail"));
4212 }
4213if ($hash{'umquota'}) {
4214 $hash{'umquota'} = &nice_size($user->{'umquota'}*"a_bsize("mail"));
4215 }
4216if ($hash{'qquota'}) {
4217 $hash{'qquota'} = &nice_size($user->{'qquota'});
4218 }
4219return %hash;
4220}
4221
4222# ensure_template(file)
4223sub ensure_template
4224{
4225local ($file) = @_;
4226local $mpath = "$module_root_directory/$file";
4227local $cpath = "$module_config_directory/$file";
4228if (!-s $cpath) {
4229 ©_source_dest($mpath, $cpath);
4230 }
4231}
4232
4233# get_miniserv_port_proto()
4234# Returns the port number and protocol (http or https) for Webmin
4235sub get_miniserv_port_proto
4236{
4237if ($ENV{'SERVER_PORT'}) {
4238 # Running under miniserv
4239 return ( $ENV{'SERVER_PORT'},
4240 $ENV{'HTTPS'} eq 'ON' ? 'https' : 'http' );
4241 }
4242else {
4243 # Get from miniserv config
4244 local %miniserv;
4245 &get_miniserv_config(\%miniserv);
4246 return ( $miniserv{'port'},
4247 $miniserv{'ssl'} ? 'https' : 'http' );
4248 }
4249}
4250
4251# send_template_email(data, address, &substitions, subject, cc, bcc,
4252# [&domain], [from])
4253# Sends the given file to the specified address, with the substitions from
4254# a hash reference. The actual subs in the file must be like $XXX for entries
4255# in the hash like xxx - ie. $DOM is replaced by the domain name, and $HOME
4256# by the home directory
4257sub send_template_email
4258{
4259local ($template, $to, $subs, $subject, $cc, $bcc, $d, $from) = @_;
4260local %hash = %$subs;
4261
4262# Add in Webmin info to the hash
4263($hash{'webmin_port'}, $hash{'webmin_proto'}) = &get_miniserv_port_proto();
4264$template = &substitute_virtualmin_template($template, \%hash);
4265
4266# Work out the From: address - if a domain is given, use it's email address
4267# as long as that address is in a local domain with mail
4268if (!$from && $remote_user && !&master_admin() && $d) {
4269 local $localdom = 0;
4270 local ($emailtouser, $emailtodom) = split(/\@/, $d->{'emailto_addr'});
4271 foreach my $ld (grep { $_->{'mail'} } &list_domains()) {
4272 if (lc($ld->{'dom'}) eq lc($emailtodom)) {
4273 $localdom = 1;
4274 }
4275 }
4276 if ($emailtodom eq &get_system_hostname()) {
4277 $localdom = 1;
4278 }
4279 if ($localdom) {
4280 $from = $d->{'emailto'};
4281 }
4282 }
4283
4284# Actually send using the mailboxes module
4285local $subject = &substitute_virtualmin_template($subject, \%hash);
4286local $cc = &substitute_virtualmin_template($cc, \%hash);
4287if (!$to) {
4288 # This can happen when a mailbox is not notified about its
4289 # own update or creation
4290 $to = $cc;
4291 $cc = undef;
4292 }
4293&foreign_require("mailboxes");
4294
4295# Set content type and encoding based on whether the email contains HTML
4296# and/or non-ascii characters
4297local $ctype = $template =~ /<html[^>]*>|<body[^>]*>/i ? "text/html"
4298 : "text/plain";
4299local $cs = &get_charset();
4300local $attach = $template =~ /[\177-\377]/ ?
4301 { 'headers' => [ [ 'Content-Type', $ctype.'; charset='.$cs ],
4302 [ 'Content-Transfer-Encoding', 'quoted-printable' ] ],
4303 'data' => &mailboxes::quoted_encode($template) } :
4304 { 'headers' => [ [ 'Content-type', $ctype ] ],
4305 'data' => &entities_to_ascii($template) };
4306
4307# Construct and send the email object
4308local $mail = { 'headers' => [ [ 'From', $from ||
4309 $config{'from_addr'} ||
4310 &mailboxes::get_from_address() ],
4311 [ 'To', $to ],
4312 $cc ? ( [ 'Cc', $cc ] ) : ( ),
4313 $bcc ? ( [ 'Bcc', $bcc ] ) : ( ),
4314 [ 'Subject', &entities_to_ascii($subject) ],
4315 ],
4316 'attach' => [ $attach ] };
4317eval {
4318 local $main::error_must_die = 1;
4319 &mailboxes::send_mail($mail);
4320 };
4321if ($@) {
4322 return (0, $@);
4323 }
4324else {
4325 return (1, &text('mail_ok', $to));
4326 }
4327}
4328
4329# send_notify_email(from, &doms|&users, [&dom], subject, body,
4330# [attach, attach-filename, attach-type], [extra-admins],
4331# [send-many], [charset])
4332# Sends a single email to multiple recipients. These can be Virtualmin domains
4333# or users.
4334sub send_notify_email
4335{
4336local ($from, $recips, $d, $subject, $body, $attach, $attachfile, $attachtype,
4337 $admins, $many, $charset) = @_;
4338&foreign_require("mailboxes");
4339local %done;
4340foreach my $r (@$recips) {
4341 # Work out recipient type and addresses
4342 local (@emails, %hash);
4343 if ($r->{'id'}) {
4344 # A domain
4345 push(@emails, $r->{'emailto'});
4346 %hash = &make_domain_substitions($r, 1);
4347 if ($admins) {
4348 # And extra admins
4349 push(@emails, map { $_->{'email'} }
4350 grep { $_->{'email'} }
4351 &list_extra_admins($r));
4352 }
4353 }
4354 else {
4355 # A mailbox user
4356 push(@emails, $r->{'email'} || $r->{'user'});
4357 %hash = &make_user_substitutions($r, $d);
4358 }
4359
4360 # Send to them
4361 foreach my $email (@emails) {
4362 next if (!$many && $done{$email}++);
4363 local $ct = 'text/plain';
4364 if ($charset) {
4365 $ct .= "; charset=".$charset;
4366 }
4367 local $mail = { 'headers' =>
4368 [ [ 'From' => $from ],
4369 [ 'To' => $email ],
4370 [ 'Subject' => &entities_to_ascii(
4371 &substitute_virtualmin_template($subject, \%hash)) ] ],
4372 'attach' =>
4373 [ { 'headers' => [ [ 'Content-type', $ct ] ],
4374 'data' => &entities_to_ascii(
4375 &substitute_virtualmin_template($body, \%hash)) } ] };
4376 if ($attach) {
4377 local $filename = $attachfile;
4378 $filename =~ s/^.*(\\|\/)//;
4379 local $type = $attachtype." name=\"$filename\"";
4380 local $disp = "inline; filename=\"$filename\"";
4381 push(@{$mail->{'attach'}},
4382 { 'data' => $in{'attach'},
4383 'headers' => [
4384 [ 'Content-type', $type ],
4385 [ 'Content-Disposition', $disp ],
4386 [ 'Content-Transfer-Encoding', 'base64' ] ] });
4387 }
4388 &mailboxes::send_mail($mail);
4389 }
4390 }
4391}
4392
4393# get_global_from_address(&domain)
4394# Returns the from address to use when sending email to some domain. This may
4395# be the reseller's email (if set), or the system-wide default
4396sub get_global_from_address
4397{
4398local ($d) = @_;
4399&foreign_require("mailboxes");
4400local $rv = $config{'from_addr'} || &mailboxes::get_from_address();
4401if ($d && $d->{'reseller'} && defined(&get_reseller)) {
4402 # From first reseller
4403 my @r = split(/\s+/, $d->{'reseller'});
4404 local $resel = &get_reseller($r[0]);
4405 if ($resel && $resel->{'acl'}->{'email'}) {
4406 $rv = $resel->{'acl'}->{'email'};
4407 }
4408 }
4409return $rv;
4410}
4411
4412# userdom_substitutions(&user, &dom)
4413# Returns a hash reference of substitutions for a user in a domain
4414sub userdom_substitutions
4415{
4416if ($_[1]) {
4417 $_[0]->{'mailbox'} = &remove_userdom($_[0]->{'user'}, $_[1]);
4418 $_[0]->{'dom'} = $_[1]->{'dom'};
4419 $_[0]->{'dom_prefix'} = substr($_[1]->{'dom'}, 0, 1);
4420 }
4421return $_[0];
4422}
4423
4424# alias_type(string, [alias-name])
4425# Return the type and destination of some alias string. Type codes are:
4426# 1 - Email address
4427# 2 - Include file of addresses
4428# 3 - Write to file
4429# 4 - Pipe to program
4430# 5 - Virtualmin autoreply
4431# 6 - Webmin filter
4432# 7 - Mailbox of user
4433# 8 - Same address at other domain
4434# 9 - Bounce, possibly with message
4435# 10- Current user's mailbox
4436# 11- Throw away
4437# 12- VPopMail autoreply
4438# 13- Everyone in some domain
4439sub alias_type
4440{
4441local @rv;
4442if ($_[0] =~ /^\|\s*$module_config_directory\/autoreply.pl\s+(\S+)/) {
4443 @rv = (5, $1);
4444 }
4445elsif ($_[0] =~ /^\|\s*$config{'vpopmail_auto'}\s+(\d+)\s+(\d+)\s+(\S+)\s+(\S+)(\s+(\S+)\s+(\S+))?/) {
4446 @rv = (12, $3, $1, $2, $4, $6, $7);
4447 }
4448elsif ($_[0] =~ /^\|\s*$module_config_directory\/filter.pl\s+(\S+)/) {
4449 @rv = (6, $1);
4450 }
4451elsif ($_[0] =~ /^\|\s*(.*)$/) {
4452 @rv = (4, $1);
4453 }
4454elsif ($_[0] eq "./Maildir/") {
4455 return (10);
4456 }
4457elsif ($config{'vpopmail_md'} && $_[0] eq "./$config{'vpopmail_md'}/") {
4458 return (10);
4459 }
4460elsif ($_[0] eq "/dev/null") {
4461 return (11);
4462 }
4463elsif ($_[0] =~ /^(\/.*)$/ || $_[0] =~ /^\.\//) {
4464 @rv = (3, $_[0]);
4465 }
4466elsif ($_[0] =~ /^:include:\Q$everyone_alias_dir\E\/(\S+)$/) {
4467 return (13, $1);
4468 }
4469elsif ($_[0] =~ /^:include:(.*)$/) {
4470 @rv = (2, $1);
4471 }
4472elsif ($_[0] =~ /^\\(\S+)$/) {
4473 if ($1 eq $_[1] || $1 eq "NEWUSER" || $1 eq &replace_atsign($_[1]) ||
4474 $1 eq &escape_user($_[1])) {
4475 return (10);
4476 }
4477 else {
4478 @rv = (7, $1);
4479 }
4480 }
4481elsif ($_[0] =~ /^\%1\@(\S+)$/) {
4482 @rv = (8, $1);
4483 }
4484elsif ($_[0] =~ /^BOUNCE\s*(.*)$/) {
4485 @rv = (9, $1);
4486 }
4487else {
4488 @rv = (1, $_[0]);
4489 }
4490return wantarray ? @rv : $rv[0];
4491}
4492
4493# set_alias_programs()
4494# Copy the wrapper scripts needed for autoresponders
4495sub set_alias_programs
4496{
4497&require_mail();
4498
4499# Copy autoresponder
4500local $mailmod = &foreign_check("sendmail") ? "sendmail" :
4501 $config{'mail_system'} == 1 ? "sendmail" :
4502 $config{'mail_system'} == 0 ? "postfix" :
4503 "qmailadmin";
4504©_source_dest("$root_directory/$mailmod/autoreply.pl",
4505 $module_config_directory);
4506&system_logged("chmod 755 $module_config_directory/config");
4507if (-d $sendmail::config{'smrsh_dir'} &&
4508 !-r "$sendmail::config{'smrsh_dir'}/autoreply.pl") {
4509 &system_logged("ln -s $module_config_directory/autoreply.pl $sendmail::config{'smrsh_dir'}/autoreply.pl");
4510 }
4511
4512# Copy filter program
4513&system_logged("cp $root_directory/$mailmod/filter.pl $module_config_directory");
4514&system_logged("chmod 755 $module_config_directory/config");
4515if (-d $sendmail::config{'smrsh_dir'} &&
4516 !-r "$sendmail::config{'smrsh_dir'}/filter.pl") {
4517 &system_logged("ln -s $module_config_directory/filter.pl $sendmail::config{'smrsh_dir'}/filter.pl");
4518 }
4519}
4520
4521# set_domain_envs(&domain, action, [&new-domain], [&old-domain], [&other-envs])
4522# Sets up VIRTUALSERVER_ environment variables for a domain update or some kind,
4523# prior to calling making_changes or made_changes. action must be one of
4524# CREATE_DOMAIN, MODIFY_DOMAIN or DELETE_DOMAIN
4525sub set_domain_envs
4526{
4527local ($d, $action, $newd, $oldd, $others) = @_;
4528&reset_domain_envs();
4529$ENV{'VIRTUALSERVER_ACTION'} = $action;
4530foreach my $e (keys %$d) {
4531 local $env = uc($e);
4532 $env =~ s/\-/_/g;
4533 $ENV{'VIRTUALSERVER_'.$env} = $d->{$e};
4534 }
4535$ENV{'VIRTUALSERVER_IDNDOM'} = &show_domain_name($d->{'dom'});
4536if ($newd) {
4537 # Set details of virtual server being changed to. This is only
4538 # done in the pre-modify call
4539 foreach my $e (keys %$newd) {
4540 local $env = uc($e);
4541 $env =~ s/\-/_/g;
4542 $ENV{'VIRTUALSERVER_NEWSERVER_'.$env} = $newd->{$e};
4543 }
4544 $ENV{'VIRTUALSERVER_NEWSERVER_IDNDOM'} =
4545 &show_domain_name($newd->{'dom'});
4546 }
4547if ($oldd) {
4548 # Set details of virtual server being changed from, in post-modify
4549 foreach my $e (keys %$oldd) {
4550 local $env = uc($e);
4551 $env =~ s/\-/_/g;
4552 $ENV{'VIRTUALSERVER_OLDSERVER_'.$env} = $oldd->{$e};
4553 }
4554 $ENV{'VIRTUALSERVER_OLDSERVER_IDNDOM'} =
4555 &show_domain_name($oldd->{'dom'});
4556 }
4557local $parent = $d->{'parent'} ? &get_domain($d->{'parent'}) : undef;
4558local $alias = $d->{'alias'} ? &get_domain($d->{'alias'}) : undef;
4559if (defined(&get_reseller)) {
4560 # Set (first) reseller details, if we have one
4561 local $rd = $d->{'reseller'} ? $d :
4562 $parent && $parent->{'reseller'} ? $parent : undef;
4563 local ($r) = $rd ? split(/\s+/, $rd->{'reseller'}) : undef;
4564 local $resel = $r ? &get_reseller($r) : undef;
4565 if ($resel) {
4566 local $acl = $resel->{'acl'};
4567 $ENV{'RESELLER_NAME'} = $resel->{'name'};
4568 $ENV{'RESELLER_THEME'} = $resel->{'theme'};
4569 $ENV{'RESELLER_MODULES'} = join(" ", @{$resel->{'modules'}});
4570 foreach my $a (keys %$acl) {
4571 local $env = uc($a);
4572 $env =~ s/\-/_/g;
4573 $ENV{'RESELLER_'.$env} = $acl->{$a};
4574 }
4575 }
4576 }
4577if ($parent) {
4578 # Set parent domain variables
4579 foreach my $e (keys %$parent) {
4580 local $env = uc($e);
4581 $env =~ s/\-/_/g;
4582 $ENV{'PARENT_VIRTUALSERVER_'.$env} = $parent->{$e};
4583 }
4584 $ENV{'PARENT_VIRTUALSERVER_IDNDOM'} =
4585 &show_domain_name($parent->{'dom'});
4586 }
4587if ($alias) {
4588 # Set alias domain variables
4589 foreach my $e (keys %$alias) {
4590 local $env = uc($e);
4591 $env =~ s/\-/_/g;
4592 $ENV{'ALIAS_VIRTUALSERVER_'.$env} = $alias->{$e};
4593 }
4594 $ENV{'ALIAS_VIRTUALSERVER_IDNDOM'} =
4595 &show_domain_name($alias->{'dom'});
4596 }
4597# Set global variables
4598foreach my $v (&get_global_template_variables()) {
4599 if ($v->{'enabled'}) {
4600 $ENV{'GLOBAL_'.uc($v->{'name'})} = $v->{'value'};
4601 }
4602 }
4603# Set other variables
4604if ($others) {
4605 foreach my $e (keys %$others) {
4606 $ENV{uc($e)} = $others->{$e};
4607 }
4608 }
4609}
4610
4611# reset_domain_envs(&domain)
4612# Removes all environment variables set by set_domain_envs
4613sub reset_domain_envs
4614{
4615foreach my $e (keys %ENV) {
4616 delete($ENV{$e}) if ($e =~ /^(VIRTUALSERVER_|RESELLER_|PARENT_VIRTUALSERVER_|GLOBAL_)/);
4617 }
4618}
4619
4620# making_changes()
4621# Called before a domain is created, modified or deleted to run the
4622# pre-change command
4623sub making_changes
4624{
4625if ($config{'pre_command'} =~ /\S/) {
4626 &clean_changes_environment();
4627 local $out = &backquote_logged(
4628 "($config{'pre_command'}) 2>&1 </dev/null");
4629 if ($config{'output_command'} && !$? && $out =~ /\S/) {
4630 &$second_print($out);
4631 }
4632 &reset_changes_environment();
4633 return $? ? $out : undef;
4634 }
4635return undef;
4636}
4637
4638# made_changes()
4639# Called after a domain has been created, modified or deleted to run the
4640# post-change command
4641sub made_changes
4642{
4643if ($config{'post_command'} =~ /\S/) {
4644 &clean_changes_environment();
4645 local $out = &backquote_logged(
4646 "($config{'post_command'}) 2>&1 </dev/null");
4647 if ($config{'output_command'} && !$? && $out =~ /\S/) {
4648 &$second_print($out);
4649 }
4650 &reset_changes_environment();
4651 return $? ? $out : undef;
4652 }
4653return undef;
4654}
4655
4656sub reset_changes_environment
4657{
4658foreach my $e (keys %UNCLEAN_ENV) {
4659 $ENV{$e} = $UNCLEAN_ENV{$e};
4660 }
4661}
4662
4663sub clean_changes_environment
4664{
4665local $e;
4666%UNCLEAN_ENV = %ENV;
4667foreach $e ('SERVER_ROOT', 'SCRIPT_NAME',
4668 'FOREIGN_MODULE_NAME', 'FOREIGN_ROOT_DIRECTORY',
4669 'SCRIPT_FILENAME') {
4670 delete($ENV{$e});
4671 }
4672}
4673
4674# print_subs_table(sub, ..)
4675sub print_subs_table
4676{
4677print "<table>\n";
4678foreach $k (@_) {
4679 print "<tr> <td><tt><b>\${$k}</b></td>\n";
4680 print "<td>",$text{"sub_".$k},"</td> </tr>\n";
4681 }
4682print "</table>\n";
4683print "$text{'sub_if'}<p>\n";
4684}
4685
4686# alias_form(&to, left, &domain, "user"|"alias", user|alias, [&tds])
4687# Prints HTML for selecting 0 or more alias destinations
4688sub alias_form
4689{
4690local ($to, $left, $d, $mode, $who, $tds) = @_;
4691&require_mail();
4692local @typenames = map { $text{"alias_type$_"} } (0 .. 13);
4693$typenames[0] = "<$typenames[0]>";
4694
4695local @values = @$to;
4696local $i;
4697for(my $i=0; $i<=@values+2; $i++) {
4698 local ($type, $val) = $values[$i] ? &alias_type($values[$i], $_[4])
4699 : (0, "");
4700
4701 # Generate drop-down menu for alias type
4702 local @opts;
4703 local $j;
4704 for($j=0; $j<@typenames; $j++) {
4705 next if ($j == 8 && $_[3] eq "user"); # to domain not valid
4706 # for users
4707 next if ($j == 10 && $_[3] ne "user"); # user's mailbox not
4708 # valid for aliases
4709 next if ($j == 9 && $_[3] eq "user"); # bounce is not valid
4710 # for users
4711 next if ($j == 13 && $_[3] eq "user"); # everyone is not valid
4712 # for users
4713 if ($j == 0 || $can_alias_types{$j} || $type == $j) {
4714 push(@opts, [ $j, $typenames[$j] ]);
4715 }
4716 }
4717 local $f = &ui_select("type_$i", $type, \@opts);
4718 if ($type == 7) {
4719 $val = &unescape_user($val);
4720 }
4721 elsif ($type == 13) {
4722 # Everyone in some domain
4723 local $d = &get_domain($val);
4724 if ($d) {
4725 $val = $d->{'dom'};
4726 }
4727 }
4728 $f .= &ui_textbox("val_$i", $val, 30)."\n";
4729 if (&can_edit_afiles()) {
4730 local $prog = $type == 2 ? "edit_afile.cgi" :
4731 $type == 5 ? "edit_rfile.cgi" :
4732 $type == 6 ? "edit_ffile.cgi" :
4733 $type == 12 ? "edit_vfile.cgi" : undef;
4734 if ($prog && $_[2]) {
4735 local $di = $_[2] ? $_[2]->{'id'} : undef;
4736 $f .= "<a href='$prog?dom=$di&file=$val&$_[3]=$_[4]&idx=$i'>$text{'alias_afile'}</a>\n";
4737 }
4738 }
4739 print &ui_table_row($left, $f, undef, $tds);
4740 $left = " ";
4741 }
4742}
4743
4744# parse_alias(catchall, name, &old-values, "user"|"alias", &domain)
4745# Returns a list of values for an alias, taken from the form generated by
4746# &alias_form
4747sub parse_alias
4748{
4749local (@values, $i, $t, $anysame, $anybounce);
4750for($i=0; defined($t = $in{"type_$i"}); $i++) {
4751 !$t || $can_alias_types{$t} ||
4752 &error($text{'alias_etype'}." : ".$text{'alias_type'.$t});
4753 local $v = $in{"val_$i"};
4754 $v =~ s/^\s+//;
4755 $v =~ s/\s+$//;
4756 if ($t == 1 && $v !~ /^([^\|\:\"\' \t\/\\\%]\S*)$/) {
4757 &error(&text('alias_etype1', $v));
4758 }
4759 elsif ($t == 3 && $v !~ /^\/(\S+)$/ && $v !~ /^\.\//) {
4760 &error(&text('alias_etype3', $v));
4761 }
4762 elsif ($t == 4) {
4763 $v =~ /^(\S+)/ || &error($text{'alias_etype4none'});
4764 (-x $1) && &check_aliasfile($1, 0) ||
4765 $1 eq "if" || $1 eq "export" || &has_command("$1") ||
4766 &error(&text('alias_etype4', $1));
4767 }
4768 elsif ($t == 7 && !defined(getpwnam($v)) &&
4769 $config{'mail_system'} != 4 && $config{'mail_system'} != 5) {
4770 &error(&text('alias_etype7', $v));
4771 }
4772 elsif ($t == 8 && $v !~ /^[a-z0-9\.\-\_]+$/) {
4773 &error(&text('alias_etype8', $v));
4774 }
4775 elsif ($t == 8 && !$_[0]) {
4776 &error(&text('alias_ecatchall', $v));
4777 }
4778 elsif ($t == 13 && !&get_domain_by("dom", $v)) {
4779 &error(&text('alias_eeveryone', $v));
4780 }
4781 if ($t == 1 || $t == 3) { push(@values, $v); }
4782 elsif ($t == 2) {
4783 $v = "$d->{'home'}/$v" if ($v !~ /^\//);
4784 push(@values, ":include:$v");
4785 }
4786 elsif ($t == 4) {
4787 push(@values, "|$v");
4788 }
4789 elsif ($t == 5) {
4790 # Setup autoreply script
4791 $v = "$d->{'home'}/$v" if ($v !~ /^\//);
4792 push(@values, "|$module_config_directory/autoreply.pl ".
4793 "$v $name");
4794 &set_alias_programs();
4795 }
4796 elsif ($t == 6) {
4797 # Setup filter script
4798 $v = "$d->{'home'}/$v" if ($v !~ /^\//);
4799 push(@values, "|$module_config_directory/filter.pl ".
4800 "$v $name");
4801 &set_alias_programs();
4802 }
4803 elsif ($t == 7) {
4804 push(@values, "\\".&escape_user($v));
4805 }
4806 elsif ($t == 8) {
4807 push(@values, "\%1\@$v");
4808 $anysame++;
4809 }
4810 elsif ($t == 9) {
4811 push(@values, "BOUNCE".($v ? " $v" : ""));
4812 $anybounce++;
4813 }
4814 elsif ($t == 10) {
4815 # Alias to self .. may need to used at-escaped name
4816 if ($config{'mail_system'} == 0 && $_[1] =~ /\@/) {
4817 push(@values, "\\".&replace_atsign($_[1]));
4818 }
4819 else {
4820 push(@values, "\\".&escape_user($_[1]));
4821 }
4822 }
4823 elsif ($t == 11) {
4824 push(@values, "/dev/null");
4825 }
4826 elsif ($t == 12) {
4827 # Setup vpopmail autoresponder script
4828 local @qm = getpwnam($config{'vpopmail_user'});
4829 if (!$v) {
4830 # Create an empty responder file
4831 local $ddir = &domain_vpopmail_dir($_[4]);
4832 $v = $_[3] eq "alias" ?
4833 "$ddir/$_[1].respond" : "$ddir/$_[1]/respond";
4834 if (!-r $v) {
4835 &open_tempfile(MSG, ">$v");
4836 &close_tempfile(MSG);
4837 &set_ownership_permissions($qm[2], $qm[3],
4838 undef, $v);
4839 }
4840 }
4841 elsif (!$v) {
4842 &error(&text('alias_eautorepond'));
4843 }
4844 $v = "$d->{'home'}/$v" if ($v !~ /^\//);
4845 local @av;
4846 if ($_[2] && &alias_type($_[2]->[$i]) == 12) {
4847 # Use old settings for delay/etc
4848 local @oldav = &alias_type($_[2]->[$i]);
4849 @av = ( $oldav[2], $oldav[3], $v, $oldav[4] );
4850 push(@av, $oldav[5]) if ($oldav[5] ne "");
4851 push(@av, $oldav[6]) if ($oldav[6] ne "");
4852 }
4853 else {
4854 # User default settings for timeouts, and create log
4855 # directory
4856 local $vdir = "$v.log";
4857 if (!-d $vdir) {
4858 &make_dir($vdir, 0755);
4859 &set_ownership_permissions($qm[2], $qm[3],
4860 0755, $vdir);
4861 }
4862 @av = ( 10000, 5, $v, $vdir );
4863 }
4864 push(@values, "|$config{'vpopmail_auto'} ".join(" ", @av));
4865 }
4866 elsif ($t == 13) {
4867 # Work out ID for everyone file
4868 local $d = &get_domain_by("dom", $v);
4869 &create_everyone_file($d);
4870 push(@values, ":include:$everyone_alias_dir/$d->{'id'}");
4871 }
4872 }
4873if (@values > 1 && $anysame) {
4874 &error(&text('alias_ecatchall2', $v));
4875 }
4876if (@values > 1 && $anybounce) {
4877 &error(&text('alias_ebounce'));
4878 }
4879return @values;
4880}
4881
4882# set_pass_change(&user)
4883# Set fields indicating that the password has just been changed
4884sub set_pass_change
4885{
4886&require_useradmin();
4887local $pft = &useradmin::passfiles_type();
4888if ($pft == 2 || $pft == 5 || $config{'ldap'}) {
4889 $_[0]->{'change'} = int(time() / (60*60*24));
4890 }
4891elsif ($pft == 4) {
4892 $_[0]->{'change'} = time();
4893 }
4894}
4895
4896# set_pass_disable(&user, disable)
4897sub set_pass_disable
4898{
4899local ($user, $disable) = @_;
4900if ($disable && $user->{'pass'} !~ /^\!/) {
4901 $user->{'pass'} = "!".$user->{'pass'};
4902 }
4903elsif (!$disable && $user->{'pass'} =~ /^\!/) {
4904 $user->{'pass'} = substr($user->{'pass'}, 1);
4905 }
4906}
4907
4908sub check_aliasfile
4909{
4910return 0 if (!-r $_[0] && !$_[1]);
4911return 1;
4912}
4913
4914# list_all_users()
4915# Returns all local and LDAP users, including those from Qmail
4916sub list_all_users
4917{
4918&require_useradmin();
4919local @rv;
4920foreach my $u (&useradmin::list_users()) {
4921 $u->{'module'} = 'useradmin';
4922 push(@rv, $u);
4923 }
4924if ($config{'ldap'}) {
4925 foreach my $u (&ldap_useradmin::list_users()) {
4926 $u->{'module'} = 'ldap-useradmin';
4927 push(@rv, $u);
4928 }
4929 }
4930if ($config{'mail_system'} == 4) {
4931 local $ldap = &connect_qmail_ldap();
4932 local $rv = $ldap->search(base => $config{'ldap_base'},
4933 filter => "(objectClass=qmailUser)");
4934 local $u;
4935 foreach $u ($rv->all_entries) {
4936 local %uinfo = &qmail_dn_to_hash($u);
4937 push(@rv, \%uinfo);
4938 }
4939 $ldap->unbind();
4940 }
4941return @rv;
4942}
4943
4944# list_all_groups()
4945# Returns all local and LDAP groups
4946sub list_all_groups
4947{
4948&require_useradmin();
4949local @rv;
4950foreach my $g (&useradmin::list_groups()) {
4951 $g->{'module'} = 'useradmin';
4952 push(@rv, $g);
4953 }
4954if ($config{'ldap'}) {
4955 foreach my $g (&ldap_useradmin::list_groups()) {
4956 $g->{'module'} = 'ldap-useradmin';
4957 push(@rv, $g);
4958 }
4959 }
4960return @rv;
4961}
4962
4963# build_taken(&uid-taken, &username-taken, [&users])
4964# Fills in the the given hashes with used usernames and UIDs
4965sub build_taken
4966{
4967my ($uidmap, $usermap, $users) = @_;
4968&obtain_lock_unix();
4969&require_useradmin();
4970
4971# Add Unix users
4972local @users = $users ? @$users : &list_all_users();
4973local $u;
4974foreach $u (@users) {
4975 $uidmap->{$u->{'uid'}} ||= 'user' if ($uidmap);
4976 $usermap->{$u->{'user'}} ||= 'user' if ($usermap);
4977 }
4978
4979# Add system users
4980setpwent();
4981while(my @uinfo = getpwent()) {
4982 $uidmap->{$uinfo[2]} ||= 'user' if ($uidmap);
4983 $usermap->{$uinfo[0]} ||= 'user' if ($usermap);
4984 }
4985endpwent();
4986
4987# Add domain users
4988local $d;
4989foreach $d (&list_domains()) {
4990 $uidmap->{$d->{'uid'}} ||= 'dom' if ($uidmap);
4991 $usermap->{$d->{'user'}} ||= 'dom' if ($usermap);
4992 }
4993
4994# Add UIDs used in the past
4995my %uids;
4996&read_file_cached($old_uids_file, \%uids);
4997foreach my $uid (keys %uids) {
4998 $uidmap->{$uid} ||= 'old' if ($uidmap);
4999 }
5000
5001&release_lock_unix();
5002}
5003
5004# build_group_taken(&gid-taken, &groupname-taken, [&groups])
5005# Fills in the the given hashes with used group names and GIDs
5006sub build_group_taken
5007{
5008my ($gidmap, $groupmap, $groups) = @_;
5009&obtain_lock_unix();
5010&require_useradmin();
5011
5012# Add Unix groups
5013local @groups = $groups ? @$groups : &list_all_groups();
5014local $g;
5015foreach $g (@groups) {
5016 $gidmap->{$g->{'gid'}} ||= 'group' if ($gidmap);
5017 $groupmap->{$g->{'group'}} ||= 'group' if ($groupmap);
5018 }
5019
5020# Add system groups
5021setgrent();
5022while(my @ginfo = getgrent()) {
5023 $gidmap->{$ginfo[2]} ||= 'group' if ($gidmap);
5024 $groupmap->{$ginfo[0]} ||= 'group' if ($groupmap);
5025 }
5026endgrent();
5027
5028# Add domains
5029local $d;
5030foreach $d (&list_domains()) {
5031 $gidmap->{$d->{'gid'}} ||= 'dom' if ($gidmap);
5032 $groupmap->{$d->{'group'}} ||= 'dom' if ($groupmap);
5033 }
5034
5035# Add GIDs used in the past
5036my %gids;
5037&read_file_cached($old_gids_file, \%gids);
5038foreach my $gid (keys %gids) {
5039 $gidmap->{$gid} ||= 'old' if ($gidmap);
5040 }
5041
5042&release_lock_unix();
5043}
5044
5045# allocate_uid(&uid-taken)
5046# Given a hash of used UIDs, return one that is free
5047sub allocate_uid
5048{
5049local $uid = $uconfig{'base_uid'};
5050while($_[0]->{$uid}) {
5051 $uid++;
5052 }
5053return $uid;
5054}
5055
5056# allocate_gid(&gid-taken)
5057# Given a hash of used GIDs, return one that is free
5058sub allocate_gid
5059{
5060local $gid = $uconfig{'base_gid'};
5061while($_[0]->{$gid}) {
5062 $gid++;
5063 }
5064return $gid;
5065}
5066
5067# server_home_directory(&domain, [&parentdomain])
5068# Returns the home directory for a new virtual server user
5069sub server_home_directory
5070{
5071&require_useradmin();
5072if ($_[0]->{'parent'}) {
5073 # Owned by some existing user, so under his home
5074 local $dname = $_[0]->{'dom'};
5075 $dname =~ s/^xn(-+)//;
5076 return "$_[1]->{'home'}/domains/$dname";
5077 }
5078elsif ($config{'home_format'}) {
5079 # Use the template from the module config
5080 local $home = "$home_base/$config{'home_format'}";
5081 return &substitute_domain_template($home, $_[0]);
5082 }
5083else {
5084 # Just use the Users and Groups module settings
5085 return &useradmin::auto_home_dir($home_base, $_[0]->{'user'},
5086 $_[0]->{'ugroup'});
5087 }
5088}
5089
5090# set_quota(user, filesystem, quota, hard)
5091# Set hard or soft quotas for one user
5092sub set_quota
5093{
5094&require_useradmin();
5095if ($_[3]) {
5096 "a::edit_user_quota($_[0], $_[1],
5097 int($_[2]), int($_[2]), 0, 0);
5098 }
5099else {
5100 "a::edit_user_quota($_[0], $_[1],
5101 int($_[2]), 0, 0, 0);
5102 }
5103}
5104
5105# set_server_quotas(&domain, [user-quota, group-quota])
5106# Set the user and possibly group quotas for a domain
5107sub set_server_quotas
5108{
5109my ($d, $uquota, $quota) = @_;
5110$uquota = $d->{'uquota'} if (!defined($uquota));
5111$quota = $d->{'quota'} if (!defined($quota));
5112local $tmpl = &get_template($d->{'template'});
5113if (&has_quota_commands()) {
5114 # User and group quotas are set externally
5115 &run_quota_command("set_user", $d->{'user'},
5116 $tmpl->{'quotatype'} eq 'hard' ? ( int($uquota), int($uquota) )
5117 : ( 0, int($uquota) ));
5118 if (&has_group_quotas() && $d->{'group'}) {
5119 &run_quota_command("set_group", $d->{'group'},
5120 $tmpl->{'quotatype'} eq 'hard' ?
5121 ( int($quota), int($quota) ) : ( 0, $quota ));
5122 }
5123 }
5124else {
5125 if (&has_home_quotas()) {
5126 # Set Unix user quota for home
5127 &set_quota($d->{'user'}, $config{'home_quotas'},
5128 $uquota, $tmpl->{'quotatype'} eq 'hard');
5129 }
5130 if (&has_mail_quotas()) {
5131 # Set Unix user quota for mail
5132 &set_quota($d->{'user'}, $config{'mail_quotas'},
5133 $uquota, $tmpl->{'quotatype'} eq 'hard');
5134 }
5135 if (&has_group_quotas() && $d->{'group'}) {
5136 # Set group quotas for home and possibly mail
5137 &require_useradmin();
5138 local @qargs;
5139 if ($tmpl->{'quotatype'} eq 'hard') {
5140 @qargs = ( int($quota), int($quota), 0, 0 );
5141 }
5142 else {
5143 @qargs = ( int($quota), 0, 0, 0 );
5144 }
5145 "a::edit_group_quota(
5146 $d->{'group'}, $config{'home_quotas'}, @qargs);
5147 if (&has_mail_quotas()) {
5148 "a::edit_group_quota(
5149 $d->{'group'}, $config{'mail_quotas'}, @qargs);
5150 }
5151 }
5152 }
5153}
5154
5155# disable_quotas(&domain)
5156# Temporarily disable quotas for some virtual server, so that file or DB
5157# operations don't fail
5158sub disable_quotas
5159{
5160local ($d) = @_;
5161return if (!&has_home_quotas());
5162if ($d->{'parent'}) {
5163 local $pd = &get_domain($d->{'parent'});
5164 &disable_quotas($pd);
5165 }
5166elsif ($d->{'unix'} && $d->{'quota'}) {
5167 local $nqd = { %$d };
5168 $nqd->{'quota'} = 0;
5169 $nqd->{'uquota'} = 0;
5170 &set_server_quotas($nqd);
5171 }
5172}
5173
5174# enable_quotas(&domain)
5175# Must be called after disable_quotas to re-activate quotas for some domain
5176sub enable_quotas
5177{
5178local ($d) = @_;
5179return if (!&has_home_quotas());
5180if ($d->{'parent'}) {
5181 local $pd = &get_domain($d->{'parent'});
5182 &enable_quotas($pd);
5183 }
5184elsif ($d->{'unix'} && $d->{'quota'}) {
5185 &set_server_quotas($d);
5186 }
5187}
5188
5189# users_table(&users, &dom, cgi, &buttons, &links, empty-msg)
5190# Output a table of mailbox users
5191sub users_table
5192{
5193local ($users, $d, $cgi, $buttons, $links, $empty) = @_;
5194
5195local $can_quotas = &has_home_quotas() || &has_mail_quotas();
5196local $can_qquotas = $config{'mail_system'} == 4 || $config{'mail_system'} == 5;
5197local @ashells = &list_available_shells($d);
5198
5199# Work out table header
5200local @headers;
5201push(@headers, "") if ($cgi);
5202push(@headers, $text{'users_name'},
5203 $d->{'mail'} ? $text{'users_pop3'} : $text{'users_pop3f'},
5204 $text{'users_real'} );
5205if ($can_quotas) {
5206 push(@headers, $text{'users_quota'}, $text{'users_uquota'});
5207 }
5208if ($can_qquotas) {
5209 push(@headers, $text{'users_qquota'});
5210 }
5211if ($config{'show_mailsize'} && $d->{'mail'}) {
5212 push(@headers, $text{'users_size'});
5213 }
5214if ($config{'show_lastlogin'} && $d->{'mail'}) {
5215 push(@headers, $text{'users_ll'});
5216 }
5217push(@headers, $text{'users_ushell'});
5218if ($d->{'mysql'} || $d->{'postgres'}) {
5219 push(@headers, $text{'users_db'});
5220 }
5221local ($f, %plugcol);
5222foreach $f (&list_mail_plugins()) {
5223 local $col = &plugin_call($f, "mailbox_header", $d);
5224 if ($col) {
5225 $plugcol{$f} = $col;
5226 push(@headers, $col);
5227 }
5228 }
5229
5230# Build table contents
5231local $u;
5232local $did = $d ? $d->{'id'} : 0;
5233local @table;
5234foreach $u (sort { $b->{'domainowner'} <=> $a->{'domainowner'} ||
5235 $a->{'user'} cmp $b->{'user'} } @$users) {
5236 local $pop3 = $d ? &remove_userdom($u->{'user'}, $d) : $u->{'user'};
5237 $pop3 = &html_escape($pop3);
5238 local @cols;
5239 push(@cols, "<a href='edit_user.cgi?dom=$did&".
5240 "user=".&urlize($u->{'user'})."&unix=$u->{'unix'}'>".
5241 ($u->{'domainowner'} ? "<b>$pop3</b>" :
5242 $u->{'webowner'} &&
5243 $u->{'pass'} =~ /^\!/ ? "<u><i>$pop3</i></u>" :
5244 $u->{'webowner'} ? "<u>$pop3</u>" :
5245 $u->{'pass'} =~ /^\!/ ? "<i>$pop3</i>" : $pop3)."</a>\n");
5246 push(@cols, &html_escape($u->{'user'}));
5247 push(@cols, &html_escape($u->{'real'}));
5248
5249 # Add columns for quotas
5250 local $quota;
5251 $quota += $u->{'quota'} if (&has_home_quotas());
5252 $quota += $u->{'mquota'} if (&has_mail_quotas());
5253 local $uquota;
5254 $uquota += $u->{'uquota'} if (&has_home_quotas());
5255 $uquota += $u->{'muquota'} if (&has_mail_quotas());
5256 if ($u->{'webowner'} && defined($quota)) {
5257 # Website owners have no real quota
5258 push(@cols, $text{'users_same'}, "");
5259 }
5260 elsif (defined($quota)) {
5261 # Has Unix quotas
5262 push(@cols, $quota ? "a_show($quota, "home")
5263 : $text{'form_unlimit'});
5264 my $color = $u->{'over_quota'} ? "#ff0000" :
5265 $u->{'warn_quota'} ? "#ff8800" :
5266 $u->{'spam_quota'} ? "#aaaaaa" : undef;
5267 if ($color) {
5268 push(@cols, "<font color=$color>".
5269 "a_show($uquota, "home")."</font>");
5270 }
5271 else {
5272 push(@cols, "a_show($uquota, "home"));
5273 }
5274 }
5275 if ($u->{'mailquota'}) {
5276 push(@cols, $u->{'qquota'} ? &nice_size($u->{'qquota'}) :
5277 $text{'form_unlimit'});
5278 }
5279 elsif ($can_qquotas) {
5280 push(@cols, "");
5281 }
5282
5283 if ($config{'show_mailsize'} && $d->{'mail'}) {
5284 # Mailbox link, if this user has email enabled or is the owner
5285 local ($szmsg, $sz);
5286 if (!$u->{'nomailfile'} &&
5287 ($u->{'email'} || @{$u->{'extraemail'}})) {
5288 ($sz) = &mail_file_size($u);
5289 $sz = $sz ? &nice_size($sz) : $text{'users_empty'};
5290 local $lnk = &read_mail_link($u, $d);
5291 if ($lnk) {
5292 $szmsg = &ui_link($lnk, $sz);
5293 }
5294 else {
5295 $szmsg = $sz;
5296 }
5297 }
5298 else {
5299 $szmsg = $text{'users_noemail'};
5300 $sz = 0;
5301 }
5302 push(@cols, { 'type' => 'string',
5303 'td' => 'data-sort='.$sz,
5304 'value' => $szmsg });
5305 }
5306
5307 if ($config{'show_lastlogin'} && $d->{'mail'}) {
5308 # Last mail login
5309 my $ll = &get_last_login_time($u->{'user'});
5310 my $llbest;
5311 foreach $k (keys %$ll) {
5312 $llbest = $ll->{$k} if ($ll->{$k} > $llbest);
5313 }
5314 push(@cols, $llbest ? &make_date($llbest)
5315 : $text{'users_ll_never'});
5316 }
5317
5318 # Show shell access level
5319 local ($shell) = grep { $_->{'shell'} eq $u->{'shell'} } @ashells;
5320 push(@cols, !$u->{'shell'} ? $text{'users_qmail'} :
5321 !$shell ? &text('users_shell', "<tt>$u->{'shell'}</tt>") :
5322 $shell->{'id'} eq 'ftp' && !$u->{'email'} ?
5323 $text{'shells_mailboxftp2'} :
5324 $shell->{'desc'});
5325
5326 # Show number of DBs
5327 if ($d->{'mysql'} || $d->{'postgres'}) {
5328 push(@cols, $u->{'domainowner'} ? $text{'users_all'} :
5329 @{$u->{'dbs'}} ? $text{'yes'}
5330 : $text{'no'});
5331 }
5332
5333 # Show columns from plugins
5334 foreach $f (grep { $plugcol{$_} } &list_mail_plugins()) {
5335 push(@cols, &plugin_call($f, "mailbox_column", $u, $d));
5336 }
5337
5338 # Insert checkbox, if needed
5339 if ($cgi) {
5340 unshift(@cols, { 'type' => 'checkbox',
5341 'name' => 'd',
5342 'value' => int($u->{'unix'})."/".$u->{'user'},
5343 'disabled' => $u->{'domainowner'} });
5344 }
5345 push(@table, \@cols);
5346 }
5347
5348# Generate the table, perhaps with a form
5349if ($cgi) {
5350 print &ui_form_columns_table($cgi, $buttons, 1, $links,
5351 $d ? [ [ "dom", $d->{'id'} ] ] : undef,
5352 \@headers,
5353 100, \@table, undef, 0, undef, $empty);
5354 }
5355else {
5356 print &ui_columns_table(\@headers, 100, \@table, undef, 0, undef,
5357 $empty);
5358 }
5359}
5360
5361# quota_bsize(filesystem|"home"|"mail", [for-filesys])
5362sub quota_bsize
5363{
5364if (&has_quota_commands()) {
5365 # When using quota commands, the block size is always 1024
5366 return 1024;
5367 }
5368local $fs = $_[0] eq "home" ? $config{'home_quotas'} :
5369 $_[0] eq "mail" ? $config{'mail_quotas'} : $_[0];
5370local $forfs = int($_[1]);
5371if ($gconfig{'os_type'} =~ /-linux$/) {
5372 # On linux, the quota block size is ALWAYS 1024, so we can shortcut
5373 # any actual filesystem tests
5374 return $forfs ? 512 : 1024;
5375 }
5376&require_useradmin();
5377if (defined("a::block_size)) {
5378 local $bsize;
5379 if (!exists($bsize_cache{$fs,$forfs})) {
5380 $bsize_cache{$fs,$forfs} = "a::block_size($fs, $forfs);
5381 }
5382 return $bsize_cache{$fs,$forfs};
5383 }
5384return undef;
5385}
5386
5387# quota_show(number, filesystem|"home"|"mail", [zero-means-none])
5388# Returns text for the quota on some filesystem, in a human-readable format
5389sub quota_show
5390{
5391if (!$_[0]) {
5392 return $_[2] ? $text{'resel_none'} : $text{'resel_unlimit'};
5393 }
5394else {
5395 local $bsize = "a_bsize($_[1]);
5396 if ($bsize) {
5397 return &nice_size($_[0]*$bsize);
5398 }
5399 return $_[0]." ".$text{'form_b'};
5400 }
5401}
5402
5403# quota_input(name, number, filesystem|"home"|"mail", [disabled])
5404# Returns HTML for an input for entering a quota, doing block->kb conversion
5405sub quota_input
5406{
5407local ($name, $value, $fs, $dis) = @_;
5408local $bsize = "a_bsize($fs);
5409if ($bsize) {
5410 # Allow units selection
5411 local $sz = $value*$bsize;
5412 local $units = 1;
5413 if ($value eq "") {
5414 # Default to MB, since bytes are rarely useful
5415 $units = 1024*1024;
5416 }
5417 elsif ($sz >= 1024*1024*1024*1024) {
5418 $units = 1024*1024*1024*1024;
5419 }
5420 elsif ($sz >= 1024*1024*1024) {
5421 $units = 1024*1024*1024;
5422 }
5423 elsif ($sz >= 1024*1024) {
5424 $units = 1024*1024;
5425 }
5426 elsif ($sz >= 1024) {
5427 $units = 1024;
5428 }
5429 else {
5430 $units = 1;
5431 }
5432 $sz = $sz == 0 ? "" : sprintf("%.2f", ($sz*1.0)/$units);
5433 $sz =~ s/\.00$//;
5434 return &ui_textbox($name, $sz, 8, $dis)." ".
5435 &ui_select($name."_units", $units,
5436 [ [ 1, "bytes" ],
5437 [ 1024, "kB" ],
5438 [ 1024*1024, "MB" ],
5439 [ 1024*1024*1024, "GB" ],
5440 [ 1024*1024*1024*1024, "TB" ] ],
5441 1, 0, 0, $_[3]);
5442 }
5443else {
5444 # Just show blocks input
5445 return &ui_textbox($name, $value, 10, $dis)." ".$text{'form_b'};
5446 }
5447}
5448
5449# opt_quota_input(name, value, filesystem|"home"|"mail"|"none",
5450# [third-option], [set-label])
5451# Returns HTML for a field for selecting a quota or unlimited
5452sub opt_quota_input
5453{
5454local ($name, $value, $fs, $third, $label) = @_;
5455local $dis1 = &js_disable_inputs([ $name, $name."_units" ], [ ]);
5456local $dis2 = &js_disable_inputs([ ], [ $name, $name."_units" ]);
5457local $mode = $value eq "" ? 1 : $value eq "0" ? 1 : $value eq "none" ? 2 : 0;
5458local $qi = $fs eq "none" ? &ui_textbox($name, $mode ? "" : $value, 10)
5459 : "a_input($name, $mode ? "" : $value, $fs,$mode);
5460return &ui_radio($name."_def", $mode,
5461 [ $third ? ([ 2, $third, "onClick='$dis1'" ]) : ( ),
5462 [ 1, $text{'form_unlimit'}, "onClick='$dis1'" ],
5463 [ 0, $label." ".$qi, "onClick='$dis2'" ] ]);
5464}
5465
5466# quota_parse(name, filesystem|"home"|"mail")
5467# Converts an entered quota into blocks
5468sub quota_parse
5469{
5470local $bsize = "a_bsize($_[1]);
5471if (!$bsize) {
5472 return $in{$_[0]};
5473 }
5474else {
5475 return int($in{$_[0]}*$in{$_[0]."_units"}/$bsize);
5476 }
5477}
5478
5479# quota_javascript(name, value, filesystem|"bw"|"none", unlimited-possible)
5480# Returns Javascript to set some quota field using Javascript
5481sub quota_javascript
5482{
5483local ($name, $value, $fs, $unlimited) = @_;
5484local $bsize = $fs eq "none" ? 0 : $fs eq "bw" ? 1 : "a_bsize($fs);
5485local $rv;
5486if ($bsize) {
5487 # Set value and units
5488 local $val = $value eq "" ? "" : $value*$bsize;
5489 local $index;
5490 if ($val >= 1024*1024*1024) {
5491 $val = $val/(1024*1024*1024);
5492 $index = 3;
5493 }
5494 elsif ($val >= 1024*1024) {
5495 $val = $val/(1024*1024);
5496 $index = 2;
5497 }
5498 elsif ($val >= 1024) {
5499 $val = $val/(1024);
5500 $index = 1;
5501 }
5502 else {
5503 $index = 0;
5504 }
5505 $val = sprintf("%.2f", $val) if ($val);
5506 $val =~ s/\.00$//;
5507 $rv .= " document.forms[0].${name}.value = \"$val\";\n";
5508 $rv .= " document.forms[0].${name}_units.selectedIndex = $index;\n";
5509 }
5510else {
5511 # Just set blocks value
5512 $rv .= " document.forms[0].${name}.value = \"$value\";\n";
5513 }
5514if ($unlimited) {
5515 if ($value eq "") {
5516 $rv .= " document.forms[0].${name}_def[0].checked = true;\n";
5517 $rv .= " document.forms[0].${name}.disabled = true;\n";
5518 $rv .= " if (document.forms[0].${name}_units) {\n";
5519 $rv .= " document.forms[0].${name}_units.disabled = true;\n";
5520 $rv .= " }\n";
5521 }
5522 else {
5523 $rv .= " document.forms[0].${name}_def[1].checked = true;\n";
5524 $rv .= " document.forms[0].${name}.disabled = false;\n";
5525 $rv .= " if (document.forms[0].${name}_units) {\n";
5526 $rv .= " document.forms[0].${name}_units.disabled = false;\n";
5527 $rv .= " }\n";
5528 }
5529 }
5530return $rv;
5531}
5532
5533# backup_virtualmin(&domain, file)
5534# Adds a domain's configuration file to the backup
5535sub backup_virtualmin
5536{
5537&$first_print($text{'backup_virtualmincp'});
5538
5539# Record parent's domain name, which can be used when restoring
5540if ($_[0]->{'parent'}) {
5541 local $parent = &get_domain($_[0]->{'parent'});
5542 $_[0]->{'backup_parent_dom'} = $parent->{'dom'};
5543 if ($_[0]->{'alias'}) {
5544 local $alias = &get_domain($_[0]->{'alias'});
5545 $_[0]->{'backup_alias_dom'} = $alias->{'dom'};
5546 }
5547 if ($_[0]->{'subdom'}) {
5548 local $subdom = &get_domain($_[0]->{'subdom'});
5549 $_[0]->{'backup_subdom_dom'} = $subdom->{'dom'};
5550 }
5551 }
5552
5553# Record sub-directory for mail folders, used during mail restores
5554local %mconfig = &foreign_config("mailboxes");
5555if ($mconfig{'mail_usermin'}) {
5556 $_[0]->{'backup_mail_folders'} = $mconfig{'mail_usermin'};
5557 }
5558else {
5559 delete($_[0]->{'backup_mail_folders'});
5560 }
5561
5562# Record encrypted Unix password
5563delete($_[0]->{'backup_encpass'});
5564if ($_[0]->{'unix'} && !$_[0]->{'parent'} && !$_[0]->{'disabled'}) {
5565 local @users = &list_all_users();
5566 local ($user) = grep { $_->{'user'} eq $_[0]->{'user'} } @users;
5567 if ($user) {
5568 $_[0]->{'backup_encpass'} = $user->{'pass'};
5569 }
5570 }
5571
5572# Record if default for the IP
5573if (&domain_has_website($_[0])) {
5574 $_[0]->{'backup_web_default'} = &is_default_website($_[0]);
5575 }
5576else {
5577 delete($_[0]->{'backup_web_default'});
5578 }
5579
5580# Record webserver type
5581$_[0]->{'backup_web_type'} = &domain_has_website($_[0]);
5582
5583&save_domain($_[0]);
5584
5585# Save the domain's data file
5586©_source_dest($_[0]->{'file'}, $_[1]);
5587
5588if (-r "$initial_users_dir/$_[0]->{'id'}") {
5589 # Initial user settings
5590 ©_source_dest("$initial_users_dir/$_[0]->{'id'}", $_[1]."_initial");
5591 }
5592if (-d "$extra_admins_dir/$_[0]->{'id'}") {
5593 # Extra admin details
5594 &execute_command(
5595 "cd ".quotemeta("$extra_admins_dir/$_[0]->{'id'}").
5596 " && ".&make_tar_command("cf", quotemeta($_[1]."_admins"), "."));
5597 }
5598if ($config{'bw_active'}) {
5599 # Bandwidth logs
5600 if (-r "$bandwidth_dir/$_[0]->{'id'}") {
5601 ©_source_dest("$bandwidth_dir/$_[0]->{'id'}", $_[1]."_bw");
5602 }
5603 else {
5604 # Create an empty file to indicate that we have no data
5605 &open_tempfile(EMPTY, ">".$_[1]."_bw");
5606 &close_tempfile(EMPTY);
5607 }
5608 }
5609# Script logs
5610if (-d "$script_log_directory/$_[0]->{'id'}") {
5611 &execute_command(
5612 "cd ".quotemeta("$script_log_directory/$_[0]->{'id'}").
5613 " && ".&make_tar_command("cf", quotemeta($_[1]."_scripts"), "."));
5614 }
5615else {
5616 # Create an empty file to indicate that we have no scripts
5617 &open_tempfile(EMPTY, ">".$_[1]."_scripts");
5618 &close_tempfile(EMPTY);
5619 }
5620
5621# Include template, in case the restore target doesn't have it
5622local ($tmpl) = grep { $_->{'id'} == $_[0]->{'template'} } &list_templates();
5623if (!$tmpl->{'standard'}) {
5624 ©_source_dest($tmpl->{'file'}, $_[1]."_template");
5625 }
5626
5627# Include plan too
5628local $plan = &get_plan($_[0]->{'plan'});
5629if ($plan) {
5630 ©_source_dest($plan->{'file'}, $_[1]."_plan");
5631 }
5632
5633# Save deleted aliases file
5634©_source_dest("$saved_aliases_dir/$_[0]->{'id'}",
5635 $_[1]."_saved_aliases");
5636
5637&$second_print($text{'setup_done'});
5638return 1;
5639}
5640
5641# virtualmin_backup_config(file, &vbs)
5642# Save the current module config to the specified file
5643sub virtualmin_backup_config
5644{
5645local ($file, $vbs) = @_;
5646&$first_print($text{'backup_vconfig_doing'});
5647©_source_dest($module_config_file, $file);
5648&$second_print($text{'setup_done'});
5649return 1;
5650}
5651
5652# virtualmin_restore_config(file, &vbs)
5653# Replace the current config with the given file, *except* for the default
5654# template settings
5655sub virtualmin_restore_config
5656{
5657local ($file, $vbs) = @_;
5658&$first_print($text{'restore_vconfig_doing'});
5659local %oldconfig = %config;
5660local @tmpls = &list_templates();
5661©_source_dest($file, $module_config_file);
5662&read_file($module_config_file, \%config);
5663foreach my $t (@tmpls) {
5664 if ($t->{'standard'}) {
5665 &save_template($t);
5666 }
5667 }
5668
5669# Put back site-specific settings, as those in the backup are unlikely to
5670# be correct.
5671$config{'iface'} = $oldconfig{'iface'};
5672$config{'defip'} = $oldconfig{'defip'};
5673$config{'sharedips'} = $oldconfig{'sharedips'};
5674$config{'sharedip6s'} = $oldconfig{'sharedip6s'};
5675$config{'home_quotas'} = $oldconfig{'home_quotas'};
5676$config{'mail_quotas'} = $oldconfig{'mail_quotas'};
5677$config{'group_quotas'} = $oldconfig{'group_quotas'};
5678$config{'old_defip'} = $oldconfig{'old_defip'};
5679$config{'old_defip6'} = $oldconfig{'old_defip6'};
5680$config{'last_check'} = $oldconfig{'last_check'};
5681
5682# Remove plugins that aren't on the new system
5683&generate_plugins_list($config{'plugins'});
5684$config{'plugins'} = join(' ', @plugins);
5685&save_module_config();
5686&$second_print($text{'setup_done'});
5687
5688# Apply any new config settings
5689&run_post_config_actions(\%oldconfig);
5690
5691return 1;
5692}
5693
5694# virtualmin_backup_templates(file, &vbs)
5695# Write a tar file of all templates (including scripts) to the given file
5696sub virtualmin_backup_templates
5697{
5698local ($file, $vbs) = @_;
5699&$first_print($text{'backup_vtemplates_doing'});
5700local $temp = &transname();
5701mkdir($temp, 0700);
5702foreach my $tmpl (&list_templates()) {
5703 my %tmplquoted = %$tmpl;
5704 foreach my $k (keys %tmplquoted) {
5705 $tmplquoted{$k} =~ s/\n/\\n/g;
5706 }
5707 &write_file("$temp/$tmpl->{'id'}", \%tmplquoted);
5708 }
5709
5710# Save template scripts
5711&execute_command("cp $template_scripts_dir/* $temp");
5712&execute_command("cd ".quotemeta($temp)." && ".
5713 &make_tar_command("cf", quotemeta($file), "."));
5714&unlink_file($temp);
5715
5716# Save global variables file
5717if (-r $global_template_variables_file) {
5718 ©_source_dest($global_template_variables_file, $file."_global");
5719 }
5720else {
5721 # Create empty, as an indicator that it exists
5722 &open_tempfile(GLOBAL, ">".$file."_global", 0, 1);
5723 &close_tempfile(GLOBAL);
5724 }
5725
5726# Save skeleton directories for all templates
5727local %done;
5728foreach my $tmpl (&list_templates()) {
5729 if ($tmpl->{'skel'} && $tmpl->{'skel'} ne 'none' &&
5730 !$done{$tmpl->{'skel'}}++ &&
5731 -d $tmpl->{'skel'}) {
5732 local $skelfile = $file.'_skel_'.$tmpl->{'id'};
5733 &execute_command(
5734 "cd ".quotemeta($tmpl->{'skel'}).
5735 " && ".&make_tar_command("cf", quotemeta($skelfile), "."));
5736 }
5737 }
5738
5739# Save plans
5740&make_dir($plans_dir, 0700);
5741&execute_command(
5742 "cd ".quotemeta($plans_dir).
5743 " && ".&make_tar_command("cf", quotemeta($file."_plans"), "."));
5744&$second_print($text{'setup_done'});
5745}
5746
5747# virtualmin_restore_templates(file, &vbs)
5748# Extract all templates from a backup. Those that already exist are not deleted.
5749sub virtualmin_restore_templates
5750{
5751local ($file, $vbs) = @_;
5752&$first_print($text{'restore_vtemplates_doing'});
5753
5754# Extract backup file
5755local $temp = &transname();
5756mkdir($temp, 0700);
5757&execute_command("cd ".quotemeta($temp)." && ".
5758 &make_tar_command("xf", quotemeta($file)));
5759
5760# Copy templates from backup across
5761opendir(DIR, $temp);
5762foreach my $t (readdir(DIR)) {
5763 next if ($t eq "." || $t eq "..");
5764 if ($t =~ /^(\d+)_(\d+)$/) {
5765 # A script file
5766 if (!-d $template_scripts_dir) {
5767 &make_dir($template_scripts_dir, 0755);
5768 }
5769 ©_source_dest("$temp/$t", "$template_scripts_dir/$t");
5770 }
5771 else {
5772 # A template file
5773 local %tmpl;
5774 &read_file("$temp/$t", \%tmpl);
5775 foreach my $k (keys %tmpl) {
5776 $tmpl{$k} =~ s/\\n/\n/g;
5777 }
5778 &save_template(\%tmpl);
5779 }
5780 }
5781closedir(DIR);
5782&execute_command("rm -rf ".quotemeta($temp));
5783
5784# Fix up bad Apache directives in templates
5785foreach my $tmpl (&list_templates()) {
5786 &fix_options_template($tmpl);
5787 }
5788
5789# Restore global variables
5790if (-r $file."_global") {
5791 ©_source_dest($file."_global", $global_template_variables_file);
5792 }
5793
5794# Restore skeleton directories
5795local %done;
5796foreach my $tmpl (&list_templates()) {
5797 if ($tmpl->{'skel'} && $tmpl->{'skel'} ne 'none' &&
5798 !$done{$tmpl->{'skel'}}++) {
5799 local $skelfile = $file.'_skel_'.$tmpl->{'id'};
5800 if (-r $skelfile) {
5801 # Delete and re-create skel directory
5802 &unlink_file($tmpl->{'skel'});
5803 &make_dir($tmpl->{'skel'}, 0755);
5804 &execute_command(
5805 "cd ".quotemeta($tmpl->{'skel'}).
5806 " && ".&make_tar_command("xf",
5807 quotemeta($skelfile)));
5808 }
5809 }
5810 }
5811
5812# Restore plans, if included
5813if (-r $file."_plans") {
5814 &execute_command(
5815 "cd ".quotemeta($plans_dir)." && ".
5816 &make_tar_command("xf", quotemeta($file."_plans")));
5817 }
5818
5819&$second_print($text{'setup_done'});
5820return 1;
5821}
5822
5823# virtualmin_backup_scheds(file, &vbs)
5824# Create a tar file of all scheduled backups and keys
5825sub virtualmin_backup_scheds
5826{
5827local ($file, $vbs) = @_;
5828local $dokeys = defined(&list_backup_keys) && scalar(&list_backup_keys());
5829&$first_print($dokeys ? $text{'backup_vscheds_doing2'}
5830 : $text{'backup_vscheds_doing'});
5831
5832# Tar up scheduled backups dir
5833local $temp = &transname();
5834mkdir($temp, 0700);
5835foreach my $sched (&list_scheduled_backups()) {
5836 &write_file("$temp/$sched->{'id'}", $sched);
5837 }
5838&execute_command("cd ".quotemeta($temp)." && ".
5839 &make_tar_command("cf", quotemeta($file), "."));
5840&unlink_file($temp);
5841
5842# Also tar up keys dir
5843if ($dokeys) {
5844 &execute_command("cd ".quotemeta($backup_keys_dir)." && ".
5845 &make_tar_command("cf", quotemeta($file."_keys"),"."));
5846 }
5847
5848&$second_print($text{'setup_done'});
5849return 1;
5850}
5851
5852# virtualmin_restore_scheds(file, vbs)
5853# Re-create all scheduled backups
5854sub virtualmin_restore_scheds
5855{
5856local ($file, $vbs) = @_;
5857local $dokeys = -r $file."_keys" && defined(&list_backup_keys);
5858&$first_print($dokeys ? $text{'restore_vscheds_doing'}
5859 : $text{'restore_vscheds_doing2'});
5860
5861# Extract backup file
5862local $temp = &transname();
5863mkdir($temp, 0700);
5864&execute_command("cd ".quotemeta($temp)." && ".
5865 &make_tar_command("xf", quotemeta($file)));
5866
5867# Delete all current non-default schedules
5868foreach my $sched (&list_scheduled_backups()) {
5869 if ($sched->{'id'} != 1) {
5870 &delete_scheduled_backup($sched);
5871 }
5872 }
5873
5874# Re-create the restored ones
5875opendir(BACKUPDIR, $temp);
5876foreach my $t (readdir(BACKUPDIR)) {
5877 next if ($t eq "." || $t eq "..");
5878 local %sched;
5879 &read_file("$temp/$t", \%sched);
5880 delete($sched{'file'});
5881 &save_scheduled_backup(\%sched);
5882 }
5883closedir(BACKUPDIR);
5884
5885# Extract dir of backup keys, then re-save each to re-import to root
5886if ($dokeys) {
5887 local %oldkeys = map { $_->{'id'}, 1 } &list_backup_keys();
5888 &make_dir($backup_keys_dir, 0700) if (!-d $backup_keys_dir);
5889 &execute_command("cd ".quotemeta($backup_keys_dir)." && ".
5890 &make_tar_command("xf", quotemeta($file."_keys")));
5891 foreach my $key (&list_backup_keys()) {
5892 if (!$oldkey{$key->{'id'}}) {
5893 eval {
5894 $main::error_must_die = 1;
5895 &save_backup_key($key, 1);
5896 };
5897 }
5898 }
5899 }
5900
5901&$second_print($text{'setup_done'});
5902return 1;
5903}
5904
5905# virtualmin_backup_resellers(file, &vbs)
5906# Create a tar file of reseller details. For each we need to store the Webmin
5907# user information, plus all ACL files
5908sub virtualmin_backup_resellers
5909{
5910local ($file, $vbs) = @_;
5911return undef if (!defined(&list_resellers));
5912&$first_print($text{'backup_vresellers_doing'});
5913local $temp = &transname();
5914mkdir($temp, 0700);
5915foreach my $resel (&list_resellers()) {
5916 &open_tempfile(RESEL, ">$temp/$resel->{'name'}.webmin");
5917 &print_tempfile(RESEL, &serialise_variable($resel));
5918 &close_tempfile(RESEL);
5919 local $acldir = "$temp/$resel->{'name'}.acls";
5920 mkdir($acldir, 0700);
5921 foreach my $m (@{$resel->{'modules'}}) {
5922 local %acl = &get_module_acl($resel->{'name'}, $m, 1, 1);
5923 &write_file("$acldir/$m", \%acl);
5924 }
5925 }
5926&execute_command("cd ".quotemeta($temp)." && ".
5927 &make_tar_command("cf", quotemeta($file), "."));
5928&execute_command("rm -rf ".quotemeta($temp));
5929&$second_print($text{'setup_done'});
5930return 1;
5931}
5932
5933# virtualmin_restore_resellers(file, &vbs)
5934# Delete all resellers and re-create them from the backup
5935sub virtualmin_restore_resellers
5936{
5937local ($file, $vbs) = @_;
5938return undef if (!defined(&list_resellers));
5939&$first_print($text{'restore_vresellers_doing'});
5940local $temp = &transname();
5941mkdir($temp, 0700);
5942&require_acl();
5943&execute_command("cd ".quotemeta($temp)." && ".
5944 &make_tar_command("xf", quotemeta($file)));
5945foreach my $resel (&list_resellers()) {
5946 &acl::delete_user($resel->{'name'});
5947 }
5948local %miniserv;
5949&get_miniserv_config(\%miniserv);
5950if (&check_pid_file($miniserv{'pidfile'})) {
5951 &reload_miniserv();
5952 }
5953opendir(DIR, $temp);
5954foreach my $f (readdir(DIR)) {
5955 if ($f =~ /^(.*)\.webmin$/) {
5956 local $acldir = "$temp/$1";
5957 local $ser = &read_file_contents("$temp/$f");
5958 local $resel = &unserialise_variable($ser);
5959 &create_reseller($resel);
5960 opendir(ACL, $acldir);
5961 foreach my $a (readdir(ACL)) {
5962 next if ($a eq "." || $a eq "..");
5963 local %acl;
5964 &read_file("$acldir/$a", \%acl);
5965 &save_module_acl(\%acl, $resel->{'name'}, $a);
5966 }
5967 closedir(ACL);
5968 }
5969 }
5970&unlink_file($temp);
5971&$second_print($text{'setup_done'});
5972return 1;
5973}
5974
5975# virtualmin_backup_email(file, &vbs)
5976# Creates a tar file of all email templates
5977sub virtualmin_backup_email
5978{
5979local ($file, $vbs) = @_;
5980&$first_print($text{'backup_vemail_doing'});
5981&execute_command(
5982 "cd $module_config_directory && ".
5983 &make_tar_command("cf", quotemeta($file), @all_template_files));
5984&$second_print($text{'setup_done'});
5985return 1;
5986}
5987
5988# virtualmin_restore_email(file, &vbs)
5989# Extract a tar file of all email templates
5990sub virtualmin_restore_email
5991{
5992local ($file, $vbs) = @_;
5993&$first_print($text{'restore_vemail_doing'});
5994&execute_command("cd $module_config_directory && ".
5995 &make_tar_command("xf", quotemeta($file)));
5996&$second_print($text{'setup_done'});
5997return 1;
5998}
5999
6000# virtualmin_backup_custom(file, &vbs)
6001# Copies the custom fields, links and shells files
6002sub virtualmin_backup_custom
6003{
6004local ($file, $vbs) = @_;
6005&$first_print($text{'backup_vcustom_doing'});
6006foreach my $fm ([ $custom_fields_file, $file ],
6007 [ $custom_links_file, $file."_links" ],
6008 [ $custom_link_categories_file, $file."_linkcats" ],
6009 [ $custom_shells_file, $file."_shells" ]) {
6010 if (-r $fm->[0]) {
6011 ©_source_dest($fm->[0], $fm->[1]);
6012 }
6013 else {
6014 &create_empty_file($fm->[1]);
6015 }
6016 }
6017&$second_print($text{'setup_done'});
6018return 1;
6019}
6020
6021# virtualmin_restore_custom(file, &vbs)
6022# Restores the custom fields, links and shells files
6023sub virtualmin_restore_custom
6024{
6025local ($file, $vbs) = @_;
6026&$first_print($text{'restore_vcustom_doing'});
6027foreach my $fm ([ $custom_fields_file, $file ],
6028 [ $custom_links_file, $file."_links" ],
6029 [ $custom_link_categories_file, $file."_linkcats" ]) {
6030 if (-r $fm->[1]) {
6031 ©_source_dest($fm->[1], $fm->[0]);
6032 }
6033 }
6034if (-s $file."_shells") {
6035 # A non-empty shells file means that the original system defined some
6036 # custom shells.
6037 ©_source_dest($file."_shells", $custom_shells_file);
6038 }
6039elsif (-r $file."_shells") {
6040 # An empty shells file means that the original system was using the
6041 # default shells, so so should we
6042 &unlink_file($custom_shells_file);
6043 }
6044&$second_print($text{'setup_done'});
6045return 1;
6046}
6047
6048# virtualmin_backup_scripts(file, &vbs)
6049# Create a tar file of the scripts directory, and of the unavailable scripts
6050sub virtualmin_backup_scripts
6051{
6052local ($file, $vbs) = @_;
6053&$first_print($text{'backup_vscripts_doing'});
6054&make_dir("$module_config_directory/scripts", 0755);
6055&execute_command("cd $module_config_directory/scripts && ".
6056 &make_tar_command("cf", quotemeta($file), "."));
6057©_source_dest($scripts_unavail_file, $file."_unavail");
6058&$second_print($text{'setup_done'});
6059return 1;
6060}
6061
6062# virtualmin_restore_scripts(file, &vbs)
6063# Extract a tar file of all third-party scripts
6064sub virtualmin_restore_scripts
6065{
6066local ($file, $vbs) = @_;
6067&$first_print($text{'restore_vscripts_doing'});
6068&make_dir("$module_config_directory/scripts", 0755);
6069&execute_command("cd $module_config_directory/scripts && ".
6070 &make_tar_command("xf", quotemeta($file)));
6071if (-r $file."_unavail") {
6072 ©_source_dest($file."_unavail", $scripts_unavail_file);
6073 }
6074&$second_print($text{'setup_done'});
6075return 1;
6076}
6077
6078# virtualmin_backup_styles(file, &vbs)
6079# Create a tar file of the styles directory, and of the unavailable styles
6080sub virtualmin_backup_styles
6081{
6082local ($file, $vbs) = @_;
6083&$first_print($text{'backup_vstyles_doing'});
6084&execute_command("cd $module_config_directory/styles && ".
6085 &make_tar_command("cf", quotemeta($file), "."));
6086©_source_dest($styles_unavail_file, $file."_unavail");
6087&$second_print($text{'setup_done'});
6088return 1;
6089}
6090
6091# virtualmin_restore_styles(file, &vbs)
6092# Extract a tar file of all third-party styles
6093sub virtualmin_restore_styles
6094{
6095local ($file, $vbs) = @_;
6096&$first_print($text{'restore_vstyles_doing'});
6097&make_dir("$module_config_directory/styles", 0755);
6098&execute_command("cd $module_config_directory/styles && ".
6099 &make_tar_command("xf", quotemeta($file)));
6100if (-r $file."_unavail") {
6101 ©_source_dest($file."_unavail", $styles_unavail_file);
6102 }
6103&$second_print($text{'setup_done'});
6104return 1;
6105}
6106
6107# virtualmin_backup_chroot(file, &vbs)
6108# Create a file of FTP directory restrictions
6109sub virtualmin_backup_chroot
6110{
6111local ($file, $vbs) = @_;
6112&$first_print($text{'backup_vchroot_doing'});
6113local @chroots = &list_ftp_chroots();
6114&open_tempfile(CHROOT, ">$file");
6115foreach my $c (@chroots) {
6116 &print_tempfile(CHROOT,
6117 join(" ", map { $_."=".&urlize($c->{$_}) }
6118 grep { $_ ne 'dr' } keys %$c),"\n");
6119 }
6120&close_tempfile(CHROOT);
6121&$second_print($text{'setup_done'});
6122return 1;
6123}
6124
6125# virtualmin_restore_chroot(file, &vbs)
6126# Restore all chroot'd directories from a backup file
6127sub virtualmin_restore_chroot
6128{
6129local ($file, $vbs) = @_;
6130&$first_print($text{'restore_vchroot_doing'});
6131&obtain_lock_ftp();
6132local @chroots;
6133open(CHROOT, $file);
6134while(<CHROOT>) {
6135 s/\r|\n//g;
6136 local %c = map { my ($n, $v) = split(/=/, $_, 2);
6137 ($n, &un_urlize($v)) }
6138 split(/\s+/, $_);
6139 push(@chroots, \%c);
6140 }
6141close(CHROOT);
6142&save_ftp_chroots(\@chroots);
6143&release_lock_ftp();
6144&$second_print($text{'setup_done'});
6145return 1;
6146}
6147
6148# virtualmin_backup_mailserver(file, &vbs)
6149# Save DKIM and Postgrey settings to a file
6150sub virtualmin_backup_mailserver
6151{
6152local ($file, $vbs) = @_;
6153&require_mail();
6154
6155# Save DKIM settings
6156&$first_print($text{'backup_vmailserver_dkim'});
6157local %dkim;
6158if (!&check_dkim()) {
6159 # DKIM can be used .. check if enabled
6160 $dkim{'support'} = 1;
6161 local $conf = &get_dkim_config();
6162 $dkim{'enabled'} = $conf->{'enabled'};
6163 $dkim{'selector'} = $conf->{'selector'};
6164 $dkim{'extra'} = join(" ", @{$conf->{'extra'}});
6165 $dkim{'keyfile'} = $conf->{'keyfile'};
6166 $dkim{'sign'} = $conf->{'sign'};
6167 $dkim{'verify'} = $conf->{'verify'};
6168 if ($conf->{'keyfile'} && -r $conf->{'keyfile'}) {
6169 ©_source_dest($conf->{'keyfile'}, $file."_dkimkey");
6170 }
6171 &$second_print($text{'setup_done'});
6172 }
6173else {
6174 $dkim{'support'} = 0;
6175 &$second_print($text{'backup_vmailserver_none'});
6176 }
6177&write_file($file."_dkim", \%dkim);
6178
6179# Save Postgrey settings
6180&$first_print($text{'backup_vmailserver_postgrey'});
6181local %grey;
6182if (!&check_postgrey()) {
6183 # Postgrey can be used .. check if enabled, and with what opts
6184 $grey{'support'} = 1;
6185 $grey{'enabled'} = &is_postgrey_enabled();
6186 local $cfile = &get_postgrey_data_file("clients");
6187 if ($cfile) {
6188 ©_source_dest($cfile, $file."_greyclients");
6189 }
6190 local $rfile = &get_postgrey_data_file("recipients");
6191 if ($rfile) {
6192 ©_source_dest($rfile, $file."_greyrecipients");
6193 }
6194 &$second_print($text{'setup_done'});
6195 }
6196else {
6197 $grey{'support'} = 0;
6198 &$second_print($text{'backup_vmailserver_none'});
6199 }
6200&write_file($file."_grey", \%grey);
6201
6202# Save rate limiting settings
6203&$first_print($text{'backup_vmailserver_ratelimit'});
6204local %ratelimit;
6205if (!&check_ratelimit()) {
6206 # Rate limiting can be used .. check if enabled, and save config
6207 $ratelimit{'support'} = 1;
6208 $ratelimit{'enabled'} = &is_ratelimit_enabled();
6209 ©_source_dest(&get_ratelimit_config_file(),
6210 $file."_ratelimitconfig");
6211 &$second_print($text{'setup_done'});
6212 }
6213else {
6214 $ratelimit{'support'} = 0;
6215 &$second_print($text{'backup_vmailserver_none'});
6216 }
6217&write_file($file."_ratelimit", \%ratelimit);
6218
6219# Save mail server type
6220&$first_print($text{'backup_vmailserver_doing'});
6221&open_tempfile(MS, ">$file", 0, 1);
6222&print_tempfile(MS, $config{'mail_system'},"\n");
6223&close_tempfile(MS);
6224
6225# Save general mail server settings
6226if ($config{'mail_system'} == 0) {
6227 # Save main.cf and master.cf
6228 ©_source_dest($postfix::config{'postfix_config_file'},
6229 $file."_maincf");
6230 ©_source_dest($postfix::config{'postfix_master'},
6231 $file."_mastercf");
6232 &$second_print($text{'setup_done'});
6233 }
6234elsif ($config{'mail_system'} == 1) {
6235 # Save sendmail.cf and sendmail.mc
6236 ©_source_dest($sendmail::config{'sendmail_cf'},
6237 $file."_sendmailcf");
6238 ©_source_dest($sendmail::config{'sendmail_mc'},
6239 $file."_sendmailmc");
6240 &$second_print($text{'setup_done'});
6241 }
6242elsif ($config{'mail_system'} == 2 || $config{'mail_system'} == 4 ||
6243 $config{'mail_system'} == 5) {
6244 # Save Qmail dir
6245 &execute_command("cd $qmailadmin::config{'qmail_dir'} && ".
6246 &make_tar_command("cf", quotemeta($file), "."));
6247 &$second_print($text{'setup_done'});
6248 }
6249else {
6250 &$second_print($text{'backup_vmailserver_supp'});
6251 }
6252return 1;
6253}
6254
6255# virtualmin_restore_mailserver(file, &vbs)
6256# Apply DKIM and Postgrey settings from the backup
6257sub virtualmin_restore_mailserver
6258{
6259local ($file, $vbs) = @_;
6260&require_mail();
6261
6262# Restore DKIM config
6263&$first_print($text{'restore_vmailserver_dkim'});
6264&obtain_lock_mail();
6265if (!&check_dkim()) {
6266 # DKIM supported .. see what state was in the backup
6267 local %dkim;
6268 &read_file($file."_dkim", \%dkim);
6269 if (!$dkim{'support'}) {
6270 &$second_print($text{'restore_vmailserver_none'});
6271 }
6272 else {
6273 local $conf = &get_dkim_config();
6274 if ($dkim{'enabled'}) {
6275 # Setup on this system, same as source
6276 &$indent_print();
6277 $conf->{'enabled'} = $dkim{'enabled'};
6278 $conf->{'selector'} = $dkim{'selector'};
6279 $conf->{'extra'} = [ split(/\s+/, $dkim{'extra'}) ];
6280 $conf->{'sign'} = $dkim{'sign'};
6281 $conf->{'verify'} = $dkim{'verify'};
6282 local $copiedkey = 0;
6283 if ($conf->{'keyfile'} && -r $file."_dkimkey") {
6284 # Can copy key now
6285 ©_source_dest($file."_dkimkey",
6286 $conf->{'keyfile'});
6287 $copiedkey = 1;
6288 }
6289 &enable_dkim($conf);
6290 $conf = &get_dkim_config();
6291 if ($conf->{'keyfile'} && -r $file."_dkimkey" &&
6292 !$copiedkey) {
6293 # Copy key file and re-enable DKIM
6294 ©_source_dest($file."_dkimkey",
6295 $conf->{'keyfile'});
6296 &enable_dkim($conf);
6297 }
6298 &$outdent_print();
6299 &$second_print($text{'setup_done'});
6300 }
6301 elsif ($conf->{'enabled'} && !$dkim{'enabled'}) {
6302 # Disable on this system
6303 &$indent_print();
6304 &disable_dkim($conf);
6305 &$outdent_print();
6306 &$second_print($text{'setup_done'});
6307 }
6308 else {
6309 # Nothing to do
6310 &$second_print($text{'restore_vmailserver_already'});
6311 }
6312 }
6313 }
6314else {
6315 &$second_print($text{'backup_vmailserver_none'});
6316 }
6317
6318# Restore Postgrey config
6319&$first_print($text{'restore_vmailserver_grey'});
6320local %grey;
6321&read_file($file."_grey", \%grey);
6322if (&check_postgrey() ne '' && &can_install_postgrey() && $grey{'enabled'}) {
6323 # Postgrey is not installed on this system yet, but it was enabled
6324 # on the old machine - try to install it now
6325 &install_postgrey_package();
6326 }
6327if (&check_postgrey() eq '') {
6328 if (!$grey{'support'}) {
6329 &$second_print($text{'restore_vmailserver_none'});
6330 }
6331 else {
6332 local $enabled = &is_postgrey_enabled();
6333 if ($grey{'enabled'}) {
6334 # Enable on this system, and copy client files
6335 &$indent_print();
6336 &enable_postgrey();
6337 local $cfile = &get_postgrey_data_file("clients");
6338 if ($cfile && -r $file."_greyclients") {
6339 ©_source_dest($file."_greyclients",
6340 $cfile);
6341 }
6342 local $rfile = &get_postgrey_data_file("recipients");
6343 if ($rfile && -r $file."_greyrecipients") {
6344 ©_source_dest($file."_greyrecipients",
6345 $rfile);
6346 }
6347 &apply_postgrey_data();
6348 &$outdent_print();
6349 &$second_print($text{'setup_done'});
6350 }
6351 elsif ($enabled && !$grey{'enabled'}) {
6352 # Disable on this system
6353 &$indent_print();
6354 &disable_postgrey();
6355 &$outdent_print();
6356 &$second_print($text{'setup_done'});
6357 }
6358 else {
6359 # Nothing to do
6360 &$second_print($text{'restore_vmailserver_already'});
6361 }
6362 }
6363 }
6364else {
6365 &$second_print($text{'backup_vmailserver_none'});
6366 }
6367
6368# Restore rate limiting config
6369&$first_print($text{'restore_vmailserver_ratelimit'});
6370local %ratelimit;
6371&read_file($file."_ratelimit", \%ratelimit);
6372if (&check_ratelimit() ne '' && &can_install_ratelimit() &&
6373 $ratelimit{'enabled'}) {
6374 # Rate limiting is not installed on this system yet, but it was enabled
6375 # on the old machine - try to install it now
6376 &install_ratelimit_package();
6377 }
6378if (&check_ratelimit() eq '') {
6379 if (!$ratelimit{'support'}) {
6380 &$second_print($text{'restore_vmailserver_none'});
6381 }
6382 else {
6383 local $enabled = &is_ratelimit_enabled();
6384 # XXX put back socket
6385 if ($ratelimit{'enabled'}) {
6386 # Enable on this system, and copy config file
6387 &$indent_print();
6388 &enable_ratelimit();
6389 my $conf = &get_ratelimit_config();
6390 my ($oldsocket) = grep { $_->{'name'} eq 'socket' }
6391 @$conf;
6392 ©_source_dest($file."_ratelimitconfig",
6393 &get_ratelimit_config_file());
6394 my $conf = &get_ratelimit_config();
6395 my ($socket) = grep { $_->{'name'} eq 'socket' }
6396 @$conf;
6397 &save_ratelimit_directive($conf, $socket, $oldsocket);
6398 &$outdent_print();
6399 &$second_print($text{'setup_done'});
6400 }
6401 elsif ($enabled && !$ratelimit{'enabled'}) {
6402 # Disable on this system
6403 &$indent_print();
6404 &disable_ratelimit();
6405 &$outdent_print();
6406 &$second_print($text{'setup_done'});
6407 }
6408 else {
6409 # Nothing to do
6410 &$second_print($text{'restore_vmailserver_already'});
6411 }
6412 }
6413 }
6414
6415&release_lock_mail();
6416
6417# Get mail server type from the backup
6418local $bms = &read_file_contents($file);
6419$bms =~ s/\n//g;
6420
6421# Restore mail server type, if matching. This is done last because DKIM or
6422# greylisting might be detected as disabled if done earlier.
6423&$first_print($text{'restore_vmailserver_doing'});
6424&obtain_lock_mail();
6425if ($bms eq $config{'mail_system'}) {
6426 if ($config{'mail_system'} == 0) {
6427 # Restore main.cf and master.cf
6428 &lock_file($postfix::config{'postfix_config_file'});
6429 &lock_file($postfix::config{'postfix_master'});
6430 ©_source_dest($file."_maincf",
6431 $postfix::config{'postfix_config_file'});
6432 ©_source_dest($file."_mastercf",
6433 $postfix::config{'postfix_master'});
6434 &unlock_file($postfix::config{'postfix_master'});
6435 &unlock_file($postfix::config{'postfix_config_file'});
6436 undef(@postfix::master_config_cache);
6437 &$second_print($text{'setup_done'});
6438 }
6439 elsif ($config{'mail_system'} == 1) {
6440 # Restore sendmail.cf and .mc
6441 &lock_file($sendmail::config{'sendmail_cf'});
6442 &lock_file($sendmail::config{'sendmail_mc'});
6443 ©_source_dest($file."_sendmailcf",
6444 $sendmail::config{'sendmail_cf'});
6445 ©_source_dest($file."_sendmailmc",
6446 $sendmail::config{'sendmail_mc'});
6447 &unlock_file($sendmail::config{'sendmail_mc'});
6448 &unlock_file($sendmail::config{'sendmail_cf'});
6449 undef(@sendmail::sendmailcf_cache);
6450 &$second_print($text{'setup_done'});
6451 }
6452 elsif ($config{'mail_system'} == 2 || $config{'mail_system'} == 4 ||
6453 $config{'mail_system'} == 5) {
6454 # Un-tar qmail dir
6455 &execute_command("cd $qmailadmin::config{'qmail_dir'} && ".
6456 &make_tar_command("xf", quotemeta($file)));
6457 &$second_print($text{'setup_done'});
6458 }
6459 else {
6460 &$second_print($text{'backup_vmailserver_supp'});
6461 }
6462 }
6463else {
6464 &$second_print(&text('restore_vmailserver_wrong',
6465 $text{'mail_system_'.$bms},
6466 $text{'mail_system_'.$config{'mail_system'}}));
6467 }
6468&release_lock_mail();
6469
6470return 1;
6471}
6472
6473# restore_virtualmin(&domain, file, &opts, &allopts)
6474# Restore the settings for a domain, such as quota, password and so on. Only
6475# selected settings are copied from the backup, such as limits.
6476sub restore_virtualmin
6477{
6478if (!$_[3]->{'fix'}) {
6479 # Merge current and backup configs
6480 &$first_print($text{'restore_virtualmincp'});
6481 local %oldd;
6482 &read_file($_[1], \%oldd);
6483 $_[0]->{'quota'} = $oldd{'quota'};
6484 $_[0]->{'uquota'} = $oldd{'uquota'};
6485 $_[0]->{'bw_limit'} = $oldd{'bw_limit'};
6486 $_[0]->{'pass'} = $oldd{'pass'};
6487 $_[0]->{'email'} = $oldd{'email'};
6488 foreach my $l (@limit_types) {
6489 $_[0]->{$l} = $oldd{$l};
6490 }
6491 $_[0]->{'nodbname'} = $oldd{'nodbname'};
6492 $_[0]->{'norename'} = $oldd{'norename'};
6493 $_[0]->{'forceunder'} = $oldd{'forceunder'};
6494 $_[0]->{'safeunder'} = $oldd{'safeunder'};
6495 $_[0]->{'ipfollow'} = $oldd{'ipfollow'};
6496 foreach my $f (@opt_features, &list_feature_plugins(), "virt") {
6497 $_[0]->{'limit_'.$f} = $oldd{'limit_'.$f};
6498 }
6499 $_[0]->{'owner'} = $oldd{'owner'};
6500 $_[0]->{'proxy_pass_mode'} = $oldd{'proxy_pass_mode'};
6501 $_[0]->{'proxy_pass'} = $oldd{'proxy_pass'};
6502 foreach my $f (&list_custom_fields()) {
6503 $_[0]->{$f->{'name'}} = $oldd{$f->{'name'}};
6504 }
6505 # Disable any features that are not on this system, as they can't
6506 # be restored from the backup anyway.
6507 foreach my $f (@features) {
6508 next if ($f eq 'dir' || $f eq 'unix'); # Always on
6509 if ($d->{$f} && !$config{$f}) {
6510 $d->{$f} = 0;
6511 }
6512 }
6513 &save_domain($_[0]);
6514 if (-r $_[1]."_initial") {
6515 # Also restore user defaults file
6516 ©_source_dest($_[1]."_initial",
6517 "$initial_users_dir/$_[0]->{'id'}");
6518 }
6519 if (-r $_[1]."_admins") {
6520 # Also restore extra admins
6521 &execute_command(
6522 "rm -rf ".quotemeta("$extra_admins_dir/$_[0]->{'id'}"));
6523 if (!-d $extra_admins_dir) {
6524 &make_dir($extra_admins_dir, 755);
6525 }
6526 &make_dir("$extra_admins_dir/$_[0]->{'id'}", 0755);
6527 &execute_command(
6528 "cd ".quotemeta("$extra_admins_dir/$_[0]->{'id'}")." && ".
6529 &make_tar_command("xf", quotemeta($_[1]."_admins"), "."));
6530 }
6531 if ($config{'bw_active'} && -r $_[1]."_bw" &&
6532 !-r "$bandwidth_dir/$_[0]->{'id'}") {
6533 # Also restore bandwidth files for the domain, but only
6534 # if missing.
6535 &make_dir($bandwidth_dir, 0700);
6536 ©_source_dest($_[1]."_bw", "$bandwidth_dir/$_[0]->{'id'}");
6537 }
6538 if (-r $_[1]."_scripts") {
6539 # Also restore script logs
6540 &execute_command("rm -rf ".
6541 quotemeta("$script_log_directory/$_[0]->{'id'}"));
6542 if (-s $_[1]."_scripts") {
6543 if (!-d $script_log_directory) {
6544 &make_dir($script_log_directory, 0755);
6545 }
6546 &make_dir("$script_log_directory/$_[0]->{'id'}", 0755);
6547 &execute_command(
6548 "cd ".quotemeta("$script_log_directory/$_[0]->{'id'}").
6549 " && ".
6550 &make_tar_command("xf",
6551 quotemeta($_[1]."_scripts"), "."));
6552 }
6553
6554 # Fix up home dir on scripts
6555 if ($_[5]->{'home'} && $_[5]->{'home'} ne $_[0]->{'home'}) {
6556 local $olddir = $_[5]->{'home'};
6557 local $newdir = $_[0]->{'home'};
6558 foreach my $sinfo (&list_domain_scripts($_[0])) {
6559 $sinfo->{'opts'}->{'dir'} =~
6560 s/^\Q$olddir\E\//$newdir\//;
6561 &save_domain_script($_[0], $sinfo);
6562 }
6563 }
6564 }
6565 if (-r $_[1]."_saved_aliases") {
6566 # Restore saved aliases
6567 &make_dir($saved_aliases_dir, 0700);
6568 ©_source_dest($_[1]."_saved_aliases",
6569 "$saved_aliases_dir/$_[0]->{'id'}");
6570 }
6571 &$second_print($text{'setup_done'});
6572 }
6573return 1;
6574}
6575
6576# scp_copy(source, dest, password, &error, port, [as-user])
6577# Copies a file from some source to a destination. One or the other can be
6578# a server, like user@foo:/path/to/bar/
6579sub scp_copy
6580{
6581local ($src, $dest, $pass, $err, $port, $asuser) = @_;
6582if ($src =~ /\s/) {
6583 my ($host, $path) = split(/:/, $src, 2);
6584 $src = $host.":".quotemeta($path);
6585 }
6586if ($dest =~ /\s/) {
6587 my ($host, $path) = split(/:/, $dest, 2);
6588 $dest = $host.":".quotemeta($path);
6589 }
6590local $cmd = "scp -r ".($port ? "-P $port " : "").$config{'ssh_args'}." ".
6591 quotemeta($src)." ".quotemeta($dest);
6592&run_ssh_command($cmd, $pass, $err, $asuser);
6593}
6594
6595# run_ssh_command(command, pass, &error, [as-user])
6596# Attempt to run some command that uses ssh or scp, feeding in a password.
6597# Returns the output, and sets the error variable ref if failed.
6598sub run_ssh_command
6599{
6600local ($cmd, $pass, $err, $asuser) = @_;
6601&foreign_require("proc");
6602if ($asuser) {
6603 $cmd = &command_as_user($asuser, 0, $cmd);
6604 }
6605local ($fh, $fpid) = &proc::pty_process_exec($cmd);
6606local $out;
6607while(1) {
6608 local $rv = &wait_for($fh, "password:", "yes\\/no", ".*\n");
6609 $out .= $wait_for_input;
6610 if ($rv == 0) {
6611 syswrite($fh, "$pass\n");
6612 }
6613 elsif ($rv == 1) {
6614 syswrite($fh, "yes\n");
6615 }
6616 elsif ($rv < 0) {
6617 last;
6618 }
6619 }
6620close($fh);
6621local $got = waitpid($fpid, 0);
6622if ($? || $out =~ /permission\s+denied/i || $out =~ /connection\s+refused/i) {
6623 $$err = $out;
6624 }
6625return $out;
6626}
6627
6628# free_ip_address(&template|&acl)
6629# Returns an IP address within the allocation range which is not currently used.
6630# Checks this system's configured interfaces, and does pings.
6631sub free_ip_address
6632{
6633local ($tmpl) = @_;
6634local %taken = &interface_ip_addresses();
6635local @ranges = split(/\s+/, $tmpl->{'ranges'});
6636foreach my $rn (@ranges) {
6637 my ($r, $n) = split(/\//, $rn);
6638 $r =~ /^(\d+\.\d+\.\d+)\.(\d+)\-(\d+)$/ || next;
6639 local ($base, $s, $e) = ($1, $2, $3);
6640 for(my $j=$s; $j<=$e; $j++) {
6641 local $try = "$base.$j";
6642 if (!$taken{$try} && !&ping_ip_address($try)) {
6643 return wantarray ? ( $try, $n ) : $try;
6644 }
6645 }
6646 }
6647return wantarray ? ( ) : undef;
6648}
6649
6650# free_ip6_address(&template|&acl)
6651# Returns an IPv6 address within the allocation range which is not currently
6652# used. Checks this system's configured interfaces, and does pings.
6653sub free_ip6_address
6654{
6655local ($tmpl) = @_;
6656local %taken = &interface_ip_addresses();
6657local @ranges = split(/\s+/, $tmpl->{'ranges6'});
6658foreach my $rn (@ranges) {
6659 my ($r, $n) = split(/\//, lc($rn));
6660 $r =~ /^([0-9a-f:]+):([0-9a-f]+)\-([0-9a-f]+)$/ || next;
6661 local ($base, $s, $e) = ($1, $2, $3);
6662 for(my $j=hex($s); $j<=hex($e); $j++) {
6663 local $try = sprintf "%s:%x", $base, $j;
6664 if (!$taken{$try} && !&ping_ip_address($try)) {
6665 return wantarray ? ( $try, $n ) : $try;
6666 }
6667 }
6668 }
6669return wantarray ? ( ) : undef;
6670}
6671
6672# interface_ip_addresses()
6673# Returns a hash of IP addresses that are in use by network interfaces, both
6674# active and boot-time
6675sub interface_ip_addresses
6676{
6677local %taken;
6678foreach my $ip (&active_ip_addresses(), &bootup_ip_addresses()) {
6679 $taken{$ip} = 1;
6680 }
6681return %taken;
6682}
6683
6684# active_ip_addresses()
6685# Returns a list of IP addresses (v4 and v6) that are active on the system
6686# right now.
6687sub active_ip_addresses
6688{
6689&foreign_require("net");
6690local @rv;
6691push(@rv, map { $_->{'address'} } &net::active_interfaces());
6692if (&supports_ip6()) {
6693 push(@rv, map { $_->{'address'} } &active_ip6_interfaces());
6694 }
6695if (&has_command("ip")) {
6696 # On Linux, the 'ip' command sometimes includes IPs that are not
6697 # shown by ifconfig -a
6698 local $out = &backquote_command("ip addr </dev/null 2>/dev/null");
6699 foreach my $l (split(/\r?\n/, $out)) {
6700 if ($l =~ /inet\s+([0-9\.]+)/) {
6701 push(@rv, $1);
6702 }
6703 if ($l =~ /inet6\s+([a-f0-9:]+)/) {
6704 push(@rv, $1);
6705 }
6706 }
6707 }
6708return grep { $_ ne '' } &unique(@rv);
6709}
6710
6711# bootup_ip_addresses()
6712# Returns a list of IP addresses (v4 and v6) that are activated at boot time
6713sub bootup_ip_addresses
6714{
6715&foreign_require("net");
6716local @rv;
6717foreach my $i (&net::boot_interfaces()) {
6718 if ($i->{'range'} && $i->{'start'} && $i->{'end'}) {
6719 local $start = &net::ip_to_integer($i->{'start'});
6720 local $end = &net::ip_to_integer($i->{'end'});
6721 for(my $j=$start; $j<=$end; $j++) {
6722 push(@rv, &net::integer_to_ip($j));
6723 }
6724 }
6725 elsif ($i->{'address'}) {
6726 push(@rv, $i->{'address'});
6727 }
6728 }
6729if (&supports_ip6()) {
6730 push(@rv, map { $_->{'address'} } &boot_ip6_interfaces());
6731 }
6732return grep { $_ ne '' } &unique(@rv);
6733}
6734
6735# ping_ip_address(hostname|ip|ipv6)
6736# Returns 1 if some host responds to a ping in 1 second
6737sub ping_ip_address
6738{
6739local ($host) = @_;
6740local $pinger = &check_ip6address($host) ? "ping6" : "ping";
6741local $pingcmd = $gconfig{'os_type'} =~ /-linux$/ ? "$pinger -c 1 -t 1"
6742 : $pinger;
6743local ($out, $timed_out) = &backquote_with_timeout(
6744 $pingcmd." ".$host." 2>&1", 1, 1);
6745return !$timed_out && !$?;
6746}
6747
6748# parse_ip_ranges(ranges)
6749# Returns a list of all IP allocation ranges, each of which is a 3-element
6750# array of starting IP, ending IP and optional netmask
6751sub parse_ip_ranges
6752{
6753local @rv;
6754local @ranges = split(/\s+/, $_[0]);
6755foreach my $rn (@ranges) {
6756 my ($r, $n) = split(/\//, $rn);
6757 if ($r =~ /^(\d+\.\d+\.\d+)\.(\d+)\-(\d+)$/) {
6758 # IPv4 range
6759 push(@rv, [ "$1.$2", "$1.$3", $n ]);
6760 }
6761 elsif ($r =~ /^([0-9a-f:]+):([0-9a-f]+)-([0-9a-f]+)$/i) {
6762 # IPv6 range
6763 push(@rv, [ "$1:$2", "$1:$3", $n ]);
6764 }
6765 }
6766return @rv;
6767}
6768
6769# join_ip_ranges(&ranges)
6770# Converts a list of ranges into a string
6771sub join_ip_ranges
6772{
6773local @ranges;
6774foreach my $r (@{$_[0]}) {
6775 if (&check_ipaddress($r->[0])) {
6776 # IPv4 range
6777 local @start = split(/\./, $r->[0]);
6778 local @end = split(/\./, $r->[1]);
6779 push(@ranges, join(".", @start)."-".$end[3].
6780 ($r->[2] ? "/".$r->[2] : ""));
6781 }
6782 elsif (&check_ip6address($r->[0])) {
6783 # IPv6 range
6784 local @end = split(/:/, $r->[1]);
6785 push(@ranges, $r->[0]."-".$end[$#end].
6786 ($r->[2] ? "/".$r->[2] : ""));
6787 }
6788 }
6789return join(" ", @ranges);
6790}
6791
6792# ip_within_ranges(ip, ranges-string)
6793# Returns 1 if some IP falls within a space-separated list of ranges
6794sub ip_within_ranges
6795{
6796my ($ip, $ranges) = @_;
6797&foreign_require("net");
6798my $n = &net::ip_to_integer($ip);
6799foreach my $r (&parse_ip_ranges($ranges)) {
6800 if (&check_ipaddress($r->[0])) {
6801 # IPv4 range
6802 if ($n >= &net::ip_to_integer($r->[0]) &&
6803 $n <= &net::ip_to_integer($r->[1])) {
6804 return 1;
6805 }
6806 }
6807 elsif (&check_ip6address($r->[0])) {
6808 # IPv6 range
6809 my ($p, $n) = split(/\//, lc($r));
6810 $p =~ /^([0-9a-f:]+):([0-9a-f]+)\-([0-9a-f]+)$/ || next;
6811 local ($base, $s, $e) = ($1, $2, $3);
6812 $ip =~ /^([0-9a-f:]+):([0-9a-f]+)$/ || next;
6813 if (lc($1) eq lc($base) &&
6814 hex($2) >= hex($s) && hex($2) <= hex($e)) {
6815 return 1;
6816 }
6817 }
6818 }
6819return 0;
6820}
6821
6822# setup_for_subdomain(&parent-domain, subdomain-user, &sub-domain)
6823# Ensures that this virtual server can host sub-servers
6824sub setup_for_subdomain
6825{
6826local ($d, $subuser, $subd) = @_;
6827if (!-d "$d->{'home'}/domains") {
6828 &make_dir_as_domain_user($d, "$d->{'home'}/domains", 0755);
6829 }
6830}
6831
6832# count_domains([type])
6833# Returns the number of additional domains the current user is allowed to
6834# create (-1 for infinite), the reason for the limit (2=this reseller,
6835# 1=reseller, 0=user), the number of domains allowed in total, and a flag
6836# indicating if this limit should be hidden from the user.
6837# May exclude alias domains if they don't count towards the max.
6838sub count_domains
6839{
6840local ($type) = @_;
6841$type ||= "doms";
6842local ($left, $reason, $max, $hide) = &count_feature($type);
6843if ($left != 0 && $type ne "aliasdoms") {
6844 # If no limit has been hit, check the licence
6845 local ($lstatus, $lexpiry, $lerr, $ldoms) = &check_licence_expired();
6846 if ($ldoms) {
6847 local @doms = grep { !$_->{'alias'} } &list_domains();
6848 if (@doms > $ldoms) {
6849 # Hit the licenced max!
6850 return (0, 3, $ldoms, 0);
6851 }
6852 else {
6853 # Haven't reached .. check if the licence limit is
6854 # less than the current limit
6855 local $dleft = $ldoms - @doms;
6856 if ($left == -1 || $dleft < $left) {
6857 # Will hit licensed domains limit
6858 return ($dleft, 3,
6859 $max < $ldoms && $max > 0 ? $max : $ldoms, 0);
6860 }
6861 else {
6862 # Will hit user or reseller limit
6863 return ($left, $reason, $max, $hide);
6864 }
6865 }
6866 }
6867 }
6868return ($left, $reason, $max, $hide);
6869}
6870
6871# count_mailboxes(&parent)
6872# Returns the number of mailboxes in this domain and all subdomains, and the
6873# max allowed for the current user
6874sub count_mailboxes
6875{
6876local $count = 0;
6877local $doms = 0;
6878local $parent = $_[0]->{'parent'} ? &get_domain($_[0]->{'parent'}) : $_[0];
6879local $d;
6880foreach $d ($parent, &get_domain_by("parent", $parent->{'id'})) {
6881 local @users = &list_domain_users($d, 0, 1, 1, 1);
6882 $count += @users;
6883 $doms++;
6884 }
6885return ( $count, $parent->{'mailboxlimit'} ? $parent->{'mailboxlimit'} : 0,
6886 $doms );
6887}
6888
6889# count_feature(feature, [user])
6890# Returns the number of extra instances of the given feature that the current
6891# user is allowed to create, the reason for the limit (2=this reseller,
6892# 1=reseller, 0=user), the total allowed, and a flag indicating if this
6893# limit should be hidden from the user.
6894# Feature can be "doms", "aliasdoms", "realdoms", "mailboxes", "aliases",
6895# "quota", "uquota", "dbs", "bw" or a feature
6896sub count_feature
6897{
6898local ($f) = @_;
6899local $user = $_[1] || $base_remote_user;
6900local %access = &get_module_acl($user);
6901
6902# Master admin has no limit
6903return (-1, 0) if (&master_admin());
6904
6905local $userleft = -1;
6906local $usermax;
6907if (!$access{'reseller'}) {
6908 # Count the number that this user has
6909 local @doms = &get_domain_by("user", $user);
6910 local ($parent) = grep { !$_->{'parent'} } @doms;
6911 local $limit = $f eq "doms" ? $parent->{'domslimit'} :
6912 $f eq "aliasdoms" ? $parent->{'aliasdomslimit'} :
6913 $f eq "realdoms" ? $parent->{'realdomslimit'} :
6914 $f eq "mailboxes" ? $parent->{'mailboxlimit'} :
6915 $f eq "aliases" ? $parent->{'aliaslimit'} :
6916 $f eq "dbs" ? $parent->{'dbslimit'} : undef;
6917 $limit = undef if ($limit eq "*");
6918 if ($limit ne "") {
6919 # A server-owner-level limit is in force .. check it
6920 local $got = &count_domain_feature($f, @doms);
6921 if ($got >= $limit) {
6922 return (0, 0, $limit);
6923 }
6924 $userleft = $limit - $got;
6925 $usermax = $limit;
6926 }
6927 if (($f eq "aliasdoms" || $f eq "realdoms") &&
6928 $parent->{'domslimit'} && $parent->{'domslimit'} ne '*') {
6929 # See if the owner is over the limit for all domains types too
6930 local $got = &count_domain_feature("doms", @doms);
6931 if ($got >= $parent->{'domslimit'}) {
6932 return (0, 0, $parent->{'domslimit'});
6933 }
6934 else {
6935 $userleft = $parent->{'domslimit'} - $got;
6936 $usermax = $parent->{'domslimit'};
6937 }
6938 }
6939 ($reseller) = split(/\s+/, $parent->{'reseller'});
6940 }
6941else {
6942 $reseller = $user;
6943 }
6944
6945if ($reseller) {
6946 # Either this user is owned by a reseller, or he is a reseller.
6947 local @rdoms = &get_reseller_domains($reseller);
6948 local %racl = &get_reseller_acl($reseller);
6949 local $reason = $access{'reseller'} ? 2 : 1;
6950 local $hide = $base_remote_user ne $reseller && $racl{'hide'};
6951 local $limit = $racl{"max_".$f};
6952 if ($limit ne "") {
6953 # Reseller has a limit ..
6954 local $got = &count_domain_feature($f, @rdoms);
6955 if ($got > $limit || $got < 0) {
6956 # Reseller has reached his limit
6957 return (0, $reason, $limit, $hide);
6958 }
6959 else {
6960 # Check if reseller limit is less than the user limit
6961 local $reselleft = $limit - $got;
6962 if ($userleft == -1 || $reselleft < $userleft) {
6963 # Yes .. reseller limit applies
6964 return ($reselleft, $reason, $limit, $hide);
6965 }
6966 }
6967 }
6968 if (($f eq "aliasdoms" || $f eq "realdoms") &&
6969 $racl{'max_doms'}) {
6970 # See if the reseller is over the limit for all domains types
6971 local $got = &count_domain_feature("doms", @rdoms);
6972 if ($got >= $racl{'max_doms'}) {
6973 return (0, $reason, $racl{'max_doms'}, $hide);
6974 }
6975 }
6976 }
6977return ($userleft, 0, $usermax);
6978}
6979
6980# count_domain_feature(feature, &domain, ...)
6981# Returns the total for some feature in the given domains. May return -1 if
6982# any are set to unlimited (ie. quotas)
6983sub count_domain_feature
6984{
6985local ($f, @doms) = @_;
6986local $rv = 0;
6987local $d;
6988foreach $d (@doms) {
6989 if ($f eq "dbs") {
6990 local @dbs = &domain_databases($d);
6991 $rv += scalar(@dbs);
6992 }
6993 elsif ($f eq "mailboxes") {
6994 local @users = &list_domain_users($d, 0, 1, 1, 1);
6995 $rv += scalar(@users);
6996 }
6997 elsif ($f eq "aliases") {
6998 local @aliases = &list_domain_aliases($d, 1);
6999 $rv += scalar(@aliases);
7000 }
7001 elsif ($f eq "quota" || $f eq "uquota") {
7002 if (!$d->{'parent'}) {
7003 return -1 if ($d->{$f} eq "" || $d->{$f} eq "0");
7004 $rv += $d->{$f};
7005 }
7006 }
7007 elsif ($f eq "bw") {
7008 if (!$d->{'parent'}) {
7009 return -1 if ($d->{'bw_limit'} eq "" ||
7010 $d->{'bw_limit'} eq "0");
7011 $rv += $d->{'bw_limit'};
7012 }
7013 }
7014 elsif ($f eq "doms") {
7015 $rv++ if (!$d->{'alias'} || !$config{'limitnoalias'});
7016 }
7017 elsif ($f eq "aliasdoms") {
7018 $rv++ if ($d->{'alias'});
7019 }
7020 elsif ($f eq "realdoms") {
7021 $rv++ if (!$d->{'alias'});
7022 }
7023 else {
7024 $rv++ if ($d->{$f});
7025 }
7026 }
7027return $rv;
7028}
7029
7030# database_name(&domain)
7031# Returns a suitable database name for a domain
7032sub database_name
7033{
7034local ($d) = @_;
7035local $tmpl = &get_template($d->{'template'});
7036local %hash = %$d;
7037if (!$hash{'uid'}) {
7038 # Fake UID allocation now, in case the template uses it
7039 local %taken;
7040 &build_taken(\%taken);
7041 $hash{'uid'} = &allocate_uid(\%taken);
7042 }
7043if (!$hash{'gid'}) {
7044 # Fake GID allocation
7045 local %gtaken;
7046 &build_group_taken(\%gtaken);
7047 $hash{'gid'} = &allocate_gid(\%gtaken);
7048 }
7049local $db = &substitute_domain_template($tmpl->{'mysql'}, \%hash);
7050$db = lc($db);
7051$db ||= $d->{'prefix'};
7052$db = &fix_database_name($db, $d->{'mysql'} && $d->{'postgres'} ? undef :
7053 $d->{'mysql'} ? 'mysql' : 'postgres');
7054return $db;
7055}
7056
7057# fix_database_name(dbname, [dbtype])
7058# If a database name starts with a number, convert it to a word to support
7059# PostgreSQL, which doesn't like numeric names. Also converts . and - to _,
7060# and handles reserved DB names.
7061sub fix_database_name
7062{
7063local ($db, $dbtype) = @_;
7064if (!$dbtype) {
7065 # Guess DB type
7066 my @dbtypes = grep { $config{$_} } @database_features;
7067 if (scalar(@dbtypes) == 1) {
7068 $dbtype = $dbtypes[0];
7069 }
7070 }
7071$db = lc($db);
7072$db =~ s/[\.\-]/_/g; # mysql doesn't like . or _
7073if (!$dbtype || $dbtype eq "postgres") {
7074 # Postgresql doesn't like leading numbers
7075 $db = &remove_numeric_prefix($db);
7076 }
7077if ($db eq "test" || $db eq "mysql" || $db =~ /^template/) {
7078 # These names are reserved by MySQL and PostgreSQL
7079 $db = "db".$db;
7080 }
7081return $db;
7082}
7083
7084# remove_numeric_prefix(name)
7085# If a name starts with a number, convert it to a work
7086sub remove_numeric_prefix
7087{
7088my ($db) = @_;
7089$db =~ s/^0/zero/g;
7090$db =~ s/^1/one/g;
7091$db =~ s/^2/two/g;
7092$db =~ s/^3/three/g;
7093$db =~ s/^4/four/g;
7094$db =~ s/^5/five/g;
7095$db =~ s/^6/six/g;
7096$db =~ s/^7/seven/g;
7097$db =~ s/^8/eight/g;
7098$db =~ s/^9/nine/g;
7099return $db;
7100}
7101
7102# validate_database_name(&domain, type, name)
7103# Returns an error message if a name is invalid, undef if OK
7104sub validate_database_name
7105{
7106local ($d, $dbtype, $dbname) = @_;
7107local $vfunc = "validate_database_name_".$dbtype;
7108if (defined(&$vfunc)) {
7109 return &$vfunc($d, $dbname);
7110 }
7111else {
7112 # Default rules
7113 $dbname =~ /^[a-z0-9\_]+$/i && $dbname =~ /^[a-z]/i ||
7114 return $text{'database_ename'};
7115 return undef;
7116 }
7117}
7118
7119# unixuser_name(domainname)
7120# Returns a Unix username for some domain, or undef if none can be found
7121sub unixuser_name
7122{
7123local ($dname) = @_;
7124$dname =~ s/^xn(-+)//;
7125$dname =~ /^([^\.]+)/;
7126$dname = &remove_numeric_prefix($dbname);
7127local ($try1, $user) = ($1, $1);
7128if (defined(getpwnam($try1)) || $config{'longname'}) {
7129 $user = &remove_numeric_prefix($_[0]);
7130 $try2 = $user;
7131 if (defined(getpwnam($try2))) {
7132 return (undef, $try1, $try2);
7133 }
7134 }
7135return ($user);
7136}
7137
7138# unixgroup_name(domainname, username)
7139# Returns a Unix group name for some domain, or undef if none can be found
7140sub unixgroup_name
7141{
7142local ($dname, $user) = @_;
7143if ($user && $config{'groupsame'}) {
7144 # Same as username where possible
7145 if (!defined(getgrnam($user))) {
7146 return ($user);
7147 }
7148 return (undef, $user, $user);
7149 }
7150$dname =~ s/^xn(-+)//;
7151$dname =~ /^([^\.]+)/;
7152local ($try1, $group) = ($1, $1);
7153if (defined(getgrnam($try1)) || $config{'longname'}) {
7154 $group = $_[0];
7155 $try2 = $group;
7156 if (defined(getpwnam($try))) {
7157 return (undef, $try1, $try2);
7158 }
7159 }
7160return ($group);
7161}
7162
7163# virtual_server_clashes(&dom, [&features-to-check], [field-to-check])
7164# Returns a clash error message if any were found for some new domain
7165sub virtual_server_clashes
7166{
7167local ($dom, $check, $field) = @_;
7168my $f;
7169foreach $f (@features) {
7170 next if ($dom->{'parent'} && $f eq "webmin");
7171 next if ($dom->{'parent'} && $f eq "unix");
7172 if ($dom->{$f} && (!$check || $check->{$f})) {
7173 local $cfunc = "check_${f}_clash";
7174 local $err = defined(&$cfunc) ? &$cfunc($dom, $field) : undef;
7175 if ($err) {
7176 if ($err eq '1') {
7177 # Use a built-in error
7178 $err = &text('setup_e'.$f,
7179 $dom->{'dom'}, $dom->{'db'},
7180 $dom->{'user'}, $dom->{'group'});
7181 }
7182 return $err;
7183 }
7184 }
7185 }
7186foreach $f (&list_feature_plugins()) {
7187 if ($dom->{$f} && (!$check || $check->{$f})) {
7188 local $cerr = &plugin_call($f, "feature_clash", $dom, $field);
7189 return $cerr if ($cerr);
7190 }
7191 }
7192return undef;
7193}
7194
7195# virtual_server_depends(&dom, [feature], [&old-dom])
7196# Returns an error message if any of the features in the domain depend on
7197# missing features
7198sub virtual_server_depends
7199{
7200local ($d, $feat, $oldd) = @_;
7201local $f;
7202
7203# Check features that are enabled
7204foreach $f (grep { $d->{$_} } @features) {
7205 next if ($feat && $f ne $feat);
7206 local $dfunc = "check_depends_$f";
7207 if (defined(&$dfunc)) {
7208 # Call dependecy function
7209 local $derr = &$dfunc($d, $oldd);
7210 return $derr if ($derr);
7211 }
7212 # Check fixed dependency list
7213 local $fd;
7214 foreach $fd (@{$feature_depends{$f}}) {
7215 return &text('setup_edep'.$f) if (!$d->{$fd});
7216 }
7217 }
7218
7219# Check plugins that are enabled
7220foreach $f (grep { $d->{$_} } &list_feature_plugins()) {
7221 next if ($feat && $f ne $feat);
7222 local $derr = &plugin_call($f, "feature_depends", $d, $oldd);
7223 return $derr if ($derr);
7224 }
7225
7226# Check features that are NOT enabled, to ensure that any needed features are
7227# not missing. ie. mysql missing from parent but on children
7228foreach $f (grep { !$d->{$_} } @features) {
7229 next if ($feat && $f ne $feat);
7230 local $dfunc = "check_anti_depends_$f";
7231 if (defined(&$dfunc)) {
7232 # Call dependecy function
7233 local $derr = &$dfunc($d);
7234 return $derr if ($derr);
7235 }
7236 }
7237
7238return undef;
7239}
7240
7241# virtual_server_limits(&domain, [&old-domain])
7242# Checks if the addition of a feature would exceed any limit for the user
7243sub virtual_server_limits
7244{
7245local ($d, $oldd) = @_;
7246local ($left, $reason, $max);
7247local $tmpl = &get_template($d->{'template'});
7248
7249# Check database limit
7250local $newdbs = 0;
7251$newdbs++ if ($d->{'mysql'} && (!$oldd || !$oldd->{'mysql'}) &&
7252 $tmpl->{'mysql_mkdb'} && !$d->{'no_mysql_db'});
7253$newdbs++ if ($d->{'postgres'} && (!$oldd || !$oldd->{'postgres'}) &&
7254 $tmpl->{'mysql_mkdb'});
7255if ($newdbs) {
7256 ($left, $reason, $max) = &count_feature("dbs");
7257 if ($left == 0 || $newdbs == 2 && $left == 1) {
7258 return &text('databases_noadd'.$reason, $max);
7259 }
7260 }
7261
7262# Check quota limits
7263($left, $reason, $max) = &count_feature("quota");
7264if (!$d->{'parent'} && $d->{'quota'} eq "" && $left != -1) {
7265 # Unlimited quota chosen, but not allowed!
7266 return &text('setup_noquotainf'.$reason, "a_show($max, "home"));
7267 }
7268local $newquota = $d->{'quota'} - ($oldd ? $oldd->{'quota'} : 0);
7269if ($left != -1 && $left-$newquota < 0) {
7270 return &text('setup_noquotaadd'.$reason,
7271 "a_show($left+($oldd ? $oldd->{'quota'} : 0),
7272 "home", 1));
7273 }
7274
7275# Check bandwidth limits
7276($left, $reason, $max) = &count_feature("bw");
7277if (!$d->{'parent'} && $d->{'bw_limit'} eq "" && $left != -1) {
7278 # Unlimited bandwidth chosen, but not allowed!
7279 return &text('setup_nobwinf'.$reason, &nice_size($max));
7280 }
7281local $newquota = $d->{'bw_limit'} - ($oldd ? $oldd->{'bw_limit'} : 0);
7282if ($left != -1 && $left-$newquota < 0) {
7283 return &text('setup_nobwadd'.$reason,
7284 &nice_size($left+($oldd ? $oldd->{'bw_limit'} : 0)));
7285 }
7286
7287# Check domains limit
7288if (!$oldd) {
7289 ($left, $reason, $max) = &count_domains(
7290 $d->{'alias'} ? 'aliasdoms' : 'realdoms');
7291 if ($left == 0) {
7292 return &text('index_noadd'.$reason, $max);
7293 }
7294 }
7295
7296return undef;
7297}
7298
7299# virtual_server_warnings(&domain, [&old-domain])
7300# Returns a list of warning messages related to the creation or modification
7301# of some virtual server.
7302sub virtual_server_warnings
7303{
7304local ($d, $oldd) = @_;
7305local @rv;
7306
7307# Check core features
7308foreach my $f (grep { $d->{$_} } @features) {
7309 local $wfunc = "check_warnings_$f";
7310 if (defined(&$wfunc)) {
7311 local $err = &$wfunc($d, $oldd);
7312 push(@rv, $err) if ($err);
7313 }
7314 }
7315
7316# Check plugins that are enabled
7317foreach $f (grep { $d->{$_} } &list_feature_plugins()) {
7318 local $err = &plugin_call($f, "feature_warnings", $d, $oldd);
7319 push(@rv, $err) if ($err);
7320 }
7321return @rv;
7322}
7323
7324# show_virtual_server_warnings(&domain, [&old-domain], &in)
7325# Checks if there are any warnings for the creation or modification of some
7326# domain, and if so shows a confirmation form - unless $in{'confirm_warnings'}
7327# is set. Returns 1 if the warning form was shown, 0 if not.
7328sub show_virtual_server_warnings
7329{
7330local ($d, $oldd, $in) = @_;
7331return 0 if ($in->{'confirm_warnings'});
7332local @warns = &virtual_server_warnings($d, $oldd);
7333return 0 if (!@warns);
7334
7335my @hids;
7336foreach my $i (keys %$in) {
7337 foreach my $v (split(/\0/, $in->{$i})) {
7338 push(@hids, [ $i, $v ]);
7339 }
7340 }
7341print &ui_confirmation_form(
7342 $script_name,
7343 ($oldd ? $text{'setup_warnings2'} : $text{'setup_warnings1'})."<p>\n".
7344 join("<br>\n", @warns)."<p>\n".
7345 $text{'setup_warnrusure'},
7346 \@hids,
7347 [ [ 'confirm_warnings', $oldd ? $text{'setup_warnok2'}
7348 : $text{'setup_warnok1'} ] ],
7349 );
7350return 1;
7351}
7352
7353# domain_name_clash(name)
7354# Returns 1 if some domain name is already in use
7355sub domain_name_clash
7356{
7357local ($domain) = @_;
7358foreach my $d (&list_domains()) {
7359 return 1 if (lc($d->{'dom'}) eq lc($domain));
7360 }
7361return 0;
7362}
7363
7364# create_virtual_server(&domain, [&parent-domain], [parent-user], [no-scripts],
7365# [no-post-actions], [password])
7366# Given a complete domain object, setup all it's features
7367sub create_virtual_server
7368{
7369local ($dom, $parentdom, $parentuser, $noscripts, $nopost, $pass) = @_;
7370
7371# Sanity checks
7372$dom->{'ip'} || return $text{'setup_edefip'};
7373
7374# Run the before command
7375&set_domain_envs($dom, "CREATE_DOMAIN");
7376local $merr = &making_changes();
7377&reset_domain_envs($dom);
7378return &text('setup_emaking', "<tt>$merr</tt>") if (defined($merr));
7379
7380# Get ready for hosting a subdomain
7381if ($dom->{'parent'}) {
7382 &setup_for_subdomain($parentdom, $parentuser, $dom);
7383 }
7384
7385# Work out if this server is being created on the primary default IP address
7386if ($dom->{'ip'} eq &get_default_ip() &&
7387 !$dom->{'virt'}) {
7388 $dom->{'defip'} = 1;
7389 }
7390
7391# Work out the auto-alias domain name
7392local $tmpl = &get_template($dom->{'template'});
7393local $aliasname;
7394if ($tmpl->{'domalias'} ne 'none' && $tmpl->{'domalias'} && !$dom->{'alias'}) {
7395 local $aliasprefix = $dom->{'dom'};
7396 if ($tmpl->{'domalias_type'} eq '1') {
7397 # Shorten to first part of domain
7398 $aliasprefix =~ s/\..*$//;
7399 }
7400 elsif ($tmpl->{'domalias_type'} ne '0') {
7401 # Use template
7402 $aliasprefix = &substitute_domain_template(
7403 $tmpl->{'domalias_type'}, $dom);
7404 }
7405 my $count;
7406 while(1) {
7407 $aliasname = $aliasprefix.$count.".".$tmpl->{'domalias'};
7408 last if (!&get_domain_by("dom", $aliasname));
7409 $count++;
7410 }
7411 $dom->{'autoalias'} = $aliasname;
7412 }
7413
7414if ($dom->{'mysql'}) {
7415 # Check if only hashed passwords are stored, and if so generate a random
7416 # MySQL password now. This has to be done before any features are setup
7417 # so that mysql_pass is available to all features.
7418 if ($dom->{'hashpass'} && !$dom->{'parent'} && !$dom->{'mysql_pass'}) {
7419 # Hashed passwords in use
7420 $dom->{'mysql_pass'} = &random_password(16);
7421 delete($dom->{'mysql_enc_pass'});
7422 }
7423 elsif ($tmpl->{'mysql_nopass'} == 2 && !$dom->{'parent'} &&
7424 !$dom->{'mysql_pass'}) {
7425 # Using random password by default
7426 $dom->{'mysql_pass'} = &random_password(16);
7427 delete($dom->{'mysql_enc_pass'});
7428 }
7429 }
7430
7431# Set up all the selected features (except Webmin login)
7432my $f;
7433local @dof = grep { $_ ne "webmin" } @features;
7434local $p = &domain_has_website($dom);
7435foreach $f (@dof) {
7436 my $err;
7437 if ($f eq 'web' && $p && $p ne 'web') {
7438 # Web feature is provided by a plugin .. call it now
7439 $err = &call_feature_setup($p, $dom);
7440 }
7441 elsif ($dom->{$f}) {
7442 $err = &call_feature_setup($f, $dom);
7443 }
7444 return $err if ($err);
7445 }
7446
7447# Set up all the selected plugins
7448foreach $f (&list_feature_plugins()) {
7449 if ($dom->{$f} && $f ne $p) {
7450 my $err = &call_feature_setup($f, $dom);
7451 return $err if ($err);
7452 }
7453 }
7454
7455# Setup Webmin login last, once all plugins are done
7456if ($dom->{'webmin'}) {
7457 local $sfunc = "setup_webmin";
7458 if (!&try_function($f, $sfunc, $dom)) {
7459 $dom->{$f} = 0;
7460 }
7461 }
7462
7463# Add virtual IP address, if needed
7464if ($dom->{'virt'}) {
7465 if (!&try_function("virt", "setup_virt", $dom)) {
7466 $dom->{'virt'} = 0;
7467 }
7468 }
7469if ($dom->{'virt6'}) {
7470 if (!&try_function("virt6", "setup_virt6", $dom)) {
7471 $dom->{'virt6'} = 0;
7472 }
7473 }
7474
7475if (!$nopost) {
7476 &run_post_actions();
7477 }
7478
7479# Save domain details
7480&$first_print($text{'setup_save'});
7481&save_domain($dom, 1);
7482&$second_print($text{'setup_done'});
7483
7484if (!$dom->{'nocreationmail'}) {
7485 # Notify the owner via email
7486 &send_domain_email($dom, undef, $pass);
7487 }
7488
7489# Update the parent domain Webmin user
7490if ($parentdom) {
7491 &refresh_webmin_user($parentdom);
7492 }
7493
7494if ($remote_user) {
7495 # Add to this user's list of domains if needed
7496 local %access = &get_module_acl();
7497 if (!&can_edit_domain($dom)) {
7498 $access{'domains'} = join(" ", split(/\s+/, $access{'domains'}),
7499 $dom->{'id'});
7500 &save_module_acl(\%access);
7501 }
7502 }
7503
7504# Update any secondary groups that might contain the domain owner
7505if (!$dom->{'parent'}) {
7506 &update_secondary_groups($dom);
7507 }
7508
7509# Create an automatic alias domain, if specified in template
7510if ($aliasname && $aliasname ne $dom->{'dom'}) {
7511 &$first_print(&text('setup_domalias', $aliasname));
7512 if ($aliasname !~ /^[a-z0-9\.\_\-]+$/i) {
7513 &$second_print($text{'setup_domaliasbad'});
7514 }
7515 else {
7516 &$indent_print();
7517 local $parentdom = $dom->{'parent'} ?
7518 &get_domain($dom->{'parent'}) : $dom;
7519 local %alias = ( 'id', &domain_id(),
7520 'dom', $aliasname,
7521 'user', $dom->{'user'},
7522 'group', $dom->{'group'},
7523 'prefix', $dom->{'prefix'},
7524 'ugroup', $dom->{'ugroup'},
7525 'pass', $dom->{'pass'},
7526 'alias', $dom->{'id'},
7527 'uid', $dom->{'uid'},
7528 'gid', $dom->{'gid'},
7529 'ugid', $dom->{'ugid'},
7530 'owner', "Automatic alias of $dom->{'dom'}",
7531 'email', $dom->{'email'},
7532 'nocreationmail', 1,
7533 'name', 1,
7534 'ip', $dom->{'ip'},
7535 'dns_ip', $dom->{'dns_ip'},
7536 'virt', 0,
7537 'source', $dom->{'source'},
7538 'parent', $parentdom->{'id'},
7539 'template', $dom->{'template'},
7540 'plan', $dom->{'plan'},
7541 'reseller', $dom->{'reseller'},
7542 );
7543 # Alias gets all features of domain, except for directory
7544 # if it isn't needed
7545 foreach my $f (@alias_features) {
7546 next if ($f eq 'dir' && $config{$f} == 3 &&
7547 $tmpl->{'aliascopy'});
7548 $alias{$f} = $dom->{$f};
7549 }
7550 my $web = &domain_has_website($dom);
7551 if ($web) {
7552 # Website may use Nginx
7553 $alias{$web} = 1;
7554 }
7555 $alias{'home'} = &server_home_directory(\%alias, $parentdom);
7556 &generate_domain_password_hashes(\%dom, 1);
7557 &set_provision_features(\%alias);
7558 &complete_domain(\%alias);
7559 &create_virtual_server(\%alias, $parentdom,
7560 $parentdom->{'user'});
7561 &$outdent_print();
7562 &$second_print($text{'setup_done'});
7563 }
7564 }
7565
7566# Install any scripts specified in the template
7567local @scripts = &get_template_scripts($tmpl);
7568if (@scripts && !$dom->{'alias'} && !$noscripts &&
7569 &domain_has_website($dom) && $dom->{'dir'} &&
7570 !$dom->{'nocreationscripts'}) {
7571 &$first_print($text{'setup_scripts'});
7572 &$indent_print();
7573 foreach my $sinfo (@scripts) {
7574 # Work out install options
7575 local ($name, $ver) = split(/\s+/, $sinfo->{'name'});
7576 local $script = &get_script($name);
7577 if (!$script) {
7578 &$first_print(&text('setup_scriptgone', $name));
7579 next;
7580 }
7581
7582 # Work out actual version
7583 local @allvers = @{$script->{'install_versions'}};
7584 if ($ver eq "latest") {
7585 $ver = $allvers[0];
7586 }
7587
7588 &$first_print(&text('setup_scriptinstall',
7589 $script->{'name'}, $ver));
7590 local $opts = { 'path' => &substitute_scriptname_template(
7591 $sinfo->{'path'}, $d) };
7592 local $perr = &validate_script_path($opts, $script, $dom);
7593 if ($perr) {
7594 &$second_print($perr);
7595 next;
7596 }
7597
7598 # Install needed packages
7599 &setup_script_packages($script, $d, $ver);
7600
7601 # Check PHP version
7602 local $phpvfunc = $script->{'php_vers_func'};
7603 local $phpver;
7604 if (defined(&$phpvfunc)) {
7605 local @vers = &$phpvfunc($dom, $ver);
7606 $phpver = &setup_php_version($dom, \@vers,
7607 $opts->{'path'});
7608 if (!$phpver) {
7609 &$second_print(&text('setup_scriptphpver',
7610 join(" ", @vers)));
7611 next;
7612 }
7613 $opts->{'phpver'} = $phpver;
7614 }
7615
7616 # Check dependencies
7617 local $derr = &check_script_depends($script, $dom, $ver,
7618 $sinfo, $phpver);
7619 if ($derr) {
7620 &$second_print(&text('setup_scriptdeps', $derr));
7621 next;
7622 }
7623
7624 # Install needed PHP modules
7625 &setup_script_requirements($d, $script, $ver, $phpver, $opts) ||
7626 next;
7627
7628 # Find the database, if requested
7629 if ($sinfo->{'db'}) {
7630 local $dbname = &substitute_domain_template(
7631 $sinfo->{'db'}, $dom);
7632 if (!$dom->{$sinfo->{'dbtype'}}) {
7633 # DB type isn't enabled for this domain
7634 &$second_print(&text('setup_scriptnodb',
7635 $text{'databases_'.$sinfo->{'dbtype'}}));
7636 next;
7637 }
7638 $opts->{'db'} = $sinfo->{'dbtype'}."_".$dbname;
7639 local @dbs = &domain_databases($dom);
7640 local ($db) = grep {
7641 $_->{'type'} eq $sinfo->{'dbtype'} &&
7642 $_->{'name'} eq $dbname } @dbs;
7643 if (!$db) {
7644 # DB doesn't exist yet .. create it
7645 $cfunc = "check_".$sinfo->{'dbtype'}.
7646 "_database_clash";
7647 if (&$cfunc($dom, $dbname)) {
7648 &$second_print(
7649 &text('setup_scriptclash', $dbname));
7650 next;
7651 }
7652 $crfunc = "create_".$sinfo->{'dbtype'}.
7653 "_database";
7654 &$indent_print();
7655 &$crfunc($dom, $dbname);
7656 &$outdent_print();
7657 }
7658 }
7659
7660 # Check options
7661 if (defined(&{$script->{'check_func'}})) {
7662 my $oerr = &{$script->{'check_func'}}($dom, $ver,$opts);
7663 if ($oerr) {
7664 &$second_print(&text('setup_scriptopts',$oerr));
7665 next;
7666 }
7667 }
7668
7669 # Fetch needed files
7670 local %gotfiles;
7671 local $ferr = &fetch_script_files($dom, $ver, $opts, undef, \%gotfiles, 1);
7672 if ($derr) {
7673 &$second_print(&text('setup_scriptfetch', $ferr));
7674 next;
7675 }
7676
7677 # Disable PHP timeouts
7678 local $t = &disable_script_php_timeout($dom);
7679
7680 # Call the install function
7681 local $dompass = $dom->{'pass'} || &random_password(8);
7682 local ($ok, $msg, $desc, $url, $suser, $spass) =
7683 &{$script->{'install_func'}}(
7684 $dom, $ver, $opts, \%gotfiles, undef,
7685 $dom->{'user'}, $dompass);
7686
7687 if ($ok) {
7688 &$second_print(&text($ok < 0 ? 'setup_scriptpartial' :
7689 'setup_scriptdone', $msg));
7690
7691 # Record script install in domain
7692 &add_domain_script($dom, $name, $ver, $opts,
7693 $desc, $url, $suser, $spass,
7694 $ok < 0 ? $msg : undef);
7695 }
7696 else {
7697 &$second_print(&text('setup_scriptfailed', $msg));
7698 }
7699
7700 # Re-enable script PHP timeout
7701 &enable_script_php_timeout($dom, $t);
7702 }
7703 &$outdent_print();
7704 &$second_print($text{'setup_done'});
7705 &save_domain($dom);
7706 }
7707
7708# If mail client autoconfig is enabled globally, set it up for
7709# this domain
7710if ($config{'mail_autoconfig'} && $dom->{'mail'} &&
7711 &domain_has_website($dom) && !$dom->{'alias'}) {
7712 &enable_email_autoconfig($dom);
7713 }
7714
7715# If this was an alias domain, notify all features in the original domain. This
7716# is useful for things like awstats, which need to add the alias domain to those
7717# supported for the main site.
7718if ($dom->{'alias'}) {
7719 local $aliasdom = &get_domain($dom->{'alias'});
7720 foreach my $f (@features) {
7721 local $safunc = "setup_alias_$f";
7722 if ($aliasdom->{$f} && defined(&$safunc)) {
7723 &try_function($f, $safunc, $aliasdom, $dom);
7724 }
7725 }
7726 foreach $f (&list_feature_plugins()) {
7727 if ($aliasdom->{$f} &&
7728 &plugin_defined($f, "feature_setup_alias")) {
7729 local $main::error_must_die = 1;
7730 eval { &plugin_call($f, "feature_setup_alias",
7731 $aliasdom, $dom) };
7732 if ($@) {
7733 &$second_print(&text('setup_aliasfailure',
7734 &plugin_call($f, "feature_name"),"$@"));
7735 }
7736 }
7737 }
7738 }
7739
7740# Refresh Unix group membership for reseller
7741if ($dom->{'reseller'} && defined(&update_reseller_unix_groups)) {
7742 local $rinfo = &get_reseller($dom->{'reseller'});
7743 if ($rinfo) {
7744 &update_reseller_unix_groups($rinfo, 1);
7745 }
7746 }
7747
7748# Attempt to request a let's encrypt cert
7749$dom->{'auto_letsencrypt'} ||= $config{'auto_letsencrypt'};
7750if ($dom->{'auto_letsencrypt'} && &domain_has_ssl($dom)) {
7751 &$first_print(&text('letsencrypt_doing2',
7752 join(", ", map { "<tt>$_</tt>" } @dnames)));
7753 &foreign_require("webmin");
7754 my @dnames = &get_hostnames_for_ssl($dom);
7755 my $phd = &public_html_dir($dom);
7756 my ($ok, $cert, $key, $chain) = &webmin::request_letsencrypt_cert(
7757 \@dnames, $phd, $dom->{'emailto'});
7758 if (!$ok) {
7759 &$second_print(&text('letsencrypt_failed', $cert));
7760 }
7761 else {
7762 &obtain_lock_ssl($dom);
7763 &install_letsencrypt_cert($dom, $cert, $key, $chain);
7764
7765 $dom->{'letsencrypt_dname'} = '';
7766 $dom->{'letsencrypt_last'} = time();
7767 &save_domain($dom);
7768
7769 if ($dom->{'virt'}) {
7770 &sync_dovecot_ssl_cert($dom, 1);
7771 &sync_postfix_ssl_cert($dom, 1);
7772 }
7773 &break_invalid_ssl_linkages($dom);
7774 &release_lock_ssl($dom);
7775 &$second_print($text{'letsencrypt_done'});
7776 }
7777 }
7778
7779# Run the after creation command
7780if (!$nopost) {
7781 &run_post_actions();
7782 }
7783&set_domain_envs($dom, "CREATE_DOMAIN");
7784local $merr = &made_changes();
7785&$second_print(&text('setup_emade', "<tt>$merr</tt>")) if (defined($merr));
7786&reset_domain_envs($dom);
7787
7788return undef;
7789}
7790
7791# call_feature_setup(feature, &domain, [args])
7792# Calls the setup function for some feature or plugin. May print stuff.
7793# Returns an error message on a vital feature failure, sets flag to 0 for
7794# a non-vital failure.
7795sub call_feature_setup
7796{
7797local ($f, $dom, @args) = @_;
7798local %vital = map { $_, 1 } @vital_features;
7799if (&indexof($f, @features) >= 0) {
7800 # Core feature
7801 local $sfunc = "setup_$f";
7802 if ($vital{$f}) {
7803 # Failure of this feature should halt the entire setup
7804 if (!&$sfunc($dom, @args)) {
7805 return &text('setup_evital',
7806 $text{'feature_'.$f});
7807 }
7808 }
7809 else {
7810 # Failure can be ignored
7811 if (!&try_function($f, $sfunc, $dom)) {
7812 $dom->{$f} = 0;
7813 }
7814 }
7815 }
7816else {
7817 # Plugin feature
7818 local $main::error_must_die = 1;
7819 eval { &plugin_call($f, "feature_setup", $dom, @args) };
7820 if ($@) {
7821 local $err = $@;
7822 &$second_print(&text('setup_failure',
7823 &plugin_call($f, "feature_name"), $err));
7824 $dom->{$f} = 0;
7825 }
7826 }
7827return undef;
7828}
7829
7830# delete_virtual_server(&domain, only-disconnect, no-post, preserve-remote)
7831# Deletes a Virtualmin domain and all sub-domains and aliases. Returns undef
7832# on succes, or an error message on failure.
7833sub delete_virtual_server
7834{
7835local ($d, $only, $nopost, $preserve) = @_;
7836
7837# Get domain details
7838local @subs = &get_domain_by("parent", $d->{'id'});
7839local @aliasdoms = &get_domain_by("alias", $d->{'id'});
7840local @aliasdoms = grep { $_->{'parent'} != $d->{'id'} } @aliasdoms;
7841
7842# Go ahead and delete this domain and all sub-domains ..
7843&obtain_lock_mail();
7844&obtain_lock_unix();
7845foreach my $dd (@aliasdoms, @subs, $d) {
7846 if ($dd ne $d) {
7847 # Show domain name
7848 &$first_print(&text('delete_dom', &show_domain_name($dd)));
7849 &$indent_print();
7850 }
7851
7852 # What is shared for this domain?
7853 my %remote;
7854 if ($preserve) {
7855 %remote = map { $_, 1 } &list_remote_domain_features($dd);
7856 }
7857
7858 # Run the before command
7859 &set_domain_envs($dd, "DELETE_DOMAIN");
7860 local $merr = &making_changes();
7861 &reset_domain_envs($dd);
7862 return &text('delete_emaking', "<tt>$merr</tt>")
7863 if (defined($merr));
7864
7865 if (!$only) {
7866 local @users = $dd->{'alias'} && !$dd->{'aliasmail'} ||
7867 !$dd->{'group'} ? ( )
7868 : &list_domain_users($dd, 1);
7869 local @aliases = &list_domain_aliases($dd);
7870
7871 # Stop any processes belonging to installed scripts, such
7872 # as Ruby on Rails mongrels
7873 local $done_stopscripts;
7874 if (!$dd->{'alias'} && defined(&list_domain_scripts)) {
7875 foreach my $sinfo (&list_domain_scripts($dd)) {
7876 local $script = &get_script($sinfo->{'name'});
7877 local $sfunc = $script->{'stop_func'};
7878 if (defined(&$sfunc)) {
7879 &$first_print(
7880 $text{'delete_stopscripts'})
7881 if (!$done_stopscripts++);
7882 &$sfunc($dd, $sinfo);
7883 }
7884 }
7885 }
7886 if ($done_stopscripts) {
7887 &$second_print($text{'setup_done'});
7888 }
7889
7890 if (@users) {
7891 # Delete mail users and their mail files
7892 &$first_print($text{'delete_users'});
7893 foreach my $u (@users) {
7894 if (!$u->{'nomailfile'} && !$remote{'dir'}) {
7895 &delete_mail_file($u);
7896 }
7897 $u->{'dbs'} = [ grep { !$remote{$_->{'type'}} }
7898 @{$u->{'dbs'}} ];
7899 &delete_user($u, $dd);
7900 if (!$u->{'nocreatehome'} && !$remote{'dir'}) {
7901 &delete_user_home($u, $d);
7902 }
7903 }
7904 &$second_print($text{'setup_done'});
7905 }
7906
7907 # Delete all virtusers
7908 if (!$dd->{'aliascopy'} && !$remote{'mail'}) {
7909 &$first_print($text{'delete_aliases'});
7910 foreach my $v (&list_virtusers()) {
7911 if ($v->{'from'} =~ /\@(\S+)$/ &&
7912 $1 eq $dd->{'dom'}) {
7913 &delete_virtuser($v);
7914 }
7915 }
7916 &sync_alias_virtuals($dd);
7917 &$second_print($text{'setup_done'});
7918 }
7919
7920 # Take down IP
7921 if ($dd->{'iface'}) {
7922 &try_function("virt", "delete_virt", $dd);
7923 }
7924 if ($dd->{'virt6'}) {
7925 &try_function("virt6", "delete_virt6", $dd);
7926 }
7927 }
7928
7929 if (!$dd->{'parent'}) {
7930 # Delete any extra admins
7931 foreach my $admin (&list_extra_admins($dd)) {
7932 &delete_extra_admin($admin);
7933 }
7934 }
7935
7936 # If this is an alias domain, notify the target that it is being
7937 # deleted. This allows things like extra awstats symlinks to be removed
7938 if (!$only && $dd->{'alias'}) {
7939 local $aliasdom = &get_domain($dd->{'alias'});
7940 foreach my $f (@features) {
7941 local $dafunc = "delete_alias_$f";
7942 if ($aliasdom->{$f} && defined(&$dafunc)) {
7943 &try_function($f, $dafunc, $aliasdom, $dd);
7944 }
7945 }
7946 foreach $f (&list_feature_plugins()) {
7947 if ($aliasdom->{$f} &&
7948 &plugin_defined($f, "feature_delete_alias")) {
7949 local $main::error_must_die = 1;
7950 eval { &plugin_call($f, "feature_delete_alias",
7951 $aliasdom, $dd) };
7952 if ($@) {
7953 &$second_print(
7954 &text('delete_aliasfailure',
7955 &plugin_call($f, "feature_name"),
7956 "$@"));
7957 }
7958 }
7959 }
7960 }
7961
7962 # Delete all features (or just 'webmin' if un-importing). Any
7963 # failures are ignored!
7964 my $f;
7965 $dd->{'deleting'} = 1; # so that features know about delete
7966 local $p = &domain_has_website($dd);
7967 if (!$only) {
7968 # Delete all plugins, with error handling
7969 foreach $f (&list_feature_plugins()) {
7970 if ($dd->{$f} && $f ne $p) {
7971 &call_feature_delete($f, $dd, $preserve);
7972 }
7973 }
7974 }
7975 foreach $f ($only ? ( "webmin" ) : reverse(@features)) {
7976 if ($f eq "web" && $p && $p ne "web") {
7977 # Delete web plugin later, after dependencies have
7978 # been removed
7979 &call_feature_delete($p, $dd, $preserve);
7980 }
7981 elsif ($config{$f} && $dd->{$f} || $f eq 'unix') {
7982 # Delete core feature
7983 local @args = ( $preserve );
7984 if ($f eq "mail") {
7985 # Don't delete mail aliases, because we have
7986 # already done so above
7987 push(@args, 1);
7988 }
7989 &call_feature_delete($f, $dd, @args);
7990 }
7991 }
7992
7993 # Delete domain file
7994 &$first_print(&text('delete_domain', &show_domain_name($dd)));
7995 &delete_domain($dd);
7996 &$second_print($text{'setup_done'});
7997
7998 # Update the parent domain Webmin user, so that his ACL
7999 # is refreshed
8000 if ($dd->{'parent'} && $dd->{'parent'} != $d->{'id'}) {
8001 local $parentdom = &get_domain($d->{'parent'});
8002 &refresh_webmin_user($parentdom);
8003 }
8004
8005 # Call post script
8006 &set_domain_envs($dd, "DELETE_DOMAIN");
8007 local $merr = &made_changes();
8008 &reset_domain_envs($dd);
8009 &$second_print(&text('setup_emade', "<tt>$merr</tt>"))
8010 if (defined($merr));
8011
8012 if ($dd ne $d) {
8013 &$outdent_print();
8014 &$second_print($text{'setup_done'});
8015 }
8016 }
8017&release_lock_mail();
8018&release_lock_unix();
8019
8020# Run the after deletion command
8021if (!$nopost) {
8022 &run_post_actions();
8023 }
8024
8025return undef;
8026}
8027
8028# call_feature_delete(feature, &domain, arg, arg, ...)
8029# Calls the core or plugin-specific function to delete a feature. May print
8030# stuff.
8031sub call_feature_delete
8032{
8033local ($f, $dom, @args) = @_;
8034if (&indexof($f, @features) >= 0) {
8035 # Call core delete function
8036 local $dfunc = "delete_$f";
8037 if (!&try_function($f, $dfunc, $dom, @args)) {
8038 $dom->{$f} = 1;
8039 }
8040 }
8041else {
8042 # Call plugin delete function
8043 local $main::error_must_die = 1;
8044 eval { &plugin_call($f, "feature_delete", $dom, @args) };
8045 if ($@) {
8046 local $err = $@;
8047 &$second_print(&text('delete_failure',
8048 &plugin_call($f, "feature_name"), $err));
8049 }
8050 }
8051}
8052
8053# disable_virtual_server(&domain, [reason-code], [reason-why])
8054# Disables all features of one virtual server. Returns undef on success, or
8055# an error message on failure.
8056sub disable_virtual_server
8057{
8058my ($d, $reason, $why) = @_;
8059
8060# Work out what can be disabled
8061my @disable = &get_disable_features($d);
8062
8063# Disable it
8064my %disable = map { $_, 1 } @disable;
8065$d->{'disabled_reason'} = $reason;
8066$d->{'disabled_why'} = $why;
8067$d->{'disabled_time'} = time();
8068
8069# Run the before command
8070&set_domain_envs($d, "DISABLE_DOMAIN");
8071my $merr = &making_changes();
8072&reset_domain_envs($d);
8073return &text('disable_emaking', "<tt>".&html_escape($merr)."</tt>")
8074 if (defined($merr));
8075
8076# Disable all configured features
8077my @disabled;
8078foreach my $f (@features) {
8079 if ($d->{$f} && $disable{$f}) {
8080 my $dfunc = "disable_$f";
8081 if (&try_function($f, $dfunc, $d)) {
8082 push(@disabled, $f);
8083 }
8084 }
8085 }
8086foreach my $f (&list_feature_plugins()) {
8087 if ($d->{$f} && $disable{$f}) {
8088 &plugin_call($f, "feature_disable", $d);
8089 push(@disabled, $f);
8090 }
8091 }
8092
8093# Disable extra admins
8094&update_extra_webmin($d, 1);
8095
8096# Save new domain details
8097&$first_print($text{'save_domain'});
8098$d->{'disabled'} = join(",", @disabled);
8099&save_domain($d);
8100&$second_print($text{'setup_done'});
8101
8102# Run the after command
8103&set_domain_envs($d, "DISABLE_DOMAIN");
8104my $merr = &made_changes();
8105&$second_print(&text('setup_emade', "<tt>$merr</tt>"))
8106 if (defined($merr));
8107&reset_domain_envs($d);
8108
8109return undef;
8110}
8111
8112# enable_virtual_server(&domain)
8113# Enables all disabled features of one virtual server. Returns undef on
8114# success, or an error message on failure.
8115sub enable_virtual_server
8116{
8117my ($d) = @_;
8118
8119# Work out what can be enabled
8120my @enable = &get_enable_features($d);
8121
8122# Go ahead and do it
8123my %enable = map { $_, 1 } @enable;
8124delete($d->{'disabled_reason'});
8125delete($d->{'disabled_why'});
8126
8127# Run the before command
8128&set_domain_envs($d, "ENABLE_DOMAIN");
8129my $merr = &making_changes();
8130&reset_domain_envs($d);
8131return &text('enable_emaking', "<tt>$merr</tt>") if (defined($merr));
8132
8133# Enable all disabled features
8134foreach my $f (@features) {
8135 if ($d->{$f} && $enable{$f}) {
8136 my $efunc = "enable_$f";
8137 &try_function($f, $efunc, $d);
8138 }
8139 }
8140foreach my $f (&list_feature_plugins()) {
8141 if ($d->{$f} && $enable{$f}) {
8142 &plugin_call($f, "feature_enable", $d);
8143 }
8144 }
8145
8146# Enable extra admins
8147&update_extra_webmin($d, 0);
8148
8149# Save new domain details
8150&$first_print($text{'save_domain'});
8151delete($d->{'disabled'});
8152&save_domain($d);
8153&$second_print($text{'setup_done'});
8154
8155# Run the after command
8156&set_domain_envs($d, "ENABLE_DOMAIN");
8157my $merr = &made_changes();
8158&$second_print(&text('setup_emade', "<tt>".&html_escape($merr)."</tt>"))
8159 if (defined($merr));
8160&reset_domain_envs($d);
8161
8162return undef;
8163}
8164
8165# register_post_action(&function, args)
8166sub register_post_action
8167{
8168push(@main::post_actions, [ @_ ]);
8169}
8170
8171# run_post_actions()
8172# Run all registered post-modification actions
8173sub run_post_actions
8174{
8175local $a;
8176
8177# Check if we are restarting Apache, and if so don't reload it
8178local $restarting;
8179foreach $a (@main::post_actions) {
8180 if ($a->[0] eq \&restart_apache && $a->[1] == 1) {
8181 $restarting = 1;
8182 }
8183 }
8184if ($restarting) {
8185 @main::post_actions = grep { $_->[0] ne \&restart_apache ||
8186 $_->[1] != 0 } @main::post_actions;
8187 }
8188
8189# Run unique actions
8190local %done;
8191foreach $a (@main::post_actions) {
8192 # Don't run multiple times. For BIND, all restarts are considered equal
8193 local $key = $a->[0] eq \&restart_bind ? $a->[0] :
8194 $a->[0] eq \&update_secondary_mx_virtusers ? $a->[1]->{'dom'} :
8195 join(",", @$a);
8196 next if ($done{$key}++);
8197
8198 # Call the restart function
8199 local ($afunc, @aargs) = @$a;
8200 local $main::error_must_die = 1;
8201 eval { &$afunc(@aargs) };
8202 if ($@) {
8203 &$second_print(&text('setup_postfailure', "$@"));
8204 }
8205 }
8206@main::post_actions = ( );
8207}
8208
8209# run_post_actions_silently()
8210# Just calls run_post_actions while supressing output
8211sub run_post_actions_silently
8212{
8213&push_all_print();
8214&set_all_null_print();
8215&run_post_actions();
8216&pop_all_print();
8217}
8218
8219# find_bandwidth_job()
8220# Returns the cron job used for bandwidth monitoring
8221sub find_bandwidth_job
8222{
8223local $job = &find_cron_script($bw_cron_cmd);
8224return $job;
8225}
8226
8227# get_bandwidth(&domain)
8228# Returns the bandwidth usage object for some domain
8229sub get_bandwidth
8230{
8231if (!defined($get_bandwidth_cache{$_[0]->{'id'}})) {
8232 local %bwinfo;
8233 &read_file("$bandwidth_dir/$_[0]->{'id'}", \%bwinfo);
8234 local $k;
8235 foreach $k (keys %bwinfo) {
8236 if ($k =~ /^\d+$/) {
8237 # Convert old web entries
8238 $bwinfo{"web_$k"} = $bwinfo{$k};
8239 delete($bwinfo{$k});
8240 }
8241 }
8242 $get_bandwidth_cache{$_[0]->{'id'}} = \%bwinfo;
8243 }
8244return $get_bandwidth_cache{$_[0]->{'id'}};
8245}
8246
8247# save_bandwidth(&domain, &info)
8248sub save_bandwidth
8249{
8250&make_dir($bandwidth_dir, 0700);
8251&write_file("$bandwidth_dir/$_[0]->{'id'}", $_[1]);
8252$get_bandwidth_cache{$_[0]->{'id'}} ||= $_[1];
8253}
8254
8255# bandwidth_input(name, value, [no-unlimited], [dont-change])
8256# Returns HTML for a bandwidth input field, with an 'unlimited' option
8257sub bandwidth_input
8258{
8259local ($name, $value, $nounlimited, $dontchange) = @_;
8260local $rv;
8261local $dis1 = &js_disable_inputs([ $name, $name."_units" ], [ ]);
8262local $dis2 = &js_disable_inputs([ ], [ $name, $name."_units" ]);
8263local $dis;
8264if (!$nounlimited) {
8265 if ($dontchange) {
8266 # Show don't change option
8267 $rv .= &ui_radio($name."_def", 2,
8268 [ [ 2, $text{'massdomains_leave'}, "onClick='$dis1'" ],
8269 [ 1, $text{'edit_bwnone'}, "onClick='$dis1'" ],
8270 [ 0, " ", "onClick='$dis2'" ] ]);
8271 $dis = 1;
8272 }
8273 else {
8274 # Show unlimited option
8275 $rv .= &ui_radio($name."_def", $value ? 0 : 1,
8276 [ [ 1, $text{'edit_bwnone'}, "onClick='$dis1'" ],
8277 [ 0, " ", "onClick='$dis2'" ] ]);
8278 $dis = 1 if (!$value);
8279 }
8280 }
8281local ($val, $u);
8282if ($value eq "") {
8283 # Default to GB, since bytes are rarely useful
8284 $u = "GB";
8285 }
8286elsif ($value && $value%(1024*1024*1024*1024) == 0) {
8287 $val = $value/(1024*1024*1024*1024);
8288 $u = "TB";
8289 }
8290elsif ($value && $value%(1024*1024*1024) == 0) {
8291 $val = $value/(1024*1024*1024);
8292 $u = "GB";
8293 }
8294elsif ($value && $value%(1024*1024) == 0) {
8295 $val = $value/(1024*1024);
8296 $u = "MB";
8297 }
8298elsif ($value && $value%(1024) == 0) {
8299 $val = $value/(1024);
8300 $u = "kB";
8301 }
8302else {
8303 $val = $value;
8304 $u = "bytes";
8305 }
8306local $sel = &ui_select($name."_units", $u,
8307 [ ["bytes"], ["kB"], ["MB"], ["GB"], ["TB"] ], 1, 0, 0, $dis);
8308$rv .= &text('edit_bwpast_'.$config{'bw_past'},
8309 &ui_textbox($name, $val, 10, $dis)." ".$sel,
8310 $config{'bw_period'});
8311return $rv;
8312}
8313
8314# parse_bandwidth(name, error, [no-unlimited])
8315sub parse_bandwidth
8316{
8317if ($in{"$_[0]_def"} && !$_[2]) {
8318 return undef;
8319 }
8320else {
8321 $in{$_[0]} =~ /^\d+$/ && $in{$_[0]} > 0 || &error($_[1]);
8322 local $m = $in{"$_[0]_units"} eq "TB" ? 1024*1024*1024*1024 :
8323 $in{"$_[0]_units"} eq "GB" ? 1024*1024*1024 :
8324 $in{"$_[0]_units"} eq "MB" ? 1024*1024 :
8325 $in{"$_[0]_units"} eq "kB" ? 1024 : 1;
8326 return $in{$_[0]} * $m;
8327 }
8328}
8329
8330# email_template_input(template-file, subject, other-cc, other-bcc,
8331# [mailbox-cc, owner-cc, reseller-cc], [header],[filemode])
8332# Returns HTML for fields for editing an email template
8333sub email_template_input
8334{
8335local ($file, $subject, $cc, $bcc, $mailbox, $owner, $reseller, $header,
8336 $filemode) = @_;
8337local $rv;
8338$rv .= &ui_table_start($header, undef, 2);
8339if ($filemode eq "none" || $filemode eq "default") {
8340 # Show input for selecting if enabled
8341 $rv .= &ui_table_row($text{'newdom_sending'},
8342 &ui_yesno_radio("sending", $filemode eq "default" ? 1 : 0));
8343 }
8344$rv .= &ui_table_row($text{'newdom_subject'},
8345 &ui_textbox("subject", $subject, 60));
8346if (@_ >= 5) {
8347 # Show inputs for selecting destination
8348 $rv .= &ui_table_row($text{'newdom_to'},
8349 &ui_checkbox("mailbox", 1, $text{'newdom_mailbox'}, $mailbox)." ".
8350 &ui_checkbox("owner", 1, $text{'newdom_owner'}, $owner)." ".
8351 ($virtualmin_pro ?
8352 &ui_checkbox("reseller", 1, $text{'newdom_reseller'},
8353 $reseller) : ""));
8354 }
8355$rv .= &ui_table_row($text{'newdom_cc'},
8356 &ui_textbox("cc", $cc, 60));
8357$rv .= &ui_table_row($text{'newdom_bcc'},
8358 &ui_textbox("bcc", $bcc, 60));
8359if ($file) {
8360 $rv .= &ui_table_row(undef,
8361 &ui_textarea("template", &read_file_contents($file), 20, 70),
8362 2);
8363 }
8364$rv .= &ui_table_end();
8365return $rv;
8366}
8367
8368# parse_email_template(file, subject-config, cc-config, bcc-config,
8369# [mailbox-config, owner-config, reseller-config],
8370# [filemode-config])
8371sub parse_email_template
8372{
8373local ($file, $subject_config, $cc_config, $bcc_config,
8374 $mailbox_config, $owner_config, $reseller_config, $filemode_config) = @_;
8375$in{'template'} =~ s/\r//g;
8376&open_lock_tempfile(FILE, ">$file", 1) ||
8377 &error(&text('efilewrite', $file, $!));
8378&print_tempfile(FILE, $in{'template'});
8379&close_tempfile(FILE);
8380
8381&lock_file($module_config_file);
8382$config{$subject_config} = $in{'subject'};
8383$config{$cc_config} = $in{'cc'};
8384$config{$bcc_config} = $in{'bcc'};
8385if ($mailbox_config) {
8386 $config{$mailbox_config} = $in{'mailbox'};
8387 $config{$owner_config} = $in{'owner'};
8388 if ($virtualmin_pro) {
8389 $config{$reseller_config} = $in{'reseller'};
8390 }
8391 }
8392if ($filemode_config && defined($in{'sending'})) {
8393 $config{$filemode_config} = $in{'sending'} ? "default" : "none";
8394 }
8395$config{'last_check'} = time()+1; # no need for check.cgi to be run
8396&save_module_config();
8397&unlock_file($module_config_file);
8398}
8399
8400# escape_user(username)
8401# Returns a Unix username with characters unsuitable for use in a mail
8402# destination (like @) escaped
8403sub escape_user
8404{
8405local $escuser = $_[0];
8406$escuser =~ s/\@/\\\@/g;
8407return $escuser;
8408}
8409
8410# unescape_user(username)
8411# The reverse of escape_user
8412sub unescape_user
8413{
8414local $escuser = $_[0];
8415$escuser =~ s/\\\@/\@/g;
8416return $escuser;
8417}
8418
8419# escape_alias(username)
8420# Converts a username into a suitable alias name
8421sub escape_alias
8422{
8423local $escuser = $_[0];
8424$escuser =~ s/\@/-/g;
8425return $escuser;
8426}
8427
8428# replace_atsign(username)
8429# Replace an @ in a username with -
8430sub replace_atsign
8431{
8432local $rv = $_[0];
8433$rv =~ s/\@/-/g;
8434return $rv;
8435}
8436
8437# dotqmail_file(&user)
8438sub dotqmail_file
8439{
8440return "$_[0]->{'home'}/.qmail";
8441}
8442
8443# get_dotqmail(file)
8444sub get_dotqmail
8445{
8446$_[0] =~ /\.qmail(-(\S+))?$/;
8447local $alias = { 'file' => $_[0],
8448 'name' => $2 };
8449local $_;
8450open(AFILE, $_[0]) || return undef;
8451while(<AFILE>) {
8452 s/\r|\n//g;
8453 s/#.*$//g;
8454 if (/\S/) {
8455 push(@{$alias->{'values'}}, $_);
8456 }
8457 }
8458close(AFILE);
8459return $alias;
8460}
8461
8462# save_dotqmail(&alias, file, username|aliasname)
8463sub save_dotqmail
8464{
8465if (@{$_[0]->{'values'}}) {
8466 &open_lock_tempfile(AFILE, ">$_[1]");
8467 local $v;
8468 foreach $v (@{$_[0]->{'values'}}) {
8469 if ($v eq "\\$_[2]" || $v eq "\\NEWUSER") {
8470 # Delivery to this user means to his maildir
8471 if ($config{'vpopmail_md'}) {
8472 &print_tempfile(AFILE, "./$config{'vpopmail_md'}/\n");
8473 }
8474 else {
8475 &print_tempfile(AFILE, "./Maildir/\n");
8476 }
8477 }
8478 else {
8479 &print_tempfile(AFILE, $v,"\n");
8480 }
8481 }
8482 &close_tempfile(AFILE);
8483 }
8484else {
8485 &unlink_file($_[1]);
8486 }
8487}
8488
8489# list_templates()
8490# Returns a list of all virtual server templates, including two defaults for
8491# top-level and sub-servers
8492sub list_templates
8493{
8494if (scalar(@list_templates_cache)) {
8495 # Use cached copy
8496 return @list_templates_cache;
8497 }
8498local @rv;
8499&ensure_template("domain-template");
8500&ensure_template("subdomain-template");
8501&ensure_template("framefwd-template");
8502push(@rv, { 'id' => 0,
8503 'name' => $text{'newtmpl_name0'},
8504 'standard' => 1,
8505 'default' => 1,
8506 'web' => $config{'apache_config'},
8507 'web_suexec' => $config{'suexec'},
8508 'web_writelogs' => $config{'web_writelogs'},
8509 'web_user' => $config{'web_user'},
8510 'web_html_dir' => $config{'html_dir'},
8511 'web_html_perms' => $config{'html_perms'} || 750,
8512 'web_stats_dir' => $config{'stats_dir'},
8513 'web_stats_hdir' => $config{'stats_hdir'},
8514 'web_stats_pass' => $config{'stats_pass'},
8515 'web_stats_noedit' => $config{'stats_noedit'},
8516 'web_port' => $default_web_port,
8517 'web_sslport' => $default_web_sslport,
8518 'web_urlport' => $config{'web_urlport'},
8519 'web_urlsslport' => $config{'web_urlsslport'},
8520 'web_alias' => $config{'alias_mode'},
8521 'web_webmin_ssl' => $config{'webmin_ssl'},
8522 'web_usermin_ssl' => $config{'usermin_ssl'},
8523 'web_webmail' => $config{'web_webmail'},
8524 'web_webmaildom' => $config{'web_webmaildom'},
8525 'web_admin' => $config{'web_admin'},
8526 'web_admindom' => $config{'web_admindom'},
8527 'php_vars' => $config{'php_vars'} || "none",
8528 'web_php_suexec' => int($config{'php_suexec'}),
8529 'web_ruby_suexec' => $config{'ruby_suexec'} eq '' ? -1 :
8530 int($config{'ruby_suexec'}),
8531 'web_phpver' => $config{'phpver'},
8532 'web_php_noedit' => int($config{'php_noedit'}),
8533 'web_phpchildren' => $config{'phpchildren'},
8534 'web_ssi' => $config{'web_ssi'} eq '' ? 2 : $config{'web_ssi'},
8535 'web_ssi_suffix' => $config{'web_ssi_suffix'},
8536 'webalizer' => $config{'def_webalizer'} || "none",
8537 'disabled_web' => $config{'disabled_web'} || "none",
8538 'disabled_url' => $config{'disabled_url'} || "none",
8539 'dns' => $config{'bind_config'},
8540 'dns_replace' => $config{'bind_replace'},
8541 'dns_view' => $config{'dns_view'},
8542 'dns_spf' => $config{'bind_spf'} || "none",
8543 'dns_spfhosts' => $config{'bind_spfhosts'},
8544 'dns_spfincludes' => $config{'bind_spfincludes'},
8545 'dns_spfall' => $config{'bind_spfall'},
8546 'dns_dmarc' => $config{'bind_dmarc'} || "none",
8547 'dns_dmarcp' => $config{'bind_dmarcp'} || "none",
8548 'dns_dmarcpct' => $config{'bind_dmarcpct'} || 100,
8549 'dns_sub' => $config{'bind_sub'} || "none",
8550 'dns_master' => $config{'bind_master'} || "none",
8551 'dns_ns' => $config{'dns_ns'},
8552 'dns_prins' => $config{'dns_prins'},
8553 'dns_records' => $config{'dns_records'},
8554 'dns_ttl' => $config{'dns_ttl'},
8555 'dnssec' => $config{'dnssec'} || "none",
8556 'dnssec_alg' => $config{'dnssec_alg'},
8557 'dnssec_single' => $config{'dnssec_single'},
8558 'namedconf' => $config{'namedconf'} || "none",
8559 'namedconf_no_allow_transfer' =>
8560 $config{'namedconf_no_allow_transfer'},
8561 'namedconf_no_also_notify' =>
8562 $config{'namedconf_no_also_notify'},
8563 'ftp' => $config{'proftpd_config'},
8564 'ftp_dir' => $config{'ftp_dir'},
8565 'logrotate' => $config{'logrotate_config'} || "none",
8566 'logrotate_files' => $config{'logrotate_files'} || "none",
8567 'logrotate_shared' => $config{'logrotate_shared'} || "no",
8568 'status' => $config{'statusemail'} || "none",
8569 'statusonly' => int($config{'statusonly'}),
8570 'statustimeout' => $config{'statustimeout'},
8571 'statustmpl' => $config{'statustmpl'},
8572 'statussslcert' => $config{'statussslcert'},
8573 'mail_on' => $config{'domain_template'} eq "none" ? "none" : "yes",
8574 'mail' => $config{'domain_template'} eq "none" ||
8575 $config{'domain_template'} eq "default" ?
8576 &cat_file("domain-template") :
8577 &cat_file($config{'domain_template'}),
8578 'mail_subject' => $config{'newdom_subject'} ||
8579 &entities_to_ascii($text{'mail_dsubject'}),
8580 'mail_cc' => $config{'newdom_cc'},
8581 'mail_bcc' => $config{'newdom_bcc'},
8582 'aliascopy' => $config{'aliascopy'} || 0,
8583 'bccto' => $config{'bccto'} || 'none',
8584 'spamclear' => $config{'spamclear'} || 'none',
8585 'spamtrap' => $config{'spamtrap'} || 'none',
8586 'defmquota' => $config{'defmquota'} || "none",
8587 'user_aliases' => $config{'newuser_aliases'} || "none",
8588 'dom_aliases' => $config{'newdom_aliases'} || "none",
8589 'dom_aliases_bounce' => int($config{'newdom_alias_bounce'}),
8590 'mysql' => $config{'mysql_db'} || '${PREFIX}',
8591 'mysql_wild' => $config{'mysql_wild'},
8592 'mysql_suffix' => $config{'mysql_suffix'} || "none",
8593 'mysql_hosts' => $config{'mysql_hosts'} || "none",
8594 'mysql_mkdb' => $config{'mysql_mkdb'},
8595 'mysql_nopass' => $config{'mysql_nopass'},
8596 'mysql_nouser' => $config{'mysql_nouser'},
8597 'mysql_chgrp' => $config{'mysql_chgrp'},
8598 'mysql_charset' => $config{'mysql_charset'},
8599 'mysql_collate' => $config{'mysql_collate'},
8600 'mysql_conns' => $config{'mysql_conns'} || "none",
8601 'mysql_uconns' => $config{'mysql_uconns'} || "none",
8602 'postgres_encoding' => $config{'postgres_encoding'} || "none",
8603 'skel' => $config{'virtual_skel'} || "none",
8604 'skel_subs' => int($config{'virtual_skel_subs'}),
8605 'skel_nosubs' => $config{'virtual_skel_nosubs'},
8606 'frame' => &cat_file("framefwd-template", 1),
8607 'gacl' => 1,
8608 'gacl_umode' => $config{'gacl_umode'},
8609 'gacl_uusers' => $config{'gacl_uusers'},
8610 'gacl_ugroups' => $config{'gacl_ugroups'},
8611 'gacl_groups' => $config{'gacl_groups'},
8612 'gacl_root' => $config{'gacl_root'},
8613 'webmin_group' => $config{'webmin_group'},
8614 'extra_prefix' => $config{'extra_prefix'} || "none",
8615 'ugroup' => $config{'defugroup'} || "none",
8616 'sgroup' => $config{'domains_group'} || "none",
8617 'quota' => $config{'defquota'} || "none",
8618 'uquota' => $config{'defuquota'} || "none",
8619 'ushell' => $config{'defushell'} || "none",
8620 'mailboxlimit' => $config{'defmailboxlimit'} eq "" ? "none" :
8621 $config{'defmailboxlimit'},
8622 'aliaslimit' => $config{'defaliaslimit'} eq "" ? "none" :
8623 $config{'defaliaslimit'},
8624 'dbslimit' => $config{'defdbslimit'} eq "" ? "none" :
8625 $config{'defdbslimit'},
8626 'domslimit' => $config{'defdomslimit'} eq "" ? 0 :
8627 $config{'defdomslimit'} eq "*" ? "none" :
8628 $config{'defdomslimit'},
8629 'aliasdomslimit' => $config{'defaliasdomslimit'} eq "" ||
8630 $config{'defaliasdomslimit'} eq "*" ? "none" :
8631 $config{'defaliasdomslimit'},
8632 'realdomslimit' => $config{'defrealdomslimit'} eq "" ||
8633 $config{'defrealdomslimit'} eq "*" ? "none" :
8634 $config{'defrealdomslimit'},
8635 'bwlimit' => $config{'defbwlimit'} eq "" ? "none" :
8636 $config{'defbwlimit'},
8637 'mongrelslimit' => $config{'defmongrelslimit'} eq "" ? "none" :
8638 $config{'defmongrelslimit'},
8639 'capabilities' => $config{'defcapabilities'} || "none",
8640 'featurelimits' => $config{'featurelimits'} || "none",
8641 'nodbname' => $config{'defnodbname'},
8642 'norename' => $config{'defnorename'},
8643 'forceunder' => $config{'defforceunder'},
8644 'safeunder' => $config{'defsafeunder'},
8645 'ipfollow' => $config{'defipfollow'},
8646 'resources' => $config{'defresources'} || "none",
8647 'ranges' => $config{'ip_ranges'} || "none",
8648 'ranges6' => $config{'ip_ranges6'} || "none",
8649 'mailgroup' => $config{'mailgroup'} || "none",
8650 'ftpgroup' => $config{'ftpgroup'} || "none",
8651 'dbgroup' => $config{'dbgroup'} || "none",
8652 'othergroups' => $config{'othergroups'} || "none",
8653 'quotatype' => $config{'hard_quotas'} ? "hard" : "soft",
8654 'hashpass' => $config{'hashpass'} || 0,
8655 'hashtypes' => $config{'hashtypes'},
8656 'append_style' => $config{'append_style'},
8657 'domalias' => $config{'domalias'} || "none",
8658 'domalias_type' => $config{'domalias_type'} || 0,
8659 'for_parent' => 1,
8660 'for_sub' => 0,
8661 'for_alias' => 1,
8662 'for_users' => !$config{'deftmpl_nousers'},
8663 'resellers' => !defined($config{'tmpl_resellers'}) ? "*" :
8664 $config{'tmpl_resellers'},
8665 'owners' => !defined($config{'tmpl_owners'}) ? "*" :
8666 $config{'tmpl_owners'},
8667 'autoconfig' => $config{'tmpl_autoconfig'} || "none",
8668 'outlook_autoconfig' => $config{'tmpl_outlook_autoconfig'} || "none",
8669 } );
8670foreach my $w (@php_wrapper_templates) {
8671 $rv[0]->{$w} = $config{$w} || 'none';
8672 }
8673foreach my $phpver (@all_possible_php_versions) {
8674 $rv[0]->{'web_php_ini_'.$phpver} =
8675 defined($config{'php_ini_'.$phpver}) ?
8676 $config{'php_ini_'.$phpver} : $config{'php_ini'},
8677 }
8678if (!defined(getpwnam($rv[0]->{'web_user'})) &&
8679 $rv[0]->{'web_user'} ne 'none' &&
8680 $rv[0]->{'web_user'} ne '') {
8681 # Apache user is invalid, due to bad Virtualmin install script. Fix it
8682 $rv[0]->{'web_user'} = &get_apache_user();
8683 }
8684my @avail;
8685foreach my $m (&list_domain_owner_modules()) {
8686 push(@avail, $m->[0]."=".$config{'avail_'.$m->[0]});
8687 }
8688$rv[0]->{'avail'} = join(' ', @avail);
8689push(@rv, { 'id' => 1,
8690 'name' => $text{'newtmpl_name1'},
8691 'standard' => 1,
8692 'mail_on' => $config{'subdomain_template'} eq "none" ? "none" :
8693 $config{'subdomain_template'} eq "" ? "" : "yes",
8694 'mail' => $config{'subdomain_template'} eq "none" ||
8695 $config{'subdomain_template'} eq "" ||
8696 $config{'subdomain_template'} eq "default" ?
8697 &cat_file("subdomain-template") :
8698 &cat_file($config{'subdomain_template'}),
8699 'mail_subject' => $config{'newsubdom_subject'} ||
8700 &entities_to_ascii($text{'mail_dsubject'}),
8701 'mail_cc' => $config{'newsubdom_cc'},
8702 'mail_bcc' => $config{'newsubdom_bcc'},
8703 'skel' => $config{'sub_skel'} || "none",
8704 'for_parent' => 0,
8705 'for_sub' => 1,
8706 'for_alias' => 0,
8707 'for_users' => !$config{'subtmpl_nousers'},
8708 'resellers' => '*',
8709 'owners' => '*',
8710 } );
8711local $f;
8712opendir(DIR, $templates_dir);
8713while(defined($f = readdir(DIR))) {
8714 if ($f ne "." && $f ne "..") {
8715 local %tmpl;
8716 &read_file("$templates_dir/$f", \%tmpl);
8717 $tmpl{'file'} = "$templates_dir/$f";
8718 $tmpl{'mail'} =~ s/\t/\n/g;
8719 $tmpl{'resellers'} = '*' if (!defined($tmpl{'resellers'}));
8720 $tmpl{'owners'} = '*' if (!defined($tmpl{'owners'}));
8721 if ($tmpl{'id'} == 1 || $tmpl{'id'} == 0) {
8722 foreach $k (keys %tmpl) {
8723 $rv[$tmpl{'id'}]->{$k} = $tmpl{$k}
8724 if (!defined($rv[$tmpl{'id'}]->{$k}));
8725 }
8726 }
8727 else {
8728 push(@rv, \%tmpl);
8729 }
8730 foreach my $phpver (@all_possible_php_versions) {
8731 if (!defined($tmpl{'web_php_ini_'.$phpver})) {
8732 $tmpl{'web_php_ini_'.$phpver} =
8733 $tmpl{'web_php_ini'};
8734 }
8735 }
8736 }
8737 }
8738closedir(DIR);
8739@list_templates_cache = @rv;
8740return @rv;
8741}
8742
8743# list_available_templates([&parentdom], [&aliasdom])
8744# Returns a list of templates for creating a new server, with the given parent
8745# and alias target domains
8746sub list_available_templates
8747{
8748local ($parentdom, $aliasdom) = @_;
8749local @rv;
8750foreach my $t (&list_templates()) {
8751 next if ($t->{'deleted'});
8752 next if (($parentdom && !$aliasdom) && !$t->{'for_sub'});
8753 next if (!$parentdom && !$t->{'for_parent'});
8754 next if (!&master_admin() && !&reseller_admin() && !$t->{'for_users'});
8755 next if ($aliasdom && !$t->{'for_alias'});
8756 next if (!&can_use_template($t));
8757 push(@rv, $t);
8758 }
8759return @rv;
8760}
8761
8762# save_template(&template)
8763# Create or update a template. If saving the standard template, updates the
8764# appropriate config options instead of the template file.
8765sub save_template
8766{
8767local ($tmpl) = @_;
8768local $save_config = 0;
8769if (!defined($tmpl->{'id'})) {
8770 $tmpl->{'id'} = &domain_id();
8771 }
8772if ($tmpl->{'id'} == 0) {
8773 # Update appropriate config entries
8774 $config{'deftmpl_nousers'} = !$tmpl->{'for_users'};
8775 if ($tmpl->{'resellers'} eq '*') {
8776 delete($config{'tmpl_resellers'});
8777 }
8778 else {
8779 $config{'tmpl_resellers'} = $tmpl->{'resellers'};
8780 }
8781 if ($tmpl->{'owners'} eq '*') {
8782 delete($config{'tmpl_owners'});
8783 }
8784 else {
8785 $config{'tmpl_owners'} = $tmpl->{'owners'};
8786 }
8787 $config{'apache_config'} = $tmpl->{'web'};
8788 $config{'suexec'} = $tmpl->{'web_suexec'};
8789 $config{'web_writelogs'} = $tmpl->{'web_writelogs'};
8790 $config{'web_user'} = $tmpl->{'web_user'};
8791 $config{'html_dir'} = $tmpl->{'web_html_dir'};
8792 $config{'html_perms'} = $tmpl->{'web_html_perms'};
8793 $config{'stats_dir'} = $tmpl->{'web_stats_dir'};
8794 $config{'stats_hdir'} = $tmpl->{'web_stats_hdir'};
8795 $config{'stats_pass'} = $tmpl->{'web_stats_pass'};
8796 $config{'stats_noedit'} = $tmpl->{'web_stats_noedit'};
8797 $config{'web_port'} = $tmpl->{'web_port'};
8798 $config{'web_sslport'} = $tmpl->{'web_sslport'};
8799 $config{'web_urlport'} = $tmpl->{'web_urlport'};
8800 $config{'web_urlsslport'} = $tmpl->{'web_urlsslport'};
8801 $config{'webmin_ssl'} = $tmpl->{'web_webmin_ssl'};
8802 $config{'usermin_ssl'} = $tmpl->{'web_usermin_ssl'};
8803 $config{'web_webmail'} = $tmpl->{'web_webmail'};
8804 $config{'web_webmaildom'} = $tmpl->{'web_webmaildom'};
8805 $config{'web_admin'} = $tmpl->{'web_admin'};
8806 $config{'web_admindom'} = $tmpl->{'web_admindom'};
8807 $config{'php_vars'} = $tmpl->{'php_vars'} eq "none" ? "" :
8808 $tmpl->{'php_vars'};
8809 $config{'php_suexec'} = $tmpl->{'web_php_suexec'};
8810 $config{'ruby_suexec'} = $tmpl->{'web_ruby_suexec'};
8811 $config{'phpver'} = $tmpl->{'web_phpver'};
8812 $config{'phpchildren'} = $tmpl->{'web_phpchildren'};
8813 $config{'web_ssi'} = $tmpl->{'web_ssi'};
8814 $config{'web_ssi_suffix'} = $tmpl->{'web_ssi_suffix'};
8815 foreach my $phpver (@all_possible_php_versions) {
8816 $config{'php_ini_'.$phpver} = $tmpl->{'web_php_ini_'.$phpver};
8817 }
8818 delete($config{'php_ini'});
8819 $config{'php_noedit'} = $tmpl->{'web_php_noedit'};
8820 $config{'def_webalizer'} = $tmpl->{'webalizer'} eq "none" ? "" :
8821 $tmpl->{'webalizer'};
8822 $config{'disabled_web'} = $tmpl->{'disabled_web'} eq "none" ? "" :
8823 $tmpl->{'disabled_web'};
8824 $config{'disabled_url'} = $tmpl->{'disabled_url'} eq "none" ? "" :
8825 $tmpl->{'disabled_url'};
8826 $config{'alias_mode'} = $tmpl->{'web_alias'};
8827 $config{'bind_config'} = $tmpl->{'dns'};
8828 $config{'bind_replace'} = $tmpl->{'dns_replace'};
8829 $config{'bind_spf'} = $tmpl->{'dns_spf'} eq 'none' ? undef
8830 : $tmpl->{'dns_spf'};
8831 $config{'bind_spfhosts'} = $tmpl->{'dns_spfhosts'};
8832 $config{'bind_spfincludes'} = $tmpl->{'dns_spfincludes'};
8833 $config{'bind_spfall'} = $tmpl->{'dns_spfall'};
8834 $config{'bind_dmarc'} = $tmpl->{'dns_dmarc'} eq 'none' ?
8835 undef : $tmpl->{'dns_dmarc'};
8836 $config{'bind_dmarcp'} = $tmpl->{'dns_dmarcp'};
8837 $config{'bind_dmarcpct'} = $tmpl->{'dns_dmarcpct'};
8838 $config{'bind_sub'} = $tmpl->{'dns_sub'} eq 'none' ? undef
8839 : $tmpl->{'dns_sub'};
8840 $config{'bind_master'} = $tmpl->{'dns_master'} eq 'none' ? undef
8841 : $tmpl->{'dns_master'};
8842 $config{'dns_view'} = $tmpl->{'dns_view'};
8843 $config{'dns_ns'} = $tmpl->{'dns_ns'};
8844 $config{'dns_prins'} = $tmpl->{'dns_prins'};
8845 $config{'dns_records'} = $tmpl->{'dns_records'};
8846 $config{'dns_ttl'} = $tmpl->{'dns_ttl'};
8847 $config{'namedconf'} = $tmpl->{'namedconf'} eq 'none' ? undef :
8848 $tmpl->{'namedconf'};
8849 $config{'namedconf_no_also_notify'} =
8850 $tmpl->{'namedconf_no_also_notify'};
8851 $config{'namedconf_no_allow_transfer'} =
8852 $tmpl->{'namedconf_no_allow_transfer'};
8853 $config{'dnssec'} = $tmpl->{'dnssec'} eq 'none' ? undef
8854 : $tmpl->{'dnssec'};
8855 $config{'dnssec_alg'} = $tmpl->{'dnssec_alg'};
8856 $config{'dnssec_single'} = $tmpl->{'dnssec_single'};
8857 delete($config{'mx_server'});
8858 $config{'proftpd_config'} = $tmpl->{'ftp'};
8859 $config{'ftp_dir'} = $tmpl->{'ftp_dir'};
8860 $config{'logrotate_config'} = $tmpl->{'logrotate'} eq "none" ?
8861 "" : $tmpl->{'logrotate'};
8862 $config{'logrotate_files'} = $tmpl->{'logrotate_files'} eq "none" ?
8863 "" : $tmpl->{'logrotate_files'};
8864 $config{'logrotate_shared'} = $tmpl->{'logrotate_shared'};
8865 $config{'statusemail'} = $tmpl->{'status'} eq 'none' ?
8866 '' : $tmpl->{'status'};
8867 $config{'statusonly'} = $tmpl->{'statusonly'};
8868 $config{'statustimeout'} = $tmpl->{'statustimeout'};
8869 $config{'statustmpl'} = $tmpl->{'statustmpl'};
8870 $config{'statussslcert'} = $tmpl->{'statussslcert'};
8871 if ($tmpl->{'mail_on'} eq 'none') {
8872 # Don't send
8873 $config{'domain_template'} = 'none';
8874 }
8875 else {
8876 # Sending, but need to set a valid mail file
8877 if ($config{'domain_template'} eq 'none') {
8878 $config{'domain_template'} = 'default';
8879 }
8880 }
8881 # Write message to default template file, or custom if set
8882 &uncat_file($config{'domain_template'} eq "none" ||
8883 $config{'domain_template'} eq "default" ?
8884 "domain-template" :
8885 $config{'domain_template'}, $tmpl->{'mail'});
8886 $config{'newdom_subject'} = $tmpl->{'mail_subject'};
8887 $config{'newdom_cc'} = $tmpl->{'mail_cc'};
8888 $config{'newdom_bcc'} = $tmpl->{'mail_bcc'};
8889 $config{'aliascopy'} = $tmpl->{'aliascopy'};
8890 $config{'bccto'} = $tmpl->{'bccto'};
8891 $config{'spamclear'} = $tmpl->{'spamclear'};
8892 $config{'spamtrap'} = $tmpl->{'spamtrap'};
8893 $config{'defmquota'} = $tmpl->{'defmquota'} eq "none" ?
8894 "" : $tmpl->{'defmquota'};
8895 $config{'newuser_aliases'} = $tmpl->{'user_aliases'} eq "none" ?
8896 "" : $tmpl->{'user_aliases'};
8897 $config{'newdom_aliases'} = $tmpl->{'dom_aliases'} eq "none" ?
8898 "" : $tmpl->{'dom_aliases'};
8899 $config{'newdom_alias_bounce'} = $tmpl->{'dom_aliases_bounce'};
8900 $config{'mysql_db'} = $tmpl->{'mysql'};
8901 $config{'mysql_wild'} = $tmpl->{'mysql_wild'};
8902 $config{'mysql_hosts'} = $tmpl->{'mysql_hosts'} eq "none" ?
8903 "" : $tmpl->{'mysql_hosts'};
8904 $config{'mysql_suffix'} = $tmpl->{'mysql_suffix'} eq "none" ?
8905 "" : $tmpl->{'mysql_suffix'};
8906 $config{'mysql_mkdb'} = $tmpl->{'mysql_mkdb'};
8907 $config{'mysql_nopass'} = $tmpl->{'mysql_nopass'};
8908 $config{'mysql_nouser'} = $tmpl->{'mysql_nouser'};
8909 $config{'mysql_chgrp'} = $tmpl->{'mysql_chgrp'};
8910 $config{'mysql_charset'} = $tmpl->{'mysql_charset'};
8911 $config{'mysql_collate'} = $tmpl->{'mysql_collate'};
8912 $config{'mysql_conns'} = $tmpl->{'mysql_conns'};
8913 $config{'mysql_uconns'} = $tmpl->{'mysql_uconns'};
8914 $config{'postgres_encoding'} = $tmpl->{'postgres_encoding'};
8915 $config{'virtual_skel'} = $tmpl->{'skel'} eq "none" ? "" :
8916 $tmpl->{'skel'};
8917 $config{'virtual_skel_subs'} = $tmpl->{'skel_subs'};
8918 $config{'virtual_skel_nosubs'} = $tmpl->{'skel_nosubs'};
8919 $config{'gacl_umode'} = $tmpl->{'gacl_umode'};
8920 $config{'gacl_ugroups'} = $tmpl->{'gacl_ugroups'};
8921 $config{'gacl_users'} = $tmpl->{'gacl_users'};
8922 $config{'gacl_groups'} = $tmpl->{'gacl_groups'};
8923 $config{'gacl_root'} = $tmpl->{'gacl_root'};
8924 $config{'webmin_group'} = $tmpl->{'webmin_group'};
8925 $config{'extra_prefix'} = $tmpl->{'extra_prefix'} eq "none" ? "" :
8926 $tmpl->{'extra_prefix'};
8927 $config{'defugroup'} = $tmpl->{'ugroup'};
8928 $config{'domains_group'} = $tmpl->{'sgroup'} eq "none" ? "" :
8929 $tmpl->{'sgroup'};
8930 $config{'defquota'} = $tmpl->{'quota'};
8931 $config{'defuquota'} = $tmpl->{'uquota'};
8932 $config{'defushell'} = $tmpl->{'ushell'};
8933 $config{'defmailboxlimit'} = $tmpl->{'mailboxlimit'} eq 'none' ? undef :
8934 $tmpl->{'mailboxlimit'};
8935 $config{'defaliaslimit'} = $tmpl->{'aliaslimit'} eq 'none' ? undef :
8936 $tmpl->{'aliaslimit'};
8937 $config{'defdbslimit'} = $tmpl->{'dbslimit'} eq 'none' ? undef :
8938 $tmpl->{'dbslimit'};
8939 $config{'defdomslimit'} = $tmpl->{'domslimit'} eq 'none' ? "*" :
8940 $tmpl->{'domslimit'} eq '0' ? "" :
8941 $tmpl->{'domslimit'};
8942 $config{'defaliasdomslimit'} = $tmpl->{'aliasdomslimit'} eq 'none' ?
8943 "*" : $tmpl->{'aliasdomslimit'};
8944 $config{'defrealdomslimit'} = $tmpl->{'realdomslimit'} eq 'none' ?
8945 "*" : $tmpl->{'realdomslimit'};
8946 $config{'defbwlimit'} = $tmpl->{'bwlimit'} eq 'none' ? undef :
8947 $tmpl->{'bwlimit'};
8948 $config{'defmongrelslimit'} = $tmpl->{'mongrelslimit'} eq 'none' ?
8949 undef : $tmpl->{'mongrelslimit'};
8950 $config{'defcapabilities'} = $tmpl->{'capabilities'};
8951 $config{'featurelimits'} = $tmpl->{'featurelimits'};
8952 $config{'defnodbname'} = $tmpl->{'nodbname'};
8953 $config{'defnorename'} = $tmpl->{'norename'};
8954 $config{'defforceunder'} = $tmpl->{'forceunder'};
8955 $config{'defsafeunder'} = $tmpl->{'safeunder'};
8956 $config{'defipfollow'} = $tmpl->{'ipfollow'};
8957 $config{'defresources'} = $tmpl->{'resources'};
8958 &uncat_file("framefwd-template", $tmpl->{'frame'}, 1);
8959 $config{'ip_ranges'} = $tmpl->{'ranges'} eq 'none' ? undef :
8960 $tmpl->{'ranges'};
8961 $config{'ip_ranges6'} = $tmpl->{'ranges6'} eq 'none' ? undef :
8962 $tmpl->{'ranges6'};
8963 $config{'mailgroup'} = $tmpl->{'mailgroup'} eq 'none' ? undef :
8964 $tmpl->{'mailgroup'};
8965 $config{'ftpgroup'} = $tmpl->{'ftpgroup'} eq 'none' ? undef :
8966 $tmpl->{'ftpgroup'};
8967 $config{'dbgroup'} = $tmpl->{'dbgroup'} eq 'none' ? undef :
8968 $tmpl->{'dbgroup'};
8969 $config{'othergroups'} = $tmpl->{'othergroups'} eq 'none' ? undef :
8970 $tmpl->{'othergroups'};
8971 $config{'hard_quotas'} = $tmpl->{'quotatype'} eq "hard" ? 1 : 0;
8972 $config{'hashpass'} = $tmpl->{'hashpass'};
8973 $config{'hashtypes'} = $tmpl->{'hashtypes'};
8974 $config{'append_style'} = $tmpl->{'append_style'};
8975 $config{'domalias'} = $tmpl->{'domalias'} eq 'none' ? undef :
8976 $tmpl->{'domalias'};
8977 $config{'domalias_type'} = $tmpl->{'domalias_type'};
8978 $config{'tmpl_autoconfig'} = $tmpl->{'autoconfig'};
8979 $config{'tmpl_outlook_autoconfig'} = $tmpl->{'outlook_autoconfig'};
8980 foreach my $w (@php_wrapper_templates) {
8981 $config{$w} = $tmpl->{$w};
8982 }
8983 my %avail = map { split(/=/, $_) } split(/\s+/, $tmpl->{'avail'});
8984 foreach my $m (&list_domain_owner_modules()) {
8985 $config{'avail_'.$m->[0]} = $avail{$m->[0]} || 0;
8986 }
8987 $save_config = 1;
8988 }
8989elsif ($tmpl->{'id'} == 1) {
8990 # For the default for sub-servers, update mail and skel in config only
8991 $config{'subtmpl_nousers'} = !$tmpl->{'for_users'};
8992 if ($tmpl->{'mail_on'} eq 'none') {
8993 # Don't send
8994 $config{'subdomain_template'} = 'none';
8995 }
8996 elsif ($tmpl->{'mail_on'} eq '') {
8997 # Use default message (for top-level servers)
8998 $config{'subdomain_template'} = '';
8999 }
9000 else {
9001 # Sending, but need to set a valid mail file
9002 if ($config{'subdomain_template'} eq 'none') {
9003 $config{'subdomain_template'} = 'default';
9004 }
9005 }
9006 &uncat_file($config{'subdomain_template'} eq "none" ||
9007 $config{'subdomain_template'} eq "" ||
9008 $config{'subdomain_template'} eq "default" ?
9009 "subdomain-template" :
9010 $config{'subdomain_template'}, $tmpl->{'mail'});
9011 $config{'newsubdom_subject'} = $tmpl->{'mail_subject'};
9012 $config{'newsubdom_cc'} = $tmpl->{'mail_cc'};
9013 $config{'newsubdom_bcc'} = $tmpl->{'mail_bcc'};
9014 $config{'sub_skel'} = $tmpl->{'skel'} eq "none" ? "" :
9015 $tmpl->{'skel'};
9016 $save_config = 1;
9017 }
9018if ($tmpl->{'id'} != 0) {
9019 # Just save the entire template to a file
9020 &make_dir($templates_dir, 0700);
9021 $tmpl->{'created'} ||= time();
9022 $tmpl->{'mail'} =~ s/\n/\t/g;
9023 &lock_file("$templates_dir/$tmpl->{'id'}");
9024 &write_file("$templates_dir/$tmpl->{'id'}", $tmpl);
9025 &unlock_file("$templates_dir/$tmpl->{'id'}");
9026 }
9027else {
9028 # Only plugin-specific options go to a file
9029 &make_dir($templates_dir, 0700);
9030 &lock_file("$templates_dir/$tmpl->{'id'}");
9031 &read_file("$templates_dir/$tmpl->{'id'}", \%ptmpl);
9032 local %ptmpl;
9033 foreach my $p (@plugins) {
9034 foreach my $k (keys %$tmpl) {
9035 if ($k =~ /^\Q$p\E/) {
9036 $ptmpl{$k} = $tmpl->{$k};
9037 }
9038 }
9039 }
9040 &write_file("$templates_dir/$tmpl->{'id'}", \%ptmpl);
9041 &unlock_file("$templates_dir/$tmpl->{'id'}");
9042 }
9043if ($save_config) {
9044 &lock_file($module_config_file);
9045 $config{'last_check'} = time()+1;
9046 &write_file($module_config_file, \%config);
9047 &unlock_file($module_config_file);
9048 }
9049undef(@list_templates_cache);
9050}
9051
9052# get_template(id)
9053# Returns a template, with any default settings filled in from real default
9054sub get_template
9055{
9056local @tmpls = &list_templates();
9057local ($tmpl) = grep { $_->{'id'} == $_[0] } @tmpls;
9058return undef if (!$tmpl); # not found
9059if (!$tmpl->{'default'}) {
9060 local $def = $tmpls[0];
9061 local $p;
9062 local %done;
9063 foreach $p ("dns_spf", "dns_sub", "dns_master", "dns_dmarc",
9064 "web", "dns", "ftp", "frame", "user_aliases",
9065 "ugroup", "sgroup", "quota", "uquota", "ushell",
9066 "mailboxlimit", "domslimit",
9067 "dbslimit", "aliaslimit", "bwlimit", "mongrelslimit","skel",
9068 "mysql_hosts", "mysql_mkdb", "mysql_suffix", "mysql_chgrp",
9069 "mysql_nopass", "mysql_wild", "mysql_charset", "mysql",
9070 "mysql_nouser", "postgres_encoding", "webalizer",
9071 "dom_aliases", "ranges", "ranges6",
9072 "mailgroup", "ftpgroup", "dbgroup",
9073 "othergroups", "defmquota", "quotatype", "append_style",
9074 "domalias", "logrotate_files", "logrotate_shared",
9075 "logrotate", "disabled_web", "disabled_url",
9076 "php", "status", "extra_prefix", "capabilities",
9077 "webmin_group", "spamclear", "spamtrap", "namedconf",
9078 "nodbname", "norename", "forceunder", "safeunder",
9079 "ipfollow",
9080 "aliascopy", "bccto", "resources", "dnssec", "avail",
9081 @plugins,
9082 @php_wrapper_templates,
9083 "capabilities",
9084 "featurelimits",
9085 "hashpass", "hashtypes", "autoconfig", "outlook_autoconfig",
9086 (map { $_."limit", $_."server", $_."master", $_."view",
9087 $_."passwd" } @plugins)) {
9088 if ($tmpl->{$p} eq "") {
9089 local $k;
9090 foreach $k (keys %$def) {
9091 next if ($p eq "dns" && $k =~ /^dns_spf/);
9092 if (!$done{$k} &&
9093 ($k =~ /^\Q$p\E_/ || $k eq $p)) {
9094 $tmpl->{$k} = $def->{$k};
9095 $done{$k}++;
9096 }
9097 }
9098 }
9099 }
9100 # Mail is a special case - it is the mail_on variable that controls
9101 # inheritance.
9102 if ($tmpl->{'mail_on'} eq '') {
9103 local $k;
9104 foreach $k (keys %$def) {
9105 if (!$done{$k} &&
9106 ($k =~ /^mail_/ || $k eq 'mail')) {
9107 $tmpl->{$k} = $def->{$k};
9108 $done{$k}++;
9109 }
9110 }
9111 }
9112 # The ruby setting needs to default to -1 if the web section is defined
9113 # in this template, but we are using the GPL release
9114 $tmpl->{'web_ruby_suexec'} = -1 if ($tmpl->{'web_ruby_suexec'} eq '');
9115 }
9116return $tmpl;
9117}
9118
9119# delete_template(&template)
9120# If this template is used by any domains, just mark it as deleted.
9121# Otherwise, really delete it.
9122sub delete_template
9123{
9124local %tmpl;
9125&lock_file("$templates_dir/$_[0]->{'id'}");
9126local @users = &get_domain_by("template", $_[0]->{'id'});
9127if (@users) {
9128 &read_file("$templates_dir/$_[0]->{'id'}", \%tmpl);
9129 $tmpl{'deleted'} = 1;
9130 &write_file("$templates_dir/$_[0]->{'id'}", \%tmpl);
9131 }
9132else {
9133 &unlink_file("$templates_dir/$_[0]->{'id'}");
9134 }
9135&unlock_file("$templates_dir/$_[0]->{'id'}");
9136}
9137
9138# list_template_scripts(&template)
9139# Returns a list of scripts specified for this template. May return "none"
9140# if there are none.
9141sub list_template_scripts
9142{
9143local ($tmpl) = @_;
9144return "none" if ($tmpl->{'noscripts'});
9145local @rv;
9146opendir(DIR, $template_scripts_dir);
9147foreach my $f (readdir(DIR)) {
9148 if ($f =~ /^(\d+)_(\d+)$/ && $1 == $tmpl->{'id'}) {
9149 local %script;
9150 &read_file("$template_scripts_dir/$f", \%script);
9151 $script{'id'} = $2;
9152 $script{'file'} = "$template_scripts_dir/$f";
9153 push(@rv, \%script);
9154 }
9155 }
9156closedir(DIR);
9157return \@rv;
9158}
9159
9160# save_template_scripts(&template, &scripts|"none")
9161# Updates the scripts for some template
9162sub save_template_scripts
9163{
9164local ($tmpl, $scripts) = @_;
9165
9166# Delete old scripts
9167opendir(DIR, $template_scripts_dir);
9168foreach my $f (readdir(DIR)) {
9169 if ($f =~ /^(\d+)_(\d+)$/ && $1 == $tmpl->{'id'}) {
9170 unlink("$template_scripts_dir/$f");
9171 }
9172 }
9173closedir(DIR);
9174
9175if ($scripts eq "none") {
9176 $tmpl->{'noscripts'} = 1;
9177 }
9178else {
9179 # Save new scripts
9180 mkdir($template_scripts_dir, 0700);
9181 foreach my $script (@$scripts) {
9182 &write_file("$template_scripts_dir/$tmpl->{'id'}_$script->{'id'}", $script);
9183 }
9184
9185 $tmpl->{'noscripts'} = 0;
9186 }
9187&save_template($tmpl);
9188}
9189
9190# get_template_scripts(&template)
9191# Returns the actual scripts that should be installed when a domain is setup
9192# using this template, taking defaults into account
9193sub get_template_scripts
9194{
9195local ($tmpl) = @_;
9196local $scripts = &list_template_scripts($tmpl);
9197if ($scripts eq "none") {
9198 return ( );
9199 }
9200elsif (@$scripts || $tmpl->{'default'}) {
9201 return @$scripts;
9202 }
9203else {
9204 # Fall back to default
9205 local @tmpls = &list_templates();
9206 local $def = $tmpls[0];
9207 return &get_template_scripts($def);
9208 }
9209}
9210
9211# cat_file(file, [newlines-to-tabs])
9212# Returns the contents of some file
9213sub cat_file
9214{
9215local ($file, $tabs) = @_;
9216local $path = $file =~ /^\// ? $file : "$module_config_directory/$file";
9217local $rv = &read_file_contents($path);
9218if ($tabs) {
9219 $rv =~ s/\r//g;
9220 $rv =~ s/\n/\t/g;
9221 }
9222return $rv;
9223}
9224
9225# uncat_file(file, data, [tabs-to-newlines])
9226# Writes to some file
9227sub uncat_file
9228{
9229local ($file, $data, $tabs) = @_;
9230if ($tabs) {
9231 $data =~ s/\t/\n/g;
9232 }
9233local $path = $file =~ /^\// ? $file : "$module_config_directory/$file";
9234&open_lock_tempfile(FILE, ">$path");
9235&print_tempfile(FILE, $data);
9236&close_tempfile(FILE);
9237}
9238
9239# uncat_transname(data)
9240# Creates a temp file and writes some data to it
9241sub uncat_transname
9242{
9243local ($data, $tabs) = @_;
9244local $temp = &transname();
9245&uncat_file($temp, $data, $tabs);
9246return $temp;
9247}
9248
9249# plugin_call(module, function, [arg, ...])
9250# If some plugin function is defined, call it and return the result,
9251# otherwise return undef
9252sub plugin_call
9253{
9254local ($mod, $func, @args) = @_;
9255&load_plugin_libraries($mod);
9256if (&plugin_defined($mod, $func)) {
9257 if ($main::module_name ne "virtual_server") {
9258 # Set up virtual_server package
9259 &foreign_require("virtual-server", "virtual-server-lib.pl");
9260 $virtual_server::first_print = $first_print;
9261 $virtual_server::second_print = $second_print;
9262 $virtual_server::indent_print = $indent_print;
9263 $virtual_server::outdent_print = $outdent_print;
9264 }
9265 return &foreign_call($mod, $func, @args);
9266 }
9267else {
9268 return wantarray ? ( ) : undef;
9269 }
9270}
9271
9272# try_plugin_call(module, function, [arg, ...])
9273# Like plugin_call, but catches and prints errors
9274sub try_plugin_call
9275{
9276local ($mod, $func, @args) = @_;
9277local $main::error_must_die = 1;
9278eval { &plugin_call($mod, $func, @args) };
9279if ($@) {
9280 &$second_print(&text('setup_failure',
9281 &plugin_call($f, "feature_name"), "$@"));
9282 return 0;
9283 }
9284return 1;
9285}
9286
9287# plugin_defined(module, function)
9288# Returns 1 if some function is defined in a plugin
9289sub plugin_defined
9290{
9291local ($mod, $func) = @_;
9292&load_plugin_libraries($mod);
9293$mod =~ s/[^A-Za-z0-9]/_/g;
9294local $func = "${mod}::$func";
9295return defined(&$func);
9296}
9297
9298# database_feature([&domain])
9299# Returns 1 if any feature that uses a database is enabled (perhaps in a domain)
9300sub database_feature
9301{
9302local ($d) = @_;
9303foreach my $f ('mysql', 'postgres') {
9304 return 1 if ($config{$f} && (!$d || $d->{$f}));
9305 }
9306foreach my $f (&list_database_plugins()) {
9307 return 1 if ($config{$f} && (!$d || $d->{$f}));
9308 }
9309return 0;
9310}
9311
9312# list_custom_fields()
9313# Returns a list of structures containing custom field details. Each has keys :
9314# name - Unique name for this field
9315# type - 0=textbox, 1=unix user, 2=unix UID, 3=unix group, 4=unix GID,
9316# 5=file chooser, 6=directory chooser, 7=yes/no, 8=password,
9317# 9=options file, 10=text area
9318# opts - Name of options file
9319# desc - Human-readable description, with optional ; separated tooltip
9320# show - 1=show in list of domains, 0=hide
9321# visible - 0=anyone can edit
9322# 1=root can edit, others can view
9323# 2=only root can see
9324sub list_custom_fields
9325{
9326local @rv;
9327local $_;
9328open(FIELDS, $custom_fields_file);
9329while(<FIELDS>) {
9330 s/\r|\n//g;
9331 local @a = split(/:/, $_, 6);
9332 push(@rv, { 'name' => $a[0],
9333 'type' => $a[1],
9334 'opts' => $a[2],
9335 'desc' => $a[3],
9336 'show' => $a[4],
9337 'visible' => $a[5], });
9338
9339 }
9340close(FIELDS);
9341return @rv;
9342}
9343
9344# save_custom_fields(&fields)
9345sub save_custom_fields
9346{
9347&open_lock_tempfile(FIELDS, ">$custom_fields_file");
9348foreach my $a (@{$_[0]}) {
9349 &print_tempfile(FIELDS, $a->{'name'},":",$a->{'type'},":",
9350 $a->{'opts'},":",$a->{'desc'},":",$a->{'show'},":",
9351 $a->{'visible'},"\n");
9352 }
9353&close_tempfile(FIELDS);
9354}
9355
9356# list_custom_links()
9357# Returns a list of structures containing custom link details
9358sub list_custom_links
9359{
9360local @rv;
9361local $_;
9362open(LINKS, $custom_links_file);
9363while(<LINKS>) {
9364 s/\r|\n//g;
9365 local @a = split(/\t/, $_);
9366 push(@rv, { 'desc' => $a[0],
9367 'url' => $a[1],
9368 'who' => { map { $_ => 1 } split(/:/, $a[2]) },
9369 'open' => $a[3],
9370 'cat' => $a[4],
9371 'tmpl' => $a[5] eq '-' ? undef : $a[5],
9372 'feature' => $a[6] eq '-' ? undef : $a[6],
9373 });
9374 }
9375close(LINKS);
9376return @rv;
9377}
9378
9379# save_custom_links(&links)
9380# Write out the given list of custom links to a file
9381sub save_custom_links
9382{
9383&open_lock_tempfile(LINKS, ">$custom_links_file");
9384foreach my $a (@{$_[0]}) {
9385 &print_tempfile(LINKS,
9386 $a->{'desc'}."\t".$a->{'url'}."\t".
9387 join(":", keys %{$a->{'who'}})."\t".
9388 int($a->{'open'})."\t".$a->{'cat'}."\t".
9389 ($a->{'tmpl'} eq "" ? "-" : $a->{'tmpl'})."\t".
9390 ($a->{'feature'} eq "" ? "-" : $a->{'feature'})."\t".
9391 "\n");
9392 }
9393&close_tempfile(LINKS);
9394}
9395
9396# list_custom_link_categories()
9397# Returns a list of all custom link category hash refs
9398sub list_custom_link_categories
9399{
9400local @rv;
9401open(LINKCATS, $custom_link_categories_file);
9402while(<LINKCATS>) {
9403 s/\r|\n//g;
9404 local @a = split(/\t/, $_);
9405 push(@rv, { 'id' => $a[0], 'desc' => $a[1] });
9406 }
9407close(LINKCATS);
9408return @rv;
9409}
9410
9411# save_custom_link_categories(&cats)
9412# Write out the given list of link categories to a file
9413sub save_custom_link_categories
9414{
9415&open_lock_tempfile(LINKCATS, ">$custom_link_categories_file");
9416foreach my $a (@{$_[0]}) {
9417 &print_tempfile(LINKCATS, $a->{'id'}."\t".$a->{'desc'}."\n");
9418 }
9419&close_tempfile(LINKCATS);
9420}
9421
9422# list_visible_custom_links(&domain)
9423# Returns a list of descriptions and URLs for custom links in the given domain,
9424# for the current user type. Category names are also include.
9425sub list_visible_custom_links
9426{
9427local ($d) = @_;
9428local @rv;
9429local $me = &master_admin() ? 'master' :
9430 &reseller_admin() ? 'reseller' : 'domain';
9431local %cats = map { $_->{'id'}, $_->{'desc'} } &list_custom_link_categories();
9432foreach my $l (&list_custom_links()) {
9433 if (!$l->{'who'}->{$me}) {
9434 # Not for you
9435 next;
9436 }
9437 if ($l->{'tmpl'} && $d->{'template'} ne $l->{'tmpl'}) {
9438 # Not for this domain template
9439 next;
9440 }
9441 if ($l->{'feature'} && !$d->{$l->{'feature'}}) {
9442 # Not for this domain feature
9443 next;
9444 }
9445 local $nl = {
9446 'desc' => &substitute_domain_template($l->{'desc'}, $d),
9447 'url' => &substitute_domain_template($l->{'url'}, $d),
9448 'open' => $l->{'open'},
9449 'catname' => $cats{$l->{'cat'}},
9450 'cat' => $l->{'cat'},
9451 };
9452 if ($nl->{'desc'} && $nl->{'url'}) {
9453 push(@rv, $nl);
9454 }
9455 }
9456return @rv;
9457}
9458
9459# show_custom_fields([&domain], [&tds])
9460# Returns HTML for custom field inputs, for inclusion in a table
9461sub show_custom_fields
9462{
9463local ($d, $tds) = @_;
9464local $rv;
9465local $col = 0;
9466foreach my $f (&list_custom_fields()) {
9467 local ($desc, $tip) = split(/;/, $f->{'desc'}, 2);
9468 if ($tip) {
9469 $desc = "<div title='"."e_escape($tip)."'>$desc</div>";
9470 }
9471 if ($f->{'visible'} == 0 || &master_admin()) {
9472 # Can edit
9473 local $n = "field_".$f->{'name'};
9474 local $v = $d ? $d->{"field_".$f->{'name'}} :
9475 $f->{'type'} == 7 ? 1 :
9476 $f->{'type'} == 11 ? 0 : undef;
9477 local $fv;
9478 if ($f->{'type'} == 0) {
9479 local $sz = $f->{'opts'} || 30;
9480 $fv = &ui_textbox($n, $v, $sz);
9481 }
9482 elsif ($f->{'type'} == 1 || $f->{'type'} == 2) {
9483 $fv = &ui_user_textbox($n, $v);
9484 }
9485 elsif ($f->{'type'} == 3 || $f->{'type'} == 4) {
9486 $fv = &ui_group_textbox($n, $v);
9487 }
9488 elsif ($f->{'type'} == 5 || $f->{'type'} == 6) {
9489 $fv = &ui_textbox($n, $v, 30)." ".
9490 &file_chooser_button($n, $f->{'type'}-5);
9491 }
9492 elsif ($f->{'type'} == 7 || $f->{'type'} == 11) {
9493 $fv = &ui_radio($n, $v ? 1 : 0, [ [ 1, $text{'yes'} ],
9494 [ 0, $text{'no'} ] ]);
9495 }
9496 elsif ($f->{'type'} == 8) {
9497 local $sz = $f->{'opts'} || 30;
9498 $fv = &ui_password($n, $v, $sz);
9499 }
9500 elsif ($f->{'type'} == 9) {
9501 local @opts = &read_opts_file($f->{'opts'});
9502 local ($found) = grep { $_->[0] eq $v } @opts;
9503 push(@opts, [ $v, $v ]) if (!$found && $v ne '');
9504 $fv = &ui_select($n, $v, \@opts);
9505 }
9506 elsif ($f->{'type'} == 10) {
9507 local ($w, $h) = split(/\s+/, $f->{'opts'});
9508 $h ||= 4;
9509 $w ||= 30;
9510 $v =~ s/\t/\n/g;
9511 $fv = &ui_textarea($n, $v, $h, $w);
9512 }
9513 $rv .= &ui_table_row($desc, $fv, 1, $tds);
9514 }
9515 elsif ($f->{'visible'} == 1 && $d) {
9516 # Can only see
9517 local $fv = $d->{"field_".$f->{'name'}};
9518 $rv .= &ui_table_row($desc, $fv, 1, $tds);
9519 }
9520 }
9521return $rv;
9522}
9523
9524# parse_custom_fields(&domain, &in)
9525# Updates a domain with custom fields
9526sub parse_custom_fields
9527{
9528local %in = %{$_[1]};
9529foreach my $f (&list_custom_fields()) {
9530 next if ($f->{'visible'} != 0 && !&master_admin());
9531 local $n = "field_".$f->{'name'};
9532 local $rv;
9533 if ($f->{'type'} == 0 || $f->{'type'} == 5 ||
9534 $f->{'type'} == 6 || $f->{'type'} == 8) {
9535 $rv = $in{$n};
9536 }
9537 elsif ($f->{'type'} == 10) {
9538 $rv = $in{$n};
9539 $rv =~ s/\r//g;
9540 $rv =~ s/\n/\t/g;
9541 }
9542 elsif ($f->{'type'} == 1 || $f->{'type'} == 2) {
9543 local @u = getpwnam($in{$n});
9544 $rv = $f->{'type'} == 1 ? $in{$n} : $u[2];
9545 }
9546 elsif ($f->{'type'} == 3 || $f->{'type'} == 4) {
9547 local @g = getgrnam($in{$n});
9548 $rv = $f->{'type'} == 3 ? $in{$n} : $g[2];
9549 }
9550 elsif ($f->{'type'} == 7 || $f->{'type'} == 11) {
9551 $rv = $in{$n} ? $f->{'opts'} : "";
9552 }
9553 elsif ($f->{'type'} == 9) {
9554 $rv = $in{$n};
9555 }
9556 $_[0]->{"field_".$f->{'name'}} = $rv;
9557 }
9558}
9559
9560# read_opts_file(file)
9561sub read_opts_file
9562{
9563local @rv;
9564local $file = $_[0];
9565if ($file !~ /^\//) {
9566 local @uinfo = getpwnam($remote_user);
9567 if (@uinfo) {
9568 $file = "$uinfo[7]/$file";
9569 }
9570 }
9571local $_;
9572open(FILE, $file);
9573while(<FILE>) {
9574 s/\r|\n//g;
9575 if (/^"([^"]*)"\s+"([^"]*)"$/) {
9576 push(@rv, [ $1, $2 ]);
9577 }
9578 elsif (/^"([^"]*)"$/) {
9579 push(@rv, [ $1, $1 ]);
9580 }
9581 elsif (/^(\S+)\s+(\S.*)/) {
9582 push(@rv, [ $1, $2 ]);
9583 }
9584 else {
9585 push(@rv, [ $_, $_ ]);
9586 }
9587 }
9588close(FILE);
9589return @rv;
9590}
9591
9592# connect_qmail_ldap([return-error])
9593# Connect to the LDAP server used for Qmail. Returns an LDAP handle on success,
9594# or an error message on failure.
9595sub connect_qmail_ldap
9596{
9597eval "use Net::LDAP";
9598if ($@) {
9599 local $err = &text('ldap_emod', "<tt>Net::LDAP</tt>");
9600 if ($_[0]) { return $err; }
9601 else { &error($err); }
9602 }
9603
9604# Connect to server
9605local $ipv6 = !&to_ipaddress($config{'ldap_host'}) &&
9606 defined(&to_ip6address) && &to_ip6address($config{'ldap_host'});
9607local $port = $config{'ldap_port'} || 389;
9608local $ldap = Net::LDAP->new($config{'ldap_host'},
9609 port => $port, inet6 => $ipv6);
9610if (!$ldap) {
9611 local $err = &text('ldap_econn',
9612 "<tt>$config{'ldap_host'}</tt>","<tt>$port</tt>");
9613 if ($_[0]) { return $err; }
9614 else { &error($err); }
9615 }
9616
9617# Start TLS if configured
9618if ($config{'ldap_tls'}) {
9619 $ldap->start_tls();
9620 }
9621
9622# Login
9623local $mesg;
9624if ($config{'ldap_login'}) {
9625 $mesg = $ldap->bind(dn => $config{'ldap_login'},
9626 password => $config{'ldap_pass'});
9627 }
9628else {
9629 $mesg = $ldap->bind(anonymous => 1);
9630 }
9631if (!$mesg || $mesg->code) {
9632 local $err = &text('ldap_elogin', "<tt>$config{'ldap_host'}</tt>",
9633 $dn, $mesg ? $mesg->error : "Unknown error");
9634 if ($_[0]) { return $err; }
9635 else { &error($err); }
9636 }
9637return $ldap;
9638}
9639
9640# qmail_dn_to_hash(&ldap-object)
9641# Given a LDAP object containing user details, convert it to a hash
9642sub qmail_dn_to_hash
9643{
9644local $x;
9645local %oc = map { $_, 1 } $_[0]->get_value("objectClass");
9646local %user = ( 'dn' => $_[0]->dn(),
9647 'qmail' => 1,
9648 'user' => scalar($_[0]->get_value("uid")),
9649 'plainpass' => scalar($_[0]->get_value("cuserPassword")),
9650 'uid' => $oc{'posixAccount'} ?
9651 scalar($_[0]->get_value("uidNumber")) :
9652 scalar($_[0]->get_value("qmailUID")),
9653 'gid' => $oc{'posixAccount'} ?
9654 scalar($_[0]->get_value("gidNumber")) :
9655 scalar($_[0]->get_value("qmailGID")),
9656 'real' => scalar($_[0]->get_value("cn")),
9657 'shell' => scalar($_[0]->get_value("loginShell")),
9658 'home' => scalar($_[0]->get_value("homeDirectory")),
9659 'pass' => scalar($_[0]->get_value("userPassword")),
9660 'mailstore' => scalar($_[0]->get_value("mailMessageStore")),
9661 'qquota' => scalar($_[0]->get_value("mailQuotaSize")),
9662 'email' => scalar($_[0]->get_value("mail")),
9663 'extraemail' => [ $_[0]->get_value("mailAlternateAddress") ],
9664 );
9665local @fwd = $_[0]->get_value("mailForwardingAddress");
9666if (@fwd) {
9667 $user{'to'} = \@fwd;
9668 }
9669$user{'pass'} =~ s/^{[a-z0-9]+}//i;
9670$user{'qmail'} = 1;
9671$user{'unix'} = 1 if ($oc{'posixAccount'});
9672$user{'person'} = 1 if ($oc{'person'} || $oc{'inetOrgPerson'} ||
9673 $oc{'posixAccount'});
9674$user{'mailquota'} = 1;
9675return %user;
9676}
9677
9678# qmail_user_to_dn(&user, &classes, &domain)
9679# Given a useradmin-style user hash, returns a list of properties to
9680# add/update and to delete
9681sub qmail_user_to_dn
9682{
9683&require_mail();
9684local $pfx = $_[0]->{'pass'} =~ /^\{[a-z0-9]+\}/i ? undef : "{crypt}";
9685local @ee = @{$_[0]->{'extraemail'}};
9686local @to = @{$_[0]->{'to'}};
9687local @delrv;
9688local $mailhost;
9689if (defined(&qmailadmin::get_control_file)) {
9690 $mailhost = &qmailadmin::get_control_file("me");
9691 }
9692$mailhost ||= &get_system_hostname();
9693local @rv = (
9694 "uid" => $_[0]->{'user'},
9695 "qmailUID" => $_[0]->{'uid'},
9696 "qmailGID" => $_[0]->{'gid'},
9697 "homeDirectory" => $_[0]->{'home'},
9698 "userPassword" => $pfx.$_[0]->{'pass'},
9699 "mailMessageStore" => $_[0]->{'mailstore'},
9700 "mailQuotaSize" => $_[0]->{'qquota'},
9701 "mail" => $_[0]->{'email'},
9702 "mailHost" => $mailhost,
9703 "accountStatus" => "active",
9704 );
9705if (@ee) {
9706 push(@rv, "mailAlternateAddress" => \@ee );
9707 }
9708else {
9709 push(@delrv, "mailAlternateAddress");
9710 }
9711if (@to) {
9712 push(@rv, "mailForwardingAddress" => \@to );
9713 push(@rv, "deliveryMode", "nolocal");
9714 }
9715else {
9716 push(@delrv, "mailForwardingAddress");
9717 push(@rv, "deliveryMode", "noforward");
9718 }
9719if ($_[0]->{'unix'}) {
9720 push(@rv, "uidNumber" => $_[0]->{'uid'},
9721 "gidNumber" => $_[0]->{'gid'},
9722 "loginShell" => $_[0]->{'shell'});
9723 }
9724if ($_[0]->{'person'}) {
9725 push(@rv, "cn" => $_[0]->{'real'});
9726 }
9727if (&indexof("person", @{$_[1]}) >= 0 ||
9728 &indexof("inetOrgPerson", @{$_[1]}) >= 0) {
9729 # Have to set sn
9730 push(@rv, "sn" => $_[0]->{'user'});
9731 }
9732# Add extra attribs, which can override those set above
9733local %subs = %{$_[0]};
9734&userdom_substitutions(\%subs, $_[2]);
9735local @props = &split_props($config{'ldap_props'}, \%subs);
9736local @addprops;
9737local $i;
9738local %over;
9739for($i=0; $i<@props; $i+=2) {
9740 if ($props[$i+1] ne "") {
9741 push(@addprops, $props[$i], $props[$i+1]);
9742 }
9743 else {
9744 push(@delrv, $props[$i]);
9745 }
9746 $over{$props[$i]} = $props[$i+1];
9747 }
9748for($i=0; $i<@rv; $i+=2) {
9749 if (exists($over{$rv[$i]})) {
9750 splice(@rv, $i, 2);
9751 $i -= 2;
9752 }
9753 }
9754push(@rv, @addprops);
9755return wantarray ? ( \@rv, \@delrv ) : \@rv;
9756}
9757
9758# split_props(text, &user)
9759# Splits up LDAP properties
9760sub split_props
9761{
9762local %pmap;
9763foreach $p (split(/\t+/, &substitute_virtualmin_template($_[0], $_[1]))) {
9764 if ($p =~ /^(\S+):\s*(.*)/) {
9765 push(@{$pmap{$1}}, $2);
9766 }
9767 }
9768local @rv;
9769local $k;
9770foreach $k (keys %pmap) {
9771 local $v = $pmap{$k};
9772 if (@$v == 1) {
9773 push(@rv, $k, $v->[0]);
9774 }
9775 else {
9776 push(@rv, $k, $v);
9777 }
9778 }
9779return @rv;
9780}
9781
9782# create_initial_user(&dom, [no-template], [for-web])
9783# Returns a structure for a new mailbox user
9784sub create_initial_user
9785{
9786local $user;
9787if ($config{'mail_system'} == 4) {
9788 # User is for Qmail+LDAP
9789 $user = { 'qmail' => 1,
9790 'mailquota' => 1,
9791 'person' => $config{'ldap_classes'} =~ /person|inetOrgPerson/ || $config{'ldap_unix'} ? 1 : 0,
9792 'unix' => $config{'ldap_unix'} };
9793 }
9794elsif ($config{'mail_system'} == 5) {
9795 # VPOPMail user
9796 $user = { 'vpopmail' => 1,
9797 'mailquota' => 1,
9798 'person' => 1,
9799 'fixedhome' => 1,
9800 'noappend' => 1,
9801 'noprimary' => 1,
9802 'alwaysplain' => 1 };
9803 }
9804else {
9805 # Normal unix user
9806 $user = { 'unix' => 1,
9807 'person' => 1 };
9808 }
9809if ($_[0] && !$_[1]) {
9810 # Initial aliases and quota come from template
9811 local $tmpl = &get_template($_[0]->{'template'});
9812 if ($tmpl->{'user_aliases'} ne 'none') {
9813 $user->{'to'} = [ map { &substitute_domain_template($_, $_[0]) }
9814 split(/\t+/, $tmpl->{'user_aliases'}) ];
9815 }
9816 $user->{'quota'} = $tmpl->{'defmquota'};
9817 $user->{'mquota'} = $tmpl->{'defmquota'};
9818 }
9819if (!$user->{'noprimary'}) {
9820 $user->{'email'} = !$_[0] ? "newuser\@".&get_system_hostname() :
9821 $_[0]->{'mail'} ? "newuser\@$_[0]->{'dom'}" : undef;
9822 }
9823$user->{'secs'} = [ ];
9824$user->{'shell'} = &default_available_shell('mailbox');
9825
9826# Merge in configurable initial user settings
9827if ($_[0]) {
9828 local %init;
9829 &read_file("$initial_users_dir/$_[0]->{'id'}", \%init);
9830 foreach my $a ("email", "quota", "mquota", "qquota", "shell") {
9831 $user->{$a} = $init{$a} if (defined($init{$a}));
9832 }
9833 foreach my $a ("secs", "to") {
9834 if (defined($init{$a})) {
9835 $user->{$a} = [ split(/\t+/, $init{$a}) ];
9836 }
9837 }
9838 if (defined($init{'dbs'})) {
9839 local ($db, @dbs);
9840 foreach $db (split(/\t+/, $init{'dbs'})) {
9841 local ($type, $name) = split(/_/, $db, 2);
9842 push(@dbs, { 'type' => $type,
9843 'name' => $name,
9844 'desc' => $text{'databases_'.$type} });
9845 }
9846 $user->{'dbs'} = \@dbs;
9847 }
9848 }
9849
9850if ($_[2] && $user->{'unix'}) {
9851 # This is a website management user
9852 local (undef, $ftp_shell, undef, $def_shell) =
9853 &get_common_available_shells();
9854 $user->{'webowner'} = 1;
9855 $user->{'fixedhome'} = 0;
9856 $user->{'home'} = &public_html_dir($_[0]);
9857 $user->{'noquota'} = 1;
9858 $user->{'mailquota'} = 0;
9859 $user->{'noprimary'} = 1;
9860 $user->{'noextra'} = 1;
9861 $user->{'noalias'} = 1;
9862 $user->{'nocreatehome'} = 1;
9863 $user->{'nomailfile'} = 1;
9864 $user->{'shell'} = $ftp_shell ? $ftp_shell->{'shell'}
9865 : $def_shell->{'shell'};
9866 delete($user->{'email'});
9867 }
9868
9869# For a unix user, apply default password expiry restrictions
9870if ($user->{'unix'} && $gconfig{'os_type'} =~ /-linux$/) {
9871 &require_useradmin();
9872 local %uconfig = &foreign_config("useradmin");
9873 if ($usermodule eq "ldap-useradmin") {
9874 local %lconfig = &foreign_config($usermodule);
9875 foreach my $k (keys %lconfig) {
9876 if ($lconfig{$k} ne "") {
9877 $uconfig{$k} = $lconfig{$k};
9878 }
9879 }
9880 }
9881 $user->{'min'} = $uconfig{'default_min'};
9882 $user->{'max'} = $uconfig{'default_max'};
9883 $user->{'warn'} = $uconfig{'default_warn'};
9884 }
9885
9886return $user;
9887}
9888
9889# save_initial_user(&user, &domain)
9890# Saves default settings for new users in a virtual server
9891sub save_initial_user
9892{
9893local ($user, $dom) = @_;
9894if (!-d $initial_users_dir) {
9895 mkdir($initial_users_dir, 0700);
9896 }
9897&lock_file("$initial_users_dir/$dom->{'id'}");
9898local %init;
9899foreach my $a ("email", "quota", "mquota", "qquota", "shell") {
9900 $init{$a} = $user->{$a} if (defined($user->{$a}));
9901 }
9902foreach my $a ("secs", "to") {
9903 if (defined($user->{$a})) {
9904 $init{$a} = join("\t", @{$user->{$a}});
9905 }
9906 }
9907if (defined($user->{'dbs'})) {
9908 $init{'dbs'} = join("\t", map { $_->{'type'}."_".$_->{'name'} }
9909 @{$user->{'dbs'}});
9910 }
9911&write_file("$initial_users_dir/$dom->{'id'}", \%init);
9912&unlock_file("$initial_users_dir/$dom->{'id'}");
9913}
9914
9915# allowed_domain_name(&parent, newdomain)
9916# Returns an error message if some domain name is invalid, or undef if OK.
9917# Checks domain-owner subdomain and reseller subdomain limits.
9918sub allowed_domain_name
9919{
9920local ($parent, $newdom) = @_;
9921
9922# Check if forced to be under one of the domains he already owns
9923if ($parent && $access{'forceunder'}) {
9924 local $ok = 0;
9925 foreach my $pdom ($parent, &get_domain_by("parent", $parent->{'id'})) {
9926 local $pd = $pdom->{'dom'};
9927 if ($newdom =~ /\.\Q$pd\E$/i) {
9928 $ok = 1;
9929 last;
9930 }
9931 }
9932 $ok || return &text('setup_eforceunder2', $parent->{'dom'});
9933 }
9934
9935# Check if under someone else's domain
9936if ($parent && $access{'safeunder'}) {
9937 foreach my $d (&list_domains()) {
9938 local $od = $d->{'dom'};
9939 if ($d->{'id'} ne $parent->{'id'} &&
9940 $d->{'parent'} ne $parent->{'id'} &&
9941 $newdom =~ /\.\Q$od\E$/i) {
9942 return &text('setup_esafeunder', $od);
9943 }
9944 }
9945 }
9946
9947# Check allowed domain regexp
9948if ($access{'subdom'}) {
9949 if ($newdom !~ /\.\Q$access{'subdom'}\E$/i) {
9950 return &text('setup_eforceunder', $access{'subdom'});
9951 }
9952 }
9953
9954# Check if on denied list
9955if (!&master_admin()) {
9956 foreach my $re (split(/\s+/, $config{'denied_domains'})) {
9957 if ($newdom =~ /^$re$/i) {
9958 return $text{'setup_edenieddomain'};
9959 }
9960 }
9961 }
9962return undef;
9963}
9964
9965# domain_databases(&domain, [&types])
9966# Returns a list of structures for databases in a domain
9967sub domain_databases
9968{
9969local ($d, $types) = @_;
9970local @dbs;
9971if ($d->{'mysql'} && (!$types || &indexof("mysql", @$types) >= 0)) {
9972 local %done;
9973 local $av = &foreign_available("mysql");
9974 &require_mysql();
9975 foreach my $db (split(/\s+/, $d->{'db_mysql'})) {
9976 next if ($done{$db}++);
9977 push(@dbs, { 'name' => $db,
9978 'type' => 'mysql',
9979 'users' => 1,
9980 'link' => $av ? "../mysql/edit_dbase.cgi?db=$db"
9981 : undef,
9982 'desc' => $text{'databases_mysql'},
9983 'host' => $mysql::config{'host'}, });
9984 }
9985 }
9986if ($d->{'postgres'} && (!$types || &indexof("postgres", @$types) >= 0)) {
9987 local %done;
9988 local $av = &foreign_available("postgresql");
9989 &require_postgres();
9990 foreach my $db (split(/\s+/, $d->{'db_postgres'})) {
9991 next if ($done{$db}++);
9992 push(@dbs, { 'name' => $db,
9993 'type' => 'postgres',
9994 'link' => $av ? "../postgresql/".
9995 "edit_dbase.cgi?db=$db"
9996 : undef,
9997 'desc' => $text{'databases_postgres'},
9998 'host' => $postgresql::config{'host'}, });
9999 }
10000 }
10001
10002# Only check plugins if some non-core DB types were requested
10003local @nctypes = $types ? grep { $_ ne "mysql" && $_ ne "postgres" } @$types
10004 : ( );
10005if (!$types || @nctypes) {
10006 foreach my $f (&list_database_plugins()) {
10007 if (!$types || &indexof($f, @$types) >= 0) {
10008 push(@dbs, &plugin_call($f, "database_list", $d));
10009 }
10010 }
10011 }
10012return @dbs;
10013}
10014
10015# all_databases([&domain])
10016# Returns a list of all known databases on the system, possibly limited to
10017# those relevant for some domain.
10018sub all_databases
10019{
10020local ($d) = @_;
10021local @rv;
10022if ($config{'mysql'} && (!$d || $d->{'mysql'})) {
10023 &require_mysql();
10024 push(@rv, map { { 'name' => $_,
10025 'type' => 'mysql',
10026 'desc' => $text{'databases_mysql'},
10027 'special' => $_ eq "mysql" } }
10028 &list_all_mysql_databases($d));
10029 }
10030if ($config{'postgres'} && (!$d || $d->{'postgres'})) {
10031 &require_postgres();
10032 push(@rv, map { { 'name' => $_,
10033 'type' => 'postgres',
10034 'desc' => $text{'databases_postgres'},
10035 'special' => ($_ =~ /^template/i) } }
10036 &list_all_postgres_databases($d));
10037 }
10038foreach my $f (&list_database_plugins()) {
10039 if (!$d || $d->{$f}) {
10040 push(@rv, &plugin_call($f, "databases_all", $d));
10041 }
10042 }
10043return @rv;
10044}
10045
10046# all_database_types()
10047# Returns a list of all database types on the system
10048sub all_database_types
10049{
10050return ( $config{'mysql'} ? ("mysql") : ( ),
10051 $config{'postgres'} ? ("postgres") : ( ),
10052 &list_database_plugins() );
10053}
10054
10055# resync_all_databases(&domain, &all-dbs)
10056# Updates a domain object to remove databases that no longer really exist, and
10057# perhaps to change the 'db' field to the first actual database
10058sub resync_all_databases
10059{
10060local ($d, $all) = @_;
10061return if (!@$all); # If no DBs were found on the system, do nothing
10062 # to avoid mass dis-association
10063local %all = map { ("$_->{'type'} $_->{'name'}", $_) } @$all;
10064local $removed = 0;
10065foreach my $k (keys %$d) {
10066 if ($k =~ /^db_(\S+)$/) {
10067 local $t = $1;
10068 local @names = split(/\s+/, $d->{$k});
10069 local @newnames = grep { $all{"$t $_"} } @names;
10070 if (@names != @newnames) {
10071 $d->{$k} = join(" ", @newnames);
10072 $removed = 1;
10073 }
10074 }
10075 }
10076if ($removed) {
10077 &save_domain($d);
10078 }
10079
10080# Fix 'db' field if it is currently set to a missing DB
10081local @domdbs = &domain_databases($d);
10082local ($defdb) = grep { $_->{'name'} eq $d->{'db'} } @domdbs;
10083if (!$defdb && @domdbs) {
10084 $d->{'db'} = $domdbs[0]->{'name'};
10085 &save_domain($d);
10086 }
10087}
10088
10089# get_database_host(type)
10090# Returns the remote host that we use for the given database type. If the
10091# DB is on the same server, returns localhost
10092sub get_database_host
10093{
10094local ($type) = @_;
10095local $rv;
10096if (&indexof($type, @features) >= 0) {
10097 # Built-in DB
10098 local $hfunc = "get_database_host_".$type;
10099 $rv = &$hfunc();
10100 }
10101elsif (&indexof($type, &list_database_plugins()) >= 0) {
10102 # From plugin
10103 $rv = &plugin_call($type, "database_host");
10104 }
10105return $rv || "localhost";
10106}
10107
10108# get_password_synced_types(&domain)
10109# Returns a list of DB types that are enabled for this domain and have their
10110# passwords synced with the admin login
10111sub get_password_synced_types
10112{
10113local ($d) = @_;
10114my @rv;
10115foreach my $t (&all_database_types()) {
10116 my $sfunc = $t."_password_synced";
10117 if (defined(&$sfunc) && &$sfunc($d)) {
10118 # Definitely is synced
10119 push(@rv, $t);
10120 }
10121 elsif (!defined(&$sfunc)) {
10122 # Assume yes for other DB types
10123 push(@rv, $t);
10124 }
10125 }
10126return @rv;
10127}
10128
10129# count_ftp_bandwidth(logfile, start, &bw-hash, &users, prefix, include-rotated)
10130# Scans an FTP server log file for downloads by some user, and returns the
10131# total bytes and time of last log entry.
10132sub count_ftp_bandwidth
10133{
10134local $max_ltime = $_[1];
10135local $f;
10136foreach $f ($_[5] ? &all_log_files($_[0], $max_ltime) : ( $_[0] )) {
10137 local $_;
10138 if ($f =~ /\.gz$/i) {
10139 open(LOG, "gunzip -c ".quotemeta($f)." |");
10140 }
10141 elsif ($f =~ /\.Z$/i) {
10142 open(LOG, "uncompress -c ".quotemeta($f)." |");
10143 }
10144 else {
10145 open(LOG, $f);
10146 }
10147 while(<LOG>) {
10148 if (/^(\S+)\s+(\S+)\s+(\S+)\s+\[(\d+)\/(\S+)\/(\d+):(\d+):(\d+):(\d+)\s+(\S+)\]\s+"([^"]*)"\s+(\S+)\s+(\S+)/) {
10149 # ProFTPD extended log format line
10150 local $ltime = timelocal($9, $8, $7, $4, $apache_mmap{lc($5)}, $6-1900);
10151 $max_ltime = $ltime if ($ltime > $max_ltime);
10152 next if ($_[3] && &indexof($3, @{$_[3]}) < 0); # user
10153 next if (substr($11, 0, 4) ne "RETR" &&
10154 substr($11, 0, 4) ne "STOR");
10155 if ($ltime > $_[1]) {
10156 local $day = int($ltime / (24*60*60));
10157 $_[2]->{$_[4]."_".$day} += $13;
10158 }
10159 }
10160 elsif (/^\S+\s+(\S+)\s+(\d+)\s+(\d+):(\d+):(\d+)\s+(\d+)\s+\d+\s+\S+\s+(\d+)\s+\S+\s+\S+\s+\S+\s+(\S+)\s+\S+\s+(\S+)/) {
10161 # xferlog format line
10162 local $ltime = timelocal($5, $4, $3, $2, $apache_mmap{lc($1)}, $6-1900);
10163 $max_ltime = $ltime if ($ltime > $max_ltime);
10164 next if ($_[3] && &indexof($9, @{$_[3]}) < 0); # user
10165 next if ($8 ne "o" && $8 ne "i");
10166 if ($ltime > $_[1]) {
10167 local $day = int($ltime / (24*60*60));
10168 $_[2]->{$_[4]."_".$day} += $7;
10169 }
10170 }
10171 }
10172 close(LOG);
10173 }
10174return $max_ltime;
10175}
10176
10177# random_password([len])
10178# Returns a random password of the specified length, or the configured default
10179sub random_password
10180{
10181&seed_random();
10182&require_useradmin();
10183local $random_password;
10184local $len = $_[0] || $config{'passwd_length'} || 15;
10185local @passwd_chars = split(//, $config{'passwd_chars'});
10186if (!@passwd_chars) {
10187 @passwd_chars = @useradmin::random_password_chars;
10188 }
10189foreach (1 .. $len) {
10190 $random_password .= $passwd_chars[rand(scalar(@passwd_chars))];
10191 }
10192return $random_password;
10193}
10194
10195# random_salt([len])
10196# Returns a crypt-format salt of the given length (default 2 chars)
10197sub random_salt
10198{
10199local $len = $_[0] || 2;
10200&seed_random();
10201local $rv;
10202local @saltchars = ( 'a' .. 'z', 'A' .. 'Z', 0 .. 9, '.', '/' );
10203for(my $i=0; $i<$len; $i++) {
10204 $rv .= $saltchars[int(rand()*scalar(@saltchars))];
10205 }
10206return $rv;
10207}
10208
10209# try_function(feature, function, arg, ...)
10210# Executes some function, and if it fails prints an error message
10211sub try_function
10212{
10213local ($f, $func, @args) = @_;
10214local $main::error_must_die = 1;
10215eval { &$func(@args) };
10216if ($@) {
10217 &$second_print(&text('setup_failure',
10218 $text{'feature_'.$f}, "$@"));
10219 return 0;
10220 }
10221return 1;
10222}
10223
10224# bandwidth_period_start([ago])
10225# Returns the day number on which the current (or some previous)
10226# bandwidth period started
10227sub bandwidth_period_start
10228{
10229local ($ago) = @_;
10230local $now = time();
10231local $day = int($now / (24*60*60));
10232local @tm = localtime(time());
10233local $rv;
10234if ($config{'bw_past'} eq 'week') {
10235 # Start on last sunday
10236 $rv = $day - $tm[6];
10237 $rv -= $ago*7;
10238 }
10239elsif ($config{'bw_past'} eq 'month') {
10240 # Start at 1st of month
10241 for(my $i=0; $i<$ago; $i++) {
10242 $tm[4]--;
10243 if ($tm[4] < 0) {
10244 $tm[5]--;
10245 $tm[4] = 11;
10246 }
10247 }
10248 $rv = int(timelocal(59, 59, 23, 1, $tm[4], $tm[5]) / (24*60*60));
10249 }
10250elsif ($config{'bw_past'} eq 'year') {
10251 # Start at start of year
10252 $tm[4] -= $ago;
10253 $rv = int(timelocal(59, 59, 23, 1, 0, $tm[5]) / (24*60*60));
10254 }
10255else {
10256 # Start N days ago
10257 $rv = $day - $config{'bw_period'};
10258 $rv -= $ago*$config{'bw_period'};
10259 }
10260return $rv;
10261}
10262
10263# bandwidth_period_end([ago])
10264# Returns the day number on which some bandwidth period ends (inclusive)
10265sub bandwidth_period_end
10266{
10267local ($ago) = @_;
10268local $now = time();
10269local $day = int($now / (24*60*60));
10270if ($ago == 0) {
10271 return $day;
10272 }
10273local $sday = &bandwidth_period_start($ago);
10274if ($config{'bw_past'} eq 'week') {
10275 # 6 days after start
10276 return $sday + 6;
10277 }
10278elsif ($config{'bw_past'} eq 'month') {
10279 # End of the month
10280 return &bandwidth_period_start($ago-1)-1;
10281 }
10282elsif ($config{'bw_past'} eq 'year') {
10283 # End of the year
10284 return &bandwidth_period_start($ago-1)-1;
10285 }
10286else {
10287 return $sday + $config{'bw_period'} - 1;
10288 }
10289}
10290
10291# servers_input(name, &ids, &domains, [disabled])
10292# Returns HTML for a multi-server selection field
10293sub servers_input
10294{
10295local ($name, $ids, $doms, $dis) = @_;
10296local $sz = scalar(@$doms) > 10 ? 10 : scalar(@$doms) < 5 ? 5 : scalar(@$doms);
10297return &ui_select($name, $ids,
10298 [ map { [ $_->{'id'}, &show_domain_name($_) ] }
10299 sort { $a->{'dom'} cmp $b->{'dom'} } @$doms ],
10300 $sz, 1, 0, $dis);
10301}
10302
10303# can_monitor_bandwidth(&domain)
10304# Returns 1 if bandwidth monitoring is enabled for some server
10305sub can_monitor_bandwidth
10306{
10307if ($config{'bw_servers'} eq "") {
10308 return 1; # always
10309 }
10310elsif ($config{'bw_servers'} =~ /^\!(.*)$/) {
10311 # List of servers not to check
10312 local @ids = split(/\s+/, $1);
10313 return &indexof($_[0]->{'id'}, @ids) == -1;
10314 }
10315else {
10316 # List of servers to check
10317 local @ids = split(/\s+/, $config{'bw_servers'});
10318 return &indexof($_[0]->{'id'}, @ids) != -1;
10319 }
10320}
10321
10322# Returns 1 if the current user can see mailbox and domain passwords
10323sub can_show_pass
10324{
10325return &master_admin() || &reseller_admin() || $config{'show_pass'};
10326}
10327
10328# Returns 1 if the user can change his own password
10329sub can_passwd
10330{
10331return &reseller_admin() || $access{'edit_passwd'};
10332}
10333
10334# Returns 1 if the user can change a domain's external IP address
10335sub can_dnsip
10336{
10337return &master_admin() || &reseller_admin() || $access{'edit_dnsip'};
10338}
10339
10340# Returns 1 if the current user can set the chained certificate path to
10341# anywhere.
10342sub can_chained_cert_path
10343{
10344return &master_admin();
10345}
10346
10347# Returns 1 if the user can copy a domain's cert to Webmin
10348sub can_webmin_cert
10349{
10350return &master_admin();
10351}
10352
10353# Returns 1 if the current user can edit allowed remote DB hosts
10354sub can_allowed_db_hosts
10355{
10356return &master_admin() || &reseller_admin() || $access{'edit_allowedhosts'};
10357}
10358
10359# Returns 2 if the current user can manage all plans, 1 if his own only,
10360# 0 if cannot manage any
10361sub can_edit_plans
10362{
10363return &master_admin() ? 2 :
10364 &reseller_admin() && !$access{'noplans'} ? 1 : 0;
10365}
10366
10367# Returns 1 if the current user can edit log file locations
10368sub can_log_paths
10369{
10370return &master_admin();
10371}
10372
10373# Returns 1 if DNS records can be manually edited
10374sub can_manual_dns
10375{
10376return &master_admin();
10377}
10378
10379sub can_edit_resellers
10380{
10381return &can_edit_templates() || $access{'createresellers'};
10382}
10383
10384# has_proxy_balancer(&domain)
10385# Returns 2 if some domain supports proxy balancing to multiple URLs, 1 for
10386# proxying to a single URL, 0 if neither.
10387sub has_proxy_balancer
10388{
10389local ($d) = @_;
10390return 0 if (!$virtualmin_pro);
10391if ($config{'web'} && !$d->{'alias'} && !$d->{'proxy_pass_mode'}) {
10392 # From Apache
10393 &require_apache();
10394 if ($apache::httpd_modules{'mod_proxy'} &&
10395 $apache::httpd_modules{'mod_proxy_balancer'}) {
10396 return 2;
10397 }
10398 elsif ($apache::httpd_modules{'mod_proxy'}) {
10399 return 1;
10400 }
10401 }
10402else {
10403 # From plugin, maybe
10404 local $p = &domain_has_website($d);
10405 return &plugin_defined($p, "feature_supports_web_balancers") ?
10406 &plugin_call($p, "feature_supports_web_balancers", $d) : 0;
10407 }
10408}
10409
10410# has_proxy_none([&domain])
10411# Returns 1 if the system supports disabling proxying for some URL
10412sub has_proxy_none
10413{
10414local ($d) = @_;
10415local $p = &domain_has_website($d);
10416if ($p eq 'web') {
10417 &require_apache();
10418 return $apache::httpd_modules{'mod_proxy'} >= 2.0;
10419 }
10420else {
10421 return 1; # Assume OK for plugins
10422 }
10423}
10424
10425# has_webmail_rewrite(&domain)
10426# Returns 1 if this system has mod_rewrite, needed for redirecting webmail.$DOM
10427# to port 20000
10428sub has_webmail_rewrite
10429{
10430local ($d) = @_;
10431local $p = &domain_has_website($d);
10432if ($p eq 'web') {
10433 # Check Apache modules
10434 &require_apache();
10435 return $apache::httpd_modules{'mod_rewrite'};
10436 }
10437else {
10438 # Call plugin
10439 return &plugin_defined($p, "feature_supports_webmail_redirect") &&
10440 &plugin_call($p, "feature_supports_webmail_redirect", $d);
10441 }
10442}
10443
10444# has_sni_support([&domain])
10445# Returns 1 if the webserver supports SNI for SSL cert selection
10446sub has_sni_support
10447{
10448local ($d) = @_;
10449local $p = &domain_has_website($d);
10450if ($p eq 'web') {
10451 # Check Apache modules
10452 &require_apache();
10453 local @dirs = &list_apache_directives();
10454 local ($sni) = grep { lc($_->[0]) eq lc("SSLStrictSNIVHostCheck") }
10455 @dirs;
10456 return 1 if ($sni);
10457 if ($apache::httpd_modules{'mod_ssl'} >= 2.3 ||
10458 $apache::httpd_modules{'mod_ssl'} =~ /^2\.2(\d+)/ && $1 >= 12) {
10459 # Assume SNI works for Apache 2.2.12 or later
10460 return 1;
10461 }
10462 return 0;
10463 }
10464else {
10465 # Call plugin
10466 return &plugin_defined($p, "feature_supports_sni") &&
10467 &plugin_call($p, "feature_supports_sni", $d);
10468 }
10469}
10470
10471# require_licence()
10472# Reads in the file containing the licence_scheduled function.
10473# Returns 1 if OK, 0 if not
10474sub require_licence
10475{
10476return 0 if (!$virtualmin_pro);
10477foreach my $ls ("$module_root_directory/virtualmin-licence.pl",
10478 $config{'licence_script'}) {
10479 if ($ls && -r $ls) {
10480 do $ls;
10481 if ($@) {
10482 &error("Licence script failed : $@");
10483 }
10484 return 1;
10485 }
10486 }
10487return 0;
10488}
10489
10490# setup_licence_cron()
10491# Checks for and sets up the licence checking cron job (if needed)
10492sub setup_licence_cron
10493{
10494if (&require_licence()) {
10495 &read_file($licence_status, \%licence);
10496 return if (time() - $licence{'last'} < 24*60*60); # checked recently, so no worries
10497
10498 # Hasn't been checked from cron for 3 days .. do it now
10499 local $job = &find_cron_script($licence_cmd);
10500 if (!$job) {
10501 # Create
10502 $job = { 'mins' => int(rand()*60),
10503 'hours' => int(rand()*24),
10504 'days' => '*',
10505 'months' => '*',
10506 'weekdays' => '*',
10507 'user' => 'root',
10508 'active' => 1,
10509 'command' => $licence_cmd };
10510 }
10511 else {
10512 # Enforce a proper schedule
10513 if ($job->{'mins'} !~ /^\d+$/) {
10514 $job->{'mins'} = int(rand()*60);
10515 }
10516 if ($job->{'hours'} !~ /^\d+$/) {
10517 $job->{'hours'} = int(rand()*24);
10518 }
10519 $job->{'days'} = '*';
10520 $job->{'months'} = '*';
10521 $job->{'weekdays'} = '*';
10522 $job->{'active'} = 1;
10523 $job->{'user'} = 'root';
10524 $job->{'command'} = $licence_cmd;
10525 }
10526 &setup_cron_script($job);
10527 }
10528}
10529
10530# check_licence_expired()
10531# Returns 0 if the licence is valid, 1 if not, or 2 if could not be checked,
10532# 3 if expired, the expiry date, error message, number of domain, number
10533# of servers, and auto-renewal flag
10534sub check_licence_expired
10535{
10536return 0 if (!&require_licence());
10537local %licence;
10538&read_file_cached($licence_status, \%licence);
10539if (time() - $licence{'last'} > 3*24*60*60) {
10540 # Hasn't been checked from cron for 3 days .. do it now
10541 &update_licence_from_site(\%licence);
10542 &write_file($licence_status, \%licence);
10543 }
10544return ($licence{'status'}, $licence{'expiry'},
10545 $licence{'err'}, $licence{'doms'}, $licence{'servers'},
10546 $licence{'autorenew'});
10547}
10548
10549# update_licence_from_site(&licence)
10550# Attempts to validate the license, and updates the given hash ref with
10551# license details.
10552sub update_licence_from_site
10553{
10554local ($licence) = @_;
10555local ($status, $expiry, $err, $doms, $servers, $max_servers, $autorenew) =
10556 &check_licence_site();
10557$licence->{'last'} = time();
10558delete($licence->{'warn'});
10559if ($status == 2) {
10560 # Networking / CGI error. Don't treat this as a failure unless we have
10561 # seen it for at least 2 days
10562 $licence->{'lastdown'} ||= time();
10563 local $diff = time() - $licence->{'lastdown'};
10564 if ($diff < 2*24*60*60) {
10565 # A short-term failure - don't change anything
10566 $licence->{'warn'} = $err;
10567 return;
10568 }
10569 }
10570else {
10571 delete($licence->{'lastdown'});
10572 }
10573$licence->{'status'} = $status;
10574$licence->{'expiry'} = $expiry;
10575$licence->{'autorenew'} = $autorenew;
10576$licence->{'err'} = $err;
10577if (defined($doms)) {
10578 # Only store the max domains if we got something valid back
10579 $licence->{'doms'} = $doms;
10580 }
10581if (defined($servers)) {
10582 # Same for servers
10583 $licence->{'used_servers'} = $servers;
10584 $licence->{'servers'} = $max_servers;
10585 }
10586}
10587
10588# check_licence_site()
10589# Calls the function to actually validate the licence, which must return 0 if
10590# valid, 1 if not, or 2 if could not be checked, 3 if expired, the expiry
10591# date, any error message, the max number of domains, number of servers,
10592# maximum servers, and the auto-renewal flag
10593sub check_licence_site
10594{
10595return (0) if (!&require_licence());
10596local $id = &get_licence_hostid();
10597
10598local ($status, $expiry, $err, $doms, $max_servers, $servers, $autorenew) =
10599 &licence_scheduled($id, undef, undef, &get_vps_type());
10600if ($status == 0 && $doms) {
10601 # A domains limit exists .. check if we have exceeded it
10602 local @doms = grep { !$_->{'alias'} } &list_domains();
10603 if (@doms > $doms) {
10604 $status = 1;
10605 $err = &text('licence_maxdoms', $doms, scalar(@doms));
10606 }
10607 }
10608if ($status == 0 && $max_servers && !$err) {
10609 # A servers limit exists .. check if we have exceeded it
10610 if ($servers > $max_servers+1) {
10611 $status = 1;
10612 $err = &text('licence_maxservers', $max_servers, $servers);
10613 }
10614 }
10615return ($status, $expiry, $err, $doms, $servers, $max_servers, $autorenew);
10616}
10617
10618# get_licence_hostid()
10619# Return a host ID for licence checking, from the hostid command or
10620# MAC address or hostname
10621sub get_licence_hostid
10622{
10623local $id;
10624if (&has_command("hostid")) {
10625 $id = &backquote_command("hostid 2>/dev/null");
10626 chop($id);
10627 }
10628if (!$id || $id =~ /^0+$/ || $id eq '7f0100') {
10629 &foreign_require("net");
10630 local ($iface) = grep { $_->{'fullname'} eq $config{'iface'} }
10631 &net::active_interfaces();
10632 $id = $iface->{'ether'} if ($iface);
10633 }
10634if (!$id) {
10635 $id = &get_system_hostname();
10636 }
10637return $id;
10638}
10639
10640# get_vps_type()
10641# If running under some kind of VPS, return a type code for it. This can be
10642# one of 'xen', 'vserver', 'zones' or undef for none.
10643sub get_vps_type
10644{
10645return defined(&running_in_zone) && &running_in_zone() ? 'zones' :
10646 defined(&running_in_vserver) && &running_in_vserver() ? 'vserver' :
10647 defined(&running_in_xen) && &running_in_xen() ? 'xen' : undef;
10648}
10649
10650# warning_messages()
10651# Returns HTML for an error messages such as the licence being expired, if it
10652# is and if the current user is the master admin. Also warns about IP changes,
10653# need to reboot, etc.
10654sub warning_messages
10655{
10656my $rv;
10657foreach my $warn (&list_warning_messages()) {
10658 $rv .= &ui_alert_box($warn, "warn");
10659 }
10660return $rv;
10661}
10662
10663# list_warning_messages()
10664# Returns all warning messages for the current user as an array
10665sub list_warning_messages
10666{
10667return () if (!&master_admin());
10668my @rv;
10669
10670# Get licence expiry date
10671local ($status, $expiry, $err, undef, undef, $autorenew) =
10672 &check_licence_expired();
10673local $expirytime;
10674if ($expiry =~ /^(\d+)\-(\d+)\-(\d+)$/) {
10675 # Make Unix time
10676 eval {
10677 $expirytime = timelocal(59, 59, 23, $3, $2-1, $1-1900);
10678 };
10679 }
10680if ($status != 0) {
10681 my $alert_text;
10682 # Not valid .. show message
10683 $alert_text .= "<b>".$text{'licence_err'}."</b><br>\n";
10684 $alert_text .= $err."\n";
10685 $alert_text .= &text('licence_renew', $virtualmin_renewal_url),"\n";
10686 if (&can_recheck_licence()) {
10687 $alert_text .= &ui_form_start("$gconfig{'webprefix'}/$module_name/licence.cgi");
10688 $alert_text .= &ui_submit($text{'licence_recheck'});
10689 $alert_text .= &ui_form_end();
10690 }
10691 push(@rv, $alert_text);
10692 }
10693elsif ($expirytime && $expirytime - time() < 7*24*60*60 && !$autorenew) {
10694 # One week to expiry .. tell the user
10695 local $days = int(($expirytime - time()) / (24*60*60));
10696 local $hours = int(($expirytime - time()) / (60*60));
10697 if ($days) {
10698 $alert_text .= "<b>".&text('licence_soon', $days)."</b><br>\n";
10699 }
10700 else {
10701 $alert_text .= "<b>".&text('licence_soon2', $hours)."</b><br>\n";
10702 }
10703 $alert_text .= &text('licence_renew', $virtualmin_renewal_url),"\n";
10704 if (&can_recheck_licence()) {
10705 $alert_text .= &ui_form_start("$gconfig{'webprefix'}/$module_name/licence.cgi");
10706 $alert_text .= &ui_submit($text{'licence_recheck'});
10707 $alert_text .= &ui_form_end();
10708 }
10709 push(@rv, $alert_text);
10710 }
10711
10712# Check if default IP has changed
10713local $defip = &get_default_ip();
10714if ($config{'old_defip'} && $defip && $config{'old_defip'} ne $defip) {
10715 my $alert_text;
10716 $alert_text .= "<b>".&text('licence_ipchanged',
10717 "<tt>$config{'old_defip'}</tt>",
10718 "<tt>$defip</tt>")."</b><p>\n";
10719 $alert_text .= &ui_form_start("$gconfig{'webprefix'}/$module_name/edit_newips.cgi");
10720 $alert_text .= &ui_hidden("old", $config{'old_defip'});
10721 $alert_text .= &ui_hidden("new", $defip);
10722 $alert_text .= &ui_hidden("setold", 1);
10723 $alert_text .= &ui_hidden("also", 1);
10724 $alert_text .= &ui_submit($text{'licence_changeip'});
10725 $alert_text .= &ui_form_end();
10726 push(@rv, $alert_text);
10727 }
10728
10729# Check if in SSL mode, and SSL cert is < 2048 bits
10730local $small;
10731if ($ENV{'HTTPS'} eq 'ON') {
10732 local %miniserv;
10733 &get_miniserv_config(\%miniserv);
10734 local $certfile = $miniserv{'certfile'} || $miniserv{'keyfile'};
10735 if ($certfile) {
10736 local $cert = &cert_file_info($certfile);
10737 if ($cert->{'size'} && $cert->{'size'} < 2048) {
10738 # Too small!
10739 $small = $cert;
10740 }
10741 }
10742 }
10743if ($small) {
10744 my $alert_text;
10745 local $msg = $small->{'issuer_c'} eq $small->{'c'} &&
10746 $small->{'issuer_o'} eq $small->{'o'} ?
10747 'licence_smallself' : 'licence_smallcert';
10748 $alert_text .= "<b>".&text($msg,
10749 $small->{'size'},
10750 $small->{'cn'},
10751 $small->{'c'} || $small->{'o'},
10752 $small->{'issuer_c'} || $small->{'issuer_o'},
10753 )."</b><p>\n";
10754 $alert_text .= &ui_form_start("$gconfig{'webprefix'}/webmin/edit_ssl.cgi");
10755 $alert_text .= &ui_hidden("mode", $msg eq 'licence_smallself' ?
10756 'create' : 'csr');
10757 $alert_text .= &ui_submit($msg eq 'licence_smallself' ?
10758 $text{'licence_newcert'} :
10759 $text{'licence_newcsr'});
10760 $alert_text .= &ui_form_end();
10761 push(@rv, $alert_text);
10762 }
10763
10764# Check if symlinks need to be fixed. Blank means not checked yet, 0 means
10765# fixed, 1 means don't fix.
10766if ($config{'allow_symlinks'} eq '') {
10767 my $alert_text;
10768 # Do any domains have unsafe settings?
10769 local @fixdoms = &fix_symlink_security(undef, 1);
10770 if (@fixdoms) {
10771 $alert_text .= "<b>".&text('licence_fixlinks', scalar(@fixdoms))."<p>".
10772 $text{'licence_fixlinks2'}."</b><p>\n";
10773 $alert_text .= &ui_form_start(
10774 "$gconfig{'webprefix'}/$module_name/fix_symlinks.cgi");
10775 $alert_text .= &ui_submit($text{'licence_fixlinksok'}, undef);
10776 $alert_text .= &ui_submit($text{'licence_fixlinksignore'}, 'ignore');
10777 $alert_text .= &ui_form_end();
10778 push(@rv, $alert_text);
10779 }
10780 else {
10781 # All OK already, don't check again
10782 $config{'allow_symlinks'} = 0;
10783 &save_module_config();
10784 }
10785 }
10786
10787# Check if mod_php needs to be disabled
10788if ($config{'allow_modphp'} eq '') {
10789 my $alert_text;
10790 # Do any domains allow mod_php incorrectly?
10791 local @fixdoms = &fix_mod_php_security(undef, 1);
10792 if (@fixdoms) {
10793 $alert_text .= "<b>".&text('licence_fixphp', scalar(@fixdoms))."<p>".
10794 $text{'licence_fixphp2'}."</b><p>\n";
10795 $alert_text .= &ui_form_start(
10796 "$gconfig{'webprefix'}/$module_name/fix_modphp.cgi");
10797 $alert_text .= &ui_submit($text{'licence_fixphpok'}, undef);
10798 $alert_text .= &ui_submit($text{'licence_fixphpignore'}, 'ignore');
10799 $alert_text .= &ui_form_end();
10800 push(@rv, $alert_text);
10801 }
10802 else {
10803 # All OK already, don't check again
10804 $config{'allow_modphp'} = 0;
10805 &save_module_config();
10806 }
10807 }
10808
10809# Check if a reboot is needed to enable Xen quotas on /
10810if (&needs_xfs_quota_fix() == 1 && &foreign_available("init")) {
10811 my $alert_text;
10812 $alert_text .= "<b>$text{'licence_xfsreboot'}</b><p>\n";
10813 $alert_text .= &ui_form_start(
10814 "$gconfig{'webprefix'}/init/reboot.cgi");
10815 $alert_text .= &ui_submit($text{'licence_xfsrebootok'});
10816 $alert_text .= &ui_form_end();
10817 push(@rv, $alert_text);
10818 }
10819
10820# Suggest that the user switch themes to authentic
10821my @themes = &list_themes();
10822my ($theme) = grep { $_->{'dir'} eq $recommended_theme } @themes;
10823if ($theme && $current_theme ne $recommended_theme &&
10824 !$config{'theme_switch_'.$recommended_theme}) {
10825 my $switch_text;
10826 $switch_text .= "<b>".&text('index_themeswitch',
10827 $theme->{'desc'})."</b><p>\n";
10828 $switch_text .= &ui_form_start(
10829 "$gconfig{'webprefix'}/$module_name/switch_theme.cgi");
10830 $switch_text .= &ui_submit($text{'index_themeswitchok'});
10831 $switch_text .= &ui_submit($text{'index_themeswitchnot'}, "cancel");
10832 $switch_text .= &ui_form_end();
10833 push(@rv, $switch_text);
10834 }
10835
10836return @rv;
10837}
10838
10839# get_user_domain(user)
10840# Given a username, returns it's virtual server details
10841sub get_user_domain
10842{
10843local @uinfo = getpwnam($_[0]);
10844local @doms;
10845if (@uinfo) {
10846 # Is a Unix user .. find the domains for his GID (which could include
10847 # sub-servers), and then check the home for each
10848 foreach my $d (&get_domain_by("gid", $uinfo[3])) {
10849 if ($uinfo[7] =~ /^\Q$d->{'home'}\E\/homes\// ||
10850 ($d->{'user'} eq $uinfo[0] && !$d->{'parent'})) {
10851 return $d;
10852 }
10853 }
10854 }
10855
10856# Need to check all domains :( This is unlikely to happen though
10857local @doms = &list_domains();
10858foreach my $d (@doms) {
10859 local @users = &list_domain_users($d, 0, 1, 1, 1);
10860 local $u;
10861 foreach $u (@users) {
10862 if ($u->{'user'} eq $_[0] ||
10863 &replace_atsign($u->{'user'}) eq $_[0]) {
10864 return $d;
10865 }
10866 }
10867 }
10868return undef;
10869}
10870
10871# get_domain_user_quotas(&domain, ...)
10872# For each virtual server, returns the home and mail directory usage for all its
10873# users (including the server admin), the server admin object, total usage for
10874# all databases, and database usage that has already been included in the
10875# home usage.
10876sub get_domain_user_quotas
10877{
10878local ($duserrv);
10879local $mailquota = 0;
10880local $homequota = 0;
10881local $dbquota = 0;
10882local $dbquota_home = 0;
10883foreach my $d (@_) {
10884 local @users = &list_domain_users($d, 0, 1, 0, 1);
10885 local ($duser) = grep { $_->{'user'} eq $d->{'user'} } @users;
10886 $duserrv ||= $duser;
10887 local $u;
10888 foreach $u (@users) {
10889 if (!$u->{'domainowner'} && !$u->{'webowner'}) {
10890 $homequota += $u->{'uquota'};
10891 $mailquota += $u->{'umquota'};
10892 }
10893 }
10894 local @dbq = &get_database_usage($d);
10895 $dbquota += $dbq[0];
10896 $dbquota_home += $dbq[1];
10897 }
10898return ($homequota, $mailquota, $duserrv, $dbquota, $dbquota_home);
10899}
10900
10901# get_domain_quota(&domain, [db-too])
10902# For a domain, returns the group quota used on home and mail filesystems.
10903# If the db flag is set, also returns the sum of all disk space used by
10904# databases on this and sub-servers. If database usage is already included
10905# in the group quota for home, it is subtracted.
10906sub get_domain_quota
10907{
10908local ($d, $dbtoo) = @_;
10909local ($home, $mail, $db, $dbq);
10910if (&has_group_quotas()) {
10911 # Query actual group quotas
10912 my @groups = &list_all_groups_quotas(0);
10913 my ($group) = grep { $_->{'group'} eq $d->{'group'} } @groups;
10914 if ($group) {
10915 $home = $group->{'uquota'};
10916 if ($config{'mail_quotas'}) {
10917 $mail = $group->{'umquota'};
10918 }
10919 }
10920 if ($dbtoo) {
10921 $db = 0;
10922 foreach my $sd ($d, &get_domain_by("parent", $d->{'id'})) {
10923 local @dbu = &get_database_usage($sd);
10924 $db += $dbu[0];
10925 $dbq += $dbu[1];
10926 }
10927 }
10928 $dbq /= "a_bsize("home");
10929 }
10930else {
10931 # Fake it by summing up user quotas
10932 local $dummy;
10933 ($home, $mail, $dummy, $db, $dbq) = &get_domain_user_quotas(
10934 $d, &get_domain_by("parent", $d->{'id'}));
10935 }
10936return ($home >= $dbq ? $home-$dbq : $home, $mail, $db);
10937}
10938
10939# compute_prefix(domain-name, group, [&parent], [creating-flag])
10940# Given a domain name, returns the prefix for usernames
10941sub compute_prefix
10942{
10943local ($name, $group, $parent, $creating) = @_;
10944if ($config{'longname'} != 1) {
10945 $name =~ s/^xn(-+)//; # Strip IDN part
10946 }
10947if ($config{'longname'} == 1) {
10948 # Prefix is same as domain name
10949 return $name;
10950 }
10951elsif ($group && !$parent && $config{'longname'} == 0) {
10952 # For top-level domains, prefix is same as group name
10953 return $group;
10954 }
10955else {
10956 # Otherwise, prefix comes from first part of domain. If this clashes,
10957 # use the second part too and so on
10958 local @p = split(/\./, $name);
10959 local $prefix;
10960 if ($creating) {
10961 # First try foo, then foo.com, then foo.com.au
10962 for(my $i=0; $i<@p; $i++) {
10963 local $testp = join("-", @p[0..$i]);
10964 local $pclash = &get_domain_by("prefix", $testp);
10965 if (!$pclash) {
10966 $prefix = $testp;
10967 last;
10968 }
10969 }
10970 # If none of those worked, append a number
10971 if (!$prefix) {
10972 my $i = 1;
10973 while(1) {
10974 local $testp = $p[0].$i;
10975 local $pclash = &get_domain_by("prefix",$testp);
10976 if (!$pclash) {
10977 $prefix = $testp;
10978 last;
10979 }
10980 $i++;
10981 }
10982 }
10983 }
10984 return $prefix || $p[0];
10985 }
10986}
10987
10988# get_domain_owner(&domain, [skip-virts, [skip-quotas, skip-dbs]])
10989# Returns the Unix user object for a server's owner. Quota, DB and virtuser
10990# details will be omitted if the skip flag is set.
10991sub get_domain_owner
10992{
10993local ($d, $novirts, $noquotas, $nodbs) = @_;
10994$noquotas = $novirts if (!defined($noquotas));
10995$nodbs = $novirts if (!defined($nodbs));
10996if ($d->{'parent'}) {
10997 local $parent = &get_domain($d->{'parent'});
10998 if ($parent) {
10999 return &get_domain_owner($parent, $noinfo);
11000 }
11001 return undef;
11002 }
11003else {
11004 local @users = &list_domain_users($d, 0, $novirts, $noquotas, $nodbs);
11005 local ($user) = grep { $_->{'user'} eq $_[0]->{'user'} } @users;
11006 return $user;
11007 }
11008}
11009
11010# new_password_input(name)
11011# Returns HTML for a password selection field
11012sub new_password_input
11013{
11014local ($name) = @_;
11015if ($config{'passwd_mode'} == 1) {
11016 # Random but editable password
11017 return &ui_textbox($name, &random_password(), 13, 0, undef,
11018 "autocomplete=off");
11019 }
11020elsif ($config{'passwd_mode'} == 0) {
11021 # One hidden password
11022 return &ui_password($name, undef, 13, 0, undef,
11023 "autocomplete=off");
11024 }
11025elsif ($config{'passwd_mode'} == 2) {
11026 # Two hidden passwords
11027 return "<table>\n".
11028 "<tr><td>$text{'form_passf'}</td> ".
11029 "<td>".&ui_password($name, undef, 13, 0, undef,
11030 "autocomplete=off")."</td> </tr>\n".
11031 "<tr><td>$text{'form_passa'}</td> ".
11032 "<td>".&ui_password($name."_again", undef, 13, 0, undef,
11033 "autocomplete=off")."</td> </tr>\n".
11034 "</table>";
11035 }
11036}
11037
11038# parse_new_password(name, allow-empty)
11039# Returns the entered or randomly generated password
11040sub parse_new_password
11041{
11042local ($name, $empty) = @_;
11043$empty || $in{$name} =~ /\S/ || &error($text{'setup_epass'});
11044if (defined($in{$name."_again"}) && $in{$name} ne $in{$name."_again"}) {
11045 &error($text{'setup_epassagain'});
11046 }
11047return $in{$name};
11048}
11049
11050# get_disable_features(&domain)
11051# Given a domain, returns a list of features that can be disabled for it
11052sub get_disable_features
11053{
11054local ($d) = @_;
11055local @disable;
11056@disable = grep { $d->{$_} && $config{$_} } split(/,/, $config{'disable'});
11057push(@disable, "ssl") if (&indexof("web", @disable) >= 0 && $d->{'ssl'});
11058push(@disable, "status") if (&indexof("web", @disable) >= 0 && $d->{'status'});
11059@disable = grep { $_ ne "unix" } @disable if ($d->{'parent'});
11060push(@disable, grep { $d->{$_} &&
11061 &plugin_defined($_, "feature_disable") } &list_feature_plugins());
11062return &unique(@disable);
11063}
11064
11065# get_enable_features(&domain)
11066# Given a domain, returns a list of features that should be enabled for it
11067sub get_enable_features
11068{
11069local ($d) = @_;
11070local @enable;
11071local @disabled = split(/,/, $d->{'disabled'});
11072local %disabled = map { $_, 1 } @disabled;
11073@enable = grep { $d->{$_} && ($config{$_} || $_ eq 'unix') } @disabled;
11074push(@enable, "ssl") if (&indexof("web", @enable) >= 0 && $d->{'ssl'});
11075@enable = grep { $_ ne "unix" } @enable if ($d->{'parent'});
11076push(@enable, grep { $d->{$_} && $disabled{$_} &&
11077 &plugin_defined($_, "feature_enable") } &list_feature_plugins());
11078return &unique(@enable);
11079}
11080
11081# sysinfo_virtualmin()
11082# Returns the OS info, Perl version and path
11083sub sysinfo_virtualmin
11084{
11085return ( [ $text{'sysinfo_os'}, "$gconfig{'real_os_type'} $gconfig{'real_os_version'}" ],
11086 [ $text{'sysinfo_perl'}, $] ],
11087 [ $text{'sysinfo_perlpath'}, &get_perl_path() ] );
11088}
11089
11090# has_home_quotas()
11091# Returns 1 if home directory quotas are enabled
11092sub has_home_quotas
11093{
11094return 1 if (&has_quota_commands());
11095return $config{'home_quotas'} ? 1 : 0;
11096}
11097
11098# has_mail_quotas()
11099# Returns 1 if mail directory quotas are enabled, and needed
11100sub has_mail_quotas
11101{
11102return 0 if (&has_quota_commands());
11103return $config{'mail_quotas'} &&
11104 $config{'mail_quotas'} ne $config{'home_quotas'} ? 1 : 0;
11105}
11106
11107# has_server_quotas()
11108# Returns 1 if the system's mail server supports mail quotas
11109sub has_server_quotas
11110{
11111return $config{'mail'} && ($config{'mail_system'} == 4 ||
11112 $config{'mail_system'} == 5);
11113}
11114
11115# has_group_quotas()
11116# Returns 1 if group quotas are enabled
11117sub has_group_quotas
11118{
11119return 1 if (&has_quota_commands());
11120return $config{'group_quotas'} ? 1 : 0;
11121}
11122
11123# has_quota_commands()
11124# Returns 1 if external quota commands are being used
11125sub has_quota_commands
11126{
11127return $config{'quota_commands'} ? 1 : 0;
11128}
11129
11130# has_quotacheck()
11131# Returns 1 if the home or mail filesystems support quota checking
11132sub has_quotacheck
11133{
11134&foreign_require("mount");
11135my @mounted = &mount::list_mounted();
11136my ($hm) = grep { $_->[0] eq $config{'home_quotas'} } @mounted;
11137return 1 if ($hm && $hm->[2] ne 'xfs');
11138if ($config{'mail_quotas'}) {
11139 my ($mm) = grep { $_->[0] eq $config{'mail_quotas'} } @mounted;
11140 return 1 if ($mm && $mm->[2] ne 'xfs');
11141 }
11142return 0;
11143}
11144
11145# get_database_usage(&domain)
11146# Returns the number of bytes used by all this virtual server's databases. If
11147# called in a array context, database space already counted by the quota system
11148# is also returned.
11149sub get_database_usage
11150{
11151local ($d) = @_;
11152local $rv = 0;
11153local $qrv = 0;
11154foreach my $db (&domain_databases($d, [ 'mysql', 'postgres' ])) {
11155 local ($size, $qsize) = &get_one_database_usage($d, $db);
11156 $rv += $size;
11157 $qrv += $qsize;
11158 }
11159return wantarray ? ($rv, $qrv) : $rv;
11160}
11161
11162# get_one_database_usage(&domain, &db)
11163# Returns the disk space used by one database, and the amount of space that
11164# is already counted by the quota system.
11165sub get_one_database_usage
11166{
11167local ($d, $db) = @_;
11168if ($db->{'type'} eq 'mysql' || $db->{'type'} eq 'postgres') {
11169 # Get size from core database
11170 local $szfunc = $db->{'type'}."_size";
11171 local ($size, $tables, $qsize) = &$szfunc($d, $db->{'name'}, 1);
11172 return ($size, $qsize);
11173 }
11174else {
11175 # Get size from plugin
11176 local ($size, $tables, $qsize) = &plugin_call($db->{'type'},
11177 "database_size", $d, $db->{'name'}, 1);
11178 return ($size, $qsize);
11179 }
11180}
11181
11182# need_config_check()
11183# Compares the current and previous configs, and returns 1 if a re-check is
11184# needed due to any checked option changing.
11185sub need_config_check
11186{
11187local @cst = stat($module_config_file);
11188return 0 if ($cst[9] <= $config{'last_check'});
11189local %lastconfig;
11190&read_file("$module_config_directory/last-config", \%lastconfig) || return 1;
11191foreach my $f (@features) {
11192 # A feature was enabled or disabled
11193 return 1 if ($config{$f} != $lastconfig{$f});
11194 }
11195foreach my $c ("mail_system", "generics", "bccs", "append_style", "ldap_host",
11196 "ldap_base", "ldap_login", "ldap_pass", "ldap_port", "ldap",
11197 "vpopmail_dir", "vpopmail_user", "vpopmail_group",
11198 "clamscan_cmd", "iface", "netmask6", "localgroup", "home_quotas",
11199 "mail_quotas", "group_quotas", "quotas", "shell", "ftp_shell",
11200 "all_namevirtual", "dns_ip", "default_procmail",
11201 "compression", "pbzip2", "suexec", "domains_group",
11202 "quota_commands", "home_base",
11203 "quota_set_user_command", "quota_set_group_command",
11204 "quota_list_users_command", "quota_list_groups_command",
11205 "quota_get_user_command", "quota_get_group_command",
11206 "preload_mode", "collect_interval", "api_helper",
11207 "spam_lock", "spam_white", "mem_low",
11208 "lookup_domain_serial") {
11209 # Some important config option was changed
11210 return 1 if ($config{$c} ne $lastconfig{$c});
11211 }
11212foreach my $k (keys %config) {
11213 if ($k =~ /^avail_/ || $k eq 'leave_acl' || $k eq 'webmin_modules' ||
11214 $k eq 'post_check') {
11215 # An option effecting Webmin users
11216 return 1 if ($config{$k} ne $lastconfig{$k});
11217 }
11218 }
11219return 0;
11220}
11221
11222# update_secondary_groups(&domain, [&users])
11223# After a user is saved, updated or deleted, update the secondary groups
11224# specified in it's template with the appropriate users.
11225sub update_secondary_groups
11226{
11227local ($dom, $users) = @_;
11228local $tmpl = &get_template($dom->{'template'});
11229
11230# See if this feature is actually configured
11231my $any = 0;
11232foreach my $g ("mailgroup", "ftpgroup", "dbgroup") {
11233 local $gn = $tmpl->{$g};
11234 $any++ if ($gn && $gn ne "none");
11235 }
11236return 0 if (!$any);
11237
11238# Get the current user and group lists
11239$users ||= [ &list_domain_users($dom) ];
11240local %indom = map { $_->{'user'}, 1 } @$users;
11241&require_useradmin();
11242local @groups = &list_all_groups();
11243local %gtaken;
11244&build_group_taken(\%gtaken, undef, \@groups);
11245local %taken;
11246&build_taken(undef, \%taken);
11247
11248# Find FTP-capable shells
11249local %shellmap = map { $_->{'shell'}, $_->{'id'} } &list_available_shells();
11250
11251foreach my $g ("mailgroup", "ftpgroup", "dbgroup") {
11252 local $gn = $tmpl->{$g};
11253 next if (!$gn || $gn eq "none");
11254 local @inusers;
11255
11256 # Work out who is in the group
11257 if ($g eq "mailgroup") {
11258 @inusers = grep { $_->{'unix'} && $_->{'email'} } @$users;
11259 }
11260 elsif ($g eq "ftpgroup") {
11261 @inusers = grep { $_->{'unix'} &&
11262 $shellmap{$_->{'shell'}} &&
11263 $shellmap{$_->{'shell'}} ne 'nologin' }
11264 @$users;
11265 }
11266 elsif ($g eq "dbgroup") {
11267 @inusers = grep { $_->{'unix'} && @{$_->{'dbs'}} > 0 ||
11268 $_->{'domainowner'} && $dom->{'mysql'} } @$users;
11269 }
11270 local @innames = map { $_->{'user'} } @inusers;
11271 local %innames = map { $_, 1 } @innames;
11272
11273 # Get the group
11274 local ($group) = grep { $_->{'group'} eq $gn } @groups;
11275 if ($group) {
11276 # Update the secondary members, removing any users who don't
11277 # exist or are in this domain but shouldn't be there.
11278 local @mems = split(/,/, $group->{'members'});
11279 @mems = grep { !($indom{$_} && !$innames{$_}) } @mems;
11280 @mems = &unique(@mems, @innames);
11281 @mems = grep { $taken{$_} } @mems;
11282 $group->{'members'} = join(",", @mems);
11283 &foreign_call($group->{'module'}, "modify_group",
11284 $group, $group);
11285 }
11286 else {
11287 # Need to create!
11288 $group = { 'group' => $gn,
11289 'gid' => &allocate_gid(\%gtaken),
11290 'members' => join(",", @innames) };
11291 &foreign_call($usermodule, "create_group", $group);
11292 $gtaken{$group->{'gid'}} = 1;
11293 }
11294 }
11295}
11296
11297# allowed_secondary_groups([&domain])
11298# Returns a list of secondary groups that users in some domain can belong to
11299sub allowed_secondary_groups
11300{
11301if ($_[0] && ($tmpl = &get_template($_[0]->{'template'})) &&
11302 $tmpl->{'othergroups'} && $tmpl->{'othergroups'} ne 'none') {
11303 return split(/\s+/, $tmpl->{'othergroups'});
11304 }
11305return ( );
11306}
11307
11308# compression_format(file, [&key])
11309# Returns 0 if uncompressed, 1 for gzip, 2 for compress, 3 for bzip2 or
11310# 4 for zip, 5 for tar
11311sub compression_format
11312{
11313local ($file, $key) = @_;
11314if ($key) {
11315 open(BACKUP, &backup_decryption_command($key)." ".
11316 quotemeta($file)." 2>/dev/null |");
11317 }
11318else {
11319 open(BACKUP, $file);
11320 }
11321local $two;
11322read(BACKUP, $two, 2);
11323close(BACKUP);
11324local $rv = $two eq "\037\213" ? 1 :
11325 $two eq "\037\235" ? 2 :
11326 $two eq "PK" ? 4 :
11327 $two eq "BZ" ? 3 : 0;
11328if (!$rv) {
11329 # Fall back to 'file' command for tar
11330 local $out = &backquote_command("file ".quotemeta($_[0]));
11331 if ($out =~ /tar\s+archive/i) {
11332 $rv = 5;
11333 }
11334 }
11335return $rv;
11336}
11337
11338# extract_compressed_file(file, [destdir])
11339# Extracts the contents of some compressed file to the given directory. Returns
11340# undef if OK, or an error message on failure.
11341# If the directory is not given, a test extraction is done instead.
11342sub extract_compressed_file
11343{
11344local ($file, $dir) = @_;
11345local $format = &compression_format($file);
11346local $tar = &get_tar_command();
11347local $bunzip2 = &get_bunzip2_command();
11348local @needs = ( undef,
11349 [ "gunzip", $tar ],
11350 [ "uncompress", $tar ],
11351 [ $bunzip2, $tar ],
11352 [ "unzip" ],
11353 [ "tar" ],
11354 );
11355foreach my $n (@{$needs[$format]}) {
11356 my ($noargs) = split(/\s+/, $n);
11357 &has_command($noargs) || return &text('addstyle_ecmd', "<tt>$n</tt>");
11358 }
11359local ($qfile, $qdir) = ( quotemeta($file), quotemeta($dir) );
11360local @cmds;
11361if ($dir) {
11362 # Actually extract
11363 @cmds = ( undef,
11364 "cd $qdir && gunzip -c $qfile | ".
11365 &make_tar_command("xf", "-"),
11366 "cd $qdir && uncompress -c $qfile | ".
11367 &make_tar_command("xf", "-"),
11368 "cd $qdir && $bunzip2 -c $qfile | ".
11369 &make_tar_command("xf", "-"),
11370 "cd $qdir && unzip $qfile",
11371 "cd $qdir && ".
11372 &make_tar_command("xf", $qfile),
11373 );
11374 }
11375else {
11376 # Just do a test listing
11377 @cmds = ( undef,
11378 "gunzip -c $qfile | ".
11379 &make_tar_command("tf", "-"),
11380 "uncompress -c $qfile | ".
11381 &make_tar_command("tf", "-"),
11382 "$bunzip2 -c $qfile | ".
11383 &make_tar_command("tf", "-"),
11384 "unzip -l $qfile",
11385 &make_tar_command("tf", $qfile),
11386 );
11387 }
11388$cmds[$format] || return "Unknown compression format";
11389local $out = &backquote_command("($cmds[$format]) 2>&1 </dev/null");
11390return $? ? &text('addstyle_ecmdfailed',
11391 "<tt>".&html_escape($out)."</tt>") : undef;
11392}
11393
11394# get_compressed_file_size(file, [&key])
11395# Returns the un-compressed size of a file in bytes, or undef if it cannot
11396# be determined
11397sub get_compressed_file_size
11398{
11399local ($file, $key) = @_;
11400my $fmt = &compression_format($file, $key);
11401my @st = stat($file);
11402if ($fmt == 0) {
11403 # Not compressed at all
11404 return $st[7];
11405 }
11406elsif ($fmt == 1) {
11407 # Gzip compressed
11408 my $out = &backquote_command("gunzip -l ".quotemeta($file));
11409 return undef if ($?);
11410 return $out =~ /\d+\s+(\d+)\s+[0-9\.]+%/ ? $1 : undef;
11411 }
11412elsif ($fmt == 2) {
11413 # Classic compress - no idea how to handle
11414 return undef;
11415 }
11416elsif ($fmt == 3) {
11417 # Bzip2 compressed - no way to estimate
11418 return undef;
11419 }
11420elsif ($fmt == 4) {
11421 # Zip format - can sum up files
11422 my $out = &backquote_command("unzip -l ".quotemeta($file));
11423 return undef if ($?);
11424 my $rv = 0;
11425 foreach my $l (split(/\r?\n/, $out)) {
11426 if ($l =~ /^\s*(\d+)\s+(\d+-\d+-\d+)/) {
11427 $rv += $1;
11428 }
11429 }
11430 return $rv;
11431 }
11432elsif ($fmt == 5) {
11433 # TAR format doesn't compress
11434 return $st[7];
11435 }
11436return undef;
11437}
11438
11439# feature_links(&domain)
11440# Returns a list of links for editing specific features within a domain, such
11441# as the DNS zone, apache config and so on. Includes plugins.
11442sub feature_links
11443{
11444local ($d) = @_;
11445local @rv;
11446
11447# Check cache for feature links
11448local $v = [ 'time' => $d->{'lastsave'},
11449 'last_check' => $config{'last_check'},
11450 'plugins' => \@plugins,
11451 'features' => \@config_features ];
11452local $ckey = $d->{'id'}."-links-".$base_remote_user;
11453local $crv = &get_links_cache($ckey, $v);
11454if ($crv) {
11455 return @$crv;
11456 }
11457
11458# Links provided by features, like editing DNS records
11459foreach my $f (@features) {
11460 if ($d->{$f}) {
11461 local $lfunc = "links_".$f;
11462 if (defined(&$lfunc)) {
11463 foreach my $l (&$lfunc($d)) {
11464 if (&foreign_available($l->{'mod'})) {
11465 $l->{'title'} ||= $l->{'desc'};
11466 push(@rv, $l);
11467 }
11468 }
11469 }
11470 }
11471 }
11472
11473# Links provided by plugins, like Mailman mailing lists
11474foreach my $f (@plugins) {
11475 if ($d->{$f}) {
11476 foreach my $l (&plugin_call($f, "feature_links", $d)) {
11477 if (&foreign_available($l->{'mod'})) {
11478 $l->{'title'} ||= $l->{'desc'};
11479 $l->{'plugin'} = 1;
11480 push(@rv, $l);
11481 }
11482 }
11483 }
11484 foreach my $l (&plugin_call($f, "feature_always_links", $d)) {
11485 if (&foreign_available($l->{'mod'})) {
11486 $l->{'title'} ||= $l->{'desc'};
11487 $l->{'plugin'} = 2;
11488 push(@rv, $l);
11489 }
11490 }
11491 }
11492
11493# Links to other Webmin modules, for domain owners
11494if (!&master_admin() && !&reseller_admin()) {
11495 local @ot;
11496 foreach my $k (keys %config) {
11497 if ($k =~ /^avail_(\S+)$/ && &indexof($1, @features) < 0 &&
11498 &indexof($1, @plugins) < 0) {
11499 if (&foreign_available($1)) {
11500 local %minfo = &get_module_info($1);
11501 push(@ot, { 'mod' => $1,
11502 'page' => 'index.cgi',
11503 'title' => $minfo{'desc'},
11504 'desc' => $minfo{'desc'},
11505 'cat' => 'webmin',
11506 'other' => 1 });
11507 }
11508 }
11509 }
11510 @ot = sort { lc($a->{'desc'}) cmp lc($b->{'desc'}) } @ot;
11511 push(@rv, @ot);
11512 }
11513
11514&save_links_cache($ckey, $v, \@rv);
11515return @rv;
11516}
11517
11518# show_domain_buttons(&domain)
11519# Print all the buttons for actions that can be taken on a server
11520sub show_domain_buttons
11521{
11522local ($d) = @_;
11523local ($anyrow1, $anyrow2, $anyrow3);
11524print &ui_buttons_start();
11525
11526# Get the actions and work out categories
11527local @buts = &get_domain_actions($d);
11528local @cats = &unique(map { $_->{'cat'} } @buts);
11529
11530# Show by category
11531foreach my $c (@cats) {
11532 local @incat = grep { $_->{'cat'} eq $c } @buts;
11533 print &ui_buttons_hr($text{'cat_'.$c});
11534 foreach my $b (@incat) {
11535 print &ui_buttons_row($b->{'page'},
11536 $b->{'title'},
11537 $b->{'desc'},
11538 &ui_hidden("dom", $d->{'id'})."\n".
11539 join("\n", map { &ui_hidden($_->[0], $_->[1]) } @{$b->{'hidden'}}));
11540 }
11541 }
11542
11543print &ui_buttons_end();
11544}
11545
11546# get_domain_actions(&domain)
11547# Returns a list of actions that can be taken for some virtual server
11548sub get_domain_actions
11549{
11550local ($d) = @_;
11551local @rv;
11552
11553# Check cache for domain actions
11554local $v = [ 'time' => $d->{'lastsave'},
11555 'last_check' => $config{'last_check'},
11556 'plugins' => \@plugins,
11557 'features' => \@config_features ];
11558local $ckey = $d->{'id'}."-actions-".$base_remote_user;
11559local $crv = &get_links_cache($ckey, $v);
11560if ($crv) {
11561 return @$crv;
11562 }
11563
11564if (&can_domain_have_users($d) && &can_edit_users()) {
11565 # Users button
11566 push(@rv, { 'page' => 'list_users.cgi',
11567 'title' => $text{'edit_users4'},
11568 'desc' => $text{'edit_usersdesc'},
11569 'cat' => 'objects',
11570 'icon' => 'group',
11571 });
11572 }
11573
11574if ($d->{'mail'} && $config{'mail'} && &can_edit_aliases() &&
11575 !$d->{'aliascopy'}) {
11576 # Mail aliases button
11577 push(@rv, { 'page' => 'list_aliases.cgi',
11578 'title' => $text{'edit_aliases'},
11579 'desc' => $text{'edit_aliasesdesc'},
11580 'cat' => 'objects',
11581 'icon' => 'email_go',
11582 });
11583 }
11584
11585if (&database_feature($d) && &can_edit_databases()) {
11586 # MySQL and PostgreSQL DBs button
11587 push(@rv, { 'page' => 'list_databases.cgi',
11588 'title' => $text{'edit_databases'},
11589 'desc' => $text{'edit_databasesdesc'},
11590 'cat' => 'objects',
11591 'icon' => 'database',
11592 });
11593 }
11594
11595if (&can_domain_have_scripts($d) && &can_edit_scripts()) {
11596 # Scripts button
11597 push(@rv, { 'page' => 'list_scripts.cgi',
11598 'title' => $text{'edit_scripts'},
11599 'desc' => $text{'edit_scriptsdesc'},
11600 'cat' => 'objects',
11601 'icon' => 'page_code',
11602 });
11603 }
11604
11605if (&domain_has_website($d) && $d->{'dir'} && !$d->{'alias'} &&
11606 !$d->{'proxy_pass_mode'} &&
11607 $virtualmin_pro && &can_edit_html()) {
11608 # Edit web pages button
11609 push(@rv, { 'page' => 'edit_html.cgi',
11610 'title' => $text{'edit_html'},
11611 'desc' => $text{'edit_htmldesc'},
11612 'cat' => 'objects',
11613 'icon' => 'page_edit',
11614 });
11615 }
11616
11617if (&can_rename_domains()) {
11618 # Rename domain button
11619 push(@rv, { 'page' => 'rename_form.cgi',
11620 'title' => $text{'edit_rename'},
11621 'desc' => $text{'edit_renamedesc'},
11622 'cat' => 'server',
11623 'icon' => 'comment_edit',
11624 });
11625 }
11626
11627if (&can_move_domain($d) && !$d->{'subdom'}) {
11628 # Move sub-server to different owner, or turn parent into sub
11629 push(@rv, { 'page' => 'move_form.cgi',
11630 'title' => $text{'edit_move'},
11631 'desc' => $d->{'parent'} ? $text{'edit_movedesc2'}
11632 : $text{'edit_movedesc'},
11633 'cat' => 'server',
11634 'icon' => 'arrow_right',
11635 });
11636 }
11637
11638if (&can_transfer_domain($d)) {
11639 # Send server to another system
11640 push(@rv, { 'page' => 'transfer_form.cgi',
11641 'title' => $text{'edit_transfer'},
11642 'desc' => $text{'edit_transferdesc'},
11643 'cat' => 'server',
11644 'icon' => 'arrow_right',
11645 });
11646 }
11647
11648if ($d->{'parent'} && &can_create_sub_servers() ||
11649 !$d->{'parent'} && &can_create_master_servers()) {
11650 # Clone server
11651 push(@rv, { 'page' => 'clone_form.cgi',
11652 'title' => $text{'edit_clone'},
11653 'desc' => $text{'edit_clonedesc'},
11654 'cat' => 'server',
11655 'icon' => 'arrow_right',
11656 });
11657 }
11658
11659if (&can_config_domain($d) && $d->{'subdom'}) {
11660 # Turn sub-domain into sub-server
11661 push(@rv, { 'page' => 'unsub.cgi',
11662 'title' => $text{'edit_unsub'},
11663 'desc' => $text{'edit_unsubdesc'},
11664 'cat' => 'server',
11665 'icon' => 'arrow_right',
11666 });
11667 }
11668
11669if (&can_config_domain($d) && $d->{'alias'}) {
11670 # Turn alias server into sub-server
11671 push(@rv, { 'page' => 'unalias.cgi',
11672 'title' => $text{'edit_unalias'},
11673 'desc' => $text{'edit_unaliasdesc'},
11674 'cat' => 'server',
11675 'icon' => 'arrow_right',
11676 });
11677 }
11678
11679if (&can_change_ip($d) && !$d->{'alias'}) {
11680 # Change IP / port button
11681 push(@rv, { 'page' => 'newip_form.cgi',
11682 'title' => $text{'edit_newip'},
11683 'desc' => $text{'edit_newipdesc'},
11684 'cat' => 'server',
11685 'icon' => 'connect',
11686 });
11687 }
11688
11689local $parentdom = $d->{'parent'} ? &get_domain($d->{'parent'}) : undef;
11690local $unixer = $parentdom || $d;
11691if (&can_create_sub_servers() && !$d->{'alias'} && $unixer->{'unix'}) {
11692 # Domain alias and sub-domain buttons
11693 local ($dleft, $dreason, $dmax) = &count_domains("realdoms");
11694 local ($aleft, $areason, $amax) = &count_domains("aliasdoms");
11695 if ($dleft != 0 && &can_create_sub_servers() &&
11696 !$d->{'parent'}) {
11697 # Sub-server
11698 push(@rv, { 'page' => 'domain_form.cgi',
11699 'title' => $text{'edit_subserv'},
11700 'desc' => &text('edit_subservesc', $d->{'dom'}),
11701 'hidden' => [ [ "parentuser1", $d->{'user'} ],
11702 [ "add1", 1 ] ],
11703 'cat' => 'create',
11704 });
11705 }
11706 if ($aleft != 0) {
11707 # Alias domain
11708 push(@rv, { 'page' => 'domain_form.cgi',
11709 'title' => $text{'edit_alias'},
11710 'desc' => $text{'edit_aliasdesc'},
11711 'hidden' => [ [ "to", $d->{'id'} ] ],
11712 'cat' => 'create',
11713 });
11714 }
11715 if (!$d->{'subdom'} && $dleft != 0 && $virtualmin_pro &&
11716 &can_create_sub_domains()) {
11717 # Sub-domain
11718 push(@rv, { 'page' => 'domain_form.cgi',
11719 'title' => $text{'edit_subdom'},
11720 'desc' => &text('edit_subdomdesc', $d->{'dom'}),
11721 'hidden' => [ [ "parentuser1", $d->{'user'} ],
11722 [ "add1", 1 ],
11723 [ "subdom", $d->{'id'} ] ],
11724 'cat' => 'create',
11725 });
11726 }
11727 }
11728
11729if (&domain_has_ssl($d) && $d->{'dir'} && &can_edit_ssl()) {
11730 # SSL options page button
11731 push(@rv, { 'page' => 'cert_form.cgi',
11732 'title' => $text{'edit_cert'},
11733 'desc' => $text{'edit_certdesc'},
11734 'cat' => 'server',
11735 });
11736 }
11737
11738if ($d->{'unix'} && &can_edit_limits($d) && !$d->{'alias'}) {
11739 # Domain limits button
11740 push(@rv, { 'page' => 'edit_limits.cgi',
11741 'title' => $text{'edit_limits'},
11742 'desc' => $text{'edit_limitsdesc'},
11743 'cat' => 'admin',
11744 });
11745 }
11746
11747if ($d->{'unix'} && defined(&supports_resource_limits) &&
11748 &supports_resource_limits() && &can_edit_res($d)) {
11749 # Resource limits button
11750 push(@rv, { 'page' => 'edit_res.cgi',
11751 'title' => $text{'edit_res'},
11752 'desc' => $text{'edit_resdesc'},
11753 'cat' => 'admin',
11754 });
11755 }
11756
11757if (!$d->{'parent'} && &can_edit_admins($d)) {
11758 # Extra admins buttons
11759 push(@rv, { 'page' => 'list_admins.cgi',
11760 'title' => $text{'edit_admins'},
11761 'desc' => $text{'edit_adminsdesc'},
11762 'cat' => 'admin',
11763 });
11764 }
11765
11766if (!$d->{'parent'} && $d->{'webmin'} && &can_switch_user($d)) {
11767 # Button to switch to the domain's admin
11768 push(@rv, { 'page' => 'switch_user.cgi',
11769 'title' => $text{'edit_switch'},
11770 'desc' => $text{'edit_switchdesc'},
11771 'cat' => 'admin',
11772 'target' => '_top',
11773 });
11774 }
11775
11776if (&domain_has_website($d) && !$d->{'alias'} && &can_edit_forward()) {
11777 # Proxying / frame forwward configuration button
11778 local $mode = $d->{'proxy_pass_mode'} || $config{'proxy_pass'};
11779 local $psuffix = $mode == 2 ? "frame" : "proxy";
11780 push(@rv, { 'page' => $psuffix.'_form.cgi',
11781 'title' => $text{'edit_'.$psuffix},
11782 'desc' => $text{'edit_'.$psuffix.'desc'},
11783 'cat' => 'server',
11784 });
11785 }
11786
11787if (&has_proxy_balancer($d) && &can_edit_forward()) {
11788 # Proxy balance editor
11789 push(@rv, { 'page' => 'list_balancers.cgi',
11790 'title' => $text{'edit_balancer'},
11791 'desc' => $text{'edit_balancerdesc'},
11792 'cat' => 'server',
11793 });
11794 }
11795
11796# Alias and redirects editor
11797if (&has_web_redirects($d) && &can_edit_redirect() && !$d->{'alias'}) {
11798 push(@rv, { 'page' => 'list_redirects.cgi',
11799 'title' => $text{'edit_redirects'},
11800 'desc' => $text{'edit_redirectsdesc'},
11801 'cat' => 'server',
11802 });
11803 }
11804
11805if (($d->{'spam'} && $config{'spam'} ||
11806 $d->{'virus'} && $config{'virus'}) && &can_edit_spam()) {
11807 # Spam/virus delivery button
11808 push(@rv, { 'page' => 'edit_spam.cgi',
11809 'title' => $text{'edit_spamvirus'},
11810 'desc' => $text{'edit_spamvirusdesc'},
11811 'cat' => 'server',
11812 });
11813 }
11814
11815if (&domain_has_website($d) && &can_edit_phpmode()) {
11816 # Website / PHP options button
11817 push(@rv, { 'page' => 'edit_phpmode.cgi',
11818 'title' => $text{'edit_phpmode'},
11819 'desc' => $text{'edit_phpmodedesc'},
11820 'cat' => 'server',
11821 });
11822 }
11823
11824if (&domain_has_website($d) && &can_edit_phpver() &&
11825 defined(&list_available_php_versions)) {
11826 # PHP directory versions button
11827 push(@rv, { 'page' => 'edit_phpver.cgi',
11828 'title' => $text{'edit_phpver'},
11829 'desc' => $text{'edit_phpverdesc'},
11830 'cat' => 'server',
11831 });
11832 }
11833
11834if ($d->{'dns'} && !$d->{'dns_submode'} && $config{'dns'} &&
11835 &can_edit_spf($d)) {
11836 # SPF settings button
11837 push(@rv, { 'page' => 'edit_spf.cgi',
11838 'title' => $text{'edit_spf'},
11839 'desc' => $text{'edit_spfdesc'},
11840 'cat' => 'server',
11841 });
11842 }
11843
11844if (&can_edit_records($d)) {
11845 if ($d->{'dns'}) {
11846 # DNS edit records button
11847 push(@rv, { 'page' => 'list_records.cgi',
11848 'title' => $text{'edit_records'},
11849 'desc' => $text{'edit_recordsdesc'},
11850 'cat' => 'server',
11851 });
11852 }
11853 elsif (!$d->{'subdom'}) {
11854 # DNS suggested records button
11855 push(@rv, { 'page' => 'view_records.cgi',
11856 'title' => $text{'edit_viewrecords'},
11857 'desc' => $text{'edit_viewrecordsdesc'},
11858 'cat' => 'server',
11859 });
11860 }
11861 }
11862
11863&require_mail();
11864if ($d->{'mail'} && $config{'mail'} && &can_edit_mail()) {
11865 # Email settings button
11866 push(@rv, { 'page' => 'edit_mail.cgi',
11867 'title' => $text{'edit_mailopts'},
11868 'desc' => $text{'edit_mailoptsdesc'},
11869 'cat' => 'server',
11870 });
11871 }
11872
11873if ($d->{'mail'} && !$d->{'alias'} && $config{'dkim_enabled'}) {
11874 # Per-domain DKIM page
11875 push(@rv, { 'page' => 'edit_domdkim.cgi',
11876 'title' => $text{'edit_domdkim'},
11877 'desc' => $text{'edit_domdkimdesc'},
11878 'cat' => 'server',
11879 });
11880 }
11881
11882# Button to show bandwidth graph
11883if ($config{'bw_active'} && &can_monitor_bandwidth($d)) {
11884 push(@rv, { 'page' => 'bwgraph.cgi',
11885 'title' => $text{'edit_bwgraph'},
11886 'desc' => $text{'edit_bwgraphdesc'},
11887 'cat' => 'logs',
11888 });
11889 }
11890
11891# Button to show disk usage
11892if ($d->{'dir'} && !$d->{'parent'}) {
11893 push(@rv, { 'page' => 'usage.cgi',
11894 'title' => $text{'edit_usage'},
11895 'desc' => $text{'edit_usagehdesc'},
11896 'cat' => 'admin',
11897 });
11898 }
11899
11900# Button to re-send signup email
11901if (!$d->{'alias'} && &can_config_domain($d)) {
11902 push(@rv, { 'page' => 'reemail.cgi',
11903 'title' => $text{'edit_reemail'},
11904 'desc' => &text('edit_reemaildesc',
11905 "<tt>$d->{'emailto_addr'}</tt>"),
11906 'cat' => 'admin',
11907 });
11908 }
11909
11910# Button to show mail logs
11911if ($virtualmin_pro && $config{'mail'} && $config{'mail_system'} <= 1 &&
11912 &can_view_maillog($d) && $d->{'mail'}) {
11913 push(@rv, { 'page' => 'maillog.cgi',
11914 'title' => $text{'edit_maillog'},
11915 'desc' => $text{'edit_maillogdesc'},
11916 'cat' => 'logs',
11917 });
11918 }
11919
11920# Button to validate connectivity
11921if ($virtualmin_pro) {
11922 push(@rv, { 'page' => 'connectivity.cgi',
11923 'title' => $text{'edit_connect'},
11924 'desc' => $text{'edit_connectdesc'},
11925 'cat' => 'logs',
11926 });
11927 }
11928
11929# Link to edit excluded directories
11930if (!$d->{'alias'} && &can_edit_exclude()) {
11931 push(@rv, { 'page' => 'edit_exclude.cgi',
11932 'title' => $text{'edit_exclude'},
11933 'desc' => $text{'edit_excludedesc'},
11934 'cat' => 'admin',
11935 });
11936 }
11937
11938if (&can_disable_domain($d)) {
11939 # Enabled or disable buttons
11940 if ($d->{'disabled'}) {
11941 push(@rv, { 'page' => 'enable_domain.cgi',
11942 'title' => $text{'edit_enable'},
11943 'desc' => $text{'edit_enabledesc'},
11944 'cat' => 'delete',
11945 });
11946 }
11947 else {
11948 push(@rv, { 'page' => 'disable_domain.cgi',
11949 'title' => $text{'edit_disable'},
11950 'desc' => $text{'edit_disabledesc'},
11951 'cat' => 'delete',
11952 });
11953 }
11954 }
11955
11956if (&can_delete_domain($d)) {
11957 # Delete domain button
11958 push(@rv, { 'page' => 'delete_domain.cgi',
11959 'title' => $text{'edit_delete'},
11960 'desc' => $text{'edit_deletedesc'},
11961 'cat' => 'delete',
11962 });
11963 }
11964
11965if (&can_associate_domain($d)) {
11966 # Feature associate / disassociate button
11967 push(@rv, { 'page' => 'assoc_form.cgi',
11968 'title' => $text{'edit_assoc'},
11969 'desc' => $text{'edit_assocdesc'},
11970 'cat' => 'delete',
11971 });
11972 }
11973
11974if (&can_passwd()) {
11975 # Change password button
11976 push(@rv, { 'page' => 'edit_pass.cgi',
11977 'title' => $text{'edit_changepass'},
11978 'desc' => $text{'edit_changepassdesc'},
11979 'cat' => 'server',
11980 });
11981 }
11982
11983&save_links_cache($ckey, $v, \@rv);
11984return @rv;
11985}
11986
11987# get_all_domain_links(&domain)
11988# Returns a list of all links for a domain, including actions, feature links
11989# and custom links. Each has the following keys :
11990# url - URL to link to
11991# title - Short name for link
11992# desc - Longer name for link (optional)
11993# cat - Category code
11994# catname - Category human-readable name
11995# target - Frame to open in (right or _new), defaults to right
11996# icon - Unique code for this link
11997sub get_all_domain_links
11998{
11999local ($d) = @_;
12000local @rv;
12001
12002# Always start with edit/view link
12003my $canconfig = &can_config_domain($d);
12004local $vm = "$gconfig{'webprefix'}/$module_name";
12005push(@rv, { 'url' => $canconfig ? "$vm/edit_domain.cgi?dom=$d->{'id'}"
12006 : "$vm/view_domain.cgi?dom=$d->{'id'}",
12007 'title' => $canconfig ? $text{'edit_title'} : $text{'view_title'},
12008 'cat' => 'objects',
12009 'icon' => $canconfig ? 'edit' : 'view' });
12010
12011# Add link to list sub-servers
12012if (!$d->{'parent'}) {
12013 push(@rv, { 'url' => $vm.'/search.cgi?field=parent&what='.
12014 &urlize($d->{'dom'}),
12015 'title' => $text{'edit_psearch'},
12016 'cat' => 'admin',
12017 'catname' => $text{'cat_admin'} });
12018 }
12019
12020# Add actions and links
12021foreach my $l (&get_domain_actions($d), &feature_links($d)) {
12022 if ($l->{'mod'}) {
12023 $l->{'url'} = "$gconfig{'webprefix'}/$l->{'mod'}/$l->{'page'}";
12024 }
12025 else {
12026 $l->{'url'} = "$vm/$l->{'page'}".
12027 "?dom=".$d->{'id'}."&".
12028 join("&", map { $_->[0]."=".&urlize($_->[1]) }
12029 @{$l->{'hidden'}});
12030 }
12031 $l->{'catname'} ||= $text{'cat_'.$l->{'cat'}};
12032 push(@rv, $l);
12033 }
12034my %catmap = map { $_->{'catname'}, $_->{'cat'} } @rv;
12035
12036# Add preview website link, proxied via Webmin
12037if (&domain_has_website($d) && &can_use_preview()) {
12038 local $pt = $d->{'web_port'} == 80 ? "" : ":$d->{'web_port'}";
12039 push(@rv, { 'url' => "$gconfig{'webprefix'}/$module_name/".
12040 "link.cgi/$d->{'ip'}/http://www.$d->{'dom'}$pt/",
12041 'title' => $text{'links_website'},
12042 'cat' => 'services',
12043 'catname' => $text{'cat_services'},
12044 'target' => '_new',
12045 });
12046 }
12047
12048# Add custom links
12049if (defined(&list_visible_custom_links)) {
12050 foreach my $l (&list_visible_custom_links($d)) {
12051 $l->{'title'} = $l->{'desc'};
12052 delete($l->{'desc'});
12053 $l->{'target'} = $l->{'open'} ? "_new" : "right";
12054 delete($l->{'open'});
12055 if (!$l->{'icon'}) {
12056 # Make a unique ID
12057 $l->{'icon'} = lc($l->{'title'});
12058 $l->{'icon'} =~ s/\s/_/g;
12059 }
12060 push(@rv, $l);
12061 # Pick a category code, based on a match by name with an
12062 # existing category or a lower-cased version of the category
12063 if ($l->{'catname'}) {
12064 $l->{'cat'} = $catmap{$l->{'catname'}} ||
12065 lc($l->{'catname'});
12066 $l->{'cat'} =~ s/\s/_/g;
12067 }
12068 else {
12069 $l->{'cat'} = 'objects';
12070 $l->{'catname'} = $text{'cat_objects'};
12071 }
12072 $l->{'nosort'} = 1;
12073 }
12074 }
12075
12076return @rv;
12077}
12078
12079# domain_footer_link(&domain)
12080# Returns a link and text suitable for the footer function
12081sub domain_footer_link
12082{
12083local $base = "$gconfig{'webprefix'}/$module_name";
12084return &can_config_domain($_[0]) ?
12085 ( "$base/edit_domain.cgi?dom=$_[0]->{'id'}", $text{'edit_return'} ) :
12086 ( "$base/view_domain.cgi?dom=$_[0]->{'id'}", $text{'view_return'} );
12087}
12088
12089# domain_redirect(&domain, [refresh-menu])
12090# Calls redirect to edit_domain.cgi or view_domain.cgi
12091sub domain_redirect
12092{
12093local ($d, $refresh) = @_;
12094&redirect("$gconfig{'webprefix'}/$module_name/postsave.cgi?".
12095 "dom=$d->{'id'}&refresh=$refresh");
12096}
12097
12098# get_template_pages()
12099# Returns five array references, for template/reseller/etc links, titles,
12100# categories and codes
12101sub get_template_pages
12102{
12103local @tmpls = ( 'features', 'tmpl', 'plan', 'user', 'update',
12104 $config{'localgroup'} ? ( 'local' ) : ( ),
12105 'bw',
12106 $virtualmin_pro ? ( 'fields', 'links', 'ips', 'sharedips', 'dynip', 'resels',
12107 'reseller', 'notify', 'scripts', 'styles' )
12108 : ( 'fields', 'ips', 'sharedips', 'scripts', 'dynip' ),
12109 'shells',
12110 $config{'spam'} || $config{'virus'} ? ( 'sv' ) : ( ),
12111 &has_home_quotas() && $virtualmin_pro ? ( 'quotas' ) : ( ),
12112 &has_home_quotas() && !&has_quota_commands() && &has_quotacheck() ?
12113 ( 'quotacheck' ) : ( ),
12114 $virtualmin_pro ? ( 'mxs' ) : ( ),
12115 'validate', 'chroot', 'global', 'changelog',
12116 $virtualmin_pro ? ( ) : ( 'upgrade' ),
12117 $config{'mail_system'} == 0 ? ( 'postgrey' ) : ( ),
12118 'dkim', 'ratelimit', 'provision',
12119 $config{'mail'} ? ( 'autoconfig' ) : ( ),
12120 $config{'mail'} && $virtualmin_pro ? ( 'retention' ) : ( ),
12121 );
12122local %tmplcat = (
12123 'features' => 'setting',
12124 'user' => 'email',
12125 'update' => 'email',
12126 'local' => 'email',
12127 'reseller' => 'email',
12128 'notify' => 'email',
12129 'sv' => 'email',
12130 'ips' => 'ip',
12131 'sharedips' => 'ip',
12132 'dynip' => 'ip',
12133 'mxs' => 'ip',
12134 'quotas' => 'check',
12135 'validate' => 'check',
12136 'quotacheck' => 'check',
12137 'tmpl' => 'setting',
12138 'plan' => 'setting',
12139 'bw' => 'setting',
12140 'plugin' => 'setting',
12141 'scripts' => 'setting',
12142 'upgrade' => 'setting',
12143 'resels' => 'setting',
12144 'fields' => 'custom',
12145 'links' => 'custom',
12146 'styles' => 'custom',
12147 'shells' => 'custom',
12148 'chroot' => 'check',
12149 'global' => 'custom',
12150 'postgrey' => 'email',
12151 'dkim' => 'email',
12152 'ratelimit' => 'email',
12153 'changelog' => 'setting',
12154 'provision' => 'setting',
12155 'autoconfig' => 'email',
12156 'retention' => 'email',
12157 );
12158local %nonew = ( 'history', 1,
12159 'postgrey', 1,
12160 'dkim', 1,
12161 'ratelimit', 1,
12162 'provision', 1,
12163 );
12164local @tlinks = map { $nonew{$_} ? "${_}.cgi"
12165 : "edit_new${_}.cgi" } @tmpls;
12166local @ttitles = map { $nonew{$_} ? $text{"${_}_title"}
12167 : $text{"new${_}_title"} } @tmpls;
12168local @ticons = map { $nonew{$_} ? "images/${_}.gif"
12169 : "images/new${_}.gif" } @tmpls;
12170local @tcats = map { $tmplcat{$_} } @tmpls;
12171
12172# Get from plugins too
12173foreach my $p (@plugins) {
12174 if (&plugin_defined($p, "settings_links")) {
12175 foreach my $sl (&plugin_call($p, "settings_links")) {
12176 push(@tlinks, $sl->{'link'});
12177 push(@ttitles, $sl->{'title'});
12178 push(@ticons, $sl->{'icon'});
12179 push(@tcats, $sl->{'cat'});
12180 }
12181 }
12182 }
12183
12184return (\@tlinks, \@ttitles, \@ticons, \@tcats, \@tmpls);
12185}
12186
12187# get_all_global_links()
12188# Returns a list of links for global actions, including those from 'templates'
12189# create/migrate, backup/restore and module config. Each element has the same
12190# keys as get_all_domain_links
12191sub get_all_global_links
12192{
12193my @rv;
12194my $vm = "$gconfig{'webprefix'}/$module_name";
12195
12196local $v = [ 'plugins' => \@plugins,
12197 'spam' => $config{'spam'},
12198 'virus' => $config{'virus'},
12199 'quotas' => &has_home_quotas(),
12200 'mail_system' => $config{'mail_system'},
12201 'pro' => $virtualmin_pro ];
12202
12203# Add template pages
12204if (&can_edit_templates()) {
12205 local $crv = &get_links_cache("global", $v);
12206 if ($crv) {
12207 # Use cache
12208 @rv = @$crv;
12209 }
12210 else {
12211 # Need to create
12212 my ($tlinks, $ttitles, undef, $tcats, $tcodes) =
12213 &get_template_pages();
12214 $tcats = [ map { "setting" } @$tlinks ] if (!$tcats);
12215 for(my $i=0; $i<@$tlinks; $i++) {
12216 local $url;
12217 if ($tcodes->[$i] eq 'upgrade' &&
12218 $config{'upgrade_link'}) {
12219 # Special link for upgrading GPL to Pro
12220 $url = $config{'upgrade_link'};
12221 }
12222 elsif ($tlinks->[$i] =~ /\//) {
12223 # Outside virtualmin module
12224 $url = $gconfig{'webprefix'}.$tlinks->[$i];
12225 }
12226 else {
12227 # Inside virtualmin
12228 $url = $vm."/".$tlinks->[$i];
12229 }
12230 push(@rv, { 'url' => $url,
12231 'title' => $ttitles->[$i],
12232 'cat' => $tcats->[$i],
12233 'icon' => $tcodes->[$i],
12234 });
12235 }
12236 &save_links_cache("global", $v, \@rv);
12237 }
12238 }
12239
12240# Add module config page
12241if (!$access{'noconfig'}) {
12242 push(@rv, { 'url' => "$gconfig{'webprefix'}/config.cgi?$module_name",
12243 'title' => $text{'index_virtualminconfig'},
12244 'cat' => 'setting',
12245 'icon' => 'config' });
12246 }
12247
12248# Add re-check config page
12249if (&can_edit_templates()) {
12250 push(@rv, { 'url' => "$vm/check.cgi",
12251 'title' => $text{'index_srefresh2'},
12252 'cat' => 'setting',
12253 'icon' => 'recheck' });
12254 }
12255
12256# Add wizard page
12257if ($config{'wizard_run'} && &can_edit_templates()) {
12258 push(@rv, { 'url' => "$vm/wizard.cgi",
12259 'title' => $text{'index_rewizard'},
12260 'cat' => 'setting',
12261 'icon' => 'wizard' });
12262 }
12263
12264# Add creation-related links
12265my ($dleft, $dreason, $dmax, $dhide) = &count_domains("realdoms");
12266my ($aleft, $areason, $amax, $ahide) = &count_domains("aliasdoms");
12267my $nobatch = !&can_create_batch();
12268if ((&can_create_sub_servers() || &can_create_master_servers()) &&
12269 $dleft && $virtualmin_pro && !$nobatch) {
12270 # Batch create
12271 push(@rv, { 'url' => "$vm/mass_create_form.cgi",
12272 'title' => $text{'index_batch'},
12273 'cat' => 'add',
12274 'icon' => 'batch' });
12275 }
12276if (&can_import_servers()) {
12277 # Import domain
12278 push(@rv, { 'url' => "$vm/import_form.cgi",
12279 'title' => $text{'index_import'},
12280 'cat' => 'add',
12281 'icon' => 'import' });
12282 }
12283if (&can_migrate_servers()) {
12284 # Migrate domain
12285 push(@rv, { 'url' => "$vm/migrate_form.cgi",
12286 'title' => $text{'index_migrate'},
12287 'cat' => 'add',
12288 'icon' => 'migrate' });
12289 }
12290
12291# Add backup/restore links
12292my ($blinks, $btitles, undef, $bcodes) = &get_backup_actions();
12293for(my $i=0; $i<@$blinks; $i++) {
12294 push(@rv, { 'url' => $vm."/".$blinks->[$i],
12295 'title' => $btitles->[$i],
12296 'cat' => 'backup',
12297 'icon' => $bcodes->[$i] });
12298 }
12299
12300# Top-level links
12301push(@rv, { 'url' => $vm.'/index.cgi',
12302 'title' => $text{'index_link'},
12303 'icon' => 'index' });
12304if (&reseller_admin()) {
12305 # Change password for resellers
12306 push(@rv, { 'url' => $vm."/edit_pass.cgi",
12307 'title' => $text{'edit_changeresellerpass'},
12308 'icon' => 'pass' });
12309 }
12310elsif (&extra_admin()) {
12311 # Change password for admin
12312 push(@rv, { 'url' => $vm."/edit_pass.cgi",
12313 'title' => $text{'edit_changeadminpass'},
12314 'icon' => 'pass' });
12315 }
12316if (&reseller_admin() && $config{'bw_active'}) {
12317 # Bandwidth for resellers
12318 push(@rv, { 'url' => $vm."/bwgraph.cgi",
12319 'title' => $text{'edit_bwgraph'},
12320 'icon' => 'bw' });
12321 }
12322if (&reseller_admin() && &can_edit_plans()) {
12323 # Add plans for resellers
12324 push(@rv, { 'url' => $vm."/edit_newplan.cgi",
12325 'title' => $text{'plans_title'},
12326 'icon' => 'newplan' });
12327 }
12328if (&reseller_admin() && &can_edit_resellers()) {
12329 # Reseller who can edit other resellers
12330 push(@rv, { 'url' => $vm."/edit_newresels.cgi",
12331 'title' => $text{'newresels_title'},
12332 'icon' => 'webmin-small' });
12333 }
12334if (&can_show_history()) {
12335 # History graphs
12336 push(@rv, { 'url' => $vm."/history.cgi",
12337 'title' => $text{'edit_history'},
12338 'icon' => 'graph' });
12339 }
12340if (&can_change_language()) {
12341 # Change language
12342 push(@rv, { 'url' => $vm."/edit_lang.cgi",
12343 'title' => $text{'edit_lang'},
12344 'icon' => 'lang' });
12345 }
12346
12347# Set category names
12348foreach my $l (@rv) {
12349 if ($l->{'cat'}) {
12350 $l->{'catname'} ||= $text{'cat_'.$l->{'cat'}};
12351 }
12352 }
12353
12354return @rv;
12355}
12356
12357# get_links_cache(key, &cache-invalidator)
12358# Checks the cache for some key, and if it exists make sure the stored cache
12359# validator matches what is given. If so, return the cache contents. If not,
12360# return undef.
12361sub get_links_cache
12362{
12363local ($cachekey, $validator) = @_;
12364local $cachedata = &read_file_contents("$links_cache_dir/$cachekey");
12365return undef if (!$cachedata);
12366local $cachestr = &unserialise_variable($cachedata);
12367return undef if (!$cachestr);
12368return undef if (&serialise_variable($cachestr->{'validator'}) ne
12369 &serialise_variable($validator));
12370return $cachestr->{'data'};
12371}
12372
12373# save_links_cache(key, &cache-invalidator, &object)
12374# Save some cached key based on a key, with an additional validator that can
12375# be used to check suitability by get_links_cache.
12376sub save_links_cache
12377{
12378local ($cachekey, $validator, $data) = @_;
12379if (!-d $links_cache_dir) {
12380 &make_dir($links_cache_dir, 0700);
12381 }
12382&open_tempfile(CACHEDATA, ">$links_cache_dir/$cachekey", 0, 1);
12383&print_tempfile(CACHEDATA, &serialise_variable(
12384 { 'validator' => $validator,
12385 'data' => $data }));
12386&close_tempfile(CACHEDATA);
12387}
12388
12389# clear_links_cache([&domain])
12390# Delete all cached information for some or all domains
12391sub clear_links_cache
12392{
12393local ($d) = @_;
12394opendir(CACHEDIR, $links_cache_dir);
12395foreach my $f (readdir(CACHEDIR)) {
12396 if ($d && $f =~ /^\Q$d->{'id'}\E\-/ || !$d) {
12397 &unlink_file("$links_cache_dir/$f");
12398 }
12399 }
12400closedir(CACHEDIR);
12401}
12402
12403# get_startstop_links([live])
12404# Returns a list of status objects for relevant features and plugins
12405sub get_startstop_links
12406{
12407local ($live) = @_;
12408local @rv;
12409local %typestatus;
12410foreach my $f (@startstop_features) {
12411 if ($config{$f}) {
12412 local $sfunc = "startstop_".$f;
12413 if (defined(&$sfunc)) {
12414 foreach my $status (&$sfunc(\%typestatus)) {
12415 $status->{'feature'} ||= $f;
12416 push(@rv, $status);
12417 }
12418 }
12419 }
12420 }
12421foreach my $f (&list_startstop_plugins()) {
12422 local $status = &plugin_call($f, "feature_startstop");
12423 $status->{'feature'} ||= $f;
12424 $status->{'plugin'} = 1;
12425 push(@rv, $status);
12426 }
12427return @rv;
12428}
12429
12430# can_domain_have_users(&domain)
12431# Returns 1 if the given domain can have mail/FTP/DB users
12432sub can_domain_have_users
12433{
12434local ($d) = @_;
12435return 0 if ($d->{'alias'} && !$d->{'aliasmail'} ||
12436 $d->{'subdom'}); # never allowed for aliases
12437if (!$d->{'mail'}) {
12438 # Qmail+LDAP and VPOPMail require mail to be enabled
12439 return 0 if ($config{'mail_system'}==4 || $config{'mail_system'}==5);
12440 }
12441if (!$d->{'dir'}) {
12442 # Only VPOPMail allows mail without a dir
12443 return 0 if ($config{'mail_system'} != 5);
12444 }
12445return 1;
12446}
12447
12448# Returns 1 if some domain can have scripts installed
12449sub can_domain_have_scripts
12450{
12451local ($d) = @_;
12452return ($d->{'web'} && $config{'web'} ||
12453 &domain_has_website($d)) && !$d->{'subdom'} && !$d->{'alias'};
12454}
12455
12456# call_feature_func(feature, &domain, &olddomain)
12457# Calls the appropriate function to enable or disable a feature for a domain
12458sub call_feature_func
12459{
12460local ($f, $d, $oldd) = @_;
12461if (&indexof($f, @features) >= 0 && $config{$f}) {
12462 # A core feature
12463 local $sfunc = "setup_$f";
12464 local $dfunc = "delete_$f";
12465 local $mfunc = "modify_$f";
12466 if ($d->{$f} && !$oldd->{$f}) {
12467 # Setup some feature
12468 if (!&try_function($f, $sfunc, $d)) {
12469 $d->{$f} = 0;
12470 }
12471 }
12472 elsif (!$d->{$f} && $oldd->{$f}) {
12473 # Delete some feature
12474 if (!&try_function($f, $dfunc, $oldd)) {
12475 $d->{$f} = 1;
12476 }
12477 }
12478 elsif ($d->{$f}) {
12479 # Modify some feature
12480 &try_function($f, $mfunc, $d, $oldd);
12481 }
12482 }
12483elsif (&indexof($f, &list_feature_plugins()) >= 0) {
12484 # A plugin feature
12485 if ($d->{$f} && !$oldd->{$f}) {
12486 &try_plugin_call($f, "feature_setup", $d);
12487 }
12488 elsif (!$d->{$f} && $oldd->{$f}) {
12489 &try_plugin_call($f, "feature_delete", $oldd);
12490 }
12491 elsif ($d->{$f}) {
12492 &try_plugin_call($f, "feature_modify", $d, $oldd);
12493 }
12494 }
12495}
12496
12497# domain_features(&dom)
12498# Returns a list of possible core features for a domain
12499sub domain_features
12500{
12501local ($d) = @_;
12502return $d->{'alias'} && $d->{'aliasmail'} ? @aliasmail_features :
12503 $d->{'alias'} ? @alias_features :
12504 $d->{'subdom'} ? @opt_subdom_features :
12505 $d->{'parent'} ? ( grep { $_ ne "webmin" && $_ ne "unix" } @features ) :
12506 @features;
12507}
12508
12509# list_mx_servers()
12510# Returns the objects for servers used as secondary MXs
12511sub list_mx_servers
12512{
12513if (&foreign_check("servers")) {
12514 &foreign_require("servers");
12515 local %servers = map { $_->{'id'}, $_ } &servers::list_servers();
12516 local @rv;
12517 foreach my $idname (split(/\s+/, $config{'mx_servers'})) {
12518 my ($id, $name) = split(/=/, $idname);
12519 local $s = $servers{$id};
12520 if ($s) {
12521 $s->{'mxname'} = $name;
12522 push(@rv, $s);
12523 }
12524 }
12525 return @rv;
12526 }
12527return ();
12528}
12529
12530# save_mx_servers(&servers)
12531# Update the list of servers to create secondary MXs on
12532sub save_mx_servers
12533{
12534local ($servers) = @_;
12535$config{'mx_servers'} =
12536 join(" ", map { $_->{'mxname'} ? $_->{'id'}."=".$_->{'mxname'}
12537 : $_->{'id'} } @$servers);
12538&save_module_config();
12539}
12540
12541# change_home_directory(&domain, newhome)
12542# Updates the home directory and anything that refers to it in a domain object
12543sub change_home_directory
12544{
12545local ($d, $newhome) = @_;
12546local $oldhome = $d->{'home'};
12547$d->{'home'} = $newhome;
12548foreach my $k (keys %$d) {
12549 if ($k ne "home") {
12550 $d->{$k} =~ s/$oldhome/$newhome/g;
12551 }
12552 }
12553}
12554
12555# move_virtual_server(&domain, &parent)
12556# Moves some virtual server so that it is now owned by the new parent domain
12557sub move_virtual_server
12558{
12559local ($d, $parent) = @_;
12560local $oldd = { %$d };
12561local $oldparent;
12562if ($d->{'parent'}) {
12563 $oldparent = &get_domain($d->{'parent'});
12564 }
12565
12566# Update the domain object with new home directory and parent details
12567local (@doms, @olddoms, @remove_feats);
12568&set_parent_attributes($d, $parent);
12569&change_home_directory($d, &server_home_directory($d, $parent));
12570if ($d->{'alias'}) {
12571 # Set new alias target to new parent
12572 $d->{'alias'} = $parent->{'id'};
12573
12574 # Clear any alias features that the new domain doesn't have
12575 foreach my $f (@alias_features) {
12576 if ($d->{$f} && !$parent->{$f}) {
12577 $d->{$f} = 0;
12578 push(@remove_feats, $f);
12579 }
12580 }
12581 }
12582push(@doms, $d);
12583push(@olddoms, $oldd);
12584
12585if (!$oldd->{'parent'}) {
12586 # If this is a parent domain, all of it's children need to be
12587 # re-parented too. This will also catch any aliases and sub-domains.
12588 # These have to be moved BEFORE their old parent, so that move of the
12589 # parent doesn't cause the home directory to disappear.
12590 local @subs = &get_domain_by("parent", $d->{'id'});
12591 foreach my $sd (@subs) {
12592 local $oldsd = { %$sd };
12593 &set_parent_attributes($sd, $parent);
12594 &change_home_directory($sd,
12595 &server_home_directory($sd, $parent));
12596 unshift(@doms, $sd);
12597 unshift(@olddoms, $oldsd);
12598 }
12599
12600 # The template may no longer be valid if it was for a top-level server
12601 local $tmpl = &get_template($d->{'template'});
12602 if (!$tmpl->{'for_sub'}) {
12603 $d->{'template'} = &get_init_template(1);
12604 }
12605 }
12606else {
12607 # Find any alias domains that also need to be re-parented. Also find
12608 # any sub-domains
12609 local @aliases = &get_domain_by("alias", $d->{'id'});
12610 local @subdoms = &get_domain_by("subdoms", $d->{'id'});
12611 foreach my $ad (@aliases, @subdoms) {
12612 local $oldad = { %$ad };
12613 &set_parent_attributes($ad, $parent);
12614 &change_home_directory($ad,
12615 &server_home_directory($ad, $parent));
12616 push(@doms, $ad);
12617 push(@olddoms, $oldad);
12618 }
12619 }
12620
12621# Run the before command
12622&set_domain_envs($oldd, "MODIFY_DOMAIN", $d);
12623local $merr = &making_changes();
12624&reset_domain_envs($oldd);
12625&error(&text('rename_emaking', "<tt>$merr</tt>")) if (defined($merr));
12626&setup_for_subdomain($parent);
12627
12628# If this is an alias domain, first delete features that don't exist in
12629# the target
12630foreach my $f (@remove_feats) {
12631 my $dfunc = "delete_".$f;
12632 local $main::error_must_die = 1;
12633 eval {
12634 &$dfunc($oldd);
12635 };
12636 if ($@) {
12637 &$second_print(&text('setup_failure',
12638 $text{'feature_'.$f}, "$@"));
12639 }
12640 }
12641
12642# Setup print function to include domain name
12643sub first_html_withdom_move
12644{
12645&$old_first_print(&text('rename_dd', $doing_dom->{'dom'})," : ",@_);
12646}
12647local $old_first_print;
12648local $doing_dom;
12649if (@doms > 1) {
12650 $old_first_print = $first_print;
12651 $first_print = \&first_html_withdom_move;
12652 }
12653
12654# Update all features in all domains
12655local %vital = map { $_, 1 } @vital_features;
12656foreach my $f (@features) {
12657 local $mfunc = "modify_$f";
12658 for(my $i=0; $i<@doms; $i++) {
12659 if (($doms[$i]->{$f} || ($f eq 'mail' && !$d->{'alias'})) &&
12660 ($config{$f} || $f eq "unix" || $f eq "mail")) {
12661 $doing_dom = $doms[$i];
12662 local $main::error_must_die = 1;
12663 eval {
12664 if ($doms[$i]->{'alias'}) {
12665 # Is an alias domain, so pass in old
12666 # and new target domain objects
12667 local $aliasdom = &get_domain(
12668 $doms[$i]->{'alias'});
12669 local $idx = &indexof($aliasdom, @doms);
12670 if ($idx >= 0) {
12671 &$mfunc(
12672 $doms[$i], $olddoms[$i],
12673 $doms[$idx], $olddoms[$idx]);
12674 }
12675 else {
12676 &$mfunc(
12677 $doms[$i], $olddoms[$i],
12678 $aliasdom, $aliasdom);
12679 }
12680 }
12681 else {
12682 # Not an alias domain
12683 &$mfunc($doms[$i], $olddoms[$i]);
12684 }
12685
12686 if (($f eq "unix" || $f eq "webmin") &&
12687 $doms[$i]->{'parent'}) {
12688 # Disable feature, since the user
12689 # will no longer exist
12690 $doms[$i]->{$f} = 0;
12691 }
12692 };
12693 if ($@) {
12694 &$second_print(&text('setup_failure',
12695 $text{'feature_'.$f}, "$@"));
12696 if ($vital{$f}) {
12697 # A vital feature failed .. give up
12698 return 0;
12699 }
12700 }
12701 }
12702 }
12703 }
12704
12705# Do move for plugins, with error handling
12706foreach my $f (&list_feature_plugins()) {
12707 for(my $i=0; $i<@doms; $i++) {
12708 if ($doms[$i]->{$f}) {
12709 $doing_dom = $doms[$i];
12710 local $main::error_must_die = 1;
12711 eval { &plugin_call($f, "feature_modify",
12712 $doms[$i], $olddoms[$i]) };
12713 if ($@) {
12714 local $err = $@;
12715 &$second_print(&text('setup_failure',
12716 &plugin_call($f, "feature_name"),$err));
12717 }
12718 }
12719 }
12720 }
12721
12722$first_print = $old_first_print if ($old_first_print);
12723
12724# Fix script installer paths in all domains
12725if (defined(&list_domain_scripts) && !$d->{'alias'}) {
12726 &$first_print($text{'rename_scripts'});
12727 for(my $i=0; $i<@doms; $i++) {
12728 local ($olddir, $newdir) =
12729 ($olddoms[$i]->{'home'}, $doms[$i]->{'home'});
12730 foreach $sinfo (&list_domain_scripts($doms[$i])) {
12731 $changed = 0;
12732 if ($olddir ne $newdir) {
12733 # Fix directory
12734 $changed++
12735 if ($sinfo->{'opts'}->{'dir'} =~
12736 s/^\Q$olddir\E\//$newdir\//);
12737 }
12738 &save_domain_script($doms[$i], $sinfo) if ($changed);
12739 }
12740 }
12741 &$second_print($text{'setup_done'});
12742 }
12743
12744# Fix backup schedule and key owners
12745if (!$oldd->{'parent'}) {
12746 &rename_backup_owner($d, $oldd);
12747 }
12748
12749# Clear email field, to force inheritance from new parent
12750for(my $i=0; $i<@doms; $i++) {
12751 delete($doms[$i]->{'email'});
12752 }
12753
12754# Save the domain objects
12755&$first_print($text{'save_domain'});
12756for(my $i=0; $i<@doms; $i++) {
12757 &save_domain($doms[$i]);
12758 }
12759&$second_print($text{'setup_done'});
12760
12761# Update old and new Webmin users
12762&modify_webmin($parent, $parent);
12763if ($oldparent) {
12764 &modify_webmin($oldparent, $oldparent);
12765 }
12766
12767# Re-apply the parent's resource limits, if any
12768if (defined(&supports_resource_limits) && &supports_resource_limits()) {
12769 local $rv = &get_domain_resource_limits($parent);
12770 &save_domain_resource_limits($parent, $rv);
12771 }
12772
12773# If the domain was an alias, re-copy any mail aliases
12774if ($d->{'alias'} && $d->{'mail'} && $parent->{'mail'}) {
12775 &sync_alias_virtuals($parent);
12776 }
12777
12778&run_post_actions();
12779
12780# Run the after command
12781&set_domain_envs($d, "MODIFY_DOMAIN", undef, $oldd);
12782local $merr = &made_changes();
12783&$second_print(&text('setup_emade', "<tt>$merr</tt>")) if (defined($merr));
12784&reset_domain_envs($d);
12785
12786return 1;
12787}
12788
12789# reparent_virtual_server(&domain, newuser, newpass)
12790# Converts an existing sub-server into a new parent server
12791sub reparent_virtual_server
12792{
12793local ($d, $newuser, $newpass) = @_;
12794local $oldd = { %$d };
12795local $oldparent = &get_domain($d->{'parent'});
12796
12797# Run the before command
12798&set_domain_envs($oldd, "MODIFY_DOMAIN");
12799local $merr = &making_changes();
12800&reset_domain_envs($oldd);
12801&error(&text('rename_emaking', "<tt>$merr</tt>")) if (defined($merr));
12802
12803# Update the domain object with a new top-level home directory and it's
12804# own user and group
12805local (@doms, @olddoms);
12806$d->{'parent'} = undef;
12807$d->{'user'} = $newuser;
12808$d->{'group'} = $newuser;
12809$d->{'pass'} = $newpass;
12810&generate_domain_password_hashes($d, 1);
12811if (!$d->{'mysql'}) {
12812 delete($d->{'mysql_user'});
12813 }
12814if (!$d->{'postgres'}) {
12815 delete($d->{'postgres_user'});
12816 }
12817local (%gtaken, %taken);
12818&build_group_taken(\%gtaken);
12819&build_taken(\%taken);
12820$d->{'uid'} = &allocate_uid(\%taken);
12821$d->{'gid'} = &allocate_gid(\%gtaken);
12822$d->{'ugid'} = $d->{'gid'};
12823&change_home_directory($d, &server_home_directory($d));
12824push(@doms, $d);
12825push(@olddoms, $oldd);
12826
12827# The template may no longer be valid if it was for a sub-server
12828local $tmpl = &get_template($d->{'template'});
12829local $skelchanged;
12830if (!$tmpl->{'for_parent'}) {
12831 local $deftmpl = &get_init_template(0);
12832 if ($d->{'template'} ne $deftmpl) {
12833 $d->{'template'} = $deftmpl;
12834 local $newtmpl = &get_template($d->{'template'});
12835 if ($newtmpl->{'skel'} ne $tmpl->{'skel'}) {
12836 $skelchanged = $newtmpl->{'skel'};
12837 }
12838 }
12839 }
12840
12841# Copy all quotas and limits from the old parent
12842$d->{'quota'} = $oldparent->{'quota'};
12843$d->{'uquota'} = $oldparent->{'uquota'};
12844$d->{'bwlimit'} = $oldparent->{'bwlimit'};
12845foreach my $l (@limit_types) {
12846 $d->{$l} = $oldparent->{$l};
12847 }
12848$d->{'nodbname'} = $oldparent->{'nodbname'};
12849$d->{'norename'} = $oldparent->{'norename'};
12850$d->{'forceunder'} = $oldparent->{'forceunder'};
12851foreach my $ed (@edit_limits) {
12852 $d->{'edit_'.$ed} = $oldparent->{'edit_'.$ed};
12853 }
12854foreach my $f (@opt_features, "virt", &list_feature_plugins()) {
12855 $d->{'limit_'.$f} = $oldparent->{'limit_'.$f};
12856 }
12857$d->{'demo'} = $oldparent->{'demo'};
12858$d->{'webmin_modules'} = $oldparent->{'webmin_modules'};
12859$d->{'plan'} = $oldparent->{'plan'};
12860
12861# Find any alias domains that also need to be re-parented. Also find
12862# any sub-domains
12863local @aliases = &get_domain_by("alias", $d->{'id'});
12864local @subdoms = &get_domain_by("subdom", $d->{'id'});
12865foreach my $ad (@aliases, @subdoms) {
12866 local $oldad = { %$ad };
12867 &set_parent_attributes($ad, $d);
12868 &change_home_directory($ad,
12869 &server_home_directory($ad, $d));
12870 push(@doms, $ad);
12871 push(@olddoms, $oldad);
12872 }
12873
12874# Setup print function to include domain name
12875sub first_html_withdom_reparent
12876{
12877&$old_first_print(&text('rename_dd', $doing_dom->{'dom'})," : ",@_);
12878}
12879local $old_first_print;
12880local $doing_dom;
12881if (@doms > 1) {
12882 $old_first_print = $first_print;
12883 $first_print = \&first_html_withdom_reparent;
12884 }
12885
12886# Update all features in all domains
12887my $f;
12888local %vital = map { $_, 1 } @vital_features;
12889foreach $f (@features) {
12890 local $mfunc = "modify_$f";
12891 for(my $i=0; $i<@doms; $i++) {
12892 $doing_dom = $doms[$i];
12893 if ($doms[$i]->{$f} && ($config{$f} || $f eq "unix")) {
12894 local $main::error_must_die = 1;
12895 eval {
12896 if ($doms[$i]->{'alias'}) {
12897 # Is an alias domain, so pass in old
12898 # and new target domain objects
12899 local $aliasdom = &get_domain(
12900 $doms[$i]->{'alias'});
12901 local $idx = &indexof($aliasdom, @doms);
12902 if ($idx >= 0) {
12903 &$mfunc(
12904 $doms[$i], $olddoms[$i],
12905 $doms[$idx], $olddoms[$idx]);
12906 }
12907 else {
12908 &$mfunc(
12909 $doms[$i], $olddoms[$i],
12910 $aliasdom, $aliasdom);
12911 }
12912 }
12913 else {
12914 # Not an alias domain
12915 &$mfunc($doms[$i], $olddoms[$i]);
12916 }
12917 };
12918 if ($@) {
12919 &$second_print(&text('setup_failure',
12920 $text{'feature_'.$f}, "$@"));
12921 if ($vital{$f}) {
12922 # A vital feature failed .. give up
12923 return 0;
12924 }
12925 }
12926
12927 # Setup domains dir for aliases/etc
12928 if ($doms[$i] eq $d && $f eq "dir") {
12929 &setup_for_subdomain($d);
12930 }
12931 }
12932
12933 # Turn on the Unix and Webmin features
12934 if ($doms[$i] eq $d && ($f eq "unix" || $f eq "webmin")) {
12935 $doms[$i]->{$f} = 1;
12936 local $sfunc = "setup_$f";
12937 &try_function($f, $sfunc, $doms[$i]);
12938 }
12939 }
12940 }
12941foreach $f (&list_feature_plugins()) {
12942 for(my $i=0; $i<@doms; $i++) {
12943 if ($doms[$i]->{$f}) {
12944 $doing_dom = $doms[$i];
12945 local $main::error_must_die = 1;
12946 eval { &plugin_call($f, "feature_modify",
12947 $doms[$i], $olddoms[$i]) };
12948 if ($@) {
12949 local $err = $@;
12950 &$second_print(&text('setup_failure',
12951 &plugin_call($f, "feature_name"),$err));
12952 }
12953 }
12954 }
12955 }
12956
12957$first_print = $old_first_print if ($old_first_print);
12958
12959# Fix script installer paths in all domains
12960if (defined(&list_domain_scripts)) {
12961 &$first_print($text{'rename_scripts'});
12962 for(my $i=0; $i<@doms; $i++) {
12963 local ($olddir, $newdir) =
12964 ($olddoms[$i]->{'home'}, $doms[$i]->{'home'});
12965 foreach $sinfo (&list_domain_scripts($doms[$i])) {
12966 $changed = 0;
12967 if ($olddir ne $newdir) {
12968 # Fix directory
12969 $changed++
12970 if ($sinfo->{'opts'}->{'dir'} =~
12971 s/^\Q$olddir\E\//$newdir\//);
12972 }
12973 &save_domain_script($doms[$i], $sinfo) if ($changed);
12974 }
12975 }
12976 &$second_print($text{'setup_done'});
12977 }
12978
12979# Save the domain objects
12980&$first_print($text{'save_domain'});
12981for(my $i=0; $i<@doms; $i++) {
12982 &save_domain($doms[$i]);
12983 }
12984&$second_print($text{'setup_done'});
12985
12986# Update old Webmin user
12987if ($oldparent->{'webmin'}) {
12988 &modify_webmin($oldparent, $oldparent);
12989 }
12990
12991# Re-save the new Webmin user to grant access to all aliases
12992if ($d->{'webmin'}) {
12993 &modify_webmin($d, $d);
12994 }
12995
12996# Re-apply resource limits, to update Apache and PHP configs
12997if (defined(&supports_resource_limits) && &supports_resource_limits()) {
12998 local $rv = &get_domain_resource_limits($d);
12999 &save_domain_resource_limits($d, $rv);
13000 }
13001
13002# Copy skeleton files for top-level server
13003if ($skelchanged && $skelchanged ne 'none') {
13004 local $uinfo = &get_domain_owner($d, 1);
13005 ©_skel_files(&substitute_domain_template($skelchanged, $d),
13006 $uinfo, $d->{'home'},
13007 $d->{'group'} || $d->{'ugroup'}, $d);
13008 }
13009
13010&run_post_actions();
13011
13012# Run the after command
13013&set_domain_envs($d, "MODIFY_DOMAIN", undef, $oldd);
13014local $merr = &made_changes();
13015&$second_print(&text('setup_emade', "<tt>$merr</tt>")) if (defined($merr));
13016&reset_domain_envs($d);
13017
13018return 1;
13019}
13020
13021# unsub_virtual_server(&domain)
13022# Convert a virtual server from a sub-domain to a sub-server
13023sub unsub_virtual_server
13024{
13025local ($d) = @_;
13026local $oldd = { %$d };
13027local $parent = &get_domain($d->{'parent'});
13028
13029# Run the before command
13030&set_domain_envs($oldd, "MODIFY_DOMAIN");
13031local $merr = &making_changes();
13032&reset_domain_envs($oldd);
13033&error(&text('rename_emaking', "<tt>$merr</tt>")) if (defined($merr));
13034
13035# Update the domain object with a new home directory
13036delete($d->{'subdom'});
13037delete($d->{'public_html_dir'});
13038delete($d->{'public_html_path'});
13039$d->{'public_html_dir'} = &public_html_dir($d, 1);
13040$d->{'public_html_path'} = &public_html_dir($d, 0);
13041delete($d->{'cgi_bin_dir'});
13042delete($d->{'cgi_bin_path'});
13043$d->{'cgi_bin_dir'} = &cgi_bin_dir($d, 1);
13044$d->{'cgi_bin_path'} = &cgi_bin_dir($d, 0);
13045&change_home_directory($d, &server_home_directory($d, $parent));
13046
13047# Update all features in the domain
13048local %vital = map { $_, 1 } @vital_features;
13049foreach my $f (@features) {
13050 local $mfunc = "modify_$f";
13051 if ($d->{$f} && $config{$f}) {
13052 local $main::error_must_die = 1;
13053 eval { &$mfunc($d, $oldd); };
13054 if ($@) {
13055 &$second_print(&text('setup_failure',
13056 $text{'feature_'.$f}, "$@"));
13057 return 0 if ($vital{$f});
13058 }
13059 }
13060 }
13061
13062# Update all enabled plugins
13063foreach my $f (&list_feature_plugins()) {
13064 if ($d->{$f}) {
13065 local $main::error_must_die = 1;
13066 eval { &plugin_call($f, "feature_modify", $d, $oldd) };
13067 if ($@) {
13068 local $err = $@;
13069 &$second_print(&text('setup_failure',
13070 &plugin_call($f, "feature_name"), $err));
13071 }
13072 }
13073 }
13074
13075# Save the domain object
13076&$first_print($text{'save_domain'});
13077&save_domain($d);
13078&$second_print($text{'setup_done'});
13079
13080# Update parent Webmin user
13081&modify_webmin($parent, $parent);
13082
13083&run_post_actions();
13084
13085# Run the after command
13086&set_domain_envs($d, "MODIFY_DOMAIN", undef, $oldd);
13087local $merr = &made_changes();
13088&$second_print(&text('setup_emade', "<tt>$merr</tt>")) if (defined($merr));
13089&reset_domain_envs($d);
13090
13091return 1;
13092}
13093
13094# unalias_virtual_server(&domain)
13095# Convert a virtual server from an alias to a sub-server
13096sub unalias_virtual_server
13097{
13098local ($d) = @_;
13099local $oldd = { %$d };
13100local $parent = &get_domain($d->{'parent'});
13101
13102# Run the before command
13103&set_domain_envs($oldd, "MODIFY_DOMAIN");
13104local $merr = &making_changes();
13105&reset_domain_envs($oldd);
13106&error(&text('rename_emaking', "<tt>$merr</tt>")) if (defined($merr));
13107
13108# Update the domain object to set the web directory
13109delete($d->{'alias'});
13110delete($d->{'public_html_dir'});
13111delete($d->{'public_html_path'});
13112$d->{'public_html_dir'} = &public_html_dir($d, 1);
13113$d->{'public_html_path'} = &public_html_dir($d, 0);
13114delete($d->{'cgi_bin_dir'});
13115delete($d->{'cgi_bin_path'});
13116$d->{'cgi_bin_dir'} = &cgi_bin_dir($d, 1);
13117$d->{'cgi_bin_path'} = &cgi_bin_dir($d, 0);
13118
13119# Create domains dir if missing
13120&setup_for_subdomain($parent, $parent->{'user'}, $d);
13121
13122# Create the directory, if missing
13123if (!$d->{'dir'}) {
13124 $d->{'dir'} = 1;
13125 local $main::error_must_die = 1;
13126 eval { &setup_dir($d); };
13127 if ($@) {
13128 &$second_print(&text('setup_failure',
13129 $text{'feature_dir'}, "$@"));
13130 }
13131 }
13132
13133# Update all features in the domain
13134local %vital = map { $_, 1 } @vital_features;
13135foreach my $f (@features) {
13136 local $mfunc = "modify_$f";
13137 if ($d->{$f} && $config{$f}) {
13138 local $main::error_must_die = 1;
13139 eval { &$mfunc($d, $oldd); };
13140 if ($@) {
13141 &$second_print(&text('setup_failure',
13142 $text{'feature_'.$f}, "$@"));
13143 return 0 if ($vital{$f});
13144 }
13145 }
13146 }
13147
13148# Update all enabled plugins
13149foreach my $f (&list_feature_plugins()) {
13150 if ($d->{$f}) {
13151 local $main::error_must_die = 1;
13152 eval { &plugin_call($f, "feature_modify", $d, $oldd) };
13153 if ($@) {
13154 local $err = $@;
13155 &$second_print(&text('setup_failure',
13156 &plugin_call($f, "feature_name"), $err));
13157 }
13158 }
13159 }
13160
13161# Save the domain object
13162&$first_print($text{'save_domain'});
13163&save_domain($d);
13164&$second_print($text{'setup_done'});
13165
13166# Update parent Webmin user
13167&modify_webmin($parent, $parent);
13168
13169&run_post_actions();
13170
13171# Turn off aliascopy for future
13172delete($d->{'aliascopy'});
13173&save_domain($d);
13174
13175# Run the after command
13176&set_domain_envs($d, "MODIFY_DOMAIN", undef, $oldd);
13177local $merr = &made_changes();
13178&$second_print(&text('setup_emade', "<tt>$merr</tt>")) if (defined($merr));
13179&reset_domain_envs($d);
13180
13181return 1;
13182}
13183
13184# set_parent_attributes(&domain, &parent)
13185# Update a domain object with attributes inherited from the parent
13186sub set_parent_attributes
13187{
13188local ($d, $parent) = @_;
13189$d->{'parent'} = $parent->{'id'};
13190$d->{'user'} = $parent->{'user'};
13191$d->{'group'} = $parent->{'group'};
13192$d->{'uid'} = $parent->{'uid'};
13193$d->{'gid'} = $parent->{'gid'};
13194$d->{'ugid'} = $parent->{'ugid'};
13195$d->{'pass'} = $parent->{'pass'};
13196$d->{'enc_pass'} = $parent->{'enc_pass'};
13197$d->{'crypt_enc_pass'} = $parent->{'crypt_enc_pass'};
13198$d->{'md5_enc_pass'} = $parent->{'md5_enc_pass'};
13199$d->{'mysql_enc_pass'} = $parent->{'mysql_enc_pass'};
13200$d->{'digest_enc_pass'} = $parent->{'digest_enc_pass'};
13201$d->{'mysql_user'} = $parent->{'mysql_user'};
13202$d->{'postgres_user'} = $parent->{'postgres_user'};
13203$d->{'email'} = $parent->{'email'};
13204}
13205
13206# rename_virtual_server(&domain, [new-domain], [new-user], [new-home|"auto"],
13207# new-prefix)
13208# Updates a virtual server and possibly sub-servers with a new domain name,
13209# username and home directory. If any of the parameters are undef, they are
13210# left un-changed. Prints progress output, and returns undef on success or
13211# an error message on failure.
13212sub rename_virtual_server
13213{
13214my ($d, $dom, $user, $home, $prefix) = @_;
13215
13216$dom = undef if ($dom eq $d->{'dom'});
13217$home = undef if ($home eq $d->{'home'});
13218$prefix = undef if ($prefix eq $d->{'prefix'});
13219
13220my %oldd = %$d;
13221my $parentdom = $d->{'parent'} ? &get_domain($d->{'parent'}) : undef;
13222
13223# Validate domain name
13224if ($dom) {
13225 my $derr = &allowed_domain_name($parentdom, $dom);
13226 return $derr if ($derr);
13227 my $clash = &get_domain_by("dom", $dom);
13228 $clash && return $text{'rename_eclash'};
13229 }
13230
13231# Validate username, home directory and prefix
13232if ($d->{'parent'}) {
13233 # Sub-servers don't have a separate user
13234 $user = undef;
13235 }
13236elsif ($user eq 'auto') {
13237 my ($try1, $try2);
13238 ($user, $try1, $try2) = &unixuser_name($dom || $d->{'dom'});
13239 $user || return &text('setup_eauto', $try1, $try2);
13240 }
13241elsif ($user) {
13242 &valid_mailbox_name($user) && return $text{'setup_euser2'};
13243 my ($clash) = grep { $_->{'user'} eq $user } &list_all_users();
13244 $clash && return $text{'rename_euserclash'};
13245 }
13246if ($prefix eq 'auto') {
13247 $prefix = &compute_prefix($dom || $d->{'dom'}, $user || $d->{'user'},
13248 $parentdom);
13249 }
13250elsif ($prefix) {
13251 $prefix =~ /^[a-z0-9\.\-]+$/i || return $text{'setup_eprefix'};
13252 my $pclash = &get_domain_by("prefix", $prefix);
13253 $pclash && return &text('setup_eprefix3', $prefix, $pclash->{'dom'});
13254 }
13255my $group;
13256if ($prefix) {
13257 $group = $user || $d->{'user'};
13258 }
13259
13260# Update the domain object with the new domain name and username
13261if ($dom) {
13262 $d->{'email'} =~ s/\@$d->{'dom'}$/\@$dom/gi;
13263 $d->{'emailto'} =~ s/\@$d->{'dom'}$/\@$dom/gi;
13264 $d->{'dom'} = $dom;
13265 }
13266if ($user) {
13267 $d->{'email'} =~ s/^\Q$d->{'user'}\E\@/$user\@/g;
13268 $d->{'emailto'} =~ s/^\Q$d->{'user'}\E\@/$user\@/g;
13269 $d->{'user'} = $user;
13270 }
13271
13272# Validate and set home directory
13273if ($home eq 'auto') {
13274 # Automatic home
13275 &change_home_directory($d, &server_home_directory($d, $parentdom));
13276 }
13277elsif ($home) {
13278 # User-selected home
13279 -e $home && return $text{'rename_ehome3'};
13280 $home =~ /^(.*)\// && -d $1 || return $text{'rename_ehome4'};
13281 &change_home_directory($d, $home);
13282 }
13283if ($group) {
13284 $d->{'group'} = $group;
13285 $d->{'prefix'} = $prefix;
13286 }
13287
13288# Find any sub-domain objects and update them
13289if (!$d->{'parent'}) {
13290 my @subs = &get_domain_by("parent", $d->{'id'});
13291 foreach my $sd (@subs) {
13292 my %oldsd = %$sd;
13293 push(@oldsubs, \%oldsd);
13294 if ($user) {
13295 $sd->{'email'} =~ s/^\Q$sd->{'user'}\E\@/$user\@/g;
13296 $sd->{'emailto'} =~ s/^\Q$sd->{'user'}\E\@/$user\@/g;
13297 $sd->{'user'} = $user;
13298 }
13299 if ($dom) {
13300 $sd->{'email'} =~ s/\@$d->{'dom'}$/\@$dom/gi;
13301 $sd->{'emailto'} =~ s/\@$d->{'dom'}$/\@$dom/gi;
13302 }
13303 if ($home) {
13304 &change_home_directory($sd,
13305 &server_home_directory($sd, $d));
13306 }
13307 if ($group) {
13308 $sd->{'group'} = $group;
13309 }
13310 }
13311 }
13312
13313# Find any domains aliases to this one, excluding child domains
13314my @aliases = &get_domain_by("alias", $d->{'id'});
13315my @aliases = grep { $_->{'parent'} != $d->{'id'} } @aliases;
13316foreach my $ad (@aliases) {
13317 my %oldad = %$ad;
13318 push(@oldaliases, \%oldad);
13319 }
13320
13321# Check for domain name clash, where the domain, user or group have changed
13322foreach my $f (@features) {
13323 my $cfunc = "check_${f}_clash";
13324 if (defined(&$cfunc) && $dom{$f}) {
13325 if ($dom && &$cfunc($d, 'dom')) {
13326 return &text('setup_e'.$f, $dom, $dom{'db'},
13327 $user, $d->{'group'} || $group);
13328 }
13329 if ($user && &$cfunc($d, 'user')) {
13330 return &text('setup_e'.$f, $dom, $dom{'db'},
13331 $user, $d->{'group'} || $group);
13332 }
13333 if ($group && &$cfunc($d, 'group')) {
13334 return &text('setup_e'.$f, $dom, $dom{'db'},
13335 $user, $group);
13336 }
13337 }
13338 }
13339
13340# Run the before command
13341&set_domain_envs(\%oldd, "MODIFY_DOMAIN", $d);
13342my $merr = &making_changes();
13343&reset_domain_envs(\%oldd);
13344return &text('rename_emaking', "<tt>$merr</tt>") if (defined($merr));
13345
13346if ($dom) {
13347 &$first_print(&text('rename_doingdom', "<tt>$dom</tt>"));
13348 }
13349if ($user) {
13350 &$first_print(&text('rename_doinguser', "<tt>$user</tt>"));
13351 }
13352if ($home) {
13353 &$first_print(&text('rename_doinghome', "<tt>$home</tt>"));
13354 }
13355
13356# Build the list of domains being changed
13357my @doms = ( $d );
13358my @olddoms = ( \%oldd );
13359push(@doms, @subs, @aliases);
13360push(@olddoms, @oldsubs, @oldaliases);
13361
13362# Setup print function to include domain name
13363sub first_html_withdom
13364{
13365print &text('rename_dd', $doing_dom->{'dom'})," : ",@_,"<br>\n";
13366}
13367if (@doms > 1) {
13368 $first_print = \&first_html_withdom;
13369 }
13370
13371# Update all features in all domains. Include the mail feature always, as this
13372# covers FTP users
13373local $doing_dom; # Has to be local for scoping
13374foreach my $f (&unique(@features, 'mail')) {
13375 my $mfunc = "modify_$f";
13376 for(my $i=0; $i<@doms; $i++) {
13377 my $p = &domain_has_website($doms[$i]);
13378 if ($f eq "web" && $p && $p ne "web") {
13379 # Web feature is provided by a plugin .. call it now
13380 $doing_dom = $doms[$i];
13381 &try_plugin_call($p, "feature_modify",
13382 $doms[$i], $olddoms[$i]);
13383 }
13384 elsif ($doms[$i]->{$f} && $config{$f} ||
13385 $f eq "unix" || $f eq "mail") {
13386 $doing_dom = $doms[$i];
13387 local $main::error_must_die = 1;
13388 eval {
13389 if ($doms[$i]->{'alias'}) {
13390 # Is an alias domain, so pass in old
13391 # and new target domain objects
13392 local $aliasdom = &get_domain(
13393 $doms[$i]->{'alias'});
13394 local $idx = &indexof($aliasdom, @doms);
13395 if ($idx >= 0) {
13396 &try_function($f, $mfunc,
13397 $doms[$i], $olddoms[$i],
13398 $doms[$idx], $olddoms[$idx]);
13399 }
13400 else {
13401 &try_function($f, $mfunc,
13402 $doms[$i], $olddoms[$i],
13403 $aliasdom, $aliasdom);
13404 }
13405 }
13406 else {
13407 # Not an alias domain
13408 &try_function($f, $mfunc,
13409 $doms[$i], $olddoms[$i]);
13410 }
13411 };
13412 if ($@) {
13413 &$second_print(&text('setup_failure',
13414 $text{'feature_'.$f}, "$@"));
13415 }
13416 }
13417 }
13418 }
13419
13420# Update plugins in all domains
13421foreach $f (&list_feature_plugins()) {
13422 for(my $i=0; $i<@doms; $i++) {
13423 my $p = &domain_has_website($doms[$i]);
13424 if ($doms[$i]->{$f} && $f ne $p) {
13425 $doing_dom = $doms[$i];
13426 &try_plugin_call($f, "feature_modify",
13427 $doms[$i], $olddoms[$i]);
13428 }
13429 }
13430 }
13431
13432# Fix script installer paths in all domains
13433if (defined(&list_domain_scripts)) {
13434 &$first_print($text{'rename_scripts'});
13435 for(my $i=0; $i<@doms; $i++) {
13436 my ($olddir, $newdir) =
13437 ($olddoms[$i]->{'home'}, $doms[$i]->{'home'});
13438 my ($olddname, $newdname) =
13439 ($olddoms[$i]->{'dom'}, $doms[$i]->{'dom'});
13440 foreach my $sinfo (&list_domain_scripts($doms[$i])) {
13441 my $changed = 0;
13442 if ($olddir ne $newdir) {
13443 # Fix directory
13444 $changed++ if ($sinfo->{'opts'}->{'dir'} =~
13445 s/^\Q$olddir\E\//$newdir\//);
13446 }
13447 if ($olddname ne $newdname) {
13448 # Fix domain in URL
13449 $changed++ if ($sinfo->{'url'} =~
13450 s/\Q$olddname\E/$newdname/);
13451 }
13452 if (!$info{'opts'}->{'dir'} ||
13453 -d $info{'opts'}->{'dir'}) {
13454 # list_domain_scripts will set deleted flag
13455 # due to home directory move, so fix it now that
13456 # script dir has been corrected
13457 $sinfo->{'deleted'} = 0;
13458 }
13459 &save_domain_script($doms[$i], $sinfo) if ($changed);
13460 }
13461 }
13462 &$second_print($text{'setup_done'});
13463 }
13464
13465# Fix backup schedule and key owners
13466if (!$oldd{'parent'}) {
13467 &rename_backup_owner($d, \%oldd);
13468 }
13469
13470&refresh_webmin_user($d);
13471&run_post_actions();
13472
13473# Save all new domain details
13474&$first_print($text{'save_domain'});
13475for(my $i=0; $i<@doms; $i++) {
13476 &save_domain($doms[$i]);
13477 }
13478&$second_print($text{'setup_done'});
13479
13480# Run the after command
13481&set_domain_envs($d, "MODIFY_DOMAIN", undef, \%oldd);
13482my $merr = &made_changes();
13483&$second_print(&text('rename_emade', "<tt>$merr</tt>")) if (defined($merr));
13484&reset_domain_envs($d);
13485
13486# Clear all left-frame links caches, as links to Apache may no longer be valid
13487&clear_links_cache();
13488
13489return undef;
13490}
13491
13492# check_virtual_server_config([&lastconfig])
13493# Validates the Virtualmin configuration, printing out messages as it goes.
13494# Returns undef on success, or an error message on failure.
13495sub check_virtual_server_config
13496{
13497local ($lastconfig) = @_;
13498local $clink = "edit_newfeatures.cgi";
13499local $mclink = "../config.cgi?$module_name";
13500
13501# Make sure networking is supported
13502if (!&foreign_check("net")) {
13503 &foreign_require("net");
13504 if (!defined(&net::boot_interfaces)) {
13505 return &text('index_enet');
13506 }
13507 &$second_print($text{'check_netok'});
13508 }
13509
13510# Check for sensible memory limits
13511if (&foreign_check("proc")) {
13512 &foreign_require("proc");
13513 local $rmem = ($config{'mem_low'} || 256)*1024*1024;
13514 if (defined(&proc::get_memory_info)) {
13515 local @mem = &proc::get_memory_info();
13516 local $beans = &get_beancounters();
13517 if ($mem[0]*1024 < $rmem) {
13518 # Memory is less than 256 M
13519 &$second_print("<b>".&text('check_lowmemory',
13520 &nice_size($mem[0]*1024),
13521 &nice_size($rmem))."</b>");
13522 }
13523 elsif ($beans->{'vmguarpages'} &&
13524 $beans->{'vmguarpages'}*4096 < $rmem &&
13525 $beans->{'vmguarpages'} < $beans->{'privvmpages'}) {
13526 # OpenVZ guaranteed memory is lower than max memory,
13527 # and is less than 256 M
13528 &$second_print("<b>".&text('check_lowgmemory',
13529 &nice_size($mem[0]*1024),
13530 &nice_size($beans->{'vmguarpages'}*4096),
13531 &nice_size($rmem))."</b>");
13532 }
13533 elsif ($beans->{'vmguarpages'} &&
13534 $beans->{'vmguarpages'} < $beans->{'privvmpages'}) {
13535 # OpenVZ guaranteed memory is lower than max memory,
13536 # but is above 256 M
13537 &$second_print(&text('check_okgmemory',
13538 &nice_size($mem[0]*1024),
13539 &nice_size($beans->{'vmguarpages'}*4096),
13540 &nice_size($rmem)));
13541 }
13542 else {
13543 # Memory is OK
13544 &$second_print(&text('check_okmemory',
13545 &nice_size($mem[0]*1024), &nice_size($rmem)));
13546 }
13547 }
13548 }
13549
13550if ($config{'dns'}) {
13551 # Make sure BIND is installed
13552 if ($config{'provision_dns'}) {
13553 # Only BIND module is needed
13554 &foreign_check("bind8") ||
13555 return $text{'index_ebindmod'};
13556 &$second_print($text{'check_dnsok3'});
13557 }
13558 else {
13559 # BIND server must be installed and usable
13560 &foreign_installed("bind8", 1) == 2 ||
13561 return &text('index_ebind', "/bind8/", $clink);
13562
13563 # Check that primary NS hostname is reasonable
13564 &require_bind();
13565 local $tmpl = &get_template(0);
13566 local $master = $tmpl->{'dns_master'} eq 'none' ? undef :
13567 $tmpl->{'dns_master'};
13568 $master ||= $bind8::config{'default_prins'} ||
13569 &get_system_hostname();
13570 local $mastermsg;
13571 if ($master !~ /\./) {
13572 $mastermsg = &text('check_dnsmaster',
13573 "<tt>$master</tt>");
13574 }
13575
13576 # Make sure this server is configured to use the local BIND
13577 if (&foreign_check("net") && $config{'dns_check'}) {
13578 &foreign_require("net");
13579 local %ips = map { $_, 1 } &active_ip_addresses();
13580 local $dns = &net::get_dns_config();
13581 local $hasdns;
13582 foreach my $ns (@{$dns->{'nameserver'}}) {
13583 $hasdns++ if ($ips{&to_ipaddress($ns)} ||
13584 $ns eq "127.0.0.1" ||
13585 $ns eq "0.0.0.0");
13586 }
13587 if (!@{$dns->{'nameserver'}}) {
13588 # No resolv.conf at all, but this means that
13589 # DNS falls back to local
13590 &$second_print($text{'check_dnsmissing'}." ".
13591 $mastermsg);
13592 }
13593 elsif (!$hasdns) {
13594 # No local nameserver
13595 my @dhcp = grep { $_->{'dhcp'} ||
13596 $_->{'bootp'} }
13597 &net::boot_interfaces();
13598 return &text('check_eresolv',
13599 '/net/list_dns.cgi', $clink).
13600 (@dhcp ? " ".$text{'check_eresolv2'} : "");
13601 }
13602 else {
13603 &$second_print($text{'check_dnsok'}." ".
13604 $mastermsg);
13605 }
13606 }
13607 else {
13608 &$second_print($text{'check_dnsok2'}." ".$mastermsg);
13609 }
13610 }
13611 }
13612
13613if ($config{'mail'}) {
13614 if ($config{'mail_system'} == 3) {
13615 # Work out which mail server we have
13616 if (&postfix_installed()) {
13617 $config{'mail_system'} = 0;
13618 }
13619 elsif (&qmail_vpopmail_installed()) {
13620 $config{'mail_system'} = 5;
13621 }
13622 elsif (&qmail_ldap_installed()) {
13623 $config{'mail_system'} = 4;
13624 }
13625 elsif (&qmail_installed()) {
13626 $config{'mail_system'} = 2;
13627 }
13628 elsif (&sendmail_installed()) {
13629 $config{'mail_system'} = 1;
13630 }
13631 else {
13632 return &text('index_email');
13633 }
13634 &$second_print(&text('check_detected', &mail_system_name()));
13635 &save_module_config();
13636 }
13637 local $expected_mailboxes;
13638 if ($config{'mail_system'} == 1) {
13639 # Make sure sendmail is installed
13640 if (!&sendmail_installed()) {
13641 return &text('index_esendmail', '/sendmail/',
13642 "../config.cgi?$module_name");
13643 }
13644 # Check that aliases and virtusers are configured
13645 &require_mail();
13646 @$sendmail_afiles ||
13647 return &text('index_esaliases', '/sendmail/');
13648 $sendmail_vdbm ||
13649 return &text('index_esvirts', '/sendmail/');
13650 if ($config{'generics'}) {
13651 $sendmail_gdbm ||
13652 return &text('index_esgens',
13653 '/sendmail/', $mclink);
13654 }
13655 if ($config{'bccs'}) {
13656 return &text('check_esendmailbccs', $mclink);
13657 }
13658
13659 # Check for external interface
13660 local @addrs;
13661 local $conf = &sendmail::get_sendmailcf();
13662 foreach my $dpo (&sendmail::find_options("DaemonPortOptions",
13663 $conf)) {
13664 local $addr = "*";
13665 if ($dpo->[1] =~ /(Addr|Address|A)=([^ ,]+)/i) {
13666 $addr = $2;
13667 }
13668 local $port = 25;
13669 if ($dpo->[1] =~ /(Port|P)=([^ ,]+)/i) {
13670 $port = $2;
13671 }
13672 push(@addrs, [ $addr, $port ]);
13673 }
13674 if (@addrs) {
13675 # Need at least one non-localhost port 25
13676 local @adescs;
13677 foreach my $a (@addrs) {
13678 if ($a->[0] eq '*') {
13679 push(@adescs, "port $a->[1]");
13680 }
13681 else {
13682 push(@adescs, "$a->[0] port $a->[1]");
13683 }
13684 }
13685 @addrs = grep { $_->[0] ne 'localhost' &&
13686 $_->[0] ne '127.0.0.1' &&
13687 $_->[0] !~ /:/ &&
13688 ($_->[1] eq '25' || $_->[1] eq 'smtp') }
13689 @addrs;
13690 @addrs || return &text('check_esendmailaddrs',
13691 join(", ", @adescs), '/sendmail/');
13692 }
13693
13694 &$second_print($text{'check_sendmailok'});
13695 $expected_mailboxes = 1;
13696 }
13697 elsif ($config{'mail_system'} == 0) {
13698 # Make sure postfix is installed
13699 if (!&postfix_installed()) {
13700 return &text('index_epostfix', '/postfix/',
13701 "../config.cgi?$module_name");
13702
13703 }
13704
13705 # Check that all the need Postfix maps are working
13706 &require_mail();
13707 my $err = &check_postfix_map("alias_maps");
13708 return &text('check_ealias_maps', $err) if ($err);
13709 $err = &check_postfix_map($virtual_type);
13710 return &text('check_evirtual_maps', $err) if ($err);
13711 if ($config{'generics'}) {
13712 $canonical_maps ||
13713 return &text('index_epgens', '/postfix/', $mclink);
13714 $err = &check_postfix_map($canonical_type);
13715 return &text('check_ecanonical_maps', $err) if ($err);
13716 }
13717 if ($config{'bccs'}) {
13718 $sender_bcc_maps ||
13719 return &text('check_epostfixbccs', '/postfix/',
13720 $mclink);
13721 $err = &check_postfix_map("sender_bcc_maps");
13722 return &text('check_ebcc_maps', $err) if ($err);
13723 }
13724
13725 # Make sure virtual_alias_domains is not set, as it overrides
13726 # virtual_alias_maps
13727 local $vad = &postfix::get_real_value("virtual_alias_domains");
13728 local $vam = &postfix::get_real_value($virtual_type);
13729 if ($vad && $vad ne $vam) {
13730 return &text('check_evad', $vad);
13731 }
13732
13733 # Make sure mydestination contains hostname or origin
13734 local $myhost = &postfix::get_real_value("myorigin") ||
13735 &postfix::get_real_value("myhostname") ||
13736 &get_system_hostname(0, 1);
13737 if ($myhost =~ /^\//) {
13738 $myhost = &read_file_contents($myhost);
13739 $myhost =~ s/\s//g;
13740 }
13741 $myhost =~ s/^\s+//;
13742 $myhost =~ s/\s+$//;
13743 local @mydest = split(/[, ]+/,
13744 &postfix::get_real_value("mydestination"));
13745 if ($myhost &&
13746 &indexoflc($myhost, @mydest) < 0 &&
13747 &indexoflc('$myhostname', @mydest) < 0) {
13748 return &text('check_emydest', $myhost, join(", ", @mydest));
13749 }
13750
13751 &$second_print($text{'check_postfixok'});
13752 $expected_mailboxes = 0;
13753
13754 # Report on outgoing IP option
13755 if ($supports_dependent) {
13756 &$second_print($text{'check_dependentok'});
13757 }
13758 elsif (&compare_versions($postfix::postfix_version, 2.7) < 0) {
13759 &$second_print($text{'check_dependentever'});
13760 }
13761 else {
13762 local $l = &get_webmin_version() >= 1.593 ?
13763 '../postfix/dependent.cgi' : '../postfix/';
13764 &$second_print(&text('check_dependentesupport', $l));
13765 }
13766 }
13767 elsif ($config{'mail_system'} == 2) {
13768 # Make sure qmail is installed
13769 if (!&qmail_installed()) {
13770 return &text('index_eqmail', '/qmailadmin/',
13771 "../config.cgi?$module_name");
13772 }
13773 if ($config{'generics'}) {
13774 return &text('index_eqgens', $mclink);
13775 }
13776 if ($config{'bccs'}) {
13777 return &text('check_eqmailbccs', $mclink);
13778 }
13779 local $tmpl = &get_template(0);
13780 if ($tmpl->{'append_style'} == 6) {
13781 &$second_print($text{'check_qmailmode6'});
13782 }
13783 else {
13784 &$second_print($text{'check_qmailok'});
13785 }
13786 $expected_mailboxes = 2;
13787 }
13788 elsif ($config{'mail_system'} == 4) {
13789 # Make sure qmail with LDAP is installed
13790 if (!&qmail_ldap_installed()) {
13791 return &text('index_eqmailldap', '/qmailadmin/',
13792 "../config.cgi?$module_name");
13793 }
13794 if ($config{'generics'}) {
13795 return &text('index_eqgens', $mclink);
13796 }
13797 if ($config{'bccs'}) {
13798 return &text('check_eqmailbccs', $mclink);
13799 }
13800 if (!&to_ipaddress($config{'ldap_host'}) &&
13801 !(defined(&to_ip6address) &&
13802 &to_ip6address($config{'ldap_host'}))) {
13803 return &text('index_eqmailhost', $mclink);
13804 }
13805 if (!$config{'ldap_base'}) {
13806 return &text('index_eqmailbase', $mclink);
13807 }
13808 local $lerr = &connect_qmail_ldap(1);
13809 if (!ref($lerr)) {
13810 return &text('index_eqmailconn', $lerr, $mclink);
13811 }
13812 &$second_print($text{'check_qmailldapok'});
13813 $expected_mailboxes = 4;
13814 }
13815 elsif ($config{'mail_system'} == 5) {
13816 # Make sure qmail with VPOPMail is installed
13817 if (!&qmail_vpopmail_installed()) {
13818 return &text('index_evpopmail', '/qmailadmin/',
13819 "../config.cgi?$module_name");
13820 }
13821 if ($config{'generics'}) {
13822 return &text('index_eqgens', $mclink);
13823 }
13824 if ($config{'bccs'}) {
13825 return &text('check_eqmailbccs', $mclink);
13826 }
13827 &$second_print($text{'check_vpopmailok'});
13828 $expected_mailboxes = 5;
13829 }
13830 # Check that Read User Mail module agrees
13831 if (&foreign_check("mailboxes") && defined($expected_mailboxes)) {
13832 local %mconfig = &foreign_config("mailboxes");
13833 $mconfig{'mail_system'} == 3 ||
13834 $mconfig{'mail_system'} == $expected_mailboxes ||
13835 return &text('index_emailboxessystem',
13836 '/mailboxes/',
13837 "../config.cgi?$module_name",
13838 $text{'mail_system_'.$expected_mailboxes});
13839 }
13840 }
13841
13842if ($config{'web'}) {
13843 # Make sure Apache is installed
13844 &foreign_installed("apache", 1) == 2 ||
13845 return &text('index_eapache', "/apache/", $clink);
13846
13847 # Make sure needed Apache modules are active
13848 local $tmpl = &get_template(0);
13849 if ($tmpl->{'web_suexec'} && $apache::httpd_modules{'core'} >= 2.0 &&
13850 !$apache::httpd_modules{'mod_suexec'}) {
13851 return &text('check_ewebsuexec');
13852 }
13853 if (!$apache::httpd_modules{'mod_actions'}) {
13854 return &text('check_ewebactions');
13855 }
13856 if ($tmpl->{'web_php_suexec'} == 2 &&
13857 !$apache::httpd_modules{'mod_fcgid'}) {
13858 return $text{'tmpl_ephpmode2'};
13859 }
13860
13861 # Run Apache config check
13862 local $err = &apache::test_config();
13863 if ($err) {
13864 local @elines = split(/\r?\n/, $err);
13865 @elines = grep { !/\[warn\]/ } @elines;
13866 $err = join("\n", @elines) if (@elines);
13867 return &text('check_ewebconfig',
13868 "<pre>".&html_escape($err)."</pre>");
13869 }
13870
13871 # Check for sane Apache version
13872 if (!$apache::httpd_modules{'core'}) {
13873 return $text{'check_ewebapacheversion'};
13874 }
13875 elsif ($apache::httpd_modules{'core'} < 1.3) {
13876 return &text('check_ewebapacheversion2',
13877 $apache::httpd_modules{'core'}, 1.3);
13878 }
13879
13880 # Check for Ubuntu PHP setting that breaks fcgi
13881 my $php5conf = "/etc/apache2/mods-enabled/php5.conf";
13882 if (-r $php5conf) {
13883 my $lref = &read_file_lines($php5conf, 1);
13884 foreach my $l (@$lref) {
13885 if ($l =~ /^\s*SetHandler/) {
13886 return &text('check_ewebphp',
13887 "<tt>$php5conf</tt>", "<tt>SetHandler</tt>");
13888 }
13889 }
13890 }
13891
13892 # Make sure suexec is installed, if enabled. Also check home path.
13893 local $err = &check_suexec_install($tmpl);
13894 if ($err) {
13895 if ($tmpl->{'web_suexec'}) {
13896 # Absolutely needed for PHP run via CGI or fCGId
13897 return $err;
13898 }
13899 else {
13900 # Just a warning
13901 &$second_print($err);
13902 }
13903 }
13904 else {
13905 &$second_print($text{'check_webok'});
13906 }
13907
13908 # Check PHP versions
13909 local @msg;
13910 foreach my $v (&list_available_php_versions()) {
13911 if ($v->[1]) {
13912 local $realv = &get_php_version($v->[0]);
13913 push(@msg, ($realv || $v->[0])." (".$v->[1].")");
13914 }
13915 else {
13916 push(@msg, $v->[0]." (mod_php)");
13917 }
13918 }
13919 if (@msg) {
13920 &$second_print(&text('check_webphpvers', join(", ", @msg)));
13921 }
13922 else {
13923 &$second_print("<b>$text{'check_webphpnovers'}</b>");
13924 }
13925 }
13926
13927if ($config{'webalizer'}) {
13928 # Make sure Webalizer is installed, and that global directives are OK
13929 &domain_has_website() || return &text('check_edepwebalizer', $clink);
13930 &foreign_installed("webalizer", 1) == 2 ||
13931 return &text('index_ewebalizer', "/webalizer/", $clink);
13932 &foreign_require("webalizer");
13933
13934 # This is not needed
13935 #local $conf = &webalizer::get_config();
13936 #$current = &webalizer::find_value("IncrementalName", $conf);
13937 #$history = &webalizer::find_value("HistoryName", $conf);
13938 #if ($current =~ /^\//) {
13939 # &check_error(&text('check_current', "/webalizer/"));
13940 # }
13941 #elsif ($history =~ /^\//) {
13942 # &check_error(&text('check_history', "/webalizer/"));
13943 # }
13944
13945 # Make sure template config file exists
13946 local $wfile = $tmpl->{'webalizer'} ||
13947 $webalizer::config{'webalizer_conf'};
13948 if (!-r $wfile) {
13949 return &text('index_ewebalizerfile', $wfile, "/webalizer/");
13950 }
13951
13952 &$second_print($text{'check_webalizerok'});
13953 }
13954
13955if ($config{'ssl'}) {
13956 # Make sure openssl is installed, that Apache supports mod_ssl,
13957 # and that port 443 is in use
13958 $config{'web'} || return &text('check_edepssl', $clink);
13959 &has_command("openssl") ||
13960 return &text('index_eopenssl', "<tt>openssl</tt>", $clink);
13961
13962 &require_apache();
13963 local $conf = &apache::get_config();
13964 local @loads = &apache::find_directive_struct("LoadModule", $conf);
13965 local ($l, $hasmod);
13966 foreach $l (@loads) {
13967 $hasmod++ if ($l->{'words'}->[1] =~ /mod_ssl/);
13968 }
13969 local ($aver, $amods) = &apache::httpd_info(&apache::find_httpd());
13970 $hasmod++ if (&indexof("mod_ssl", @$amods) >= 0);
13971 $hasmod++ if ($apache::httpd_modules{'mod_ssl'});
13972 $hasmod ||
13973 return &text('index_emodssl', "<tt>mod_ssl</tt>", $clink);
13974
13975 local @listens = &apache::find_directive_struct("Listen", $conf);
13976 local $haslisten;
13977 foreach $l (@listens) {
13978 $haslisten++ if ($l->{'words'}->[0] =~ /^(\S+:)?$default_web_sslport$/);
13979 }
13980 local @ports = &apache::find_directive_struct("Port", $conf);
13981 foreach $l (@ports) {
13982 $haslisten++ if ($l->{'words'}->[0] == $default_web_sslport);
13983 }
13984 $haslisten ||
13985 return &text('index_emodssl2', $default_web_sslport, $clink);
13986 &$second_print($text{'check_sslok'});
13987 }
13988
13989if ($config{'mysql'}) {
13990 # Make sure MySQL is installed
13991 &require_mysql();
13992 if ($config{'provision_mysql'}) {
13993 # Only MySQL client is needed
13994 &foreign_installed("mysql") ||
13995 return &text('index_emysql2', "/mysql/", $clink);
13996 &$second_print($text{'check_mysqlok2'});
13997 }
13998 else {
13999 # MySQL server is needed
14000 &foreign_installed("mysql", 1) == 2 ||
14001 return &text('index_emysql', "/mysql/", $clink);
14002 if ($mysql::mysql_pass eq '') {
14003 local $myd = &module_root_directory("mysql");
14004 &$second_print(&text('check_mysqlnopass',
14005 '/mysql/root_form.cgi'));
14006 }
14007 else {
14008 &$second_print($text{'check_mysqlok'});
14009 }
14010 }
14011
14012 # If MYSQL_PWD doesn't work, disable it
14013 if (defined(&mysql::working_env_pass) &&
14014 !&mysql::working_env_pass()) {
14015 $mysql::config{'nopwd'} = 1;
14016 &mysql::save_module_config();
14017 }
14018 }
14019
14020if ($config{'postgres'}) {
14021 # Make sure PostgreSQL is installed
14022 &require_postgres();
14023 &foreign_installed("postgresql", 1) == 2 ||
14024 return &text('index_epostgres', "/postgresql/", $clink);
14025 if (!$postgresql::postgres_sameunix &&
14026 $postgresql::postgres_pass eq '') {
14027 &$second_print(&text('check_postgresnopass', '/postgresql/',
14028 $postgresql::postgres_login || 'root'));
14029 }
14030 else {
14031 &$second_print($text{'check_postgresok'});
14032 }
14033 }
14034
14035if ($config{'ftp'}) {
14036 # Make sure ProFTPd is installed, and that the ftp user exists
14037 &foreign_installed("proftpd", 1) == 2 ||
14038 return &text('index_eproftpd', "/proftpd/", $clink);
14039 local $err = &check_proftpd_template();
14040 $err && return &text('check_proftpd', $err);
14041 &$second_print($text{'check_ftpok'});
14042 }
14043
14044if ($config{'logrotate'}) {
14045 # Make sure logrotate is installed
14046 &foreign_installed("logrotate", 1) == 2 ||
14047 return &text('index_elogrotate', "/logrotate/", $clink);
14048 &foreign_require("logrotate");
14049 local $ver = &logrotate::get_logrotate_version();
14050 $ver >= 3.6 ||
14051 return &text('index_elogrotatever', "/logrotate/",
14052 $clink, $ver, 3.6);
14053
14054 # Make sure the current config is OK
14055 local $out = &backquote_with_timeout(
14056 "$logrotate::config{'logrotate'} -d -f ".
14057 "e_path($logrotate::config{'logrotate_conf'})." 2>&1",
14058 60, 1, 1000);
14059 if ($? && $out =~ /(.*stat\s+of\s+.*\s+failed:.*)/) {
14060 return &text('check_elogrotateconf',
14061 "<pre>".&html_escape("$1")."</pre>");
14062 }
14063 &$second_print($text{'check_logrotateok'});
14064 }
14065
14066if ($config{'spam'}) {
14067 # Make sure SpamAssassin and procmail are installed
14068 &foreign_installed("spam", 1) == 2 ||
14069 return &text('index_espam', "/spam/", $clink);
14070 &foreign_installed("procmail", 1) == 2 ||
14071 return &text('index_eprocmail', "/procmail/", $clink);
14072 local $spamclient = &get_global_spam_client();
14073 if ($spamclient =~ /^spamassassin/) {
14074 # Make sure it supports --siteconfigpath
14075 local $out = &backquote_command("$spamclient -h 2>&1 </dev/null");
14076 if ($out !~ /\-\-siteconfigpath/) {
14077 &require_spam();
14078 local $ver = &spam::get_spamassassin_version();
14079 return &text('check_espamsiteconfig', $ver);
14080 }
14081 }
14082 local $hasprocmail = &mail_system_has_procmail();
14083 if ($hasprocmail) {
14084 &$second_print($text{'check_spamok'});
14085 }
14086 else {
14087 &$second_print($text{'check_noprocmail'});
14088 }
14089
14090 # Check for spamassassin call in /etc/procmailrc
14091 &require_spam();
14092 local @recipes = &procmail::get_procmailrc();
14093 foreach my $r (@recipes) {
14094 if ($r->{'action'} =~ /spamassassin|spamc/) {
14095 return &text('check_spamglobal',
14096 "<tt>$procmail::procmailrc</tt>");
14097 }
14098 }
14099
14100 # Check for spam_white conflict with spamc
14101 if ($config{'spam_white'}) {
14102 local ($client, $host, $size) = &get_global_spam_client();
14103 if ($client eq "spamc") {
14104 return &text('check_spamwhite', $mclink,
14105 "edit_newsv.cgi");
14106 }
14107 }
14108
14109 # If using Postfix, procmail-wrapper must be used and setuid root
14110 if ($hasprocmail && $config{'mail_system'} == 0) {
14111 &require_mail();
14112 local $mbc = &postfix::get_real_value("mailbox_command");
14113 local @mbc = &split_quoted_string($mbc);
14114 $mbc[0] = &has_command($mbc[0]);
14115 local @st = stat($mbc[0]);
14116 if (!&has_command($mbc[0])) {
14117 # Procmail does not exist
14118 return &text('check_spamwrappercmd', $mbc[0]);
14119 }
14120 if ($st[4] != 0) {
14121 # User is not root
14122 local $user = getpwuid($st[4]);
14123 return &text('check_spamwrapperuser', $mbc[0],
14124 $user || "UID $st[4]");
14125 }
14126 if ($st[5] != 0) {
14127 # Group is not root
14128 local $group = getgrgid($st[5]);
14129 return &text('check_spamwrappergroup', $mbc[0],
14130 $group || "GID $st[5]");
14131 }
14132 if (($st[2] & 04000) != 04000) {
14133 # Not setuid and setgid
14134 return &text('check_spamwrapperperms', $mbc[0],
14135 sprintf("%o", $st[2]));
14136 }
14137 }
14138 }
14139
14140if ($config{'virus'}) {
14141 # Make sure ClamAV is installed and working
14142 $config{'spam'} || return $text{'check_evirusspam'};
14143 &full_clamscan_path() ||
14144 return &text('index_evirus',
14145 "<tt>$config{'clamscan_cmd'}</tt>", $clink);
14146 if ($config{'clamscan_cmd'} eq "clamdscan") {
14147 # Need clamd to be running
14148 &find_byname("clamd") || return $text{'check_eclamd'};
14149 }
14150 local $err;
14151 if ($config{'clamscan_cmd_tested'} ne $config{'clamscan_cmd'}) {
14152 $err = &test_virus_scanner($config{'clamscan_cmd'},
14153 $config{'clamscan_host'});
14154 }
14155 if ($err) {
14156 # Failed .. but this can often be due to the ClamAV database
14157 # being out of date.
14158 local $freshclam = &has_command("freshclam");
14159 if (!$freshclam &&
14160 $config{'clamscan_cmd'} =~ /^(\/.*\/)[^\/]+$/) {
14161 $freshclam = $1."freshclam";
14162 }
14163 if (-x $freshclam) {
14164 local $cout = &backquote_with_timeout($freshclam, 180);
14165 $err = &test_virus_scanner($config{'clamscan_cmd'},
14166 $config{'clamscan_host'});
14167 }
14168 }
14169 if ($err) {
14170 return &text('index_evirusrun2',
14171 "<tt>$config{'clamscan_cmd'}</tt>",
14172 $err, "edit_newsv.cgi");
14173 }
14174 if ($config{'clamscan_cmd_tested'} eq $config{'clamscan_cmd'}) {
14175 &$second_print($text{'check_virusok2'});
14176 }
14177 else {
14178 $config{'clamscan_cmd_tested'} = $config{'clamscan_cmd'};
14179 &$second_print($text{'check_virusok'});
14180 }
14181 }
14182
14183if ($config{'status'}) {
14184 # Make sure scheduled status monitoring is enabled
14185 &foreign_check("status") ||
14186 return &text('index_estatus', "/status/", $clink);
14187 local %sconfig = &foreign_config("status");
14188 if ($sconfig{'sched_mode'}) {
14189 &$second_print($text{'check_statusok'});
14190 }
14191 else {
14192 &$second_print(&text('check_statussched',
14193 "../status/edit_sched.cgi"));
14194 }
14195 }
14196
14197# Check all plugins
14198foreach $p (@plugins) {
14199 if ($p eq "virtualmin-mysqluser") {
14200 return &text('check_emysqlplugin');
14201 }
14202 local $err = &plugin_call($p, "feature_check");
14203 if ($err) {
14204 return $err;
14205 }
14206 else {
14207 $pname = &plugin_call($p, "feature_name");
14208 &$second_print(&text('check_plugin', $pname));
14209 }
14210 }
14211
14212if (!$config{'iface'}) {
14213 if (!&running_in_zone()) {
14214 # Work out the network interface automatically
14215 $config{'iface'} = &first_ethernet_iface();
14216 if (!$config{'iface'}) {
14217 return &text('index_eiface',
14218 "../config.cgi?$module_name");
14219 }
14220 &save_module_config();
14221 }
14222 else {
14223 # In a zone, it is worked out as needed, as it changes!
14224 $config{'iface'} = undef;
14225 }
14226 }
14227if (!&running_in_zone()) {
14228 &$second_print(&text('check_ifaceok', "<tt>$config{'iface'}</tt>"));
14229 }
14230
14231# Tell the user that IPv6 is available
14232if (&supports_ip6()) {
14233 !$config{'netmask6'} || $config{'netmask6'} =~ /^\d+$/ ||
14234 return &text('check_enetmask6', $config{'netmask6'});
14235 &$second_print(&text('check_iface6',
14236 "<tt>".($config{'iface6'} || $config{'iface'})."</tt>"));
14237 }
14238
14239# Show the default IPv4 address
14240local $defip = &get_default_ip();
14241if (!$defip) {
14242 return &text('index_edefip', "../config.cgi?$module_name");
14243 }
14244else {
14245 &$second_print(&text('check_defip', $defip));
14246 }
14247$config{'old_defip'} ||= $defip;
14248
14249# Show the default IPv6 address
14250if (&supports_ip6()) {
14251 local $defip6 = &get_default_ip6();
14252 if (!$defip6) {
14253 &$second_print("<b>".&text('index_edefip6',
14254 "../config.cgi?$module_name")."</b>");
14255 }
14256 else {
14257 &$second_print(&text('check_defip6', $defip6));
14258 }
14259 $config{'old_defip6'} ||= $defip6;
14260 }
14261
14262# Make sure the external IP is set if needed
14263if ($config{'dns_ip'} ne '*') {
14264 local $dns_ip = $config{'dns_ip'} || $defip;
14265 local $ext_ip = &get_external_ip_address();
14266 if ($ext_ip && $ext_ip eq $dns_ip) {
14267 # Looks OK
14268 &$second_print(&text($config{'dns_ip'} ? 'check_dnsip1' :
14269 'check_dnsip2', $dns_ip));
14270 }
14271 elsif ($ext_ip && $ext_ip ne $dns_ip) {
14272 # Mis-match .. warn user
14273 &$second_print("<b>".&text($config{'dns_ip'} ? 'check_ednsip1' :
14274 'check_ednsip2', $dns_ip, $ext_ip,
14275 "../config.cgi?$module_name")."</b>");
14276 }
14277 }
14278
14279# Make sure local group exists
14280if ($config{'localgroup'} && !defined(getgrnam($config{'localgroup'}))) {
14281 return &text('index_elocal', "<tt>$config{'localgroup'}</tt>",
14282 "../config.cgi?$module_name");
14283 }
14284
14285# Validate home directory format
14286if ($config{'home_base'} && $config{'home_base'} !~ /^\/\S+/) {
14287 return &text('check_ehomebase', "<tt>$config{'home_base'}</tt>",
14288 "../config.cgi?$module_name");
14289 }
14290&require_useradmin();
14291if (!$config{'home_base'} && $uconfig{'home_base'} !~ /^\/\S+/) {
14292 return &text('check_ehomebase2', "<tt>$uconfig{'home_base'}</tt>",
14293 "../config.cgi?useradmin");
14294 }
14295if ($config{'home_format'} &&
14296 $config{'home_format'} !~ /\$\{(USER|UID|DOM|PREFIX)\}/ &&
14297 $config{'home_format'} !~ /\$(USER|UID|DOM|PREFIX)/) {
14298 return &text('check_ehomeformat', "<tt>$config{'home_format'}</tt>",
14299 "../config.cgi?$module_name");
14300 }
14301elsif (!$config{'home_format'} && $uconfig{'home_style'} == 4) {
14302 return &text('check_ehomestyle', "../config.cgi?useradmin");
14303 }
14304
14305$config{'home_quotas'} = '';
14306$config{'mail_quotas'} = '';
14307$config{'group_quotas'} = '';
14308if ($config{'quotas'} && $config{'quota_commands'}) {
14309 # External commands are being used for quotas - make sure they exist!
14310 foreach my $c ("set_user", "set_group", "list_users", "list_groups") {
14311 local $cmd = $config{"quota_".$c."_command"};
14312 $cmd && &has_command($cmd) || return $text{'check_e'.$c};
14313 }
14314 foreach my $c ("get_user", "get_group") {
14315 local $cmd = $config{"quota_".$c."_command"};
14316 !$cmd || &has_command($cmd) || return $text{'check_e'.$c};
14317 }
14318 &$second_print($text{'check_quotacommands'});
14319 }
14320elsif ($config{'quotas'}) {
14321 # Make sure quotas are enabled, and work out where they are needed
14322 local $qerr;
14323 &require_useradmin();
14324 if (!$home_base) {
14325 $qerr = &text('index_ehomebase');
14326 }
14327 elsif (&running_in_zone()) {
14328 $qerr = &text('index_ezone');
14329 }
14330 else {
14331 local $mail_base = &simplify_path(&resolve_links(
14332 &mail_system_base()));
14333 local ($home_mtab, $home_fstab) = &mount_point($home_base);
14334 local ($mail_mtab, $mail_fstab) = &mount_point($mail_base);
14335 if (!$home_mtab) {
14336 $qerr = &text('index_ehomemtab', "<tt>$home_base</tt>");
14337 }
14338 elsif (!$mail_mtab) {
14339 $qerr = &text('index_emailmtab', "<tt>$mail_base</tt>");
14340 }
14341 else {
14342 # Check if quotas are enabled for home filesystem
14343 local $nohome;
14344 $home_mtab->[4] = "a::quota_can($home_mtab,
14345 $home_fstab);
14346 $home_mtab->[4] &&= "a::quota_now($home_mtab,
14347 $home_fstab);
14348 if (!($home_mtab->[4] % 2)) {
14349 # User quotas are not active
14350 $nohome++;
14351 }
14352 else {
14353 # User quotas are active
14354 if ($home_mtab->[4] >= 2) {
14355 # Group quotas are active too
14356 $config{'group_quotas'} = 1;
14357 }
14358 }
14359
14360 if ($home_mtab->[0] eq $mail_mtab->[0]) {
14361 # Home and mail are the same filesystem
14362 if ($nohome) {
14363 # Neither are enabled
14364 $qerr = &text('index_equota2',
14365 "<tt>$home_mtab->[0]</tt>",
14366 "<tt>$home_base</tt>",
14367 "<tt>$mail_base</tt>");
14368 }
14369 else {
14370 # Both are enabled
14371 $config{'home_quotas'} =
14372 $home_mtab->[0];
14373 $config{'mail_quotas'} =
14374 $home_mtab->[0];
14375 }
14376 }
14377 else {
14378 # Different .. so check mail too
14379 local $nomail;
14380 $mail_mtab->[4] = "a::quota_can(
14381 $mail_mtab, $mail_fstab);
14382 $mail_mtab->[4] &&= "a::quota_now(
14383 $mail_mtab, $mail_fstab);
14384 if (!$mail_mtab->[4]) {
14385 # Mail user quotas are not active
14386 $nomail++;
14387 }
14388 if ($nohome) {
14389 $qerr = &text('index_equota3',
14390 "<tt>$home_mtab->[0]</tt>",
14391 "<tt>$home_base</tt>");
14392 }
14393 else {
14394 $config{'home_quotas'} =
14395 $home_mtab->[0];
14396 }
14397 if ($nomail) {
14398 $qerr = &text('index_equota4',
14399 "<tt>$mail_mtab->[0]</tt>",
14400 "<tt>$mail_base</tt>");
14401 }
14402 else {
14403 $config{'mail_quotas'} =
14404 $mail_mtab->[0];
14405 }
14406 }
14407 }
14408 }
14409 if ($qerr) {
14410 &$second_print("<b>$qerr</b>");
14411 }
14412 elsif (!$config{'group_quotas'}) {
14413 &$second_print($text{'check_nogroup'});
14414 }
14415 else {
14416 &$second_print($text{'check_group'});
14417 }
14418 }
14419else {
14420 &$second_print($text{'check_noquotas'});
14421 }
14422
14423# Check for FTP shells in /etc/shells
14424local $_;
14425open(SHELLS, "/etc/shells");
14426while(<SHELLS>) {
14427 s/\r|\n//g;
14428 s/#.*$//;
14429 $shells{$_}++;
14430 }
14431close(SHELLS);
14432local ($nologin_shell, $ftp_shell) = &get_common_available_shells();
14433if ($nologin_shell && $shells{$nologin_shell->{'shell'}}) {
14434 &$second_print(&text('check_eshell',
14435 "<tt>$nologin_shell->{'shell'}</tt>", "<tt>/etc/shells</tt>"));
14436 }
14437if ($ftp_shell && !$shells{$ftp_shell->{'shell'}}) {
14438 &$second_print(&text('check_eftpshell',
14439 "<tt>$ftp_shell->{'shell'}</tt>", "<tt>/etc/shells</tt>"));
14440 }
14441
14442# Check for problem module config settings
14443if ($config{'all_namevirtual'} && $config{'dns_ip'}) {
14444 return &text('check_enamevirt', $clink);
14445 }
14446
14447# Make sure LDAP module is set up, if selected
14448if ($config{'ldap'}) {
14449 &require_useradmin();
14450 local $ldap = &ldap_useradmin::ldap_connect(1);
14451 if (!ref($ldap)) {
14452 return &text('check_eldap', $ldap, $clink,
14453 "../ldap-useradmin/");
14454 }
14455 else {
14456 &require_useradmin();
14457 if (!defined(&ldap_useradmin::list_users)) {
14458 return &text('check_eldap2', $clink, 1.164);
14459 }
14460 else {
14461 &$second_print(&text('check_ldap'));
14462 }
14463 }
14464 }
14465
14466# Check for NSCD
14467if ($config{'unix'}) {
14468 if (&find_byname("nscd")) {
14469 local $msg;
14470 if (&foreign_available("init")) {
14471 &foreign_require("init");
14472 if (($init::init_mode eq 'init' ||
14473 $init::init_mode eq 'upstart' ||
14474 $init::init_mode eq 'systemd') &&
14475 &init::action_status("nscd") == 2) {
14476 $msg = &text('check_enscd2',
14477 '../init/edit_action.cgi?0+nscd');
14478 }
14479 }
14480 &$second_print($text{'check_enscd'}." ".$msg);
14481 }
14482 }
14483
14484# Check for conflicting other-modules calls
14485if ($config{'unix'} && $config{'other_users'}) {
14486 # MySQL user creation
14487 local %mconfig = &foreign_config('mysql');
14488 if ($mconfig{'sync_create'} || $mconfig{'sync_modify'} ||
14489 $mconfig{'sync_delete'}) {
14490 return &text('check_emysqlsync', '../mysql/list_users.cgi');
14491 }
14492 # User and group default quotas
14493 if ($config{'home_quotas'}) {
14494 local %qconfig = &foreign_config('quota');
14495 local @syncs = map { /^sync_(\S+)/; $1 }
14496 grep { /^sync_/ } (keys %qconfig);
14497 if (@syncs) {
14498 return &text('check_equotasync',
14499 join(' , ', map { "<tt>$_</tt>" } @syncs),
14500 '../quota/');
14501 }
14502 local @gsyncs = map { /^gsync_(\S+)/; $1 }
14503 grep { /^gsync_/ } (keys %qconfig);
14504 if (@gsyncs) {
14505 return &text('check_egquotasync',
14506 join(' , ', map { "<tt>$_</tt>" } @gsyncs),
14507 '../quota/');
14508 }
14509 }
14510 }
14511
14512# Make sure needed compression programs are installed
14513if (!&has_command("tar")) {
14514 return &text('check_ebcmd', "<tt>tar</tt>");
14515 }
14516local @bcmds = $config{'compression'} == 0 ? ( "gzip", "gunzip" ) :
14517 $config{'compression'} == 3 ? ( "zip", "unzip" ) :
14518 $config{'compression'} == 1 && $config{'pbzip2'} ? ( "pbzip2" ) :
14519 $config{'compression'} == 1 ? ( "bzip2", "bunzip2" ) :
14520 ( );
14521foreach my $bcmd (@bcmds) {
14522 if (!&has_command($bcmd)) {
14523 return &text('check_ebcmd', "<tt>$bcmd</tt>");
14524 }
14525 }
14526
14527# If pbzip2 is being used, make sure it is a version that supports
14528# compressing to stdout
14529if ($config{'compression'} == 1 && $config{'pbzip2'}) {
14530 local $out = &backquote_command("pbzip2 -V 2>&1");
14531 if ($out !~ /Parallel\s+BZIP2\s+v([0-9\.]+)/i) {
14532 return &text('check_epbzip2out',
14533 "<tt>".&html_escape($out)."</tt>");
14534 }
14535 local $ver = $1;
14536 if (&compare_versions($ver, "1.0.4") < 0) {
14537 return &text('check_epbzip2ver', "1.0.4", $ver);
14538 }
14539 }
14540
14541&$second_print(&text('check_bcmdok'));
14542
14543# Check if resource limits are supported
14544if (defined(&supports_resource_limits)) {
14545 local ($rok, $rmsg) = &supports_resource_limits(1);
14546 &$second_print(!$rok ? &text('check_reserr', $rmsg) :
14547 $rmsg ? &text('check_reswarn', $rmsg) :
14548 $text{'check_resok'});
14549 }
14550
14551# Check if software packages work, for script installs
14552if (&foreign_check("software")) {
14553 &foreign_require("software");
14554 if (defined(&software::check_package_system)) {
14555 local $err = &software::check_package_system();
14556 local $uerr = &software::check_update_system();
14557 if ($err) {
14558 &$second_print(&text('check_packageerr', $err));
14559 }
14560 elsif ($uerr) {
14561 &$second_print(&text('check_updateerr', $err));
14562 }
14563 else {
14564 &$second_print(&text('check_packageok'));
14565 }
14566 }
14567 }
14568
14569# Check for disabled features that are in use
14570my @doms = &list_domains();
14571foreach my $f (@features) {
14572 if (!$config{$f} && (!$lastconfig || $lastconfig->{$f})) {
14573 my @lost = grep { $_->{$f} } @doms;
14574 if (@lost) {
14575 return &text('check_lostfeature', $text{'feature_'.$f},
14576 join(" ", map { $_->{'dom'} } @lost));
14577 }
14578 }
14579 }
14580
14581# All looks OK .. save the config
14582$config{'last_check'} = time()+1;
14583$config{'disable'} =~ s/user/unix/g; # changed since last release
14584&lock_file($module_config_file);
14585&save_module_config();
14586&unlock_file($module_config_file);
14587&write_file("$module_config_directory/last-config", \%config);
14588
14589return undef;
14590}
14591
14592# need_update_webmin_users_post_config(&oldconfig)
14593# Check if we need to Webmin users following a config re-check
14594sub need_update_webmin_users_post_config
14595{
14596local ($lastconfig) = @_;
14597local $webminchanged = 0;
14598foreach my $k (keys %config) {
14599 if ($k eq 'leave_acl' || $k eq 'webmin_modules' ||
14600 &indexof($k, @features) >= 0) {
14601 $webminchanged++ if ($config{$k} ne $lastconfig->{$k});
14602 }
14603 }
14604return $webminchanged;
14605}
14606
14607# get_beancounters()
14608# Returns the contents of /proc/user_beancounters for this VM
14609sub get_beancounters
14610{
14611local %beans;
14612local $inctx = 0;
14613open(BEANS, "/proc/user_beancounters") || return undef;
14614while(<BEANS>) {
14615 if (/^\s*(\d+):/) {
14616 if ($1 != 0) {
14617 $inctx = 1;
14618 }
14619 else {
14620 $inctx = 0;
14621 }
14622 }
14623 if (/\s+(\S+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)/ && $inctx) {
14624 $beans{$1} = $5;
14625 }
14626 }
14627close(BEANS);
14628return \%beans;
14629}
14630
14631# run_post_config_actions(&lastconfig)
14632# Make various changes to the system as specified by a new module config.
14633# May print stuff.
14634sub run_post_config_actions
14635{
14636local %lastconfig = %{$_[0]};
14637
14638# Update the domain owner's group
14639&update_domain_owners_group();
14640
14641# Update preload settings if changed
14642if ($config{'preload_mode'} != $lastconfig{'preload_mode'}) {
14643 &$first_print($text{'check_preload'});
14644 &update_miniserv_preloads($config{'preload_mode'});
14645 &restart_miniserv();
14646 &$second_print($text{'setup_done'});
14647 }
14648
14649# Update collectinfo.pl run time
14650if ($config{'collect_interval'} ne $lastconfig{'collect_interval'}) {
14651 if ($config{'collect_interval'} eq 'none') {
14652 &$first_print($text{'check_collectoff'});
14653 }
14654 else {
14655 &$first_print($text{'check_collect'});
14656 }
14657 &setup_collectinfo_job();
14658 &$second_print($text{'setup_done'});
14659 }
14660
14661# Re-collect system info
14662local $info = &collect_system_info();
14663if ($info) {
14664 &save_collected_info($info);
14665 }
14666
14667# Update spamassassin lock files
14668if ($config{'spam_lock'} != $lastconfig{'spam_lock'}) {
14669 &$first_print($config{'spam_lock'} ? $text{'check_spamlockon'}
14670 : $text{'check_spamlockoff'});
14671 &save_global_spam_lockfile($config{'spam_lock'});
14672 &$second_print($text{'setup_done'});
14673 }
14674
14675# Fix default procmail delivery if changed
14676if ($config{'default_procmail'} != $lastconfig{'default_procmail'}) {
14677 &setup_default_delivery();
14678 }
14679
14680# Re-create API helper command
14681if ($config{'api_helper'} ne $lastconfig{'api_helper'}) {
14682 &$first_print($text{'check_apicmd'});
14683 local ($ok, $path) = &create_api_helper_command();
14684 &$second_print(&text($ok ? 'check_apicmdok' : 'check_apicmderr',
14685 $path));
14686 }
14687
14688# Restart lookup-domain daemon, if need
14689if ($config{'spam'} && !$config{'no_lookup_domain_daemon'}) {
14690 &setup_lookup_domain_daemon();
14691 }
14692
14693# If bandwidth checking was enabled in the backup, re-enable it now
14694&setup_bandwidth_job($config{'bw_active'}, $config{'bw_step'} || 1);
14695
14696# Re-setup script warning job, if it was enabled
14697if (defined(&setup_scriptwarn_job) && defined($config{'scriptwarn_enabled'})) {
14698 &setup_scriptwarn_job($config{'scriptwarn_enabled'},
14699 $config{'scriptwarn_wsched'});
14700 }
14701
14702# Re-setup script updates job, if it was enabled
14703if (defined(&setup_scriptlatest_job) && $config{'scriptlatest_enabled'}) {
14704 &setup_scriptlatest_job(1);
14705 }
14706
14707# Re-setup spam clearing / retention cron job
14708&setup_spamclear_cron_job();
14709
14710# Re-setup the validation cron job based on the saved config
14711local ($oldjob, $job);
14712$oldjob = $job = &find_cron_script($validate_cron_cmd);
14713$job ||= { 'user' => 'root',
14714 'active' => 1,
14715 'command' => $validate_cron_cmd };
14716if ($oldjob) {
14717 &delete_cron_script($validate_cron_cmd);
14718 }
14719if ($config{'validate_sched'}) {
14720 # Re-create cron job
14721 if ($config{'validate_sched'} =~ /^\@(\S+)/) {
14722 $job->{'special'} = $1;
14723 }
14724 else {
14725 ($job->{'mins'}, $job->{'hours'}, $job->{'days'},
14726 $job->{'months'}, $job->{'weekdays'}) =
14727 split(/\s+/, $config{'validate_sched'});
14728 delete($job->{'special'});
14729 }
14730 &setup_cron_script($job);
14731 }
14732
14733# Enable or disable mail client auto-config
14734if ($config{'mail_autoconfig'} ne '') {
14735 my @doms = grep { $_->{'mail'} && &domain_has_website($_) &&
14736 !$_->{'alias'} } &list_domains();
14737 foreach my $d (@doms) {
14738 if ($config{'mail_autoconfig'} eq '1') {
14739 &enable_email_autoconfig($d);
14740 }
14741 else {
14742 &disable_email_autoconfig($d);
14743 }
14744 }
14745 }
14746}
14747
14748# mount_point(dir)
14749# Returns both the mtab and fstab details for the parent mount for a directory
14750sub mount_point
14751{
14752local $dir = &resolve_links($_[0]);
14753if ($mount_point_cache{$dir}) {
14754 # Already found, so no need to re-lookup
14755 return @{$mount_point_cache{$dir}};
14756 }
14757&foreign_require("mount");
14758local @mounts = &mount::list_mounts();
14759local @mounted = &mount::list_mounted();
14760# Exclude swap mounts
14761local @realmounts = grep { $_->[0] ne 'none' &&
14762 $_->[0] ne 'proc' &&
14763 $_->[0] ne '/proc' &&
14764 $_->[0] !~ /^swap/ &&
14765 $_->[1] ne 'none' } @mounts;
14766if (!@realmounts) {
14767 # If /etc/fstab contains no real mounts (such as in a VPS environment),
14768 # then fake it to be the same as /etc/mtab
14769 @mounts = @mounted;
14770 }
14771foreach my $m (sort { length($b->[0]) <=> length($a->[0]) } @mounted) {
14772 if ($dir eq $m->[0] || $m->[0] eq "/" ||
14773 substr($dir, 0, length($m->[0])+1) eq "$m->[0]/") {
14774 # Found currently mounted parent directory
14775 local ($m2) = grep { $_->[0] eq $m->[0] } @mounts;
14776 if ($m2) {
14777 if ($m2->[2] eq "bind" && $m2->[0] eq $m2->[1]) {
14778 # Skip loopback mount onto same directory,
14779 # as any quotas will be defined in the real
14780 # mount.
14781 next;
14782 }
14783 # Found boot-time mount as well
14784 $mount_point_cache{$dir} = [ $m, $m2 ];
14785 return ($m, $m2);
14786 }
14787 }
14788 }
14789print STDERR "Failed to find mount point for $dir\n";
14790return ( );
14791}
14792
14793# sub_mount_points(dir)
14794# Returns the mtab entries for mounts at or under some directory
14795sub sub_mount_points
14796{
14797local $dir = &resolve_links($_[0]);
14798&foreign_require("mount");
14799local @mounted = &mount::list_mounted();
14800local @rv;
14801foreach my $m (@mounted) {
14802 if ($dir eq $m->[0] || &is_under_directory($dir, $m->[0])) {
14803 push(@rv, $m);
14804 }
14805 }
14806return @rv;
14807}
14808
14809# show_template_basic(&tmpl)
14810# Outputs HTML for editing basic template options (like the name)
14811sub show_template_basic
14812{
14813local ($tmpl) = @_;
14814
14815# Name of this template - only editable for custom templates
14816print &ui_table_row(&hlink($text{'tmpl_name'}, "template_name"),
14817 $tmpl->{'standard'} ? $tmpl->{'name'} :
14818 &ui_textbox("name", $tmpl->{'name'}, 40));
14819
14820# Who this template is suitable for
14821local @fors = ( );
14822foreach my $f ("parent", "sub", "alias", "users") {
14823 if ($tmpl->{'standard'} && $f ne "users") {
14824 if ($tmpl->{"for_".$f}) {
14825 push(@fors, $text{'tmpl_for_'.$f});
14826 }
14827 }
14828 else {
14829 push(@fors, &ui_checkbox("for_$f", 1,
14830 &hlink($text{'tmpl_for_'.$f}, "template_for_$f"),
14831 $tmpl->{"for_".$f}));
14832 }
14833 }
14834print &ui_table_row(&hlink($text{'tmpl_for'}, "template_for"),
14835 join(", ", @fors));
14836
14837# Which resellers can use this template?
14838local @resels = $virtualmin_pro ? &list_resellers() : ( );
14839if (@resels) {
14840 print &ui_table_row(
14841 &hlink($text{'tmpl_resellers'}, "template_resellers"),
14842 &ui_radio("resellers_def", $tmpl->{'resellers'} eq "*" ? 1 :
14843 $tmpl->{'resellers'} ? 0 : 2,
14844 [ [ 1, $text{'tmpl_resellers_all'} ],
14845 [ 2, $text{'tmpl_resellers_none'} ],
14846 [ 0, $text{'tmpl_resellers_sel'} ] ])."<br>\n".
14847 &ui_select("resellers", [ split(/\s+/, $tmpl->{'resellers'}) ],
14848 [ map { [ $_->{'name'},
14849 $_->{'name'}.
14850 ($_->{'acl'}->{'desc'} ?
14851 " ($_->{'acl'}->{'desc'})" : "") ] }
14852 @resels ], 5, 1));
14853 }
14854
14855# Which system owners can use this template
14856local @owners = &unique(map { $_->{'user'} } &list_domains());
14857print &ui_table_row(
14858 &hlink($text{'tmpl_owners'}, "template_owners"),
14859 &ui_radio("owners_def", $tmpl->{'owners'} eq "*" ? 1 :
14860 $tmpl->{'owners'} eq "" ? 2 : 0,
14861 [ [ 1, $text{'tmpl_owners_all'} ],
14862 [ 2, $text{'tmpl_owners_none'} ],
14863 [ 0, $text{'tmpl_owners_sel'} ] ])."<br>\n".
14864 &ui_select("owners", [ split(/\s+/, $tmpl->{'owners'}) ],
14865 \@owners, 5, 1));
14866}
14867
14868# parse_template_basic(&tmpl)
14869sub parse_template_basic
14870{
14871local ($tmpl) = @_;
14872
14873if (!$tmpl->{'standard'}) {
14874 $in{'name'} || &error($text{'tmpl_ename'});
14875 $tmpl->{'name'} = $in{'name'};
14876 }
14877
14878# Save for-use-by list
14879foreach my $f ($tmpl->{'standard'} ? ( "users" )
14880 : ( "parent", "sub", "alias", "users" )) {
14881 $tmpl->{"for_".$f} = $in{"for_".$f};
14882 }
14883
14884local @resels = $virtualmin_pro ? &list_resellers() : ( );
14885if (@resels) {
14886 # Save list of allowed resellers
14887 if ($in{'resellers_def'} == 1) {
14888 $tmpl->{'resellers'} = '*';
14889 }
14890 elsif ($in{'resellers_def'} == 2) {
14891 $tmpl->{'resellers'} = '';
14892 }
14893 else {
14894 $tmpl->{'resellers'} = join(" ", split(/\0/, $in{'resellers'}));
14895 $tmpl->{'resellers'} || &error($text{'tmpl_eresellers'});
14896 }
14897 }
14898
14899# Save system owners
14900if ($in{'owners_def'} == 1) {
14901 $tmpl->{'owners'} = '*';
14902 }
14903elsif ($in{'owners_def'} == 2) {
14904 $tmpl->{'owners'} = '';
14905 }
14906else {
14907 $tmpl->{'owners'} = join(" ", split(/\0/, $in{'owners'}));
14908 $tmpl->{'owners'} || &error($text{'tmpl_eowners'});
14909 }
14910}
14911
14912# show_template_plugins(&tmpl)
14913# Outputs HTML for editing emplate options from plugins
14914sub show_template_plugins
14915{
14916# Show plugin-specific template options
14917my $plugtmpl = "";
14918foreach my $f (@plugins) {
14919 if (&plugin_defined($f, "template_input")) {
14920 $plugtmpl .= &plugin_call($f, "template_input", $tmpl);
14921 }
14922 }
14923if ($plugtmpl) {
14924 print $plugtmpl;
14925 }
14926else {
14927 print &ui_table_row(undef, "<b>$text{'tmpl_noplugins'}</b>");
14928 }
14929}
14930
14931# parse_template_plugins(&tmpl)
14932# Parse plugin options
14933sub parse_template_plugins
14934{
14935local ($tmpl) = @_;
14936foreach my $f (@plugins) {
14937 if (&plugin_defined($f, "template_parse")) {
14938 &plugin_call($f, "template_parse", $tmpl, \%in);
14939 }
14940 }
14941}
14942
14943# list_domain_owner_modules()
14944# Returns a list of modules that can be granted to domain owners, as array refs
14945# with module name, description and list of options (optional) entries.
14946sub list_domain_owner_modules
14947{
14948local @rv = (
14949 [ 'dns', 'BIND DNS Server (for DNS domain)' ],
14950 [ 'mail', 'Virtual Email (for mailboxes and aliases)' ],
14951 [ 'web', 'Apache Webserver (for virtual host)' ],
14952 [ 'webalizer', 'Webalizer Logfile Analysis (for website\'s logs)' ],
14953 [ 'mysql', 'MySQL Database Server (for database)' ],
14954 [ 'postgres', 'PostgreSQL Database Server (for database)' ],
14955 [ 'spam', 'SpamAssassin Mail Filter (for domain\'s config file)' ],
14956 [ 'file', 'Java File Manager (home directory only)' ],
14957 [ 'filemin', 'Filemin File Manager (home directory only)' ],
14958 [ 'passwd', 'Change Password',
14959 [ [ 2, 'User and mailbox passwords' ],
14960 [ 1, 'User password' ],
14961 [ 0, 'No' ] ] ],
14962 [ 'proc', 'Running Processes (user\'s processes only)',
14963 [ [ 2, 'See own processes' ],
14964 [ 1, 'See all processes' ],
14965 [ 0, 'No' ] ] ],
14966 [ 'cron', 'Scheduled Cron Jobs (user\'s Cron jobs)' ],
14967 [ 'at', 'Scheduled Commands (user\'s commands)' ],
14968 [ 'telnet', 'SSH Login' ],
14969 [ 'updown', 'Upload and Download (as user)',
14970 [ [ 1, 'Yes' ],
14971 [ 0, 'No' ],
14972 [ 2, 'Upload only' ] ] ],
14973 [ 'change-user', 'Change Language and Theme' ],
14974 [ 'htaccess-htpasswd', 'Protected Web Directories (under home directory)' ],
14975 [ 'mailboxes', 'Read User Mail (users\' mailboxes)' ],
14976 [ 'custom', 'Custom Commands' ],
14977 [ 'shell', 'Command Shell (run commands as admin)' ],
14978 [ 'webminlog', 'Webmin Actions Log (view own actions)' ],
14979 [ 'syslog', 'System Logs (view Apache and FTP logs)' ],
14980 [ 'phpini', 'PHP Configuration (for domain\'s php.ini files)' ],
14981 );
14982&load_plugin_libraries();
14983foreach my $p (@plugins) {
14984 if (&plugin_defined($p, "feature_modules")) {
14985 push(@rv, &plugin_call($p, "feature_modules"));
14986 }
14987 }
14988return @rv;
14989}
14990
14991# show_template_avail(&tmpl)
14992# Output HTML for selecting modules available to domain owners
14993sub show_template_avail
14994{
14995local ($tmpl) = @_;
14996local $field;
14997if (!$tmpl->{'default'}) {
14998 local @inames = map { "avail_".$_->[0] } &list_domain_owner_modules();
14999 local $dis1 = &js_disable_inputs(\@inames, [ ], 'onClick');
15000 local $dis2 = &js_disable_inputs([ ], \@inames, 'onClick');
15001 $field .= &ui_radio("avail_def", $tmpl->{'avail'} ? 0 : 1,
15002 [ [ 1, $text{'tmpl_avail1'}, $dis1 ],
15003 [ 0, $text{'tmpl_avail0'}, $dis2 ] ])."<br>\n";
15004 }
15005$field .= &ui_columns_start(
15006 [ $text{'tmpl_availmod'}, $text{'tmpl_availyes'} ]);
15007my $alist;
15008if ($tmpl->{'default'} || $tmpl->{'avail'}) {
15009 $alist = $tmpl->{'avail'};
15010 }
15011else {
15012 # Initial selection comes from default template
15013 my $deftmpl = &get_template(0);
15014 $alist = $deftmpl->{'avail'};
15015 }
15016my %avail = map { split(/=/, $_, 2) } split(/\s+/, $alist);
15017# If not set yet, assumed enabled for plugins
15018foreach my $p (@plugins) {
15019 if ($avail{$p} eq '') {
15020 $avail{$p} = 1;
15021 }
15022 }
15023foreach my $m (&list_domain_owner_modules()) {
15024 my $minp;
15025 if ($m->[2]) {
15026 $minp = &ui_radio("avail_".$m->[0], int($avail{$m->[0]}),
15027 $m->[2]);
15028 }
15029 else {
15030 $minp = &ui_yesno_radio("avail_".$m->[0], int($avail{$m->[0]}));
15031 }
15032 my @h = ( $m->[1], "config_avail_".$m->[0] );
15033 $field .= &ui_columns_row([
15034 -r &help_file($module_name, $h[1]) ? &hlink(@h) : $m->[1], $minp ]);
15035 }
15036$field .= &ui_columns_end();
15037print &ui_table_row(undef, $field, 2);
15038}
15039
15040# parse_template_avail(&tmpl)
15041# Update the list of modules available to domain owners
15042sub parse_template_avail
15043{
15044local ($tmpl) = @_;
15045if ($in{'avail_def'}) {
15046 $tmpl->{'avail'} = undef;
15047 }
15048else {
15049 local @avail;
15050 foreach my $m (&list_domain_owner_modules()) {
15051 push(@avail, $m->[0].'='.$in{'avail_'.$m->[0]});
15052 }
15053 $tmpl->{'avail'} = join(' ', @avail);
15054 }
15055}
15056
15057# show_template_virtualmin(&tmpl)
15058# Outputs HTML for editing core Virtualmin template options
15059sub show_template_virtualmin
15060{
15061local ($tmpl) = @_;
15062
15063# Automatic alias domain
15064local @afields = ( "domalias", "domalias_type", "domalias_tmpl" );
15065print &ui_table_row(&hlink($text{'tmpl_domalias'}, "template_domalias"),
15066 &none_def_input("domalias", $tmpl->{'domalias'},
15067 $text{'tmpl_aliasset'},
15068 undef, undef, $text{'no'}, \@afields)."\n".
15069 &ui_textbox("domalias", $tmpl->{'domalias'} eq "none" ? undef :
15070 $tmpl->{'domalias'}, 30));
15071
15072# Suffix for alias domain
15073my $mode = $tmpl->{'domalias_type'} eq '0' ? 0 :
15074 $tmpl->{'domalias_type'} eq '' ? 0 :
15075 $tmpl->{'domalias_type'} eq '1' ? 1 : 2;
15076print &ui_table_row(&hlink($text{'tmpl_domalias_type'},
15077 "template_domalias_type"),
15078 &ui_radio("domalias_type", $mode,
15079 [ [ 0, $text{'tmpl_domalias_type0'} ],
15080 [ 1, $text{'tmpl_domalias_type1'} ],
15081 [ 2, $text{'tmpl_domalias_type2'}." ".
15082 &ui_textbox("domalias_tmpl",
15083 $mode == 2 ? $tmpl->{'domalias_type'} : "", 20) ] ]));
15084}
15085
15086# parse_template_virtualmin(&tmpl)
15087# Updates core Virtualmin template options from %in
15088sub parse_template_virtualmin
15089{
15090local ($tmpl) = @_;
15091
15092# Parse automatic alias domain mode
15093$tmpl->{'domalias'} = &parse_none_def("domalias");
15094if ($in{'domalias_mode'} == 2) {
15095 $in{'domalias'} =~ /^[a-z0-9\.\-\_]+$/i ||
15096 &error($text{'tmpl_edomalias'});
15097 if ($in{'domalias_type'} == 2) {
15098 $in{'domalias_tmpl'} =~ /^\S+$/ ||
15099 &error($text{'tmpl_edomaliastmpl'});
15100 $tmpl->{'domalias_type'} = $in{'domalias_tmpl'};
15101 }
15102 else {
15103 $tmpl->{'domalias_type'} = $in{'domalias_type'};
15104 }
15105 }
15106}
15107
15108# show_template_autoconfig(&tmpl)
15109# Outputs HTML for mail client autoconfig XML
15110sub show_template_autoconfig
15111{
15112local ($tmpl) = @_;
15113
15114# XML for Thunderbird
15115local $xml;
15116if ($tmpl->{'autoconfig'} eq "" || $tmpl->{'autoconfig'} eq "none") {
15117 $xml = &get_thunderbird_autoconfig_xml();
15118 }
15119else {
15120 $xml = join("\n", split(/\t/, $tmpl->{'autoconfig'}));
15121 }
15122print &ui_table_row(
15123 &hlink($text{'tmpl_autoconfig'}, "template_autoconfig"),
15124 &none_def_input("autoconfig", $tmpl->{'autoconfig'},
15125 $text{'tmpl_autoconfigset'}, 0, 0,
15126 $text{'tmpl_autoconfignone'})."<br>\n".
15127 &ui_textarea("autoconfig", $xml, 20, 80));
15128
15129# XML for Outlook
15130if ($tmpl->{'outlook_autoconfig'} eq "" ||
15131 $tmpl->{'outlook_autoconfig'} eq "none") {
15132 $xml = &get_outlook_autoconfig_xml();
15133 }
15134else {
15135 $xml = join("\n", split(/\t/, $tmpl->{'outlook_autoconfig'}));
15136 }
15137print &ui_table_row(
15138 &hlink($text{'tmpl_outlook_autoconfig'}, "template_outlook_autoconfig"),
15139 &none_def_input("outlook_autoconfig", $tmpl->{'outlook_autoconfig'},
15140 $text{'tmpl_autoconfigset'}, 0, 0,
15141 $text{'tmpl_autoconfignone'})."<br>\n".
15142 &ui_textarea("outlook_autoconfig", $xml, 20, 80));
15143}
15144
15145# parse_template_autoconfig(&tmpl)
15146# Updates core mail client autoconfig template options from %in
15147sub parse_template_autoconfig
15148{
15149local ($tmpl) = @_;
15150
15151# Parse Thunderbird automatic alias domain mode
15152$tmpl->{'autoconfig'} = &parse_none_def("autoconfig");
15153if ($in{'autoconfig_mode'} == 2) {
15154 $in{'autoconfig'} =~ /<clientConfig.*>/i ||
15155 &error($text{'tmpl_eautoconfig'});
15156 }
15157
15158# Parse Outlook automatic alias domain mode
15159$tmpl->{'outlook_autoconfig'} = &parse_none_def("outlook_autoconfig");
15160if ($in{'outlook_autoconfig_mode'} == 2) {
15161 $in{'outlook_autoconfig'} =~ /<Autodiscover.*>/i ||
15162 &error($text{'tmpl_outlook_eautoconfig'});
15163 }
15164}
15165
15166# postsave_template_autoconfig(&tmpl)
15167# If mail autoconfig is active, update the template for all domains
15168sub postsave_template_autoconfig
15169{
15170local ($tmpl) = @_;
15171if ($config{'mail_autoconfig'}) {
15172 local @doms = grep { $_->{'mail'} && &domain_has_website($_) &&
15173 !$_->{'alias'} } &list_domains();
15174 foreach my $d (@doms) {
15175 &enable_email_autoconfig($d);
15176 }
15177 }
15178}
15179
15180# list_template_editmodes([&template])
15181# Returns a list of available template sections for editing
15182sub list_template_editmodes
15183{
15184local ($tmpl) = @_;
15185local @rv = grep { $sfunc = "show_template_".$_;
15186 defined(&$sfunc) &&
15187 ($config{$_} || !$isfeature{$_} || $_ eq 'mail' ||
15188 $_ eq 'web' && &domain_has_website()) }
15189 @template_features;
15190if ($tmpl && $tmpl->{'id'} == 1) {
15191 # For sub-servers only
15192 @rv = grep { $_ ne 'resources' && $_ ne 'unix' && $_ ne 'webmin' &&
15193 $_ ne 'avail' } @rv;
15194 }
15195return @rv;
15196}
15197
15198# substitute_domain_template(string, &domain, [&extra-hash], [html-escape])
15199# Does $VAR substitution in a string for a given domain, pulling in
15200# PARENT_DOMAIN variables too
15201sub substitute_domain_template
15202{
15203local ($str, $d, $extra, $escape) = @_;
15204local %hash = &make_domain_substitions($d, 0);
15205if ($extra) {
15206 %hash = ( %hash, %$extra );
15207 }
15208return &substitute_virtualmin_template($str, \%hash, $escape);
15209}
15210
15211# substitute_virtualmin_template(string, &hash, [html-escape])
15212# Just calls the standard substitute_template function, but with global
15213# variables added to the hash
15214sub substitute_virtualmin_template
15215{
15216local ($str, $hash, $escape) = @_;
15217local %ghash = %$hash;
15218foreach my $v (&get_global_template_variables()) {
15219 if ($v->{'enabled'} && !defined($ghash{$v->{'name'}})) {
15220 $ghash{$v->{'name'}} = $v->{'value'};
15221 }
15222 }
15223if ($escape) {
15224 # Escape XML / HTML special chars, for example when including in
15225 # mail client autoconfig template
15226 foreach my $v (keys %ghash) {
15227 $ghash{$v} = &html_escape($ghash{$v});
15228 }
15229 }
15230return &substitute_template($str, \%ghash);
15231}
15232
15233# absolute_domain_path(&domain, path)
15234# Converts some path to be relative to a domain, like foo.txt or bar/foo.txt or
15235# ~/bar/foo.txt. Absolute paths are not converted.
15236sub absolute_domain_path
15237{
15238local ($d, $path) = @_;
15239if ($path =~ /^\//) {
15240 # Already absolute
15241 return $path;
15242 }
15243elsif ($path =~ /^~\/(.*)/) {
15244 # Relative to home
15245 return $d->{'home'}.'/'.$1;
15246 }
15247else {
15248 # Also relative to home
15249 return $d->{'home'}.'/'.$path;
15250 }
15251}
15252
15253# get_init_template(for-subdom)
15254# Returns the ID of the initially selected template
15255sub get_init_template
15256{
15257local $rv = $_[0] ? $config{'initsub_template'} : $config{'init_template'};
15258if ($rv > 1 && !-r "$templates_dir/$rv") {
15259 # Template doesn't exist! Return sensible default
15260 return $_[0] ? 1 : 0;
15261 }
15262return $rv;
15263}
15264
15265# set_chained_features(&domain, [&old-domain])
15266# Updates a domain object, setting any features that are automatically based
15267# on another. Called from .cgi scripts to activate hidden features (mode 3).
15268sub set_chained_features
15269{
15270local ($d, $oldd) = @_;
15271foreach my $f (@features) {
15272 if ($config{$f} == 3) {
15273 local $cfunc = "chained_$f";
15274 if (defined(&$cfunc)) {
15275 local $c = &$cfunc($d, $oldd);
15276 if (defined($c)) {
15277 $d->{$f} = $c;
15278 }
15279 }
15280 }
15281 }
15282}
15283
15284# check_password_restrictions(&user, [webmin-too], [&domain])
15285# Returns an error if some user's password (from plainpass) is not acceptable
15286sub check_password_restrictions
15287{
15288local ($user, $webmin, $d) = @_;
15289&require_useradmin();
15290local $err = &useradmin::check_password_restrictions(
15291 $user->{'plainpass'}, $user->{'user'}, $user);
15292return $err if ($err);
15293if ($d) {
15294 # Check again with short username
15295 $err = &useradmin::check_password_restrictions(
15296 $user->{'plainpass'}, &remove_userdom($user->{'user'}, $d),
15297 $user);
15298 return $err if ($err);
15299 }
15300if ($webmin) {
15301 # Check ACL module too
15302 &foreign_require("acl");
15303 $err = &acl::check_password_restrictions(
15304 $user->{'user'}, $user->{'plainpass'});
15305 return $err if ($err);
15306 }
15307return undef;
15308}
15309
15310# lock_domain_name(name)
15311# Obtain a lock on some domain name, to prevent concurrent creation
15312sub lock_domain_name
15313{
15314local ($name) = @_;
15315if (!-d $domainnames_dir) {
15316 &make_dir($domainnames_dir, 0755);
15317 }
15318&lock_file("$domainnames_dir/$name");
15319}
15320
15321# show_domain_quota_usage(&domain)
15322# Prints ui_table fields for quota usage in a domain
15323sub show_domain_quota_usage
15324{
15325local ($d) = @_;
15326local ($tcount, $total) = (0, 0);
15327
15328# Get usage for mail users and DBs in the domain
15329local ($homequota, $mailquota, $duser, $dbquota, $dbquota_home) =
15330 &get_domain_user_quotas($d);
15331
15332# Get usage for sub-domain mail users
15333local @subs = &get_domain_by("parent", $d->{'id'});
15334local ($subhomequota, $submailquota, $dummy, $subdbquota) =
15335 &get_domain_user_quotas(@subs);
15336
15337# Get group usage for the domain
15338local ($totalhomequota, $totalmailquota) = &get_domain_quota($d);
15339local $bsize = "a_bsize("home");
15340$totalhomequota -= $dbquota_home/$bsize;
15341
15342# Show home directory file usage, for total, unix user and mail users
15343local $tmsg = &nice_size($totalhomequota*$bsize);
15344if ($d->{'quota'} && $totalhomequota > $d->{'quota'}) {
15345 $tmsg = "<font color=#ff0000><b>$tmsg</b></font>";
15346 }
15347local $umsg = &nice_size($duser->{'uquota'}*$bsize);
15348if ($d->{'uquota'} && $duser->{'uquota'} > $d->{'uquota'}) {
15349 $umsg = "<font color=#ff0000><b>$umsg</b></font>";
15350 }
15351local $mmsg = &nice_size(($homequota+$subhomequota)*$bsize);
15352print &ui_table_row($text{'edit_allquotah'},
15353 &text('edit_quotaby', $tmsg, $umsg, $mmsg), 3);
15354$tcount++;
15355$total += $totalhomequota*$bsize;
15356
15357# Show mail filesystem usage separately
15358if (&has_mail_quotas()) {
15359 local $mbsize = "a_bsize("home");
15360 print &ui_table_row($text{'edit_allquotam'},
15361 &text('edit_quotaby',
15362 &nice_size($totalmailquota*$mbsize),
15363 &nice_size($duser->{'umquota'}*$mbsize),
15364 &nice_size(($mailquota+$submailquota)*$mbsize)), 3);
15365 $tcount++;
15366 $total += $totalmailquota*$mbsize;
15367 }
15368
15369# Show DB usage
15370if ($dbquota+$subdbquota) {
15371 print &ui_table_row($text{'edit_dbquota'},
15372 &text('edit_quotabysubs',
15373 &nice_size($dbquota+$subdbquota),
15374 &nice_size($dbquota),
15375 &nice_size($subdbquota)), 3);
15376 $tcount++;
15377 $total += $dbquota+$subdbquota;
15378 }
15379
15380# Show overall total, if needed
15381if ($tcount > 1) {
15382 print &ui_table_row($text{'edit_totalquota'}, &nice_size($total));
15383 }
15384}
15385
15386# show_domain_bw_usage(&domain)
15387# Print ui_table rows for bandwidth usage in a domain
15388sub show_domain_bw_usage
15389{
15390local ($d) = @_;
15391if (defined($d->{'bw_usage'})) {
15392 local $msg = &text('edit_bwusage',
15393 strftime("%d/%m/%Y", localtime($d->{'bw_start'}*(24*60*60))));
15394 if ($d->{'bw_limit'} && $d->{'bw_usage'} > $d->{'bw_limit'}) {
15395 local $notify = localtime($d->{'bw_notify'});
15396 print &ui_table_row($msg,
15397 "<font color=#ff0000>".
15398 &nice_size($d->{'bw_usage'})."</font>\n".
15399 ($d->{'bw_notify'} ?
15400 &text('edit_bwnotify', $notify) : ""), 3);
15401 }
15402 else {
15403 print &ui_table_row($msg, &nice_size($d->{'bw_usage'}), 3);
15404 }
15405 }
15406}
15407
15408# domains_list_links(&domains, field, what)
15409# Returns text for a list of domain with links, or a search
15410sub domains_list_links
15411{
15412local ($doms, $field, $what) = @_;
15413if (@$doms > 5) {
15414 return scalar(@$doms)." <a href='search.cgi?field=$field&what=$what'>".
15415 "$text{'edit_sublist'}</a>";
15416 }
15417else {
15418 # Show actual domain names
15419 my @alinks;
15420 foreach my $a (@$doms) {
15421 my $prog = &can_config_domain($a) ? "edit_domain.cgi"
15422 : "view_domain.cgi";
15423 push(@alinks, "<a href='$prog?dom=$a->{'id'}'>".
15424 &show_domain_name($a)."</a>");
15425 }
15426 local $lr = &ui_links_row(\@alinks);
15427 $lr =~ s/<br>$//;
15428 return $lr;
15429 }
15430
15431}
15432
15433# show_password_popup(&domain, [&user], [mode])
15434# Returns HTML for a link that pops up a password display window
15435sub show_password_popup
15436{
15437local ($d, $user, $mode) = @_;
15438local $pass = $mode ? $d->{$mode."_pass"} :
15439 $user ? $user->{'plainpass'} : $d->{'pass'};
15440if (&can_show_pass() && $pass) {
15441 local $link = "showpass.cgi?dom=$d->{'id'}&mode=".&urlize($mode);
15442 if ($user) {
15443 $link .= "&user=".&urlize($user->{'user'});
15444 }
15445 if (defined(&popup_window_link)) {
15446 return &popup_window_link($link, $text{'edit_showpass'},
15447 500, 70, "no");
15448 }
15449 else {
15450 return "(<a href='$link' onClick='window.open(\"$link\", \"showpass\", \"toolbar=no,menubar=no,scrollbar=no,width=500,height=70,resizable=yes\"); return false'>$text{'edit_showpass'}</a>)";
15451 }
15452 }
15453else {
15454 return "";
15455 }
15456}
15457
15458# flush_virtualmin_caches()
15459# Clear all in-memory caches of users, quotas, domains, etc..
15460sub flush_virtualmin_caches
15461{
15462undef(%main::get_domain_cache);
15463undef(@main::list_domains_cache);
15464undef(%bsize_cache);
15465undef(%get_bandwidth_cache);
15466undef(%main::soft_home_quota);
15467undef(%main::hard_home_quota);
15468undef(%main::used_home_quota);
15469undef(%main::soft_mail_quota);
15470undef(%main::hard_mail_quota);
15471undef(%main::used_mail_quota);
15472undef(@useradmin::list_users_cache);
15473undef(@useradmin::list_groups_cache);
15474}
15475
15476# list_shared_ips()
15477# Returns a list of extra IP addresses that can be used by virtual servers
15478sub list_shared_ips
15479{
15480return split(/\s+/, $config{'sharedips'});
15481}
15482
15483# save_shared_ips(ip, ...)
15484# Updates the list of extra IP addresses that can be used by virtual servers
15485sub save_shared_ips
15486{
15487$config{'sharedips'} = join(" ", @_);
15488&save_module_config();
15489}
15490
15491# list_shared_ip6s()
15492# Returns a list of extra IPv6 addresses that can be used by virtual servers
15493sub list_shared_ip6s
15494{
15495return split(/\s+/, $config{'sharedip6s'});
15496}
15497
15498# save_shared_ip6s(ip6, ...)
15499# Updates the list of extra IPv6 addresses that can be used by virtual servers
15500sub save_shared_ip6s
15501{
15502$config{'sharedip6s'} = join(" ", @_);
15503&save_module_config();
15504}
15505
15506# is_shared_ip(ip)
15507# Returns 1 if some IP address is shared among multiple domains (ie. default,
15508# shared or reseller shared)
15509sub is_shared_ip
15510{
15511local ($ip) = @_;
15512return 1 if ($ip eq &get_default_ip());
15513return 1 if (&indexof($ip, &list_shared_ips()) >= 0);
15514return 1 if ($ip eq &get_default_ip6());
15515return 1 if (&indexof($ip, &list_shared_ip6s()) >= 0);
15516if (defined(&list_resellers)) {
15517 foreach my $r (&list_resellers()) {
15518 return 1 if ($r->{'acl'}->{'defip'} &&
15519 $ip eq $r->{'acl'}->{'defip'});
15520 return 1 if ($r->{'acl'}->{'defip6'} &&
15521 $ip eq $r->{'acl'}->{'defip6'});
15522 }
15523 }
15524return 0;
15525}
15526
15527# activate_shared_ip(address, [netmask])
15528# Create a new virtual interface using some IP address. Returns undef on success
15529# or an error message on failure.
15530sub activate_shared_ip
15531{
15532local ($ip, $netmask) = @_;
15533&foreign_require("net");
15534local @boot = &net::active_interfaces();
15535local ($iface) = grep { $_->{'fullname'} eq $config{'iface'} } @boot;
15536if (!$iface) {
15537 return &text('sharedips_missing', $config{'iface'});
15538 }
15539local $vmax = $config{'iface_base'} || int($net::min_virtual_number);
15540foreach my $b (@boot) {
15541 $vmax = $b->{'virtual'} if ($b->{'name'} eq $iface->{'name'} &&
15542 $b->{'virtual'} > $vmax);
15543 }
15544$netmask ||= $net::virtual_netmask || $iface->{'netmask'};
15545local $virt = { 'address' => $ip,
15546 'netmask' => $netmask,
15547 'broadcast' => &net::compute_broadcast($ip, $netmask),
15548 'name' => $iface->{'name'},
15549 'virtual' => $vmax+1,
15550 'up' => 1,
15551 'desc' => "Virtualmin shared address",
15552 };
15553$virt->{'fullname'} = $virt->{'name'}.":".$virt->{'virtual'};
15554&net::save_interface($virt);
15555&net::activate_interface($virt);
15556return undef;
15557}
15558
15559# deactivate_shared_ip(address)
15560# Removes the virtual interface using some IP address. Returns undef on success
15561# or an error message on failure.
15562sub deactivate_shared_ip
15563{
15564local ($ip) = @_;
15565&foreign_require("net");
15566local @boot = &net::boot_interfaces();
15567local @active = &net::active_interfaces();
15568local ($b) = grep { $_->{'address'} eq $ip } @boot;
15569$b || return $text{'sharedips_eboot'};
15570$b->{'virtual'} eq '' && return $text{'sharedips_ebootreal'};
15571local ($a) = grep { $_->{'address'} eq $ip } @active;
15572$a || return $text{'sharedips_eactives'};
15573$a->{'virtual'} eq '' && return $text{'sharedips_ebootreal'};
15574&net::delete_interface($b);
15575&net::deactivate_interface($a);
15576return undef;
15577}
15578
15579# get_available_backup_features([safe-only])
15580# Returns a list of features for which backups are possible
15581sub get_available_backup_features
15582{
15583local ($safe) = @_;
15584local @rv;
15585foreach my $f ($safe ? @safe_backup_features : @backup_features) {
15586 local $bfunc = "backup_$f";
15587 if (defined(&$bfunc) &&
15588 ($config{$f} ||
15589 $f eq "unix" || $f eq "virtualmin" || $f eq "mail")) {
15590 push(@rv, $f);
15591 }
15592 }
15593return @rv;
15594}
15595
15596# html_extract_head_body(html)
15597# Given some HTML, extracts the header, body and stuff after the body
15598sub html_extract_head_body
15599{
15600local ($html) = @_;
15601if ($html =~ /^([\000-\377]*<body[^>]*>)([\000-\377]*)(<\/body[^>]*>[\000-\377]*)/i) {
15602 return ($1, $2, $3);
15603 }
15604else {
15605 return (undef, $html, undef);
15606 }
15607}
15608
15609# open_uncompress_file(filehandle, filename)
15610# Open a file, uncompressing if needed
15611sub open_uncompress_file
15612{
15613local ($fh, $f) = @_;
15614if ($f =~ /\.gz$/i) {
15615 return open($fh, "gunzip -c ".quotemeta($f)." |");
15616 }
15617elsif ($f =~ /\.Z$/i) {
15618 return open($fh, "uncompress -c ".quotemeta($f)." |");
15619 }
15620elsif ($f =~ /\.bz2$/i) {
15621 return open($fh, &get_bunzip2_command()." -c ".quotemeta($f)." |");
15622 }
15623else {
15624 return open($fh, $f);
15625 }
15626}
15627
15628# list_available_features([&parentdom], [&aliasdom], [&subdom])
15629# Returns a list of features available for a virtual server, by the current
15630# Virtualmin user.
15631sub list_available_features
15632{
15633local ($parentdom, $aliasdom, $subdom) = @_;
15634
15635# Start with core features
15636local @core = $aliasdom ? @opt_alias_features :
15637 $subdom ? @opt_subdom_features : @opt_features;
15638@core = grep { &can_use_feature($_) } @core;
15639if ($parentdom) {
15640 @core = grep { $_ ne 'webmin' && $_ ne 'unix' } @core;
15641 }
15642if ($aliasdom) {
15643 @core = grep { $aliasdom->{$_} } @core;
15644 }
15645local @rv = map { { 'feature' => $_,
15646 'desc' => $text{'feature_'.$_},
15647 'core' => 1,
15648 'auto' => $config{$_} == 3,
15649 'default' => $config{$_} == 1 || $config{$_} == 3,
15650 'enabled' => $config{$_} || !defined($config{$_}) } } @core;
15651
15652# Add plugin features
15653local @plug = grep { &plugin_call($_, "feature_suitable",
15654 $parentdom, $aliasdom, $subdom) } &list_feature_plugins();
15655@plug = grep { &can_use_feature($_) } @plug;
15656if ($aliasdom) {
15657 @plug = grep { $aliasdom->{$_} } @plug;
15658 }
15659local %inactive = map { $_, 1 } split(/\s+/, $config{'plugins_inactive'});
15660push(@rv, map { { 'feature' => $_,
15661 'desc' => &plugin_call($_, "feature_name", 0),
15662 'plugin' => 1,
15663 'auto' => 0,
15664 'default' => !$inactive{$_},
15665 'enabled' => 1 } } @plug);
15666
15667return @rv;
15668}
15669
15670# list_allowable_features()
15671# Returns a list of feature and plugin codes that resellers and domain owners
15672# can be allowed access to
15673sub list_allowable_features
15674{
15675return ( @opt_features, "virt", "virt6", &list_feature_plugins() );
15676}
15677
15678# count_domain_users()
15679# Returns a hash ref from domain IDs to user counts
15680sub count_domain_users
15681{
15682local %rv;
15683local (%homemap, %doneuser, %gidmap);
15684foreach my $d (&list_domains()) {
15685 $homemap{$d->{'home'}} = $d->{'id'};
15686 $gidmap{$d->{'gid'}} = $d->{'id'} if (!$d->{'parent'});
15687 }
15688foreach my $u (&list_all_users_quotas(1)) {
15689 local $h = $u->{'home'};
15690 local $did;
15691 if ($homemap{$h}) {
15692 # User home is a domain's home .. so this is the domain owner
15693 $did = $homemap{$h};
15694 }
15695 elsif ($h =~ /^(.*)\/homes\/(\S+)$/) {
15696 # User's home is under a domain's homes dir, so he must
15697 # belong to it.
15698 $did = $homemap{$1};
15699 }
15700 elsif ($h =~ /^(.*)\/public_html(\/\S+)?$/) {
15701 # Home is in or under public_html, so he is a web user
15702 $did = $homemap{$1};
15703 }
15704 else {
15705 # Fallback to trying each domain's home (longest first)
15706 foreach my $hd (sort { length($b) cmp length($a) }
15707 keys %homemap) {
15708 if ($h =~ /^\Q$hd\E\//) {
15709 $did = $homemap{$hd};
15710 last;
15711 }
15712 }
15713 # If THAT still doesn't work, look by GID
15714 $did = $gidmap{$u->{'gid'}};
15715 }
15716 if ($config{'mail_system'} == 0) {
15717 # Don't double-count Postfix @ and - users
15718 local $noat = &replace_atsign($u->{'user'});
15719 next if ($doneuser{$noat}++);
15720 }
15721 if ($did) {
15722 $rv{$did}++;
15723 }
15724 }
15725return \%rv;
15726}
15727
15728# add_user_to_domain_group(&domain, user, [text-message])
15729# Adds some user (like httpd or ftp) to the Unix group for a domain, if missing
15730sub add_user_to_domain_group
15731{
15732local ($d, $user, $msg) = @_;
15733return 0 if ($d->{'alias'} || !$d->{'group'});
15734&require_useradmin();
15735&obtain_lock_unix($d);
15736local @groups = &list_all_groups();
15737local ($group) = grep { $_->{'group'} eq $d->{'group'} } @groups;
15738local $rv;
15739if ($group) {
15740 local @mems = split(/,/, $group->{'members'});
15741 if (&indexof($user, @mems) < 0) {
15742 # Need to add him
15743 &$first_print(&text($msg, $user)) if ($msg);
15744 local $oldgroup = { %$group };
15745 $group->{'members'} = join(",", @mems, $user);
15746 &foreign_call($group->{'module'}, "set_group_envs", $group,
15747 'MODIFY_GROUP', $oldgroup);
15748 &foreign_call($group->{'module'}, "making_changes");
15749 &foreign_call($group->{'module'}, "modify_group",
15750 $oldgroup, $group);
15751 &foreign_call($group->{'module'}, "made_changes");
15752 &$second_print($text{'setup_done'}) if ($msg);
15753 $rv = 1;
15754 }
15755 }
15756&release_lock_unix($d);
15757return $rv;
15758}
15759
15760# get_backup_excludes(&domain)
15761# Returns a list of excluded directories
15762sub get_backup_excludes
15763{
15764local ($d) = @_;
15765return split(/\t+/, $d->{'backup_excludes'});
15766}
15767
15768# save_backup_excludes(&domain, &excludes)
15769# Updates the list of excluded directories
15770sub save_backup_excludes
15771{
15772local ($d, $excludes) = @_;
15773$d->{'backup_excludes'} = join("\t", @$excludes);
15774&save_domain($d);
15775}
15776
15777# get_backup_db_excludes(&domain)
15778# Returns a list of excluded DB or DB.table names
15779sub get_backup_db_excludes
15780{
15781local ($d) = @_;
15782return split(/\t+/, $d->{'backup_db_excludes'});
15783}
15784
15785# save_backup_db_excludes(&domain, &excludes)
15786# Updates the list of excluded DB or DB.table names
15787sub save_backup_db_excludes
15788{
15789local ($d, $excludes) = @_;
15790$d->{'backup_db_excludes'} = join("\t", @$excludes);
15791&save_domain($d);
15792}
15793
15794# list_plugin_sections(level)
15795# Returns a list of right-frame sections defined by Virtualmin plugins.
15796# Level 0 = master admin, 1 = domain owner, 2 = reseller
15797sub list_plugin_sections
15798{
15799local ($level) = @_;
15800local $want = $level == 0 ? "for_master" :
15801 $level == 1 ? "for_owner" : "for_reseller";
15802local @rv;
15803foreach my $p (@plugins) {
15804 if (&plugin_defined($p, "theme_sections")) {
15805 foreach my $s (&plugin_call($p, "theme_sections")) {
15806 if ($s->{$want}) {
15807 $s->{'plugin'} = $p;
15808 push(@rv, $s);
15809 }
15810 }
15811 }
15812 }
15813return @rv;
15814}
15815
15816# get_provider_link()
15817# Returns HTML for the logo that should be displayed in the theme for the
15818# Virtualmin hosting provider. In an array context, also returns the image
15819# URL and link URL, if set.
15820sub get_provider_link
15821{
15822# Does this user's domain's reseller have a logo?
15823local ($logo, $link, $alt);
15824local $d = &get_domain_by("user", $remote_user, "parent", "");
15825if (!$d) {
15826 # No domain found by user .. but is this user an extra admin?
15827 if ($access{'admin'}) {
15828 $d = &get_domain($access{'admin'});
15829 }
15830 }
15831if ($d && $d->{'reseller'} && defined(&get_reseller)) {
15832 # Domain has a reseller .. check for his logo
15833 foreach my $r (split(/\s+/, $d->{'reseller'})) {
15834 local $resel = &get_reseller($r);
15835 if ($resel->{'acl'}->{'logo'}) {
15836 $logo = $resel->{'acl'}->{'logo'};
15837 $link = $resel->{'acl'}->{'link'};
15838 $alt = $resel->{'acl'}->{'alt'};
15839 last;
15840 }
15841 }
15842 }
15843if (!$d && &reseller_admin()) {
15844 # This user is a reseller .. use his logo
15845 local $resel = &get_reseller($remote_user);
15846 if ($resel->{'acl'}->{'logo'}) {
15847 $logo = $resel->{'acl'}->{'logo'};
15848 $link = $resel->{'acl'}->{'link'};
15849 $alt = $resel->{'acl'}->{'alt'};
15850 }
15851 }
15852if (!$logo) {
15853 # Call back to global config
15854 $logo = $config{'theme_image'} || $gconfig{'virtualmin_theme_image'};
15855 $link = $config{'theme_link'} || $gconfig{'virtualmin_theme_link'};
15856 $alt = $config{'theme_alt'} || $gconfig{'virtualmin_theme_alt'};
15857 }
15858if ($logo && $logo ne "none") {
15859 local $html;
15860 $html .= "<a href='".&html_escape($link)."' target=_blank>" if ($link);
15861 $html .= "<img src='".&html_escape($image)."' ".
15862 "alt='".&html_escape($alt)."' border=0>";
15863 $html .= "</a>" if ($link);
15864 return wantarray ? ( $html, $logo, $link, $alt ) : $html;
15865 }
15866else {
15867 return wantarray ? ( ) : undef;
15868 }
15869}
15870
15871# nice_domains_list(&doms)
15872# Returns a string listing multiple domains
15873sub nice_domains_list
15874{
15875local ($doms) = @_;
15876local @ttdoms = map { "<tt>".&show_domain_name($_)."</tt>" } @$doms;
15877if (@ttdoms > 10) {
15878 @ttdoms = ( @ttdoms[0..9], &text('index_dmore', @ttdoms-10) );
15879 }
15880return join(" , ", @ttdoms);
15881}
15882
15883# list_available_shells([&domain], [mail])
15884# Returns a list of shells assignable to domain owners and/or mailboxes.
15885# Each is a hash ref with shell, desc, owner and mailbox keys.
15886sub list_available_shells
15887{
15888local ($d, $mail) = @_;
15889if (!defined($mail)) {
15890 $mail = !$d || $d->{'mail'};
15891 }
15892local @rv;
15893if ($list_available_shells_cache{$mail}) {
15894 return @{$list_available_shells_cache{$mail}};
15895 }
15896if (-r $custom_shells_file) {
15897 # Read shells data file
15898 open(SHELLS, $custom_shells_file);
15899 while(<SHELLS>) {
15900 s/\r|\n//g;
15901 local %shell = map { split(/=/, $_, 2) } split(/\t+/, $_);
15902 push(@rv, \%shell);
15903 }
15904 close(SHELLS);
15905 }
15906if (!@rv) {
15907 # Fake up from config file and known shells, if there is no custom
15908 # file or if it is somehow empty.
15909 push(@rv, { 'shell' => $config{'shell'},
15910 'desc' => $mail ? $text{'shells_mailbox'}
15911 : $text{'shells_mailbox2'},
15912 'mailbox' => 1,
15913 'default' => 1,
15914 'avail' => 1,
15915 'id' => 'nologin' });
15916 push(@rv, { 'shell' => $config{'ftp_shell'},
15917 'desc' => $mail ? $text{'shells_mailboxftp'}
15918 : $text{'shells_mailboxftp2'},
15919 'mailbox' => 1,
15920 'avail' => 1,
15921 'id' => 'ftp' });
15922 if ($config{'jail_shell'}) {
15923 push(@rv, { 'shell' => $config{'jail_shell'},
15924 'desc' => $mail ? $text{'shells_mailboxjail'}
15925 : $text{'shells_mailboxjail2'},
15926 'mailbox' => 1,
15927 'avail' => 1,
15928 'id' => 'ftp' });
15929 }
15930 if (&has_command("scponly")) {
15931 push(@rv, { 'shell' => &has_command("scponly"),
15932 'desc' => $mail ? $text{'shells_mailboxscp'}
15933 : $text{'shells_mailboxscp2'},
15934 'mailbox' => 1,
15935 'avail' => 1,
15936 'id' => 'scp' });
15937 }
15938 local (%done, %classes, $defclass);
15939 local $best_unix_shell;
15940 foreach my $s (split(/\s+/, $config{'unix_shell'})) {
15941 if (&has_command($s)) {
15942 $best_unix_shell = &has_command($s);
15943 last;
15944 }
15945 }
15946 $best_unix_shell ||= "/bin/sh";
15947 foreach my $us (&get_unix_shells()) {
15948 next if (!-r $us->[1]);
15949 next if ($done{$us->[1]}++);
15950 local %shell = ( 'shell' => $us->[1],
15951 'desc' => $mail ? $text{'shells_'.$us->[0]}
15952 : $text{'shells_'.$us->[0].'2'},
15953 'id' => $us->[0],
15954 'owner' => 1,
15955 'reseller' => 1 );
15956 if ($us->[1] eq $best_unix_shell) {
15957 $shell{'default'} = 1;
15958 $shell{'avail'} = 1;
15959 $defclass = $us->[0];
15960 }
15961 push(@rv, \%shell);
15962 $classes{$us->[0]}++;
15963 }
15964 if (!$defclass) {
15965 # Default for owners was not found .. use config
15966 local %shell = ( 'shell' => $best_unix_shell,
15967 'desc' => $text{'shells_ssh'},
15968 'id' => 'ssh',
15969 'owner' => 1,
15970 'reseller' => 1,
15971 'default' => 1,
15972 'avail' => 1 );
15973 push(@rv, \%shell);
15974 $classes{'ssh'}++;
15975 $defclass = 'ssh';
15976 }
15977 # Only the default or first of each class are available
15978 foreach my $c (grep { $_ ne $defclass } keys %classes) {
15979 local ($firstclass) = grep { $_->{'id'} eq $c } @rv;
15980 $firstclass->{'avail'} = 1;
15981 }
15982 }
15983$list_available_shells_cache{$mail} = \@rv;
15984return @rv;
15985}
15986
15987# save_available_shells(&shells|undef)
15988# Updates the list of custom shells available, or resets to the built-in
15989# defaults if undef is given
15990sub save_available_shells
15991{
15992local ($shells) = @_;
15993if ($shells) {
15994 &open_lock_tempfile(SHELLS, ">$custom_shells_file");
15995 foreach my $s (@$shells) {
15996 &print_tempfile(SHELLS,
15997 join("\t", map { $_."=".$s->{$_} } keys %$s),"\n");
15998 }
15999 &close_tempfile(SHELLS);
16000 @list_available_shells_cache = @$shells;
16001 }
16002else {
16003 &unlink_logged($custom_shells_file);
16004 undef(@list_available_shells_cache);
16005 }
16006}
16007
16008# available_shells_menu(name, [value], 'owner'|'mailbox'|'reseller', [show-cmd],
16009# [must-ftp])
16010# Returns HTML for selecting a shell for a mailbox or domain owner
16011sub available_shells_menu
16012{
16013local ($name, $value, $type, $showcmd, $mustftp) = @_;
16014local @tshells = grep { $_->{$type} } &list_available_shells(
16015 undef, $mustftp ? 0 : undef);
16016local @ashells = grep { $_->{'avail'} } @tshells;
16017if ($mustftp) {
16018 # Only show shells with FTP access or better
16019 @ashells = grep { $_->{'id'} ne 'nologin' } @ashells;
16020 }
16021if (defined($value)) {
16022 # Is current shell on the list?
16023 local ($got) = grep { $_->{'shell'} eq $value } @ashells;
16024 if (!$got) {
16025 ($got) = grep { $_->{'shell'} eq $value } @tshells;
16026 if ($got) {
16027 # Current exists but is not available .. make it visible
16028 push(@ashells, $got);
16029 }
16030 else {
16031 # Totally unknown
16032 if ($value) {
16033 push(@ashells, { 'shell' => $value,
16034 'desc' => $value });
16035 }
16036 else {
16037 push(@ashells, { 'shell' => '',
16038 'desc' => $text{'shells_none'} });
16039 }
16040 }
16041 }
16042 }
16043else {
16044 local ($def) = grep { $_->{'default'} } @ashells;
16045 $value = $def ? $def->{'shell'} : undef;
16046 }
16047return &ui_select($name, $value,
16048 [ map { [ $_->{'shell'},
16049 $_->{'desc'}.($showcmd ? " ($_->{'shell'})" : "") ] }
16050 @ashells ]);
16051}
16052
16053# default_available_shell('owner'|'mailbox'|'reseller')
16054# Returns the default shell for a mailbox user or domain owner
16055sub default_available_shell
16056{
16057local ($type) = @_;
16058local @ashells = grep { $_->{$type} && $_->{'avail'} } &list_available_shells();
16059local ($def) = grep { $_->{'default'} } @ashells;
16060return $def ? $def->{'shell'} : undef;
16061}
16062
16063# check_available_shell(shell, type, [old])
16064# Returns 1 if some shell is on the available list for this type
16065sub check_available_shell
16066{
16067local ($shell, $type, $old) = @_;
16068local @ashells = grep { $_->{$type} && $_->{'avail'} } &list_available_shells();
16069local ($got) = grep { $_->{'shell'} eq $shell } @ashells;
16070return $got || $old && $shell eq $old;
16071}
16072
16073# get_common_available_shells()
16074# Returns the nologin, FTP and jailed FTP shells for mailbox users, some of
16075# which may be undef. Mainly for legacy use.
16076sub get_common_available_shells
16077{
16078my @ashells = grep { $_->{'mailbox'} && $_->{'avail'} }
16079 &list_available_shells();
16080my ($nologin_shell) = grep { $_->{'id'} eq 'nologin' } @ashells;
16081my ($ftp_shell) = grep { $_->{'id'} eq 'ftp' } @ashells;
16082my ($jailed_shell) = grep { $_->{'id'} eq 'ftp' && $_ ne $ftp_shell } @ashells;
16083my ($def_shell) = grep { $_->{'default'} } @ashells;
16084return ($nologin_shell, $ftp_shell, $jailed_shell, $def_shell);
16085}
16086
16087# create_empty_file(path)
16088# Creates a new root-owned empty file
16089sub create_empty_file
16090{
16091local ($file) = @_;
16092&open_tempfile(EMPTY, ">$file", 0, 1);
16093&close_tempfile(EMPTY);
16094}
16095
16096# update_miniserv_preloads(mode)
16097# Changes the Perl libraries preloaded by miniserv, based on the mode flag.
16098# This can be 0 for none, 1 for Virtualmin only, or 2 for Virtualmin and
16099# plugins.
16100sub update_miniserv_preloads
16101{
16102local ($mode) = @_;
16103
16104local $msc = $ENV{'MINISERV_CONFIG'} || "$config_directory/miniserv.conf";
16105&lock_file($msc);
16106local %miniserv;
16107&get_miniserv_config(\%miniserv);
16108local @preload;
16109local $oldpreload = $miniserv{'preload'};
16110delete($miniserv{'premodules'});
16111if ($mode == 0) {
16112 # Nothing to load
16113 @preload = ( );
16114 }
16115else {
16116 # Do core library and features
16117 local $vslf = "virtual-server/virtual-server-lib-funcs.pl";
16118 push(@preload, "virtual-server=$vslf");
16119 foreach my $f (@features, "virt", "virt6") {
16120 local $file = "virtual-server/feature-$f.pl";
16121 push(@preload, "virtual-server=$file");
16122 }
16123
16124 if (&get_webmin_version() >= 1.455) {
16125 # Do new perl module version of Webmin API
16126 $miniserv{'premodules'} = "WebminCore";
16127 }
16128 }
16129$miniserv{'preload'} = join(" ", &unique(@preload));
16130&put_miniserv_config(\%miniserv);
16131&unlock_file($msc);
16132return $oldpreload ne $miniserv{'preload'};
16133}
16134
16135# nice_hour_mins_secs(unixtime, [no-pad], [show-seconds])
16136# Convert a number of seconds into an HH hours, MM minutes, SS seconds format
16137sub nice_hour_mins_secs
16138{
16139local ($time, $nopad, $showsecs) = @_;
16140local $days = int($time / (24*60*60));
16141local $hours = int($time / (60*60)) % 24;
16142local $mins = sprintf($nopad ? "%d" : "%2.2d", int($time / 60) % 60);
16143local $secs = sprintf($nopad ? "%d" : "%2.2d", int($time) % 60);
16144if ($days) {
16145 return &text('nicetime_days', $days, $hours, $mins, $secs);
16146 }
16147elsif ($hours) {
16148 return &text('nicetime_hours', $hours, $mins, $secs);
16149 }
16150elsif ($mins || !$showsecs) {
16151 return &text('nicetime_mins', $mins, $secs);
16152 }
16153else {
16154 return &text('nicetime_secs', $secs);
16155 }
16156}
16157
16158# short_nice_hour_mins_secs(unixtime)
16159# Convert a number of seconds into an HH:MM:SS format
16160sub short_nice_hour_mins_secs
16161{
16162local ($time) = @_;
16163local $days = int($time / (24*60*60));
16164local $hours = int($time / (60*60)) % 24;
16165local $mins = sprintf("%2.2d", int($time / 60) % 60);
16166local $secs = sprintf("%2.2d", int($time) % 60);
16167return $days ? $days." days, ".$hours.":".$mins.":".$secs :
16168 $hours ? $hours.":".$mins.":".$secs :
16169 $mins.":".$secs;
16170}
16171
16172# show_check_migration_features(feature, ...)
16173# Shows a message about features found in a migration, plus any that are
16174# not supported. Returns only those that are supported.
16175sub show_check_migration_features
16176{
16177local @got = @_;
16178local %pconfig = map { $_, 1 } &list_feature_plugins();
16179local @notgot = grep { !$config{$_} && !$pconfig{$_} } @got;
16180@got = grep { $config{$_} || $pconfig{$_} } @got;
16181local @gotmsg = map { $text{'feature_'.$_} ||
16182 &plugin_call($_, "feature_name") || $_ } @got;
16183local @notgotmsg = map { $text{'feature_'.$_} ||
16184 &plugin_call($_, "feature_name") || $_ } @notgot;
16185&$second_print(".. found ",join(", ", @gotmsg),".");
16186if (@notgot) {
16187 &$second_print("<b>However, the follow features are not supported or enabled on your system : ",join(", ", @notgotmsg).". Some functions of the migrated virtual server may not work.</b>");
16188 }
16189return @got;
16190}
16191
16192# obtain_lock_everything(&domain)
16193# Obtain locks on everything lockable that this domain has enabled
16194sub obtain_lock_everything
16195{
16196local ($d) = @_;
16197foreach my $f (@features) {
16198 local $lfunc = "obtain_lock_".$f;
16199 if (defined(&$lfunc) && $d->{$d}) {
16200 &$lfunc($d);
16201 }
16202 }
16203}
16204
16205# release_lock_everything(&domain)
16206# Reverses obtain_lock_everything
16207sub release_lock_everything
16208{
16209local ($d) = @_;
16210foreach my $f (@features) {
16211 local $lfunc = "release_lock_".$f;
16212 if (defined(&$lfunc) && $d->{$d}) {
16213 &$lfunc($d);
16214 }
16215 }
16216}
16217
16218# obtain_lock_anything(&domain)
16219# Called by the various obtain_lock_* functions
16220sub obtain_lock_anything
16221{
16222local ($d) = @_;
16223# Assume that we are about to do something important, and so don't want to be
16224# killed by a SIGPIPE triggered by a browser cancel.
16225$SIG{'PIPE'} = 'ignore';
16226}
16227
16228# release_lock_anything(&domain)
16229sub release_lock_anything
16230{
16231local ($d) = @_;
16232}
16233
16234# virtualmin_api_log(&argv, [&domain], [&suppress-flags])
16235# Log an action taken by a Virtualmin command-line API call
16236sub virtualmin_api_log
16237{
16238local ($argv, $d, $hide) = @_;
16239
16240# Parse into flags hash
16241local (%flags, $lastflag);
16242local @argv = @$argv;
16243while(@argv) {
16244 local $a = shift(@argv);
16245 if ($a =~ /^\-+(\S+)$/) {
16246 # A new flag
16247 $lastflag = $1;
16248 $flags{$lastflag} = "";
16249 }
16250 elsif ($lastflag) {
16251 # A flag value
16252 if ($flags{$lastflag} ne "") {
16253 $flags{$lastflag} .= " ";
16254 }
16255 $flags{$lastflag} .= $a;
16256 }
16257 if ($a =~ /^[^"' ]+$/) {
16258 push(@qargv, $a);
16259 }
16260 elsif ($a !~ /"/) {
16261 push(@qargv, "\"$a\"");
16262 }
16263 elsif ($a !~ /'/) {
16264 push(@qargv, "'$a'");
16265 }
16266 else {
16267 push(@qargv, quotameta($a));
16268 }
16269 }
16270if ($hide) {
16271 # Hide sensitive fields, like the password
16272 foreach my $h (@$hide) {
16273 if ($flags{$h}) {
16274 $flags{$h} = ("X" x length($flags{$h}));
16275 }
16276 my $idx = &indexoflc("--".$h, @qargv);
16277 if ($idx >= 0) {
16278 $qargv[$idx+1] = $flags{$h};
16279 }
16280 }
16281 }
16282$flags{'argv'} = &urlize(join(" ", @qargv));
16283
16284# Log it
16285local $script = $0;
16286$script =~ s/^.*\///;
16287local $remote_user = "root";
16288local $WebminCore::remote_user = "root";
16289local $rh = $ENV{'REMOTE_HOST'};
16290local $ENV{'REMOTE_HOST'} = $rh || "127.0.0.1";
16291&webmin_log($main::virtualmin_remote_api ||
16292 $ENV{'VIRTUALMIN_REMOTE_API'} ? "remote" : "cmd",
16293 $script, $d ? $d->{'dom'} : undef, \%flags);
16294}
16295
16296# get_global_template_variables()
16297# Returns an array of hash refs containing global variable names and values
16298sub get_global_template_variables
16299{
16300if (!scalar(@global_template_variables_cache)) {
16301 local @rv = ( );
16302 &open_readfile(GLOBAL, $global_template_variables_file);
16303 while(<GLOBAL>) {
16304 s/\r|\n//g;
16305 local $dis;
16306 $dis = 1 if (s/^\#+\s*//);
16307 local ($n, $v) = split(/\s+/, $_, 2);
16308 push(@rv, { 'name' => $n,
16309 'value' => $v,
16310 'enabled' => !$dis });
16311 }
16312 close(GLOBAL);
16313 @global_template_variables_cache = @rv;
16314 }
16315return @global_template_variables_cache;
16316}
16317
16318# save_global_template_variables(&variables)
16319# Write out the array ref of hash refs of global variables to a file
16320sub save_global_template_variables
16321{
16322local ($vars) = @_;
16323&open_tempfile(GLOBAL, ">$global_template_variables_file");
16324foreach my $v (@$vars) {
16325 &print_tempfile(GLOBAL,
16326 ($v->{'enabled'} ? "" : "#").
16327 $v->{'name'}." ".$v->{'value'}."\n");
16328 }
16329&close_tempfile(GLOBAL);
16330@global_template_variables_cache = @$vars;
16331}
16332
16333# home_relative_path(&domain, path)
16334# Returns a path relative to a domain's home, if possible
16335sub home_relative_path
16336{
16337local ($d, $file) = @_;
16338local $l = length($d->{'home'});
16339if (substr($file, 0, $l+1) eq $d->{'home'}."/") {
16340 return substr($file, $l+1);
16341 }
16342return $file;
16343}
16344
16345# update_alias_domain_ips(&domain, &old-domain)
16346# Called when a domain's IP is changed by adding or removing a virtual IP, to
16347# update the IPs of an alias domains too. May print stuff.
16348sub update_alias_domain_ips
16349{
16350local ($d, $oldd) = @_;
16351local @aliases = &get_domain_by("alias", $d->{'id'});
16352return 0 if (!@aliases);
16353foreach my $ad (@aliases) {
16354 next if ($ad->{'ip'} ne $oldd->{'ip'} &&
16355 $ad->{'ip6'} ne $oldd->{'ip6'});
16356 my $oldad = { %$ad };
16357 if ($ad->{'ip'} eq $oldd->{'ip'}) {
16358 $ad->{'ip'} = $d->{'ip'};
16359 }
16360 if ($oldd->{'ip6'} && $ad->{'ip6'} eq $oldd->{'ip6'}) {
16361 $ad->{'ip6'} = $d->{'ip6'};
16362 }
16363 &$first_print(&text('save_aliasip', $ad->{'dom'}, $d->{'ip'}));
16364 &$indent_print();
16365 foreach my $f (@features) {
16366 local $mfunc = "modify_$f";
16367 if ($config{$f} && $ad->{$f}) {
16368 &try_function($f, $mfunc, $ad, $oldad);
16369 }
16370 }
16371 foreach my $f (&list_feature_plugins()) {
16372 if ($ad->{$f}) {
16373 &plugin_call($f, "feature_modify", $ad, $oldad);
16374 }
16375 }
16376 &$outdent_print();
16377 &save_domain($ad);
16378 &$second_print($text{'setup_done'});
16379 }
16380}
16381
16382# get_dns_ip([reseller-name-list])
16383# Returns the IP address for use in DNS records, or undef to use the domain's IP
16384sub get_dns_ip
16385{
16386local ($reselname) = @_;
16387if (defined(&get_reseller)) {
16388 # Check if the reseller has an external IP
16389 foreach my $r (split(/\s+/, $reselname)) {
16390 local $resel = &get_reseller($r);
16391 if ($resel && $resel->{'acl'}->{'defdnsip'}) {
16392 return $resel->{'acl'}->{'defdnsip'};
16393 }
16394 }
16395 }
16396if ($config{'dns_ip'} eq '*') {
16397 local $rv = &get_external_ip_address();
16398 $rv || &error($text{'newdynip_eext'});
16399 return $rv;
16400 }
16401elsif ($config{'dns_ip'}) {
16402 return $config{'dns_ip'};
16403 }
16404return undef;
16405}
16406
16407# setup_bandwidth_job(enabled, [hour-step])
16408# Create or delete the bandwidth monitoring cron job
16409sub setup_bandwidth_job
16410{
16411local ($active, $step) = @_;
16412$step ||= 1;
16413&foreign_require("cron");
16414local $job = &find_bandwidth_job();
16415if ($job) {
16416 &delete_cron_script($job);
16417 }
16418if ($active) {
16419 my @hours;
16420 if ($step == 1) {
16421 @hours = ( "*" );
16422 }
16423 else {
16424 for(my $h=0; $h<24; $h+=$step) {
16425 push(@hours, $h);
16426 }
16427 }
16428 $job = { 'user' => 'root',
16429 'command' => $bw_cron_cmd,
16430 'active' => 1,
16431 'mins' => '0',
16432 'hours' => join(',', @hours),
16433 'days' => '*',
16434 'weekdays' => '*',
16435 'months' => '*' };
16436 &setup_cron_script($job);
16437 }
16438}
16439
16440# get_virtualmin_url([&domain])
16441# Returns a URL for accessing Virtualmin. Never has a trailing /
16442sub get_virtualmin_url
16443{
16444local ($d) = @_;
16445$d ||= { 'dom' => &get_system_hostname() };
16446local $rv;
16447if ($config{'scriptwarn_url'} && !$main::calling_get_virtualmin_url) {
16448 # From module config
16449 $main::calling_get_virtualmin_url = 1;
16450 $rv = &substitute_domain_template($config{'scriptwarn_url'}, $d);
16451 $rv =~ s/\/$//;
16452 $main::calling_get_virtualmin_url = 0;
16453 }
16454else {
16455 # Work out from miniserv
16456 local %miniserv;
16457 &get_miniserv_config(\%miniserv);
16458 local $proto = $miniserv{'ssl'} ? 'https' : 'http';
16459 local $port = $miniserv{'port'};
16460 $rv = $proto."://$d->{'dom'}:$port";
16461 }
16462return $rv;
16463}
16464
16465# get_domain_url(&domain)
16466# Returns the URL for a domain (with no trailing /)
16467sub get_domain_url
16468{
16469my ($d) = @_;
16470my $ptn = $d->{'web_urlport'} || $d->{'web_port'};
16471my $pt = $ptn == 80 || !$ptn ? "" : ":".$ptn;
16472return "http://".$d->{'dom'}.$pt;
16473}
16474
16475# get_quotas_message()
16476# Returns the template for email to users who are over quota
16477sub get_quotas_message
16478{
16479local $msg = &read_file_contents($user_quota_msg_file);
16480if (!$msg) {
16481 $msg = "You have reached or are approaching your disk quota limit:\n".
16482 "\n".
16483 "Username: \${USER}\n".
16484 "Domain: \${DOM}\n".
16485 "Email: \${EMAIL}\n".
16486 "Disk quota: \${QUOTA_LIMIT}\n".
16487 "Disk usage: \${QUOTA_USED}\n".
16488 "Status: \${IF-QUOTA_PERCENT}Reached \${QUOTA_PERCENT}%\${ELSE-QUOTA_PERCENT}Over quota\${ENDIF-QUOTA_PERCENT}\n".
16489 "\n".
16490 "Sent by Virtualmin at: \${VIRTUALMIN_URL}\n";
16491 }
16492return $msg;
16493}
16494
16495# save_quotas_message(message)
16496# Updates the template for over-quota email message
16497sub save_quotas_message
16498{
16499local ($msg) = @_;
16500&open_tempfile(QUOTAMSG, ">$user_quota_msg_file");
16501&print_tempfile(QUOTAMSG, $msg);
16502&close_tempfile(QUOTAMSG);
16503}
16504
16505# get_domain_http_hostname(&domain)
16506# Returns the best hostname for making HTTP requests to some domain, like
16507# www.$DOM or just $DOM
16508sub get_domain_http_hostname
16509{
16510my ($d) = @_;
16511foreach my $h ("www.$d->{'dom'}", $d->{'dom'}) {
16512 my $ip = &to_ipaddress($h);
16513 if ($ip && $ip eq $d->{'ip'}) {
16514 return $h;
16515 }
16516 }
16517return $d->{'dom'}; # Fallback
16518}
16519
16520# date_to_time(date-string, [gmt])
16521# Convert a date string like YYYY-MM-DD or -5 to a Unix time
16522sub date_to_time
16523{
16524local ($date, $gmt) = @_;
16525local $rv;
16526if ($date =~ /^(\d{4})-(\d+)-(\d+)$/) {
16527 # Date only
16528 if ($gmt) {
16529 $rv = timegm(0, 0, 0, $3, $2-1, $1-1900);
16530 }
16531 else {
16532 $rv = timelocal(0, 0, 0, $3, $2-1, $1-1900);
16533 }
16534 }
16535elsif ($date =~ /^\-(\d+)$/) {
16536 # Some days ago
16537 $rv = time()-($1*24*60*60);
16538 }
16539elsif ($date =~ /^\+(\d+)$/) {
16540 # Some days in the future
16541 $rv = time()+($1*24*60*60);
16542 }
16543$rv || &usage("Date spec must be like 2007-01-20 or -5 (days ago)");
16544return $rv;
16545}
16546
16547# time_to_date(unix-time)
16548# Convert a Unix time to a date formatted in YYYY-MM-DD
16549sub time_to_date
16550{
16551local ($secs) = @_;
16552local @tm = localtime($secs);
16553return sprintf "%4.4d-%2.2d-%2.2d", $tm[5]+1900, $tm[4]+1, $tm[3];
16554}
16555
16556# get_prefix_msg(&tmpl)
16557# Returns either "prefix" or "suffix", depending on the mailbox name mode
16558# set in the template.
16559sub get_prefix_msg
16560{
16561local ($tmpl) = @_;
16562return $tmpl->{'append_style'} == 0 ||
16563 $tmpl->{'append_style'} == 1 ||
16564 $tmpl->{'append_style'} == 4 ||
16565 $tmpl->{'append_style'} == 7 ? 'suffix' :
16566 'prefix';
16567}
16568
16569# compare_versions(ver1, ver2, [&script])
16570# Returns -1 if ver1 is older than ver2, 1 if newer, 0 if same
16571sub compare_versions
16572{
16573local ($ver1, $ver2, $script) = @_;
16574if ($script && $script->{'numeric_version'}) {
16575 # Strict numeric compare
16576 return $ver1 <=> $ver2;
16577 }
16578if ($script && $script->{'release_version'}) {
16579 # Compare release and version separately
16580 local ($rel1, $rel2);
16581 ($ver1, $rel1) = split(/-/, $ver1, 2);
16582 ($ver2, $rel2) = split(/-/, $ver2, 2);
16583 return &compare_versions($ver1, $ver2) ||
16584 &compare_versions($rel1, $rel2);
16585 }
16586local @sp1 = split(/[\.\-]/, $ver1);
16587local @sp2 = split(/[\.\-]/, $ver2);
16588for(my $i=0; $i<@sp1 || $i<@sp2; $i++) {
16589 local $v1 = $sp1[$i];
16590 local $v2 = $sp2[$i];
16591 local $comp;
16592 if ($v1 =~ /^\d+$/ && $v2 =~ /^\d+$/) {
16593 # Full numeric compare
16594 $comp = $v1 <=> $v2;
16595 }
16596 elsif ($v1 =~ /^\d+\S*$/ && $v2 =~ /^\d+\S*$/) {
16597 # Numeric followed by string
16598 $v1 =~ /^(\d+)(\S*)$/;
16599 local ($v1n, $v1s) = ($1, $2);
16600 $v2 =~ /^(\d+)(\S*)$/;
16601 local ($v2n, $v2s) = ($1, $2);
16602 $comp = $v1n <=> $v2n;
16603 if (!$comp) {
16604 # X.rcN is always older than X
16605 if ($v1s =~ /^rc\d+$/i && $v2s =~ /^\d*$/) {
16606 $comp = -1;
16607 }
16608 elsif ($v1s =~ /^\d*$/ && $v2s =~ /^rc\d+$/i) {
16609 $comp = 1;
16610 }
16611 else {
16612 $comp = $v1s cmp $v2s;
16613 }
16614 }
16615 }
16616 elsif ($v1 =~ /^\d+$/ && $v2 =~ /^rc\d+$/i) {
16617 # N is always newer than rcN
16618 $comp = 1;
16619 }
16620 elsif ($v1 =~ /^rc\d+$/i && $v2 =~ /^\d+$/) {
16621 # rcN is always older than N
16622 $comp = -1;
16623 }
16624 elsif ($v1 =~ /^\d+$/ && $v2 !~ /^\d+$/ && $v2 ne "") {
16625 # Numeric compared to non-numeric - numeric is always higher
16626 $comp = 1;
16627 }
16628 elsif ($v1 !~ /^\d+$/ && $v2 =~ /^\d+$/ && $v1 ne "") {
16629 # Non-numeric compared to numeric - numeric is always higher
16630 $comp = -1;
16631 }
16632 elsif ($v1 eq "" && $v2 ne "") {
16633 # Any number is better an empty string
16634 $comp = -1;
16635 }
16636 elsif ($v1 ne "" && $v2 eq "") {
16637 # Any number is better an empty string
16638 $comp = 1;
16639 }
16640 else {
16641 # String compare
16642 $v1 = 0 if ($v1 eq '');
16643 $v2 = 0 if ($v2 eq '');
16644 $comp = $v1 cmp $v2;
16645 }
16646 return $comp if ($comp);
16647 }
16648return 0;
16649}
16650
16651# clone_virtual_server(&domain, new-domain, [new-user, [new-password]],
16652# [ip], [ip-already])
16653# Creates a copy of a virtual server, with a new domain name and perhaps
16654# username (if top-level). Prints stuff as it progresses. Returns 0 on failure
16655# or 1 on success.
16656sub clone_virtual_server
16657{
16658local ($oldd, $newdom, $newuser, $newpass, $ip, $virtalready) = @_;
16659
16660# Create the new domain object, with changes
16661&$first_print($text{'clone_object'});
16662local $d = { %$oldd };
16663local $parent;
16664local $tmpl = &get_template($d->{'template'});
16665$d->{'id'} = &domain_id();
16666$d->{'clone'} = $oldd->{'id'};
16667$d->{'dom'} = $newdom;
16668$d->{'owner'} = "Clone of ".($d->{'owner'} || $d->{'dom'});
16669if (!$d->{'parent'}) {
16670 # Allocate new UID, GID, prefix, username and group name
16671 delete($d->{'uid'});
16672 delete($d->{'gid'});
16673 delete($d->{'ugid'});
16674 $d->{'user'} = $newuser;
16675 $d->{'group'} = $newuser;
16676 $d->{'ugroup'} = $newuser;
16677 delete($d->{'mysql_user'}); # Force re-creation of DB name
16678 delete($d->{'postgres_user'});
16679 if ($newpass) {
16680 $d->{'pass'} = $newpass;
16681 delete($d->{'enc_pass'}); # Any stored encrypted
16682 # password is not valid
16683 }
16684
16685 # Re-compute email address
16686 $d->{'emailto'} = $d->{'mail'} ? $d->{'user'}.'@'.$d->{'dom'}
16687 : $d->{'user'}.'@'.&get_system_hostname();
16688 }
16689else {
16690 $parent = &get_domain($d->{'parent'});
16691 }
16692
16693# Pick a new home directory and prefix
16694$d->{'home'} = &server_home_directory($d, $parent);
16695$d->{'prefix'} = &compute_prefix($d->{'dom'}, $d->{'group'}, $parent, 1);
16696local $pclash = &get_domain_by("prefix", $d->{'prefix'});
16697if ($pclash) {
16698 &$second_print(&text('clone_prefixclash',
16699 $d->{'prefix'}, $pclash->{'dom'}));
16700 return 0;
16701 }
16702$d->{'db'} = &database_name($d);
16703$d->{'no_mysql_db'} = 1; # Don't create DB automatically
16704$d->{'no_tmpl_aliases'} = 1; # Don't create any aliases
16705
16706# Fix any paths that refer to old home, like SSL certs
16707foreach my $k (keys %$d) {
16708 next if ($k eq "home"); # already fixed
16709 $d->{$k} =~ s/\Q$oldd->{'home'}\E\//$d->{'home'}\//g;
16710 }
16711&$second_print($text{'setup_done'});
16712
16713# Pick a new IPv4 address if needed
16714if ($d->{'virt'} && $ip) {
16715 # IP specific by caller
16716 &$first_print(&text('clone_virt2', $ip));
16717 $d->{'ip'} = $ip;
16718 $d->{'virtalready'} = $virtalready;
16719 delete($d->{'dns_ip'});
16720 &$second_print($text{'setup_done'});
16721 }
16722elsif ($d->{'virt'}) {
16723 # Allocating IP
16724 &$first_print($text{'clone_virt'});
16725 if ($tmpl->{'ranges'} eq 'none') {
16726 &$second_print($text{'clone_virtrange'});
16727 return 0;
16728 }
16729 local ($ip, $netmask) = &free_ip_address($tmpl);
16730 if (!$ip) {
16731 &$second_print($text{'clone_virtalloc'});
16732 return 0;
16733 }
16734 $d->{'ip'} = $ip;
16735 $d->{'netmask'} = $netmask;
16736 $d->{'virtalready'} = 0;
16737 delete($d->{'dns_ip'});
16738 &$second_print(&text('clone_virtdone', $ip));
16739 }
16740
16741# Allocate a new IPv6 address if needed
16742if ($d->{'virt6'}) {
16743 &$first_print($text{'clone_virt6'});
16744 if ($tmpl->{'ranges6'} eq 'none') {
16745 &$second_print($text{'clone_virt6range'});
16746 return 0;
16747 }
16748 local ($ip6, $netmask6) = &free_ip6_address($tmpl);
16749 if (!$ip6) {
16750 &$second_print($text{'clone_virt6alloc'});
16751 return 0;
16752 }
16753 $d->{'ip6'} = $ip6;
16754 $d->{'netmask6'} = $netmask6;
16755 $d->{'virt6already'} = 0;
16756 &$second_print(&text('clone_virt6done', $ip6));
16757 }
16758
16759# Disable and features that don't support cloning
16760&$first_print($text{'clone_clash'});
16761foreach my $f (@features) {
16762 local $cfunc = "clone_".$f;
16763 if ($d->{$f} && !defined(&$cfunc)) {
16764 $d->{$f} = 0;
16765 }
16766 }
16767foreach my $f (@plugins) {
16768 if ($d->{$f} && !&plugin_defined($f, "feature_clone")) {
16769 $d->{$f} = 0;
16770 }
16771 }
16772
16773# Check for clashes / depends
16774local $derr = &virtual_server_depends($d);
16775if ($derr) {
16776 &$second_print(&text('clone_dependfound', $derr));
16777 return 0;
16778 }
16779local $cerr = &virtual_server_clashes($d);
16780if ($cerr) {
16781 &$second_print(&text('clone_clashfound', $cerr));
16782 return 0;
16783 }
16784&$second_print($text{'setup_done'});
16785
16786# Create it
16787&$first_print($text{'clone_create'});
16788&$indent_print();
16789local $err = &create_virtual_server($d, $parent,
16790 $parent ? $parent->{'user'} : undef);
16791&$outdent_print();
16792if ($err) {
16793 &$second_print(&text('clone_createfailed', $err));
16794 return 0;
16795 }
16796&$second_print($text{'setup_done'});
16797
16798# Copy across features, mail last so that user DB association works
16799my @clonefeatures = @features;
16800if (&indexof("mail", @clonefeatures) >= 0) {
16801 @clonefeatures = ( ( grep { $_ ne "mail" } @clonefeatures ), "mail" );
16802 }
16803foreach my $f (@clonefeatures) {
16804 if ($d->{$f}) {
16805 local $cfunc = "clone_".$f;
16806 &try_function($f, $cfunc, $d, $oldd);
16807 }
16808 }
16809foreach my $f (@plugins) {
16810 if ($d->{$f}) {
16811 &try_plugin_call($f, "feature_clone", $d, $oldd);
16812 }
16813 }
16814&save_domain($d);
16815
16816# Copy across script logs, and then fix paths
16817# Fix script installer paths in all domains
16818local $scriptsrc = "$script_log_directory/$oldd->{'id'}";
16819local $scriptdest = "$script_log_directory/$d->{'id'}";
16820if (defined(&list_domain_scripts) && -d $scriptsrc) {
16821 &$first_print($text{'clone_scripts'});
16822 ©_source_dest($scriptsrc, $scriptdest);
16823 local ($olddir, $newdir) = ($oldd->{'home'}, $d->{'home'});
16824 foreach $sinfo (&list_domain_scripts($d)) {
16825 my $changed = 0;
16826 $changed++ if ($sinfo->{'opts'}->{'dir'} =~
16827 s/^\Q$olddir\E\//$newdir\//);
16828 $changed++ if ($sinfo->{'url'} =~
16829 s/\/$oldd->{'dom'}/\/$d->{'dom'}/);
16830 &save_domain_script($d, $sinfo) if ($changed);
16831 }
16832 &$second_print($text{'setup_done'});
16833 }
16834
16835&run_post_actions();
16836return 1;
16837}
16838
16839# record_old_uid(uid, [gid])
16840# Record usage of some UID and perhaps GID to prevent re-use
16841sub record_old_uid
16842{
16843my ($uid, $gid) = @_;
16844&lock_file($old_uids_file);
16845my %uids;
16846&read_file_cached($old_uids_file, \%uids);
16847$uids{$uid} = 1;
16848&write_file($old_uids_file, \%uids);
16849&unlock_file($old_uids_file);
16850if ($gid) {
16851 &lock_file($old_gids_file);
16852 my %gids;
16853 &read_file_cached($old_gids_file, \%gids);
16854 $gids{$gid} = 1;
16855 &write_file($old_gids_file, \%gids);
16856 &unlock_file($old_gids_file);
16857 }
16858}
16859
16860# check_resolvability(name)
16861# Returns 1 and the IP if a name can be resolved, or 0 and an error message
16862sub check_resolvability
16863{
16864my ($name) = @_;
16865local $page = $resolve_check_page."?host=".&urlize($name);
16866local ($out, $error);
16867&http_download($resolve_check_host,
16868 $resolve_check_port,
16869 $page, \$out, \$error, undef, 0, undef, undef, 60, 0, 1);
16870if ($error) {
16871 return (0, $error);
16872 }
16873elsif ($out =~ /^ok\s+([0-9\.]+)/) {
16874 return (1, $1);
16875 }
16876elsif ($out =~ /^(error|param)\s+(.*)/) {
16877 return (0, $2);
16878 }
16879else {
16880 return (0, "Unknown response : $out");
16881 }
16882}
16883
16884# domain_has_website([&domain])
16885# Returns 1 if a domain has a website, either via apache or a plugin.
16886# If called without a domain parameter, just return the plugin or feature
16887# that provides a website.
16888sub domain_has_website
16889{
16890my ($d) = @_;
16891return 'web' if ((!$d || $d->{'web'}) && $config{'web'});
16892foreach my $p (&list_feature_plugins()) {
16893 if ((!$d || $d->{$p}) && &plugin_call($p, "feature_provides_web")) {
16894 return $p;
16895 }
16896 }
16897return undef;
16898}
16899
16900# domain_has_ssl([&domain])
16901# Returns 1 if a domain has a website with SSL, either via apache or a plugin
16902# If called without a domain parameter, just return the plugin or feature
16903# that provides an SSL website.
16904sub domain_has_ssl
16905{
16906my ($d) = @_;
16907return 'ssl' if ((!$d || $d->{'ssl'}) && $config{'ssl'});
16908foreach my $p (&list_feature_plugins()) {
16909 if ((!$d || $d->{$p}) && &plugin_call($p, "feature_provides_ssl")) {
16910 return $p;
16911 }
16912 }
16913return undef;
16914}
16915
16916# get_website_log(&domain, [error-log])
16917# Returns the access or error log for a domain's website. May come from a plugin
16918sub get_website_log
16919{
16920local ($d, $errorlog) = @_;
16921local $p = &domain_has_website($d);
16922if ($p eq 'web') {
16923 return &get_apache_log($d->{'dom'}, $d->{'web_port'}, $errorlog);
16924 }
16925elsif ($p) {
16926 return &plugin_call($p, "feature_get_web_log", $d, $errorlog);
16927 }
16928return undef;
16929}
16930
16931# get_old_website_log(log, &domain, &old-domain)
16932# Returns the log path that would have been used in the old domain
16933sub get_old_website_log
16934{
16935local ($alog, $d, $oldd) = @_;
16936if ($d->{'home'} ne $oldd->{'home'}) {
16937 $alog =~ s/\Q$d->{'home'}\E/$oldd->{'home'}/;
16938 }
16939if ($d->{'dom'} ne $oldd->{'dom'} &&
16940 !&is_under_directory($d->{'home'}, $alog)) {
16941 $alog =~ s/\Q$d->{'dom'}\E/$oldd->{'dom'}/;
16942 }
16943return $alog;
16944}
16945
16946# restart_website_server(&domain, [args])
16947# Calls the restart function for the webserver for a domain
16948sub restart_website_server
16949{
16950local ($d, @args) = @_;
16951local $p = &domain_has_website($d);
16952if ($p eq "web") {
16953 &restart_apache(@args);
16954 }
16955else {
16956 &plugin_call($p, "feature_restart_web", @args);
16957 }
16958}
16959
16960# save_website_ssl_file(&domain, "cert"|"key"|"ca", file)
16961# Configure the webserver for some domain to use a file as the SSL cert or key
16962sub save_website_ssl_file
16963{
16964local ($d, $type, $file) = @_;
16965local $p = &domain_has_website($d);
16966if ($p ne "web") {
16967 return &plugin_call($p, "feature_save_web_ssl_file", $d, $type, $file);
16968 }
16969&obtain_lock_ssl($d);
16970local ($virt, $vconf, $conf) = &get_apache_virtual($d->{'dom'},
16971 $d->{'web_sslport'});
16972if (!$virt) {
16973 &release_lock_ssl($d);
16974 return "No virtual host found for $d->{'dom'}:$d->{'web_sslport'}";
16975 }
16976local $dir = $type eq 'cert' ? "SSLCertificateFile" :
16977 $type eq 'key' ? "SSLCertificateKeyFile" :
16978 $type eq 'ca' ? "SSLCACertificateFile" : undef;
16979if ($dir) {
16980 &apache::save_directive($dir, [ $file ], $vconf, $conf);
16981 }
16982&release_lock_ssl($d);
16983if ($dir) {
16984 &flush_file_lines($virt->{'file'});
16985 ®ister_post_action(\&restart_apache, 1);
16986 }
16987return undef;
16988}
16989
16990# get_website_ssl_file(&domain, "cert"|"key"|"ca")
16991# Looks up the SSL cert, key or chained CA file for some domain
16992sub get_website_ssl_file
16993{
16994local ($d, $type) = @_;
16995local $p = &domain_has_website($d);
16996if ($p ne "web") {
16997 return &plugin_call($p, "feature_get_web_ssl_file", $d, $type);
16998 }
16999local ($virt, $vconf) = &get_apache_virtual($d->{'dom'},
17000 $d->{'web_sslport'});
17001return undef if (!$virt);
17002local $dir = $type eq 'cert' ? "SSLCertificateFile" :
17003 $type eq 'key' ? "SSLCertificateKeyFile" :
17004 $type eq 'ca' ? "SSLCACertificateFile" : undef;
17005return undef if (!$dir);
17006local ($file) = &apache::find_directive($dir, $vconf);
17007return $file;
17008}
17009
17010# list_ordered_features(&domain)
17011# Returns a list of features or plugins possibly relevant to some domain,
17012# in dependency order
17013sub list_ordered_features
17014{
17015local ($d) = @_;
17016local @dom_features = &domain_features($d);
17017local $p = &domain_has_website($d);
17018local @rv;
17019foreach my $f (@dom_features, &list_feature_plugins()) {
17020 if ($f eq "web" && $p && $p ne "web") {
17021 # Replace 'web' feature in ordering with plugin that provides
17022 # a website.
17023 push(@rv, $p, "web");
17024 }
17025 elsif ($f eq $p && $p ne "web") {
17026 # Skip website plugin feature, as it was inserted above
17027 }
17028 else {
17029 # Some other feature
17030 push(@rv, $f);
17031 }
17032 }
17033return @rv;
17034}
17035
17036# set_virtualmin_user_envs(&user, &domain)
17037# Set environment variables containing Virtualmin user-specific info
17038sub set_virtualmin_user_envs
17039{
17040local ($user, $d) = @_;
17041if ($d) {
17042 $ENV{'USERADMIN_DOM'} = $d->{'dom'};
17043 }
17044$ENV{'USERADMIN_EMAIL'} = $d->{'email'};
17045if ($u->{'extraemail'}) {
17046 $ENV{'USERADMIN_EXTRAEMAIL'} = join(" ", @{$u->{'extraemail'}});
17047 }
17048}
17049
17050# extract_address_parts(string)
17051# Given a string that may contain multiple email addresses with real names,
17052# return a list of just the address parts. Excludes un-qualified addresses
17053sub extract_address_parts
17054{
17055local ($str) = @_;
17056&foreign_require("mailboxes");
17057return grep { /^[^@ ]+\@[^@ ]+$/ }
17058 map { $_->[0] } &mailboxes::split_addresses($str);
17059}
17060
17061# execute_command_via_ssh(host:port, pass, command)
17062# Run some command on a remote system, and return either 1 and the output, or
17063# 0 and an error message
17064sub execute_command_via_ssh
17065{
17066my ($host, $pass, $cmd) = @_;
17067my $port;
17068if ($host =~ s/:(\d+)$//) {
17069 $port = $1;
17070 }
17071my $sshcmd = "ssh".($port ? " -p $port" : "")." ".
17072 $config{'ssh_args'}." ".
17073 "root\@".$host." ".
17074 $cmd;
17075my $err;
17076my $out = &run_ssh_command($sshcmd, $pass, \$err);
17077if ($err) {
17078 return (0, $err);
17079 }
17080else {
17081 $out =~ s/^\S+\s+password:.*\n//; # Strip password prompt
17082 return (1, $out);
17083 }
17084}
17085
17086# execute_virtualmin_api_command(host, pass, command)
17087# Runs a Virtualmin API command on some system via SSH. Returns
17088# 0 and the output structure on success, 1 and an error message
17089# on remote API failure, or 2 and an error message on SSH failure.
17090sub execute_virtualmin_api_command
17091{
17092my ($host, $pass, $cmd) = @_;
17093my ($sshok, $out) = &execute_command_via_ssh($host, $pass,
17094 "virtualmin ".$cmd);
17095if (!$sshok) {
17096 return (2, $out);
17097 }
17098my $args = { };
17099if ($cmd =~ /--(multiline|name-only|id-only)/) {
17100 $args->{$1} = '';
17101 }
17102my $data = &convert_remote_format($out, 0, $cmd, $args, undef);
17103if ($data->{'error'}) {
17104 return (1, $data->{'error'});
17105 }
17106else {
17107 return (0, $data->{'data'}, $out);
17108 }
17109}
17110
17111# validate_transfer_host(&domain, desthost, destpass, ignore-clash)
17112# Checks if a transfer to a remote Virtualmin system is possible
17113sub validate_transfer_host
17114{
17115my ($d, $desthost, $destpass, $overwrite) = @_;
17116
17117# Cannot transfer a disabled domain
17118if ($d->{'disabled'}) {
17119 return $text{'transfer_edisabled'};
17120 }
17121
17122my ($status, $out) = &execute_virtualmin_api_command($desthost, $destpass,
17123 "list-domains --name-only");
17124if ($status) {
17125 # Couldn't connect or run the command
17126 return &text('transfer_econnect', $out);
17127 }
17128
17129# Check for domains clash
17130if (!$overwrite) {
17131 my @poss = ( $d );
17132 push(@poss, &get_domain_by("parent", $d->{'id'}));
17133 push(@poss, &get_domain_by("alias", $d->{'id'}));
17134 foreach my $p (@poss) {
17135 if (&indexoflc($p->{'dom'}, @$out) >= 0) {
17136 return &text('transfer_already', $p->{'dom'});
17137 }
17138 }
17139 }
17140
17141# Make sure parent and alias target exists on target
17142if ($d->{'parent'}) {
17143 my $parent = &get_domain($d->{'parent'});
17144 if (&indexoflc($parent->{'dom'}, @$out) < 0) {
17145 return &text('transfer_noparent', &show_domain_name($parent));
17146 }
17147 }
17148if ($d->{'alias'}) {
17149 my $alias = &get_domain($d->{'alias'});
17150 if (&indexoflc($alias->{'dom'}, @$out) < 0) {
17151 return &text('transfer_noalias', &show_domain_name($alias));
17152 }
17153 }
17154
17155return undef;
17156}
17157
17158# transfer_virtual_server(&domain, desthost, destpass, delete-mode,
17159# delete-missing-files, replication-mode, show-output)
17160# Transfers a domain (and sub-servers) to a destination system, possibly while
17161# deleting it from the source. Will print stuff while transferring, and returns
17162# an OK flag.
17163sub transfer_virtual_server
17164{
17165my ($d, $desthost, $destpass, $deletemode, $deletemissing, $replication,
17166 $showoutput) = @_;
17167
17168# Get all domains to include
17169my @doms = ( $d );
17170push(@doms, &get_domain_by("parent", $d->{'id'}));
17171push(@doms, &get_domain_by("alias", $d->{'id'}));
17172
17173# Get all feature names
17174my @feats = grep { $config{$_} || $_ eq 'virtualmin' }
17175 @backup_features;
17176push(@feats, &list_backup_plugins());
17177my $homefmt;
17178if ($replication) {
17179 my %remotes = map { $_, 1 } &list_remote_domain_features($d);
17180 @feats = grep { !$remotes{$_} } @feats;
17181 $homefmt = &indexof("dir", @feats) >= 0 ? 1 : 0;
17182 }
17183else {
17184 $homefmt = 1;
17185 }
17186
17187# Backup all the domains to a temp dir on the remote system
17188my $remotetemp = "/tmp/virtualmin-transfer-$$";
17189local $config{'compression'} = 0;
17190local $config{'zip_args'} = undef;
17191&$first_print($text{'transfer_backing'});
17192if (!$showoutput) {
17193 &push_all_print();
17194 &set_all_null_print();
17195 }
17196my ($ok, $errdoms) = &backup_domains(
17197 "ssh://root:$destpass\@$desthost:$remotetemp",
17198 \@doms,
17199 \@feats,
17200 1,
17201 0,
17202 { },
17203 $homefmt,
17204 [ ],
17205 1,
17206 1,
17207 0);
17208if (!$showoutput) {
17209 &pop_all_print();
17210 }
17211if (!$ok) {
17212 &$second_print($text{'transfer_ebackup'});
17213 return 0;
17214 }
17215&$second_print($text{'transfer_backingdone'});
17216
17217# Verify that the destination directory was actually created and contains
17218# all the expected files
17219&$first_print($text{'transfer_validating'});
17220my ($lsok, $lsout) = &execute_command_via_ssh($desthost, $destpass,
17221 "ls ".$remotetemp);
17222if (!$lsok) {
17223 &$second_print(&text('transfer_eremotetemp', $remotetemp, $desthost));
17224 return 0;
17225 }
17226my @lsfiles = split(/\r?\n/, $lsout);
17227my @missing;
17228foreach my $lsd (@doms) {
17229 if (&indexof($lsd->{'dom'}.".tar.gz", @lsfiles) < 0) {
17230 push(@missing, $lsd);
17231 }
17232 }
17233if (@missing) {
17234 &execute_command_via_ssh($desthost, $destpass,
17235 "rm -rf ".$remotetemp);
17236 if (@missing == @doms) {
17237 &$second_print(&text('transfer_empty', $remotetemp));
17238 }
17239 else {
17240 &$second_print(&text('transfer_missing', $remotetemp,
17241 join(" ", map { &show_domain_name($_) } @missing)));
17242 }
17243 return 0;
17244 }
17245&$second_print($text{'transfer_validated'});
17246
17247# Delete or disable locally, if requested
17248if ($deletemode == 2) {
17249 # Delete from this system
17250 &$first_print(&text('transfer_deleting', &show_domain_name($d)));
17251 if (!$showoutput) {
17252 &push_all_print();
17253 &set_all_null_print();
17254 }
17255 my $err = &delete_virtual_server($d);
17256 if (!$showoutput) {
17257 &pop_all_print();
17258 }
17259 if ($err) {
17260 &$second_print(&text('transfer_edelete', $err));
17261 return 0;
17262 }
17263 else {
17264 &$second_print($text{'setup_done'});
17265 }
17266 }
17267elsif ($deletemode == 1) {
17268 # Disable on this system
17269 &$first_print(&text('transfer_disabling', &show_domain_name($d)));
17270 if (!$showoutput) {
17271 &push_all_print();
17272 &set_all_null_print();
17273 }
17274 foreach my $dd (@doms) {
17275 &disable_virtual_server($dd, 'transfer',
17276 'Transferred to '.$desthost);
17277 }
17278 if (!$showoutput) {
17279 &pop_all_print();
17280 }
17281 &$second_print($text{'setup_done'});
17282 }
17283
17284# Restore via an API call to the remote system
17285&$first_print($text{'transfer_restoring'});
17286my ($rok, $rerr, $rout) = &execute_virtualmin_api_command($desthost, $destpass,
17287 "restore-domain --source $remotetemp --all-domains --all-features ".
17288 "--skip-warnings --continue-on-error ".
17289 ($deletemissing ? "--option dir delete 1 " : "").
17290 ($replication ? "--replication --no-reuid " : "")
17291 );
17292if ($showoutput) {
17293 &$first_print("<pre>".$rout."</pre>");
17294 }
17295if ($rok != 0) {
17296 if ($deletemode == 2) {
17297 &$second_print(&text('transfer_erestoring2', $rerr,
17298 $remotetemp, $desthost));
17299 }
17300 elsif ($deletemode == 1) {
17301 &$second_print(&text('transfer_erestoring1', $rerr));
17302 }
17303 else {
17304 &$second_print(&text('transfer_erestoring', $rerr));
17305 }
17306 if ($deletemode != 2) {
17307 &execute_command_via_ssh($desthost, $destpass,
17308 "rm -rf ".$remotetemp);
17309 }
17310 return 0;
17311 }
17312&$second_print($text{'transfer_restoringdone'});
17313
17314# Remove temp file from remote system
17315&execute_command_via_ssh($desthost, $destpass,
17316 "rm -rf ".$remotetemp);
17317
17318return 1;
17319}
17320
17321# get_transfer_hosts()
17322# Returns previous hosts that transfers have been made to. Each is a tuple
17323# of hostname and password
17324sub get_transfer_hosts
17325{
17326my $hfile = "$module_config_directory/transfer-hosts";
17327my %hosts;
17328&read_file($hfile, \%hosts);
17329return map { [ $_, $hosts{$_} ] } keys %hosts;
17330}
17331
17332# save_transfer_hosts(&host, ...)
17333# Writes out tuples in the same format as returned by get_transfer_hosts
17334sub save_transfer_hosts
17335{
17336my $hfile = "$module_config_directory/transfer-hosts";
17337my %hosts = map { $_->[0], $_->[1] } @_;
17338&write_file($hfile, \%hosts);
17339}
17340
17341# list_possible_domain_features(&domain)
17342# Given a domain, returns a list of core features that can possibly be enabled
17343# or disabled for it
17344sub list_possible_domain_features
17345{
17346my ($d) = @_;
17347my @rv;
17348my $aliasdom = $d->{'alias'} ? &get_domain($d->{'alias'}) : undef;
17349my $subdom = $d->{'subdom'} ? &get_domain($d->{'subdom'}) : undef;
17350foreach my $f (&domain_features($d)) {
17351 # Cannot enable features not in alias
17352 next if ($aliasdom && !$aliasdom->{$f});
17353
17354 # Don't show features that are globally disabled
17355 next if (!$config{$f} && defined($config{$f}));
17356
17357 push(@rv, $f);
17358 }
17359return @rv;
17360}
17361
17362# list_remote_domain_features(&domain)
17363# Returns a list of all features for a domain that are on shared storage
17364sub list_remote_domain_features
17365{
17366my ($d) = @_;
17367my @rv;
17368foreach my $f (grep { $d->{$_} } &domain_features($d)) {
17369 my $rfunc = "remote_".$f;
17370 if (defined(&$rfunc) && &$rfunc($d)) {
17371 push(@rv, $f);
17372 }
17373 }
17374return @rv;
17375}
17376
17377# transname_owned(user|&domain)
17378# Create a temporary sub-directory owned by some user, and return a filename
17379# inside it
17380sub transname_owned
17381{
17382my ($user) = @_;
17383$user = $user->{'user'} if (ref($user));
17384my $temp = &transname();
17385if (!$user || $user eq "root") {
17386 return $temp;
17387 }
17388&make_dir($temp, 0755);
17389&set_ownership_permissions($user, undef, undef, $temp);
17390my $rv = $temp."/".($$."_".($transname_owned_counter++));
17391unshift(@main::temporary_files, $rv);
17392return $rv;
17393}
17394
17395# load_plugin_libraries([plugin, ...])
17396# Call foreign_require on some or all plugins, just once
17397sub load_plugin_libraries
17398{
17399local @load = @_;
17400@load = @plugins if (!@load);
17401local $loaded = 0;
17402foreach my $pname (@load) {
17403 if (!$main::done_load_plugin_libraries{$pname}++) {
17404 if (&foreign_check($pname)) {
17405 &foreign_require($pname, "virtual_feature.pl");
17406 $loaded++;
17407 }
17408 }
17409 }
17410return $loaded;
17411}
17412
17413# Returns a list of all plugins that define features
17414sub list_feature_plugins
17415{
17416&load_plugin_libraries();
17417return grep { &plugin_defined($_, "feature_setup") } @plugins;
17418}
17419
17420# Returns a list of all plugins that add mailbox-level options
17421sub list_mail_plugins
17422{
17423&load_plugin_libraries();
17424return grep { &plugin_defined($_, "mailbox_inputs") } @plugins;
17425}
17426
17427# Returns a list of all plugins that add a new database type
17428sub list_database_plugins
17429{
17430&load_plugin_libraries();
17431return grep { &plugin_defined($_, "database_name") } @plugins;
17432}
17433
17434# Returns a list of all plugins that add a service that can be started
17435sub list_startstop_plugins
17436{
17437&load_plugin_libraries();
17438return grep { &plugin_defined($_, "feature_startstop") } @plugins;
17439}
17440
17441# Returns a list of all plugins that have a backupable feature
17442sub list_backup_plugins
17443{
17444&load_plugin_libraries();
17445return grep { &plugin_defined($_, "feature_backup") } @plugins;
17446}
17447
17448# Returns a list of all plugins that define new script installers
17449sub list_script_plugins
17450{
17451&load_plugin_libraries();
17452return grep { &plugin_defined($_, "scripts_list") } @plugins;
17453}
17454
17455# Returns a list of all plugins that define content styles
17456sub list_style_plugins
17457{
17458&load_plugin_libraries();
17459return grep { &plugin_defined($_, "styles_list") } @plugins;
17460}
17461
17462$done_virtual_server_lib_funcs = 1;
17463
174641;