#!/usr/bin/perl
#cPanel12 - pkgacct-sXh                           Copyright(c) 2008 cPanel, Inc.
#                                                           All rights Reserved.
# copyright@cpanel.net                                         http://cpanel.net
# This code is subject to the cpanel license. Unauthorized copying is prohibited
# $Desc: v3.0.0-274-g545221d$

package Pkgacct::sXh;

use strict;
use warnings;

use IPC::Open3 ();
use POSIX      ();
use XML::Twig  ();

$|++;

## Set to 1 in production runs, 0 in debugging.
my $useRealFork = 1;

## DEVEL note: so dumpvar.pl is not lost in chrooted env
## cd $homedir  (e.g. /home/accounts/k/i/kingphil)
## mkdir -p usr/lib/perl5/5.8.5
## cp /usr/lib/perl5/5.8.5/dumpvar.pl usr/lib/perl5/5.8.5/dumpvar.pl

__PACKAGE__->script(@ARGV) unless caller();

sub script {
    my ( $class, @argv ) = @_;

    my $user    = $argv[0];
    my $sphuser = $argv[1];
    my $sphpass = $argv[2];
    my $sphhost = $argv[3];
    my %opts    = ( 'skipacctdb' => pop(@argv) eq '--skipacctdb' );

    if ( !getpwnam($user) ) {
        print "Invalid Account\n";
        exit;
    }

    if ( !$sphuser || !$sphpass || !$sphhost ) {
        print "The API user, API password and API host were not given!\n";
        exit;
    }

    my $system = ( POSIX::uname() )[0];

    if ( $user eq "root" ) {
        print "You cannot copy the root user.\n";
        exit;
    }

    my $hostdir   = hostdir();
    my $formatter = "$hostdir/open_api/formatter";

    set_sph_auth( $sphuser, $sphpass );
    set_sph_formater( $formatter, $sphhost );

    my ( $orig_homedir, $dns, $usePerlChroot ) = basic_info($user);

    my $plugins        = get_plugins($user);
    my $zone_data      = get_dnszone_data( $user, $dns );
    my $mail_aliases   = get_mail_aliases($user);
    my $main_user_data = get_main_user_data($user);
    my $user_data      = get_user_data($user);

    if ( $dns eq "" ) {
        print "Unable to find domain name for $user\n";
        exit;
    }

    my $homedir;
    if ($usePerlChroot) {
        if ( chdir($orig_homedir) ) {
            chroot($orig_homedir);
            $homedir = "/home/${user}";
        }
    }
    else {
        print "Assuming chroot enviroment for user $user\n";
        $homedir = $orig_homedir;
    }

    my $tarroot = find_tarroot();
    my $prefix  = 'cpmove-';

    my $work_dir = "${tarroot}/${prefix}${user}";

    if ( -d $work_dir && !-l $work_dir ) {
        system( "rm", "-rf", $work_dir );
    }
    if ( -f "$work_dir.tar.gz" && !-l "$work_dir.tar.gz" ) {
        system( "rm", "-rf", "$work_dir.tar.gz" );
    }

    if ( !-e $work_dir ) {
        mkdir( $work_dir, 0700 );
        foreach my $dir (
            'cp',       'logs',     'mysql',   'psql', 'mm', 'mma', 'mma/pub', 'mma/priv', 'va', 'vad', 'fp', 'vf', 'homedir', 'homedir/etc', 'homedir/mail', 'homedir/public_html', 'meta', 'cron',
            'dnszones', 'sslcerts', 'sslkeys', 'fp'
          ) {
            system( 'mkdir', '-p', "$work_dir/$dir", 0700 );
        }
    }
    else {
        print "$work_dir exists, please remove it and try again\n";
        exit;
    }

    print "Create cpuser file...";
    if ( open( my $fh, '>', "${work_dir}/cp/${user}" ) ) {
        print {$fh} "DNS=${dns}\n";
        print {$fh} "STARTDATE=" . time() . "\n";
        close $fh;
    }
    print "Done\n";

### copying DNS zone
    print "pXa Grabbing DNS Zone...";
    $zone_data = build_zone( $user, $dns, $zone_data );
    if ($zone_data) {
        if ( open( my $fh, '>', "$work_dir/dnszones/$dns" ) ) {
            print {$fh} $zone_data;
            close($fh);
        }
    }
    print 'Done' . "\n";

    print "Copying homedir....";
    if ( $useRealFork and my $pid = fork() ) {
        my $dotcount = 5;
        while ( waitpid( $pid, 1 ) != -1 ) {
            if ( $dotcount % 5 == 0 ) {
                print ".........\n";
            }
            sleep(1);
            $dotcount++;
        }
    }
    else {
        if ( chdir($homedir) ) {
            system("tar -cf - . | ( cd $work_dir/homedir; tar -xf - )");
        }
        elsif ( chdir('/home') ) {
            system("tar --exclude=${prefix}* -cf - . | ( cd $work_dir/homedir; tar -xf - )");
        }
        else {
            print "Could not find home dir\n";
        }
        my $wwwdir = "/www/htdocs";
        if ( chdir($wwwdir) ) {
            system("tar -cf - . | ( cd $work_dir/homedir/public_html; tar -xf - )");
        }
        exit if $useRealFork;
    }
    print "Done\n";

### Grab crontab
    print "pXa Grabbing crontab for....";
    my $crontab = "/var/spool/cron/$user";
    if ( open( my $fh, '>', "$work_dir/cron/$user" ) ) {
        if ( open( my $cron_h, '<', $crontab ) ) {
            my $start = 1;
            while ( my $line = <$cron_h> ) {
                $start = 0 if $line =~ /do not remove/;
                print {$fh} $line if $start;
                $start = 1 if $line =~ /^[\#]+$/;
            }
        }
    }
    print 'Done' . "\n";

    print "Copying password...";

    if ( open( my $fh, '>', "$work_dir/shadow" ) ) {
        print {$fh} $main_user_data->{'password'} . "\n";
        close $fh;
    }
    print "Done\n";

    my ( $domains, $loc_map ) = domains($dns);

    print "Setup addon and subdomains...\n";
    foreach my $addon ( keys %{$domains} ) {
        if ( $addon ne $dns ) {
            subdomains(
                {
                    domain  => $addon,
                    locmap  => $loc_map,
                    workdir => $work_dir,
                    dns     => $dns,
                    type    => 'addon',
                }
            );
        }

        foreach my $subdomain ( @{ $domains->{$addon} } ) {
            subdomains(
                {
                    domain  => $subdomain,
                    locmap  => $loc_map,
                    workdir => $work_dir,
                    dns     => $addon,
                    type    => 'subdomain',
                }
            );
        }
    }
    print "Done\n";

    print 'Copying mail...' . "\n";
    mkdir("$work_dir/homedir/mail/$dns");
    mkdir("$work_dir/homedir/etc/$dns");
    my $inbox = '/var/spool/mail/' . $user;
    if ( -e $inbox ) {
        system( 'cp', $inbox, "$work_dir/homedir/mail/$dns/inbox" );
        if ( open( my $passwd_h, '>', "$work_dir/homedir/etc/$dns/passwd" ) ) {
            if ( open( my $shadow_h, '>', "$work_dir/homedir/etc/$dns/shadow" ) ) {
                print {$passwd_h} "$user:x:-1:-1::/home/$user/mail/$dns/$user:/usr/local/cpanel/bin/noshell\n";
                print {$shadow_h} "$user:$main_user_data->{'password'}:-1:-1:::::\n";
            }
        }
    }

    if ( open( my $passwd_h, '>>', "$work_dir/homedir/etc/$dns/passwd" ) ) {
        if ( open( my $shadow_h, '>>', "$work_dir/homedir/etc/$dns/shadow" ) ) {
            foreach my $email_user ( keys %$user_data ) {

                my $user_email = '/var/spool/mail/' . $email_user;
                mkdir("$work_dir/homedir/mail/$dns/$email_user");
                if ( -e $user_email ) {
                    system( 'cp', $user_email, "$work_dir/homedir/mail/$dns/$email_user/inbox" );
                }

                if ( -e $user_data->{$email_user} ) {
                    opendir( my $dir_h, $user_data->{$email_user}->{'vdirectory'} );
                    my @files = map { "$user_data->{$email_user}->{'vdirectory'}/$_" } grep { !/^\.\.?/ } readdir $dir_h;
                    foreach my $file (@files) {
                        next if !$file;
                        next if $file && !-e $file;
                        system( 'cp', '-R', $file, "$work_dir/homedir/mail/$dns/$email_user/" );
                    }
                }

                print {$passwd_h} "$email_user:x:-1:-1::/home/$user/mail/$dns/$email_user:/usr/local/cpanel/bin/noshell\n";
                print {$shadow_h} "$email_user:$user_data->{$email_user}->{'password'}:-1:-1:::::\n";
            }
            close $shadow_h;
        }
        close $passwd_h;
    }
    print "Done\n";

    print "Copying mail aliases...\n";
    mail_aliases( $mail_aliases, $dns, $work_dir );
    print "Done\n";

    print "Copying FTP users...\n";

    if ( open( my $fh, '>', "$work_dir/proftpdpasswd" ) ) {
        foreach my $ftp_user ( keys %{$user_data} ) {
            next if $user_data->{$ftp_user}->{'ftp_enabled'} ne 'true';
            print {$fh} "$ftp_user:$user_data->{$ftp_user}->{'password'}:-1:-1::/dev/null:/bin/ftpsh\n";
        }
        close $fh;
    }

    print "Done";

    plugins( $plugins, $user, $dns, $work_dir, \%opts );

    if ( chdir("${tarroot}") ) {
        print "Creating Archive ....";
        my $parts    = [];
        my $splitdir = "${work_dir}-split";

        mkdir $splitdir;

        $parts = splittar(
            {
                source      => "${prefix}${user}",
                destination => $splitdir,
                tarname     => "${prefix}${user}",
                splitname   => "${prefix}${user}.tar.gz",
            }
        );

        if ( -d $work_dir && !-l $work_dir ) {
            system( "rm", "-rf", $work_dir );
        }
        print "Done\n";

        my $path;
        ## FIXME: might read better as "if ($usePerlChroot)"
        if ( $orig_homedir eq $homedir ) {
            $path = "${splitdir}";
        }
        else {
            $path = "${orig_homedir}${splitdir}";
        }

        print "realusername is: $user\n";
        foreach my $part ( @{$parts} ) {
            print "splitpkgacctfile is: $path/$part\n";
            my $md5sum = md5( "$splitdir/$part", $system );
            print "splitmd5sum is: $md5sum\n";
        }
    }
}

sub basic_info {
    my ($user) = @_;

    my $main_user = <<XML;
<API>
<CMD
keys_path="sphera\\accounts\\$user"
cmd="get"
/>
</API>
XML

    my @stash;
    my $results = sph_get($main_user);

    if ( $results->{'status'} ) {
        push @stash, $results->{'data'}->[0]->{'directory'}, $results->{'data'}->[0]->{'domain'};
    }
    else {
        die "Failed Open API call";
    }

    push @stash, 1;    # usePerlChroot
    return @stash;
}

{
    my $hostdir;

    sub hostdir {
        return $hostdir if $hostdir;
        my $scripts = `rpm -q ServerDirector --scripts`;
        my $conf    = '';
        foreach my $line ( split /\n/, $scripts ) {
            if ( $line =~ /\s+(\/.*sphera.conf)/ ) {
                $conf = $1;
                last;
            }
        }

        if ( open( my $fh, '<', $conf ) ) {
            $hostdir = ( split /\s/, <$fh> )[1];
        }
        die "Unable to find hostdir" if !$hostdir;
        return $hostdir;
    }
}

sub find_tarroot {
    my ($tarroot) = @_;
    if ( $tarroot || !-d $tarroot ) {
        $tarroot = '/home';
    }
    return $tarroot;
}

sub my_cnf {
    my ($homedir) = @_;
    my $my_cnf = "/etc/my.cnf";

    my $stash = {};
    if ( open( my $fh, '<', $my_cnf ) ) {
        my $section;
        while ( my $line = <$fh> ) {
            chomp($line);
            next if $line =~ /^\#/;
            if ( $line =~ /^\[(.*?)\]/ ) {
                $section = $1;
            }
            if ( $line =~ /(\S+)\s*=\s*(\S+)/ ) {
                $stash->{$section}->{$1} = $2;
            }
        }
    }
    return $stash;
}

sub mysql_databases {
    my $datadir = '/var/lib/mysql';
    opendir( my $mysql_h, $datadir );

    my @databases = grep { -d "$datadir/$_" } grep { $_ ne 'mysql' } grep { !/^\.\.?/ } readdir $mysql_h;
    return \@databases;
}

sub mysqldumpdb {
    my ($args) = @_;

    my $mysqladmin = '/usr/bin/mysqldump';

    my @options = @{ $args->{'options'} };
    my $db      = $args->{'db'};
    my $file    = $args->{'file'};

    my $pid = IPC::Open3::open3( my $w, my $r, my $err, $mysqladmin, @options, $db );

    if ( open my $fh, '>', $file ) {
        use bytes;
        while ( my $line = <$r> ) {
            print {$fh} $line;
        }
    }
    close $w;
    close $r;
    waitpid( $pid, 0 );
}

sub splittar {
    my ($args) = @_;

    my $source      = $args->{'source'};
    my $destination = $args->{'destination'};
    my $tarname     = $args->{'tarname'};
    my $splitname   = $args->{'splitname'};

    if ( -d $source ) {
        mkdir( $destination, 0700 );
        rename( $source, "$destination/$tarname" );
        chdir($destination) || die 'Unable to change into ' . $destination;
    }
    else {
        die 'The source: ' . $source . ' is not a directory';
    }

    my ( $pid, $it ) = make_splitfile_iter(
        {
            read_limit  => 3000000,
            bytes_limit => 10000000,
            dir         => $tarname,
        }
    );

    my $count = 1;
    while ( my $chunk = $it->() ) {
        my $file = sprintf( "%s%05d", "$splitname.part", $count );
        if ( open( my $fh, '>', $file ) ) {
            print {$fh} $chunk;
            $count++;
            close $fh;
        }
        print '.......' . "\n";
    }

    waitpid $pid, 0;
    system( 'rm', '-rf', $tarname );
    opendir( my $dir_h, $destination );
    my @files = grep { !/^\.\.?$/ } readdir $dir_h;
    return \@files;
}

sub make_splitfile_iter {
    my ($args)      = @_;
    my $read_limit  = $args->{'read_limit'};
    my $bytes_limit = $args->{'bytes_limit'};
    my $dir         = $args->{'dir'};

    my $pid = IPC::Open3::open3( my $tar_w, my $tar_r, my $tar_e, 'tar', 'pcz', $dir );
    if ($pid) {
        close $tar_w;
        return (
            $pid,
            sub {
                my $store;
                my $bytes = 0;
                while ( my $bytes_read = read( $tar_r, my $buffer, $read_limit ) ) {
                    $bytes += $bytes_read;
                    $store .= $buffer;
                    if ( $bytes > $bytes_limit ) {
                        return $store;
                    }
                    elsif ( eof($tar_r) ) {
                        return $store;
                    }
                }
            }
        );
    }
}

sub md5 {
    my ( $file, $system ) = @_;
    my $md5sum;

    if ( $system =~ /freebsd/i ) {
        chomp( $md5sum = `md5 -r "$file"` );
    }
    else {
        chomp( $md5sum = `md5sum "$file"` );
    }
    $md5sum =~ /^(\S+)[\s|\t]*/;
    $md5sum = $1;
    return $md5sum;
}

sub find_email_users {
    ## FIXME?: I am not seeing this file in the /etc or chrooted/etc. Maybe chrooted/etc/mail/virt*?
    my $dir = '/etc/virt_users';
    opendir( my $dir_h, $dir );
    my @users = grep { !/^\.\.?/ } readdir($dir_h);
    return \@users;
}

sub mail_aliases {
    my ( $data, $dns, $work_dir ) = @_;

    if ( open( my $fh, '>', "$work_dir/va/$dns" ) ) {
        foreach my $line (@$data) {
            print {$fh} $line . "\n";
        }
        close $fh;
    }
}

sub get_mail_aliases {
    my ($user) = @_;

    my $mail_aliases = <<XML;
<API>
  <CMD
    cmd="getlist"
    keys_path="sphera\\accounts\\${user}\\aliases"
  />
</API>
XML

    my $aliases = sph_get($mail_aliases);

    my @aliases = ();

    foreach my $alias ( @{ $aliases->{'data'} } ) {
        if ( $alias->{'aliastype'} eq 'Email' ) {
            push @aliases, "$alias->{'destination'}: $user";
        }
        elsif ( $alias->{'aliastype'} eq 'Distribution List' ) {
            push @aliases, "$alias->{'key'}: $alias->{'destination'}";
        }
    }

    return \@aliases;
}

sub domains {
    my ( $dns, $conf_file ) = @_;
    $conf_file ||= '/etc/httpd/conf/httpd.conf';

    my $httpd_data = do {
        local $/;
        open( my $fh, '<', $conf_file );
        scalar <$fh>;
    };

    my $stash = {};
    ## fix: the regex allows for <VirtualHost> tag to be indented
    ## fix: the ? after [^#] was subtlely wrong; I *think* what we want is a negative assertion
    ##   on one-or-more # characters.
    while (
        $httpd_data =~ /^\s*(?!\#+)\s*                # No match if the <VirtualHost starts with a \#
                        <VirtualHost\s(?:.+?)>    # Find a VirtualHost opening tag
                        (.*?)                     # The data between the tags
                        <\/VirtualHost>           # Close tag
                       /xmsg
      ) {
        my $chunk = $1;
        chomp($chunk);
        next if !$chunk;
        $chunk =~ s/^\s*//;
        $chunk =~ s/[\s]{2,}/\n/g;

        my $server_name   = _process_chunk( $chunk, 'ServerName' );
        my $document_root = _process_chunk( $chunk, 'DocumentRoot' );

        next if $server_name eq $dns;

        next if !$server_name;
        $stash->{$server_name} = $document_root;
    }

    my @index = map { $_->[0] }
      sort { $a->[1] cmp $b->[1] }
      map { [ $_, rdomain($_) ] } $dns, keys %$stash;

    my $main = find_subs(@index);

    return ( $main, $stash );

}

sub find_subs {
    my (@list) = @_;
    return _subs_helper( head(@list), tail(@list), {} );
}

sub _subs_helper {
    my ( $head, $tail, $hold ) = @_;

    if ( $head && $tail->[0] && $tail->[0] =~ /\.$head$/ ) {
        push @{ $hold->{$head} }, $tail->[0];
        return _subs_helper( $head, tail(@$tail), $hold );
    }
    elsif ($head) {
        _subs_helper( head(@$tail), tail(@$tail), $hold );
    }
    elsif ( !@$tail ) {
        return $hold;
    }
}

sub head {
    my (@list) = @_;
    return shift @list;
}

sub tail {
    my (@list) = @_;
    shift @list;
    return \@list;
}

sub rdomain {
    my ($domain) = @_;
    return join '.', reverse split /\./, $domain;
}

sub _process_chunk {
    my ( $chunk, $key ) = @_;
    my @lines = split /\n/, $chunk;

    foreach my $line (@lines) {
        if ( $line =~ /$key/ ) {
            my ( undef, $domain ) = split /\s/, $line, 2;
            return $domain;
        }
    }
}

sub mysql_query {
    my ($cmd) = @_;
    my $result;
    my $wtrfh;
    my $rdrfh;
    my $mysql = find_mysql();
    if ( -e $mysql ) {
        my $pid = IPC::Open3::open3( $wtrfh, $rdrfh, $rdrfh, $mysql, 'mysql', '-N' );
        print {$wtrfh} "$cmd\n";
        close($wtrfh);
        local $/;
        $result = readline($rdrfh);
        waitpid( $pid, 0 );
    }
    return $result;
}

sub find_mysql {
    my ($self) = @_;
    my ( @LOC, $loc );
    @LOC = ( "/usr/bin/mysql", "/usr/sbin/mysql", "/usr/local/bin/mysql" );
    foreach $loc (@LOC) {
        if ( -e $loc ) {
            return $loc;
        }
    }
}

sub subdomains {
    my ($args) = @_;

    my $domain   = $args->{'domain'};
    my $work_dir = $args->{'workdir'};
    my $loc_map  = $args->{'locmap'};
    my $dns      = $args->{'dns'};
    my $type     = $args->{'type'};

    my $sub = $domain;
    $sub =~ s/\.$dns//;

    if ( $type eq 'addon' ) {
        my @sub = split /\./, $sub;
        pop @sub;
        $sub = join ".", @sub;
    }

    my $subdomain = $sub . '_' . $dns;
    if ( open( my $fh, '>>', "$work_dir/sds" ) ) {
        print {$fh} $subdomain . "\n";
        close $fh;
    }

    if ( open( my $fh, '>>', "$work_dir/sds2" ) ) {
        my $documentroot = $loc_map->{$domain};
        if ( -e $documentroot ) {

            my $path;
            if ( $type eq 'addon' ) {
                $path = "$work_dir/homedir/public_html/$sub";
                mkdir $path, 0751;
            }
            else {
                $path = "$work_dir/homedir/public_html/$dns/$sub";
                system 'mkdir', '-p',   $path;
                system 'chmod', '0751', $path;
            }

            if ( -e $documentroot ) {
                system("cp -ra $documentroot/ $path");
            }

            my @parts = split /public_html\//, $path, 2;
            print {$fh} "$subdomain=public_html/$parts[1]\n";
            close $fh;
        }
    }

    if ( $type eq 'addon' ) {
        if ( open( my $fh, '>>', "$work_dir/addons" ) ) {
            print {$fh} "$domain=$subdomain\n";
            close $fh;
        }
    }
}

sub build_zone {
    my ( $user, $dns, $dns_zone ) = @_;

    my $zone_txt;
    my $email = $dns_zone->{'ZONE'}{'email'};
    $email =~ s/\@/\./;

    $zone_txt = sprintf <<EOT, $dns_zone->{'ZONE'}{'ttl'}, $dns_zone->{'ZONE_DATA'}{'NS'}[0]{'destination'}, $email, $dns_zone->{'ZONE'}{'serial'}, $dns_zone->{'ZONE'}{'refresh'}, $dns_zone->{'ZONE'}{'retry'}, $dns_zone->{'ZONE'}{'expire'}, $dns_zone->{'ZONE'}{'minimum'};
\$TTL\t%s

@\tIN\tSOA\t%s %s (
\t\t\t%d\t; Serial
\t\t\t%s\t; Refresh
\t\t\t%s\t; Retry
\t\t\t%s\t; Expire
\t\t\t%s )\t; Minimum
EOT

    foreach my $ns ( @{ $dns_zone->{'ZONE_DATA'}{'NS'} } ) {
        $zone_txt .= sprintf "%s\t\tIN NS\t%s\n", $ns->{'destination'};
    }

    foreach my $mx ( @{ $dns_zone->{'ZONE_DATA'}{'MX'} } ) {
        $zone_txt .= sprintf "%s.\t\tIN MX\t%s %s\n", $dns, $mx->{'preference'}, $mx->{'destination'};
    }

    foreach my $a ( @{ $dns_zone->{'ZONE_DATA'}{'A'} } ) {
        next unless exists $a->{'name'};
        $zone_txt .= sprintf "%s\t\tIN A\t%s\n", $a->{'name'}, $a->{'destination'};
    }

    foreach my $cname ( @{ $dns_zone->{'ZONE_DATA'}{'CNAME'} } ) {
        $zone_txt .= sprintf "%s\t\tIN CNAME\t%s\n", $cname->{'name'}, $cname->{'destination'};
    }

    return $zone_txt;
}

sub get_main_user_data {
    my ($user) = @_;

    my $main_user = <<XML;
<API>
  <CMD
    keys_path="sphera\\accounts\\$user"
    cmd="get"
  />
</API>
XML

    my $hash = {};
    my $data = sph_get($main_user);

    return $data->{data}->[0];

}

sub get_user_data {
    my ($user) = @_;

    my $user_accounts = <<XML;
<API>
  <CMD
    cmd="getlist"
    keys_path="sphera\\accounts\\$user\\user_accounts"
  />
</API>
XML

    my $hash = {};
    my $data = sph_get($user_accounts);

    foreach my $node ( @{ $data->{'data'} } ) {
        $hash->{ $node->{'name'} } = $node;
    }

    return $hash;
}

sub get_dnszone_data {
    my ( $user, $dns ) = @_;

    my $domains = <<XML;
<API>
  <CMD
    cmd="getlist"
    keys_path="sphera\\accounts\\$user\\domains"
  />
</API>
XML

    my $dns_headers = <<XML;
<API>
  <CMD
    cmd="getlist"
    keys_path="$user\\dns\\header"
  />
</API>
XML

    my $dns_zone = <<XML;
<API>
  <CMD
    cmd="getlist"
    keys_path="sphera\\accounts\\$user\\dns\\details"
  />
</API>
XML
    my $stash = {};

    $stash->{'DOMAINS'}   = dns_domains($domains);
    $stash->{'ZONE'}      = zone($dns_headers);
    $stash->{'ZONE_DATA'} = zone_data( $dns_zone, $dns );
    return $stash;

}

sub zone {
    my ($xml) = @_;
    my $zone = sph_get($xml);

    my $header = $zone->{'data'}->[0];

    $header->{'serial'} = 1;
    delete $header->{'type'};
    delete $header->{'keys_path'};
    delete $header->{'key'};

    return $header;
}

sub dns_domains {
    my ($xml) = @_;
    my $domains = sph_get($xml);

    my $store = { primary => '', other => [] };
    foreach my $data ( @{ $domains->{'data'} } ) {
        if ( $data->{'primary'} eq 'true' ) {
            $store->{'primary'} = $data->{'name'};
        }
        else {
            push @{ $store->{'other'} }, $data->{'name'};
        }
    }
    return $store;
}

sub zone_data {
    my ( $xml, $dns ) = @_;
    my $zone_data = sph_get($xml);

    my $store = { A => [], NS => [], CNAME => [], MX => [] };
    foreach my $data ( @{ $zone_data->{'data'} } ) {
        next if !$data->{'rec_type'};
        my $key = $data->{'rec_type'};

        if ( $key eq 'A' ) {
            push @{ $store->{$key} },
              {
                destination => $data->{'address'},
                name        => $data->{'name'},
              };
        }
        elsif ( $key eq 'NS' ) {
            push @{ $store->{$key} },
              {
                destination => $data->{'servers_name'},
                name        => $data->{'name'},
              };
        }
        elsif ( $key eq 'MX' ) {
            push @{ $store->{$key} },
              {
                preference  => $data->{'preference'},
                name        => $data->{'name'},
                destination => $data->{'mail'},
              };
        }
        elsif ( $key eq 'CNAME' ) {
            my $destination;
            if ( $data->{'cname'} eq '@' ) {
                $destination = $dns . '.';
            }
            else {
                $destination = $data->{'cname'};
            }

            push @{ $store->{$key} },
              {
                destination => $destination,
                name        => $data->{'name'},
              };
        }
    }
    return $store;
}

sub get_plugins {
    my ($user) = @_;

    return sph_get(
        qq{
<API>
  <CMD 
    cmd="getrecursive" 
    keys_path="$user\\plugins"
  />
</API>
    },
        sub {
            my ($node) = @_;
            if ( exists $node->{'att'}->{'_plugin_status'} && exists $node->{'att'}->{'enable'} && $node->{'att'}->{'_plugin_status'} eq 'installed' && $node->{'att'}->{'enable'} eq 'true' ) {
                return $node->{'att'};
            }
        }
    );
}

sub plugins {
    my ( $stash, $user, $dns, $work_dir, $opts ) = @_;
    my $hash = plugin_hash( $user, $dns, $work_dir, $opts );
    foreach my $node ( @{ $stash->{'data'} } ) {
        my $name = $node->{'va_name'};
        if ( exists $hash->{$name} && ref $hash->{$name} eq 'CODE' ) {
            $hash->{$name}->($node);
        }
        elsif ( !exists $hash->{$name} ) {
            print "\n\n$name is not supported for transfer yet.\n\n";
        }
    }
}

sub plugin_hash {
    my ( $user, $dns, $work_dir, $opts ) = @_;
    return {
        'PhpMyAdmins'    => 1,
        'Perls'          => 1,
        'Mod_phps'       => 1,
        'Mod_perl'       => 1,
        'PerlMySQLs'     => 1,
        'FrontPages2002' => sub {
            my ($va) = @_;
            print 'Copy FrontPage config...' . "\n";
            system( 'cp', '/usr/local/frontpage/we80.cnf',  "$work_dir/fp/www.${dns}:80.cnf" )  if -e '/usr/local/frontpage/we80.cnf';
            system( 'cp', '/usr/local/frontpage/we443.cnf', "$work_dir/fp/www.${dns}:443.cnf" ) if -e '/usr/local/frontpage/we443.cnf';
            print 'Done.' . "\n";
        },
        'MySQLs' => sub {
            return if $opts->{'skipacctdb'};

            print "Copying MySQL privileges...\n";
            if ( open( my $fh, '>>', "$work_dir/mysql.sql" ) ) {
                my @mysql_users = split( /\n/, mysql_query('SELECT user from user') );
                foreach my $mysql_user (@mysql_users) {
                    next if !$mysql_user;
                    my $grant_line = mysql_query("SHOW GRANTS FOR $mysql_user\@localhost");

                    print {$fh} $grant_line;
                }
                open $fh;
            }
            print "Done\n";

            print "Copying MySQL databases...\n";
            my $dbs = mysql_databases();
            foreach my $db (@$dbs) {
                mysqldumpdb( { options => [ '-c', '-Q', '-q', '-t' ], db => $db, file => "${work_dir}/mysql/${db}.sql" } );
            }
            print "Done\n";

        },
    };
}

sub sph_get {
    my ( $cmd, $code ) = @_;
    my $xml = api_call($cmd);

    my $status = 0;
    my $stash  = [];
    my $twig   = XML::Twig->new(
        twig_handlers => {
            RESPONSE => sub {
                my ( $twig, $res ) = @_;
                if ( $res->att('result') eq 'OK' ) {
                    $status = 1;
                    my @nodes = $res->children;
                    foreach my $node (@nodes) {
                        if ( ref $code eq 'CODE' ) {
                            my $att = $code->($node);
                            push @$stash, $att if $att;
                        }
                        else {
                            push @$stash, $node->{'att'};
                        }
                    }
                }
            },
        },
    );

    eval { $twig->parse($xml); };

    if ( my $err = $@ ) {
        print "Error connecting to the API!\n";
        exit;
    }

    return { status => $status, data => $stash };
}

sub api_call {
    my ($cmd) = @_;

    my ( $sph_user, $sph_pass ) = get_sph_auth();

    local $ENV{'SPH_USER'}   = $sph_user;
    local $ENV{'SPH_PASSWD'} = $sph_pass;

    my ( $formatter_path, $sphera_host ) = get_sph_formater();

    my $pid = IPC::Open3::open3( my $w, my $r, '', $formatter_path, '-h', $sphera_host, '-cmd', $cmd );
    close $w;

    my $output;
    while (<$r>) {
        $output .= $_;
    }

    close $r;
    waitpid( $pid, 0 );

    return $output;
}

{
    my $sph_user;
    my $sph_pass;
    my $sph_formater;
    my $sph_host;

    sub set_sph_auth {
        ( $sph_user, $sph_pass ) = @_;
    }

    sub get_sph_auth {
        return ( $sph_user, $sph_pass );
    }

    sub set_sph_formater {
        ( $sph_formater, $sph_host ) = @_;
    }

    sub get_sph_formater {
        return ( $sph_formater, $sph_host );
    }
}

1;