--- loncom/build/make_domain_coordinator.pl 2009/07/17 22:23:59 1.17 +++ 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.17 2009/07/17 22:23:59 droeschl 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). # @@ -92,6 +92,9 @@ 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; =pod @@ -119,69 +122,112 @@ 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". - '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"); + 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; +my ($username,$domain)=(@ARGV); if ($username=~/$LONCAPA::not_username_re/) { - die('**** ERROR **** '. - 'Username '.$username.' must consist only of - . and alphanumeric characters'. - "\n"); + print(&mt('**** ERROR **** Username [_1] must consist only of - . and alphanumeric characters.',$username)."\n"); + exit; } if ($domain=~/$LONCAPA::not_domain_re/) { - die('**** ERROR **** '. - 'Domain '.$domain.' must consist only of - . and alphanumeric charaters and '. - "\n"); + 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; +} + +if (-d "/home/$username") { + $is_user = 1; } -# And does user already exist +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; +} -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"; +# 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"); -if (-d "/home/$username") { - die ('**** ERROR **** '.$username.' is already a linux operating system '. - 'user.'."\n".$caveat); +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 ++; + } } -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 @@ -219,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 @@ -235,26 +282,30 @@ if ($< != 0) { # Am I root? # -- Add group $username=~s/\W//g; # an extra filter, just to be sure -print "adding group: $username \n"; +print(&mt('adding group: [_1]',$username)."\n"); my $status = system('/usr/sbin/groupadd', $username); if ($status) { - die "Error. Something went wrong with the addition of group ". - "\"$username\".\n"; + 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 "adding user: $username \n"; +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"); - die "Error. Something went wrong with the addition of user ". - "\"$username\".\n"; + print(&mt('Error.').' '. + &mt('Something went wrong with the addition of user "[_1]".', + $username)."\n"); + exit; } -print "Done adding user\n"; +print(&mt('Done adding user.')."\n"); # Make www a member of that user group. my $groups=`/usr/bin/groups www`; # untaint @@ -264,18 +315,20 @@ chomp $groups; $groups=~s/^\S+\s+\:\s+// my @grouplist=split(/\s+/,$groups); my @ugrouplist=grep {!/www|$username/} @grouplist; my $gl=join(',',(@ugrouplist,$username)); -print "Putting www in user's group\n"; +print(&mt("Putting www in user's group.")."\n"); if (system('/usr/sbin/usermod','-G',$gl,'www')) { - die "Error. Could not make www a member of the group ". - "\"$username\".\n"; + 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 "Error. Could not add home directory for ". - "\"$username\".\n"; + print(&mt('Error.').' '.&mt('Could not add home directory for "[_1]".', + $username)."\n"); + exit; } } @@ -302,7 +355,8 @@ $username =~ s/\W//g; # an extra filter, $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; @@ -371,7 +425,8 @@ close(OUT); # Get permissions correct on udpath - print "Setting permissions on user data directories. This may take a moment, please be patient ...\n"; + 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 @@ -387,7 +442,9 @@ 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; } my $now = time; $rolesref->{'/'.$domain.'/_dc'}='dc_0_'.$now; # Set the domain coordinator role. @@ -407,7 +464,8 @@ my $dompath = $perlvar{'lonUsersDir'}.'/ my $domrolesref = &LONCAPA::locking_hash_tie("$dompath/nohist_domainroles.db",&GDBM_WRCREAT()); if (!$domrolesref) { - die('unable to tie nohist_domainroles db: '."$dompath/nohist_domainroles.db"); + print(&mt('Error').' '.&mt('unable to tie nohist_domainroles db: [_1].', + "$dompath/nohist_domainroles.db")."\n"); } # Store in nohist_domainroles.db @@ -420,7 +478,7 @@ $domrolesref->{$domkey}= &LONCAPA::escap #Update allusers MySQL table -print "Adding new user to allusers table\n"; +print(&mt('Adding new user to allusers table.')."\n"); &allusers_update($username,$domain,\%perlvar); =pod @@ -433,12 +491,12 @@ by going to http://MACHINENAME/adm/creat =cut # Output success message, and inform sysadmin about how to further proceed. -print("\n$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("\n".'Once LON-CAPA is running, you should log-in and use: '."\n". - 'http://'.$hostname.'/adm/createuser to further define this user.'."\n\n". - 'From the user management menu, click the link: "Add/Modify a User" '."\n". - 'to search for the user and to provide additional information (last name, first name etc.).'."\n"); +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 { @@ -450,7 +508,7 @@ sub allusers_update { unless ($dbh = DBI->connect("DBI:mysql:loncapa","www", $perlvar->{'lonSqlAccess'}, { RaiseError =>0,PrintError=>0})) { - print "Cannot connect to database!\n"; + print(&mt('Cannot connect to database!')."\n"); return; } my $tablechk = &allusers_table_exists($dbh); @@ -459,7 +517,7 @@ sub allusers_update { &LONCAPA::lonmetadata::create_metadata_storage('allusers','allusers'); $dbh->do($request); if ($dbh->err) { - print "Failed to crate allusers table\n"; + print(&mt('Failed to create [_1] table.','allusers')."\n"); return; } } @@ -495,6 +553,27 @@ sub allusers_table_exists { 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