Annotation of loncom/build/make_domain_coordinator.pl, revision 1.24

1.1       harris41    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: 
1.2       harris41    9: =cut
                     10: 
                     11: # The LearningOnline Network
                     12: # make_domain_coordinator.pl - Make a domain coordinator on a system
                     13: #
1.24    ! raeburn    14: # $Id: make_domain_coordinator.pl,v 1.23 2012/11/20 19:00:52 raeburn Exp $
1.2       harris41   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: 
1.1       harris41   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
1.7       harris41   52: LON-CAPA, if so aborts.  A message is output that recommends following
                     53: a manual procedure enabling this user if so desired.
1.1       harris41   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
1.7       harris41   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
1.1       harris41   88: # installation.
                     89: 
                     90: # ---------------------------------------------------- Configure general values
                     91: 
1.10      albertel   92: use lib '/home/httpd/lib/perl/';
                     93: use LONCAPA;
1.13      raeburn    94: use LONCAPA::lonmetadata;
1.18      raeburn    95: use Term::ReadKey;
                     96: use Apache::lonnet;
                     97: use Apache::lonlocal;
1.13      raeburn    98: use DBI;
1.22      raeburn    99: use Storable qw(nfreeze);
1.20      raeburn   100: use strict;
1.1       harris41  101: 
                    102: =pod
                    103: 
                    104: =head1 OPTIONS
                    105: 
                    106: There are no flags to this script.
                    107: 
                    108: usage: make_domain_coordinator.pl [USERNAME] [DOMAIN] 
                    109: 
1.3       harris41  110: The password is accepted through standard input
                    111: and should only consist of printable ASCII
                    112: characters and be a string of length greater than 5 characters.
1.1       harris41  113: 
                    114: The first argument
                    115: specifies the user name of the domain coordinator and
                    116: should consist of only alphanumeric characters.
1.8       harris41  117: It is recommended that the USERNAME should be institution-specific
                    118: as opposed to something like "Sammy" or "Jo".
                    119: For example, "dcmsu" or "dcumich" would be good domain coordinator
                    120: USERNAMEs for places like Mich State Univ, etc.
1.1       harris41  121: 
1.3       harris41  122: The second argument specifies the domain of the computer
1.12      albertel  123: coordinator.
1.1       harris41  124: 
                    125: =cut
                    126: 
1.18      raeburn   127: my $lang = &Apache::lonlocal::choose_language();
                    128: &Apache::lonlocal::get_language_handle(undef,$lang);
                    129: print"\n";
                    130: 
1.1       harris41  131: # ----------------------------------------------- So, are we invoked correctly?
                    132: # Two arguments or abort
                    133: if (@ARGV!=2) {
1.18      raeburn   134:     print(&mt('usage: [_1]','make_domain_coordinator.pl [USERNAME] [DOMAIN]')."\n\n".
                    135:         &mt('It is recommended that the USERNAME should be institution-specific.').
                    136: 	"\n".&mt('It should not be something like "Sammy" or "Jo".')."\n".
                    137: 	&mt('For example, [_1] or [_2] would be good domain coordinator USERNAMEs for places like Michigan State University, etc.','"domcoordmsu"','"dcmichstate"')."\n");
                    138:     exit;
1.1       harris41  139: }
1.18      raeburn   140: my ($username,$domain)=(@ARGV);
1.12      albertel  141: if ($username=~/$LONCAPA::not_username_re/) {
1.18      raeburn   142:     print(&mt('**** ERROR **** Username [_1] must consist only of - . and alphanumeric characters.',$username)."\n");
                    143:     exit;
1.1       harris41  144: }
1.12      albertel  145: if ($domain=~/$LONCAPA::not_domain_re/) {
1.18      raeburn   146:     print(&mt('**** ERROR **** Domain [_1] must consist only of - . and alphanumeric characters.',$domain)."\n");
                    147:     exit;
                    148: }
                    149: 
                    150: # Does user already exist
                    151: my ($is_user,$has_lc_account);
                    152: 
                    153: my $udpath=&propath($domain,$username);
                    154: if (-d $udpath) {
                    155:     $has_lc_account = 1;
1.1       harris41  156: }
                    157: 
1.18      raeburn   158: if ($has_lc_account) {
                    159:     print(&mt('**** ERROR **** [_1] is already defined as a LON-CAPA user.',
                    160:               $username)."\n\n".
                    161:           &mt('To assign a domain coordinator role to an existing user, use: [_1]',
                    162:               "\n".'perl add_domain_coordinator_privilege.pl')."\n\n");
                    163:     exit;
1.1       harris41  164: }
1.18      raeburn   165: 
                    166: if (-d "/home/$username") {
                    167:     $is_user = 1;
1.1       harris41  168: }
                    169: 
