#!/usr/bin/perl
# Copyright 1999-2025. WebPros International GmbH. All rights reserved.

#########################################################################################################################
#                                                                                                                       #
#   transvhost.pl - Utility change HTTPD_VHOSTS_D psa.conf value: moves content and corrects database and config files. #
#                                                                                                                       #
#########################################################################################################################
use strict;
use warnings;
use File::Find ();
use File::Temp qw(tempfile);
use IO::File;
use JSON::XS;

use vars qw($newVhostsPath $oldVhostsPath %config %domainHash %statHash %logRotHash);

$ENV{"LC_ALL"}="C";

my %arg_opts = ('--help|-h'=>'',
    '--dest-dir|-d'=>'s',
    '--correct-scripts'=>'',
);

my $ptrArgs = getArguments(\@ARGV,\%arg_opts);

if (exists $ptrArgs->{'help'}){
    printHelp($0);
    exit(0);
}

if (!exists $ptrArgs->{'dest-dir'}) {
    printf ("You should specify destination directory.\n");
    printHelp($0);
    exit(2);
}

read_config();

$oldVhostsPath = $config{HTTPD_VHOSTS_D};

$newVhostsPath = $ptrArgs->{'dest-dir'};
if ($newVhostsPath =~ m/\/$/){
    # remove slash at the end of path
    ($newVhostsPath) = $newVhostsPath =~ m/^(.*)\/$/;
}

my $getenforce = '/usr/sbin/getenforce';
if (-x $getenforce and `$getenforce` =~ /Enforcing/i) {
    print STDERR "Before transferring virtual hosts' content, disable SELinux " .
        "or set it to permissive mode and keep it that way to avoid breaking your websites.\n";
    print STDERR "Read more: " .
        "https://support.plesk.com/hc/en-us/articles/12377953257111-How-to-change-virtual-hosts-location-in-Plesk-for-Linux\n";
    exit(1);
}

detectFileSystem();
correctPhpFpmPools();
fail2BanInstalled() and corrertFail2BanApacheJails();
correctDb();

reconfigureAps();

if(system($config{WEBSERV} . " --reconfigure-all > /dev/null") !=0) {
    printf("Can`t reconfigure web server \n");
}

if(system($config{FTPSERV} . " --reconfigure-all > /dev/null") !=0) {
    printf("Can`t reconfigure ftp server \n");
}

createDomainHash();
createLogRotHash();
correctPhpIniFiles();

foreach my $domain (keys %statHash) {
    system($config{WEBSTAT}. " --unset-configs --stat-prog=$statHash{$domain} --domain-name=$domain");
    system($config{WEBSTAT}. " --set-configs --stat-prog=$statHash{$domain} --domain-name=$domain < /dev/null");
}

foreach my $domain (keys %logRotHash) {
    system($config{LOGROT}. " $domain off $logRotHash{$domain}");
    system($config{LOGROT}. " $domain on $logRotHash{$domain}");
}

if (exists $ptrArgs->{'correct-scripts'}) {
    if (correctScripts()!=0){
        exit -1;
    }
    exit 0;
}

exit 0;

