#!/usr/bin/perl
# cpanel - pkgacct-enXim                          Copyright(c) 2010 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::Open2;
use IPC::Open3;
use File::Copy;
use File::Find;
use File::Path qw/mkpath/;
use File::Basename qw/dirname/;

use POSIX ();
use Cwd qw/abs_path getcwd/;

my $VIRTUALHOSTING_DIR      = '/etc/virtualhosting';
my $VIRTUALHOSTING_PLAN_DIR = "$VIRTUALHOSTING_DIR/plans";
my $PYTHON                  = find_python() or die('Unable to locate Python binary');

$| = 1;

my $site;
my $user = $ARGV[0] or die('No account specified');

if ( -x '/scripts/prepkgacct' ) {
    print "Running prepkgacct...\n";
    system '/scripts/prepkgacct', $user;
    print "\nDone.\n";
}

_call_hook( 'pkgacct_start', $user );

( $user, $site ) = split /\^/, $user, 2;

my $cpuser = clean_username($user);

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

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

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

if ( $user eq "root" ) {
    print "You cannot copy the root user.\n";
    exit;
}
my $tarroot = '/home';
my $prefix  = 'cpmove-';

my $option     = '';
my $user_check = $user;
if ($site) {
    $option     = '-s';
    $user_check = $site;
}
elsif ( $user =~ /site\d+/ ) {
    $option = '-s';
}
else {
    $option = '-u';
}

my $sitelookup = '/usr/local/bin/sitelookup';

if ( !-e $sitelookup ) {
    print 'Unable to find sitelookup' . "\n";
    exit;
}

my $sitelookup_data = '';
if ( open( my $sitelookup_h, '-|', "$sitelookup $option $user_check" ) ) {
    while ( my $line = <$sitelookup_h> ) {
        $sitelookup_data .= $line;
    }
}
else {
    print 'Unable to open ' . $sitelookup . ' for reading' . "\n";
    exit;
}

my @sitelookup_data = split /\n/, $sitelookup_data;

if ( scalar @sitelookup_data > 1 ) {
    print 'More than one account has the username ' . $user . ".\n";
    print 'Please choose by site name: ' . "\n";
    foreach my $line (@sitelookup_data) {
        chomp($line);
        my ( $dns, $wp_user, $site, $sitedir, $homeuser ) = split ',', $line;
        print "\t" . $dns . ' --> ' . $site . "\n";
    }
    exit;
}

my ( $dns, $wp_user, $sitedir, $homeuser );
( $dns, $wp_user, $site, $sitedir, $homeuser ) = split ',', $sitelookup_data[0];

my $muid = getpwnam($wp_user);

if ( $site eq "" ) {
    print "Invalid user $user\n";
    exit;
}

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

my $sitecdir = '/home/virtual/' . $site . "/info";

my %VIRTUSERS;
mkdir( "$sitedir/etc/$dns", 0700 );
my $site_passwd = ( -e "$sitedir/etc/$dns/passwd" ) ? "$sitedir/etc/$dns/passwd" : "$sitedir/etc/passwd";

open( PASSWD, $site_passwd );
my @badusers = ( 'cnfd', 'mail', 'ftp', 'majordomo' );
while (<PASSWD>) {
    chomp;
    my ( $puser, $ppass, $puid ) = split( /:/, $_ );
    if ( ( grep { $_ eq $puser } @badusers ) or $puid < 500 ) {
        next;
    }
    $VIRTUSERS{$puser} = $puid;
}
close(PASSWD);

my $lcdns          = lc($dns);
my $homedir        = "$sitedir/home/$homeuser";
my @domain_aliases = grep { $_ ne $lcdns } site_domain_aliases($site);
my @subdomains     = subdomains( $lcdns, $site, $sitedir );
my $passwd_data    = get_site_passwd_data($site);

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

print "enXim DNS is $dns\n";

if ( $prefix eq "" && $tarroot eq "/home" ) {
    print "Bailing out .. no prefix set and tarroot is /home\n";
    exit;
}
my $work_dir = "${tarroot}/${prefix}${cpuser}";
if ( $prefix ne "" ) {
    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" );
    }
}

open( CPM, ">${work_dir}.tar.gz" );
close(CPM);
chmod( 0600, "${work_dir}.tar.gz" );

if ( !-e "$work_dir" ) {
    mkdir( "$work_dir",                       0700 );
    mkdir( "${work_dir}/homedir",             0700 );
    mkdir( "${work_dir}/cp",                  0700 );
    mkdir( "${work_dir}/logs",                0700 );
    mkdir( "${work_dir}/mysql",               0700 );
    mkdir( "${work_dir}/mm",                  0700 );
    mkdir( "${work_dir}/mma",                 0700 );
    mkdir( "${work_dir}/mma/pub",             0700 );
    mkdir( "${work_dir}/mma/priv",            0700 );
    mkdir( "${work_dir}/va",                  0700 );
    mkdir( "${work_dir}/fp",                  0700 );
    mkdir( "${work_dir}/vf",                  0700 );
    mkdir( "${work_dir}/sslcerts",            0700 );
    mkdir( "${work_dir}/sslkeys",             0700 );
    mkdir( "${work_dir}/meta",                0700 );
    mkdir( "${work_dir}/bandwidth",           0700 );
    mkdir( "${work_dir}/homedir/tmp",         0755 );
    mkdir( "${work_dir}/homedir/tmp/awstats", 0755 );

}
else {
    print "$work_dir exists, please remove it and try again\n";
    exit;
}

if ( open my $fh, '>', "${work_dir}/meta/html_paths" ) {
    print 'enXim setting up public html symlink...';

    print {$fh} "/home/virtual/${site}/fst/var/www/html\n";
    print {$fh} "/home/virtual/${lcdns}/var/www/html\n";
    close($fh);

    print "Done\n";
}

{
    print 'enXim Copying FrontPage(TM) configuration data...';

    #
    # Provide an association between FrontPage(TM) configuration filenames and
    # the FQDN they will service.  This information will be important when
    # associating a given FrontPage(TM) configuration file with an Apache site
    # config file on the cPanel machine.
    #
    my %host_files = (
        "www.$dns:80.cnf" => "www.$dns",
        "$dns:80.cnf"     => $dns,
        "$dns:443.cnf"    => $dns
    );

    foreach my $file ( keys %host_files ) {
        my $host     = $host_files{$file};
        my $existing = "/usr/local/frontpage/$file";
        my $new      = "$work_dir/fp/$file";

        next unless -f $existing;

        create_patched_frontpage_conf( $existing, $new, { 'host' => $host } );
    }

    print "Done\n";
}

_wait_run(
    sub {
        if ( -e "$sitedir/var/www" ) {
            my @MAPPINGS = (
                [ 'var/www/.htpasswd'                => '.htpasswd' ],
                [ 'var/www/.htgroup'                 => '.htgroup' ],
                [ 'var/www/squirrelmail'             => 'squirrelmail' ],
                [ 'var/www/squirrelmail-attachments' => '.sqmailattach' ],
                [ 'var/www/squirrelmail-data'        => '.sqmaildata' ],
                [ 'var/www/html'                     => 'public_html' ],
                [ 'var/www/cgi-bin'                  => 'public_html/cgi-bin' ],
                [ 'var/www/perl'                     => 'public_html/perl' ],
                [ 'var/www/mivadata'                 => 'mivadata' ],
                [ 'var/ftp'                          => 'public_ftp' ]
            );

            foreach (@MAPPINGS) {
                my $src  = "$sitedir/$_->[0]";
                my $dest = "$work_dir/homedir/$_->[1]";
                next unless -e $src;

                system qw/cp -a/, $src, $dest;
            }
        }
    }
);

print "Done\n";

print 'enXim Copying contact email...';
my $data = info_data( 'siteinfo', $site );
my $contactemail = $data->{'default'}{'email'};
if ( open( my $fh, '>', "${work_dir}/homedir/.contactemail" ) ) {
    print {$fh} $contactemail;
    close($fh);
}
print "Done\n";

print 'enXim Copying SSL Certificates, CSRS, and Keys...';
my $ssldir = "$sitedir/etc/httpd/conf";
if ( -e "${ssldir}/ssl.crt/server.crt" ) {
    print "..${dns}.crt..";
    system( "cp", "-f", "${ssldir}/ssl.crt/server.crt", "${work_dir}/sslcerts/${dns}.crt" );
}
if ( -e "$ssldir/ssl.crt/intermediate.crt" ) {
    print "..{$dns}.cabundle..";
    system( qw/cp -f/, "${ssldir}/ssl.crt/intermediate.crt", "$work_dir/sslcerts/${dns}.cabundle" );
}
if ( -e "${ssldir}/ssl.key/server.key" ) {
    print "..${dns}.key..";
    system( "cp", "-f", "${ssldir}/ssl.key/server.key", "${work_dir}/sslkeys/${dns}.key" );
}
print "Done\n";

print 'enXim Copying Bandwidth Data...';

$site =~ /^site(\d+)$/;
my $site_id = int($1);

my @bandwidth_samples = psql_query(
    'appldb', qq{
    select
        bs.name as service,
        bl.site_id,
        bl.in_bytes,
        bl.out_bytes,
        bl.ts
    from
        bandwidth_services bs,
        bandwidth_log bl
    where
        bs.svc_id = bl.svc_id
        and bl.site_id = $site_id
    order by
        bl.site_id,
        bl.ts
}
);

my %service_translations = (
    qr/^pop$/i   => 'pop3',
    qr/^https /i => 'https',
    qr/^http /i  => 'http'
);

my $daily_bandwidth = {};

foreach my $sample (@bandwidth_samples) {
    my $timestamp = $sample->{'ts'};
    $timestamp =~ /^([0-9]{4})-([0-9]{2})-([0-9]{2}) /;

    my $date = sprintf( "%.2d.%.2d.%.4d", $2, $3, $1 );

    #
    # Translate the service name found in the database into a form suitable for our
    # bandwidth log format.
    #
    my $service = lc( $sample->{'service'} );

    foreach my $pattern ( keys %service_translations ) {
        my $translation = $service_translations{$pattern};

        if ( $service =~ $pattern ) {
            $service = $translation;
            last;
        }
    }

    $daily_bandwidth->{$date}->{$service} += int( $sample->{'in_bytes'} ) + int( $sample->{'out_bytes'} );
}

if ( open( my $bwfile, '>', "${work_dir}/bandwidth/${user}" ) ) {
    foreach my $date ( sort keys %{$daily_bandwidth} ) {
        my $readings = $daily_bandwidth->{$date};
        my $total    = 0;

        foreach my $service ( sort keys %{$readings} ) {
            my $reading = $readings->{$service};
            $total += $reading;
            print( $bwfile "${date}-${service}=${reading}\n" );
        }

        print( $bwfile "${date}-all=${total}\n" );
    }

    close $bwfile;

    system( "cp", "-f", "${work_dir}/bandwidth/${user}", "${work_dir}/bandwidth/${dns}" );
}
else {
    print "Could not open bandwidth file in working directory\n";
}

print "Done\n";

print "Copying AWstats info...\n";
my $awstatsdir = "${sitedir}/var/www/cgi-bin/awstats/data";
opendir( my $cgi_h, $awstatsdir );
foreach my $awstats_file ( readdir $cgi_h ) {
    next if $awstats_file !~ /awstats/;
    $awstats_file =~ /(^awstats\d+)\.txt/;
    my $awbasename = $1;
    system( "cp", "-f", "${awstatsdir}/${awstats_file}", "${work_dir}/homedir/tmp/awstats/${awbasename}.${dns}.txt" );
}
closedir $cgi_h;
print "Done\n";

{
    my %webalizer_dirs = (
        "$sitedir/var/www/html/webalizer/web" => "$work_dir/homedir/tmp/webalizer",
        "$sitedir/var/www/html/webalizer/ftp" => "$work_dir/homedir/tmp/webalizerftp"
    );

    print "Copying Webalizer data...";

    foreach my $src ( keys %webalizer_dirs ) {
        next unless -d $src;

        my $dest = $webalizer_dirs{$src};

        system( qw(cp -Rp), $src, $dest ) == 0 or die("Failed to copy Webalizer data from $src to $dest: $!");
    }

    print "Done\n";
}

if (@domain_aliases) {
    print "Storing parked domains and mail domain aliases....\n";

    #
    # Write out the mail domain alias files, first.
    #
    my $dir = "$work_dir/vad";
    mkdir($dir) unless -d $dir;

    foreach my $alias (@domain_aliases) {
        my $mail_virtual_alias_file = "$dir/$alias";

        next unless open( my $fh, '>', $mail_virtual_alias_file );
        print $fh "$alias: $lcdns\n";
        close($fh);
    }

    #
    # Next, write out the parked domain file.
    #
    if ( open( my $fh, '>', "$work_dir/pds" ) ) {
        foreach my $alias (@domain_aliases) {
            print $fh "$alias\n";
        }

        close($fh);
        print "Done.\n";
    }
    else {
        print "Unable to save parked domains.\n";
    }
}

if (@subdomains) {
    print "enXim Saving subdomain data...\n";

    open( my $sds_fh,  '>', "$work_dir/sds" )  or die("Unable to open subdomain file $work_dir/sds: $!");
    open( my $sds2_fh, '>', "$work_dir/sds2" ) or die("Unable to open new format subdomain file $work_dir/sds2: $!");

    foreach my $subdomain (@subdomains) {
        print " + $subdomain->{'fqdn'}\n";
        print {$sds_fh} "$subdomain->{'cpanel_fqdn'}\n";
        print {$sds2_fh} "$subdomain->{'cpanel_fqdn'}=$subdomain->{'cpanel_docroot'}\n";
    }

    close($sds2_fh);
    close($sds_fh);

    print "...Done\n";
}