1.19      raeburn   170: if ($is_user) {
1.18      raeburn   171:     print(&mt('**** ERROR **** [_1] is already a linux operating system user.',
                    172:               $username)."\n\n".
                    173:           &mt('This script will only automatically generate new users.')."\n".
                    174:           &mt('To assign a domain coordinator role to an existing user:')."\n\n".
                    175:           &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".
                    176:           &mt('To view the documentation for this script, type: [_1].',
                    177:               "\n".'perldoc ./make_domain_coordinator.pl')."\n\n");
                    178:     exit;
                    179: }
1.1       harris41  180: 
1.18      raeburn   181: # Output a warning message.
                    182: print(&mt('**** NOTE **** Generating a domain coordinator is "serious business".')."\n".
                    183:      &mt('You must choose a password that is difficult to guess.')."\n");
1.7       harris41  184: 
1.18      raeburn   185: print(&mt('Continue? ~[Y/n~] '));
                    186: my $go_on = <STDIN>;
                    187: chomp($go_on);
                    188: $go_on =~ s/(^\s+|\s+$)//g;
                    189: my $yes = &mt('y');
                    190: unless (($go_on eq '') || ($go_on =~ /^\Q$yes\E/i)) {
                    191:     exit;
                    192: }
                    193: print "\n";
                    194: 
