#!/usr/bin/perl
# cpanel12 - pkgacct-da                           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$

use strict;
use warnings;

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

$|++;

script(@ARGV) unless caller();

sub script {
    my (@argv) = @_;

    my $user = $argv[0];

    my $nosplit = 0;
    if ( $argv[1] && $argv[1] eq '--nosplit' ) {
        $nosplit = 1;
    }

    my $cpuser = clean_username($user);
    my $system = OS();

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

    my $tarroot    = find_tarroot( $argv[1] );
    my $prefix     = 'cpmove-';
    my $skipacctdb = pop(@argv) eq '--skipacctdb';

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

    my $homedir = ( getpwnam($user) )[7];

    if ( -l $homedir ) {
        $homedir = readlink($homedir);
    }

    my $user_conf = get_user_config($user);
    my $dns       = $user_conf->{'domain'};

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

    print "DA DNS is $dns\n";

    my $parkeddomains = get_parkeddomains($user);
    my $work_dir      = "${tarroot}/${prefix}${cpuser}";

    if ( $prefix ne "" ) {
        if ( -d $work_dir && !-l $work_dir ) {
            remove($work_dir);
        }
        if ( -f "${work_dir}.tar.gz" && !-l "${work_dir}.tar.gz" ) {
            remove("${work_dir}.tar.gz");
        }
    }

    if ($nosplit) {
        open( my $cpm, '>', "${work_dir}.tar.gz" );
        close($cpm);
        chmod( 0600, "${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', 'meta', 'vad', 'dnszones', 'sslcerts', 'sslkeys' ) {
            mkdir( "$work_dir/$dir", 0700 );
        }
    }
    else {
        print "$work_dir exists, please remove it and try again\n";
        exit;
    }

    print "DA Copying homedir....";
    fork_code(
        {
            wait   => 1,
            dots   => 1,
            stdout => 1,
            code   => sub {
                tarcopy( $homedir, "$work_dir/homedir" );
                remove("$work_dir/homedir/mail");
                remove("$work_dir/homedir/imap");
                remove("$work_dir/homedir/public_html");

                mkdir( "$work_dir/homedir/etc",  0700 );
                mkdir( "$work_dir/homedir/mail", 0700 );

                my $public_html = $homedir . '/public_html';
                while ( -l $public_html ) {
                    $public_html = readlink($public_html);
                }
                diskcheck();
                copy( $public_html, "$work_dir/homedir/public_html" );

                if ( !tarcopy( "$work_dir/homedir/domains/$dns/public_html", "$work_dir/homedir/public_html" ) ) {
                    print "Unable to copy homedir!\n";
                }
            },
        }
    );

    print 'Done' . "\n";

    print "Setup Domains...\n";
    my $domains = get_all_domains($user);
    my @other_domains = grep { $dns ne $_ } @{$domains};
    if ( open( my $sub_h, '>>', "$work_dir/sds" ) ) {
        foreach my $other_domain (@other_domains) {
            my $sub;
            ( $sub = $other_domain ) =~ s/^(\w+)\./$1/;
            my $subdomain = $sub . '_' . $dns;
            print {$sub_h} "$subdomain\n";

            if ( open( my $sub2_h, '>>', "$work_dir/sds2" ) ) {
                print {$sub2_h} "$subdomain=domains/$other_domain/public_html\n";
                close $sub2_h;
            }
            if ( open( my $addon_h, '>>', "$work_dir/addons" ) ) {
                print {$addon_h} "$other_domain=$subdomain\n";
                close $addon_h;
            }
        }
        close $sub_h;
    }
    print "Done\n";

    if ( open( my $sub_h, '>>', "$work_dir/sds" ) ) {
        print 'Storing Subdomains....';
        my $subdomains = get_subdomains($user);
        foreach my $subdomain ( keys %{$subdomains} ) {
            print {$sub_h} $subdomain . '_' . $subdomains->{$subdomain} . "\n";
        }
        close $sub_h;

        if ( open( my $sub2_h, '>>', "$work_dir/sds2" ) ) {
            foreach my $subdomain ( keys %{$subdomains} ) {
                my $domain = $subdomains->{$subdomain};
                print {$sub2_h} "${subdomain}_" . $domain . "=public_html/$subdomain\n";
            }
            close $sub2_h;
        }
        print 'Done' . "\n";
    }

    if ( open( my $park_h, '>', "$work_dir/pds" ) ) {
        print 'Storing Parked domains....';
        foreach my $parked ( @{$parkeddomains} ) {
            print {$park_h} $parked->[0] . "\n";
            if ( open( my $domal, '>', "$work_dir/vad/$parked->[0]" ) ) {
                print {$domal} "$parked->[0]: $dns\n";
                close $domal;
                write_htaccess( $parked, "$work_dir/homedir/public_html" );
            }
        }
        close $park_h;
        print 'Done' . "\n";
    }

    if ( -e "/etc/virtual" ) {
        print 'Storing mail aliases....';
        $domains = get_all_domains($user);
        my $parked = get_parkeddomains($user);

        foreach my $domain ( @{$domains}, @{$parked} ) {
            if ( -e "/etc/virtual/$domain/aliases" ) {
                copy( "/etc/virtual/$domain/aliases", "$work_dir/va/$domain" );
                rewrite_aliases( $domain, "$work_dir/va/$domain" );
            }
        }
        print "Done\n";
    }

    if ( -e "/usr/local/frontpage/www.${dns}:80.cnf" ) {
        print "Copying frontpage file....";
        copy( "/usr/local/frontpage/www.${dns}:80.cnf", "$work_dir/fp" );
        print "Done\n";
    }

    my @all_users = ();
    print "DA Copying mail....";
    if ( -e "/home/$user/Maildir" ) {
        system( 'mkdir', '-p', "$work_dir/homedir/mail/" );
        tarcopy( "/home/$user/Maildir", "$work_dir/homedir/mail/" );
        system( 'rm', '-rf', "$work_dir/homedir/Maildir" );
    }

    $domains = get_all_domains($user);
    my $daconf  = daconf();
    my $spoolon = 0;
    foreach my $domain ( @{$domains} ) {

        if ( $spoolon && exists $daconf->{'emailspoolvirtual'} && -e $daconf->{'emailspoolvirtual'} ) {
            if ( -e $daconf->{'emailspoolvirtual'} . "/$domain" ) {
                mkdir( "$work_dir/homedir/mail/$domain", 0750 );

                opendir( my $dir_h, $daconf->{'emailspoolvirtual'} . "/$domain" );
                my %accounts = map { $_ => $daconf->{'emailspoolvirtual'} . "/$domain/$_" } grep { !/^\.\.?$/ } readdir $dir_h;

                foreach my $account ( keys %accounts ) {
                    mkdir( "$work_dir/homedir/mail/$domain/$account", 0750 );
                    copy( $accounts{$account}, "$work_dir/homedir/mail/$domain/$account/inbox" );
                }
            }

            mkdir( "$work_dir/homedir/etc/$domain", 0700 );
            if ( open( my $passwd_h, '>>', "$work_dir/homedir/etc/$domain/passwd" ) ) {
                if ( open( my $shadow_h, '>>', "$work_dir/homedir/etc/$domain/shadow" ) ) {
                    my @ids    = getpwnam($user);
                    my $passwd = get_email_user_pass($domain);
                    foreach my $pass ( @{$passwd} ) {
                        my $pw_user = $pass->[0];
                        my $pw_pass = $pass->[1];
                        print {$passwd_h} "$pw_user:x:-1:-1::/home/$user/mail/$domain/$pw_user:/usr/local/cpanel/bin/noshell\n";
                        print {$shadow_h} "${pw_user}:${pw_pass}:-1:-1:::::\n";
                    }
                    close $shadow_h;
                }
                close $passwd_h;
            }

            next;
        }

        if ( -e "/home/$user/mail" ) {
            my $domain_mail_dir = "/home/$user/mail/$domain";
            while ( -l $domain_mail_dir ) {
                $domain_mail_dir = readlink($domain_mail_dir);
            }
            opendir( my $email_h, $domain_mail_dir );
            my @files = readdir($email_h);
            close $email_h;
            @files = grep !/^\.\.?/, @files;

            foreach my $file (@files) {
                chomp($file);
                push @all_users, $file . '@' . $domain;
                mkdir( "$work_dir/homedir/mail/$domain",       0700 );
                mkdir( "$work_dir/homedir/mail/$domain/$file", 0700 );
                copy( "$domain_mail_dir/$file", "$work_dir/homedir/mail/$domain/$file/inbox" );
            }
        }

        if ( -e "/home/$user/imap" ) {
            my $domain_mail_dir = "/home/$user/imap/$domain";
            while ( -l $domain_mail_dir ) {
                $domain_mail_dir = readlink($domain_mail_dir);
            }
            opendir( my $email_h, $domain_mail_dir );
            my @files = readdir($email_h);
            close $email_h;
            @files = grep !/^\.\.?$/, @files;

            foreach my $file (@files) {
                chomp($file);
                push @all_users, $file . '@' . $domain;
                mkdir( "$work_dir/homedir/mail/$domain", 0700 );
                diskcheck();
                if ( -e "$domain_mail_dir/$file/Maildir" ) {
                    system( 'mkdir', '-p', "$work_dir/homedir/mail/$domain/$file" );
                    tarcopy( "$domain_mail_dir/$file/Maildir", "$work_dir/homedir/mail/$domain/$file" );
                    system( 'rm', '-rf', "$work_dir/homedir/imap/$domain" );
                }
                elsif ( -e "$domain_mail_dir/$file/mail" ) {
                    glob_copy( "$domain_mail_dir/$file/mail/*", "$work_dir/homedir/mail/$domain/$file" );
                }
            }
        }

        mkdir( "$work_dir/homedir/etc/$domain", 0700 );
        if ( open( my $passwd_h, '>>', "$work_dir/homedir/etc/$domain/passwd" ) ) {
            if ( open( my $shadow_h, '>>', "$work_dir/homedir/etc/$domain/shadow" ) ) {
                my @ids    = getpwnam($user);
                my $passwd = get_email_user_pass($domain);
                foreach my $pass ( @{$passwd} ) {
                    my $pw_user = $pass->[0];
                    my $pw_pass = $pass->[1];
                    print {$passwd_h} "$pw_user:x:-1:-1::/home/$user/mail/$domain/$pw_user:/usr/local/cpanel/bin/noshell\n";
                    print {$shadow_h} "${pw_user}:${pw_pass}:-1:-1:::::\n";
                }
                close $shadow_h;
            }
            close $passwd_h;
        }
    }
    print 'Done' . "\n";

    my $squirrelmail_dir = find_squirrelmail_dir();

    if ($squirrelmail_dir) {
        print "Copying squirrelmail files....";
        mkdir( "$work_dir/homedir/.sqmaildata/", 0711 );
        $domains = get_all_domains($user);
        foreach my $domain ( @{$domains} ) {
            my $email_users = get_email_user_pass($domain);
            foreach my $email_user ( map { $_->[0] } @{$email_users} ) {
                my $email = "${email_user}\@${domain}";
                opendir( my $dir_h, $squirrelmail_dir );
                my @files = map { "$squirrelmail_dir/$_" } grep { /\.abook$/ } grep { /$email/ } grep { !/^\.\.?$/ } readdir($dir_h);
                foreach my $file (@files) {
                    copy( $file, "$work_dir/homedir/.sqmaildata" );
                }
            }
        }
        print 'Done' . "\n";
    }

    print "DA Copying proftpd file....";
    if ( open( my $proftp_h, '>', "$work_dir/proftpdpasswd" ) ) {
        if ( open( my $pro_pass_h, '<', '/etc/proftpd.passwd' ) ) {
            while ( my $line = <$pro_pass_h> ) {
                chomp($line);
                foreach my $domain ( @{$domains} ) {
                    my ( $ftpuser, $ftppass ) = split /:/, $line;
                    if ( $ftpuser =~ /$domain$/ ) {
                        my $name;
                        ($name) = split /\@/, $ftpuser;
                        print {$proftp_h} "${name}:${ftppass}:-1:-1::/dev/null:/bin/ftpsh\n";
                    }
                }
            }
            close $pro_pass_h;
        }
        close $proftp_h;
    }

    print "DA Copying cpuser file.......";
    if ( open( my $user_h, '>', "$work_dir/cp/$cpuser" ) ) {
        print {$user_h} 'DNS=' . $dns . "\n";

        #
        # Ensure each parked/addon domain has a numerically-sequenced
        # entry in the $work_dir/cp/$cpuser per-user configuration file,
        # as various parts of the cPanel interface will depend on their
        # presence as an authoritative listing of secondary domains.
        #
        my $dns_number = 1;

        foreach my $parked_domain ( @{$parkeddomains} ) {
            next if $parked_domain eq $dns;
            print {$user_h} "DNS${dns_number}=${parked_domain}\n";
            $dns_number++;
        }

        close $user_h;
    }
    print 'Done' . "\n";

    print "DA Copying quota info.......";
    if ( open( my $quota_h, '>', "$work_dir/quota" ) ) {
        print {$quota_h} $user_conf->{'quota'};
        close $quota_h;
    }
    print 'Done' . "\n";

    print "DA Copying password.......";
    if ( open( my $shadow_h, '>', "$work_dir/shadow" ) ) {
        print {$shadow_h} get_user_pass($user);
        close $shadow_h;
    }
    print 'Done' . "\n";

    unless ($skipacctdb) {
        print "DA Grabbing mysql dbs.......";
        get_mysql_dbs( $user, $cpuser, $work_dir );
        print "Done\n";

        # Remove redundant directory in cpmove file
        system( 'rm', '-rf', "$work_dir/homedir/domains/$dns/public_html" );

        if ( open( my $grants_h, '>', "$work_dir/mysql.sql" ) ) {
            print 'DA Grabbing mysql privileges...';
            my $mysql_users = get_mysql_users($user);
            foreach my $mysql_user ( @{$mysql_users} ) {
                print {$grants_h} get_mysql_grants($mysql_user);
            }
            close $grants_h;
            print 'Done...' . "\n";
        }
    }

    ### copying SSL certs
    if ( -e "/usr/local/directadmin/data/users/$user/domains/${dns}.cert" ) {
        print "DA Grabbing SSL Cert...";
        system( 'cp', "/usr/local/directadmin/data/users/$user/domains/${dns}.cert", "$work_dir/sslcerts/$dns.crt" );
        system( 'cp', "/usr/local/directadmin/data/users/$user/domains/${dns}.key",  "$work_dir/sslkeys/$dns.key" );
    }

    print "DA Grabbing zone files......";
    get_zone_files( $user, $work_dir );
    print "Done\n";

    # Remove redundant directory in cpmove file
    system( 'rm', '-rf', "$work_dir/homedir/domains/$dns/public_html" );

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

        if ($nosplit) {

            fork_code(
                {
                    wait => 1,
                    dots => 1,
                    code => sub {
                        system( "tar", "pczf", "${prefix}${cpuser}.tar.gz", "${prefix}${cpuser}" );
                    },
                }
            );

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

        if ( -d $work_dir && !-l $work_dir ) {
            remove($work_dir);
        }
        print "Done\n";

        print "realusername is: $cpuser\n";
        if ( !$nosplit && @{$parts} ) {
            foreach my $part ( @{$parts} ) {
                print "splitpkgacctfile is: $splitdir/${part}\n";
                my $md5sum = md5("$splitdir/${part}");
                print "splitmd5sum is: $md5sum\n";
            }
        }
        else {
            print "pkgacctfile is: ${work_dir}.tar.gz\n";
            my $md5sum = md5( "${work_dir}.tar.gz", $system );
            print "md5sum is: $md5sum\n";
        }
    }
    else {
        die "Unable to create archive\n";
    }
}

