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

version 1.2, 2002/03/04 05:06:00 version 1.27, 2015/01/03 02:45:22
Line 33  make_domain_coordinator.pl - Make a doma Line 33  make_domain_coordinator.pl - Make a doma
 #  #
 # http://www.lon-capa.org/  # http://www.lon-capa.org/
 #  #
 # YEAR=2002  
 # 3/1,3/3,3/4 Scott Harrison  
 #  
 ###  ###
   
 =pod  =pod
Line 52  These are the steps that are executed on Line 49  These are the steps that are executed on
 =item *   =item * 
   
 Tests to see if user already exists for linux system or for  Tests to see if user already exists for linux system or for
 LON-CAPA, if so aborts  LON-CAPA, if so aborts.  A message is output that recommends following
   a manual procedure enabling this user if so desired.
   
 =item *  =item *
   
Line 83  Set roles.hist and roles.db Line 81  Set roles.hist and roles.db
   
 # This is a standalone script.  It *could* alternatively use the  # This is a standalone script.  It *could* alternatively use the
 # lcuseradd script, however lcuseradd relies on certain system  # lcuseradd script, however lcuseradd relies on certain system
 # dependencies.  make_domain_coordinator.pl should be able  # dependencies.  In order to have a focused performance, I am trying
 # to run freely as possible irrespective of the status of a LON-CAPA  # to avoid system dependencies until the LON-CAPA code base becomes
   # more robust and well-boundaried.  make_domain_coordinator.pl should be able
   # to run freely as possible, irrespective of the status of a LON-CAPA
 # installation.  # installation.
   
 # ---------------------------------------------------- Configure general values  # ---------------------------------------------------- Configure general values
   
 my %perlvar;  use lib '/home/httpd/lib/perl/';
 $perlvar{'lonUsersDir'}='/home/httpd/lonUsers';  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 101  There are no flags to this script. Line 107  There are no flags to this script.
   
 usage: make_domain_coordinator.pl [USERNAME] [DOMAIN]   usage: make_domain_coordinator.pl [USERNAME] [DOMAIN] 
   
 The password is accepted through standard input.  The password is accepted through standard input
   and should only consist of printable ASCII
   characters and be a string of length greater than 5 characters.
   
 The first argument  The first argument
 specifies the user name of the domain coordinator and  specifies the user name of the domain coordinator and
 should consist of only alphanumeric characters.  should consist of only alphanumeric characters.
   It is recommended that the USERNAME should be institution-specific
   as opposed to something like "Sammy" or "Jo".
   For example, "dcmsu" or "dcumich" would be good domain coordinator
   USERNAMEs for places like Mich State Univ, etc.
   
 The second argument specifies the password for the domain  The second argument specifies the domain of the computer
 coordinator and should only consist of printable ASCII  coordinator.
 characters and be a string of length greater than 5 characters.  
   
 =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.').
    "\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);
 unless ($username=~/^\w+$/ and $username!~/\_/) {  if ($username=~/$LONCAPA::not_username_re/) {
     die 'Username '.$username.' must consist only of alphanumeric characters'.      print(&mt('**** ERROR **** Username [_1] must consist only of - . and alphanumeric characters.',$username)."\n");
  "\n";      exit;
 }  }
 unless ($domain=~/^\w+$/ and $domain!~/\_/) {  if ($domain=~/$LONCAPA::not_domain_re/) {
     die 'Domain '.$domain.' must consist only of alphanumeric characters'.      print(&mt('**** ERROR **** Domain [_1] must consist only of - . and alphanumeric characters.',$domain)."\n");
  "\n";      exit;
 }  }
   
 my $passwd=<>; # read in password from standard input  # Does user already exist
 chomp($passwd);  my ($is_user,$has_lc_account);
   
 if (length($passwd)<6 or length($passwd)>30) {  my $udpath=&propath($domain,$username);
     die 'Password is an unreasonable length.'."\n";  if (-d $udpath) {
 }      $has_lc_account = 1;
 my $pbad=0;  
 foreach (split(//,$passwd)) {if ((ord($_)<32)||(ord($_)>126)){$pbad=1;}}  
 if ($pbad) {  
     die 'Password must consist of standard ASCII characters'."\n";  
 }  }
   
 # And does user already exist  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") {  if (-d "/home/$username") {
     die ($username.' is already a linux operating system user.'."\n");      $is_user = 1;
 }  }
 my $udpath=propath($domain,$username);  
 if (-d $udpath) {  if ($is_user) {
     die ($username.' is already defined as a LON-CAPA user.'."\n");      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;
   }
   
   # 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 = <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 ++;
       }
   }
   if (!$got_passwd) {
       exit;
   }
   print "\n";
   
 =pod  =pod
   
 =head1 MANUAL PROCEDURE  =head1 MANUAL PROCEDURE
   
 There are 10 steps to a manual procedure.  There are 10 steps to manually recreating what this script performs
   automatically.
   
 You need to decide on three pieces of information  You need to decide on three pieces of information
 to create a domain coordinator.  to create a domain coordinator.
   
  * USERNAME (kermit, albert, joe, etc)   * USERNAME (kermit, albert, joe, etc)
  * DOMAIN (should be the same as lonDefDomain in /etc/httpd/conf/access.conf)   * DOMAIN (should be the same as lonDefDomain in /etc/httpd/conf/loncapa.conf)
  * PASSWORD (don't tell me)   * PASSWORD (don't tell me)
   
 The examples in these instructions will be based  The examples in these instructions will be based
