package Stanford::WebApps::SharedEmail::RequestForm;

use strict;
use warnings FATAL => 'all';

use Carp;
use CGI::FormBuilder;
use Net::Remctl;
use Stanford::WebApps::SharedEmail::Config qw(%CONFIG);
use Stanford::WebApps::SharedEmail::Util qw(
  announcement_enabled
  lookup_orgid
  split_entries
);
use Stanford::WebApps::SharedEmail::Logger qw(get_logger);
use Readonly;
use Template;

use base qw(CGI::FormBuilder);

Readonly my $INCLUDE_PATH => [qw(
    /usr/share/shared-email/templates
    /usr/share/stanford-web-template/html
)];

# We are a singleton, and this is copies of stuff that we'll use.
our $FORM;
our $FORM_DATA;
our $SCHEMA;

my $LOGGER = get_logger() ;

sub new {
    my ($self, $schema_ref, $data_ref) = @_;

    $SCHEMA = $schema_ref;

    # Make sure $data_ref is either undef, or a hashref
    if (!defined($data_ref)) {
        $data_ref = {};
    }
    if (ref($data_ref) ne 'HASH') {
        croak('$data_ref must be undef, or a hashref');
    }
    $FORM_DATA = $data_ref;
    $FORM_DATA->{announcement_enabled} = announcement_enabled();

    # Build our form
    my $form = CGI::FormBuilder->new(
        name     => 'form',
        title    => 'Shared Email Request Form',
        method   => 'POST',
        header   => 1,
        reset    => 1,
        submit   => 1,
        template => {
            type     => 'TT2',
            template => 'request.html.tmpl',
            variable => 'form',
            engine   => {
                INCLUDE_PATH => $INCLUDE_PATH,
                ABSOLUTE     => 1,
            },
            data     => $FORM_DATA,
        },
    );

    # Add all of our form fields
    $form->field(
        name      => 'acctname',
        label     => 'Account Name',
        required  => 1,
        size      => 30,
        maxlength => 32,
        validate  => \&validate_acctname,
    );

    $form->field(
        name      => 'description',
        label     => 'Description',
        required  => 1,
        type      => 'textarea',
        cols      => 40,
        rows      => 2,
        maxlength => 255,
        validate  => \&validate_description,
    );

    $form->field(
        name      => 'owners',
        label     => 'Administrator SUNetID(s)',
        comment   => 'One per line, max. 3',
        required  => 1,
        type      => 'textarea',
        cols      => 9,
        rows      => 3,
        value     => $ENV{REMOTE_USER},
        validate  => \&validate_owners,
    );

    $form->field(
        name      => 'orgid',
        label     => 'Organization ID',
        required  => 1,
        value     => $ENV{WEBAUTH_LDAP_SUPRIMARYORGANIZATIONID},
        size      => 4,
        maxlength => 4,
        validate  => \&validate_orgid,
    );

    $form->field(
        name      => 'sponsor',
        label     => 'Sponsor SUNetID',
        required  => 1,
        size      => 8,
        maxlength => 8,
        validate  => \&validate_owners,
    );

    $form->field(
        name      => 'mailbox',
        label     => 'Keep a copy of email in the mailbox?',
        options   => [qw(yes)],
        validate  => \&validate_mailbox,
    );

    for (my $i=1; $i <= $CONFIG{'shared_email_max_forwards'}; $i++) {
        $form->field(
            name      => "forwardaddr$i",
            label     => "Forwarding Addresses #$i",
            size      => 30,
            maxlength => 40,
            required  => 0,
            validate  => \&validate_forwardaddr,
        );
    }

    $form->field(
        name      => 'addlinfo',
        label     => 'Additional Information',
        required  => 0,
        type      => 'textarea',
        cols      => 40,
        rows      => 2,
    );

    $FORM = $form;
    return $form;
}


######################################################

#
# VALIDATION FUNCTIONS
#

