[BACK]Return to make_domain_coordinator.pl CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / build

Diff for /loncom/build/make_domain_coordinator.pl between versions 1.15 and 1.27

version 1.15, 2008/03/03 15:25:02 version 1.27, 2015/01/03 02:45:22
Line 92  Set roles.hist and roles.db Line 92  Set roles.hist and roles.db
 use lib '/home/httpd/lib/perl/';  use lib '/home/httpd/lib/perl/';
 use LONCAPA;  use LONCAPA;
 use LONCAPA::lonmetadata;  use LONCAPA::lonmetadata;
   use Term::ReadKey;
   use Apache::lonnet;
   use Apache::lonlocal;
 use DBI;  use DBI;
   use Storable qw(nfreeze);
   use strict;
   
 =pod  =pod
   
Line 119  coordinator. Line 124  coordinator.
   
 =cut  =cut
   
   my $lang = &Apache::lonlocal::choose_language();
   &Apache::lonlocal::get_language_handle(undef,$lang);
   print"\n";
   
 # ----------------------------------------------- So, are we invoked correctly?  # ----------------------------------------------- So, are we invoked correctly?
 # Two arguments or abort  # Two arguments or abort
 if (@ARGV!=2) {  if (@ARGV!=2) {
     die('usage: make_domain_coordinator.pl [USERNAME] [DOMAIN] '."\n".      print(&mt('usage: [_1]','make_domain_coordinator.pl [USERNAME] [DOMAIN]')."\n\n".
  '(and password through standard input)'."\n".          &mt('It is recommended that the USERNAME should be institution-specific.').
  'It is recommended that the USERNAME should be institution-specific '.   "\n".&mt('It should not be something like "Sammy" or "Jo".')."\n".
  "\n".'as opposed to 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");
  'For example, "dcmsu" or "dcumich" would be good domain coordinator'.      exit;
  "\n".'USERNAMEs for places like Mich State Univ, etc.'."\n");  
 }  }
 my ($username,$domain)=(@ARGV); shift @ARGV; shift @ARGV;  my ($username,$domain)=(@ARGV);
 if ($username=~/$LONCAPA::not_username_re/) {  if ($username=~/$LONCAPA::not_username_re/) {
     die('**** ERROR **** '.      print(&mt('**** ERROR **** Username [_1] must consist only of - . and alphanumeric characters.',$username)."\n");
  'Username '.$username.' must consist only of - . and alphanumeric characters'.      exit;
  "\n");  
 }  }
 if ($domain=~/$LONCAPA::not_domain_re/) {  if ($domain=~/$LONCAPA::not_domain_re/) {
     die('**** ERROR **** '.      print(&mt('**** ERROR **** Domain [_1] must consist only of - . and alphanumeric characters.',$domain)."\n");
  'Domain '.$domain.' must consist only of - . and alphanumeric charaters and '.      exit;
  "\n");  
 }  }
   
 # Output a warning message.  # Does user already exist
 print('**** NOTE **** '.  my ($is_user,$has_lc_account);
       'Generating a domain coordinator is "serious business".'."\n".  
       'Choosing a difficult-to-guess (and keeping it a secret) password '."\n".  my $udpath=&propath($domain,$username);
       'is highly recommended.'."\n");  if (-d $udpath) {
       $has_lc_account = 1;
 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");  
 }  }
 my $pbad=0;  
 foreach (split(//,$passwd)) {if ((ord($_)<32)||(ord($_)>126)){$pbad=1;}}  if ($has_lc_account) {
 if ($pbad) {      print(&mt('**** ERROR **** [_1] is already defined as a LON-CAPA user.',
     die('**** ERROR **** '.                $username)."\n\n".
  'Password must consist of standard ASCII characters'."\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 =  if ($is_user) {
     'For security reasons, this script will only automatically generate '."\n".      print(&mt('**** ERROR **** [_1] is already a linux operating system user.',
     'new users, not pre-existing users.'."\n".                $username)."\n\n".
     "If you want to make '$username' a domain coordinator, you "."\n".            &mt('This script will only automatically generate new users.')."\n".
     'should do so manually by customizing the MANUAL PROCEDURE'."\n".            &mt('To assign a domain coordinator role to an existing user:')."\n\n".
     'described in the documentation.  To view the documentation '."\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".
     'for this script, type '.            &mt('To view the documentation for this script, type: [_1].',
     "'perldoc ./make_domain_coordinator.pl'."."\n";                "\n".'perldoc ./make_domain_coordinator.pl')."\n\n");
       exit;
   }
   
 if (-d "/home/$username") {  # Output a warning message.
     die ('**** ERROR **** '.$username.' is already a linux operating system '.  print(&mt('**** NOTE **** Generating a domain coordinator is "serious business".')."\n".
  'user.'."\n".$caveat);       &mt('You must choose a password that is difficult to guess.')."\n");
   
   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,$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 ++;
       }
 }  }
 my $udpath=&propath($domain,$username);  if (!$got_passwd) {
 if (-d $udpath) {      exit;
     die ('**** ERROR **** '.$username.' is already defined as a LON-CAPA '.  
  'user.'."\n".$caveat);  
 }  }
   print "\n";
   
 =pod  =pod
   
Line 219  login as root on your Linux system Line 266  login as root on your Linux system
 # ------------------------------------------------------------ So, are we root?  # ------------------------------------------------------------ So, are we root?
   
 if ($< != 0) { # Am I 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  =pod
Line 235  if ($< != 0) { # Am I root? Line 283  if ($< != 0) { # Am I root?
 # -- Add group  # -- Add group
 $username=~s/\W//g; # an extra filter, just to be sure  $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);  my $status = system('/usr/sbin/groupadd', $username);
 if ($status) {  if ($status) {
     die "Error.  Something went wrong with the addition of group ".      print(&mt('Error.').' '.
           "\"$username\".\n";            &mt('Something went wrong with the addition of group "[_1]".',
                 $username)."\n");
       exit;
 }  }
 my $gid = getgrnam($username);  my $gid = getgrnam($username);
   
 # ----------------------------------------------------------- /usr/sbin/useradd  # ----------------------------------------------------------- /usr/sbin/useradd
 # -- Add user  # -- 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);  my $status = system('/usr/sbin/useradd','-c','LON-CAPA user','-g',$gid,$username);
 if ($status) {  if ($status) {
     system("/usr/sbin/groupdel $username");      system("/usr/sbin/groupdel $username");
     die "Error.  Something went wrong with the addition of user ".      print(&mt('Error.').' '.
           "\"$username\".\n";            &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.  # Make www a member of that user group.
 my $groups=`/usr/bin/groups www`;  my $groups=`/usr/bin/groups www`;
 # untaint  # untaint
Line 264  chomp $groups; $groups=~s/^\S+\s+\:\s+// Line 316  chomp $groups; $groups=~s/^\S+\s+\:\s+//
 my @grouplist=split(/\s+/,$groups);  my @grouplist=split(/\s+/,$groups);
 my @ugrouplist=grep {!/www|$username/} @grouplist;  my @ugrouplist=grep {!/www|$username/} @grouplist;
 my $gl=join(',',(@ugrouplist,$username));  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')) {  if (system('/usr/sbin/usermod','-G',$gl,'www')) {
     die "Error. Could not make www a member of the group ".      print(&mt('Error.').' '.&mt('Could not make www a member of the group "[_1]".',
           "\"$username\".\n";                $username)."\n");
       exit;
 }  }
   
 # Check if home directory exists for user  # Check if home directory exists for user
 # If not, create one.  # If not, create one.
 if (!-e "/home/$username") {  if (!-e "/home/$username") {
     if (!mkdir("/home/$username",0710)) {      if (!mkdir("/home/$username",0710)) {
         print "Error. Could not add home directory for ".          print(&mt('Error.').' '.&mt('Could not add home directory for "[_1]".',
           "\"$username\".\n";                    $username)."\n");
           exit;
     }      }
 }  }
   
Line 299  if (-d "/home/$username") { Line 353  if (-d "/home/$username") {
   
 # Process password (taint-check, then pass to the UNIX passwd command).  # Process password (taint-check, then pass to the UNIX passwd command).
 $username =~ s/\W//g; # an extra filter, just to be sure  $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;}}  foreach (split(//,$passwd)) {if ((ord($_)<32)||(ord($_)>126)){$pbad=1;}}
 if ($pbad) {  if ($pbad) {
     die('Password must consist of standard ASCII characters'."\n");      print(&mt('Password must consist of standard ASCII characters.').
             "\n");
   }
    
   my ($distro,$nostdin);
   if (open(PIPE,"perl distprobe|")) {
       $distro = <PIPE>;
       close(PIPE);
   }
   if ($distro =~ /^ubuntu|debian/) {
       $nostdin = 1;
   } elsif ($distro =~ /^suse([\d.]+)$/) {
       if ($1 > 12.2) {
           $nostdin = 1;
       }
   } elsif ($distro =~ /^sles(\d+)$/) {
       if ($1 > 11) {
           $nostdin = 1;
       }
   }
   if ($nostdin) {
       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  =pod
   
Line 360  close(OUT); Line 437  close(OUT);
   
 # Get permissions correct on udpath  # 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.  `chown -R www:www /home/httpd/lonUsers/$domain` ; # Must be writeable by httpd process.
   
 =pod  =pod
Line 376  use GDBM_File; # A simplistic key-value Line 454  use GDBM_File; # A simplistic key-value
   
 my $rolesref=&LONCAPA::locking_hash_tie("$udpath/roles.db",&GDBM_WRCREAT());  my $rolesref=&LONCAPA::locking_hash_tie("$udpath/roles.db",&GDBM_WRCREAT());
 if (!$rolesref) {  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;  my $now = time;
 $rolesref->{'/'.$domain.'/_dc'}='dc_0_'.$now; # Set the domain coordinator role.  $rolesref->{'/'.$domain.'/_dc'}='dc_0_'.$now; # Set the domain coordinator role.
Line 396  my $dompath = $perlvar{'lonUsersDir'}.'/ Line 476  my $dompath = $perlvar{'lonUsersDir'}.'/
 my $domrolesref = &LONCAPA::locking_hash_tie("$dompath/nohist_domainroles.db",&GDBM_WRCREAT());  my $domrolesref = &LONCAPA::locking_hash_tie("$dompath/nohist_domainroles.db",&GDBM_WRCREAT());
   
 if (!$domrolesref) {  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  # Store in nohist_domainroles.db
Line 407  $domrolesref->{$domkey}= &LONCAPA::escap Line 488  $domrolesref->{$domkey}= &LONCAPA::escap
  system('/bin/chown',"www:www","$dompath/nohist_domainroles.db"); # Must be writeable by httpd process.   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");   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  #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);  &allusers_update($username,$domain,\%perlvar);
   
 =pod  =pod
Line 422  by going to http://MACHINENAME/adm/creat Line 538  by going to http://MACHINENAME/adm/creat
 =cut  =cut
   
 # Output success message, and inform sysadmin about how to further proceed.  # 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.  my $hostname=`hostname`; chomp($hostname); # Read in hostname.
 print("\n".'Once LON-CAPA is running, you should log-in and use: '."\n".  print("\n".
       'http://'.$hostname.'/adm/createuser to further define this user.'."\n\n".        &mt('Once LON-CAPA is running, you should log-in and use: [_1] to further define this user.',
       'From the user management menu, click the link: "Add/Modify a Single User" '."\n".            "\nhttp://$hostname/adm/createuser\n")."\n\n".
       'to search for the user and to provide additional information (last name, first name etc.).'."\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.  # Output a suggested URL.
   
 sub allusers_update {  sub allusers_update {
Line 439  sub allusers_update { Line 555  sub allusers_update {
     unless ($dbh = DBI->connect("DBI:mysql:loncapa","www",      unless ($dbh = DBI->connect("DBI:mysql:loncapa","www",
                             $perlvar->{'lonSqlAccess'},                              $perlvar->{'lonSqlAccess'},
                             { RaiseError =>0,PrintError=>0})) {                              { RaiseError =>0,PrintError=>0})) {
         print "Cannot connect to database!\n";          print(&mt('Cannot connect to database!')."\n");
         return;          return;
     }      }
     my $tablechk = &allusers_table_exists($dbh);      my $tablechk = &allusers_table_exists($dbh);
Line 448  sub allusers_update { Line 564  sub allusers_update {
    &LONCAPA::lonmetadata::create_metadata_storage('allusers','allusers');     &LONCAPA::lonmetadata::create_metadata_storage('allusers','allusers');
         $dbh->do($request);          $dbh->do($request);
         if ($dbh->err) {          if ($dbh->err) {
              print "Failed to crate allusers table\n";               print(&mt('Failed to create [_1] table.','allusers')."\n");
              return;               return;
         }          }
     }      }
Line 484  sub allusers_table_exists { Line 600  sub allusers_table_exists {
     return $result;      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  =pod
   
 =head1 AUTHOR  =head1 AUTHOR
Removed from v.1.15  
changed lines
  Added in v.1.27

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>