#!/usr/bin/perl

=pod

=head1 NAME

make_domain_coordinator.pl - Make a domain coordinator on a LON-CAPA system

=cut

# The LearningOnline Network
# make_domain_coordinator.pl - Make a domain coordinator on a system
#
# $Id: make_domain_coordinator.pl,v 1.24 2012/12/18 13:05:41 raeburn Exp $
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
###

=pod

=head1 DESCRIPTION

Automates the steps for domain coordinator creation.  This
program also describes a manual procedure (see below).

These are the steps that are executed on the linux operating system:

=over 4

=item * 

Tests to see if user already exists for linux system or for
LON-CAPA, if so aborts.  A message is output that recommends following
a manual procedure enabling this user if so desired.

=item *

Creates a linux system user

=item *

Sets password

=item *

Creates a LON-CAPA lonUsers directory for user

=item *

Sets LON-CAPA password mechanism to be "unix"

=item *

Set roles.hist and roles.db

=back

=cut

# NOTE: I am interspersing the manual procedure with the automation.
# To see the manual procedure, do perldoc ./make_domain_coordinator.pl

# This is a standalone script.  It *could* alternatively use the
# lcuseradd script, however lcuseradd relies on certain system
# dependencies.  In order to have a focused performance, I am trying
# to avoid system dependencies until the LON-CAPA code base becomes
# more robust and well-boundaried.  make_domain_coordinator.pl should be able
# to run freely as possible, irrespective of the status of a LON-CAPA
# installation.

# ---------------------------------------------------- Configure general values

use lib '/home/httpd/lib/perl/';
use LONCAPA;
use LONCAPA::lonmetadata;
use Term::ReadKey;
use Apache::lonnet;
use Apache::lonlocal;
use DBI;
use Storable qw(nfreeze);
use strict;

=pod

=head1 OPTIONS

There are no flags to this script.

usage: make_domain_coordinator.pl [USERNAME] [DOMAIN] 

The password is accepted through standard input
and should only consist of printable ASCII
characters and be a string of length greater than 5 characters.

The first argument
specifies the user name of the domain coordinator and
should consist of only alphanumeric characters.
It is recommended that the USERNAME should be institution-specific
as opposed to something like "Sammy" or "Jo".
For example, "dcmsu" or "dcumich" would be good domain coordinator
USERNAMEs for places like Mich State Univ, etc.

The second argument specifies the domain of the computer
coordinator.

=cut

my $lang = &Apache::lonlocal::choose_language();
&Apache::lonlocal::get_language_handle(undef,$lang);
print"\n";

# ----------------------------------------------- So, are we invoked correctly?
# Two arguments or abort
if (@ARGV!=2) {
    print(&mt('usage: [_1]','make_domain_coordinator.pl [USERNAME] [DOMAIN]')."\n\n".
        &mt('It is recommended that the USERNAME should be institution-specific.').
	"\n".&mt('It should not be something like "Sammy" or "Jo".')."\n".
	&mt('For example, [_1] or [_2] would be good domain coordinator USERNAMEs for places like Michigan State University, etc.','"domcoordmsu"','"dcmichstate"')."\n");
    exit;
}
my ($username,$domain)=(@ARGV);
if ($username=~/$LONCAPA::not_username_re/) {
    print(&mt('**** ERROR **** Username [_1] must consist only of - . and alphanumeric characters.',$username)."\n");
    exit;
}
if ($domain=~/$LONCAPA::not_domain_re/) {
    print(&mt('**** ERROR **** Domain [_1] must consist only of - . and alphanumeric characters.',$domain)."\n");
    exit;
}

# Does user already exist
my ($is_user,$has_lc_account);

my $udpath=&propath($domain,$username);
if (-d $udpath) {
    $has_lc_account = 1;
}

if ($has_lc_account) {
    print(&mt('**** ERROR **** [_1] is already defined as a LON-CAPA user.',
              $username)."\n\n".
          &mt('To assign a domain coordinator role to an existing user, use: [_1]',
              "\n".'perl add_domain_coordinator_privilege.pl')."\n\n");
    exit;
}