if ( open( my $access_fh, '<', "$sitedir/etc/mail/access") ) {
    print("enXim Copying mail access lists...");

    my $yaml_format = <<EOF;
  -
    actions:
      -
        action: save
        dest: /dev/null
    filtername: %s
    rules:
      -
        match: is
        opt: or
        part: "\$header_from:"
        val: %s
EOF

    my $exim_format = <<EOF;
#%s
if
 \$header_from: is "%s"
then
 save "/dev/null" 660
endif
EOF

    my $cpanel_dir = "$work_dir/homedir/.cpanel";
    mkdir($cpanel_dir) unless -d $cpanel_dir;

    open( my $yaml_fh, '>', "$cpanel_dir/filter.yaml" ) or die("Unable to open Exim filter YAML file for writing: $!");
    open( my $exim_fh, '>', "$work_dir/vf/$dns" ) or die("Unable to open Exim filter file for writing: $!");

    print( $yaml_fh "---\nfilter:\n" );
    print( $exim_fh "# Exim filter\n\n" );

    while (<$access_fh>) {
        chomp;

        next if /^\s*(#|$)/;
        my ( $recipient, $action ) = split( /\s+/, $_, 2 );
        next unless $action eq 'REJECT';

        my $name = "Reject $recipient";

        printf( $yaml_fh $yaml_format, $name, $recipient );
        printf( $exim_fh $exim_format, $name, $recipient );
    }

    close($exim_fh);
    close($yaml_fh);
    close($access_fh);

    printf("Done\n");
}

if ( open( my $alias_fh, '<', "$sitedir/etc/aliases" ) ) {

    # tidyoff
    my %EXCLUSIONS = map { $_ => 1 } (
        qw(MAILER-DAEMON postmaster site_blackhole root),

        map {
            ( "$_", "$_-outgoing", "$_-list", "owner-$_", "$_-owner", "$_-approval", "$_-request" )
        } majordomo_lists($sitedir)
    );
    # tidyon

    open( my $va_fh, '>', "$work_dir/va/$dns" ) or die("Unable to open $work_dir/va/$dns for writing: $!");

    print "enXim Copying Mail files....";

    while (<$alias_fh>) {
        if (/^([^:]+):\s*([^,]+)\s*,\s*"\|responder\.sh\s+(\S+)\s+(\S+)"$/) {
            #
            # Copy Ensim autoresponders in a form usable by cPanel.
            #
            my $autorespond_name  = "$1\@$dns";
            my $autorespond_alias = $2;
            my $autorespond_file  = "$sitedir/$4";
            my $autorespond_dir   = "$work_dir/homedir/.autorespond";

            mkdir( $autorespond_dir, 0700 ) unless -d $autorespond_dir;

            if ( open( my $conf_fh, '>', "$autorespond_dir/$autorespond_name.conf" ) ) {
                print( $conf_fh "interval=28800\n" );
                close($conf_fh);
            }
            else {
                die("Unable to open $autorespond_dir/$autorespond_name.conf for writing: $!");
            }

            if ( open( my $autorespond_in_fh, '<', $autorespond_file ) ) {
                my $autorespond_out_fh;

                unless ( open( $autorespond_out_fh, '>', "$autorespond_dir/$autorespond_name" ) ) {
                    die("Unable to write autoresponder file $autorespond_dir/$autorespond_name");
                }

                print( $autorespond_out_fh "From: $autorespond_name\n" );
                print( $autorespond_out_fh "Content-type: text/plain; charset=utf-8\n" );

                #
                # Ensim stores the subject of the automatic response in the
                # first line of its response file.  Keep track of this and format
                # it properly in the output.
                #
                my $subject = 1;

                while ( my $line = readline($autorespond_in_fh) ) {
                    chomp($line);

                    if ($subject) {
                        print( $autorespond_out_fh "Subject: $line\n\n" );
                        $subject = 0;
                    }
                    else {
                        print( $autorespond_out_fh "$line\n" );
                    }
                }

                close($autorespond_out_fh);
                close($autorespond_in_fh);
            }
            else {
                die("Unable to open autoresponder file $autorespond_file");
            }

            printf( $va_fh "%s: %s@%s,\"|/usr/local/cpanel/bin/autorespond %s /home/%s/.autorespond\"\n",
                $autorespond_name, $autorespond_alias, $dns, $autorespond_name, $cpuser
            );
        }
        elsif (/^([^\:]+):\s*(\S+)/) {
            #
            # Handle all other alias declarations.
            #
            my (@ALLDESTS);
            my $dest = $1;
            my @REALDESTS = split( /\,/, $2 );

            #
            # Skip any alias entries if the current local part is listed as an
            # exclusion.
            #
            next if exists $EXCLUSIONS{$dest};

            if ( $dest eq "catch-all" ) {
                $dest = '*';
            }
            elsif ( $dest !~ /\@/ ) {
                $dest .= '@';
                $dest .= $lcdns;
            }

            foreach my $realdest (@REALDESTS) {
                $realdest =~ s/^[\s\t]*|[\s\t]*$//g;
                next if ( $realdest eq "" );
                if (   $realdest !~ /\@/
                    && $realdest !~ /\|/
                    && $realdest ne "/dev/null"
                    && $realdest ne $user ) {
                    $realdest .= '@';
                    $realdest .= $lcdns;
                }
                push( @ALLDESTS, $realdest );
            }

            @ALLDESTS = grep( !/majordomo/, @ALLDESTS );
            next if ( $#ALLDESTS == -1 );
            print( $va_fh "$dest: " . join( ',', @ALLDESTS ) . "\n" );
        }
    }

    close($va_fh);
    close($alias_fh);

    print "Done\n";
}

if ( $passwd_data && open( my $pamlist_fh, '<', "$sitedir/etc/proftpd.pamlist" ) ) {
    print("enXim Copying proftpd file....");

    open( my $passwd_fh, '>', "$work_dir/proftpdpasswd" ) or die("Unable to open proftpdpasswd file for writing: $!");

    while (<$pamlist_fh>) {
        chomp;

        my $passwd       = $passwd_data->{$_} or next;
        my $work_homedir = "$work_dir/homedir/public_html/$_";
        my $real_homedir = "/home/$cpuser/public_html/$_";

        unless ( -d $work_homedir ) {
            mkpath($work_homedir) or die("Unable to create home directory for FTP user $_: $!");
        }

        printf( $passwd_fh "%s:%s:-1:-1::%s:/bin/ftpsh\n", $_, $passwd->{'passwd'}, $real_homedir );
    }

    close($passwd_fh);
    close($pamlist_fh);

    print("Done\n");
}

if ( my $info = info_data( 'anonftp', $site ) ) {
    print 'enXim Setting up anonymous FTP permissions...';
    chmod( $info->{'default'}->{'enabled'} == 1 ? 0755 : 0750, "$work_dir/homedir/public_ftp" );
    print "Done\n";
}

print "enXim Copying www logs....";

_wait_run(sub {
    diskcheck();
    system("cat $sitedir/var/log/httpd/access_log* > ${work_dir}/logs/${lcdns} 2>/dev/null");
});

print "Done\n";

unless ($skipacctdb) {
    my $mysql_ini = info_data( 'mysql', $site );

    if ( exists $mysql_ini->{'default'}{'enabled'} && $mysql_ini->{'default'}{'enabled'} && mysql_version() =~ /^4|^5/ ) {
        my $db_user   = $mysql_ini->{'default'}{'dbaseadmin'};
        my $db_prefix = $mysql_ini->{'default'}{'dbaseprefix'};

        print "enXim Grabbing mysql grants...\n";

        my $user_databases = get_mysql_databases($db_user);

        my $grants = get_grants($db_user);

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

        print "Done\n";

        if ( open( my $grants_h, '>', "${work_dir}/mysql.sql" ) ) {
            foreach my $grant ( @{$grants} ) {
                print {$grants_h} $grant . "\n";
            }
            print {$grants_h} 'FLUSH PRIVILEGES;' . "\n";
        }
        else {
            print 'Unable to create mysql.sql' . "\n";
        }
    }
}

print "enXim Copying homedir....";

_wait_run(sub {
    tarcopy( $homedir, "${work_dir}/homedir/" );
});

system( "rm", "-f",  "${work_dir}/homedir/mainwebsite_html" );
system( "rm", "-f",  "${work_dir}/homedir/mainwebsite_perl" );
system( "rm", "-f",  "${work_dir}/homedir/mainwebsite_cgi" );
system( "rm", "-rf", "${work_dir}/homedir/mail" );

print "enXim Copying subdomains....";

_wait_run(
    sub {
        foreach my $subdomain (@subdomains) {

            #
            # Skip copying the wildcard subdomain, since it actually refers to the
            # main site itself.
            #
            next if $subdomain->{'name'} eq '*';

            mkdir( "$work_dir/homedir/$subdomain->{'cpanel_docroot'}", 0755 );

            if ( -e $subdomain->{'docroot'} ) {
                chdir( $subdomain->{'docroot'} );
                diskcheck();
                system("tar -c . | tar -C ${work_dir}/homedir/$subdomain->{'cpanel_docroot'} -x");
            }
        }
    }
);

print "Done\n";

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

if ( my $passwd_data = get_site_passwd_data($site) ) {
    my $etc_dir = "$work_dir/homedir/etc/$dns";

    mkdir( $etc_dir, 0755 ) unless -d $etc_dir;
    open( my $quota_fh, '>', "$etc_dir/quota" ) or die("Unable to open quota file for writing: $!");

    foreach my $name ( keys %{$passwd_data} ) {
        my $pwent = $passwd_data->{$name};

        next if ( !$VIRTUSERS{$name} );

        if ( my $quota = get_user_quota( $pwent->{'uid'} ) ) {
            printf( $quota_fh "%s:%d\n", $name, $quota );
        }

        my $maildir = $name eq $homeuser ? 'mail' : "mail/$dns/$name";

        mkpath( "$work_dir/homedir/$maildir", 0755 );

        _wait_run(
            sub {
                system( qw(cp -a), "$sitedir/var/spool/mail/$name", "$work_dir/homedir/$maildir/inbox" );
            }
        );

        my $mailboxlist = "$sitedir/home/$name/.mailboxlist";
        my $forward     = "$sitedir/home/$name/.forward";
        my @mbx_files;
        my @subscriptions;

        if ( open( my $forward_fh, '<', $forward ) ) {
            open( my $va_fh, '>>', "$work_dir/va/$dns" ) or die("Unable to open virtual alias file: $!");

            my @destinations;

            while ( my $line = readline($forward_fh) ) {
                chomp $line;

                #
                # If we've found a line that uses the system vacation(1) command
                # to act as an autoresponder, which Ensim will always list in
                # the following manner:
                #
                #     \localpart, "|vacation username"
                #
                # ...then record an alias entry destined for the corresponding
                # full email address based on the local part found.
                #
                if ( $line =~ /^\\([^,]+), "\|vacation [^,]+"$/ ) {
                    my $address = "$1\@$dns";

                    my $autorespond_dir  = "$work_dir/homedir/.autorespond";
                    my $autorespond_file = "$autorespond_dir/$address";
                    my $autorespond_conf = "$autorespond_dir/$address.conf";

                    #
                    # It just so happens that the vacation(1) message file is
                    # in the same format as is acceptable for consumption by
                    # /u/l/c/bin/autorespond, so later, we will simply copy
                    # this.
                    #
                    my $vacation_msg = "$sitedir/home/$name/.vacation.msg";

                    next unless -f $vacation_msg;
                    mkdir $autorespond_dir, 0700 unless -d $autorespond_dir;

                    #
                    # Emails which receive an automated response should be
                    # forwarded both to the local user, as well as the
                    # autoresponder program.
                    #
                    push @destinations, $address;
                    push @destinations, qq("|/usr/local/cpanel/bin/autorespond $address /home/$cpuser/.autorespond");

                    #
                    # Copy the vacation(1) message to the location that the
                    # cPanel autoresponder program will know to look for
                    # when handling an autoresponse for a given destination.
                    #
                    #
                    # Convert the vacation(1) message file in a manner acceptable
                    # for use in cPanel.
                    #
                    convert_vacation_message_file( $vacation_msg, $autorespond_file, { 'from' => $address } );

                    #
                    # Write a short configuration file for the autoresponder to
                    # indicate that an automated response should only be dispatched
                    # once a year, based on a requirement in case 46811 that these
                    # vacation(1)-based autoresponders be "one-time-only".
                    #
                    if ( open( my $autorespond_conf_fh, '>', $autorespond_conf ) ) {
                        print {$autorespond_conf_fh} "interval=31536000\n";
                        close $autorespond_conf_fh;
                    }
                    else {
                        die("Unable to open $autorespond_conf_fh for writing: $!");
                    }

                    #
                    # Use 'next' since this is really just a special case in the grand
                    # scheme of things.
                    #
                    next;
                }

                push @destinations, split( /\s*,\s*/, $line );
            }

            print {$va_fh} "$name\@$dns: " . join( ', ', @destinations ) . "\n";

            close($va_fh);
            close($forward_fh);
        }

        if ( -f $mailboxlist ) {
            my $mailboxfiles = _read_flat_file($mailboxlist);

            foreach my $imap_mailbox (@$mailboxfiles) {
                push @subscriptions, $imap_mailbox;

                my $cpanel_mailbox   = "$maildir/$imap_mailbox";
                my $real_mailbox     = "$sitedir/home/$name/$imap_mailbox";
                my $work_mailbox     = "$work_dir/homedir/$cpanel_mailbox";
                my $work_mailbox_dir = dirname($work_mailbox);

                unless ( -d $work_mailbox_dir || $work_mailbox_dir eq '.' ) {
                    mkpath($work_mailbox_dir);
                }

                if ( -d $real_mailbox ) {
                    mkdir($work_mailbox);
                }
                else {
                    copy( $real_mailbox, $work_mailbox );
                    push @mbx_files, $cpanel_mailbox if _lazyrun( 'file', $real_mailbox ) =~ /: MBX mail folder$/i;
                }
            }
        }

        if ( open( my $fh, '>>', "${work_dir}/meta/mbx" ) ) {
            foreach my $mbx_file (@mbx_files) {
                print {$fh} $mbx_file . "\n";
            }
            close($fh);
        }

        if ( open( my $fh, '>', "$work_dir/homedir/$maildir/subscriptions" ) ) {
            foreach my $subscription (@subscriptions) {
                $subscription =~ s/\//\./g;
                print {$fh} "INBOX.$subscription\n";
            }

            close($fh);
        }

        my $nodotdns;
        ( $nodotdns = $dns ) =~ s/\./_/g;

        mkdir( "${work_dir}/homedir/etc/$dns", 0755 );
        open( PASSWD, ">>${work_dir}/homedir/etc/$dns/passwd" );
        print PASSWD "$name:x:-1:-1:$cpuser:/home/${cpuser}/mail/$dns/$name:/usr/local/cpanel/bin/noshell\n";
        close(PASSWD);
        chmod( 0600, "${work_dir}/homedir/etc/$dns/shadow" );
        open( PASSWD, ">>${work_dir}/homedir/etc/$dns/shadow" );
        print PASSWD "${name}:$pwent->{'passwd'}:::::::\n";
        close(PASSWD);
        chmod( 0600, "${work_dir}/homedir/etc/$dns/shadow" );
    }

    close($quota_fh);
}

if ( open ( my $fh, '>', "$work_dir/meta/mailserver" ) ) {
    print {$fh} "courier\n";
    close($fh);
}

symlink( "public_html/cgi-bin",              "${work_dir}/homedir/cgi-bin" );
symlink( "public_ftp",                       "${work_dir}/homedir/anon_ftp" );
symlink( "/usr/local/apache/domlogs/${dns}", "${work_dir}/homedir/logs/access_log" );

{
    print 'enXim Creating cpuser file...';

    my %data = (
        'IP'        => 'n',
        'DNS'       => $lcdns,
        'PLAN'      => get_account_plan_name( $site ),
        'STARTDATE' => time,
        'BWLIMIT'   => get_bandwidth_limit( $site ) || 0,
        'MAXPARK'   => ( info_data( 'aliases', $site )->{'default'}->{'enabled'} ) eq '1'? 'unlimited': '0',
    );

    #
    # Copy the site domain aliases into the config file as well.  Email domain
    # forwarders and the like will depend on these entries being present in the
    # cpuser config file for this account.
    #
    my $dns_number = 1;

    foreach (@domain_aliases) {
        $data{"DNS$dns_number"} = $_;
        $dns_number++;
    }

    if ( my $ipinfo = info_data( 'ipinfo', $site ) ) {
        if ( $ipinfo->{'default'}->{'enabled'} eq '1' && $ipinfo->{'default'}->{'namebased'} eq '0' ) {
            $data{'ip'} = 'y';
        }
    }

    if ( open( my $cpu_fh, '>', "$work_dir/cp/$cpuser") ) {
        foreach ( keys %data ) {
            printf( $cpu_fh "%s=%s\n", $_, $data{$_} );
        }

        close( $cpu_fh );
    }

    print "Done\n";
}

{
    print 'enXim Setting up user shell...';
    my $shell = '/usr/local/bin/noshell';

    if ( my $info = info_data( 'ssh', $site ) ) {
        if ( $info->{'default'}->{'enabled'} eq '1' ) {
            $shell = $info->{'default'}->{'jail'} eq '1' ? '/usr/local/cpanel/bin/jailshell' : '/bin/bash';
        }
    }

    open( my $fh, '>', "$work_dir/shell" ) or die("Unable to open $work_dir/shell for writing: $!");
    print( $fh $shell );
    close($fh);

    print "Done\n";
}

print "enXim Copying quota info.......";
open( QUOTA, ">${work_dir}/quota" );
open( QINFO, "$sitecdir/current/diskquota" );

my $quota;

while (<QINFO>) {
    if (/^quota\s*=\s*(\d+)/) {
        $quota = $1;
    }
}
close(QINFO);
print QUOTA "$quota";
close(QUOTA);
print "Done\n";

print "enXim Copying password.......";
open( SH, ">${work_dir}/shadow" );
open( S,  "$sitedir/etc/shadow" );

my ( $muser, $passwd, $pass );

while (<S>) {
    ( $muser, $passwd, undef ) = split( /:/, $_, 3 );
    if ( $homeuser eq $muser ) {
        $pass = $passwd;
        last;
    }
}
close(S);
print SH "$pass";
close(SH);
print "Done\n";

_wait_run(sub {
    if ( -e "$sitedir/var/www/html/" ) {
        opendir( my $dir_h, "$sitedir/var/www/html/" );
        my @files = grep { !/^\.\.?$/ } readdir($dir_h);
        close($dir_h);
        foreach my $file (@files) {
            diskcheck();
            system( 'cp', '-ar', "$sitedir/var/www/html/$file", "${work_dir}/homedir/public_html" );
        }
    }
});

print "Done\n";

{
    print 'enXim Converting password protected directories...';
    print convert_all_htaccess_files( $work_dir, $sitedir, $homeuser ) ? "Done\n" : "Failed\n";
}

{
    print 'enXim Archiving Majordomo data into homedir...';

    if ( my $tarball = archive_majordomo( $site, $work_dir ) ) {
        print "Done\n";
    }
    else {
        print "Failed\n";
    }
}

_call_hook( 'pkgacct_pre_archive', $cpuser, $user, $work_dir );

chdir($tarroot) or die("Unable to chdir() into tarball directory $tarroot: $!");
print 'enXim Creating archive...';
my $parts    = [];
my $splitdir = "$work_dir-split";
if ($nosplit) {
    _wait_run(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",
        }
    );

    unlink("$work_dir.tar.gz") if -f "$work_dir.tar.gz";
}

if ( -d "$work_dir" && !-l "$work_dir" ) {
    system( "rm", "-rf", "$work_dir" ) unless $nosplit;
}

print "Done\n";

print "realusername is: $cpuser\n";
if ( !$nosplit && @{$parts} ) {

    if ( -x '/scripts/postpkgacct' ) {
        print "Running postpkgacct...";
        system( '/scripts/postpkgacct', 'split', $cpuser, $user, $splitdir );
        print "Done.\n";
    }

    _call_hook( 'pkgacct_post_archive', 'split', $cpuser, $user, $splitdir );

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

        if ( my $size = eval { uncompressed_gzip_size("$splitdir/$part") || 0 } ) {
            printf( "splitsize is: %d\n", $size );
        }
    }
}
else {
    if ( -x '/scripts/postpkgacct' ) {
        print "Running postpkgacct...\n";
        system( '/scripts/postpkgacct', 'nosplit', $cpuser, $user, "${work_dir}.tar.gz" );
        print "\nDone.\n";
    }

    _call_hook( 'pkgacct_post_archive', 'nosplit', $cpuser, $user, "$work_dir.tar.gz" );

    print "pkgacctfile is: ${work_dir}.tar.gz\n";
    my $md5sum = md5("${work_dir}.tar.gz");
    print "md5sum is: $md5sum\n";

    if ( my $size = eval { uncompressed_gzip_size("$work_dir.tar.gz") || 0 } ) {
        printf( "size is: %d\n", $size );
    }
}

