use Time::Local; use POSIX; use feature 'state'; ## Work out where our extra -lib.pl files are, and load them $virtual_server_root = $module_root_directory; if (!$virtual_server_root) { foreach my $i (keys %INC) { if ($i =~ /^(.*)\/virtual-server-lib-funcs.pl$/) { $virtual_server_root = $1; } } } if (!$virtual_server_root) { $0 =~ /^(.*)\//; $virtual_server_root = "$1/virtual-server"; } foreach my $lib ("scripts", "resellers", "admins", "users", "simple", "s3", "php", "ruby", "vui", "dynip", "collect", "maillog", "balancer", "newfeatures", "resources", "backups", "domainname", "commands", "connectivity", "plans", "postgrey", "wizard", "security", "json", "redirects", "ftp", "dkim", "provision", "stats", "bkeys", "rs", "cron", "ratelimit", "cloud", "google", "gcs", "dropbox", "copycert", "jailkit", "ports", "bb", "dnscloud", "dnscloudpro", "smtpcloud", "pro-tip", "azure", "remotedns", "drive") { my $libfile = "$virtual_server_root/pro/$lib-lib.pl"; if (!-r $libfile) { $libfile = "$virtual_server_root/$lib-lib.pl"; } do $libfile; if ($@ && -r "$virtual_server_root/$lib-lib.pl") { print STDERR "failed to load $lib-lib.pl : $@\n"; } } # Wrapper function to get webprefix safely sub get_webprefix_safe { if (defined(&get_webprefix)) { return &get_webprefix(); } return $gconfig{'webprefix'}; } # require_useradmin([no-quotas]) sub require_useradmin { if (!$require_useradmin++) { &foreign_require("useradmin"); %uconfig = &foreign_config("useradmin"); $home_base = &resolve_links($config{'home_base'} || $uconfig{'home_base'}); $cannot_rehash_password = 0; if ($config{'ldap'}) { &foreign_require("ldap-useradmin"); %luconfig = &foreign_config("ldap-useradmin"); $usermodule = "ldap-useradmin"; if ($ldap_useradmin::config{'md5'} == 3 || $ldap_useradmin::config{'md5'} == 4) { $cannot_rehash_password = 1; } } else { $usermodule = "useradmin"; } } if (!&has_quota_commands() && !$_[0] && !$require_useradmin_quota++) { &foreign_require("quota"); } } # Bring in libraries used for migrating from other servers sub require_migration { foreach my $m (@migration_types) { do "$module_root_directory/migration-$m.pl"; } } # list_domains() # Returns a list of structures containing information about hosted domains sub list_domains { local (@rv, $d); local @files; local @st = stat($domains_dir); if (scalar(@main::list_domains_cache) && $st[9] == $main::list_domains_cache_time) { # Use cache of domain IDs in RAM @files = @main::list_domains_cache; } else { # Re-scan the directory, if un-changed opendir(DIR, $domains_dir); @files = readdir(DIR); closedir(DIR); @main::list_domains_cache = @files; $main::list_domains_cache_time = $st[9]; } foreach $d (@files) { if ($d !~ /^\./ && $d !~ /\.(lock|bak|back|backup|rpmsave|sav|swp|~)$/i && $d !~ /\.webmintmp\.\d+/i) { push(@rv, &get_domain($d)); } } return @rv; } # list_visible_domains([opts]) # Returns a list of domain structures the current user can see, for use in # domain menus. Excludes those that he doesn't have access to, and perhaps # alias domains. sub list_visible_domains { my ($opts) = @_; my @rv = grep { &can_edit_domain($_) } &list_domains(); # Always exclude default host domain my $exclude_defaulthostdomain = { 'exclude' => 'defaulthostdomain' }; $opts = {%$opts, %$exclude_defaulthostdomain} if ($config{'default_domain_ssl'} != 2); # Exclude domains based on given field @rv = grep { ! $_->{$opts->{'exclude'}} } @rv if ($opts->{'exclude'}); return @rv; } # sort_indent_domains(&domains) # Returns a list of all domains sorted according to the module config setting. # Those that should be indented have the 'indent' field set to some number. sub sort_indent_domains { local @doms = @{$_[0]}; local $sortfield = $config{'domains_sort'} || "user"; local %sortkey; if ($sortfield eq 'dom' || $sortfield eq 'sub') { %sortkey = map { $_->{'id'}, &show_domain_name($_) } @doms; } else { %sortkey = map { $_->{'id'}, $_->{$sortfield} } @doms; } @doms = sort { $sortkey{$a->{'id'}} cmp $sortkey{$b->{'id'}} || $a->{'created'} <=> $b->{'created'} } @doms; foreach my $d (@doms) { $d->{'indent'} = 0; } if ($sortfield eq 'user' || $sortfield eq 'sub') { # Re-categorize by owner, with sub-servers indented one and alias # servers indented two under their targets local @catdoms; foreach my $d (grep { !$_->{'parent'} } @doms) { push(@catdoms, $d); foreach my $sd (grep { $_->{'parent'} eq $d->{'id'} && !$_->{'alias'} } @doms) { $sd->{'indent'} = 1; push(@catdoms, $sd); foreach my $ad (grep { $_->{'alias'} eq $sd->{'id'} } @doms) { $ad->{'indent'} = 3; push(@catdoms, $ad); } } foreach my $ad (grep { $_->{'alias'} eq $d->{'id'} } @doms) { $ad->{'indent'} = 2; push(@catdoms, $ad); } } # Any domains that we missed due to their parent not being included # should appear at the top level my %incatdoms = map { $_->{'id'}, $_ } @catdoms; foreach my $d (@doms) { if (!$incatdoms{$d->{'id'}}) { push(@catdoms, $d); } } @doms = @catdoms; } return @doms; } # get_domain(id, [file], [force-reread]) # Looks up a domain object by ID sub get_domain { local ($id, $file, $force) = @_; return undef if (!$id && !$file); if ($id && defined($main::get_domain_cache{$id}) && !$force) { return $main::get_domain_cache{$id}; } local %dom; $file ||= "$domains_dir/$id"; &read_file($file, \%dom) || return undef; $dom{'file'} = "$domains_dir/$id"; $dom{'id'} ||= $id; $dom{'lastread_time'} = time(); &complete_domain(\%dom); if (!defined($dom->{'created'})) { # compat - creation date can be inferred from ID $dom->{'id'} =~ /^(\d{10})/; $dom->{'created'} = $1; } delete($dom->{'missing'}); # never set in a saved domain if ($id) { if ($main::get_domain_cache{$id} && $force) { # In forced re-read mode, update existing object in cache local $cache = $main::get_domain_cache{$id}; %$cache = %dom; } else { # Add to cache $main::get_domain_cache{$id} = \%dom; } } return \%dom; } # complete_domain(&domain) # Fills in any missing fields in a domain object sub complete_domain { local ($dom) = @_; $dom->{'mail'} = 1 if (!defined($dom->{'mail'})); # compat - assume mail is on if (!defined($dom->{'ugid'})) { # compat - assume user's group is domain's group $dom->{'ugid'} = $dom->{'gid'} } if (!defined($dom->{'ugroup'}) && defined($dom->{'ugid'})) { $dom->{'ugroup'} = getgrgid($dom->{'ugid'}); } if ($dom->{'disabled'} eq '1') { # compat - assume everything was disabled $dom->{'disabled'} = "unix,web,dns,mail,mysql,postgres"; } elsif ($dom->{'disabled'}) { # compat - user disabled has changed to unix $dom->{'disabled'} =~ s/user/unix/g; } if ($dom->{'disabled'}) { # Manually disabled $dom->{'disabled_reason'} ||= 'manual'; } if (!defined($dom->{'gid'}) && defined($dom->{'group'})) { # compat - get GID from group name $dom->{'gid'} = getgrnam($dom->{'group'}); } if (!defined($dom->{'unix'}) && !$dom->{'parent'}) { # compat - unix is always on for parent domains $dom->{'unix'} = 1; } if (!defined($dom->{'dir'})) { # if unix is on, so is home $dom->{'dir'} = $dom->{'unix'}; if ($dom->{'parent'}) { # if server has a parent, it never has a Unix user $dom->{'unix'} = 0; } } if (!defined($dom->{'limit_unix'})) { # compat - unix is always available for subdomains $dom->{'limit_unix'} = 1; } if (!defined($dom->{'limit_dir'})) { # compat - home is always available for subdomains $dom->{'limit_dir'} = 1; } if (!defined($dom->{'virt'})) { # compat - assume virtual IP if interface assigned $dom->{'virt'} = $dom->{'iface'} ? 1 : 0; } if (!defined($dom->{'template'})) { # assume default parent or sub-server template $dom->{'template'} = $dom->{'parent'} ? 1 : 0; } if (!defined($dom->{'web_port'}) && $dom->{'web'}) { # compat - assume web port is current setting my $tmpl = &get_template($dom->{'template'}); $dom->{'web_port'} = $tmpl->{'web_port'} || $default_web_port; } if (!defined($dom->{'web_sslport'}) && $dom->{'ssl'}) { # compat - assume SSL port is current setting my $tmpl = &get_template($dom->{'template'}); $dom->{'web_sslport'} = $tmpl->{'web_sslport'} || $web_sslport; } if (!defined($dom->{'prefix'})) { # compat - assume that prefix is same as group $dom->{'prefix'} = $dom->{'group'}; } if (!defined($dom->{'home'})) { local @u = getpwnam($dom->{'user'}); if (@u && $u[7] ne '/' && $u[7] ne '/root') { $dom->{'home'} = $u[7]; } } if (!defined($dom->{'proxy_pass_mode'}) && $dom->{'proxy_pass'}) { # assume that proxy pass mode is proxy-based if not set $dom->{'proxy_pass_mode'} = 1; } if (!defined($dom->{'plan'}) && !$main::no_auto_plan) { # assume first plan local @plans = sort { $a->{'id'} <=> $b->{'id'} } &list_plans(); $dom->{'plan'} = $plans[0]->{'id'}; } if ($dom->{'db'} eq '' && ($dom->{'mysql'} || $dom->{'postgres'})) { $dom->{'db'} = &database_name($dom); } if (!defined($dom->{'db_mysql'}) && $dom->{'mysql'}) { # Assume just one MySQL DB $dom->{'db_mysql'} = $dom->{'db'}; } $dom->{'db_mysql'} = join(" ", &unique(split(/\s+/, $dom->{'db_mysql'}))); if (!defined($dom->{'db_postgres'}) && $dom->{'postgres'}) { # Assume just one PostgreSQL DB $dom->{'db_postgres'} = $dom->{'db'}; } $dom->{'db_postgres'} = join(" ", &unique(split(/\s+/, $dom->{'db_postgres'}))); if ($dom->{'dns'} && $dom->{'dns_submode'} && !$dom->{'dns_subof'}) { # Assume parent DNS domain is parent virtual server $dom->{'dns_subof'} = $dom->{'subdom'} || $dom->{'parent'}; } # Emailto is a computed field &compute_emailto($dom); # Also compute first actual email address if (!$dom->{'emailto_addr'} || $dom->{'emailto_src'} ne $dom->{'emailto'}) { if ($dom->{'emailto'} =~ /^[a-z0-9\.\_\-\+]+\@[a-z0-9\.\_\-]+$/i) { $dom->{'emailto_addr'} = $dom->{'emailto'}; } else { ($dom->{'emailto_addr'}) = &extract_address_parts($dom->{'emailto'}); } $dom->{'emailto_src'} = $dom->{'emailto'}; } # Set edit limits based on ability to edit domains local %acaps = map { $_, 1 } &list_automatic_capabilities($dom->{'domslimit'}); foreach my $ed (@edit_limits) { if (!defined($dom->{'edit_'.$ed})) { $dom->{'edit_'.$ed} = $acaps{$ed} || 0; } } delete($dom->{'pass_set'}); # Only set by callers for modify_* functions } # compute_emailto(&domain) # Populate the emailto field based on the email field sub compute_emailto { local ($dom) = @_; local $parent; if ($dom->{'parent'} && ($parent = &get_domain($dom->{'parent'}))) { $dom->{'emailto'} = $parent->{'emailto'}; } elsif ($dom->{'email'}) { $dom->{'emailto'} = $dom->{'email'}; } elsif ($dom->{'mail'}) { $dom->{'emailto'} = $dom->{'user'}.'@'.$dom->{'dom'}; } else { $dom->{'emailto'} = $dom->{'user'}.'@'.&get_system_hostname(); } } # list_automatic_capabilities(can-create-domains) # Returns a list of default capabilities for a domain owner or plan sub list_automatic_capabilities { local ($cancreate) = @_; if ($cancreate) { return @edit_limits; } else { return ( 'users', 'aliases', 'html', 'passwd' ); } } # get_domain_by(field, value, [field, value, ...]) # Looks up a domain by some field(s). For each field, we either use the quick # map to find relevant domains, or check though all that we have left. # The special value _ANY_ matches any domains where the field is non-empty sub get_domain_by { local @rv; for(my $i=0; $i<@_; $i+=2) { local $mf = $get_domain_by_maps{$_[$i]}; local @possible; local %map; if ($mf && &read_file_cached($mf, \%map)) { # The map knows relevant domains if ($_[$i+1] eq "_ANY_") { # Find domains where the field is non-empty foreach my $k (keys %map) { next if ($k eq ''); foreach my $did (split(" ", $map{$k})) { local $d = &get_domain($did); push(@possible, $d) if ($d); } } } else { # Check for a match foreach my $did (split(" ", $map{$_[$i+1]})) { local $d = &get_domain($did); push(@possible, $d) if ($d); } } } else { # Need to check manually @possible = grep { $_->{$_[$i]} eq $_[$i+1] || $_->{$_[$i]} ne "" && $_[$i+1] eq "_ANY_" } &list_domains(); } if ($i == 0) { # First field, so matches are the result @rv = @possible; } else { # Later field, so winnow down prevent results with new set local %possible = map { $_->{'id'}, $_ } @possible; @rv = grep { $possible{$_->{'id'}} } @rv; } } return wantarray ? @rv : $rv[0]; } # get_domains_by_names_users(&dnames, &usernames, &errorfunc, &plans, # [subservers-too]) # Given a list of domain names, usernames and plans, returns all matching # domains (unioned). May callback to the error function if one cannot be found. sub get_domains_by_names_users { local ($dnames, $users, $efunc, $plans, $subs) = @_; foreach my $domain (&unique(@$dnames)) { local $d = &get_domain_by("dom", $domain); $d || &$efunc("Virtual server $domain does not exist"); push(@doms, $d); } foreach my $uname (&unique(@$users)) { local $dinfo = &get_domain_by("user", $uname, "parent", ""); if ($dinfo) { push(@doms, $dinfo); push(@doms, &get_domain_by("parent", $dinfo->{'id'})); } else { &$efunc("No top-level domain owned by $uname exists"); } } foreach my $plan (&unique(@$plans)) { foreach my $dinfo (&get_domain_by("plan", $plan->{'id'})) { push(@doms, $dinfo); push(@doms, &get_domain_by("parent", $dinfo->{'id'})); } } if ($subs) { my @add; foreach my $d (@doms) { push(@add, &get_domain_by("parent", $d->{'id'})) if (!$d->{'parent'}); push(@add, &get_domain_by("alias", $d->{'id'})) if (!$d->{'alias'}); push(@add, &get_domain_by("subdom", $d->{'id'})) if (!$d->{'subdom'}); } push(@doms, @add); } local %donedomain; @doms = grep { !$donedomain{$_->{'id'}}++ } @doms; return @doms; } # get_domain_by_user(username) # Given a domain owner's Webmin login, return his top-level domain sub get_domain_by_user { local ($user) = @_; if ($access{'admin'}) { # Extra admin local $d = &get_domain($access{'admin'}); if ($d && $d->{'parent'}) { $d = &get_domain($d->{'parent'}); } return $d; } else { # Domain owner local $d = &get_domain_by("user", $user, "parent", ""); return $d; } } # get_domains_by_names(name, ...) # Given a list of domain names, returns the domain objects (where they exist) sub get_domains_by_names { local @rv; foreach my $dname (@_) { my $d = &get_domain_by("dom", $dname); push(@rv, $d) if ($d); } return @rv; } # expand_dns_subdomains(&domains) # Given a list of domains, find all their sub-domains as well and return the # complete list sub expand_dns_subdomains { my ($doms) = @_; my @rv; foreach my $d (@doms) { push(@rv, $d); if ($d->{'dns'}) { push(@rv, grep { $_->{'dns'} } &get_domain_by("dns_subof", $d->{'id'})); } } my %done; return grep { !$done{$_->{'id'}}++ } @rv; } # domain_id() # Returns a new unique domain ID sub domain_id { local $rv = time().$$.$main::domain_id_count; $main::domain_id_count++; return $rv; } # lock_domain(&domain|id) # Lock the config file for some domain sub lock_domain { my ($id) = @_; $id = $id->{'id'} if (ref($id)); &lock_file("$domains_dir/$id"); } # unlock_domain(&domain|id) # Unlock the config file for some domain sub unlock_domain { my ($id) = @_; $id = $id->{'id'} if (ref($id)); &unlock_file("$domains_dir/$id"); } # save_domain(&domain, [creating]) # Write domain information to disk sub save_domain { local ($d, $creating) = @_; local $file = "$domains_dir/$d->{'id'}"; if (!$creating && $d->{'id'} && !-r $file) { # Deleted from under us! Don't save print STDERR "Domain $file was deleted before saving!\n"; &print_call_stack(); return 0; } if ($d->{'dom'} eq '') { # Has no domain name! print STDERR "Domain has no name!\n"; return 0; } &make_dir($domains_dir, 0700); &lock_file($file); local $oldd = { }; if (&read_file($file, $oldd)) { my @st = stat($file); if ($d->{'lastread_time'} && $st[9] > $d->{'lastread_time'}) { print STDERR "Domain $file was modified since last read!\n"; &print_call_stack(); } } if (!$d->{'created'}) { $d->{'created'} = time(); $d->{'creator'} ||= $remote_user; $d->{'creator'} ||= getpwuid($<); } $d->{'id'} ||= &domain_id(); $d->{'lastsave'} = time(); $d->{'lastsave_script'} = $ENV{'SCRIPT_NAME'} || $0; $d->{'lastsave_user'} = $remote_user; $d->{'lastsave_type'} = $main::webmin_script_type; $d->{'lastsave_webmincron'} = $main::webmin_script_webmincron; $d->{'lastsave_pid'} = $main::initial_process_id; delete($d->{'lastread_time'}); &write_file($file, $d); &unlock_file($file); $d->{'lastread_time'} = time(); $main::get_domain_cache{$d->{'id'}} = $d; if (scalar(@main::list_domains_cache)) { @main::list_domains_cache = &unique(@main::list_domains_cache, $d->{'id'}); } # Only rebuild maps if something relevant changed local $mchanged = 0; foreach my $m (keys %get_domain_by_maps) { $mchanged++ if ($d->{$m} ne $oldd->{$m}); } if ($mchanged) { &build_domain_maps(); } &set_ownership_permissions(undef, undef, 0700, $file); return 1; } # delete_domain(&domain) # Delete all of Virtualmin's internal information about a domain sub delete_domain { my ($d) = @_; my $id = $d->{'id'}; &unlink_logged("$domains_dir/$id"); # And the bandwidth and plain-text password files &unlink_file("$bandwidth_dir/$id"); &unlink_file("$plainpass_dir/$id"); &unlink_file("$hashpass_dir/$id"); &unlink_file("$nospam_dir/$id"); &unlink_file("$quota_cache_dir/$id"); if (defined(&get_autoreply_file_dir)) { # Delete any autoreply file links local $dir = &get_autoreply_file_dir(); opendir(AUTODIR, $dir); foreach my $f (readdir(AUTODIR)) { next if ($f eq "." || $f eq ".."); if ($f =~ /^\Q$id-\E/) { unlink("$dir/$f"); } } closedir(AUTODIR); } # Delete scheduled backups owned by the domain owner, or that backup only # this dokmain foreach my $sched (&list_scheduled_backups()) { my @dids = split(/\s+/, $sched->{'doms'}); if ($sched->{'owner'} eq $id) { &delete_scheduled_backup($sched); } elsif (!$sched->{'all'} && !$sched->{'virtualmin'} && &indexof($id, @dids) >= 0) { # If the backup is for specified domains, check if any of # them exist and aren't this domain my $candelete = 1; foreach my $did (@dids) { my $bd = &get_domain($did); if ($bd && $id ne $bd->{'id'}) { $candelete = 0; last; } } if ($candelete) { &delete_scheduled_backup($sched); } } } # Delete any script notifications logs if (-r $script_warnings_file) { &read_file($script_warnings_file, \%warnsent); foreach my $key (keys %warnsent) { my ($keyid) = split(/\//, $key); delete($warnsent{$key}) if ($keyid eq $id); } &write_file($script_warnings_file, \%warnsent); } # Delete script install logs &unlink_file("$script_log_directory/$id"); # Delete differential backup file &unlink_file("$incremental_backups_dir/$id"); # Delete cached links for the domain &clear_links_cache($d); # Delete any saved aliases &unlink_file("$saved_aliases_dir/$id"); # Release any lock on the name &unlock_file("$domainnames_dir/$d->{'dom'}"); &unlink_file("$domainnames_dir/$d->{'dom'}.lock"); # Remove from caches delete($main::get_domain_cache{$d->{'id'}}); if (scalar(@main::list_domains_cache)) { @main::list_domains_cache = grep { $_ ne $d->{'id'} } @main::list_domains_cache; } &build_domain_maps(); } # build_domain_maps() # Create the files used by get_domain_by to quickly lookup domains by user # or parent sub build_domain_maps { local @doms = &list_domains(); foreach my $m (keys %get_domain_by_maps) { local %map; foreach my $d (@doms) { local $v = $d->{$m}; #next if ($v eq ''); if (!defined($map{$v})) { $map{$v} = $d->{'id'}; } else { $map{$v} .= " ".$d->{'id'}; } } &write_file($get_domain_by_maps{$m}, \%map); } } # list_domain_users([&domain], [skipunix], [no-virts], [no-quotas], [no-dbs], [include-extra]) # List all Unix users who are in the domain's primary group. # If domain is omitted, returns local users. sub list_domain_users { local ($d, $skipunix, $novirts, $noquotas, $nodbs, $includeextra) = @_; # Get all aliases (and maybe generics) to look for those that match users local (%aliases, %generics); if ($config{'mail'} && !$novirts) { &require_mail(); if ($config{'mail_system'} == 1) { # Find Sendmail aliases for users %aliases = map { $_->{'name'}, $_ } grep { $_->{'enabled'} } &sendmail::list_aliases($sendmail_afiles); } elsif ($config{'mail_system'} == 0) { # Find Postfix aliases for users %aliases = map { $_->{'name'}, $_ } &$postfix_list_aliases($postfix_afiles); } elsif ($config{'mail_system'} == 5) { # Find VPOPMail aliases to match with users %valiases = map { $_->{'from'}, $_ } &list_virtusers(); } if ($config{'generics'}) { %generics = &get_generics_hash(); } } # Get all virtusers to look for those for users local @virts; if (!$novirts) { @virts = &list_virtusers(); } # Are we setting quotas individually? local $ind_quota = 0; if (&has_quota_commands() && $config{'quota_get_user_command'} && $d) { $ind_quota = 1; } local @users = &list_all_users_quotas($noquotas || $ind_quota); if ($d) { # Limit to domain users. @users = grep { $d->{'gid'} ne '' && $_->{'gid'} == $d->{'gid'} || $_->{'user'} eq $d->{'user'} } @users; foreach my $u (@users) { if ($u->{'user'} eq $d->{'user'} && $u->{'unix'}) { # Virtual server owner $u->{'domainowner'} = 1; if ($config{'mail_system'} == 5) { $u->{'noprimary'} = 1; } if ($d->{'hashpass'}) { $u->{'pass_crypt'} = $d->{'crypt_enc_pass'}; $u->{'pass_md5'} = $d->{'md5_enc_pass'}; $u->{'pass_mysql'} = $d->{'mysql_enc_pass'}; $u->{'pass_digest'} = $d->{'digest_enc_pass'}; } } elsif ($u->{'uid'} == $d->{'uid'} && $u->{'unix'}) { # Web management user $u->{'webowner'} = 1; $u->{'noquota'} = 1; $u->{'noprimary'} = 1; $u->{'noextra'} = 1; $u->{'noalias'} = 1; $u->{'nocreatehome'} = 1; $u->{'nomailfile'} = 1; delete($u->{'email'}); } if ($ind_quota && !$noquotas) { # Call quota getting command for each user local $out = &run_quota_command( "get_user", $u->{'user'}); local ($used, $soft, $hard) = split(/\s+/, $out); $u->{'softquota'} = $soft; $u->{'hardquota'} = $hard; $u->{'uquota'} = $used; } } local @subdoms; if ($d->{'parent'}) { # This is a subdomain - exclude parent domain users @users = grep { $_->{'home'} =~ /^$d->{'home'}\// } @users; } elsif (@subdoms = &get_domain_by("parent", $d->{'id'})) { # This domain has subdomains - exclude their users @users = grep { $_->{'home'} !~ /^$d->{'home'}\/domains\// } @users; } @users = grep { !$_->{'domainowner'} } @users if ($skipunix || $d->{'parent'}); # Remove users with @ in their names for whom a user with the @ replace # already exists (for Postfix) if ($config{'mail_system'} == 0) { local %umap = map { &replace_atsign($_->{'user'}), $_ } grep { $_->{'user'} =~ /\@/ } @users; @users = grep { !$umap{$_->{'user'}} } @users; } if ($config{'mail_system'} == 5) { # Add VPOPMail users for this domain local %attr_map = ( 'name' => 'user', 'passwd' => 'pass', 'clear passwd' => 'plainpass', 'comment/gecos' => 'real', 'dir' => 'home', 'quota' => 'qquota', ); local $user; local $_; open(UINFO, "$vpopbin/vuserinfo -D $d->{'dom'} |"); while() { s/\r|\n//g; if (/^([^:]+):\s+(.*)$/) { local ($attr, $value) = ($1, $2); if ($attr eq "name") { # Start of a new user $user = { 'vpopmail' => 1, 'mailquota' => 1, 'person' => 1, 'fixedhome' => 1, 'noappend' => 1, 'noprimary' => 1, 'alwaysplain' => 1 }; push(@users, $user); } local $amapped = $attr_map{$attr}; $user->{$amapped} = $value if ($amapped); if ($amapped eq "qquota") { # Convert quota to virtualmin format if ($value eq "NOQUOTA") { $user->{$amapped} = 0; } else { $user->{$amapped} = int($value); } } if ($amapped eq "user") { # Email is fixed with vpopmail $user->{'email'} = $value."\@".$d->{'dom'}; } } } close(UINFO); } # Find users with broken home dir (not under homes, or # domain's home, or public_html (for web ftp users)) local $phd = &public_html_dir($d); foreach my $u (@users) { if (!$u->{'webowner'} && $u->{'home'} && $u->{'home'} !~ /^$d->{'home'}\/$config{'homes_dir'}\// && !&is_under_directory($d->{'home'}, $u->{'home'})) { # Home dir is outside domain's home base somehow $u->{'brokenhome'} = 1; } elsif ($u->{'webowner'} && $u->{'home'} && !&is_under_directory($phd, $u->{'home'})) { # Website FTP user's home dir must be under public_html $u->{'brokenhome'} = 1; } elsif ($u->{'home'} eq $d->{'home'}) { # Home dir is equal to domain's dir, which is invalid $u->{'brokenhome'} = 1; } } if ($d->{'hashpass'}) { # Merge in encrypted passwords &read_file_cached("$hashpass_dir/$d->{'id'}", \%hash); foreach my $u (@users) { foreach my $s (@hashpass_types) { $u->{'pass_'.$s} = $hash{$u->{'user'}.' '.$s}; } } } else { # Merge in plain text passwords local (%plain, $need_plainpass_save); &read_file_cached("$plainpass_dir/$d->{'id'}", \%plain); foreach my $u (@users) { if ($u->{'domainowner'}) { # The domain owner's password is always known $u->{'plainpass'} = $d->{'pass'}; } elsif (!defined($u->{'plainpass'}) && defined($plain{$u->{'user'}})) { # Check if the plain password is valid, in case # the crypted password was changed behind # our back if ($plain{$u->{'user'}." encrypted"} eq $u->{'pass'} || &encrypt_user_password( $u, $plain{$u->{'user'}}) eq $u->{'pass'} || &safe_unix_crypt($plain{$u->{'user'}}, $u->{'pass'}) eq $u->{'pass'}) { # Valid - we can use it $u->{'plainpass'} =$plain{$u->{'user'}}; if (!defined($plain{$u->{'user'}. " encrypted"})) { # Save the correct crypted # version now $plain{$u->{'user'}. " encrypted"} = $u->{'pass'}; $need_plainpass_save = 1; } } else { # We know it is wrong, so remove from # the plain password cache file delete($plain{$u->{'user'}}); delete($plain{$u->{'user'}." encrypted"}); $need_plainpass_save = 1; } } } if ($need_plainpass_save) { &write_file("$plainpass_dir/$d->{'id'}", \%plain); } } } else { # Limit to local users local @lg = getgrnam($config{'localgroup'}); @users = grep { $_->{'gid'} == $lg[2] } @users; } # Set appropriate quota field local $tmpl = &get_template($d ? $d->{'template'} : 0); local $qtype = $tmpl->{'quotatype'}; local $u; foreach $u (@users) { $u->{'quota'} = $u->{$qtype.'quota'} if (!defined($u->{'quota'})); $u->{'mquota'} = $u->{$qtype.'mquota'} if (!defined($u->{'mquota'})); } # Merge in cached quotas if ($d) { my $qfile = $quota_cache_dir."/".$d->{'id'}; my %qcache; &read_file_cached($qfile, \%qcache); foreach $u (@users) { $u->{'quota_cache'} = $qcache{$u->{'user'}."_quota"}; $u->{'mquota_cache'} = $qcache{$u->{'user'}."_mquota"}; } } # Check if spamc is being used local $spamc; if ($d && $d->{'spam'}) { local $spamclient = &get_domain_spam_client($d); $spamc = 1 if ($spamclient =~ /spamc/); } # Detect user who are close to their quota if (&has_home_quotas()) { local $bsize = "a_bsize("home"); foreach $u (@users) { local $diff = $u->{'quota'}*$bsize - $u->{'uquota'}*$bsize; if ($u->{'quota'} && $diff < $quota_spam_margin && $d->{'spam'} && !$spamc) { # Close to quota, which will block spamassassin .. $u->{'spam_quota'} = 1; $u->{'spam_quota_diff'} = $diff < 0 ? 0 : $diff; } if ($u->{'quota'} && $u->{'uquota'} >= $u->{'quota'}) { # At or over quota $u->{'over_quota'} = 1; } elsif ($u->{'quota'} && $u->{'uquota'} >= $u->{'quota'}*0.95) { # Over 95% of quota $u->{'warn_quota'} = 1; } } } # Add user-configured recovery addresses if (!$novirts) { foreach my $u (@users) { if (!defined($u->{'recovery'})) { my $recovery = &write_as_mailbox_user($u, sub { &read_file_contents( "$u->{'home'}/.usermin/changepass/recovery") }); $recovery =~ s/\r|\n//g; $u->{'recovery'} = $recovery; } } } if (!$novirts) { # Add email addresses and forwarding addresses to user structures foreach my $u (@users) { $u->{'email'} = $u->{'virt'} = undef; $u->{'alias'} = $u->{'to'} = $u->{'generic'} = undef; $u->{'extraemail'} = $u->{'extravirt'} = undef; local ($al, $va); if ($al = $aliases{&escape_alias($u->{'user'})}) { $u->{'alias'} = $al; $u->{'to'} = $al->{'values'}; } elsif ($va = $valiases{"$u->{'user'}\@$d->{'dom'}"}) { $u->{'valias'} = $va; $u->{'to'} = $va->{'to'}; } elsif ($config{'mail_system'} == 2 || $config{'mail_system'} == 5) { # Find .qmail file local $alias = &get_dotqmail(&dotqmail_file($u)); if ($alias) { $u->{'alias'} = $alias; $u->{'to'} = $u->{'alias'}->{'values'}; } } $u->{'generic'} = $generics{$u->{'user'}}; local $pop3 = $d ? &remove_userdom($u->{'user'}, $d) : $u->{'user'}; local $email = $d ? "$pop3\@$d->{'dom'}" : undef; local $escuser = &escape_user($u->{'user'}); local $escalias = &escape_alias($u->{'user'}); local $v; foreach $v (@virts) { if (@{$v->{'to'}} == 1 && ($v->{'to'}->[0] eq $escuser || $v->{'to'}->[0] eq $escalias || ($v->{'to'}->[0] eq $email && $config{'mail_system'} != 5) || $v->{'from'} eq $email && $v->{'to'}->[0] =~ /^BOUNCE/) && (!$d || $v->{'from'} ne $d->{'dom'})) { if ($v->{'from'} eq $email) { if ($v->{'to'}->[0] !~ /^BOUNCE/) { $u->{'email'} = $email; } $u->{'virt'} = $v; } else { push(@{$u->{'extraemail'}}, $v->{'from'}); push(@{$u->{'extravirt'}}, $v); } } } } } # Push domain extra database users push(@users, &list_extra_db_users($d)) if ($includeextra); if (!$nodbs && $d) { # Add accessible databases local @dbs = &domain_databases($d); local $db; local %dbdone; foreach $u (@users) { $u->{'dbs'} = [ ]; } foreach $db (@dbs) { local @dbu; local $ufunc; if (&indexof($db->{'type'}, &list_database_plugins()) < 0) { # Core database local $dfunc = "list_".$db->{'type'}."_database_users"; next if (!defined(&$dfunc)); $ufunc = $db->{'type'}."_username"; @dbu = &$dfunc($d, $db->{'name'}); } else { # Plugin database next if (!&plugin_defined($db->{'type'}, "database_users")); @dbu = &plugin_call($db->{'type'}, "database_users", $d, $db->{'name'}); } local %dbu = map { $_->[0], $_->[1] } @dbu; local $u; local $domufunc = $db->{'type'}.'_user'; local $domu = defined(&$domufunc) ? &$domufunc($d) : undef; foreach $u (@users) { # Domain owner always gets all databases next if ($u->{'user'} eq $d->{'user'} && $u->{'unix'}); # For each user, add this DB to his list if there # is a user for it with the same name. Unless this # is the same as the domain owner's DB username. local $uname = $ufunc ? &$ufunc($u->{'user'}) : &plugin_call($db->{'type'}, "database_user", $u->{'user'}); if (exists($dbu{$uname}) && $uname ne $domu && !$dbdone{$db->{'type'},$db->{'name'},$uname}++) { push(@{$u->{'dbs'}}, $db); $u->{$db->{'type'}."_user"} = $uname; $u->{$db->{'type'}."_pass"} = $dbu{$uname}; } } } # Add plugin databases local @dbs = &domain_databases($d); foreach $db (@dbs) { next if (&indexof($db->{'type'}, &list_database_plugins()) == -1); } } if ($includeextra && &domain_has_website($d) && &indexof('virtualmin-htpasswd', @plugins) >= 0) { # Include webserver users push(@users, &list_extra_web_users($d)); } # Add any secondary groups in the template local @sgroups = &allowed_secondary_groups($d); if (@sgroups) { local @groups = &list_all_groups(); foreach my $u (@users) { $u->{'secs'} = [ ]; } foreach my $g (@sgroups) { local ($group) = grep { $_->{'group'} eq $g } @groups; if ($group) { local %mems = map { $_, 1 } split(/,/, $group->{'members'}); foreach my $u (@users) { if ($mems{$u->{'user'}}) { push(@{$u->{'secs'}}, $g); } } } } } # Add no-spam flags if ($d) { local %nospam; &read_file_cached("$nospam_dir/$d->{'id'}", \%nospam); foreach my $u (@users) { if (!defined($u->{'nospam'})) { $u->{'nospam'} = $nospam{$u->{'user'}}; } } } # Return users list return @users; } # create_databases_user(&domain, &user, [type]) # Create a database user for some domain # Returns an error message on failure, or undef on success sub create_databases_user { my ($d, $user, $type) = @_; foreach my $dt (&unique(map { $_->{'type'} } &domain_databases($d))) { next if ($type && $type ne $dt); eval { local $main::error_must_die = 1; my @dbs = map { $_->{'name'} } grep { $_->{'type'} eq $dt } @{$user->{'dbs'}}; if (&indexof($dt, &list_database_plugins()) < 0) { # Create in core database my $crfunc = "create_${dt}_database_user"; &$crfunc($d, \@dbs, $user->{'user'}, $user->{'pass'}); } elsif (&indexof($dt, &list_database_plugins()) >= 0) { # Create in plugin database &plugin_call($dt, "database_create_user", $d, \@dbs, $user->{'user'}, $user->{'pass'}); } }; # Show error if ($@) { return &text('user_eadddbuser', "$user->{'user'} : $@"); } } return undef; } # delete_databases_user(&domain, &user) # Delete a database user from a domain # Returns an error message on failure, or undef on success sub delete_databases_user { my ($d, $user) = @_; my @dts; foreach my $dt (&unique(map { $_->{'type'} } &domain_databases($d))) { push(@dts, $dt); eval { local $main::error_must_die = 1; if (&indexof($dt, &list_database_plugins()) < 0) { # Delete from core database local $dlfunc = "delete_${dt}_database_user"; if (defined(&$dlfunc)) { &$dlfunc($d, $user); } } elsif (&indexof($dt, &list_database_plugins()) >= 0) { # Delete from plugin database &plugin_call($dt, "delete_database_user", $d, $user); } }; # Show error if ($@) { my $err = &text('user_edeletedbuser', "$user : $@"); return wantarray ? ($err) : $err; } } return wantarray ? (0, \@dts) : undef; } # safe_unix_crypt(pass, salt) # Tries to call unix_crypt, returns undef if it fails sub safe_unix_crypt { local ($pass, $salt) = @_; local $uc; eval { local $main::error_must_die = 1; $uc = &unix_crypt($pass, $salt); }; return $uc; } # get_user_database_url() # Returns a string to identify the remote system for storing users sub get_user_database_url { &require_useradmin(1); if ($usermodule eq "ldap-useradmin") { my $ldap = &ldap_useradmin::ldap_connect(); my $rv; eval { $rv = "ldap://".$ldap->host(); }; if ($@) { # Fall back to host from config $rv = $ldap_useradmin::config{'ldap_host'} || "localhost"; } $ldap->unbind(); return $rv; } return undef; # Local files } # list_all_users_quotas([no-quotas]) # Returns a list of all Unix users, with quota info sub list_all_users_quotas { # Get quotas for all users &require_useradmin($_[0]); local $hascmds = &has_quota_commands(); if ($hascmds) { # Get from user quota command if (!%main::soft_home_quota && !$_[0]) { local $out = &run_quota_command("list_users"); foreach my $l (split(/\r?\n/, $out)) { local ($user, $used, $soft, $hard) = split(/\s+/, $l); $main::soft_home_quota{$user} = $soft; $main::hard_home_quota{$user} = $hard; $main::used_home_quota{$user} = $used; } } } else { # Get from real quota system if (!%main::soft_home_quota && &has_home_quotas() && !$_[0]) { local $n = "a::filesystem_users($config{'home_quotas'}); local $i; for($i=0; $i<$n; $i++) { $main::soft_home_quota{$quota::user{$i,'user'}} = $quota::user{$i,'sblocks'}; $main::hard_home_quota{$quota::user{$i,'user'}} = $quota::user{$i,'hblocks'}; $main::used_home_quota{$quota::user{$i,'user'}} = $quota::user{$i,'ublocks'}; $main::used_home_fquota{$quota::user{$i,'user'}} = $quota::user{$i,'ufiles'}; } } if (!%main::soft_mail_quota && &has_mail_quotas() && !$_[0]) { local $n = "a::filesystem_users($config{'mail_quotas'}); local $i; for($i=0; $i<$n; $i++) { $main::soft_mail_quota{$quota::user{$i,'user'}} = $quota::user{$i,'sblocks'}; $main::hard_mail_quota{$quota::user{$i,'user'}} = $quota::user{$i,'hblocks'}; $main::used_mail_quota{$quota::user{$i,'user'}} = $quota::user{$i,'ublocks'}; $main::used_mail_fquota{$quota::user{$i,'user'}} = $quota::user{$i,'ufiles'}; } } } # Get user list and add in quota info local @users = &foreign_call($usermodule, "list_users"); local %uidmap; foreach my $u (@users) { $u->{'module'} = $usermodule; local $sameu = $uidmap{$u->{'uid'}}; if ($sameu && !$hascmds) { # Quotas are set on a per-uid basis, so copy from previously # seem user with same ID $u->{'softquota'} = $sameu->{'softquota'}; $u->{'hardquota'} = $sameu->{'hardquota'}; $u->{'uquota'} = $sameu->{'uquota'}; $u->{'ufquota'} = $sameu->{'ufquota'}; $u->{'softmquota'} = $sameu->{'softmquota'}; $u->{'hardmquota'} = $sameu->{'hardmquota'}; $u->{'umquota'} = $sameu->{'umquota'}; $u->{'umfquota'} = $sameu->{'umfquota'}; } else { # Set quotas based on quota commands my $altuser = $u->{'user'} =~ /\@/ ? &replace_atsign($u->{'user'}) : &add_atsign($u->{'user'}); $u->{'softquota'} = $main::soft_home_quota{$u->{'user'}} || $main::soft_home_quota{$altuser}; $u->{'hardquota'} = $main::hard_home_quota{$u->{'user'}} || $main::hard_home_quota{$altuser}; $u->{'uquota'} = $main::used_home_quota{$u->{'user'}} || $main::used_home_quota{$altuser}; $u->{'ufquota'} = $main::used_home_fquota{$u->{'user'}} || $main::used_home_fquota{$altuser}; $u->{'softmquota'} = $main::soft_mail_quota{$u->{'user'}} || $main::soft_mail_quota{$altuser}; $u->{'hardmquota'} = $main::hard_mail_quota{$u->{'user'}} || $main::hard_mail_quota{$altuser}; $u->{'umquota'} = $main::used_mail_quota{$u->{'user'}} || $main::used_mail_quota{$altuser}; $u->{'umfquota'} = $main::used_mail_fquota{$u->{'user'}} || $main::used_mail_fquota{$altuser}; } $u->{'unix'} = 1; $u->{'person'} = 1; $uidmap{$u->{'uid'}} ||= $u; } return @users; } # list_all_groups_quotas([no-quotas]) # Returns a list of all Unix groups, with quota info sub list_all_groups_quotas { # Get quotas for all groups &require_useradmin($_[0]); if (&has_quota_commands()) { # Get from user quota command if (!%main::gsoft_home_quota && !$_[0]) { local $out = &run_quota_command("list_groups"); foreach my $l (split(/\r?\n/, $out)) { local ($group, $used, $soft, $hard) = split(/\s+/, $l); $main::gsoft_home_quota{$group} = $soft; $main::ghard_home_quota{$group} = $hard; $main::gused_home_quota{$group} = $used; } } } else { # Get from real quota system if (!%main::gsoft_home_quota && &has_home_quotas() && !$_[0]) { local $n = "a::filesystem_groups($config{'home_quotas'}); local $i; for($i=0; $i<$n; $i++) { $main::gsoft_home_quota{$quota::group{$i,'group'}} = $quota::group{$i,'sblocks'}; $main::ghard_home_quota{$quota::group{$i,'group'}} = $quota::group{$i,'hblocks'}; $main::gused_home_quota{$quota::group{$i,'group'}} = $quota::group{$i,'ublocks'}; $main::gused_home_fquota{$quota::group{$i,'group'}} = $quota::group{$i,'ufiles'}; } } if (!%main::gsoft_mail_quota && &has_mail_quotas() && !$_[0]) { local $n = "a::filesystem_groups($config{'mail_quotas'}); local $i; for($i=0; $i<$n; $i++) { $main::gsoft_mail_quota{$quota::group{$i,'group'}} = $quota::group{$i,'sblocks'}; $main::ghard_mail_quota{$quota::group{$i,'group'}} = $quota::group{$i,'hblocks'}; $main::gused_mail_quota{$quota::group{$i,'group'}} = $quota::group{$i,'ublocks'}; $main::gused_mail_fquota{$quota::group{$i,'group'}} = $quota::group{$i,'ufiles'}; } } } # Get group list and add in quota info local @groups = &foreign_call($usermodule, "list_groups"); local $u; foreach $u (@groups) { $u->{'module'} = $usermodule; $u->{'softquota'} = $main::gsoft_home_quota{$u->{'group'}}; $u->{'hardquota'} = $main::ghard_home_quota{$u->{'group'}}; $u->{'uquota'} = $main::gused_home_quota{$u->{'group'}}; $u->{'ufquota'} = $main::gused_home_fquota{$u->{'group'}}; $u->{'softmquota'} = $main::gsoft_mail_quota{$u->{'group'}}; $u->{'hardmquota'} = $main::ghard_mail_quota{$u->{'group'}}; $u->{'umquota'} = $main::gused_mail_quota{$u->{'group'}}; $u->{'umfquota'} = $main::gused_mail_fquota{$u->{'group'}}; } return @groups; } # need_extra_user(&user) # Checks if an extra Unix user needs # to be created for Postfix sub need_extra_user { &require_mail(); my $needextra = 0; if ($config{'mail_system'} == 0 && $_[0]->{'user'} =~ /\@/ && !$_[0]->{'webowner'}) { if ($config{'nopostfix_extra_user'} == 2) { # Explicitly enabled by the admin $needextra = 1; } elsif ($config{'nopostfix_extra_user'} == 0) { # Check if it's really needed my $dq = &postfix::get_real_value("resolve_dequoted_address"); $needextra = lc($dq) eq "no" ? 0 : 1; } } return $needextra; } # create_user(&user, [&domain]) # Create a mailbox or local user, his virtuser and possibly his alias sub create_user { local $pop3 = &remove_userdom($_[0]->{'user'}, $_[1]); &require_useradmin(); &require_mail(); if ($_[0]->{'vpopmail'}) { # Create user in VPOPMail local $quser = quotemeta($_[0]->{'user'}); local $qdom = $_[1]->{'dom'}; local $qreal = quotemeta($_[0]->{'real'}) || '""'; local $quota = $_[0]->{'qquota'} ? "-q $_[0]->{'qquota'}" : "-q NOQUOTA"; local $qpass = quotemeta($_[0]->{'plainpass'}) || '""'; local $cmd = "$vpopbin/vadduser $quota -c $qreal $quser\@$qdom $qpass"; local $out = &backquote_logged("$cmd 2>&1"); &error("$cmd failed:
$out
") if ($?); $_[0]->{'home'} = &domain_vpopmail_dir($_[1])."/".$_[0]->{'user'}; } else { # Add the Unix user if ($config{'ldap_mail'}) { $_[0]->{'ldap_attrs'} = [ ]; if ($_[0]->{'email'}) { push(@{$_[0]->{'ldap_attrs'}}, "mail",$_[0]->{'email'}); } local $ea = $config{'ldap_mail'} == 2 ? 'mailAlternateAddress' : 'mail'; push(@{$_[0]->{'ldap_attrs'}}, map { ( $ea, $_ ) } @{$_[0]->{'extraemail'}}); } &foreign_call($usermodule, "set_user_envs", $_[0], 'CREATE_USER', $_[0]->{'plainpass'}, [ ]); &set_virtualmin_user_envs($_[0], $_[1]); &foreign_call($usermodule, "making_changes"); &userdom_substitutions($_[0], $_[1]); &foreign_call($usermodule, "create_user", $_[0]); &foreign_call($usermodule, "made_changes"); } # If we are running Postfix and the username has an @ in it, create an extra # Unix user without the @ but all the other details the same local $extrauser; if (&need_extra_user($_[0])) { $extrauser = { %{$_[0]} }; $extrauser->{'user'} = &replace_atsign($extrauser->{'user'}); &foreign_call($usermodule, "set_user_envs", $extrauser, 'CREATE_USER', $extrauser->{'plainpass'}, [ ]); &set_virtualmin_user_envs($_[0], $_[1]); &foreign_call($usermodule, "making_changes"); &userdom_substitutions($extrauser, $_[1]); &foreign_call($usermodule, "create_user", $extrauser); &foreign_call($usermodule, "made_changes"); } # Add virtusers local $firstemail; local @to = @{$_[0]->{'to'}}; local $vto = @to ? &escape_alias($_[0]->{'user'}) : $extrauser ? $extrauser->{'user'} : &escape_user($_[0]->{'user'}); if ($_[0]->{'email'}) { local $virt = { 'from' => $_[0]->{'email'}, 'to' => [ $vto ] }; &create_virtuser($virt); $_[0]->{'virt'} = $virt; $firstemail ||= $_[0]->{'email'}; } elsif ($can_alias_types{9} && $_[1] && !$_[0]->{'noprimary'} && $_[1]->{'mail'}) { # Add bouncer if email disabled local $virt = { 'from' => "$pop3\@$_[1]->{'dom'}", 'to' => [ "BOUNCE" ] }; &create_virtuser($virt); $_[0]->{'virt'} = $virt; } local @extravirt; local $e; foreach $e (&unique(@{$_[0]->{'extraemail'}})) { local $virt = { 'from' => $e, 'to' => [ $vto ] }; &create_virtuser($virt); push(@extravirt, $virt); $firstemail ||= $e; } $_[0]->{'extravirt'} = \@extravirt; # Add his alias, if any if (@to) { local $alias = { 'name' => &escape_alias($_[0]->{'user'}), 'enabled' => 1, 'values' => $_[0]->{'to'} }; &check_alias_clash($_[0]->{'user'}) && &error(&text('alias_eclash2', $_[0]->{'user'})); if ($config{'mail_system'} == 1) { &sendmail::lock_alias_files($sendmail_afiles); &sendmail::create_alias($alias, $sendmail_afiles); &sendmail::unlock_alias_files($sendmail_afiles); } elsif ($config{'mail_system'} == 0) { &postfix::lock_alias_files($postfix_afiles); &$postfix_create_alias($alias, $postfix_afiles); &postfix::unlock_alias_files($postfix_afiles); &postfix::regenerate_aliases(); } elsif ($config{'mail_system'} == 2 || $config{'mail_system'} == 5) { # Set up user's .qmail file local $dqm = &dotqmail_file($_[0]); &lock_file($dqm); &save_dotqmail($alias, $dqm, $pop3); &unlock_file($dqm); } $_[0]->{'alias'} = $alias; } if ($config{'generics'} && $firstemail) { # Add genericstable entry too &create_generic($_[0]->{'user'}, $firstemail); } if ($_[0]->{'unix'} && !$_[0]->{'noquota'}) { # Set his initial quotas &set_user_quotas($_[0]->{'user'}, $_[0]->{'quota'}, $_[0]->{'mquota'}, $_[1]); &update_user_quota_cache($_[1], $_[0], 0); } # Grant access to databases (unless this is the domain owner) if ($_[1] && !$_[0]->{'domainowner'}) { local $dt; foreach $dt (&unique(map { $_->{'type'} } &domain_databases($_[1]))) { eval { local $main::error_must_die = 1; local @dbs = map { $_->{'name'} } grep { $_->{'type'} eq $dt } @{$_[0]->{'dbs'}}; if (@dbs && &indexof($dt, &list_database_plugins()) < 0) { # Create in core database local $crfunc = "create_${dt}_database_user"; &$crfunc($_[1], \@dbs, $_[0]->{'user'}, $_[0]->{'plainpass'}, $_[0]->{$dt.'_pass'}); } elsif (@dbs && &indexof($dt, &list_database_plugins()) >= 0) { # Create in plugin database &plugin_call($dt, "database_create_user", $_[1], \@dbs, $_[0]->{'user'}, $_[0]->{'plainpass'},$_[0]->{$dt.'_pass'}); } }; if ($@) { $restore_eusersql = $text{'restore_eusersql'}; } } } # Add user to any secondary groups local @groups; @groups = &list_all_groups() if (@{$_[0]->{'secs'}}); foreach my $g (@{$_[0]->{'secs'}}) { local ($group) = grep { $_->{'group'} eq $g } @groups; if ($group) { local @mems = split(/,/, $group->{'members'}); push(@mems, $_[0]->{'user'}); $group->{'members'} = join(",", @mems); &foreign_call($group->{'module'}, "modify_group", $group, $group); } } # Update secondary groups for mail/FTP/db users &update_secondary_groups($_[1]) if ($_[1]); # Update spamassassin whitelist if ($_[1]) { &obtain_lock_spam($_[1]); &update_spam_whitelist($_[1]); &release_lock_spam($_[1]); } if ($_[1]->{'hashpass'}) { # Save hashed passwords, if plain is known if (!-d $hashpass_dir) { mkdir($hashpass_dir, 0700); } if (defined($_[0]->{'plainpass'})) { local %hash; &read_file_cached("$hashpass_dir/$_[1]->{'id'}", \%hash); local $g = &generate_password_hashes( $_[0], $_[0]->{'plainpass'}, $_[1]); foreach my $s (@hashpass_types) { $hash{$_[0]->{'user'}.' '.$s} = $g->{$s}; } &write_file("$hashpass_dir/$_[1]->{'id'}", \%hash); } } else { # Save the plain-text password, if known if (!-d $plainpass_dir) { mkdir($plainpass_dir, 0700); } if (defined($_[0]->{'plainpass'})) { local %plain; &read_file_cached("$plainpass_dir/$_[1]->{'id'}", \%plain); $plain{$_[0]->{'user'}} = $_[0]->{'plainpass'}; $plain{$_[0]->{'user'}." encrypted"} = $_[0]->{'pass'}; &write_file("$plainpass_dir/$_[1]->{'id'}", \%plain); } } # Save the no-spam-check flag if (!-d $nospam_dir) { mkdir($nospam_dir, 0700); } if ($_[0]->{'nospam'}) { local %nospam; &read_file_cached("$nospam_dir/$_[1]->{'id'}", \%nospam); $nospam{$_[0]->{'user'}} = 1; &write_file("$nospam_dir/$_[1]->{'id'}", \%nospam); } # Set the user's Usermin IMAP password if ($_[0]->{'email'} || @{$_[0]->{'extraemail'}}) { &set_usermin_imap_password($_[0]); } # Save the recovery address &set_usermin_recovery_address($_[0]); # Update cache of existing usernames $unix_user{&escape_alias($_[0]->{'user'})}++; # Copy virtusers into alias domains if ($_[1]) { &sync_alias_virtuals($_[1]); } # Create everyone file for domain if ($_[1] && $_[1]->{'mail'}) { &create_everyone_file($_[1]); } # Sync up jail password file if ($_[1]) { &create_jailkit_passwd_file($_[1]); } # Remove clashing records of extra user &merge_extra_user($_[0], $_[1]); } # modify_user(&user, &old, &domain, [noaliases]) # Update a mail / FTP user sub modify_user { # Rename any of his cron jobs if ($_[0]->{'unix'}) { &rename_unix_cron_jobs($_[0]->{'user'}, $_[1]->{'user'}); } local $pop3 = &remove_userdom($_[0]->{'user'}, $_[2]); local $extrauser; if ($_[1]->{'vpopmail'}) { # Update VPOPMail user local $quser = quotemeta($_[1]->{'user'}); local $qdom = $_[2]->{'dom'}; local $qreal = quotemeta($_[0]->{'real'}) || '""'; local $qpass = quotemeta($_[0]->{'plainpass'}); local $qquota = $_[0]->{'qquota'} ? $_[0]->{'qquota'} : "NOQUOTA"; local $cmd = "$vpopbin/vmoduser -c $qreal ". ($_[0]->{'passmode'} == 3 ? " -C $qpass" : ""). " -q $qquota $quser\@$qdom"; local $out = &backquote_logged("$cmd 2>&1"); if ($?) { &error("$cmd failed:
$out
"); } if ($_[0]->{'user'} ne $_[1]->{'user'}) { # Need to rename manually local $vdomdir = &domain_vpopmail_dir($_[2]); &rename_logged("$vdomdir/$_[1]->{'user'}", "$vdomdir/$_[0]->{'user'}"); &lock_file("$vdomdir/vpasswd"); local $lref = &read_file_lines("$vdomdir/vpasswd"); local $l; foreach $l (@$lref) { local @u = split(/:/, $l); if ($u[0] eq $_[1]->{'user'}) { $u[0] = $_[0]->{'user'}; $u[5] =~ s/$_[1]->{'user'}$/$_[0]->{'user'}/; $l = join(":", @u); } } &flush_file_lines(); &unlock_file("$vdomdir/vpasswd"); &system_logged("$vpopbin/vmkpasswd $qdom"); } } else { # Modifying Unix user &require_useradmin(); &require_mail(); # Update the unix user if ($config{'ldap_mail'}) { $_[0]->{'ldap_attrs'} = [ ]; if ($_[0]->{'email'}) { push(@{$_[0]->{'ldap_attrs'}}, "mail",$_[0]->{'email'}); } local $ea = $config{'ldap_mail'} == 2 ? 'mailAlternateAddress' : 'mail'; push(@{$_[0]->{'ldap_attrs'}}, map { ( $ea, $_ ) } @{$_[0]->{'extraemail'}}); } &foreign_call($usermodule, "set_user_envs", $_[0], 'MODIFY_USER', $_[0]->{'plainpass'}, undef, $_[1], $_[1]->{'plainpass'}); &set_virtualmin_user_envs($_[0], $_[2]); &foreign_call($usermodule, "making_changes"); &userdom_substitutions($_[0], $_[2]); &foreign_call($usermodule, "modify_user", $_[1], $_[0]); &foreign_call($usermodule, "made_changes"); if ($config{'mail_system'} == 0 && $_[1]->{'user'} =~ /\@/) { local $esc = &replace_atsign($_[1]->{'user'}); local @allusers = &list_all_users_quotas(1); local ($oldextrauser) = grep { $_->{'user'} eq $esc } @allusers; if ($oldextrauser) { # Found him .. fix up $extrauser = { %{$_[0]} }; $extrauser->{'user'} = &replace_atsign($_[0]->{'user'}); $extrauser->{'dn'} = $oldextrauser->{'dn'}; &foreign_call($usermodule, "set_user_envs", $extrauser, 'MODIFY_USER', $_[0]->{'plainpass'}, undef, $oldextrauser, $_[1]->{'plainpass'}); &set_virtualmin_user_envs($_[0], $_[2]); &foreign_call($usermodule, "making_changes"); &userdom_substitutions($extrauser, $_[2]); &foreign_call($usermodule, "modify_user", $oldextrauser, $extrauser); &foreign_call($usermodule, "made_changes"); } } goto NOALIASES if ($_[3]); # no need to touch aliases and virtusers } # Check if email has changed local $echanged; if (!$_[0]->{'email'} && $_[1]->{'virt'} && # disabling $_[1]->{'virt'}->{'to'}->[0] !~ /^BOUNCE/ || $_[0]->{'email'} && !$_[1]->{'virt'} || # enabling $_[0]->{'email'} && $_[1]->{'virt'} && # changing $_[0]->{'email'} ne $_[1]->{'virt'}->{'from'} || $_[0]->{'email'} && $_[1]->{'virt'} && # also enabling $_[1]->{'virt'}->{'to'}->[0] =~ /^BOUNCE/ ) { # Primary has changed $echanged = 1; } local $oldextra = join(" ", map { $_->{'from'} } @{$_[1]->{'extravirt'}}); local $newextra = join(" ", @{$_[0]->{'extraemail'}}); if ($oldextra ne $newextra) { # Extra has changed $echanged = 1; } if ($_[0]->{'user'} ne $_[1]->{'user'}) { # Always update on a rename $echanged = 1; } local $oldto = join(" ", @{$_[1]->{'to'}}); local $newto = join(" ", @{$_[0]->{'to'}}); if ($oldto ne $newto) { # Always update if forwarding dest has changed $echanged = 1; } local $firstemail; local @to = @{$_[0]->{'to'}}; local @oldto = @{$_[1]->{'to'}}; if ($echanged) { # Take away all virtusers and add new ones, for non Qmail+LDAP users &delete_virtuser($_[1]->{'virt'}) if ($_[1]->{'virt'}); local %oldcmt; foreach my $e (@{$_[1]->{'extravirt'}}) { $oldcmt{$e->{'from'}} = $e->{'cmt'}; &delete_virtuser($e); } local $vto = @to ? &escape_alias($_[0]->{'user'}) : $extrauser ? $extrauser->{'user'} : &escape_user($_[0]->{'user'}); if ($_[0]->{'email'}) { local $virt = { 'from' => $_[0]->{'email'}, 'to' => [ $vto ], 'cmt' => $oldcmt{$_[0]->{'email'}} }; &create_virtuser($virt); $_[0]->{'virt'} = $virt; $firstemail ||= $_[0]->{'email'}; } elsif ($can_alias_types{9} && $_[2] && !$_[0]->{'noprimary'} && $_[2]->{'mail'}) { # Add bouncer if email disabled local $virt = { 'from' => "$pop3\@$_[2]->{'dom'}", 'to' => [ "BOUNCE" ], 'cmt' => $oldcmt{"$pop3\@$_[2]->{'dom'}"} }; &create_virtuser($virt); $_[0]->{'virt'} = $virt; } local @extravirt; foreach my $e (&unique(@{$_[0]->{'extraemail'}})) { local $virt = { 'from' => $e, 'to' => [ $vto ], 'cmt' => $oldcmt{$e} }; &create_virtuser($virt); push(@extravirt, $virt); $firstemail ||= $e; } $_[0]->{'extravirt'} = \@extravirt; } else { # Just work out primary email address, for use by generics if ($_[0]->{'email'}) { $firstemail ||= $_[0]->{'email'}; } foreach my $e (@{$_[0]->{'extraemail'}}) { $firstemail ||= $e; } } # Update, create or delete alias if (@to && !@oldto) { # Need to add alias local $alias = { 'name' => &escape_alias($_[0]->{'user'}), 'enabled' => 1, 'values' => $_[0]->{'to'} }; &check_alias_clash($_[0]->{'user'}) && &error(&text('alias_eclash2', $_[0]->{'user'})); if ($config{'mail_system'} == 1) { # Create Sendmail alias with same name as user &sendmail::lock_alias_files($sendmail_afiles); &sendmail::create_alias($alias, $sendmail_afiles); &sendmail::unlock_alias_files($sendmail_afiles); } elsif ($config{'mail_system'} == 0) { # Create Postfix alias with same name as user &postfix::lock_alias_files($postfix_afiles); &$postfix_create_alias($alias, $postfix_afiles); &postfix::unlock_alias_files($postfix_afiles); &postfix::regenerate_aliases(); } elsif ($config{'mail_system'} == 2 || $config{'mail_system'} == 5) { # Set up user's .qmail file local $dqm = &dotqmail_file($_[0]); &lock_file($dqm); &save_dotqmail($alias, $dqm, $pop3); &unlock_file($dqm); } $_[0]->{'alias'} = $alias; } elsif (!@to && @oldto) { # Need to delete alias if ($config{'mail_system'} == 1) { # Delete Sendmail alias &lock_file($_[0]->{'alias'}->{'file'}); &sendmail::delete_alias($_[0]->{'alias'}); &unlock_file($_[0]->{'alias'}->{'file'}); } elsif ($config{'mail_system'} == 0) { # Delete Postfix alias &lock_file($_[0]->{'alias'}->{'file'}); &$postfix_delete_alias($_[0]->{'alias'}); &unlock_file($_[0]->{'alias'}->{'file'}); &postfix::regenerate_aliases(); } elsif ($config{'mail_system'} == 2 || $config{'mail_system'} == 5) { # Remove user's .qmail file local $dqm = &dotqmail_file($_[0]); &unlink_logged($dqm); } } elsif (@to && @oldto && join(" ", @to) ne join(" ", @oldto)) { # Need to update the alias local $alias = { 'name' => &escape_alias($_[0]->{'user'}), 'enabled' => 1, 'values' => $_[0]->{'to'} }; if ($config{'mail_system'} == 1) { # Update Sendmail alias &lock_file($_[1]->{'alias'}->{'file'}); &sendmail::modify_alias($_[1]->{'alias'}, $alias); &unlock_file($_[1]->{'alias'}->{'file'}); } elsif ($config{'mail_system'} == 0) { # Update Postfix alias &lock_file($_[1]->{'alias'}->{'file'}); &$postfix_modify_alias($_[1]->{'alias'}, $alias); &unlock_file($_[1]->{'alias'}->{'file'}); &postfix::regenerate_aliases(); } elsif ($config{'mail_system'} == 2 || $config{'mail_system'} == 5) { # Set up user's .qmail file local $dqm = &dotqmail_file($_[0]); &lock_file($dqm); &save_dotqmail($alias, $dqm, $pop3); &unlock_file($dqm); } $_[0]->{'alias'} = $alias; } if ($config{'generics'} && $echanged) { # Update genericstable entry too if ($_[1]->{'generic'}) { &delete_generic($_[1]->{'generic'}); } if ($firstemail) { &create_generic($_[0]->{'user'}, $firstemail); } } &sync_alias_virtuals($_[2]); NOALIASES: # Save his quotas if changed (unless this is the domain owner) if ($_[0]->{'unix'} && $_[2] && $_[0]->{'user'} ne $_[2]->{'user'} && !$_[0]->{'noquota'} && ($_[0]->{'quota'} != $_[1]->{'quota'} || $_[0]->{'mquota'} != $_[1]->{'mquota'})) { &set_user_quotas($_[0]->{'user'}, $_[0]->{'quota'}, $_[0]->{'mquota'}, $_[2]); if ($_[0]->{'user'} ne $_[1]->{'user'}) { &update_user_quota_cache($_[1], $_[0], 1); } &update_user_quota_cache($_[2], $_[0], 0); } # Update the plain-text password file, except for a domain owner if (!$_[0]->{'domainowner'} && $_[2] && !$_[2]->{'hashpass'}) { local %plain; mkdir($plainpass_dir, 0700); &read_file_cached("$plainpass_dir/$_[2]->{'id'}", \%plain); if ($_[0]->{'user'} ne $_[1]->{'user'}) { $plain{$_[0]->{'user'}} = $plain{$_[1]->{'user'}}; delete($plain{$_[1]->{'user'}}); $plain{$_[0]->{'user'}." encrypted"} = $plain{$_[1]->{'user'}." encrypted"}; delete($plain{$_[1]->{'user'}." encrypted"}); } if (defined($_[0]->{'plainpass'})) { $plain{$_[0]->{'user'}} = $_[0]->{'plainpass'}; $plain{$_[0]->{'user'}." encrypted"} = $_[0]->{'pass'}; } &write_file("$plainpass_dir/$_[2]->{'id'}", \%plain); } # Update hashed passwords file, except for domain owner if (!$_[0]->{'domainowner'} && $_[2] && $_[2]->{'hashpass'}) { local %hash; mkdir($hashpass_dir, 0700); &read_file_cached("$hashpass_dir/$_[2]->{'id'}", \%hash); if ($_[0]->{'user'} ne $_[1]->{'user'}) { foreach my $s (@hashpass_types) { $hash{$_[0]->{'user'}.' '.$s} = $hash{$_[1]->{'user'}.' '.$s}; delete($hash{$_[1]->{'user'}.' '.$s}); } } if (defined($_[0]->{'plainpass'})) { # Re-hash new password local $g = &generate_password_hashes( $_[0], $_[0]->{'plainpass'}, $_[2]); foreach my $s (@hashpass_types) { $hash{$_[0]->{'user'}.' '.$s} = $g->{$s}; $_[0]->{'pass_'.$s} = $g->{$s}; } } &write_file("$hashpass_dir/$_[2]->{'id'}", \%hash); } # Update his allowed databases (unless this is the domain owner), if any # have been added or removed. &modify_database_user(@_); # Rename user in secondary groups, and update membership local @groups = &list_all_groups(); local %secs = map { $_, 1 } @{$_[0]->{'secs'}}; local @sgroups = &allowed_secondary_groups($_[2]); foreach my $group (@groups) { local @mems = split(/,/, $group->{'members'}); local $idx = &indexof($_[1]->{'user'}, @mems); local $changed; if ($idx >= 0) { # User is currently in group if ($_[0]->{'user'} ne $_[1]->{'user'}) { # Just rename in group, if needed $changed = 1; $mems[$idx] = $_[0]->{'user'}; } elsif (!$secs{$group->{'group'}}) { # Remove from group, if this is a secondary managed # by Virtualmin if (&indexof($group->{'group'}, @sgroups) >= 0) { splice(@mems, $idx, 1); $changed = 1; } } } elsif ($secs{$group->{'group'}}) { # User is not in group, but needs to be push(@mems, $_[0]->{'user'}); $changed = 1; } if ($changed) { # Only save group if members were changed $group->{'members'} = join(",", @mems); &foreign_call($group->{'module'}, "modify_group", $group, $group); } } # Update mail/FTP/db groups &update_secondary_groups($_[2]) if ($_[2]); # Update spamassassin whitelist if ($_[2]) { &obtain_lock_spam($_[2]); &update_spam_whitelist($_[2]); &release_lock_spam($_[2]); } # Update the no-spam-check flag if ($_[2]) { if (!-d $nospam_dir) { mkdir($nospam_dir, 0700); } if (defined($_[0]->{'nospam'})) { local %nospam; &read_file_cached("$nospam_dir/$_[2]->{'id'}", \%nospam); if ($_[0]->{'user'} ne $_[1]->{'user'}) { delete($nospam{$_[1]->{'user'}}); } $nospam{$_[0]->{'user'}} = $_[0]->{'nospam'}; &write_file("$nospam_dir/$_[2]->{'id'}", \%nospam); } } # Update the last logins file if ($_[0]->{'user'} ne $_[1]->{'user'}) { &lock_file($mail_login_file); my %logins; &read_file_cached($mail_login_file, \%logins); if ($logins{$_[1]->{'user'}}) { $logins{$_[1]->{'user'}} = $logins{$_[1]->{'user'}}; delete($logins{$_[1]->{'user'}}); &write_file($mail_login_file, \%logins); } &unlock_file($mail_login_file); } # Clear quota cache for this user if (defined(&clear_lookup_domain_cache) && $_[2]) { &clear_lookup_domain_cache($_[2], $_[0]); } # Set the user's Usermin IMAP password if ($_[0]->{'email'} || @{$_[0]->{'extraemail'}}) { &set_usermin_imap_password($_[0]); } # Save the recovery address &set_usermin_recovery_address($_[0]); # Update cache of existing usernames if ($_[0]->{'user'} ne $_[1]->{'user'}) { $unix_user{&escape_alias($_[0]->{'user'})}++; $unix_user{&escape_alias($_[1]->{'user'})} = 0; } if ($_[0]->{'shell'} ne $_[1]->{'shell'}) { # Rebuild denied user list, by shell &build_denied_ssh_group(); } # Rebuild group of domain owners if ($_[0]->{'domainowner'}) { &update_domain_owners_group(); } # Create everyone file for domain if ($_[2] && $_[2]->{'mail'}) { &create_everyone_file($_[2]); } # Sync up jail password file if ($_[2]) { &create_jailkit_passwd_file($_[2]); } } # delete_user(&user, &domain) # Delete a mailbox user and all associated virtusers and aliases sub delete_user { # For extra specific user associated # with domain delete it and return if ($_[0]->{'extra'}) { if ($_[0]->{'type'} eq 'db') { # Delete database user my ($err, $dts) = &delete_databases_user($_[1], $_[0]->{'user'}); &error($err) if ($err); # Delete user from domain config &delete_extra_user($_[1], $_[0]); } if ($_[0]->{'type'} eq 'web') { &delete_webserver_user($_[0], $_[1]); } return undef; } # Check if deleted user present in other users aliases &remove_forward_in_other_users($_[0], $_[1]); # Zero out his quotas if ($_[0]->{'unix'} && !$_[0]->{'noquota'}) { &set_user_quotas($_[0]->{'user'}, 0, 0, $_[1]); &update_user_quota_cache($_[1], $_[0], 1); } # Delete any of his cron jobs if ($_[0]->{'unix'}) { &delete_unix_cron_jobs($_[0]->{'user'}); } if ($_[0]->{'vpopmail'}) { # Call VPOPMail delete user program local $quser = quotemeta($_[0]->{'user'}); local $qdom = $_[1]->{'dom'}; local $cmd = "$vpopbin/vdeluser $quser\@$qdom"; local $out = &backquote_logged("$cmd 2>&1"); if ($?) { &error("$cmd failed:
$out
"); } } else { # Delete Unix user $_[0]->{'user'} eq 'root' && &error("Cannot delete root user!"); $_[0]->{'uid'} == 0 && &error("Cannot delete UID 0 user!"); &require_useradmin(); &require_mail(); # Delete the user &foreign_call($usermodule, "set_user_envs", $_[0], 'DELETE_USER'); &set_virtualmin_user_envs($_[0], $_[1]); &foreign_call($usermodule, "making_changes"); &foreign_call($usermodule, "delete_user", $_[0]); &foreign_call($usermodule, "made_changes"); # Record the old UID to prevent re-use &record_old_uid($_[0]->{'uid'}); } if ($config{'mail_system'} == 0 && $_[0]->{'user'} =~ /\@/) { # Find the Unix user with the @ escaped and delete it too local $esc = &replace_atsign_if_exists($_[0]->{'user'}); local @allusers = &list_all_users_quotas(1); local ($extrauser) = grep { $_->{'user'} eq $esc } @allusers; if ($extrauser) { &foreign_call($usermodule, "set_user_envs", $extrauser, 'DELETE_USER'); &set_virtualmin_user_envs($_[0], $_[1]); &foreign_call($usermodule, "making_changes"); &foreign_call($usermodule, "delete_user", $extrauser); &foreign_call($usermodule, "made_changes"); } } # Delete any virtusers (extra email addresses for this user) &delete_virtuser($_[0]->{'virt'}) if ($_[0]->{'virt'}); local $e; foreach $e (@{$_[0]->{'extravirt'}}) { &delete_virtuser($e); } # Delete his alias (for forwarding), if any if ($_[0]->{'alias'}) { if ($config{'mail_system'} == 1) { # Delete Sendmail alias with same name as user if (!$_[0]->{'alias'}->{'deleted'}) { &lock_file($_[0]->{'alias'}->{'file'}); &sendmail::delete_alias($_[0]->{'alias'}); &unlock_file($_[0]->{'alias'}->{'file'}); $_[0]->{'alias'}->{'deleted'} = 1; } } elsif ($config{'mail_system'} == 0) { # Delete Postfix alias with same name as user if (!$_[0]->{'alias'}->{'deleted'}) { &lock_file($_[0]->{'alias'}->{'file'}); &$postfix_delete_alias($_[0]->{'alias'}); &unlock_file($_[0]->{'alias'}->{'file'}); &postfix::regenerate_aliases(); $_[0]->{'alias'}->{'deleted'} = 1; } } elsif ($config{'mail_system'} == 2 || $config{'mail_system'} == 5) { # .qmail will be deleted when user is } } if ($config{'generics'} && $_[0]->{'generic'}) { # Delete genericstable entry too &delete_generic($_[0]->{'generic'}); } # Delete database access (unless this is the domain owner) if ($_[1] && !$_[0]->{'domainowner'}) { local $dt; foreach $dt (&unique(map { $_->{'type'} } &domain_databases($_[1]))) { local @dbs = map { $_->{'name'} } grep { $_->{'type'} eq $dt } @{$_[0]->{'dbs'}}; if (@dbs && &indexof($dt, &list_database_plugins()) < 0) { # Delete from core database local $dlfunc = "delete_${dt}_database_user"; &$dlfunc($_[1], $_[0]->{'user'}); } elsif (@dbs && &indexof($dt, &list_database_plugins()) >= 0) { # Delete from plugin database &plugin_call($dt, "delete_database_user", $_[1], $_[0]->{'user'}); } } } # Take the user out of any secondary groups local @groups = &list_all_groups(); foreach my $group (@groups) { local @mems = split(/,/, $group->{'members'}); local $idx = &indexof($_[0]->{'user'}, @mems); if ($idx >= 0) { splice(@mems, $idx, 1); $group->{'members'} = join(",", @mems); &foreign_call($group->{'module'}, "modify_group", $group, $group); } } # Update mail/FTP/db groups to remove user &update_secondary_groups($_[1]) if ($_[1]); # Update spamassassin whitelist if ($_[1]) { &obtain_lock_spam($_[1]); &update_spam_whitelist($_[1]); &release_lock_spam($_[1]); } # Remove the plain-text password local %plain; if (!-d $plainpass_dir) { mkdir($plainpass_dir, 0700); } &read_file_cached("$plainpass_dir/$_[1]->{'id'}", \%plain); delete($plain{$_[0]->{'user'}}); delete($plain{$_[0]->{'user'}." encrypted"}); &write_file("$plainpass_dir/$_[1]->{'id'}", \%plain); # Remove the hashed password local %hash; if (!-d $hashpass_dir) { mkdir($hashpass_dir, 0700); } &read_file_cached("$hashpass_dir/$_[1]->{'id'}", \%hash); foreach my $s (@hashpass_types) { delete($hash{$_[0]->{'user'}.' '.$s}); } &write_file("$hashpass_dir/$_[1]->{'id'}", \%hash); # Clear the no-spam flag local %spam; if (!-d $nospam_dir) { mkdir($nospam_dir, 0700); } &read_file_cached("$nospam_dir/$_[1]->{'id'}", \%spam); delete($spam{$_[0]->{'user'}}); &write_file("$nospam_dir/$_[1]->{'id'}", \%spam); # Update cache of existing usernames $unix_user{&escape_alias($_[0]->{'user'})} = 0; # Delete from last logins file &lock_file($mail_login_file); my %logins; &read_file_cached($mail_login_file, \%logins); if ($logins{$_[0]->{'user'}}) { delete($logins{$_[0]->{'user'}}); &write_file($mail_login_file, \%logins); } &unlock_file($mail_login_file); # Create everyone file for domain, minus the user if ($_[1] && $_[1]->{'mail'}) { &create_everyone_file($_[1]); } if ($_[1]) { &sync_alias_virtuals($_[1]); } # Sync up jail password file if ($_[1]) { &create_jailkit_passwd_file($_[1]); } } # modify_databse_user(&user, &olduser, &domain) # Updates the database user, including database # permissions and password sub modify_database_user { my $newdbstr = join(" ", map { $_->{'type'}."_".$_->{'name'} } @{$_[0]->{'dbs'}}); my $olddbstr = join(" ", map { $_->{'type'}."_".$_->{'name'} } @{$_[1]->{'dbs'}}); if ($_[2] && !$_[0]->{'domainowner'} && ($newdbstr ne $olddbstr || $_[0]->{'pass'} ne $_[1]->{'pass'} || $_[0]->{'user'} ne $_[1]->{'user'})) { foreach my $dt (&unique(map { $_->{'type'} } &domain_databases($_[2]))) { my @dbs = map { $_->{'name'} } grep { $_->{'type'} eq $dt } @{$_[0]->{'dbs'}}; my @olddbs = map { $_->{'name'} } grep { $_->{'type'} eq $dt } @{$_[1]->{'dbs'}}; my $plugin = &indexof($dt, &list_database_plugins()) >= 0; if (@dbs && !@olddbs) { # Need to add database user if (!$plugin) { my $crfunc = "create_${dt}_database_user"; &$crfunc($_[2], \@dbs, $_[0]->{'user'}, $_[0]->{'plainpass'}, $_[0]->{'pass_'.$dt}); } else { &plugin_call($dt, "database_create_user", $_[2], \@dbs, $_[0]->{'user'}, $_[0]->{'plainpass'}, $_[0]->{'pass_'.$dt}); } } elsif (@dbs && @olddbs) { # Need to update database user if (!$plugin) { my $mdfunc = "modify_${dt}_database_user"; &$mdfunc($_[2], \@olddbs, \@dbs, $_[1]->{'user'}, $_[0]->{'user'}, $_[0]->{'plainpass'}, $_[0]->{'pass_'.$dt}); } else { &plugin_call($dt, "database_modify_user", $_[2], \@olddbs, \@dbs, $_[1]->{'user'}, $_[0]->{'user'}, $_[0]->{'plainpass'}, $_[0]->{'pass_'.$dt}); } } elsif (!@dbs && @olddbs) { # Need to delete database user if (!$plugin) { my $dlfunc = "delete_${dt}_database_user"; &$dlfunc($_[2], $_[1]->{'user'}); } else { &plugin_call($dt, "database_delete_user", $_[2], $_[1]->{'user'}); } } } } } # set_usermin_imap_password(&user) # If Usermin is setup to use an IMAP inbox on localhost, set this user's # IMAP password sub set_usermin_imap_password { local ($user) = @_; return 0 if (!$user->{'unix'} || !$user->{'home'}); return 0 if (!$user->{'plainpass'}); # Make sure Usermin is installed, and the mailbox module is setup for IMAP return 0 if (!&foreign_check("usermin")); &foreign_require("usermin"); return 0 if (!&usermin::get_usermin_module_info("mailbox")); local %mconfig; &read_file("$usermin::config{'usermin_dir'}/mailbox/config", \%mconfig); return 0 if ($mconfig{'mail_system'} != 4); return 0 if ($mconfig{'pop3_server'} ne '' && $mconfig{'pop3_server'} ne 'localhost' && $mconfig{'pop3_server'} ne '127.0.0.1' && &to_ipaddress($mconfig{'pop3_server'}) ne &to_ipaddress(&get_system_hostname())); # Set the password &create_usermin_module_directory($user, "mailbox"); if (-d "$user->{'home'}/.usermin/mailbox") { local %inbox; local $imapfile = "$user->{'home'}/.usermin/mailbox/inbox.imap"; &read_file($imapfile, \%inbox); if (&usermin::get_usermin_version() >= 1.323) { $inbox{'user'} = '*'; } else { $inbox{'user'} = $user->{'user'}; } $inbox{'pass'} = $user->{'plainpass'}; $inbox{'nologout'} = 1; eval { # Ignore errors here, in case user is over quota local $main::error_must_die = 1; &write_as_mailbox_user($user, sub { &write_file($imapfile, \%inbox); &set_ownership_permissions(undef, undef, $imapfile, 0600) }); }; } } # create_usermin_module_directory(&user, module) # Creates the Usermin config directories for a user sub create_usermin_module_directory { my ($user, $mod) = @_; foreach my $dir ($user->{'home'}, "$user->{'home'}/.usermin", "$user->{'home'}/.usermin/$mod") { next if ($user->{'webowner'} && $dir eq $user->{'home'}); next if ($user->{'domainowner'} && $dir eq $user->{'home'}); if (!-e $dir) { if ($dir eq $user->{'home'}) { &make_dir($dir, 0700); &set_ownership_permissions( $user->{'uid'}, $user->{'gid'}, 0700, $dir); } else { &write_as_mailbox_user($user, sub { &make_dir($dir, 0700); &set_ownership_permissions(undef, undef, 0700, $dir) }); } } } } # set_usermin_recovery_address(&user) # Updates the password recovery file for a user sub set_usermin_recovery_address { my ($user) = @_; return 0 if (!$user->{'unix'} || !$user->{'home'}); &create_usermin_module_directory($user, "changepass"); if (-d "$user->{'home'}/.usermin/changepass") { my $rfile = "$user->{'home'}/.usermin/changepass/recovery"; eval { # Ignore errors here, in case user is over quota local $main::error_must_die = 1; &write_as_mailbox_user($user, sub { open(RECOVERY, ">$rfile"); if ($user->{'recovery'}) { print RECOVERY $user->{'recovery'},"\n"; } close(RECOVERY); &set_ownership_permissions(undef, undef, $rfile, 0600) }); }; return 1; } return 0; } # delete_unix_cron_jobs(username) # Delete all Cron jobs belonging to some Unix user sub delete_unix_cron_jobs { local ($username) = @_; &foreign_require("cron"); local @jobs = &cron::list_cron_jobs(); local $cronfile; foreach my $j (@jobs) { if ($j->{'user'} eq $username) { $cronfile ||= &cron::cron_file($j); &lock_file($cronfile); &cron::delete_cron_job($j); } } if ($cron::config{'cron_dir'} && $username) { # Make sure file is gone &unlink_file($cron::config{'cron_dir'}."/".$username); } &unlock_file($cronfile) if ($cronfile); } # rename_unix_cron_jobs(username, oldusername) # Change the name of the user who owns any cron jobs sub rename_unix_cron_jobs { local ($username, $oldusername) = @_; return if ($username eq $oldusername); &foreign_require("cron"); if (-r "$cron::config{'cron_dir'}/$oldusername") { # Rename user's crontab directory file &rename_logged("$cron::config{'cron_dir'}/$oldusername", "$cron::config{'cron_dir'}/$username"); } # Rename jobs in other files local @jobs = &cron::list_cron_jobs(); local $cronfile; foreach my $j (@jobs) { if ($j->{'user'} eq $oldusername) { $cronfile ||= &cron::cron_file($j); &lock_file($cronfile); $j->{'user'} = $username; &cron::change_cron_job($j); } } &unlock_file($cronfile) if ($cronfile); } # copy_unix_cron_jobs(username, oldusername) # Duplicate all cron jobs for some domain user sub copy_unix_cron_jobs { local ($username, $oldusername) = @_; return if ($username eq $oldusername); &foreign_require("cron"); local @jobs = &cron::list_cron_jobs(); foreach my $j (@jobs) { if ($j->{'user'} eq $oldusername) { local $newj = { %$j }; $newj->{'user'} = $username; &cron::create_cron_job($newj); } } } # disable_unix_cron_jobs(username) # Disable all Cron jobs belonging to some Unix user sub disable_unix_cron_jobs { local ($username) = @_; &foreign_require("cron"); local @jobs = &cron::list_cron_jobs(); local $cronfile; foreach my $j (@jobs) { if ($j->{'user'} eq $username && $j->{'active'} && !$j->{'name'}) { $cronfile ||= &cron::cron_file($j); &lock_file($cronfile); $j->{'active'} = 0; if ($j->{'command'} !~ /#\s+VIRTUALMIN\s+DISABLE/) { $j->{'command'} .= " # VIRTUALMIN DISABLE"; } &cron::change_cron_job($j); } } &unlock_file($cronfile) if ($cronfile); } # enable_unix_cron_jobs(username) # Enable all Cron jobs belonging to some Unix user sub enable_unix_cron_jobs { local ($username) = @_; &foreign_require("cron"); local @jobs = &cron::list_cron_jobs(); local $cronfile; foreach my $j (@jobs) { if ($j->{'user'} eq $username && !$j->{'active'} && !$j->{'name'} && $j->{'command'} =~ /#\s+VIRTUALMIN\s+DISABLE/) { $cronfile ||= &cron::cron_file($j); &lock_file($cronfile); $j->{'active'} = 1; $j->{'command'} =~ s/\s+#\s+VIRTUALMIN\s+DISABLE//g; &cron::change_cron_job($j); } } &unlock_file($cronfile) if ($cronfile); } # validate_user(&domain, &user, [&olduser]) # Called before a user is saved, to validate it. Must return undef on success, # or an error message on failure sub validate_user { local ($d, $user, $old) = @_; if ($d && @{$user->{'dbs'}} && (!$old || !@{$old->{'dbs'}})) { # Enabling database access .. make sure a password was given if (!$user->{'plainpass'} && !$user->{'pass_mysql'}) { return $text{'user_edbpass'}; } # Check for username clash return &check_any_database_user_clash($d, $user->{'user'}) if (!$user->{'nocheck'}); } if ($d && $user->{'home'} && (!$old || $old->{'home'} ne $user->{'home'}) && !&is_under_directory($d->{'home'}, $user->{'home'})) { # Home dir is outside domain's home return &text('user_ehomehome', $d->{'home'}); } return undef; } # set_user_quotas(username, home-quota, mail-quota, [&domain]) # Sets the quotas for a mailbox user sub set_user_quotas { local $tmpl = &get_template($_[3] ? $_[3]->{'template'} : 0); if (&has_quota_commands()) { # Call the external quota program &run_quota_command("set_user", $_[0], $tmpl->{'quotatype'} eq 'hard' ? ( int($_[1]), int($_[1]) ) : ( int($_[1]), 0 )); } else { # Call through to quotas module if (&has_home_quotas()) { &set_quota($_[0], $config{'home_quotas'}, $_[1], $tmpl->{'quotatype'} eq 'hard'); } if (&has_mail_quotas()) { &set_quota($_[0], $config{'mail_quotas'}, $_[2], $tmpl->{'quotatype'} eq 'hard'); } } } # update_user_quota_cache(&domain, &user|&users, [deleting]) # Updates the cache file of mailbox quotas for this virtual server sub update_user_quota_cache { my ($d, $userlist, $deleting) = @_; my $users = ref($userlist) eq 'ARRAY' ? $userlist : [ $userlist ]; &make_dir($quota_cache_dir, 0755) if (!-d $quota_cache_dir); my $qfile = $quota_cache_dir."/".$d->{'id'}; my %cache; &lock_file($qfile); &read_file_cached($qfile, \%cache); foreach my $user (@$users) { my $u = $user->{'user'}; if ($deleting) { delete($cache{$u."_quota"}); delete($cache{$u."_mquota"}); } else { $cache{$u."_quota"} = $user->{'quota'}; if (defined($user->{'mquota'})) { $cache{$u."_mquota"} = $user->{'mquota'} } else { delete($cache{$u."_mquota"}); } } } &write_file($qfile, \%cache); &unlock_file($qfile); } # run_quota_command(config-suffix, arg, ...) # Run some external quota set/get command. On failure calls error, otherwise # returns the output. sub run_quota_command { local ($cfg, @args) = @_; local $cmd = $config{'quota_'.$cfg.'_command'}." ". join(" ", map { quotemeta($_) } @args); local $out = &backquote_logged("$cmd 2>&1 $cmd", "
".&html_escape($out)."
")); } else { return $out; } } # encrypt_user_password(&user, text) # Given a plain text password, returns a suitable encrypted form for # a mailbox user. sub encrypt_user_password { &require_useradmin(); local ($user, $pass) = @_; local $salt = $user->{'pass'}; $salt =~ s/^\!//; return &foreign_call($usermodule, "encrypt_password", $pass, $salt); } # generate_password_hashes(&user, text, &domain) # Given a password, returns a hash ref of it hashed into different formats. # Keys returned are : # md5 - MD5 hash # crypt - Unix crypt # unix - Appropriate hash for Unix user # mysql - MySQL password hash # digest - Web digest authentication hash sub generate_password_hashes { local ($user, $pass, $d) = @_; local $tmpl = &get_template($d->{'template'}); if ($tmpl->{'hashtypes'} eq 'none') { # Don't return any hash types return { }; } &require_useradmin(); local %rv; local $salt = $user->{'pass'} && $user->{'pass'} !~ /\$/ ? $user->{'pass'} : &random_salt(); $salt =~ s/^\!// if ($salt); $rv{'crypt'} = &unix_crypt($pass, $salt); if (!&useradmin::check_md5()) { local $salt = $user->{'pass'} && $user->{'pass'} =~ /\$1\$/ ? $user->{'pass'} : undef; $salt =~ s/^\!// if ($salt); $rv{'md5'} = &useradmin::encrypt_md5($pass); } $rv{'unix'} = &encrypt_user_password($user, $pass); if ($config{'mysql'}) { &require_mysql(); eval { # This can fail if MySQL is down local $main::error_must_die = 1; local $qpass = &mysql_escape($pass); local $pf = &get_mysql_password_func($d); local $rv = &execute_dom_sql($d, $mysql::master_db, "select $pf('$qpass')"); $rv{'mysql'} = $rv->{'data'}->[0]->[0]; }; } if (&foreign_check("htaccess-htpasswd")) { &foreign_require("htaccess-htpasswd"); $rv{'digest'} = &htaccess_htpasswd::digest_password( $user->{'user'}, $d->{'dom'}, $pass); } if ($tmpl->{'hashtypes'} ne '' && $tmpl->{'hashtypes'} ne '*') { # Remove disabled types local %newrv; foreach my $t (split(/\s+/, $tmpl->{'hashtypes'})) { $newrv{$t} = $rv{$t} if (defined($rv{$t})); } return \%newrv; } else { # Just return all types return \%rv; } } # list_password_hash_types() # Returns a list of all supported hashing types and their descriptions sub list_password_hash_types { return ( map { [ $_, $text{'hashtype_'.$_} ] } @hashpass_types ); } # generate_domain_password_hashes(&domain, new-domain?) # Updates a domain object with the appropriate password hash fields. For use # when creating a new domain. sub generate_domain_password_hashes { local ($d, $newdom) = @_; local $parent = $d->{'parent'} ? &get_domain($d->{'parent'}) : undef; if ($newdom) { if ($parent) { # Inherit from parent $d->{'hashpass'} ||= $parent->{'hashpass'}; } else { # Inherit from template local $tmpl = &get_template($d->{'template'}); $d->{'hashpass'} ||= $tmpl->{'hashpass'}; } } return if (!$d->{'hashpass'}); # Hashing disabled if ($d->{'parent'}) { # Just copy from parent $parent = &get_domain($d->{'parent'}); foreach my $k ('enc_pass', 'mysql_enc_pass', 'crypt_enc_pass', 'md5_enc_pass', 'digest_enc_pass') { $d->{$k} = $parent->{$k}; } } else { # Hash and store return if (!$d->{'pass'}); # Plaintext password unknown local $fakeuinfo = { 'user' => $d->{'user'} }; local $hashes = &generate_password_hashes( $fakeuinfo, $d->{'pass'}, $d); $d->{'enc_pass'} = $hashes->{'unix'}; if (!$d->{'mysql_pass'}) { $d->{'mysql_enc_pass'} = $hashes->{'mysql'}; } $d->{'crypt_enc_pass'} = $hashes->{'crypt'}; $d->{'md5_enc_pass'} = $hashes->{'md5'}; $d->{'digest_enc_pass'} = $hashes->{'digest'}; } $d->{'hashpass'} = 1; delete($d->{'pass'}); } # create_user_home(&uinfo, &domain, always-chown) # Creates the home directory for a new mail user, and copies skel files into it sub create_user_home { local ($user, $d, $always) = @_; local $home = $user->{'home'}; if ($home) { # Create his homedir local @st = $d ? stat($d->{'home'}) : ( undef, undef, 0755 ); if (!-e $home || $always) { &lock_file($home); &make_dir($home, $st[2] & 0777); &set_ownership_permissions($user->{'uid'}, $user->{'gid'}, $st[2] & 0777, $home); &system_logged("chown -R $user->{'uid'}:$user->{'gid'} ". quotemeta($home)); &unlock_file($home); } # Copy files into homedir. Don't die if this fails for quota issues eval { local $main::error_must_die = 1; ©_skel_files( &substitute_domain_template($config{'mail_skel'}, $d), $user, $home); }; } } # delete_user_home(&user, &domain) # Deletes the home directory of a user, if valid sub delete_user_home { local ($user, $d) = @_; if ($user->{'unix'} && -d $user->{'home'} && &safe_delete_dir($d, $user->{'home'})) { &system_logged("rm -rf ".quotemeta($user->{'home'})); } } # domain_title(&domain) sub domain_title { print "
",&domain_in($_[0]),"
\n"; } # domain_in(&domain) sub domain_in { return &text('indom', "".&show_domain_name($_[0]).""); } # copy_skel_files(basedir, &user, home, [group], [&for-domain]) # Copy files to the home directory of some new user sub copy_skel_files { local ($uf, $user, $home, $group, $d) = @_; return if (!$uf); # Find all files under the skeleton dir my @files = &find_skel_files($uf); my @copied; foreach my $f (@files) { local $src = "$uf/$f"; # Needs to be local, for subs local $dst = "$home/$f"; my $func; # Get file info as root before copying local @st = stat($src); local $data; if (-f $src) { $data = &read_file_contents($src); } local $lnk = readlink($src); if (-l $src) { # Re-create symlink $func = sub { &symlink_file($lnk, $dst) }; } elsif (-d $src) { # Re-create directory $func = sub { $st[2] ||= 0755; &make_dir($dst, $st[2] & 07777) }; } else { # Copy file contents $func = sub { return if (!defined($data)); &open_tempfile(SKEL, ">$dst", 0, 1); &print_tempfile(SKEL, $data); &close_tempfile(SKEL); &set_ownership_permissions( undef, undef, $st[2], $dst) }; } if ($user) { &write_as_mailbox_user($user, $func); } else { &$func(); } push(@copied, $dst); } # Perform variable substition on the files, if requested if ($d) { local $tmpl = &get_template($d->{'template'}); if ($tmpl->{'skel_subs'}) { foreach my $c (@copied) { if (-r $c && !-d $c && !-l $c && (!$tmpl->{'skel_onlysubs'} || &match_skel_subs($c, $tmpl->{'skel_onlysubs'})) && !&match_skel_subs($c, $tmpl->{'skel_nosubs'}) && &guess_mime_type($c) !~ /^image\//) { local $data = &read_file_contents_as_domain_user($d, $c); &open_tempfile_as_domain_user($d, OUT, ">$c"); &print_tempfile(OUT, &substitute_domain_template($data, $d)); &close_tempfile_as_domain_user($d, OUT); } } } } } # match_skel_subs(path, nosubs-list) # Returns 1 if some filename matches the space-separated list of patterns given sub match_skel_subs { my ($path, $nosubs_str) = @_; return 0 if ($nosubs_str !~ /\S/); my @nosubs = &split_quoted_string($nosubs_str); foreach my $ns (@nosubs) { $path =~ /^(\S+)\/([^\/]+)$/ || next; my ($dir, $file) = ($1, $2); my @matches = glob("$dir/$ns"); if (&indexof($path, @matches) >= 0) { return 1; } } return 0; } # find_skel_files(dir) # Given a directory, recursively finds all files and directories under it and # returns their relative paths sub find_skel_files { my ($dir) = @_; opendir(SKELDIR, $dir); my @files = grep { $_ ne '.' && $_ ne '..' } readdir(SKELDIR); closedir(SKELDIR); my @rv; foreach my $f (@files) { my $path = "$dir/$f"; if (-l $path || !-d $path) { push(@rv, $f); } elsif (-d $path) { push(@rv, $f); push(@rv, map { "$f/$_" } &find_skel_files($path)); } } return @rv; } # can_edit_domain(&domain) # Returns 1 if the current user can edit some domain (ie. change users, aliases # databases, and so on) sub can_edit_domain { if ($access{'reseller'}) { # User is a reseller .. is this one of his domains? if ($_[0]->{'parent'}) { # Parent domain permissions apply return &can_edit_domain(&get_domain($_[0]->{'parent'})); } else { return &indexof($base_remote_user, split(/\s+/, $_[0]->{'reseller'})) >= 0; } } else { return 1 if ($access{'domains'} eq "*"); return 0 if (!$_[0]->{'id'}); local $d; foreach $d (split(/\s+/, $access{'domains'})) { return 1 if ($d eq $_[0]->{'id'}); } return 0; } } # can_delete_domain(&domain) sub can_delete_domain { local ($d) = @_; return &can_edit_domain($d) && !$d->{'protected'} && (&master_admin() || &reseller_admin() && !$access{'nodelete'} || $_[0]->{'parent'} && $access{'edit_delete'}); } # can_associate_domain(&domain) # Only the master admin is allowed to disconnect or connect features sub can_associate_domain { return &master_admin() && !$d->{'protected'}; } sub can_move_domain { local ($d) = @_; return &can_edit_domain($d) && (&master_admin() || &reseller_admin()); } sub can_transfer_domain { return &master_admin(); } # Returns 1 if the current user is the master Virtualmin admin sub master_admin { return !$access{'noconfig'}; } # Returns 1 if the current user is a reseller sub reseller_admin { return $access{'reseller'}; } # Returns the domain ID if the current user is an extra admin sub extra_admin { return $access{'admin'}; } # Returns 1 if the current user can stop and start servers sub can_stop_servers { return $access{'stop'}; } # Returns 1 if templates, plugins, fields, ips and resellers can be edited sub can_edit_templates { return &master_admin(); } # Returns 1 if the user can view installed plugins and system status sub can_view_status { return &master_admin(); } # Returns 1 if the user can view software versions and other info sub can_view_sysinfo { if ($config{'show_sysinfo'} == 1) { # Show to everyone return 1; } elsif ($config{'show_sysinfo'} == 2) { # Show to root only return &master_admin(); } elsif ($config{'show_sysinfo'} == 3) { # Show to root and resellers (not used) return &master_admin() || &reseller_admin(); } else { # Show to nobody (not used) return 0; } } # Returns 1 if the user can re-check the licence status sub can_recheck_licence { return 0 if (!$virtualmin_pro); return &master_admin(); } # Returns 1 if the user can edit local users sub can_edit_local { return $access{'local'}; } # Returns 1 if the user can create new top-level servers or child servers sub can_create_master_servers { return $access{'create'} == 1; } # Returns 1 if the user can create new child servers sub can_create_sub_servers { return $access{'create'}; } sub can_create_sub_domains { return 0 if (!&can_create_sub_servers()); if ($config{'allow_subdoms'} eq '1') { return 1; } elsif ($config{'allow_subdoms'} eq '0') { return 0; } else { local @subdoms = grep { $_->{'subdom'} } &list_domains(); return @subdoms ? 1 : 0; } } sub can_create_batch { return &master_admin() || &reseller_admin() || $config{'batch_create'}; } # Returns 1 if the user can migrate servers from other control panels with # no limits, 2 if only remote file migration is allowed, and 3 if only # remote file migration of sub-servers is allowed. sub can_migrate_servers { if (!$access{'import'} && !$access{'migrate'}) { return 0; } elsif (&master_admin()) { # Root can import everything return 1; } elsif (&reseller_admin()) { # Resellers can import from remote return 2; } else { # Domain owners can migrate sub-servers from remote, iff they can also # restore backups return &can_restore_domain() ? 3 : 0; } } # Returns 1 if the user can import existing servers and databases sub can_import_servers { return $access{'import'}; } # Returns 1 if an existing group can be chosen for new domain Unix users sub can_choose_ugroup { return $config{'show_ugroup'} && &master_admin(); } # can_use_feature(feature) # Returns 1 if the current user can use some feature at domain creation time, # or enable or disable it for existing domains sub can_use_feature { local ($f) = @_; if (&master_admin()) { # Master admin can use anything return 1; } elsif (&reseller_admin()) { # Resellers can use features they have been granted, or features # that are forced on return $config{$f} == 3 || $access{"feature_".$f}; } else { # Domain owners can use granted features (but never change the Unix # account, which will be always on) if ($f eq 'unix') { return 0; } else { return $config{$f} == 3 || $access{"feature_".$f}; } } } # Returns 1 if the current user is allowed to select a private or shared # IP for a virtual server sub can_select_ip { local @shared = &list_shared_ips(); return &can_use_feature("virt") || @shared && &can_edit_sharedips(); } # Returns 1 if the current user is allowed to select a private or shared # IPv6 address for a virtual server sub can_select_ip6 { local @shared = &list_shared_ip6s(); return &can_use_feature("virt6") || @shared && &can_edit_sharedips(); } # can_edit_limits(&domain) # Returns 1 if owner limits can be edited in some domain sub can_edit_limits { return &master_admin() || &reseller_admin() && &can_edit_domain($_[0]); } # can_edit_res(&domain) # Returns 1 if memory / process limits can be edited in some domain sub can_edit_res { return &master_admin() || &reseller_admin() && &can_edit_domain($_[0]); } # can_config_domain(&domain) # Returns 1 if the current user can change the settings for a domain (like the # password, real name and so on) sub can_config_domain { return $access{'edit'} && &can_edit_domain($_[0]); } # Returns 1 if the current user can change quotas for an owned domain sub can_edit_quotas { return $access{'edit'} == 1; } # Returns 1 if the current user can rename domains, 2 if he can rename and # select a new username sub can_rename_domains { return $access{'norename'} ? 0 : &master_admin() || &reseller_admin() ? 2 : 1; } # Returns 1 if the current user can change the home directory of a domain, # 2 if he can change it to anything sub can_rehome_domains { return $access{'norename'} ? 0 : &master_admin() ? 2 : 1; } sub can_edit_users { return &master_admin() || &reseller_admin() || $access{'edit_users'}; } sub can_edit_aliases { return &master_admin() || &reseller_admin() || $access{'edit_aliases'}; } # Returns 1 if the current user can edit databases sub can_edit_databases { return &master_admin() || &reseller_admin() || $access{'edit_dbs'}; } # Returns 1 if the current user can change this name of his default DB sub can_edit_database_name { return &master_admin() || &reseller_admin() || !$access{'nodbname'}; } sub can_edit_admins { local ($d) = @_; return $d->{'webmin'} && (&master_admin() || &reseller_admin() && !$access{'noadmins'} || $access{'edit_admins'}); } sub can_edit_spam { return &master_admin() || &reseller_admin() || $access{'edit_spam'}; } # Returns 2 if all website options can be edited, 1 if only non-suexec related # settings, 0 if nothing sub can_edit_phpmode { return &master_admin() ? 2 : &reseller_admin() ? 1 : $access{'edit_phpmode'} ? 1 : 0; } sub can_edit_phpver { return &master_admin() || &reseller_admin() || $access{'edit_phpver'}; } sub can_edit_sharedips { return &master_admin() || &reseller_admin() && !$access{'nosharedips'} || $access{'edit_sharedips'}; } sub can_edit_catchall { return &master_admin() || &reseller_admin() || $access{'edit_catchall'}; } sub can_edit_html { return &master_admin() || &reseller_admin() || $access{'edit_html'}; } sub can_edit_scripts { return &master_admin() || &reseller_admin() || $access{'edit_scripts'}; } sub can_unsupported_scripts { return &master_admin(); } sub can_edit_forward { return &master_admin() || &reseller_admin() && !$access{'noproxy'} || $access{'edit_forward'}; } sub can_edit_redirect { return &master_admin() || &reseller_admin() || $access{'edit_redirect'}; } sub can_edit_ssl { return &master_admin() || &reseller_admin() || $access{'edit_ssl'}; } sub can_edit_letsencrypt { return &master_admin() || &reseller_admin() && $config{'can_letsencrypt'} <= 1 || $config{'can_letsencrypt'} == 0; } # Returns 1 if the current user can setup bandwidth limits for a domain sub can_edit_bandwidth { return &master_admin() || &reseller_admin(); } # Returns 1 if the current user can see historical system data sub can_show_history { return $virtualmin_pro && &master_admin(); } sub can_edit_exclude { return !$access{'admin'} && &can_backup_domain(); } # can_edit_spf(&domain) # Allow master admin, resellers, domain owners with DNS options permissions sub can_edit_spf { local ($d) = @_; return &master_admin() || &reseller_admin() || $access{'edit_spf'}; } # can_edit_dmarc(&domain) # Allow master admin, resellers, domain owners with DNS options permissions sub can_edit_dmarc { local ($d) = @_; return &master_admin() || &reseller_admin() || $access{'edit_spf'}; } # can_edit_records(&domain) # Allow master admin, resellers, domain owners with DNS records permission sub can_edit_records { local ($d) = @_; return &master_admin() || &reseller_admin() || $access{'edit_records'}; } sub can_edit_mail { return &master_admin() || &reseller_admin() || $access{'edit_mail'}; } # Returns 1 if the current user can disable and enable the given domain sub can_disable_domain { local ($d) = @_; return &can_edit_domain($d) && !$d->{'protected'} && (&master_admin() || &reseller_admin() || $d->{'parent'} && !$d->{'alias'} && $access{'edit_disable'}); } # Returns 1 if the configuration can be checked sub can_check_config { return &master_admin(); } # Returns 1 if address, autoreply and filter files can be edited sub can_edit_afiles { return $config{'edit_afiles'} || &master_admin(); } # can_change_ip(&domain) # Returns 1 if the current user can change the IP of a domain sub can_change_ip { local $tmpl = &get_template($_[0]->{'template'}); return &master_admin() || $access{'edit_ip'} && &can_use_feature("virt") && $tmpl->{'ranges'} ne "none"; } # can_mailbox_home(&user) # Returns 1 if the current Webmin user can choose the home directory of some # mailbox user sub can_mailbox_home { local ($user) = @_; return &master_admin() || $config{'edit_homes'} == 1 || $config{'edit_homes'} == 2 && $user->{'webowner'}; } # Returns 1 if the current user can create FTP mailboxes sub can_mailbox_ftp { return &master_admin() || $config{'edit_ftp'}; } # Returns 1 if the current user can set the quota for mailboxes sub can_mailbox_quota { return &master_admin() || $config{'edit_quota'}; } # can_use_template(&template) # Returns 1 if some template can be used by the current user, or his reseller sub can_use_template { local ($tmpl) = @_; if (&master_admin()) { # Root can use all templates return 1; } if ($tmpl->{'resellers'} ne '*') { # Template has a reseller restriction, check it local %resels = map { $_, 1 } split(/\s+/, $tmpl->{'resellers'}); if (&reseller_admin()) { # Is current user in the reseller list? return 0 if (!$resels{$base_remote_user}); } else { # Is user's reseller in list? local $dom = &get_domain_by("user", $base_remote_user, "parent", undef); if (!($dom && $dom->{'reseller'} && $resels{$dom->{'reseller'}})) { return 0; } } } if ($tmpl->{'owners'} ne '*' && !&reseller_admin()) { # Template has owner restrictions, check them local %owners = map { $_, 1 } split(/\s+/, $tmpl->{'owners'}); return 0 if (!$owners{$base_remote_user}); } return 1; } # Returns 1 if the current user can execute remote commands sub can_remote { return &master_admin(); } # Returns 1 if the current user can grant extra modules to server owners sub can_webmin_modules { return &master_admin(); } # Returns 1 if the current user can change a domain's shell sub can_edit_shell { return &master_admin(); } # can_switch_user(&domain, [extra-admin]) # Returns 1 if the current user can switch to the Webmin login for some domain sub can_switch_user { local ($d, $admin) = @_; return $main::session_id && # When using session auth !$access{'admin'} && # Not for extra admins (&master_admin() || # Master can switch, or domain owner to extras &reseller_admin() && &can_edit_domain($d) || $admin && &can_edit_domain($d)); } # can_switch_usermin(&domain, &user) # Returns 1 if the current user is allowed to switch to Usermin sub can_switch_usermin { local ($d, $user) = @_; return &can_edit_domain($d) && &master_admin() || $config{'usermin_switch'}; } # Returns 1 if the user can view mail logs for some domain (or all domains if # none was given). Also returns 0 if mail logs are not enabled. sub can_view_maillog { local ($d) = @_; return 0 if ($config{'maillog_hide'} == 2 || $config{'maillog_hide'} == 1 && !&master_admin()); return 0 if (!&procmail_logging_enabled()); if ($d) { return &can_edit_domain($d); } else { return &master_admin(); } } # Returns 1 if the current user can see the preview website link sub can_use_preview { return $config{'show_preview'} == 2 || $config{'show_preview'} == 1 && &master_admin(); } # can_use_validation() # Returns 1 if the current user can validate virtual servers, 2 if they can # setup scheduled validaton. sub can_use_validation { if (&master_admin()) { return 2; } elsif ($config{'show_validation'} >= 1 && &reseller_admin()) { return 1; } elsif ($config{'show_validation'} == 2) { return 1; } else { return 0; } } # can_forward_alias(address) # Returns 1 if forwarding to some remote address is allowed sub can_forward_alias { my ($a) = @_; return 1 if (&master_admin()); return 1 if ($config{'remote_alias'}); my %allowed = map { $_->{'dom'}, 1 } &list_domains(); $allowed{&get_system_hostname(0)} = 1; $allowed{&get_system_hostname(1)} = 1; foreach my $e (&extract_address_parts($a)) { my ($mb, $dn) = split(/\@/, $e); next if (!$dn); $allowed{lc($dn)} || return 0; } return 1; } # domains_table(&domains, [checkboxes], [return-html], [exclude-cols]) # Display a list of domains in a table, with links for editing sub domains_table { local ($doms, $checks, $noprint, $exclude) = @_; $exclude ||= [ ]; local %emap = map { $_, 1 } @$exclude; local $usercounts = &count_domain_users(); local $aliascounts = &count_domain_aliases(1); local @table_features = grep { $config{$_} } split(/,/, $config{'index_fcols'}); local $showchecks = $checks && &can_config_domain($_[0]->[0]); # Generate headers local @heads; if ($showchecks) { push(@heads, ""); } my @colnames = split(/,/, $config{'index_cols'}); if (!@colnames) { @colnames = ( 'dom', 'user', 'owner', 'users', 'aliases'); } if (!&has_home_quotas()) { @colnames = grep { $_ ne 'quota' && $_ ne 'uquota' } @colnames; } @colnames = grep { !$emap{$_} } @colnames; if (!defined(&list_resellers)) { @colnames = grep { $_ ne 'reseller' } @colnames; } push(@heads, map { $text{'index_'.$_} } @colnames); foreach my $f (&list_custom_fields()) { if ($f->{'show'} && ($f->{'visible'} < 2 || &master_admin())) { push(@colnames, 'field_'.$f->{'name'}); my ($desc, $tip) = split(/;/, $f->{'desc'}); push(@heads, $desc); } } push(@heads, map { $text{'index_'.$_} } @table_features); # Generate the table contents local @table; foreach my $d (&sort_indent_domains($doms)) { $done{$d->{'id'}}++; local $pfx = " " x ($d->{'indent'} * 2); local @cols; # Add configured columns foreach my $c (@colnames) { if ($c eq "dom") { # Domain name, with link my $prog = &can_config_domain($d) ? "edit_domain.cgi" : "view_domain.cgi"; my $dn = &shorten_domain_name($d); $dn = $d->{'disabled'} ? &ui_text_color("$dn", 'danger') : $dn; my $proxy = $d->{'proxy_pass_mode'} == 2 ? " (F)" : $d->{'proxy_pass_mode'} == 1 ? " (P)" :""; push(@cols, "$pfx$dn$proxy"); } elsif ($c eq "type") { my $dtype = $d->{'alias'} ? "$pfx$text{'form_generic_aliasshort'}" : $d->{'parent'} ? "$pfx$text{'form_generic_subserver'}" : $text{'form_generic_master'}; push(@cols, $dtype); } elsif ($c eq "user") { # Username push(@cols, &html_escape($d->{'user'})); } elsif ($c eq "owner") { # Domain description / owner if ($d->{'alias'}) { my $aliasdom = &get_domain($d->{'alias'}); my $of = &text('index_aliasof', $aliasdom->{'dom'}); push(@cols, &html_escape($d->{'owner'} || $of)); } else { push(@cols, &html_escape($d->{'owner'})); } } elsif ($c eq "emailto") { # Email address push(@cols, &html_escape($d->{'emailto'})); } elsif ($c eq "reseller") { # Reseller name push(@cols, &html_escape($d->{'reseller'})); } elsif ($c eq "admins") { # Extra admin names my @admins = map { $_->{'name'} } &list_extra_admins($d); if (&can_edit_admins($d)) { @admins = map { "". &html_escape($_)."" } @admins; } push(@cols, join(' ', @admins)); } elsif ($c eq "users") { # User count if (&can_domain_have_users($d)) { # Link to users my $uc = int($usercounts->{$d->{'id'}}); if (&can_edit_users()) { push(@cols, $uc." ". "(". $text{'index_list'}.")"); } else { push(@cols, $uc); } } else { push(@cols, ""); } } elsif ($c eq "aliases") { # Alias count, with link if ($d->{'mail'}) { my $ac = int($aliascounts->{$d->{'id'}}); if (&can_edit_aliases() && !$d->{'aliascopy'}) { push(@cols, $ac." ". "(". $text{'index_list'}.")"); } else { push(@cols, scalar(@aliases)); } } else { push(@cols, $text{'index_nomail'}); } } elsif ($c eq "quota") { # Quota assigned my $qd = $d->{'parent'} ? &get_domain($d->{'parent'}) : $d; push(@cols, $qd->{'quota'} ? "a_show($qd->{'quota'}, "home") : $text{'form_unlimit'}); } elsif ($c eq "uquota") { # Quota used if ($d->{'alias'} || $d->{'parent'}) { # Alias and sub-servers have no usage push(@cols, &nice_size(0)); } else { # Show total usage for domain my $qmax = $d->{'quota'} ? $d->{'quota'}*"a_bsize("home") : undef; my ($hq, $mq, $dbq) = &get_domain_quota($d, 1); my $ut = $hq*"a_bsize("home") + $mq*"a_bsize("mail") + $dbq; local $txt = &nice_size($ut); if ($qmax && $bytes > $qmax) { $txt ="$txt"; } push(@cols, $txt); } } elsif ($c eq "created") { # Creation date push(@cols, &make_date($d->{'created'}, 1)); } elsif ($c eq "plan") { # Account plan my $p; if ($d->{'plan'} ne '' && defined(&get_plan) && ($p = &get_plan($d->{'plan'}))) { push(@cols, $p->{'name'}); } else { push(@cols, ""); } } elsif ($c eq "phpv") { # PHP version my $ver; if (&domain_has_website($d)) { $ver = &get_domain_php_version($d); $ver ||= &get_apache_mod_php_version(); $ver = &get_php_version($ver) || $ver; } push(@cols, $ver); } elsif ($c eq "ip") { # IP address my $ip = $d->{'ip'}; $ip = "$ip" if ($d->{'virt'}); push(@cols, $ip); } elsif ($c eq "ssl_expiry") { # SSL cert expiry if (!&domain_has_ssl_cert($d)) { push(@cols, ""); } elsif ($d->{'ssl_cert_expiry'}) { push(@cols, &make_date($d->{'ssl_cert_expiry'}, 1)); } else { push(@cols, "$text{'maillog_unknown'}"); } } elsif ($c =~ /^field_/) { # Some custom field push(@cols, &html_escape($d->{$c})); } } foreach $f (@table_features) { push(@cols, $d->{$f} ? $text{'yes'} : $text{'no'}); } if (&can_config_domain($d) && $showchecks) { unshift(@cols, { 'type' => 'checkbox', 'name' => 'd', 'value' => $d->{'id'} }); } push(@table, \@cols); } # Output the table local $rv = &ui_columns_table(\@heads, 100, \@table); if ($noprint) { return $rv; } else { print $rv; } } # userdom_name(name, &domain, [force-append-style]) # Returns a username with the domain prefix (usually group) appended somehow sub userdom_name { my ($name, $d, $append_style) = @_; if (!defined($append_style)) { if (defined($d->{'append_style'})) { $append_style = $d->{'append_style'}; } else { my $tmpl = &get_template($d->{'template'}); $append_style = $tmpl->{'append_style'}; } } if ($append_style == 0) { return $name.".".$d->{'prefix'}; } elsif ($append_style == 1) { return $name."-".$d->{'prefix'}; } elsif ($append_style == 2) { return $d->{'prefix'}.".".$name; } elsif ($append_style == 3) { return $d->{'prefix'}."-".$name; } elsif ($append_style == 4) { return $name."_".$d->{'prefix'}; } elsif ($append_style == 5) { return $d->{'prefix'}."_".$name; } elsif ($append_style == 6) { return $name."\@".$d->{'dom'}; } elsif ($append_style == 7) { return $name."\%".$d->{'prefix'}; } else { &error("Unknown append_style $append_style"); } } # guess_append_style(username, &domain) # Returns the append_style number used for some username, or undef if unknown sub guess_append_style { local ($name, $d) = @_; local $p = $d->{'prefix'}; local $dom = $d->{'dom'}; return $name =~ /\.\Q$p\E$/ ? 0 : $name =~ /\-\Q$p\E$/ ? 1 : $name =~ /^\Q$p\E\./ ? 2 : $name =~ /^\Q$p\E\-/ ? 3 : $name =~ /_\Q$p\E$/ ? 4 : $name =~ /^\Q$p\E_/ ? 5 : $name =~ /\@\Q$dom\E$/ ? 6 : $name =~ /\%\Q$p\E$/ ? 7 : undef; } # remove_userdom(name, &domain) # Returns a username with the domain prefix (group) stripped off sub remove_userdom { return $_[0] if (!$_[1]); # No domain return $_[0] if ($_[0] eq $_[1]->{'user'}); # Domain owner has no prefix local $g = $_[1]->{'prefix'}; local $d = $_[1]->{'dom'}; local $rv = $_[0]; ($rv =~ s/\@(\Q$d\E)$//) || ($rv =~ s/(\.|\-|_|\%)\Q$g\E$//) || ($rv =~ s/^\Q$g\E(\.|\-|_|\%)//); return $rv; } # too_long(name) # Returns an error message if a username is too long for this Unix variant sub too_long { local $max = &max_username_length(); if ($max && length($_[0]) > $max) { return &text('user_elong', "$_[0]", $max); } else { return undef; } } # valid_alias_name(name) # Returns an error message if an alias name contains bogus characters sub valid_alias_name { local ($name) = @_; if ($name !~ /^[^ \t:\&\(\)\|\;\<\>\*\?\!\/\\]+$/) { return $text{'user_euser'}; } return undef; } # valid_mailbox_name(name) # Returns an error message if a mailbox name contains bogus characters, or uses # a reserved name sub valid_mailbox_name { local ($name) = @_; &require_useradmin(); local $err = &valid_alias_name($name); return $err if ($err); if ($name eq "domains" || $name eq "logs" || $name eq $home_virtualmin_backup) { return &text('user_ereserved', $name); } if ($name =~ /^\d+/) { return $text{'user_enumeric'}; } $err = &useradmin::check_username_restrictions($name); if ($err) { return $err; } return undef; } sub max_username_length { &require_useradmin(); return $uconfig{'max_length'}; } # get_default_ip([reseller-list]) # Returns this system's primary IP address. If a reseller is given and he # has a custom IP, use that. sub get_default_ip { local ($reselname) = @_; if ($reselname && defined(&get_reseller)) { # Check if the reseller has an IP foreach my $r (split(/\s+/, $reselname)) { local $resel = &get_reseller($r); if ($resel && $resel->{'acl'}->{'defip'}) { return $resel->{'acl'}->{'defip'}; } } } if ($config{'defip'}) { # Explicitly set on module config page return $config{'defip'}; } elsif (&running_in_zone()) { # From zone's interface &foreign_require("net"); local ($iface) = grep { $_->{'up'} && &net::iface_type($_->{'name'}) =~ /ethernet/i } &net::active_interfaces(); return $iface ? $iface->{'address'} : undef; } else { # From interface detected at check time &foreign_require("net"); local $ifacename = $config{'iface'} || &first_ethernet_iface(); local ($iface) = grep { $_->{'fullname'} eq $ifacename } &net::active_interfaces(); if ($iface) { return $iface->{'address'}; } else { return undef; } } } # get_default_ip6([reseller-name]) # Returns this system's primary IPv6 address. If a reseller is given and he # has a custom IP, use that. sub get_default_ip6 { local ($reselname) = @_; if ($reselname && defined(&get_reseller)) { # Check if the reseller has an IP local $resel = &get_reseller($reselname); if ($resel && $resel->{'acl'}->{'defip6'}) { return $resel->{'acl'}->{'defip6'}; } } if ($config{'defip6'}) { # Explicitly set on module config page return $config{'defip6'}; } else { # From interface detected at check time &foreign_require("net"); local $ifacename = $config{'iface'} || &first_ethernet_iface(); local ($iface) = grep { $_->{'fullname'} eq $ifacename } &net::boot_interfaces(); if ($iface) { # Use address on the boot interface if possible, as active # IPv6 addresses can get re-ordered my $best = &best_ip6_address($iface); return $best if ($best); } # Otherwise, fall back to first active address ($iface) = grep { $_->{'fullname'} eq $ifacename } &net::active_interfaces(); if ($iface) { my $best = &best_ip6_address($iface); return $best if ($best); } return undef; } } # best_ip6_address(&iface) # Returns the best IPv6 address (not local) from an interface sub best_ip6_address { local ($iface) = @_; return undef if (!$iface->{'address6'}); foreach my $a (@{$iface->{'address6'}}) { next if ($a eq '::1'); # localhost next if ($a =~ /^fe80::/); # Link local next if ($a =~ /^2000::/); # Global unicast next if ($a eq '::'); # Unknown next if ($a =~ /^(fec0|fc00):/); # Site local return $a; } return undef; } # first_ethernet_iface() # Returns the name of the first active ethernet interface sub first_ethernet_iface { &foreign_require("net"); my @active = &net::active_interfaces(); # First try to find a non-virtual Ethernet interface foreach my $a (@active) { if ($a->{'up'} && $a->{'virtual'} eq '' && $a->{'address'} ne '127.0.0.1' && (&net::iface_type($a->{'name'}) =~ /ethernet/i || $a->{'name'} =~ /^bond/)) { return $a->{'fullname'}; } } # Failing that, look for a virtual interface. On some VPS systems, the # main interface is actually venet0:0 foreach my $a (@active) { if ($a->{'up'} && $a->{'address'} ne '127.0.0.1' && (&net::iface_type($a->{'name'}) =~ /ethernet/i || $a->{'name'} =~ /^venet/)) { return $a->{'fullname'}; } } return undef; } # get_address_iface(address) # Given an IPv4 or v6 address, returns the interface name sub get_address_iface { local ($a) = @_; &foreign_require("net"); local ($iface) = grep { $_->{'address'} eq $a || &indexof(&net::canonicalize_ip6($a), (map { &net::canonicalize_ip6($_) } @{$_->{'address6'}})) >= 0 } &net::active_interfaces(); return $iface ? $iface->{'fullname'} : undef; } # check_apache_directives([directives]) # Returns an error string if the default Apache directives don't look valid sub check_apache_directives { local ($d, $gotname, $gotdom, $gotdoc, $gotproxy); local @dirs = split(/\t+/, defined($_[0]) ? $_[0] : $config{'apache_config'}); foreach $d (@dirs) { $d =~ s/#.*$//; if ($d =~ /^\s*ServerName\s+(\S+)$/i) { $gotname++; $gotdom++ if ($1 =~ /\$DOM|\$\{DOM\}/); } if ($d =~ /^\s*ServerAlias\s+(.*)$/i) { $gotdom++ if ($1 =~ /\$DOM|\$\{DOM\}/); } $gotdoc++ if ($d =~ /^\s*(DocumentRoot|VirtualDocumentRoot)\s+(.*)$/i); $gotproxy++ if ($d =~ /^\s*ProxyPass\s+(.*)$/i); } $gotname || return $text{'acheck_ename'}; $gotdom || return $text{'acheck_edom'}; $gotdoc || $gotproxy || return $text{'acheck_edoc'}; return undef; } # Return optional javascript to force scroll to the botton sub bottom_scroll_js { if ($main::force_bottom_scroll && $ENV{'HTTP_X_REQUESTED_WITH'} ne "XMLHttpRequest") { return "\n"; } else { return ""; } } # Print functions for HTML output sub first_html_print { print_and_capture("@_","
\n"); print bottom_scroll_js(); } sub second_html_print { print_and_capture("@_","

\n"); print bottom_scroll_js(); } sub indent_html_print { print_and_capture("\n"); print bottom_scroll_js(); } # Print functions for text output sub first_text_print { print_and_capture($indent_text, (map { &html_tags_to_text(&entities_to_ascii($_)) } @_),"\n"); } sub second_text_print { print_and_capture($indent_text, (map { &html_tags_to_text(&entities_to_ascii($_)) } @_),"\n\n"); } sub indent_text_print { $indent_text .= " "; } sub outdent_text_print { $indent_text = substr($indent_text, 4); } sub html_tags_to_text { local ($rv, $disallow_newlines, $allow_links) = @_; my $newline = "\n"; if ($disallow_newlines) { $newline = " " if ($disallow_newlines); $rv =~ s/\n/ /g; } $rv =~ s/|<\/tt>//g; $rv =~ s/|<\/span>//g; $rv =~ s/|<\/b>//g; $rv =~ s/|<\/i>//g; $rv =~ s/|<\/u>//g; $rv =~ s/]*>|<\/a>//g if (!$allow_links); $rv =~ s/
|<\/pre>//g;
$rv =~ s/
|]*>/$newline/g; $rv =~ s/

|<\/p>/$newline$newline/g; $rv =~ s/

|]*>/$newline$newline/g; $rv = &entities_to_ascii($rv); return $rv; } # Print functions for caturing output sub first_capture_print { $print_output .= $indent_text. join("", (map { &html_tags_to_text(&entities_to_ascii($_)) } @_))."\n"; } sub second_capture_print { $print_output .= $indent_text. join("", (map { &html_tags_to_text(&entities_to_ascii($_)) } @_))."\n\n"; } sub null_print { } sub set_all_null_print { $first_print = $second_print = $indent_print = $outdent_print = \&null_print; } sub set_all_text_print { $first_print = \&first_text_print; $second_print = \&second_text_print; $indent_print = \&indent_text_print; $outdent_print = \&outdent_text_print; } sub set_all_html_print { $first_print = \&first_html_print; $second_print = \&second_html_print; $indent_print = \&indent_html_print; $outdent_print = \&outdent_html_print; } sub set_all_capture_print { $first_print = \&first_capture_print; $second_print = \&second_capture_print; $indent_print = \&indent_text_print; $outdent_print = \&outdent_text_print; } # These functions store and retrieve the current print commands sub push_all_print { push(@print_function_stack, [ $first_print, $second_print, $indent_print, $outdent_print ]); &set_all_null_print(); } sub pop_all_print { local $p = pop(@print_function_stack); ($first_print, $second_print, $indent_print, $outdent_print) = @$p; } # Start capturing output sub start_print_capture { $print_capture = 1; $print_output = undef; } # Stop capturing output, and return what we have sub stop_print_capture { $print_capture = 1; return $print_output; } sub print_and_capture { print @_; if ($print_capture) { $print_output .= join("", @_); } } # will_send_domain_email(&domain) # Returns 1 if email would be sent to this domain at signup time sub will_send_domain_email { local $tmpl = &get_template($_[0]->{'template'}); return $tmpl->{'mail_on'} ne 'none'; } # send_domain_email(&domain, [force-to], [password]) # Sends the signup email to a new domain owner. Returns a pair containing a # number (0=failed, 1=success) and an optional message. Also outputs status # messages. sub send_domain_email { local ($d, $forceto, $pass) = @_; local $tmpl = &get_template($d->{'template'}); local $mail = $tmpl->{'mail'}; local $subject = $tmpl->{'mail_subject'}; local $cc = $tmpl->{'mail_cc'}; local $bcc = $tmpl->{'mail_bcc'}; if ($tmpl->{'mail_on'} eq 'none') { return (1, undef); } &$first_print($text{'setup_email'}); local %hash = &make_domain_substitions($d, 1); $hash{'pass'} = $pass if ($pass); local @erv = &send_template_email($mail, $forceto || $d->{'emailto'}, \%hash, $subject, $cc, $bcc, undef, &get_global_from_address($d)); if ($erv[0]) { &$second_print(&text('setup_emailok', $erv[1])); } else { &$second_print(&text('setup_emailfailed', $erv[1])); } } # make_domain_substitions(&domain, [nice-sizes]) # Returns a hash of substitions for email to a virtual server sub make_domain_substitions { local ($d, $nice_sizes) = @_; local %hash = %$d; local $tmpl = &get_template($d->{'template'}); delete($hash{''}); $hash{'idndom'} = &show_domain_name($d->{'dom'}); # With unicode # Convert disabled_time to timestamp if ($d->{'disabled_time'}) { $hash{'disabled_time'} = &make_date($d->{'disabled_time'}); } # Add parent domain info local $parent; if ($d->{'parent'}) { $parent = &get_domain($d->{'parent'}); foreach my $k (keys %$parent) { $hash{'parent_domain_'.$k} = $parent->{$k}; } delete($hash{'parent_domain_'}); } # Add alias target domain info if ($d->{'alias'}) { local $alias = &get_domain($d->{'alias'}); foreach my $k (keys %$alias) { $hash{'alias_domain_'.$k} = $alias->{$k}; } delete($hash{'alias_domain_'}); } # Add (first) reseller details if ($d->{'reseller'} && defined(&get_reseller)) { my @r = split(/\s+/, $d->{'reseller'}); local $resel = &get_reseller($r[0]); local $acl = $resel->{'acl'}; $hash{'reseller_name'} = $resel->{'name'}; $hash{'reseller_theme'} = $resel->{'theme'}; $hash{'reseller_modules'} = join(" ", @{$resel->{'modules'}}); foreach my $a (keys %$acl) { $hash{'reseller_'.$a} = $acl->{$a}; } } # Add plan details, if any local $plan = &get_plan($d->{'plan'}); if ($plan) { foreach my $k (keys %$plan) { $hash{'plan_'.$k} = $plan->{$k}; } } # Add DNS serial number, for use in DNS templates if ($config{'dns'}) { &require_bind(); if ($bind8::config{'soa_style'} == 1) { $hash{'dns_serial'} = &bind8::date_serial(). sprintf("%2.2d", $bind8::config{'soa_start'}); } else { # Use Unix time for date and running number serials $hash{'dns_serial'} = time(); } } else { # BIND not installed, so default to using unix time for serial $hash{'dns_serial'} = time(); } # Add DNS master nameserver if ($config{'dns'}) { $hash{'dns_master'} = &get_master_nameserver($tmpl); } # Add webmin and usermin ports $hash{'virtualmin_url'} = &get_virtualmin_url($d); local %miniserv; &get_miniserv_config(\%miniserv); $hash{'webmin_port'} = $miniserv{'port'}; $hash{'webmin_proto'} = $miniserv{'ssl'} ? 'https' : 'http'; if (&foreign_installed('usermin')) { &foreign_require('usermin'); local %uminiserv; &usermin::get_usermin_miniserv_config(\%uminiserv); $hash{'usermin_port'} = $uminiserv{'port'}; $hash{'usermin_proto'} = $uminiserv{'ssl'} ? 'https' : 'http'; } # Make quotas nicer, if needed if ($nice_sizes) { if ($hash{'quota'}) { $hash{'quota'} = &nice_size($d->{'quota'}*"a_bsize("home")); } if ($hash{'uquota'}) { $hash{'uquota'} = &nice_size($d->{'uquota'}*"a_bsize("home")); } if ($hash{'bw_limit'}) { $hash{'bw_limit'} = &nice_size($d->{'bw_limit'}); } if ($hash{'bw_usage'}) { $hash{'bw_usage'} = &nice_size($d->{'bw_usage'}); } if ($config{'bw_period'}) { $hash{'bw_period'} = $config{'bw_period'}; $hash{'bw_past'} = ''; } else { $hash{'bw_past'} = $config{'bw_past'}; $hash{'bw_period'} = ''; } } # Set mysql_pass to blank if missing, so that it can be used if $IF $hash{'mysql_pass'} ||= ''; $hash{'postgres_pass'} ||= ''; # Setup MySQL and PostgreSQL usernames if not set yet if ($d->{'mysql'} && !$hash{'mysql_user'}) { $hash{'mysql_user'} = &mysql_user($d); if ($d->{'parent'}) { $hash{'mysql_pass'} = $parent->{'mysql_pass'}; } } if ($d->{'postgres'} && !$hash{'postgres_user'}) { $hash{'postgres_user'} = &postgres_user($d); if ($d->{'parent'}) { $hash{'postgres_pass'} = $parent->{'postgres_pass'}; } } # Add remote MySQL and PostgreSQL hosts if ($d->{'mysql'}) { $hash{'mysql_host'} = &get_database_host_mysql($d); $hash{'mysql_port'} = &get_database_port_mysql($d); } if ($d->{'postgres'}) { $hash{'postgres_host'} = &get_database_host_postgres($d); $hash{'postgres_port'} = &get_database_port_postgres($d); } # Add random numbers length 1-10 &seed_random(); for(my $i=1; $i<=10; $i++) { my $r; do { $r = int(rand()*(10**$i)); } while(length($r) != $i); $hash{"RANDOM$i"} = $r; } # Add secondary mail servers local %ids = map { $_, 1 } split(/\s+/, $d->{'mx_servers'}); if (%ids) { local @servers = grep { $ids{$_->{'id'}} } &list_mx_servers(); $hash{'mx_slaves'} = join(" ", map { $_->{'host'} } @servers); } else { $hash{'mx_slaves'} = ''; } # Add secondary nameservers if ($config{'dns'}) { local %on = map { $_, 1 } split(/\s+/, $d->{'dns_slave'}); local @servers = grep { $on{$_->{'host'}} || $on{$_->{'nsname'}} } &bind8::list_slave_servers(); $hash{'dns_server'} = &get_master_nameserver($tmpl); $hash{'dns_slave'} = join(" ", map { $_->{'nsname'} || $_->{'host'} } @servers); } else { $hash{'dns_slave'} = ''; } # If any website feature is enabled (like Nginx), set the web variable if (&domain_has_website($d)) { $hash{'web'} = 1; } # Add domain parts my @parts = split(/\./, $d->{'dom'}); for(my $i=0; $i<@parts; $i++) { $hash{'dompart'.$i} = $parts[$i]; } return %hash; } # will_send_user_email([&domain], [new-flag]) # Returns 1 if a new mailbox email would be sent to a user in this domain. # Will return 0 if no template is defined, or if sending mail to the mailbox # has been deactivated, or if the domain doesn't even have email sub will_send_user_email { local ($d, $isnew) = @_; local $tmpl = &get_template($d ? $d->{'template'} : 0); local $tmode = !$d || $isnew ? "newuser" : "updateuser"; if ($tmpl->{$tmode.'_on'} eq 'none' || $tmode eq "newuser" && !$tmpl->{$tmode.'_to_mailbox'}) { return 0; } else { return 1; } } # send_user_email([&domain], &user, [mailbox-to|'none'], [update-mode]) # Sends email to a new mailbox user, and possibly the domain owner, reseller # and master admin. Returns a pair containing a number (0=failed, 1=success) # and an optional message sub send_user_email { local ($d, $user, $userto, $mode) = @_; local $tmpl = &get_template($d ? $d->{'template'} : 0); local $tmode = $mode ? "updateuser" : "newuser"; local $subject = $config{$tmode.'_subject'}; if ($tmpl->{$tmode.'_on'} eq 'none') { return (1, undef); } # Work out who we CC to local @ccs; push(@ccs, $tmpl->{$tmode.'_cc'}) if ($tmpl->{$tmode.'_cc'}); push(@ccs, $d->{'emailto'}) if ($d && $tmpl->{$tmode.'_to_owner'}); if ($tmpl->{$tmode.'_to_reseller'} && $d && $d->{'reseller'} && defined(&get_reseller)) { foreach my $r (split(/\s+/, $d->{'reseller'})) { local $resel = &get_reseller($r); if ($resel && $resel->{'acl'}->{'email'}) { push(@ccs, &extract_address_parts( $resel->{'acl'}->{'email'})); } } } local $cc = join(",", @ccs); local $bcc = $tmpl->{$tmode.'_bcc'}; local $mail = $tmpl->{$tmode}; return (1, undef) if ($mail eq 'none'); local %hash = &make_user_substitutions($user, $d); local $email = $d ? $hash{'mailbox'}.'@'.$hash{'dom'} : $hash{'user'}.'@'.&get_system_hostname(); # Work out who we send to if ($userto) { $email = $userto eq 'none' ? undef : $userto; } if ($d && !$tmpl->{$tmode.'_to_mailbox'}) { # Don't email domain owner if disabled $email = undef; } return (1, undef) if (!$email && !$cc && !$bcc); return &send_template_email($mail, $email, \%hash, $subject || &entities_to_ascii($mode ? $text{'mail_upsubject'} : $text{'mail_usubject'}), $cc, $bcc, $d); } # make_user_substitutions(&user, [&domain]) # Create a hash of email substitions for a user in some domain sub make_user_substitutions { local ($user, $d) = @_; local %hash; if ($d) { %hash = ( %$d, %$user ); $hash{'mailbox'} = &remove_userdom($user->{'user'}, $d); } else { %hash = ( %$user ); $hash{'mailbox'} = $hash{'user'}; } $hash{'plainpass'} ||= ""; $hash{'extra'} = join(" ", @{$user->{'extraemail'}}); # Check SSH and FTP shells local ($shell) = grep { $_->{'shell'} eq $user->{'shell'} } &list_available_shells(); if ($shell) { $hash{'ftp'} = $shell->{'id'} eq 'nologin' ? 0 : 1; $hash{'ssh'} = $shell->{'id'} eq 'ssh' ? 1 : 0; } else { # Assume FTP but no SSH if unknown shell $hash{'ftp'} = 1; $hash{'ssh'} = 0; } # Make quotas use nice units if ($hash{'quota'}) { $hash{'quota'} = &nice_size($user->{'quota'}*"a_bsize("home")); } if ($hash{'uquota'}) { $hash{'uquota'} = &nice_size($user->{'uquota'}*"a_bsize("home")); } if ($hash{'mquota'}) { $hash{'mquota'} = &nice_size($user->{'mquota'}*"a_bsize("mail")); } if ($hash{'umquota'}) { $hash{'umquota'} = &nice_size($user->{'umquota'}*"a_bsize("mail")); } if ($hash{'qquota'}) { $hash{'qquota'} = &nice_size($user->{'qquota'}); } return %hash; } # ensure_template(file) sub ensure_template { local ($file) = @_; local $mpath = "$module_root_directory/$file"; local $cpath = "$module_config_directory/$file"; if (!-s $cpath) { ©_source_dest($mpath, $cpath); } } # get_miniserv_port_proto() # Returns the port number, protocol (http or https) and hostname for Webmin sub get_miniserv_port_proto { if ($ENV{'SERVER_PORT'}) { # Running under miniserv return ( $ENV{'SERVER_PORT'}, $ENV{'HTTPS'} eq 'ON' ? 'https' : 'http', $ENV{'SERVER_NAME'} ); } else { # Get from miniserv config local %miniserv; &get_miniserv_config(\%miniserv); return ( $miniserv{'port'}, $miniserv{'ssl'} ? 'https' : 'http', &get_system_hostname() ); } } # get_usermin_miniserv_port_proto() # Returns the port number, protocol (http or https) and hostname for Usermin sub get_usermin_miniserv_port_proto { my ($port, $proto, $host); if (&foreign_installed("usermin")) { &foreign_require("usermin"); my %miniserv; &usermin::get_usermin_miniserv_config( \%miniserv); $proto = $miniserv{'ssl'} ? 'https' : 'http'; $port = $miniserv{'port'}; } # Fall back to standard defaults $proto ||= "https"; $port ||= 20000; $host ||= &get_system_hostname(); return ($port, $proto, $host); } # get_miniserv_base_url() # Returns the base URL for this Virtualmin install, without the trailing / sub get_miniserv_base_url { my ($port, $proto, $host) = &get_miniserv_port_proto(); my $portstr = $proto eq "http" && $port == 80 ? "" : $proto eq "https" && $port == 443 ? "" : ":".$port; return $proto."://".$host.$portstr; } # send_template_email(data, address, &substitions, subject, cc, bcc, # [&domain], [from]) # Sends the given file to the specified address, with the substitions from # a hash reference. The actual subs in the file must be like $XXX for entries # in the hash like xxx - ie. $DOM is replaced by the domain name, and $HOME # by the home directory sub send_template_email { local ($template, $to, $subs, $subject, $cc, $bcc, $d, $from) = @_; local %hash = %$subs; # Add in Webmin info to the hash ($hash{'webmin_port'}, $hash{'webmin_proto'}) = &get_miniserv_port_proto(); $template = &substitute_virtualmin_template($template, \%hash); # Work out the From: address - if a domain is given, use it's email address # as long as that address is in a local domain with mail if (!$from && $remote_user && !&master_admin() && $d) { local $localdom = 0; local ($emailtouser, $emailtodom) = split(/\@/, $d->{'emailto_addr'}); foreach my $ld (grep { $_->{'mail'} } &list_domains()) { if (lc($ld->{'dom'}) eq lc($emailtodom)) { $localdom = 1; } } if ($emailtodom eq &get_system_hostname()) { $localdom = 1; } if ($localdom) { $from = $d->{'emailto'}; } } # Actually send using the mailboxes module local $subject = &substitute_virtualmin_template($subject, \%hash); local $cc = &substitute_virtualmin_template($cc, \%hash); if (!$to) { # This can happen when a mailbox is not notified about its # own update or creation $to = $cc; $cc = undef; } &foreign_require("mailboxes"); # Set content type and encoding based on whether the email contains HTML # and/or non-ascii characters local $ctype = $template =~ /]*>|]*>/i ? "text/html" : "text/plain"; local $cs = &get_charset(); local $attach = { 'headers' => [ [ 'Content-Type', $ctype.'; charset='.$cs ], [ 'Content-Transfer-Encoding', 'quoted-printable' ] ], 'data' => &mailboxes::quoted_encode($template) }; # Construct and send the email object local $mail = { 'headers' => [ [ 'From', $from || $config{'from_addr'} || &mailboxes::get_from_address() ], [ 'To', $to ], $cc ? ( [ 'Cc', $cc ] ) : ( ), $bcc ? ( [ 'Bcc', $bcc ] ) : ( ), [ 'Subject', &entities_to_ascii($subject) ], ], 'attach' => [ $attach ] }; eval { local $main::error_must_die = 1; &mailboxes::send_mail($mail); }; if ($@) { return (0, $@); } else { return (1, &text('mail_ok', $to)); } } # send_notify_email(from, &doms|&users, [&dom], subject, body, # [attach, attach-filename, attach-type], [extra-admins], # [send-many], [charset]) # Sends a single email to multiple recipients. These can be Virtualmin domains # or users. sub send_notify_email { local ($from, $recips, $d, $subject, $body, $attach, $attachfile, $attachtype, $admins, $many, $charset) = @_; &foreign_require("mailboxes"); local %done; foreach my $r (@$recips) { # Work out recipient type and addresses local (@emails, %hash); if ($r->{'id'}) { # A domain push(@emails, $r->{'emailto'}); %hash = &make_domain_substitions($r, 1); if ($admins) { # And extra admins push(@emails, map { $_->{'email'} } grep { $_->{'email'} } &list_extra_admins($r)); } } else { # A mailbox user push(@emails, $r->{'email'} || $r->{'user'}); %hash = &make_user_substitutions($r, $d); } # Send to them foreach my $email (@emails) { next if (!$many && $done{$email}++); local $ct = 'text/plain'; if ($charset) { $ct .= "; charset=".$charset; } local $mail = { 'headers' => [ [ 'From' => $from ], [ 'To' => $email ], [ 'Subject' => &entities_to_ascii( &substitute_virtualmin_template($subject, \%hash)) ] ], 'attach' => [ { 'headers' => [ [ 'Content-type', $ct ] ], 'data' => &entities_to_ascii( &substitute_virtualmin_template($body, \%hash)) } ] }; if ($attach) { local $filename = $attachfile; $filename =~ s/^.*(\\|\/)//; local $type = $attachtype." name=\"$filename\""; local $disp = "inline; filename=\"$filename\""; push(@{$mail->{'attach'}}, { 'data' => $in{'attach'}, 'headers' => [ [ 'Content-type', $type ], [ 'Content-Disposition', $disp ], [ 'Content-Transfer-Encoding', 'base64' ] ] }); } &mailboxes::send_mail($mail); } } } # get_global_from_address([&domain]) # Returns the from address to use when sending email to some domain. This may # be the reseller's email (if set), or the system-wide default sub get_global_from_address { local ($d) = @_; &foreign_require("mailboxes"); local $rv = $config{'from_addr'} || &mailboxes::get_from_address(); if ($d && $d->{'reseller'} && defined(&get_reseller) && $config{'from_reseller'}) { # From first reseller my @r = split(/\s+/, $d->{'reseller'}); local $resel = &get_reseller($r[0]); if ($resel && $resel->{'acl'}->{'email'}) { # Reseller has an email .... but is it valid for this system? if ($resel->{'acl'}->{'from'}) { # Custom from address set $rv = $resel->{'acl'}->{'from'}; } else { my ($rs) = &extract_address_parts($resel->{'acl'}->{'email'}); my ($rsmbox, $rsdom) = split(/\@/, $rs); my $rsd = &get_domain_by("dom", $rsdom); if ($rsd || $rsdom eq &get_system_hostname() || $config{'from_reseller'} == 2) { # Yes - safe to use $rv = $rs; } } } } return $rv; } # userdom_substitutions(&user, &dom) # Returns a hash reference of substitutions for a user in a domain sub userdom_substitutions { if ($_[1]) { $_[0]->{'mailbox'} = &remove_userdom($_[0]->{'user'}, $_[1]); $_[0]->{'dom'} = $_[1]->{'dom'}; $_[0]->{'dom_prefix'} = substr($_[1]->{'dom'}, 0, 1); } return $_[0]; } # alias_type(string, [alias-name]) # Return the type and destination of some alias string. Type codes are: # 1 - Email address # 2 - Include file of addresses # 3 - Write to file # 4 - Pipe to program # 5 - Virtualmin autoreply # 6 - Webmin filter # 7 - Mailbox of user # 8 - Same address at other domain # 9 - Bounce, possibly with message # 10- Current user's mailbox # 11- Throw away # 12- VPopMail autoreply # 13- Everyone in some domain sub alias_type { local @rv; if ($_[0] =~ /^\|\s*$module_config_directory\/autoreply.pl\s+(\S+)/) { @rv = (5, $1); } elsif ($_[0] =~ /^\|\s*$config{'vpopmail_auto'}\s+(\d+)\s+(\d+)\s+(\S+)\s+(\S+)(\s+(\S+)\s+(\S+))?/) { @rv = (12, $3, $1, $2, $4, $6, $7); } elsif ($_[0] =~ /^\|\s*$module_config_directory\/filter.pl\s+(\S+)/) { @rv = (6, $1); } elsif ($_[0] =~ /^\|\s*(.*)$/) { @rv = (4, $1); } elsif ($_[0] eq "./Maildir/") { return (10); } elsif ($config{'vpopmail_md'} && $_[0] eq "./$config{'vpopmail_md'}/") { return (10); } elsif ($_[0] eq "/dev/null") { return (11); } elsif ($_[0] =~ /^(\/.*)$/ || $_[0] =~ /^\.\//) { @rv = (3, $_[0]); } elsif ($_[0] =~ /^:include:\Q$everyone_alias_dir\E\/(\S+)$/) { return (13, $1); } elsif ($_[0] =~ /^:include:(.*)$/) { @rv = (2, $1); } elsif ($_[0] =~ /^\\(\S+)$/) { if ($1 eq $_[1] || $1 eq "NEWUSER" || $1 eq &replace_atsign($_[1]) || $1 eq &escape_user($_[1])) { return (10); } else { @rv = (7, $1); } } elsif ($_[0] =~ /^\%1\@(\S+)$/) { @rv = (8, $1); } elsif ($_[0] =~ /^BOUNCE\s*(.*)$/) { @rv = (9, $1); } else { @rv = (1, $_[0]); } return wantarray ? @rv : $rv[0]; } # set_alias_programs() # Copy the wrapper scripts needed for autoresponders sub set_alias_programs { &require_mail(); # Copy autoresponder local $mailmod = &foreign_check("sendmail") ? "sendmail" : $config{'mail_system'} == 1 ? "sendmail" : $config{'mail_system'} == 0 ? "postfix" : "qmailadmin"; ©_source_dest("$root_directory/$mailmod/autoreply.pl", $module_config_directory); &system_logged("chmod 755 $module_config_directory/config"); if (-d $sendmail::config{'smrsh_dir'} && !-r "$sendmail::config{'smrsh_dir'}/autoreply.pl") { &system_logged("ln -s $module_config_directory/autoreply.pl $sendmail::config{'smrsh_dir'}/autoreply.pl"); } # Copy filter program &system_logged("cp $root_directory/$mailmod/filter.pl $module_config_directory"); &system_logged("chmod 755 $module_config_directory/config"); if (-d $sendmail::config{'smrsh_dir'} && !-r "$sendmail::config{'smrsh_dir'}/filter.pl") { &system_logged("ln -s $module_config_directory/filter.pl $sendmail::config{'smrsh_dir'}/filter.pl"); } } # set_domain_envs(&domain, action, [&new-domain], [&old-domain], [&other-envs]) # Sets up VIRTUALSERVER_ environment variables for a domain update or some kind, # prior to calling making_changes or made_changes. action must be one of # CREATE_DOMAIN, MODIFY_DOMAIN or DELETE_DOMAIN sub set_domain_envs { local ($d, $action, $newd, $oldd, $others) = @_; &reset_domain_envs(); $ENV{'VIRTUALSERVER_ACTION'} = $action; foreach my $e (keys %$d) { local $env = uc($e); $env =~ s/\-/_/g; $ENV{'VIRTUALSERVER_'.$env} = $d->{$e}; } $ENV{'VIRTUALSERVER_IDNDOM'} = &show_domain_name($d->{'dom'}); if ($newd) { # Set details of virtual server being changed to. This is only # done in the pre-modify call foreach my $e (keys %$newd) { local $env = uc($e); $env =~ s/\-/_/g; $ENV{'VIRTUALSERVER_NEWSERVER_'.$env} = $newd->{$e}; } $ENV{'VIRTUALSERVER_NEWSERVER_IDNDOM'} = &show_domain_name($newd->{'dom'}); } if ($oldd) { # Set details of virtual server being changed from, in post-modify foreach my $e (keys %$oldd) { local $env = uc($e); $env =~ s/\-/_/g; $ENV{'VIRTUALSERVER_OLDSERVER_'.$env} = $oldd->{$e}; } $ENV{'VIRTUALSERVER_OLDSERVER_IDNDOM'} = &show_domain_name($oldd->{'dom'}); } local $parent = $d->{'parent'} ? &get_domain($d->{'parent'}) : undef; local $alias = $d->{'alias'} ? &get_domain($d->{'alias'}) : undef; if (defined(&get_reseller)) { # Set (first) reseller details, if we have one local $rd = $d->{'reseller'} ? $d : $parent && $parent->{'reseller'} ? $parent : undef; local ($r) = $rd ? split(/\s+/, $rd->{'reseller'}) : undef; local $resel = $r ? &get_reseller($r) : undef; if ($resel) { local $acl = $resel->{'acl'}; $ENV{'RESELLER_NAME'} = $resel->{'name'}; $ENV{'RESELLER_THEME'} = $resel->{'theme'}; $ENV{'RESELLER_MODULES'} = join(" ", @{$resel->{'modules'}}); foreach my $a (keys %$acl) { local $env = uc($a); $env =~ s/\-/_/g; $ENV{'RESELLER_'.$env} = $acl->{$a}; } } } if ($parent) { # Set parent domain variables foreach my $e (keys %$parent) { local $env = uc($e); $env =~ s/\-/_/g; $ENV{'PARENT_VIRTUALSERVER_'.$env} = $parent->{$e}; } $ENV{'PARENT_VIRTUALSERVER_IDNDOM'} = &show_domain_name($parent->{'dom'}); } if ($alias) { # Set alias domain variables foreach my $e (keys %$alias) { local $env = uc($e); $env =~ s/\-/_/g; $ENV{'ALIAS_VIRTUALSERVER_'.$env} = $alias->{$e}; } $ENV{'ALIAS_VIRTUALSERVER_IDNDOM'} = &show_domain_name($alias->{'dom'}); } # Set global variables foreach my $v (&get_global_template_variables()) { if ($v->{'enabled'}) { $ENV{'GLOBAL_'.uc($v->{'name'})} = $v->{'value'}; } } # Set other variables if ($others) { foreach my $e (keys %$others) { $ENV{uc($e)} = $others->{$e}; $ENV{"VIRTUALSERVER_".uc($e)} = $others->{$e}; } } } # reset_domain_envs(&domain) # Removes all environment variables set by set_domain_envs sub reset_domain_envs { foreach my $e (keys %ENV) { delete($ENV{$e}) if ($e =~ /^(VIRTUALSERVER_|RESELLER_|PARENT_VIRTUALSERVER_|GLOBAL_)/); } } # making_changes() # Called before a domain is created, modified or deleted to run the # pre-change command sub making_changes { if ($config{'pre_command'} =~ /\S/) { &clean_changes_environment(); local $out = &backquote_logged( "($config{'pre_command'}) 2>&1 &1 \n"; foreach $k (@_) { print " \${$k}\n"; print "",$text{"sub_".$k}," \n"; } print "\n"; print "$text{'sub_if'}

\n"; } # alias_form(&to, left, &domain, "user"|"alias", user|alias, [&tds]) # Prints HTML for selecting 0 or more alias destinations sub alias_form { local ($to, $left, $d, $mode, $who, $tds) = @_; &require_mail(); local @typenames = map { $text{"alias_type$_"} } (0 .. 13); $typenames[0] = "<$typenames[0]>"; local @values = @$to; local $i; for(my $i=0; $i<=@values+2; $i++) { local ($type, $val) = $values[$i] ? &alias_type($values[$i], $_[4]) : (0, ""); # Generate drop-down menu for alias type local @opts; local $j; for($j=0; $j<@typenames; $j++) { next if ($j == 8 && $_[3] eq "user"); # to domain not valid # for users next if ($j == 10 && $_[3] ne "user"); # user's mailbox not # valid for aliases next if ($j == 9 && $_[3] eq "user"); # bounce is not valid # for users next if ($j == 13 && $_[3] eq "user"); # everyone is not valid # for users if ($j == 0 || $can_alias_types{$j} || $type == $j) { push(@opts, [ $j, $typenames[$j] ]); } } local $f = &ui_select("type_$i", $type, \@opts); if ($type == 7) { $val = &unescape_user($val); } elsif ($type == 13) { # Everyone in some domain local $d = &get_domain($val); if ($d) { $val = $d->{'dom'}; } } $f .= &ui_textbox("val_$i", $val, 30)."\n"; if (&can_edit_afiles()) { local $prog = $type == 2 ? "edit_afile.cgi" : $type == 5 ? "edit_rfile.cgi" : $type == 6 ? "edit_ffile.cgi" : $type == 12 ? "edit_vfile.cgi" : undef; if ($prog && $_[2]) { local $di = $_[2] ? $_[2]->{'id'} : undef; $f .= "$text{'alias_afile'}\n"; } } print &ui_table_row($left, $f, undef, $tds); $left = " "; } } # parse_alias(catchall, name, &old-values, "user"|"alias", &domain) # Returns a list of values for an alias, taken from the form generated by # &alias_form sub parse_alias { local (@values, $i, $t, $anysame, $anybounce); for($i=0; defined($t = $in{"type_$i"}); $i++) { !$t || $can_alias_types{$t} || &error($text{'alias_etype'}." : ".$text{'alias_type'.$t}); local $v = $in{"val_$i"}; $v =~ s/^\s+//; $v =~ s/\s+$//; if ($t == 1 && $v !~ /^([^\|\:\"\' \t\/\\\%]\S*)$/) { &error(&text('alias_etype1', $v)); } elsif ($t == 1 && !&can_forward_alias($v)) { &error(&text('alias_etype1f', $v)); } elsif ($t == 3 && $v !~ /^\/(\S+)$/ && $v !~ /^\.\//) { &error(&text('alias_etype3', $v)); } elsif ($t == 4) { $v =~ /^(\S+)/ || &error($text{'alias_etype4none'}); my $prog = $1; (-x $prog) && &check_aliasfile($prog, 0) || $prog eq "if" || $prog eq "export" || &has_command($prog) || &error(&text('alias_etype4', $prog)); } elsif ($t == 7 && !defined(getpwnam($v)) && $config{'mail_system'} != 4 && $config{'mail_system'} != 5) { &error(&text('alias_etype7', $v)); } elsif ($t == 8 && $v !~ /^[a-z0-9\.\-\_]+$/) { &error(&text('alias_etype8', $v)); } elsif ($t == 8 && !$_[0]) { &error(&text('alias_ecatchall', $v)); } elsif ($t == 13 && !&get_domain_by("dom", $v)) { &error(&text('alias_eeveryone', $v)); } if ($t == 1 || $t == 3) { push(@values, $v); } elsif ($t == 2) { $v = "$d->{'home'}/$v" if ($v !~ /^\//); push(@values, ":include:$v"); } elsif ($t == 4) { push(@values, "|$v"); } elsif ($t == 5) { # Setup autoreply script $v = "$d->{'home'}/$v" if ($v !~ /^\//); push(@values, "|$module_config_directory/autoreply.pl ". "$v $name"); &set_alias_programs(); } elsif ($t == 6) { # Setup filter script $v = "$d->{'home'}/$v" if ($v !~ /^\//); push(@values, "|$module_config_directory/filter.pl ". "$v $name"); &set_alias_programs(); } elsif ($t == 7) { push(@values, "\\".&escape_user($v)); } elsif ($t == 8) { push(@values, "\%1\@$v"); $anysame++; } elsif ($t == 9) { push(@values, "BOUNCE".($v ? " $v" : "")); $anybounce++; } elsif ($t == 10) { # Alias to self .. may need to used at-escaped name if ($config{'mail_system'} == 0 && $_[1] =~ /\@/) { push(@values, "\\".&escape_user(&replace_atsign_if_exists($_[1]))); } else { push(@values, "\\".&escape_user($_[1])); } } elsif ($t == 11) { push(@values, "/dev/null"); } elsif ($t == 12) { # Setup vpopmail autoresponder script local @qm = getpwnam($config{'vpopmail_user'}); if (!$v) { # Create an empty responder file local $ddir = &domain_vpopmail_dir($_[4]); $v = $_[3] eq "alias" ? "$ddir/$_[1].respond" : "$ddir/$_[1]/respond"; if (!-r $v) { &open_tempfile(MSG, ">$v"); &close_tempfile(MSG); &set_ownership_permissions($qm[2], $qm[3], undef, $v); } } elsif (!$v) { &error(&text('alias_eautorepond')); } $v = "$d->{'home'}/$v" if ($v !~ /^\//); local @av; if ($_[2] && &alias_type($_[2]->[$i]) == 12) { # Use old settings for delay/etc local @oldav = &alias_type($_[2]->[$i]); @av = ( $oldav[2], $oldav[3], $v, $oldav[4] ); push(@av, $oldav[5]) if ($oldav[5] ne ""); push(@av, $oldav[6]) if ($oldav[6] ne ""); } else { # User default settings for timeouts, and create log # directory local $vdir = "$v.log"; if (!-d $vdir) { &make_dir($vdir, 0755); &set_ownership_permissions($qm[2], $qm[3], 0755, $vdir); } @av = ( 10000, 5, $v, $vdir ); } push(@values, "|$config{'vpopmail_auto'} ".join(" ", @av)); } elsif ($t == 13) { # Work out ID for everyone file local $d = &get_domain_by("dom", $v); &create_everyone_file($d); push(@values, ":include:$everyone_alias_dir/$d->{'id'}"); } } if (@values > 1 && $anysame) { &error(&text('alias_ecatchall2', $v)); } if (@values > 1 && $anybounce) { &error(&text('alias_ebounce')); } return @values; } # set_pass_change(&user) # Set fields indicating that the password has just been changed sub set_pass_change { &require_useradmin(); local $pft = &useradmin::passfiles_type(); if ($pft == 2 || $pft == 5 || $config{'ldap'}) { $_[0]->{'change'} = int(time() / (60*60*24)); } elsif ($pft == 4) { $_[0]->{'change'} = time(); } } # set_pass_disable(&user, disable) sub set_pass_disable { local ($user, $disable) = @_; if ($disable && $user->{'pass'} !~ /^\!/) { $user->{'pass'} = "!".$user->{'pass'}; } elsif (!$disable && $user->{'pass'} =~ /^\!/) { $user->{'pass'} = substr($user->{'pass'}, 1); } } sub check_aliasfile { return 0 if (!-r $_[0] && !$_[1]); return 1; } # list_all_users() # Returns all local and LDAP users, including those from Qmail sub list_all_users { &require_useradmin(); local @rv; foreach my $u (&useradmin::list_users()) { $u->{'module'} = 'useradmin'; push(@rv, $u); } if ($config{'ldap'}) { foreach my $u (&ldap_useradmin::list_users()) { $u->{'module'} = 'ldap-useradmin'; push(@rv, $u); } } return @rv; } # list_all_groups() # Returns all local and LDAP groups sub list_all_groups { &require_useradmin(); local @rv; foreach my $g (&useradmin::list_groups()) { $g->{'module'} = 'useradmin'; push(@rv, $g); } if ($config{'ldap'}) { foreach my $g (&ldap_useradmin::list_groups()) { $g->{'module'} = 'ldap-useradmin'; push(@rv, $g); } } return @rv; } # build_taken(&uid-taken, &username-taken, [&users]) # Fills in the the given hashes with used usernames and UIDs sub build_taken { my ($uidmap, $usermap, $users) = @_; &obtain_lock_unix(); &require_useradmin(); # Add Unix users local @users = $users ? @$users : &list_all_users(); local $u; foreach $u (@users) { $uidmap->{$u->{'uid'}} ||= 'user' if ($uidmap); $usermap->{$u->{'user'}} ||= 'user' if ($usermap); } # Add system users setpwent(); while(my @uinfo = getpwent()) { $uidmap->{$uinfo[2]} ||= 'user' if ($uidmap); $usermap->{$uinfo[0]} ||= 'user' if ($usermap); } endpwent(); # Add domain users local $d; foreach $d (&list_domains()) { $uidmap->{$d->{'uid'}} ||= 'dom' if ($uidmap); $usermap->{$d->{'user'}} ||= 'dom' if ($usermap); } # Add UIDs used in the past my %uids; &read_file_cached($old_uids_file, \%uids); foreach my $uid (keys %uids) { $uidmap->{$uid} ||= 'old' if ($uidmap); } &release_lock_unix(); } # build_group_taken(&gid-taken, &groupname-taken, [&groups]) # Fills in the the given hashes with used group names and GIDs sub build_group_taken { my ($gidmap, $groupmap, $groups) = @_; &obtain_lock_unix(); &require_useradmin(); # Add Unix groups local @groups = $groups ? @$groups : &list_all_groups(); local $g; foreach $g (@groups) { $gidmap->{$g->{'gid'}} ||= 'group' if ($gidmap); $groupmap->{$g->{'group'}} ||= 'group' if ($groupmap); } # Add system groups setgrent(); while(my @ginfo = getgrent()) { $gidmap->{$ginfo[2]} ||= 'group' if ($gidmap); $groupmap->{$ginfo[0]} ||= 'group' if ($groupmap); } endgrent(); # Add domains local $d; foreach $d (&list_domains()) { $gidmap->{$d->{'gid'}} ||= 'dom' if ($gidmap); $groupmap->{$d->{'group'}} ||= 'dom' if ($groupmap); } # Add GIDs used in the past my %gids; &read_file_cached($old_gids_file, \%gids); foreach my $gid (keys %gids) { $gidmap->{$gid} ||= 'old' if ($gidmap); } &release_lock_unix(); } # allocate_uid(&uid-taken) # Given a hash of used UIDs, return one that is free sub allocate_uid { local $uid; if ($usermodule eq "ldap-useradmin") { $uid = $luconfig{'base_uid'}; } $uid ||= $uconfig{'base_uid'}; while($_[0]->{$uid}) { $uid++; } return $uid; } # allocate_gid(&gid-taken) # Given a hash of used GIDs, return one that is free sub allocate_gid { local $gid; if ($usermodule eq "ldap-useradmin") { $gid = $luconfig{'base_gid'}; } $gid ||= $uconfig{'base_gid'}; while($_[0]->{$gid}) { $gid++; } return $gid; } # server_home_directory(&domain, [&parentdomain]) # Returns the home directory for a new virtual server user sub server_home_directory { &require_useradmin(); if ($_[0]->{'parent'}) { # Owned by some existing user, so under his home local $dname = $_[0]->{'dom'}; $dname =~ s/^xn(-+)//; return "$_[1]->{'home'}/domains/$dname"; } elsif ($config{'home_format'}) { # Use the template from the module config local $home = "$home_base/$config{'home_format'}"; return &substitute_domain_template($home, $_[0]); } else { # Just use the Users and Groups module settings return &useradmin::auto_home_dir($home_base, $_[0]->{'user'}, $_[0]->{'ugroup'}); } } # set_quota(user, filesystem, quota, hard) # Set hard or soft quotas for one user sub set_quota { &require_useradmin(); if ($_[3]) { "a::edit_user_quota($_[0], $_[1], int($_[2]), int($_[2]), 0, 0); } else { "a::edit_user_quota($_[0], $_[1], int($_[2]), 0, 0, 0); } } # set_server_quotas(&domain, [user-quota, group-quota]) # Set the user and possibly group quotas for a domain sub set_server_quotas { my ($d, $uquota, $quota) = @_; $uquota = $d->{'uquota'} if (!defined($uquota)); $quota = $d->{'quota'} if (!defined($quota)); local $tmpl = &get_template($d->{'template'}); if (&has_quota_commands()) { # User and group quotas are set externally &run_quota_command("set_user", $d->{'user'}, $tmpl->{'quotatype'} eq 'hard' ? ( int($uquota), int($uquota) ) : ( 0, int($uquota) )); if (&has_group_quotas() && $d->{'group'}) { &run_quota_command("set_group", $d->{'group'}, $tmpl->{'quotatype'} eq 'hard' ? ( int($quota), int($quota) ) : ( 0, $quota )); } } else { if (&has_home_quotas()) { # Set Unix user quota for home &set_quota($d->{'user'}, $config{'home_quotas'}, $uquota, $tmpl->{'quotatype'} eq 'hard'); } if (&has_mail_quotas()) { # Set Unix user quota for mail &set_quota($d->{'user'}, $config{'mail_quotas'}, $uquota, $tmpl->{'quotatype'} eq 'hard'); } if (&has_group_quotas() && $d->{'group'}) { # Set group quotas for home and possibly mail &require_useradmin(); local @qargs; if ($tmpl->{'quotatype'} eq 'hard') { @qargs = ( int($quota), int($quota), 0, 0 ); } else { @qargs = ( int($quota), 0, 0, 0 ); } "a::edit_group_quota( $d->{'group'}, $config{'home_quotas'}, @qargs); if (&has_mail_quotas()) { "a::edit_group_quota( $d->{'group'}, $config{'mail_quotas'}, @qargs); } } } } # disable_quotas(&domain) # Temporarily disable quotas for some virtual server, so that file or DB # operations don't fail sub disable_quotas { local ($d) = @_; return if (!&has_home_quotas()); if ($d->{'parent'}) { local $pd = &get_domain($d->{'parent'}); &disable_quotas($pd); } elsif ($d->{'unix'} && $d->{'quota'}) { local $nqd = { %$d }; $nqd->{'quota'} = 0; $nqd->{'uquota'} = 0; &set_server_quotas($nqd); if (!@disable_quotas_users) { @disable_quotas_users = &list_domain_users($d, 1, 1, 0, 1); foreach my $u (@disable_quotas_users) { next if ($u->{'noquota'}); &set_user_quotas($u->{'user'}, 0, 0, $d); } } } } # enable_quotas(&domain) # Must be called after disable_quotas to re-activate quotas for some domain sub enable_quotas { local ($d) = @_; return if (!&has_home_quotas()); if ($d->{'parent'}) { local $pd = &get_domain($d->{'parent'}); &enable_quotas($pd); } elsif ($d->{'unix'} && $d->{'quota'}) { &set_server_quotas($d); if (@disable_quotas_users) { foreach my $u (@disable_quotas_users) { next if ($u->{'noquota'}); &set_user_quotas($u->{'user'}, $u->{'quota'}, $u->{'mquota'}, $d); } @disable_quotas_users = ( ); } } } # users_table(&users, &dom, cgi, &buttons, &links, empty-msg) # Output a table of mailbox users sub users_table { local ($users, $d, $cgi, $buttons, $links, $empty) = @_; local $can_quotas = &has_home_quotas() || &has_mail_quotas(); local $can_qquotas = $config{'mail_system'} == 5; local @ashells = &list_available_shells($d); # Given a list of services return # user-friendly login access label my $login_access_label = sub { my @s = @_; @s = map { $text{'users_login_access_'.$_} } @s; @s = grep { $_ } @s; my $n = scalar(@s); if ($n == 0) { return ''; } elsif ($n == 1) { return "$s[0] $text{'users_login_access__only'}"; } else { my $l = pop(@s); return join(', ', @s) . " $text{'users_login_access__and'} $l"; } }; # Work out table header local @headers; push(@headers, "") if ($cgi); push(@headers, $text{'users_name'}, $text{'user_user2'}, $text{'users_real'} ); if ($can_quotas) { push(@headers, $text{'users_quota'}, $text{'users_uquota'}); } if ($can_qquotas) { push(@headers, $text{'users_qquota'}); } if ($config{'show_mailsize'} && $d->{'mail'}) { push(@headers, $text{'users_size'}); } if ($config{'show_lastlogin'} && $d->{'mail'}) { push(@headers, $text{'users_ll'}); } push(@headers, $text{'users_ushell'}); # Database column if (($d->{'mysql'} || $d->{'postgres'}) && $config{'show_dbs'}) { push(@headers, $text{'users_db'}); } # Other plugins columns local ($f, %plugcol); if ($config{'show_plugins'}) { foreach $f (&list_mail_plugins()) { local $col = &plugin_call($f, "mailbox_header", $d); if ($col) { $plugcol{$f} = $col; push(@headers, $col); } } } # Build table contents local $u; local $did = $d ? $d->{'id'} : 0; local @table; local $userdesc; my @domsdbs = &domain_databases($d); foreach $u (sort { $b->{'domainowner'} <=> $a->{'domainowner'} || $a->{'user'} cmp $b->{'user'} } @$users) { local $pop3 = $d ? &remove_userdom($u->{'user'}, $d) : $u->{'user'}; local $pop3_dis = &ui_text_color($pop3.&vui_inline_label('users_disabled_label', undef, 'disabled'), 'danger'); $pop3 = &html_escape($pop3); local @cols; local $filetype = $u->{'extra'} ? "&type=@{[&urlize($u->{'type'})]}" : ""; my $col_text = ($u->{'domainowner'} ? "$pop3".&vui_inline_label('users_owner_label') : $u->{'webowner'} && $u->{'pass'} =~ /^\!/ ? $pop3_dis : $u->{'webowner'} ? $pop3 : $u->{'pass'} =~ /^\!/ ? $pop3_dis : $pop3); my $col_val = "{'unix'}'>$col_text"; if (!$virtualmin_pro && $u->{'extra'}) { $col_val = $col_text; } push(@cols, "$col_val\n"); push(@cols, &html_escape($u->{'user'})); push(@cols, &html_escape($u->{'real'})); $userdesc++ if ($u->{'real'}); # Add columns for quotas local $quota; $quota += $u->{'quota'} if (&has_home_quotas()); $quota += $u->{'mquota'} if (&has_mail_quotas()); local $uquota; $uquota += $u->{'uquota'} if (&has_home_quotas()); $uquota += $u->{'muquota'} if (&has_mail_quotas()); if (($u->{'webowner'} || $u->{'extra'}) && defined($quota)) { # Website owners, virtual database and web users have no # real quota push(@cols, $u->{'type'} eq 'web' || $u->{'type'} eq 'db' ? $text{'users_na'} : $text{'users_same'}, ""); } elsif (defined($quota)) { # Has Unix quotas push(@cols, $quota ? "a_show($quota, "home") : $text{'form_unlimit'}); my $color = $u->{'over_quota'} ? "#ff0000" : $u->{'warn_quota'} ? "#df7d0e" : $u->{'spam_quota'} ? "#aaaaaa" : undef; if ($color) { push(@cols, "". "a_show($uquota, "home").""); } else { push(@cols, "a_show($uquota, "home")); } } if ($u->{'mailquota'}) { push(@cols, $u->{'qquota'} ? &nice_size($u->{'qquota'}) : $text{'form_unlimit'}); } elsif ($can_qquotas) { push(@cols, ""); } if ($config{'show_mailsize'} && $d->{'mail'}) { # Mailbox link, if this user has email enabled or is the owner local ($szmsg, $sz, $szb); if (!$u->{'nomailfile'} && ($u->{'email'} || @{$u->{'extraemail'}})) { ($sz) = &mail_file_size($u); $szb = $sz; $sz = $sz ? &nice_size($sz) : $text{'users_empty'}; local $lnk = &read_mail_link($u, $d); if ($lnk) { $szmsg = &ui_link($lnk, $sz); } else { $szmsg = $sz; } } else { $szmsg = $text{'users_noemail'}; $sz = 0; $szb = 0; } push(@cols, { 'type' => 'string', 'td' => 'data-sort='.$szb, 'value' => $szmsg }); } if ($config{'show_lastlogin'} && $d->{'mail'}) { # Last mail login my $ll = &get_last_login_time($u->{'user'}); my $llbest; foreach $k (keys %$ll) { $llbest = $ll->{$k} if ($ll->{$k} > $llbest); } push(@cols, $llbest ? &make_date($llbest) : $text{'users_ll_never'}); } # Show shell access level if ($u->{'domainowner'}) { $u->{'shell'} = &get_domain_shell($d, $u); } local ($shell) = grep { $_->{'shell'} eq $u->{'shell'} } @ashells; my $udbs = scalar(@{$u->{'dbs'}}) || $u->{'domainowner'}; push(@cols, ($u->{'extra'} && $u->{'type'} eq 'db') ? &$login_access_label('db') : ($u->{'extra'} && $u->{'type'} eq 'web') ? &$login_access_label('web') : !$u->{'shell'} ? &$login_access_label($udbs ? 'db' : undef, 'mail') : !$shell ? &text('users_shell', "$u->{'shell'}") : $shell->{'id'} eq 'ftp' && !$u->{'email'} ? &$login_access_label($udbs ? 'db' : undef, 'ftp') : (&$login_access_label( ($u->{'extra'} && $u->{'type'} eq 'web') ? 'web' : $udbs ? 'db' : undef, $shell->{'id'} eq 'nologin' ? ($u->{'email'} ? 'mail' : undef) : $shell->{'id'} eq 'ftp' ? ($u->{'email'} ? 'mail' : undef, 'ftp') : $shell->{'id'} eq 'scp' ? ($u->{'email'} ? 'mail' : undef, 'scp') : $shell->{'id'} eq 'ssh' ? ($u->{'email'} ? 'mail' : undef, 'ftp', 'ssh') : undef ) || ($shell->{'id'} eq 'nologin' ? (!$u->{'email'} ? $text{'users_login_access_none'} : $shell->{'desc'}) : $shell->{'desc'}))); # Show number of DBs if (($d->{'mysql'} || $d->{'postgres'}) && $config{'show_dbs'}) { my $userdbscnt = scalar(@{$u->{'dbs'}}); push(@cols, $u->{'domainowner'} ? $text{'users_all'} : $userdbscnt ? scalar(@domsdbs) == $userdbscnt ? $text{'users_all'} : $userdbscnt : $text{'no'}); } # Show columns from plugins if ($config{'show_plugins'}) { foreach $f (grep { $plugcol{$_} } &list_mail_plugins()) { push(@cols, &plugin_call($f, "mailbox_column", $u, $d)); } } # Insert checkbox, if needed if ($cgi) { unshift(@cols, { 'type' => 'checkbox', 'name' => 'd', 'value' => int($u->{'unix'})."/".$u->{'user'}, 'disabled' => $u->{'domainowner'} }); } push(@table, \@cols); } # Drop "Real name" column if no column has any data if (!$userdesc) { my $colnum = $cgi ? 3 : 2; map { splice(@$_, $colnum, 1) } @table; splice(@headers, $colnum, 1); } # Generate the table, perhaps with a form if ($cgi) { print &ui_form_columns_table($cgi, $buttons, 1, $links, $d ? [ [ "dom", $d->{'id'} ] ] : undef, \@headers, 100, \@table, undef, 0, undef, $empty); } else { print &ui_columns_table(\@headers, 100, \@table, undef, 0, undef, $empty); } } # quota_bsize(filesystem|"home"|"mail", [for-filesys]) sub quota_bsize { if (&has_quota_commands()) { # When using quota commands, the block size is always 1024 return 1024; } local $fs = $_[0] eq "home" ? $config{'home_quotas'} : $_[0] eq "mail" ? $config{'mail_quotas'} : $_[0]; local $forfs = int($_[1]); if ($gconfig{'os_type'} =~ /-linux$/) { # On linux, the quota block size is ALWAYS 1024, so we can shortcut # any actual filesystem tests return $forfs ? 512 : 1024; } &require_useradmin(); if (defined("a::block_size)) { local $bsize; if (!exists($bsize_cache{$fs,$forfs})) { $bsize_cache{$fs,$forfs} = "a::block_size($fs, $forfs); } return $bsize_cache{$fs,$forfs}; } return undef; } # quota_show(number, filesystem|"home"|"mail", [zero-means-none]) # Returns text for the quota on some filesystem, in a human-readable format sub quota_show { my ($n, $fs, $zeromode) = @_; if (!$n) { return $zeromode == 1 ? $text{'resel_none'} : $zeromode == 0 ? $text{'resel_unlimit'} : 0; } else { local $bsize = "a_bsize($fs); if ($bsize) { return &nice_size($n*$bsize); } return $n." ".$text{'form_b'}; } } # quota_input(name, number, filesystem|"home"|"mail", [disabled]) # Returns HTML for an input for entering a quota, doing block->kb conversion sub quota_input { my ($name, $value, $fs, $dis) = @_; my $bsize = "a_bsize($fs); if ($bsize) { return &ui_bytesbox($name, $value*$bsize, 8, $dis, undef, 1024*1024); } else { # Just show blocks input return &ui_textbox($name, $value, 10, $dis)." ".$text{'form_b'}; } } # opt_quota_input(name, value, filesystem|"home"|"mail"|"none", # [third-option], [set-label]) # Returns HTML for a field for selecting a quota or unlimited sub opt_quota_input { local ($name, $value, $fs, $third, $label) = @_; local $dis1 = &js_disable_inputs([ $name, $name."_units" ], [ ]); local $dis2 = &js_disable_inputs([ ], [ $name, $name."_units" ]); local $mode = $value eq "" ? 1 : $value eq "0" ? 1 : $value eq "none" ? 2 : 0; local $qi = $fs eq "none" ? &ui_textbox($name, $mode ? "" : $value, 10) : "a_input($name, $mode ? "" : $value, $fs,$mode); return &ui_radio($name."_def", $mode, [ $third ? ([ 2, $third, "onClick='$dis1'" ]) : ( ), [ 1, $text{'form_unlimit'}, "onClick='$dis1'" ], [ 0, $label." ".$qi, "onClick='$dis2'" ] ]); } # quota_parse(name, filesystem|"home"|"mail") # Converts an entered quota into blocks sub quota_parse { local $bsize = "a_bsize($_[1]); if (!$bsize) { return $in{$_[0]}; } else { return int($in{$_[0]}*$in{$_[0]."_units"}/$bsize); } } # quota_javascript(name, value, filesystem|"bw"|"none", unlimited-possible) # Returns Javascript to set some quota field using Javascript sub quota_javascript { local ($name, $value, $fs, $unlimited) = @_; local $bsize = $fs eq "none" ? 0 : $fs eq "bw" ? 1 : "a_bsize($fs); local $rv; if ($bsize) { # Set value and units local $val = $value eq "" ? "" : $value*$bsize; local $index; if ($val >= 1024*1024*1024) { $val = $val/(1024*1024*1024); $index = 3; } elsif ($val >= 1024*1024) { $val = $val/(1024*1024); $index = 2; } elsif ($val >= 1024) { $val = $val/(1024); $index = 1; } else { $index = 0; } $val = sprintf("%.2f", $val) if ($val); $val =~ s/\.00$//; $rv .= " !!domain_form_target[0].${name} && (domain_form_target[0].${name}.value = \"$val\");\n"; $rv .= " !!domain_form_target[0].${name}_units && (domain_form_target[0].${name}_units.selectedIndex = $index);\n"; } else { # Just set blocks value $rv .= " !!domain_form_target[0].${name} && (domain_form_target[0].${name}.value = \"$value\");\n"; } if ($unlimited) { if ($value eq "") { $rv .= " !!domain_form_target[0].${name}_def && (domain_form_target[0].${name}_def[0].checked = true);\n"; $rv .= " !!domain_form_target[0].${name} && (domain_form_target[0].${name}.disabled = true);\n"; $rv .= " if (domain_form_target[0].${name}_units) {\n"; $rv .= " domain_form_target[0].${name}_units.disabled = true;\n"; $rv .= " }\n"; } else { $rv .= " !!domain_form_target[0].${name}_def && (domain_form_target[0].${name}_def[1].checked = true);\n"; $rv .= " !!domain_form_target[0].${name} && (domain_form_target[0].${name}.disabled = false);\n"; $rv .= " if (domain_form_target[0].${name}_units) {\n"; $rv .= " domain_form_target[0].${name}_units.disabled = false;\n"; $rv .= " }\n"; } } return $rv; } # quota_field(name, value, used, files-used, filesystem, &user) sub quota_field { my ($name, $value, $used, $fused, $fs, $u) = @_; my $rv; my $color = $u->{'over_quota'} ? "#ff0000" : $u->{'warn_quota'} ? "#df7d0e" : $u->{'spam_quota'} ? "#aaaaaa" : undef; if (&can_mailbox_quota()) { # Show inputs for editing quotas local $quota = $_[1]; $quota = undef if ($quota eq "none"); $rv .= &opt_quota_input($_[0], $quota, $_[3]); $rv .= "\n"; } else { # Just show current settings, or default $rv .= ($defmquota[0] ? "a_show($defmquota[0], $_[3]) : $text{'form_unlimit'})."\n"; } return $rv; } # backup_virtualmin(&domain, file) # Adds a domain's configuration file to the backup sub backup_virtualmin { my ($d, $file) = @_; &$first_print($text{'backup_virtualmincp'}); # Record parent's domain name, which can be used when restoring if ($d->{'parent'}) { local $parent = &get_domain($d->{'parent'}); $d->{'backup_parent_dom'} = $parent->{'dom'}; if ($d->{'alias'}) { local $alias = &get_domain($d->{'alias'}); $d->{'backup_alias_dom'} = $alias->{'dom'}; } if ($d->{'subdom'}) { local $subdom = &get_domain($d->{'subdom'}); $d->{'backup_subdom_dom'} = $subdom->{'dom'}; } } # Record sub-directory for mail folders, used during mail restores local %mconfig = &foreign_config("mailboxes"); if ($mconfig{'mail_usermin'}) { $d->{'backup_mail_folders'} = $mconfig{'mail_usermin'}; } else { delete($d->{'backup_mail_folders'}); } # Record encrypted Unix password delete($d->{'backup_encpass'}); if ($d->{'unix'} && !$d->{'parent'} && !$d->{'disabled'}) { local @users = &list_all_users(); local ($user) = grep { $_->{'user'} eq $d->{'user'} } @users; if ($user) { $d->{'backup_encpass'} = $user->{'pass'}; } } # Record if default for the IP if (&domain_has_website($d)) { $d->{'backup_web_default'} = &is_default_website($d); } else { delete($d->{'backup_web_default'}); } # Record webserver type $d->{'backup_web_type'} = &domain_has_website($d); $d->{'backup_ssl_type'} = &domain_has_ssl($d); &save_domain($d); # Save the domain's data file ©_source_dest($d->{'file'}, $file); if (-r "$initial_users_dir/$d->{'id'}") { # Initial user settings ©_source_dest("$initial_users_dir/$d->{'id'}", $file."_initial"); } if (-d "$extra_admins_dir/$d->{'id'}") { # Extra admin details &execute_command( "cd ".quotemeta("$extra_admins_dir/$d->{'id'}"). " && ".&make_tar_command("cf", $file."_admins", ".")); } if (-d "$extra_users_dir/$d->{'id'}") { # Extra users details &execute_command( "cd ".quotemeta("$extra_users_dir/$d->{'id'}"). " && ".&make_tar_command("cf", $file."_users", ".")); } if ($config{'bw_active'}) { # Bandwidth logs if (-r "$bandwidth_dir/$d->{'id'}") { ©_source_dest("$bandwidth_dir/$d->{'id'}", $file."_bw"); } else { # Create an empty file to indicate that we have no data &open_tempfile(EMPTY, ">".$file."_bw"); &close_tempfile(EMPTY); } } # Script logs if (-d "$script_log_directory/$d->{'id'}") { &execute_command( "cd ".quotemeta("$script_log_directory/$d->{'id'}"). " && ".&make_tar_command("cf", $file."_scripts", ".")); } else { # Create an empty file to indicate that we have no scripts &open_tempfile(EMPTY, ">".$file."_scripts"); &close_tempfile(EMPTY); } # Include template, in case the restore target doesn't have it local ($tmpl) = grep { $_->{'id'} == $d->{'template'} } &list_templates(); if (!$tmpl->{'standard'}) { ©_source_dest($tmpl->{'file'}, $file."_template"); } # Include plan too local $plan = &get_plan($d->{'plan'}); if ($plan) { ©_source_dest($plan->{'file'}, $file."_plan"); } # Save deleted aliases file ©_source_dest("$saved_aliases_dir/$d->{'id'}", $file."_saved_aliases"); &$second_print($text{'setup_done'}); return 1; } # virtualmin_backup_config(file, &vbs) # Save the current module config to the specified file sub virtualmin_backup_config { local ($file, $vbs) = @_; &$first_print($text{'backup_vconfig_doing'}); ©_source_dest($module_config_file, $file); &$second_print($text{'setup_done'}); return 1; } # virtualmin_restore_config(file, &vbs) # Replace the current config with the given file, *except* for the default # template settings sub virtualmin_restore_config { local ($file, $vbs) = @_; &$first_print($text{'restore_vconfig_doing'}); local %oldconfig = %config; local @tmpls = &list_templates(); ©_source_dest($file, $module_config_file); &read_file($module_config_file, \%config); foreach my $t (@tmpls) { if ($t->{'standard'}) { &save_template($t); } } # Put back site-specific settings, as those in the backup are unlikely to # be correct. $config{'iface'} = $oldconfig{'iface'}; $config{'defip'} = $oldconfig{'defip'}; $config{'sharedips'} = $oldconfig{'sharedips'}; $config{'sharedip6s'} = $oldconfig{'sharedip6s'}; $config{'home_quotas'} = $oldconfig{'home_quotas'}; $config{'mail_quotas'} = $oldconfig{'mail_quotas'}; $config{'group_quotas'} = $oldconfig{'group_quotas'}; $config{'old_defip'} = $oldconfig{'old_defip'}; $config{'old_defip6'} = $oldconfig{'old_defip6'}; $config{'last_check'} = $oldconfig{'last_check'}; # Remove plugins that aren't on the new system &generate_plugins_list($config{'plugins'}); $config{'plugins'} = join(' ', @plugins); &save_module_config(); &$second_print($text{'setup_done'}); # Apply any new config settings &run_post_config_actions(\%oldconfig); return 1; } # virtualmin_backup_templates(file, &vbs) # Write a tar file of all templates (including scripts) to the given file sub virtualmin_backup_templates { local ($file, $vbs) = @_; &$first_print($text{'backup_vtemplates_doing'}); local $temp = &transname(); mkdir($temp, 0700); foreach my $tmpl (&list_templates()) { my %tmplquoted = %$tmpl; foreach my $k (keys %tmplquoted) { $tmplquoted{$k} =~ s/\n/\\n/g; } &write_file("$temp/$tmpl->{'id'}", \%tmplquoted); } # Save template scripts &execute_command("cp $template_scripts_dir/* $temp"); &execute_command("cd ".quotemeta($temp)." && ". &make_tar_command("cf", $file, ".")); &unlink_file($temp); # Save global variables file if (-r $global_template_variables_file) { ©_source_dest($global_template_variables_file, $file."_global"); } else { # Create empty, as an indicator that it exists &open_tempfile(GLOBAL, ">".$file."_global", 0, 1); &close_tempfile(GLOBAL); } # Save skeleton directories for all templates local %done; foreach my $tmpl (&list_templates()) { if ($tmpl->{'skel'} && $tmpl->{'skel'} ne 'none' && !$done{$tmpl->{'skel'}}++ && -d $tmpl->{'skel'}) { local $skelfile = $file.'_skel_'.$tmpl->{'id'}; &execute_command( "cd ".quotemeta($tmpl->{'skel'}). " && ".&make_tar_command("cf", $skelfile, ".")); } } # Save plans &make_dir($plans_dir, 0700); &execute_command( "cd ".quotemeta($plans_dir). " && ".&make_tar_command("cf", $file."_plans", ".")); &$second_print($text{'setup_done'}); } # virtualmin_restore_templates(file, &vbs) # Extract all templates from a backup. Those that already exist are not deleted. sub virtualmin_restore_templates { local ($file, $vbs) = @_; &$first_print($text{'restore_vtemplates_doing'}); # Extract backup file local $temp = &transname(); mkdir($temp, 0700); &execute_command("cd ".quotemeta($temp)." && ". &make_tar_command("xf", $file)); # Copy templates from backup across opendir(DIR, $temp); foreach my $t (readdir(DIR)) { next if ($t eq "." || $t eq ".."); if ($t =~ /^(\d+)_(\d+)$/) { # A script file if (!-d $template_scripts_dir) { &make_dir($template_scripts_dir, 0755); } ©_source_dest("$temp/$t", "$template_scripts_dir/$t"); } else { # A template file local %tmpl; &read_file("$temp/$t", \%tmpl); foreach my $k (keys %tmpl) { $tmpl{$k} =~ s/\\n/\n/g; } &save_template(\%tmpl); } } closedir(DIR); &execute_command("rm -rf ".quotemeta($temp)); # Fix up bad Apache directives in templates foreach my $tmpl (&list_templates()) { &fix_options_template($tmpl); } # Restore global variables if (-r $file."_global") { ©_source_dest($file."_global", $global_template_variables_file); } # Restore skeleton directories local %done; foreach my $tmpl (&list_templates()) { if ($tmpl->{'skel'} && $tmpl->{'skel'} ne 'none' && !$done{$tmpl->{'skel'}}++) { local $skelfile = $file.'_skel_'.$tmpl->{'id'}; if (-r $skelfile) { # Delete and re-create skel directory &unlink_file($tmpl->{'skel'}); &make_dir($tmpl->{'skel'}, 0755); &execute_command( "cd ".quotemeta($tmpl->{'skel'}). " && ".&make_tar_command("xf", quotemeta($skelfile))); } } } # Restore plans, if included if (-r $file."_plans") { &execute_command( "cd ".quotemeta($plans_dir)." && ". &make_tar_command("xf", $file."_plans")); } &$second_print($text{'setup_done'}); return 1; } # virtualmin_backup_scheds(file, &vbs) # Create a tar file of all scheduled backups and keys sub virtualmin_backup_scheds { local ($file, $vbs) = @_; local $dokeys = defined(&list_backup_keys) && scalar(&list_backup_keys()); &$first_print($dokeys ? $text{'backup_vscheds_doing2'} : $text{'backup_vscheds_doing'}); # Tar up scheduled backups dir local $temp = &transname(); mkdir($temp, 0700); foreach my $sched (&list_scheduled_backups()) { &write_file("$temp/$sched->{'id'}", $sched); } &execute_command("cd ".quotemeta($temp)." && ". &make_tar_command("cf", $file, ".")); &unlink_file($temp); # Also tar up keys dir if ($dokeys) { &execute_command("cd ".quotemeta($backup_keys_dir)." && ". &make_tar_command("cf", $file."_keys", ".")); } # Also tar up S3 accounts dir if (-d $s3_accounts_dir) { &execute_command("cd ".quotemeta($s3_accounts_dir)." && ". &make_tar_command("cf", $file."_s3accounts", ".")); } &$second_print($text{'setup_done'}); return 1; } # virtualmin_restore_scheds(file, vbs) # Re-create all scheduled backups sub virtualmin_restore_scheds { local ($file, $vbs) = @_; local $dokeys = -r $file."_keys" && defined(&list_backup_keys); &$first_print($dokeys ? $text{'restore_vscheds_doing'} : $text{'restore_vscheds_doing2'}); # Extract backup file local $temp = &transname(); mkdir($temp, 0700); &execute_command("cd ".quotemeta($temp)." && ". &make_tar_command("xf", $file)); # Delete all current non-default schedules foreach my $sched (&list_scheduled_backups()) { if ($sched->{'id'} != 1) { &delete_scheduled_backup($sched); } } # Re-create the restored ones opendir(BACKUPDIR, $temp); foreach my $t (readdir(BACKUPDIR)) { next if ($t eq "." || $t eq ".."); local %sched; &read_file("$temp/$t", \%sched); delete($sched{'file'}); &save_scheduled_backup(\%sched); } closedir(BACKUPDIR); # Extract dir of backup keys, then re-save each to re-import to root if ($dokeys) { local %oldkeys = map { $_->{'id'}, 1 } &list_backup_keys(); &make_dir($backup_keys_dir, 0700) if (!-d $backup_keys_dir); &execute_command("cd ".quotemeta($backup_keys_dir)." && ". &make_tar_command("xf", $file."_keys")); foreach my $key (&list_backup_keys()) { if (!$oldkey{$key->{'id'}}) { eval { $main::error_must_die = 1; &save_backup_key($key, 1); }; } } } # Extract dir of S3 accounts if (-r $file."_s3accounts") { &unlink_file($s3_accounts_dir); &make_dir($s3_accounts_dir, 0700); &execute_command("cd ".quotemeta($s3_accounts_dir)." && ". &make_tar_command("xf", $file."_s3accounts")); } &$second_print($text{'setup_done'}); return 1; } # virtualmin_backup_resellers(file, &vbs) # Create a tar file of reseller details. For each we need to store the Webmin # user information, plus all ACL files sub virtualmin_backup_resellers { local ($file, $vbs) = @_; return undef if (!defined(&list_resellers)); &$first_print($text{'backup_vresellers_doing'}); local $temp = &transname(); mkdir($temp, 0700); foreach my $resel (&list_resellers()) { &open_tempfile(RESEL, ">$temp/$resel->{'name'}.webmin"); &print_tempfile(RESEL, &serialise_variable($resel)); &close_tempfile(RESEL); local $acldir = "$temp/$resel->{'name'}.acls"; mkdir($acldir, 0700); foreach my $m (@{$resel->{'modules'}}) { local %acl = &get_module_acl($resel->{'name'}, $m, 1, 1); &write_file("$acldir/$m", \%acl); } } &execute_command("cd ".quotemeta($temp)." && ". &make_tar_command("cf", $file, ".")); &execute_command("rm -rf ".quotemeta($temp)); &$second_print($text{'setup_done'}); return 1; } # virtualmin_restore_resellers(file, &vbs) # Delete all resellers and re-create them from the backup sub virtualmin_restore_resellers { local ($file, $vbs) = @_; return undef if (!defined(&list_resellers)); &$first_print($text{'restore_vresellers_doing'}); local $temp = &transname(); mkdir($temp, 0700); &require_acl(); &execute_command("cd ".quotemeta($temp)." && ". &make_tar_command("xf", $file)); foreach my $resel (&list_resellers()) { &acl::delete_user($resel->{'name'}); &delete_reseller_unix_user($resel); } local %miniserv; &get_miniserv_config(\%miniserv); if (&check_pid_file($miniserv{'pidfile'})) { &reload_miniserv(); } opendir(DIR, $temp); foreach my $f (readdir(DIR)) { if ($f =~ /^(.*)\.webmin$/) { local $acldir = "$temp/$1"; local $ser = &read_file_contents("$temp/$f"); local $resel = &unserialise_variable($ser); &create_reseller($resel); opendir(ACL, $acldir); foreach my $a (readdir(ACL)) { next if ($a eq "." || $a eq ".."); local %acl; &read_file("$acldir/$a", \%acl); &save_module_acl(\%acl, $resel->{'name'}, $a); } closedir(ACL); } } &unlink_file($temp); &$second_print($text{'setup_done'}); return 1; } # virtualmin_backup_email(file, &vbs) # Creates a tar file of all email templates sub virtualmin_backup_email { local ($file, $vbs) = @_; &$first_print($text{'backup_vemail_doing'}); &execute_command( "cd $module_config_directory && ". &make_tar_command("cf", $file, @all_template_files)); &$second_print($text{'setup_done'}); return 1; } # virtualmin_restore_email(file, &vbs) # Extract a tar file of all email templates sub virtualmin_restore_email { local ($file, $vbs) = @_; &$first_print($text{'restore_vemail_doing'}); &execute_command("cd $module_config_directory && ". &make_tar_command("xf", $file)); &$second_print($text{'setup_done'}); return 1; } # virtualmin_backup_custom(file, &vbs) # Copies the custom fields, links and shells files sub virtualmin_backup_custom { local ($file, $vbs) = @_; &$first_print($text{'backup_vcustom_doing'}); foreach my $fm ([ $custom_fields_file, $file ], [ $custom_links_file, $file."_links" ], [ $custom_link_categories_file, $file."_linkcats" ], [ $custom_shells_file, $file."_shells" ]) { if (-r $fm->[0]) { ©_source_dest($fm->[0], $fm->[1]); } else { &create_empty_file($fm->[1]); } } &$second_print($text{'setup_done'}); return 1; } # virtualmin_restore_custom(file, &vbs) # Restores the custom fields, links and shells files sub virtualmin_restore_custom { local ($file, $vbs) = @_; &$first_print($text{'restore_vcustom_doing'}); foreach my $fm ([ $custom_fields_file, $file ], [ $custom_links_file, $file."_links" ], [ $custom_link_categories_file, $file."_linkcats" ]) { if (-r $fm->[1]) { ©_source_dest($fm->[1], $fm->[0]); } } if (-s $file."_shells") { # A non-empty shells file means that the original system defined some # custom shells. ©_source_dest($file."_shells", $custom_shells_file); } elsif (-r $file."_shells") { # An empty shells file means that the original system was using the # default shells, so so should we &unlink_file($custom_shells_file); } &$second_print($text{'setup_done'}); return 1; } # virtualmin_backup_scripts(file, &vbs) # Create a tar file of the scripts directory, and of the unavailable scripts sub virtualmin_backup_scripts { local ($file, $vbs) = @_; &$first_print($text{'backup_vscripts_doing'}); &make_dir("$module_config_directory/scripts", 0755); &execute_command("cd $module_config_directory/scripts && ". &make_tar_command("cf", $file, ".")); ©_source_dest($scripts_unavail_file, $file."_unavail"); &$second_print($text{'setup_done'}); return 1; } # virtualmin_restore_scripts(file, &vbs) # Extract a tar file of all third-party scripts sub virtualmin_restore_scripts { local ($file, $vbs) = @_; &$first_print($text{'restore_vscripts_doing'}); &make_dir("$module_config_directory/scripts", 0755); &execute_command("cd $module_config_directory/scripts && ". &make_tar_command("xf", $file)); if (-r $file."_unavail") { ©_source_dest($file."_unavail", $scripts_unavail_file); } &$second_print($text{'setup_done'}); return 1; } # virtualmin_backup_chroot(file, &vbs) # Create a file of FTP directory restrictions sub virtualmin_backup_chroot { local ($file, $vbs) = @_; &$first_print($text{'backup_vchroot_doing'}); local @chroots = &list_ftp_chroots(); &open_tempfile(CHROOT, ">$file"); foreach my $c (@chroots) { &print_tempfile(CHROOT, join(" ", map { $_."=".&urlize($c->{$_}) } grep { $_ ne 'dr' } keys %$c),"\n"); } &close_tempfile(CHROOT); &$second_print($text{'setup_done'}); return 1; } # virtualmin_restore_chroot(file, &vbs) # Restore all chroot'd directories from a backup file sub virtualmin_restore_chroot { local ($file, $vbs) = @_; &$first_print($text{'restore_vchroot_doing'}); &obtain_lock_ftp(); local @chroots; open(CHROOT, "<".$file); while() { s/\r|\n//g; local %c = map { my ($n, $v) = split(/=/, $_, 2); ($n, &un_urlize($v)) } split(/\s+/, $_); push(@chroots, \%c); } close(CHROOT); &save_ftp_chroots(\@chroots); &release_lock_ftp(); &$second_print($text{'setup_done'}); return 1; } # virtualmin_backup_mailserver(file, &vbs) # Save DKIM and Postgrey settings to a file sub virtualmin_backup_mailserver { local ($file, $vbs) = @_; &require_mail(); # Save DKIM settings &$first_print($text{'backup_vmailserver_dkim'}); local %dkim; if (!&check_dkim()) { # DKIM can be used .. check if enabled $dkim{'support'} = 1; local $conf = &get_dkim_config(); $dkim{'enabled'} = $conf->{'enabled'}; $dkim{'selector'} = $conf->{'selector'}; $dkim{'extra'} = join(" ", @{$conf->{'extra'}}); $dkim{'keyfile'} = $conf->{'keyfile'}; $dkim{'sign'} = $conf->{'sign'}; $dkim{'verify'} = $conf->{'verify'}; if ($conf->{'keyfile'} && -r $conf->{'keyfile'}) { ©_source_dest($conf->{'keyfile'}, $file."_dkimkey"); } &$second_print($text{'setup_done'}); } else { $dkim{'support'} = 0; &$second_print($text{'backup_vmailserver_none'}); } &write_file($file."_dkim", \%dkim); # Save Postgrey settings &$first_print($text{'backup_vmailserver_postgrey'}); local %grey; if (!&check_postgrey()) { # Postgrey can be used .. check if enabled, and with what opts $grey{'support'} = 1; $grey{'enabled'} = &is_postgrey_enabled(); local $cfile = &get_postgrey_data_file("clients"); if ($cfile) { ©_source_dest($cfile, $file."_greyclients"); } local $rfile = &get_postgrey_data_file("recipients"); if ($rfile) { ©_source_dest($rfile, $file."_greyrecipients"); } &$second_print($text{'setup_done'}); } else { $grey{'support'} = 0; &$second_print($text{'backup_vmailserver_none'}); } &write_file($file."_grey", \%grey); # Save rate limiting settings &$first_print($text{'backup_vmailserver_ratelimit'}); local %ratelimit; if (!&check_ratelimit()) { # Rate limiting can be used .. check if enabled, and save config $ratelimit{'support'} = 1; $ratelimit{'enabled'} = &is_ratelimit_enabled(); ©_source_dest(&get_ratelimit_config_file(), $file."_ratelimitconfig"); &$second_print($text{'setup_done'}); } else { $ratelimit{'support'} = 0; &$second_print($text{'backup_vmailserver_none'}); } &write_file($file."_ratelimit", \%ratelimit); # Save mail server type &$first_print($text{'backup_vmailserver_doing'}); &open_tempfile(MS, ">$file", 0, 1); &print_tempfile(MS, $config{'mail_system'},"\n"); &close_tempfile(MS); # Save general mail server settings if ($config{'mail_system'} == 0) { # Save main.cf and master.cf ©_source_dest($postfix::config{'postfix_config_file'}, $file."_maincf"); ©_source_dest($postfix::config{'postfix_master'}, $file."_mastercf"); foreach my $o ("smtpd_tls_cert_file", "smtpd_tls_key_file", "smtpd_tls_CAfile") { my $v = &postfix::get_current_value($o); if ($v) { ©_source_dest($v, $file."_".$o); } } &$second_print($text{'setup_done'}); } elsif ($config{'mail_system'} == 1) { # Save sendmail.cf and sendmail.mc ©_source_dest($sendmail::config{'sendmail_cf'}, $file."_sendmailcf"); ©_source_dest($sendmail::config{'sendmail_mc'}, $file."_sendmailmc"); &$second_print($text{'setup_done'}); } elsif ($config{'mail_system'} == 2 || $config{'mail_system'} == 5) { # Save Qmail dir &execute_command("cd $qmailadmin::config{'qmail_dir'} && ". &make_tar_command("cf", $file, ".")); &$second_print($text{'setup_done'}); } else { &$second_print($text{'backup_vmailserver_supp'}); } return 1; } # virtualmin_restore_mailserver(file, &vbs) # Apply DKIM and Postgrey settings from the backup sub virtualmin_restore_mailserver { local ($file, $vbs) = @_; &require_mail(); # Restore DKIM config &$first_print($text{'restore_vmailserver_dkim'}); &obtain_lock_mail(); if (!&check_dkim()) { # DKIM supported .. see what state was in the backup local %dkim; &read_file($file."_dkim", \%dkim); if (!$dkim{'support'}) { &$second_print($text{'restore_vmailserver_none'}); } else { local $conf = &get_dkim_config(); if ($dkim{'enabled'}) { # Setup on this system, same as source &$indent_print(); $conf->{'enabled'} = $dkim{'enabled'}; $conf->{'selector'} = $dkim{'selector'}; $conf->{'extra'} = [ split(/\s+/, $dkim{'extra'}) ]; $conf->{'sign'} = $dkim{'sign'}; $conf->{'verify'} = $dkim{'verify'}; local $copiedkey = 0; if ($conf->{'keyfile'} && -r $file."_dkimkey") { # Can copy key now ©_source_dest($file."_dkimkey", $conf->{'keyfile'}); $copiedkey = 1; } &enable_dkim($conf); $conf = &get_dkim_config(); if ($conf->{'keyfile'} && -r $file."_dkimkey" && !$copiedkey) { # Copy key file and re-enable DKIM ©_source_dest($file."_dkimkey", $conf->{'keyfile'}); &enable_dkim($conf); } &$outdent_print(); &$second_print($text{'setup_done'}); } elsif ($conf->{'enabled'} && !$dkim{'enabled'}) { # Disable on this system &$indent_print(); &disable_dkim($conf); &$outdent_print(); &$second_print($text{'setup_done'}); } else { # Nothing to do &$second_print($text{'restore_vmailserver_already'}); } } } else { &$second_print($text{'backup_vmailserver_none'}); } # Restore Postgrey config &$first_print($text{'restore_vmailserver_grey'}); local %grey; &read_file($file."_grey", \%grey); if (&check_postgrey() ne '' && &can_install_postgrey() && $grey{'enabled'}) { # Postgrey is not installed on this system yet, but it was enabled # on the old machine - try to install it now &install_postgrey_package(); } if (&check_postgrey() eq '') { if (!$grey{'support'}) { &$second_print($text{'restore_vmailserver_none'}); } else { local $enabled = &is_postgrey_enabled(); if ($grey{'enabled'}) { # Enable on this system, and copy client files &$indent_print(); &enable_postgrey(); local $cfile = &get_postgrey_data_file("clients"); if ($cfile && -r $file."_greyclients") { ©_source_dest($file."_greyclients", $cfile); } local $rfile = &get_postgrey_data_file("recipients"); if ($rfile && -r $file."_greyrecipients") { ©_source_dest($file."_greyrecipients", $rfile); } &apply_postgrey_data(); &$outdent_print(); &$second_print($text{'setup_done'}); } elsif ($enabled && !$grey{'enabled'}) { # Disable on this system &$indent_print(); &disable_postgrey(); &$outdent_print(); &$second_print($text{'setup_done'}); } else { # Nothing to do &$second_print($text{'restore_vmailserver_already'}); } } } else { &$second_print($text{'backup_vmailserver_none'}); } # Restore rate limiting config &$first_print($text{'restore_vmailserver_ratelimit'}); local %ratelimit; &read_file($file."_ratelimit", \%ratelimit); if (&check_ratelimit() ne '' && &can_install_ratelimit() && $ratelimit{'enabled'}) { # Rate limiting is not installed on this system yet, but it was enabled # on the old machine - try to install it now &install_ratelimit_package(); } if (&check_ratelimit() eq '') { if (!$ratelimit{'support'}) { &$second_print($text{'restore_vmailserver_none'}); } else { local $enabled = &is_ratelimit_enabled(); # XXX put back socket if ($ratelimit{'enabled'}) { # Enable on this system, and copy config file &$indent_print(); &enable_ratelimit(); my $conf = &get_ratelimit_config(); my ($oldsocket) = grep { $_->{'name'} eq 'socket' } @$conf; ©_source_dest($file."_ratelimitconfig", &get_ratelimit_config_file()); my $conf = &get_ratelimit_config(); my ($socket) = grep { $_->{'name'} eq 'socket' } @$conf; &save_ratelimit_directive($conf, $socket, $oldsocket); &$outdent_print(); &$second_print($text{'setup_done'}); } elsif ($enabled && !$ratelimit{'enabled'}) { # Disable on this system &$indent_print(); &disable_ratelimit(); &$outdent_print(); &$second_print($text{'setup_done'}); } else { # Nothing to do &$second_print($text{'restore_vmailserver_already'}); } } } else { &$second_print($text{'restore_vmailserver_missing'}); } &release_lock_mail(); # Get mail server type from the backup local $bms = &read_file_contents($file); $bms =~ s/\n//g; # Restore mail server type, if matching. This is done last because DKIM or # greylisting might be detected as disabled if done earlier. &$first_print($text{'restore_vmailserver_doing'}); &obtain_lock_mail(); if ($bms eq $config{'mail_system'}) { if ($config{'mail_system'} == 0) { # Restore main.cf and master.cf &lock_file($postfix::config{'postfix_config_file'}); &lock_file($postfix::config{'postfix_master'}); ©_source_dest($file."_maincf", $postfix::config{'postfix_config_file'}); ©_source_dest($file."_mastercf", $postfix::config{'postfix_master'}); &unlock_file($postfix::config{'postfix_master'}); &unlock_file($postfix::config{'postfix_config_file'}); undef(@postfix::master_config_cache); foreach my $o ("smtpd_tls_cert_file", "smtpd_tls_key_file", "smtpd_tls_CAfile") { my $v = &postfix::get_current_value($o); if ($v) { ©_source_dest($file."_".$o, $v); } } &$second_print($text{'setup_done'}); } elsif ($config{'mail_system'} == 1) { # Restore sendmail.cf and .mc &lock_file($sendmail::config{'sendmail_cf'}); &lock_file($sendmail::config{'sendmail_mc'}); ©_source_dest($file."_sendmailcf", $sendmail::config{'sendmail_cf'}); ©_source_dest($file."_sendmailmc", $sendmail::config{'sendmail_mc'}); &unlock_file($sendmail::config{'sendmail_mc'}); &unlock_file($sendmail::config{'sendmail_cf'}); undef(@sendmail::sendmailcf_cache); &$second_print($text{'setup_done'}); } elsif ($config{'mail_system'} == 2 || $config{'mail_system'} == 5) { # Un-tar qmail dir &execute_command("cd $qmailadmin::config{'qmail_dir'} && ". &make_tar_command("xf", $file)); &$second_print($text{'setup_done'}); } else { &$second_print($text{'backup_vmailserver_supp'}); } } else { &$second_print(&text('restore_vmailserver_wrong', $text{'mail_system_'.$bms}, $text{'mail_system_'.$config{'mail_system'}})); } &release_lock_mail(); return 1; } # restore_virtualmin(&domain, file, &opts, &allopts) # Restore the settings for a domain, such as quota, password and so on. Only # selected settings are copied from the backup, such as limits. sub restore_virtualmin { my ($d, $file, $opts, $allopts) = @_; if (!$allopts->{'fix'}) { # Merge current and backup configs &$first_print($text{'restore_virtualmincp'}); local %oldd; &read_file($file, \%oldd); $d->{'quota'} = $oldd{'quota'}; $d->{'uquota'} = $oldd{'uquota'}; $d->{'bw_limit'} = $oldd{'bw_limit'}; $d->{'pass'} = $oldd{'pass'}; $d->{'email'} = $oldd{'email'}; foreach my $l (@limit_types) { $d->{$l} = $oldd{$l}; } $d->{'nodbname'} = $oldd{'nodbname'}; $d->{'norename'} = $oldd{'norename'}; $d->{'forceunder'} = $oldd{'forceunder'}; $d->{'safeunder'} = $oldd{'safeunder'}; $d->{'ipfollow'} = $oldd{'ipfollow'}; foreach my $f (@opt_features, &list_feature_plugins(), "virt") { $d->{'limit_'.$f} = $oldd{'limit_'.$f}; } $d->{'owner'} = $oldd{'owner'}; $d->{'proxy_pass_mode'} = $oldd{'proxy_pass_mode'}; $d->{'proxy_pass'} = $oldd{'proxy_pass'}; foreach my $f (&list_custom_fields()) { $d->{$f->{'name'}} = $oldd{$f->{'name'}}; } # Disable any features that are not on this system, as they can't # be restored from the backup anyway. foreach my $f (@features) { next if ($f eq 'dir' || $f eq 'unix'); # Always on if ($d->{$f} && !$config{$f}) { $d->{$f} = 0; } } &save_domain($d); if (-r $file."_initial") { # Also restore user defaults file ©_source_dest($file."_initial", "$initial_users_dir/$d->{'id'}"); } if (-r $file."_admins") { # Also restore extra admins if ($d->{'id'}) { &execute_command( "rm -rf ".quotemeta("$extra_admins_dir/$d->{'id'}")); } if (!-d $extra_admins_dir) { &make_dir($extra_admins_dir, 755); } &make_dir("$extra_admins_dir/$d->{'id'}", 0755); &execute_command( "cd ".quotemeta("$extra_admins_dir/$d->{'id'}")." && ". &make_tar_command("xf", $file."_admins", ".")); } if (-r $file."_users") { # Also restore extra users if ($d->{'id'}) { &execute_command( "rm -rf ".quotemeta("$extra_users_dir/$d->{'id'}")); } if (!-d $extra_users_dir) { &make_dir($extra_users_dir, 0700); } &make_dir("$extra_users_dir/$d->{'id'}", 0700); &execute_command( "cd ".quotemeta("$extra_users_dir/$d->{'id'}")." && ". &make_tar_command("xf", $file."_users", ".")); } if ($config{'bw_active'} && -r $file."_bw" && !-r "$bandwidth_dir/$d->{'id'}") { # Also restore bandwidth files for the domain, but only # if missing. &make_dir($bandwidth_dir, 0700); ©_source_dest($file."_bw", "$bandwidth_dir/$d->{'id'}"); } if (-r $file."_scripts") { # Also restore script logs &execute_command("rm -rf ". quotemeta("$script_log_directory/$d->{'id'}")); if (-s $file."_scripts") { if (!-d $script_log_directory) { &make_dir($script_log_directory, 0755); } &make_dir("$script_log_directory/$d->{'id'}", 0755); &execute_command( "cd ".quotemeta("$script_log_directory/$d->{'id'}"). " && ". &make_tar_command("xf", $file."_scripts", ".")); } # Fix up home dir on scripts if ($_[5]->{'home'} && $_[5]->{'home'} ne $d->{'home'}) { local $olddir = $_[5]->{'home'}; local $newdir = $d->{'home'}; foreach my $sinfo (&list_domain_scripts($d)) { $sinfo->{'opts'}->{'dir'} =~ s/^\Q$olddir\E\//$newdir\//; &save_domain_script($d, $sinfo); } } } if (-r $file."_saved_aliases") { # Restore saved aliases &make_dir($saved_aliases_dir, 0700); ©_source_dest($file."_saved_aliases", "$saved_aliases_dir/$d->{'id'}"); } &$second_print($text{'setup_done'}); } return 1; } # scp_copy(source, dest, password, &error, port, [as-user]) # Copies a file from some source to a destination. One or the other can be # a server, like user@foo:/path/to/bar/ sub scp_copy { local ($src, $dest, $pass, $err, $port, $asuser) = @_; if ($src =~ /\s|\(|\)/) { my ($host, $path) = split(/:/, $src, 2); if ($path) { $src = $host.":".quotemeta($path); } } if ($dest =~ /\s|\(|\)/) { my ($host, $path) = split(/:/, $dest, 2); if ($path) { $dest = $host.":".quotemeta($path); } } local $cmd = "scp -r ".($port ? "-P $port " : "").$config{'ssh_args'}." ". quotemeta($src)." ".quotemeta($dest); &run_ssh_command($cmd, $pass, $err, $asuser); } # run_ssh_command(command, pass, &error, [as-user]) # Attempt to run some command that uses ssh or scp, feeding in a password. # Returns the output, and sets the error variable ref if failed. sub run_ssh_command { my ($cmd, $pass, $err, $asuser) = @_; if ($pass =~ /^\// && -r $pass) { # Using a key file my ($bin, $args) = split(/\s+/, $cmd, 2); $cmd = $bin." -i ".quotemeta($pass)." ".$args; $pass = undef; } &foreign_require("proc"); if ($asuser) { $cmd = &command_as_user($asuser, 0, $cmd); } my ($fh, $fpid) = &proc::pty_process_exec($cmd); my $out; my $nopass = 0; while(1) { my $rv = &wait_for($fh, "password:", "yes\\/no", ".*\n"); $out .= $wait_for_input; if ($rv == 0) { if (!defined($pass) || $pass eq "") { $nopass = 1; last; } syswrite($fh, "$pass\n"); } elsif ($rv == 1) { syswrite($fh, "yes\n"); } elsif ($rv < 0) { last; } } close($fh); my $got = waitpid($fpid, 0); if ($nopass) { $$err = "Password required but not supplied"; } elsif ($? || $out =~ /permission\s+denied/i || $out =~ /connection\s+refused/i) { $$err = $out; } return $out; } # free_ip_address(&template|&acl) # Returns an IP address within the allocation range which is not currently used. # Checks this system's configured interfaces, and does pings. sub free_ip_address { local ($tmpl) = @_; local %taken = &interface_ip_addresses(); %taken = (%taken, &domain_ip_addresses(), &cloudmin_ip_addresses()); foreach my $ip (&get_default_ip(), &list_shared_ips()) { $taken{$ip}++; } local @ranges = split(/\s+/, $tmpl->{'ranges'}); foreach my $rn (@ranges) { my ($r, $n) = split(/\//, $rn); $r =~ /^(\d+\.\d+\.\d+)\.(\d+)\-(\d+)$/ || next; local ($base, $s, $e) = ($1, $2, $3); for(my $j=$s; $j<=$e; $j++) { local $try = "$base.$j"; if (!$taken{$try} && !&ping_ip_address($try)) { return wantarray ? ( $try, $n ) : $try; } } } return wantarray ? ( ) : undef; } # free_ip6_address(&template|&acl) # Returns an IPv6 address within the allocation range which is not currently # used. Checks this system's configured interfaces, and does pings. sub free_ip6_address { local ($tmpl) = @_; local %taken = &interface_ip_addresses(); %taken = (%taken, &domain_ip_addresses()); local @ranges = split(/\s+/, $tmpl->{'ranges6'}); foreach my $rn (@ranges) { my ($r, $n) = split(/\//, lc($rn)); $r =~ /^([0-9a-f:]+):([0-9a-f]+)\-([0-9a-f]+)$/ || next; local ($base, $s, $e) = ($1, $2, $3); for(my $j=hex($s); $j<=hex($e); $j++) { local $try = sprintf "%s:%x", $base, $j; if (!$taken{$try} && !&ping_ip_address($try)) { return wantarray ? ( $try, $n ) : $try; } } } return wantarray ? ( ) : undef; } # interface_ip_addresses() # Returns a hash of IP addresses that are in use by network interfaces, both # active and boot-time sub interface_ip_addresses { local %taken; foreach my $ip (&active_ip_addresses(), &bootup_ip_addresses()) { $taken{$ip} = 1; } return %taken; } # domain_ip_addresses() # Returns a hash of IPs that are assigned to any domains as virtual IPs sub domain_ip_addresses { local %taken; foreach my $d (&list_domains()) { $taken{$d->{'ip'}} = 1 if ($d->{'virt'}); $taken{$d->{'ip6'}} = 1 if ($d->{'virt6'}); } return %taken; } # cloudmin_ip_addresses() # Returns a hash of IPs that are assigned to any Cloudmin servers (if installed) sub cloudmin_ip_addresses { local %taken; if (&foreign_installed("server-manager")) { &foreign_require("server-manager"); foreach my $s (&server_manager::list_managed_servers()) { foreach my $ip (&server_manager::get_server_ip($s)) { $taken{$ip} = 1; } foreach my $ip (&server_manager::get_server_ip6($s)) { $taken{$ip} = 1; } } } return %taken; } # active_ip_addresses() # Returns a list of IP addresses (v4 and v6) that are active on the system # right now. sub active_ip_addresses { &foreign_require("net"); local @rv; push(@rv, map { $_->{'address'} } &net::active_interfaces()); if (&supports_ip6()) { push(@rv, map { $_->{'address'} } &active_ip6_interfaces()); } if (&has_command("ip")) { # On Linux, the 'ip' command sometimes includes IPs that are not # shown by ifconfig -a local $out = &backquote_command("ip addr /dev/null"); foreach my $l (split(/\r?\n/, $out)) { if ($l =~ /inet\s+([0-9\.]+)/) { push(@rv, $1); } if ($l =~ /inet6\s+([a-f0-9:]+)/) { push(@rv, $1); } } } return grep { $_ ne '' } &unique(@rv); } # bootup_ip_addresses() # Returns a list of IP addresses (v4 and v6) that are activated at boot time sub bootup_ip_addresses { &foreign_require("net"); local @rv; foreach my $i (&net::boot_interfaces()) { if ($i->{'range'} && $i->{'start'} && $i->{'end'}) { local $start = &net::ip_to_integer($i->{'start'}); local $end = &net::ip_to_integer($i->{'end'}); for(my $j=$start; $j<=$end; $j++) { push(@rv, &net::integer_to_ip($j)); } } elsif ($i->{'address'}) { push(@rv, $i->{'address'}); } } if (&supports_ip6()) { push(@rv, map { $_->{'address'} } &boot_ip6_interfaces()); } return grep { $_ ne '' } &unique(@rv); } # ping_ip_address(hostname|ip|ipv6) # Returns 1 if some host responds to a ping in 1 second sub ping_ip_address { local ($host) = @_; local $pinger = &check_ip6address($host) ? "ping6" : "ping"; local $pingcmd = $gconfig{'os_type'} =~ /-linux$/ ? "$pinger -c 1 -t 1" : $pinger; local ($out, $timed_out) = &backquote_with_timeout( $pingcmd." ".$host." 2>&1", 1, 1); return !$timed_out && !$?; } # parse_ip_ranges(ranges) # Returns a list of all IP allocation ranges, each of which is a 3-element # array of starting IP, ending IP and optional netmask sub parse_ip_ranges { local @rv; local @ranges = split(/\s+/, $_[0]); foreach my $rn (@ranges) { my ($r, $n) = split(/\//, $rn); if ($r =~ /^(\d+\.\d+\.\d+)\.(\d+)\-(\d+)$/) { # IPv4 range push(@rv, [ "$1.$2", "$1.$3", $n ]); } elsif ($r =~ /^([0-9a-f:]+):([0-9a-f]+)-([0-9a-f]+)$/i) { # IPv6 range push(@rv, [ "$1:$2", "$1:$3", $n ]); } } return @rv; } # join_ip_ranges(&ranges) # Converts a list of ranges into a string sub join_ip_ranges { local @ranges; foreach my $r (@{$_[0]}) { if (&check_ipaddress($r->[0])) { # IPv4 range local @start = split(/\./, $r->[0]); local @end = split(/\./, $r->[1]); push(@ranges, join(".", @start)."-".$end[3]. ($r->[2] ? "/".$r->[2] : "")); } elsif (&check_ip6address($r->[0])) { # IPv6 range local @end = split(/:/, $r->[1]); push(@ranges, $r->[0]."-".$end[$#end]. ($r->[2] ? "/".$r->[2] : "")); } } return join(" ", @ranges); } # ip_within_ranges(ip, ranges-string) # Returns 1 if some IP falls within a space-separated list of ranges sub ip_within_ranges { my ($ip, $ranges) = @_; &foreign_require("net"); my $n = &net::ip_to_integer($ip); foreach my $r (&parse_ip_ranges($ranges)) { if (&check_ipaddress($r->[0])) { # IPv4 range if ($n >= &net::ip_to_integer($r->[0]) && $n <= &net::ip_to_integer($r->[1])) { return 1; } } elsif (&check_ip6address($r->[0])) { # IPv6 range my ($p, $n) = split(/\//, lc($r)); $p =~ /^([0-9a-f:]+):([0-9a-f]+)\-([0-9a-f]+)$/ || next; local ($base, $s, $e) = ($1, $2, $3); $ip =~ /^([0-9a-f:]+):([0-9a-f]+)$/ || next; if (lc($1) eq lc($base) && hex($2) >= hex($s) && hex($2) <= hex($e)) { return 1; } } } return 0; } # setup_for_subdomain(&parent-domain, subdomain-user, &sub-domain) # Ensures that this virtual server can host sub-servers sub setup_for_subdomain { local ($d, $subuser, $subd) = @_; if (!-d "$d->{'home'}/domains") { &make_dir_as_domain_user($d, "$d->{'home'}/domains", 0755); } } # count_domains([type]) # Returns the number of additional domains the current user is allowed to # create (-1 for infinite), the reason for the limit (2=this reseller, # 1=reseller, 0=user), the number of domains allowed in total, and a flag # indicating if this limit should be hidden from the user. # May exclude alias domains if they don't count towards the max. sub count_domains { local ($type) = @_; $type ||= "doms"; local ($left, $reason, $max, $hide) = &count_feature($type); if ($left != 0 && $type ne "aliasdoms") { # If no limit has been hit, check the licence local ($lstatus, $lexpiry, $lerr, $ldoms) = &check_licence_expired(); if ($ldoms) { local $donedef = 0; local @doms = grep { !$_->{'alias'} && (!$_->{'defaultdomain'} || $donedef++) } &list_domains(); if (@doms > $ldoms) { return (0, 3, $ldoms, 0); } else { # Haven't reached .. check if the licence limit is # less than the current limit local $dleft = $ldoms - @doms; if ($left == -1 || $dleft < $left) { # Will hit licensed domains limit return ($dleft, 3, $max < $ldoms && $max > 0 ? $max : $ldoms, 0); } else { # Will hit user or reseller limit return ($left, $reason, $max, $hide); } } } } return ($left, $reason, $max, $hide); } # count_mailboxes(&parent) # Returns the number of mailboxes in this domain and all subdomains, and the # max allowed for the current user sub count_mailboxes { local $count = 0; local $doms = 0; local $parent = $_[0]->{'parent'} ? &get_domain($_[0]->{'parent'}) : $_[0]; local $d; foreach $d ($parent, &get_domain_by("parent", $parent->{'id'})) { local @users = &list_domain_users($d, 0, 1, 1, 1); $count += @users; $doms++; } return ( $count, $parent->{'mailboxlimit'} ? $parent->{'mailboxlimit'} : 0, $doms ); } # count_feature(feature, [user]) # Returns the number of extra instances of the given feature that the current # user is allowed to create, the reason for the limit (2=this reseller, # 1=reseller, 0=user), the total allowed, and a flag indicating if this # limit should be hidden from the user. # Feature can be "doms", "aliasdoms", "realdoms", "topdoms", "mailboxes", # "aliases", "quota", "uquota", "dbs", "bw" or a feature sub count_feature { local ($f) = @_; local $user = $_[1] || $base_remote_user; local %access = &get_module_acl($user); # Master admin has no limit return (-1, 0) if (&master_admin()); local $userleft = -1; local $usermax; if (!$access{'reseller'}) { # Count the number that this user has local @doms = &get_domain_by("user", $user); local ($parent) = grep { !$_->{'parent'} } @doms; local $limit = $f eq "doms" ? $parent->{'domslimit'} : $f eq "aliasdoms" ? $parent->{'aliasdomslimit'} : $f eq "realdoms" ? $parent->{'realdomslimit'} : $f eq "mailboxes" ? $parent->{'mailboxlimit'} : $f eq "aliases" ? $parent->{'aliaslimit'} : $f eq "dbs" ? $parent->{'dbslimit'} : undef; $limit = undef if ($limit eq "*"); if ($limit ne "") { # A server-owner-level limit is in force .. check it local $got = &count_domain_feature($f, @doms); if ($got >= $limit) { return (0, 0, $limit); } $userleft = $limit - $got; $usermax = $limit; } if (($f eq "aliasdoms" || $f eq "realdoms") && $parent->{'domslimit'} && $parent->{'domslimit'} ne '*') { # See if the owner is over the limit for all domains types too local $got = &count_domain_feature("doms", @doms); if ($got >= $parent->{'domslimit'}) { return (0, 0, $parent->{'domslimit'}); } else { $userleft = $parent->{'domslimit'} - $got; $usermax = $parent->{'domslimit'}; } } ($reseller) = split(/\s+/, $parent->{'reseller'}); } else { $reseller = $user; } if ($reseller && defined(&get_reseller_domains)) { # Either this user is owned by a reseller, or he is a reseller. local @rdoms = &get_reseller_domains($reseller); local %racl = &get_reseller_acl($reseller); local $reason = $access{'reseller'} ? 2 : 1; local $hide = $base_remote_user ne $reseller && $racl{'hide'}; local $limit = $racl{"max_".$f}; if ($limit ne "") { # Reseller has a limit .. local $got = &count_domain_feature($f, @rdoms); if ($got > $limit || $got < 0) { # Reseller has reached his limit return (0, $reason, $limit, $hide); } else { # Check if reseller limit is less than the user limit local $reselleft = $limit - $got; if ($userleft == -1 || $reselleft < $userleft) { # Yes .. reseller limit applies return ($reselleft, $reason, $limit, $hide); } } } if (($f eq "aliasdoms" || $f eq "realdoms" || $f eq "topdoms") && $racl{'max_doms'}) { # See if the reseller is over the limit for all domains types local $got = &count_domain_feature("doms", @rdoms); if ($got >= $racl{'max_doms'}) { return (0, $reason, $racl{'max_doms'}, $hide); } } if ($f eq "topdoms" && $racl{'max_realdoms'}) { # See if the reseller is over the limit for all real domains local $got = &count_domain_feature("realdoms", @rdoms); if ($got >= $racl{'max_realdoms'}) { return (0, $reason, $racl{'max_realdoms'}, $hide); } } } return ($userleft, 0, $usermax); } # count_domain_feature(feature, &domain, ...) # Returns the total for some feature in the given domains. May return -1 if # any are set to unlimited (ie. quotas) sub count_domain_feature { local ($f, @doms) = @_; local $rv = 0; local $d; foreach $d (@doms) { if ($f eq "dbs") { local @dbs = &domain_databases($d); $rv += scalar(@dbs); } elsif ($f eq "mailboxes") { local @users = &list_domain_users($d, 0, 1, 1, 1); $rv += scalar(@users); } elsif ($f eq "aliases") { local @aliases = &list_domain_aliases($d, 1); $rv += scalar(@aliases); } elsif ($f eq "quota" || $f eq "uquota") { if (!$d->{'parent'}) { return -1 if ($d->{$f} eq "" || $d->{$f} eq "0"); $rv += $d->{$f}; } } elsif ($f eq "bw") { if (!$d->{'parent'}) { return -1 if ($d->{'bw_limit'} eq "" || $d->{'bw_limit'} eq "0"); $rv += $d->{'bw_limit'}; } } elsif ($f eq "doms") { $rv++ if (!$d->{'alias'} || !$config{'limitnoalias'}); } elsif ($f eq "aliasdoms") { $rv++ if ($d->{'alias'}); } elsif ($f eq "realdoms") { $rv++ if (!$d->{'alias'}); } elsif ($f eq "topdoms") { $rv++ if (!$d->{'parent'}); } else { $rv++ if ($d->{$f}); } } return $rv; } # database_name(&domain) # Returns a suitable database name for a domain sub database_name { local ($d) = @_; local $tmpl = &get_template($d->{'template'}); local %hash = %$d; if (!$hash{'uid'}) { # Fake UID allocation now, in case the template uses it local %taken; &build_taken(\%taken); $hash{'uid'} = &allocate_uid(\%taken); } if (!$hash{'gid'}) { # Fake GID allocation local %gtaken; &build_group_taken(\%gtaken); $hash{'gid'} = &allocate_gid(\%gtaken); } local $db = &substitute_domain_template($tmpl->{'mysql'}, \%hash); $db = lc($db); $db ||= $d->{'prefix'}; $db = &fix_database_name($db, $d->{'mysql'} && $d->{'postgres'} ? undef : $d->{'mysql'} ? 'mysql' : 'postgres'); return $db; } # fix_database_name(dbname, [dbtype]) # If a database name starts with a number, convert it to a word to support # PostgreSQL, which doesn't like numeric names. Also converts . and - to _, # and handles reserved DB names. sub fix_database_name { local ($db, $dbtype) = @_; if (!$dbtype) { # Guess DB type my @dbtypes = grep { $config{$_} } @database_features; if (scalar(@dbtypes) == 1) { $dbtype = $dbtypes[0]; } } $db = lc($db); $db =~ s/[\.\-]/_/g; # mysql doesn't like . or _ if (!$dbtype || $dbtype eq "postgres") { # Postgresql doesn't like leading numbers $db = &remove_numeric_prefix($db); } if ($db eq "test" || $db eq "mysql" || $db =~ /^template/) { # These names are reserved by MySQL and PostgreSQL $db = "db".$db; } if (!$dbtype || $dbtype eq "mysql") { # MySQL DB names cannot be longer than 64 chars if (length($db) > 64) { $db = substr($db, 0, 64); } } return $db; } # remove_numeric_prefix(name) # If a name starts with a number, convert it to a work sub remove_numeric_prefix { my ($db) = @_; $db =~ s/^0/zero/g; $db =~ s/^1/one/g; $db =~ s/^2/two/g; $db =~ s/^3/three/g; $db =~ s/^4/four/g; $db =~ s/^5/five/g; $db =~ s/^6/six/g; $db =~ s/^7/seven/g; $db =~ s/^8/eight/g; $db =~ s/^9/nine/g; return $db; } # validate_database_name(&domain, type, name) # Returns an error message if a name is invalid, undef if OK sub validate_database_name { local ($d, $dbtype, $dbname) = @_; local $vfunc = "validate_database_name_".$dbtype; if (defined(&$vfunc)) { return &$vfunc($d, $dbname); } else { # Default rules $dbname =~ /^[a-z0-9\_]+$/i && $dbname =~ /^[a-z]/i || return $text{'database_ename'}; return undef; } } # generate_random_available_user(pattern) # Generates free user available to be used as # Unix user, group, and virtual server user sub generate_random_available_user { my ($pattern) = @_; $pattern ||= 'u-[0-9]{4}'; state $user; if (!defined($user)) { for (;;) { my $rand_name = &substitute_pattern($pattern, {'filter' => '[^A-Za-z0-9\\-_]', 'substitute-datetime' => 1}); my $uname_clash = defined(getpwnam($rand_name)) || defined(getgrnam($rand_name)) || &get_domain_by("prefix", $rand_name); if (!$uname_clash) { $user = $rand_name; last; } } } return $user; } # unixuser_name(domainname) # Returns a Unix username for some domain, or undef if none can be found sub unixuser_name { my ($dname) = @_; my ($dname_, $config_longname, $try1, $user) = ($dname, $config{'longname'}); if ($config_longname && $config_longname !~ /^[0-9]$/) { # Extract random username based on the user pattern $user = &generate_random_available_user($config_longname); } elsif ($config_longname == 2) { $user = &compute_prefix($dname, undef, undef, 1); } else { # Use one based on actual domain name $dname =~ s/^xn(-+)//; $dname = &remove_numeric_prefix($dname); $dname =~ /^([^\.]+)/; ($try1, $user) = ($1, $1); if (defined(getpwnam($try1)) || $config_longname) { $user = &remove_numeric_prefix($dname_); $try2 = $user; if (defined(getpwnam($try2))) { return (undef, $try1, $try2); } } } if ($config{'username_length'} && length($user) > $config{'username_length'}) { # Admin asked for a short username my $short = substr($user, 0, $config{'username_length'}); if (!defined(getpwnam($short))) { $user = $short; } } return ($user); } # unixgroup_name(domainname, username) # Returns a Unix group name for some domain, or undef if none can be found sub unixgroup_name { my ($dname, $user) = @_; my ($dname_, $config_longname, $try1, $group) = ($dname, $config{'longname'}); if ($user && $config{'groupsame'}) { # Same as username where possible if (!defined(getgrnam($user))) { return ($user); } return (undef, $user, $user); } # Extract random group based on the user pattern if ($config_longname && $config_longname !~ /^[0-9]$/) { $group = &generate_random_available_user($config_longname); } elsif ($config_longname == 2) { $group = &compute_prefix($dname, undef, undef, 1); } # Use one based on actual domain name else { $dname =~ s/^xn(-+)//; $dname = &remove_numeric_prefix($dname); $dname =~ /^([^\.]+)/; ($try1, $group) = ($1, $1); if (defined(getgrnam($try1)) || $config{'longname'}) { $group = &remove_numeric_prefix($dname_); $try2 = $group; if (defined(getpwnam($try))) { return (undef, $try1, $try2); } } } return ($group); } # virtual_server_clashes(&dom, [&features-to-check], [field-to-check], # [replication-mode]) # Returns a clash error message if any were found for some new domain sub virtual_server_clashes { local ($dom, $check, $field, $repl) = @_; my $f; foreach $f (@features) { next if ($dom->{'parent'} && $f eq "webmin"); next if ($dom->{'parent'} && $f eq "unix"); if ($dom->{$f} && (!$check || $check->{$f})) { local $cfunc = "check_${f}_clash"; local $err = defined(&$cfunc) ? &$cfunc($dom, $field, $repl) : undef; if ($err) { if ($err eq '1') { # Use a built-in error $err = &text('setup_e'.$f, $dom->{'dom'}, $dom->{'db'}, $dom->{'user'}, $dom->{'group'}); } return $err; } } } foreach $f (&list_feature_plugins()) { if ($dom->{$f} && (!$check || $check->{$f})) { local $cerr = &plugin_call($f, "feature_clash", $dom, $field); return $cerr if ($cerr); } } return undef; } # virtual_server_depends(&dom, [feature], [&old-dom]) # Returns an error message if any of the features in the domain depend on # missing features sub virtual_server_depends { local ($d, $feat, $oldd) = @_; local $f; # Check features that are enabled foreach $f (grep { $d->{$_} } @features) { next if ($feat && $f ne $feat); local $dfunc = "check_depends_$f"; if (defined(&$dfunc)) { # Call dependecy function local $derr = &$dfunc($d, $oldd); return $derr if ($derr); } # Check fixed dependency list local $fd; foreach $fd (@{$feature_depends{$f}}) { return &text('setup_edep'.$f) if (!$d->{$fd}); } } # Check plugins that are enabled foreach $f (grep { $d->{$_} } &list_feature_plugins()) { next if ($feat && $f ne $feat); local $derr = &plugin_call($f, "feature_depends", $d, $oldd); return $derr if ($derr); } # Check features that are NOT enabled, to ensure that any needed features are # not missing. ie. mysql missing from parent but on children foreach $f (grep { !$d->{$_} } @features) { next if ($feat && $f ne $feat); local $dfunc = "check_anti_depends_$f"; if (defined(&$dfunc)) { # Call dependecy function local $derr = &$dfunc($d); return $derr if ($derr); } } return undef; } # virtual_server_limits(&domain, [&old-domain]) # Checks if the addition of a feature would exceed any limit for the user sub virtual_server_limits { local ($d, $oldd) = @_; local ($left, $reason, $max); local $tmpl = &get_template($d->{'template'}); # Check database limit local $newdbs = 0; $newdbs++ if ($d->{'mysql'} && (!$oldd || !$oldd->{'mysql'}) && $tmpl->{'mysql_mkdb'} && !$d->{'no_mysql_db'}); $newdbs++ if ($d->{'postgres'} && (!$oldd || !$oldd->{'postgres'}) && $tmpl->{'mysql_mkdb'}); if ($newdbs) { ($left, $reason, $max) = &count_feature("dbs"); if ($left == 0 || $newdbs == 2 && $left == 1) { return &text('databases_noadd'.$reason, $max); } } # Check quota limits ($left, $reason, $max) = &count_feature("quota"); if (!$d->{'parent'} && $d->{'quota'} eq "" && $left != -1) { # Unlimited quota chosen, but not allowed! return &text('setup_noquotainf'.$reason, "a_show($max, "home")); } local $newquota = $d->{'quota'} - ($oldd ? $oldd->{'quota'} : 0); if ($left != -1 && $left-$newquota < 0) { return &text('setup_noquotaadd'.$reason, "a_show($left+($oldd ? $oldd->{'quota'} : 0), "home", 2)); } # Check bandwidth limits ($left, $reason, $max) = &count_feature("bw"); if (!$d->{'parent'} && $d->{'bw_limit'} eq "" && $left != -1) { # Unlimited bandwidth chosen, but not allowed! return &text('setup_nobwinf'.$reason, &nice_size($max)); } local $newquota = $d->{'bw_limit'} - ($oldd ? $oldd->{'bw_limit'} : 0); if ($left != -1 && $left-$newquota < 0) { return &text('setup_nobwadd'.$reason, &nice_size($left+($oldd ? $oldd->{'bw_limit'} : 0))); } # Check domains limit if (!$oldd) { ($left, $reason, $max) = &count_domains( $d->{'alias'} ? 'aliasdoms' : $d->{'parent'} ? 'realdoms' : 'topdoms'); if ($left == 0) { return &text('index_noadd'.$reason, $max); } } return undef; } # virtual_server_warnings(&domain, [&old-domain], [replication-mode]) # Returns a list of warning messages related to the creation or modification # of some virtual server. sub virtual_server_warnings { local ($d, $oldd, $repl) = @_; local @rv; # Check core features foreach my $f (grep { $d->{$_} } @features) { local $wfunc = "check_warnings_$f"; if (defined(&$wfunc)) { local $err = &$wfunc($d, $oldd, $repl); push(@rv, $err) if ($err); } } # Check plugins that are enabled foreach $f (grep { $d->{$_} } &list_feature_plugins()) { local $err = &plugin_call($f, "feature_warnings", $d, $oldd); push(@rv, $err) if ($err); } return @rv; } # show_virtual_server_warnings(&domain, [&old-domain], &in) # Checks if there are any warnings for the creation or modification of some # domain, and if so shows a confirmation form - unless $in{'confirm_warnings'} # is set. Returns 1 if the warning form was shown, 0 if not. sub show_virtual_server_warnings { local ($d, $oldd, $in) = @_; return 0 if ($in->{'confirm_warnings'}); local @warns = &virtual_server_warnings($d, $oldd); return 0 if (!@warns); my @hids; foreach my $i (keys %$in) { foreach my $v (split(/\0/, $in->{$i})) { push(@hids, [ $i, $v ]); } } print &ui_confirmation_form( $script_name, ($oldd ? $text{'setup_warnings2'} : $text{'setup_warnings1'})."

\n". join("
\n", @warns)."

\n". $text{'setup_warnrusure'}, \@hids, [ [ 'confirm_warnings', $oldd ? $text{'setup_warnok2'} : $text{'setup_warnok1'} ] ], ); return 1; } # domain_name_clash(name) # Returns 1 if some domain name is already in use sub domain_name_clash { my ($domain) = @_; foreach my $d (&list_domains()) { return $d if (lc($d->{'dom'}) eq lc($domain)); } return 0; } # create_virtual_server(&domain, [&parent-domain], [parent-user], [no-scripts], # [no-post-actions], [password], [content]) # Given a complete domain object, setup all it's features sub create_virtual_server { local ($dom, $parentdom, $parentuser, $noscripts, $nopost, $pass, $content) = @_; # Sanity checks $dom->{'ip'} || return $text{'setup_edefip'}; # Run the before command &set_domain_envs($dom, "CREATE_DOMAIN"); local $merr = &making_changes(); &reset_domain_envs($dom); return &text('setup_emaking', "$merr") if (defined($merr)); # Get ready for hosting a subdomain if ($dom->{'parent'}) { &setup_for_subdomain($parentdom, $parentuser, $dom); } # Work out if this server is being created on the primary default IP address if ($dom->{'ip'} eq &get_default_ip() && !$dom->{'virt'}) { $dom->{'defip'} = 1; } # Work out the auto-alias domain name local $tmpl = &get_template($dom->{'template'}); local $aliasname; if ($tmpl->{'domalias'} ne 'none' && $tmpl->{'domalias'} && !$dom->{'alias'}) { local $aliasprefix = $dom->{'dom'}; if ($tmpl->{'domalias_type'} eq '1') { # Shorten to first part of domain $aliasprefix =~ s/\..*$//; } elsif ($tmpl->{'domalias_type'} ne '0') { # Use template $aliasprefix = &substitute_domain_template( $tmpl->{'domalias_type'}, $dom); } my $count; while(1) { $aliasname = $aliasprefix.$count.".".$tmpl->{'domalias'}; last if (!&get_domain_by("dom", $aliasname)); $count++; } $dom->{'autoalias'} = $aliasname; } # Check if only hashed passwords are stored, and if so generate a random # MySQL password now. This has to be done before any features are setup # so that mysql_pass is available to all features. if ($dom->{'hashpass'} && !$dom->{'parent'} && !$dom->{'mysql_pass'}) { # Hashed passwords in use $dom->{'mysql_pass'} = &random_password(); delete($dom->{'mysql_enc_pass'}); } elsif ($tmpl->{'mysql_nopass'} == 2 && !$dom->{'parent'} && !$dom->{'mysql_pass'}) { # Using random password by default $dom->{'mysql_pass'} = &random_password(); delete($dom->{'mysql_enc_pass'}); } # Same for PostgreSQL if ($dom->{'hashpass'} && !$dom->{'parent'} && !$dom->{'postgres_pass'}) { # Hashed passwords in use $dom->{'postgres_pass'} = &random_password(); delete($dom->{'postgres_enc_pass'}); } elsif ($tmpl->{'postgres_nopass'} == 2 && !$dom->{'parent'} && !$dom->{'postgres_pass'}) { # Using random password by default $dom->{'postgres_pass'} = &random_password(); delete($dom->{'postgres_enc_pass'}); } # MySQL module comes from parent always if ($parentdom) { $dom->{'mysql_module'} = $parentdom->{'mysql_module'}; $dom->{'postgres_module'} = $parentdom->{'postgres_module'}; } # Was this originally the default domain? if (!defined($dom->{'defaultdomain'})) { $dom->{'defaultdomain'} = 1, $dom->{'defaulthostdomain'} = 1 if ($dom->{'dom'} eq $config{'defaultdomain_name'}); } # Save domain details before enabling features &$first_print($text{'setup_save'}); &save_domain($dom, 1); &$second_print($text{'setup_done'}); # Set up all the selected features (except Webmin login) my $f; local @dof = grep { $_ ne "webmin" } @features; local $p = &domain_has_website($dom); local $s = &domain_has_ssl($dom); $dom->{'creating'} = 1; # Tell features that they are being called for creation foreach $f (@dof) { my $err; if ($f eq 'web' && $p && $p ne 'web') { # Web feature is provided by a plugin .. call it now $err = &call_feature_setup($p, $dom); } elsif ($f eq 'ssl' && $s && $s ne 'ssl') { # SSL feature is provided by a plugin .. call it now $err = &call_feature_setup($s, $dom); } elsif ($dom->{$f}) { $err = &call_feature_setup($f, $dom); } return $err if ($err); } # Set up all the selected plugins foreach $f (&list_feature_plugins()) { if ($dom->{$f} && $f ne $p && $f ne $s) { my $err = &call_feature_setup($f, $dom); return $err if ($err); } } # Setup Webmin login last, once all plugins are done if ($dom->{'webmin'}) { local $sfunc = "setup_webmin"; local ($ok, $fok) = &try_function($f, $sfunc, $dom); if (!$ok || !$fok) { $dom->{$f} = 0; } } # Add virtual IP address, if needed if ($dom->{'virt'}) { local ($ok, $fok) = &try_function("virt", "setup_virt", $dom); if (!$ok || !$fok) { $dom->{'virt'} = 0; } } if ($dom->{'virt6'}) { local ($ok, $fok) = &try_function("virt6", "setup_virt6", $dom); if (!$ok || !$fok) { $dom->{'virt6'} = 0; } } delete($dom->{'creating'}); # Save domain details again at the end &$first_print($text{'setup_save'}); &save_domain($dom); &$second_print($text{'setup_done'}); # If mail client autoconfig is enabled globally, set it up for # this domain if ($config{'mail_autoconfig'} && $dom->{'mail'} && &domain_has_website($dom) && !$dom->{'alias'}) { &enable_email_autoconfig($dom); } if (!$nopost) { &run_post_actions(); } if (!$dom->{'nocreationmail'}) { # Notify the owner via email &send_domain_email($dom, undef, $pass); } # Update the parent domain Webmin user &refresh_webmin_user($dom); if ($remote_user) { # Add to this user's list of domains if needed local %access = &get_module_acl(); if (!&can_edit_domain($dom)) { $access{'domains'} = join(" ", split(/\s+/, $access{'domains'}), $dom->{'id'}); &save_module_acl(\%access); } } # Update any secondary groups that might contain the domain owner if (!$dom->{'parent'}) { &update_secondary_groups($dom); } # Create an automatic alias domain, if specified in template if ($aliasname && $aliasname ne $dom->{'dom'}) { &$first_print(&text('setup_domalias', $aliasname)); if ($aliasname !~ /^[a-z0-9\.\_\-]+$/i) { &$second_print($text{'setup_domaliasbad'}); } else { &$indent_print(); local $parentdom = $dom->{'parent'} ? &get_domain($dom->{'parent'}) : $dom; local %alias = ( 'id', &domain_id(), 'dom', $aliasname, 'user', $dom->{'user'}, 'group', $dom->{'group'}, 'prefix', $dom->{'prefix'}, 'ugroup', $dom->{'ugroup'}, 'pass', $dom->{'pass'}, 'alias', $dom->{'id'}, 'uid', $dom->{'uid'}, 'gid', $dom->{'gid'}, 'ugid', $dom->{'ugid'}, 'owner', "Automatic alias of $dom->{'dom'}", 'email', $dom->{'email'}, 'nocreationmail', 1, 'name', 1, 'ip', $dom->{'ip'}, 'dns_ip', $dom->{'dns_ip'}, 'virt', 0, 'source', $dom->{'source'}, 'parent', $parentdom->{'id'}, 'template', $dom->{'template'}, 'plan', $dom->{'plan'}, 'reseller', $dom->{'reseller'}, ); # Alias gets all features of domain, except for directory # if it isn't needed foreach my $f (@alias_features) { next if ($f eq 'dir' && $config{$f} == 3 && $tmpl->{'aliascopy'}); $alias{$f} = $dom->{$f}; } my $web = &domain_has_website($dom); if ($web) { # Website may use Nginx $alias{$web} = 1; } $alias{'home'} = &server_home_directory(\%alias, $parentdom); &generate_domain_password_hashes(\%dom, 1); &set_provision_features(\%alias); &complete_domain(\%alias); &create_virtual_server(\%alias, $parentdom, $parentdom->{'user'}); &$outdent_print(); &$second_print($text{'setup_done'}); } } # Install any scripts specified in the template local @scripts = &get_template_scripts($tmpl); if (@scripts && !$dom->{'alias'} && !$noscripts && &domain_has_website($dom) && $dom->{'dir'} && !$dom->{'nocreationscripts'}) { &$first_print($text{'setup_scripts'}); &$indent_print(); foreach my $sinfo (@scripts) { # Work out install options local ($name, $ver) = split(/\s+/, $sinfo->{'name'}); local $script = &get_script($name); if (!$script) { &$first_print(&text('setup_scriptgone', $name)); next; } # Work out actual version local @allvers = @{$script->{'install_versions'}}; if ($ver eq "latest") { $ver = $allvers[0]; } &$first_print(&text('setup_scriptinstall', $script->{'name'}, $ver)); local $opts = { 'path' => &substitute_scriptname_template( $sinfo->{'path'}, $d) }; if ($sinfo->{'sopts'}) { $opts->{$_->[0]} = $_->[1] for map { [split(/=/, $_)] } split(/,/, $sinfo->{'sopts'}); } local $perr = &validate_script_path($opts, $script, $dom); if ($perr) { &$second_print($perr); next; } # Install needed packages &setup_script_packages($script, $d, $ver); # Check PHP version local ($phpver, $phperr); if (&indexof("php", @{$script->{'uses'}}) >= 0) { ($phpver, $phperr) = &setup_php_version( $dom, $script, $ver, $opts->{'path'}); if (!$phpver) { &$second_print($phperr); next; } $opts->{'phpver'} = $phpver; } # Check Python version local ($pyver, $pyerr); if (&indexof("python", @{$script->{'uses'}}) >= 0) { ($pyver, $pyerr) = &setup_python_version( $dom, $script, $ver, $opts->{'path'}); if ($pyerr) { &$second_print($pyerr); next; } $opts->{'pyver'} = $pyver; } # Check dependencies local $derr = &check_script_depends($script, $dom, $ver, $sinfo, $phpver); if ($derr) { &$second_print(&text('setup_scriptdeps', $derr)); next; } # Install needed PHP modules &setup_script_requirements($d, $script, $ver, $phpver, $opts) || next; # Find the database, if requested if ($sinfo->{'db'}) { local $dbname = &substitute_domain_template( $sinfo->{'db'}, $dom); if (!$dom->{$sinfo->{'dbtype'}}) { # DB type isn't enabled for this domain &$second_print(&text('setup_scriptnodb', $text{'databases_'.$sinfo->{'dbtype'}})); next; } $opts->{'db'} = $sinfo->{'dbtype'}."_".$dbname; local @dbs = &domain_databases($dom); local ($db) = grep { $_->{'type'} eq $sinfo->{'dbtype'} && $_->{'name'} eq $dbname } @dbs; if (!$db) { # DB doesn't exist yet .. create it $cfunc = "check_".$sinfo->{'dbtype'}. "_database_clash"; if (&$cfunc($dom, $dbname)) { &$second_print( &text('setup_scriptclash', $dbname)); next; } $crfunc = "create_".$sinfo->{'dbtype'}. "_database"; &$indent_print(); &$crfunc($dom, $dbname); &$outdent_print(); } } # Check options if (defined(&{$script->{'check_func'}})) { my $oerr = &{$script->{'check_func'}}($dom, $ver,$opts); if ($oerr) { &$second_print(&text('setup_scriptopts',$oerr)); next; } } # Fetch needed files local %gotfiles; local $ferr = &fetch_script_files($dom, $ver, $opts, undef, \%gotfiles, 1); if ($derr) { &$second_print(&text('setup_scriptfetch', $ferr)); next; } # Disable PHP timeouts local $t = &disable_script_php_timeout($dom); # Call the install function local $dompass = $dom->{'pass'} || &random_password(8); local ($ok, $msg, $desc, $url, $suser, $spass) = &{$script->{'install_func'}}( $dom, $ver, $opts, \%gotfiles, undef, $dom->{'user'}, $dompass); if ($ok) { &$second_print(&text($ok < 0 ? 'setup_scriptpartial' : 'setup_scriptdone', $msg)); # Record script install in domain &add_domain_script($dom, $name, $ver, $opts, $desc, $url, $suser, $spass, $ok < 0 ? $msg : undef); } else { &$second_print(&text('setup_scriptfailed', $msg)); } # Re-enable script PHP timeout &enable_script_php_timeout($dom, $t); } &$outdent_print(); &$second_print($text{'setup_done'}); &save_domain($dom); } # Create any redirects or aliases specified in the template my @redirs = map { [ split(/\s+/, $_, 3) ] } split(/\t+/, $tmpl->{'web_redirects'}); if (@redirs && !$dom->{'alias'} && &domain_has_website($dom) && !$noscripts && !$dom->{'nocreationscripts'}) { &$first_print($text{'setup_redirects'}); &$indent_print(); foreach my $r (@redirs) { my %protos = map { $_, 1 } split(/,/, $r->[2]); next if ($protos{'https'} && !$protos{'http'} && !&domain_has_ssl($dom)); my $path = &substitute_domain_template($r->[0], $dom); my $dest = &substitute_domain_template($r->[1], $dom); &$first_print(&text('setup_redirecting', $path, $dest)); if ($dest !~ /^(http|https):/) { $dest = &public_html_dir($dom).$dest; } my $redirect = { 'path' => $path, 'dest' => $dest, 'alias' => $dest =~ /^(http|https):/ ? 0 : 1, 'regexp' => 0, 'http' => $protos{'http'}, 'https' => $protos{'https'}, }; $redirect = &add_wellknown_redirect($redirect); my $err = &create_redirect($dom, $redirect); if ($err) { &$second_print(&text('setup_redirecterr', $err)); } else { &$second_print($text{'setup_redirected'}); } } &$outdent_print(); &$second_print($text{'setup_done'}); } # If this was an alias domain, notify all features in the original domain. This # is useful for things like awstats, which need to add the alias domain to those # supported for the main site. if ($dom->{'alias'}) { local $aliasdom = &get_domain($dom->{'alias'}); foreach my $f (@features) { local $safunc = "setup_alias_$f"; if ($aliasdom->{$f} && defined(&$safunc)) { &try_function($f, $safunc, $aliasdom, $dom); } } foreach $f (&list_feature_plugins()) { if ($aliasdom->{$f} && &plugin_defined($f, "feature_setup_alias")) { local $main::error_must_die = 1; eval { &plugin_call($f, "feature_setup_alias", $aliasdom, $dom) }; if ($@) { &$second_print(&text('setup_aliasfailure', &plugin_call($f, "feature_name"),"$@")); } } } } # Refresh Unix group membership for reseller if ($dom->{'reseller'} && defined(&update_reseller_unix_groups)) { local $rinfo = &get_reseller($dom->{'reseller'}); if ($rinfo) { &update_reseller_unix_groups($rinfo, 1); } } # If an SSL cert wasn't generated because SSL wasn't enabled, do one now my $always_ssl = defined($dom->{'always_ssl'}) ? $dom->{'always_ssl'} : $config{'always_ssl'}; my $generated = 0; if (!&domain_has_ssl($dom) && $always_ssl && !$dom->{'alias'}) { $generated = &generate_default_certificate($dom) ? 1 : 0; } # Attempt to request a let's encrypt cert. This has to be done after the # initial setup and when Apache has been restarted, so that it can serve the # new website. if (!defined($dom->{'auto_letsencrypt'})) { $dom->{'auto_letsencrypt'} = $config{'auto_letsencrypt'}; if ($dom->{'dns'}) { $dom->{'letsencrypt_dwild'} = $config{'letsencrypt_wild'}; } } if ($dom->{'auto_letsencrypt'} && &domain_has_website($dom) && !$dom->{'disabled'} && !$dom->{'alias'} && !$dom->{'ssl_same'} && &under_public_dns_suffix($dom->{'dom'})) { my $info = &cert_info($dom); if ($info->{'self'}) { if ($nopost) { # Need to run any pending Apache restart &run_post_actions(\&restart_apache); } if (&create_initial_letsencrypt_cert( $dom, $dom->{'auto_letsencrypt'} == 2 ? 0 : 1, $config{'err_letsencrypt'})) { # Let's encrypt cert request worked $generated = 2; } } } # Update service certs and DANE DNS records # if a new Let's Encrypt cert was generated if ($generated == 2) { &enable_domain_service_ssl_certs($dom); &sync_domain_tlsa_records($dom); } # For a new alias domain, if the target has a Let's Encrypt cert for all # possible hostnames, re-request it to include the alias if ($dom->{'alias'} && &domain_has_website($dom)) { local $target = &get_domain($dom->{'alias'}); local $tinfo; if ($target && &domain_has_website($target) && &domain_has_ssl_cert($target) && !$target->{'letsencrypt_dname'} && ($tinfo = &cert_info($target)) && &is_letsencrypt_cert($tinfo) && !&check_domain_certificate($dom->{'dom'}, $tinfo)) { &$first_print(&text('setup_letsaliases', &show_domain_name($target), &show_domain_name($dom))); my ($ok, $err, $dnames) = &renew_letsencrypt_cert($target); if ($ok) { &$second_print($text{'setup_done'}); } else { &$second_print(&text('setup_eletsaliases', $err)); } } } &save_domain($dom); # Put the user in a jail if possible if ($dom->{'jail'} && !&check_jailkit_support()) { &$first_print($text{'setup_jail'}); my $err = &enable_domain_jailkit($dom); if ($err) { &$second_print(&text('setup_ejail', $err)); } else { &$second_print(&text('setup_jailed', &domain_jailkit_dir($dom))); } &save_domain($dom); } if (!$dom->{'alias'} && &domain_has_website($dom) && defined($content)) { # Just create virtualmin default index.html &$first_print($text{'setup_contenting'}); eval { local $main::error_must_die = 1; &create_index_content($dom, $content, 0); }; if ($@) { &$second_print(&text('setup_econtenting', "$@")); } else { &$second_print($text{'setup_done'}); } } # Run the after creation command if (!$nopost) { &run_post_actions(); } &set_domain_envs($dom, "CREATE_DOMAIN"); local $merr = &made_changes(); &$second_print(&text('setup_emade', "$merr")) if (defined($merr)); &reset_domain_envs($dom); return wantarray ? ($dom) : undef; } # create_initial_letsencrypt_cert(&domain, [validate-first], [show-errors]) # Create the initial default let's encrypt cert for a domain which has just # had SSL enabled. May print stuff. sub create_initial_letsencrypt_cert { local ($d, $valid, $showerrors) = @_; &foreign_require("webmin"); my @dnames; if ($d->{'letsencrypt_dname'}) { @dnames = split(/\s+/, $d->{'letsencrypt_dname'}); } else { @dnames = &get_hostnames_for_ssl($d); } push(@dnames, "*.".$d->{'dom'}) if ($d->{'letsencrypt_dwild'}); &$first_print($text{'letsencrypt_doing3'}); if ($valid) { my $vcheck = ['web']; foreach my $dn (@dnames) { $vcheck = ['dns'] if ($dn =~ /\*/); } my @errs = &validate_letsencrypt_config($d, $vcheck); if (@errs) { if ($showerrors) { &$second_print(&text('letsencrypt_evalid', &html_escape(join(", ", @errs)))); } else { &$second_print($text{'letsencrypt_doing3failed'}); } return 0; } if (defined(&check_domain_connectivity)) { @errs = &check_domain_connectivity( $d, { 'mail' => 1, 'ssl' => 1 }); if (@errs) { if ($showerrors) { &$second_print(&text('letsencrypt_econnect', &html_escape(join(", ", map { $_->{'desc'} } @errs)))); } else { &$second_print($text{'letsencrypt_doing3failed'}); } return 0; } } } my $phd = &public_html_dir($d); my $before = &before_letsencrypt_website($d); my @beforecerts = &get_all_domain_service_ssl_certs($d); my ($ok, $cert, $key, $chain) = &request_domain_letsencrypt_cert( $d, \@dnames); &after_letsencrypt_website($d, $before); if (!$ok) { if ($showerrors) { &$second_print(&text('letsencrypt_failed', $cert)); } else { &$second_print($text{'letsencrypt_doing3failed'}); } return 0; } else { &obtain_lock_ssl($d); &install_letsencrypt_cert($d, $cert, $key, $chain); $d->{'letsencrypt_dname'} = ''; $d->{'letsencrypt_dwild'} = 0; $d->{'letsencrypt_last'} = time(); $d->{'letsencrypt_renew'} = 1 if ($d->{'letsencrypt_renew'} eq ''); # Inject initial SSL expiry to avoid wrong "until expiry" &refresh_ssl_cert_expiry($d); &save_domain($d); # Update other services using the cert &update_all_domain_service_ssl_certs($d, \@beforecerts); &break_invalid_ssl_linkages($d); &sync_domain_tlsa_records($d); &release_lock_ssl($d); &$second_print(&text('letsencrypt_doing3ok', join(", ", map { "$_" } @dnames))); return 1; } } # call_feature_setup(feature, &domain, [args]) # Calls the setup function for some feature or plugin. May print stuff. # Returns an error message on a vital feature failure, sets flag to 0 for # a non-vital failure. sub call_feature_setup { local ($f, $dom, @args) = @_; local %vital = map { $_, 1 } @vital_features; if (&indexof($f, @features) >= 0) { # Core feature local $sfunc = "setup_$f"; if ($vital{$f}) { # Failure of this feature should halt the entire setup if (!&$sfunc($dom, @args)) { return &text('setup_evital', $text{'feature_'.$f}); } } else { # Failure can be ignored local ($ok, $fok) = &try_function($f, $sfunc, $dom); if (!$ok || !$fok) { $dom->{$f} = 0; } } } else { # Plugin feature local $main::error_must_die = 1; eval { &plugin_call($f, "feature_setup", $dom, @args) }; if ($@) { local $err = $@; &$second_print(&text('setup_failure', &plugin_call($f, "feature_name"), $err)); $dom->{$f} = 0; } } return undef; } # delete_virtual_server(&domain, only-disconnect, no-post, preserve-remote) # Deletes a Virtualmin domain and all sub-domains and aliases. Returns undef # on succes, or an error message on failure. sub delete_virtual_server { local ($d, $only, $nopost, $preserve) = @_; # Get domain details local @subs = &get_domain_by("parent", $d->{'id'}); local @aliasdoms = &get_domain_by("alias", $d->{'id'}); local @aliasdoms = grep { $_->{'parent'} ne $d->{'id'} } @aliasdoms; local @alldoms = (@aliasdoms, @subs, $d); # Check for DNS dependencies foreach my $dd (@alldoms) { foreach my $du (&get_domain_by("dns_subof", $dd->{'id'})) { if (&indexof($du, @alldoms) < 0) { # Domain is being used as a DNS parent, and user isn't # being deleted return &text('delete_ednssubof', &show_domain_name($dd), &show_domain_name($du)); } } } # Delete any jail if (!&check_jailkit_support() && !$d->{'parent'}) { &disable_domain_jailkit($d, 1); } # Go ahead and delete this domain and all sub-domains .. &obtain_lock_mail(); &obtain_lock_unix(); foreach my $dd (@alldoms) { if ($dd ne $d) { # Show domain name &$first_print(&text('delete_dom', &show_domain_name($dd))); &$indent_print(); } # What is shared for this domain? my %remote; if ($preserve) { %remote = map { $_, 1 } &list_remote_domain_features($dd); } # Run the before command &set_domain_envs($dd, "DELETE_DOMAIN"); local $merr = &making_changes(); &reset_domain_envs($dd); return &text('delete_emaking', "$merr") if (defined($merr)); if (!$only) { local @users = $dd->{'alias'} && !$dd->{'aliasmail'} || !$dd->{'group'} ? ( ) : &list_domain_users($dd, 1, 0, 0, 0, 1); local @aliases = &list_domain_aliases($dd); # Stop any processes belonging to installed scripts, such # as Ruby on Rails mongrels local $done_stopscripts; if (!$dd->{'alias'} && defined(&list_domain_scripts)) { foreach my $sinfo (&list_domain_scripts($dd)) { local $script = &get_script($sinfo->{'name'}); local $sfunc = $script->{'stop_func'}; if (defined(&$sfunc)) { &$first_print( $text{'delete_stopscripts'}) if (!$done_stopscripts++); &$sfunc($dd, $sinfo); } } } if ($done_stopscripts) { &$second_print($text{'setup_done'}); } if (@users) { # Delete mail users and their mail files &$first_print($text{'delete_users'}); foreach my $u (@users) { if (!$u->{'nomailfile'} && !$remote{'dir'}) { &delete_mail_file($u); } $u->{'dbs'} = [ grep { !$remote{$_->{'type'}} } @{$u->{'dbs'}} ]; &delete_user($u, $dd); if (!$u->{'nocreatehome'} && !$remote{'dir'}) { &delete_user_home($u, $d); } } &$second_print($text{'setup_done'}); } # Delete all virtusers if (!$dd->{'aliascopy'} && !$remote{'mail'}) { &$first_print($text{'delete_aliases'}); foreach my $v (&list_virtusers()) { if ($v->{'from'} =~ /\@(\S+)$/ && $1 eq $dd->{'dom'}) { &delete_virtuser($v); } } &sync_alias_virtuals($dd); &$second_print($text{'setup_done'}); } # Take down IP if ($dd->{'virt'}) { &try_function("virt", "delete_virt", $dd); } if ($dd->{'virt6'}) { &try_function("virt6", "delete_virt6", $dd); } } if (!$dd->{'parent'}) { # Delete any extra admins foreach my $admin (&list_extra_admins($dd)) { &delete_extra_admin($admin); } } # If this is an alias domain, notify the target that it is being # deleted. This allows things like extra awstats symlinks to be removed $dd->{'deleting'} = 1; # so that features know about delete if (!$only && $dd->{'alias'}) { local $aliasdom = &get_domain($dd->{'alias'}); foreach my $f (@features) { local $dafunc = "delete_alias_$f"; if ($aliasdom->{$f} && defined(&$dafunc)) { &try_function($f, $dafunc, $aliasdom, $dd); } } foreach $f (&list_feature_plugins()) { if ($aliasdom->{$f} && &plugin_defined($f, "feature_delete_alias")) { local $main::error_must_die = 1; eval { &plugin_call($f, "feature_delete_alias", $aliasdom, $dd) }; if ($@) { &$second_print( &text('delete_aliasfailure', &plugin_call($f, "feature_name"), "$@")); } } } } # Remove SSL cert from Dovecot, Postfix, etc &disable_domain_service_ssl_certs($dd); # If this domain had it's own lets encrypt cert, delete any leftover # files for it under /etc/letsencrypt &foreign_require("webmin"); if ($dd->{'letsencrypt_last'} && !$dd->{'ssl_same'} && defined(&webmin::cleanup_letsencrypt_files)) { &webmin::cleanup_letsencrypt_files($dd->{'dom'}); } # Delete all features (or just 'webmin' if un-importing). Any # failures are ignored! my $f; local $p = &domain_has_website($dd); local @of; if ($only) { @of = ( "webmin" ); } else { @of = reverse(&list_ordered_features($dd, 1)); } foreach $f (@of) { if (($config{$f} || &indexof($f, @plugins) >= 0) && $dd->{$f} || $f eq 'unix') { # Delete core feature local @args = ( $preserve ); if ($f eq "mail") { # Don't delete mail aliases, because we have # already done so above push(@args, 1); } &call_feature_delete($f, $dd, @args); } if (&indexof($f, @plugins) >= 0) { &plugin_call($f, "feature_always_delete", $dd); } } # Delete any FPM or FCGIwrap servers, just in case they # were disassociated &delete_php_fpm_pool($d); if ($d->{'fcgiwrap_port'}) { &delete_fcgiwrap_server($d); } # Delete SSL key files outside the home dir if (!$dd->{'ssl_same'}) { foreach my $k ('ssl_cert', 'ssl_key', 'ssl_chain', 'ssl_combined', 'ssl_everything') { if ($dd->{$k} && !&is_under_directory($dd->{'home'}, $dd->{$k}) && -f $dd->{$k}) { &unlink_logged($dd->{$k}); } } foreach my $dir (&ssl_certificate_directories($dd, 1)) { if (!&is_under_directory($dd->{'home'}, $dir) && -d $dir && $dir =~ /\/[^\/]*(\Q$dd->{'dom'}\E|\Q$dd->{'id'}\E)[^\/]*$/ && &is_empty_directory($dir)) { &unlink_logged($dir); } } } # Delete domain file &$first_print(&text('delete_domain', &show_domain_name($dd))); &delete_domain($dd); &$second_print($text{'setup_done'}); # Update the parent domain Webmin user, so that his ACL # is refreshed (and any resellers) &refresh_webmin_user($dd); # Call post script &set_domain_envs($dd, "DELETE_DOMAIN"); local $merr = &made_changes(); &reset_domain_envs($dd); &$second_print(&text('setup_emade', "$merr")) if (defined($merr)); if ($dd ne $d) { &$outdent_print(); &$second_print($text{'setup_done'}); } } &release_lock_mail(); &release_lock_unix(); # Run the after deletion command if (!$nopost) { &run_post_actions(); } return undef; } # call_feature_delete(feature, &domain, arg, arg, ...) # Calls the core or plugin-specific function to delete a feature. May print # stuff. sub call_feature_delete { local ($f, $dom, @args) = @_; if (&indexof($f, @features) >= 0) { # Call core delete function local $dfunc = "delete_$f"; local ($ok, $fok) = &try_function($f, $dfunc, $dom, @args); if (!$ok || !$fok) { $dom->{$f} = 1; } } else { # Call plugin delete function local $main::error_must_die = 1; eval { &plugin_call($f, "feature_delete", $dom, @args) }; if ($@) { local $err = $@; &$second_print(&text('delete_failure', &plugin_call($f, "feature_name"), $err)); } } } # disable_virtual_server(&domain, [reason-code], [reason-why], [&only-features]) # Disables all features of one virtual server. Returns undef on success, or # an error message on failure. sub disable_virtual_server { my ($d, $reason, $why, $only) = @_; # Work out what can be disabled my @disable = &get_disable_features($d); if ($only) { @disable = grep { &indexof($_, @$only) >= 0 } @disable; @disable || return "None of the features to disable exist on this ". "virtual server"; } # Disable it my %disable = map { $_, 1 } @disable; $d->{'disabled_reason'} = $reason; $d->{'disabled_why'} = $why; $d->{'disabled_time'} = time(); # Run the before command &set_domain_envs($d, "DISABLE_DOMAIN"); my $merr = &making_changes(); &reset_domain_envs($d); return &text('disable_emaking', "".&html_escape($merr)."") if (defined($merr)); # Disable all configured features my @disabled; foreach my $f (@features) { if ($d->{$f} && $disable{$f}) { my $dfunc = "disable_$f"; local ($ok, $fok) = &try_function($f, $dfunc, $d); if ($ok && $fok) { push(@disabled, $f); } } } foreach my $f (&list_feature_plugins()) { if ($d->{$f} && $disable{$f}) { &plugin_call($f, "feature_disable", $d); push(@disabled, $f); } } # Disable extra admins &update_extra_webmin($d, 1); # Save new domain details &$first_print($text{'save_domain'}); $d->{'disabled'} = join(",", @disabled); &save_domain($d); &$second_print($text{'setup_done'}); # Run the after command &set_domain_envs($d, "DISABLE_DOMAIN"); my $merr = &made_changes(); &$second_print(&text('setup_emade', "$merr")) if (defined($merr)); &reset_domain_envs($d); return undef; } # enable_virtual_server(&domain) # Enables all disabled features of one virtual server. Returns undef on # success, or an error message on failure. sub enable_virtual_server { my ($d) = @_; # Work out what can be enabled my @enable = &get_enable_features($d); # Go ahead and do it my %enable = map { $_, 1 } @enable; delete($d->{'disabled_reason'}); delete($d->{'disabled_why'}); # Run the before command &set_domain_envs($d, "ENABLE_DOMAIN"); my $merr = &making_changes(); &reset_domain_envs($d); return &text('enable_emaking', "$merr") if (defined($merr)); # Enable all disabled features foreach my $f (@features) { if ($d->{$f} && $enable{$f}) { my $efunc = "enable_$f"; &try_function($f, $efunc, $d); } } foreach my $f (&list_feature_plugins()) { if ($d->{$f} && $enable{$f}) { &plugin_call($f, "feature_enable", $d); } } # Enable extra admins &update_extra_webmin($d, 0); # Save new domain details &$first_print($text{'save_domain'}); delete($d->{'disabled'}); &save_domain($d); &$second_print($text{'setup_done'}); # Run the after command &set_domain_envs($d, "ENABLE_DOMAIN"); my $merr = &made_changes(); &$second_print(&text('setup_emade', "".&html_escape($merr)."")) if (defined($merr)); &reset_domain_envs($d); return undef; } # register_post_action(&function, args) sub register_post_action { push(@main::post_actions, [ @_ ]); } # run_post_actions([&only-action]) # Run all registered post-modification actions sub run_post_actions { local @only = @_; local %only = map { $_, 1 } @only; local $a; # Check if we are restarting Apache, and if so don't reload it local $restarting; foreach $a (@main::post_actions) { if ($a->[0] eq \&restart_apache) { $a->[1] ||= 0; $restarting = 1 if ($a->[1] == 1); } } if ($restarting) { @main::post_actions = grep { $_->[0] ne \&restart_apache || $_->[1] != 0 } @main::post_actions; } # Run unique actions local %done; local @newpost; foreach my $a (@main::post_actions) { # Don't run multiple times my $key; if ($a->[0] eq \&restart_bind || $a->[0] eq \&update_secondary_mx_virtusers) { # Restarts in the same domain are considered equal $key = $a->[0].($a->[1] ? ",".$a->[1]->{'dom'} : ""); } else { $key = join(",", @$a); } next if ($done{$key}++); # Skip if the caller requested specific actions local ($afunc, @aargs) = @$a; if (@only && !$only{$afunc}) { push(@newpost, $a); next; } # Call the restart function local $main::error_must_die = 1; eval { &$afunc(@aargs) }; if ($@) { &$second_print(&text('setup_postfailure', "$@")); } } @main::post_actions = @newpost; } # run_post_actions_silently() # Just calls run_post_actions while supressing output sub run_post_actions_silently { &push_all_print(); &set_all_null_print(); &run_post_actions(); &pop_all_print(); } # find_bandwidth_job() # Returns the cron job used for bandwidth monitoring sub find_bandwidth_job { local $job = &find_cron_script($bw_cron_cmd); return $job; } # get_bandwidth(&domain) # Returns the bandwidth usage object for some domain sub get_bandwidth { my ($d) = @_; if (!defined($get_bandwidth_cache{$d->{'id'}})) { local %bwinfo; &read_file("$bandwidth_dir/$d->{'id'}", \%bwinfo); foreach my $k (keys %bwinfo) { if ($k =~ /^\d+$/) { # Convert old web entries $bwinfo{"web_$k"} = $bwinfo{$k}; delete($bwinfo{$k}); } } $get_bandwidth_cache{$d->{'id'}} = \%bwinfo; } return $get_bandwidth_cache{$d->{'id'}}; } # save_bandwidth(&domain, &info) # Update the bandwidth usage object for some domain sub save_bandwidth { my ($d, $info) = @_; &make_dir($bandwidth_dir, 0700); &write_file("$bandwidth_dir/$d->{'id'}", $info); $get_bandwidth_cache{$d->{'id'}} ||= $info; } # bandwidth_input(name, value, [no-unlimited], [dont-change]) # Returns HTML for a bandwidth input field, with an 'unlimited' option sub bandwidth_input { local ($name, $value, $nounlimited, $dontchange) = @_; local $rv; local $dis1 = &js_disable_inputs([ $name, $name."_units" ], [ ]); local $dis2 = &js_disable_inputs([ ], [ $name, $name."_units" ]); local $dis; if (!$nounlimited) { if ($dontchange) { # Show don't change option $rv .= &ui_radio($name."_def", 2, [ [ 2, $text{'massdomains_leave'}, "onClick='$dis1'" ], [ 1, $text{'edit_bwnone'}, "onClick='$dis1'" ], [ 0, " ", "onClick='$dis2'" ] ]); $dis = 1; } else { # Show unlimited option $rv .= &ui_radio($name."_def", $value ? 0 : 1, [ [ 1, $text{'edit_bwnone'}, "onClick='$dis1'" ], [ 0, " ", "onClick='$dis2'" ] ]); $dis = 1 if (!$value); } } local ($val, $u); my $unit = 1024; if ($value eq "") { # Default to GB, since bytes are rarely useful $u = $text{"nice_size_GiB"}; } elsif ($value && $value%($unit*$unit*$unit*$unit) == 0) { $val = $value/($unit*$unit*$unit*$unit); $u = $text{"nice_size_TiB"}; } elsif ($value && $value%($unit*$unit*$unit) == 0) { $val = $value/($unit*$unit*$unit); $u = $text{"nice_size_GiB"}; } elsif ($value && $value%($unit*$unit) == 0) { $val = $value/($unit*$unit); $u = $text{"nice_size_MiB"}; } elsif ($value && $value%($unit) == 0) { $val = $value/($unit); $u = $text{"nice_size_kiB"}; } else { $val = $value; $u = $text{"nice_size_b"}; } local $sel = &ui_select($name."_units", $u, [ [$text{"nice_size_b"}], [$text{"nice_size_kiB"}], [$text{"nice_size_MiB"}], [$text{"nice_size_GiB"}], [$text{"nice_size_TiB"}] ], 1, 0, 0, $dis); $rv .= &text('edit_bwpast_'.$config{'bw_past'}, &ui_textbox($name, $val, 10, $dis)." ".$sel, $config{'bw_period'}); return $rv; } # parse_bandwidth(name, error, [no-unlimited]) sub parse_bandwidth { if ($in{"$_[0]_def"} && !$_[2]) { return undef; } else { my $unit = 1024; $in{$_[0]} =~ /^\d+$/ && $in{$_[0]} > 0 || &error($_[1]); local $m = $in{"$_[0]_units"} eq $text{"nice_size_TiB"} ? $unit*$unit*$unit*$unit : $in{"$_[0]_units"} eq $text{"nice_size_GiB"} ? $unit*$unit*$unit : $in{"$_[0]_units"} eq $text{"nice_size_MiB"} ? $unit*$unit : $in{"$_[0]_units"} eq $text{"nice_size_kiB"} ? $unit : 1; return $in{$_[0]} * $m; } } # email_template_input(template-file, subject, other-cc, other-bcc, # [mailbox-cc, owner-cc, reseller-cc], [header],[filemode]) # Returns HTML for fields for editing an email template sub email_template_input { local ($file, $subject, $cc, $bcc, $mailbox, $owner, $reseller, $header, $filemode) = @_; local $rv; $rv .= &ui_table_start($header, undef, 2); if ($filemode eq "none" || $filemode eq "default") { # Show input for selecting if enabled $rv .= &ui_table_row($text{'newdom_sending'}, &ui_yesno_radio("sending", $filemode eq "default" ? 1 : 0)); } $rv .= &ui_table_row($text{'newdom_subject'}, &ui_textbox("subject", $subject, 60)); if (defined($mailbox)) { # Show inputs for selecting destination $rv .= &ui_table_row($text{'newdom_to'}, &ui_checkbox("mailbox", 1, $text{'newdom_mailbox'}, $mailbox)." ". &ui_checkbox("owner", 1, $text{'newdom_owner'}, $owner)." ". ($virtualmin_pro ? &ui_checkbox("reseller", 1, $text{'newdom_reseller'}, $reseller) : "")); } $rv .= &ui_table_row($text{'newdom_cc'}, &ui_textbox("cc", $cc, 60)); $rv .= &ui_table_row($text{'newdom_bcc'}, &ui_textbox("bcc", $bcc, 60)); if ($file) { $rv .= &ui_table_row(undef, &ui_textarea("template", &read_file_contents($file), 20, 70), 2); } $rv .= &ui_table_end(); return $rv; } # parse_email_template(file, subject-config, cc-config, bcc-config, # [mailbox-config, owner-config, reseller-config], # [filemode-config]) sub parse_email_template { local ($file, $subject_config, $cc_config, $bcc_config, $mailbox_config, $owner_config, $reseller_config, $filemode_config) = @_; $in{'template'} =~ s/\r//g; &open_lock_tempfile(FILE, ">$file", 1) || &error(&text('efilewrite', $file, $!)); &print_tempfile(FILE, $in{'template'}); &close_tempfile(FILE); &lock_file($module_config_file); $config{$subject_config} = $in{'subject'}; $config{$cc_config} = $in{'cc'}; $config{$bcc_config} = $in{'bcc'}; if ($mailbox_config) { $config{$mailbox_config} = $in{'mailbox'}; $config{$owner_config} = $in{'owner'}; if ($virtualmin_pro) { $config{$reseller_config} = $in{'reseller'}; } } if ($filemode_config && defined($in{'sending'})) { $config{$filemode_config} = $in{'sending'} ? "default" : "none"; } $config{'last_check'} = time()+1; # no need for check.cgi to be run &save_module_config(); &unlock_file($module_config_file); } # escape_user(username) # Returns a Unix username with characters unsuitable for use in a mail # destination (like @) escaped sub escape_user { local $escuser = $_[0]; $escuser =~ s/\@/\\\@/g; return $escuser; } # unescape_user(username) # The reverse of escape_user sub unescape_user { local $escuser = $_[0]; $escuser =~ s/\\\@/\@/g; return $escuser; } # escape_alias(username) # Converts a username into a suitable alias name sub escape_alias { my ($escuser) = @_; my $origuser = $escuser; $escuser =~ s/\@/-/g; if (!getpwnam($escuser)) { $escuser = &escape_user($origuser); } return $escuser; } # replace_atsign(username) # Replace an @ in a username with - sub replace_atsign { my ($user) = @_; $user =~ s/\@/-/g; return $user; } # replace_atsign_if_exists(username) # Replace an @ in a username with - # if a user exists in system sub replace_atsign_if_exists { my ($user) = @_; my $origuser = $user; $user =~ s/\@/-/g; $user = $origuser if (!getpwnam($user)); return $user; } # escape_replace_atsign_if_exists(username) # Replace an @ in a username with - if a # user exists in system and if not return # escaped @ user sub escape_replace_atsign_if_exists { my ($user) = @_; my $origuser = $user; $user =~ s/\@/-/g; $user = &escape_user($origuser) if (!getpwnam($user)); return $user; } # add_atsign(username) # Given a username like foo-bar.com, return foo@bar.com sub add_atsign { local ($rv) = @_; $rv =~ s/\-/\@/; return $rv; } # dotqmail_file(&user) sub dotqmail_file { return "$_[0]->{'home'}/.qmail"; } # get_dotqmail(file) sub get_dotqmail { $_[0] =~ /\.qmail(-(\S+))?$/; local $alias = { 'file' => $_[0], 'name' => $2 }; local $_; open(AFILE, "<".$_[0]) || return undef; while() { s/\r|\n//g; s/#.*$//g; if (/\S/) { push(@{$alias->{'values'}}, $_); } } close(AFILE); return $alias; } # save_dotqmail(&alias, file, username|aliasname) sub save_dotqmail { if (@{$_[0]->{'values'}}) { &open_lock_tempfile(AFILE, ">$_[1]"); local $v; foreach $v (@{$_[0]->{'values'}}) { if ($v eq "\\$_[2]" || $v eq "\\NEWUSER") { # Delivery to this user means to his maildir if ($config{'vpopmail_md'}) { &print_tempfile(AFILE, "./$config{'vpopmail_md'}/\n"); } else { &print_tempfile(AFILE, "./Maildir/\n"); } } else { &print_tempfile(AFILE, $v,"\n"); } } &close_tempfile(AFILE); } else { &unlink_file($_[1]); } } # list_templates() # Returns a list of all virtual server templates, including two defaults for # top-level and sub-servers sub list_templates { if (scalar(@list_templates_cache)) { # Use cached copy return @list_templates_cache; } local @rv; &ensure_template("domain-template"); &ensure_template("subdomain-template"); &ensure_template("framefwd-template"); &ensure_template("user-template"); push(@rv, { 'id' => 0, 'name' => $text{'newtmpl_name0'}, 'standard' => 1, 'default' => 1, 'web' => $config{'apache_config'}, 'web_ssl' => $config{'apache_ssl_config'}, 'web_writelogs' => $config{'web_writelogs'}, 'web_user' => $config{'web_user'}, 'web_fcgiwrap' => $config{'fcgiwrap'}, 'web_cgimode' => $config{'cgimode'}, 'web_html_dir' => $config{'html_dir'}, 'web_html_perms' => $config{'html_perms'} || 750, 'web_stats_dir' => $config{'stats_dir'}, 'web_stats_hdir' => $config{'stats_hdir'}, 'web_stats_pass' => $config{'stats_pass'}, 'web_stats_noedit' => $config{'stats_noedit'}, 'web_port' => $default_web_port, 'web_sslport' => $default_web_sslport, 'web_urlport' => $config{'web_urlport'}, 'web_urlsslport' => $config{'web_urlsslport'}, 'web_sslprotos' => $config{'web_sslprotos'}, 'web_alias' => $config{'alias_mode'}, 'web_webmin_ssl' => $config{'webmin_ssl'}, 'web_usermin_ssl' => $config{'usermin_ssl'}, 'web_webmail' => $config{'web_webmail'}, 'web_webmaildom' => $config{'web_webmaildom'}, 'web_admin' => $config{'web_admin'}, 'web_admindom' => $config{'web_admindom'}, 'php_vars' => $config{'php_vars'} || "none", 'php_fpm' => $config{'php_fpm'} || "none", 'php_sock' => $config{'php_sock'} || 0, 'php_log' => $config{'php_log'} || 0, 'php_log_path' => $config{'php_log_path'}, 'web_php_suexec' => int($config{'php_suexec'}), 'web_ruby_suexec' => $config{'ruby_suexec'} eq '' ? -1 : int($config{'ruby_suexec'}), 'web_phpver' => $config{'phpver'}, 'web_php_noedit' => int($config{'php_noedit'}), 'web_phpchildren' => $config{'phpchildren'}, 'web_ssi' => $config{'web_ssi'} eq '' ? 2 : $config{'web_ssi'}, 'web_ssi_suffix' => $config{'web_ssi_suffix'}, 'web_dovecot_ssl' => $config{'dovecot_ssl'}, 'web_postfix_ssl' => $config{'postfix_ssl'}, 'web_mysql_ssl' => $config{'mysql_ssl'}, 'web_proftpd_ssl' => $config{'proftpd_ssl'}, 'web_http2' => $config{'web_http2'}, 'web_redirects' => $config{'web_redirects'}, 'web_sslredirect' => $config{'auto_redirect'}, 'webalizer' => $config{'def_webalizer'} || "none", 'disabled_web' => $config{'disabled_web'} || "none", 'disabled_url' => $config{'disabled_url'} || "none", 'dns' => $config{'bind_config'} || "none", 'dns_replace' => $config{'bind_replace'}, 'dns_view' => $config{'dns_view'}, 'dns_spf' => $config{'bind_spf'} || "none", 'dns_spfhosts' => $config{'bind_spfhosts'}, 'dns_spfonly' => $config{'bind_spfonly'}, 'dns_spfincludes' => $config{'bind_spfincludes'}, 'dns_spfall' => $config{'bind_spfall'}, 'dns_dmarc' => $config{'bind_dmarc'} || "none", 'dns_dmarcp' => $config{'bind_dmarcp'} || "none", 'dns_dmarcpct' => $config{'bind_dmarcpct'} || 100, 'dns_dmarcruf' => $config{'bind_dmarcruf'}, 'dns_dmarcrua' => $config{'bind_dmarcrua'}, 'dns_dmarcextra' => $config{'bind_dmarcextra'}, 'dns_sub' => $config{'bind_sub'} || "none", 'dns_cloud' => $config{'bind_cloud'}, 'dns_cloud_import' => $config{'bind_cloud_import'}, 'dns_cloud_proxy' => $config{'bind_cloud_proxy'}, 'dns_slaves' => $config{'bind_slaves'}, 'dns_master' => $config{'bind_master'} || "none", 'dns_mx' => $config{'bind_mx'} || "none", 'dns_ns' => $config{'dns_ns'}, 'dns_prins' => $config{'dns_prins'}, 'dns_records' => $config{'dns_records'}, 'dns_ttl' => $config{'dns_ttl'}, 'dns_indom' => $config{'bind_indom'}, 'dnssec' => $config{'dnssec'} || "none", 'dnssec_alg' => $config{'dnssec_alg'}, 'dnssec_single' => $config{'dnssec_single'}, 'namedconf' => $config{'namedconf'} || "none", 'namedconf_no_allow_transfer' => $config{'namedconf_no_allow_transfer'}, 'namedconf_no_also_notify' => $config{'namedconf_no_also_notify'}, 'ftp' => $config{'proftpd_config'}, 'ftp_dir' => $config{'ftp_dir'}, 'logrotate' => $config{'logrotate_config'} || "none", 'logrotate_files' => $config{'logrotate_files'} || "none", 'logrotate_shared' => $config{'logrotate_shared'} || "no", 'status' => $config{'statusemail'} || "none", 'statusonly' => int($config{'statusonly'}), 'statustimeout' => $config{'statustimeout'}, 'statustmpl' => $config{'statustmpl'}, 'statussslcert' => $config{'statussslcert'}, 'mail_on' => $config{'domain_template'} eq "none" ? "none" : "yes", 'mail' => $config{'domain_template'} eq "none" || $config{'domain_template'} eq "" || $config{'domain_template'} eq "default" ? &cat_file("domain-template") : &cat_file($config{'domain_template'}), 'mail_subject' => $config{'newdom_subject'} || &entities_to_ascii($text{'mail_dsubject'}), 'mail_cc' => $config{'newdom_cc'}, 'mail_bcc' => $config{'newdom_bcc'}, 'mail_cloud' => $config{'mail_cloud'}, 'newuser_on' => $config{'user_template'} eq "none" ? "none" : "yes", 'newuser' => $config{'user_template'} eq "none" || $config{'user_template'} eq "" || $config{'user_template'} eq "default" ? &cat_file("user-template") : &cat_file($config{'user_template'}), 'newuser_subject' => $config{'newuser_subject'} || &entities_to_ascii($text{'mail_usubject'}), 'newuser_cc' => $config{'newuser_cc'}, 'newuser_bcc' => $config{'newuser_bcc'}, 'newuser_to_mailbox' => $config{'newuser_to_mailbox'} || 0, 'newuser_to_owner' => $config{'newuser_to_owner'} || 0, 'newuser_to_reseller' => $config{'newuser_to_reseller'} || 0, 'updateuser_on' => $config{'update_template'} eq "none" ? "none" : "yes", 'updateuser' => $config{'update_template'} eq "none" || $config{'update_template'} eq "" || $config{'update_template'} eq "default" ? &cat_file("update-template") : &cat_file($config{'update_template'}), 'updateuser_subject' => $config{'newupdate_subject'} || &entities_to_ascii($text{'mail_upsubject'}), 'updateuser_cc' => $config{'newupdate_cc'}, 'updateuser_bcc' => $config{'newupdate_bcc'}, 'updateuser_to_mailbox' => $config{'newupdate_to_mailbox'} || 0, 'updateuser_to_owner' => $config{'newupdate_to_owner'} || 0, 'updateuser_to_reseller' => $config{'newupdate_to_reseller'} || 0, 'aliascopy' => $config{'aliascopy'} || 0, 'bccto' => $config{'bccto'} || 'none', 'spamclear' => $config{'spamclear'} || 'none', 'trashclear' => $config{'trashclear'} || 'none', 'spamtrap' => $config{'spamtrap'} || 'none', 'defmquota' => $config{'defmquota'} || "none", 'user_aliases' => $config{'newuser_aliases'} || "none", 'dom_aliases' => $config{'newdom_aliases'} || "none", 'dom_aliases_bounce' => int($config{'newdom_alias_bounce'}), 'mysql' => $config{'mysql_db'} || '${PREFIX}', 'mysql_wild' => $config{'mysql_wild'}, 'mysql_suffix' => $config{'mysql_suffix'} || "none", 'mysql_hosts' => $config{'mysql_hosts'} || "none", 'mysql_mkdb' => $config{'mysql_mkdb'}, 'mysql_nopass' => $config{'mysql_nopass'}, 'mysql_nouser' => $config{'mysql_nouser'}, 'mysql_chgrp' => $config{'mysql_chgrp'}, 'mysql_charset' => $config{'mysql_charset'}, 'mysql_collate' => $config{'mysql_collate'}, 'mysql_conns' => $config{'mysql_conns'} || "none", 'mysql_uconns' => $config{'mysql_uconns'} || "none", 'postgres_encoding' => $config{'postgres_encoding'} || "none", 'skel' => $config{'virtual_skel'} || "none", 'skel_subs' => int($config{'virtual_skel_subs'}), 'skel_nosubs' => $config{'virtual_skel_nosubs'}, 'exclude' => $config{'default_exclude'} || "none", 'frame' => &cat_file("framefwd-template", 1), 'gacl' => 1, 'gacl_umode' => $config{'gacl_umode'}, 'gacl_uusers' => $config{'gacl_uusers'}, 'gacl_ugroups' => $config{'gacl_ugroups'}, 'gacl_groups' => $config{'gacl_groups'}, 'gacl_root' => $config{'gacl_root'}, 'webmin_group' => $config{'webmin_group'}, 'extra_prefix' => $config{'extra_prefix'} || "none", 'ugroup' => $config{'defugroup'} || "none", 'sgroup' => $config{'domains_group'} || "none", 'quota' => $config{'defquota'} || "none", 'uquota' => $config{'defuquota'} || "none", 'ushell' => $config{'defushell'} || "none", 'ujail' => $config{'defujail'}, 'mailboxlimit' => $config{'defmailboxlimit'} eq "" ? "none" : $config{'defmailboxlimit'}, 'aliaslimit' => $config{'defaliaslimit'} eq "" ? "none" : $config{'defaliaslimit'}, 'dbslimit' => $config{'defdbslimit'} eq "" ? "none" : $config{'defdbslimit'}, 'domslimit' => $config{'defdomslimit'} eq "" ? 0 : $config{'defdomslimit'} eq "*" ? "none" : $config{'defdomslimit'}, 'aliasdomslimit' => $config{'defaliasdomslimit'} eq "" || $config{'defaliasdomslimit'} eq "*" ? "none" : $config{'defaliasdomslimit'}, 'realdomslimit' => $config{'defrealdomslimit'} eq "" || $config{'defrealdomslimit'} eq "*" ? "none" : $config{'defrealdomslimit'}, 'bwlimit' => $config{'defbwlimit'} eq "" ? "none" : $config{'defbwlimit'}, 'mongrelslimit' => $config{'defmongrelslimit'} eq "" ? "none" : $config{'defmongrelslimit'}, 'capabilities' => $config{'defcapabilities'} || "none", 'featurelimits' => $config{'featurelimits'} || "none", 'nodbname' => $config{'defnodbname'}, 'norename' => $config{'defnorename'}, 'forceunder' => $config{'defforceunder'}, 'safeunder' => $config{'defsafeunder'}, 'ipfollow' => $config{'defipfollow'}, 'resources' => $config{'defresources'} || "none", 'ranges' => $config{'ip_ranges'} || "none", 'ranges6' => $config{'ip_ranges6'} || "none", 'mailgroup' => $config{'mailgroup'} || "none", 'ftpgroup' => $config{'ftpgroup'} || "none", 'dbgroup' => $config{'dbgroup'} || "none", 'othergroups' => $config{'othergroups'} || "none", 'quotatype' => $config{'hard_quotas'} ? "hard" : "soft", 'hashpass' => $config{'hashpass'} || 0, 'hashtypes' => $config{'hashtypes'}, 'append_style' => $config{'append_style'}, 'domalias' => $config{'domalias'} || "none", 'domalias_type' => $config{'domalias_type'} || 0, 'for_parent' => 1, 'for_sub' => 0, 'for_alias' => 1, 'for_users' => !$config{'deftmpl_nousers'}, 'resellers' => !defined($config{'tmpl_resellers'}) ? "*" : $config{'tmpl_resellers'}, 'owners' => !defined($config{'tmpl_owners'}) ? "*" : $config{'tmpl_owners'}, 'autoconfig' => $config{'tmpl_autoconfig'} || "none", 'outlook_autoconfig' => $config{'tmpl_outlook_autoconfig'} || "none", 'cert_key_tmpl' => $config{'key_tmpl'}, 'cert_cert_tmpl' => $config{'cert_tmpl'}, 'cert_ca_tmpl' => $config{'ca_tmpl'}, 'cert_combined_tmpl' => $config{'combined_tmpl'}, 'cert_everything_tmpl' => $config{'everything_tmpl'}, } ); foreach my $w (&list_php_wrapper_templates()) { $rv[0]->{$w} = $config{$w} || 'none'; } foreach my $phpver (@all_possible_php_versions) { $rv[0]->{'web_php_ini_'.$phpver} = defined($config{'php_ini_'.$phpver}) ? $config{'php_ini_'.$phpver} : $config{'php_ini'}, } if (!defined(getpwnam($rv[0]->{'web_user'})) && $rv[0]->{'web_user'} ne 'none' && $rv[0]->{'web_user'} ne '') { # Apache user is invalid, due to bad Virtualmin install script. Fix it $rv[0]->{'web_user'} = &get_apache_user(); } my @avail; foreach my $m (&list_domain_owner_modules()) { push(@avail, $m->[0]."=".$config{'avail_'.$m->[0]}); } $rv[0]->{'avail'} = join(' ', @avail); push(@rv, { 'id' => 1, 'name' => $text{'newtmpl_name1'}, 'standard' => 1, 'mail_on' => $config{'subdomain_template'} eq "none" ? "none" : $config{'subdomain_template'} eq "" ? "" : "yes", 'mail' => $config{'subdomain_template'} eq "none" || $config{'subdomain_template'} eq "" || $config{'subdomain_template'} eq "default" ? &cat_file("subdomain-template") : &cat_file($config{'subdomain_template'}), 'mail_subject' => $config{'newsubdom_subject'} || &entities_to_ascii($text{'mail_dsubject'}), 'mail_cc' => $config{'newsubdom_cc'}, 'mail_bcc' => $config{'newsubdom_bcc'}, 'skel' => $config{'sub_skel'} || "none", 'for_parent' => 0, 'for_sub' => 1, 'for_alias' => 0, 'for_users' => !$config{'subtmpl_nousers'}, } ); local $f; opendir(DIR, $templates_dir); while(defined($f = readdir(DIR))) { if ($f ne "." && $f ne "..") { local %tmpl; &read_file("$templates_dir/$f", \%tmpl); $tmpl{'file'} = "$templates_dir/$f"; $tmpl{'mail'} =~ s/\t/\n/g; $tmpl{'newuser'} =~ s/\t/\n/g; $tmpl{'updateuser'} =~ s/\t/\n/g; if ($tmpl{'id'} == 1 || $tmpl{'id'} == 0) { foreach $k (keys %tmpl) { $rv[$tmpl{'id'}]->{$k} = $tmpl{$k} if (!defined($rv[$tmpl{'id'}]->{$k})); } } else { push(@rv, \%tmpl); } foreach my $phpver (@all_possible_php_versions) { if (!defined($tmpl{'web_php_ini_'.$phpver})) { $tmpl{'web_php_ini_'.$phpver} = $tmpl{'web_php_ini'}; } } } } foreach my $tmpl (@rv) { $tmpl->{'resellers'} = '*' if (!defined($tmpl->{'resellers'})); $tmpl->{'owners'} = '*' if (!defined($tmpl->{'owners'})); if (!defined($tmpl->{'web_cgimode'})) { my @cgimodes = &has_cgi_support(); $tmpl->{'web_cgimode'} = $tmpl->{'web_fcgiwrap'} ? 'fcgiwrap' : $cgimodes[0]; delete($tmpl->{'web_fcgiwrap'}); } } closedir(DIR); @list_templates_cache = @rv; return @rv; } # list_available_templates([&parentdom], [&aliasdom]) # Returns a list of templates for creating a new server, with the given parent # and alias target domains sub list_available_templates { local ($parentdom, $aliasdom) = @_; local @rv; foreach my $t (&list_templates()) { next if ($t->{'deleted'}); next if (($parentdom && !$aliasdom) && !$t->{'for_sub'}); next if (!$parentdom && !$t->{'for_parent'}); next if (!&master_admin() && !&reseller_admin() && !$t->{'for_users'}); next if ($aliasdom && !$t->{'for_alias'}); next if (!&can_use_template($t)); push(@rv, $t); } return @rv; } # save_template(&template) # Create or update a template. If saving the standard template, updates the # appropriate config options instead of the template file. sub save_template { local ($tmpl) = @_; local $save_config = 0; if (!defined($tmpl->{'id'})) { $tmpl->{'id'} = &domain_id(); } if ($tmpl->{'id'} == 0) { # Update appropriate config entries $config{'deftmpl_nousers'} = !$tmpl->{'for_users'}; if ($tmpl->{'resellers'} eq '*') { delete($config{'tmpl_resellers'}); } else { $config{'tmpl_resellers'} = $tmpl->{'resellers'}; } if ($tmpl->{'owners'} eq '*') { delete($config{'tmpl_owners'}); } else { $config{'tmpl_owners'} = $tmpl->{'owners'}; } $config{'apache_config'} = $tmpl->{'web'}; $config{'apache_ssl_config'} = $tmpl->{'web_ssl'}; $config{'web_writelogs'} = $tmpl->{'web_writelogs'}; $config{'web_user'} = $tmpl->{'web_user'}; delete($config{'fcgiwrap'}); $config{'cgimode'} = $tmpl->{'web_cgimode'}; $config{'html_dir'} = $tmpl->{'web_html_dir'}; $config{'html_perms'} = $tmpl->{'web_html_perms'}; $config{'stats_dir'} = $tmpl->{'web_stats_dir'}; $config{'stats_hdir'} = $tmpl->{'web_stats_hdir'}; $config{'stats_pass'} = $tmpl->{'web_stats_pass'}; $config{'stats_noedit'} = $tmpl->{'web_stats_noedit'}; $config{'web_port'} = $tmpl->{'web_port'}; $config{'web_sslport'} = $tmpl->{'web_sslport'}; $config{'web_urlport'} = $tmpl->{'web_urlport'}; $config{'web_urlsslport'} = $tmpl->{'web_urlsslport'}; $config{'web_sslprotos'} = $tmpl->{'web_sslprotos'}; $config{'webmin_ssl'} = $tmpl->{'web_webmin_ssl'}; $config{'usermin_ssl'} = $tmpl->{'web_usermin_ssl'}; $config{'web_webmail'} = $tmpl->{'web_webmail'}; $config{'web_webmaildom'} = $tmpl->{'web_webmaildom'}; $config{'web_admin'} = $tmpl->{'web_admin'}; $config{'web_admindom'} = $tmpl->{'web_admindom'}; $config{'web_http2'} = $tmpl->{'web_http2'}; $config{'web_redirects'} = $tmpl->{'web_redirects'}; $config{'auto_redirect'} = $tmpl->{'web_sslredirect'}; $config{'php_vars'} = $tmpl->{'php_vars'} eq "none" ? "" : $tmpl->{'php_vars'}; $config{'php_fpm'} = $tmpl->{'php_fpm'} eq "none" ? "" : $tmpl->{'php_fpm'}; $config{'php_sock'} = $tmpl->{'php_sock'}; $config{'php_log'} = $tmpl->{'php_log'}; $config{'php_log_path'} = $tmpl->{'php_log_path'}; $config{'php_suexec'} = $tmpl->{'web_php_suexec'}; $config{'ruby_suexec'} = $tmpl->{'web_ruby_suexec'}; $config{'phpver'} = $tmpl->{'web_phpver'}; $config{'phpchildren'} = $tmpl->{'web_phpchildren'}; $config{'web_ssi'} = $tmpl->{'web_ssi'}; $config{'web_ssi_suffix'} = $tmpl->{'web_ssi_suffix'}; $config{'dovecot_ssl'} = $tmpl->{'web_dovecot_ssl'}; $config{'postfix_ssl'} = $tmpl->{'web_postfix_ssl'}; $config{'mysql_ssl'} = $tmpl->{'web_mysql_ssl'}; $config{'proftpd_ssl'} = $tmpl->{'web_proftpd_ssl'}; foreach my $phpver (@all_possible_php_versions) { $config{'php_ini_'.$phpver} = $tmpl->{'web_php_ini_'.$phpver}; } delete($config{'php_ini'}); $config{'php_noedit'} = $tmpl->{'web_php_noedit'}; $config{'def_webalizer'} = $tmpl->{'webalizer'} eq "none" ? "" : $tmpl->{'webalizer'}; $config{'disabled_web'} = $tmpl->{'disabled_web'} eq "none" ? "" : $tmpl->{'disabled_web'}; $config{'disabled_url'} = $tmpl->{'disabled_url'} eq "none" ? "" : $tmpl->{'disabled_url'}; $config{'alias_mode'} = $tmpl->{'web_alias'}; $config{'bind_config'} = $tmpl->{'dns'} eq "none" ? "" : $tmpl->{'dns'}; $config{'bind_replace'} = $tmpl->{'dns_replace'}; $config{'bind_spf'} = $tmpl->{'dns_spf'} eq 'none' ? undef : $tmpl->{'dns_spf'}; $config{'bind_spfhosts'} = $tmpl->{'dns_spfhosts'}; $config{'bind_spfonly'} = $tmpl->{'dns_spfonly'}; $config{'bind_spfincludes'} = $tmpl->{'dns_spfincludes'}; $config{'bind_spfall'} = $tmpl->{'dns_spfall'}; $config{'bind_dmarc'} = $tmpl->{'dns_dmarc'} eq 'none' ? undef : $tmpl->{'dns_dmarc'}; $config{'bind_dmarcp'} = $tmpl->{'dns_dmarcp'}; $config{'bind_dmarcpct'} = $tmpl->{'dns_dmarcpct'}; $config{'bind_dmarcruf'} = $tmpl->{'dns_dmarcruf'}; $config{'bind_dmarcrua'} = $tmpl->{'dns_dmarcrua'}; $config{'bind_dmarcextra'} = $tmpl->{'dns_dmarcextra'}; $config{'bind_sub'} = $tmpl->{'dns_sub'} eq 'none' ? undef : $tmpl->{'dns_sub'}; $config{'bind_cloud'} = $tmpl->{'dns_cloud'}; $config{'bind_slaves'} = $tmpl->{'dns_slaves'}; $config{'bind_cloud_import'} = $tmpl->{'dns_cloud_import'}; $config{'bind_cloud_proxy'} = $tmpl->{'dns_cloud_proxy'}; $config{'bind_master'} = $tmpl->{'dns_master'} eq 'none' ? undef : $tmpl->{'dns_master'}; $config{'bind_mx'} = $tmpl->{'dns_mx'} eq 'none' ? undef : $tmpl->{'dns_mx'}; $config{'bind_indom'} = $tmpl->{'dns_indom'}; $config{'dns_view'} = $tmpl->{'dns_view'}; $config{'dns_ns'} = $tmpl->{'dns_ns'}; $config{'dns_prins'} = $tmpl->{'dns_prins'}; $config{'dns_records'} = $tmpl->{'dns_records'}; $config{'dns_ttl'} = $tmpl->{'dns_ttl'}; $config{'namedconf'} = $tmpl->{'namedconf'} eq 'none' ? undef : $tmpl->{'namedconf'}; $config{'namedconf_no_also_notify'} = $tmpl->{'namedconf_no_also_notify'}; $config{'namedconf_no_allow_transfer'} = $tmpl->{'namedconf_no_allow_transfer'}; $config{'dnssec'} = $tmpl->{'dnssec'} eq 'none' ? undef : $tmpl->{'dnssec'}; $config{'dnssec_alg'} = $tmpl->{'dnssec_alg'}; $config{'dnssec_single'} = $tmpl->{'dnssec_single'}; delete($config{'mx_server'}); $config{'proftpd_config'} = $tmpl->{'ftp'}; $config{'ftp_dir'} = $tmpl->{'ftp_dir'}; $config{'logrotate_config'} = $tmpl->{'logrotate'} eq "none" ? "" : $tmpl->{'logrotate'}; $config{'logrotate_files'} = $tmpl->{'logrotate_files'} eq "none" ? "" : $tmpl->{'logrotate_files'}; $config{'logrotate_shared'} = $tmpl->{'logrotate_shared'}; $config{'statusemail'} = $tmpl->{'status'} eq 'none' ? '' : $tmpl->{'status'}; $config{'statusonly'} = $tmpl->{'statusonly'}; $config{'statustimeout'} = $tmpl->{'statustimeout'}; $config{'statustmpl'} = $tmpl->{'statustmpl'}; $config{'statussslcert'} = $tmpl->{'statussslcert'}; if ($tmpl->{'mail_on'} eq 'none') { # Don't send $config{'domain_template'} = 'none'; } elsif ($config{'domain_template'} eq 'none') { # Sending, but need to set a valid mail file $config{'domain_template'} = 'default'; } # Write message to default template file, or custom if set &uncat_file($config{'domain_template'} eq "none" || $config{'domain_template'} eq "" || $config{'domain_template'} eq "default" ? "domain-template" : $config{'domain_template'}, $tmpl->{'mail'}); $config{'newdom_subject'} = $tmpl->{'mail_subject'}; $config{'newdom_cc'} = $tmpl->{'mail_cc'}; $config{'newdom_bcc'} = $tmpl->{'mail_bcc'}; if ($tmpl->{'newuser_on'} eq 'none') { $config{'user_template'} = 'none'; } elsif ($config{'user_template'} eq 'none') { $config{'user_template'} = 'default'; } &uncat_file($config{'user_template'} eq "none" || $config{'user_template'} eq "" || $config{'user_template'} eq "default" ? "user-template" : $config{'user_template'}, $tmpl->{'newuser'}); $config{'newuser_subject'} = $tmpl->{'newuser_subject'}; $config{'newuser_cc'} = $tmpl->{'newuser_cc'}; $config{'newuser_bcc'} = $tmpl->{'newuser_bcc'}; $config{'newuser_to_mailbox'} = $tmpl->{'newuser_to_mailbox'}; $config{'newuser_to_owner'} = $tmpl->{'newuser_to_owner'}; $config{'newuser_to_reseller'} = $tmpl->{'newuser_to_reseller'}; if ($tmpl->{'updateuser_on'} eq 'none') { $config{'update_template'} = 'none'; } elsif ($config{'user_template'} eq 'none') { $config{'update_template'} = 'default'; } &uncat_file($config{'update_template'} eq "none" || $config{'update_template'} eq "" || $config{'update_template'} eq "default" ? "update-template" : $config{'update_template'}, $tmpl->{'updateuser'}); $config{'newupdate_subject'} = $tmpl->{'updateuser_subject'}; $config{'newupdate_cc'} = $tmpl->{'updateuser_cc'}; $config{'newupdate_bcc'} = $tmpl->{'updateuser_bcc'}; $config{'newupdate_to_mailbox'} = $tmpl->{'updateuser_to_mailbox'}; $config{'newupdate_to_owner'} = $tmpl->{'updateuser_to_owner'}; $config{'newupdate_to_reseller'} = $tmpl->{'updateuser_to_reseller'}; $config{'mail_cloud'} = $tmpl->{'mail_cloud'}; $config{'aliascopy'} = $tmpl->{'aliascopy'}; $config{'bccto'} = $tmpl->{'bccto'}; $config{'spamclear'} = $tmpl->{'spamclear'}; $config{'trashclear'} = $tmpl->{'trashclear'}; $config{'spamtrap'} = $tmpl->{'spamtrap'}; $config{'defmquota'} = $tmpl->{'defmquota'} eq "none" ? "" : $tmpl->{'defmquota'}; $config{'newuser_aliases'} = $tmpl->{'user_aliases'} eq "none" ? "" : $tmpl->{'user_aliases'}; $config{'newdom_aliases'} = $tmpl->{'dom_aliases'} eq "none" ? "" : $tmpl->{'dom_aliases'}; $config{'newdom_alias_bounce'} = $tmpl->{'dom_aliases_bounce'}; $config{'mysql_db'} = $tmpl->{'mysql'}; $config{'mysql_wild'} = $tmpl->{'mysql_wild'}; $config{'mysql_hosts'} = $tmpl->{'mysql_hosts'} eq "none" ? "" : $tmpl->{'mysql_hosts'}; $config{'mysql_suffix'} = $tmpl->{'mysql_suffix'} eq "none" ? "" : $tmpl->{'mysql_suffix'}; $config{'mysql_mkdb'} = $tmpl->{'mysql_mkdb'}; $config{'mysql_nopass'} = $tmpl->{'mysql_nopass'}; $config{'mysql_nouser'} = $tmpl->{'mysql_nouser'}; $config{'mysql_chgrp'} = $tmpl->{'mysql_chgrp'}; $config{'mysql_charset'} = $tmpl->{'mysql_charset'}; $config{'mysql_collate'} = $tmpl->{'mysql_collate'}; $config{'mysql_conns'} = $tmpl->{'mysql_conns'}; $config{'mysql_uconns'} = $tmpl->{'mysql_uconns'}; $config{'postgres_encoding'} = $tmpl->{'postgres_encoding'}; $config{'virtual_skel'} = $tmpl->{'skel'} eq "none" ? "" : $tmpl->{'skel'}; $config{'default_exclude'} = $tmpl->{'exclude'} eq "none" ? "" : $tmpl->{'exclude'}; $config{'virtual_skel_subs'} = $tmpl->{'skel_subs'}; $config{'virtual_skel_nosubs'} = $tmpl->{'skel_nosubs'}; $config{'gacl_umode'} = $tmpl->{'gacl_umode'}; $config{'gacl_ugroups'} = $tmpl->{'gacl_ugroups'}; $config{'gacl_users'} = $tmpl->{'gacl_users'}; $config{'gacl_groups'} = $tmpl->{'gacl_groups'}; $config{'gacl_root'} = $tmpl->{'gacl_root'}; $config{'webmin_group'} = $tmpl->{'webmin_group'}; $config{'extra_prefix'} = $tmpl->{'extra_prefix'} eq "none" ? "" : $tmpl->{'extra_prefix'}; $config{'defugroup'} = $tmpl->{'ugroup'}; $config{'domains_group'} = $tmpl->{'sgroup'} eq "none" ? "" : $tmpl->{'sgroup'}; $config{'defquota'} = $tmpl->{'quota'}; $config{'defuquota'} = $tmpl->{'uquota'}; $config{'defushell'} = $tmpl->{'ushell'}; $config{'defujail'} = $tmpl->{'ujail'}; $config{'defmailboxlimit'} = $tmpl->{'mailboxlimit'} eq 'none' ? undef : $tmpl->{'mailboxlimit'}; $config{'defaliaslimit'} = $tmpl->{'aliaslimit'} eq 'none' ? undef : $tmpl->{'aliaslimit'}; $config{'defdbslimit'} = $tmpl->{'dbslimit'} eq 'none' ? undef : $tmpl->{'dbslimit'}; $config{'defdomslimit'} = $tmpl->{'domslimit'} eq 'none' ? "*" : $tmpl->{'domslimit'} eq '0' ? "" : $tmpl->{'domslimit'}; $config{'defaliasdomslimit'} = $tmpl->{'aliasdomslimit'} eq 'none' ? "*" : $tmpl->{'aliasdomslimit'}; $config{'defrealdomslimit'} = $tmpl->{'realdomslimit'} eq 'none' ? "*" : $tmpl->{'realdomslimit'}; $config{'defbwlimit'} = $tmpl->{'bwlimit'} eq 'none' ? undef : $tmpl->{'bwlimit'}; $config{'defmongrelslimit'} = $tmpl->{'mongrelslimit'} eq 'none' ? undef : $tmpl->{'mongrelslimit'}; $config{'defcapabilities'} = $tmpl->{'capabilities'}; $config{'featurelimits'} = $tmpl->{'featurelimits'}; $config{'defnodbname'} = $tmpl->{'nodbname'}; $config{'defnorename'} = $tmpl->{'norename'}; $config{'defforceunder'} = $tmpl->{'forceunder'}; $config{'defsafeunder'} = $tmpl->{'safeunder'}; $config{'defipfollow'} = $tmpl->{'ipfollow'}; $config{'defresources'} = $tmpl->{'resources'}; &uncat_file("framefwd-template", $tmpl->{'frame'}, 1); $config{'ip_ranges'} = $tmpl->{'ranges'} eq 'none' ? undef : $tmpl->{'ranges'}; $config{'ip_ranges6'} = $tmpl->{'ranges6'} eq 'none' ? undef : $tmpl->{'ranges6'}; $config{'mailgroup'} = $tmpl->{'mailgroup'} eq 'none' ? undef : $tmpl->{'mailgroup'}; $config{'ftpgroup'} = $tmpl->{'ftpgroup'} eq 'none' ? undef : $tmpl->{'ftpgroup'}; $config{'dbgroup'} = $tmpl->{'dbgroup'} eq 'none' ? undef : $tmpl->{'dbgroup'}; $config{'othergroups'} = $tmpl->{'othergroups'} eq 'none' ? undef : $tmpl->{'othergroups'}; $config{'hard_quotas'} = $tmpl->{'quotatype'} eq "hard" ? 1 : 0; $config{'hashpass'} = $tmpl->{'hashpass'}; $config{'hashtypes'} = $tmpl->{'hashtypes'}; $config{'append_style'} = $tmpl->{'append_style'}; $config{'domalias'} = $tmpl->{'domalias'} eq 'none' ? undef : $tmpl->{'domalias'}; $config{'domalias_type'} = $tmpl->{'domalias_type'}; $config{'tmpl_autoconfig'} = $tmpl->{'autoconfig'}; $config{'tmpl_outlook_autoconfig'} = $tmpl->{'outlook_autoconfig'}; $config{'key_tmpl'} = $tmpl->{'cert_key_tmpl'}; $config{'cert_tmpl'} = $tmpl->{'cert_cert_tmpl'}; $config{'ca_tmpl'} = $tmpl->{'cert_ca_tmpl'}; $config{'combined_tmpl'} = $tmpl->{'cert_combined_tmpl'}; $config{'everything_tmpl'} = $tmpl->{'cert_everything_tmpl'}; foreach my $w (&list_php_wrapper_templates()) { $config{$w} = $tmpl->{$w}; } my %avail = map { split(/=/, $_) } split(/\s+/, $tmpl->{'avail'}); foreach my $m (&list_domain_owner_modules()) { $config{'avail_'.$m->[0]} = $avail{$m->[0]} || 0; } $save_config = 1; } elsif ($tmpl->{'id'} == 1) { # For the default for sub-servers, update mail and skel in config only $config{'subtmpl_nousers'} = !$tmpl->{'for_users'}; if ($tmpl->{'mail_on'} eq 'none') { # Don't send $config{'subdomain_template'} = 'none'; } elsif ($tmpl->{'mail_on'} eq '') { # Use default message (for top-level servers) $config{'subdomain_template'} = ''; } else { # Sending, but need to set a valid mail file if ($config{'subdomain_template'} eq 'none') { $config{'subdomain_template'} = 'default'; } } &uncat_file($config{'subdomain_template'} eq "none" || $config{'subdomain_template'} eq "" || $config{'subdomain_template'} eq "default" ? "subdomain-template" : $config{'subdomain_template'}, $tmpl->{'mail'}); $config{'newsubdom_subject'} = $tmpl->{'mail_subject'}; $config{'newsubdom_cc'} = $tmpl->{'mail_cc'}; $config{'newsubdom_bcc'} = $tmpl->{'mail_bcc'}; $config{'sub_skel'} = $tmpl->{'skel'} eq "none" ? "" : $tmpl->{'skel'}; $save_config = 1; } if ($tmpl->{'id'} != 0) { # Just save the entire template to a file &make_dir($templates_dir, 0700); $tmpl->{'created'} ||= time(); $tmpl->{'mail'} =~ s/\n/\t/g; $tmpl->{'newuser'} =~ s/\n/\t/g; $tmpl->{'updateuser'} =~ s/\n/\t/g; &lock_file("$templates_dir/$tmpl->{'id'}"); &write_file("$templates_dir/$tmpl->{'id'}", $tmpl); &unlock_file("$templates_dir/$tmpl->{'id'}"); } else { # Only plugin-specific options go to a file &make_dir($templates_dir, 0700); &lock_file("$templates_dir/$tmpl->{'id'}"); &read_file("$templates_dir/$tmpl->{'id'}", \%ptmpl); local %ptmpl; foreach my $p (@plugins) { foreach my $k (keys %$tmpl) { if ($k =~ /^\Q$p\E/) { $ptmpl{$k} = $tmpl->{$k}; } } } &write_file("$templates_dir/$tmpl->{'id'}", \%ptmpl); &unlock_file("$templates_dir/$tmpl->{'id'}"); } if ($save_config) { &lock_file($module_config_file); $config{'last_check'} = time()+1; &write_file($module_config_file, \%config); &unlock_file($module_config_file); } undef(@list_templates_cache); } # get_template(id, [template-overrides]) # Returns a template, with any default settings filled in from real default sub get_template { my ($tmplid) = @_; local @tmpls = &list_templates(); local ($tmpl) = grep { $_->{'id'} == $tmplid } @tmpls; return undef if (!$tmpl); # not found if (!$tmpl->{'default'}) { local $def = $tmpls[0]; local $p; local %done; foreach $p ("dns_spf", "dns_sub", "dns_master", "dns_mx", "dns_dmarc", "dns_cloud", "dns_slaves", "web_webmail", "web_admin", "web_http2", "web_redirects", "web_sslredirect", "web_php", "web", "dns", "ftp", "mail", "frame", "user_aliases", "ugroup", "sgroup", "quota", "uquota", "ushell", "ujail", "mailboxlimit", "domslimit", "dbslimit", "aliaslimit", "bwlimit", "mongrelslimit","skel", "mysql_hosts", "mysql_mkdb", "mysql_suffix", "mysql_chgrp", "mysql_nopass", "mysql_wild", "mysql_charset", "mysql", "mysql_nouser", "postgres_encoding", "webalizer", "dom_aliases", "ranges", "ranges6", "mailgroup", "ftpgroup", "dbgroup", "othergroups", "defmquota", "quotatype", "append_style", "domalias", "logrotate_files", "logrotate_shared", "logrotate", "disabled_web", "disabled_url", "php_sock", "php_fpm", "php_log", "php", "newuser", "updateuser", "status", "extra_prefix", "capabilities", "webmin_group", "spamclear", "trashclear", "spamtrap", "namedconf", "nodbname", "norename", "forceunder", "safeunder", "ipfollow", "exclude", "cert_key_tmpl", "cert_cert_tmpl", "cert_ca_tmpl", "cert_combined_tmpl","cert_everything_tmpl", "aliascopy", "bccto", "resources", "dnssec", "avail", @plugins, &list_php_wrapper_templates(), "capabilities", "featurelimits", "hashpass", "hashtypes", "autoconfig", "outlook_autoconfig", (map { $_."limit", $_."server", $_."master", $_."view", $_."passwd" } @plugins)) { my $psel = $p eq "web_php" ? "web_php_suexec" : $p eq "mail" ? "mail_on" : $p; if ($tmpl->{$psel} eq "") { local $k; foreach $k (keys %$def) { next if ($p eq "dns" && $k =~ /^dns_(spf|cloud|slaves)/); next if ($p eq "php" && $k =~ /^php_(fpm|sock)/); next if ($p eq "web" && $k =~ /^web_(webmail|admin|http2|redirects|sslredirect|php)/); next if ($done{$k}); if ($k =~ /^\Q$p\E_/ || $k eq $psel || $k eq $p) { $tmpl->{$k} = $def->{$k}; $done{$k}++; } } } } # The ruby setting needs to default to -1 if the web section is defined # in this template, but we are using the GPL release $tmpl->{'web_ruby_suexec'} = -1 if ($tmpl->{'web_ruby_suexec'} eq ''); } return $tmpl; } # delete_template(&template) # If this template is used by any domains, just mark it as deleted. # Otherwise, really delete it. sub delete_template { local %tmpl; &lock_file("$templates_dir/$_[0]->{'id'}"); local @users = &get_domain_by("template", $_[0]->{'id'}); if (@users) { &read_file("$templates_dir/$_[0]->{'id'}", \%tmpl); $tmpl{'deleted'} = 1; &write_file("$templates_dir/$_[0]->{'id'}", \%tmpl); } else { &unlink_file("$templates_dir/$_[0]->{'id'}"); } &unlock_file("$templates_dir/$_[0]->{'id'}"); } # list_template_scripts(&template) # Returns a list of scripts specified for this template. May return "none" # if there are none. sub list_template_scripts { local ($tmpl) = @_; return "none" if ($tmpl->{'noscripts'}); local @rv; opendir(DIR, $template_scripts_dir); foreach my $f (readdir(DIR)) { if ($f =~ /^(\d+)_(\d+)$/ && $1 == $tmpl->{'id'}) { local %script; &read_file("$template_scripts_dir/$f", \%script); $script{'id'} = $2; $script{'file'} = "$template_scripts_dir/$f"; push(@rv, \%script); } } closedir(DIR); return \@rv; } # save_template_scripts(&template, &scripts|"none") # Updates the scripts for some template sub save_template_scripts { local ($tmpl, $scripts) = @_; # Delete old scripts opendir(DIR, $template_scripts_dir); foreach my $f (readdir(DIR)) { if ($f =~ /^(\d+)_(\d+)$/ && $1 == $tmpl->{'id'}) { unlink("$template_scripts_dir/$f"); } } closedir(DIR); if ($scripts eq "none") { $tmpl->{'noscripts'} = 1; } else { # Save new scripts mkdir($template_scripts_dir, 0700); foreach my $script (@$scripts) { &write_file("$template_scripts_dir/$tmpl->{'id'}_$script->{'id'}", $script); } $tmpl->{'noscripts'} = 0; } &save_template($tmpl); } # get_template_scripts(&template) # Returns the actual scripts that should be installed when a domain is setup # using this template, taking defaults into account sub get_template_scripts { local ($tmpl) = @_; local $scripts = &list_template_scripts($tmpl); if ($scripts eq "none") { return ( ); } elsif (@$scripts || $tmpl->{'default'}) { return @$scripts; } else { # Fall back to default local @tmpls = &list_templates(); local $def = $tmpls[0]; return &get_template_scripts($def); } } # cat_file(file, [newlines-to-tabs]) # Returns the contents of some file sub cat_file { local ($file, $tabs) = @_; local $path = $file =~ /^\// ? $file : "$module_config_directory/$file"; local $rv = &read_file_contents($path); if ($tabs) { $rv =~ s/\r//g; $rv =~ s/\n/\t/g; } return $rv; } # uncat_file(file, data, [tabs-to-newlines]) # Writes to some file sub uncat_file { local ($file, $data, $tabs) = @_; if ($tabs) { $data =~ s/\t/\n/g; } local $path = $file =~ /^\// ? $file : "$module_config_directory/$file"; &open_lock_tempfile(FILE, ">$path"); &print_tempfile(FILE, $data); &close_tempfile(FILE); } # uncat_transname(data) # Creates a temp file and writes some data to it sub uncat_transname { local ($data, $tabs) = @_; local $temp = &transname(); &uncat_file($temp, $data, $tabs); return $temp; } # plugin_call(module, function, [arg, ...]) # If some plugin function is defined, call it and return the result, # otherwise return undef sub plugin_call { local ($mod, $func, @args) = @_; &load_plugin_libraries($mod); if (&plugin_defined($mod, $func)) { if ($main::module_name ne "virtual_server") { # Set up virtual_server package &foreign_require("virtual-server", "virtual-server-lib.pl"); $virtual_server::first_print = $first_print; $virtual_server::second_print = $second_print; $virtual_server::indent_print = $indent_print; $virtual_server::outdent_print = $outdent_print; } return &foreign_call($mod, $func, @args); } else { return wantarray ? ( ) : undef; } } # try_plugin_call(module, function, [arg, ...]) # Like plugin_call, but catches and prints errors sub try_plugin_call { local ($mod, $func, @args) = @_; local $main::error_must_die = 1; eval { &plugin_call($mod, $func, @args) }; if ($@) { my $fn = &plugin_call($mod, "feature_name"); &$second_print(&text('setup_failure', $fn, "$@")); return 0; } return 1; } # plugin_defined(module, function) # Returns 1 if some function is defined in a plugin sub plugin_defined { local ($mod, $func) = @_; &load_plugin_libraries($mod); $mod =~ s/[^A-Za-z0-9]/_/g; local $func = "${mod}::$func"; return defined(&$func); } # database_feature([&domain]) # Returns 1 if any feature that uses a database is enabled (perhaps in a domain) sub database_feature { local ($d) = @_; foreach my $f ('mysql', 'postgres') { return 1 if ($config{$f} && (!$d || $d->{$f})); } foreach my $f (&list_database_plugins()) { return 1 if ($config{$f} && (!$d || $d->{$f})); } return 0; } # list_custom_fields() # Returns a list of structures containing custom field details. Each has keys : # name - Unique name for this field # type - 0=textbox, 1=unix user, 2=unix UID, 3=unix group, 4=unix GID, # 5=file chooser, 6=directory chooser, 7=yes/no, 8=password, # 9=options file, 10=text area # opts - Name of options file # desc - Human-readable description, with optional ; separated tooltip # show - 1=show in list of domains, 0=hide # visible - 0=anyone can edit # 1=root can edit, others can view # 2=only root can see sub list_custom_fields { local @rv; local $_; open(FIELDS, "<".$custom_fields_file); while() { s/\r|\n//g; local @a = split(/:/, $_, 6); push(@rv, { 'name' => $a[0], 'type' => $a[1], 'opts' => $a[2], 'desc' => $a[3], 'show' => $a[4], 'visible' => $a[5], }); } close(FIELDS); return @rv; } # save_custom_fields(&fields) sub save_custom_fields { &open_lock_tempfile(FIELDS, ">$custom_fields_file"); foreach my $a (@{$_[0]}) { &print_tempfile(FIELDS, $a->{'name'},":",$a->{'type'},":", $a->{'opts'},":",$a->{'desc'},":",$a->{'show'},":", $a->{'visible'},"\n"); } &close_tempfile(FIELDS); } # list_custom_links() # Returns a list of structures containing custom link details sub list_custom_links { local @rv; local $_; open(LINKS, "<".$custom_links_file); while() { s/\r|\n//g; local @a = split(/\t/, $_); push(@rv, { 'desc' => $a[0], 'url' => $a[1], 'who' => { map { $_ => 1 } split(/:/, $a[2]) }, 'open' => $a[3], 'cat' => $a[4], 'tmpl' => $a[5] eq '-' ? undef : $a[5], 'feature' => $a[6] eq '-' ? undef : $a[6], }); } close(LINKS); return @rv; } # save_custom_links(&links) # Write out the given list of custom links to a file sub save_custom_links { &open_lock_tempfile(LINKS, ">$custom_links_file"); foreach my $a (@{$_[0]}) { &print_tempfile(LINKS, $a->{'desc'}."\t".$a->{'url'}."\t". join(":", keys %{$a->{'who'}})."\t". int($a->{'open'})."\t".$a->{'cat'}."\t". ($a->{'tmpl'} eq "" ? "-" : $a->{'tmpl'})."\t". ($a->{'feature'} eq "" ? "-" : $a->{'feature'})."\t". "\n"); } &close_tempfile(LINKS); } # list_custom_link_categories() # Returns a list of all custom link category hash refs sub list_custom_link_categories { local @rv; open(LINKCATS, "<".$custom_link_categories_file); while() { s/\r|\n//g; local @a = split(/\t/, $_); push(@rv, { 'id' => $a[0], 'desc' => $a[1] }); } close(LINKCATS); return @rv; } # save_custom_link_categories(&cats) # Write out the given list of link categories to a file sub save_custom_link_categories { &open_lock_tempfile(LINKCATS, ">$custom_link_categories_file"); foreach my $a (@{$_[0]}) { &print_tempfile(LINKCATS, $a->{'id'}."\t".$a->{'desc'}."\n"); } &close_tempfile(LINKCATS); } # list_visible_custom_links(&domain) # Returns a list of descriptions and URLs for custom links in the given domain, # for the current user type. Category names are also include. sub list_visible_custom_links { local ($d) = @_; local @rv; local $me = &master_admin() ? 'master' : &reseller_admin() ? 'reseller' : 'domain'; local %cats = map { $_->{'id'}, $_->{'desc'} } &list_custom_link_categories(); foreach my $l (&list_custom_links()) { if (!$l->{'who'}->{$me}) { # Not for you next; } if ($l->{'tmpl'} && $d->{'template'} ne $l->{'tmpl'}) { # Not for this domain template next; } if ($l->{'feature'} && !$d->{$l->{'feature'}}) { # Not for this domain feature next; } local $nl = { 'desc' => &substitute_domain_template($l->{'desc'}, $d), 'url' => &substitute_domain_template($l->{'url'}, $d), 'open' => $l->{'open'}, 'catname' => $cats{$l->{'cat'}}, 'cat' => $l->{'cat'}, }; if ($nl->{'desc'} && $nl->{'url'}) { push(@rv, $nl); } } return @rv; } # show_custom_fields([&domain], [&tds]) # Returns HTML for custom field inputs, for inclusion in a table sub show_custom_fields { local ($d, $tds) = @_; local $rv; local $col = 0; foreach my $f (&list_custom_fields()) { local ($desc, $tip) = split(/;/, $f->{'desc'}, 2); $desc = &html_escape($desc); if ($tip) { $desc = "

$desc
"; } if ($f->{'visible'} == 0 || &master_admin()) { # Can edit local $n = "field_".$f->{'name'}; local $v = $d ? $d->{"field_".$f->{'name'}} : $f->{'type'} == 7 ? 1 : $f->{'type'} == 11 ? 0 : undef; local $fv; if ($f->{'type'} == 0) { local $sz = $f->{'opts'} || 30; $fv = &ui_textbox($n, $v, $sz); } elsif ($f->{'type'} == 1 || $f->{'type'} == 2) { $fv = &ui_user_textbox($n, $v); } elsif ($f->{'type'} == 3 || $f->{'type'} == 4) { $fv = &ui_group_textbox($n, $v); } elsif ($f->{'type'} == 5 || $f->{'type'} == 6) { $fv = &ui_textbox($n, $v, 30)." ". &file_chooser_button($n, $f->{'type'}-5); } elsif ($f->{'type'} == 7 || $f->{'type'} == 11) { $fv = &ui_radio($n, $v ? 1 : 0, [ [ 1, $text{'yes'} ], [ 0, $text{'no'} ] ]); } elsif ($f->{'type'} == 8) { local $sz = $f->{'opts'} || 30; $fv = &ui_password($n, $v, $sz); } elsif ($f->{'type'} == 9) { local @opts = &read_opts_file($f->{'opts'}); local ($found) = grep { $_->[0] eq $v } @opts; push(@opts, [ $v, $v ]) if (!$found && $v ne ''); $fv = &ui_select($n, $v, \@opts); } elsif ($f->{'type'} == 10) { local ($w, $h) = split(/\s+/, $f->{'opts'}); $h ||= 4; $w ||= 30; $v =~ s/\t/\n/g; $fv = &ui_textarea($n, $v, $h, $w); } $rv .= &ui_table_row($desc, $fv, 1, $tds); } elsif ($f->{'visible'} == 1 && $d) { # Can only see local $fv = $d->{"field_".$f->{'name'}}; $rv .= &ui_table_row($desc, $fv, 1, $tds); } } return $rv; } # parse_custom_fields(&domain, &in) # Updates a domain with custom fields sub parse_custom_fields { local %in = %{$_[1]}; foreach my $f (&list_custom_fields()) { next if ($f->{'visible'} != 0 && !&master_admin()); local $n = "field_".$f->{'name'}; local $rv; if ($f->{'type'} == 0 || $f->{'type'} == 5 || $f->{'type'} == 6 || $f->{'type'} == 8) { $rv = $in{$n}; } elsif ($f->{'type'} == 10) { $rv = $in{$n}; $rv =~ s/\r//g; $rv =~ s/\n/\t/g; } elsif ($f->{'type'} == 1 || $f->{'type'} == 2) { local @u = getpwnam($in{$n}); $rv = $f->{'type'} == 1 ? $in{$n} : $u[2]; } elsif ($f->{'type'} == 3 || $f->{'type'} == 4) { local @g = getgrnam($in{$n}); $rv = $f->{'type'} == 3 ? $in{$n} : $g[2]; } elsif ($f->{'type'} == 7 || $f->{'type'} == 11) { $rv = $in{$n} ? $f->{'opts'} : ""; } elsif ($f->{'type'} == 9) { $rv = $in{$n}; } $_[0]->{"field_".$f->{'name'}} = $rv; } } # read_opts_file(file) sub read_opts_file { local @rv; local $file = $_[0]; if ($file !~ /^\//) { local @uinfo = getpwnam($remote_user); if (@uinfo) { $file = "$uinfo[7]/$file"; } } local $_; open(FILE, "<".$file); while() { s/\r|\n//g; if (/^"([^"]*)"\s+"([^"]*)"$/) { push(@rv, [ $1, $2 ]); } elsif (/^"([^"]*)"$/) { push(@rv, [ $1, $1 ]); } elsif (/^(\S+)\s+(\S.*)/) { push(@rv, [ $1, $2 ]); } else { push(@rv, [ $_, $_ ]); } } close(FILE); return @rv; } # create_initial_user(&dom, [no-template], [for-web]) # Returns a structure for a new mailbox user sub create_initial_user { my ($d, $notmpl, $forweb) = @_; my $user; if ($config{'mail_system'} == 5) { # VPOPMail user $user = { 'vpopmail' => 1, 'mailquota' => 1, 'person' => 1, 'fixedhome' => 1, 'noappend' => 1, 'noprimary' => 1, 'alwaysplain' => 1 }; } else { # Normal unix user $user = { 'unix' => 1, 'person' => 1 }; } if ($d && !$notmpl) { # Initial aliases and quota come from template local $tmpl = &get_template($d->{'template'}); if ($tmpl->{'user_aliases'} ne 'none') { $user->{'to'} = [ map { &substitute_domain_template($_, $d) } split(/\t+/, $tmpl->{'user_aliases'}) ]; } if (&has_home_quotas()) { $user->{'quota'} = $tmpl->{'defmquota'}; } if (&has_mail_quotas()) { $user->{'mquota'} = $tmpl->{'defmquota'}; } } if (!$user->{'noprimary'}) { $user->{'email'} = !$d ? "newuser\@".&get_system_hostname() : $d->{'mail'} ? "newuser\@$d->{'dom'}" : undef; } $user->{'secs'} = [ ]; $user->{'shell'} = &default_available_shell('mailbox'); # Merge in configurable initial user settings if ($d) { local %init; &read_file("$initial_users_dir/$d->{'id'}", \%init); foreach my $a ("email", "quota", "mquota", "qquota", "shell") { $user->{$a} = $init{$a} if (defined($init{$a})); } foreach my $a ("secs", "to") { if (defined($init{$a})) { $user->{$a} = [ split(/\t+/, $init{$a}) ]; } } if (defined($init{'dbs'})) { local ($db, @dbs); foreach $db (split(/\t+/, $init{'dbs'})) { local ($type, $name) = split(/_/, $db, 2); push(@dbs, { 'type' => $type, 'name' => $name, 'desc' => $text{'databases_'.$type} }); } $user->{'dbs'} = \@dbs; } } if ($forweb && $user->{'unix'}) { # This is a website management user local (undef, $ftp_shell, undef, $def_shell) = &get_common_available_shells(); $user->{'webowner'} = 1; $user->{'fixedhome'} = 0; $user->{'home'} = &public_html_dir($d); $user->{'noquota'} = 1; $user->{'mailquota'} = 0; $user->{'noprimary'} = 1; $user->{'noextra'} = 1; $user->{'noalias'} = 1; $user->{'nocreatehome'} = 1; $user->{'nomailfile'} = 1; $user->{'shell'} = $ftp_shell ? $ftp_shell->{'shell'} : $def_shell->{'shell'}; delete($user->{'email'}); } # For a unix user, apply default password expiry restrictions if ($user->{'unix'} && $gconfig{'os_type'} =~ /-linux$/) { &require_useradmin(); local %uconfig = &foreign_config("useradmin"); if ($usermodule eq "ldap-useradmin") { local %lconfig = &foreign_config($usermodule); foreach my $k (keys %lconfig) { if ($lconfig{$k} ne "") { $uconfig{$k} = $lconfig{$k}; } } } $user->{'min'} = $uconfig{'default_min'}; $user->{'max'} = $uconfig{'default_max'}; $user->{'warn'} = $uconfig{'default_warn'}; } return $user; } # save_initial_user(&user, &domain) # Saves default settings for new users in a virtual server sub save_initial_user { local ($user, $dom) = @_; if (!-d $initial_users_dir) { mkdir($initial_users_dir, 0700); } &lock_file("$initial_users_dir/$dom->{'id'}"); local %init; foreach my $a ("email", "quota", "mquota", "qquota", "shell") { $init{$a} = $user->{$a} if (defined($user->{$a})); } foreach my $a ("secs", "to") { if (defined($user->{$a})) { $init{$a} = join("\t", @{$user->{$a}}); } } if (defined($user->{'dbs'})) { $init{'dbs'} = join("\t", map { $_->{'type'}."_".$_->{'name'} } @{$user->{'dbs'}}); } &write_file("$initial_users_dir/$dom->{'id'}", \%init); &unlock_file("$initial_users_dir/$dom->{'id'}"); } # allowed_domain_name(&parent, newdomain) # Returns an error message if some domain name is invalid, or undef if OK. # Checks domain-owner subdomain and reseller subdomain limits. sub allowed_domain_name { local ($parent, $newdom) = @_; # Check if forced to be under one of the domains he already owns if ($parent && $access{'forceunder'}) { local $ok = 0; foreach my $pdom ($parent, &get_domain_by("parent", $parent->{'id'})) { local $pd = $pdom->{'dom'}; if ($newdom =~ /\.\Q$pd\E$/i) { $ok = 1; last; } } $ok || return &text('setup_eforceunder2', $parent->{'dom'}); } # Check if under someone else's domain if ($parent && $access{'safeunder'}) { foreach my $d (&list_domains()) { local $od = $d->{'dom'}; if ($d->{'id'} ne $parent->{'id'} && $d->{'parent'} ne $parent->{'id'} && $newdom =~ /\.\Q$od\E$/i) { return &text('setup_esafeunder', $od); } } } # Check allowed domain regexp if ($access{'subdom'}) { if ($newdom !~ /\.\Q$access{'subdom'}\E$/i) { return &text('setup_eforceunder', $access{'subdom'}); } } # Check if on denied list if (!&master_admin()) { foreach my $re (split(/\s+/, $config{'denied_domains'})) { if ($newdom =~ /^$re$/i) { return $text{'setup_edenieddomain'}; } } } return undef; } # domain_databases(&domain, [&types]) # Returns a list of structures for databases in a domain sub domain_databases { local ($d, $types) = @_; local @dbs; if ($d->{'mysql'} && (!$types || &indexof("mysql", @$types) >= 0)) { local %done; local $mymod = &require_dom_mysql($d); local $av = &foreign_available($mymod); local $myhost = &get_database_host_mysql($d); $myhost = undef if ($myhost eq 'localhost'); foreach my $db (split(/\s+/, $d->{'db_mysql'})) { next if ($done{$db}++); push(@dbs, { 'name' => $db, 'type' => 'mysql', 'users' => 1, 'link' => $av ? "../$mymod/edit_dbase.cgi?db=$db" : undef, 'desc' => $text{'databases_mysql'}, 'host' => $myhost, }); } } if ($d->{'postgres'} && (!$types || &indexof("postgres", @$types) >= 0)) { local %done; local $pgmod = &require_dom_postgres($d); local $av = &foreign_available("postgresql"); &require_postgres(); local $pghost = &get_database_host_postgres($d); $pghost = undef if ($pghost eq 'localhost'); foreach my $db (split(/\s+/, $d->{'db_postgres'})) { next if ($done{$db}++); push(@dbs, { 'name' => $db, 'type' => 'postgres', 'link' => $av ? "../$pgmod/". "edit_dbase.cgi?db=$db" : undef, 'desc' => $text{'databases_postgres'}, 'host' => $pghost, }); } } # Only check plugins if some non-core DB types were requested local @nctypes = $types ? grep { $_ ne "mysql" && $_ ne "postgres" } @$types : ( ); if (!$types || @nctypes) { foreach my $f (&list_database_plugins()) { if (!$types || &indexof($f, @$types) >= 0) { push(@dbs, &plugin_call($f, "database_list", $d)); } } } return @dbs; } # all_databases([&domain]) # Returns a list of all known databases on the system, possibly limited to # those relevant for some domain. sub all_databases { local ($d) = @_; local @rv; if ($config{'mysql'} && (!$d || $d->{'mysql'})) { &require_mysql(); push(@rv, map { { 'name' => $_, 'type' => 'mysql', 'desc' => $text{'databases_mysql'}, 'special' => $_ =~ /^(mysql|sys|information_schema|performance_schema)$/ } } &list_all_mysql_databases($d)); } if ($config{'postgres'} && (!$d || $d->{'postgres'})) { &require_postgres(); push(@rv, map { { 'name' => $_, 'type' => 'postgres', 'desc' => $text{'databases_postgres'}, 'special' => ($_ =~ /^template/i) } } &list_all_postgres_databases($d)); } foreach my $f (&list_database_plugins()) { if (!$d || $d->{$f}) { push(@rv, &plugin_call($f, "databases_all", $d)); } } return @rv; } # all_database_types() # Returns a list of all database types on the system sub all_database_types { return ( $config{'mysql'} ? ("mysql") : ( ), $config{'postgres'} ? ("postgres") : ( ), &list_database_plugins() ); } # resync_all_databases(&domain, &all-dbs) # Updates a domain object to remove databases that no longer really exist, and # perhaps to change the 'db' field to the first actual database sub resync_all_databases { local ($d, $all) = @_; return if (!@$all); # If no DBs were found on the system, do nothing # to avoid mass dis-association local %all = map { ("$_->{'type'} $_->{'name'}", $_) } @$all; local $removed = 0; foreach my $k (keys %$d) { if ($k =~ /^db_(\S+)$/) { local $t = $1; local @names = split(/\s+/, $d->{$k}); local @newnames = grep { $all{"$t $_"} } @names; if (@names != @newnames) { $d->{$k} = join(" ", @newnames); $removed = 1; } } } if ($removed) { &save_domain($d); } # Fix 'db' field if it is currently set to a missing DB local @domdbs = &domain_databases($d); local ($defdb) = grep { $_->{'name'} eq $d->{'db'} } @domdbs; if (!$defdb && @domdbs) { $d->{'db'} = $domdbs[0]->{'name'}; &save_domain($d); } } # get_database_host(type, [&domain]) # Returns the remote host that we use for the given database type. If the # DB is on the same server, returns localhost sub get_database_host { local ($type, $d) = @_; local $rv; if (&indexof($type, @features) >= 0) { # Built-in DB local $hfunc = "get_database_host_".$type; $rv = &$hfunc($d); } elsif (&indexof($type, &list_database_plugins()) >= 0) { # From plugin $rv = &plugin_call($type, "database_host", $d); } $rv ||= "localhost"; if ($rv eq "localhost" && $type eq "mysql") { # Is this domain under a chroot? If so, use 127.0.0.1 to force use # of a TCP connection rather than a socket my $parent = $d->{'parent'} ? &get_domain($d->{'parent'}) : $d; if (&get_domain_jailkit($parent)) { $rv = "127.0.0.1"; } } return $rv; } # check_domain_hashpass(&domain) # Shows a checkbox to enable hashed passwords # if domain and template don't have it aligned sub check_domain_hashpass { my ($d) = @_; my $tmpl = &get_template($d->{'template'}); if (defined($d->{'hashpass'}) && defined($tmpl->{'hashpass'}) && $d->{'hashpass'} != $tmpl->{'hashpass'}) { return 1; } return 0; } # update_domain_hashpass(&dom, mode) # Updates domain hashpass option if needed, and # delete all *_enc_pass if disabling hashing sub update_domain_hashpass { my ($d, $mode) = @_; if (&check_domain_hashpass($d)) { $d->{'hashpass'} = $mode; if (!$mode) { my @encpass_opts = grep { /enc_pass$/ } keys %{$d}; foreach my $encpass_opt (@encpass_opts) { delete($d->{$encpass_opt}); } } return 1; } return 0; } # post_update_domain_hashpass(&@doms, mode, pass) # Apply domain services hashpass clean ups sub post_update_domain_hashpass { my ($d, $mode, $pass) = @_; if ($mode) { # On switching to hashed mode some passwords # services need to be reset to plain text my $opt = 'mysql_enc_pass'; if ($d->{$opt}) { my $fn = $opt; $fn =~ s/enc_//; $d->{$fn} = $pass; delete($d->{$opt}); } } } # get_password_synced_types(&domain) # Returns a list of DB types that are enabled for this domain and have their # passwords synced with the admin login sub get_password_synced_types { local ($d) = @_; my @rv; foreach my $t (&all_database_types()) { my $sfunc = $t."_password_synced"; if (defined(&$sfunc) && &$sfunc($d)) { # Definitely is synced push(@rv, $t); } elsif (!defined(&$sfunc)) { # Assume yes for other DB types push(@rv, $t); } } return @rv; } # count_ftp_bandwidth(logfile, start, &bw-hash, &users, prefix, include-rotated) # Scans an FTP server log file for downloads by some user, and returns the # total bytes and time of last log entry. sub count_ftp_bandwidth { local $max_ltime = $_[1]; local $f; foreach $f ($_[5] ? &all_log_files($_[0], $max_ltime) : ( $_[0] )) { local $_; if ($f =~ /\.gz$/i) { open(LOG, "gunzip -c ".quotemeta($f)." |"); } elsif ($f =~ /\.Z$/i) { open(LOG, "uncompress -c ".quotemeta($f)." |"); } else { open(LOG, "<".$f); } while() { if (/^(\S+)\s+(\S+)\s+(\S+)\s+\[(\d+)\/(\S+)\/(\d+):(\d+):(\d+):(\d+)\s+(\S+)\]\s+"([^"]*)"\s+(\S+)\s+(\S+)/) { # ProFTPD extended log format line local $ltime = timelocal($9, $8, $7, $4, $apache_mmap{lc($5)}, $6); $max_ltime = $ltime if ($ltime > $max_ltime); next if ($_[3] && &indexof($3, @{$_[3]}) < 0); # user next if (substr($11, 0, 4) ne "RETR" && substr($11, 0, 4) ne "STOR"); if ($ltime > $_[1]) { local $day = int($ltime / (24*60*60)); $_[2]->{$_[4]."_".$day} += $13; } } 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+)/) { # xferlog format line local $ltime = timelocal($5, $4, $3, $2, $apache_mmap{lc($1)}, $6); $max_ltime = $ltime if ($ltime > $max_ltime); next if ($_[3] && &indexof($9, @{$_[3]}) < 0); # user next if ($8 ne "o" && $8 ne "i"); if ($ltime > $_[1]) { local $day = int($ltime / (24*60*60)); $_[2]->{$_[4]."_".$day} += $7; } } } close(LOG); } return $max_ltime; } # random_password([len]) # Returns a random password of the specified length, or the configured default sub random_password { &seed_random(); &require_useradmin(); my $random_password; my $len = $_[0] || $config{'passwd_length'} || 15; eval "utf8::decode(\$config{'passwd_chars'})" if ($config{'passwd_chars'}); my @passwd_chars = split(//, $config{'passwd_chars'}); if (!@passwd_chars) { @passwd_chars = @useradmin::random_password_chars; } # Number of characters to operate on my $passwd_chars = scalar(@passwd_chars); # Check resulting password and try again # if it doesn't meet the requirements for (my $i = 0; $i < $passwd_chars*100; $i++) { $random_password = ''; foreach (1 .. $len) { $random_password .= $passwd_chars[rand($passwd_chars)]; } return $random_password if (&random_password_validate( \@passwd_chars, $len, $random_password) != 0); } return $random_password; } sub random_password_validate { my ($chars, $len, $pass) = @_; # Define character type checks in a hash my %check = ( uppercase => qr/[A-Z]/, lowercase => qr/[a-z]/, digit => qr/[0-9]/, special => qr/[\@\#\$\%\^\&\*\(\)\_\+\!\-\=\[\]\{\}\;\:\'\"\,\<\.\>\/\?\~\`\\]/, unicode => qr/(?![A-Za-z])\p{L}/, ); # Determine required character types my %required; foreach my $key (keys %check) { # If any character in @$chars matches the regex for this # key, add the key to %required with a value of 1 if (grep { $_ =~ $check{$key} } @$chars) { $required{$key} = 1; } } # Return -1 if the number of required types exceeds the password length return -1 if scalar(keys %required) > $len; # Check if password contains one of each required types my $matches = grep { $pass =~ $check{$_} } keys %required; return 0 unless $matches == keys %required; return 1; } # random_salt([len]) # Returns a crypt-format salt of the given length (default 2 chars) sub random_salt { local $len = $_[0] || 2; &seed_random(); local $rv; local @saltchars = ( 'a' .. 'z', 'A' .. 'Z', 0 .. 9, '.', '/' ); for(my $i=0; $i<$len; $i++) { $rv .= $saltchars[int(rand()*scalar(@saltchars))]; } return $rv; } # try_function(feature, function, arg, ...) # Executes some function, and if it fails prints an error message. In a scalar # context returns 0 if the function failed, 1 otherwise. In an array context, # returns this flag plus the function's actual return value. sub try_function { local ($f, $func, @args) = @_; local $main::error_must_die = 1; local $rv; eval { $rv = &$func(@args) }; if ($@) { &$second_print(&text('setup_failure', $text{'feature_'.$f}, "$@")); return wantarray ? ( 0 ) : 0; } return wantarray ? ( 1, $rv ) : 1; } # bandwidth_period_start([ago]) # Returns the day number on which the current (or some previous) # bandwidth period started sub bandwidth_period_start { local ($ago) = @_; local $now = time(); local $day = int($now / (24*60*60)); local @tm = localtime(time()); local $rv; if ($config{'bw_past'} eq 'week') { # Start on last sunday $rv = $day - $tm[6]; $rv -= $ago*7; } elsif ($config{'bw_past'} eq 'month') { # Start at 1st of month for(my $i=0; $i<$ago; $i++) { $tm[4]--; if ($tm[4] < 0) { $tm[5]--; $tm[4] = 11; } } $rv = int(timelocal(59, 59, 23, 1, $tm[4], $tm[5]) / (24*60*60)); } elsif ($config{'bw_past'} eq 'year') { # Start at start of year $tm[4] -= $ago; $rv = int(timelocal(59, 59, 23, 1, 0, $tm[5]) / (24*60*60)); } else { # Start N days ago $rv = $day - $config{'bw_period'}; $rv -= $ago*$config{'bw_period'}; } return $rv; } # bandwidth_period_end([ago]) # Returns the day number on which some bandwidth period ends (inclusive) sub bandwidth_period_end { local ($ago) = @_; local $now = time(); local $day = int($now / (24*60*60)); if ($ago == 0) { return $day; } local $sday = &bandwidth_period_start($ago); if ($config{'bw_past'} eq 'week') { # 6 days after start return $sday + 6; } elsif ($config{'bw_past'} eq 'month') { # End of the month return &bandwidth_period_start($ago-1)-1; } elsif ($config{'bw_past'} eq 'year') { # End of the year return &bandwidth_period_start($ago-1)-1; } else { return $sday + $config{'bw_period'} - 1; } } # servers_input(name, &ids, &domains, [disabled], [use-multi-select]) # Returns HTML for a multi-server selection field sub servers_input { my ($name, $ids, $doms, $dis, $ms) = @_; my $sz = scalar(@$doms) > 10 ? 10 : scalar(@$doms) < 5 ? 5 : scalar(@$doms); my $opts = [ map { [ $_->{'id'}, &show_domain_name($_) ] } sort { $a->{'dom'} cmp $b->{'dom'} } @$doms ]; my $vals = [ ]; foreach my $id (@$ids) { my $d = &get_domain($id); push(@$vals, [ $id, $d ? &show_domain_name($d) : $id ]); } if ($ms) { return &ui_multi_select($name, $vals, $opts, $sz, 1, $dis); } else { return &ui_select($name, $vals, $opts, $sz, 1, 0, $dis); } } # one_server_input(name, id, &domains, [disabled]) # Returns HTML for a single-server selection field sub one_server_input { local ($name, $id, $doms, $dis) = @_; return &ui_select($name, $id, [ map { [ $_->{'id'}, &show_domain_name($_) ] } sort { $a->{'dom'} cmp $b->{'dom'} } @$doms ], 1, 0, 0, $dis); } # can_monitor_bandwidth(&domain) # Returns 1 if bandwidth monitoring is enabled for some server sub can_monitor_bandwidth { if ($config{'bw_servers'} eq "") { return 1; # always } elsif ($config{'bw_servers'} =~ /^\!(.*)$/) { # List of servers not to check local @ids = split(/\s+/, $1); return &indexof($_[0]->{'id'}, @ids) == -1; } else { # List of servers to check local @ids = split(/\s+/, $config{'bw_servers'}); return &indexof($_[0]->{'id'}, @ids) != -1; } } # Returns 1 if the current user can see mailbox and domain passwords sub can_show_pass { return &master_admin() || &reseller_admin() || $config{'show_pass'}; } # Returns 1 if the user can change his own password. Not shown for root, # because this is done outside of Virtualmin. sub can_passwd { return &reseller_admin() || $access{'edit_passwd'}; } # Returns 1 if the user can enroll for 2fa sub can_2fa { my %miniserv; &get_miniserv_config(\%miniserv); return $miniserv{'twofactor_provider'} && (&reseller_admin() || $access{'edit_passwd'}); } # Returns 1 if the user can change a domain's external IP address sub can_dnsip { return &master_admin() || &reseller_admin() || $access{'edit_dnsip'}; } # Returns 1 if the current user can set the chained certificate path to # anywhere. sub can_chained_cert_path { return &master_admin(); } # Returns 1 if the user can copy a domain's cert to Webmin sub can_webmin_cert { return &master_admin(); } # Returns 1 if the current user can edit allowed remote DB hosts sub can_allowed_db_hosts { return &master_admin() || &reseller_admin() || $access{'edit_allowedhosts'}; } # Returns 2 if the current user can manage all plans, 1 if his own only, # 0 if cannot manage any sub can_edit_plans { return &master_admin() ? 2 : &reseller_admin() && !$access{'noplans'} ? 1 : 0; } # Returns 1 if the current user can edit log file locations sub can_log_paths { return &master_admin(); } # Returns 1 if DNS records can be manually edited sub can_manual_dns { return &master_admin(); } sub can_edit_resellers { return &can_edit_templates() || $access{'createresellers'}; } # has_proxy_balancer(&domain) # Returns 2 if some domain supports proxy balancing to multiple URLs, 1 for # proxying to a single URL, 0 if neither. sub has_proxy_balancer { local ($d) = @_; if ($config{'web'} && !$d->{'alias'} && !$d->{'proxy_pass_mode'}) { # From Apache &require_apache(); if ($apache::httpd_modules{'mod_proxy'} && $apache::httpd_modules{'mod_proxy_balancer'}) { return 2; } elsif ($apache::httpd_modules{'mod_proxy'}) { return 1; } } else { # From plugin, maybe local $p = &domain_has_website($d); return &plugin_defined($p, "feature_supports_web_balancers") ? &plugin_call($p, "feature_supports_web_balancers", $d) : 0; } } # has_proxy_none([&domain]) # Returns 1 if the system supports disabling proxying for some URL sub has_proxy_none { local ($d) = @_; local $p = &domain_has_website($d); if ($p eq 'web') { &require_apache(); return $apache::httpd_modules{'mod_proxy'} >= 2.0; } else { return 1; # Assume OK for plugins } } # has_webmail_rewrite(&domain) # Returns 1 if this system has mod_rewrite, needed for redirecting webmail.$DOM # to port 20000 sub has_webmail_rewrite { local ($d) = @_; local $p = &domain_has_website($d); if ($p eq 'web') { # Check Apache modules &require_apache(); return $apache::httpd_modules{'mod_rewrite'}; } else { # Call plugin return &plugin_defined($p, "feature_supports_webmail_redirect") && &plugin_call($p, "feature_supports_webmail_redirect", $d); } } # has_sni_support([&domain]) # Returns 1 if the webserver supports SNI for SSL cert selection sub has_sni_support { local ($d) = @_; local $p = &domain_has_website($d); if ($p eq 'web') { # Check Apache modules &require_apache(); local @dirs = &list_apache_directives(); local ($sni) = grep { lc($_->[0]) eq lc("SSLStrictSNIVHostCheck") } @dirs; return 1 if ($sni); if ($apache::httpd_modules{'mod_ssl'} >= 2.3 || $apache::httpd_modules{'mod_ssl'} =~ /^2\.2(\d+)/ && $1 >= 12) { # Assume SNI works for Apache 2.2.12 or later return 1; } return 0; } else { # Call plugin return &plugin_defined($p, "feature_supports_sni") && &plugin_call($p, "feature_supports_sni", $d); } } # has_cgi_support([&domain]) # Returns a list of supported cgi modes, which can be 'suexec' and 'fcgiwrap' sub has_cgi_support { my ($d) = @_; my $p = &domain_has_website($d); if ($p eq 'web') { # Check if Apache supports suexec or fcgiwrap my @rv; push(@rv, 'suexec') if (&supports_suexec($d)); if ($d) { push(@rv, 'fcgiwrap') if ($d->{'fcgiwrap_port'}); } else { push(@rv, 'fcgiwrap') if (&supports_fcgiwrap()); } return @rv; } elsif ($p) { # Call plugin function my $supp = &plugin_defined($p, "feature_web_supports_cgi") && &plugin_call($p, "feature_web_supports_cgi", $d); return ('fcgiwrap') if ($supp); } return ( ); } # get_domain_cgi_mode(&domain) # Returns either 'suexec', 'fcgiwrap' or undef depending on how CGI scripts # are being run sub get_domain_cgi_mode { my ($d) = @_; my $p = &domain_has_website($d); if ($p eq 'web') { # Check Apache suexec or fcgiwrap modes if (&get_domain_suexec($d)) { return 'suexec'; } elsif (&get_domain_fcgiwrap($d)) { return 'fcgiwrap'; } return undef; } elsif ($p) { # Check plugin supported mode return &plugin_call($p, "feature_web_get_domain_cgi_mode", $d); } return undef; } # save_domain_cgi_mode(&domain, mode) # Change the mode for executing CGI scripts to either fcgiwrap, suexec or undef # to disable them entirely sub save_domain_cgi_mode { my ($d, $mode) = @_; my $p = &domain_has_website($d); if ($p eq 'web') { &obtain_lock_web($d); if ($mode ne 'fcgiwrap') { &disable_apache_fcgiwrap($d); } if ($mode ne 'suexec') { &disable_apache_suexec($d); } my $err = undef; if ($mode eq 'suexec') { $err = &enable_apache_suexec($d); } elsif ($mode eq 'fcgiwrap') { $err = &enable_apache_fcgiwrap($d); } if (!$err) { $d->{'last_cgimode'} = $mode; &save_domain($d); } &save_domain($d); &release_lock_web($d); return $err; } elsif ($p) { my $err = &plugin_call($p, "feature_web_save_domain_cgi_mode", $d, $mode); if (!$err) { $d->{'last_cgimode'} = $mode; &save_domain($d); } return $err; } else { return "Virtual server does not have a website!"; } } # require_licence() # Reads in the file containing the licence_scheduled function. # Returns 1 if OK, 0 if not sub require_licence { my ($force) = @_; return 0 if (!$virtualmin_pro && !$force); foreach my $ls ("$module_root_directory/virtualmin-licence.pl", $config{'licence_script'}) { if ($ls && -r $ls) { do $ls; if ($@) { &error("Licence script failed : $@"); } return 1; } } return 0; } # setup_licence_cron() # Checks for and sets up the licence checking cron job (if needed) sub setup_licence_cron { if (&require_licence()) { &read_file($licence_status, \%licence); return if (time() - $licence{'last'} < 24*60*60); # checked recently, so no worries # Hasn't been checked from cron for 3 days .. do it now local $job = &find_cron_script($licence_cmd); if (!$job) { # Create $job = { 'mins' => int(rand()*60), 'hours' => int(rand()*24), 'days' => '*', 'months' => '*', 'weekdays' => '*', 'user' => 'root', 'active' => 1, 'command' => $licence_cmd }; } else { # Enforce a proper schedule if ($job->{'mins'} !~ /^\d+$/) { $job->{'mins'} = int(rand()*60); } if ($job->{'hours'} !~ /^\d+$/) { $job->{'hours'} = int(rand()*24); } $job->{'days'} = '*'; $job->{'months'} = '*'; $job->{'weekdays'} = '*'; $job->{'active'} = 1; $job->{'user'} = 'root'; $job->{'command'} = $licence_cmd; } &setup_cron_script($job); } } # check_licence_expired() # Returns 0 if the licence is valid, 1 if not, or 2 if could not be checked, # 3 if expired, the expiry date, error message, number of domain, number # of servers, and auto-renewal flag sub check_licence_expired { return 0 if (!&require_licence()); local %licence; &read_file_cached($licence_status, \%licence); if (time() - $licence{'last'} > 3*24*60*60) { # Hasn't been checked from cron for 3 days .. do it now &update_licence_from_site(\%licence); &write_file($licence_status, \%licence); } return ($licence{'status'}, $licence{'expiry'}, $licence{'err'}, $licence{'doms'}, $licence{'servers'}, $licence{'autorenew'}); } # update_licence_from_site(&licence) # Attempts to validate the license, and updates the given hash ref with # license details. Returns the status code (0=OK, 1=Invalid, 2=Down, 3=Expired) and # error message. sub update_licence_from_site { local ($licence) = @_; local ($status, $expiry, $err, $doms, $servers, $max_servers, $autorenew) = &check_licence_site(); $licence->{'last'} = time(); delete($licence->{'warn'}); if ($status == 2) { # Networking / CGI error. Don't treat this as a failure unless we have # seen it for at least 2 days $licence->{'lastdown'} ||= time(); local $diff = time() - $licence->{'lastdown'}; if ($diff < 2*24*60*60) { # A short-term failure - don't change anything $licence->{'warn'} = $err; return; } } else { delete($licence->{'lastdown'}); } $licence->{'status'} = $status; $licence->{'expiry'} = $expiry; $licence->{'autorenew'} = $autorenew; $licence->{'err'} = $err; if (defined($doms)) { # Only store the max domains if we got something valid back $licence->{'doms'} = $doms; } if (defined($servers)) { # Same for servers $licence->{'used_servers'} = $servers; $licence->{'servers'} = $max_servers; } return ($status, $err); } # check_licence_site() # Calls the function to actually validate the licence, which must return 0 if # valid, 1 if not, or 2 if could not be checked, 3 if expired, the expiry # date, any error message, the max number of domains, number of servers, # maximum servers, and the auto-renewal flag sub check_licence_site { return (0) if (!&require_licence()); local $id = &get_licence_hostid(); my %serial; &read_env_file($virtualmin_license_file, \%serial); local ($status, $expiry, $err, $doms, $max_servers, $servers, $autorenew) = &licence_scheduled($id, undef, undef, &get_vps_type()); if ($status == 0 && $doms) { # A domains limit exists .. check if we have exceeded it local @doms = grep { !$_->{'alias'} } &list_domains(); if (@doms > $doms) { $status = 1; $err = &text('licence_maxdoms', $doms, scalar(@doms)); } } if ($status == 0 && $max_servers && !$err) { # A servers limit exists .. check if we have exceeded it if ($servers > $max_servers+1) { $status = 1; $err = "".&text('licence_maxservers2', $max_servers, $servers, "$serial{'SerialNumber'}").""; $err .= " " . &text('licence_maxwarn', "https://virtualmin.com/shop/", $text{'license_shop_name'}); } } return ($status, $expiry, $err, $doms, $servers, $max_servers, $autorenew); } # get_licence_hostid() # Return a host ID for licence checking, from the hostid command or # MAC address or hostname sub get_licence_hostid { local $id; if (&has_command("hostid")) { $id = &backquote_command("hostid 2>/dev/null"); chop($id); } if (!$id || $id =~ /^0+$/ || $id eq '7f0100') { &foreign_require("net"); local ($iface) = grep { $_->{'fullname'} eq $config{'iface'} } &net::active_interfaces(); $id = $iface->{'ether'} if ($iface); } if (!$id) { $id = &get_system_hostname(); } return $id; } # get_vps_type() # If running under some kind of VPS, return a type code for it. This can be # one of 'xen', 'vserver', 'zones' or undef for none. sub get_vps_type { return defined(&running_in_zone) && &running_in_zone() ? 'zones' : defined(&running_in_vserver) && &running_in_vserver() ? 'vserver' : defined(&running_in_xen) && &running_in_xen() ? 'xen' : undef; } # warning_messages() # Returns HTML for an error messages such as the licence being expired, if it # is and if the current user is the master admin. Also warns about IP changes, # need to reboot, etc. sub warning_messages { my $rv; foreach my $warn (&list_warning_messages()) { $rv .= &ui_alert_box($warn, "warn"); } return $rv; } # list_warning_messages() # Returns all warning messages for the current user as an array sub list_warning_messages { return () if (!&master_admin()); my @rv; # Get licence expiry date local ($status, $expiry, $err, undef, undef, $autorenew) = &check_licence_expired(); local $expirytime; if ($expiry =~ /^(\d+)\-(\d+)\-(\d+)$/) { # Make Unix time eval { $expirytime = timelocal(59, 59, 23, $3, $2-1, $1); }; } if ($status != 0) { my $alert_text; # Not valid .. show message $alert_text .= "".$text{'licence_err'}."
\n"; $alert_text .= $err."\n"; $alert_text .= &text('licence_renew', $virtualmin_renewal_url),"\n" if ($alert_text !~ /$virtualmin_renewal_url/); $alert_text =~ s/>\Q$virtualmin_renewal_url\E$text{'license_shop_name'}".&text('licence_soon', $days)."

\n"; } else { $alert_text .= "".&text('licence_soon2', $hours)."
\n"; } $alert_text .= &text('licence_renew', $virtualmin_renewal_url),"\n"; if (&can_recheck_licence()) { $alert_text .= &ui_form_start("@{[&get_webprefix_safe()]}/$module_name/licence.cgi"); $alert_text .= &ui_submit($text{'licence_recheck'}); $alert_text .= &ui_form_end(); } push(@rv, $alert_text); } # Check if default IP has changed local $defip = &get_default_ip(); if ($config{'old_defip'} && $defip && $config{'old_defip'} ne $defip) { my $alert_text; $alert_text .= "".&text('licence_ipchanged', "$config{'old_defip'}", "$defip")."

\n"; $alert_text .= &ui_form_start("@{[&get_webprefix_safe()]}/$module_name/edit_newips.cgi"); $alert_text .= &ui_hidden("old", $config{'old_defip'}); $alert_text .= &ui_hidden("new", $defip); $alert_text .= &ui_hidden("setold", 1); $alert_text .= &ui_hidden("also", 1); $alert_text .= &ui_submit($text{'licence_changeip'}); $alert_text .= &ui_form_end(); push(@rv, $alert_text); } # Check if in SSL mode, and SSL cert is < 2048 bits local $small; if ($ENV{'HTTPS'} eq 'ON') { local %miniserv; &get_miniserv_config(\%miniserv); local $certfile = $miniserv{'certfile'} || $miniserv{'keyfile'}; if ($certfile) { local $cert = &cert_file_info($certfile); if ($cert->{'algo'} eq 'rsa' && $cert->{'size'} && $cert->{'size'} < 2048) { # Too small! $small = $cert; } } } if ($small) { my $alert_text; local $msg = $small->{'issuer_c'} eq $small->{'c'} && $small->{'issuer_o'} eq $small->{'o'} ? 'licence_smallself' : 'licence_smallcert'; $alert_text .= &text($msg, $small->{'size'}, "$small->{'cn'}", $small->{'issuer_o'}, $small->{'issuer_cn'}, )."

\n"; my $formlink = "@{[&get_webprefix_safe()]}/webmin/edit_ssl.cgi"; my $domid = &get_domain_by('dom', $small->{'cn'}); if ($domid) { $formlink = "@{[&get_webprefix_safe()]}/$module_name/cert_form.cgi?dom=$domid"; } $alert_text .= &ui_form_start($formlink); $alert_text .= &ui_hidden("mode", $msg eq 'licence_smallself' ? 'create' : &is_letsencrypt_cert($small) ? 'lets' : 'csr'); $alert_text .= &ui_submit($msg eq 'licence_smallself' ? $text{'licence_newcert'} : $text{'licence_newcsr'}); $alert_text .= &ui_form_end(); push(@rv, $alert_text); } # Check if symlinks need to be fixed. Blank means not checked yet, 0 means # fixed, 1 means don't fix. if ($config{'allow_symlinks'} eq '') { my $alert_text; # Do any domains have unsafe settings? local @fixdoms = &fix_symlink_security(undef, 1); if (@fixdoms) { $alert_text .= "".&text('licence_fixlinks', scalar(@fixdoms))."

". $text{'licence_fixlinks2'}."

\n"; $alert_text .= &ui_form_start( "@{[&get_webprefix_safe()]}/$module_name/fix_symlinks.cgi"); $alert_text .= &ui_submit($text{'licence_fixlinksok'}, undef); $alert_text .= &ui_submit($text{'licence_fixlinksignore'}, 'ignore'); $alert_text .= &ui_form_end(); push(@rv, $alert_text); } else { # All OK already, don't check again $config{'allow_symlinks'} = 0; &save_module_config(); } } # Suggest that the user switch themes to authentic my @themes = &list_themes(); my ($theme) = grep { $_->{'dir'} eq $recommended_theme } @themes; if ($theme && $current_theme !~ /$recommended_theme/ && !$config{'theme_switch_'.$recommended_theme}) { my $switch_text; $switch_text .= "".&text('index_themeswitch', $theme->{'desc'})."

\n"; $switch_text .= &ui_form_start( "@{[&get_webprefix_safe()]}/$module_name/switch_theme.cgi"); $switch_text .= &ui_submit($text{'index_themeswitchok'}); $switch_text .= &ui_submit($text{'index_themeswitchnot'}, "cancel"); $switch_text .= &ui_form_end(); push(@rv, $switch_text); } # Check for expired SSL certs (if enabled) my (@expired, @nearly); my $now = time(); foreach my $d (&list_domains()) { next if (!$d->{'ssl_cert_expiry'}); next if ($d->{'disabled'}); # Check if cached cert file time is valid my @st = stat($d->{'ssl_cert'}); next if (!@st); next if ($d->{'ssl_cert_expiry_cache'} != $st[9]); # Skip this if the cert isn't being used next if (!&domain_has_ssl_cert($d)); my $anyuse; $anyuse++ if (&domain_has_ssl($d)); if (!$anyuse) { my @svcs = &get_all_domain_service_ssl_certs($d); $anyuse++ if (@svcs); } next if (!$anyuse); # Check if at or near expiry if ($d->{'ssl_cert_expiry'} < $now) { push(@expired, $d); } elsif ($d->{'ssl_cert_expiry'} < $now + 24*60*60) { push(@nearly, $d); } } if (@expired || @nearly) { my $exp; my $cert_text = "$text{'index_certwarn'}

\n"; if (@expired) { $cert_text .= &text('index_certexpired', &domain_ssl_page_links(\@expired)); $exp++; } if (@nearly) { my $nl = $exp ? "
" : ""; $cert_text .= $nl . &text('index_certnearly', &domain_ssl_page_links(\@nearly)); } push(@rv, $cert_text); } # Check for invalid SSL cert files my @badcert; foreach my $d (&list_domains()) { next if (!&domain_has_ssl_cert($d)); my $cerr = &validate_cert_format($d->{'ssl_cert'}, 'cert'); my $kerr = &validate_cert_format($d->{'ssl_key'}, 'key'); if ($cerr) { push(@rv, &text('index_certinvalid', &show_domain_name($d), "".&html_escape($d->{'ssl_cert'})."", $cerr)); } elsif ($kerr) { push(@rv, &text('index_keyinvalid', &show_domain_name($d), "".&html_escape($d->{'ssl_key'})."", $kerr)); } } # Check for impending domain registrar expiry my (@expired, @nearly); foreach my $d (&list_domains()) { next if (!$d->{'whois_expiry'} || !$d->{'dns'}); next if ($d->{'disabled'}); next if ($d->{'whois_ignore'}); # If status collection is disabled and last # config check was done a long time ago or if # already expired and next hasn't been updated # for the passed half an hour, then skip it # considering current records to be stale my $nocoll = $config{'collect_interval'} eq 'none' ? 1 : 0; if ($d->{'whois_next'}) { if ($nocoll && $now > $d->{'whois_next'} || $nocoll && $config{'last_check'} > $d->{'whois_next'} || $config{'whois_expiry'} < $now && $now > $d->{'whois_next'} + 1800) { next; } } # Tell if domain is already expired if ($d->{'whois_expiry'} < $now) { push(@expired, $d); } # Warn 7 days before domain expiry elsif ($d->{'whois_expiry'} < $now + 7*24*60*60) { push(@nearly, $d); } } if (@expired || @nearly) { my $exp; if (@expired) { my $gluechar = ", "; if (scalar(@expired) == 1) { $gluechar = ""; } $expiry_text .= &text('index_expiryexpired', join($gluechar, map { "{'id'}\">@{[&show_domain_name($_)]}" } @expired)); $exp++; } if (@nearly) { my $gluechar = ", "; if (scalar(@nearly) == 1) { $gluechar = ""; } my $nl = $exp ? "
" : ""; $expiry_text .= $nl . &text('index_expirynearly', join($gluechar, map { "{'id'}\">@{[&show_domain_name($_)]}" } @nearly)); } if (@expired || @nearly) { my @edoms; push(@edoms, map { $_->{'dom'} } @expired) if (@expired); push(@edoms, map { $_->{'dom'} } @nearly) if (@nearly); @edoms = &unique(@edoms); my $expiry_form .= &ui_form_start( "@{[&get_webprefix_safe()]}/$module_name/recollect_whois.cgi"); $expiry_form .= &ui_hidden("doms", join(" ", @edoms))."\n". $expiry_form .= &ui_submit($text{'index_drefresh'}); $expiry_form .= &ui_submit($text{'index_dignore'}, "ignore"); $expiry_form .= &ui_form_end(); $expiry_text .= $expiry_form; } push(@rv, $expiry_text); } # Check for active but un-used mod_php if (&master_admin() && !$config{'mod_php_ok'} && $config{'web'} && &get_apache_mod_php_version()) { # Available, but is it used? my $count = 0; foreach my $d (&list_domains()) { if ($d->{'php_mode'} && $d->{'php_mode'} eq 'mod_php') { $count++; } } if (!$count) { my $mod_text = &text('index_disable_mod_php')."

\n"; $mod_text .= &ui_form_start( "@{[&get_webprefix_safe()]}/$module_name/disable_mod_php.cgi"); $mod_text .= &ui_submit($text{'index_disable_mod_phpok'}); $mod_text .= &ui_submit($text{'index_themeswitchnot'}, "cancel"); $mod_text .= &ui_form_end(); push(@rv, $mod_text); } } return @rv; } sub domain_ssl_page_links { my ($doms) = @_; return join(" ", map { &ui_link("@{[&get_webprefix_safe()]}/$module_name/cert_form.cgi?dom=$_->{'id'}", &show_domain_name($_)) } @$doms); } # get_user_domain(user) # Given a username, returns it's virtual server details sub get_user_domain { local @uinfo = getpwnam($_[0]); local @doms; if (@uinfo) { # Is a Unix user .. find the domains for his GID (which could include # sub-servers), and then check the home for each foreach my $d (&get_domain_by("gid", $uinfo[3])) { if ($uinfo[7] =~ /^\Q$d->{'home'}\E\/homes\// || ($d->{'user'} eq $uinfo[0] && !$d->{'parent'})) { return $d; } } } # Need to check all domains :( This is unlikely to happen though local @doms = &list_domains(); foreach my $d (@doms) { local @users = &list_domain_users($d, 0, 1, 1, 1); local $u; foreach $u (@users) { if ($u->{'user'} eq $_[0] || &replace_atsign($u->{'user'}) eq $_[0]) { return $d; } } } return undef; } # get_domain_user_quotas(&domain, ...) # For each virtual server, returns the home and mail directory usage for all its # users (including the server admin), the server admin object, total usage for # all databases, and database usage that has already been included in the # home usage. sub get_domain_user_quotas { local ($duserrv); local $mailquota = 0; local $homequota = 0; local $dbquota = 0; local $dbquota_home = 0; foreach my $d (@_) { local @users = &list_domain_users($d, 0, 1, 0, 1); local ($duser) = grep { $_->{'user'} eq $d->{'user'} } @users; $duserrv ||= $duser; local $u; foreach $u (@users) { if (!$u->{'domainowner'} && !$u->{'webowner'}) { $homequota += $u->{'uquota'}; $mailquota += $u->{'umquota'}; } } local @dbq = &get_database_usage($d); $dbquota += $dbq[0]; $dbquota_home += $dbq[1]; } return ($homequota, $mailquota, $duserrv, $dbquota, $dbquota_home); } # get_domain_quota(&domain, [db-too]) # For a domain, returns the group quota used on home and mail filesystems. # If the db flag is set, also returns the sum of all disk space used by # databases on this and sub-servers. If database usage is already included # in the group quota for home, it is subtracted. All quotas are in blocks. sub get_domain_quota { local ($d, $dbtoo) = @_; local ($home, $mail, $db, $dbq); if (&has_group_quotas()) { # Query actual group quotas my @groups = &list_all_groups_quotas(0); my ($group) = grep { $_->{'group'} eq $d->{'group'} } @groups; if ($group) { $home = $group->{'uquota'}; if ($config{'mail_quotas'}) { $mail = $group->{'umquota'}; } } if ($dbtoo) { $db = 0; foreach my $sd ($d, &get_domain_by("parent", $d->{'id'})) { local @dbu = &get_database_usage($sd); $db += $dbu[0]; $dbq += $dbu[1]; } } $dbq /= "a_bsize("home"); } else { # Fake it by summing up user quotas local $dummy; ($home, $mail, $dummy, $db, $dbq) = &get_domain_user_quotas( $d, &get_domain_by("parent", $d->{'id'})); } return ($home >= $dbq ? $home-$dbq : $home, $mail, $db); } # check_domain_over_quota(&domain) # If a virtual server is over quota, return an error message sub check_domain_over_quota { my ($d) = @_; if ($d->{'parent'}) { my $parent = &get_domain($d->{'parent'}); return &check_domain_over_quota($parent); } if (&has_group_quotas()) { # Check server group quota my $bsize = "a_bsize("home"); my ($homequota, $mailquota) = &get_domain_quota($d); if ($d->{'quota'} && $homequota >= $d->{'quota'}) { return &text('setup_overgroupquota', &nice_size($d->{'quota'}*$bsize), &show_domain_name($d)); } } if (&has_home_quotas()) { # Check domain owner user my $bsize = "a_bsize("home"); my ($homequota, $mailquota, $duser, $dbquota, $dbquota_home) = &get_domain_user_quotas($d); if ($d->{'uquota'} && $duser->{'uquota'} >= $d->{'uquota'}) { return &text('setup_overuserquota', &nice_size($d->{'uquota'}*$bsize), $duser->{'user'}); } } return undef; } # compute_prefix(domain-name, group, [&parent], [creating-flag]) # Given a domain name, returns the prefix for usernames sub compute_prefix { local ($name, $group, $parent, $creating) = @_; my $config_longname = $config{'longname'}; if ($config_longname != 1) { $name =~ s/^xn(-+)//; # Strip IDN part } if ($config_longname == 1) { # Prefix is same as domain name return $name; } elsif ($group && !$parent && !$config_longname) { # For top-level domains, prefix is same as group name (but append a # number if there's a clash) my $rv = $group; if ($creating) { my $sfx; while(&get_domain_by("prefix", $rv)) { $sfx++; $rv = $group.$sfx; } } return $rv; } else { # Otherwise, prefix comes from first part of domain. If this clashes, # use the second part too and so on local @p = split(/\./, $name); local $prefix; if ($creating) { # Extract prefix based on the user pattern if ($config_longname && $config_longname !~ /^[0-9]$/) { $prefix = &generate_random_available_user($config_longname); } else { # First try foo, then foo.com, then foo.com.au for(my $i=0; $i<@p; $i++) { local $testp = join("-", @p[0..$i]); local $pclash = &get_domain_by("prefix", $testp); if (!$pclash) { $prefix = $testp; last; } } # If none of those worked, append a number if (!$prefix) { my $i = 1; while(1) { local $testp = $p[0].$i; local $pclash = &get_domain_by("prefix",$testp); if (!$pclash) { $prefix = $testp; last; } $i++; } } } } return $prefix || $p[0]; } } # get_domain_owner(&domain, [skip-virts, [skip-quotas, skip-dbs]]) # Returns the Unix user object for a server's owner. Quota, DB and virtuser # details will be omitted if the skip flag is set. sub get_domain_owner { local ($d, $novirts, $noquotas, $nodbs) = @_; $noquotas = $novirts if (!defined($noquotas)); $nodbs = $novirts if (!defined($nodbs)); if ($d->{'parent'}) { local $parent = &get_domain($d->{'parent'}); if ($parent) { return &get_domain_owner($parent, $noinfo); } return undef; } else { local @users = &list_domain_users($d, 0, $novirts, $noquotas, $nodbs); local ($user) = grep { $_->{'user'} eq $_[0]->{'user'} } @users; return $user; } } # get_domain_shell(&domain, [&user]) # Return the real shell for a domain's unix user sub get_domain_shell { my ($d, $user) = @_; $user ||= &get_domain_owner($d, 1, 1, 1); if ($user->{'shell'} =~ /\/jk_chrootsh$/) { return $d->{'unjailed_shell'}; } else { return $user->{'shell'}; } } # change_domain_shell(&domain, shell-path) # Change the shell for a domain user, taking chroot into account sub change_domain_shell { my ($d, $shell) = @_; my $user = &get_domain_owner($d); my $olduser = { %$user }; if ($user->{'shell'} =~ /\/jk_chrootsh$/) { $d->{'unjailed_shell'} = $shell; &save_domain($d); } else { $user->{'shell'} = $shell; } &modify_user($user, $olduser, $d); } # new_password_input(name) # Returns HTML for a password selection field sub new_password_input { local ($name) = @_; if ($config{'passwd_mode'} == 1) { # Random but editable password return &vui_noauto_textbox($name, &random_password(), 21); } elsif ($config{'passwd_mode'} == 0) { # One hidden password return &vui_noauto_password($name, undef, 21); } elsif ($config{'passwd_mode'} == 2) { # Two hidden passwords return "

". &vui_noauto_password($name, undef, undef, 0, undef, " placeholder='$text{'form_passf'}'"). &vui_noauto_password($name."_again", undef, undef, 0, undef, " data-password-again placeholder='$text{'form_passa'}'")."
\n"; } } # parse_new_password(name, allow-empty) # Returns the entered or randomly generated password sub parse_new_password { local ($name, $empty) = @_; $empty || $in{$name} =~ /\S/ || &error($text{'setup_epass'}); if (defined($in{$name."_again"}) && $in{$name} ne $in{$name."_again"}) { &error($text{'setup_epassagain'}); } return $in{$name}; } # get_disable_features(&domain) # Given a domain, returns a list of features that can be disabled for it sub get_disable_features { local ($d) = @_; local @disable; @disable = grep { $d->{$_} && $config{$_} } split(/,/, $config{'disable'}); push(@disable, "ssl") if (&indexof("web", @disable) >= 0 && $d->{'ssl'}); push(@disable, "status") if (&indexof("web", @disable) >= 0 && $d->{'status'}); @disable = grep { $_ ne "unix" } @disable if ($d->{'parent'}); push(@disable, grep { $d->{$_} && &plugin_defined($_, "feature_disable") } &list_feature_plugins()); return &unique(@disable); } # get_enable_features(&domain) # Given a domain, returns a list of features that should be enabled for it sub get_enable_features { local ($d) = @_; local @enable; local @disabled = split(/,/, $d->{'disabled'}); local %disabled = map { $_, 1 } @disabled; @enable = grep { $d->{$_} && ($config{$_} || $_ eq 'unix') } @disabled; push(@enable, "ssl") if (&indexof("web", @enable) >= 0 && $d->{'ssl'}); @enable = grep { $_ ne "unix" } @enable if ($d->{'parent'}); push(@enable, grep { $d->{$_} && $disabled{$_} && &plugin_defined($_, "feature_enable") } &list_feature_plugins()); return &unique(@enable); } # get_python_version([path]) # Return current Python version, if instaled sub get_python_version { my ($python_pathpath) = @_; $python_pathpath ||= get_python_path(); my $python_version; my $out = &backquote_command("$python_pathpath --version 2>&1", 1); $python_version = $1 if ($out =~ /Python\s+(.*)/i); return $python_version; } # get_usermin_version() # Return current Usermin version, if instaled sub get_usermin_version { return 0 if (!&foreign_check("usermin")); &foreign_require("usermin"); return &usermin::get_usermin_version(); } # sysinfo_virtualmin() # Returns the OS info, Perl version and path sub sysinfo_virtualmin { my @sysinfo_virtualmin; # OS and Perl info if ($main::sysinfo_virtualmin_self) { # Add Webmin version; add Usermin version, if installed my %systemstatustext = &load_language('system-status'); push(@sysinfo_virtualmin, [ $systemstatustext{'right_webmin'}, &get_webmin_version() ] ); my $um_ver = &get_usermin_version(); if ($um_ver) { push(@sysinfo_virtualmin, [ $systemstatustext{'right_usermin'}, $um_ver ] ); } # Add Virtualmin version push(@sysinfo_virtualmin, [ $text{'right_virtualmin'}, &get_module_version_and_type() ] ); # Add Cloudmin version, if installed if (&foreign_installed("server-manager")) { &foreign_require("server-manager"); if (defined(&server_manager::get_module_version_and_type)) { my $cm_ver = &server_manager::get_module_version_and_type(); if ($cm_ver) { my %cmtext = &load_language('server-manager'); push(@sysinfo_virtualmin, [ $cmtext{'right_vm2'}, $cm_ver ] ); } } } } my @basic_info; if (!&master_admin() && !$main::sysinfo_virtualmin_self) { push(@basic_info, ( [ $text{'sysinfo_os'}, "$gconfig{'real_os_type'} $gconfig{'real_os_version'}" ] ) ); } push(@basic_info, ( [ $text{'sysinfo_perl'}, $] ], [ $text{'sysinfo_perlpath'}, &get_perl_path() ] ) ); push(@sysinfo_virtualmin, @basic_info); # Python, if exists my $python_version = &get_python_version(); if ($python_version) { push(@sysinfo_virtualmin, [ $text{'sysinfo_python'}, $python_version ], [ $text{'sysinfo_pythonpath'}, &get_python_path() ]); } return @sysinfo_virtualmin; } # has_home_quotas() # Returns 1 if home directory quotas are enabled sub has_home_quotas { return 1 if (&has_quota_commands()); return $config{'home_quotas'} ? 1 : 0; } # has_mail_quotas() # Returns 1 if mail directory quotas are enabled, and needed sub has_mail_quotas { return 0 if (&has_quota_commands()); return $config{'mail_quotas'} && $config{'mail_quotas'} ne $config{'home_quotas'} ? 1 : 0; } # has_server_quotas() # Returns 1 if the system's mail server supports mail quotas sub has_server_quotas { return $config{'mail'} && $config{'mail_system'} == 5; } # has_group_quotas() # Returns 1 if group quotas are enabled sub has_group_quotas { return 1 if (&has_quota_commands()); return $config{'group_quotas'} ? 1 : 0; } # has_quota_commands() # Returns 1 if external quota commands are being used sub has_quota_commands { return $config{'quota_commands'} ? 1 : 0; } # has_quotacheck() # Returns 1 if the home or mail filesystems support quota checking sub has_quotacheck { &foreign_require("mount"); my @mounted = &mount::list_mounted(); my ($hm) = grep { $_->[0] eq $config{'home_quotas'} } @mounted; return 1 if ($hm && $hm->[2] ne 'xfs'); if ($config{'mail_quotas'}) { my ($mm) = grep { $_->[0] eq $config{'mail_quotas'} } @mounted; return 1 if ($mm && $mm->[2] ne 'xfs'); } return 0; } # get_database_usage(&domain) # Returns the number of bytes used by all this virtual server's databases. If # called in a array context, database space already counted by the quota system # is also returned. sub get_database_usage { local ($d) = @_; local $rv = 0; local $qrv = 0; foreach my $db (&domain_databases($d, [ 'mysql', 'postgres' ])) { local ($size, $qsize) = &get_one_database_usage($d, $db); $rv += $size; $qrv += $qsize; } return wantarray ? ($rv, $qrv) : $rv; } # get_one_database_usage(&domain, &db) # Returns the disk space used by one database, the table count, the amount of # space that is already counted by the quota system, and the file count. sub get_one_database_usage { local ($d, $db) = @_; if ($db->{'type'} eq 'mysql' || $db->{'type'} eq 'postgres') { # Get size from core database local $szfunc = $db->{'type'}."_size"; local ($size, $tables, $qsize, $count) = &$szfunc($d, $db->{'name'}, 0); return ($size, $tables, $qsize, $count); } else { # Get size from plugin local ($size, $tables, $qsize, $count) = &plugin_call($db->{'type'}, "database_size", $d, $db->{'name'}, 0); return ($size, $tables, $qsize, $count); } } # need_config_check() # Compares the current and previous configs, and returns 1 if a re-check is # needed due to any checked option changing. sub need_config_check { local @cst = stat($module_config_file); return 0 if ($cst[9] <= $config{'last_check'}); local %lastconfig; &read_file("$module_config_directory/last-config", \%lastconfig) || return 1; foreach my $f (@features) { # A feature was enabled or disabled return 1 if ($config{$f} != $lastconfig{$f}); } foreach my $c ("mail_system", "generics", "bccs", "append_style", "ldap_host", "ldap_base", "ldap_login", "ldap_pass", "ldap_port", "ldap", "vpopmail_dir", "vpopmail_user", "vpopmail_group", "clamscan_cmd", "iface", "netmask6", "localgroup", "home_quotas", "mail_quotas", "group_quotas", "quotas", "shell", "ftp_shell", "dns_ip", "default_procmail", "compression", "pbzip2", "domains_group", "quota_commands", "home_base", "quota_set_user_command", "quota_set_group_command", "quota_list_users_command", "quota_list_groups_command", "quota_get_user_command", "quota_get_group_command", "preload_mode", "collect_interval", "api_helper", "spam_lock", "spam_white", "mem_low", "lookup_domain_serial") { # Some important config option was changed return 1 if ($config{$c} ne $lastconfig{$c}); } foreach my $k (keys %config) { if ($k =~ /^avail_/ || $k eq 'leave_acl' || $k eq 'webmin_modules' || $k eq 'post_check') { # An option effecting Webmin users return 1 if ($config{$k} ne $lastconfig{$k}); } } return 0; } # update_secondary_groups(&domain, [&users]) # After a user is saved, updated or deleted, update the secondary groups # specified in it's template with the appropriate users. sub update_secondary_groups { local ($dom, $users) = @_; local $tmpl = &get_template($dom->{'template'}); # See if this feature is actually configured my $any = 0; foreach my $g ("mailgroup", "ftpgroup", "dbgroup") { local $gn = $tmpl->{$g}; $any++ if ($gn && $gn ne "none"); } return 0 if (!$any); # Get the current user and group lists $users ||= [ &list_domain_users($dom) ]; local %indom = map { $_->{'user'}, 1 } @$users; &require_useradmin(); local @groups = &list_all_groups(); local %gtaken; &build_group_taken(\%gtaken, undef, \@groups); local %taken; &build_taken(undef, \%taken); # Find FTP-capable shells local %shellmap = map { $_->{'shell'}, $_->{'id'} } &list_available_shells(); foreach my $g ("mailgroup", "ftpgroup", "dbgroup") { local $gn = $tmpl->{$g}; next if (!$gn || $gn eq "none"); local @inusers; # Work out who is in the group if ($g eq "mailgroup") { @inusers = grep { $_->{'unix'} && $_->{'email'} } @$users; } elsif ($g eq "ftpgroup") { @inusers = grep { $_->{'unix'} && $shellmap{$_->{'shell'}} && $shellmap{$_->{'shell'}} ne 'nologin' } @$users; } elsif ($g eq "dbgroup") { @inusers = grep { $_->{'unix'} && @{$_->{'dbs'}} > 0 || $_->{'domainowner'} && $dom->{'mysql'} } @$users; } local @innames = map { $_->{'user'} } @inusers; local %innames = map { $_, 1 } @innames; # Get the group local ($group) = grep { $_->{'group'} eq $gn } @groups; if ($group) { # Update the secondary members, removing any users who don't # exist or are in this domain but shouldn't be there. local @mems = split(/,/, $group->{'members'}); @mems = grep { !($indom{$_} && !$innames{$_}) } @mems; @mems = &unique(@mems, @innames); @mems = grep { $taken{$_} } @mems; $group->{'members'} = join(",", @mems); &foreign_call($group->{'module'}, "modify_group", $group, $group); } else { # Need to create! $group = { 'group' => $gn, 'gid' => &allocate_gid(\%gtaken), 'members' => join(",", @innames) }; &foreign_call($usermodule, "create_group", $group); $gtaken{$group->{'gid'}} = 1; } } } # allowed_secondary_groups([&domain]) # Returns a list of secondary groups that users in some domain can belong to sub allowed_secondary_groups { if ($_[0] && ($tmpl = &get_template($_[0]->{'template'})) && $tmpl->{'othergroups'} && $tmpl->{'othergroups'} ne 'none') { return split(/\s+/, $tmpl->{'othergroups'}); } return ( ); } # compression_format(file, [&key]) # Returns 0 if uncompressed, 1 for gzip, 2 for compress, 3 for bzip2 or # 4 for zip, 5 for tar, 6 for zstd sub compression_format { local ($file, $key) = @_; if ($key) { open(BACKUP, &backup_decryption_command($key)." ". quotemeta($file)." 2>/dev/null |"); } else { open(BACKUP, "<".$file); } local $two; read(BACKUP, $two, 2); close(BACKUP); local $rv = $two eq "\037\213" ? 1 : $two eq "\037\235" ? 2 : $two eq "PK" ? 4 : $two eq "BZ" ? 3 : 0; if (!$rv) { # Fall back to 'file' command for tar local $out = &backquote_command("file ".quotemeta($_[0])); if ($out =~ /tar\s+archive/i) { $rv = 5; } elsif ($out =~ /zstandard\s+compressed/i) { $rv = 6; } } return $rv; } # extract_compressed_file(file, [destdir]) # Extracts the contents of some compressed file to the given directory. Returns # undef if OK, or an error message on failure. # If the directory is not given, a test extraction is done instead. sub extract_compressed_file { local ($file, $dir) = @_; local $format = &compression_format($file); local $tar = &get_tar_command(); local $bunzip2 = &get_bunzip2_command(); local @needs = ( undef, [ "gunzip", $tar ], [ "uncompress", $tar ], [ $bunzip2, $tar ], [ "unzip" ], [ "tar" ], [ "unzstd" ], ); foreach my $n (@{$needs[$format]}) { my ($noargs) = split(/\s+/, $n); &has_command($noargs) || return &text('addstyle_ecmd', "$n"); } local ($qfile, $qdir) = ( quotemeta($file), quotemeta($dir) ); local @cmds; if ($dir) { # Actually extract @cmds = ( undef, "cd $qdir && gunzip -c $qfile | ". &make_tar_command("xf", "-"), "cd $qdir && uncompress -c $qfile | ". &make_tar_command("xf", "-"), "cd $qdir && $bunzip2 -c $qfile | ". &make_tar_command("xf", "-"), "cd $qdir && unzip $qfile", "cd $qdir && ". &make_tar_command("xf", $file), "cd $qdir && unzstd -d -c $qfile | ". &make_tar_command("xf", "-") ); } else { # Just do a test listing @cmds = ( undef, "gunzip -c $qfile | ". &make_tar_command("tf", "-"), "uncompress -c $qfile | ". &make_tar_command("tf", "-"), "$bunzip2 -c $qfile | ". &make_tar_command("tf", "-"), "unzip -l $qfile", &make_tar_command("tf", $file), "unzstd --test $qfile", ); } $cmds[$format] || return "Unknown compression format"; local $out = &backquote_command("($cmds[$format]) 2>&1 ".&html_escape($out)."
") : undef; } # get_compressed_file_size(file, [&key]) # Returns the un-compressed size of a file in bytes, or undef if it cannot # be determined sub get_compressed_file_size { local ($file, $key) = @_; return undef if ($key); # Too expensive to decrypt and check my $fmt = &compression_format($file, $key); my @st = stat($file); if ($fmt == 0) { # Not compressed at all return $st[7]; } elsif ($fmt == 1) { # Gzip compressed my $out = &backquote_command("gunzip -l ".quotemeta($file)); return undef if ($?); return $out =~ /\d+\s+(\d+)\s+[0-9\.]+%/ ? $1 : undef; } elsif ($fmt == 2) { # Classic compress - no idea how to handle return undef; } elsif ($fmt == 3) { # Bzip2 compressed - no way to estimate return undef; } elsif ($fmt == 4) { # Zip format - can sum up files my $out = &backquote_command("unzip -l ".quotemeta($file)); return undef if ($?); my $rv = 0; foreach my $l (split(/\r?\n/, $out)) { if ($l =~ /^\s*(\d+)\s+(\d+-\d+-\d+)/) { $rv += $1; } } return $rv; } elsif ($fmt == 5) { # TAR format doesn't compress return $st[7]; } return undef; } # features_sort(\@features_values, \@features_order) # Sorts features based on given pre-sorted list, # and fills unlisted based on initial sorting sub features_sort { my ($features_values, $features_order) = @_; my @order_manual = ('unix', 'dir', 'dns', 'virtualmin-slavedns', 'virtualmin-powerdns', 'web', 'ssl', 'virtualmin-nginx', 'virtualmin-nginx-ssl', 'mysql', 'postgres', 'virtualmin-sqlite', 'virtualmin-oracle', 'mail', 'spam', 'virus', 'virtualmin-mailrelay', 'virtualmin-mailman', 'virtualmin-signup', 'logrotate', 'status', 'webalizer', 'webmin', 'virtualmin-awstats', 'virtualmin-notes', 'virtualmin-google-analytics', 'virtualmin-init', 'virtualmin-dav', 'virtualmin-registrar', 'virtualmin-disable', 'virtualmin-git', 'virtualmin-svn', 'virtualmin-messageoftheday', 'virtualmin-htpasswd', 'ftp', 'virtualmin-vsftpd', 'virtualmin-support', ); my @order_initial = @{$features_order}; my %ordered_; my @ordered; my @unordered; for my $i (0 .. $#order_initial) { # Store all features $ordered_{$order_initial[$i]} = $features_values->[$i]; # Unordered keys if (! grep( /^$order_initial[$i]$/, @order_manual ) ) { push(@unordered, $features_values->[$i]); } } # Sort ordered based on manual sorting for my $i (0 .. $#order_manual) { my $__ = $ordered_{$order_manual[$i]}; push(@ordered, $__) if ($__); } # Combine both and modify original my @ordered_combined = (@ordered, @unordered); @$features_values = @ordered_combined; } # feature_links(&domain) # Returns a list of links for editing specific features within a domain, such # as the DNS zone, apache config and so on. Includes plugins. sub feature_links { local ($d) = @_; local @rv; # Check cache for feature links local $v = [ 'time' => $d->{'lastsave'}, 'last_check' => $config{'last_check'}, 'plugins' => \@plugins, 'features' => \@config_features ]; local $ckey = $d->{'id'}."-links-".$base_remote_user; local $crv = &get_links_cache($ckey, $v); my $modify_plugin_category = sub { my ($l) = @_; if ($l->{'mod'} =~ /virtualmin-(init|oracle|svn|git)/ || ($l->{'cat'} eq 'services' && $l->{'mod'} eq 'virtualmin-awstats')) { $l->{'cat'} = 'server'; } elsif ($l->{'mod'} =~ /virtualmin-(mailman|mailrelay)/) { $l->{'cat'} = 'mail'; } elsif ($l->{'mod'} =~ /virtualmin-(htpasswd|dav)/ || ($l->{'cat'} eq 'services' && $l->{'mod'} eq 'virtualmin-nginx')) { $l->{'cat'} = 'web'; } elsif ($l->{'mod'} eq 'virtualmin-slavedns') { $l->{'cat'} = 'dns'; } elsif ($l->{'mod'} eq 'virtualmin-registrar') { $l->{'cat'} = 'dnsreg'; } }; if ($crv) { return @$crv; } # Links provided by features, like editing DNS records foreach my $f (@features) { my $lfunc = "links_".$f; if ($d->{$f} && defined(&$lfunc)) { foreach my $l (&$lfunc($d)) { if (&foreign_available($l->{'mod'})) { $l->{'title'} ||= $l->{'desc'}; push(@rv, $l); } } } my $lafunc = "links_always_".$f; if (defined(&$lafunc)) { foreach my $l (&$lafunc($d)) { if (&foreign_available($l->{'mod'})) { $l->{'title'} ||= $l->{'desc'}; push(@rv, $l); } } } } # Links provided by plugins, like Mailman mailing lists foreach my $f (@plugins) { if ($d->{$f}) { foreach my $l (&plugin_call($f, "feature_links", $d)) { if (&foreign_available($l->{'mod'})) { $l->{'title'} ||= $l->{'desc'}; $l->{'plugin'} = 1; &$modify_plugin_category($l); push(@rv, $l); } } } foreach my $l (&plugin_call($f, "feature_always_links", $d)) { if (&foreign_available($l->{'mod'})) { $l->{'title'} ||= $l->{'desc'}; $l->{'plugin'} = 2; &$modify_plugin_category($l); push(@rv, $l); } } } # Links to other Webmin modules, for domain owners if (!&master_admin() && !&reseller_admin()) { local @ot; foreach my $k (keys %config) { if ($k =~ /^avail_(\S+)$/ && &indexof($1, @features) < 0 && &indexof($1, @plugins) < 0 && $1 !~ /(phpini|webminlog|filemin)/) { my $mod = $1; if (&foreign_available($mod)) { local %minfo = &get_module_info($mod); push(@ot, { 'mod' => $mod, 'page' => 'index.cgi', 'title' => $minfo{'desc'}, 'desc' => $minfo{'desc'}, 'cat' => 'webmin', 'other' => 1 }); } } } @ot = sort { lc($a->{'desc'}) cmp lc($b->{'desc'}) } @ot; push(@rv, @ot); } &save_links_cache($ckey, $v, \@rv); return @rv; } # show_domain_buttons(&domain) # Print all the buttons for actions that can be taken on a server sub show_domain_buttons { local ($d) = @_; local ($anyrow1, $anyrow2, $anyrow3); print &ui_buttons_start(); # Get the actions and work out categories local @buts = &get_domain_actions($d); local @cats = &unique(map { $_->{'cat'} } @buts); # Show by category foreach my $c (@cats) { local @incat = grep { $_->{'cat'} eq $c } @buts; print &ui_buttons_hr($text{'cat_'.$c}); foreach my $b (@incat) { print &ui_buttons_row($b->{'page'}, $b->{'title'}, $b->{'desc'}, &ui_hidden("dom", $d->{'id'})."\n". join("\n", map { &ui_hidden($_->[0], $_->[1]) } @{$b->{'hidden'}})); } } print &ui_buttons_end(); } # get_domain_actions(&domain) # Returns a list of actions that can be taken for some virtual server sub get_domain_actions { local ($d) = @_; local @rv; # Check cache for domain actions local $v = [ 'time' => $d->{'lastsave'}, 'last_check' => $config{'last_check'}, 'plugins' => \@plugins, 'features' => \@config_features ]; local $ckey = $d->{'id'}."-actions-".$base_remote_user; local $crv = &get_links_cache($ckey, $v); if ($crv) { return @$crv; } if (&can_domain_have_users($d) && &can_edit_users()) { # Users button push(@rv, { 'page' => 'list_users.cgi', 'title' => $text{'edit_users'}, 'desc' => $text{'edit_usersdesc'}, 'cat' => 'objects', 'icon' => 'group', }); } if ($d->{'mail'} && $config{'mail'} && &can_edit_aliases() && !$d->{'aliascopy'}) { # Mail aliases button push(@rv, { 'page' => 'list_aliases.cgi', 'title' => $text{'edit_aliases'}, 'desc' => $text{'edit_aliasesdesc'}, 'cat' => 'mail', }); } if (&database_feature($d) && &can_edit_databases()) { # MySQL and PostgreSQL DBs button push(@rv, { 'page' => 'list_databases.cgi', 'title' => $text{'edit_databases'}, 'desc' => $text{'edit_databasesdesc'}, 'cat' => 'objects', 'icon' => 'database', }); } if (&can_domain_have_scripts($d) && &can_edit_scripts()) { # Scripts button push(@rv, { 'page' => 'list_scripts.cgi', 'title' => $text{'edit_scripts'}, 'desc' => $text{'edit_scriptsdesc'}, 'cat' => 'objects', 'icon' => 'page_code', }); } if (&can_rename_domains()) { # Rename domain button push(@rv, { 'page' => 'rename_form.cgi', 'title' => $text{'edit_rename'}, 'desc' => $text{'edit_renamedesc'}, 'cat' => 'server', 'icon' => 'comment_edit', }); } if (&can_move_domain($d) && !$d->{'subdom'}) { # Move sub-server to different owner, or turn parent into sub push(@rv, { 'page' => 'move_form.cgi', 'title' => $text{'edit_move'}, 'desc' => $d->{'parent'} ? $text{'edit_movedesc2'} : $text{'edit_movedesc'}, 'cat' => 'server', 'icon' => 'arrow_right', }); } if (&can_transfer_domain($d)) { # Send server to another system push(@rv, { 'page' => 'transfer_form.cgi', 'title' => $text{'edit_transfer'}, 'desc' => $text{'edit_transferdesc'}, 'cat' => 'server', 'icon' => 'arrow_right', }); } if ($d->{'parent'} && &can_create_sub_servers() || !$d->{'parent'} && &can_create_master_servers()) { # Clone server push(@rv, { 'page' => 'clone_form.cgi', 'title' => $text{'edit_clone'}, 'desc' => $text{'edit_clonedesc'}, 'cat' => 'server', 'icon' => 'arrow_right', }); } if (&can_config_domain($d) && $d->{'subdom'}) { # Turn sub-domain into sub-server push(@rv, { 'page' => 'unsub.cgi', 'title' => $text{'edit_unsub'}, 'desc' => $text{'edit_unsubdesc'}, 'cat' => 'server', 'icon' => 'arrow_right', }); } if (&can_config_domain($d) && $d->{'alias'}) { # Turn alias server into sub-server push(@rv, { 'page' => 'unalias.cgi', 'title' => $text{'edit_unalias'}, 'desc' => $text{'edit_unaliasdesc'}, 'cat' => 'server', 'icon' => 'arrow_right', }); } if (&can_change_ip($d) && !$d->{'alias'}) { # Change IP / port button push(@rv, { 'page' => 'newip_form.cgi', 'title' => $text{'edit_newip'}, 'desc' => $text{'edit_newipdesc'}, 'cat' => 'server', 'icon' => 'connect', }); } local $parentdom = $d->{'parent'} ? &get_domain($d->{'parent'}) : undef; local $unixer = $parentdom || $d; if (&can_create_sub_servers() && !$d->{'alias'} && $unixer->{'unix'}) { # Domain alias and sub-domain buttons local ($dleft, $dreason, $dmax) = &count_domains("realdoms"); local ($aleft, $areason, $amax) = &count_domains("aliasdoms"); if ($dleft != 0 && &can_create_sub_servers() && !$d->{'parent'}) { # Sub-server push(@rv, { 'page' => 'domain_form.cgi', 'title' => $text{'edit_subserv'}, 'desc' => &text('edit_subservesc', $d->{'dom'}), 'hidden' => [ [ "parentuser1", $d->{'user'} ], [ "add1", 1 ] ], 'cat' => 'create', }); } if ($aleft != 0) { # Alias domain push(@rv, { 'page' => 'domain_form.cgi', 'title' => $text{'edit_alias'}, 'desc' => $text{'edit_aliasdesc'}, 'hidden' => [ [ "to", $d->{'id'} ] ], 'cat' => 'create', }); } if (!$d->{'subdom'} && $dleft != 0 && $virtualmin_pro && &can_create_sub_domains()) { # Sub-domain push(@rv, { 'page' => 'domain_form.cgi', 'title' => $text{'edit_subdom'}, 'desc' => &text('edit_subdomdesc', $d->{'dom'}), 'hidden' => [ [ "parentuser1", $d->{'user'} ], [ "add1", 1 ], [ "subdom", $d->{'id'} ] ], 'cat' => 'create', }); } } if ($d->{'dir'} && &can_edit_ssl() && !$d->{'alias'}) { # SSL options page button push(@rv, { 'page' => 'cert_form.cgi', 'title' => $text{'edit_catcert'}, 'desc' => $text{'edit_certdesc'}, 'cat' => 'server', }); } if ($d->{'unix'} && &can_edit_limits($d) && !$d->{'alias'}) { # Domain limits button push(@rv, { 'page' => 'edit_limits.cgi', 'title' => $text{'edit_limits'}, 'desc' => $text{'edit_limitsdesc'}, 'cat' => 'server', }); } if ($d->{'unix'} && defined(&supports_resource_limits) && &supports_resource_limits() && &can_edit_res($d)) { # Resource limits button push(@rv, { 'page' => 'pro/edit_res.cgi', 'title' => $text{'edit_res'}, 'desc' => $text{'edit_resdesc'}, 'cat' => 'server', }); } if (!$d->{'parent'} && &can_edit_admins($d)) { # Extra admins buttons push(@rv, { 'page' => 'list_admins.cgi', 'title' => $text{'edit_admins'}, 'desc' => $text{'edit_adminsdesc'}, 'cat' => 'server', }); } if (!$d->{'parent'} && $d->{'webmin'} && &can_switch_user($d)) { # Button to switch to the domain's admin push(@rv, { 'page' => 'switch_user.cgi', 'title' => $text{'edit_switch'}, 'desc' => $text{'edit_switchdesc'}, 'cat' => 'server', 'target' => '_top', }); } if (&domain_has_website($d) && !$d->{'alias'} && &can_edit_forward()) { # Proxying / frame forward configuration button local $mode = $d->{'proxy_pass_mode'} || $config{'proxy_pass'}; local $psuffix = $mode == 2 ? "frame" : "proxy"; push(@rv, { 'page' => $psuffix.'_form.cgi', 'title' => $text{'edit_'.$psuffix}, 'desc' => $text{'edit_'.$psuffix.'desc'}, 'cat' => 'web', }); } if (&has_proxy_balancer($d) && &can_edit_forward()) { # Proxy balance editor push(@rv, { 'page' => 'list_balancers.cgi', 'title' => $text{'edit_balancer'}, 'desc' => $text{'edit_balancerdesc'}, 'cat' => 'web', }); } # Alias and redirects editor if (&has_web_redirects($d) && &can_edit_redirect() && !$d->{'alias'}) { push(@rv, { 'page' => 'list_redirects.cgi', 'title' => $text{'edit_redirects'}, 'desc' => $text{'edit_redirectsdesc'}, 'cat' => 'web', }); } if (($d->{'spam'} && $config{'spam'} || $d->{'virus'} && $config{'virus'}) && &can_edit_spam()) { # Spam/virus delivery button push(@rv, { 'page' => 'edit_spam.cgi', 'title' => $text{'edit_spamvirus'}, 'desc' => $text{'edit_spamvirusdesc'}, 'cat' => 'mail', }); } if (&domain_has_website($d) && !$d->{'alias'}) { # Website / PHP options buttons if (&can_edit_phpmode()) { push(@rv, { 'page' => 'edit_website.cgi', 'title' => $text{'edit_website'}, 'desc' => $text{'edit_websitedesc'}, 'cat' => 'web', }); } if (&can_edit_phpmode() || &can_edit_phpver()) { push(@rv, { 'page' => 'edit_phpmode.cgi', 'title' => $text{'edit_php'}, 'desc' => $text{'edit_phpdesc'}, 'cat' => 'web', }); } } if ($d->{'dns'} && !$d->{'dns_submode'} && $config{'dns'} && &can_edit_spf($d)) { # SPF settings button push(@rv, { 'page' => 'edit_spf.cgi', 'title' => $text{'edit_spf'}, 'desc' => $text{'edit_spfdesc'}, 'cat' => 'dns', }); } if (&can_edit_records($d) && !©_alias_records($d)) { if ($d->{'dns'}) { # DNS edit records button push(@rv, { 'page' => 'list_records.cgi', 'title' => $text{'edit_records'}, 'desc' => $text{'edit_recordsdesc'}, 'cat' => 'dns', }); } elsif (!$d->{'subdom'}) { # DNS suggested records button push(@rv, { 'page' => 'view_records.cgi', 'title' => $text{'edit_viewrecords'}, 'desc' => $text{'edit_viewrecordsdesc'}, 'cat' => 'dns', }); } } &require_mail(); if ($d->{'mail'} && $config{'mail'} && &can_edit_mail()) { # Email settings button push(@rv, { 'page' => 'edit_mail.cgi', 'title' => $text{'edit_mailopts'}, 'desc' => $text{'edit_mailoptsdesc'}, 'cat' => 'mail', }); } if ($d->{'mail'} && !$d->{'alias'} && $config{'dkim_enabled'}) { # Per-domain DKIM page push(@rv, { 'page' => 'edit_domdkim.cgi', 'title' => $text{'edit_domdkim'}, 'desc' => $text{'edit_domdkimdesc'}, 'cat' => 'dns', }); } # Button to show bandwidth graph if ($config{'bw_active'} && &can_monitor_bandwidth($d)) { push(@rv, { 'page' => 'bwgraph.cgi', 'title' => $text{'edit_bwgraph'}, 'desc' => $text{'edit_bwgraphdesc'}, 'cat' => 'logs', }); } # Button to show disk usage if ($d->{'dir'} && !$d->{'parent'}) { push(@rv, { 'page' => 'usage.cgi', 'title' => $text{'edit_usage'}, 'desc' => $text{'edit_usagehdesc'}, 'cat' => 'logs', }); } # Button to re-send signup email if (!$d->{'alias'} && &can_config_domain($d)) { push(@rv, { 'page' => 'reemail.cgi', 'title' => $text{'edit_reemail'}, 'desc' => &text('edit_reemaildesc', "$d->{'emailto_addr'}"), 'cat' => 'mail', }); } # Button to show mail logs if ($virtualmin_pro && $config{'mail'} && $config{'mail_system'} <= 1 && &can_view_maillog($d) && $d->{'mail'}) { push(@rv, { 'page' => 'pro/maillog.cgi', 'title' => $text{'edit_maillog'}, 'desc' => $text{'edit_maillogdesc'}, 'cat' => 'logs', }); } # Button to validate connectivity if ($virtualmin_pro) { push(@rv, { 'page' => 'pro/connectivity.cgi', 'title' => $text{'edit_connect'}, 'desc' => $text{'edit_connectdesc'}, 'cat' => 'logs', }); } # Link to edit excluded directories if (!$d->{'alias'} && &can_edit_exclude()) { push(@rv, { 'page' => 'edit_exclude.cgi', 'title' => $text{'edit_exclude'}, 'desc' => $text{'edit_excludedesc'}, 'cat' => 'server', }); } if (&can_disable_domain($d)) { # Enabled or disable buttons if ($d->{'disabled'}) { push(@rv, { 'page' => 'enable_domain.cgi', 'title' => $text{'edit_enable'}, 'desc' => $text{'edit_enabledesc'}, 'cat' => 'delete', }); } else { push(@rv, { 'page' => 'disable_domain.cgi', 'title' => $text{'edit_disable'}, 'desc' => $text{'edit_disabledesc'}, 'cat' => 'delete', }); } } if (&can_delete_domain($d)) { # Delete domain button push(@rv, { 'page' => 'delete_domain.cgi', 'title' => $text{'edit_delete'}, 'desc' => $text{'edit_deletedesc'}, 'cat' => 'delete', }); } if (&can_associate_domain($d)) { # Feature associate / disassociate button push(@rv, { 'page' => 'assoc_form.cgi', 'title' => $text{'edit_assoc'}, 'desc' => $text{'edit_assocdesc'}, 'cat' => 'delete', }); } if (&can_passwd()) { # Change password button push(@rv, { 'page' => 'edit_pass.cgi', 'title' => $text{'edit_changepass'}, 'desc' => $text{'edit_changepassdesc'}, 'cat' => 'server', }); } if (&can_2fa()) { # Twofactor enroll button push(@rv, { 'page' => 'edit_2fa.cgi', 'title' => $text{'edit_change2fa'}, 'desc' => $text{'edit_change2fadesc'}, 'cat' => 'server', }); } if (&domain_has_website($d) && $d->{'dir'} && !$d->{'alias'} && !$d->{'proxy_pass_mode'} && $virtualmin_pro && &can_edit_html()) { # Edit web pages button push(@rv, { 'page' => 'pro/edit_html.cgi', 'title' => $text{'edit_html'}, 'desc' => $text{'edit_htmldesc'}, 'cat' => 'web', }); } if ($d->{'dir'} && !$d->{'alias'} && !$d->{'proxy_pass_mode'} && &foreign_available("filemin")) { # Link to file manager for HTML directory my $phd = &public_html_dir($d); my %faccess = &get_module_acl(undef, 'filemin'); my @ap = split(/\s+/, $faccess{'allowed_paths'}); if (@ap == 1) { if ($ap[0] eq '$HOME' && $base_remote_user eq $d->{'user'}) { $ap[0] = $d->{'home'}; } $phd =~ s/^\Q$ap[0]\E//; } push(@rv, { 'page' => 'index.cgi?path='.&urlize($phd), 'mod' => 'filemin', 'title' => $text{'edit_filemin'}, 'desc' => $text{'edit_filemindesc'}, 'cat' => 'objects', 'icon' => 'page_edit', }); } if (&foreign_available("xterm") && !$d->{'alias'} && $d->{'unix'} && $d->{'user'}) { # Link to Terminal for master admin push(@rv, { 'page' => 'index.cgi?user='.&urlize($d->{'user'}). '&dir='.&urlize($d->{'home'}), 'mod' => 'xterm', 'title' => $text{'edit_terminal'}, 'desc' => $text{'edit_terminaldesc'}, 'cat' => 'objects', 'icon' => 'page_edit', }); } &menu_link_pro_tips(\@rv, $d) if (!$virtualmin_pro); &save_links_cache($ckey, $v, \@rv); return @rv; } # get_all_domain_links(&domain) # Returns a list of all links for a domain, including actions, feature links # and custom links. Each has the following keys : # url - URL to link to # title - Short name for link # desc - Longer name for link (optional) # cat - Category code # catname - Category human-readable name # target - Frame to open in (right or _new), defaults to right # icon - Unique code for this link sub get_all_domain_links { local ($d) = @_; local @rv; # Always start with edit/view link my $canconfig = &can_config_domain($d); local $vm = "/$module_name"; push(@rv, { 'url' => $canconfig ? "$vm/edit_domain.cgi?dom=$d->{'id'}" : "$vm/view_domain.cgi?dom=$d->{'id'}", 'title' => $canconfig ? $text{'edit_title'} : $text{'view_title'}, 'cat' => 'objects', 'icon' => $canconfig ? 'edit' : 'view' }); # Add link to list sub-servers if (!$d->{'parent'}) { push(@rv, { 'url' => $vm.'/search.cgi?field=parent&what='. &urlize($d->{'dom'}), 'title' => $text{'edit_psearch'}, 'cat' => 'server', 'catname' => $text{'cat_server'} }); } # Add actions and links foreach my $l (&get_domain_actions($d), &feature_links($d)) { if ($l->{'mod'}) { $l->{'url'} = "/$l->{'mod'}/$l->{'page'}"; } else { $l->{'url'} = $l->{'urlpro'} || "$vm/$l->{'page'}". "?dom=".$d->{'id'}."&". join("&", map { $_->[0]."=".&urlize($_->[1]) } @{$l->{'hidden'}}); } $l->{'catname'} ||= $text{'cat_'.$l->{'cat'}}; push(@rv, $l); } my %catmap = map { $_->{'catname'}, $_->{'cat'} } @rv; # Add preview website link, proxied via Webmin if (&domain_has_website($d) && &can_use_preview()) { local $pt = $d->{'web_port'} == 80 ? "" : ":$d->{'web_port'}"; push(@rv, { 'url' => "/$module_name/". "link.cgi/$d->{'ip'}/http://www.$d->{'dom'}$pt/", 'title' => $text{'links_website'}, 'cat' => 'web', 'catname' => $text{'cat_services'}, 'target' => '_new', }); } # Add custom links if (defined(&list_visible_custom_links)) { foreach my $l (&list_visible_custom_links($d)) { $l->{'title'} = $l->{'desc'}; delete($l->{'desc'}); $l->{'target'} = $l->{'open'} ? "_new" : "right"; delete($l->{'open'}); if (!$l->{'icon'}) { # Make a unique ID $l->{'icon'} = lc($l->{'title'}); $l->{'icon'} =~ s/\s/_/g; } push(@rv, $l); # Pick a category code, based on a match by name with an # existing category or a lower-cased version of the category if ($l->{'catname'}) { $l->{'cat'} = $catmap{$l->{'catname'}} || lc($l->{'catname'}); $l->{'cat'} =~ s/\s/_/g; } else { $l->{'cat'} = 'objects'; $l->{'catname'} = $text{'cat_objects'}; } $l->{'nosort'} = 1; } } return @rv; } # domain_footer_link(&domain) # Returns a link and text suitable for the footer function sub domain_footer_link { local $base = "/".$module_name; return &can_config_domain($_[0]) ? ( "$base/edit_domain.cgi?dom=$_[0]->{'id'}", $text{'edit_return'} ) : ( "$base/view_domain.cgi?dom=$_[0]->{'id'}", $text{'view_return'} ); } # domain_redirect(&domain, [refresh-menu]) # Calls redirect to edit_domain.cgi or view_domain.cgi sub domain_redirect { local ($d, $refresh) = @_; &redirect("/$module_name/postsave.cgi?". "dom=$d->{'id'}&refresh=$refresh"); } # get_template_pages() # Returns five array references, for template/reseller/etc links, titles, # categories and codes sub get_template_pages { local @tmpls = ( 'features', 'tmpl', 'plan', 'bw', $virtualmin_pro ? ( 'fields', 'links', 'ips', 'sharedips', 'dynip', 'resels', 'notify', 'scripts', ) : ( 'fields', 'ips', 'sharedips', 'scripts', 'dynip' ), 'shells', $config{'spam'} || $config{'virus'} ? ( 'sv' ) : ( ), &has_home_quotas() && $virtualmin_pro ? ( 'quotas' ) : ( ), &has_home_quotas() && !&has_quota_commands() && &has_quotacheck() ? ( 'quotacheck' ) : ( ), $virtualmin_pro ? ( 'mxs' ) : ( ), 'validate', &has_ftp_chroot() ? ( 'chroot' ) : ( ), 'global', $virtualmin_pro ? ( ) : ( 'upgrade' ), $config{'mail_system'} == 0 ? ( 'postgrey' ) : ( ), 'dkim', 'ratelimit', 'provision', $config{'mail'} ? ( 'autoconfig' ) : ( ), $config{'mail'} && $virtualmin_pro ? ( 'retention' ) : ( ), $virtualmin_pro ? ( 'smtpclouds' ) : ( ), $config{'mysql'} ? ( 'mysqls' ) : ( ), 'dnsclouds', $virtualmin_pro ? ( 'remotedns' ) : ( ), ); local %tmplcat = ( 'features' => 'setting', 'notify' => 'email', 'sv' => 'email', 'ips' => 'ip', 'sharedips' => 'ip', 'dynip' => 'ip', 'mxs' => 'email', 'quotas' => 'check', 'validate' => 'check', 'quotacheck' => 'check', 'tmpl' => 'setting', 'plan' => 'setting', 'bw' => 'setting', 'plugin' => 'setting', 'scripts' => 'setting', 'upgrade' => 'setting', 'resels' => 'setting', 'fields' => 'custom', 'links' => 'custom', 'shells' => 'custom', 'chroot' => 'check', 'global' => 'custom', 'postgrey' => 'email', 'dkim' => 'email', 'ratelimit' => 'email', 'changelog' => 'setting', 'provision' => 'setting', 'autoconfig' => 'email', 'retention' => 'email', 'smtpclouds' => 'email', 'mysqls' => 'setting', 'dnsclouds' => 'ip', 'remotedns' => 'ip', ); local %nonew = ( 'history', 1, 'postgrey', 1, 'dkim', 1, 'ratelimit', 1, 'provision', 1, 'smtpclouds', 1, 'dnsclouds', 1, 'remotedns', 1, ); local %pro = ( 'resels', 1, 'reseller', 1, 'smtpclouds', 1, 'remotedns', 1, ); local @tlinks = map { ($pro{$_} ? "pro/" : ""). ($nonew{$_} ? "${_}.cgi" : "edit_new${_}.cgi") } @tmpls; local @ttitles = map { $nonew{$_} ? $text{"${_}_title"} : $text{"new${_}_title"} } @tmpls; local @ticons = map { $nonew{$_} ? "images/${_}.gif" : "images/new${_}.gif" } @tmpls; local @tcats = map { $tmplcat{$_} } @tmpls; # Get from plugins too foreach my $p (@plugins) { if (&plugin_defined($p, "settings_links")) { foreach my $sl (&plugin_call($p, "settings_links")) { push(@tlinks, $sl->{'link'}); push(@ttitles, $sl->{'title'}); push(@ticons, $sl->{'icon'}); push(@tcats, $sl->{'cat'}); } } } return (\@tlinks, \@ttitles, \@ticons, \@tcats, \@tmpls); } # get_all_global_links() # Returns a list of links for global actions, including those from 'templates' # create/migrate, backup/restore and module config. Each element has the same # keys as get_all_domain_links sub get_all_global_links { my @rv; my $vm = "/$module_name"; local $v = [ 'plugins' => \@plugins, 'spam' => $config{'spam'}, 'virus' => $config{'virus'}, 'quotas' => &has_home_quotas(), 'mail_system' => $config{'mail_system'}, 'pro' => $virtualmin_pro ]; # Add template pages if (&can_edit_templates()) { local $crv = &get_links_cache("global", $v); if ($crv) { # Use cache @rv = @$crv; } else { # Need to create my ($tlinks, $ttitles, undef, $tcats, $tcodes) = &get_template_pages(); $tcats = [ map { "setting" } @$tlinks ] if (!$tcats); for(my $i=0; $i<@$tlinks; $i++) { local $url; if ($tcodes->[$i] eq 'upgrade' && $config{'upgrade_link'}) { # Special link for upgrading GPL to Pro $url = $config{'upgrade_link'}; } elsif ($tlinks->[$i] =~ /^\//) { # Outside virtualmin module $url = $tlinks->[$i]; } else { # Inside virtualmin $url = $vm."/".$tlinks->[$i]; } push(@rv, { 'url' => $url, 'title' => $ttitles->[$i], 'cat' => $tcats->[$i], 'icon' => $tcodes->[$i], }); } &global_menu_link_pro_tip(\@rv) if (!$virtualmin_pro); &save_links_cache("global", $v, \@rv); } } # Add module config page if (!$access{'noconfig'}) { push(@rv, { 'url' => "/config.cgi?$module_name", 'title' => $text{'index_virtualminconfig'}, 'cat' => 'setting', 'icon' => 'config' }); } # Add re-check config page if (&can_edit_templates()) { push(@rv, { 'url' => "$vm/check.cgi", 'title' => $text{'index_srefresh2'}, 'cat' => 'setting', 'icon' => 'recheck' }); } # Add wizard page if ($config{'wizard_run'} && &can_edit_templates()) { push(@rv, { 'url' => "$vm/wizard.cgi", 'title' => $text{'index_rewizard'}, 'cat' => 'setting', 'icon' => 'wizard' }); } # Add creation-related links my ($dleft, $dreason, $dmax, $dhide) = &count_domains("realdoms"); my ($aleft, $areason, $amax, $ahide) = &count_domains("aliasdoms"); my $nobatch = !&can_create_batch(); if ((&can_create_sub_servers() || &can_create_master_servers()) && $dleft && $virtualmin_pro && !$nobatch) { # Batch create push(@rv, { 'url' => "$vm/mass_create_form.cgi", 'title' => $text{'index_batch'}, 'cat' => 'add', 'icon' => 'batch' }); } if (&can_import_servers()) { # Import domain push(@rv, { 'url' => "$vm/import_form.cgi", 'title' => $text{'index_import'}, 'cat' => 'add', 'icon' => 'import' }); } if (&can_migrate_servers()) { # Migrate domain push(@rv, { 'url' => "$vm/migrate_form.cgi", 'title' => $text{'index_migrate'}, 'cat' => 'add', 'icon' => 'migrate' }); } # Add backup/restore links my ($blinks, $btitles, undef, $bcodes) = &get_backup_actions(); for(my $i=0; $i<@$blinks; $i++) { push(@rv, { 'url' => $vm."/".$blinks->[$i], 'title' => $btitles->[$i], 'cat' => 'backup', 'icon' => $bcodes->[$i] }); } # Top-level links push(@rv, { 'url' => $vm.'/index.cgi', 'title' => $text{'index_link'}, 'icon' => 'index' }); if (&reseller_admin()) { # Change password for resellers push(@rv, { 'url' => $vm."/edit_pass.cgi", 'title' => $text{'edit_changeresellerpass'}, 'icon' => 'pass' }); } elsif (&extra_admin()) { # Change password for admin push(@rv, { 'url' => $vm."/edit_pass.cgi", 'title' => $text{'edit_changeadminpass'}, 'icon' => 'pass' }); } if (&reseller_admin() && $config{'bw_active'}) { # Bandwidth for resellers push(@rv, { 'url' => $vm."/bwgraph.cgi", 'title' => $text{'edit_bwgraph'}, 'icon' => 'bw' }); } if (&reseller_admin() && &can_edit_plans()) { # Add plans for resellers push(@rv, { 'url' => $vm."/edit_newplan.cgi", 'title' => $text{'plans_title'}, 'icon' => 'newplan' }); } if (&reseller_admin() && &can_edit_resellers()) { # Reseller who can edit other resellers push(@rv, { 'url' => $vm."/edit_newresels.cgi", 'title' => $text{'newresels_title'}, 'icon' => 'webmin-small' }); } if (&can_show_history()) { # History graphs push(@rv, { 'url' => $vm."/pro/history.cgi", 'title' => $text{'edit_history'}, 'icon' => 'graph' }); } if (&can_use_validation() && !&can_edit_templates()) { # Validation page for domain owner push(@rv, { 'url' => $vm."/edit_newvalidate.cgi", 'title' => $text{'newvalidate_title'}, 'icon' => 'validate' }); } # Set category names foreach my $l (@rv) { if ($l->{'cat'}) { $l->{'catname'} ||= $text{'cat_'.$l->{'cat'}}; } } return @rv; } # get_links_cache(key, &cache-invalidator) # Checks the cache for some key, and if it exists make sure the stored cache # validator matches what is given. If so, return the cache contents. If not, # return undef. sub get_links_cache { local ($cachekey, $validator) = @_; local $cachedata = &read_file_contents("$links_cache_dir/$cachekey"); return undef if (!$cachedata); local $cachestr = &unserialise_variable($cachedata); return undef if (!$cachestr); return undef if (&serialise_variable($cachestr->{'validator'}) ne &serialise_variable($validator)); return $cachestr->{'data'}; } # save_links_cache(key, &cache-invalidator, &object) # Save some cached key based on a key, with an additional validator that can # be used to check suitability by get_links_cache. sub save_links_cache { local ($cachekey, $validator, $data) = @_; if (!-d $links_cache_dir) { &make_dir($links_cache_dir, 0700); } &open_tempfile(CACHEDATA, ">$links_cache_dir/$cachekey", 0, 1); &print_tempfile(CACHEDATA, &serialise_variable( { 'validator' => $validator, 'data' => $data })); &close_tempfile(CACHEDATA); } # clear_links_cache([&domain|user], ...) # Delete all cached information for some or all domains sub clear_links_cache { my (@list) = @_; @list = (undef) if (!@list); foreach my $d (@list) { opendir(CACHEDIR, $links_cache_dir); foreach my $f (readdir(CACHEDIR)) { my $del; if (ref($d)) { # Belongs to domain? $del = $f =~ /^\Q$d->{'id'}\E\-/ ? 1 : 0; } elsif ($d) { # Belongs to user? $del = $f =~ /\-\Q$d\E$/ ? 1 : 0; } else { # Deleting everything $del = 1; } &unlink_file("$links_cache_dir/$f") if ($del); } closedir(CACHEDIR); } } # get_startstop_links([live]) # Returns a list of status objects for relevant features and plugins sub get_startstop_links { local ($live) = @_; local @rv; local %typestatus; foreach my $f (@startstop_features) { if ($config{$f}) { local $sfunc = "startstop_".$f; if (defined(&$sfunc)) { foreach my $status (&$sfunc(\%typestatus)) { $status->{'feature'} ||= $f; push(@rv, $status); } } } } foreach my $f (&list_startstop_plugins()) { local $status = &plugin_call($f, "feature_startstop"); $status->{'feature'} ||= $f; $status->{'plugin'} = 1; push(@rv, $status); } return @rv; } # can_domain_have_users(&domain) # Returns 1 if the given domain can have mail/FTP/DB users sub can_domain_have_users { local ($d) = @_; return 0 if ($d->{'alias'} && !$d->{'aliasmail'} || $d->{'subdom'}); # never allowed for aliases if (!$d->{'mail'}) { # Qmail+LDAP and VPOPMail require mail to be enabled return 0 if ($config{'mail_system'}==4 || $config{'mail_system'}==5); } if (!$d->{'dir'}) { # Only VPOPMail allows mail without a dir return 0 if ($config{'mail_system'} != 5); } return 1; } # Returns 1 if some domain can have scripts installed sub can_domain_have_scripts { local ($d) = @_; return ($d->{'web'} && $config{'web'} || &domain_has_website($d)) && !$d->{'subdom'} && !$d->{'alias'}; } # can_chained_feature(feature, [check-chaining-enabled?]) # Returns a list of parent features if some feature or plugin type gets enabled # when another feature is. If the second param is set, also check if chaining # is active for this feature right now. sub can_chained_feature { my ($f, $check) = @_; if (&indexof($f, @plugins) >= 0) { if ($check && &indexof($f, @plugins_inactive) >= 0) { # Chaining not currently active for this plugin return (); } if (&plugin_defined($f, "feature_can_chained")) { return &plugin_call($f, "feature_can_chained"); } return (); } else { if ($check && $config{$f} != 3) { # Chaining not currently active for this feature return (); } my $cfunc = "can_chained_".$f; return defined(&$cfunc) ? &$cfunc() : (); } } # call_feature_func(feature, &domain, &olddomain) # Calls the appropriate function to enable or disable a feature for a domain sub call_feature_func { local ($f, $d, $oldd) = @_; if (&indexof($f, @features) >= 0 && $config{$f}) { # A core feature local $sfunc = "setup_$f"; local $dfunc = "delete_$f"; local $mfunc = "modify_$f"; if ($d->{$f} && !$oldd->{$f}) { # Setup some feature local ($ok, $fok) = &try_function($f, $sfunc, $d); if (!$ok || !$fok) { $d->{$f} = 0; } } elsif (!$d->{$f} && $oldd->{$f}) { # Delete some feature local ($ok, $fok) = &try_function($f, $dfunc, $oldd); if (!$ok || !$fok) { $d->{$f} = 1; } $d->{'db_mysql'} = $oldd->{'db_mysql'}; $d->{'db_postgres'} = $oldd->{'db_postgres'}; } elsif ($d->{$f}) { # Modify some feature &try_function($f, $mfunc, $d, $oldd); } } elsif (&indexof($f, &list_feature_plugins()) >= 0) { # A plugin feature if ($d->{$f} && !$oldd->{$f}) { &try_plugin_call($f, "feature_setup", $d); } elsif (!$d->{$f} && $oldd->{$f}) { &try_plugin_call($f, "feature_delete", $oldd); } elsif ($d->{$f}) { &try_plugin_call($f, "feature_modify", $d, $oldd); } } } # feature_name(name, [&domain]) # Returns a human-readable short feature name, even if it's a plugin sub feature_name { my ($f, $d) = @_; return $text{'feature_'.$f} || &plugin_call($f, "feature_name") || $f; } # domain_features(&dom) # Returns a list of possible core features for a domain sub domain_features { local ($d) = @_; return $d->{'alias'} && $d->{'aliasmail'} ? @aliasmail_features : $d->{'alias'} ? @alias_features : $d->{'subdom'} ? @opt_subdom_features : $d->{'parent'} ? ( grep { $_ ne "webmin" && $_ ne "unix" } @features ) : @features; } # list_mx_servers() # Returns the objects for servers used as secondary MXs sub list_mx_servers { if (&foreign_check("servers") && $config{'mx_servers'}) { &foreign_require("servers"); local %servers = map { $_->{'id'}, $_ } &servers::list_servers(); local @rv; foreach my $idname (split(/\s+/, $config{'mx_servers'})) { my ($id, $name) = split(/=/, $idname); local $s = $servers{$id}; if ($s) { $s->{'mxname'} = $name; push(@rv, $s); } } return @rv; } return (); } # save_mx_servers(&servers) # Update the list of servers to create secondary MXs on sub save_mx_servers { local ($servers) = @_; $config{'mx_servers'} = join(" ", map { $_->{'mxname'} ? $_->{'id'}."=".$_->{'mxname'} : $_->{'id'} } @$servers); &save_module_config(); } # change_home_directory(&domain, newhome) # Updates the home directory and anything that refers to it in a domain object sub change_home_directory { local ($d, $newhome) = @_; local $oldhome = $d->{'home'}; $d->{'home'} = $newhome; foreach my $k (keys %$d) { if ($k ne "home") { $d->{$k} =~ s/$oldhome/$newhome/g; } } } # move_virtual_server(&domain, &parent) # Moves some virtual server so that it is now owned by the new parent domain sub move_virtual_server { local ($d, $parent) = @_; local $oldd = { %$d }; local $oldparent; if ($d->{'parent'}) { $oldparent = &get_domain($d->{'parent'}); } # Update the domain object with new home directory and parent details local (@doms, @olddoms, @remove_feats); &set_parent_attributes($d, $parent); &change_home_directory($d, &server_home_directory($d, $parent)); if ($d->{'alias'}) { # Set new alias target to new parent $d->{'alias'} = $parent->{'id'}; # Clear any alias features that the new domain doesn't have foreach my $f (@alias_features) { if ($d->{$f} && !$parent->{$f}) { $d->{$f} = 0; push(@remove_feats, $f); } } } push(@doms, $d); push(@olddoms, $oldd); if (!$oldd->{'parent'}) { # If this is a parent domain, all of it's children need to be # re-parented too. This will also catch any aliases and sub-domains. # These have to be moved BEFORE their old parent, so that move of the # parent doesn't cause the home directory to disappear. local @subs = &get_domain_by("parent", $d->{'id'}); foreach my $sd (@subs) { local $oldsd = { %$sd }; &set_parent_attributes($sd, $parent); &change_home_directory($sd, &server_home_directory($sd, $parent)); unshift(@doms, $sd); unshift(@olddoms, $oldsd); } # The template may no longer be valid if it was for a top-level server local $tmpl = &get_template($d->{'template'}); if (!$tmpl->{'for_sub'}) { $d->{'template'} = &get_init_template(1); } } else { # Find any alias domains that also need to be re-parented. Also find # any sub-domains local @aliases = &get_domain_by("alias", $d->{'id'}); local @subdoms = &get_domain_by("subdoms", $d->{'id'}); foreach my $ad (@aliases, @subdoms) { local $oldad = { %$ad }; &set_parent_attributes($ad, $parent); &change_home_directory($ad, &server_home_directory($ad, $parent)); push(@doms, $ad); push(@olddoms, $oldad); } } # Run the before command &set_domain_envs($oldd, "MODIFY_DOMAIN", $d); local $merr = &making_changes(); &reset_domain_envs($oldd); &error(&text('rename_emaking', "$merr")) if (defined($merr)); &setup_for_subdomain($parent); # If this is an alias domain, first delete features that don't exist in # the target foreach my $f (@remove_feats) { my $dfunc = "delete_".$f; local $main::error_must_die = 1; eval { &$dfunc($oldd); }; if ($@) { &$second_print(&text('setup_failure', $text{'feature_'.$f}, "$@")); } } # Setup print function to include domain name sub first_html_withdom_move { &$old_first_print(&text('rename_dd', $doing_dom->{'dom'})," : ",@_); } local $old_first_print; local $doing_dom; if (@doms > 1) { $old_first_print = $first_print; $first_print = \&first_html_withdom_move; } # Update all features in all domains local %vital = map { $_, 1 } @vital_features; foreach my $f (@features) { local $mfunc = "modify_$f"; for(my $i=0; $i<@doms; $i++) { if (($doms[$i]->{$f} || ($f eq 'mail' && !$d->{'alias'})) && ($config{$f} || $f eq "unix" || $f eq "mail")) { $doing_dom = $doms[$i]; local $main::error_must_die = 1; eval { if ($doms[$i]->{'alias'}) { # Is an alias domain, so pass in old # and new target domain objects local $aliasdom = &get_domain( $doms[$i]->{'alias'}); local $idx = &indexof($aliasdom, @doms); if ($idx >= 0) { &$mfunc( $doms[$i], $olddoms[$i], $doms[$idx], $olddoms[$idx]); } else { &$mfunc( $doms[$i], $olddoms[$i], $aliasdom, $aliasdom); } } else { # Not an alias domain &$mfunc($doms[$i], $olddoms[$i]); } if (($f eq "unix" || $f eq "webmin") && $doms[$i]->{'parent'}) { # Disable feature, since the user # will no longer exist $doms[$i]->{$f} = 0; } }; if ($@) { &$second_print(&text('setup_failure', $text{'feature_'.$f}, "$@")); if ($vital{$f}) { # A vital feature failed .. give up return 0; } } } } } # Do move for plugins, with error handling foreach my $f (&list_feature_plugins(1)) { for(my $i=0; $i<@doms; $i++) { $doing_dom = $doms[$i]; local $main::error_must_die = 1; if ($doms[$i]->{$f}) { eval { &plugin_call($f, "feature_modify", $doms[$i], $olddoms[$i]) }; if ($@) { local $err = $@; &$second_print(&text('setup_failure', &plugin_call($f, "feature_name"),$err)); } } eval { &plugin_call($f, "feature_always_modify", $doms[$i], $olddoms[$i]) }; } } $first_print = $old_first_print if ($old_first_print); # Fix script installer paths in all domains if (defined(&list_domain_scripts) && !$d->{'alias'}) { &$first_print($text{'rename_scripts'}); for(my $i=0; $i<@doms; $i++) { local ($olddir, $newdir) = ($olddoms[$i]->{'home'}, $doms[$i]->{'home'}); foreach $sinfo (&list_domain_scripts($doms[$i])) { $changed = 0; if ($olddir ne $newdir) { # Fix directory $changed++ if ($sinfo->{'opts'}->{'dir'} =~ s/^\Q$olddir\E\//$newdir\//); } &save_domain_script($doms[$i], $sinfo) if ($changed); } } &$second_print($text{'setup_done'}); } # Fix backup schedule and key owners if (!$oldd->{'parent'}) { &rename_backup_owner($d, $oldd); } # Clear email field, to force inheritance from new parent for(my $i=0; $i<@doms; $i++) { delete($doms[$i]->{'email'}); } # Set plan based on new parent for(my $i=0; $i<@doms; $i++) { &set_plan_on_children($doms[$i]); } # Save the domain objects &$first_print($text{'save_domain'}); for(my $i=0; $i<@doms; $i++) { &save_domain($doms[$i]); } &$second_print($text{'setup_done'}); # Update old and new Webmin users &modify_webmin($parent, $parent); if ($oldparent) { &modify_webmin($oldparent, $oldparent); } # Re-apply the parent's resource limits, if any if (defined(&supports_resource_limits) && &supports_resource_limits()) { local $rv = &get_domain_resource_limits($parent); &save_domain_resource_limits($parent, $rv); } # If the domain was an alias, re-copy any mail aliases if ($d->{'alias'} && $d->{'mail'} && $parent->{'mail'}) { &sync_alias_virtuals($parent); } &run_post_actions(); # Run the after command &set_domain_envs($d, "MODIFY_DOMAIN", undef, $oldd); local $merr = &made_changes(); &$second_print(&text('setup_emade', "$merr")) if (defined($merr)); &reset_domain_envs($d); return 1; } # reparent_virtual_server(&domain, newuser, newpass) # Converts an existing sub-server into a new parent server sub reparent_virtual_server { local ($d, $newuser, $newpass) = @_; local $oldd = { %$d }; local $oldparent = &get_domain($d->{'parent'}); # Run the before command &set_domain_envs($oldd, "MODIFY_DOMAIN"); local $merr = &making_changes(); &reset_domain_envs($oldd); &error(&text('rename_emaking', "$merr")) if (defined($merr)); # Update the domain object with a new top-level home directory and it's # own user and group local (@doms, @olddoms); $d->{'parent'} = undef; $d->{'user'} = $newuser; $d->{'group'} = $newuser; $d->{'ugroup'} = $newuser; $d->{'pass'} = $newpass; &generate_domain_password_hashes($d, 1); if (!$d->{'mysql'}) { delete($d->{'mysql_user'}); } if (!$d->{'postgres'}) { delete($d->{'postgres_user'}); } local (%gtaken, %taken); &build_group_taken(\%gtaken); &build_taken(\%taken); $d->{'uid'} = &allocate_uid(\%taken); $d->{'gid'} = &allocate_gid(\%gtaken); $d->{'ugid'} = $d->{'gid'}; &change_home_directory($d, &server_home_directory($d)); push(@doms, $d); push(@olddoms, $oldd); # The template may no longer be valid if it was for a sub-server local $tmpl = &get_template($d->{'template'}); local $skelchanged; if (!$tmpl->{'for_parent'}) { local $deftmpl = &get_init_template(0); if ($d->{'template'} ne $deftmpl) { $d->{'template'} = $deftmpl; local $newtmpl = &get_template($d->{'template'}); if ($newtmpl->{'skel'} ne $tmpl->{'skel'}) { $skelchanged = $newtmpl->{'skel'}; } } } # Copy all quotas and limits from the old parent $d->{'quota'} = $oldparent->{'quota'}; $d->{'uquota'} = $oldparent->{'uquota'}; $d->{'bwlimit'} = $oldparent->{'bwlimit'}; foreach my $l (@limit_types) { $d->{$l} = $oldparent->{$l}; } $d->{'nodbname'} = $oldparent->{'nodbname'}; $d->{'norename'} = $oldparent->{'norename'}; $d->{'forceunder'} = $oldparent->{'forceunder'}; foreach my $ed (@edit_limits) { $d->{'edit_'.$ed} = $oldparent->{'edit_'.$ed}; } foreach my $f (@opt_features, "virt", &list_feature_plugins()) { $d->{'limit_'.$f} = $oldparent->{'limit_'.$f}; } $d->{'demo'} = $oldparent->{'demo'}; $d->{'webmin_modules'} = $oldparent->{'webmin_modules'}; $d->{'plan'} = $oldparent->{'plan'}; # Find any alias domains that also need to be re-parented. Also find # any sub-domains local @aliases = &get_domain_by("alias", $d->{'id'}); local @subdoms = &get_domain_by("subdom", $d->{'id'}); foreach my $ad (@aliases, @subdoms) { local $oldad = { %$ad }; &set_parent_attributes($ad, $d); &change_home_directory($ad, &server_home_directory($ad, $d)); push(@doms, $ad); push(@olddoms, $oldad); } # Setup print function to include domain name sub first_html_withdom_reparent { &$old_first_print(&text('rename_dd', $doing_dom->{'dom'})," : ",@_); } local $old_first_print; local $doing_dom; if (@doms > 1) { $old_first_print = $first_print; $first_print = \&first_html_withdom_reparent; } # Update all features in all domains my $f; local %vital = map { $_, 1 } @vital_features; foreach $f (@features) { local $mfunc = "modify_$f"; for(my $i=0; $i<@doms; $i++) { $doing_dom = $doms[$i]; if ($doms[$i]->{$f} && ($config{$f} || $f eq "unix")) { local $main::error_must_die = 1; eval { if ($doms[$i]->{'alias'}) { # Is an alias domain, so pass in old # and new target domain objects local $aliasdom = &get_domain( $doms[$i]->{'alias'}); local $idx = &indexof($aliasdom, @doms); if ($idx >= 0) { &$mfunc( $doms[$i], $olddoms[$i], $doms[$idx], $olddoms[$idx]); } else { &$mfunc( $doms[$i], $olddoms[$i], $aliasdom, $aliasdom); } } else { # Not an alias domain &$mfunc($doms[$i], $olddoms[$i]); } }; if ($@) { &$second_print(&text('setup_failure', $text{'feature_'.$f}, "$@")); if ($vital{$f}) { # A vital feature failed .. give up return 0; } } # Setup domains dir for aliases/etc if ($doms[$i] eq $d && $f eq "dir") { &setup_for_subdomain($d); } } # Turn on the Unix and Webmin features if ($doms[$i] eq $d && ($f eq "unix" || $f eq "webmin")) { $doms[$i]->{$f} = 1; local $sfunc = "setup_$f"; &try_function($f, $sfunc, $doms[$i]); } } } foreach $f (&list_feature_plugins(1)) { for(my $i=0; $i<@doms; $i++) { $doing_dom = $doms[$i]; local $main::error_must_die = 1; if ($doms[$i]->{$f}) { eval { &plugin_call($f, "feature_modify", $doms[$i], $olddoms[$i]) }; if ($@) { local $err = $@; &$second_print(&text('setup_failure', &plugin_call($f, "feature_name"),$err)); } } eval { &plugin_call($f, "feature_always_modify", $doms[$i], $olddoms[$i]) }; } } $first_print = $old_first_print if ($old_first_print); # Fix script installer paths in all domains if (defined(&list_domain_scripts)) { &$first_print($text{'rename_scripts'}); for(my $i=0; $i<@doms; $i++) { local ($olddir, $newdir) = ($olddoms[$i]->{'home'}, $doms[$i]->{'home'}); foreach $sinfo (&list_domain_scripts($doms[$i])) { $changed = 0; if ($olddir ne $newdir) { # Fix directory $changed++ if ($sinfo->{'opts'}->{'dir'} =~ s/^\Q$olddir\E\//$newdir\//); } &save_domain_script($doms[$i], $sinfo) if ($changed); } } &$second_print($text{'setup_done'}); } # Save the domain objects &$first_print($text{'save_domain'}); for(my $i=0; $i<@doms; $i++) { &save_domain($doms[$i]); } &$second_print($text{'setup_done'}); # Update old Webmin user if ($oldparent->{'webmin'}) { &modify_webmin($oldparent, $oldparent); } # Re-save the new Webmin user to grant access to all aliases if ($d->{'webmin'}) { &modify_webmin($d, $d); } # Re-apply resource limits, to update Apache and PHP configs if (defined(&supports_resource_limits) && &supports_resource_limits()) { local $rv = &get_domain_resource_limits($d); &save_domain_resource_limits($d, $rv); } # Copy skeleton files for top-level server if ($skelchanged && $skelchanged ne 'none') { local $uinfo = &get_domain_owner($d, 1); ©_skel_files(&substitute_domain_template($skelchanged, $d), $uinfo, $d->{'home'}, $d->{'group'} || $d->{'ugroup'}, $d); } &run_post_actions(); # Run the after command &set_domain_envs($d, "MODIFY_DOMAIN", undef, $oldd); local $merr = &made_changes(); &$second_print(&text('setup_emade', "$merr")) if (defined($merr)); &reset_domain_envs($d); return 1; } # unsub_virtual_server(&domain) # Convert a virtual server from a sub-domain to a sub-server sub unsub_virtual_server { local ($d) = @_; local $oldd = { %$d }; local $parent = &get_domain($d->{'parent'}); # Run the before command &set_domain_envs($oldd, "MODIFY_DOMAIN"); local $merr = &making_changes(); &reset_domain_envs($oldd); &error(&text('rename_emaking', "$merr")) if (defined($merr)); # Update the domain object with a new home directory delete($d->{'subdom'}); delete($d->{'public_html_dir'}); delete($d->{'public_html_path'}); $d->{'public_html_dir'} = &public_html_dir($d, 1); $d->{'public_html_path'} = &public_html_dir($d, 0); delete($d->{'cgi_bin_dir'}); delete($d->{'cgi_bin_path'}); $d->{'cgi_bin_dir'} = &cgi_bin_dir($d, 1); $d->{'cgi_bin_path'} = &cgi_bin_dir($d, 0); &change_home_directory($d, &server_home_directory($d, $parent)); # Update all features in the domain local %vital = map { $_, 1 } @vital_features; foreach my $f (@features) { local $mfunc = "modify_$f"; if ($d->{$f} && $config{$f}) { local $main::error_must_die = 1; eval { &$mfunc($d, $oldd); }; if ($@) { &$second_print(&text('setup_failure', $text{'feature_'.$f}, "$@")); return 0 if ($vital{$f}); } } } # Update all enabled plugins foreach my $f (&list_feature_plugins(1)) { local $main::error_must_die = 1; if ($d->{$f}) { eval { &plugin_call($f, "feature_modify", $d, $oldd) }; if ($@) { local $err = $@; &$second_print(&text('setup_failure', &plugin_call($f, "feature_name"), $err)); } } eval { &plugin_call($f, "feature_always_modify", $d, $oldd) }; } # Save the domain object &$first_print($text{'save_domain'}); &save_domain($d); &$second_print($text{'setup_done'}); # Update parent Webmin user &modify_webmin($parent, $parent); &run_post_actions(); # Run the after command &set_domain_envs($d, "MODIFY_DOMAIN", undef, $oldd); local $merr = &made_changes(); &$second_print(&text('setup_emade', "$merr")) if (defined($merr)); &reset_domain_envs($d); return 1; } # unalias_virtual_server(&domain) # Convert a virtual server from an alias to a sub-server sub unalias_virtual_server { local ($d) = @_; local $oldd = { %$d }; local $parent = &get_domain($d->{'parent'}); # Run the before command &set_domain_envs($oldd, "MODIFY_DOMAIN"); local $merr = &making_changes(); &reset_domain_envs($oldd); &error(&text('rename_emaking', "$merr")) if (defined($merr)); # Update the domain object to set the web directory delete($d->{'alias'}); delete($d->{'public_html_dir'}); delete($d->{'public_html_path'}); $d->{'public_html_dir'} = &public_html_dir($d, 1); $d->{'public_html_path'} = &public_html_dir($d, 0); delete($d->{'cgi_bin_dir'}); delete($d->{'cgi_bin_path'}); $d->{'cgi_bin_dir'} = &cgi_bin_dir($d, 1); $d->{'cgi_bin_path'} = &cgi_bin_dir($d, 0); # Create domains dir if missing &setup_for_subdomain($parent, $parent->{'user'}, $d); # Create the directory, if missing if (!$d->{'dir'}) { $d->{'dir'} = 1; local $main::error_must_die = 1; eval { &setup_dir($d); }; if ($@) { &$second_print(&text('setup_failure', $text{'feature_dir'}, "$@")); } } # Update all features in the domain local %vital = map { $_, 1 } @vital_features; foreach my $f (@features) { local $mfunc = "modify_$f"; if ($d->{$f} && $config{$f}) { local $main::error_must_die = 1; eval { &$mfunc($d, $oldd); }; if ($@) { &$second_print(&text('setup_failure', $text{'feature_'.$f}, "$@")); return 0 if ($vital{$f}); } } } # Update all enabled plugins foreach my $f (&list_feature_plugins(1)) { local $main::error_must_die = 1; if ($d->{$f}) { eval { &plugin_call($f, "feature_modify", $d, $oldd) }; if ($@) { local $err = $@; &$second_print(&text('setup_failure', &plugin_call($f, "feature_name"), $err)); } } eval { &plugin_call($f, "feature_always_modify", $d, $oldd) }; } # Save the domain object &$first_print($text{'save_domain'}); &save_domain($d); &$second_print($text{'setup_done'}); # Update parent Webmin user &modify_webmin($parent, $parent); &run_post_actions(); # Turn off aliascopy for future delete($d->{'aliascopy'}); &save_domain($d); # Run the after command &set_domain_envs($d, "MODIFY_DOMAIN", undef, $oldd); local $merr = &made_changes(); &$second_print(&text('setup_emade', "$merr")) if (defined($merr)); &reset_domain_envs($d); return 1; } # set_parent_attributes(&domain, &parent) # Update a domain object with attributes inherited from the parent sub set_parent_attributes { local ($d, $parent) = @_; $d->{'parent'} = $parent->{'id'}; $d->{'user'} = $parent->{'user'}; $d->{'group'} = $parent->{'group'}; $d->{'ugroup'} = $parent->{'ugroup'}; $d->{'uid'} = $parent->{'uid'}; $d->{'gid'} = $parent->{'gid'}; $d->{'ugid'} = $parent->{'ugid'}; $d->{'pass'} = $parent->{'pass'}; $d->{'enc_pass'} = $parent->{'enc_pass'}; $d->{'crypt_enc_pass'} = $parent->{'crypt_enc_pass'}; $d->{'md5_enc_pass'} = $parent->{'md5_enc_pass'}; $d->{'mysql_enc_pass'} = $parent->{'mysql_enc_pass'}; $d->{'digest_enc_pass'} = $parent->{'digest_enc_pass'}; $d->{'mysql_user'} = $parent->{'mysql_user'}; $d->{'postgres_user'} = $parent->{'postgres_user'}; $d->{'email'} = $parent->{'email'}; } # rename_virtual_server(&domain, [new-domain], [new-user], [new-home|"auto"], # new-prefix) # Updates a virtual server and possibly sub-servers with a new domain name, # username and home directory. If any of the parameters are undef, they are # left un-changed. Prints progress output, and returns undef on success or # an error message on failure. sub rename_virtual_server { my ($d, $dom, $user, $home, $prefix) = @_; $dom = undef if ($dom eq $d->{'dom'}); $home = undef if ($home eq $d->{'home'}); $prefix = undef if ($prefix eq $d->{'prefix'}); my %oldd = %$d; my $parentdom = $d->{'parent'} ? &get_domain($d->{'parent'}) : undef; # Validate domain name if ($dom) { my $derr = &allowed_domain_name($parentdom, $dom); return $derr if ($derr); my $clash = &get_domain_by("dom", $dom); $clash && return $text{'rename_eclash'}; } # Validate username, home directory and prefix if ($d->{'parent'}) { # Sub-servers don't have a separate user $user = undef; } elsif ($user eq 'auto') { my ($try1, $try2); ($user, $try1, $try2) = &unixuser_name($dom || $d->{'dom'}); $user || return &text('setup_eauto', $try1, $try2); } elsif ($user) { &valid_mailbox_name($user) && return $text{'setup_euser2'}; my ($clash) = grep { $_->{'user'} eq $user } &list_all_users(); $clash && return $text{'rename_euserclash'}; } if ($prefix eq 'auto') { $prefix = &compute_prefix($dom || $d->{'dom'}, $user || $d->{'user'}, $parentdom); } elsif ($prefix) { $prefix =~ /^[a-z0-9\.\-]+$/i || return $text{'setup_eprefix'}; my $pclash = &get_domain_by("prefix", $prefix); $pclash && return &text('setup_eprefix3', $prefix, $pclash->{'dom'}); } my $group; if ($prefix) { $group = $user || $d->{'user'}; } # If the domain name is being changed and there are any DNS sub-domains # which share the same zone file, split them out into their own files if ($dom && $d->{'dns'} && !$d->{'dns_submode'}) { my @dnssub = grep { $_->{'dns'} } &get_domain_by("dns_subof", $d->{'id'}); if (@dnssub) { &$first_print($text{'rename_dnssub'}); &$indent_print(); foreach my $sd (@dnssub) { &save_dns_submode($sd, 0); } &$outdent_print(); } } # Update the domain object with the new domain name and username if ($dom) { $d->{'email'} =~ s/\@$d->{'dom'}$/\@$dom/gi; $d->{'emailto'} =~ s/\@$d->{'dom'}$/\@$dom/gi; $d->{'dom'} = $dom; } if ($user) { $d->{'email'} =~ s/^\Q$d->{'user'}\E\@/$user\@/g; $d->{'emailto'} =~ s/^\Q$d->{'user'}\E\@/$user\@/g; $d->{'user'} = $user; } # Validate and set home directory if ($home eq 'auto') { # Automatic home &change_home_directory($d, &server_home_directory($d, $parentdom)); } elsif ($home) { # User-selected home -e $home && return $text{'rename_ehome3'}; $home =~ /^(.*)\// && -d $1 || return $text{'rename_ehome4'}; &change_home_directory($d, $home); } if ($group) { if ($d->{'ugroup'} eq $d->{'group'}) { $d->{'ugroup'} = $group; } $d->{'group'} = $group; $d->{'prefix'} = $prefix; } # Find any sub-server objects and update them my @subs; if (!$d->{'parent'}) { @subs = &get_domain_by("parent", $d->{'id'}); foreach my $sd (@subs) { my %oldsd = %$sd; push(@oldsubs, \%oldsd); if ($user) { $sd->{'email'} =~ s/^\Q$sd->{'user'}\E\@/$user\@/g; $sd->{'emailto'} =~ s/^\Q$sd->{'user'}\E\@/$user\@/g; $sd->{'user'} = $user; } if ($dom) { $sd->{'email'} =~ s/\@$d->{'dom'}$/\@$dom/gi; $sd->{'emailto'} =~ s/\@$d->{'dom'}$/\@$dom/gi; } if ($home) { &change_home_directory($sd, &server_home_directory($sd, $d)); } if ($group) { if ($sd->{'ugroup'} eq $sd->{'group'}) { $sd->{'ugroup'} = $group; } $sd->{'group'} = $group; } } } # Find any domains aliases to this one, excluding child domains since they # were covered above my @aliases = &get_domain_by("alias", $d->{'id'}); my @aliases = grep { $_->{'parent'} != $d->{'id'} } @aliases; foreach my $ad (@aliases) { my %oldad = %$ad; push(@oldaliases, \%oldad); if ($user) { $ad->{'email'} =~ s/^\Q$ad->{'user'}\E\@/$user\@/g; $ad->{'emailto'} =~ s/^\Q$ad->{'user'}\E\@/$user\@/g; $ad->{'user'} = $user; } if ($dom) { $ad->{'email'} =~ s/\@$d->{'dom'}$/\@$dom/gi; $ad->{'emailto'} =~ s/\@$d->{'dom'}$/\@$dom/gi; } if ($home) { &change_home_directory($ad, &server_home_directory($ad, $d)); } if ($group) { $ad->{'group'} = $group; } } # Check for domain name clash, where the domain, user or group have changed foreach my $f (@features) { my $cfunc = "check_${f}_clash"; if (defined(&$cfunc) && $dom{$f}) { if ($dom && &$cfunc($d, 'dom')) { return &text('setup_e'.$f, $dom, $dom{'db'}, $user, $d->{'group'} || $group); } if ($user && &$cfunc($d, 'user')) { return &text('setup_e'.$f, $dom, $dom{'db'}, $user, $d->{'group'} || $group); } if ($group && &$cfunc($d, 'group')) { return &text('setup_e'.$f, $dom, $dom{'db'}, $user, $group); } } } # Run the before command &set_domain_envs(\%oldd, "MODIFY_DOMAIN", $d); my $merr = &making_changes(); &reset_domain_envs(\%oldd); return &text('rename_emaking', "$merr") if (defined($merr)); if ($dom) { &$first_print(&text('rename_doingdom', "$dom")); &$second_print($text{'setup_done'}); } if ($user) { &$first_print(&text('rename_doinguser', "$user")); &$second_print($text{'setup_done'}); } if ($home eq 'auto') { &$first_print(&text('rename_doinghome', "".&server_home_directory($d, $parentdom)."")); &$second_print($text{'setup_done'}); } elsif ($home) { &$first_print(&text('rename_doinghome', "$home")); &$second_print($text{'setup_done'}); } # Build the list of domains being changed my @doms = ( $d ); my @olddoms = ( \%oldd ); push(@doms, @subs, @aliases); push(@olddoms, @oldsubs, @oldaliases); foreach my $ld (@doms) { &lock_domain($ld); } # Update all features in all domains. Include the mail feature always, as this # covers FTP users local $doing_dom; # Has to be local for scoping foreach my $f (&unique(@features, 'mail')) { my $mfunc = "modify_$f"; for(my $i=0; $i<@doms; $i++) { my $p = &domain_has_website($doms[$i]); if ($f eq "web" && $p && $p ne "web") { # Web feature is provided by a plugin .. call it now $doing_dom = $doms[$i]; &try_plugin_call($p, "feature_modify", $doms[$i], $olddoms[$i]); } elsif ($doms[$i]->{$f} && $config{$f} || $f eq "unix" || $f eq "mail") { $doing_dom = $doms[$i]; local $main::error_must_die = 1; eval { if ($doms[$i]->{'alias'}) { # Is an alias domain, so pass in old # and new target domain objects local $aliasdom = &get_domain( $doms[$i]->{'alias'}); local $idx = &indexof($aliasdom, @doms); if ($idx >= 0) { &try_function($f, $mfunc, $doms[$i], $olddoms[$i], $doms[$idx], $olddoms[$idx]); } else { &try_function($f, $mfunc, $doms[$i], $olddoms[$i], $aliasdom, $aliasdom); } } else { # Not an alias domain &try_function($f, $mfunc, $doms[$i], $olddoms[$i]); } }; if ($@) { &$second_print(&text('setup_failure', $text{'feature_'.$f}, "$@")); } } } } # Update plugins in all domains foreach $f (&list_feature_plugins(1)) { for(my $i=0; $i<@doms; $i++) { my $p = &domain_has_website($doms[$i]); $doing_dom = $doms[$i]; if ($doms[$i]->{$f} && $f ne $p) { &try_plugin_call($f, "feature_modify", $doms[$i], $olddoms[$i]); } &try_plugin_call($f, "feature_always_modify", $doms[$i], $olddoms[$i]); } } # Fix script installer paths in all domains if (defined(&list_domain_scripts)) { &$first_print($text{'rename_scripts'}); for(my $i=0; $i<@doms; $i++) { my ($olddir, $newdir) = ($olddoms[$i]->{'home'}, $doms[$i]->{'home'}); my ($olddname, $newdname) = ($olddoms[$i]->{'dom'}, $doms[$i]->{'dom'}); foreach my $sinfo (&list_domain_scripts($doms[$i])) { my $changed = 0; if ($olddir ne $newdir) { # Fix directory $changed++ if ($sinfo->{'opts'}->{'dir'} =~ s/^\Q$olddir\E\//$newdir\//); } if ($olddname ne $newdname) { # Fix domain in URL $changed++ if ($sinfo->{'url'} =~ s/\Q$olddname\E/$newdname/); } if (!$info{'opts'}->{'dir'} || -d $info{'opts'}->{'dir'}) { # list_domain_scripts will set deleted flag # due to home directory move, so fix it now that # script dir has been corrected $sinfo->{'deleted'} = 0; } &save_domain_script($doms[$i], $sinfo) if ($changed); } } &$second_print($text{'setup_done'}); } # Fix backup schedule and key owners if (!$oldd{'parent'}) { &rename_backup_owner($d, \%oldd); } &refresh_webmin_user($d); &run_post_actions(); # Save all new domain details &$first_print($text{'save_domain'}); for(my $i=0; $i<@doms; $i++) { &save_domain($doms[$i]); &unlock_domain($doms[$i]); } &$second_print($text{'setup_done'}); # Run the after command &set_domain_envs($d, "MODIFY_DOMAIN", undef, \%oldd); my $merr = &made_changes(); &$second_print(&text('rename_emade', "$merr")) if (defined($merr)); &reset_domain_envs($d); # Clear all left-frame links caches, as links to Apache may no longer be valid &clear_links_cache(); return undef; } # check_virtual_server_config([&lastconfig]) # Validates the Virtualmin configuration, printing out messages as it goes. # Returns undef on success, or an error message on failure. sub check_virtual_server_config { local ($lastconfig) = @_; local $clink = "edit_newfeatures.cgi"; local $mclink = "../config.cgi?$module_name"; # Make sure networking is supported if (!&foreign_check("net")) { &foreign_require("net"); if (!defined(&net::boot_interfaces)) { return &text('index_enet'); } &$second_print($text{'check_netok'}); } # Check for sensible memory limits if (&foreign_check("proc")) { &foreign_require("proc"); local $arch = &backquote_command("uname -m"); local $defmem = 1024; $defmem += 512 if ($config{'virus'}); # ClamAV eats RAM local $rmem = ($config{'mem_low'} || $defmem)*1024*1024; if (defined(&proc::get_memory_info)) { local @mem = &proc::get_memory_info(); local $beans = &get_beancounters(); if ($mem[0]*1024 < $rmem) { # Memory is less than 512 MB (768 on 64-bit) &$second_print(&ui_text_color(&text('check_lowmemory', &nice_size($mem[0]*1024), &nice_size($rmem)), 'warn')); } elsif ($beans->{'vmguarpages'} && $beans->{'vmguarpages'}*4096 < $rmem && $beans->{'vmguarpages'} < $beans->{'privvmpages'}) { # OpenVZ guaranteed memory is lower than max memory, # and is less than 256 M &$second_print(&ui_text_color(&text('check_lowgmemory', &nice_size($mem[0]*1024), &nice_size($beans->{'vmguarpages'}*4096), &nice_size($rmem)), 'warn')); } elsif ($beans->{'vmguarpages'} && $beans->{'vmguarpages'} < $beans->{'privvmpages'}) { # OpenVZ guaranteed memory is lower than max memory, # but is above 256 M &$second_print(&text('check_okgmemory', &nice_size($mem[0]*1024), &nice_size($beans->{'vmguarpages'}*4096), &nice_size($rmem))); } else { # Memory is OK &$second_print(&text('check_okmemory', &nice_size($mem[0]*1024), &nice_size($rmem))); } } } if ($config{'dns'}) { # Make sure BIND is installed if (&is_dns_remote()) { # Only BIND module is needed &foreign_check("bind8") || return $text{'index_ebindmod'}; &$second_print($text{'check_dnsok3'}); } else { # BIND server must be installed and usable &foreign_installed("bind8", 1) == 2 || return &text('index_ebind', "../bind8/", $clink); # Validate BIND config &require_bind(); if (&bind8::supports_check_conf()) { my @errs = &bind8::check_bind_config(); if (@errs) { return &text('index_ebinderrs', join(", ", @errs)); } } # Check that primary NS hostname is reasonable &require_bind(); local $tmpl = &get_template(0); local $master = $tmpl->{'dns_master'} eq 'none' ? undef : $tmpl->{'dns_master'}; $master ||= $bind8::config{'default_prins'} || &get_system_hostname(); local $mastermsg; if ($master !~ /\./) { $mastermsg = &text('check_dnsmaster', "$master"); } my $masterip = &to_ipaddress($master); if (!$masterip) { $mastermsg ||= &text('check_dnsmaster2', "$master"); } elsif ($masterip ne &get_dns_ip() && $masterip ne &get_external_ip_address() && &indexof($masterip, &active_ip_addresses()) < 0) { $mastermsg ||= &text('check_dnsmaster2', "$master", "$masterip"); } $mastermsg = ", $mastermsg" if ($mastermsg); &$second_print($text{'check_dnsok2'}.$mastermsg); # Make sure TLSA records can be created if ($config{'tlsa_records'}) { my $err = &check_tlsa_support(); if ($err) { &$second_print(&text('check_etlsa', $err)); } else { &$second_print($text{'check_tlsaok'}); } } } } if ($config{'mail'}) { if ($config{'mail_system'} == 3) { # Work out which mail server we have if (&postfix_installed()) { $config{'mail_system'} = 0; } elsif (&qmail_vpopmail_installed()) { $config{'mail_system'} = 5; } elsif (&qmail_installed()) { $config{'mail_system'} = 2; } elsif (&sendmail_installed()) { $config{'mail_system'} = 1; } else { return &text('index_email'); } &$second_print(&text('check_detected', &mail_system_name())); &save_module_config(); } local $expected_mailboxes; if ($config{'mail_system'} == 1) { # Make sure sendmail is installed if (!&sendmail_installed()) { return &text('index_esendmail', '/sendmail/', "../config.cgi?$module_name"); } # Check that aliases and virtusers are configured &require_mail(); @$sendmail_afiles || return &text('index_esaliases', '/sendmail/'); $sendmail_vdbm || return &text('index_esvirts', '/sendmail/'); if ($config{'generics'}) { $sendmail_gdbm || return &text('index_esgens', '/sendmail/', $mclink); } if ($config{'bccs'}) { return &text('check_esendmailbccs', $mclink); } # Check for external interface local @addrs; local $conf = &sendmail::get_sendmailcf(); foreach my $dpo (&sendmail::find_options("DaemonPortOptions", $conf)) { local $addr = "*"; if ($dpo->[1] =~ /(Addr|Address|A)=([^ ,]+)/i) { $addr = $2; } local $port = 25; if ($dpo->[1] =~ /(Port|P)=([^ ,]+)/i) { $port = $2; } push(@addrs, [ $addr, $port ]); } if (@addrs) { # Need at least one non-localhost port 25 local @adescs; foreach my $a (@addrs) { if ($a->[0] eq '*') { push(@adescs, "port $a->[1]"); } else { push(@adescs, "$a->[0] port $a->[1]"); } } @addrs = grep { $_->[0] ne 'localhost' && $_->[0] ne '127.0.0.1' && $_->[0] !~ /:/ && ($_->[1] eq '25' || $_->[1] eq 'smtp') } @addrs; @addrs || return &text('check_esendmailaddrs', join(", ", @adescs), '/sendmail/'); } &$second_print($text{'check_sendmailok'}); $expected_mailboxes = 1; } elsif ($config{'mail_system'} == 0) { # Make sure postfix is installed if (!&postfix_installed()) { return &text('index_epostfix', '/postfix/', "../config.cgi?$module_name"); } # Check that all the need Postfix maps are working &require_mail(); my $err = &check_postfix_map("alias_maps"); return &text('check_ealias_maps', $err) if ($err); $err = &check_postfix_map($virtual_type); return &text('check_evirtual_maps', $err) if ($err); if ($config{'generics'}) { $canonical_maps || return &text('index_epgens', '/postfix/', $mclink); $err = &check_postfix_map($canonical_type); return &text('check_ecanonical_maps', $err) if ($err); } if ($config{'bccs'}) { $sender_bcc_maps || return &text('check_epostfixbccs', '/postfix/', $mclink); $err = &check_postfix_map("sender_bcc_maps"); return &text('check_ebcc_maps', $err) if ($err); } # Make sure virtual_alias_domains is not set, as it overrides # virtual_alias_maps local $vad = &postfix::get_real_value("virtual_alias_domains"); local $vam = &postfix::get_real_value($virtual_type); if ($vad && $vad ne $vam) { return &text('check_evad', $vad); } # Make sure mydestination contains hostname or origin local $myhost = &postfix::get_real_value("myorigin") || &postfix::get_real_value("myhostname") || &get_system_hostname(0, 1); if ($myhost =~ /^\//) { $myhost = &read_file_contents($myhost); $myhost =~ s/\s//g; } $myhost =~ s/^\s+//; $myhost =~ s/\s+$//; local @mydest = split(/[, ]+/, &postfix::get_real_value("mydestination")); if ($myhost && &indexoflc($myhost, @mydest) < 0 && &indexoflc('$myhostname', @mydest) < 0) { return &text('check_emydest', $myhost, join(", ", @mydest)); } &$second_print($text{'check_postfixok'}); $expected_mailboxes = 0; # Report on outgoing IP option if ($supports_dependent) { &$second_print($text{'check_dependentok'}); } elsif (&compare_versions($postfix::postfix_version, 2.7) < 0) { &$second_print($text{'check_dependentever'}); } else { local $l = '../postfix/dependent.cgi'; &$second_print(&text('check_dependentesupport', $l)); } } elsif ($config{'mail_system'} == 2) { # Make sure qmail is installed if (!&qmail_installed()) { return &text('index_eqmail', '/qmailadmin/', "../config.cgi?$module_name"); } if ($config{'generics'}) { return &text('index_eqgens', $mclink); } if ($config{'bccs'}) { return &text('check_eqmailbccs', $mclink); } local $tmpl = &get_template(0); if ($tmpl->{'append_style'} == 6) { &$second_print($text{'check_qmailmode6'}); } else { &$second_print($text{'check_qmailok'}); } $expected_mailboxes = 2; } elsif ($config{'mail_system'} == 4) { # Qmail+LDAP is deprecated return $text{'check_eqmailldap'}; } elsif ($config{'mail_system'} == 5) { # Make sure qmail with VPOPMail is installed if (!&qmail_vpopmail_installed()) { return &text('index_evpopmail', '/qmailadmin/', "../config.cgi?$module_name"); } if ($config{'generics'}) { return &text('index_eqgens', $mclink); } if ($config{'bccs'}) { return &text('check_eqmailbccs', $mclink); } &$second_print($text{'check_vpopmailok'}); $expected_mailboxes = 5; } # Check that Read User Mail module agrees if (&foreign_check("mailboxes") && defined($expected_mailboxes)) { local %mconfig = &foreign_config("mailboxes"); $mconfig{'mail_system'} == 3 || $mconfig{'mail_system'} == $expected_mailboxes || return &text('index_emailboxessystem', '/mailboxes/', "../config.cgi?$module_name", $text{'mail_system_'.$expected_mailboxes}); } } if ($config{'web'}) { # Make sure Apache is installed &foreign_installed("apache", 1) == 2 || return &text('index_eapache', "/apache/", $clink); # Make sure needed Apache modules are active if (!$apache::httpd_modules{'mod_actions'}) { return &text('check_ewebactions'); } # Check if template PHP mode is supported, and if not change it my @supp = &supported_php_modes(); foreach my $id (0, 1) { my $tmpl = &get_template($id); my $mode = &template_to_php_mode($tmpl); my $modupd; if (&indexof($mode, @supp) < 0) { my $mmap = &php_mode_numbers_map(); my ($best) = grep { $_ ne "none" } @supp; $best ||= $supp[0]; $tmpl->{'web_php_suexec'} = $mmap->{$best}; &$second_print(&text('check_ewebdefphpmode2', $mode, $supp[0])); &save_template($tmpl); $modupd++ } } # Complain if mod_php is the default mode, unless force reset above if ($mode eq "mod_php" && !$modupd) { &$second_print(&ui_alert_box(&text('check_ewebmod_php', $mode), 'warn', undef, undef, "", 'fa-spam')); } # Run Apache config check local $err = &apache::test_config(); if ($err) { local @elines = split(/\r?\n/, $err); @elines = grep { !/\[warn\]/ } @elines; $err = join("\n", @elines) if (@elines); return &text('check_ewebconfig', "
".&html_escape($err)."
"); } # Check for sane Apache version if (!$apache::httpd_modules{'core'}) { return $text{'check_ewebapacheversion'}; } elsif ($apache::httpd_modules{'core'} < 1.3) { return &text('check_ewebapacheversion2', $apache::httpd_modules{'core'}, 1.3); } # Check for Ubuntu PHP setting that breaks fcgi my $php5conf = "/etc/apache2/mods-enabled/php5.conf"; if (-r $php5conf) { my $lref = &read_file_lines($php5conf, 1); foreach my $l (@$lref) { if ($l =~ /^\s*SetHandler/) { return &text('check_ewebphp', "$php5conf", "SetHandler"); } } } # Check for breaking SetHandler lines local $conf = &apache::get_config(); local $fixed = &recursive_fix_sethandler($conf, $conf); if ($fixed) { &flush_file_lines(); } &$second_print($text{'check_webok'}); # Check HTTP2 support my ($ok, $err) = &supports_http2(); if ($ok) { &$second_print($text{'check_http2ok'}); } else { &$second_print(&text('check_http2err', $err)); } } if (&domain_has_website()) { # Check suEXEC / CGI mode my @cgimodes = &has_cgi_support(); if (@cgimodes) { &$second_print(&text('check_cgimodes', join(' ', @cgimodes))); } else { &$second_print($text{'check_nocgiscript'}); } # Report on supported PHP modes my @supp = grep { $_ ne 'none' } &supported_php_modes(); if (@supp) { &$second_print(&text('check_webphpmodes', join(" ", @supp))); } else { &$second_print($text{'check_ewebphpmodes'}); } # Report on PHP versions (unless it's just FPM, which we cover later) local @vers = &list_available_php_versions(); my @othersupp = grep { !/fpm|none/ } @supp; if (@othersupp) { local @msg; foreach my $v (@vers) { if ($v->[1]) { local $realv = &get_php_version($v->[0]); push(@msg, ($realv ||$v->[0])." (".$v->[1].")"); } else { push(@msg, $v->[0]." (mod_php)"); } } if (@msg) { &$second_print(&text('check_webphpvers', join(", ", @msg))); } else { &$second_print(&ui_text_color($text{'check_webphpnovers'}, 'warn')); } } # Check for PHP-FPM support my @fpms = &list_php_fpm_configs(); if (!@fpms) { &$second_print($text{'check_webphpnofpm2'}); } else { my @okfpms = grep { !$_->{'err'} } @fpms; my @errfpms = grep { $_->{'err'} } @fpms; if (@okfpms) { &$second_print(&text('check_webphpfpm2', join(" ", map { $_->{'version'}. " (".($_->{'package'} || $_->{'cmd'}).")" } @okfpms))); } if (@errfpms) { &$second_print(&text('check_ewebphpfpm2', join(" ", map { $_->{'version'}." ". "(".$_->{'err'}.")" } @errfpms))); } if (@okfpms > 1) { # Fix any port clashes for non-Virtualmin pools my %used; foreach my $conf (@okfpms) { my @pools = &list_php_fpm_pools($conf); my $restart = 0; foreach my $p (@pools) { my $pd = &get_domain($p); next if ($pd); my $t = get_php_fpm_pool_config_value( $conf, $p, "listen"); # If returned "$t" is "127.0.0.1:9000", # then extract the port number if ($t && $t =~ /\S+:(\d+)/) { $t = $1; } if ($t && $t =~ /^\d+$/ && $used{$t}++) { # Port is wrong! &$second_print(&text('check_webphpfpmport', $conf->{'shortversion'}, $t)); while($used{$t}) { $t = &increase_fpm_port($t) || 9001; } $used{$t}++; &save_php_fpm_pool_config_value( $conf, $p, "listen", $t); $restart++; } } if ($restart) { &restart_php_fpm_server($conf); } } } # Fix FPM versions that aren't enabled at boot my @bootfpms = grep { $_->{'init'} && !$_->{'enabled'}} @okfpms; foreach my $conf (@bootfpms) { &foreign_require("init"); &$second_print(&text('check_webfpmboot', $conf->{'shortversion'})); &init::enable_at_boot($conf->{'init'}); } # Check if the custom FPM binary path is a valid if ($config{'php_fpm_cmd'} && !-e $config{'php_fpm_cmd'}) { &$second_print(&text('check_ewebphpcustomcmd', "$config{'php_fpm_cmd'}")); } if ($config{'php_fpm_cmd'} && $config{'php_fpm_pool'} && !-d $config{'php_fpm_pool'}) { &$second_print(&text('check_ewebphpcustompool', "$config{'php_fpm_pool'}")); } # Check for invalid FPM versions, in case one has been # upgraded to a new release local @fpmfixed; @fpms = sort { &compare_versions($a->{'shortversion'}, $b->{'shortversion'}) } @fpms; foreach my $d (grep { &domain_has_website($_) && !$_->{'alias'} } &list_domains()) { # Check if an FPM version is stored, but doesn't exist next if (!$d->{'php_fpm_version'}); local $mode = &get_domain_php_mode($d); next if ($mode ne "fpm"); local ($f) = grep { $_->{'shortversion'} eq $d->{'php_fpm_version'} } @fpms; next if ($f); # Find the existing version just above the one that # was stored, or alternately the highest available local ($nf) = grep { &compare_versions($_->{'shortversion'}, $d->{'php_fpm_version'}) > 0 } @fpms; $nf ||= $fpms[$#fpms]; $d->{'php_fpm_version'} = $nf->{'shortversion'}; &save_domain($d); push(@fpmfixed, $d); } if (@fpmfixed) { &$second_print(&text('check_webphpverfixed', scalar(@fpmfixed))); } # Fix numeric ports for any Virtualmin domains foreach my $conf (@okfpms) { my @pools = &list_php_fpm_pools($conf); my $changed = 0; foreach my $p (@pools) { my $t = get_php_fpm_pool_config_value( $conf, $p, "listen"); if ($t =~ /^\d+$/) { $t = "localhost:".$t; &save_php_fpm_pool_config_value( $conf, $p, "listen", $t); $changed++; } } if ($changed) { &$second_print(&text('check_webphplocalfixed', $changed, $conf->{'shortversion'})); &$second_print(&text('check_fpmrestart', $conf->{'shortversion'})); &push_all_print(); &set_all_null_print(); &restart_php_fpm_server($conf); &pop_all_print(); } } } # Check for any unsupported mod_php directives if (!&get_apache_mod_php_version()) { my $changed = 0; foreach my $d (grep { $_->{'web'} } &list_domains()) { my @ports = ( $d->{'web_port'}, $d->{'ssl'} ? ( $d->{'web_sslport'} ) : ( ) ); foreach my $p (@ports) { my ($virt, $vconf, $conf) = &get_apache_virtual($d->{'dom'}, $p); next if (!$vconf); my @admin = &apache::find_directive( "php_admin_value", $vconf); if (@admin) { &apache::save_directive( "php_admin_value", [], $vconf, $conf); $changed++; } } } if ($changed) { &$second_print(&text('check_webadminfixed', "php_admin_value", $changed)); &flush_file_lines(); ®ister_post_action(\&restart_apache); } } # Check if any new PHP versions have shown up, and re-generate their # cgi and fcgid wrappers and INI files local @newvernums = sort { $a <=> $b } map { $_->[0] } &unique(@vers); local @oldvernums = sort { $a <=> $b } split(/\s+/, $config{'last_check_php_vers'}); if (join(" ", @newvernums) ne join(" ", @oldvernums)) { my $indented_print; foreach my $d (grep { &domain_has_website($_) && !$_->{'alias'} } &list_domains()) { eval { local $main::error_must_die = 1; local $mode = $d->{'php_mode'} || &get_domain_php_mode($d); if ($mode && $mode ne "mod_php" && $mode ne "fpm" && $mode ne "none") { if (!$indented_print++) { &$first_print(&text('check_webphpversinis', join(", ", @newvernums))); &$indent_print(); } &$first_print(&text('check_webphpversd', &show_domain_name($d))); &obtain_lock_web($d); &save_domain_php_mode($d, $mode); &clear_links_cache($d); &release_lock_web($d); &$second_print($text{'setup_done'}); } }; } &$outdent_print(), &$second_print("") if ($indented_print); $config{'last_check_php_vers'} = join(" ", @newvernums); } } if ($config{'webalizer'}) { # Make sure Webalizer is installed, and that global directives are OK &domain_has_website() || return &text('check_edepwebalizer', $clink); &foreign_installed("webalizer", 1) == 2 || return &text('index_ewebalizer', "/webalizer/", $clink); &foreign_require("webalizer"); # This is not needed #local $conf = &webalizer::get_config(); #$current = &webalizer::find_value("IncrementalName", $conf); #$history = &webalizer::find_value("HistoryName", $conf); #if ($current =~ /^\//) { # &check_error(&text('check_current', "/webalizer/")); # } #elsif ($history =~ /^\//) { # &check_error(&text('check_history', "/webalizer/")); # } # Make sure template config file exists local $wfile = $tmpl->{'webalizer'} || $webalizer::config{'webalizer_conf'}; if (!-r $wfile) { return &text('index_ewebalizerfile', $wfile, "/webalizer/"); } &$second_print($text{'check_webalizerok'}); } if ($config{'ssl'}) { # Make sure openssl is installed, that Apache supports mod_ssl, # and that port 443 is in use $config{'web'} || return &text('check_edepssl', $clink); &has_command("openssl") || return &text('index_eopenssl', "openssl", $clink); &require_apache(); local $conf = &apache::get_config(); local @loads = &apache::find_directive_struct("LoadModule", $conf); local ($l, $hasmod); foreach $l (@loads) { $hasmod++ if ($l->{'words'}->[1] =~ /mod_ssl/); } local ($aver, $amods) = &apache::httpd_info(&apache::find_httpd()); $hasmod++ if (&indexof("mod_ssl", @$amods) >= 0); $hasmod++ if ($apache::httpd_modules{'mod_ssl'}); $hasmod || return &text('index_emodssl', "mod_ssl", $clink); local @listens = &apache::find_directive_struct("Listen", $conf); local $haslisten; foreach $l (@listens) { $haslisten++ if ($l->{'words'}->[0] =~ /^(\S+:)?$default_web_sslport$/); } local @ports = &apache::find_directive_struct("Port", $conf); foreach $l (@ports) { $haslisten++ if ($l->{'words'}->[0] == $default_web_sslport); } $haslisten || return &text('index_emodssl2', $default_web_sslport, $clink); &$second_print($text{'check_sslok'}); } if ($config{'mysql'}) { # Make sure MySQL is installed &require_mysql(); if ($config{'provision_mysql'}) { # Only MySQL client is needed &foreign_installed("mysql") || return &text('index_emysql2', "/mysql/", $clink); &$second_print($text{'check_mysqlok'}); } else { # MySQL server is needed my $mysql_server_status = &foreign_installed("mysql", 1); my ($defmysql) = grep { $_->{'config'}->{'virtualmin_default'} && $_->{'dbtype'} eq 'mysql' } &list_remote_mysql_modules(); if ($defmysql && $defmysql->{'host'}) { &$second_print($text{'check_mysqlok3'}); } elsif ($mysql_server_status != 2) { return &text('index_emysql', "/mysql/", $clink); } else { my ($mysql_ver) = &get_dom_remote_mysql_version(); if ($mysql::mysql_pass eq '') { if (defined(&mysql::mysql_login_type) && &mysql::mysql_login_type($mysql::mysql_login || 'root')) { # Using socket authentication &$second_print(&text('check_mysqlnopasssocket', $mysql_ver)); } else { &$second_print(&text('check_mysqlnopass', '/mysql/root_form.cgi', $mysql_ver)); } } else { &$second_print(&text('check_mysqlok', $mysql_ver)); } # Update any cached MySQL version if (defined(&mysql::save_mysql_version)) { &mysql::save_mysql_version(); } # If MYSQL_PWD doesn't work, disable it if (defined(&mysql::working_env_pass) && !&mysql::working_env_pass()) { $mysql::config{'nopwd'} = 1; &mysql::save_module_config(); } } } } if ($config{'postgres'}) { # Make sure PostgreSQL is installed &require_postgres(); my ($defpostgres) = grep { $_->{'config'}->{'virtualmin_default'} && $_->{'dbtype'} eq 'postgres' } &list_remote_mysql_modules(); if ($defpostgres && $defpostgres->{'host'}) { &$second_print($text{'check_postgresok3'}); } else { &foreign_installed("postgresql", 1) == 2 || return &text('index_epostgres', "/postgresql/", $clink); if (!$postgresql::postgres_sameunix && $postgresql::postgres_pass eq '') { &$second_print(&text('check_postgresnopass', '/postgresql/', $postgresql::postgres_login || 'root')); } else { my $v = &get_dom_remote_postgres_version(); &$second_print(&text('check_postgresok', $v)); } } } if ($config{'ftp'}) { # Make sure ProFTPd is installed, and that the ftp user exists &foreign_installed("proftpd", 1) == 2 || return &text('index_eproftpd', "/proftpd/", $clink); local $err = &check_proftpd_template(); $err && return &text('check_proftpd', $err); &$second_print($text{'check_ftpok'}); } if ($config{'logrotate'}) { # Make sure logrotate is installed &foreign_installed("logrotate", 1) == 2 || return &text('index_elogrotate', "/logrotate/", $clink); &foreign_require("logrotate"); local $ver = &logrotate::get_logrotate_version(); &compare_versions($ver, 3.6) >= 0 || return &text('index_elogrotatever', "/logrotate/", $clink, $ver, 3.6); # Make sure the current config is OK local $out = &backquote_with_timeout( "$logrotate::config{'logrotate'} -d -f ". "e_path($logrotate::config{'logrotate_conf'})." 2>&1", 60, 1, 1000); if ($? && $out =~ /(.*stat\s+of\s+.*\s+failed:.*)/) { return &text('check_elogrotateconf', "
".&html_escape("$1")."
"); } &$second_print($text{'check_logrotateok'}); } if ($config{'spam'}) { # Make sure SpamAssassin and procmail are installed &foreign_installed("spam", 1) == 2 || return &text('index_espam', "/spam/", $clink); &foreign_installed("procmail", 1) == 2 || return &text('index_eprocmail', "/procmail/", $clink); local $spamclient = &get_global_spam_client(); if ($spamclient =~ /^spamassassin/) { # Make sure it supports --siteconfigpath local $out = &backquote_command("$spamclient -h 2>&1 {'action'} =~ /spamassassin|spamc/) { return &text('check_spamglobal', "$procmail::procmailrc"); } } # Check for spam_white conflict with spamc if ($config{'spam_white'}) { local ($client, $host, $size) = &get_global_spam_client(); if ($client eq "spamc") { return &text('check_spamwhite', $mclink, "edit_newsv.cgi"); } } # If using Postfix, procmail-wrapper must be used and setuid root if ($hasprocmail && $config{'mail_system'} == 0) { &require_mail(); local $mbc = &postfix::get_real_value("mailbox_command"); local @mbc = &split_quoted_string($mbc); $mbc[0] = &has_command($mbc[0]); local @st = stat($mbc[0]); if (!&has_command($mbc[0])) { # Procmail does not exist return &text('check_spamwrappercmd', $mbc[0]); } if ($mbc[0] !~ /\/procmail-wrapper$/) { # Command must be the procmail wrapper return &text('check_spamwrappercmd2', $mbc[0]); } if ($st[4] != 0) { # User is not root local $user = getpwuid($st[4]); return &text('check_spamwrapperuser', $mbc[0], $user || "UID $st[4]"); } if ($st[5] != 0) { # Group is not root local $group = getgrgid($st[5]); return &text('check_spamwrappergroup', $mbc[0], $group || "GID $st[5]"); } if (($st[2] & 04000) != 04000) { # Not setuid and setgid return &text('check_spamwrapperperms', $mbc[0], sprintf("%o", $st[2])); } # Check for safe flags my @safe = ("-o", "-a", "\$DOMAIN", "-d", "\$LOGNAME"); my $ok = 1; for(my $i=0; $i<@safe; $i++) { $ok = 0 if ($mbc[$i+1] ne $safe[$i]); } $ok = 0 if (@mbc != @safe+1); if (!$ok) { return &text('check_spamwrapperargs', $mbc, join(" ", @safe)); } } } if ($config{'virus'}) { # Make sure ClamAV is installed and working $config{'spam'} || return $text{'check_evirusspam'}; &full_clamscan_path() || return &text('index_evirus', "$config{'clamscan_cmd'}", $clink); if ($config{'clamscan_cmd'} eq "clamdscan") { # Need clamd to be running &find_byname("clamd") || return $text{'check_eclamd'}; } local $err; if ($config{'clamscan_cmd_tested'} ne $config{'clamscan_cmd'}) { $err = &test_virus_scanner($config{'clamscan_cmd'}, $config{'clamscan_host'}); } if ($err) { # Failed .. but this can often be due to the ClamAV database # being out of date. local $freshclam = &has_command("freshclam"); if (!$freshclam && $config{'clamscan_cmd'} =~ /^(\/.*\/)[^\/]+$/) { $freshclam = $1."freshclam"; } if (-x $freshclam) { local $cout = &backquote_with_timeout($freshclam, 180); $err = &test_virus_scanner($config{'clamscan_cmd'}, $config{'clamscan_host'}); } } if ($err) { return &text('index_evirusrun2', "$config{'clamscan_cmd'}", $err, "edit_newsv.cgi"); } if ($config{'clamscan_cmd_tested'} eq $config{'clamscan_cmd'}) { &$second_print($text{'check_virusok2'}); } else { $config{'clamscan_cmd_tested'} = $config{'clamscan_cmd'}; &$second_print($text{'check_virusok'}); } } if ($config{'status'}) { # Make sure scheduled status monitoring is enabled &foreign_check("status") || return &text('index_estatus', "/status/", $clink); local %sconfig = &foreign_config("status"); if ($sconfig{'sched_mode'}) { &$second_print($text{'check_statusok'}); } else { &$second_print(&text('check_statussched', "../status/edit_sched.cgi")); } } # Check all plugins foreach $p (@plugins) { if ($p eq "virtualmin-mysqluser") { return &text('check_emysqlplugin'); } local $err = &plugin_call($p, "feature_check"); if ($err) { return &text('check_eplugin', "$p", $err); } else { my $pname = &plugin_call($p, "feature_name"); &$second_print(&text('check_plugin', $pname)); } } if (!$config{'iface'}) { if (!&running_in_zone()) { # Work out the network interface automatically $config{'iface'} = &first_ethernet_iface(); if (!$config{'iface'}) { return &text('index_eiface', "../config.cgi?$module_name"); } &save_module_config(); } else { # In a zone, it is worked out as needed, as it changes! $config{'iface'} = undef; } } if (!&running_in_zone()) { &$second_print(&text('check_ifaceok', "$config{'iface'}")); } # Tell the user that IPv6 is available if ($config{'ip6enabled'} && &supports_ip6()) { !$config{'netmask6'} || $config{'netmask6'} =~ /^\d+$/ || return &text('check_enetmask6', $config{'netmask6'}); if (&supports_ip6() == 2) { &$second_print(&text('check_iface6', "".($config{'iface6'} || $config{'iface'})."")); } } # Show the default IPv4 address local $defip = &get_default_ip(); if (!$defip) { return &text('index_edefip', "../config.cgi?$module_name"); } else { &$second_print(&text('check_defip', $defip)); } $config{'old_defip'} ||= $defip; # Show the default IPv6 address if ($config{'ip6enabled'} && &supports_ip6()) { local $defip6 = &get_default_ip6(); if ($defip6) { &$second_print(&text('check_defip6', $defip6)); } $config{'old_defip6'} ||= $defip6; } # Make sure the external IP is set if needed if ($config{'dns_ip'} ne '*') { local $dns_ip = $config{'dns_ip'} || $defip; local $ext_ip = &get_external_ip_address(); if ($ext_ip && $ext_ip eq $dns_ip) { # Looks OK &$second_print(&text($config{'dns_ip'} ? 'check_dnsip1' : 'check_dnsip2', $dns_ip)); } elsif ($ext_ip && $ext_ip ne $dns_ip) { # Mis-match .. warn user &$second_print(&ui_text_color(&text($config{'dns_ip'} ? 'check_ednsip1' : 'check_ednsip2', $dns_ip, $ext_ip, "../config.cgi?$module_name"), 'warn')); } } else { my $ext_ip = &get_external_ip_address(); if ($ext_ip) { &$second_print(&text('check_dnsip3', $ext_ip)); } else { &$second_print(&ui_text_color($text{'check_ednsip3'}, 'warn')); } } # Make sure local group exists if ($config{'localgroup'} && !defined(getgrnam($config{'localgroup'}))) { return &text('index_elocal', "$config{'localgroup'}", "../config.cgi?$module_name"); } # Validate home directory format if ($config{'home_base'} && $config{'home_base'} !~ /^\/\S+/) { return &text('check_ehomebase', "$config{'home_base'}", "../config.cgi?$module_name"); } &require_useradmin(); if (!$config{'home_base'} && $uconfig{'home_base'} !~ /^\/\S+/) { return &text('check_ehomebase2', "$uconfig{'home_base'}", "../config.cgi?useradmin"); } if ($config{'home_format'} && $config{'home_format'} !~ /\$\{(USER|UID|DOM|PREFIX)\}/ && $config{'home_format'} !~ /\$(USER|UID|DOM|PREFIX)/) { return &text('check_ehomeformat', "$config{'home_format'}", "../config.cgi?$module_name"); } elsif (!$config{'home_format'} && $uconfig{'home_style'} == 4) { return &text('check_ehomestyle', "../config.cgi?useradmin"); } $config{'home_quotas'} = ''; $config{'mail_quotas'} = ''; $config{'group_quotas'} = ''; if ($config{'quotas'} && $config{'quota_commands'}) { # External commands are being used for quotas - make sure they exist! foreach my $c ("set_user", "set_group", "list_users", "list_groups") { local ($cmd) = &split_quoted_string( $config{"quota_".$c."_command"}); $cmd && &has_command($cmd) || return $text{'check_e'.$c}; } foreach my $c ("get_user", "get_group") { local ($cmd) = &split_quoted_string( $config{"quota_".$c."_command"}); !$cmd || &has_command($cmd) || return $text{'check_e'.$c}; } &$second_print($text{'check_quotacommands'}); } elsif ($config{'quotas'}) { # Make sure quotas are enabled, and work out where they are needed local $qerr; &require_useradmin(); if (!$home_base) { $qerr = &text('index_ehomebase'); } elsif (&running_in_zone()) { $qerr = &text('index_ezone'); } else { local $mail_base = &simplify_path(&resolve_links( &mail_system_base())); local ($home_mtab, $home_fstab) = &mount_point($home_base); local ($mail_mtab, $mail_fstab) = &mount_point($mail_base); if (!$home_mtab) { $qerr = &text('index_ehomemtab', "$home_base"); } elsif (!$mail_mtab) { $qerr = &text('index_emailmtab', "$mail_base"); } else { # Check if quotas are enabled for home filesystem local $nohome; $home_mtab->[4] = "a::quota_can($home_mtab, $home_fstab); $home_mtab->[4] &&= "a::quota_now($home_mtab, $home_fstab); if ($home_mtab->[4] != 3 && $home_mtab->[4] != 7) { # User quotas are not active (we need # both user and group quotas being active) $nohome++; } else { # User quotas are active if ($home_mtab->[4] >= 2) { # Group quotas are active too $config{'group_quotas'} = 1; } } if ($home_mtab->[0] eq $mail_mtab->[0]) { # Home and mail are the same filesystem if ($nohome) { # Neither are enabled $qerr = &text('index_equota2', "$home_mtab->[0]", "$home_base", "$mail_base"); } else { # Both are enabled $config{'home_quotas'} = mount_point_bind($home_mtab->[0]); $config{'mail_quotas'} = mount_point_bind($home_mtab->[0]); } } else { # Different .. so check mail too local $nomail; $mail_mtab->[4] = "a::quota_can( $mail_mtab, $mail_fstab); $mail_mtab->[4] &&= "a::quota_now( $mail_mtab, $mail_fstab); if ($mail_mtab->[4] != 3 && $mail_mtab->[4] != 7) { # Mail user quotas are not active (we need # both user and group quotas being active) $nomail++; } if ($nohome) { $qerr = &text('index_equota3', "$home_mtab->[0]", "$home_base"); } else { $config{'home_quotas'} = $home_mtab->[0]; } if ($nomail) { $qerr = &text('index_equota4', "$mail_mtab->[0]", "$mail_base"); } else { $config{'mail_quotas'} = $mail_mtab->[0]; } } } } if ($qerr) { # Check if a reboot is needed to enable XFS quotas on / if (&needs_xfs_quota_fix() == 1) { my $reboot_msg = "\n$text{'licence_xfsreboot'} "; if (&foreign_available("init")) { $reboot_msg .= ui_link("@{[&get_webprefix_safe()]}/init/reboot.cgi", $text{'licence_xfsrebootok'}); $reboot_msg .= "."; } &$second_print(&ui_text_color($reboot_msg, 'warn')); } else { &$second_print(&ui_text_color($qerr, 'warn')); } } elsif (!$config{'group_quotas'}) { &$second_print($text{'check_nogroup'}); } else { &$second_print($text{'check_group'}); } } else { &$second_print($text{'check_noquotas'}); } # Check for FTP shells in /etc/shells local $_; open(SHELLS, ") { s/\r|\n//g; s/#.*$//; $shells{$_}++; } close(SHELLS); local ($nologin_shell, $ftp_shell) = &get_common_available_shells(); if ($nologin_shell && $shells{$nologin_shell->{'shell'}}) { &$second_print(&text('check_eshell', "$nologin_shell->{'shell'}", "/etc/shells")); } if ($ftp_shell && !$shells{$ftp_shell->{'shell'}}) { &$second_print(&text('check_eftpshell', "$ftp_shell->{'shell'}", "/etc/shells")); } # Make sure LDAP module is set up, if selected if ($config{'ldap'}) { &require_useradmin(); local $ldap = &ldap_useradmin::ldap_connect(1); if (!ref($ldap)) { return &text('check_eldap', $ldap, $clink, "../ldap-useradmin/"); } else { &require_useradmin(); if (!defined(&ldap_useradmin::list_users)) { return &text('check_eldap2', $clink, 1.164); } else { &$second_print(&text('check_ldap')); } } } # Check for conflicting other-modules calls if ($config{'unix'} && $config{'other_users'}) { # MySQL user creation local %mconfig = &foreign_config('mysql'); if ($mconfig{'sync_create'} || $mconfig{'sync_modify'} || $mconfig{'sync_delete'}) { return &text('check_emysqlsync', '../mysql/list_users.cgi'); } # User and group default quotas if ($config{'home_quotas'}) { local %qconfig = &foreign_config('quota'); local @syncs = map { /^sync_(\S+)/; $1 } grep { /^sync_/ } (keys %qconfig); if (@syncs) { return &text('check_equotasync', join(' , ', map { "$_" } @syncs), '../quota/'); } local @gsyncs = map { /^gsync_(\S+)/; $1 } grep { /^gsync_/ } (keys %qconfig); if (@gsyncs) { return &text('check_egquotasync', join(' , ', map { "$_" } @gsyncs), '../quota/'); } } } # Make sure needed compression programs are installed if (!&has_command("tar")) { return &text('check_ebcmd', "tar"); } local @bcmds = $config{'compression'} == 0 ? ( "gzip", "gunzip" ) : $config{'compression'} == 3 ? ( "zip", "unzip" ) : $config{'compression'} == 1 && $config{'pbzip2'} ? ( "pbzip2" ) : $config{'compression'} == 1 ? ( "bzip2", "bunzip2" ) : ( ); foreach my $bcmd (@bcmds) { if (!&has_command($bcmd)) { return &text('check_ebcmd', "$bcmd"); } } # If pbzip2 is being used, make sure it is a version that supports # compressing to stdout if ($config{'compression'} == 1 && $config{'pbzip2'}) { local $out = &backquote_command("pbzip2 -V 2>&1"); if ($out !~ /Parallel\s+BZIP2\s+v([0-9\.]+)/i) { return &text('check_epbzip2out', "".&html_escape($out).""); } local $ver = $1; if (&compare_versions($ver, "1.0.4") < 0) { return &text('check_epbzip2ver', "1.0.4", $ver); } } &$second_print(&text('check_bcmdok')); # Check if resource limits are supported if (defined(&supports_resource_limits)) { local ($rok, $rmsg) = &supports_resource_limits(1); &$second_print(!$rok ? &text('check_reserr', $rmsg) : $rmsg ? &text('check_reswarn', $rmsg) : $text{'check_resok'}); } # Check if software packages work, for script installs if (&foreign_check("software")) { &foreign_require("software"); if (defined(&software::check_package_system)) { local $err = &software::check_package_system(); local $uerr = &software::check_update_system(); if ($err) { &$second_print(&text('check_packageerr', $err)); } elsif ($uerr) { &$second_print(&text('check_updateerr', $err)); } else { &$second_print(&text('check_packageok')); } } } # Check if jailkit support is available my $err = &check_jailkit_support(); if ($err) { &$second_print(&text('check_jailkiterr', $err)) if(!$config{'jailkit_disabled'}); } else { &$second_print(&text('check_jailkitok')); } # If using the Pro version, make sure the repo licence matches my %vserial; if ($virtualmin_pro && &read_env_file($virtualmin_license_file, \%vserial) && $vserial{'SerialNumber'} ne 'GPL') { if ($gconfig{'os_type'} eq 'redhat-linux') { # Check the YUM config file if (!-r $virtualmin_yum_repo) { &$second_print(&text('check_eyumrepofile', $virtualmin_yum_repo)); } else { # File exists, but does it contain the right repo line? my $lref = &read_file_lines($virtualmin_yum_repo, 1); my $found = 0; foreach my $l (@$lref) { if ($l =~ /baseurl=https?:\/\/([^:]+):([^\@]+)\@$upgrade_virtualmin_host/) { if ($1 eq $vserial{'SerialNumber'} && $2 eq $vserial{'LicenseKey'}) { $found = 2; } else { $found = 1; } last; } } if ($found == 2) { &$second_print($text{'check_yumrepook'}); } elsif ($found == 1) { &$second_print(&text('check_yumrepowrong', $virtualmin_yum_repo)); } else { &$second_print(&text('check_yumrepomissing', $virtualmin_yum_repo)); } } } elsif ($gconfig{'os_type'} eq 'debian-linux') { # Check the APT config file if (!-r $virtualmin_apt_repo) { &$second_print(&text('check_eaptrepofile', $virtualmin_apt_repo)); } else { # File exists, but does it contain the right repo line? my $lref = &read_file_lines($virtualmin_apt_repo, 1); my $found = 0; foreach my $l (@$lref) { # An old Debian format with login/pass inside of the repo file if ($l =~ /^deb(.*?)https?:\/\/([^:]+):([^\@]+)\@$upgrade_virtualmin_host/) { if ($2 eq $vserial{'SerialNumber'} && $3 eq $vserial{'LicenseKey'}) { $found = 2; } else { $found = 1; } last; } # A new Debian format with auth in a separate file if ($l =~ /^deb(.*?)(https):(\/)(\/).*($upgrade_virtualmin_host.*)$/ && -r "$virtualmin_apt_auth_dir/virtualmin.conf") { my $auth_conf_lines = &read_file_contents("$virtualmin_apt_auth_dir/virtualmin.conf"); if ($auth_conf_lines =~ /machine\s+$upgrade_virtualmin_host\s+login\s+(\S+)\s+password\s+(\S+)/gmi) { if ($1 eq $vserial{'SerialNumber'} && $2 eq $vserial{'LicenseKey'}) { $found = 2; } else { $found = 1; } last; } } } if ($found == 2) { &$second_print($text{'check_aptrepook'}); } elsif ($found == 1) { &$second_print(&text('check_aptrepowrong', $virtualmin_apt_repo)); } else { &$second_print(&text('check_aptrepomissing', $virtualmin_apt_repo)); } } } } # Display a message about deprecated repos if ($gconfig{'os_type'} =~ /^(redhat-linux|debian-linux)$/) { my $repolines; if ($gconfig{'os_type'} eq 'redhat-linux') { # File exists, but does it contain correct repo links $repolines = &read_file_lines($virtualmin_yum_repo, 1) if (-r $virtualmin_yum_repo); } elsif ($gconfig{'os_type'} eq 'debian-linux') { # File exists, but does it contain correct repo links $repolines = &read_file_lines($virtualmin_apt_repo, 1) if (-r $virtualmin_apt_repo); } # Does repo file has correct links? my $repofound; if (defined($repolines)) { foreach my $repoline (@$repolines) { $repofound++ # If repo file contains /vm/6/ or /vm/7/ consider valid if ($repoline =~ /\/(vm\/(?|([6-9])|([0-9]{2,4})))\//); } if (!$repofound) { &$second_print(&ui_text_color( &text('check_repoeoutdate', "$virtualmin_link/documentation/repositories/"), 'warn')); } } } # Check for disabled features that were just turned off if ($lastconfig) { my @doms = &list_domains(); foreach my $f (@features) { if (!$config{$f} && $lastconfig->{$f}) { my @lost = grep { $_->{$f} } @doms; if (@lost) { return &text('check_lostfeature', $text{'feature_'.$f}, join(" ", map { $_->{'dom'} } @lost)); } } } } # All looks OK .. save the config $config{'last_check'} = time()+1; $config{'disable'} =~ s/user/unix/g; # changed since last release &lock_file($module_config_file); &save_module_config(); &unlock_file($module_config_file); &write_file("$module_config_directory/last-config", \%config); return undef; } # recursive_fix_sethandler(&directive, &config) # Remove any global SetHandler lines that would run PHP in mod_php mode sub recursive_fix_sethandler { my ($dirs, $conf) = @_; my $rv = 0; my @sh = &apache::find_directive("SetHandler", $dirs); my @newsh; foreach my $sh (@sh) { if ($sh !~ /^application\/x-httpd-php/) { push(@newsh, @sh); } } if (@sh != @newsh) { $rv += @sh - @newsh; &apache::save_directive("SetHandler", \@newsh, $dirs, $conf); } foreach my $m (@$dirs) { if ($m->{'type'} && $m->{'name'} ne 'VirtualHost') { $rv += &recursive_fix_sethandler($m->{'members'}, $conf); } } return $rv; } # need_update_webmin_users_post_config(&oldconfig) # Check if we need to Webmin users following a config re-check sub need_update_webmin_users_post_config { local ($lastconfig) = @_; local $webminchanged = 0; foreach my $k (keys %config) { if ($k eq 'leave_acl' || $k eq 'webmin_modules' || $k eq 'last_check_php_vers' || &indexof($k, @features) >= 0) { $webminchanged++ if ($config{$k} ne $lastconfig->{$k}); } } return $webminchanged; } # get_beancounters() # Returns the contents of /proc/user_beancounters for this VM sub get_beancounters { local %beans; local $inctx = 0; open(BEANS, ") { if (/^\s*(\d+):/) { if ($1 != 0) { $inctx = 1; } else { $inctx = 0; } } if (/\s+(\S+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)/ && $inctx) { $beans{$1} = $5; } } close(BEANS); return \%beans; } # run_post_config_actions(&lastconfig) # Make various changes to the system as specified by a new module config. # May print stuff. sub run_post_config_actions { local %lastconfig = %{$_[0]}; # Update the domain owner's group &update_domain_owners_group(); # Update preload settings if changed if ($config{'preload_mode'} != $lastconfig{'preload_mode'}) { &$first_print($text{'check_preload'}); &update_miniserv_preloads($config{'preload_mode'}); &restart_miniserv(); &$second_print($text{'setup_done'}); } # Update collectinfo.pl run time if ($config{'collect_interval'} ne $lastconfig{'collect_interval'}) { if ($config{'collect_interval'} eq 'none') { &$first_print($text{'check_collectoff'}); } else { &$first_print($text{'check_collect'}); } &setup_collectinfo_job(); &$second_print($text{'setup_done'}); } # Re-collect system info local $info = &collect_system_info(); if ($info) { &save_collected_info($info); } # Update spamassassin lock files if ($config{'spam_lock'} != $lastconfig{'spam_lock'}) { &$first_print($config{'spam_lock'} ? $text{'check_spamlockon'} : $text{'check_spamlockoff'}); &save_global_spam_lockfile($config{'spam_lock'}); &$second_print($text{'setup_done'}); } # Fix default procmail delivery if changed if ($config{'default_procmail'} != $lastconfig{'default_procmail'}) { &setup_default_delivery(); } # Re-create API helper command if ($config{'api_helper'} ne $lastconfig{'api_helper'} || !&has_command(&get_api_helper_command())) { &$first_print($text{'check_apicmd'}); local ($ok, $path) = &create_virtualmin_api_helper_command(); &$second_print(&text($ok ? 'check_apicmdok' : 'check_apicmderr', $path)); } # Create Bash startup profile for PHP alias work on sub-server # basis, so users could use specific to sub-server PHP version my $profiled = "/etc/profile.d"; my $profiledphpalias = "$profiled/virtualmin-phpalias.sh"; if (-d $profiled && !-r $profiledphpalias) { &$first_print($text{'check_bashphpprofile'}); my $phpalias = "php=\$\(which php 2>/dev/null\)\n". "if \[ -x \"\$php\" \]; then\n". " alias php='\$\(phpdom=\"bin/php\" ; \(while [ ! -f \"\$phpdom\" ] && [ \"\$PWD\" != \"/\" ]; do cd \"\$\(dirname \"\$PWD\"\)\" || \"\$php\" ; done ; if [ -f \"\$phpdom\" ] ; then echo \"\$PWD/\$phpdom\" ; else echo \"\$php\" ; fi\)\)'\n". "fi\n"; &write_file_contents($profiledphpalias, $phpalias); &$second_print($text{'setup_done'}); } # Check host default domain &check_virtualmin_default_hostname_ssl(); # Restart lookup-domain daemon, if need if ($config{'spam'} && !$config{'no_lookup_domain_daemon'}) { &setup_lookup_domain_daemon(); } # If bandwidth checking was enabled in the backup, re-enable it now &setup_bandwidth_job($config{'bw_active'}, $config{'bw_step'} || 1); # Re-setup script warning job, if it was enabled if (defined(&setup_scriptwarn_job) && defined($config{'scriptwarn_enabled'})) { &setup_scriptwarn_job($config{'scriptwarn_enabled'}, $config{'scriptwarn_wsched'}); } # Re-setup script updates job, if it was enabled if (defined(&setup_scriptlatest_job) && $config{'scriptlatest_enabled'}) { &setup_scriptlatest_job(1); } # Re-setup spam clearing / retention cron job &setup_spamclear_cron_job(); # Re-setup the validation cron job based on the saved config local ($oldjob, $job); $oldjob = $job = &find_cron_script($validate_cron_cmd); $job ||= { 'user' => 'root', 'active' => 1, 'command' => $validate_cron_cmd }; if ($oldjob) { &delete_cron_script($validate_cron_cmd); } if ($config{'validate_sched'}) { # Re-create cron job if ($config{'validate_sched'} =~ /^\@(\S+)/) { $job->{'special'} = $1; } else { ($job->{'mins'}, $job->{'hours'}, $job->{'days'}, $job->{'months'}, $job->{'weekdays'}) = split(/\s+/, $config{'validate_sched'}); delete($job->{'special'}); } &setup_cron_script($job); } # Enable or disable mail client auto-config if ($config{'mail_autoconfig'} ne '') { my @doms = grep { $_->{'mail'} && &domain_has_website($_) && !$_->{'alias'} } &list_domains(); foreach my $d (@doms) { if ($config{'mail_autoconfig'} eq '1') { &enable_email_autoconfig($d); } else { &disable_email_autoconfig($d); } } } } # mount_point(dir) # Returns both the mtab and fstab details for the parent mount for a directory sub mount_point { local $dir = &resolve_links($_[0]); if ($mount_point_cache{$dir}) { # Already found, so no need to re-lookup return @{$mount_point_cache{$dir}}; } &foreign_require("mount"); local @mounts = &mount::list_mounts(); local @mounted = &mount::list_mounted(); # Exclude swap mounts local @realmounts = grep { $_->[0] ne 'none' && $_->[0] ne 'proc' && $_->[0] ne '/proc' && $_->[0] !~ /^swap/ && $_->[1] ne 'none' } @mounts; if (!@realmounts) { # If /etc/fstab contains no real mounts (such as in a VPS environment), # then fake it to be the same as /etc/mtab @mounts = @mounted; } foreach my $m (sort { length($b->[0]) <=> length($a->[0]) } @mounted) { if ($dir eq $m->[0] || $m->[0] eq "/" || substr($dir, 0, length($m->[0])+1) eq "$m->[0]/") { # Found currently mounted parent directory local ($m2) = grep { $_->[0] eq $m->[0] } @mounts; if ($m2) { if ($m2->[2] eq "bind" && $m2->[0] eq $m2->[1]) { # Skip loopback mount onto same directory, # as any quotas will be defined in the real # mount. next; } # Found boot-time mount as well $mount_point_cache{$dir} = [ $m, $m2 ]; return ($m, $m2); } } } print STDERR "Failed to find mount point for $dir\n"; return ( ); } # mount_point_bind(dir) # Check the home to be mounted with other device sub mount_point_bind { my ($mount) = @_; if (!&has_command("findmnt")) { return $mount; } my %uconfig = foreign_config("useradmin"); my %bind_mounts = map { $_ => 1 } split( /\n/m, &backquote_command('findmnt -r | grep -oP \'^(\S+)(?=.*\[\/)\'') ); if (exists($bind_mounts{$uconfig{'home_base'}})) { my @device = sub_mount_points($uconfig{'home_base'}); if (@device) { $mount = $device[0]->[1]; } } return $mount; } # sub_mount_points(dir) # Returns the mtab entries for mounts at or under some directory sub sub_mount_points { local $dir = &resolve_links($_[0]); &foreign_require("mount"); local @mounted = &mount::list_mounted(); local @rv; foreach my $m (@mounted) { if ($dir eq $m->[0] || &is_under_directory($dir, $m->[0])) { push(@rv, $m); } } return @rv; } # show_template_basic(&tmpl) # Outputs HTML for editing basic template options (like the name) sub show_template_basic { local ($tmpl) = @_; # Name of this template - only editable for custom templates print &ui_table_row(&hlink($text{'tmpl_name'}, "template_name"), $tmpl->{'standard'} ? $tmpl->{'name'} : &ui_textbox("name", $tmpl->{'name'}, 40)); # Who this template is suitable for local @fors = ( ); foreach my $f ("parent", "sub", "alias", "users") { if ($tmpl->{'standard'} && $f ne "users") { if ($tmpl->{"for_".$f}) { push(@fors, $text{'tmpl_for_'.$f}); } } else { push(@fors, &ui_checkbox("for_$f", 1, &hlink($text{'tmpl_for_'.$f}, "template_for_$f"), $tmpl->{"for_".$f})); } } print &ui_table_row(&hlink($text{'tmpl_for'}, "template_for"), join("   ", @fors)); # Which resellers can use this template? local @resels = $virtualmin_pro ? &list_resellers() : ( ); if (@resels) { print &ui_table_row( &hlink($text{'tmpl_resellers'}, "template_resellers"), &ui_radio("resellers_def", $tmpl->{'resellers'} eq "*" ? 1 : $tmpl->{'resellers'} ? 0 : 2, [ [ 1, $text{'tmpl_resellers_all'} ], [ 2, $text{'tmpl_resellers_none'} ], [ 0, $text{'tmpl_resellers_sel'} ] ])."
\n". &ui_select("resellers", [ split(/\s+/, $tmpl->{'resellers'}) ], [ map { [ $_->{'name'}, $_->{'name'}. ($_->{'acl'}->{'desc'} ? " ($_->{'acl'}->{'desc'})" : "") ] } @resels ], 5, 1)); } # Which system owners can use this template local @owners = &unique(map { $_->{'user'} } &list_domains()); print &ui_table_row( &hlink($text{'tmpl_owners'}, "template_owners"), &ui_radio("owners_def", $tmpl->{'owners'} eq "*" ? 1 : $tmpl->{'owners'} eq "" ? 2 : 0, [ [ 1, $text{'tmpl_owners_all'} ], [ 2, $text{'tmpl_owners_none'} ], [ 0, $text{'tmpl_owners_sel'} ] ])."
\n". &ui_select("owners", [ split(/\s+/, $tmpl->{'owners'}) ], \@owners, 5, 1)); } # parse_template_basic(&tmpl) sub parse_template_basic { local ($tmpl) = @_; if (!$tmpl->{'standard'}) { $in{'name'} || &error($text{'tmpl_ename'}); if ($tmpl->{'name'} ne $in{'name'}) { $in{'name'} =~ /<|>|\&|"|'/ && &error($text{'tmpl_ename2'}); $tmpl->{'name'} = $in{'name'}; } } # Save for-use-by list foreach my $f ($tmpl->{'standard'} ? ( "users" ) : ( "parent", "sub", "alias", "users" )) { $tmpl->{"for_".$f} = $in{"for_".$f}; } local @resels = $virtualmin_pro ? &list_resellers() : ( ); if (@resels) { # Save list of allowed resellers if ($in{'resellers_def'} == 1) { $tmpl->{'resellers'} = '*'; } elsif ($in{'resellers_def'} == 2) { $tmpl->{'resellers'} = ''; } else { $tmpl->{'resellers'} = join(" ", split(/\0/, $in{'resellers'})); $tmpl->{'resellers'} || &error($text{'tmpl_eresellers'}); } } # Save system owners if ($in{'owners_def'} == 1) { $tmpl->{'owners'} = '*'; } elsif ($in{'owners_def'} == 2) { $tmpl->{'owners'} = ''; } else { $tmpl->{'owners'} = join(" ", split(/\0/, $in{'owners'})); $tmpl->{'owners'} || &error($text{'tmpl_eowners'}); } } # show_template_plugins(&tmpl) # Outputs HTML for editing emplate options from plugins sub show_template_plugins { # Show plugin-specific template options my $plugtmpl = ""; foreach my $f (@plugins) { if (&plugin_defined($f, "template_input")) { $plugtmpl .= &plugin_call($f, "template_input", $tmpl); } } if ($plugtmpl) { print $plugtmpl; } else { print &ui_table_row(undef, "$text{'tmpl_noplugins'}"); } } # parse_template_plugins(&tmpl) # Parse plugin options sub parse_template_plugins { local ($tmpl) = @_; foreach my $f (@plugins) { if (&plugin_defined($f, "template_parse")) { &plugin_call($f, "template_parse", $tmpl, \%in); } } } # list_domain_owner_modules() # Returns a list of modules that can be granted to domain owners, as array refs # with module name, description and list of options (optional) entries. sub list_domain_owner_modules { &require_mysql(); my $mytype = $mysql::mysql_version =~ /mariadb/i ? "MariaDB" : "MySQL"; local @rv = ( [ 'dns', 'BIND DNS Server (for DNS domain)' ], [ 'mail', 'Virtual Email (for mailboxes and aliases)' ], [ 'web', 'Apache Webserver (for virtual host)' ], [ 'webalizer', 'Webalizer Logfile Analysis (for website\'s logs)' ], [ 'mysql', $mytype.' Database Server (for database)' ], [ 'postgres', 'PostgreSQL Database Server (for database)' ], [ 'spam', 'SpamAssassin Mail Filter (for domain\'s config file)' ], [ 'filemin', 'File Manager (home directory only)' ], [ 'passwd', 'Change Password', [ [ 2, 'User and mailbox passwords' ], [ 1, 'User password' ], [ 0, 'No' ] ] ], [ 'proc', 'Running Processes (user\'s processes only)', [ [ 2, 'See own processes' ], [ 1, 'See all processes' ], [ 0, 'No' ] ] ], [ 'cron', 'Scheduled Cron Jobs (user\'s Cron jobs)' ], [ 'at', 'Scheduled Commands (user\'s commands)' ], [ 'telnet', 'SSH Login' ], [ 'xterm', 'Terminal' ], [ 'updown', 'Upload and Download (as user)', [ [ 1, 'Yes' ], [ 0, 'No' ], [ 2, 'Upload only' ] ] ], [ 'change-user', 'Change Language and Theme' ], [ 'htaccess-htpasswd', 'Protected Web Directories (under home directory)' ], [ 'mailboxes', 'Read User Mail (users\' mailboxes)' ], [ 'custom', 'Custom Commands' ], [ 'shell', 'Command Shell (run commands as admin)' ], [ 'webminlog', 'Webmin Actions Log (view own actions)' ], [ 'logviewer', 'System Logs (view Apache and FTP logs)' ], [ 'phpini', 'PHP Configuration (for domain\'s php.ini files)' ], ); &load_plugin_libraries(); foreach my $p (@plugins) { if (&plugin_defined($p, "feature_modules")) { push(@rv, &plugin_call($p, "feature_modules")); } } return @rv; } # show_template_avail(&tmpl) # Output HTML for selecting modules available to domain owners sub show_template_avail { local ($tmpl) = @_; local $field; if (!$tmpl->{'default'}) { local @inames = map { "avail_".$_->[0] } &list_domain_owner_modules(); local $dis1 = &js_disable_inputs(\@inames, [ ], 'onClick'); local $dis2 = &js_disable_inputs([ ], \@inames, 'onClick'); $field .= &ui_radio("avail_def", $tmpl->{'avail'} ? 0 : 1, [ [ 1, $text{'tmpl_avail1'}, $dis1 ], [ 0, $text{'tmpl_avail0'}, $dis2 ] ])."
\n"; } $field .= &ui_columns_start( [ $text{'tmpl_availmod'}, $text{'tmpl_availyes'} ]); my $alist; if ($tmpl->{'default'} || $tmpl->{'avail'}) { $alist = $tmpl->{'avail'}; } else { # Initial selection comes from default template my $deftmpl = &get_template(0); $alist = $deftmpl->{'avail'}; } my %avail = map { split(/=/, $_, 2) } split(/\s+/, $alist); # If not set yet, assumed enabled for plugins foreach my $p (@plugins) { if ($avail{$p} eq '') { $avail{$p} = 1; } } foreach my $m (&list_domain_owner_modules()) { my $minp; if ($m->[2]) { $minp = &ui_radio("avail_".$m->[0], int($avail{$m->[0]}), $m->[2]); } else { $minp = &ui_yesno_radio("avail_".$m->[0], int($avail{$m->[0]})); } my @h = ( $m->[1], "config_avail_".$m->[0] ); $field .= &ui_columns_row([ -r &help_file($module_name, $h[1]) ? &hlink(@h) : $m->[1], $minp ]); } $field .= &ui_columns_end(); print &ui_table_row(undef, $field, 2); } # parse_template_avail(&tmpl) # Update the list of modules available to domain owners sub parse_template_avail { local ($tmpl) = @_; if ($in{'avail_def'}) { $tmpl->{'avail'} = undef; } else { local @avail; foreach my $m (&list_domain_owner_modules()) { push(@avail, $m->[0].'='.$in{'avail_'.$m->[0]}); } $tmpl->{'avail'} = join(' ', @avail); } } # show_template_virtualmin(&tmpl) # Outputs HTML for editing core Virtualmin template options sub show_template_virtualmin { local ($tmpl) = @_; # Automatic alias domain local @afields = ( "domalias", "domalias_type", "domalias_tmpl" ); print &ui_table_row(&hlink($text{'tmpl_domalias'}, "template_domalias"), &none_def_input("domalias", $tmpl->{'domalias'}, $text{'tmpl_aliasset'}, undef, undef, $text{'no'}, \@afields)."\n". &ui_textbox("domalias", $tmpl->{'domalias'} eq "none" ? undef : $tmpl->{'domalias'}, 30)); # Suffix for alias domain my $mode = $tmpl->{'domalias_type'} eq '0' ? 0 : $tmpl->{'domalias_type'} eq '' ? 0 : $tmpl->{'domalias_type'} eq '1' ? 1 : 2; print &ui_table_row(&hlink($text{'tmpl_domalias_type'}, "template_domalias_type"), &ui_radio("domalias_type", $mode, [ [ 0, $text{'tmpl_domalias_type0'} ], [ 1, $text{'tmpl_domalias_type1'} ], [ 2, $text{'tmpl_domalias_type2'}." ". &ui_textbox("domalias_tmpl", $mode == 2 ? $tmpl->{'domalias_type'} : "", 20) ] ])); } # parse_template_virtualmin(&tmpl) # Updates core Virtualmin template options from %in sub parse_template_virtualmin { local ($tmpl) = @_; # Parse automatic alias domain mode $tmpl->{'domalias'} = &parse_none_def("domalias"); if ($in{'domalias_mode'} == 2) { $in{'domalias'} =~ /^[a-z0-9\.\-\_]+$/i || &error($text{'tmpl_edomalias'}); if ($in{'domalias_type'} == 2) { $in{'domalias_tmpl'} =~ /^\S+$/ || &error($text{'tmpl_edomaliastmpl'}); $tmpl->{'domalias_type'} = $in{'domalias_tmpl'}; } else { $tmpl->{'domalias_type'} = $in{'domalias_type'}; } } } # show_template_autoconfig(&tmpl) # Outputs HTML for mail client autoconfig XML sub show_template_autoconfig { local ($tmpl) = @_; # XML for Thunderbird local $xml; if ($tmpl->{'autoconfig'} eq "" || $tmpl->{'autoconfig'} eq "none") { $xml = &get_thunderbird_autoconfig_xml(); } else { $xml = join("\n", split(/\t/, $tmpl->{'autoconfig'})); } print &ui_table_row( &hlink($text{'tmpl_autoconfig'}, "template_autoconfig"), &none_def_input("autoconfig", $tmpl->{'autoconfig'}, $text{'tmpl_autoconfigset'}, 0, 0, $text{'tmpl_autoconfignone'})."
\n". &ui_textarea("autoconfig", $xml, 20, 80)); # XML for Outlook if ($tmpl->{'outlook_autoconfig'} eq "" || $tmpl->{'outlook_autoconfig'} eq "none") { $xml = &get_outlook_autoconfig_xml(); } else { $xml = join("\n", split(/\t/, $tmpl->{'outlook_autoconfig'})); } print &ui_table_row( &hlink($text{'tmpl_outlook_autoconfig'}, "template_outlook_autoconfig"), &none_def_input("outlook_autoconfig", $tmpl->{'outlook_autoconfig'}, $text{'tmpl_autoconfigset'}, 0, 0, $text{'tmpl_autoconfignone'})."
\n". &ui_textarea("outlook_autoconfig", $xml, 20, 80)); } # parse_template_autoconfig(&tmpl) # Updates core mail client autoconfig template options from %in sub parse_template_autoconfig { local ($tmpl) = @_; # Parse Thunderbird automatic alias domain mode $tmpl->{'autoconfig'} = &parse_none_def("autoconfig"); if ($in{'autoconfig_mode'} == 2) { $in{'autoconfig'} =~ //i || &error($text{'tmpl_eautoconfig'}); } # Parse Outlook automatic alias domain mode $tmpl->{'outlook_autoconfig'} = &parse_none_def("outlook_autoconfig"); if ($in{'outlook_autoconfig_mode'} == 2) { $in{'outlook_autoconfig'} =~ //i || &error($text{'tmpl_outlook_eautoconfig'}); } } # postsave_template_autoconfig(&tmpl) # If mail autoconfig is active, update the template for all domains sub postsave_template_autoconfig { local ($tmpl) = @_; if ($config{'mail_autoconfig'}) { local @doms = grep { $_->{'mail'} && &domain_has_website($_) && !$_->{'alias'} } &list_domains(); foreach my $d (@doms) { &enable_email_autoconfig($d); } } } # list_template_editmodes([&template]) # Returns a list of available template sections for editing sub list_template_editmodes { local ($tmpl) = @_; local @rv = grep { $sfunc = "show_template_".$_; defined(&$sfunc) && ($config{$_} || !$isfeature{$_} || $_ eq 'mail' || $_ eq 'web' || $_ eq 'ssl') } @template_features; if ($tmpl && ($tmpl->{'id'} == 1 || !$tmpl->{'for_parent'})) { # For sub-servers only @rv = grep { $_ ne 'resources' && $_ ne 'unix' && $_ ne 'webmin' && $_ ne 'avail' } @rv; } return @rv; } # substitute_domain_template(string, &domain, [&extra-hash], [html-escape]) # Does $VAR substitution in a string for a given domain, pulling in # PARENT_DOMAIN variables too sub substitute_domain_template { local ($str, $d, $extra, $escape) = @_; local %hash = &make_domain_substitions($d, 0); if ($extra) { %hash = ( %hash, %$extra ); } return &substitute_virtualmin_template($str, \%hash, $escape); } # substitute_virtualmin_template(string, &hash, [html-escape]) # Just calls the standard substitute_template function, but with global # variables added to the hash sub substitute_virtualmin_template { local ($str, $hash, $escape) = @_; local %ghash = %$hash; foreach my $v (&get_global_template_variables()) { if ($v->{'enabled'} && !defined($ghash{$v->{'name'}})) { $ghash{$v->{'name'}} = $v->{'value'}; } } if ($escape) { # Escape XML / HTML special chars, for example when including in # mail client autoconfig template foreach my $v (keys %ghash) { $ghash{$v} = &html_escape($ghash{$v}); } } $ghash{'MYSQL_TYPE'} = "MySQL"; if ($config{'mysql'}) { &require_mysql(); $ghash{'MYSQL_TYPE'} = "MariaDB" if ($mysql::mysql_version =~ /mariadb/i); } return &substitute_template($str, \%ghash); } # populate_default_index_page(&dom, hash) # Populates defaults for index.html for the given domain sub populate_default_index_page { my ($d, %h) = @_; my $lpref = 'deftmplt_'; my ($wmport, $wmproto, $wmhost) = &get_miniserv_port_proto(); # Domain defaults my $ddom = $d->{'dom'}; my $dndis = $d->{'disabled_time'} ? 0 : 1; my $ddomdef = $d->{'defaultdomain'}; my $diswhy = $d->{'disabled_why'} || $text{"${lpref}tmpltpagedommsglogindescnoreason0"}; $diswhy = "$diswhy." if ($diswhy && $diswhy !~ /[.!?]$/); my $ddompubhtml = $d->{'public_html_dir'} || 'public_html'; my $deftitle = ($ddomdef ? $text{"${lpref}tmpltpagedefhost"} : $text{"${lpref}tmpltpagedefdom"}); # Template defaults variables my $lang = uc('tmpltpagelang'); my $title = uc('tmpltpagetitle'); my $container_type = uc('tmpltpagecontainertype'); my $headtitle = uc('tmpltpageheadtitle'); my $dom = uc('tmpltpagedomname'); my $statushead = uc('tmpltpagedommsg'); my $status = uc('tmpltpagedomstatus'); my $statustext = uc('tmpltpagedommsglogin'); my $statusico = uc('tmpltpagedommsgloginico'); my $dommsglogindesc = uc("tmpltpagedommsglogindesc"); my $dommsgloginlink = uc('tmpltpagedommsgloginlink'); my $pagefooteryear = uc('tmpltpagefooteryear'); # Domain template defaults substitutions $h{$lang} = $current_lang if (!defined($h{$lang})); $h{$title} = "$ddom \— " . $deftitle if (!defined($h{$title})); $h{$container_type} = $ddomdef ? 'no-max' : undef; $h{$headtitle} = $deftitle if (!defined($h{$headtitle})); $h{$dom} = $ddom if (!defined($h{$dom})); $h{$statushead} = $text{$lpref . lc("$statushead$dndis")} if (!defined($h{$statushead})); $h{$status} = $text{"${lpref}tmpltpagedomstatus$dndis"} if (!defined($h{$status})); $h{$statustext} = $text{$lpref . lc("$statustext$dndis")} if (!defined($h{$statustext})); $h{$statusico} = "⊗" if (!defined($h{$statusico}) && !$dndis); $h{$dommsglogindesc} = &text($lpref . lc("$dommsglogindesc$dndis"), $dndis ? $ddompubhtml : $diswhy) if (!defined($h{$dommsglogindesc})); $h{$dommsgloginlink} = "$wmproto://$wmhost:$wmport" if (!defined($h{$dommsgloginlink})); $h{$pagefooteryear} = strftime('%Y',localtime) if (!defined($h{$pagefooteryear})); # Standard template defaults substitutions my (@deftmpls) = grep { $_ =~ s/^(\Q$lpref\E)// } keys %text; foreach my $deftmpl (@deftmpls) { my $key = &trim(uc($deftmpl)); my $value = $text{"$lpref$deftmpl"}; $h{$key} = $value if (!defined($h{$key}) && $key !~ /\d$/); } return %h; } # replace_default_index_page(&dom, content) # Replaces defaults for index.html for the given template in domain sub replace_default_index_page { my ($d, $content) = @_; my $ddis = $d->{'disabled_time'}; my $type = ($d->{'defaultdomain'} && !$ddis) ? 'domain' : 'host'; $content =~ s///gs; if ($ddis) { $content =~ s///s, $content =~ s///s, $content =~ s/(data-(login|domain)=["'].*?["'].*?)(success)/$1warning/gm; } $content =~ s/(data-login=["']row["'].*)(col-l.*)(".*)/$1col-lg-8 col-xl-7$3/gm; $content =~ s/x-(main|div)/$1/g; return $content; } # absolute_domain_path(&domain, path) # Converts some path to be relative to a domain, like foo.txt or bar/foo.txt or # ~/bar/foo.txt. Absolute paths are not converted. sub absolute_domain_path { local ($d, $path) = @_; $d->{'home'} || &error("absolute_domain_path called for $path without a home directory!"); if ($path =~ /^\//) { # Already absolute return $path; } elsif ($path =~ /^~\/(.*)/) { # Relative to home return $d->{'home'}.'/'.$1; } else { # Also relative to home return $d->{'home'}.'/'.$path; } } # get_init_template(for-subdom) # Returns the ID of the initially selected template sub get_init_template { local $rv = $_[0] ? $config{'initsub_template'} : $config{'init_template'}; if ($rv > 1 && !-r "$templates_dir/$rv") { # Template doesn't exist! Return sensible default return $_[0] ? 1 : 0; } return $rv; } # set_chained_features(&domain, [&old-domain]) # Updates a domain object, setting any features that are automatically based # on another. Called from .cgi scripts to activate hidden features (mode 3). sub set_chained_features { local ($d, $oldd) = @_; foreach my $f (@features) { local $cfunc = "chained_$f"; if (defined(&$cfunc)) { local $c = &$cfunc($d, $oldd); if (defined($c) && $c ne "") { $d->{$f} = $c; } } } foreach my $f (@plugins) { if (&plugin_defined($f, "feature_chained")) { my $c = &plugin_call($f, "feature_chained", $d, $oldd); if (defined($c) && $c ne "") { $d->{$f} = $c; } } } } # check_password_restrictions(&user, [webmin-too], [&domain]) # Returns an error if some user's password (from plainpass) is not acceptable sub check_password_restrictions { local ($user, $webmin, $d) = @_; &require_useradmin(); local $err = &useradmin::check_password_restrictions( $user->{'plainpass'}, $user->{'user'}, $user); return $err if ($err); if ($d) { # Check again with short username $err = &useradmin::check_password_restrictions( $user->{'plainpass'}, &remove_userdom($user->{'user'}, $d), $user); return $err if ($err); } if ($webmin) { # Check ACL module too &foreign_require("acl"); $err = &acl::check_password_restrictions( $user->{'user'}, $user->{'plainpass'}); return $err if ($err); } if ($user->{'plainpass'} =~ /\\/) { # MySQL breaks with backslash passwords return $text{'setup_eslashpass'}; } return undef; } # lock_domain_name(name) # Obtain a lock on some domain name, to prevent concurrent creation sub lock_domain_name { local ($name) = @_; if (!-d $domainnames_dir) { &make_dir($domainnames_dir, 0755); } &lock_file("$domainnames_dir/$name"); } # unlock_domain_name(name) # Release a lock on some domain name, used to prevent concurrent creation sub unlock_domain_name { local ($name) = @_; &unlock_file("$domainnames_dir/$name"); } # merge_domain_config(&d, &newhash, [@&deleted]) # Merge domain configs, possibly delete some keys sub merge_domain_config { my ($d, $newhash, $deleted) = @_; # Merge the hashes %$d = (%$d, %$newhash); # Delete specified keys from the merged hash delete @{$d}{@$deleted} if @$deleted; } # show_domain_quota_usage(&domain) # Prints ui_table fields for quota usage in a domain sub show_domain_quota_usage { local ($d) = @_; local ($tcount, $total) = (0, 0); # Get usage for mail users and DBs in the domain local ($homequota, $mailquota, $duser, $dbquota, $dbquota_home) = &get_domain_user_quotas($d); # Get usage for sub-domain mail users local @subs = &get_domain_by("parent", $d->{'id'}); local ($subhomequota, $submailquota, $dummy, $subdbquota) = &get_domain_user_quotas(@subs); # Get group usage for the domain local ($totalhomequota, $totalmailquota) = &get_domain_quota($d); local $bsize = "a_bsize("home"); $totalhomequota -= $dbquota_home/$bsize; # Show home directory file usage, for total, unix user and mail users local $tmsg = &nice_size($totalhomequota*$bsize); if ($d->{'quota'} && $totalhomequota > $d->{'quota'}) { $tmsg = "$tmsg"; } local $umsg = &nice_size($duser->{'uquota'}*$bsize); if ($d->{'uquota'} && $duser->{'uquota'} > $d->{'uquota'}) { $umsg = "$umsg"; } local $mmsg = &nice_size(($homequota+$subhomequota)*$bsize); print &ui_table_row($text{'edit_allquotah'}, &text('edit_quotaby', $tmsg, $umsg, $mmsg), 3); $tcount++; $total += $totalhomequota*$bsize; # Show mail filesystem usage separately if (&has_mail_quotas()) { local $mbsize = "a_bsize("home"); print &ui_table_row($text{'edit_allquotam'}, &text('edit_quotaby', &nice_size($totalmailquota*$mbsize), &nice_size($duser->{'umquota'}*$mbsize), &nice_size(($mailquota+$submailquota)*$mbsize)), 3); $tcount++; $total += $totalmailquota*$mbsize; } # Show DB usage if ($dbquota+$subdbquota) { print &ui_table_row($text{'edit_dbquota'}, &text('edit_quotabysubs', &nice_size($dbquota+$subdbquota), &nice_size($dbquota), &nice_size($subdbquota)), 3); $tcount++; $total += $dbquota+$subdbquota; } # Show overall total, if needed if ($tcount > 1) { print &ui_table_row($text{'edit_totalquota'}, &nice_size($total)); } } # show_domain_bw_usage(&domain) # Print ui_table rows for bandwidth usage in a domain sub show_domain_bw_usage { local ($d) = @_; if (defined($d->{'bw_usage'})) { local $msg = &text('edit_bwusage', strftime("%d/%m/%Y", localtime($d->{'bw_start'}*(24*60*60)))); if ($d->{'bw_limit'} && $d->{'bw_usage'} > $d->{'bw_limit'}) { local $notify = localtime($d->{'bw_notify'}); print &ui_table_row($msg, "". &nice_size($d->{'bw_usage'})."\n". ($d->{'bw_notify'} ? &text('edit_bwnotify', $notify) : ""), 3); } else { print &ui_table_row($msg, &nice_size($d->{'bw_usage'}), 3); } } } # domains_list_links(&domains, field, what) # Returns text for a list of domain with links, or a search sub domains_list_links { local ($doms, $field, $what) = @_; if (@$doms > 5) { return scalar(@$doms)." ". "$text{'edit_sublist'}"; } else { # Show actual domain names my @alinks; foreach my $a (@$doms) { my $prog = &can_config_domain($a) ? "edit_domain.cgi" : "view_domain.cgi"; push(@alinks, "". &show_domain_name($a).""); } local $lr = &ui_links_row(\@alinks); $lr =~ s/
$//; return $lr; } } # show_password_popup(&domain, [&user], [mode]) # Returns HTML for a link that pops up a password display window sub show_password_popup { local ($d, $user, $mode) = @_; local $pass = $mode ? $d->{$mode."_pass"} : $user ? $user->{'plainpass'} : $d->{'pass'}; if (&can_show_pass() && $pass) { local $link = "showpass.cgi?dom=$d->{'id'}&mode=".&urlize($mode); if ($user) { $link .= "&user=".&urlize($user->{'user'}); } if (defined(&popup_window_link)) { return &popup_window_link($link, $text{'edit_showpass'}, 500, 70, "no"); } else { return "($text{'edit_showpass'})"; } } else { return ""; } } # flush_virtualmin_caches() # Clear all in-memory caches of users, quotas, domains, etc.. sub flush_virtualmin_caches { undef(%main::get_domain_cache); undef(@main::list_domains_cache); undef(%bsize_cache); undef(%get_bandwidth_cache); undef(%main::soft_home_quota); undef(%main::hard_home_quota); undef(%main::used_home_quota); undef(%main::used_home_fquota); undef(%main::soft_mail_quota); undef(%main::hard_mail_quota); undef(%main::used_mail_quota); undef(@useradmin::list_users_cache); undef(@useradmin::list_groups_cache); } # list_shared_ips() # Returns a list of extra IP addresses that can be used by virtual servers sub list_shared_ips { return split(/\s+/, $config{'sharedips'}); } # save_shared_ips(ip, ...) # Updates the list of extra IP addresses that can be used by virtual servers sub save_shared_ips { $config{'sharedips'} = join(" ", @_); &save_module_config(); } # list_shared_ip6s() # Returns a list of extra IPv6 addresses that can be used by virtual servers sub list_shared_ip6s { return split(/\s+/, $config{'sharedip6s'}); } # save_shared_ip6s(ip6, ...) # Updates the list of extra IPv6 addresses that can be used by virtual servers sub save_shared_ip6s { $config{'sharedip6s'} = join(" ", @_); &save_module_config(); } # is_shared_ip(ip) # Returns 1 if some IP address is shared among multiple domains (ie. default, # shared or reseller shared) sub is_shared_ip { local ($ip) = @_; return 1 if ($ip eq &get_default_ip()); return 1 if (&indexof($ip, &list_shared_ips()) >= 0); return 1 if ($ip eq &get_default_ip6()); return 1 if (&indexof($ip, &list_shared_ip6s()) >= 0); if (defined(&list_resellers)) { foreach my $r (&list_resellers()) { return 1 if ($r->{'acl'}->{'defip'} && $ip eq $r->{'acl'}->{'defip'}); return 1 if ($r->{'acl'}->{'defip6'} && $ip eq $r->{'acl'}->{'defip6'}); } } return 0; } # activate_shared_ip(address, [netmask]) # Create a new virtual interface using some IP address. Returns undef on success # or an error message on failure. sub activate_shared_ip { local ($ip, $netmask) = @_; &foreign_require("net"); local @boot = &net::active_interfaces(); local ($iface) = grep { $_->{'fullname'} eq $config{'iface'} } @boot; if (!$iface) { return &text('sharedips_missing', $config{'iface'}); } local $vmax = $config{'iface_base'} || int($net::min_virtual_number); foreach my $b (@boot) { $vmax = $b->{'virtual'} if ($b->{'name'} eq $iface->{'name'} && $b->{'virtual'} > $vmax); } $netmask ||= $net::virtual_netmask || $iface->{'netmask'}; local $virt = { 'address' => $ip, 'netmask' => $netmask, 'broadcast' => &net::compute_broadcast($ip, $netmask), 'name' => $iface->{'name'}, 'virtual' => $vmax+1, 'up' => 1, 'desc' => "Virtualmin shared address", }; $virt->{'fullname'} = $virt->{'name'}.":".$virt->{'virtual'}; &net::save_interface($virt); if (&auto_apply_interface()) { &net::apply_network(); } else { &net::activate_interface($virt); } return undef; } # deactivate_shared_ip(address) # Removes the virtual interface using some IP address. Returns undef on success # or an error message on failure. sub deactivate_shared_ip { local ($ip) = @_; &foreign_require("net"); local @boot = &net::boot_interfaces(); local @active = &net::active_interfaces(); local ($b) = grep { $_->{'address'} eq $ip } @boot; $b || return $text{'sharedips_eboot'}; $b->{'virtual'} eq '' && return $text{'sharedips_ebootreal'}; local ($a) = grep { $_->{'address'} eq $ip } @active; $a || return $text{'sharedips_eactives'}; $a->{'virtual'} eq '' && return $text{'sharedips_ebootreal'}; &net::delete_interface($b); &net::deactivate_interface($a); return undef; } # get_available_backup_features([safe-only]) # Returns a list of features for which backups are possible sub get_available_backup_features { local ($safe) = @_; local @rv; foreach my $f ($safe ? @safe_backup_features : @backup_features) { local $bfunc = "backup_$f"; if (defined(&$bfunc) && ($config{$f} || $f eq "unix" || $f eq "virtualmin" || $f eq "mail")) { push(@rv, $f); } } return @rv; } # html_extract_head_body(html) # Given some HTML, extracts the header, body and stuff after the body sub html_extract_head_body { local ($html) = @_; if ($html =~ /^([\000-\377]*]*>)([\000-\377]*)(<\/body[^>]*>[\000-\377]*)/i) { return ($1, $2, $3); } else { return (undef, $html, undef); } } # open_uncompress_file(filehandle, filename) # Open a file, uncompressing if needed sub open_uncompress_file { local ($fh, $f) = @_; if ($f =~ /\|$/) { return open($fh, $f); } elsif ($f =~ /\.gz$/i) { return open($fh, "gunzip -c ".quotemeta($f)." |"); } elsif ($f =~ /\.Z$/i) { return open($fh, "uncompress -c ".quotemeta($f)." |"); } elsif ($f =~ /\.bz2$/i) { return open($fh, &get_bunzip2_command()." -c ".quotemeta($f)." |"); } else { return open($fh, "<".$f); } } # list_available_features([&parentdom], [&aliasdom], [&subdom]) # Returns a list of features available for a virtual server, by the current # Virtualmin user. sub list_available_features { local ($parentdom, $aliasdom, $subdom) = @_; # Start with core features local @core = $aliasdom ? @opt_alias_features : $subdom ? @opt_subdom_features : @opt_features; @core = grep { &can_use_feature($_) } @core; if ($parentdom) { @core = grep { $_ ne 'webmin' && $_ ne 'unix' } @core; } if ($aliasdom) { @core = grep { $aliasdom->{$_} } @core; } local @rv = map { { 'feature' => $_, 'desc' => $text{'feature_'.$_}, 'core' => 1, 'auto' => $config{$_} == 3, 'default' => $config{$_} == 1 || $config{$_} == 3, 'enabled' => $config{$_} || !defined($config{$_}) } } @core; # Add plugin features local @plug = grep { &plugin_call($_, "feature_suitable", $parentdom, $aliasdom, $subdom) } &list_feature_plugins(); @plug = grep { &can_use_feature($_) } @plug; if ($aliasdom) { @plug = grep { $aliasdom->{$_} } @plug; } local %inactive = map { $_, 1 } @plugins_inactive; push(@rv, map { { 'feature' => $_, 'desc' => &plugin_call($_, "feature_name", 0), 'plugin' => 1, 'auto' => 0, 'default' => !$inactive{$_}, 'enabled' => 1 } } @plug); return @rv; } # list_allowable_features() # Returns a list of feature and plugin codes that resellers and domain owners # can be allowed access to sub list_allowable_features { return ( @opt_features, "virt", "virt6", &list_feature_plugins() ); } # count_domain_users() # Returns a hash ref from domain IDs to user counts sub count_domain_users { local %rv; local (%homemap, %doneuser, %gidmap); foreach my $d (&list_visible_domains()) { $homemap{$d->{'home'}} = $d->{'id'}; $gidmap{$d->{'gid'}} = $d->{'id'} if (!$d->{'parent'}); } foreach my $u (&list_all_users_quotas(1)) { local $h = $u->{'home'}; local $did; if ($homemap{$h}) { # User home is a domain's home .. so this is the domain owner $did = $homemap{$h}; } elsif ($h =~ /^(.*)\/homes\/(\S+)$/) { # User's home is under a domain's homes dir, so he must # belong to it. $did = $homemap{$1}; } elsif ($h =~ /^(.*)\/public_html(\/\S+)?$/) { # Home is in or under public_html, so he is a web user $did = $homemap{$1}; } else { # Fallback to trying each domain's home (longest first) foreach my $hd (sort { length($b) cmp length($a) } keys %homemap) { if ($h =~ /^\Q$hd\E\//) { $did = $homemap{$hd}; last; } } # If THAT still doesn't work, look by GID $did = $gidmap{$u->{'gid'}}; } if ($config{'mail_system'} == 0) { # Don't double-count Postfix @ and - users local $noat = &replace_atsign($u->{'user'}); next if ($doneuser{$noat}++); } if ($did) { $rv{$did}++; } } return \%rv; } # add_user_to_domain_group(&domain, user, [text-message]) # Adds some user (like httpd or ftp) to the Unix group for a domain, if missing sub add_user_to_domain_group { local ($d, $user, $msg) = @_; return 0 if ($d->{'alias'} || !$d->{'group'}); &require_useradmin(); &obtain_lock_unix($d); local @groups = &list_all_groups(); local ($group) = grep { $_->{'group'} eq $d->{'group'} } @groups; local $rv; if ($group) { local @mems = split(/,/, $group->{'members'}); if (&indexof($user, @mems) < 0) { # Need to add him &$first_print(&text($msg, $user)) if ($msg); local $oldgroup = { %$group }; $group->{'members'} = join(",", @mems, $user); &foreign_call($group->{'module'}, "set_group_envs", $group, 'MODIFY_GROUP', $oldgroup); &foreign_call($group->{'module'}, "making_changes"); &foreign_call($group->{'module'}, "modify_group", $oldgroup, $group); &foreign_call($group->{'module'}, "made_changes"); &$second_print($text{'setup_done'}) if ($msg); $rv = 1; } } &release_lock_unix($d); return $rv; } # get_backup_excludes(&domain) # Returns a list of excluded directories sub get_backup_excludes { local ($d) = @_; return split(/\t+/, $d->{'backup_excludes'}); } # save_backup_excludes(&domain, &excludes) # Updates the list of excluded directories sub save_backup_excludes { local ($d, $excludes) = @_; $d->{'backup_excludes'} = join("\t", @$excludes); &save_domain($d); } # get_backup_db_excludes(&domain) # Returns a list of excluded DB or DB.table names sub get_backup_db_excludes { local ($d) = @_; return split(/\t+/, $d->{'backup_db_excludes'}); } # save_backup_db_excludes(&domain, &excludes) # Updates the list of excluded DB or DB.table names sub save_backup_db_excludes { local ($d, $excludes) = @_; $d->{'backup_db_excludes'} = join("\t", @$excludes); &save_domain($d); } # list_plugin_sections(level) # Returns a list of right-frame sections defined by Virtualmin plugins. # Level 0 = master admin, 1 = domain owner, 2 = reseller sub list_plugin_sections { local ($level) = @_; local $want = $level == 0 ? "for_master" : $level == 1 ? "for_owner" : "for_reseller"; local @rv; foreach my $p (@plugins) { if (&plugin_defined($p, "theme_sections")) { foreach my $s (&plugin_call($p, "theme_sections")) { if ($s->{$want}) { $s->{'plugin'} = $p; push(@rv, $s); } } } } return @rv; } # get_provider_link() # Returns HTML for the logo that should be displayed in the theme for the # Virtualmin hosting provider. In an array context, also returns the image # URL and link URL, if set. sub get_provider_link { # Does this user's domain's reseller have a logo? local ($logo, $link, $alt); local $d = &get_domain_by("user", $remote_user, "parent", ""); if (!$d) { # No domain found by user .. but is this user an extra admin? if ($access{'admin'}) { $d = &get_domain($access{'admin'}); } } if ($d && $d->{'reseller'} && defined(&get_reseller)) { # Domain has a reseller .. check for his logo foreach my $r (split(/\s+/, $d->{'reseller'})) { local $resel = &get_reseller($r); if ($resel->{'acl'}->{'logo'}) { $logo = $resel->{'acl'}->{'logo'}; $link = $resel->{'acl'}->{'link'}; $alt = $resel->{'acl'}->{'alt'}; last; } } } if (!$d && &reseller_admin()) { # This user is a reseller .. use his logo local $resel = &get_reseller($remote_user); if ($resel->{'acl'}->{'logo'}) { $logo = $resel->{'acl'}->{'logo'}; $link = $resel->{'acl'}->{'link'}; $alt = $resel->{'acl'}->{'alt'}; } } if (!$logo) { # Call back to global config $logo = $config{'theme_image'} || $gconfig{'virtualmin_theme_image'}; $link = $config{'theme_link'} || $gconfig{'virtualmin_theme_link'}; $alt = $config{'theme_alt'} || $gconfig{'virtualmin_theme_alt'}; } if ($logo && $logo ne "none") { local $html; $html .= "" if ($link); $html .= ""; $html .= "" if ($link); return wantarray ? ( $html, $logo, $link, $alt ) : $html; } else { return wantarray ? ( ) : undef; } } # nice_domains_list(&doms) # Returns a string listing multiple domains sub nice_domains_list { local ($doms) = @_; local @ttdoms = map { "".&show_domain_name($_)."" } @$doms; if (@ttdoms > 10) { @ttdoms = ( @ttdoms[0..9], &text('index_dmore', @ttdoms-10) ); } return join(", ", @ttdoms); } # list_available_shells([&domain], [mail]) # Returns a list of shells assignable to domain owners and/or mailboxes. # Each is a hash ref with shell, desc, owner and mailbox keys. sub list_available_shells { local ($d, $mail) = @_; if (!defined($mail)) { $mail = !$d || $d->{'mail'}; } local @rv; if ($list_available_shells_cache{$mail}) { return @{$list_available_shells_cache{$mail}}; } if (-r $custom_shells_file) { # Read shells data file open(SHELLS, "<".$custom_shells_file); while() { s/\r|\n//g; local %shell = map { split(/=/, $_, 2) } split(/\t+/, $_); push(@rv, \%shell); } close(SHELLS); } if (!@rv) { # Master admin should be able to create SSH users by default my $defloginshell_admin = &master_admin() ? 1 : 0; # Fake up from config file and known shells, if there is no custom # file or if it is somehow empty. push(@rv, { 'shell' => $config{'shell'}, 'desc' => $mail ? $text{'shells_mailbox'} : $text{'shells_mailbox2'}, 'mailbox' => 1, 'default' => !$defloginshell_admin, 'avail' => 1, 'id' => 'nologin' }); push(@rv, { 'shell' => $config{'ftp_shell'}, 'desc' => $mail ? $text{'shells_mailboxftp'} : $text{'shells_mailboxftp2'}, 'mailbox' => 1, 'avail' => 1, 'id' => 'ftp' }); if (&has_command("scponly")) { push(@rv, { 'shell' => &has_command("scponly"), 'desc' => $mail ? $text{'shells_mailboxscp'} : $text{'shells_mailboxscp2'}, 'mailbox' => 1, 'avail' => 1, 'id' => 'scp' }); } local (%done, %classes, $defclass); local $best_unix_shell; foreach my $s (split(/\s+/, $config{'unix_shell'})) { if (&has_command($s)) { $best_unix_shell = &has_command($s); last; } } $best_unix_shell ||= "/bin/sh"; foreach my $us (&get_unix_shells()) { next if (!-r $us->[1]); next if ($done{$us->[1]}++); local %shell = ( 'shell' => $us->[1], 'desc' => $mail ? $text{'shells_'.$us->[0]} : $text{'shells_'.$us->[0].'2'}, 'id' => $us->[0], 'owner' => 1, 'reseller' => 1 ); if ($us->[1] eq $best_unix_shell) { $shell{'default'} = 1; $shell{'avail'} = 1; $shell{'mailbox'} = $defloginshell_admin; $defclass = $us->[0]; } push(@rv, \%shell); $classes{$us->[0]}++; } if (!$defclass) { # Default for owners was not found .. use config local %shell = ( 'shell' => $best_unix_shell, 'desc' => $text{'shells_ssh'}, 'id' => 'ssh', 'owner' => 1, 'reseller' => 1, 'default' => 1, 'avail' => 1 ); push(@rv, \%shell); $classes{'ssh'}++; $defclass = 'ssh'; } # Only the default or first of each class are available for each user foreach my $c (grep { $_ ne $defclass } keys %classes) { foreach my $u ('owner', 'mailbox') { my ($firstclass) = grep { $_->{'id'} eq $c && $_->{$u} } @rv; if ($firstclass) { $firstclass->{'avail'} = 1; } } } } # Sort based on both description and shell # name to avoid random ordering @rv = sort { $a->{'desc'} cmp $b->{'desc'} || $a->{'shell'} cmp $b->{'shell'} } @rv; $list_available_shells_cache{$mail} = \@rv; return @rv; } # list_available_shells_by_id(id, [type], [&domain], [mail]) # Returns a list of shells by given id sub list_available_shells_by_id { my ($id, $type, $d, $mail) = @_; my @rv = &list_available_shells($d, $mail); @rv = grep { $_->{'id'} eq $id && $_->{'avail'} } @rv; @rv = grep { $_->{$type} } @rv if ($type); return @rv; } # list_available_shells_by_type(type, [id], [include-current-shell]) # Returns a list of shells by given type. If current shell is given # it will be added to a list of available shells sub list_available_shells_by_type { my ($type, $id, $current_shell) = @_; my @rv = &available_shells($type, $current_shell); @rv = grep { $_->{'id'} eq $id } @rv if ($id); return @rv; } # save_available_shells(&shells|undef) # Updates the list of custom shells available, or resets to the built-in # defaults if undef is given sub save_available_shells { local ($shells) = @_; if ($shells) { &open_lock_tempfile(SHELLS, ">$custom_shells_file"); foreach my $s (@$shells) { &print_tempfile(SHELLS, join("\t", map { $_."=".$s->{$_} } keys %$s),"\n"); } &close_tempfile(SHELLS); @list_available_shells_cache = @$shells; } else { &unlink_logged($custom_shells_file); undef(@list_available_shells_cache); } } # available_shells('owner'|'mailbox'|'reseller', [value], [must-ftp]) # Returns available shells for a mailbox or domain owner sub available_shells { my ($type, $value, $mustftp) = @_; my @aashells = &list_available_shells(undef, $mustftp ? 0 : undef); my @tshells = grep { $_->{$type} } @aashells; my @ashells = grep { $_->{'avail'} } @tshells; if ($mustftp) { # Only show shells with FTP access or better @ashells = grep { $_->{'id'} ne 'nologin' } @ashells; } if (defined($value)) { # Is current shell on the list? my ($got) = grep { $_->{'shell'} eq $value } @ashells; if (!$got) { ($got) = grep { $_->{'shell'} eq $value } @tshells; if ($got) { # Current exists but is not available .. make it visible push(@ashells, $got); } else { # Add unknown shell description if available my ($value_desc) = grep { $_->{'shell'} eq $value } @aashells; # Totally unknown if ($value) { push(@ashells, { 'id' => $value_desc->{'id'} || 'unknown', 'shell' => $value, 'desc' => $value_desc->{'desc'} || $value }); } else { push(@ashells, { 'shell' => '', 'desc' => $text{'shells_none'} }); } } } } else { my ($def) = grep { $_->{'default'} } @ashells; $value = $def ? $def->{'shell'} : undef; } return @ashells; } # available_shells_menu(name, [value], 'owner'|'mailbox'|'reseller', [show-cmd], # [must-ftp]) # Returns HTML for selecting a shell for a mailbox or domain owner sub available_shells_menu { my ($name, $value, $type, $showcmd, $mustftp) = @_; return &ui_select($name, $value, [ map { [ $_->{'shell'}, $_->{'desc'}.($showcmd ? " ($_->{'shell'})" : "") ] } &available_shells($type, $value, $mustftp) ]); } # default_available_shell('owner'|'mailbox'|'reseller') # Returns the default shell for a mailbox user or domain owner sub default_available_shell { local ($type) = @_; local @ashells = grep { $_->{$type} && $_->{'avail'} } &list_available_shells(); local ($def) = grep { $_->{'default'} } @ashells; return $def ? $def->{'shell'} : undef; } # check_available_shell(shell, type, [old]) # Returns 1 if some shell is on the available list for this type sub check_available_shell { local ($shell, $type, $old) = @_; local @ashells = grep { $_->{$type} && $_->{'avail'} } &list_available_shells(); local ($got) = grep { $_->{'shell'} eq $shell } @ashells; return $got || $old && $shell eq $old; } # get_common_available_shells() # Returns the nologin, FTP and jailed FTP shells for mailbox users, some of # which may be undef. Mainly for legacy use. sub get_common_available_shells { my @ashells = grep { $_->{'mailbox'} && $_->{'avail'} } &list_available_shells(); my ($nologin_shell) = grep { $_->{'id'} eq 'nologin' } @ashells; my ($ftp_shell) = grep { $_->{'id'} eq 'ftp' } @ashells; my ($jailed_shell) = grep { $_->{'id'} eq 'ftp' && $_ ne $ftp_shell } @ashells; my ($def_shell) = grep { $_->{'default'} } @ashells; return ($nologin_shell, $ftp_shell, $jailed_shell, $def_shell); } # create_empty_file(path) # Creates a new root-owned empty file sub create_empty_file { local ($file) = @_; &open_tempfile(EMPTY, ">$file", 0, 1); &close_tempfile(EMPTY); } # is_empty_directory(path) # Returns 1 if a directory contains no files sub is_empty_directory { my ($dir) = @_; opendir(EMPTYDIR, $dir) || return 0; my @files = grep { $_ ne "." && $_ ne ".." } readdir(EMPTYDIR); closedir(EMPTYDIR); return @files ? 0 : 1; } # update_miniserv_preloads(mode) # Changes the Perl libraries preloaded by miniserv, based on the mode flag. # This can be 0 for none, 1 for Virtualmin only, or 2 for Virtualmin and # plugins. sub update_miniserv_preloads { local ($mode) = @_; local $msc = $ENV{'MINISERV_CONFIG'} || "$config_directory/miniserv.conf"; &lock_file($msc); local %miniserv; &get_miniserv_config(\%miniserv); local @preload; local $oldpreload = $miniserv{'preload'}; delete($miniserv{'premodules'}); if ($mode == 0) { # Nothing to load @preload = ( ); } else { # Do core library and features local $vslf = "virtual-server/virtual-server-lib-funcs.pl"; push(@preload, "virtual-server=$vslf"); foreach my $f (@features, "virt", "virt6") { local $file = "virtual-server/feature-$f.pl"; push(@preload, "virtual-server=$file"); } # Do new perl module version of Webmin API $miniserv{'premodules'} = "WebminCore"; } $miniserv{'preload'} = join(" ", &unique(@preload)); &put_miniserv_config(\%miniserv); &unlock_file($msc); return $oldpreload ne $miniserv{'preload'}; } # nice_hour_mins_secs(unixtime, [no-pad], [show-seconds]) # Convert a number of seconds into an HH hours, MM minutes, SS seconds format sub nice_hour_mins_secs { local ($time, $nopad, $showsecs) = @_; local $days = int($time / (24*60*60)); local $hours = int($time / (60*60)) % 24; local $mins = sprintf($nopad ? "%d" : "%2.2d", int($time / 60) % 60); local $secs = sprintf($nopad ? "%d" : "%2.2d", int($time) % 60); if ($days) { return &text('nicetime_days', $days, $hours, $mins, $secs); } elsif ($hours) { return &text('nicetime_hours', $hours, $mins, $secs); } elsif ($mins || !$showsecs) { return &text('nicetime_mins', $mins, $secs); } else { return &text('nicetime_secs', $secs); } } # short_nice_hour_mins_secs(unixtime) # Convert a number of seconds into an HH:MM:SS format sub short_nice_hour_mins_secs { local ($time) = @_; local $days = int($time / (24*60*60)); local $hours = int($time / (60*60)) % 24; local $mins = sprintf("%2.2d", int($time / 60) % 60); local $secs = sprintf("%2.2d", int($time) % 60); return $days ? $days." days, ".$hours.":".$mins.":".$secs : $hours ? $hours.":".$mins.":".$secs : $mins.":".$secs; } # show_check_migration_features(feature, ...) # Shows a message about features found in a migration, plus any that are # not supported. Returns only those that are supported. sub show_check_migration_features { local @got = @_; local %pconfig = map { $_, 1 } &list_feature_plugins(); local @notgot = grep { !$config{$_} && !$pconfig{$_} } @got; @got = grep { $config{$_} || $pconfig{$_} } @got; local @gotmsg = map { &feature_name($_) } @got; local @notgotmsg = map { &feature_name($_) } @notgot; &$second_print(".. found ",join(", ", @gotmsg),"."); if (@notgot) { &$second_print("However, the follow features are not supported or enabled on your system : ",join(", ", @notgotmsg).". Some functions of the migrated virtual server may not work."); } return @got; } # obtain_lock_everything(&domain) # Obtain locks on everything lockable that this domain has enabled sub obtain_lock_everything { local ($d) = @_; foreach my $f (@features) { local $lfunc = "obtain_lock_".$f; if (defined(&$lfunc) && $d->{$d}) { &$lfunc($d); } } } # release_lock_everything(&domain) # Reverses obtain_lock_everything sub release_lock_everything { local ($d) = @_; foreach my $f (@features) { local $lfunc = "release_lock_".$f; if (defined(&$lfunc) && $d->{$d}) { &$lfunc($d); } } } # obtain_lock_anything(&domain) # Called by the various obtain_lock_* functions sub obtain_lock_anything { local ($d) = @_; &lock_domain($d) if ($d && $d->{'id'}); # Assume that we are about to do something important, and so don't want to be # killed by a SIGPIPE triggered by a browser cancel. $SIG{'PIPE'} = 'ignore'; $SIG{'TERM'} = 'ignore'; } # release_lock_anything(&domain) # Called by the various release_lock_* functions sub release_lock_anything { local ($d) = @_; &unlock_domain($d) if ($d && $d->{'id'}); } # virtualmin_api_log(&argv, [&domain], [&suppress-flags]) # Log an action taken by a Virtualmin command-line API call sub virtualmin_api_log { local ($argv, $d, $hide) = @_; # Parse into flags hash local (%flags, $lastflag); local @argv = @$argv; while(@argv) { local $a = shift(@argv); if ($a =~ /^\-+(\S+)$/) { # A new flag $lastflag = $1; $flags{$lastflag} = ""; } elsif ($lastflag) { # A flag value if ($flags{$lastflag} ne "") { $flags{$lastflag} .= " "; } $flags{$lastflag} .= $a; } if ($a =~ /^[^"' ]+$/) { push(@qargv, $a); } elsif ($a !~ /"/) { push(@qargv, "\"$a\""); } elsif ($a !~ /'/) { push(@qargv, "'$a'"); } else { push(@qargv, quotemeta($a)); } } if ($hide) { # Hide sensitive fields, like the password foreach my $h (@$hide) { if ($flags{$h}) { $flags{$h} = ("X" x length($flags{$h})); } my $idx = &indexoflc("--".$h, @qargv); if ($idx >= 0) { $qargv[$idx+1] = $flags{$h}; } } } $flags{'argv'} = &urlize(join(" ", @qargv)); # Log it local $script = $0; $script =~ s/^.*\///; local $remote_user = "root"; local $WebminCore::remote_user = "root"; local $rh = $ENV{'REMOTE_HOST'}; local $ENV{'REMOTE_HOST'} = $rh || "127.0.0.1"; &webmin_log($main::virtualmin_remote_api || $ENV{'VIRTUALMIN_REMOTE_API'} ? "remote" : "cmd", $script, $d ? $d->{'dom'} : undef, \%flags); } # get_global_template_variables() # Returns an array of hash refs containing global variable names and values sub get_global_template_variables { if (!scalar(@global_template_variables_cache)) { local @rv = ( ); &open_readfile(GLOBAL, $global_template_variables_file); while() { s/\r|\n//g; local $dis; $dis = 1 if (s/^\#+\s*//); local ($n, $v) = split(/\s+/, $_, 2); push(@rv, { 'name' => $n, 'value' => $v, 'enabled' => !$dis }); } close(GLOBAL); @global_template_variables_cache = @rv; } return @global_template_variables_cache; } # save_global_template_variables(&variables) # Write out the array ref of hash refs of global variables to a file sub save_global_template_variables { local ($vars) = @_; &open_tempfile(GLOBAL, ">$global_template_variables_file"); foreach my $v (@$vars) { &print_tempfile(GLOBAL, ($v->{'enabled'} ? "" : "#"). $v->{'name'}." ".$v->{'value'}."\n"); } &close_tempfile(GLOBAL); @global_template_variables_cache = @$vars; } # home_relative_path(&domain, path) # Returns a path relative to a domain's home, if possible sub home_relative_path { local ($d, $file) = @_; local $l = length($d->{'home'}); if (substr($file, 0, $l+1) eq $d->{'home'}."/") { return substr($file, $l+1); } return $file; } # update_alias_domain_ips(&domain, &old-domain) # Called when a domain's IP is changed by adding or removing a virtual IP, to # update the IPs of an alias domains too. May print stuff. sub update_alias_domain_ips { local ($d, $oldd) = @_; local @aliases = &get_domain_by("alias", $d->{'id'}); return 0 if (!@aliases); foreach my $ad (@aliases) { next if ($ad->{'ip'} ne $oldd->{'ip'} && $ad->{'ip6'} ne $oldd->{'ip6'}); my $oldad = { %$ad }; if ($ad->{'ip'} eq $oldd->{'ip'}) { $ad->{'ip'} = $d->{'ip'}; } if ($oldd->{'ip6'} && $ad->{'ip6'} eq $oldd->{'ip6'}) { $ad->{'ip6'} = $d->{'ip6'}; } &$first_print(&text('save_aliasip', $ad->{'dom'}, $d->{'ip'})); &$indent_print(); foreach my $f (@features) { local $mfunc = "modify_$f"; if ($config{$f} && $ad->{$f}) { &try_function($f, $mfunc, $ad, $oldad); } } foreach my $f (&list_feature_plugins(1)) { if ($ad->{$f}) { &plugin_call($f, "feature_modify", $ad, $oldad); } &plugin_call($f, "feature_always_modify", $ad, $oldad); } &$outdent_print(); &save_domain($ad); &$second_print($text{'setup_done'}); } } # get_dns_ip([reseller-name-list]) # Returns the IP address for use in DNS records, or undef to use the domain's IP sub get_dns_ip { local ($reselname) = @_; if (defined(&get_reseller)) { # Check if the reseller has an external IP foreach my $r (split(/\s+/, $reselname)) { local $resel = &get_reseller($r); if ($resel && $resel->{'acl'}->{'defdnsip'}) { return $resel->{'acl'}->{'defdnsip'}; } } } if ($config{'dns_ip'} eq '*') { local $rv = &get_external_ip_address(); $rv || &error($text{'newdynip_eext'}); return $rv; } elsif ($config{'dns_ip'}) { return $config{'dns_ip'}; } return undef; } # setup_bandwidth_job(enabled, [hour-step]) # Create or delete the bandwidth monitoring cron job sub setup_bandwidth_job { local ($active, $step) = @_; $step ||= 1; &foreign_require("cron"); local $job = &find_bandwidth_job(); if ($job) { &delete_cron_script($job); } if ($active) { my @hours; if ($step == 1) { @hours = ( "*" ); } else { for(my $h=0; $h<24; $h+=$step) { push(@hours, $h); } } $job = { 'user' => 'root', 'command' => $bw_cron_cmd, 'active' => 1, 'mins' => '0', 'hours' => join(',', @hours), 'days' => '*', 'weekdays' => '*', 'months' => '*' }; &setup_cron_script($job); } } # get_virtualmin_url([&domain]) # Returns a URL for accessing Virtualmin. Never has a trailing / sub get_virtualmin_url { local ($d) = @_; $d ||= { 'dom' => &get_system_hostname() }; local $rv; if ($config{'scriptwarn_url'} && !$main::calling_get_virtualmin_url) { # From module config $main::calling_get_virtualmin_url = 1; $rv = &substitute_domain_template($config{'scriptwarn_url'}, $d); $rv =~ s/\/$//; $main::calling_get_virtualmin_url = 0; return $rv; } else { # Use new standard function return &get_webmin_email_url(undef, undef, 0, $d->{'dom'}); } } # get_domain_url(&domain, [ssl-if-enabled]) # Returns the URL for a domain (with no trailing /) sub get_domain_url { my ($d, $ssl) = @_; my $linkd; if ($d->{'linkdom'}) { $linkd = &get_domain($d->{'linkdom'}); } $linkd ||= $d; my $ptn = $linkd->{'web_urlport'} || $linkd->{'web_port'}; my $pt = $ptn == 80 || !$ptn ? "" : ":".$ptn; return ($ssl && &domain_has_ssl($d) ? "https" : "http"). "://".$linkd->{'dom'}.$pt; } # get_quotas_message() # Returns the template for email to users who are over quota sub get_quotas_message { local $msg = &read_file_contents($user_quota_msg_file); if (!$msg) { $msg = "You have reached or are approaching your disk quota limit:\n". "\n". "Username: \${USER}\n". "Domain: \${DOM}\n". "Email: \${EMAIL}\n". "Disk quota: \${QUOTA_LIMIT}\n". "Disk usage: \${QUOTA_USED}\n". "Status: \${IF-QUOTA_PERCENT}Reached \${QUOTA_PERCENT}%\${ELSE-QUOTA_PERCENT}Over quota\${ENDIF-QUOTA_PERCENT}\n". "\n". "Sent by Virtualmin at: \${VIRTUALMIN_URL}\n"; } return $msg; } # save_quotas_message(message) # Updates the template for over-quota email message sub save_quotas_message { local ($msg) = @_; &open_tempfile(QUOTAMSG, ">$user_quota_msg_file"); &print_tempfile(QUOTAMSG, $msg); &close_tempfile(QUOTAMSG); } # get_domain_http_hostname(&domain) # Returns the best hostname for making HTTP requests # to some domain, like www.$DOM or just $DOM sub get_domain_http_hostname { my ($d) = @_; my $host = $d->{'dom'}; foreach my $h ("www.$d->{'dom'}", $d->{'dom'}) { my $ip = &to_ipaddress($h); if ($ip && $ip eq $d->{'ip'}) { $host = $h; last; } } if (defined(&get_http_redirect)) { my $http_redirect = &get_http_redirect( (&domain_has_ssl($d) ? "https" : "http")."://$host"); if ($http_redirect->{'host'} =~ /\Q$host\E/) { $host = $http_redirect->{'host'}; } } return $host; } # date_to_time(date-string, [gmt], [end-of-day]) # Convert a date string like YYYY-MM-DD or -5 to a Unix time sub date_to_time { local ($date, $gmt, $eod) = @_; local $rv; if ($date =~ /^(\d{4})-(\d+)-(\d+)$/) { # Date only if ($gmt) { $rv = timegm(0, 0, 0, $3, $2-1, $1); } else { $rv = timelocal(0, 0, 0, $3, $2-1, $1); } $rv += 24*60*60-1 if ($eod); } elsif ($date =~ /^\-(\d+)$/) { # Some days ago $rv = time()-($1*24*60*60); } elsif ($date =~ /^\+(\d+)$/) { # Some days in the future $rv = time()+($1*24*60*60); } $rv || &usage("Date spec must be like 2007-01-20 or -5 (days ago)"); return $rv; } # time_to_date(unix-time) # Convert a Unix time to a date formatted in YYYY-MM-DD sub time_to_date { local ($secs) = @_; local @tm = localtime($secs); return sprintf "%4.4d-%2.2d-%2.2d", $tm[5]+1900, $tm[4]+1, $tm[3]; } # get_prefix_msg(&domain) # Returns either "prefix" or "suffix", depending on the mailbox name mode # set in the template. sub get_prefix_msg { my ($d) = @_; my $a = $d->{'append_style'}; if (!defined($a)) { my $tmpl = &get_template($d->{'template'}); $a = $tmpl->{'append_style'}; } return $a == 0 || $a == 1 || $a == 4 || $a == 7 ? 'suffix' : 'prefix'; } # compare_versions(ver1, ver2, [&script]) # Returns -1 if ver1 is older than ver2, 1 if newer, 0 if same sub compare_versions { local ($ver1, $ver2, $script) = @_; if ($script && $script->{'numeric_version'}) { # Strict numeric compare return $ver1 <=> $ver2; } if ($script && $script->{'release_version'}) { # Compare release and version separately local ($rel1, $rel2); ($ver1, $rel1) = split(/-/, $ver1, 2); ($ver2, $rel2) = split(/-/, $ver2, 2); return &compare_versions($ver1, $ver2) || &compare_versions($rel1, $rel2); } return &compare_version_numbers($ver1, $ver2); } # clone_virtual_server(&domain, new-domain, [new-user, [new-password]], # [ip], [ip-already]) # Creates a copy of a virtual server, with a new domain name and perhaps # username (if top-level). Prints stuff as it progresses. Returns 0 on failure # or 1 on success. sub clone_virtual_server { local ($oldd, $newdom, $newuser, $newpass, $ip, $virtalready) = @_; # Create the new domain object, with changes &$first_print($text{'clone_object'}); local $d = { %$oldd }; local $parent; local $tmpl = &get_template($d->{'template'}); $d->{'id'} = &domain_id(); $d->{'clone'} = $oldd->{'id'}; $d->{'dom'} = $newdom; $d->{'owner'} = "Clone of ".($d->{'owner'} || $d->{'dom'}); if (!$d->{'parent'}) { # Allocate new UID, GID, prefix, username and group name delete($d->{'uid'}); delete($d->{'gid'}); delete($d->{'ugid'}); $d->{'user'} = $newuser; $d->{'group'} = $newuser; $d->{'ugroup'} = $newuser; delete($d->{'mysql_user'}); # Force re-creation of DB name delete($d->{'postgres_user'}); if ($newpass) { $d->{'pass'} = $newpass; delete($d->{'enc_pass'}); # Any stored encrypted # password is not valid } # Re-compute email address $d->{'emailto'} = $d->{'mail'} ? $d->{'user'}.'@'.$d->{'dom'} : $d->{'user'}.'@'.&get_system_hostname(); } else { $parent = &get_domain($d->{'parent'}); } # Pick a new home directory and prefix $d->{'home'} = &server_home_directory($d, $parent); $d->{'prefix'} = &compute_prefix($d->{'dom'}, $d->{'group'}, $parent, 1); local $pclash = &get_domain_by("prefix", $d->{'prefix'}); if ($pclash) { &$second_print(&text('clone_prefixclash', $d->{'prefix'}, $pclash->{'dom'})); return 0; } $d->{'db'} = &database_name($d); $d->{'no_mysql_db'} = 1; # Don't create DB automatically $d->{'no_tmpl_aliases'} = 1; # Don't create any aliases $d->{'nocreationmail'} = 1; # Don't re-send post-creation email # Fix creator $d->{'created'} = time(); $d->{'creator'} = $remote_user || getpwuid($<); # Fix any paths that refer to old home or ID, like SSL certs foreach my $k (keys %$d) { next if ($k eq "home"); # already fixed $d->{$k} =~ s/\Q$oldd->{'home'}\E\//$d->{'home'}\//g; $d->{$k} =~ s/\Q$oldd->{'id'}\E/$d->{'id'}/g if ($k =~ /^ssl_/); } &$second_print($text{'setup_done'}); # Pick a new IPv4 address if needed if ($d->{'virt'} && $ip) { # IP specific by caller &$first_print(&text('clone_virt2', $ip)); $d->{'ip'} = $ip; $d->{'virtalready'} = $virtalready; delete($d->{'dns_ip'}); &$second_print($text{'setup_done'}); } elsif ($d->{'virt'}) { # Allocating IP &$first_print($text{'clone_virt'}); if ($tmpl->{'ranges'} eq 'none') { &$second_print($text{'clone_virtrange'}); return 0; } local ($ip, $netmask) = &free_ip_address($tmpl); if (!$ip) { &$second_print($text{'clone_virtalloc'}); return 0; } $d->{'ip'} = $ip; $d->{'netmask'} = $netmask; $d->{'virtalready'} = 0; delete($d->{'dns_ip'}); &$second_print(&text('clone_virtdone', $ip)); } # Allocate a new IPv6 address if needed if ($d->{'virt6'}) { &$first_print($text{'clone_virt6'}); if ($tmpl->{'ranges6'} eq 'none') { &$second_print($text{'clone_virt6range'}); return 0; } local ($ip6, $netmask6) = &free_ip6_address($tmpl); if (!$ip6) { &$second_print($text{'clone_virt6alloc'}); return 0; } $d->{'ip6'} = $ip6; $d->{'netmask6'} = $netmask6; $d->{'virt6already'} = 0; &$second_print(&text('clone_virt6done', $ip6)); } # Disable and features that don't support cloning &$first_print($text{'clone_clash'}); foreach my $f (@features) { local $cfunc = "clone_".$f; if ($d->{$f} && !defined(&$cfunc)) { $d->{$f} = 0; } } foreach my $f (@plugins) { if ($d->{$f} && !&plugin_defined($f, "feature_clone")) { $d->{$f} = 0; } } # Check for clashes / depends local $derr = &virtual_server_depends($d); if ($derr) { &$second_print(&text('clone_dependfound', $derr)); return 0; } local $cerr = &virtual_server_clashes($d); if ($cerr) { &$second_print(&text('clone_clashfound', $cerr)); return 0; } &$second_print($text{'setup_done'}); # By default the old chained cert doesn't need to be used by the clone, # because it won't get copied over and the SSL cert is being re-generated # anyway. delete($d->{'ssl_chain'}); # Create it &$first_print($text{'clone_create'}); &$indent_print(); local $err = &create_virtual_server($d, $parent, $parent ? $parent->{'user'} : undef, 1); &$outdent_print(); if ($err) { &$second_print(&text('clone_createfailed', $err)); return 0; } &$second_print($text{'setup_done'}); # Run the before clone command &set_domain_envs($d, "CLONE_DOMAIN", undef, $oldd); local $merr = &making_changes(); &reset_domain_envs($d); return &text('setup_emaking', "$merr") if (defined($merr)); # Copy across features, mail last so that user DB association works my @clonefeatures = @features; if (&indexof("mail", @clonefeatures) >= 0) { @clonefeatures = ( ( grep { $_ ne "mail" } @clonefeatures ), "mail" ); } foreach my $f (@clonefeatures) { if ($d->{$f}) { local $cfunc = "clone_".$f; &try_function($f, $cfunc, $d, $oldd); } } foreach my $f (@plugins) { if ($d->{$f}) { &try_plugin_call($f, "feature_clone", $d, $oldd); } } &save_domain($d); # Copy across script logs, and then fix paths # Fix script installer paths in all domains local $scriptsrc = "$script_log_directory/$oldd->{'id'}"; local $scriptdest = "$script_log_directory/$d->{'id'}"; if (defined(&list_domain_scripts) && -d $scriptsrc) { &$first_print($text{'clone_scripts'}); ©_source_dest($scriptsrc, $scriptdest); local ($olddir, $newdir) = ($oldd->{'home'}, $d->{'home'}); foreach $sinfo (&list_domain_scripts($d)) { my $changed = 0; $changed++ if ($sinfo->{'opts'}->{'dir'} =~ s/^\Q$olddir\E\//$newdir\//); $changed++ if ($sinfo->{'url'} =~ s/\/$oldd->{'dom'}/\/$d->{'dom'}/); &save_domain_script($d, $sinfo) if ($changed); } &$second_print($text{'setup_done'}); } &run_post_actions(); &set_domain_envs($d, "CLONE_DOMAIN", undef, $oldd); local $merr = &made_changes(); &$second_print(&text('setup_emade', "$merr")) if (defined($merr)); &reset_domain_envs($d); return 1; } # record_old_uid(uid, [gid]) # Record usage of some UID and perhaps GID to prevent re-use sub record_old_uid { my ($uid, $gid) = @_; &lock_file($old_uids_file); my %uids; &read_file_cached($old_uids_file, \%uids); $uids{$uid} = 1; &write_file($old_uids_file, \%uids); &unlock_file($old_uids_file); if ($gid) { &lock_file($old_gids_file); my %gids; &read_file_cached($old_gids_file, \%gids); $gids{$gid} = 1; &write_file($old_gids_file, \%gids); &unlock_file($old_gids_file); } } # check_resolvability(name) # Returns 1 and the IP if a name can be resolved, or 0 and an error message sub check_resolvability { my ($name) = @_; local $page = $resolve_check_page."?host=".&urlize($name); local ($out, $error); &http_download($resolve_check_host, $resolve_check_port, $page, \$out, \$error, undef, 0, undef, undef, 60, 0, 1); if ($error) { return (0, $error); } elsif ($out =~ /^ok\s+([0-9\.]+)/) { return (1, $1); } elsif ($out =~ /^(error|param)\s+(.*)/) { return (0, $2); } else { return (0, "Unknown response : $out"); } } # domain_has_website([&domain]) # Returns the feature name if a domain has a website, either via apache or a # plugin. If called without a domain parameter, just return the plugin or # feature that provides a website. sub domain_has_website { my ($d) = @_; return 'web' if ((!$d || $d->{'web'}) && $config{'web'}); foreach my $p (&list_feature_plugins()) { if ((!$d || $d->{$p}) && &plugin_call($p, "feature_provides_web")) { return $p; } } return undef; } # domain_has_ssl([&domain]) # Returns the feature name if a domain has a website with SSL, either via # apache or a plugin. If called without a domain parameter, just return the # plugin or feature that provides an SSL website. sub domain_has_ssl { my ($d) = @_; return 'ssl' if ((!$d || $d->{'ssl'}) && $config{'ssl'}); foreach my $p (&list_feature_plugins()) { if ((!$d || $d->{$p}) && &plugin_call($p, "feature_provides_ssl")) { return $p; } } return undef; } # domain_has_ssl_cert(&domain) # Returns 1 if a domain has an SSL cert file, even if not used sub domain_has_ssl_cert { my ($d) = @_; return $d->{'ssl_cert'} && -r $d->{'ssl_cert'} ? 1 : 0; } # get_website_log(&domain, [error-log]) # Returns the access or error log for a domain's website. May come from a plugin sub get_website_log { local ($d, $errorlog) = @_; local $p = &domain_has_website($d); if ($p eq 'web') { return &get_apache_log($d->{'dom'}, $d->{'web_port'}, $errorlog); } elsif ($p) { return &plugin_call($p, "feature_get_web_log", $d, $errorlog); } return undef; } # get_old_website_log(log, &domain, &old-domain) # Returns the log path that would have been used in the old domain sub get_old_website_log { local ($alog, $d, $oldd) = @_; if ($d->{'home'} ne $oldd->{'home'}) { $alog =~ s/\Q$d->{'home'}\E/$oldd->{'home'}/; } if ($d->{'dom'} ne $oldd->{'dom'} && !&is_under_directory($d->{'home'}, $alog)) { $alog =~ s/\Q$d->{'dom'}\E/$oldd->{'dom'}/; } return $alog; } # restart_website_server(&domain, [args]) # Calls the restart function for the webserver for a domain sub restart_website_server { local ($d, @args) = @_; local $p = &domain_has_website($d); if ($p eq "web") { &restart_apache(@args); } elsif ($p) { &plugin_call($p, "feature_restart_web", @args); } } # save_website_ssl_file(&domain, "cert"|"key"|"ca", file) # Configure the webserver for some domain to use a file as the SSL cert or key sub save_website_ssl_file { my ($d, $type, $file) = @_; if (&domain_has_ssl($d)) { # Update the actual webserver config my $p = &domain_has_website($d); if ($p ne "web") { return &plugin_call($p, "feature_save_web_ssl_file", $d, $type, $file); } &obtain_lock_ssl($d); my ($virt, $vconf, $conf) = &get_apache_virtual($d->{'dom'}, $d->{'web_sslport'}); if (!$virt) { &release_lock_ssl($d); return "No virtual host found for ". "$d->{'dom'}:$d->{'web_sslport'}"; } my $dir = $type eq 'cert' ? "SSLCertificateFile" : $type eq 'key' ? "SSLCertificateKeyFile" : $type eq 'ca' ? "SSLCACertificateFile" : undef; if ($dir eq "SSLCACertificateFile") { # Check for the alternate directive my ($oldfile) = &apache::find_directive( "SSLCertificateChainFile", $vconf); if ($oldfile) { $dir = "SSLCertificateChainFile"; } } if ($dir) { &apache::save_directive($dir, $file ? [ $file ] : [ ], $vconf, $conf); } &release_lock_ssl($d); if ($dir) { &flush_file_lines($virt->{'file'}, undef, 1); ®ister_post_action(\&restart_apache, &ssl_needs_apache_restart()); } return undef; } else { # Just update the domain object my $k = $type eq 'ca' ? 'ssl_chain' : 'ssl_'.$type; $d->{$k} = $file; return undef; } } # get_website_ssl_file(&domain, "cert"|"key"|"ca") # Looks up the SSL cert, key or chained CA file for some domain sub get_website_ssl_file { my ($d, $type) = @_; if (&domain_has_ssl($d)) { # Get from the actual Apache config my $p = &domain_has_website($d); if ($p ne "web") { return &plugin_call($p, "feature_get_web_ssl_file", $d, $type); } my ($virt, $vconf) = &get_apache_virtual($d->{'dom'}, $d->{'web_sslport'}); return undef if (!$virt); my $dir = $type eq 'cert' ? "SSLCertificateFile" : $type eq 'key' ? "SSLCertificateKeyFile" : $type eq 'ca' || $type eq 'chain' ? "SSLCACertificateFile" : undef; return undef if (!$dir); my ($file) = &apache::find_directive($dir, $vconf); if (!$file && $dir eq "SSLCACertificateFile") { # Check for the alternate directive $dir = "SSLCertificateChainFile"; ($file) = &apache::find_directive($dir, $vconf); } return $file; } else { # Use the domain object my $k = $type eq 'ca' ? 'ssl_chain' : 'ssl_'.$type; return $d->{$k}; } } # list_ordered_features(&domain, [include-always-features]) # Returns a list of features or plugins possibly relevant to some domain, # in dependency order for creation. sub list_ordered_features { my ($d, $always) = @_; my @dom_features = &domain_features($d); my $p = &domain_has_website($d); my $s = &domain_has_ssl($d); my @rv; foreach my $f (@dom_features, &list_feature_plugins($always)) { if ($f eq "web" && $p && $p ne "web") { # Replace website feature in ordering with website plugin push(@rv, $p, "web"); } elsif ($f eq "ssl" && $s && $s ne "ssl") { # Replace SSL feature in ordering with SSL plugin push(@rv, $s, "ssl"); } elsif ($f eq $p && $p ne "web" || $f eq $s && $s ne "ssl") { # Skip website or SSL plugin feature, as it was inserted above } else { # Some other feature push(@rv, $f); } } return @rv; } # set_virtualmin_user_envs(&user, &domain) # Set environment variables containing Virtualmin user-specific info sub set_virtualmin_user_envs { local ($user, $d) = @_; if ($d) { $ENV{'USERADMIN_DOM'} = $d->{'dom'}; } $ENV{'USERADMIN_EMAIL'} = $d->{'email'}; if ($u->{'extraemail'}) { $ENV{'USERADMIN_EXTRAEMAIL'} = join(" ", @{$u->{'extraemail'}}); } } # extract_address_parts(string) # Given a string that may contain multiple email addresses with real names, # return a list of just the address parts. Excludes un-qualified addresses sub extract_address_parts { local ($str) = @_; &foreign_require("mailboxes"); return grep { /^[^@ ]+\@[^@ ]+$/ } map { $_->[0] } &mailboxes::split_addresses($str); } # execute_command_via_ssh(host:port, user, pass, command) # Run some command on a remote system, and return either 1 and the output, or # 0 and an error message sub execute_command_via_ssh { my ($host, $user, $pass, $cmd) = @_; my $port; if ($host =~ s/:(\d+)$//) { $port = $1; } my $sshcmd = "ssh".($port ? " -p $port" : "")." ". $config{'ssh_args'}." ". $user."\@".$host." ". $cmd; my $err; my $out = &run_ssh_command($sshcmd, $pass, \$err); if ($err) { return (0, $err); } else { $out =~ s/^\S+\s+password:.*\n//; # Strip password prompt return (1, $out); } } # execute_virtualmin_api_command(host, user, pass, proto, command) # Runs a Virtualmin API command on some system via SSH. Returns # 0 and the output structure on success, 1 and an error message # on remote API failure, or 2 and an error message on SSH failure. sub execute_virtualmin_api_command { my ($host, $user, $pass, $proto, $cmd) = @_; $proto ||= "ssh"; $user ||= "root"; my $out; if ($proto eq "ssh") { # Run the virtualmin command via SSH my $sshok; ($sshok, $out) = &execute_command_via_ssh($host, $user, $pass, "virtualmin ".$cmd); if (!$sshok) { return (2, $out); } } elsif ($proto eq "webmin") { # Run via a Webmin API call my $webmin = &dest_to_webmin("webmin://$user:$pass\@$host:/tmp"); eval { local $main::error_must_die = 1; &remote_foreign_require($webmin, "webmin"); my @out = &remote_foreign_call($webmin, "webmin", "backquote_command", "virtualmin ".$cmd); $out = join("", @out); }; if ($@) { return (2, "Webmin failed : $@"); } } my $args = { }; if ($cmd =~ /--(multiline|name-only|id-only)/) { $args->{$1} = ''; } my $data = &convert_remote_format($out, 0, $cmd, $args, undef); if ($data->{'error'}) { return (1, $data->{'error'}); } else { return (0, $data->{'data'}, $out); } } # validate_transfer_host(&domain, destuser, desthost, destpass, proto, # ignore-clash) # Checks if a transfer to a remote Virtualmin system is possible sub validate_transfer_host { my ($d, $desthost, $destuser, $destpass, $proto, $overwrite) = @_; # Cannot transfer a disabled domain if ($d->{'disabled'}) { return $text{'transfer_edisabled'}; } my ($status, $out) = &execute_virtualmin_api_command( $desthost, $destuser, $destpass, $proto, "list-domains --name-only"); if ($status) { # Couldn't connect or run the command return &text('transfer_econnect', $out); } # Check for domains clash if (!$overwrite) { my @poss = ( $d ); push(@poss, &get_domain_by("parent", $d->{'id'})); push(@poss, &get_domain_by("alias", $d->{'id'})); foreach my $p (@poss) { if (&indexoflc($p->{'dom'}, @$out) >= 0) { return &text('transfer_already', $p->{'dom'}); } } } # Make sure parent and alias target exists on target if ($d->{'parent'}) { my $parent = &get_domain($d->{'parent'}); if (&indexoflc($parent->{'dom'}, @$out) < 0) { return &text('transfer_noparent', &show_domain_name($parent)); } } if ($d->{'alias'}) { my $alias = &get_domain($d->{'alias'}); if (&indexoflc($alias->{'dom'}, @$out) < 0) { return &text('transfer_noalias', &show_domain_name($alias)); } } return undef; } # transfer_virtual_server(&domain, desthost, destpass, protocol, delete-mode, # delete-missing-files, replication-mode, show-output, # reallocate-ip) # Transfers a domain (and sub-servers) to a destination system, possibly while # deleting it from the source. Will print stuff while transferring, and returns # an OK flag. sub transfer_virtual_server { my ($d, $desthost, $destuser, $destpass, $proto, $deletemode, $deletemissing, $replication, $showoutput, $reallocate) = @_; # Get all domains to include $proto ||= "ssh"; $destuser ||= "root"; my @doms = ( $d ); push(@doms, &get_domain_by("parent", $d->{'id'})); push(@doms, &get_domain_by("alias", $d->{'id'})); my @vdoms = grep { $_->{'virt'} } @doms; $reallocate = 0 if (!@vdoms); # Get all feature names my @feats = grep { $config{$_} || $_ eq 'virtualmin' } @backup_features; push(@feats, &list_backup_plugins()); my $homefmt; if ($replication) { my %remotes = map { $_, 1 } &list_remote_domain_features($d); @feats = grep { !$remotes{$_} } @feats; $homefmt = &indexof("dir", @feats) >= 0 ? 1 : 0; } else { $homefmt = 1; } # Attempt to get the preferred temp dir on the remote system my $remotetempdir = "/tmp"; my $desturl; my $webmin; if ($proto eq "ssh") { # Get the temp dir from the webmin config $desturl = "ssh://$destuser:$destpass\@$desthost"; my ($tok, $tout) = &execute_command_via_ssh( $desthost, $destuser, $destpass, "grep tempdir= /etc/webmin/config"); if ($tok && $tout =~ /tempdir=(\/\S+)/) { $remotetempdir = $1; } } elsif ($proto eq "webmin") { # Get the temp dir via Webmin call $desturl = "webmin://$destuser:$destpass\@$desthost"; $webmin = &dest_to_webmin($desturl.':/tmp'); eval { local $main::error_must_die = 1; &remote_foreign_require($webmin, "webmin"); $remotetempdir = &remote_foreign_call( $webmin, "webmin", "tempname_dir"); $remotetempdir =~ s/\/\.webmin$//; }; if ($@) { return (0, "Webmin call failed : $@"); } } else { return (0, "Unknown protocol $proto"); } # Backup all the domains to a temp dir on the remote system my $remotetemp = "$remotetempdir/virtualmin-transfer-$$"; local $config{'compression'} = 0; local $config{'zip_args'} = undef; &$first_print($text{'transfer_backing'}); if (!$showoutput) { $print_output = ""; &push_all_print(); &set_all_capture_print(); } my ($ok, $size, $errdoms) = &backup_domains( $desturl.":".$remotetemp, \@doms, \@feats, 1, 0, { }, $homefmt, [ ], 1, 1, 0); if (!$showoutput) { &pop_all_print(); } if (!$ok) { my @lines = grep { /\S/ } split(/\r?\n/, $print_output); my $ll = pop(@lines); my $sl = pop(@lines); &$second_print($sl); &$second_print($ll); &$second_print($text{'transfer_ebackup'}); return 0; } &$second_print($text{'transfer_backingdone'}); my $cleanup_remotetemp = sub { if ($proto eq "ssh") { &execute_command_via_ssh($desthost, $destuser, $destpass, "rm -rf ".quotemeta($remotetemp)); } elsif ($proto eq "webmin") { &remote_foreign_call( $webmin, "webmin", "unlink_file", $remotetemp); } }; # Verify that the destination directory was actually created and contains # all the expected files &$first_print($text{'transfer_validating'}); my @lsfiles; if ($proto eq "ssh") { # Run the SSH command my ($lsok, $lsout) = &execute_command_via_ssh( $desthost, $destuser, $destpass, "ls ".$remotetemp); if (!$lsok) { &$second_print(&text('transfer_eremotetemp', $remotetemp, $desthost)); return 0; } @lsfiles = split(/\r?\n/, $lsout); } elsif ($proto eq "webmin") { # Glob the directory my $files = &remote_eval($webmin, "webmin", '[ glob("'.quotemeta($remotetemp."/*").'") ]'); @lsfiles = map { /^\Q$remotetemp\E\/(.*)/; $1 } @$files; } my @missing; foreach my $lsd (@doms) { if (&indexof($lsd->{'dom'}.".tar.gz", @lsfiles) < 0) { push(@missing, $lsd); } } if (@missing) { &$cleanup_remotetemp(); if (@missing == @doms) { &$second_print(&text('transfer_empty', $remotetemp)); } else { &$second_print(&text('transfer_missing', $remotetemp, join(" ", map { &show_domain_name($_) } @missing))); } return 0; } &$second_print($text{'transfer_validated'}); # Delete or disable locally, if requested if ($deletemode == 2) { # Delete from this system &$first_print(&text('transfer_deleting', &show_domain_name($d))); if (!$showoutput) { &push_all_print(); &set_all_null_print(); } my $err = &delete_virtual_server($d); if (!$showoutput) { &pop_all_print(); } if ($err) { &$second_print(&text('transfer_edelete', $err)); return 0; } else { &$second_print($text{'setup_done'}); } } elsif ($deletemode == 1) { # Disable on this system &$first_print(&text('transfer_disabling', &show_domain_name($d))); if (!$showoutput) { &push_all_print(); &set_all_null_print(); } foreach my $dd (@doms) { &disable_virtual_server($dd, 'transfer', 'Transferred to '.$desthost); } if (!$showoutput) { &pop_all_print(); } &$second_print($text{'setup_done'}); } # Restore via an API call to the remote system &$first_print($text{'transfer_restoring'}); my ($rok, $rerr, $rout) = &execute_virtualmin_api_command( $desthost, $destuser, $destpass, $proto, "restore-domain --source $remotetemp --all-domains --all-features ". "--skip-warnings --continue-on-error ". ($deletemissing ? "--option dir delete 1 " : ""). ($replication ? "--replication --no-reuid " : ""). ($reallocate ? "--allocate-ip " : "") ); if ($showoutput) { &$first_print("
".$rout."
"); } if ($rok != 0) { if ($deletemode == 2) { &$second_print(&text('transfer_erestoring3', "
".$rerr."
", $remotetemp, $desthost)); } elsif ($deletemode == 1) { &$second_print(&text('transfer_erestoring2', "
".$rerr."
")); } else { &$second_print(&text('transfer_erestoring', "
".$rerr."
")); } if ($deletemode != 2) { &$cleanup_remotetemp(); } return 0; } &$second_print($text{'transfer_restoringdone'}); # Remove temp file from remote system &$cleanup_remotetemp(); return 1; } # get_transfer_hosts() # Returns previous hosts that transfers have been made to. Each is a tuple # of hostname and password sub get_transfer_hosts { my $hfile = "$module_config_directory/transfer-hosts"; my %hosts; &read_file($hfile, \%hosts); return map { [ $_, split(/\s+/, $hosts{$_}) ] } keys %hosts; } # save_transfer_hosts(&host, ...) # Writes out tuples in the same format as returned by get_transfer_hosts sub save_transfer_hosts { my $hfile = "$module_config_directory/transfer-hosts"; my %hosts = map { $_->[0], $_->[1]." ".($_->[2] || "ssh")." ". ($_->[3] || "root") } @_; &write_file($hfile, \%hosts); &set_ownership_permissions(undef, undef, 0600, $hfile); } # list_possible_domain_features(&domain) # Given a domain, returns a list of core features that can possibly be enabled # or disabled for it sub list_possible_domain_features { my ($d) = @_; my @rv; my $aliasdom = $d->{'alias'} ? &get_domain($d->{'alias'}) : undef; my $subdom = $d->{'subdom'} ? &get_domain($d->{'subdom'}) : undef; foreach my $f (&domain_features($d)) { # Cannot enable features not in alias next if ($aliasdom && !$aliasdom->{$f}); # Don't show features that are globally disabled next if (!$config{$f} && defined($config{$f})); push(@rv, $f); } return @rv; } # list_possible_domain_plugins(&domain) # Given a domain, returns a list of plugin features that can possibly be enabled # or disabled for it sub list_possible_domain_plugins { my ($d) = @_; my @rv; my $aliasdom = $d->{'alias'} ? &get_domain($d->{'alias'}) : undef; my $subdom = $d->{'subdom'} ? &get_domain($d->{'subdom'}) : undef; foreach my $f (&list_feature_plugins()) { next if (!&plugin_call($f, "feature_suitable", $parentdom, $aliasdom, $subdom)); push(@rv, $f); } return @rv; } # list_remote_domain_features(&domain) # Returns a list of all features for a domain that are on shared storage sub list_remote_domain_features { my ($d) = @_; my @rv; foreach my $f (grep { $d->{$_} } &domain_features($d)) { my $rfunc = "remote_".$f; if (defined(&$rfunc) && &$rfunc($d)) { push(@rv, $f); } } return @rv; } # transname_owned(user|&domain) # Create a temporary sub-directory owned by some user, and return a filename # inside it sub transname_owned { my ($user) = @_; $user = $user->{'user'} if (ref($user)); my $temp = &transname(); if (!$user || $user eq "root") { return $temp; } &make_dir($temp, 0755); &set_ownership_permissions($user, undef, undef, $temp); my $rv = $temp."/".($$."_".($transname_owned_counter++)); unshift(@main::temporary_files, $rv); return $rv; } # create_virtualmin_api_helper_command() # Create the API helper for virtualmin core and all plugins sub create_virtualmin_api_helper_command { local @plugindirs = map { &module_root_directory($_) } @plugins; return &create_api_helper_command([ "$module_root_directory/pro", @plugindirs ]); } # load_plugin_libraries([plugin, ...]) # Call foreign_require on some or all plugins, just once sub load_plugin_libraries { local @load = @_; @load = @plugins if (!@load); local $loaded = 0; foreach my $pname (@load) { if (!$main::done_load_plugin_libraries{$pname}++) { if (&foreign_check($pname)) { eval { local $main::error_must_die = 1; &foreign_require($pname, "virtual_feature.pl"); }; if (!$@) { $loaded++; } else { my $err = $@; $err = &html_strip($err); $err =~ s/[\n\r]+/ /g; &error_stderr_local($err); } } } } return $loaded; } # needs_xfs_quota_fix() # Checks if quotas are enabled on the /home filesystem in /etc/fstab but # not for real in /etc/mtab. Returns 0 if all is OK, 1 if just a reboot is # needed, 2 if GRUB needs to be configured, or 3 if we don't know how to # fix GRUB. sub needs_xfs_quota_fix { return 0 if ($gconfig{'os_type'} !~ /-linux$/); # Some other OS return 0 if (!$config{'quotas'}); # Quotas not even in use return 0 if ($config{'quota_commands'}); # Using external commands &require_useradmin(); return 0 if (!$home_base); # Don't know base dir return 0 if (&running_in_zone()); # Zones have no quotas my ($home_mtab, $home_fstab) = &mount_point($home_base); return 0 if (!$home_mtab || !$home_fstab); # No mount found? return 0 if ($home_mtab->[2] ne "xfs"); # Other FS type return 0 if ($home_mtab->[0] ne "/"); # /home is not on the / FS return 0 if (!"a::quota_can($home_mtab, # Not enabled in fstab $home_fstab)); my $now = "a::quota_now($home_mtab, $home_fstab); $now -= 4 if ($now >= 4); # Ignore XFS always bit return 0 if ($now); # Already enabled in mtab # At this point, we are definite in a bad state my $grubfile = "/etc/default/grub"; return 3 if (!-r $grubfile); # Check if grub default config was edited after reboot if (&foreign_check("webmin")) { &foreign_require("webmin"); my $uptime = webmin::get_system_uptime(); my $lastreboot = $uptime ? time() - $uptime : undef; if ($lastreboot) { my @grubfile_stat = stat($grubfile); return 0 if ($lastreboot > $grubfile_stat[9]); } } my %grub; &read_env_file($grubfile, \%grub); return 3 if (!$grub{'GRUB_CMDLINE_LINUX'}); # Enabled already, so just need to reboot return 1 if ($grub{'GRUB_CMDLINE_LINUX'} =~ /rootflags=\S*uquota,gquota/ || $grub{'GRUB_CMDLINE_LINUX'} =~ /rootflags=\S*gquota,uquota/); # Otherwise, flags need adding return 2; } # create_domain_ssh_key(&domain) # Creates an SSH public and private key for a domain, and returns the public # key and an error message. sub create_domain_ssh_key { my ($d) = @_; return (undef, $text{'setup_esshkeydir'}) if (!$d->{'dir'} || !$d->{'unix'}); return (undef, $text{'setup_esshsshd'}) if (!&foreign_installed("sshd")); my $sshdir = $d->{'home'}."/.ssh"; my %oldpubs = map { $_, 1 } glob("$sshdir/*.pub"); &foreign_require("sshd"); my $cmd = $sshd::config{'keygen_path'}." -P \"\""; $cmd = &command_as_user($d->{'user'}, 0, $cmd); my $out; my $inp = "\n"; &execute_command($cmd, \$inp, \$out, \$out); if ($?) { return (undef, $out); } my @newpubs = grep { !$oldpubs{$_} } glob("$sshdir/*.pub"); return (undef, $text{'setup_esshnopub'}) if (!@newpubs); return (&read_file_contents($newpubs[0]), undef); } # save_domain_ssh_pubkey(&domain, pubkey) # Adds an SSH public key to the authorized keys file sub save_domain_ssh_pubkey { my ($d, $pubkey) = @_; return $text{'setup_esshkeydir'} if (!$d->{'dir'}); my $sshdir = $d->{'home'}."/.ssh"; if (!-d $sshdir) { &make_dir_as_domain_user($d, $sshdir, 0700); } my $sshfile = $sshdir."/authorized_keys"; my $ex = -e $sshfile; &open_tempfile_as_domain_user($d, SSHFILE, ">>$sshfile"); &print_tempfile(SSHFILE, $pubkey."\n"); &close_tempfile_as_domain_user($d, SSHFILE); &set_permissions_as_domain_user($d, 0600, $sshfile) if (!$ex); return undef; } # get_ssh_key_identifier(&user) # Returns a string that uniquely identifies a user's SSH public key sub get_ssh_key_identifier { my ($user, $d) = @_; my $username = &remove_userdom($user->{'user'}, $d); return "[$d->{'id'}:$username]"; # [1234567890123456:ilia] } # add_domain_user_ssh_pubkey(&domain, &user, pubkey) # Adds an SSH public key to the authorized keys file sub add_domain_user_ssh_pubkey { my ($d, $user, $pubkey) = @_; return if (!$d->{'dir'}); my $sshdir = $user->{'home'}."/.ssh"; &make_dir_as_domain_user($user, $sshdir, 0700); my $sshfile = "$sshdir/authorized_keys"; my $identifier = &get_ssh_key_identifier($user, $d); eval { &write_as_domain_user($user, sub { &write_file_contents($sshfile, "$pubkey $identifier") }); }; return $@ if ($@); return 0; } # get_domain_user_ssh_pubkey(&domain, &user) # Returns the SSH public key for some user # in a domain, or undef if none sub get_domain_user_ssh_pubkey { my ($d, $user) = @_; return if (!$d->{'dir'}); my $sshdir = $user->{'home'}."/.ssh"; return if (!-d $sshdir); my $sshfile = "$sshdir/authorized_keys"; return if (!-f $sshfile); my $identifier = &get_ssh_key_identifier($user, $d); my $pubkey; my $authorized_keys = &read_file_lines_as_domain_user($user, $sshfile, 1); foreach my $authorized_key (@$authorized_keys) { if ($authorized_key =~ /\Q$identifier\E/) { $pubkey = $authorized_key; $pubkey =~ s/\s+\Q$identifier\E//; last; } } return $pubkey; } # delete_domain_user_ssh_pubkey(&domain, &user) # Removes an SSH public key from the authorized keys file # if it is used by the domain and key can be identified sub delete_domain_user_ssh_pubkey { my ($d, $user) = @_; return if (!$d->{'dir'}); my $sshdir = $user->{'home'}."/.ssh"; return if (!-d $sshdir); my $sshfile = "$sshdir/authorized_keys"; return if (!-f $sshfile); my $identifier = &get_ssh_key_identifier($user, $d); my $authorized_keys = &read_file_lines_as_domain_user($user, $sshfile); for (my $i = 0; $i < @$authorized_keys; $i++) { if ($authorized_keys->[$i] =~ /\Q$identifier\E/) { splice(@$authorized_keys, $i, 1); last; } } &flush_file_lines_as_domain_user($user, $sshfile); return undef; } # update_domain_user_ssh_pubkey(&domain, &user, &olduser, [pubkey]) # Updates an SSH public key or key identifier in the authorized # keys file if it is used by the domain and the old key can be # identified sub update_domain_user_ssh_pubkey { my ($d, $user, $olduser, $pubkey) = @_; return if (!$d->{'dir'}); my $sshdir = $user->{'home'}."/.ssh"; return if (!-d $sshdir); my $sshfile = "$sshdir/authorized_keys"; return if (!-f $sshfile); my $identifier = &get_ssh_key_identifier($user, $d); my $identifier_old = &get_ssh_key_identifier($olduser, $d); my $authorized_keys = &read_file_lines_as_domain_user($user, $sshfile); foreach my $authorized_key (@$authorized_keys) { if ($authorized_key =~ /\Q$identifier_old\E/) { # Replace old key with new key if set if ($pubkey) { $authorized_key = "$pubkey $identifier"; } # Just update identifier and keep same key else { $authorized_key =~ s/\Q$identifier_old\E/$identifier/; } } } &flush_file_lines_as_domain_user($user, $sshfile); return undef; } # get_ssh_pubkey_from_file(file, [match]) # Returns the SSH public key from some file, # alternatively matching by some string. If # match parameter is not set, returns the first # line of the file. sub get_ssh_pubkey_from_file { my ($sshpubkeyfile, $sshpubkeyid) = @_; my $pubkey; my $sshpubkeyfilelines = &read_file_lines($sshpubkeyfile, 1); foreach my $sshpubkeyfileline (@$sshpubkeyfilelines) { $sshpubkeyfileline = &trim($sshpubkeyfileline); if ($sshpubkeyid) { if ($sshpubkeyfileline =~ /\Q$sshpubkeyid\E/) { $pubkey = $sshpubkeyfileline; last; } } else { $pubkey = $sshpubkeyfileline; last; } } return $pubkey; } # validate_ssh_pubkey(pubkey, [no-ssh-keygen]) # Returns an error message if some SSH public key is invalid sub validate_ssh_pubkey { my ($pubkey, $no_ssh_keygen) = @_; my ($ssh_keytest_out, $ssh_keytest_err); ($ssh_keytest_err = $text{'validate_esshpubkeyempty'}) if (!$pubkey); if (!$ssh_keytest_err) { my $ssh_keygen = !$no_ssh_keygen && &has_command('ssh-keygen'); if ($ssh_keygen) { my $pubkeyfile = &transname('id_rsa.pub'); &write_file_contents($pubkeyfile, $pubkey); &execute_command("$ssh_keygen -l -f $pubkeyfile", undef, \$ssh_keytest_out, \$ssh_keytest_err); if ($ssh_keytest_err) { $ssh_keytest_err =~ s/\s*\Q$pubkeyfile\E\s*|^\s+|\s+$//g; $ssh_keytest_err =~ s/\.$//; $ssh_keytest_err = &text('validate_esshpubkeyinvalid', &html_escape(ucfirst($ssh_keytest_err))); } } elsif ($pubkey && $pubkey !~ /^(ssh-rsa|ssh-dss|ssh-dsa|ecdsa-sha2-nistp256|rsa-sha2-512| rsa-sha2-256|ecdsa-sha2-nistp384|ecdsa-sha2-nistp521| ssh-ed25519|sk-ecdsa-sha2-nistp256|sk-ssh-ed25519)/x) { $ssh_keytest_err = &text('validate_esshpubkeyinvalid', $text{'validate_esshpubkeyinvalidformat'}); } } return wantarray ? ($ssh_keytest_err, $ssh_keytest_out) : $ssh_keytest_err; } sub get_module_version_and_type { my ($list, $gpl, $ver) = @_; my $mver = $ver || $module_info{'version'}; my ($v_major, $v_minor, $v_build, $v_type); if ($mver =~ /(?\d+)\.(?\d+)\.(?\d+).*?(?[a-z]+)/i) { ($v_major, $v_minor, $v_build, $v_type) = ($+{major}, $+{minor}, $+{build}, $+{type}); } elsif ($mver =~ /(?\d+)\.(?\d+).*?(?[a-z]+)/i) { ($v_major, $v_minor, $v_build, $v_type) = ($+{major}, $+{minor}, undef, $+{type}); } elsif ($mver =~ /(?\d+)\.(?\d+)\.(?\d+)/) { ($v_major, $v_minor, $v_build) = ($+{major}, $+{minor}, $+{build}); } elsif ($mver =~ /(?\d+)\.(?\d+)/) { ($v_major, $v_minor) = ($+{major}, $+{minor}); } else { return $mver; } if ($v_type =~ /pro/i) { $v_type = " Pro"; } else { if ($gpl) { $v_type = " GPL"; } else { $v_type = ""; } } return $list ? ($v_major, $v_minor, $v_build, &trim($v_type)) : "$v_major.$v_minor".(defined($v_build) ? ".$v_build" : "")."$v_type"; } # set_provision_features(&domain) # Set the provision_* and cloud_* fields in a domain based on what # provisioning features are currently configured globally and in the template, # to indicate that they should be created remotely. sub set_provision_features { my ($d) = @_; my $tmpl = &get_template($d->{'template'}); foreach my $f (&list_provision_features()) { if ($f eq "dns") { # Template has an option to control where DNS is hosted my $alias = $d->{'alias'} ? &get_domain($d->{'alias'}) : undef; my $cloud = $alias && $alias->{'dns_cloud'} ? $alias->{'dns_cloud'} : $d->{'dns_cloud'} ? $d->{'dns_cloud'} : $d->{'dns_remote'} ? 'remote_'.$d->{'dns_remote'} : $tmpl->{'dns_cloud'}; if ($cloud eq 'services') { # Cloudmin services $d->{'provision_dns'} = 1; delete($d->{'dns_cloud'}); } elsif ($cloud eq 'local') { # Local system $d->{'provision_dns'} = 0; delete($d->{'dns_cloud'}); } elsif ($cloud =~ /^remote_(\S+)$/) { # Remote Webmin server delete($d->{'dns_cloud'}); $d->{'dns_remote'} = $1; } elsif ($cloud eq '') { # Global default $d->{'provision_dns'} = 1 if ($config{'provision_dns'}); delete($d->{'dns_cloud'}); } else { # Cloud provider $d->{'dns_cloud'} = $cloud; $d->{'dns_cloud_import'} = $tmpl->{'dns_cloud_import'}; } } elsif ($config{'provision_'.$f}) { # Only option is cloudmin services $d->{'provision_'.$f} = 1; } } # Check if template has an option to control cloud SMTP provider my $cloud = $d->{'smtp_cloud'} || $tmpl->{'mail_cloud'}; if ($cloud eq 'local') { delete($d->{'smtp_cloud'}); } else { $d->{'smtp_cloud'} = $cloud; } } # update_edit_limits(&dom, limit-name, limit-value) # Updates dependencies for given feature # when limits for a domain changed sub update_edit_limits { my ($d, $lname, $lvalue) = @_; } # text_html(&text) # Prints given only if in HTML mode sub text_html { if (defined(&get_sub_ref_name)) { my $print_mode = &get_sub_ref_name($first_print); if ($print_mode && $print_mode =~ /_html_/) { return &text(@_); } } } # setup_virtualmin_default_hostname_ssl() # Setup default hostname domain with SSL certificate, # unless previously default domain has not been setup # and return error message or undef on success sub setup_virtualmin_default_hostname_ssl { my $wantarr = wantarray; my $err = sub { my ($msg, $code, $d) = @_; return $wantarr ? ($code || 0, $msg, $d) : $code || 0; }; # Can create return &$err(&text('check_defhost_cannot', $remote_user)) if (!&can_create_master_servers()); my $is_default_domain = &get_domain_by("defaultdomain", 1); my $system_host_name = &get_system_hostname(); if ($system_host_name !~ /\./) { my $system_host_name_ = &get_system_hostname(0, 1); $system_host_name = $system_host_name_ if ($system_host_name_ =~ /\./); } # Hostname should be FQDN return &$err(&text('check_defhost_nok', $system_host_name)) if ($system_host_name !~ /(\.[^.]+){2,}/); # Check if domain already exist for some reason return &$err(&text('check_defhost_clash', $system_host_name)) if (&get_domain_by("dom", $system_host_name) || $is_default_domain->{'dom'}); # Setup from source my $setup_source = $0; &lock_domain_name($system_host_name); # Work out username / etc my ($user, $try1, $try2); $user = "_default_hostname"; if (defined(getpwnam($user))) { ($user, $try1, $try2) = &unixuser_name($system_host_name); } $user || return &$err(&text('setup_eauto', $try1, $try2)); my ($group, $gtry1, $gtry2); $group = "_default_hostname"; if (defined(getgrnam($group))) { ($group, $gtry1, $gtry2) = &unixgroup_name($system_host_name, $user); } $group || return &$err(&text('setup_eauto2', $try1, $try2)); my $defip = &get_default_ip(); my $defip6 = &get_default_ip6(); my $template = &get_init_template(); my $plan = &get_default_plan(); # Create the virtual server object my %dom; %dom = ('id', &domain_id(), 'dom', $system_host_name, 'user', $user, 'group', $group, 'ugroup', $group, 'owner', $text{'check_defhost_desc'}, 'name', 1, 'name6', 1, 'ip', $defip, 'dns_ip', &get_dns_ip(), 'virt', 0, 'virtalready', 0, 'ip6', $defip6, 'virt6', 0, 'virt6already', 0, 'pass', &random_password(), 'quota', 0, 'uquota', 0, 'source', $setup_source, 'template', $template, 'plan', $plan->{'id'}, 'prefix', $prefix, 'nocreationmail', 1, 'nowebmailredirect', 1, 'nodnsspf', 1, 'hashpass', 1, 'nocreationscripts', 1, 'defaultdomain', 1, 'defaulthostdomain', 1, 'letsencrypt_dwild', 0, 'defaultshell', '/dev/null', 'dns_initial_records', '@', 'nodnsdmarc', 1, 'default_php_mode', 4, 'dom_defnames', $system_host_name ); # Set initial features $dom{'dir'} = 1; $dom{'unix'} = 1; $dom{'dns'} = 1; $dom{'mail'} = 0; my $webf = &domain_has_website(); my $sslf = &domain_has_ssl(); $dom{$webf} = 1; $dom{$sslf} = 1; $dom{'letsencrypt_dname'} = $system_host_name; $dom{'auto_letsencrypt'} = 2; # Fill in other default fields &set_limits_from_plan(\%dom, $plan); &set_capabilities_from_plan(\%dom, $plan); $dom{'emailto'} = $dom{'user'}.'@'.$system_host_name; $dom{'db'} = &database_name(\%dom); &set_featurelimits_from_plan(\%dom, $plan); &set_chained_features(\%dom, undef); &set_provision_features(\%dom); &generate_domain_password_hashes(\%dom, 1); $dom{'home'} = &server_home_directory(\%dom, undef); $dom{'home'} =~ s/(\/)(?=[^\/]*$)/$1./; &complete_domain(\%dom); # Check for various clashes $derr = &virtual_server_depends(\%dom); return &$err($derr) if ($derr); $cerr = &virtual_server_clashes(\%dom); return &$err($cerr) if ($cerr); my @warns = &virtual_server_warnings(\%dom); return &$err(join(" ", @warns)) if (@warns); # Create the server &push_all_print(); &set_all_null_print(); my ($rs) = &create_virtual_server( \%dom, undef, undef, 1, 0, $pass, $dom{'owner'}); &pop_all_print(); return &$err($rs) if ($rs && ref($rs) ne 'HASH'); my $succ = $rs->{'letsencrypt_last'} ? 1 : 0; # Perhaps shared SSL certificate was installed, trust it $succ = 2 if ($rs->{'ssl_same'}); my $succ_msg = $succ ? &text($succ == 2 ? 'check_defhost_sharedsucc' : 'check_defhost_succ', $system_host_name) : &text('check_defhost_err', $system_host_name); $config{'defaultdomain_name'} = $dom{'dom'}; $config{'default_domain_ssl'} = 1 if ($succ && !$config{'default_domain_ssl'}); &lock_file($module_config_file); &save_module_config(); &unlock_file($module_config_file); # Set as default domain if create some time later if (&can_default_website(\%dom)) { &set_default_website(\%dom); } &run_post_actions_silently(); &unlock_domain_name($system_host_name); &clear_links_cache() if ($config{'default_domain_ssl'} == 2); return &$err($succ_msg, $succ, $rs); } # delete_virtualmin_default_hostname_ssl() # Delete default hostname domain sub delete_virtualmin_default_hostname_ssl { # Test host default domain being deleted my $d = &get_domain_by("defaulthostdomain", 1); return if (!$d->{'dom'}); return if (!&can_delete_domain($d)); # Delete host default domain # &lock_domain_name($d->{'dom'}); #### XXXX do we need locking on delete? &push_all_print(); &set_all_null_print(); $err = &delete_virtual_server($d, 0, 0); &pop_all_print(); &run_post_actions_silently(); # &unlock_domain_name($d->{'dom'}); #### XXXX &lock_file($module_config_file); $config{'defaultdomain_name'} = undef; &save_module_config(); &unlock_file($module_config_file); &clear_links_cache(); return wantarray ? (0, $err) : 0 if ($err); return wantarray ? (1, undef) : 1; } # rename_default_domain_ssl(&domain, new_hostname) # Rename default hostname domain sub rename_default_domain_ssl { my ($d, $new_hostname) = @_; if (!&can_edit_domain($d) || !&can_edit_ssl() || !&can_webmin_cert()) { return 0; } # Try renaming default domain &push_all_print(); &set_all_null_print(); my $err = &rename_virtual_server($d, $new_hostname); # Update state of all certs my @already = &get_all_domain_service_ssl_certs($d); foreach my $st (&list_service_ssl_cert_types()) { next if (!$st->{'dom'} && !$st->{'virt'}); next if (!$st->{'dom'} && !$d->{'virt'}); my ($a) = grep { $_->{'d'} && $_->{'id'} eq $st->{'id'} } @already; my $func = "sync_".$st->{'id'}."_ssl_cert"; my $ok = 1; $ok = &$func($d, 1) if (!$a); $err = 1 if (!$ok); } # Update config entry $config{'defaultdomain_name'} = $new_hostname; &lock_file($module_config_file); &save_module_config(); &unlock_file($module_config_file); &run_post_actions_silently(); &pop_all_print(); &clear_links_cache() if ($config{'default_domain_ssl'} == 2); return $err ? 0 : 1; } # check_virtualmin_default_hostname_ssl() # Check default host domain sub check_virtualmin_default_hostname_ssl { # Get actual system hostname my $system_host_name = &get_system_hostname(); if ($system_host_name !~ /\./) { my $system_host_name_ = &get_system_hostname(0, 1); $system_host_name = $system_host_name_ if ($system_host_name_ =~ /\./); } my $remove_default_host_domain = sub { my ($silent_print) = @_; if ($silent_print) { &push_all_print(); &set_all_null_print(); } &$first_print(&text('check_hostdefaultdomain_disable', $system_host_name)); my ($ok, $rsmsg) = &delete_virtualmin_default_hostname_ssl(); if (!$ok) { &$second_print(&text('check_apicmderr', $rsmsg)); } else { &$second_print($text{'setup_done'}); } if ($silent_print) { &pop_all_print(); } }; my $new_default_domain = &get_domain_by("defaulthostdomain", 1); if ($new_default_domain->{'dom'}) { if ($config{'default_domain_ssl'}) { my $known_default_domain = $config{'defaultdomain_name'}; my $hostname_changed = $known_default_domain ne $system_host_name; my $failed_le = !$new_default_domain->{'letsencrypt_last'} && !$new_default_domain->{'ssl_same'}; my $text_msg = $hostname_changed ? 'check_hostdefaultdomain_change' : 'check_hostdefaultdomain_enable'; if ($hostname_changed || $failed_le) { &$first_print(&text($text_msg, $known_default_domain, $system_host_name)); my ($defdom_status, $defdom_msg); if ($hostname_changed) { $defdom_status = &rename_default_domain_ssl($new_default_domain, $system_host_name); } else { &$remove_default_host_domain(1); ($defdom_status, $defdom_msg) = &setup_virtualmin_default_hostname_ssl(); } if ($defdom_status == 2) { &$second_print($text{'check_defhost_sharedsucc2'}); } elsif ($defdom_status == 1) { &$second_print($text{'setup_done'}); } else { # Remove on failure unless host # default domain set to be visible &$remove_default_host_domain(1) if ($config{'default_domain_ssl'} != 2 && !$hostname_changed); &$second_print(&text('check_apicmderr', $defdom_msg)); } } } else { &$remove_default_host_domain(); } } elsif ($config{'default_domain_ssl'}) { my $old_default_domain = &get_domain_by("defaultdomain", 1); &$first_print(&text('check_hostdefaultdomain_enable', $system_host_name)); if ($old_default_domain->{'dom'} && !$old_default_domain->{'defaulthostdomain'}) { &$second_print(&text('check_hostdefaultdomain_errold', $old_default_domain->{'dom'})); } else { &$remove_default_host_domain(1); my ($defdom_status, $defdom_msg) = &setup_virtualmin_default_hostname_ssl(); if ($defdom_status == 2) { &$second_print($text{'check_defhost_sharedsucc2'}); } elsif ($defdom_status == 1) { &$second_print($text{'setup_done'}); } else { # Remove on failure unless host # default domain set to be visible &$remove_default_host_domain(1) if ($config{'default_domain_ssl'} != 2); &$second_print(&text('check_apicmderr', $defdom_msg)); } } } } # error_stderr_local(err, [dont-print-return-as-string]]]) # Print an error message to STDERR, # or call error_stderr if defined sub error_stderr_local { my ($err, $noprint) = @_; if (defined(&error_stderr)) { if ($noprint) { return &error_stderr($err, $noprint); } else { &error_stderr($err); } } else { print STDERR "$err\n"; } } # list_feature_plugins([include-always]) # Returns a list of all plugins that define features sub list_feature_plugins { my ($always) = @_; &load_plugin_libraries(); return grep { &plugin_defined($_, "feature_setup") || $always && &plugin_defined($_, "feature_always_setup") } @plugins; } # Returns a list of all plugins that add mailbox-level options sub list_mail_plugins { &load_plugin_libraries(); return grep { &plugin_defined($_, "mailbox_inputs") } @plugins; } # Returns a list of all plugins that add a new database type sub list_database_plugins { &load_plugin_libraries(); return grep { &plugin_defined($_, "database_name") } @plugins; } # Returns a list of all plugins that add a service that can be started sub list_startstop_plugins { &load_plugin_libraries(); return grep { &plugin_defined($_, "feature_startstop") } @plugins; } # Returns a list of all plugins that have a backupable feature sub list_backup_plugins { &load_plugin_libraries(); return grep { &plugin_defined($_, "feature_backup") || &plugin_defined($_, "feature_always_backup") } @plugins; } # Returns a list of all plugins that define new script installers sub list_script_plugins { &load_plugin_libraries(); return grep { &plugin_defined($_, "scripts_list") } @plugins; } $done_virtual_server_lib_funcs = 1; 1;