sub read_config {
    open FCONF, "< /etc/psa/psa.conf"
      or die "Can't open Plesk configurational file\n";
    while (<FCONF>) {
        s/\#.*$//;
        m/^\s*(\w+)\s+(.+?)\s*$/;
        next unless $1;
        $config{$1} = $2;
    }

    close FCONF;

    # prepare temporary file with mysql login and password
    # that will be kept until the finish of the util execution
    my ($myExtFH, $myExtFN) = tempfile(UNLINK => 1);
    print $myExtFH "[client]\n";
    print $myExtFH "user=admin\n";
    print $myExtFH "password=";
    close $myExtFH;
    0 == system("cat /etc/psa/.psa.shadow >> \"$myExtFN\"")
        or die "Can't get Plesk administrator's password\n";

    if (-x $config{MYSQL_BIN_D}.'/mariadb') {
        $config{MYSQL} = $config{MYSQL_BIN_D}."/mariadb --defaults-extra-file=\"$myExtFN\" -s -N -Dpsa";
    } else {
        $config{MYSQL} = $config{MYSQL_BIN_D}."/mysql --defaults-extra-file=\"$myExtFN\" -s -N -Dpsa";
    }

    if (-e '/etc/SuSE-release' or -e '/etc/debian_version') {
        $config{MYSQL_SCRIPT} = $config{PRODUCT_RC_D} . '/mysql';
    } else {
        $config{MYSQL_SCRIPT} = $config{PRODUCT_RC_D} . '/mysqld';
    }

    $config{WEBSERV} = $config{PRODUCT_ROOT_D}.'/admin/bin/httpdmng';
    $config{FTPSERV} = $config{PRODUCT_ROOT_D}.'/admin/bin/ftpmng';
    $config{WEBSTAT} = $config{PRODUCT_ROOT_D}.'/admin/bin/webstatmng';
    $config{LOGROT} = $config{PRODUCT_ROOT_D}.'/admin/bin/logrot_mng';

    return 0;
}

sub find(&@) { &File::Find::find }

sub correctFileSystem{
    if ($newVhostsPath eq $oldVhostsPath) {
        print "Server is already configured.\n";
        exit 0;
    }
    print "Moving files to new directory...\n";

    my $mkdir = `mkdir -p $newVhostsPath` if (! -d '$newVhostsPath');
    system("mv $oldVhostsPath/* $oldVhostsPath/\.* $newVhostsPath 2>/dev/null");

    #correct psa.conf

    my $psaSed = "-e \"s|$oldVhostsPath|$newVhostsPath|g\"";
    print "Correct psa configuration file...\n";
    system("sed $psaSed /etc/psa/psa.conf > /etc/psa/psa.conf.new");
    system("cp /etc/psa/psa.conf.new /etc/psa/psa.conf");
    if ($? == 0) {
        unlink "/etc/psa/psa.conf.new";
    }

    #correct /etc/passwd

    print "Correct passwd file...\n";

    system("sed $psaSed /etc/passwd > /etc/passwd.new");
    system("cp /etc/passwd.new /etc/passwd");
    if ($? == 0) {
        unlink "/etc/passwd.new";
    }

    setDirtyFlag();

    return 0;
}

sub createLogRotHash {
    my $query = "select d.name, l.turned_on, l.period_type, l.period, l.max_number_of_logfiles, l.compress_enable, l.email from domains d, hosting h, log_rotation l, dom_param dp where d.htype='vrt_hst' and d.id=dp.dom_id and dp.val=l.id";
    my $state;
    my $command = $config{MYSQL}." -e \"$query\"";
    open (QUERY, "$command |");
    while (<QUERY>){
        if (m/([\S]+)\s([\S]+)\s([\S]+)\s([\S]+)\s([\S]+)\s([\S]+)\s(.*)/){
            next if ($2 eq 'false');
            $logRotHash{$1} = join(" ", $3, $4, $5, $6, $7);
        }
    }
    close (QUERY);
}

sub createDomainHash {
    my $query = "SELECT d.id, d.name, h.webstat FROM domains d LEFT JOIN hosting h ON d.id=h.dom_id WHERE d.htype='vrt_hst'";
    my $command = $config{MYSQL}." -e \"$query\"";
    open (QUERY, "$command |");
    while (<QUERY>){
        if (m/([\S]+)\s([\S]+)\s([\S]+)/){
            $domainHash{$2} = $1;
            next if $3 eq 'none';
            $statHash{$2} = $3;
        }
    }
    close (QUERY);
}

sub correctDb {
    my ($query, $command);
    print "Correct database...\n";
    print "Update hosting settings...\n";
    $query = "UPDATE hosting SET www_root = REPLACE(www_root, '$oldVhostsPath', '$newVhostsPath')";
    $command = $config{MYSQL}." -e \"$query\"";
    system($command);
    print "done\n";

    print "Update subdomains settings...\n";
    $query = "UPDATE subdomains SET www_root = REPLACE(www_root, '$oldVhostsPath', '$newVhostsPath')";
    $command = $config{MYSQL}." -e \"$query\"";
    system($command);
    print "done\n";

    print "Update system users settings...\n";
    $query = "UPDATE sys_users SET home = REPLACE(home, '$oldVhostsPath', '$newVhostsPath')";
    $command = $config{MYSQL}." -e \"$query\"";
    system($command);
    print "done\n";

    print "Update aps resources parameters...\n";
    $query = "UPDATE apsResourcesParameters SET value = REPLACE(value, '$oldVhostsPath', '$newVhostsPath')";
    $command = $config{MYSQL}." -e \"$query\"";
    system($command);
    print "done\n";

    $command = $config{PRODUCT_ROOT_D}."/bin/sw-engine-pleskrun ".$config{PRODUCT_ROOT_D}."/admin/plib/api-cli/service_node.php --update local";
    system($command);
}

sub reconfigureAps{
    print "Reconfigure aps applications...\n";
    my $command = $config{PRODUCT_ROOT_D}."/bin/sw-engine-pleskrun ".$config{PRODUCT_ROOT_D}."/admin/plib/api-cli/aps.php --reconfigure-all";
    system($command);
    print "done\n";
}

sub check_mysql() {
    printf("Attempting to connect to MySQL: ");
    my $res = system($config{MYSQL} . " -e '' 2> /dev/null");
    printf("%s\n", ($res ? "failed" : "ok"));
    return $res;
}

sub correctFile($) {
    my $file = shift;

    open(my $fh, "+<$file") or die "Cannot open file: $! : $file .\n";
    my $out = '';
    while (<$fh>) {
        s/$oldVhostsPath(?![\w\.])/$newVhostsPath/g;
        $out .= $_;
    }
    seek($fh, 0, 0);
    print $fh $out;
    truncate($fh, tell($fh));
    close($fh);
}

sub correctScripts{
    unless (-d $newVhostsPath){
        print "Directory $newVhostsPath does not exist.\n";
        return -1;
    }

    print "Correct user scripts...\n";

    my @skip_dirs = qw/bin dev lib usr/;

    foreach my $domain (keys(%domainHash), "default") {
        my @files;
        if (-e "$newVhostsPath/$domain"){
            find { push @files, $File::Find::name if -e } "$newVhostsPath/$domain";
            FILE: foreach my $file (@files) {
                next FILE if (-d $file or # Skip directories
                    -S $file or #     and sockets (e.g. .plesk/php-fpm.sock)
                    -B $file or #     and binary files.
                    -l $file);  # I'm not sure that I want to follow symlinks.

                # Also skip httpd autogenerated configs except vhost.conf and vhost_ssl.conf
                next FILE if ( $file =~ m{^$newVhostsPath/$domain/.plesk/conf/}
                    and $file !~ m{^$newVhostsPath/$domain/.plesk/conf/(vhost|vhost_ssl)\.conf$} );

                foreach my $skip_d (@skip_dirs) {
                    next FILE if $file =~ m{^$newVhostsPath/$domain/$skip_d/};
                }
                correctFile($file);
            }
        }
    }
    return 0;
}

sub correctPhpFpmPools {
    print "Correct php-fpm pools configuration...\n";

    my $cmd = $config{PRODUCT_ROOT_D} . "/admin/sbin/php_handlers_control --list-json";
    my $php_handlers_json = qx{$cmd};
    if ($?) {
        print STDERR "Failed to read list of php handlers ($?). Continue.";
        return;
    }

    my $handlers_data_ref = decode_json $php_handlers_json;
    unless($handlers_data_ref) {
        print STDERR "Failed to parse json data: $php_handlers_json. Continue.";
        return;
    }

    my @fpms = grep {$_->{type} eq "fpm" } @{$handlers_data_ref->{php}};
    for my $fpm(@fpms) {
        correctPhpFpm($fpm->{service}, $fpm->{poold});
    }
}

sub correctPhpFpm {
    my ($service, @pool_dirs) = @_;
    my $configuration_changed = 0;
    for my $fpm_dir(@pool_dirs) {
        next unless -d $fpm_dir;

        opendir(my $dh, $fpm_dir) or die "Cannot open directory: $! : $fpm_dir .\n";
        while (defined( my $file = readdir($dh) )) {
            next unless $file =~ /(?<!^www)\.conf$/;
            correctFile("$fpm_dir/$file");
            $configuration_changed = 1;
        }
        closedir($dh);
    }
    if ($configuration_changed) {
        my $fpm_service_name = $service || "php-fpm";
        print "Restart $fpm_service_name service...\n";
        my $command = $config{PRODUCT_ROOT_D}."/admin/sbin/pleskrc \"$service\" try-reload";
        system($command);
    }
}

sub correctPhpIniFiles {
    foreach my $domain (keys %statHash) {
        my $phpIniFile = $newVhostsPath."/system/".$domain."/etc/php.ini";
        next unless -f $phpIniFile;
        correctFile($phpIniFile);
    }
}

sub setDirtyFlag {
    my $packagemng = $config{PRODUCT_ROOT_D} . "/admin/sbin/packagemng";
    system("$packagemng --set-dirty-flag");
}

sub fail2BanInstalled {
    my $packagemng = $config{PRODUCT_ROOT_D} . "/admin/sbin/packagemng";
    my @f2b_status = grep { /^fail2ban:\S+\s*$/ } `$packagemng --list`;
    return scalar(@f2b_status) > 0;
}

sub corrertFail2BanApacheJails {
    print "Correct Fail2Ban jails configuration...\n";

    my $f2bmng = $config{PRODUCT_ROOT_D} . "/admin/sbin/f2bmng";
    my @jails = ('plesk-apache', 'plesk-apache-badbot');

    JAIL: for my $jail ( @jails ) {
        open my $f2b_get, "$f2bmng --get-jail=$jail |" or do {
            print "Unable to get jail $jail configuration: $!";
            next JAIL
        };
        my $jail_config = <$f2b_get>;
        close $f2b_get;

        $jail_config =~ s#(\s"|\\n)\Q$oldVhostsPath\E/#$1$newVhostsPath/#g;

        open my $f2b_set, "| $f2bmng --set-jail=$jail" or do {
            print "Unable to set jail $jail configuration: $!";
            next JAIL
        };
        print $f2b_set $jail_config;
        close $f2b_set;
    }
}

sub detectFileSystem {
    my %pseudofs = ('autofs' => 1,
        'binfmt_misc' => 1,
        'cd9660' => 1,
        'devfs' => 1,
        'devpts' => 1,
        'fdescfs' => 1,
        'iso9660' => 1,
        'linprocfs' => 1,
        'proc' => 1,
        'procfs' => 1,
        'romfs' => 1,
        'sysfs' => 1,
        'tmpfs' => 1,
        'usbdevfs' => 1,
        'usbfs' => 1,
        'rpc_pipefs' => 1,
    );

    my $mkdir = `mkdir -p $newVhostsPath` if (! -d "$newVhostsPath");

    my %partitions;
    foreach my $mountinfo (`mount`) {
        chomp $mountinfo;
        #unable to use 'undef' here - perl 5.004 compatibility
        my ($device, $undef, $mountpoint, $undef1, $type, $options) = split /\s+/, $mountinfo;
        my $mode = 'rw';
        $mode = 'ro' if ($options =~ /[(,]ro[,)]/);
        unless (defined $pseudofs{$type}) {
            $partitions{$mountpoint} = ();
            $partitions{$mountpoint}->{'device'} = $device;
            $partitions{$mountpoint}->{'mode'} = $mode;
            $partitions{$mountpoint}->{'type'} = $type;
        }
    }

    foreach my $dfinfo (`LANG=C POSIXLY_CORRECT= df -Pk | tail -n +2`) {
        chomp $dfinfo;
        #unable to use 'undef' here - perl 5.004 compatibility
        my ($undef, $size, $undef1, $free, $undef2, $mountpoint) = split /\s+/, $dfinfo;
        if (exists $partitions{$mountpoint}) {
            # for brain-dead NFS shares:
            $free = $size if $free > $size;
            $partitions{$mountpoint}->{'size'} = $size;
            $partitions{$mountpoint}->{'free'} = $free;
        }
    }

    my $buf = `LANG=C POSIXLY_CORRECT= df -P $oldVhostsPath | tail -n +2`;
    my ($undef, $oldmountpoint, $newmountpoint);
    ($undef, $undef, $undef, $undef, $undef, $oldmountpoint) = split /\s+/, $buf;

    $buf = `LANG=C POSIXLY_CORRECT= df -P $newVhostsPath | tail -n +2`;
    ($undef, $undef, $undef, $undef, $undef, $newmountpoint) = split /\s+/, $buf;

    if ($oldmountpoint ne $newmountpoint){
        my $du = `du -k $oldVhostsPath | tail -n 1`;
        chomp $du;
        my ($oldSize,$undef) = split /\s+/,$du;
        if (!exists $partitions{$newmountpoint}) {
            print "Partition $newmountpoint uses unsupported filesystem.\n";
            exit 1;
        } elsif ($oldSize < $partitions{$newmountpoint}->{'free'}) {
            correctFileSystem();
        }else{
            print "Partition $newmountpoint has not enough free space.\n";
            exit 1;
        }
    }else{
        correctFileSystem();
    }
}