sub _strip {
    my ($s) = @_;

    chomp($s);
    $s =~ s/^\s+//;
    $s =~ s/\s+$//;

    $s;
}

sub _unquote {
    my ($s) = @_;

    if ( $s =~ /^'([^']+)'$/ || $s =~ /^"([^"]+)"$/ ) {
        $s = $1;
    }

    $s;
}

sub read_ini_file {
    my ($file) = @_;
    my ( $section, $key, $ret ) = ( undef, undef, {} );

    open( my $fh, '<', $file ) or die("Unable to open configuration file $file for reading");

    while ( my $buf = readline($fh) ) {
        next unless my $line = _strip($buf);

        if ( $line =~ /^([^=]+)=(.*)$/ ) {

            # Key-value assignments
            $section                 = 'default' unless defined $section;
            $key                     = _strip($1);
            $ret->{$section}->{$key} = _unquote( _strip($2) );
        }
        elsif ( $line =~ /^\[([^\[\]]+)\]$/i ) {

            # Section headers
            $section = _strip( lc $1 );
            $ret->{$section} ||= {};
        }
        else {

            # Line continuations
            die("Syntax error: $line") unless defined $ret->{$section}->{$key};
            $ret->{$section}->{$key} .= ' ' . _strip($line);
        }
    }

    close($fh);

    return $ret;
}