if (-d "/home/$username") {
    $is_user = 1;
}

if ($is_user) {
    print(&mt('**** ERROR **** [_1] is already a linux operating system user.',
              $username)."\n\n".
          &mt('This script will only automatically generate new users.')."\n".
          &mt('To assign a domain coordinator role to an existing user:')."\n\n".
          &mt('If you want to make "[_1]" a domain coordinator, you should do so manually by customizing the MANUAL PROCEDURE described in the documentation.',$username)."\n\n".
          &mt('To view the documentation for this script, type: [_1].',
              "\n".'perldoc ./make_domain_coordinator.pl')."\n\n");
    exit;
}

# Output a warning message.
print(&mt('**** NOTE **** Generating a domain coordinator is "serious business".')."\n".
     &mt('You must choose a password that is difficult to guess.')."\n");

print(&mt('Continue? ~[Y/n~] '));
my $go_on = <STDIN>;
chomp($go_on);
$go_on =~ s/(^\s+|\s+$)//g;
my $yes = &mt('y');
unless (($go_on eq '') || ($go_on =~ /^\Q$yes\E/i)) {
    exit;
}
print "\n";

my ($got_passwd,$firstpass,$secondpass,$passwd);
my $maxtries = 10;
my $trial = 0;
while ((!$got_passwd) && ($trial < $maxtries)) {
    $firstpass = &get_password(&mt('Enter password'));
    if (length($firstpass) < 6) {
        print(&mt('Password too short.')."\n".
              &mt('Please choose a password with at least six characters.')."\n".
              &mt('Please try again.')."\n");
    } elsif (length($firstpass) > 30) {
        print(&mt('Password too long.')."\n".
              &mt('Please choose a password with no more than thirty characters.')."\n".
              &mt('Please try again.')."\n");
    } else {
        my $pbad=0;
        foreach (split(//,$firstpass)) {if ((ord($_)<32)||(ord($_)>126)){$pbad=1;}}
        if ($pbad) {
            print(&mt('Password contains invalid characters.')."\n".
                  &mt('Password must consist of standard ASCII characters.')."\n".
                  &mt('Please try again.')."\n");
        } else {
            $secondpass = &get_password(&mt('Enter password a second time'));
            if ($firstpass eq $secondpass) {
                $got_passwd = 1;
                $passwd = $firstpass;
            } else {
                print(&mt('Passwords did not match.')."\n". 
                      &mt('Please try again.')."\n");
            }
        }
        $trial ++;
    }
}
if (!$got_passwd) {
    exit;
}
print "\n";

=pod

=head1 MANUAL PROCEDURE

There are 10 steps to manually recreating what this script performs
automatically.

You need to decide on three pieces of information
to create a domain coordinator.

 * USERNAME (kermit, albert, joe, etc)
 * DOMAIN (should be the same as lonDefDomain in /etc/httpd/conf/loncapa.conf)
 * PASSWORD (don't tell me)

The examples in these instructions will be based
on three example pieces of information:

 * USERNAME=dc103
 * DOMAIN=103
 * PASSWORD=sesame

You will also need to know your "root" password
and your "www" password.

=over 4

=item 1.

login as root on your Linux system
 [prompt %] su

=cut

# ------------------------------------------------------------ So, are we root?

if ($< != 0) { # Am I root?
   print(&mt('You must be root in order to generate a domain coordinator.').
         "\n");
}

=pod

=item 2 (as root). add the user

 Command: [prompt %] /usr/sbin/useradd USERNAME
 Example: [prompt %] /usr/sbin/useradd dc103

=cut

# ----------------------------------------------------------- /usr/sbin/groupadd
# -- Add group
$username=~s/\W//g; # an extra filter, just to be sure

print(&mt('adding group: [_1]',$username)."\n");
my $status = system('/usr/sbin/groupadd', $username);
if ($status) {
    print(&mt('Error.').' '.
          &mt('Something went wrong with the addition of group "[_1]".',
              $username)."\n");
    exit;
}
my $gid = getgrnam($username);

# ----------------------------------------------------------- /usr/sbin/useradd
# -- Add user

print(&mt('adding user: [_1]',$username)."\n");
my $status = system('/usr/sbin/useradd','-c','LON-CAPA user','-g',$gid,$username);
if ($status) {
    system("/usr/sbin/groupdel $username");
    print(&mt('Error.').' '.
          &mt('Something went wrong with the addition of user "[_1]".',
              $username)."\n");
    exit;
}

print(&mt('Done adding user.')."\n");
# Make www a member of that user group.
my $groups=`/usr/bin/groups www`;
# untaint
my ($safegroups)=($groups=~/:\s*([\s\w]+)/);
$groups=$safegroups;
chomp $groups; $groups=~s/^\S+\s+\:\s+//;
my @grouplist=split(/\s+/,$groups);
my @ugrouplist=grep {!/www|$username/} @grouplist;
my $gl=join(',',(@ugrouplist,$username));
print(&mt("Putting www in user's group.")."\n");
if (system('/usr/sbin/usermod','-G',$gl,'www')) {
    print(&mt('Error.').' '.&mt('Could not make www a member of the group "[_1]".',
              $username)."\n");
    exit;
}

# Check if home directory exists for user
# If not, create one.
if (!-e "/home/$username") {
    if (!mkdir("/home/$username",0710)) {
        print(&mt('Error.').' '.&mt('Could not add home directory for "[_1]".',
                  $username)."\n");
        exit;
    }
}

if (-d "/home/$username") {
    system('/bin/chown',"$username:$username","/home/$username");
    system('/bin/chmod','-R','0660',"/home/$username");
    system('/bin/chmod','0710',"/home/$username");
}
=pod

=item 3 (as root). enter in a password

 Command: [prompt %] passwd USERNAME
          New UNIX password: PASSWORD
          Retype new UNIX passwd: PASSWORD
 Example: [prompt %] passwd dc103
          New UNIX password: sesame
          Retype new UNIX passwd: sesame

=cut

# Process password (taint-check, then pass to the UNIX passwd command).
$username =~ s/\W//g; # an extra filter, just to be sure
my $pbad = 0;
foreach (split(//,$passwd)) {if ((ord($_)<32)||(ord($_)>126)){$pbad=1;}}
if ($pbad) {
    print(&mt('Password must consist of standard ASCII characters.').
          "\n");
}
 
my $distro;
if (open(PIPE,"perl distprobe|")) {
    $distro = <PIPE>;
    close(PIPE);
}
if ($distro =~ /^ubuntu|debian/) {
    open(OUT,"|usermod -p `mkpasswd $passwd` $username");
    close(OUT);
} else {
    open(OUT,"|passwd --stdin $username");
    print(OUT $passwd."\n");
    close(OUT);
}

=pod

=cut

=pod

=item 4. login as user=www

 Command: [prompt %] su www
 Password: WWWPASSWORD

=item 5. (as www). cd /home/httpd/lonUsers

=item 6. (as www) Create user directory for your new user.

 Let U equal first letter of USERNAME
 Let S equal second letter of USERNAME
 Let E equal third letter of USERNAME
 Command: [prompt %] install -d DOMAIN/U/S/E/USERNAME

 Here are three examples of the commands that would be needed
 for different domain coordinator names (dc103, morphy, or ng):

 Example #1 (dc103):  [prompt %] install -d 103/d/c/1/dc103
 Example #2 (morphy): [prompt %] install -d 103/m/o/r/morphy
 Example #3 (ng):     [prompt %] install -d 103/n/g/_/ng

=cut

# Generate the user directory.
`install -o www -g www -d $udpath`; # Must be writeable by httpd process.

=pod

=item 7. (as www) Enter the newly created user directory.

 Command: [prompt %] cd DOMAIN/U/S/E/USERNAME
 Example: [prompt %] cd 103/d/c/1/dc103

=item 8. (as www). Set your password mechanism to 'unix' 

 Command: [prompt %] echo "unix:" > passwd

=cut

# UNIX (/etc/passwd) style authentication is asserted for domain coordinators.
open(OUT, ">$udpath/passwd");
print(OUT 'unix:'."\n");
close(OUT);

# Get permissions correct on udpath

 print(&mt('Setting permissions on user data directories.').' '.
       &mt('This may take a moment, please be patient ...')."\n");
`chown -R www:www /home/httpd/lonUsers/$domain` ; # Must be writeable by httpd process.

=pod

=item 9. (as www). Run CVS:loncapa/doc/rolesmanip.pl:

 Command: [prompt %] perl rolesmanip.pl DOMAIN USERNAME
 Example: [prompt %] perl rolesmanip.pl 103 dc103

=cut

use GDBM_File; # A simplistic key-value pairing database.

my $rolesref=&LONCAPA::locking_hash_tie("$udpath/roles.db",&GDBM_WRCREAT());
if (!$rolesref) {
    print(&mt('Error').' '.
          &mt('unable to tie roles db: [_1].',"$udpath/roles.db")."\n");
    exit;
}
my $now = time;
$rolesref->{'/'.$domain.'/_dc'}='dc_0_'.$now; # Set the domain coordinator role.
open(OUT, ">$udpath/roles.hist"); # roles.hist is the synchronous plain text.
foreach my $key (keys(%{$rolesref})) {
    print(OUT $key.' : '.$rolesref->{$key}."\n");
}
close(OUT);
&LONCAPA::locking_hash_untie($rolesref);


`chown www:www $udpath/roles.hist`; # Must be writeable by httpd process.
`chown www:www $udpath/roles.db`; # Must be writeable by httpd process.

my %perlvar = %{&LONCAPA::Configuration::read_conf('loncapa.conf')};
my $dompath = $perlvar{'lonUsersDir'}.'/'.$domain;
my $domrolesref = &LONCAPA::locking_hash_tie("$dompath/nohist_domainroles.db",&GDBM_WRCREAT());

if (!$domrolesref) {
    print(&mt('Error').' '.&mt('unable to tie nohist_domainroles db: [_1].',
                               "$dompath/nohist_domainroles.db")."\n");
}

# Store in nohist_domainroles.db
my $domkey=&LONCAPA::escape('dc:'.$username.':'.$domain.'::'.$domain.':');
$domrolesref->{$domkey}= &LONCAPA::escape('0:'.$now);
&LONCAPA::locking_hash_untie($domrolesref);

 system('/bin/chown',"www:www","$dompath/nohist_domainroles.db"); # Must be writeable by httpd process.
 system('/bin/chown',"www:www","$dompath/nohist_domainroles.db.lock");

# Log with domainconfiguser in nohist_rolelog.db
my $domconfiguser = $domain.'-domainconfig';
my $subdir = $domconfiguser;
$subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;
$subdir .= "/$domconfiguser";

if (-d "$dompath/$subdir") {
    my $rolelogref = &LONCAPA::locking_hash_tie("$dompath/$subdir/nohist_rolelog.db",&GDBM_WRCREAT());
    my $domlogkey = &LONCAPA::escape($now.'00000'.$$.'000000'); 
    my $storehash = {
                       role    => 'dc',
                       start   => $now,
                       end     => 0,
                       context => 'server',
                    };
    my $domlogvalue = {
                        'exe_uname' => '',
                        'exe_udom'  => $domain,
                        'exe_time'  => $now,
                        'exe_ip'    => '127.0.0.1',
                        'delflag'   => '',
                        'logentry'  => $storehash,
                        'uname'     => $username,
                        'udom'      => $domain,
                     };
    $rolelogref->{$domlogkey}=&freeze_escape($domlogvalue);
    &LONCAPA::locking_hash_untie($rolelogref);

    system('/bin/chown',"www:www","$dompath/$subdir/nohist_rolelog.db"); # Must be writeable by httpd process.
    system('/bin/chown',"www:www","$dompath/$subdir/nohist_rolelog.db.lock");
} else {
    print(&mt('Failed to log role creation as the path to the directory: "[_1]" does not exist.',"$dompath/$subdir/")."\n".
          &mt('Please run UPDATE from the top level directory of the extracted LON-CAPA tarball, i.e., two levels up from this current directory (loncom/build).'));
}

#Update allusers MySQL table

print(&mt('Adding new user to allusers table.')."\n");
&allusers_update($username,$domain,\%perlvar);

=pod

=item 10.

You may further define the domain coordinator user (i.e. dc103)
by going to http://MACHINENAME/adm/createuser.

=cut

# Output success message, and inform sysadmin about how to further proceed.
print("\n".&mt('[_1] is now a domain coordinator',$username)."\n"); # Output success message.
my $hostname=`hostname`; chomp($hostname); # Read in hostname.
print("\n".
      &mt('Once LON-CAPA is running, you should log-in and use: [_1] to further define this user.',
          "\nhttp://$hostname/adm/createuser\n")."\n\n".
      &mt('From the user management menu, click the link: "Add/Modify a User" to search for the user and to provide additional information (last name, first name etc.).')."\n"); 
# Output a suggested URL.

sub allusers_update {
    my ($username,$domain,$perlvar) = @_;
    my %tablenames = (
                       'allusers'   => 'allusers',
                     );
    my $dbh;
    unless ($dbh = DBI->connect("DBI:mysql:loncapa","www",
                            $perlvar->{'lonSqlAccess'},
                            { RaiseError =>0,PrintError=>0})) {
        print(&mt('Cannot connect to database!')."\n");
        return;
    }
    my $tablechk = &allusers_table_exists($dbh);
    if ($tablechk == 0) {
        my $request =
   &LONCAPA::lonmetadata::create_metadata_storage('allusers','allusers');
        $dbh->do($request);
        if ($dbh->err) {
             print(&mt('Failed to create [_1] table.','allusers')."\n");
             return;
        }
    }
    my %userdata =  (
                username => $username,
                domain   => $domain,
    );
    my %loghash =
        &LONCAPA::lonmetadata::process_allusers_data($dbh,undef,
            \%tablenames,$username,$domain,\%userdata,'update');
    foreach my $key (keys(%loghash)) {
        print $loghash{$key}."\n";
    }
    return;
}

sub allusers_table_exists {
    my ($dbh) = @_;
    my $sth=$dbh->prepare('SHOW TABLES');
    $sth->execute();
    my $aref = $sth->fetchall_arrayref;
    $sth->finish();
    if ($sth->err()) {
        return undef;
    }
    my $result = 0;
    foreach my $table (@{$aref}) {
        if ($table->[0] eq 'allusers') {
            $result = 1;
            last;
        }
    }
    return $result;
}

sub get_password {
    my ($prompt) = @_;
    local $| = 1;
    print $prompt.': ';
    my $newpasswd = '';
    ReadMode 'raw';
    my $key;
    while(ord($key = ReadKey(0)) != 10) {
        if(ord($key) == 127 || ord($key) == 8) {
            chop($newpasswd);
            print "\b \b";
        } elsif(!ord($key) < 32) {
            $newpasswd .= $key;
            print '*';
        }
    }
    ReadMode 'normal';
    print "\n";
    return $newpasswd;
}

sub freeze_escape {
    my ($value)=@_;
    if (ref($value)) {
        $value=&nfreeze($value);
        return '__FROZEN__'.&LONCAPA::escape($value);
    }
    return &LONCAPA::escape($value);
}

=pod

=head1 AUTHOR

Written to help the LON-CAPA project.

=cut