sub validate_acctname {
    my ($acctname) = @_;

    # First, check the length, without various types of characters
    my $name_no_special = $acctname;
    $name_no_special =~ s/[_-]//xmsg;
    if (length($name_no_special) < 9) {
        my $message =   'Account names must be at least 9 characters long '
                      . '(hyphens and underscores do not count towards '
                      . 'the total).';
        $FORM_DATA->{error} = $message;
        return 0;
    }

    my $name_letters_only = $acctname;
    $name_letters_only =~ s/[^a-z]//xmsig;
    if (length($name_letters_only) < 3) {
        my $message = 'Account names must have at least 3 letters';
        $FORM_DATA->{error} =$message;
        return 0;
    }

    # Check for any disallowed characters
    if ($acctname !~ m/\A[a-z0-9_-]+\z/xmsi) {
        my $message =   'Account names may only contain letters, numbers, '
                      . 'hyphens, and underscores.';
        $FORM_DATA->{error} = $message;
        return 0;
    }

    # Next, check to see if there is a pending request
    my $record = $SCHEMA->resultset('Account')->search({ account => $acctname });
    if ($record->count > 0) {
        my $message =   "A request already exists for the account $acctname.  "
                      . 'Someone (maybe you?) has already requested this '
                      . 'account, and that request was either denied or has '
                      . 'not yet been processed.  You can either try a '
                      . 'different account name, or you can open a HelpSU!';
        $FORM_DATA->{error} = $message;
        return 0;
    }

    # Finally, check Accounts to see if this account name exists
    my $result = remctl($CONFIG{acctsponsor_server},
                        0,
                        $CONFIG{'acctsponsor_server_principal'},
                        'sunetid-verify', 'show', $acctname);
    if (defined($result->error())) {
        $LOGGER->fatal(    "Error on remctl sunetid-verify show $acctname: "
                         . $result->error() . ' (request was from '
                         . $ENV{REMOTE_USER} . ')');
        my $message =   'We are having trouble talking to the registry.  '
                      . 'Please try again later, or open a HelpSU.  Sorry!';
        $FORM_DATA->{error} = $message;
        return 0;
    }
    elsif ($result->stdout() =~ m/^Success:[ ]active\n$/xms) {
        my $message = 'An account with this name already exists';
        $FORM_DATA->{error} = $message;
        return 0;
    }
    elsif ($result->stdout() =~ m/^Success:[ ]inactive\n$/xms) {
        my $message =   'An account with this name already exists, but it is '
                      . 'currently unsponsored.  The account may be '
                      . 'intentionally abandoned, or its sponsorship may '
                      . 'have lapsed accidentally.  You should probably open '
                      . 'a HelpSU!';
        $FORM_DATA->{error} = $message;
        return 0;
    }
    elsif ($result->stdout() !~ m/^Success:[ ]none\n$/xms) {
        $LOGGER->fatal(    'Weird output on remctl sunetid-verify show '
                         . "$acctname: '" . $result->stdout() . q{' (}
                         . 'request was from ' . $ENV{REMOTE_USER} . ')');
        my $message =   'We are having trouble talking to the registry.  '
                      . 'Please try again later, or open a HelpSU.  Sorry!';
        $FORM_DATA->{error} = $message;
        return 0;
    }

    # Looks like we're good!
    return 1;
}

sub validate_description {
    my ($description) = @_;

    # Decriptions are limited to 255 characters
    if (length() > 255) {
        my $message = 'Please limit your description to 255 characters';
        $FORM_DATA->{error} = $message;
        return 0;
    }

    # Make sure there are only ASCII characters in the string.
    if ($description !~ m{^[[:alnum:][:punct:]\s]*$}xsm) {
        my $message = 'The Description contains an illegal character; '
                    . 'only letters, numbers, and ASCII punctuation allowed';
        $FORM_DATA->{error} = $message;
        return 0;
    }

    return 1;
}

sub validate_owners {
    my ($input) = @_;
    my @owners = split_entries($input);

    # We need at least one owner
    if (scalar(@owners) == 0) {
        my $message = 'Please enter at least one administrator';
        $FORM_DATA->{error} = $message;
        return 0;
    }

    if (scalar(@owners) > 3) {
        my $message = 'Please enter no more than three administrators';
        $FORM_DATA->{error} = $message;
        return 0;
    }

    my %owner_hash = ();
    foreach my $owner (@owners) {
        if (exists($owner_hash{$owner})) {
            my $message = "Please remove the duplicate from 'Administrator SUNetID(s)'";
            $FORM_DATA->{error} = $message;
            return 0;
        } else {
            $owner_hash{$owner} = 1;
        }
    }

    # Make an LDAP connection, for alias checking. We set
    # net_ldapapi to 1 as Stanford::Directory is having trouble making queries
    # using Net::LDAP.
    my $LDAP = Stanford::Directory->new();
    $LDAP->set(
        ldap_server => $CONFIG{ldap_server},
        mechanism   => 'GSSAPI',
        ticket_file => $CONFIG{ccache},
        basedn      => 'cn=accounts,dc=stanford,dc=edu',
        scope       => 'one',
        net_ldapapi => 1,
    );

    # Make sure each owner is an active person
    # In this case, we want the SUNetID to be "active"
    foreach my $owner (@owners) {
        my $result = remctl($CONFIG{acctsponsor_server},
                            0,
                            $CONFIG{'acctsponsor_server_principal'},
                            'sunetid-verify', 'show', $owner);
        if (defined($result->error())) {
            $LOGGER->fatal("Error on remctl sunetid-verify show $owner: "
                          . $result->error() . ' (request was from '
                          . $ENV{REMOTE_USER} . ')');
            my $message =   'We are having trouble talking to the registry.  '
                          . 'Please try again later, or open a HelpSU.  Sorry!';
            $FORM_DATA->{error} = $message;
            return 0;
        }
        elsif ($result->stdout() =~ m/^Success:[ ]none$/xms) {
            my $message = "The SUNetID $owner does not exist";
            $FORM_DATA->{error} = $message;
            return 0;
        }
        elsif ($result->stdout() =~ m/^Success:[ ]inactive$/xms) {
            my $message = "The SUNetID $owner is inactive";
            $FORM_DATA->{error} = $message;
            return 0;
        }
        elsif ($result->stdout() =~ m/^Success:[ ]active$/xms) {
            1;
        }
        else {
            $LOGGER->fatal('Weird output on owner-checking '
                           . "sunetid-verify show $owner: '"
                           . $result->stdout() . q{' (request was from }
                           . $ENV{REMOTE_USER} . q{)});
            my $message =   'We are having trouble talking to the registry.  '
                          . 'Please try again later, or open a HelpSU.  Sorry!';
            $FORM_DATA->{error} = $message;
            return 0;
        }

        # Now we know that the name provided is valid, but is it an alias?
        # We need to do a directory lookup to figure that out.

        # First, we need to remove all non-alphanum characters.
        # Then we can do the search.
        my $hashed_owner = $owner;
        $hashed_owner =~ s/[^a-z0-9]//xmsig;
        $LOGGER->debug("About to run LDAP query with 'suSeasSunetID=$hashed_owner'");
        my @ldap_results = $LDAP->ldap_query('suSeasSunetID=' . $hashed_owner,
            'uid'
        );
        if (!@ldap_results) {
            if ($LDAP->error) {
                $LOGGER->fatal("Weird output on LDAP lookup of $owner:"
                               . $LDAP->error);
                my $message =   'We are having trouble talking to the '
                              . 'Directory.  Please try again later, or open '
                              . 'a HelpSU.  Sorry!';
                $FORM_DATA->{error} = $message;
                return 0;
            } else {
                $LOGGER->fatal("LDAP lookup of known ID $owner returned "
                                 . 'zero results.');
                my $message =   "The SUNetID $owner is valid, but does not "
                              . 'exist in the Directory.  It is possible that '
                              . 'the SUNetID you mentioned is disabled.  '
                              . 'Please check the SUNetID, and open a HelpSU '
                              . 'if necessary.';
                $FORM_DATA->{error} = $message;
                return 0;
            }
        }
        if (scalar(@ldap_results) > 1) {
            $LOGGER->fatal("LDAP lookup of $owner returned multiple entries.");
            my $message =   'We are having trouble talking to the '
                          . 'Directory.  Please try again later, or open '
                          . 'a HelpSU.  Sorry!';
            $FORM_DATA->{error} = $message;
            return 0;
        }

        # Get the UID, and compare
        my ($uid) = $ldap_results[0]->uid;
        if ($owner ne $uid) {
            my $message =   "'$owner' is not a SUNetID.  It appears to be "
                          . 'an alias.  Please try again with a SUNetID.';
            $FORM_DATA->{error} = $message;
            return 0;
        }
    }

    return 1;
}

sub validate_orgid {
    my ($orgid) = @_;

    # Check with Accounts to see if the Org ID is valid
    my $lookup_result;
    eval {
        $lookup_result = lookup_orgid($orgid);
    };
    if ($@) {
        $LOGGER->fatal("Error looking up Org ID $orgid: $@ (request was "
                     . 'from ' . $ENV{REMOTE_USER});
        my $message =   'We are having trouble talking to the registry.  '
                      . 'Please try again later, or open a HelpSU.  Sorry!';
        $FORM_DATA->{error} = $message;
        return 0;
    }

    # If we got a false lookup result, then fail
    if (!$lookup_result) {
        my $message =   "The Org ID $orgid did not match any known "
                      . 'organization IDs';
        $FORM_DATA->{error} = $message;
        return 0;
    }

    # No errors came back, so we have a valid OrgID!
    return 1;
}

sub validate_forwardaddr {
    my ($input) = @_;

    # Make sure the email address is an email address
    if (!Email::Valid->address($input)) {
        my $message = "'$input' is not a valid email address.";
        $FORM_DATA->{error} = $message;
        return 0;
    }

    # Make sure the email address isn't too long
    if (length($input) > 67) {
        my $message = "'$input' is too long.  Maximum length is 67 characters";
        $FORM_DATA->{error} = $message;
        return 0;
    }

    return 1;
}

sub validate_mailbox {
    my ($input) = @_;

    # Make sure "yes" is the text
    if ($input ne 'yes') {
        my $message = 'Unexpected value for the mailbox checkbox';
        $FORM_DATA->{error} = $message;
        return 0;
    }

    # Make sure we have no more than two forwarding addresses
    my @emails = split_entries($FORM->field('forwardaddr'));
    if (scalar(@emails) > 2) {
        my $message =   'When keeping a copy in the mailbox, you can only '
                      . 'forward to two other email addresses.';
        $FORM_DATA->{error} = $message;
        return 0;
    }

    return 1;
}

1;

__END__

=pod

=head1 NAME



=head1 SYNOPSIS



=head1 DESCRIPTION




=head1 OPTIONS



=back

=head1 AUTHOR

A. Karl Kornel - akkornel@stanford.edu
