#!/usr/bin/perl
# cpanel12 - scripts                              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 POSIX;
require 5.006;

my $httpuser = 'nobody';
my $httpgid  = ( getgrnam($httpuser) )[2];

#recusive, copy symlinks as symlinks, preserve permissions,
#preserve times, preserve devices

$| = 1;

my $isinc = $ENV{'INCBACKUP'};
my $user  = $ARGV[0];

my ( $system, $release, $machine ) = ( POSIX::uname() )[ 0, 2, 4 ];

if ( $> == 0 ) {
    $ENV{'USER'} = 'root';
    $ENV{'HOME'} = '/root';
}

my $dotbuffer = '/scripts/dotbuffer';
if ( !-e "/scripts/dotbuffer" ) {
    my $tmpdir = ( getpwuid($>) )[7] . "/tmp";
    if ( -f "$tmpdir" ) {
        print "$tmpdir is a normal file.  Please remove it and try again\n";
        sleep(5);
        exit;
    }
    mkdir( $tmpdir, 0700 );
    open( DOTBUFFER, ">$tmpdir/dotbuffer" );
    print DOTBUFFER <<EOM;
#!/usr/bin/perl
   \$limit = \$ARGV[0];
   \$|=1;
   while(read(STDIN,\$buffer,1)) {
      if (\$buffer =~ /a/i || \$buffer =~ /b/i) {
         print ".";
         \$count++;
         if (\$count == \$limit) {
            print "\n";
            \$count=0;
         }
      }
   }
EOM
    close(DOTBUFFER);
    chmod( 0700, "$tmpdir/dotbuffer" );
    $dotbuffer = "$tmpdir/dotbuffer";
}

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

my $tarroot = $ARGV[1];
if ( substr( $tarroot, 0, 1 ) eq "~" ) {
    my $tuser = substr( $tarroot, 1 );
    $tarroot = ( getpwnam($tuser) )[7];
}

my $prefix;
my $isbackup;
my $isuserbackup;
my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst );
if ( $ARGV[2] eq "backup" ) {
    $isbackup = 1;
    $prefix   = '';
}
elsif ( $ARGV[2] eq "userbackup" ) {
    $isuserbackup = 1;
    $isbackup     = 1;
    ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) = localtime(time);
    $mon++;
    $year += 1900;
    $sec  = sprintf( "%02d", $sec );
    $min  = sprintf( "%02d", $min );
    $hour = sprintf( "%02d", $hour );
    $prefix = "backup-${mon}.${mday}.${year}_${hour}-${min}-${sec}_";
}
else {
    $prefix = 'cpmove-';
}
my $split = 0;
if ( $ARGV[2] =~ /split/i ) {
    print "We will be spliting the archive!!\n";
    $split = 1;
}

$prefix =~ s/\s//g;
$prefix =~ s/\n//g;

if ( $tarroot eq "" || !-d "$tarroot" ) {
    if ( $ARGV[2] eq "backup" ) {
        print "Bailing out.. you must set a valid destination for backups\n";
        exit;
    }
    $tarroot = getmntpoint();
}

my $skipacctdb = pop(@ARGV) eq '--skipacctdb';

if ( $> == 0 && ( !($isbackup) ) ) {
    system( "rdate", "-s", "rdate.cpanel.net" );
}

$0 = "pkgacct - ${user}";

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

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

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

open( CPU, "/var/cpanel/users/${user}" );
my $dns = '';
while (<CPU>) {
    if (/^DNS=(\S+)/) {
        $dns = $1;
    }
}
close(CPU);

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

open( CPU, "/var/cpanel/users/${user}" );
my @DNS;
while (<CPU>) {
    if (/^DNS\d*=(\S+)/) {
        push( @DNS, $1 );
    }
}
close(CPU);

if ( $prefix eq "" && ( $tarroot eq "/home" || $tarroot eq getmntpoint() ) ) {
    print "Bailing out .. no prefix set and tarroot is /home\n";
    exit;
}

if ( $prefix ne "" ) {
    if ( -d "${tarroot}/${prefix}${user}" && !-l "${tarroot}/${prefix}${user}" ) {
        if ( !$isinc ) {
            system( "rm", "-rf", "${tarroot}/${prefix}${user}" );
        }
    }
    if ( -d "${tarroot}/${prefix}${user}-split" && !-l "${tarroot}/${prefix}${user}-split" ) {
        if ( !$isinc ) {
            system( "rm", "-rf", "${tarroot}/${prefix}${user}-split" );
        }
    }
    if ( -f "${tarroot}/${prefix}${user}.tar.gz" && !-l "${tarroot}/${prefix}${user}.tar.gz" ) {
        system( "rm", "-rf", "${tarroot}/${prefix}${user}.tar.gz" );
    }
}

if ( !$isinc && !$split ) {
    open( CPM, ">${tarroot}/${prefix}${user}.tar.gz" );
    close(CPM);
    chmod( 0600, "${tarroot}/${prefix}${user}.tar.gz" );
}

if ( !-e "${tarroot}/${prefix}${user}" ) {
    mkdir( "${tarroot}/${prefix}${user}",                0700 );
    mkdir( "${tarroot}/${prefix}${user}/cp",             0700 );
    mkdir( "${tarroot}/${prefix}${user}/resellerconfig", 0700 );
    mkdir( "${tarroot}/${prefix}${user}/logs",           0700 );
    mkdir( "${tarroot}/${prefix}${user}/mysql",          0700 );
    mkdir( "${tarroot}/${prefix}${user}/mm",             0700 );
    mkdir( "${tarroot}/${prefix}${user}/mma",            0700 );
    mkdir( "${tarroot}/${prefix}${user}/mma/pub",        0700 );
    mkdir( "${tarroot}/${prefix}${user}/mma/priv",       0700 );
    mkdir( "${tarroot}/${prefix}${user}/va",             0700 );
    mkdir( "${tarroot}/${prefix}${user}/vad",            0700 );
    mkdir( "${tarroot}/${prefix}${user}/fp",             0700 );
    mkdir( "${tarroot}/${prefix}${user}/interchange",    0700 );
    mkdir( "${tarroot}/${prefix}${user}/httpfiles",      0700 );
    mkdir( "${tarroot}/${prefix}${user}/vf",             0700 );
    mkdir( "${tarroot}/${prefix}${user}/cron",           0700 );
    mkdir( "${tarroot}/${prefix}${user}/sslcerts",       0700 );
    mkdir( "${tarroot}/${prefix}${user}/sslkeys",        0700 );
}
else {
    if ( !$isinc ) {
        print "${tarroot}/${prefix}${user} exists, please remove it and try again\n";
        exit;
    }
}

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

print "Copying Reseller Config...";
opendir( VCP, "/var/cpanel" );
my @RESCFG = readdir(VCP);
@RESCFG = grep( /reseller/, @RESCFG );
closedir(VCP);
foreach my $resfile (@RESCFG) {
    if ( -f "/var/cpanel/${resfile}" ) {
        open( RF, "<", "/var/cpanel/${resfile}" );
        open( RW, ">", "${tarroot}/${prefix}${user}/resellerconfig/${resfile}" );
        while (<RF>) {
            if (/^${user}[\s:]+/) {
                print RW;
            }
        }
        close(RF);
        close(RW);
    }
}
print "Done\n";

print "Copying SSL Certificates, CSRS, and Keys...";

if ( $> == 0 ) {
    foreach my $domain (@DNS) {
        if ( -e "${ssldir}/certs/${domain}.crt" ) {
            print "..${domain}.crt..";
            syncfile( "${ssldir}/certs/${domain}.crt", "${tarroot}/${prefix}${user}/sslcerts" );
        }
        if ( -e "${ssldir}/certs/${domain}.csr" ) {
            print "..${domain}.csr..";
            syncfile( "${ssldir}/certs/${domain}.csr", "${tarroot}/${prefix}${user}/sslcerts" );
        }
        if ( -e "${ssldir}/private/${domain}.key" ) {
            print "..${domain}.key..";
            syncfile( "${ssldir}/private/${domain}.key", "${tarroot}/${prefix}${user}/sslkeys" );
        }
    }
}
else {
    my @SSLTYPES = ( "csr", "key", "crt" );
    foreach my $ssltype (@SSLTYPES) {
        my $items = `/usr/local/cpanel/bin/sslwrap LIST ${dns} $ssltype`;
        my (@SSLFILES) = split( /\n/, $items );
        foreach my $host (@SSLFILES) {
            my $ssldata = `/usr/local/cpanel/bin/sslwrap FETCH $host $ssltype`;
            if ( $ssltype eq "csr" ) {
                print "..${host}.csr..";
                open( CSR, ">", "${tarroot}/${prefix}${user}/sslcerts/${host}.csr" );
                print CSR $ssldata;
                close(CSR);
            }
            elsif ( $ssltype eq "crt" ) {
                print "..${host}.crt..";
                open( CRT, ">", "${tarroot}/${prefix}${user}/sslcerts/${host}.crt" );
                print CRT $ssldata;
                close(CRT);
            }
            elsif ( $ssltype eq "key" ) {
                print "..${host}.key..";
                open( KEY, ">", "${tarroot}/${prefix}${user}/sslkeys/${host}.key" );
                print KEY $ssldata;
                close(KEY);
            }
        }
    }
}
print "Done\n";

print "Copying Mail files....";
foreach my $domain (@DNS) {
    if ( -e "/etc/valiases/${domain}" ) {
        syncfile( "/etc/valiases/${domain}", "${tarroot}/${prefix}${user}/va" );
    }
    if ( -e "/etc/vdomainaliases/${domain}" ) {
        syncfile( "/etc/vdomainaliases/${domain}", "${tarroot}/${prefix}${user}/vad" );
    }
    if ( -e "/etc/vfilters/${domain}" ) {
        syncfile( "/etc/vfilters/${domain}", "${tarroot}/${prefix}${user}/vf" );
    }
}
print "Done\n";

print "Copying frontpage files....";
foreach my $domain (@DNS) {
    syncfile( "/usr/local/frontpage/www.${domain}:80.cnf", "${tarroot}/${prefix}${user}/fp" );
}
print "Done\n";

print "Copying proftpd file....";
if ( $> == 0 ) {
    syncfile( "/etc/proftpd/${user}", "${tarroot}/${prefix}${user}/proftpdpasswd" );
}
else {
    system("/usr/local/cpanel/bin/ftpwrap DUMP 0 0 >> ${tarroot}/${prefix}${user}/proftpdpasswd");
}
chmod( 0600, "${tarroot}/${prefix}${user}/proftpdpasswd" );
print "Done\n";

if ( $ENV{'pkgacct-logs'} eq "yes" || $ENV{'pkgacct-cpbackup'} eq "" ) {
    print "Copying www logs....";
    foreach my $domain (@DNS) {
        if ( my $pid = fork() ) {
            my $dotcount = 5;
            while ( waitpid( $pid, 1 ) != -1 ) {
                if ( $dotcount % 5 == 0 ) {
                    print ".........\n";
                }
                sleep(1);
                $dotcount++;
            }
        }
        else {
            $0 = "pkgacct - ${user} - log copy child";
            globsyncfile( "/usr/local/apache/domlogs/${domain}*",     "${tarroot}/${prefix}${user}/logs" );
            globsyncfile( "/usr/local/apache/domlogs/www.${domain}*", "${tarroot}/${prefix}${user}/logs" );
            globsyncfile( "/usr/local/apache/domlogs/ftp.${domain}*", "${tarroot}/${prefix}${user}/logs" );
            exit;
        }
    }
    print "Done\n";
}

unless ($skipacctdb) {
    my $mysqladmin = find_mysqladmin();
    my $mysqldump  = find_mysqldump();

    my ($mysqldatadir) = '/var/lib/mysql';
    open( MADMIN, "$mysqladmin variables|" );
    while (<MADMIN>) {
        s/\|//g;
        if (/[\s\t]+datadir[\s\t]+(\S+)/) {
            $mysqldatadir = $1;
        }
    }
    close(MADMIN);
    while ( -l $mysqldatadir ) {
        $mysqldatadir = readlink($mysqldatadir);
    }

    if ( $ENV{'pkgacct-mysql'} eq "yes" || $ENV{'pkgacct-cpbackup'} eq "" ) {

        print "Grabbing mysql dbs...";
        my ($mysqluser) = $user;
        $mysqluser =~ s/-//g;
        my $users;
        my @DBS;
        if ( $> == 0 ) {

            #no ipc::open for portability
            $users = `echo \"$uid LISTUSERS 0 0\" | /usr/local/cpanel/bin/mysqladmin`;
            if ( $users !~ /^Warning/ ) {
                @DBS = split( /\n/, `echo \"$uid LISTDBS 0 0\" | /usr/local/cpanel/bin/mysqladmin` );
            }
        }
        else {
            $users = `/usr/local/cpanel/bin/mysqlwrap LISTUSERS 0 0`;
            if ( $users !~ /^Warning/ ) {
                @DBS = split( /\n/, `/usr/local/cpanel/bin/mysqlwrap LISTDBS 0 0` );
            }
        }
        foreach my $db (@DBS) {
            $db =~ s/\n//g;
            if ( $> == 0 || $ENV{'REMOTE_PASSWORD'} eq "" ) {
                open( MYSQLDUMP, "-|" ) || exec( "$mysqldump", "-c", "-Q", "-q", "${db}" );
            }
            else {
                open( MYSQLDUMP, "-|" ) || exec( "$mysqldump", "-c", "-Q", "-q", "-u${user}", "-p$ENV{'REMOTE_PASSWORD'}", "${db}" );
            }
            open( SQL, ">", "${tarroot}/${prefix}${user}/mysql/${db}.sql" );
            use bytes;
            while (<MYSQLDUMP>) { print SQL; }
            no bytes;
            close(SQL);
            close(MYSQLDUMP);
        }
        open( SQL, ">", "${tarroot}/${prefix}${user}/mysql/${user}.sql" );
        my $pid = open( MYSQLDUMP, "-|" );

        if ($pid) {
            use bytes;
            while (<MYSQLDUMP>) { print SQL; }
            no bytes;
        }
        else {
            open( STDERR, ">/dev/null" );
            if ( $> == 0 || $ENV{'REMOTE_PASSWORD'} eq "" ) {
                exec( "$mysqldump", "-c", "-Q", "-q", "${user}" );
            }
            else {
                exec( "$mysqldump", "-c", "-Q", "-q", "-u${user}", "-p$ENV{'REMOTE_PASSWORD'}", "${user}" );
            }
            exit(1);
        }

        close(SQL);
        close(MYSQLDUMP);

        print "Done\n";

        print "Grabbing mysql privs...";
        if ( $> == 0 ) {
            system("echo \"$uid DUMPSQL 0 0\" | /usr/local/cpanel/bin/mysqladmin >>  ${tarroot}/${prefix}${user}/mysql.sql");
        }
        else {
            system("/usr/local/cpanel/bin/mysqlwrap DUMPSQL 0 0 >>  ${tarroot}/${prefix}${user}/mysql.sql");
        }
        print "Done\n";
    }
}

print "Copying mailman lists....";
globsyncfile( "/usr/local/cpanel/3rdparty/mailman/lists/*_${dns}", "${tarroot}/${prefix}${user}/mm" );
print "Done\n";

print "Copying mailman archives....";
globsyncfile( "/usr/local/cpanel/3rdparty/mailman/archives/public/*_${dns}",       "${tarroot}/${prefix}${user}/mma/pub" );
globsyncfile( "/usr/local/cpanel/3rdparty/mailman/archives/public/*_${dns}.mbox",  "${tarroot}/${prefix}${user}/mma/pub" );
globsyncfile( "/usr/local/cpanel/3rdparty/mailman/archives/private/*_${dns}",      "${tarroot}/${prefix}${user}/mma/priv" );
globsyncfile( "/usr/local/cpanel/3rdparty/mailman/archives/private/*_${dns}.mbox", "${tarroot}/${prefix}${user}/mma/priv" );
print "Done\n";

print "Copying homedir....";

if ( my $pid = fork() ) {
    my $dotcount = 5;
    while ( waitpid( $pid, 1 ) != -1 ) {
        if ( !$isbackup && $dotcount % 5 == 0 ) {
            print ".........\n";
        }
        sleep(1);
        $dotcount++;
    }
}
else {

    my %NFL;

    if ( -d "${tarroot}/${prefix}${user}" && !-l "${tarroot}/${prefix}${user}" ) {
        chown( 0, ${gid}, "${tarroot}/${prefix}${user}" );
        chmod( 0750, "${tarroot}/${prefix}${user}" );
    }
    if ( -d "${tarroot}/${prefix}${user}/homedir" && !-l "${tarroot}/${prefix}${user}/homedir" ) {
        chown( 0, 0, "${tarroot}/${prefix}${user}/homedir" );
    }
    mkdir( "${tarroot}/${prefix}${user}/homedir", 0700 );
    chmod( 0700, "${tarroot}/${prefix}${user}/homedir" );
    if ($isuserbackup) {
        %NFL = safesync(
            user    => $user,
            gidlist => [ "cpanel", "nobody" ],
            source  => "${homedir}/",
            dest    => "${tarroot}/${prefix}${user}/homedir",
            chown   => 0,
            exclude => '/backup-[^\_]+_[^\-]+-[^\-]+-[^\_]+_' . ${user}
        );
    }
    else {
        %NFL = safesync(
            user    => $user,
            gidlist => [ "cpanel", "nobody" ],
            source  => "${homedir}/",
            dest    => "${tarroot}/${prefix}${user}/homedir",
            chown   => 0,
            delete  => 1,
            verbose => 0
        );
    }
    chmod( 0700, "${tarroot}/${prefix}${user}/homedir" );

    open( NFILES, ">${tarroot}/${prefix}${user}/nobodyfiles" );
    foreach my $file (%NFL) {
        next if ( $NFL{$file} ne "nobody" );
        chomp($file);
        $file =~ s/^${homedir}\/?//g;
        print NFILES $file . "\n";
    }
    close(NFILES);

    exit();
}
print "Done\n";

print "Copying cpuser file.......";
syncfile( "/var/cpanel/users/${user}", "${tarroot}/${prefix}${user}/cp" );
print "Done\n";

print "Copying crontab file.......";
if ( -e "/var/spool/cron/${user}" ) {
    syncfile( "/var/spool/cron/${user}", "${tarroot}/${prefix}${user}/cron" );
}
if ( -e "/var/spool/fcron/${user}" ) {
    syncfile( "/var/spool/fcron/${user}", "${tarroot}/${prefix}${user}/cron" );
}
print "Done\n";

print "Copying quota info.......";
open( QUOTA, ">${tarroot}/${prefix}${user}/quota" );
open( QC,    "/etc/quota.conf" );
my $quota;
while (<QC>) {
    if (/^${user}=(\d+)/) {
        $quota = $1;
    }
}
close(QC);
print QUOTA "$quota";
close(QUOTA);
print "Done\n";

print "Storing Subdomains....\n";
my @SUBS = listsubdomains( ${homedir}, @DNS );

open( SH, ">${tarroot}/${prefix}${user}/sds" );
foreach my $sd (@SUBS) {
    print SH "$sd\n";
}
close(SH);
print "Done\n";

print "Storing Parked Domains....\n";
my @SDS = getparked( ${dns} );

open( SH, ">${tarroot}/${prefix}${user}/pds" );
foreach my $sd (@SDS) {
    print SH "$sd\n";
}
close(SH);
print "Done\n";

print "Storing Addon Domains....\n";
my (@PSUBS);
my ( %PN, %FN, $pname, $fname );

foreach (@SUBS) {
    $fname = $_;
    s/_/\./g;
    $FN{$_} = $fname;
    push( @PSUBS, $_ );
}

my %PARKED = getmultiparked(@PSUBS);
open( SH, ">${tarroot}/${prefix}${user}/addons" );
foreach my $subdomain ( keys %PARKED ) {
    foreach my $parked ( keys %{ $PARKED{$subdomain} } ) {
        print SH "$parked=$FN{$subdomain}\n";
    }
}

close(SH);
print "Done\n";

print "Copying password.......";
open( SH, ">${tarroot}/${prefix}${user}/shadow" );
chmod( 0600, "${tarroot}/${prefix}${user}/shadow" );
my $pass = ( getpwnam($user) )[1];
print SH "$pass";
close(SH);
print "Done\n";

print "Copying shell.......";
open( SH, ">${tarroot}/${prefix}${user}/shell" );
my $shell = ( getpwnam($user) )[8];
print SH "$shell";
close(SH);
print "Done\n";

chdir("${tarroot}");
if ( !$split ) {
    print "pkgacctfile is: ${tarroot}/${prefix}${user}.tar.gz\n";
}
print "Creating Archive ....";
if ( !$isinc ) {
    if ($isbackup) {
        system( "tar", "pczf", "${prefix}${user}.tar.gz", "${prefix}${user}" );
    }
    else {
        if ($split) {
            mkdir( "${tarroot}/${prefix}${user}-split", 0700 );
            rename( "${tarroot}/${prefix}${user}", "${tarroot}/${prefix}${user}-split/${prefix}${user}" );
            chdir("${tarroot}/${prefix}${user}-split");
            opendir( SPD, "${tarroot}/${prefix}${user}-split" );
            my @FILES = readdir(SPD);
            closedir(SPD);
            foreach my $file (@FILES) {
                if ( -f "${tarroot}/${prefix}${user}-split/${file}" ) {
                    unlink("${tarroot}/${prefix}${user}-split/${file}");
                }
            }
            my $limit = 40;
            my $bc    = 0;
            my $part  = 1;
            open( PART, ">cpmove-${user}.tar.gz.part${part}" );
            chmod( 0600, "cpmove-${user}.tar.gz.part${part}" );
            if ( $system =~ /freebsd/i ) {
                open( TR, "-|" ) || exec( "tar", "pczf", "-", "${prefix}${user}" );
            }
            else {
                open( TR, "-|" ) || exec( "tar", "pcz", "${prefix}${user}" );
            }
            my $bf;
            my $bytes = 0;
            my $count = 0;
            while ( read( TR, $bf, 30000 ) ) {
                $bytes += 30000;
                if ( $bytes > 100000000 ) {
                    $bytes = 0;
                    $part++;
                    close(PART);
                    open( PART, ">cpmove-${user}.tar.gz.part${part}" );
                }
                print PART $bf;
                print ".";
                $count++;
                if ( $count == $limit ) {
                    print "\n";
                    $count = 0;
                }
            }
            close(TR);
            close(PART);
            print "\n";
            opendir( SPD, "${tarroot}/${prefix}${user}-split" );
            my @FILES = readdir(SPD);
            closedir(SPD);
            foreach my $file (@FILES) {

                if ( -f "${tarroot}/${prefix}${user}-split/${file}" ) {
                    print "splitpkgacctfile is: ${tarroot}/${prefix}${user}-split/${file}\n";
                    my $md5sum = getmd5sum("${tarroot}/${prefix}${user}-split/${file}");
                    print "splitmd5sum is: ${md5sum}\n";
                }
            }
            if ( -d "${tarroot}/${prefix}${user}-split/${prefix}${user}" && !-l "${tarroot}/${prefix}${user}-split/${prefix}${user}" ) {
                system( "rm", "-rf", "${tarroot}/${prefix}${user}-split/${prefix}${user}" );
            }
        }
        else {
            if ( my $tpid = fork() ) {
                my $dotcount = 5;
                while ( waitpid( $tpid, 1 ) != -1 ) {
                    if ( $dotcount % 5 == 0 ) {
                        print ".........\n";
                    }
                    sleep(1);
                    $dotcount++;
                }
            }
            else {
                system( "tar", "pczf", "${prefix}${user}.tar.gz", "${prefix}${user}" );
                exit();
            }
        }
    }
    if ( -d "${tarroot}/${prefix}${user}" && !-l "${tarroot}/${prefix}${user}" ) {
        system( "rm", "-rf", "${tarroot}/${prefix}${user}" );
    }
}
print "Done\n";

my $md5sum;
if ( ( !$isinc ) && ( !$split ) ) {
    $md5sum = getmd5sum("${tarroot}/${prefix}${user}.tar.gz");
    print "md5sum is: $md5sum\n";
}

sub find_httpconf {
    my ( @LOC, $loc );
    @LOC = ( "/usr/local/apache/conf/httpd.conf", "/etc/httpd/conf/httpd.conf", "/usr/local/etc/apache/apache.conf" );
    foreach $loc (@LOC) {
        if ( -e $loc ) { return $loc; }
    }
    return "";
}

sub getparked {
    my ($mydomain) = @_;
    my $httpdconf = find_httpconf();
    open( HTTPDCONF, "$httpdconf" );
    my $xu = 0;
    my %SN;
    my %SA;
    while (<HTTPDCONF>) {
        s/\>//g;

        my $mvh;
        my $vh;
        my %DA;
        my %DR;
        if ( $_ !~ /#/ ) {
            if (/\<virtualhost (\S+)($|\s)/i) {
                $mvh = $1;
                $vh  = 1;
                $xu++;
            }
            if ( $vh == 1 ) {
                if (/servername (\S+)($|\s)/i) {
                    my $sn = $1;
                    $SN{$xu} = $1;
                }
                if (/serveralias (.*)/i) {
                    my $sa = $1;
                    $SA{$xu}{$sa} = 1;
                }
                if (/documentroot (\S+)/i) {
                    $DR{$xu} = $1;
                }
            }
            if (/\<\/virtualhost/i) {
                $vh = 0;
            }
        }
    }
    close(HTTPDCONF);

    my @PARKED;
    foreach my $server ( sort keys %SN ) {
        if ( $SN{$server} eq $mydomain || $SN{$server} eq "www.${mydomain}" ) {
            foreach my $parked ( sort keys %{ $SA{$server} } ) {
                my $skipd = 0;
                my @TP = split( / /, $parked );
                foreach my $tpp (@TP) {
                    if ( $tpp eq $mydomain ) { $skipd = 1; }
                }
                if ($skipd) { next(); }
                push( @PARKED, $parked );
            }
        }
    }
    return (@PARKED);
}

sub getmntpoint {

    my ($homedir);
    my ($homematch);

    open( CONF, "/etc/wwwacct.conf" );
    while (<CONF>) {
        $_ =~ s/\n//g;
        if ( $_ !~ /^;/ ) {
            if ( $_ =~ /HOMEDIR/ ) {
                ( undef, $homedir ) = split( / /, $_ );
            }
            if ( $_ =~ /HOMEMATCH/ ) {
                ( undef, $homematch ) = split( / /, $_ );
            }
        }
    }
    close(CONF);

    my $disk = `df`;

    my $max = 0;
    my $mnt = "/";
    my (@DISK) = split( /\n/, $disk );
    my $addline = '';
    foreach my $line (@DISK) {
        if ( $line !~ /[\s|\t]+/ ) {
            $addline = $line;
            $addline =~ s/\n//g;
            next;
        }
        if ( $line =~ /^\/dev/ || $addline ne "" ) {
            $line =~ s/\n//g;

            $line =~ / (\d*)\s*\d*\%\s*(\S+)$/;
            my $free  = $1;
            my $mount = $2;

            my $assess = 1;
            if ( ( $mount eq "/" ) && ( $homedir eq 0 ) ) {
                $assess = 0;
            }
            $free = int($free);
            $max  = int($max);

            if ( ( $max < $free ) && ( $assess eq 1 ) && ( $mount =~ /$homematch/ || $mount eq "/" ) ) {
                $max = $free;
                if ( $mount eq "/" ) {
                    $mount = $homedir;
                }
                $mnt = $mount;
            }
        }
    }

    if ( $mnt eq "" || $mnt eq "/" ) { $mnt = '/home'; }
    return ($mnt);

}

sub find_mysqladmin {
    my ( @LOC, $loc );
    @LOC = ( "/usr/bin/mysqladmin", "/usr/local/bin/mysqladmin" );
    foreach $loc (@LOC) {
        if ( -e $loc ) { return $loc; }
    }
}

sub find_mysqldump {
    my ( @LOC, $loc );
    @LOC = ( "/usr/bin/mysqldump", "/usr/local/bin/mysqldump" );
    foreach $loc (@LOC) {
        if ( -e $loc ) { return $loc; }
    }
}

sub getmultiparked {
    my (@MYDOMAINS) = @_;

    my $httpdconf = find_httpconf();
    my %DR;
    my (%PARKED);
    my %SN;
    my $sn;
    my $sa;
    my $xu;
    my $mvh;
    my $vh;
    my %SA;

    open( HTTPDCONF, "$httpdconf" );
    $xu = 0;
    while (<HTTPDCONF>) {
        s/\>//g;

        if ( $_ !~ /#/ ) {
            if (/\<virtualhost (\S+)($|\s)/i) {
                $mvh = $1;
                $vh  = 1;
                $xu++;
            }
            if ( $vh == 1 ) {
                if (/servername (\S+)($|\s)/i) {
                    $sn = $1;
                    $SN{$xu} = $1;
                }
                if (/serveralias (.*)/i) {
                    $sa = $1;
                    $SA{$xu}{$sa} = 1;
                }
                if (/documentroot (\S+)/i) {
                    $DR{$xu} = $1;
                }
            }
            if (/\<\/virtualhost/i) {
                $vh = 0;
            }
        }
    }
    close(HTTPDCONF);

    foreach my $server ( sort keys %SN ) {
        foreach my $mydomain (@MYDOMAINS) {
            if ( $SN{$server} eq $mydomain || $SN{$server} eq "www.${mydomain}" ) {
                foreach my $parked ( sort keys %{ $SA{$server} } ) {
                    my (@SPD) = split( / /, $parked );
                    foreach my $parked (@SPD) {
                        $parked =~ s/[\r\n\s]*//g;
                        $parked =~ s/^www\.//g;
                        next if ( $parked =~ /^\*/ );
                        next if ( $parked eq $mydomain );
                        $PARKED{$mydomain}{$parked} = 1;
                    }
                }
            }
        }
    }
    return (%PARKED);
}

