[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.11 and 1.27

version 1.11, 2006/10/08 23:05:18 version 1.27, 2015/01/03 02:45:22
Line 91  Set roles.hist and roles.db Line 91  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 Term::ReadKey;
   use Apache::lonnet;
   use Apache::lonlocal;
   use DBI;
   use Storable qw(nfreeze);
   use strict;
   
 =pod  =pod
   
Line 113  For example, "dcmsu" or "dcumich" would Line 120  For example, "dcmsu" or "dcumich" would
 USERNAMEs for places like Mich State Univ, etc.  USERNAMEs for places like Mich State Univ, etc.
   
 The second argument specifies the domain of the computer  The second argument specifies the domain of the computer
 coordinator and should consist of only alphanumeric characters.  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);
 my ($username,$domain)=(@ARGV); shift @ARGV; shift @ARGV;  if ($username=~/$LONCAPA::not_username_re/) {
 unless ($username=~/^\w+$/ and $username!~/\_/) {      print(&mt('**** ERROR **** Username [_1] must consist only of - . and alphanumeric characters.',$username)."\n");
     die('**** ERROR **** '.      exit;
  'Username '.$username.' 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");
 unless ($domain=~/^\w+$/ and $domain!~/\_/) {      exit;
     die('**** ERROR **** '.  
  'Domain '.$domain.' must consist only of alphanumeric characters'.  
  "\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;
   }
   
   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 =  # Output a warning message.
     'For security reasons, this script will only automatically generate '."\n".  print(&mt('**** NOTE **** Generating a domain coordinator is "serious business".')."\n".
     'new users, not pre-existing users.'."\n".       &mt('You must choose a password that is difficult to guess.')."\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 (-d "/home/$username") {  print(&mt('Continue? ~[Y/n~] '));
     die ('**** ERROR **** '.$username.' is already a linux operating system '.  my $go_on = <STDIN>;
  'user.'."\n".$caveat);  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 217  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 233  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 262  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 297  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 355  close(OUT); Line 434  close(OUT);
 open(OUT, ">$udpath/passwd");  open(OUT, ">$udpath/passwd");
 print(OUT 'unix:'."\n");  print(OUT 'unix:'."\n");
 close(OUT);  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  =pod
   
Line 370  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;
 }  }
 $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.  open(OUT, ">$udpath/roles.hist"); # roles.hist is the synchronous plain text.
 foreach my $key (keys(%{$rolesref})) {  foreach my $key (keys(%{$rolesref})) {
     print(OUT $key.' : '.$rolesref->{$key}."\n");      print(OUT $key.' : '.$rolesref->{$key}."\n");
Line 384  close(OUT); Line 471  close(OUT);
 `chown www:www $udpath/roles.hist`; # Must be writeable by httpd process.  `chown www:www $udpath/roles.hist`; # Must be writeable by httpd process.
 `chown www:www $udpath/roles.db`; # 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");
   
   # 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
   
   print(&mt('Adding new user to allusers table.')."\n");
   &allusers_update($username,$domain,\%perlvar);
   
 =pod  =pod
   
 =item 10.  =item 10.
Line 394  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("$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("http://$hostname/adm/createuser will allow you to further define".  print("\n".
       " this user.\n"); # Output a suggested URL.        &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;
   }
   
   sub freeze_escape {
       my ($value)=@_;
       if (ref($value)) {
           $value=&nfreeze($value);
           return '__FROZEN__'.&LONCAPA::escape($value);
       }
       return &LONCAPA::escape($value);
   }
   
 =pod  =pod
   
Line 406  print("http://$hostname/adm/createuser w Line 637  print("http://$hostname/adm/createuser w
 Written to help the LON-CAPA project.  Written to help the LON-CAPA project.
   
 =cut  =cut
   
Removed from v.1.11  
changed lines
  Added in v.1.27

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