sub getArguments {
    my ($ptrArgv,$ptrOpts) = @_;
    my (@keys,$firstKey,%prepKeys,$key,$value,$ptrArr,$arg,$state);
    my (%retHash,$pat,$found,$used,@rest,$fullArg,$prevKey);

    while (($key,$value)=each(%{$ptrOpts})){
        @keys = split(/\|/,$key);
        $firstKey = $keys[0];
        $firstKey =~s/^-*//;
        push @{$prepKeys{$firstKey}},[@keys];
        push @{$prepKeys{$firstKey}},$value;
    }

    $state =0;
    foreach $arg (@{$ptrArgv}){

        $used = 0;
        if($state==1){
            if  ($arg =~ /^-/){
                $state=0;
            }else{
                $used = 1;
                $retHash{$prevKey}=$arg;
                next;
            }
        }
        if ($state == 2){
            $retHash{$prevKey}=$arg;
            $state = 0;
            $used = 1;
        }else{
            $fullArg = $arg;
            if ($arg =~ /^(-\S+)=(.+)/s){
                $arg = $1;
                $value = $2;
            }else{
                $value = undef;
            }
            foreach $key (keys %prepKeys){

                $ptrArr = $prepKeys{$key};

                $found = 0;
                foreach $pat (@{$ptrArr->[0]}){
                    if ($pat eq $arg){
                        $found = 1;
                        last;
                    }
                }
                if($found){
                    $used = 1;
                    if(defined($value)){
                        $retHash{$key}=$value;
                    }else{
                        if($ptrArr->[1]){
                            if($ptrArr->[1] =~ /\?$/){
                                $state = 1;
                            }else{
                                $state = 2;
                            }
                            $prevKey = $key;
                        }else{
                            $retHash{$key}=undef;
                        }
                    }
                    last;
                }
            }
        }
        unless($used){
            if($value){
                push @rest,$fullArg;
            }else{
                push @rest,$arg;
            }
        }
    }
    @{$ptrArgv}=@rest;
    return \%retHash;
}

sub printHelp {
    my ($progname)=@_;
    my $help = <<HELP;
Utility to transfer vhosts content from HTTPD_VHOSTS_D directory to new place.

Usage:
        --dest-dir   <path>  Destination path. Path to new vhosts directory.
                             Example: /path/to/new/vhosts.
                             If directory does not exist it will be created.

        --correct-scripts    Changes user scripts.
                             Old vhost path is replaced to new path in content of all files.
HELP

    printf($help);
}

# vim:set et ts=4 sts=4 sw=4: