#!/usr/bin/perl
# based on user.pl from "Official Guide to Programming with CGI.pm"
# by Lincoln Stien
#
# modified by Vicki Brown

use CGI qw/:standard :html3 :netscape/;
use CGI::Carp qw(fatalsToBrowser carpout);
use POSIX;
use Mail::Mailer;

use vars qw{@REQUIRED @OPTIONAL @HIDDEN @VIEWABLE};
@REQUIRED = qw/AddedBy Login RealName Location Status Password1 Password2/;
@OPTIONAL = qw/Phone Scientist RA Tech Other MolBio ACF TC TOther IT Admin
Shell Group Home/;
@HIDDEN   = qw/Password/;
@VIEWABLE = qw/RealName Login Location Phone Scientist RA Tech Other Status/;

use vars qw{$LINUX $TIMEOUT $USERFILE $DATAFILE %ENTITIES };
$LINUX = 1;  # set to true for Linux (has newusers command);
             # false for non-Linux (no newusers) (Check adduser syntax!!!)
             
$TIMEOUT = 10;  # allow up to 10 seconds for waiting on a locked user

$USERFILE = './userfile.txt';
$DATAFILE = './userdata.txt';
%ENTITIES = ('&'=>'&amp;', '>'=>'&gt;', '<'=>'&lt;', '\"'=>'&quot;' );

use vars qw{$ePassword $Email $To_Address @From };
$ePassword = ''; # The encrypted password

$Email = '@companyn.com';

$To_Address = 'sysadmin@company.com';  # for notification email
@From = ('System Admin <sysadmin@company.com>',
         'Vicki Brown <vlb@company.com>',
        );

use vars qw{ $msg $oldsig };

#
# main
#
{           
	print header,
	    start_html(-title=>'User Accounts',
	               -background=>"",
	              ),
	    h1("User Accounts");
	
	$_ = param('action');
	
	 CASE: {
	     /^add/i and do    {
	         add_user();
	         last CASE;
	     };
	     /^yes|confirm/i and do {
	         write_data()     &&
	         write_userinfo() &&
	         notify_admin()   &&
	         view_user();
	         last CASE;
	     };
	     /^view/i and do {
	         view_user();
	     };
	     # default
	     generate_form();
	 }
	
	print end_html;
}

sub add_user {
    my @missing = check_missing(param());
    if (@missing) {
        print_warning("Please fill in the following fields: ", @missing);
        generate_form();
        return undef;
    }
    
    # Test the User Login name
    my $uid = getpwnam(param('Login'));
    if ($uid) {
        print_warning("There is already a user with ID", param('Login'));
        print_warning("Please choose another User ID");
        generate_form();
        return undef;
    }

    # remove any spaces, flatten case, take out any '@deltagen.com'
    my $login = param('Login');
    $login =~ s/\s+//g;
    $login =~ s/\@.*//;
    $login =~ tr/[A-Z]/[a-z]/;
    param(-name=>'Login', -value=>"$login");
    
    $cnt = $login =~ tr/a-z0-9_\-//c;
    
    if ($cnt) {
        print_warning("User ID [$login] may consist only of letters (and numbers); try again");
        generate_form();
        return undef;
    }
    
    # Check the password
    
    my $pass1 = param('Password1');
    $chars = ($pass1 =~ s/.//g);     # s/(.)/$1/g would not destroy $pass1
    
    unless ($chars <= 8) {
        print_warning("Password may contain no more than 8 characters; try again");
        generate_form();
        return undef;
    }
     
    my $ePassword = check_password(param('Password1'), param('Password2'));
    unless ($ePassword) {
        print_warning("Password fields do not match; please re-enter password");
        generate_form();
        return undef;
    }
    
    
    param(-name=>'ePassword', -value=>"$ePassword");
    my @rows;
    foreach (@REQUIRED,@OPTIONAL) {
        if (/Password/) {
            push(@rows,TR(th({-align=>LEFT},$_),td(escapeHTML(param('ePassword')))));
        } else {
            push(@rows,TR(th({-align=>LEFT},$_),td(escapeHTML(param($_)))));
        }
    }
    
    unless (-d param('Home')) {
        print_warning("No such directory %s; cannot create home directory", param('Home'));
        generate_form();
        return undef;
    }
    
    # Everything is OK
    
    print "Here is your new user entry.  Press ",
          em('Confirm')," to save it, or ",em('Change'),
          " to change it.",
          hr,
          table(@rows),
          hr;

    print start_form(-method=>'POST');
    foreach (@REQUIRED, @OPTIONAL, @HIDDEN) {
        print hidden(-name=>$_)
    }
    print submit(-name=>'action',
                 -value=>'No - Change Entry'),
          submit(-name=>'action',
                 -value=>'Yes - Confirm Entry'),
          end_form;
}

sub check_missing {
    my (%p);
    grep (param($_) ne '' && $p{$_}++,@_);
    return grep(!$p{$_},@REQUIRED);
}

sub print_warning {
    $message = shift;
    print font({-color=>'red'},
          "$message",
          em(join(', ',@_)),
          '.');
}

sub check_password {
    my ($Password1, $Password2) = @_;
    my @saltchars;
    my $salt;

    @saltchars = ('a'..'z', 'A'..'Z', 0..9 , '.',  ',', '/' );

    return(0) unless ($Password1 eq $Password2);
    srand($$|time);
    $salt  = $saltchars[int(rand($#saltchars+1))];
    $salt .= $saltchars[int(rand($#saltchars+1))];
    return(crypt($Password1,$salt));   
}

sub generate_form {
    print start_form(-method=>'POST'),
     table(
        TR({-align=>LEFT},
          th('User Real Name (First Last)'),
          td(textfield(-name=>'RealName',-size=>50))
        ),
        TR({-align=>LEFT},
          th('User ID (desired email ID)'),
          td(textfield(-name=>'Login',-size=>50))
        ),
        TR({-align=>LEFT},
          th('Phone (if own phone)'),
          td(textfield(-name=>'Phone',-size=>25, -value=>''))
        ),
        TR({-align=>LEFT},
          th('Status'),
          td(radio_group(-name=>'Status', -value=>['Perm', 'Temp'])
            ),
        ),
        TR({-align=>LEFT},
          th('Location (e.g. WetLab, ACF, IT...)'),
          td(textfield(-name=>'Location',-size=>50))
        ),
        TR({-align=>LEFT},
          th('Job type (check one)'),
          td(
             checkbox(-name=>'Scientist', -label=>'Scientist', -value=>'Yes'),
             checkbox(-name=>'RA', -label=>'RA', -value=>'Yes'),
             checkbox(-name=>'Tech', -label=>'Tech', -value=>'Yes'),
             checkbox(-name=>'Other', -label=>'Other', -value=>'Yes'),
             ),
        ),
        TR({-align=>LEFT},
          th('Teams (check all that apply)'),
          td(
             checkbox(-name=>'MolBio', -label=>'MolBio', -value=>'Yes'),
             checkbox(-name=>'ACF', -label=>'ACF', -value=>'Yes'),
             checkbox(-name=>'TC', -label=>'TC', -value=>'Yes'),
             checkbox(-name=>'IT', -label=>'Info. Tech.', -value=>'Yes'),
             checkbox(-name=>'Admin', -label=>'HR, Finance, Legal...', -value=>'Yes'),
             checkbox(-name=>'TOther', -label=>'Other', -value=>'Yes'),
             ),
        ),
        TR({-align=>LEFT},
          th('Password (case-sensitive)'),
          td(password_field(-name=>'Password1',),
             password_field(-name=>'Password2',),
            ),
        ),
        TR({-align=>LEFT},
          th('Account Added By (email address)'),
          td(popup_menu(-name=>'AddedBy',
                        -value=>[@From]),
          ),
        ),
        TR({-align=>LEFT},
          th('Unix data (do not change :-)'),
          td(popup_menu(-name=>'Shell',
             -value=>['/POPPER/SHELL', '/bin/tcsh', '/bin/csh', '/bin/bash'], -default=>'/POPPER/SHELL'),
             textfield(-name=>'Group', -size=>10, -value=>'102'),
             textfield(-name=>'Home', -size=>10, -value=>'/homes'),
             ),
        ),
     ),
     br,
     submit(-name=>'action',-value=>'Add New User'),
     submit(-name=>'action',-value=>'View All Users'),
     end_form;
     print hr,
       h2("Instructions");
     print << 'EOT';
     <UL>
     <P><LI>User's <B>real name</B> (e.g. Joe Jones)
     <P><LI>Preferred <B>email address</B>; 8 characters or fewer is best (e.g. jjones)
     <P><LI><B>Phone</B> - if user has a phone number. Otherwise, use the lab number
        or leave blank.
     <P><LI><B>Status</B>: Permanent or temporary?
     <P><LI><B>Location</B>: Where is this person most likely to be found?<BR>
        If the user doesn't have a lab job, use the job type / Department,<BR>
        e.g. Bioinformatics, Finance, Legal, HR...
     <P><LI><B>Job Type</B> - Please check as appropriate
     <P><LI><B>Teams</B> - Please check all that apply (information is used for mailing lists)<BR>
     Lab: <B>Molbio</B> - Molecular Biology; <B>ACF</B> - Animal Care Facility;
     <B>TC</B> - Tissue Culture<BR>
     <B>Info. Tech</B>: Information Technology (Programmer, Database, SysAdmin...)<BR>
     Admin: <B>HR, Finance, Legal</B> - Administrative positions<BR>
     Other - any not categorized.
     <P><LI><B>Password</B> - 8 characters or fewer, any standard keyboard character<BR>
        Case matters! This can be changed later.
     <P><LI><B>Unix Data</B> - Do Not Change This
     </UL>
EOT
}

sub notify_admin {
    my $mailer;
    my $subject;
    my $user = param('Login');
    my $pw = param('Password1');
    my $realname = param('RealName');
    my $from_address = param('AddedBy');
    my $location = param('Location');
    my $date = localtime;
    
    $subject = 'Email account created for ' . $user;
    
    $mailer = Mail::Mailer->new();
    
    # From is httpd. I can't seem to change that somehow...
    
    $mailer->open({ 'To'      => $To_Address,
                    'Subject' => $subject,
                  })
             or die "Cannot open [$!]\n";
    
    print $mailer <<EO_MAIL;
    $date
    Email account added for $realname <$user\@deltagen.com>.
    Initial Password is $pw
    Location: $location

    Added by: $from_address
EO_MAIL

    $mailer->close();
    1;
}

sub view_user {

    # print start_form(-method=>'POST'),
    #      submit(-name=>'New User'),
    #      end_form
    #      unless param('Login');

    my $fh = Lock($USERFILE,0);

    unless ($fh) {
       print strong('Sorry, an error occurred: unable to read user data file.'),br;
       Delete('action');
       print a({-href=>self_url},'Try again');
       return undef;
    }
    my @rows;
    while (<$fh>) {
       chomp;
       my @data = map {CGI::unescape($_)} split("\t");
       foreach (@data) {
           $_ = escapeHTML($_);
           $_ = '.' unless($_);
       }
       unshift(@rows,td(\@data));
    }
    my $usercnt = scalar(@rows);     # don't count the header
#    @rows = sort(@rows);
    unshift(@rows,th([@VIEWABLE]));  # header
    print table({-border=>''},
          caption(strong("$usercnt Users")),
          TR(\@rows));
    UnLock($fh);
    1;
}


sub write_data {
    my $fh2 = Lock($DATAFILE,1);
   
    unless ($fh2) {
       print strong('Sorry, an error occurred: unable to write to user data file.'),p();
       Delete('action');
       print a({-href=>self_url},'Try again');
       return undef;
    }

    printf $fh2 ("%s:%s:%s:%s:%s:%s:%s:%s:%s:%s:%s:%s:%s:%s:%s:%s:%s:%s:%s:%s\n",
	  param('Login'), param('RealName'), param('Password1'), param('ePassword'),
	  param('Location'), param('Phone'), param('Group'), 
	  param('Shell'), param('Home'), param('Status'),
	  param('Scientist'), param('RA'), param('Tech'), param('Other'),
	  param('MolBio'), param('ACF'), param('TC'), param('IT'),
	  param('Admin'), param('TOther')
	  );

    UnLock($fh2);
    1;
}

sub write_userinfo {
    
    my $fh = Lock($USERFILE,1);
    unless ($fh) {
       print strong('Sorry, an error occurred: unable to write to user file.'),p();
       # Delete('action');
       # print a({-href=>self_url},'Try again');
       print start_form;
       foreach (@REQUIRED,@OPTIONAL) {
           print hidden(-name=>$_);
       }
       print submit(-name=>'action',
                    -value=>'Change Entry'),
             end_form;
       return undef;
    }

    print $fh join("\t",map {CGI::escape(param($_))} (@VIEWABLE)),"\n";
    UnLock($fh);
    1;
}

sub escapeHTML {
    my $text = shift;
    $text =~ s/([&\"><])/$ENTITIES{$1}/ge;
    return $text;
}

sub LOCK_SH { 1 }
sub LOCK_EX { 2 }
sub LOCK_UN { 8 }

sub Lock {
    # Because this function designate the Filehandle, it can only Lock one
    # file at a time
    my $path = shift;
    my $for_writing = shift;

    my ($lock_Job,$path_name,$description);
    if ($for_writing) {
        $lock_Job = LOCK_EX;
        $path_name = ">>$path";
        $description = 'writing';
    } else {
        $lock_Job = LOCK_SH;
        $path_name = $path;
        $description = 'reading';
    }

    local($msg,$oldsig);
    my $handler = sub { $msg='timed out'; $SIG{ALRM}=$oldsig; };
    ($oldsig,$SIG{ALRM}) = ($SIG{ALRM},$handler);
    alarm($TIMEOUT);

    open (FH,$path_name) or
       warn("Couldn't open $path for $description: $!"), return undef;

    # now try to lock it
    unless (flock (FH,$lock_Job)) {
       warn("Couldn't get lock for $description (" . ($msg || "$!") . ")"); 
       alarm(0);
       close FH;
       return undef; 
    }
    alarm(0);
    return \*FH;
}

sub UnLock {
    my $fh = shift;
    flock($fh,LOCK_UN) || die("Couldn't unlock $fh\n");
    close $fh;
}