sub get_subdomains {
    my ($user) = @_;
    my $path = "/usr/local/directadmin/data/users/$user/domains/";

    my $domains    = get_all_domains($user);
    my $subdomains = {};
    foreach my $domain ( @{$domains} ) {
        my $conf = $path . $domain . '.subdomains';
        if ( open( my $sub_h, '<', $conf ) ) {
            while ( my $line = <$sub_h> ) {
                chomp $line;
                $subdomains->{$line} = $domain;
            }
        }
    }
    return $subdomains;
}

sub get_parkeddomains {
    my ($user) = @_;
    my $path = "/usr/local/directadmin/data/users/$user/domains/";

    my $domains       = get_all_domains($user);
    my $parkeddomains = [];
    foreach my $domain ( @{$domains} ) {
        my $conf = $path . $domain . '.pointers';
        if ( open( my $parked_h, '<', $conf ) ) {
            while ( my $line = <$parked_h> ) {
                chomp $line;
                my @items = split /=/, $line;
                if ( $items[1] eq 'alias' ) {
                    push @$parkeddomains, [ $items[0], $domain ];
                }
            }
        }
    }
    return $parkeddomains;
}

sub get_all_domains {
    my ($user) = @_;
    my $conf = '/usr/local/directadmin/data/users/' . $user . '/domains.list';

    my @data = ();
    if ( open( my $fh, '<', $conf ) ) {
        while ( my $line = <$fh> ) {
            chomp($line);
            push @data, $line;
        }
    }
    return \@data;
}

sub get_user_config {
    my ($user) = @_;
    my $conf = '/usr/local/directadmin/data/users/' . $user . '/user.conf';

    my $data = {};
    if ( open( my $fh, '<', $conf ) ) {
        while ( my $line = <$fh> ) {
            chomp($line);
            my ( $key, $value ) = split /=/, $line;
            $data->{$key} = $value;
        }
        close $fh;
    }
    return $data;
}

sub get_user_pass {
    my ($user) = @_;
    my $path = "/home/$user/.shadow";

    if ( open( my $shadow_h, '<', $path ) ) {
        my $pass = <$shadow_h>;
        close $shadow_h;
        return $pass;
    }
}

sub get_email_user_pass {
    my ($domain) = @_;
    my $path = '/etc/virtual/' . $domain . '/passwd';

    my $stash;
    if ( open( my $shadow_h, '<', $path ) ) {
        while ( my $passwd = <$shadow_h> ) {
            chomp $passwd;
            my ( $user, $pass ) = split /:/, $passwd;
            push @{$stash}, [ $user, $pass ];
        }
        close $shadow_h;
    }
    return $stash;
}

sub mysql_query {
    my (%args)  = @_;
    my $da_user = $args{'da_user'};
    my $db      = $args{'db'};
    my $mysql   = _find_mysql();
    my $passwd  = _mysql_pass();

    my $user = $passwd->{'user'};
    my $pass = $passwd->{'passwd'};

    IPC::Open3::open3( my $mysql_h, my $mysql_res, '', $mysql . qq{ -u $user $db -B -ss --raw --password=$pass} );
    return ( $mysql_res, $mysql_h );
}

