--- loncom/build/make_domain_coordinator.pl 2002/06/10 01:50:16 1.4 +++ loncom/build/make_domain_coordinator.pl 2011/03/28 21:13:41 1.18 @@ -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.18 2011/03/28 21:13: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,21 @@ 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; =pod @@ -108,62 +112,135 @@ 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 ($username,$domain)=(@ARGV); +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); +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". +i &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". +i &mt('Please try again.')."\n"); + } else { + my $pbad=0; + foreach (split(//,$passwd)) {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 +264,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 +278,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 +350,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 +$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 +392,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 +418,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 +438,48 @@ 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"); + +#Update allusers MySQL table + +print(&mt('Adding new user to allusers table.')."\n"); +&allusers_update($username,$domain,\%perlvar); =pod @@ -305,26 +490,95 @@ 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; } =pod =head1 AUTHOR -Scott Harrison, harris41@msu.edu +Written to help the LON-CAPA project. =cut + 500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.