--- loncom/build/make_domain_coordinator.pl 2006/08/11 20:09:02 1.10 +++ loncom/build/make_domain_coordinator.pl 2011/11/17 14:29:51 1.20 @@ -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.10 2006/08/11 20:09:02 albertel Exp $ +# $Id: make_domain_coordinator.pl,v 1.20 2011/11/17 14:29:51 raeburn Exp $ # # This file is part of the LearningOnline Network with CAPA (LON-CAPA). # @@ -91,6 +91,12 @@ Set roles.hist and roles.db use lib '/home/httpd/lib/perl/'; use LONCAPA; +use LONCAPA::lonmetadata; +use Term::ReadKey; +use Apache::lonnet; +use Apache::lonlocal; +use DBI; +use strict; =pod @@ -113,73 +119,115 @@ For example, "dcmsu" or "dcumich" would 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". - 'It is recommended that the USERNAME should be institution-specific '. - "\n".'as opposed to something like "Sammy" or "Jo".'."\n". - 'For example, "dcmsu" or "dcumich" would be good domain coordinator'. - "\n".'USERNAMEs for places like Mich State Univ, etc.'."\n"); -} -my ($username,$domain)=(@ARGV); shift @ARGV; shift @ARGV; -unless ($username=~/^\w+$/ and $username!~/\_/) { - die('**** ERROR **** '. - 'Username '.$username.' must consist only of alphanumeric characters'. - "\n"); -} -unless ($domain=~/^\w+$/ and $domain!~/\_/) { - die('**** ERROR **** '. - 'Domain '.$domain.' must consist only of alphanumeric characters'. - "\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); +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; } -# Output a warning message. -print('**** NOTE **** '. - 'Generating a domain coordinator is "serious business".'."\n". - 'Choosing a difficult-to-guess (and keeping it a secret) password '."\n". - 'is highly recommended.'."\n"); - -print("Password: "); $|=1; -my $passwd=<>; # read in password from standard input -chomp($passwd); - -if (length($passwd)<6 or length($passwd)>30) { - die('**** ERROR **** '.'Password is an unreasonable length.'."\n". - 'It should be at least 6 characters in length.'."\n"); +# Does user already exist +my ($is_user,$has_lc_account); + +my $udpath=&propath($domain,$username); +if (-d $udpath) { + $has_lc_account = 1; } -my $pbad=0; -foreach (split(//,$passwd)) {if ((ord($_)<32)||(ord($_)>126)){$pbad=1;}} -if ($pbad) { - die('**** ERROR **** '. - 'Password must consist of standard ASCII characters'."\n"); + +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; } -# And does user already exist +if (-d "/home/$username") { + $is_user = 1; +} -my $caveat = - 'For security reasons, this script will only automatically generate '."\n". - 'new users, not pre-existing users.'."\n". - "If you want to make '$username' a domain coordinator, you "."\n". - 'should do so manually by customizing the MANUAL PROCEDURE'."\n". - 'described in the documentation. To view the documentation '."\n". - 'for this script, type '. - "'perldoc ./make_domain_coordinator.pl'."."\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; +} -if (-d "/home/$username") { - die ('**** ERROR **** '.$username.' is already a linux operating system '. - 'user.'."\n".$caveat); +# 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(//,$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 ++; + } } -my $udpath=&propath($domain,$username); -if (-d $udpath) { - die ('**** ERROR **** '.$username.' is already defined as a LON-CAPA '. - 'user.'."\n".$caveat); +if (!$got_passwd) { + exit; } +print "\n"; =pod @@ -217,7 +265,8 @@ login as root on your Linux system # ------------------------------------------------------------ So, are we root? if ($< != 0) { # Am I root? - die 'You must be root in order to generate a domain coordinator.'."\n"; + print(&mt('You must be root in order to generate a domain coordinator.'). + "\n"); } =pod @@ -229,11 +278,65 @@ if ($< != 0) { # Am I root? =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`; # Add the user with the 'useradd' command. +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 @@ -249,14 +352,26 @@ $username=~s/\W//g; # an extra filter, j # Process password (taint-check, then pass to the UNIX passwd command). $username =~ s/\W//g; # an extra filter, just to be sure -$pbad = 0; +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 @@ -307,7 +422,12 @@ close(OUT); open(OUT, ">$udpath/passwd"); print(OUT 'unix:'."\n"); close(OUT); -`chown www:www $udpath/passwd`; # Must be writeable by httpd process. + +# 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 @@ -322,9 +442,12 @@ use GDBM_File; # A simplistic key-value my $rolesref=&LONCAPA::locking_hash_tie("$udpath/roles.db",&GDBM_WRCREAT()); if (!$rolesref) { - die('unable to tie roles db: '."$udpath/roles.db"); + print(&mt('Error').' '. + &mt('unable to tie roles db: [_1]'."$udpath/roles.db")."\n"); + exit; } -$rolesref->{'/'.$domain.'/_dc'}='dc'; # Set the domain coordinator role. +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"); @@ -336,6 +459,28 @@ close(OUT); `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 =item 10. @@ -346,10 +491,88 @@ by going to http://MACHINENAME/adm/creat =cut # Output success message, and inform sysadmin about how to further proceed. -print("$username is now a domain coordinator\n"); # Output success message. +print("\n".&mt('[_1] is now a domain coordinator',$username)."\n"); # Output success message. my $hostname=`hostname`; chomp($hostname); # Read in hostname. -print("http://$hostname/adm/createuser will allow you to further define". - " this user.\n"); # Output a suggested URL. +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 @@ -358,3 +581,4 @@ print("http://$hostname/adm/createuser w 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.