Line 185  login as root on your Linux system Line 265  login as root on your Linux system
   
 # ------------------------------------------------------------ So, are we root?  # ------------------------------------------------------------ So, are we root?
   
 if ($< != 0) {  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 198  if ($< != 0) { Line 279  if ($< != 0) {
   
 =cut  =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  # ----------------------------------------------------------- /usr/sbin/useradd
   # -- Add user
   
 $username=~s/\W//g; # an extra filter, just to be sure  print(&mt('adding user: [_1]',$username)."\n");
 `/usr/sbin/useradd $username`;  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  =pod
   
 =item 3 (as root). enter in a password  =item 3 (as root). enter in a password
Line 216  $username=~s/\W//g; # an extra filter, j Line 351  $username=~s/\W//g; # an extra filter, j
   
 =cut  =cut
   
 $username=~s/\W//g; # an extra filter, just to be sure  # Process password (taint-check, then pass to the UNIX passwd command).
 $pbad=0;  $username =~ s/\W//g; # an extra filter, just to be sure
   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 245  close OUT; Line 404  close OUT;
  Let S equal second letter of USERNAME   Let S equal second letter of USERNAME
  Let E equal third letter of USERNAME   Let E equal third letter of USERNAME
  Command: [prompt %] install -d DOMAIN/U/S/E/USERNAME   Command: [prompt %] install -d DOMAIN/U/S/E/USERNAME
  Example: [prompt %] install -d 103/d/c/1/dc103  
    Here are three examples of the commands that would be needed
    for different domain coordinator names (dc103, morphy, or ng):
   
    Example #1 (dc103):  [prompt %] install -d 103/d/c/1/dc103
    Example #2 (morphy): [prompt %] install -d 103/m/o/r/morphy
    Example #3 (ng):     [prompt %] install -d 103/n/g/_/ng
   
 =cut  =cut
   
 `install -o www -g www -d $udpath`;  # Generate the user directory.
   `install -o www -g www -d $udpath`; # Must be writeable by httpd process.
   
 =pod  =pod
   
Line 264  close OUT; Line 430  close OUT;
   
 =cut  =cut
   
 open OUT, ">$udpath/passwd";  # UNIX (/etc/passwd) style authentication is asserted for domain coordinators.
 print OUT 'unix:'."\n";  open(OUT, ">$udpath/passwd");
 close OUT;  print(OUT 'unix:'."\n");
 `chown www:www $udpath/passwd`;  close(OUT);
   
   # 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 278  close OUT; Line 450  close OUT;
   
 =cut  =cut
   
 use GDBM_File;  use GDBM_File; # A simplistic key-value pairing database.
 my %hash;  
         tie(%hash,'GDBM_File',"$udpath/roles.db",  my $rolesref=&LONCAPA::locking_hash_tie("$udpath/roles.db",&GDBM_WRCREAT());
     &GDBM_WRCREAT,0640);  if (!$rolesref) {
       print(&mt('Error').' '.
 $hash{'/'.$domain.'/_dc'}='dc';            &mt('unable to tie roles db: [_1].',"$udpath/roles.db")."\n");
 open OUT, ">$udpath/roles.hist";      exit;
 map {  }
     print OUT $_.' : '.$hash{$_}."\n";  my $now = time;
 } keys %hash;  $rolesref->{'/'.$domain.'/_dc'}='dc_0_'.$now; # Set the domain coordinator role.
 close OUT;  open(OUT, ">$udpath/roles.hist"); # roles.hist is the synchronous plain text.
   foreach my $key (keys(%{$rolesref})) {
 untie %hash;      print(OUT $key.' : '.$rolesref->{$key}."\n");
 `chown www:www $udpath/roles.hist`;  }
 `chown www:www $udpath/roles.db`;  close(OUT);
   &LONCAPA::locking_hash_untie($rolesref);
   
   
   `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");
   
   # 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
   
Line 303  by going to http://MACHINENAME/adm/creat Line 537  by going to http://MACHINENAME/adm/creat
   
 =cut  =cut
   
 print "$username is now a domain coordinator\n";  # Output success message, and inform sysadmin about how to further proceed.
 my $hostname=`hostname`; chomp $hostname;  print("\n".&mt('[_1] is now a domain coordinator',$username)."\n"); # Output success message.
 print "http://$hostname/adm/createuser will allow you to further define".  my $hostname=`hostname`; chomp($hostname); # Read in hostname.
       " this user.\n";  print("\n".
         &mt('Once LON-CAPA is running, you should log-in and use: [_1] to further define this user.',
 # ----------------------------------------------------------------- SUBROUTINES            "\nhttp://$hostname/adm/createuser\n")."\n\n".
 sub propath {        &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"); 
     my ($udom,$uname)=@_;  # Output a suggested URL.
     $udom=~s/\W//g;  
     $uname=~s/\W//g;  sub allusers_update {
     my $subdir=$uname.'__';      my ($username,$domain,$perlvar) = @_;
     $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;      my %tablenames = (
     my $proname="$perlvar{'lonUsersDir'}/$udom/$subdir/$uname";                         'allusers'   => 'allusers',
     return $proname;                       );
       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
   
 =head1 AUTHOR  =head1 AUTHOR
   
 Scott Harrison, harris41@msu.edu  Written to help the LON-CAPA project.
   
 =cut  =cut
   
Removed from v.1.2  
changed lines
  Added in v.1.27

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