#!/usr/bin/perl

#######  meta-verify
#
#  System and database integrity check utility
#  for the Sun Cobalt RaQ4 product family
# 
#  Copyright (c) 2000 Cobalt Networks, Inc.
#  Copyright (c) 2002 Sun Microsystems, Inc.
#  All Rights Reserved.
#
#
#######  DESCRIPTION
#
#  This script attempts to detect and repair coherency problems between
#  the system configuration state and the state saved in the database.
#
#  - Verify and repair virtual sites.
#  - Verify and repair user accounts.
#  - Maintain intergrity of the RaQ system configuration files.
#  - Ensure coherency between System and Meta/postgreSQL backend.
#
#
#######  SUPPORTED SYSTEMS
#
#  Sun Cobalt RaQ 4 product family (en, ja)
#
#
#######  CHANGELOG
#
# version 3.1 (Jan 07 2002)
#   - add option to reset symlinks in /home/sites
#
# version 3.0 (Jun 28 2000)
#   - updates to support new Meta for RaQ4
#
# version 2.1 (Apr 18 2000)
#   - added 'Y' option to say yes to all
#
# version 2.0 (Mar 01 2000)
#   - now has support for rebuilding the virtual site list
#   - command line options have changed
#
# version 1.2 (Feb 16 2000)
#   - don't show conflict on self->self aliases
#   - vacationmsg field is now blank
#
# version 1.1 (Feb 04 2000)
#   - fix display of user info that is longer than page width
#   - fix alias handling
#   - verifies system is RaQ3 and user is root
#
# version 1.0 (Feb 03 2000)
#   - initial release
#   - fix incorrect reporting of frontpage state
#
# version 0.9 (Feb 02 2000)
#   - verify valid user accounts, prompt database update when changes detected
#   - prompts for and allows database deletion of sites that do not exist in
#     the system configuration
#   - fix int() conversion & mismatched parens
#
# version 0.8 (Feb 01 2000)
#   - @{ union,intersect,symmetric difference } for database/system user lists
#   - detect invalid system users correctly
#
# version 0.7 (Feb 01 2000)
#   - meta object containing all user fields, completed with information from
#     current system configuration and state information
#
# version 0.1 (Jan 31 2000)
#   - initial creation
#
#
#######  


BEGIN {
    require Cobalt::Meta;
    require Cobalt::Meta::vsite;
    require Cobalt::User;
    require Cobalt::Vacation;
    require Cobalt::Email;
    require Cobalt::List;
    require Cobalt::Fpx;
    require Cobalt::Ftp;
    require Cobalt::Quota;
    
    use Getopt::Std;
    use IO::File;

    use vars qw($TITLE $VERSION $COPYRIGHT);

    $TITLE       = "meta-verify";
    $VERSION     = "3.1";
    $COPYRIGHT   = "Copyright (c) 2002 Sun Microsystems, Inc.";
}

# verify that this is a supported system
if (-e "/etc/build") {
    if (system("egrep", "-q", "3(100|001|500|599)R", "/etc/build")) {
        die("\nThis program is designed for the RaQ 4\n\n");
    }
} else {
    die("\nThis program is only for the RaQ 4!\n\n");
}

# verify that we are root
if ($< != 0) {
    die("\nThis program must be run as root!\n\n");
}

# program header
printf("\n");
printf("%s (version %s)\n", $TITLE, $VERSION);
printf("%s\n", $COPYRIGHT);

# global variables
use vars qw($Verbose);
use vars qw($target $e %eCOUNT @eALL @eGOOD @eBAD);
use vars qw(@eFIELDS @eARRAYS);
use vars qw(@all_DB @all_SYS $entryX $entry $entryTYPE);
use vars qw($login $message $field $DB_field $SYS_field);

# format for output of messages
format PRINT_MSG =
                | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
                  $message
~                 ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<...
                  $message
.

# format for output of messages
format PRINT_ENTRY =
@>>>>>>>>>>>>>> | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$login,           $message
~                 ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<...
                  $message
.

# format for output when handling entry errors
format PRINT_ENTRY_ERROR =
@>>>>>>>>>>>>>> | ERROR ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$login,                 $message
~                       ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<...
                        $message
.

# format for output when processing
format PRINT_FIELD =
@>>>>>>>>>>>>>> | @>>>>>>>>>>>>> = ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$login,           $field,          $message
~                                  ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
                                   $message
~                                  ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<...
                                   $message
.

# format for error output when comparing meta+system fields
format PRINT_FIELD_ERROR =
@>>>>>>>>>>>>>> | ERROR IN @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$login,                    $field
                | DATABASE ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
                           $DB_field
~               |          ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
                           $DB_field
~               |          ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<...
                           $DB_field
                |   SYSTEM ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
                           $SYS_field
~               |          ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
                           $SYS_field
~               |          ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<...
                           $SYS_field
.

# command-line arguments, verbose level
getopts("suvaihdfl");
    
# usage help
&usage if ($opt_h);

$Auto    = ($opt_f) ? 1 : 0;
$Verbose = ($opt_v) ? 1 : 0;

if ($opt_u) {
    # fix users
    $target = "USERS";
    &setup_users();
    &diff_arrays();
}
elsif ($opt_s) {
    # fix virtual sites
    $target = "VIRTUAL SITES";
    &setup_vsite();
    &diff_arrays();
}
elsif ($Auto) {
    # fix virtual sites
    $target = "VIRTUAL SITES";
    &setup_vsite();
    &diff_arrays();
    &examine_invalid(@eBAD);

    # fix users
    $target = "USERS";
    &setup_users();
    &diff_arrays();
    &examine_invalid(@eBAD);

    printf("\nOK\n\n");
    exit 0;
}
elsif ($opt_l) {
    # reset virtual site symlinks with
    # entries from /etc/httpd/conf/httpd.conf
    my $root = "/home/sites";
    my $httpd_conf = "/etc/httpd/conf/httpd.conf";
    my($vpath,$vhost);

    unless (-s $httpd_conf) {
	printf("ERROR: $httpd_conf not found\n");
	exit 1;
    }

    my $htconf = new IO::File "$httpd_conf";
    unless (defined $htconf) {
	printf("ERROR: unable to open $httpd_conf: $!\n");
	exit 1;
    }

    print "\n";
    while (<$htconf>) {
	if (m{^<VirtualHost [0-9\.]+>} ... m{^</VirtualHost>}) {
	    if (m{^DocumentRoot $root/([^/]+)/web}) {
		$entry = $1;
		$vpath = "$root/$entry";
	    }
	    elsif (m{^ServerName (.+)}) {
		$host  = $1;
		$vhost = "$root/$host";
	    }

	    if (m{^</VirtualHost>}) {
		next unless (-d $vpath);
		unlink $vhost if (-e $vhost);
		print_entry($host);
		symlink $vpath, $vhost;
		$vpath=$vhost="";
	    }
	}
    }
    print "\n";

    undef $htconf;
    exit 0;
}
else {
    &usage;
}

if ($opt_d) {
    printf("dropping database table...\n");
    &Cobalt::Meta::drop($entryTYPE);
    printf("OK\n\n");
    exit 0;
}

if ($opt_a) {
    &examine_valid(@eGOOD);
}
elsif ($opt_i) {
    &examine_invalid(@eBAD);
}
else {
    printf("error - must specify valid (-a) or invalid (-i)\n\n");
    exit 1;
}

print "\n" unless ($Verbose);
printf("OK\n\n");

exit 0;

1;

sub usage ()
{
    print <<EOL

usage: $TITLE [ -hvfl ] [ -uo -iad ]

   -h   help
   -v   verbose
   -f   automatic fix (vsite+users)
   -l   reset vsite symlinks

   -u   target: users table
   -s   target: vsite table

   -i   select: invalid
   -a   select: valid
   -d   drop target table

EOL
    ;
    exit 1;
}

sub print_msg
{
    $message = "@_";
    $~ = 'PRINT_MSG';
    write();
}

sub print_entry
{
    $message = "@_";
    $login = "$entry";
    $~ = 'PRINT_ENTRY';
    write();
}

sub print_entry_error
{
    $message = "(@_)";
    $login = "$entry";
    $~ = 'PRINT_ENTRY_ERROR';
    write();
}

sub print_field
{
    ($field,$message) = (@_);
    $login = "$entry";
    $~ = 'PRINT_FIELD';
    write();
}

sub print_field_error
{
    ($field,$DB_field,$SYS_field) = (@_);
    $field = "($field)";
    $DB_field = "($DB_field)";
    $SYS_field = "($SYS_field)";
    $login = "$entry";
    $~ = 'PRINT_FIELD_ERROR';
    write();
}