sub getmd5sum {
    my ($file) = @_;
    my ($md5);

    if ( -e "/bin/md5sum" || -e "/usr/bin/md5sum" || -e "/usr/local/bin/md5sum" ) {
        open( MD5, "-|" ) || exec 'md5sum', $file;
    }
    else {
        open( MD5, "-|" ) || exec 'md5', "-r", $file;
    }
    while (<MD5>) {
        chomp();
        ( $md5, undef ) = split( /\s+/, $_ );
        last();
    }
    close(MD5);
    return ($md5);
}

sub getssldir {
    my $ssldir;
    if ( -e "/usr/share/ssl" ) {
        $ssldir = "/usr/share/ssl";
    }
    elsif ( -e "/etc/ssl" ) {
        $ssldir = "/etc/ssl";
    }
    elsif ( -e "/var/ssl" ) {
        $ssldir = "/var/ssl";
    }
    else {
        $ssldir = "/usr/local/ssl";
    }
    return ($ssldir);
}

sub runasuser {
    my ( $user, @CMDS ) = @_;

    if ( my $pid = fork() ) {
        waitpid( $pid, 0 );
    }
    else {
        if ( $ENV{'PKG_VERBOSE'} ne "1" ) {
            open( STDERR, ">", "/dev/null" );
        }
        chdir("/");
        setuids($user);
        exec(@CMDS);
        exit();
    }
}

sub findunreadable {
    my (@files) = @_;

    foreach my $file (@files) {
        next if ( -l $file ) || ( ishardlink($file) );
        if ( -d $file ) {
            opendir( DIR, $file );
            my @nfiles = grep { !/^\.+$/ } readdir(DIR);
            my @newfiles;
            foreach my $nfile (@nfiles) {
                push( @newfiles, "${file}/${nfile}" );
            }
            closedir(DIR);
            findunreadable(@newfiles);
        }
        if ( !-r "${file}" ) {
            print "$file\n";
        }
    }

}

sub findunreadablehttpfiles {
    my (@files) = @_;

    foreach my $file (@files) {
        next if ( -l $file ) || ( ishardlink($file) );
        if ( -d $file ) {
            opendir( DIR, $file );
            my @nfiles = grep { !/^\.+$/ } readdir(DIR);
            my @newfiles;
            foreach my $nfile (@nfiles) {
                push( @newfiles, "${file}/${nfile}" );
            }
            closedir(DIR);
            findunreadablehttpfiles(@newfiles);
        }
        if ( !-r "${file}" && ishttpowned($file) ) {
            print "$file\n";
        }
    }

}

sub ishttpowned {
    my ($file) = @_;
    my $gid = ( stat($file) )[5];
    return ( $gid == $httpgid ) ? 1 : 0;
}

sub ishardlink {
    my ($file) = @_;
    return if ( -d $file );
    my $linkage = ( stat($file) )[3];
    return ( $linkage > 1 ) ? 1 : 0;
}

my %PWENTUID = ();
my %PWENTGID = ();

# getcacheduid -
#    param  :
#       user   : Name of the user.
#    return
#       UID for the user.
sub getcacheduid {
    my ($user) = @_;

    if ( !defined( $PWENTUID{$user} ) ) {
        $PWENTUID{$user} = ( getpwnam($user) )[2];
    }
    return $PWENTUID{$user};
}

sub getcachedgid {
    my ($group) = @_;

    if ( !defined( $PWENTGID{$group} ) ) {
        $PWENTGID{$group} = ( getgrnam($group) )[2];
    }
    return $PWENTGID{$group};
}