1.20      raeburn   195: my ($got_passwd,$firstpass,$secondpass,$passwd);
1.18      raeburn   196: my $maxtries = 10;
                    197: my $trial = 0;
                    198: while ((!$got_passwd) && ($trial < $maxtries)) {
                    199:     $firstpass = &get_password(&mt('Enter password'));
                    200:     if (length($firstpass) < 6) {
                    201:         print(&mt('Password too short.')."\n".
                    202:               &mt('Please choose a password with at least six characters.')."\n".
1.20      raeburn   203:               &mt('Please try again.')."\n");
1.18      raeburn   204:     } elsif (length($firstpass) > 30) {
                    205:         print(&mt('Password too long.')."\n".
                    206:               &mt('Please choose a password with no more than thirty characters.')."\n".
1.20      raeburn   207:               &mt('Please try again.')."\n");
1.18      raeburn   208:     } else {
                    209:         my $pbad=0;
1.21      raeburn   210:         foreach (split(//,$firstpass)) {if ((ord($_)<32)||(ord($_)>126)){$pbad=1;}}
1.18      raeburn   211:         if ($pbad) {
                    212:             print(&mt('Password contains invalid characters.')."\n".
1.24    ! raeburn   213:                   &mt('Password must consist of standard ASCII characters.')."\n".
1.18      raeburn   214:                   &mt('Please try again.')."\n");
                    215:         } else {
                    216:             $secondpass = &get_password(&mt('Enter password a second time'));
                    217:             if ($firstpass eq $secondpass) {
                    218:                 $got_passwd = 1;
                    219:                 $passwd = $firstpass;
                    220:             } else {
                    221:                 print(&mt('Passwords did not match.')."\n". 
                    222:                       &mt('Please try again.')."\n");
                    223:             }
                    224:         }
                    225:         $trial ++;
                    226:     }
1.1       harris41  227: }
1.18      raeburn   228: if (!$got_passwd) {
                    229:     exit;
1.1       harris41  230: }
1.18      raeburn   231: print "\n";
1.1       harris41  232: 
                    233: =pod
                    234: 
                    235: =head1 MANUAL PROCEDURE
                    236: 
1.7       harris41  237: There are 10 steps to manually recreating what this script performs
                    238: automatically.
1.1       harris41  239: 
                    240: You need to decide on three pieces of information
                    241: to create a domain coordinator.
                    242: 
                    243:  * USERNAME (kermit, albert, joe, etc)
1.6       harris41  244:  * DOMAIN (should be the same as lonDefDomain in /etc/httpd/conf/loncapa.conf)
1.1       harris41  245:  * PASSWORD (don't tell me)
                    246: 
                    247: The examples in these instructions will be based
                    248: on three example pieces of information:
                    249: 
                    250:  * USERNAME=dc103
                    251:  * DOMAIN=103
                    252:  * PASSWORD=sesame
                    253: 
                    254: You will also need to know your "root" password
                    255: and your "www" password.
                    256: 
                    257: =over 4
                    258: 
                    259: =item 1.
                    260: 
                    261: login as root on your Linux system
                    262:  [prompt %] su
                    263: 
                    264: =cut
                    265: 
                    266: # ------------------------------------------------------------ So, are we root?
                    267: 
1.7       harris41  268: if ($< != 0) { # Am I root?
1.18      raeburn   269:    print(&mt('You must be root in order to generate a domain coordinator.').
                    270:          "\n");
1.1       harris41  271: }
                    272: 
                    273: =pod
                    274: 
                    275: =item 2 (as root). add the user
                    276: 
                    277:  Command: [prompt %] /usr/sbin/useradd USERNAME
                    278:  Example: [prompt %] /usr/sbin/useradd dc103
                    279: 
                    280: =cut
                    281: 
1.11      raeburn   282: # ----------------------------------------------------------- /usr/sbin/groupadd
                    283: # -- Add group
                    284: $username=~s/\W//g; # an extra filter, just to be sure
                    285: 
1.18      raeburn   286: print(&mt('adding group: [_1]',$username)."\n");
1.11      raeburn   287: my $status = system('/usr/sbin/groupadd', $username);
                    288: if ($status) {
1.18      raeburn   289:     print(&mt('Error.').' '.
                    290:           &mt('Something went wrong with the addition of group "[_1]".',
                    291:               $username)."\n");
                    292:     exit;
1.11      raeburn   293: }
                    294: my $gid = getgrnam($username);
                    295: 
1.1       harris41  296: # ----------------------------------------------------------- /usr/sbin/useradd
1.11      raeburn   297: # -- Add user
1.1       harris41  298: 
1.18      raeburn   299: print(&mt('adding user: [_1]',$username)."\n");
1.11      raeburn   300: my $status = system('/usr/sbin/useradd','-c','LON-CAPA user','-g',$gid,$username);
                    301: if ($status) {
                    302:     system("/usr/sbin/groupdel $username");
1.18      raeburn   303:     print(&mt('Error.').' '.
                    304:           &mt('Something went wrong with the addition of user "[_1]".',
                    305:               $username)."\n");
                    306:     exit;
1.11      raeburn   307: }
                    308: 
1.18      raeburn   309: print(&mt('Done adding user.')."\n");
1.11      raeburn   310: # Make www a member of that user group.
                    311: my $groups=`/usr/bin/groups www`;
                    312: # untaint
                    313: my ($safegroups)=($groups=~/:\s*([\s\w]+)/);
                    314: $groups=$safegroups;
                    315: chomp $groups; $groups=~s/^\S+\s+\:\s+//;
                    316: my @grouplist=split(/\s+/,$groups);
                    317: my @ugrouplist=grep {!/www|$username/} @grouplist;
                    318: my $gl=join(',',(@ugrouplist,$username));
1.18      raeburn   319: print(&mt("Putting www in user's group.")."\n");
1.11      raeburn   320: if (system('/usr/sbin/usermod','-G',$gl,'www')) {
1.18      raeburn   321:     print(&mt('Error.').' '.&mt('Could not make www a member of the group "[_1]".',
                    322:               $username)."\n");
                    323:     exit;
1.11      raeburn   324: }
                    325: 
                    326: # Check if home directory exists for user
                    327: # If not, create one.
                    328: if (!-e "/home/$username") {
                    329:     if (!mkdir("/home/$username",0710)) {
1.18      raeburn   330:         print(&mt('Error.').' '.&mt('Could not add home directory for "[_1]".',
                    331:                   $username)."\n");
                    332:         exit;
1.11      raeburn   333:     }
                    334: }
1.1       harris41  335: 
1.11      raeburn   336: if (-d "/home/$username") {
                    337:     system('/bin/chown',"$username:$username","/home/$username");
                    338:     system('/bin/chmod','-R','0660',"/home/$username");
                    339:     system('/bin/chmod','0710',"/home/$username");
                    340: }
1.1       harris41  341: =pod
                    342: 
                    343: =item 3 (as root). enter in a password
                    344: 
                    345:  Command: [prompt %] passwd USERNAME
                    346:           New UNIX password: PASSWORD
                    347:           Retype new UNIX passwd: PASSWORD
                    348:  Example: [prompt %] passwd dc103
                    349:           New UNIX password: sesame
                    350:           Retype new UNIX passwd: sesame
                    351: 
                    352: =cut
                    353: 
1.7       harris41  354: # Process password (taint-check, then pass to the UNIX passwd command).
                    355: $username =~ s/\W//g; # an extra filter, just to be sure
1.20      raeburn   356: my $pbad = 0;
1.1       harris41  357: foreach (split(//,$passwd)) {if ((ord($_)<32)||(ord($_)>126)){$pbad=1;}}
                    358: if ($pbad) {
1.18      raeburn   359:     print(&mt('Password must consist of standard ASCII characters.').
                    360:           "\n");
1.1       harris41  361: }
1.16      raeburn   362:  
                    363: my $distro;
                    364: if (open(PIPE,"perl distprobe|")) {
                    365:     $distro = <PIPE>;
                    366:     close(PIPE);
                    367: }
                    368: if ($distro =~ /^ubuntu|debian/) {
                    369:     open(OUT,"|usermod -p `mkpasswd $passwd` $username");
                    370:     close(OUT);
                    371: } else {
                    372:     open(OUT,"|passwd --stdin $username");
                    373:     print(OUT $passwd."\n");
                    374:     close(OUT);
                    375: }
1.1       harris41  376: 
                    377: =pod
                    378: 
                    379: =cut
                    380: 
                    381: =pod
                    382: 
                    383: =item 4. login as user=www
                    384: 
                    385:  Command: [prompt %] su www
                    386:  Password: WWWPASSWORD
                    387: 
                    388: =item 5. (as www). cd /home/httpd/lonUsers
                    389: 
                    390: =item 6. (as www) Create user directory for your new user.
                    391: 
                    392:  Let U equal first letter of USERNAME
                    393:  Let S equal second letter of USERNAME
                    394:  Let E equal third letter of USERNAME
                    395:  Command: [prompt %] install -d DOMAIN/U/S/E/USERNAME
1.7       harris41  396: 
                    397:  Here are three examples of the commands that would be needed
                    398:  for different domain coordinator names (dc103, morphy, or ng):
                    399: 
                    400:  Example #1 (dc103):  [prompt %] install -d 103/d/c/1/dc103
                    401:  Example #2 (morphy): [prompt %] install -d 103/m/o/r/morphy
                    402:  Example #3 (ng):     [prompt %] install -d 103/n/g/_/ng
1.1       harris41  403: 
                    404: =cut
                    405: 
1.7       harris41  406: # Generate the user directory.
                    407: `install -o www -g www -d $udpath`; # Must be writeable by httpd process.
1.1       harris41  408: 
                    409: =pod
                    410: 
                    411: =item 7. (as www) Enter the newly created user directory.
                    412: 
                    413:  Command: [prompt %] cd DOMAIN/U/S/E/USERNAME
                    414:  Example: [prompt %] cd 103/d/c/1/dc103
                    415: 
                    416: =item 8. (as www). Set your password mechanism to 'unix' 
                    417: 
                    418:  Command: [prompt %] echo "unix:" > passwd
                    419: 
                    420: =cut
                    421: 
1.7       harris41  422: # UNIX (/etc/passwd) style authentication is asserted for domain coordinators.
                    423: open(OUT, ">$udpath/passwd");
                    424: print(OUT 'unix:'."\n");
                    425: close(OUT);
1.15      www       426: 
                    427: # Get permissions correct on udpath
                    428: 
1.18      raeburn   429:  print(&mt('Setting permissions on user data directories.').' '.
                    430:        &mt('This may take a moment, please be patient ...')."\n");
1.15      www       431: `chown -R www:www /home/httpd/lonUsers/$domain` ; # Must be writeable by httpd process.
1.1       harris41  432: 
                    433: =pod
                    434: 
                    435: =item 9. (as www). Run CVS:loncapa/doc/rolesmanip.pl:
                    436: 
                    437:  Command: [prompt %] perl rolesmanip.pl DOMAIN USERNAME
                    438:  Example: [prompt %] perl rolesmanip.pl 103 dc103
                    439: 
                    440: =cut
                    441: 
1.7       harris41  442: use GDBM_File; # A simplistic key-value pairing database.
1.1       harris41  443: 
1.10      albertel  444: my $rolesref=&LONCAPA::locking_hash_tie("$udpath/roles.db",&GDBM_WRCREAT());
                    445: if (!$rolesref) {
1.18      raeburn   446:     print(&mt('Error').' '.
1.24    ! raeburn   447:           &mt('unable to tie roles db: [_1].',"$udpath/roles.db")."\n");
1.18      raeburn   448:     exit;
1.10      albertel  449: }
1.13      raeburn   450: my $now = time;
                    451: $rolesref->{'/'.$domain.'/_dc'}='dc_0_'.$now; # Set the domain coordinator role.
1.7       harris41  452: open(OUT, ">$udpath/roles.hist"); # roles.hist is the synchronous plain text.
1.10      albertel  453: foreach my $key (keys(%{$rolesref})) {
                    454:     print(OUT $key.' : '.$rolesref->{$key}."\n");
                    455: }
1.7       harris41  456: close(OUT);
1.10      albertel  457: &LONCAPA::locking_hash_untie($rolesref);
                    458: 
1.1       harris41  459: 
1.7       harris41  460: `chown www:www $udpath/roles.hist`; # Must be writeable by httpd process.
                    461: `chown www:www $udpath/roles.db`; # Must be writeable by httpd process.
1.1       harris41  462: 
1.13      raeburn   463: my %perlvar = %{&LONCAPA::Configuration::read_conf('loncapa.conf')};
                    464: my $dompath = $perlvar{'lonUsersDir'}.'/'.$domain;
                    465: my $domrolesref = &LONCAPA::locking_hash_tie("$dompath/nohist_domainroles.db",&GDBM_WRCREAT());
                    466: 
                    467: if (!$domrolesref) {
1.18      raeburn   468:     print(&mt('Error').' '.&mt('unable to tie nohist_domainroles db: [_1].',
                    469:                                "$dompath/nohist_domainroles.db")."\n");
1.13      raeburn   470: }
                    471: 
                    472: # Store in nohist_domainroles.db
                    473: my $domkey=&LONCAPA::escape('dc:'.$username.':'.$domain.'::'.$domain.':');
                    474: $domrolesref->{$domkey}= &LONCAPA::escape('0:'.$now);
                    475: &LONCAPA::locking_hash_untie($domrolesref);
                    476: 
1.14      raeburn   477:  system('/bin/chown',"www:www","$dompath/nohist_domainroles.db"); # Must be writeable by httpd process.
                    478:  system('/bin/chown',"www:www","$dompath/nohist_domainroles.db.lock");
                    479: 
1.22      raeburn   480: # Log with domainconfiguser in nohist_rolelog.db
                    481: my $domconfiguser = $domain.'-domainconfig';
                    482: my $subdir = $domconfiguser;
                    483: $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;
1.23      raeburn   484: $subdir .= "/$domconfiguser";
1.22      raeburn   485: 
1.23      raeburn   486: if (-d "$dompath/$subdir") {
                    487:     my $rolelogref = &LONCAPA::locking_hash_tie("$dompath/$subdir/nohist_rolelog.db",&GDBM_WRCREAT());
                    488:     my $domlogkey = &LONCAPA::escape($now.'00000'.$$.'000000'); 
                    489:     my $storehash = {
                    490:                        role    => 'dc',
                    491:                        start   => $now,
                    492:                        end     => 0,
                    493:                        context => 'server',
                    494:                     };
                    495:     my $domlogvalue = {
                    496:                         'exe_uname' => '',
                    497:                         'exe_udom'  => $domain,
                    498:                         'exe_time'  => $now,
                    499:                         'exe_ip'    => '127.0.0.1',
                    500:                         'delflag'   => '',
                    501:                         'logentry'  => $storehash,
                    502:                         'uname'     => $username,
                    503:                         'udom'      => $domain,
                    504:                      };
                    505:     $rolelogref->{$domlogkey}=&freeze_escape($domlogvalue);
                    506:     &LONCAPA::locking_hash_untie($rolelogref);
1.22      raeburn   507: 
1.23      raeburn   508:     system('/bin/chown',"www:www","$dompath/$subdir/nohist_rolelog.db"); # Must be writeable by httpd process.
                    509:     system('/bin/chown',"www:www","$dompath/$subdir/nohist_rolelog.db.lock");
                    510: } else {
                    511:     print(&mt('Failed to log role creation as the path to the directory: "[_1]" does not exist.',"$dompath/$subdir/")."\n".
                    512:           &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).'));
                    513: }
1.22      raeburn   514: 
1.13      raeburn   515: #Update allusers MySQL table
                    516: 
1.18      raeburn   517: print(&mt('Adding new user to allusers table.')."\n");
1.13      raeburn   518: &allusers_update($username,$domain,\%perlvar);
                    519: 
1.1       harris41  520: =pod
                    521: 
                    522: =item 10.
                    523: 
                    524: You may further define the domain coordinator user (i.e. dc103)
                    525: by going to http://MACHINENAME/adm/createuser.
                    526: 
                    527: =cut
                    528: 
1.7       harris41  529: # Output success message, and inform sysadmin about how to further proceed.
1.18      raeburn   530: print("\n".&mt('[_1] is now a domain coordinator',$username)."\n"); # Output success message.
1.7       harris41  531: my $hostname=`hostname`; chomp($hostname); # Read in hostname.
1.18      raeburn   532: print("\n".
                    533:       &mt('Once LON-CAPA is running, you should log-in and use: [_1] to further define this user.',
                    534:           "\nhttp://$hostname/adm/createuser\n")."\n\n".
                    535:       &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"); 
1.13      raeburn   536: # Output a suggested URL.
                    537: 
                    538: sub allusers_update {
                    539:     my ($username,$domain,$perlvar) = @_;
                    540:     my %tablenames = (
                    541:                        'allusers'   => 'allusers',
                    542:                      );
                    543:     my $dbh;
                    544:     unless ($dbh = DBI->connect("DBI:mysql:loncapa","www",
                    545:                             $perlvar->{'lonSqlAccess'},
                    546:                             { RaiseError =>0,PrintError=>0})) {
1.18      raeburn   547:         print(&mt('Cannot connect to database!')."\n");
1.13      raeburn   548:         return;
                    549:     }
                    550:     my $tablechk = &allusers_table_exists($dbh);
                    551:     if ($tablechk == 0) {
                    552:         my $request =
                    553:    &LONCAPA::lonmetadata::create_metadata_storage('allusers','allusers');
                    554:         $dbh->do($request);
                    555:         if ($dbh->err) {
1.18      raeburn   556:              print(&mt('Failed to create [_1] table.','allusers')."\n");
1.13      raeburn   557:              return;
                    558:         }
                    559:     }
                    560:     my %userdata =  (
                    561:                 username => $username,
                    562:                 domain   => $domain,
                    563:     );
                    564:     my %loghash =
                    565:         &LONCAPA::lonmetadata::process_allusers_data($dbh,undef,
                    566:             \%tablenames,$username,$domain,\%userdata,'update');
                    567:     foreach my $key (keys(%loghash)) {
                    568:         print $loghash{$key}."\n";
                    569:     }
                    570:     return;
                    571: }
                    572: 
                    573: sub allusers_table_exists {
                    574:     my ($dbh) = @_;
                    575:     my $sth=$dbh->prepare('SHOW TABLES');
                    576:     $sth->execute();
                    577:     my $aref = $sth->fetchall_arrayref;
                    578:     $sth->finish();
                    579:     if ($sth->err()) {
                    580:         return undef;
                    581:     }
                    582:     my $result = 0;
                    583:     foreach my $table (@{$aref}) {
                    584:         if ($table->[0] eq 'allusers') {
                    585:             $result = 1;
                    586:             last;
                    587:         }
                    588:     }
                    589:     return $result;
                    590: }
1.1       harris41  591: 
1.18      raeburn   592: sub get_password {
                    593:     my ($prompt) = @_;
                    594:     local $| = 1;
                    595:     print $prompt.': ';
                    596:     my $newpasswd = '';
                    597:     ReadMode 'raw';
                    598:     my $key;
                    599:     while(ord($key = ReadKey(0)) != 10) {
                    600:         if(ord($key) == 127 || ord($key) == 8) {
                    601:             chop($newpasswd);
                    602:             print "\b \b";
                    603:         } elsif(!ord($key) < 32) {
                    604:             $newpasswd .= $key;
                    605:             print '*';
                    606:         }
                    607:     }
                    608:     ReadMode 'normal';
                    609:     print "\n";
                    610:     return $newpasswd;
                    611: }
                    612: 
1.22      raeburn   613: sub freeze_escape {
                    614:     my ($value)=@_;
                    615:     if (ref($value)) {
                    616:         $value=&nfreeze($value);
                    617:         return '__FROZEN__'.&LONCAPA::escape($value);
                    618:     }
                    619:     return &LONCAPA::escape($value);
                    620: }
                    621: 
1.1       harris41  622: =pod
                    623: 
1.2       harris41  624: =head1 AUTHOR
1.1       harris41  625: 
1.7       harris41  626: Written to help the LON-CAPA project.
1.1       harris41  627: 
                    628: =cut
1.13      raeburn   629: 

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