#!/usr/bin/perl

#########################################################################################################################
#                                                                                                                       #
#   transvhost.pl - Utility to move content from /home/httpd to /var/www and correct database and config files.         #
#                                                                                                                       #
#########################################################################################################################
use File::Find ();
use IO::File;

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

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

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

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

  read_config();

  $oldVhostsPath = $config{HTTPD_VHOSTS_D};

  $newVhostsPath = $ptrArgs->{'dest-dir'};

  detectFileSystem();
  correctDb();

  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");
  }

  createLogRotHash();

  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");
  }

  foreach $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;
  }

  if (exists $ptrArgs->{'help'}){
    printHelp($0);
    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;

  $config{LOGIN} = 'admin';
  $config{DBNAME} = 'psa';

  open PASSWD, "< /etc/psa/.psa.shadow"
    or die "Can't get Plesk administrator's password\n";
  $config{PASSWORD} = <PASSWD>;
  chomp $config{PASSWORD};
  close PASSWD;

  $config{MYSQL} = $config{MYSQL_BIN_D}.'/mysql -s -N -u'.shellArgQuote($config{LOGIN}).' -p'.shellArgQuote($config{PASSWORD}).' -D'.$config{DBNAME};

  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";
  }

  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 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";

  $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 detectOs{
  my $uname = `uname -s`;
  chomp $uname;
  return $uname;
}

sub shellArgQuote($){
  ($_) = @_;
  s/'/'\\''/g;
  return "'$_'";
}

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 correctScripts{
  unless (-d $newVhostsPath){
    print "Directory $newVhostsPath does not exist.\n";
    return -1;
  }

  *name = *File::Find::name;

  my @files;
  find { push @files, $name if -e } $newVhostsPath;
  foreach my $file (@files){
    next if -d $file;
    next if -B $file;
    my $fh = IO::File->new();
    open($fh,"+<$file") or die "Cannot open file: $file .\n";
    my $out ='';
    while (<$fh>){
      s/$oldVhostsPath/$newVhostsPath/g;
      $out.=$_;
    }
  seek($fh,0,0);
  print $fh $out;
  truncate($fh, tell($fh));
  close($fh);
  }

  return 0;
}

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;
  my $osname = detectOs();
  if ($osname eq 'FreeBSD') {
    foreach my $mountinfo (`mount -p`) {
      chomp $mountinfo;
      my ($device, $mountpoint, $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;
      }
    }
  }elsif ($osname eq 'Linux'){
    foreach my $mountinfo (`mount`) {
      chomp $mountinfo;
      #unable to use 'undef' here - perl 5.004 compatibility
      my ($device, $undef, $mountpoint, $undef, $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;
     }
   }
  }else{
    die "Unknown OS 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, $undef, $free, $undef, $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, $undef, $undef, $undef, $undef, $oldmountpoint) = split /\s+/, $buf;

  $buf = `LANG=C POSIXLY_CORRECT= df -P $newVhostsPath | tail -n +2`;
  my ($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 ($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);
}