sub mysql_dbs {
    my ($da_user) = @_;

    my ( $mysql_res, $mysql_h ) = mysql_query(
        da_user => $da_user,
        db      => 'mysql',
    );

    my $stmt = 'SHOW DATABASES';
    print {$mysql_h} $stmt;
    close $mysql_h;

    my @results;
    while ( my $res = <$mysql_res> ) {
        chomp($res);
        push @results, $res if $res =~ /^$da_user/;
    }
    close $mysql_res;
    return \@results;
}

sub get_mysql_dbs {
    my ( $da_user, $cpuser, $work_dir ) = @_;
    my $dbs    = mysql_dbs($da_user);
    my $passwd = _mysql_pass();

    my @options = ( '-c', '-Q', '-q', '-u', $passwd->{'user'}, "--password=$passwd->{'passwd'}" );
    foreach my $db ( @{$dbs} ) {
        mysqldumpdb( { 'options' => [@options], 'db' => $db, 'file' => "$work_dir/mysql/${db}.sql" } );
    }
}

sub get_mysql_users {
    my ($da_user) = @_;

    my %result = ();
    my ( $mysql_res, $mysql_h ) = mysql_query(
        da_user => $da_user,
        db      => 'mysql',
    );

    my $stmt = "SELECT user from user WHERE user LIKE '${da_user}%'";
    print {$mysql_h} $stmt;
    close $mysql_h;

    while ( my $res = <$mysql_res> ) {
        chomp $res;
        $result{$res} = 1;
    }
    close $mysql_res;

    return [ keys %result ];
}