# diff_arrays
#
# determine union, intersection, and difference
# of the @all_DB and @all_SYS arrays
#
sub diff_arrays ()
{
    my %eCOUNT = ();

    @eALL  = ();
    @eBAD  = ();
    @eGOOD = ();

    foreach my $el (@all_DB, @all_SYS)
    {
	$eCOUNT{$el}++;
    }

    foreach my $el (keys %eCOUNT)
    {
	# union -
	# all in database or system
	push(@eALL, $el);
	
	if ($eCOUNT{$el} == 2)
	{
	    # intersection -
	    # both in database and in system
	    push(@eGOOD, $el);
	}
	else
	{
	    # symmetric difference -
	    # either not in database or not in system
	    push(@eBAD, $el);
	}
    }

    # output results
    if ($Verbose) {
	print "\n";
	printf("       database | %d\n", scalar(@all_DB));
	printf("         system | %d\n", scalar(@all_SYS));
	printf("          total | %d\n", scalar(@eALL));
	printf("          valid | %d\n", scalar(@eGOOD));
	printf("        invalid | %d\n", scalar(@eBAD));
	print "\n";
    }
}

# examine_invalid ()
#
#   check the LIST for invalid
#   correct the problem if possible
#
#   arg:  list to check
#
sub examine_invalid ()
{
    my (@eLIST) = (@_);
    return unless (scalar(@eLIST));
    
    printf("repairing %d INVALID %s\n\n", scalar(@eLIST), $target);

    foreach $entry (@eLIST)
    {
	my $inDB  = 0;
	my $inSYS = 0;

	printf("\n") if ($Verbose);

	# see if this entry exists in the database
	if (grep(/\b$entry\b/, @all_DB))
	{
	    $inDB = 1;
	}
	else
	{
	    $inDB = 0;
	    &print_entry_error("entry does not exist in database") if ($Verbose);
	}

	# see if this entry exists in the system
	&print_msg("retrieving information from system...") if ($Verbose);
	$entryX = &build_system("$entry");
	if ($entryX)
	{
	    $inSYS = 1;
	}
	else
	{
	    &print_entry_error("does not exist in system");
	    $inSYS = 0;
	}

	# in both system and database
	# this should never happen
	if ($inSYS && $inDB)
	{
	    &print_entry_error("entry is already valid");
	    $entryX->DESTROY();
	    next;
	}

	# in system but not database
	if ($inSYS)
	{
	    my $input;

	    # confirm add
	    while ($input !~ /^[Yyn]/ && !$Auto)
	    {
		printf("                | <Y> - save ALL\n");
		printf("                | <y> - save entry to database\n");
		printf("                | <n> - do NOT save entry to database\n");
		printf("                | <v> - view info obtained from system\n");
		printf("                | save? [Yynv] ");

		$input = <STDIN>;
		$Auto++ if ($input =~ /^Y/);

		# print info
		if ($input =~ /^v/)
		{
		    $Verbose++;
		    $entryX->DESTROY;
		    $entryX = &build_system($entry);
		    $Verbose--;
		}
	    }

	    # always give the chance to bail
	    next if ($input =~ /^n/);

	    # save
	    unless ($entryX->save)
	    {
		&print_entry_error("unable to save");
		$entryX->DESTROY;
		next;
	    }

	    &print_entry("saved");
	    $entryX->DESTROY;
	    next;
	}

	# in database but not system
	if ($inDB)
	{
	    my $input = '';
	    my $entryY = Cobalt::Meta->new(type => "$entryTYPE");

	    # confirm database entry delete
	    while ($input !~ /^[yn]/ && !$Auto)
	    {
                printf("                | <y> - remove database entry\n");
                printf("                | <n> - do NOT remove database entry\n");
		printf("                | remove? [yn] ");
		$input = <STDIN>;
	    }

	    # always give the chance to bail
	    next if ($input =~ /^n/);

	    # delete entry
	    $entryY->retrieve("$entry");
	    unless ($entryY->delete())
	    {
		&print_entry_error("unable to remove");
		$entryY->DESTROY();
		next;
	    }

	    $entryY->DESTROY();
	    &print_entry("removed");
	    next;
	}

	# not in database or system
	&print_entry_error("entry not in database OR system");
	next;
    }

    return;
}