# syncfile - source, destination [, no_symlinks]
#    Given source and dest, if source's mtime is greater than that
#    of dest's, source will be copied over dest.
# Return Values:  0 - Problem copying.
#                -1 - File not copied,
#                 1 - File copied.
sub syncfile {
    my ( $source, $dest, $no_sym, $no_chown ) = @_;
    my $s_handle;
    my $d_handle;
    my $buff;

    return 0 if ( !-e $source );
    if ( !defined($no_sym) )   { $no_sym   = 0; }
    if ( !defined($no_chown) ) { $no_chown = 0; }

    if ( -d $dest ) {
        $dest =~ s/\/$//g;
        my @SRC = split( /\//, $source );
        $dest .= '/' . $SRC[$#SRC];
        undef @SRC;
    }

    if ($no_sym) {
        if ( is_link($source) || is_link($dest) ) {
            return -1;
        }
    }

    my ( $mode, $uid, $gid, $s_size, $s_mod ) = ( stat($source) )[ 2, 4, 5, 7, 9 ];
    my ( $d_mod, $d_size, $d_mode, $d_uid, $d_gid );
    if ( !-e $dest ) {
        $d_mode = $d_mod = $d_size = 0;
        $d_uid = $d_gid = -1;
    }
    else { ( $d_mode, $d_uid, $d_gid, $d_size, $d_mod ) = ( stat($dest) )[ 2, 4, 5, 7, 9 ]; }

    if ( ( $s_mod != $d_mod ) || ( $d_size != $s_size ) ) {
        copy( $source, $dest );
        $mode = $mode & 07777;
        chmod( $mode, $dest );
        chown( $uid, $gid, $dest ) if ( !$no_chown );
        utime( time, $s_mod, $dest );
    }
    else {
        chown( $uid, $gid, $dest ) if ( ( ( $d_uid != $uid ) || ( $d_gid != $gid ) ) && ( !$no_chown ) );
        return -1;    # Not Copied, but successful.
    }
    return 1;
}

# globsyncfile -
#    Params:
#         source   : csh style glob expression for file matching.
#         dest     : Directory to copy the files into.
#         no_sym   : 1 to not follow symlinks, 0 to follow.
#         no_chown : 1 to disable chowning, 0 to chown.
sub globsyncfile {
    my ( $source, $dest, $no_sym, $no_chown ) = @_;

    my @files = glob $source;
    foreach my $file (@files) {
        syncfile( $file, $dest, $no_sym, $no_chown );
    }
}

# safesync -
#   Parameter Hash:
#           user     : Username of owner.
#           gidlist  : List of group names.
#           source   : Path to source directory.
#           dest     : Path to destination directory.
#           callback : Optional callback reference to be used
#                      instead of copy.
#           chown    : Boolean parameter. If true function
#                      Will chown files (default), if false
#                      it will not chown.
#           exclude  : A regex to compare filenames against,
#                      if file matches, the file will be excluded
#                      from the copy process.
#           delete   : Boolean, if true safesync will delete all
#                      files in dest that are not in source.
#           verbose  : Boolean, if true safesync will print
#                      detailed information on its actions.
#   Returns: Hash, keys are full pathnames of destination
#           files.  Value is a group name if one of the
#           groups from gidlist was able to read the file.
sub safesync {
    my (%OPTS)   = @_;
    my %OLIST    = ();
    my $can_read = 0;

    return 0 if ( !-d $OPTS{source} );
    if ( !defined( $OPTS{chown} ) )   { $OPTS{chown}   = 1; }
    if ( !defined( $OPTS{delete} ) )  { $OPTS{delete}  = 0; }
    if ( !defined( $OPTS{verbose} ) ) { $OPTS{verbose} = 0; }

    if ( !-e $OPTS{dest} ) {
        print "Destination does not exist, creating.\n";
        my ( $mode, $uid, $gid, $s_mod ) = ( stat( $OPTS{source} ) )[ 2, 4, 5, 9 ];
        if ( !mkdir( $OPTS{dest} ) ) {
            die "Unable to create destination directory. Failing.\n";
        }
        chown( $uid, $gid, $OPTS{dest} ) if ( $OPTS{chown} );
        chmod( $mode & 00777, $OPTS{dest} );
        utime( time, $s_mod, $OPTS{dest} );
    }
    elsif ( !-d $OPTS{dest} ) {
        return 0;
    }

    my @new_files = find_files( $OPTS{source} );
    foreach my $file (@new_files) {
        next if !defined($file);
        my $dfile = $file;
        $dfile =~ s/^$OPTS{source}/$OPTS{dest}/;
        if ( defined( $OPTS{exclude} ) ) {
            my $absfile = $file;
            $absfile =~ s#/{2,}#/#g;
            $absfile =~ s#/$##;
            if ( $absfile =~ m/$OPTS{exclude}/ ) {
                print "Excluding File: ${absfile}\n" if ( $OPTS{verbose} );
                next;
            }
        }

        my ( $mode, $uid, $gid, $size, $s_mod );
        if ( -l $file ) {
            ( $mode, $uid, $gid, $size, $s_mod ) = ( lstat($file) )[ 2, 4, 5, 7, 9 ];
        }
        else {
            ( $mode, $uid, $gid, $size, $s_mod ) = ( stat($file) )[ 2, 4, 5, 7, 9 ];
        }
        my $nmode = ( $mode & 0170000 );

        if ( $nmode != 0120000 && $nmode != 0100000 && $nmode != 040000 ) {

            # Next if file isn't a directory, a symlink, or a regular file.
            print "Skipping irregular file: ${file}\n" if ( $OPTS{verbose} );
            next;
        }

        my ( $d_mode, $d_uid, $d_gid, $d_mod, $d_size );
        if ( -e $dfile ) {
            if ( -l $dfile ) {
                ( $d_mode, $d_uid, $d_gid, $d_size, $d_mod ) = ( lstat($dfile) )[ 2, 4, 5, 7, 9 ];
            }
            else {
                ( $d_mode, $d_uid, $d_gid, $d_size, $d_mod ) = ( stat($dfile) )[ 2, 4, 5, 7, 9 ];
            }
        }
        else {
            $d_size = $d_mod = $d_size = 0;
            $d_uid  = $d_gid = -1;
            $d_mode = 00644;
        }
        $mode = $mode & 07777;
        if ( ( $d_mod == $s_mod ) && ( $d_size == $size ) ) {
            chown( $uid, $gid, $dfile ) if ( ( $d_uid != $uid || $d_gid != $gid ) && $OPTS{chown} );
            chmod( $mode, $dfile ) if ( $d_mode != $mode );
            next;
        }

        my ( $user_uid, $user_gid ) = ( getpwnam( $OPTS{user} ) )[ 2, 3 ];
        foreach my $group ( @{ $OPTS{gidlist} } ) {
            my $t_uid = getcacheduid($group);
            my $t_gid = getcachedgid($group);
            if ( ( $mode & 00040 ) && ( $gid == $t_gid ) ) {
                $can_read = 1;
            }
            if ( $uid == $t_uid ) {
                $OLIST{$file} = $group;
            }
        }
        $can_read = 1 if ( ( $user_gid == $gid ) && ( $mode & 00040 ) );
        $can_read = 1 if ( ( $user_uid == $uid ) && ( $mode & 00400 ) );
        $can_read = 0 if ( defined( $OPTS{callback} ) );

        if ($can_read) {
            if ( -l $file ) {
                my $rfile  = readlink($file);
                my $rdfile = readlink($dfile);

                if ( -l $dfile && $rfile eq $rdfile ) { next; }

                $rfile =~ s/^$OPTS{source}/$OPTS{dest}/;
                if ( $OPTS{chown} ) {
                    if ( my $pid = fork() ) {
                        waitpid( $pid, 0 );
                    }
                    else {
                        unlink($dfile);
                        setuids( $uid, $gid );
                        print "Creating symlink: $dfile => $rfile\n" if ( $OPTS{verbose} );
                        if ( !symlink( $rfile, $dfile ) ) { print "Couldn't Link: $rfile => $dfile\n"; }
                        exit;
                    }
                }
                else {
                    print "Creating symlink: $dfile => $rfile\n" if ( $OPTS{verbose} );
                    symlink( $rfile, $dfile );
                }
            }
            elsif ( -d $file ) {
                if ( !-e $dfile ) {
                    print "Creating directory: $dfile\n" if ( $OPTS{verbose} );
                    mkdir($dfile);
                    chown( $uid, $gid, $dfile ) if ( $OPTS{chown} );
                    chmod( $mode, $dfile );
                    utime( time, $s_mod, $dfile );
                }
            }
            else {
                print "Copying ${file} => ${dfile}\n" if ( $OPTS{verbose} );
                copy( $file, $dfile );
                chown( $uid, $gid, $dfile ) if ( $OPTS{chown} );
                chmod( $mode, $dfile );
                utime( time, $s_mod, $dfile );
            }
        }
        elsif ( defined( $OPTS{callback} ) ) {
            &{ $OPTS{callback} }( $file, $dfile );
        }
    }

    # Delete files, if needed.
    if ( $OPTS{delete} ) {
        my @dest_files = find_files( $OPTS{dest} );
        my @dfiles     = ();
        foreach my $file (@dest_files) {
            $file =~ s/^$OPTS{dest}//;
            $file =~ s#/{2,}#/#g;
            $file =~ s#^/##;
            push @dfiles, $file;
        }
        my @nfiles = ();
        foreach my $file (@new_files) {
            $file =~ s/^$OPTS{source}//;
            $file =~ s#/{2,}#/#g;
            $file =~ s#^/##;
            push @nfiles, $file;
        }
        my @dirs = ();
        foreach my $file (@dfiles) {
            next if ( $file =~ m/\.\.?/ );
            if ( !grep( /^\Q${file}\E$/, @nfiles ) ) {
                if ( -d $OPTS{dest} . "/${file}" ) {
                    push @dirs, $file;
                    next;
                }
                print "Deleting file: " . $OPTS{dest} . "/${file}\n" if ( $OPTS{verbose} );
                unlink( $OPTS{dest} . "/${file}" );
            }
        }
        foreach my $dir (@dirs) {
            print "Removing directory: " . $OPTS{dest} . "/${dir}\n" if ( $OPTS{verbose} );
            rmdir( $OPTS{dest} . "/${dir}" );
        }
    }

    return %OLIST;
}

# find_files -
#    Param: Path to directory.
#    Returns: An array containing all
#      filenames and directories contained
#      within the starting directory, and
#      recursively within.
sub find_files {
    my ($start) = @_;

    return undef if ( !-d $start );

    opendir( BASEDIR, $start ) or return undef;
    my @files = readdir(BASEDIR);
    @files = grep( !/^\.+$/, @files );
    closedir(BASEDIR);

    my @new_files = ();
    foreach my $file (@files) {
        if ( -l "${start}/$file" ) {
            push @new_files, "${start}/${file}";
        }
        elsif ( -d "${start}/$file" ) {
            push @new_files, "${start}/${file}";
            my (@nfiles) = find_files("${start}/${file}");
            push @new_files, @nfiles;
        }
        else { push @new_files, "${start}/${file}"; }
    }
    return (@new_files);
}

# copy -
#   Params: Source file, Destination file.
#   Copies source to destination.
sub copy {
    my ( $source, $dest ) = @_;
    my $s_handle;
    my $d_handle;
    my $buff;

    open( $s_handle, "<", $source ) or return 0;
    binmode $s_handle;
    open( $d_handle, ">", $dest ) or return 0;
    binmode $d_handle;

    while ( my $n = sysread( $s_handle, $buff, 4096 ) ) {
        syswrite( $d_handle, $buff, $n );
    }
}

# is_link -
#    Params: Path to a file.
#    Returns true if file is either a symlink or
#    a hardlink.
sub is_link {
    my ($file) = @_;

    if ( !-e $file ) { return 0; }
    if ( -l $file )  { return 1; }
    my $s_links = ( stat($file) )[3];
    if ( $s_links > 1 && !-d $file ) {
        return 1;
    }
}

sub setuids {
    my ($user) = $_[0];
    my ( $uid, $gid );
    if ( $user !~ /^\d+$/ ) {
        ( undef, undef, $uid, $gid ) = getpwnam($user);
    }
    else {
        $uid = $user;
        $gid = ( getpwuid($uid) )[3];
    }
    if ( !( $( = int($gid) ) ) {
        print "error setting gid\n";
        exit;
    }

    if ( !( $) = "$gid $gid" ) ) {
        print "error setting gid\n";
        exit;
    }
    if ( !( ( $< = $uid ) && ( $> = $uid ) ) ) {
        print "error setting uid ($uid) [$user]\n";
    }
    return $<;
}

1;

sub listsubdomains {
    my ( $homedir, @DOMAINS ) = @_;
    my ($httpconf) = find_httpconf();
    my ($d);
    my (%SUBS);
    my (%DR);
    my (@SSD);

    open( HTTPDCONF, "$httpconf" ) || do {
        print "Fatal Error! Unable to open httpd config file $httpconf!\n";
    };
    my $xu = 0;
    my $mvh;
    my $vh;
    while (<HTTPDCONF>) {
        s/\>//g;

        if ( $_ !~ /#/ ) {
            if (/\<virtualhost (\S+)($|\s)/i) {
                $mvh = $1;
                $vh  = 1;
                $xu++;
            }

            if ( $vh == 1 ) {
                if (/servername/i) {
                    foreach my $dns (@DOMAINS) {
                        if (/servername[\s\t]*(\S+)\.${dns}[\s\t]*$/i) {
                            if ( lc($1) ne "www" ) {
                                $d = "$1_$dns";
                                $d =~ s/^\.?www//g;
                                $d =~ s/[\s\r\n]*//g;

                                next if ( $d eq "" || $d eq "." );
                                $SUBS{$d} = $xu;
                                last;
                            }
                        }
                    }
                }
                elsif (/documentroot[\s\t]+(\S+)/i) {
                    $DR{$xu} = $1;
                }
            }
            if (/\<\/virtualhost/i) {
                $vh = 0;
            }
        }
    }
    close(HTTPDCONF);

    foreach my $sub ( sort keys %SUBS ) {
        my $server = $SUBS{$sub};
        if (   beginmatch( $DR{$server}, ${homedir} )
            && !endmatch( $DR{$server}, "public_html/" )
            && !endmatch( $DR{$server}, "public_html" ) ) {
            push( @SSD, $sub );
        }
    }

    return (@SSD);
}

sub beginmatch {
    my ( $haystack, $needle ) = @_;
    if ( substr( $haystack, 0, length($needle) ) eq $needle ) {
        return (1);
    }
    return (0);
}

sub endmatch {
    my ( $haystack, $needle ) = @_;
    if ( substr( $haystack, -1 * length($needle) ) eq $needle ) {
        return (1);
    }
    return (0);
}