sub get_mysql_grants {
    my ($da_user) = @_;

    my $result = '';
    my ( $mysql_res, $mysql_h ) = mysql_query(
        da_user => $da_user,
        db      => 'mysql',
    );

    my $stmt = "SHOW GRANTS FOR $da_user\@localhost";
    print {$mysql_h} $stmt;
    close $mysql_h;

    while ( my $res = <$mysql_res> ) {
        chomp $res;
        $result .= $res . ";\n";
    }
    close $mysql_res;

    return $result;
}

sub _mysql_pass {
    my $path = '/usr/local/directadmin/conf/mysql.conf';

    my $data = {};
    if ( open( my $fh, '<', $path ) ) {
        while ( my $line = <$fh> ) {
            chomp($line);
            my ( $key, $value ) = split /=/, $line;
            $data->{$key} = $value;
        }
        close $fh;
    }
    return $data;
}

sub _find_mysql {
    return _find_bin( 'mysql', [ '/usr/bin', '/usr/sbin', '/usr/local/bin', '/usr/local/sbin', '/usr/libexec', '/usr/local/libexec', '/usr/local/mysql/bin' ] );
}

sub _find_bin {
    my $bin     = shift;
    my $pathref = shift;

    foreach my $path ( @{$pathref} ) {
        if ( -e $path . '/' . $bin ) {
            return $path . '/' . $bin;
        }
    }
}

