[LON-CAPA-cvs] cvs: loncom /build make_domain_coordinator.pl

raeburn raeburn@source.lon-capa.org
Mon, 28 Mar 2011 21:13:41 -0000


This is a MIME encoded message

--raeburn1301346821
Content-Type: text/plain

raeburn		Mon Mar 28 21:13:41 2011 EDT

  Modified files:              
    /loncom/build	make_domain_coordinator.pl 
  Log:
  - Don't echo password to screen when creating new user from command line.
  - Localization
  - Advertise add_domain_coordinator_privilege.pl if user already has a
    LON-CAPA account.	
  
  
--raeburn1301346821
Content-Type: text/plain
Content-Disposition: attachment; filename="raeburn-20110328211341.txt"

Index: loncom/build/make_domain_coordinator.pl
diff -u loncom/build/make_domain_coordinator.pl:1.17 loncom/build/make_domain_coordinator.pl:1.18
--- loncom/build/make_domain_coordinator.pl:1.17	Fri Jul 17 22:23:59 2009
+++ loncom/build/make_domain_coordinator.pl	Mon Mar 28 21:13:41 2011
@@ -11,7 +11,7 @@
 # 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 @@
 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 @@
 
 =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 = <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);
+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 @@
 # ------------------------------------------------------------ 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 @@
 # -- 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 @@
 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 @@
 $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 @@
 
 # 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 @@
 
 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 $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 @@
 
 #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 @@
 =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 @@
     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 @@
    &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 @@
     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

--raeburn1301346821--