# examine_valid ()
#
#   check the LIST for valid and verify
#   coherency of fields between system and database
#
#   correct the problem if possible
#
#   arg:  list to check
#
sub examine_valid ()
{
    my (@eLIST) = (@_);
    return unless (scalar(@eLIST));

    printf("verifying %d VALID %s\n\n", scalar(@eLIST), $target);

    foreach $entry (@eLIST)
    {
	# this entry from the database
	my $entry_DB = (Cobalt::Meta->new(type => "$entryTYPE"));
	unless ($entry_DB->retrieve("$entry"))
	{
	    &print_entry_error("entry non-existant in database");
	    next;
	}

	# get info from the system
	my $entry_SYS = &build_system("$entry");
	unless ($entry_SYS)
	{
	    &print_entry_error("entry does not exist in system");
	    next;
	}

	# compare fields
	my $errcount = 0;
	foreach my $fld (@eFIELDS)
	{
	    if ($entry_DB->{$fld} ne $entry_SYS->{$fld})
	    {
		$errcount++;
		&print_field_error($fld, $entry_DB->{$fld}, $entry_SYS->{$fld});
	    }
	}

	foreach my $fld (@eARRAYS)
	{
	    my ($e,@aDB,@aSYS,%count,@diff);

	    # turn flat string into list
	    @aDB = split(' ', $entry_DB->{$fld});
	    @aSYS = split(' ', $entry_SYS->{$fld});

	    # compute difference of lists
	    foreach $e (@aDB, @aSYS) { $count{$e}++ }
	    foreach $e (keys %count) { push (@diff, $e) unless ($count{$e} == 2) }

	    # if difference then error
	    if (scalar(@diff))
	    {
		$errcount++;
		&print_field_error($fld, join(', ', @aDB), join(', ', @aSYS));
	    }
	}

	if ($errcount)
	{
	    my $input;

	    # confirm database update
	    while ($input !~ /^[yn]/)
	    {
		printf("                | <y> - update database info for entry\n");
		printf("                | <n> - do NOT update database\n");
		printf("                | update? [yn] ");
		$input = <STDIN>;
	    }

	    # always give the chance to bail
	    if ($input =~ /^n/)
	    {
		print "\n";
		next;
	    }

	    # save
	    unless ($entry_SYS->save())
	    {
		&print_entry_error("unable to save");
		print "\n";
	    }
	    else
	    {
		&print_entry("updated");
		print "\n";
	    }
	}
	else
	{
	    &print_entry("ok");
	    print "\n" if ($Verbose);
	}

	$entry_DB->DESTROY();
	$entry_SYS->DESTROY();
    }

    return;
}

sub setup_users ()
{
    $entryTYPE = "users";
    printf("\nchecking $target\n");

    @all_SYS = ();
    @all_DB  = ();

    # some global variables
    # user fields to compare when verifying all users
    @eFIELDS = ("name", "fullname", "uid", "vsite", "quota",
		"vacation", "admin", "shell", "apop", "fpx", "suspend");

    # these fields are to be treated as arrays
    # where order does NOT matter
    @eARRAYS = ("forward", "aliases");
    
    # the global database views and Meta objects
    $entryX = Cobalt::Meta->new(type => "users");
    @all_DB = $entryX->getall();
    @all_SYS = Cobalt::User::user_list();

    # remove admin from both sets
    @all_SYS = grep !/\bdefault\b/, @all_SYS;
    @all_SYS = grep !/\badmin\b/, @all_SYS;
    @all_DB = grep !/\bdefault\b/, @all_DB;
    @all_DB = grep !/\badmin\b/, @all_DB;

    if ($Verbose)
    {
	print "\n";
	foreach $e (@all_DB) { &print_field("db user", $e); }
	foreach $e (@all_SYS) { &print_field("sys user", $e); }
	print "\n";
    }
}

sub setup_vsite ()
{
    printf("\nchecking $target\n");
    $entryTYPE = "vsite";

    @all_SYS = ();
    @all_DB  = ();

    # some global variables
    # user fields to compare when verifying all users
    @eFIELDS = ("name", "ipaddr", "hostname", "domain", "fqdn",
		"suspend", "quota",
		"ftp", "fpx", "ssi", "ssl", "cgi", "casp",
		);

    # these fields are to be treated as arrays
    # where order does NOT matter
    @eARRAYS = ();
    
    # the global database views and Meta objects
    $entryX = new Cobalt::Meta::vsite;
    @all_DB = $entryX->getall();
    map { push @all_SYS, @$_[2]; } (Cobalt::Vsite::vsite_list());

    # remove from both sets
    @all_SYS = grep !/\bdefault\b/, @all_SYS;
    @all_DB  = grep !/\bdefault\b/, @all_DB;

    if ($Verbose)
    {
	print "\n";
	foreach $e (@all_DB)  { &print_field("db vsite", $e);  }
	foreach $e (@all_SYS) { &print_field("sys vsite", $e); }
	print "\n";
    }
}