sub _find_mysqldump {
    return _find_bin( 'mysqldump', [ '/usr/bin', '/usr/sbin', '/usr/local/bin', '/usr/local/sbin', '/usr/libexec', '/usr/local/libexec', '/usr/local/mysql/bin' ] );
}

sub _find_mysqlcheck {
    return _find_bin( 'mysqlcheck', [ '/usr/bin', '/usr/sbin', '/usr/local/bin', '/usr/local/sbin', '/usr/libexec', '/usr/local/libexec', '/usr/local/mysql/bin' ] );
}

sub clean_username {
    my ($cpuser) = @_;

    $cpuser =~ s/[^a-zA-Z0-9.-]//g;
    $cpuser =~ s/[.]+/./g;
    $cpuser =~ s/[_]//g;
    $cpuser = lc $cpuser;

    return $cpuser;
}

sub rewrite_aliases {
    my ( $domain, $file ) = @_;
    if ( open( my $vaf_fh, '+<', $file ) ) {
        my @VAF;
        while ( readline($vaf_fh) ) { push @VAF, $_; }
        if (@VAF) {
            seek( $vaf_fh, 0, 0 );
            foreach my $line (@VAF) {
                chomp($line);
                my ( $source, $target ) = split( /:\s*/, $line, 2 );
                next if ( $source eq $target );
                if ( $source ne '*' && $source !~ /[\@\:]/ ) {
                    $source .= '@' . $domain;
                }

                # if ( $target !~ /\s/ && $target !~ /[\@\:]/ ) {
                #                     $target .= '@' . $domain;
                #                 }
                $source =~ s/^\s+//g;
                $target =~ s/^\s+//g;

                print {$vaf_fh} $source . ': ' . $target . "\n";
            }
            truncate( $vaf_fh, tell($vaf_fh) );
        }
        close($vaf_fh);
    }
}

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

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

    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 $it = make_splitfile_iter(
        {
            read_limit  => 3000000,
            bytes_limit => 10000000,
            dir         => $tarname,
            system      => $system,
        }
    );

    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";
    }
    remove($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 $system      = $args->{'system'};

    my ( $pid, $tar_w, $tar_r, $tar_e );
    if ( $system =~ /freebsd/i ) {
        $pid = IPC::Open3::open3( $tar_w, $tar_r, $tar_e, 'tar', 'pczf', '-', $dir );
    }
    else {
        $pid = IPC::Open3::open3( $tar_w, $tar_r, $tar_e, 'tar', 'pcz', $dir );
    }

    if ($pid) {
        close $tar_w;
        return 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) = @_;
    my $md5sum;

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

sub df_mount {
    my ($mount) = @_;
    $mount ||= '/home';

    IPC::Open3::open3( my $df_h, my $df_res, '', 'df', '-P', $mount );
    close $df_h;

    my $buffer;
    while ( my $line = <$df_res> ) {
        $buffer .= $line;
    }
    for ( split( "\n", $buffer ) ) {
        if (/^(\S+)\s*\d*\s*\d*\s*\d*\s*(\d*)\%\s*(\S+)/) {
            my $dev   = $1;
            my $per   = $2;
            my $mount = $3;
            ## Look for block or character special file, or specifically a
            ##   Virtuozzo filesystem
            if ( !-l $dev && ( -b _ || -c _ || $dev eq 'vzfs' ) ) {
                my $disk = $dev;
                $disk =~ s/^.+\///;
                return {
                    'disk'       => $disk,
                    'percentage' => $per,
                    'mount'      => $mount,
                };
            }
        }
    }
}

sub diskcheck {
    my $df = df_mount();
    if ( $df->{'percentage'} >= 98 ) {
        print 'RUNNING LOW ON DISKSPACE!!!' . "\n";
        print 'Diskusage at ' . $df->{'percentage'} . '%' . "\n";
    }
}

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

sub OS {
    return ( POSIX::uname() )[0];
}

sub tarcopy {
    my ( $src, $dest ) = @_;
    my $retval = 0;
    if ( -e $src ) {
        if ( chdir($src) ) {
            system("tar -cf - . | ( cd $dest; tar -xf - )");
            $retval = 1;
        }
    }
    else {
        die "$src does not exists";
    }
    return $retval;
}

sub glob_copy {
    my ( $src, $dest ) = @_;
    my @src = glob($src);
    foreach my $file (@src) {
        copy( $file, $dest );
    }
}

sub copy {
    my ( $src, $dest ) = @_;
    my $system = OS();

    my $flags = ( $system =~ /freebsd/i ) ? '-pR' : '-aR';

    my $retval = system( 'cp', $flags, $src, $dest );
    return ( $retval == 0 ) ? 1 : 0;
}

sub remove {
    my (@path) = @_;
    foreach my $path (@path) {
        system( 'rm', '-rf', $path );
    }
}

sub fork_code {
    my ($args) = @_;
    if ( ref( $args->{'code'} ) ne 'CODE' ) {
        print 'Argument not a code ref' . "\n";
        exit(1);
    }

    if ( ( exists $args->{'args'} ) && ( ref $args->{'args'} ne 'ARRAY' ) ) {
        print 'args must be an array ref.' . "\n";
        exit(1);
    }

    my $user   = $args->{'user'} || '';
    my $code   = $args->{'code'};
    my $wait   = $args->{'wait'} ? 1 : 0;
    my $dots   = $args->{'dots'} ? 1 : 0;
    my $stdout = $args->{'stdout'} ? 1 : 0;
    my @args   = exists $args->{'args'} ? @{ $args->{'args'} } : ();

    my ( $uid, $gid ) = ( getpwnam($user) )[ 2, 3 ];

    my $pid;
    if ( $pid = fork() ) {
        my $dotcount = 5;
        if ($wait) {
            while ( waitpid( $pid, 1 ) != -1 ) {
                if ( $dotcount % 5 == 0 ) {
                    print "\t" . ".........\n" if $dots;
                }
                sleep(1);
                $dotcount++;
            }
        }
    }
    else {
        if ( defined $uid && $< == 0 ) {
            $< = int $uid;
            $> = int $uid;
            $( = int $gid;
            $) = "$gid $gid";
        }
        open( STDIN,  '<', '/dev/null' );
        open( STDOUT, '>', '/dev/null' ) if !$args->{'stdout'};
        open( STDERR, '>', '/dev/null' );

        $code->(@args);
        exit;
    }
}

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

    my @options   = @{ $args->{'options'} };
    my $db        = $args->{'db'};
    my $table     = $args->{'table'};
    my $file      = $args->{'file'};
    my $file_mode = $args->{'append'} ? '>>' : '>';

    my $mysqldump = _find_mysqldump();
    my @db        = ($db);
    if ($table) {
        push @db, $table;
    }
    print join( '.', @db ) . ' ';
    my $pid = IPC::Open3::open3( my $w, my $r, '', $mysqldump, @options, @db );

    my $first_line = 1;
    if ( open( my $fh, $file_mode, $file ) ) {
        use bytes;
        while (<$r>) {
            if ( $first_line && ( !$_ || m/^mysqldump:/ ) ) {
                warn join( '.', @db ) . ': ' . $_;
                close $w;
                close $r;
                waitpid( $pid, 0 );
                $first_line = 0;
                my $mysqlcheck = _find_mysqlcheck();
                system( $mysqlcheck, '--repair', @db );
                $pid = IPC::Open3::open3( $w, $r, '', $mysqldump, @options, @db );
            }
            else {
                print {$fh} $_;
            }
        }
        no bytes;
    }
    close $w;
    close $r;
    waitpid( $pid, 0 );
}

