--- loncom/build/make_domain_coordinator.pl 2002/06/10 01:50:16 1.4 +++ loncom/build/make_domain_coordinator.pl 2012/12/18 13:05:41 1.24 @@ -11,7 +11,7 @@ make_domain_coordinator.pl - Make a doma # The LearningOnline Network # make_domain_coordinator.pl - Make a domain coordinator on a system # -# $Id: make_domain_coordinator.pl,v 1.4 2002/06/10 01:50:16 harris41 Exp $ +# $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). # @@ -33,9 +33,6 @@ make_domain_coordinator.pl - Make a doma # # http://www.lon-capa.org/ # -# YEAR=2002 -# 3/1,3/3,3/4 Scott Harrison -# ### =pod @@ -52,7 +49,8 @@ These are the steps that are executed on =item * Tests to see if user already exists for linux system or for -LON-CAPA, if so aborts +LON-CAPA, if so aborts. A message is output that recommends following +a manual procedure enabling this user if so desired. =item * @@ -83,15 +81,23 @@ Set roles.hist and roles.db # This is a standalone script. It *could* alternatively use the # lcuseradd script, however lcuseradd relies on certain system -# dependencies. make_domain_coordinator.pl should be able -# to run freely as possible irrespective of the status of a LON-CAPA +# 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 -my %perlvar; -$perlvar{'lonUsersDir'}='/home/httpd/lonUsers'; - +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 @@ -108,62 +114,134 @@ characters and be a string of length gre 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 and should consist of only alphanumeric characters. +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) { - die 'usage: make_domain_coordinator.pl [USERNAME] [DOMAIN] '."\n". - '(and password through standard input)'."\n"; + 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); shift @ARGV; shift @ARGV; -unless ($username=~/^\w+$/ and $username!~/\_/) { - die 'Username '.$username.' must consist only of alphanumeric characters'. - "\n"; +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; } -unless ($domain=~/^\w+$/ and $domain!~/\_/) { - die 'Domain '.$domain.' must consist only of alphanumeric characters'. - "\n"; +if ($domain=~/$LONCAPA::not_domain_re/) { + print(&mt('**** ERROR **** Domain [_1] must consist only of - . and alphanumeric characters.',$domain)."\n"); + exit; } -print "Password: "; $|=0; -my $passwd=<>; # read in password from standard input -chomp($passwd); +# Does user already exist +my ($is_user,$has_lc_account); -if (length($passwd)<6 or length($passwd)>30) { - die 'Password is an unreasonable length.'."\n"; -} -my $pbad=0; -foreach (split(//,$passwd)) {if ((ord($_)<32)||(ord($_)>126)){$pbad=1;}} -if ($pbad) { - die 'Password must consist of standard ASCII characters'."\n"; +my $udpath=&propath($domain,$username); +if (-d $udpath) { + $has_lc_account = 1; } -# And does user already exist +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") { - die ($username.' is already a linux operating system user.'."\n"); + $is_user = 1; } -my $udpath=propath($domain,$username); -if (-d $udpath) { - die ($username.' is already defined as a LON-CAPA user.'."\n"); + +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 = ; +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 a 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/access.conf) + * 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 @@ -187,8 +265,9 @@ login as root on your Linux system # ------------------------------------------------------------ So, are we root? -if ($< != 0) { - die 'You must be root in order to generate a domain coordinator.'."\n"; +if ($< != 0) { # Am I root? + print(&mt('You must be root in order to generate a domain coordinator.'). + "\n"); } =pod @@ -200,11 +279,65 @@ if ($< != 0) { =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 -$username=~s/\W//g; # an extra filter, just to be sure -`/usr/sbin/useradd $username`; +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 @@ -218,15 +351,28 @@ $username=~s/\W//g; # an extra filter, j =cut -$username=~s/\W//g; # an extra filter, just to be sure -$pbad=0; +# 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) { - die 'Password must consist of standard ASCII characters'."\n"; + print(&mt('Password must consist of standard ASCII characters.'). + "\n"); +} + +my $distro; +if (open(PIPE,"perl distprobe|")) { + $distro = ; + 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); } -open OUT,"|passwd --stdin $username"; -print OUT $passwd."\n"; -close OUT; =pod @@ -247,11 +393,18 @@ close OUT; Let S equal second letter of USERNAME Let E equal third letter of USERNAME Command: [prompt %] install -d DOMAIN/U/S/E/USERNAME - Example: [prompt %] install -d 103/d/c/1/dc103 + + 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 -`install -o www -g www -d $udpath`; +# Generate the user directory. +`install -o www -g www -d $udpath`; # Must be writeable by httpd process. =pod @@ -266,10 +419,16 @@ close OUT; =cut -open OUT, ">$udpath/passwd"; -print OUT 'unix:'."\n"; -close OUT; -`chown www:www $udpath/passwd`; +# 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 @@ -280,21 +439,83 @@ close OUT; =cut -use GDBM_File; -my %hash; - tie(%hash,'GDBM_File',"$udpath/roles.db", - &GDBM_WRCREAT,0640); - -$hash{'/'.$domain.'/_dc'}='dc'; -open OUT, ">$udpath/roles.hist"; -map { - print OUT $_.' : '.$hash{$_}."\n"; -} keys %hash; -close OUT; - -untie %hash; -`chown www:www $udpath/roles.hist`; -`chown www:www $udpath/roles.db`; +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 @@ -305,26 +526,104 @@ by going to http://MACHINENAME/adm/creat =cut -print "$username is now a domain coordinator\n"; -my $hostname=`hostname`; chomp $hostname; -print "http://$hostname/adm/createuser will allow you to further define". - " this user.\n"; - -# ----------------------------------------------------------------- SUBROUTINES -sub propath { - my ($udom,$uname)=@_; - $udom=~s/\W//g; - $uname=~s/\W//g; - my $subdir=$uname.'__'; - $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/; - my $proname="$perlvar{'lonUsersDir'}/$udom/$subdir/$uname"; - return $proname; +# 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 -Scott Harrison, harris41@msu.edu +Written to help the LON-CAPA project. =cut +