sub read_htpasswd_file {
    my ($file) = @_;
    my $ret = {};

    open( my $fh, $file ) or die("Unable to open htpasswd file $file for reading");

    while ( my $buf = readline($fh) ) {
        my $line = _strip($buf);
        next if $line =~ /^#/;
        next unless $line =~ /^([^:]+):([^:]+)$/;

        $ret->{$1} = $2;
    }

    close($fh);

    return $ret;
}

sub read_htgroup_file {
    my ($file) = @_;
    my $ret = {};

    open( my $fh, '<', $file ) or die("Unable to open htgroup file $file for reading");

    while ( my $buf = readline($fh) ) {
        my $line = _strip($buf);
        next unless $line =~ /^([^:]+):(.*)$/;

        $ret->{$1} = [ split /\s+/, _unquote( _strip($2) ) ];
    }

    return $ret;
}

sub write_htpasswd_file {
    my ( $file, $data ) = @_;

    open( my $fh, '>', $file ) or die("Unable to open htpasswd file $file for writing");

    foreach ( keys %$data ) {
        printf( $fh "%s:%s\n", $_, $data->{$_} );
    }

    close($fh);
}

sub read_htaccess_file {
    my ($file) = @_;
    my ( %ret, @lines );

    open( my $fh, $file ) or die("Unable to open htaccess file $file for reading");

    while ( my $buf = readline($fh) ) {
        my $line = _strip($buf);
        push @lines, $line;

        next if $line =~ /^[#<]/;
        next unless $line =~ /^([a-z0-9]+)\s+(.*)$/i;

        $ret{$1} = [ split /\s+/, _unquote( _strip($2) ) ];
    }

    close($fh);

    $ret{'_lines'} = \@lines;

    return \%ret;
}

sub write_htaccess_file {
    my ( $file, $data ) = @_;

    open( my $fh, '>', $file ) or die("Unable to open htaccess file $file for writing");

    foreach my $line ( @{ $data->{'_lines'} } ) {
        foreach my $key (%$data) {
            if ( $line =~ /^$key/ ) {
                $line = $key . ' ' . join( ' ', @{ $data->{$key} } );
            }
        }

        print $fh $line . "\n";
    }

    close($fh);
}

sub convert_htaccess_file {
    my ( $file, $main_htpasswd, $main_htgroup, $work_dir ) = @_;

    my $work_htmldir = "$work_dir/homedir/public_html";

    return 0 unless -f $file;

    #
    # Retrieve the parsed htaccess data from the file passed, as well as
    # the line-by-line data stored therein, for easier reproduction upon
    # writing any changes.
    #
    my $htaccess = read_htaccess_file($file) or return 0;

    #
    # Determine the location of the password file this htaccess file
    # references.  Return 1 if no AuthUserFile was mentioned in this
    # htpasswd file, as this is not necessarily an erroneous condition.
    #
    my $htpasswd_file = $htaccess->{'AuthUserFile'}->[0] or return 1;

    #
    # Obviously, we want the above htpasswd file to exist.
    #
    return 0 unless -f $htpasswd_file;

    #
    # Are we dealing with an htaccess file that references the "main" htpasswd file?
    #
    if ( $htpasswd_file eq "$sitedir/var/www/.htpasswd" ) {

        #
        # Obtain the relative destination directory for any new htpasswd data
        # files, the destination path for both the working account and real restored
        # path, and the location of the password files themselves.
        #
        my $relative_dir = dirname( substr( $file, length("$work_dir/homedir/") ) ) || '.';
        my $relative_dest_dir = ".htpasswds/$relative_dir";

        my $work_dest_dir = "$work_dir/homedir/$relative_dest_dir";
        my $real_dest_dir = "/home/$homeuser/$relative_dest_dir";

        my $work_htpasswd_file = "$work_dest_dir/htpasswd";
        my $real_htpasswd_file = "$real_dest_dir/htpasswd";

        #
        # Attempt to create the new, mapped htpasswd directory structure.
        #
        unless ( -d $work_dest_dir ) {
            mkpath($work_dest_dir) or die("Unable to create htpasswd directory $work_dest_dir");
        }

        my $new_htpasswd = {};

        #
        # If the htaccess file lists a group in which the user must authenticate
        # in, then stow the users and their passwords into the new htpasswd
        # hash.  Otherwise, simply read the one mentioned and recreate it shortly.
        #
        if ( $htaccess->{'require'}->[0] eq 'group' ) {
            my $group = $htaccess->{'require'}->[1];

            foreach ( @{ $main_htgroup->{$group} } ) {
                $new_htpasswd->{$_} = $main_htpasswd->{$_};
            }
        }
        else {
            $new_htpasswd = eval { read_htpasswd_file($htpasswd_file) } || {};
        }

        #
        # Update the existing htaccess file in place, with the location of the new
        # htpasswd file.
        #
        $htaccess->{'AuthUserFile'}  = [$real_htpasswd_file];
        $htaccess->{'AuthGroupFile'} = [qw/none/];
        $htaccess->{'require'}       = [qw/valid-user/];

        write_htpasswd_file( $work_htpasswd_file, $new_htpasswd );
        write_htaccess_file( $file, $htaccess );
    }
    else {
        my $old_htmldir = "$sitedir/var/www/html";
        my $new_htmldir = "/home/$homeuser/public_html";

        my $dirty = 0;

        foreach my $key (qw/AuthUserFile AuthGroupFile/) {
            next unless my $value = $htaccess->{$key}->[0];

            $value =~ s|^$old_htmldir/|$new_htmldir/|;
            $htaccess->{$key}->[0] = $value;

            $dirty = 1;
        }

        if ($dirty) {
            write_htaccess_file( $file, $htaccess ) or return 0;
        }
    }

    return 1;
}

sub convert_all_htaccess_files {
    my ( $work_dir, $sitedir, $homeuser ) = @_;

    my $main_htpasswd = eval { read_htpasswd_file("$work_dir/homedir/.htpasswd") || {} };
    my $main_htgroup  = eval { read_htgroup_file("$work_dir/homedir/.htgroup")   || {} };

    my $ret = 1;

    find(
        sub {
            return unless $_ eq '.htaccess';

            $ret = 0 unless convert_htaccess_file( $File::Find::name, $main_htpasswd, $main_htgroup, $work_dir );
        },
        "$work_dir/homedir"
    );

    return $ret;
}

sub read_domain_mappings {
    my $file = '/etc/virtualhosting/mappings/domainmap';
    return {} unless -f $file;
    return eval { read_ini_file($file) } || {};
}

sub subdomains {
    my ( $domain, $site, $sitedir ) = @_;
    my $cwd = getcwd();
    my $dir = "$sitedir/var/subdomain";
    my @ret;

    #
    # First, take a look to see if the wildcard subdomain is enabled for this site.
    #
    my $data = eval { info_data( 'subdomain', $site ) } || {};

    if ( exists $data->{'default'}->{'wildcards'} && $data->{'default'}->{'wildcards'} eq '1' ) {
        push @ret,
          {
            'name'           => '*',
            'fqdn'           => "*.$domain",
            'docroot'        => "$sitedir/$data->{'default'}->{'base'}",
            'cpanel_name'    => '*',
            'cpanel_fqdn'    => "*_$domain",
            'cpanel_docroot' => 'public_html'
          };
    }

    #
    # Return early if the subdomain directory doesn't actually exist.  This happens
    # when no subdomains are present on an account.
    #
    return @ret unless -d $dir;

    #
    # The best way to ascertain the names of the subdomains belonging to an Ensim
    # account is by inspecting the site's /var/subdomain directory for directories
    # that contain a document root, a symlink or a directory named "html".
    #
    opendir( my $dh, $dir ) or die("Unable to open directory $dir: $!");

    while ( my $name = readdir($dh) ) {
        my $path    = "$dir/$name";
        my $docroot = "$path/html";

        next unless -d $path;

        #
        # Descend into the subdomain directory, as we need to be able to resolve
        # any symlinks the 'html' docroot may refer to, relative to this point
        # in the filesystem.
        #
        chdir($path) or die("Unable to chdir() to $path: $!");

        #
        # If the document root found is a symlink to something else, then resolve
        # it until it is no longer a symlink.
        #
        while ( -l $docroot ) {
            $docroot = readlink($docroot);
        }

        #
        # Ignore this "subdomain" if the document root isn't actually a directory.
        #
        next unless -d $docroot;

        #
        # For some reason, only the first dot is replaced with an underscore,
        # and this is expected by cPanel; even in situations where there are
        # multiple components to the subdomain name.
        #
        my $cpanel_fqdn = "$name.$domain";
        $cpanel_fqdn =~ s/\./_/;

        #
        # We now have enough data to stipulate the presence of a subdomain.
        #
        push @ret,
          {
            'name'           => $name,
            'fqdn'           => "$name.$domain",
            'docroot'        => $docroot,
            'cpanel_name'    => $name,
            'cpanel_fqdn'    => $cpanel_fqdn,
            'cpanel_docroot' => "public_html/$name"
          };
    }

    closedir($dh);
    chdir($cwd);

    return @ret;
}

sub site_domain_aliases {
    my ($site) = @_;

    my $mappings = read_domain_mappings();
    my %defaults = %{ $mappings->{'default'} };

    return grep { $defaults{$_} eq $site } keys %defaults;
}

sub majordomo_lists {
    my ($sitedir) = @_;
    my $dir = "$sitedir/var/lib/majordomo/lists";
    my @ret;

    return () unless -d $dir;

    opendir(my $dh, $dir) or die("Unable to open Majordomo list directory $dir: $!");

    while (my $item = readdir($dh)) {
        next unless $item =~ /^([^\.]+)\.config$/;
        push @ret, $1;
    }

    closedir($dh);

    return @ret;
}

sub info_data {
    my ( $file_name, $site ) = @_;
    return eval { read_ini_file("/home/virtual/$site/info/current/$file_name") } || {};
}

sub list_plans {
    my $dir = $VIRTUALHOSTING_PLAN_DIR;
    opendir( my $dh, $dir ) or die( "Unable to open directory $dir to read plans" );

    my @ret = grep {
        $_ ne '.' && $_ ne '..' && -d "$VIRTUALHOSTING_PLAN_DIR/$_"
    } readdir( $dh );

    closedir( $dh );

    return @ret;
}

sub list_plan_features {
    my ( $plan ) = @_;
    my $dir = "$VIRTUALHOSTING_PLAN_DIR/$plan";

    opendir( my $dh, $dir ) or die( "Unable to open directory $dir to read plan features" );

    my @ret = grep {
        $_ ne '.' && $_ ne '..' && -f "$dir/$_"
    } readdir( $dh );

    closedir( $dh );

    return @ret;
}

sub list_account_features {
    my ( $site ) = @_;
    my $dir = "/home/virtual/$site/info/current";

    opendir( my $dh, $dir ) or die( "Unable to open directory $dir to read account features" );

    my @ret = grep {
        $_ ne '.' && $_ ne '..' && -f "$dir/$_"
    } readdir( $dh );

    closedir( $dh );

    return @ret;
}

sub get_plan_feature {
    my ( $plan, $feature ) = @_;
    my $file = "$VIRTUALHOSTING_PLAN_DIR/$plan/$feature";

    return read_ini_file( $file )->{'default'} or die( "Unable to read plan $plan feature '$feature'" );
}

sub get_account_feature {
    my ( $site, $feature ) = @_;
    my $file = "/home/virtual/$site/info/current/$feature";

    return read_ini_file( $file )->{'default'} or die( "Unable to read site $site feature '$feature'" );
}

sub get_account_plan_name {
    my ( $site ) = @_;

    my %scores;

    #
    # First, make a scored comparison of the features of each plan versus the
    # features on the account specified.
    #
    foreach my $plan ( list_plans() ) {
        $scores{$plan} = 0;

        foreach my $feature ( list_plan_features( $plan ) ) {
            my $plan_feature = get_plan_feature( $plan, $feature );
            my $user_feature = get_account_feature( $site, $feature );

            foreach ( keys %{$plan_feature} ) {
                next unless exists $user_feature->{$_};
                $scores{$plan}++ if $plan_feature->{$_} eq $user_feature->{$_};
            }
        }
    }

    #
    # Next, sort the highest score to the top, giving priority to the cases
    # where the 'default' plan is the most likely candidate for which plan
    # was selected by the administartor at account creation or modification.
    #
    my ( $top_result ) = sort {
        my $expr = 0;

        if ( $scores{$a} eq $scores{$b} && $a ne $b ) {
            $expr = $a eq 'default'? -1: 1;
        } else {
            $expr = $scores{$b} <=> $scores{$a};
        }
    } keys %scores;

    return defined $top_result? $top_result: 'undefined';
}

sub get_site_passwd_data {
    my ($site) = @_;
    my %passwd;

    open( my $passwd_fh, '<', "/home/virtual/$site/fst/etc/passwd" ) or die("Unable to open /etc/passwd for $site: $!");
    open( my $shadow_fh, '<', "/home/virtual/$site/fst/etc/shadow" ) or die("Unable to open /etc/shadow for $site: $!");

    #
    # Read in the /etc/passwd data as providing authoritative user
    # listings, first.  Any corresponding entries in /etc/shadow will
    # later be interpolated.
    #
    foreach (<$passwd_fh>) {
        chomp;

        my ( $name, @pwdata ) = split /:/;
        my $pwent = {};

        @{$pwent}{qw/passwd uid gid gecos home shell/} = @pwdata;

        $passwd{$name} = $pwent;
    }

    #
    # Now, read over each entry of /etc/shadow and set the 'passwd'
    # field of the appropriate password entry with the actual encrypted
    # password.
    #
    foreach (<$shadow_fh>) {
        chomp;

        my ( $name, $salt ) = split /:/;
        next unless exists $passwd{$name};

        $passwd{$name}->{'passwd'} = $salt;
    }

    close($shadow_fh);
    close($passwd_fh);

    return \%passwd;
}

sub get_user_quota {
    my ($uid) = @_;
    my $quota = 0;

    my $pid = open3( my ( $in, $out ), undef, qw/quota -v/, $uid ) or return 0;

    close($in);

    while (<$out>) {
        next unless /^\s*[0-9]+\s+([0-9]+)/;
        $quota = $1;
    }

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

    #
    # Values displayed by 'quota -v' are in KiB.  We need bytes.
    #
    return $quota * 1024;
}

sub get_bandwidth_limit {
    my ($site) = @_;
    my $info = info_data( 'bandwidth', $site );

    return $info->{'default'}->{'threshold'} if $info->{'default'}->{'enabled'} == 1;
}

sub get_grants {
    my ($ensim_user) = @_;

    my $mysql  = find_mysql();
    my $result = [];

    my $stmt = "SHOW GRANTS FOR '$ensim_user'\@localhost";

    # -B option for the mysql binary causes mysql to seperate values with tabs.
    # -ss option for the mysql binary causes mysql to not send the header row.
    my $db      = 'mysql';
    my $user    = 'root';
    my $pass    = get_mysql_passwd();
    my @command = ( $mysql, '-u', $user, $db, qw(-B -ss --raw), "--password=$pass" );

    my $pid = IPC::Open3::open3( my ( $in, $out ), undef, @command ) or die("Unable to run mysql: $!");

    print {$in} $stmt;
    close $in;

    while ( my $line = readline($out) ) {
        chomp $line;
        push @{$result}, "$line;";
    }

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

    return $result;
}

sub mysql_version {
    my $mysqlconfig = find_mysql_config();
    my $version     = `$mysqlconfig --version`;
    chomp($version);
    return ( split( '-', $version ) )[0];
}

sub find_python {
    foreach my $name (qw(ensim-python python python2 python2.1 python2.4)) {
        foreach my $dir (qw(/usr/bin /usr/local/bin /bin)) {
            my $path = "$dir/$name";

            return $path if -x $path;
        }
    }

    return undef;
}

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

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

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

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

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

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

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

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 $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";
    }
    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 @commands = (
        [ qw/tar pcf -/, $dir ],
        ['gzip']
    );

    if ( pipeline( my ( $tar_w, $tar_r, $tar_e ), @commands ) ) {
        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 archive_majordomo {
    my ( $site, $work_dir ) = @_;
    my $site_fst = "/home/virtual/$site/fst";
    my $tarball  = "$work_dir/homedir/majordomo.tar.gz";

    my @paths = qw(
      etc/aliases
      usr/lib/majordomo
      usr/lib/opcenter/majordomo
      var/lib/majordomo
    );

    my @commands = (
        [ qw/tar -C/, $site_fst, qw/-pcf -/, @paths ],
        ['gzip']
    );

    my @pids = pipeline( my ( $in, $out, $error ), @commands ) or return undef;
    open( my $fh, '>', $tarball ) or return undef;
    close($in);

    while ( my $len = sysread( $out, my $buf, 512 ) ) {
        syswrite( $fh, $buf, $len );
    }

    close($out);
    close($fh);

    #
    # Wait for both processes, but only care about the return status of tar.
    #
    waitpid( $pids[0], 0 );
    my $status = $? >> 8;
    waitpid( $pids[1], 0 );

    return $status == 0 ? $tarball : undef;
}

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

#
# Provides a limited subset of IPC::Pipeline, without support for typeglob
# or numeric fd input parameters.
#
sub pipeline {
    my @commands = @_[ 3 .. $#_ ];

    #
    # Create the initial pipe for passing data into standard input to the first command passed; then,
    # create the standard error pipe that will be used for all subsequent processes.
    #
    pipe my ( $child_out, $in )       or die('Unable to create a file descriptor pair for standard input piping');
    pipe my ( $error_out, $error_in ) or die('Unable to create a file descriptor pair for standard error piping');

    my @pids = ();

    foreach my $command (@commands) {
        pipe my ( $out, $child_in ) or die('Unable to create a file descriptor pair for standard output piping');

        my $pid = fork();

        if ( !defined $pid ) {
            die $!;
        }
        elsif ( $pid == 0 ) {
            POSIX::dup2( fileno($child_out), 0 ) or die('Cannot dup2() last output fd to current child stdin');
            POSIX::dup2( fileno($child_in),  1 ) or die('Cannot dup2() last input fd to current child stdout');
            POSIX::dup2( fileno($error_in),  2 ) or die('Cannot dup2() error pipe input to current child stderr');

            exec(@$command) or die( 'Cannot exec "' . join( ' ', @$command ) . '"' );
        }

        $child_out = $out;

        push @pids, $pid;
    }

    #
    # Substitute the first three arguments passed by the user with the file descriptor
    # on the parent's writing end of the initial pipe created for writing to the first
    # command, the last output file descriptor for the last command, and the standard
    # error descriptor.
    #
    @_[ 0 .. 2 ] = ( $in, $child_out, $error_out );

    #
    # Return each subprocess ID as an array ordered the same as the input commands.
    #
    return @pids;
}

#
# Note: This only works on tarballs created with 'tar | gzip', not 'tar pcz',
# as this implements the literal RFC 1952-specified behavior.
#
sub uncompressed_gzip_size {
    my ($file) = @_;
    my ( $fh, $buf );

    sysopen( $fh, $file, 0 ) or die("Cannot open file '$file' for analysis");
    sysread( $fh, $buf, 2 ) == 2 or die("Short read on '$file'");
    die unless $buf eq "\x1F\x8B";

    sysseek( $fh, -4, 2 );    # SEEK_END
    sysread( $fh, $buf, 4 ) == 4 or die("Short read while obtaining archive size on '$file'");

    close($fh);

    return ( unpack( 'V', $buf ) )[0];
}

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

    my $pid = IPC::Open2::open2( my $df_res, my $df_h, 'df', '-P', $mount ) or die("Unable to run 'df': $!");
    close $df_h;

    my $buffer;
    while ( my $line = <$df_res> ) {
        $buffer .= $line;
    }

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

    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 clean_mysql_username {
    my ($cpuser) = @_;

    $cpuser = substr $cpuser, 0, 16;
    return $cpuser;
}

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

#
# Scrub any invalid characters from the username based on safe cPanel defaults,
# while preserving the caret symbol that delimits the username from a site
# identifier that would be specified for disambiguation purposes; for example,
# 'foo^site1'.
#
sub clean_username {
    my ($cpuser) = @_;

    $cpuser =~ s/[^a-z0-9\^]//gi;
    $cpuser = lc $cpuser;

    return $cpuser;
}

sub get_mysql_passwd {
    local $ENV{'PYTHONPATH'} = '/usr/lib/opcenter/mysql/';
    my $pass = `$PYTHON -c 'from mysqlbe import *; print read_mysqlpass();'`;
    chomp($pass);
    return $pass;
}

sub get_mysql_databases {
    my $user = shift;

    # select DISTINCT(db) from db where user = 'cpdavel';

    my $databases = sqlcmd("SELECT DISTINCT(db) FROM db WHERE user = '$user'");
    my @databases = split /\n/, $databases;

    foreach (@databases) {
        s/\\//g;
    }

    return \@databases;
}

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();

    if ( !-e $mysqldump ) {
        print "Unable to backup mysql database $db\n";
        return;
    }
    my $pass = get_mysql_passwd();

    my @db = ($db);
    if ($table) {
        push @db, $table;
    }
    print join( '.', @db ) . ' ';
    my $pid = IPC::Open3::open3( my $w, my $r, '', $mysqldump, '-u', 'root', "--password=$pass", @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 find_mysqlcheck {
    my ( @LOC, $loc );
    @LOC = ( "/usr/bin/mysqlcheck", "/usr/local/bin/mysqlcheck" );
    foreach $loc (@LOC) {
        if ( -e $loc ) { return $loc; }
    }
}

sub sqlcmd {
    my ($cmd) = @_;
    my $result;
    my $wtrfh;
    my $rdrfh;
    my $mysql = find_mysql();
    my $user  = 'root';
    my $pass  = get_mysql_passwd();

    my $pid = IPC::Open3::open3( $wtrfh, $rdrfh, $rdrfh, $mysql, '-N', '-u', $user, "--password=$pass", 'mysql' );
    print {$wtrfh} "$cmd\n";
    close($wtrfh);
    local $/;
    $result = readline($rdrfh);
    waitpid( $pid, 0 );
    return $result;
}

sub psql_query {
    my ( $db, $query ) = @_;
    my $psql = find_psql();

    my $pid = IPC::Open3::open3( undef, my $fh, undef, $psql, qw/-A -F |/, $db, '-c', $query );

    #
    # Obtain the names of each database column, as listed in the first line.
    #
    my @columns = split /\|/, readline($fh);
    chomp(@columns);

    #
    # Map each subsequent line (except the final '(N rows)' line to an anonymous
    # hash, where each key is the name of the column, and the value is of course
    # the value of that particular column.
    #
    my @rows = map {
        chomp;
        my %row;
        @row{@columns} = split /\|/, $_;
        \%row;
    } grep !/^\([0-9]+ rows\)$/, <$fh>;

    close($fh);

    waitpid( $pid, 0 );

    return @rows;
}

sub convert_vacation_message_file {
    my ( $vacation_msg, $autorespond_file, $args ) = @_;

    #
    # These are the only two fields known to be populated in .vacation.msg
    # files written by Ensim.  For some reason, Ensim has made the mistake
    # of not writing an empty line to the file to separate message body and
    # header, so without depending on the presence of these two headers,
    # picking the body out from the header portion of the file is not a
    # deterministic affair.
    #
    my %FIELD_PATTERNS = (
        'Subject'    => qr/^Subject: (.*)$/,
        'Precedence' => qr/^Precedence: (.*)$/
    );

    open( my $vacation_msg_fh,     '<', $vacation_msg )     or die("Unable to open vacation message file $vacation_msg: $!");
    open( my $autorespond_file_fh, '>', $autorespond_file ) or die("Unable to open $autorespond_file for writing: $!");

    #
    # Begin assembling the header and body components of the cPanel-acceptable
    # autoresponder message file.  A value for Content-type is provided by
    # default, as it is required by cPanel.
    #
    my %header = (
        'From'         => $args->{'from'},
        'Content-type' => 'text/plain; charset=utf-8',
    );

    my $body;

    while ( my $line = readline($vacation_msg_fh) ) {
        chomp $line;
        $line =~ s/\015//sg;

        #
        # If we have already found the end of known headers, then append the
        # current data to the body.
        #
        if ($body) {
            $body .= "$line\n";
        }
        else {

            #
            # Only treat a line as a potential candidate for inclusion in the
            # header if nothing was previously found to be a part of the body.
            #
            my $found_header = 0;

            foreach my $field ( keys %FIELD_PATTERNS ) {

                if ( $line =~ $FIELD_PATTERNS{$field} && !$body ) {
                    $header{$field} = $1;
                    $found_header = 1;
                }
            }

            #
            # If the current line doesn't look like any of the known headers,
            # then consider this to be the start of the body.
            #
            unless ($found_header) {
                $body .= "$line\n";
            }
        }
    }

    close $vacation_msg;

    #
    # vacation(1)-style .vacation.msg variable substitutions should
    # be scrubbed for use with cPanel's autorespond binary.
    #
    foreach my $ref ( \$header{'Subject'}, \$body ) {
        ${$ref} =~ s/\$([a-z_][a-z0-9_]*)/\%$1\%/gi;
    }

    #
    # Write out the new file.  We should make concessions for RFC standards,
    # however, with regards to the order in which we write particular header
    # values.
    #
    my @header_fields = qw(From Content-type Subject Precedence);

    foreach my $header_field (@header_fields) {
        my $value = $header{$header_field};
        next unless $value;

        print {$autorespond_file_fh} "$header_field: $value\n";
    }

    print {$autorespond_file_fh} "\n$body";

    close $autorespond_file_fh;
}

#
# Read in an existing FrontPage(TM) configuration file, and output a new one in
# the location specified, containing modifications that will make the
# configuration file suitable for use in a cPanel environment.
#
sub create_patched_frontpage_conf {
    my ( $existing, $new, $args ) = @_;

    die('Arguments not supplied as a hash') unless ref($args) eq 'HASH';
    die('No host specified') unless defined $args->{'host'};

    my %substitutions = (
        'logrollover'       => undef,
        'logfilelocation'   => undef,
        'usagefulldaysonly' => undef,
        'servertype'        => 'apache-fp',
        'serverconfig'      => "/usr/local/apache/conf/sites/$args->{'host'}.conf",
        'SendmailCommand'   => '/usr/sbin/sendmail'
    );

    open( my $existing_fh, '<', $existing ) or die("Unable to open existing FrontPage(TM) config file $existing: $!");
    open( my $new_fh,      '>', $new )      or die("Unable to open new FrontPage(TM) config file $new: $!");

    #
    # Read in the existing configuration file into %config, ignoring anything
    # that doesn't appear to be a simple key:value pair.
    #
    my %config;

    while ( my $line = readline($existing_fh) ) {
        chomp($line);

        my ( $key, $value ) = split( /:/, $line, 2 );
        next unless defined $value;

        $config{$key} = $value;
    }

    close($existing_fh);

    #
    # Merge the substitutions into the newly-read configuration data.
    #
    foreach my $key ( keys %substitutions ) {

        #
        # If there is an entry in the substitutions hash with an undefined
        # value, then delete the entry from the configuration file and move
        # on to the next substitution item.
        #
        unless ( defined $substitutions{$key} ) {
            delete $config{$key};
            next;
        }

        $config{$key} = $substitutions{$key};
    }

    #
    # Dump out the new configuration file.
    #
    foreach my $key ( keys %config ) {
        print {$new_fh} "$key=$config{$key}\n";
    }

    close($new_fh);
}

#
# Read in an existing AWstats configuration file, and output a new one in the
# location specified, containing modifications that will make the configuration
# file suitable for use in a cPanel environment.
#
sub create_patched_awstats_conf {
    my ( $existing, $new, $args ) = @_;

    # tidyoff -- perltidy does not align conditionals properly here
    die('Arguments not supplied as a hash')    unless ref($args) eq 'HASH';
    die('No cPanel username specified')        unless defined $args->{'cpuser'};
    die('No HTTP log file location specified') unless defined $args->{'logfile'};
    die('No site domain specified')            unless defined $args->{'domain'};
    # tidyon

    unless ( defined $args->{'aliases'} && ref( $args->{'aliases'} ) eq 'ARRAY' ) {
        die('No domain aliases specified');
    }

    my %substitutions = (
        'DirCgi'                    => '/tmp/awstats',
        'DirIcons'                  => '/images/awstats',
        'DirLang'                   => '/usr/local/cpanel/3rdparty/share/awstats/lang',
        'LinkToWhois'               => 'http://www.whois.net/search.cgi2?str=',
        'LogFile'                   => $args->{'logfile'},
        'SiteDomain'                => $args->{'domain'},
        'DirData'                   => "/home/$args->{'cpuser'}/tmp/awstats",
        'AllowFullYearView'         => 3,
        'HostAliases'               => join( ' ', @{ $args->{'aliases'} } ),
        'LevelForKeywordsDetection' => undef,
        'MiscTrackerUrl'            => undef
    );

    open( my $existing_fh, '<', $existing ) or die("Unable to open existing AWstats config file $existing: $!");
    open( my $new_fh,      '>', $new )      or die("Unable to open new AWstats config file $new for writing: $!");

    while ( my $line = readline($existing_fh) ) {
        chomp($line);

        #
        # If we've found a non-comment, non-whitespace line that looks like an
        # assignment, such as the following...
        #
        #     LogFile = "/var/www/access.log"
        #
        # ...then, using the name portion parsed out from the string, check to
        # see if any substitutions for the values listed in the configuration
        # file exists.  Note that an undef is used as a means of dropping a
        # declaration from the configuration file altogether, as necessary.
        #
        # If the line does not appear to be a declaration for which we have a
        # substitute, then the line is simply repeated as-is into the patched
        # configuration file.
        #
        if ( $line =~ /^\s*([^=\s]+)\s*=/ && exists $substitutions{$1} ) {
            next unless defined $substitutions{$1};

            print {$new_fh} qq($1 = "$substitutions{$1}"\n);
        }
        else {
            print {$new_fh} "$line\n";
        }
    }

    close($new_fh);
    close($existing_fh);
}

#
# Run a command, read a single line of output, chomp it, return it.
# Error swallowing is a feature and a virtue here where a caller
# considers SOME sort of output a success.
#
sub _lazyrun {
    open( my $error, '<', '/dev/null' ) or return undef;
    my $pid = open3( my ( $in, $out ), $error, @_ ) or return undef;
    my $ret;

    close $in;

    if ( defined $error && readline($error) =~ /does not exist$/ ) {
        return undef;
    }

    close $error;

    if ( defined( $ret = readline $out ) ) {
        chomp $ret;
        close $out;
        waitpid $pid, 0;
    }

    return ( $? >> 8 ) ? undef : $ret;
}

sub _wait_run {
    my ($sub, @args) = @_;

    my $pid = fork();

    if ($pid > 0) {
        until (waitpid($pid, 1) == $pid) {
            print '......';

            sleep 1;
        }
    } elsif ($pid == 0) {
        $sub->(@args);
        exit 0;
    } else {
        die("Unable to fork(): $!");
    }
}

sub _read_flat_file {
    my ($file) = @_;

    open( my $fh, '<', $file) or die( "Unable to open flat file $file for reading" );

    my @ret;

    while ( my $buf = readline( $fh ) ) {
        next unless my $line = _strip( $buf );
        next if $line =~ /^(#|$)/;

        push @ret, $line;
    }

    close( $fh);

    return \@ret;
}

sub _call_hook {
    my ($event, @args) = @_;
    my $script = '/scripts/pkgaccthook';

    return unless -x $script;
    return system $script, $event, @args;
}

__END__

=head1 NAME

pkgacct-enXim - Generate cPanel-compatible account archives from an "enXim"
machine

=head1 SYNOPSIS

    /scripts/pkgacct account

    /scripts/pkgacct account --nosplit

=head1 DESCRIPTION

pkgacct-enXim will create cPanel-compatible account archives from an "enXim"
machine, when run in such a foreign environment.  A best effort will be made
to convert pertinent data in the appropriate manner, where possible.

=head1 ACCOUNT PACKAGING EVENT HOOKS

There are currently two separate mechanisms, or conventions, by which the
current state of a pkgacct process can be inspected: An old-style system,
where a call will be made to a script placed in the appropriate location, with
a specific name, indicating the corresponding pkgacct state it services; and a
new-style system, where a single hook script is installed, but many different
event types can be serviced.  Both hook event dispatch systems are similar in
calling convention, however; both new- and old-style hooks, when present, can
peacefully coexist.

=head2 OLD-STYLE HOOKS

Old-style hooks are executable scripts with a very specific name which
corresponds to the respective pkgacct events they service.  Each hook script
takes a specific set of arguments.

=over

=item C</scripts/prepkgacct $account>

This hook is called at the earliest possible point in the execution of the
pkgacct script.  The username used to specify the "enXim" account will be
passed as its sole argument.

=item C</scripts/postpkgacct 'split', $cpuser, $user, $splitdir>

=item C</scripts/postpkgacct 'nosplit', $cpuser, $user, $archive>

Dispatched immediately after the creation of the cPanel account archive.  The
first argument can be specified as either 'split' or 'nosplit'; the second
argument specifies the name of the username to be created when the account
archive is restored on a cPanel machine; the third argument specifies the name
of the "enXim" account from which the archive is generated; and finally, the
fourth argument is based on the value of the first, where either a path to the
"split" archives directory, or the single, monolithic archive, is specified.

=back

=head2 NEW-STYLE HOOKS

New-style hooks are called through a single executable, /scripts/pkgaccthook,
passing the name of the event indicating the current pkgacct state, along with
any number of arguments pertinent to the current state of the process.  A
single hook script is used to avoid the potential pitfalls of naming conflicts
when the need to handle new sorts of events is identified, allowing both the
cPanel developers and hook implementors alike additional flexibility in
devising solutions.

=over

=item C<pkgacct_start $user>

Dispatched immediately at the beginning of the pkgacct process.  The sole
argument to this hook is the username that was specified for packaging.

=item C<pkgacct_pre_archive $cpuser, $user, $work_dir>

Dispatched immediately prior to the creation of the cPanel account archive,
or archives.  A hook can be implemented here to allow, for instance,
modification of the account package contents prior to its final archiving, as
seen fit by the implementor.

=item C<pkgacct_post_archive 'split', $cpuser, $user, $splitdir>

=item C<pkgacct_post_archive 'nosplit', $cpuser, $user, $archive>

These two hooks are implemented in the exact manner as the aforementioned
/scripts/postpkgacct hook in the L</"OLD-STYLE HOOKS"> section.

=back

=head1 COPYRIGHT

Copyright(c) cPanel, Inc.  All rights reserved.