sub daconf {
    my $conf = '/usr/local/directadmin/conf/directadmin.conf';

    my $stash = {};
    if ( open( my $fh, '<', $conf ) ) {
        while ( my $line = <$fh> ) {
            chomp $line;
            next if !$line;
            next if $line =~ /^#/;
            my ( $key, $value ) = split( /=/, $line, 2 );
            $stash->{$key} = $value;
        }
        close $fh;
    }
    return $stash;
}

sub get_zone_files {
    my ( $user, $dir ) = @_;

    my $domains = get_all_domains($user);
    my $daconf  = daconf();

    my $namedir = $daconf->{'nameddir'};
    foreach my $zone (@$domains) {
        system( 'cp', "$namedir/$zone.db", "$dir/dnszones" );
    }
}

sub write_htaccess {
    my ( $parked, $path ) = @_;

    if ( !-e "$path/.htaccess" ) {
        my $domain = $parked->[0];
        my $addon  = $parked->[1];
        $addon =~ s/\./\\./g;
        if ( open( my $fh, '>', "$path/.htaccess" ) ) {
            print {$fh} <<EOF;
RewriteEngine on

RewriteCond \%{HTTP_HOST} ^$domain\$ [OR]
RewriteCond \%{HTTP_HOST} ^www.$domain\$
RewriteRule ^/?\$ "http\\:\\/\\/www\\.$addon" [R=301,L]
EOF
        }
    }
}

sub find_squirrelmail_dir {
    my $base = '/var/www/html';
    opendir( my $dir_h, $base );
    my ($path) = map { "$base/$_" } grep { /squirrelmail-/ } grep { !/^\.\.?$/ } readdir($dir_h);

    return "$path/data";
}