Return to make_domain_coordinator.pl CVS log

Up to [LON-CAPA] / loncom / build

- Perform ASCII character check on correct scalar.

    1: #!/usr/bin/perl
    2: 
    3: =pod
    4: 
    5: =head1 NAME
    6: 
    7: make_domain_coordinator.pl - Make a domain coordinator on a LON-CAPA system
    8: 
    9: =cut
   10: 
   11: # The LearningOnline Network
   12: # make_domain_coordinator.pl - Make a domain coordinator on a system
   13: #
   14: # $Id: make_domain_coordinator.pl,v 1.21 2011/11/17 14:35:22 raeburn Exp $
   15: #
   16: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
   17: #
   18: # LON-CAPA is free software; you can redistribute it and/or modify
   19: # it under the terms of the GNU General Public License as published by
   20: # the Free Software Foundation; either version 2 of the License, or
   21: # (at your option) any later version.
   22: #
   23: # LON-CAPA is distributed in the hope that it will be useful,
   24: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   25: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   26: # GNU General Public License for more details.
   27: #
   28: # You should have received a copy of the GNU General Public License
   29: # along with LON-CAPA; if not, write to the Free Software
   30: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   31: #
   32: # /home/httpd/html/adm/gpl.txt
   33: #
   34: # http://www.lon-capa.org/
   35: #
   36: ###
   37: 
   38: =pod
   39: 
   40: =head1 DESCRIPTION
   41: 
   42: Automates the steps for domain coordinator creation.  This
   43: program also describes a manual procedure (see below).
   44: 
   45: These are the steps that are executed on the linux operating system:
   46: 
   47: =over 4
   48: 
   49: =item * 
   50: 
   51: Tests to see if user already exists for linux system or for
   52: LON-CAPA, if so aborts.  A message is output that recommends following
   53: a manual procedure enabling this user if so desired.
   54: 
   55: =item *
   56: 
   57: Creates a linux system user
   58: 
   59: =item *
   60: 
   61: Sets password
   62: 
   63: =item *
   64: 
   65: Creates a LON-CAPA lonUsers directory for user
   66: 
   67: =item *
   68: 
   69: Sets LON-CAPA password mechanism to be "unix"
   70: 
   71: =item *
   72: 
   73: Set roles.hist and roles.db
   74: 
   75: =back
   76: 
   77: =cut
   78: 
   79: # NOTE: I am interspersing the manual procedure with the automation.
   80: # To see the manual procedure, do perldoc ./make_domain_coordinator.pl
   81: 
   82: # This is a standalone script.  It *could* alternatively use the
   83: # lcuseradd script, however lcuseradd relies on certain system
   84: # dependencies.  In order to have a focused performance, I am trying
   85: # to avoid system dependencies until the LON-CAPA code base becomes
   86: # more robust and well-boundaried.  make_domain_coordinator.pl should be able
   87: # to run freely as possible, irrespective of the status of a LON-CAPA
   88: # installation.
   89: 
   90: # ---------------------------------------------------- Configure general values
   91: 
   92: use lib '/home/httpd/lib/perl/';
   93: use LONCAPA;
   94: use LONCAPA::lonmetadata;
   95: use Term::ReadKey;
   96: use Apache::lonnet;
   97: use Apache::lonlocal;
   98: use DBI;
   99: use strict;
  100: 
  101: =pod
  102: 
  103: =head1 OPTIONS
  104: 
  105: There are no flags to this script.
  106: 
  107: usage: make_domain_coordinator.pl [USERNAME] [DOMAIN] 
  108: 
  109: The password is accepted through standard input
  110: and should only consist of printable ASCII
  111: characters and be a string of length greater than 5 characters.
  112: 
  113: The first argument
  114: specifies the user name of the domain coordinator and
  115: should consist of only alphanumeric characters.
  116: It is recommended that the USERNAME should be institution-specific
  117: as opposed to something like "Sammy" or "Jo".
  118: For example, "dcmsu" or "dcumich" would be good domain coordinator
  119: USERNAMEs for places like Mich State Univ, etc.
  120: 
  121: The second argument specifies the domain of the computer
  122: coordinator.
  123: 
  124: =cut
  125: 
  126: my $lang = &Apache::lonlocal::choose_language();
  127: &Apache::lonlocal::get_language_handle(undef,$lang);
  128: print"\n";
  129: 
  130: # ----------------------------------------------- So, are we invoked correctly?
  131: # Two arguments or abort
  132: if (@ARGV!=2) {
  133:     print(&mt('usage: [_1]','make_domain_coordinator.pl [USERNAME] [DOMAIN]')."\n\n".
  134:         &mt('It is recommended that the USERNAME should be institution-specific.').
  135: 	"\n".&mt('It should not be something like "Sammy" or "Jo".')."\n".
  136: 	&mt('For example, [_1] or [_2] would be good domain coordinator USERNAMEs for places like Michigan State University, etc.','"domcoordmsu"','"dcmichstate"')."\n");
  137:     exit;
  138: }
  139: my ($username,$domain)=(@ARGV);
  140: if ($username=~/$LONCAPA::not_username_re/) {
  141:     print(&mt('**** ERROR **** Username [_1] must consist only of - . and alphanumeric characters.',$username)."\n");
  142:     exit;
  143: }
  144: if ($domain=~/$LONCAPA::not_domain_re/) {
  145:     print(&mt('**** ERROR **** Domain [_1] must consist only of - . and alphanumeric characters.',$domain)."\n");
  146:     exit;
  147: }
  148: 
  149: # Does user already exist
  150: my ($is_user,$has_lc_account);
  151: 
  152: my $udpath=&propath($domain,$username);
  153: if (-d $udpath) {
  154:     $has_lc_account = 1;
  155: }
  156: 
  157: if ($has_lc_account) {
  158:     print(&mt('**** ERROR **** [_1] is already defined as a LON-CAPA user.',
  159:               $username)."\n\n".
  160:           &mt('To assign a domain coordinator role to an existing user, use: [_1]',
  161:               "\n".'perl add_domain_coordinator_privilege.pl')."\n\n");
  162:     exit;
  163: }
  164: 
  165: if (-d "/home/$username") {
  166:     $is_user = 1;
  167: }
  168: 
  169: if ($is_user) {
  170:     print(&mt('**** ERROR **** [_1] is already a linux operating system user.',
  171:               $username)."\n\n".
  172:           &mt('This script will only automatically generate new users.')."\n".
  173:           &mt('To assign a domain coordinator role to an existing user:')."\n\n".
  174:           &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".
  175:           &mt('To view the documentation for this script, type: [_1].',
  176:               "\n".'perldoc ./make_domain_coordinator.pl')."\n\n");
  177:     exit;
  178: }
  179: 
  180: # Output a warning message.
  181: print(&mt('**** NOTE **** Generating a domain coordinator is "serious business".')."\n".
  182:      &mt('You must choose a password that is difficult to guess.')."\n");
  183: 
  184: print(&mt('Continue? ~[Y/n~] '));
  185: my $go_on = <STDIN>;
  186: chomp($go_on);
  187: $go_on =~ s/(^\s+|\s+$)//g;
  188: my $yes = &mt('y');
  189: unless (($go_on eq '') || ($go_on =~ /^\Q$yes\E/i)) {
  190:     exit;
  191: }
  192: print "\n";
  193: 
  194: my ($got_passwd,$firstpass,$secondpass,$passwd);
  195: my $maxtries = 10;
  196: my $trial = 0;
  197: while ((!$got_passwd) && ($trial < $maxtries)) {
  198:     $firstpass = &get_password(&mt('Enter password'));
  199:     if (length($firstpass) < 6) {
  200:         print(&mt('Password too short.')."\n".
  201:               &mt('Please choose a password with at least six characters.')."\n".
  202:               &mt('Please try again.')."\n");
  203:     } elsif (length($firstpass) > 30) {
  204:         print(&mt('Password too long.')."\n".
  205:               &mt('Please choose a password with no more than thirty characters.')."\n".
  206:               &mt('Please try again.')."\n");
  207:     } else {
  208:         my $pbad=0;
  209:         foreach (split(//,$firstpass)) {if ((ord($_)<32)||(ord($_)>126)){$pbad=1;}}
  210:         if ($pbad) {
  211:             print(&mt('Password contains invalid characters.')."\n".
  212:                   &mt('Password must consist of standard ASCII characters')."\n".
  213:                   &mt('Please try again.')."\n");
  214:         } else {
  215:             $secondpass = &get_password(&mt('Enter password a second time'));
  216:             if ($firstpass eq $secondpass) {
  217:                 $got_passwd = 1;
  218:                 $passwd = $firstpass;
  219:             } else {
  220:                 print(&mt('Passwords did not match.')."\n". 
  221:                       &mt('Please try again.')."\n");
  222:             }
  223:         }
  224:         $trial ++;
  225:     }
  226: }
  227: if (!$got_passwd) {
  228:     exit;
  229: }
  230: print "\n";
  231: 
  232: =pod
  233: 
  234: =head1 MANUAL PROCEDURE
  235: 
  236: There are 10 steps to manually recreating what this script performs
  237: automatically.
  238: 
  239: You need to decide on three pieces of information
  240: to create a domain coordinator.
  241: 
  242:  * USERNAME (kermit, albert, joe, etc)
  243:  * DOMAIN (should be the same as lonDefDomain in /etc/httpd/conf/loncapa.conf)
  244:  * PASSWORD (don't tell me)
  245: 
  246: The examples in these instructions will be based
  247: on three example pieces of information:
  248: 
  249:  * USERNAME=dc103
  250:  * DOMAIN=103
  251:  * PASSWORD=sesame
  252: 
  253: You will also need to know your "root" password
  254: and your "www" password.
  255: 
  256: =over 4
  257: 
  258: =item 1.
  259: 
  260: login as root on your Linux system
  261:  [prompt %] su
  262: 
  263: =cut
  264: 
  265: # ------------------------------------------------------------ So, are we root?
  266: 
  267: if ($< != 0) { # Am I root?
  268:    print(&mt('You must be root in order to generate a domain coordinator.').
  269:          "\n");
  270: }
  271: 
  272: =pod
  273: 
  274: =item 2 (as root). add the user
  275: 
  276:  Command: [prompt %] /usr/sbin/useradd USERNAME
  277:  Example: [prompt %] /usr/sbin/useradd dc103
  278: 
  279: =cut
  280: 
  281: # ----------------------------------------------------------- /usr/sbin/groupadd
  282: # -- Add group
  283: $username=~s/\W//g; # an extra filter, just to be sure
  284: 
  285: print(&mt('adding group: [_1]',$username)."\n");
  286: my $status = system('/usr/sbin/groupadd', $username);
  287: if ($status) {
  288:     print(&mt('Error.').' '.
  289:           &mt('Something went wrong with the addition of group "[_1]".',
  290:               $username)."\n");
  291:     exit;
  292: }
  293: my $gid = getgrnam($username);
  294: 
  295: # ----------------------------------------------------------- /usr/sbin/useradd
  296: # -- Add user
  297: 
  298: print(&mt('adding user: [_1]',$username)."\n");
  299: my $status = system('/usr/sbin/useradd','-c','LON-CAPA user','-g',$gid,$username);
  300: if ($status) {
  301:     system("/usr/sbin/groupdel $username");
  302:     print(&mt('Error.').' '.
  303:           &mt('Something went wrong with the addition of user "[_1]".',
  304:               $username)."\n");
  305:     exit;
  306: }
  307: 
  308: print(&mt('Done adding user.')."\n");
  309: # Make www a member of that user group.
  310: my $groups=`/usr/bin/groups www`;
  311: # untaint
  312: my ($safegroups)=($groups=~/:\s*([\s\w]+)/);
  313: $groups=$safegroups;
  314: chomp $groups; $groups=~s/^\S+\s+\:\s+//;
  315: my @grouplist=split(/\s+/,$groups);
  316: my @ugrouplist=grep {!/www|$username/} @grouplist;
  317: my $gl=join(',',(@ugrouplist,$username));
  318: print(&mt("Putting www in user's group.")."\n");
  319: if (system('/usr/sbin/usermod','-G',$gl,'www')) {
  320:     print(&mt('Error.').' '.&mt('Could not make www a member of the group "[_1]".',
  321:               $username)."\n");
  322:     exit;
  323: }
  324: 
  325: # Check if home directory exists for user
  326: # If not, create one.
  327: if (!-e "/home/$username") {
  328:     if (!mkdir("/home/$username",0710)) {
  329:         print(&mt('Error.').' '.&mt('Could not add home directory for "[_1]".',
  330:                   $username)."\n");
  331:         exit;
  332:     }
  333: }
  334: 
  335: if (-d "/home/$username") {
  336:     system('/bin/chown',"$username:$username","/home/$username");
  337:     system('/bin/chmod','-R','0660',"/home/$username");
  338:     system('/bin/chmod','0710',"/home/$username");
  339: }
  340: =pod
  341: 
  342: =item 3 (as root). enter in a password
  343: 
  344:  Command: [prompt %] passwd USERNAME
  345:           New UNIX password: PASSWORD
  346:           Retype new UNIX passwd: PASSWORD
  347:  Example: [prompt %] passwd dc103
  348:           New UNIX password: sesame
  349:           Retype new UNIX passwd: sesame
  350: 
  351: =cut
  352: 
  353: # Process password (taint-check, then pass to the UNIX passwd command).
  354: $username =~ s/\W//g; # an extra filter, just to be sure
  355: my $pbad = 0;
  356: foreach (split(//,$passwd)) {if ((ord($_)<32)||(ord($_)>126)){$pbad=1;}}
  357: if ($pbad) {
  358:     print(&mt('Password must consist of standard ASCII characters.').
  359:           "\n");
  360: }
  361:  
  362: my $distro;
  363: if (open(PIPE,"perl distprobe|")) {
  364:     $distro = <PIPE>;
  365:     close(PIPE);
  366: }
  367: if ($distro =~ /^ubuntu|debian/) {
  368:     open(OUT,"|usermod -p `mkpasswd $passwd` $username");
  369:     close(OUT);
  370: } else {
  371:     open(OUT,"|passwd --stdin $username");
  372:     print(OUT $passwd."\n");
  373:     close(OUT);
  374: }
  375: 
  376: =pod
  377: 
  378: =cut
  379: 
  380: =pod
  381: 
  382: =item 4. login as user=www
  383: 
  384:  Command: [prompt %] su www
  385:  Password: WWWPASSWORD
  386: 
  387: =item 5. (as www). cd /home/httpd/lonUsers
  388: 
  389: =item 6. (as www) Create user directory for your new user.
  390: 
  391:  Let U equal first letter of USERNAME
  392:  Let S equal second letter of USERNAME
  393:  Let E equal third letter of USERNAME
  394:  Command: [prompt %] install -d DOMAIN/U/S/E/USERNAME
  395: 
  396:  Here are three examples of the commands that would be needed
  397:  for different domain coordinator names (dc103, morphy, or ng):
  398: 
  399:  Example #1 (dc103):  [prompt %] install -d 103/d/c/1/dc103
  400:  Example #2 (morphy): [prompt %] install -d 103/m/o/r/morphy
  401:  Example #3 (ng):     [prompt %] install -d 103/n/g/_/ng
  402: 
  403: =cut
  404: 
  405: # Generate the user directory.
  406: `install -o www -g www -d $udpath`; # Must be writeable by httpd process.
  407: 
  408: =pod
  409: 
  410: =item 7. (as www) Enter the newly created user directory.
  411: 
  412:  Command: [prompt %] cd DOMAIN/U/S/E/USERNAME
  413:  Example: [prompt %] cd 103/d/c/1/dc103
  414: 
  415: =item 8. (as www). Set your password mechanism to 'unix' 
  416: 
  417:  Command: [prompt %] echo "unix:" > passwd
  418: 
  419: =cut
  420: 
  421: # UNIX (/etc/passwd) style authentication is asserted for domain coordinators.
  422: open(OUT, ">$udpath/passwd");
  423: print(OUT 'unix:'."\n");
  424: close(OUT);
  425: 
  426: # Get permissions correct on udpath
  427: 
  428:  print(&mt('Setting permissions on user data directories.').' '.
  429:        &mt('This may take a moment, please be patient ...')."\n");
  430: `chown -R www:www /home/httpd/lonUsers/$domain` ; # Must be writeable by httpd process.
  431: 
  432: =pod
  433: 
  434: =item 9. (as www). Run CVS:loncapa/doc/rolesmanip.pl:
  435: 
  436:  Command: [prompt %] perl rolesmanip.pl DOMAIN USERNAME
  437:  Example: [prompt %] perl rolesmanip.pl 103 dc103
  438: 
  439: =cut
  440: 
  441: use GDBM_File; # A simplistic key-value pairing database.
  442: 
  443: my $rolesref=&LONCAPA::locking_hash_tie("$udpath/roles.db",&GDBM_WRCREAT());
  444: if (!$rolesref) {
  445:     print(&mt('Error').' '.
  446:           &mt('unable to tie roles db: [_1]'."$udpath/roles.db")."\n");
  447:     exit;
  448: }
  449: my $now = time;
  450: $rolesref->{'/'.$domain.'/_dc'}='dc_0_'.$now; # Set the domain coordinator role.
  451: open(OUT, ">$udpath/roles.hist"); # roles.hist is the synchronous plain text.
  452: foreach my $key (keys(%{$rolesref})) {
  453:     print(OUT $key.' : '.$rolesref->{$key}."\n");
  454: }
  455: close(OUT);
  456: &LONCAPA::locking_hash_untie($rolesref);
  457: 
  458: 
  459: `chown www:www $udpath/roles.hist`; # Must be writeable by httpd process.
  460: `chown www:www $udpath/roles.db`; # Must be writeable by httpd process.
  461: 
  462: my %perlvar = %{&LONCAPA::Configuration::read_conf('loncapa.conf')};
  463: my $dompath = $perlvar{'lonUsersDir'}.'/'.$domain;
  464: my $domrolesref = &LONCAPA::locking_hash_tie("$dompath/nohist_domainroles.db",&GDBM_WRCREAT());
  465: 
  466: if (!$domrolesref) {
  467:     print(&mt('Error').' '.&mt('unable to tie nohist_domainroles db: [_1].',
  468:                                "$dompath/nohist_domainroles.db")."\n");
  469: }
  470: 
  471: # Store in nohist_domainroles.db
  472: my $domkey=&LONCAPA::escape('dc:'.$username.':'.$domain.'::'.$domain.':');
  473: $domrolesref->{$domkey}= &LONCAPA::escape('0:'.$now);
  474: &LONCAPA::locking_hash_untie($domrolesref);
  475: 
  476:  system('/bin/chown',"www:www","$dompath/nohist_domainroles.db"); # Must be writeable by httpd process.
  477:  system('/bin/chown',"www:www","$dompath/nohist_domainroles.db.lock");
  478: 
  479: #Update allusers MySQL table
  480: 
  481: print(&mt('Adding new user to allusers table.')."\n");
  482: &allusers_update($username,$domain,\%perlvar);
  483: 
  484: =pod
  485: 
  486: =item 10.
  487: 
  488: You may further define the domain coordinator user (i.e. dc103)
  489: by going to http://MACHINENAME/adm/createuser.
  490: 
  491: =cut
  492: 
  493: # Output success message, and inform sysadmin about how to further proceed.
  494: print("\n".&mt('[_1] is now a domain coordinator',$username)."\n"); # Output success message.
  495: my $hostname=`hostname`; chomp($hostname); # Read in hostname.
  496: print("\n".
  497:       &mt('Once LON-CAPA is running, you should log-in and use: [_1] to further define this user.',
  498:           "\nhttp://$hostname/adm/createuser\n")."\n\n".
  499:       &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"); 
  500: # Output a suggested URL.
  501: 
  502: sub allusers_update {
  503:     my ($username,$domain,$perlvar) = @_;
  504:     my %tablenames = (
  505:                        'allusers'   => 'allusers',
  506:                      );
  507:     my $dbh;
  508:     unless ($dbh = DBI->connect("DBI:mysql:loncapa","www",
  509:                             $perlvar->{'lonSqlAccess'},
  510:                             { RaiseError =>0,PrintError=>0})) {
  511:         print(&mt('Cannot connect to database!')."\n");
  512:         return;
  513:     }
  514:     my $tablechk = &allusers_table_exists($dbh);
  515:     if ($tablechk == 0) {
  516:         my $request =
  517:    &LONCAPA::lonmetadata::create_metadata_storage('allusers','allusers');
  518:         $dbh->do($request);
  519:         if ($dbh->err) {
  520:              print(&mt('Failed to create [_1] table.','allusers')."\n");
  521:              return;
  522:         }
  523:     }
  524:     my %userdata =  (
  525:                 username => $username,
  526:                 domain   => $domain,
  527:     );
  528:     my %loghash =
  529:         &LONCAPA::lonmetadata::process_allusers_data($dbh,undef,
  530:             \%tablenames,$username,$domain,\%userdata,'update');
  531:     foreach my $key (keys(%loghash)) {
  532:         print $loghash{$key}."\n";
  533:     }
  534:     return;
  535: }
  536: 
  537: sub allusers_table_exists {
  538:     my ($dbh) = @_;
  539:     my $sth=$dbh->prepare('SHOW TABLES');
  540:     $sth->execute();
  541:     my $aref = $sth->fetchall_arrayref;
  542:     $sth->finish();
  543:     if ($sth->err()) {
  544:         return undef;
  545:     }
  546:     my $result = 0;
  547:     foreach my $table (@{$aref}) {
  548:         if ($table->[0] eq 'allusers') {
  549:             $result = 1;
  550:             last;
  551:         }
  552:     }
  553:     return $result;
  554: }
  555: 
  556: sub get_password {
  557:     my ($prompt) = @_;
  558:     local $| = 1;
  559:     print $prompt.': ';
  560:     my $newpasswd = '';
  561:     ReadMode 'raw';
  562:     my $key;
  563:     while(ord($key = ReadKey(0)) != 10) {
  564:         if(ord($key) == 127 || ord($key) == 8) {
  565:             chop($newpasswd);
  566:             print "\b \b";
  567:         } elsif(!ord($key) < 32) {
  568:             $newpasswd .= $key;
  569:             print '*';
  570:         }
  571:     }
  572:     ReadMode 'normal';
  573:     print "\n";
  574:     return $newpasswd;
  575: }
  576: 
  577: =pod
  578: 
  579: =head1 AUTHOR
  580: 
  581: Written to help the LON-CAPA project.
  582: 
  583: =cut
  584: