File:  [LON-CAPA] / loncom / build / make_domain_coordinator.pl
Revision 1.15: download - view: text, annotated - select for diffs
Mon Mar 3 15:25:02 2008 UTC (16 years, 2 months ago) by www
Branches: MAIN
CVS tags: version_2_8_X, version_2_8_2, version_2_8_1, version_2_8_0, version_2_7_X, version_2_7_99_1, version_2_7_99_0, version_2_7_1, version_2_7_0, version_2_6_X, version_2_6_99_1, version_2_6_99_0, version_2_6_3, bz5969, HEAD, GCI_1, BZ5971-printing-apage, BZ5434-fox
Bug #5646 - make_domain_coordinator.pl generates wrong ownership of director

    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.15 2008/03/03 15:25:02 www 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 DBI;
   96: 
   97: =pod
   98: 
   99: =head1 OPTIONS
  100: 
  101: There are no flags to this script.
  102: 
  103: usage: make_domain_coordinator.pl [USERNAME] [DOMAIN] 
  104: 
  105: The password is accepted through standard input
  106: and should only consist of printable ASCII
  107: characters and be a string of length greater than 5 characters.
  108: 
  109: The first argument
  110: specifies the user name of the domain coordinator and
  111: should consist of only alphanumeric characters.
  112: It is recommended that the USERNAME should be institution-specific
  113: as opposed to something like "Sammy" or "Jo".
  114: For example, "dcmsu" or "dcumich" would be good domain coordinator
  115: USERNAMEs for places like Mich State Univ, etc.
  116: 
  117: The second argument specifies the domain of the computer
  118: coordinator.
  119: 
  120: =cut
  121: 
  122: # ----------------------------------------------- So, are we invoked correctly?
  123: # Two arguments or abort
  124: if (@ARGV!=2) {
  125:     die('usage: make_domain_coordinator.pl [USERNAME] [DOMAIN] '."\n".
  126: 	'(and password through standard input)'."\n".
  127: 	'It is recommended that the USERNAME should be institution-specific '.
  128: 	"\n".'as opposed to something like "Sammy" or "Jo".'."\n".
  129: 	'For example, "dcmsu" or "dcumich" would be good domain coordinator'.
  130: 	"\n".'USERNAMEs for places like Mich State Univ, etc.'."\n");
  131: }
  132: my ($username,$domain)=(@ARGV); shift @ARGV; shift @ARGV;
  133: if ($username=~/$LONCAPA::not_username_re/) {
  134:     die('**** ERROR **** '.
  135: 	'Username '.$username.' must consist only of - . and alphanumeric characters'.
  136: 	"\n");
  137: }
  138: if ($domain=~/$LONCAPA::not_domain_re/) {
  139:     die('**** ERROR **** '.
  140: 	'Domain '.$domain.' must consist only of - . and alphanumeric charaters and '.
  141: 	"\n");
  142: }
  143: 
  144: # Output a warning message.
  145: print('**** NOTE **** '.
  146:       'Generating a domain coordinator is "serious business".'."\n".
  147:       'Choosing a difficult-to-guess (and keeping it a secret) password '."\n".
  148:       'is highly recommended.'."\n");
  149: 
  150: print("Password: "); $|=1;
  151: my $passwd=<>; # read in password from standard input
  152: chomp($passwd);
  153: 
  154: if (length($passwd)<6 or length($passwd)>30) {
  155:     die('**** ERROR **** '.'Password is an unreasonable length.'."\n".
  156: 	'It should be at least 6 characters in length.'."\n");
  157: }
  158: my $pbad=0;
  159: foreach (split(//,$passwd)) {if ((ord($_)<32)||(ord($_)>126)){$pbad=1;}}
  160: if ($pbad) {
  161:     die('**** ERROR **** '.
  162: 	'Password must consist of standard ASCII characters'."\n");
  163: }
  164: 
  165: # And does user already exist
  166: 
  167: my $caveat =
  168:     'For security reasons, this script will only automatically generate '."\n".
  169:     'new users, not pre-existing users.'."\n".
  170:     "If you want to make '$username' a domain coordinator, you "."\n".
  171:     'should do so manually by customizing the MANUAL PROCEDURE'."\n".
  172:     'described in the documentation.  To view the documentation '."\n".
  173:     'for this script, type '.
  174:     "'perldoc ./make_domain_coordinator.pl'."."\n";
  175: 
  176: if (-d "/home/$username") {
  177:     die ('**** ERROR **** '.$username.' is already a linux operating system '.
  178: 	 'user.'."\n".$caveat);
  179: }
  180: my $udpath=&propath($domain,$username);
  181: if (-d $udpath) {
  182:     die ('**** ERROR **** '.$username.' is already defined as a LON-CAPA '.
  183: 	 'user.'."\n".$caveat);
  184: }
  185: 
  186: =pod
  187: 
  188: =head1 MANUAL PROCEDURE
  189: 
  190: There are 10 steps to manually recreating what this script performs
  191: automatically.
  192: 
  193: You need to decide on three pieces of information
  194: to create a domain coordinator.
  195: 
  196:  * USERNAME (kermit, albert, joe, etc)
  197:  * DOMAIN (should be the same as lonDefDomain in /etc/httpd/conf/loncapa.conf)
  198:  * PASSWORD (don't tell me)
  199: 
  200: The examples in these instructions will be based
  201: on three example pieces of information:
  202: 
  203:  * USERNAME=dc103
  204:  * DOMAIN=103
  205:  * PASSWORD=sesame
  206: 
  207: You will also need to know your "root" password
  208: and your "www" password.
  209: 
  210: =over 4
  211: 
  212: =item 1.
  213: 
  214: login as root on your Linux system
  215:  [prompt %] su
  216: 
  217: =cut
  218: 
  219: # ------------------------------------------------------------ So, are we root?
  220: 
  221: if ($< != 0) { # Am I root?
  222:   die 'You must be root in order to generate a domain coordinator.'."\n";
  223: }
  224: 
  225: =pod
  226: 
  227: =item 2 (as root). add the user
  228: 
  229:  Command: [prompt %] /usr/sbin/useradd USERNAME
  230:  Example: [prompt %] /usr/sbin/useradd dc103
  231: 
  232: =cut
  233: 
  234: # ----------------------------------------------------------- /usr/sbin/groupadd
  235: # -- Add group
  236: $username=~s/\W//g; # an extra filter, just to be sure
  237: 
  238: print "adding group: $username \n";
  239: my $status = system('/usr/sbin/groupadd', $username);
  240: if ($status) {
  241:     die "Error.  Something went wrong with the addition of group ".
  242:           "\"$username\".\n";
  243: }
  244: my $gid = getgrnam($username);
  245: 
  246: # ----------------------------------------------------------- /usr/sbin/useradd
  247: # -- Add user
  248: 
  249: print "adding user: $username \n";
  250: my $status = system('/usr/sbin/useradd','-c','LON-CAPA user','-g',$gid,$username);
  251: if ($status) {
  252:     system("/usr/sbin/groupdel $username");
  253:     die "Error.  Something went wrong with the addition of user ".
  254:           "\"$username\".\n";
  255: }
  256: 
  257: print "Done adding user\n";
  258: # Make www a member of that user group.
  259: my $groups=`/usr/bin/groups www`;
  260: # untaint
  261: my ($safegroups)=($groups=~/:\s*([\s\w]+)/);
  262: $groups=$safegroups;
  263: chomp $groups; $groups=~s/^\S+\s+\:\s+//;
  264: my @grouplist=split(/\s+/,$groups);
  265: my @ugrouplist=grep {!/www|$username/} @grouplist;
  266: my $gl=join(',',(@ugrouplist,$username));
  267: print "Putting www in user's group\n";
  268: if (system('/usr/sbin/usermod','-G',$gl,'www')) {
  269:     die "Error. Could not make www a member of the group ".
  270:           "\"$username\".\n";
  271: }
  272: 
  273: # Check if home directory exists for user
  274: # If not, create one.
  275: if (!-e "/home/$username") {
  276:     if (!mkdir("/home/$username",0710)) {
  277:         print "Error. Could not add home directory for ".
  278:           "\"$username\".\n";
  279:     }
  280: }
  281: 
  282: if (-d "/home/$username") {
  283:     system('/bin/chown',"$username:$username","/home/$username");
  284:     system('/bin/chmod','-R','0660',"/home/$username");
  285:     system('/bin/chmod','0710',"/home/$username");
  286: }
  287: =pod
  288: 
  289: =item 3 (as root). enter in a password
  290: 
  291:  Command: [prompt %] passwd USERNAME
  292:           New UNIX password: PASSWORD
  293:           Retype new UNIX passwd: PASSWORD
  294:  Example: [prompt %] passwd dc103
  295:           New UNIX password: sesame
  296:           Retype new UNIX passwd: sesame
  297: 
  298: =cut
  299: 
  300: # Process password (taint-check, then pass to the UNIX passwd command).
  301: $username =~ s/\W//g; # an extra filter, just to be sure
  302: $pbad = 0;
  303: foreach (split(//,$passwd)) {if ((ord($_)<32)||(ord($_)>126)){$pbad=1;}}
  304: if ($pbad) {
  305:     die('Password must consist of standard ASCII characters'."\n");
  306: }
  307: open(OUT,"|passwd --stdin $username");
  308: print(OUT $passwd."\n");
  309: close(OUT);
  310: 
  311: =pod
  312: 
  313: =cut
  314: 
  315: =pod
  316: 
  317: =item 4. login as user=www
  318: 
  319:  Command: [prompt %] su www
  320:  Password: WWWPASSWORD
  321: 
  322: =item 5. (as www). cd /home/httpd/lonUsers
  323: 
  324: =item 6. (as www) Create user directory for your new user.
  325: 
  326:  Let U equal first letter of USERNAME
  327:  Let S equal second letter of USERNAME
  328:  Let E equal third letter of USERNAME
  329:  Command: [prompt %] install -d DOMAIN/U/S/E/USERNAME
  330: 
  331:  Here are three examples of the commands that would be needed
  332:  for different domain coordinator names (dc103, morphy, or ng):
  333: 
  334:  Example #1 (dc103):  [prompt %] install -d 103/d/c/1/dc103
  335:  Example #2 (morphy): [prompt %] install -d 103/m/o/r/morphy
  336:  Example #3 (ng):     [prompt %] install -d 103/n/g/_/ng
  337: 
  338: =cut
  339: 
  340: # Generate the user directory.
  341: `install -o www -g www -d $udpath`; # Must be writeable by httpd process.
  342: 
  343: =pod
  344: 
  345: =item 7. (as www) Enter the newly created user directory.
  346: 
  347:  Command: [prompt %] cd DOMAIN/U/S/E/USERNAME
  348:  Example: [prompt %] cd 103/d/c/1/dc103
  349: 
  350: =item 8. (as www). Set your password mechanism to 'unix' 
  351: 
  352:  Command: [prompt %] echo "unix:" > passwd
  353: 
  354: =cut
  355: 
  356: # UNIX (/etc/passwd) style authentication is asserted for domain coordinators.
  357: open(OUT, ">$udpath/passwd");
  358: print(OUT 'unix:'."\n");
  359: close(OUT);
  360: 
  361: # Get permissions correct on udpath
  362: 
  363:  print "Setting permissions on user data directories. This may take a moment, please be patient ...\n";
  364: `chown -R www:www /home/httpd/lonUsers/$domain` ; # Must be writeable by httpd process.
  365: 
  366: =pod
  367: 
  368: =item 9. (as www). Run CVS:loncapa/doc/rolesmanip.pl:
  369: 
  370:  Command: [prompt %] perl rolesmanip.pl DOMAIN USERNAME
  371:  Example: [prompt %] perl rolesmanip.pl 103 dc103
  372: 
  373: =cut
  374: 
  375: use GDBM_File; # A simplistic key-value pairing database.
  376: 
  377: my $rolesref=&LONCAPA::locking_hash_tie("$udpath/roles.db",&GDBM_WRCREAT());
  378: if (!$rolesref) {
  379:     die('unable to tie roles db: '."$udpath/roles.db");
  380: }
  381: my $now = time;
  382: $rolesref->{'/'.$domain.'/_dc'}='dc_0_'.$now; # Set the domain coordinator role.
  383: open(OUT, ">$udpath/roles.hist"); # roles.hist is the synchronous plain text.
  384: foreach my $key (keys(%{$rolesref})) {
  385:     print(OUT $key.' : '.$rolesref->{$key}."\n");
  386: }
  387: close(OUT);
  388: &LONCAPA::locking_hash_untie($rolesref);
  389: 
  390: 
  391: `chown www:www $udpath/roles.hist`; # Must be writeable by httpd process.
  392: `chown www:www $udpath/roles.db`; # Must be writeable by httpd process.
  393: 
  394: my %perlvar = %{&LONCAPA::Configuration::read_conf('loncapa.conf')};
  395: my $dompath = $perlvar{'lonUsersDir'}.'/'.$domain;
  396: my $domrolesref = &LONCAPA::locking_hash_tie("$dompath/nohist_domainroles.db",&GDBM_WRCREAT());
  397: 
  398: if (!$domrolesref) {
  399:     die('unable to tie nohist_domainroles db: '."$dompath/nohist_domainroles.db");
  400: }
  401: 
  402: # Store in nohist_domainroles.db
  403: my $domkey=&LONCAPA::escape('dc:'.$username.':'.$domain.'::'.$domain.':');
  404: $domrolesref->{$domkey}= &LONCAPA::escape('0:'.$now);
  405: &LONCAPA::locking_hash_untie($domrolesref);
  406: 
  407:  system('/bin/chown',"www:www","$dompath/nohist_domainroles.db"); # Must be writeable by httpd process.
  408:  system('/bin/chown',"www:www","$dompath/nohist_domainroles.db.lock");
  409: 
  410: #Update allusers MySQL table
  411: 
  412: print "Adding new user to allusers table\n";
  413: &allusers_update($username,$domain,\%perlvar);
  414: 
  415: =pod
  416: 
  417: =item 10.
  418: 
  419: You may further define the domain coordinator user (i.e. dc103)
  420: by going to http://MACHINENAME/adm/createuser.
  421: 
  422: =cut
  423: 
  424: # Output success message, and inform sysadmin about how to further proceed.
  425: print("\n$username is now a domain coordinator\n"); # Output success message.
  426: my $hostname=`hostname`; chomp($hostname); # Read in hostname.
  427: print("\n".'Once LON-CAPA is running, you should log-in and use: '."\n".
  428:       'http://'.$hostname.'/adm/createuser to further define this user.'."\n\n".
  429:       'From the user management menu, click the link: "Add/Modify a Single User" '."\n".
  430:       'to search for the user and to provide additional information (last name, first name etc.).'."\n");
  431: # Output a suggested URL.
  432: 
  433: sub allusers_update {
  434:     my ($username,$domain,$perlvar) = @_;
  435:     my %tablenames = (
  436:                        'allusers'   => 'allusers',
  437:                      );
  438:     my $dbh;
  439:     unless ($dbh = DBI->connect("DBI:mysql:loncapa","www",
  440:                             $perlvar->{'lonSqlAccess'},
  441:                             { RaiseError =>0,PrintError=>0})) {
  442:         print "Cannot connect to database!\n";
  443:         return;
  444:     }
  445:     my $tablechk = &allusers_table_exists($dbh);
  446:     if ($tablechk == 0) {
  447:         my $request =
  448:    &LONCAPA::lonmetadata::create_metadata_storage('allusers','allusers');
  449:         $dbh->do($request);
  450:         if ($dbh->err) {
  451:              print "Failed to crate allusers table\n";
  452:              return;
  453:         }
  454:     }
  455:     my %userdata =  (
  456:                 username => $username,
  457:                 domain   => $domain,
  458:     );
  459:     my %loghash =
  460:         &LONCAPA::lonmetadata::process_allusers_data($dbh,undef,
  461:             \%tablenames,$username,$domain,\%userdata,'update');
  462:     foreach my $key (keys(%loghash)) {
  463:         print $loghash{$key}."\n";
  464:     }
  465:     return;
  466: }
  467: 
  468: sub allusers_table_exists {
  469:     my ($dbh) = @_;
  470:     my $sth=$dbh->prepare('SHOW TABLES');
  471:     $sth->execute();
  472:     my $aref = $sth->fetchall_arrayref;
  473:     $sth->finish();
  474:     if ($sth->err()) {
  475:         return undef;
  476:     }
  477:     my $result = 0;
  478:     foreach my $table (@{$aref}) {
  479:         if ($table->[0] eq 'allusers') {
  480:             $result = 1;
  481:             last;
  482:         }
  483:     }
  484:     return $result;
  485: }
  486: 
  487: =pod
  488: 
  489: =head1 AUTHOR
  490: 
  491: Written to help the LON-CAPA project.
  492: 
  493: =cut
  494: 

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