sub build_system ()
{
    my $ebuild = shift;
    return unless ($ebuild);

    if ($entryTYPE eq "users")
    {
	return build_user_system($ebuild);
    }
    elsif ($entryTYPE eq "vsite")
    {
	return build_vsite_system($ebuild);
    }

    return;
}

sub build_vsite_system ()
{
    my $site = shift;
    return unless ($site);

    my(@tmpARRAY);
    my($newVSITE) = new Cobalt::Meta::vsite(name => $site);

    &print_field("group", $newVSITE->name) if ($Verbose);

    # verify the group existance
    unless (Cobalt::Group::group_exist("$site"))
    {
	&print_entry_error("group does not exist");
	return;
    }

    # retrieve network info from httpd.conf
    my($ipaddr,$fqdn) = (Cobalt::Vsite::vsite_get_bygroup("$site"))[0,1];
    unless ($ipaddr && $fqdn)
    {
	&print_entry_error("does not exist in apache configuration");
	return;
    }
    $newVSITE->ipaddr($ipaddr);
    &print_field("ipaddr", $newVSITE->ipaddr) if ($Verbose);

    $newVSITE->fqdn($fqdn);
    &print_field("fqdn", $newVSITE->fqdn) if ($Verbose);

    # parse fqdn for hostname+domain
    unless ($fqdn =~ /([\w-]+)\.([\w-\.]+)/)
    {
	&print_entry_error("unable to split \"$fqdn\" into hostname+domain");
	return;
    }
    my($hostname,$domain) = ($1,$2);

    $newVSITE->hostname($1);
    &print_field("hostname", $newVSITE->hostname) if ($Verbose);

    $newVSITE->domain($2);
    &print_field("domain", $newVSITE->domain) if ($Verbose);

    # get disk quota
    my($quota) = (Cobalt::Quota::repquota($site, 1))[1];
    if ($quota > 0)
    {
	$newVSITE->quota(int(($quota * 1024) / 1048576));
    }
    &print_field("disk quota", $newVSITE->quota) if ($Verbose);

    # get anon ftp settings from proftpd config file
    my($ftp,$ftpusers,$ftpquota) = Cobalt::Ftp::ftp_get_anonymous($site);
    if ($ftp)
    {
	$newVSITE->ftp(t);
	$newVSITE->ftpusers($ftpusers);
	if ($ftpquota > 0)
	{
	    $newVSITE->ftpquota(int(($ftpquota * 1024) / 1048576));
	}
    }
    &print_field("anonymous FTP", $newVSITE->get(ftp)) if ($Verbose);

    # get suspend flag
    $newVSITE->suspend(Cobalt::Vsite::vsite_issuspend($site));
    &print_field("suspended", $newVSITE->get(suspend)) if ($Verbose);

    # get frontpage settings
    $newVSITE->fpx(Cobalt::Fpx::fpx_get_web($site));
    &print_field("frontpage", $newVSITE->get(fpx)) if ($Verbose);

    # get chilisoft ASP settings
    $newVSITE->casp(Cobalt::Vsite::vsite_get_casp($site));
    &print_field("Chil!soft ASP", $newVSITE->get(casp)) if ($Verbose);

    # get cgi settings
    $newVSITE->cgi(Cobalt::Vsite::vsite_get_cgis($site));
    &print_field("CGI scripts", $newVSITE->get(cgi)) if ($Verbose);

    # get ssi settings
    $newVSITE->ssi(Cobalt::Vsite::vsite_get_ssi($site));
    &print_field("SSI scripts", $newVSITE->get(ssi)) if ($Verbose);

    # get php settings
    $newVSITE->php(Cobalt::Vsite::vsite_get_php($site));
    &print_field("PHP scripts", $newVSITE->get(php)) if ($Verbose);

    # get ssl settings
    $newVSITE->ssl((-e "/etc/httpd/ssl/$site") ? 't' : 'f');
    &print_field("SSL server", $newVSITE->get(ssl)) if ($Verbose);

    printf("\n") if ($Verbose);

    return $newVSITE;
}

# build_user_system ()
#
#   tries to build a Meta object of type "users"
#   from information gathered by the system
#
#   arg:  login name
#   ret:  Meta object (type => users)
#
sub build_user_system ()
{
    my $user = shift;
    return unless ($user);

    my (@tmpARRAY);
    my $newUSER = Cobalt::Meta->new(type => "users");

    # get basic user info
    my ($name,$uid,$fullname,$dir,$sh) = (getpwnam($user))[0,2,6,7,8];
    unless ($name)
    {
	&print_entry_error("does not exist in password file");
	return;
    }

    # determine virtual site from home directory path
    my $vsite;
    if ($dir =~ m%^/home/sites/home/users/%)
    {
	$vsite = "home";
    }
    elsif ($dir =~ m%^/home/sites/(site[0-9]+)/users/%)
    {
	$vsite = "$1";
    }
    else
    {
	&print_entry_error("invalid home directory");
	return;
    }

    printf("\n") if ($Verbose);

    # user name
    $newUSER->put(name => "$name");
    &print_field("user name", $name) if ($Verbose);

    # full name
    $newUSER->put(fullname => "$fullname", altname => "");
    &print_field("full name", $fullname) if ($Verbose);

    # UID
    $newUSER->put(uid => "$uid");
    &print_field("UID", $uid) if ($Verbose);

    # virtual site membership
    $newUSER->put(vsite => "$vsite");
    &print_field("virtual site", $vsite) if ($Verbose);

    # disk quota
    my($quota) = (Cobalt::Quota::repquota($user))[1];
    $newUSER->put(quota => (($quota > 0) ? int(($quota * 1024) / 1048576) : 0));
    &print_field("disk quota", $newUSER->get(quota)) if ($Verbose);

    # email aliases
    my $aliases = "";
    @tmpARRAY = (Cobalt::Email::mail_virtuser_get_byuser($user));
    if (scalar(@tmpARRAY))
    {
	# remove domains
	my @oARRAY;
	foreach (@tmpARRAY) {
	    if (/^([^@]+)\@.*/) {
                push(@oARRAY, $1) unless($1 eq $user);
            } else {
		push(@oARRAY, $_);
            }
        }
	$aliases = join(" ", @oARRAY);
    }
    $newUSER->put(aliases => "$aliases");
    &print_field("email aliases", $aliases) if ($Verbose);

    # email forwarding
    @tmpARRAY = (Cobalt::List::alias_get_vacationless($user));
    $newUSER->put(forward => ((scalar(@tmpARRAY) > 0) ? join(" ", @tmpARRAY) : ''));
    &print_field("email forward", $newUSER->get(forward)) if ($Verbose);

    # virtual site administrator
    @tmpARRAY = (Cobalt::User::user_list_groups($user));
    $newUSER->put(admin => ((scalar(grep(/\b$vsite\b/, @tmpARRAY))) ? 't' : 'f'));
    &print_field("site admin", $newUSER->get(admin)) if ($Verbose);

    # suspended user
    $newUSER->put(suspend => ((Cobalt::User::user_issuspend($user)) ? 't' : 'f'));
    &print_field("suspended", $newUSER->get(suspend)) if ($Verbose);

    # telnet/shell access
    $newUSER->put(shell => (($sh eq "/bin/bash") ? 't' : 'f'));
    &print_field("telnet/shell", $newUSER->get(shell)) if ($Verbose);

    # authenticated pop3 (APOP)
    $newUSER->put(apop => ((Cobalt::Email::mail_apop_isuser($user)) ? 't' : 'f'));
    &print_field("secure POP3", $newUSER->get(apop)) if ($Verbose);

    # frontpage extensions
    @tmpARRAY = (Cobalt::Vsite::vsite_get_fpx($vsite));
    $newUSER->put(fpx => ((scalar(grep(/\b$user\b/, @tmpARRAY))) ? 't' : 'f'));
    &print_field("frontpage", $newUSER->get(fpx)) if ($Verbose);

    # email vacation responder
    $newUSER->put(vacation => ((Cobalt::Vacation::vacation_get_on($user)) ? 't' : 'f'));
    &print_field("vacation", $newUSER->get(vacation)) if ($Verbose);

    printf("\n") if ($Verbose);

    return $newUSER;
}