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

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.19    ! raeburn    14: # $Id: make_domain_coordinator.pl,v 1.18 2011/03/28 21:13:41 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.1       harris41   99: 
                    100: =pod
                    101: 
                    102: =head1 OPTIONS
                    103: 
                    104: There are no flags to this script.
                    105: 
                    106: usage: make_domain_coordinator.pl [USERNAME] [DOMAIN] 
                    107: 
1.3       harris41  108: The password is accepted through standard input
                    109: and should only consist of printable ASCII
                    110: characters and be a string of length greater than 5 characters.
1.1       harris41  111: 
                    112: The first argument
                    113: specifies the user name of the domain coordinator and
                    114: should consist of only alphanumeric characters.
1.8       harris41  115: It is recommended that the USERNAME should be institution-specific
                    116: as opposed to something like "Sammy" or "Jo".
                    117: For example, "dcmsu" or "dcumich" would be good domain coordinator
                    118: USERNAMEs for places like Mich State Univ, etc.
1.1       harris41  119: 
1.3       harris41  120: The second argument specifies the domain of the computer
1.12      albertel  121: coordinator.
1.1       harris41  122: 
                    123: =cut
                    124: 
1.18      raeburn   125: my ($username,$domain)=(@ARGV);
                    126: my $lang = &Apache::lonlocal::choose_language();
                    127: &Apache::lonlocal::get_language_handle(undef,$lang);
                    128: print"\n";
                    129: 
1.1       harris41  130: # ----------------------------------------------- So, are we invoked correctly?
                    131: # Two arguments or abort
                    132: if (@ARGV!=2) {
1.18      raeburn   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;
1.1       harris41  138: }
1.18      raeburn   139: my ($username,$domain)=(@ARGV);
1.12      albertel  140: if ($username=~/$LONCAPA::not_username_re/) {
1.18      raeburn   141:     print(&mt('**** ERROR **** Username [_1] must consist only of - . and alphanumeric characters.',$username)."\n");
                    142:     exit;
1.1       harris41  143: }
1.12      albertel  144: if ($domain=~/$LONCAPA::not_domain_re/) {
1.18      raeburn   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;
1.1       harris41  155: }
                    156: 
1.18      raeburn   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;
1.1       harris41  163: }
1.18      raeburn   164: 
                    165: if (-d "/home/$username") {
                    166:     $is_user = 1;
1.1       harris41  167: }
                    168: 
1.19    ! raeburn   169: if ($is_user) {
1.18      raeburn   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: }
1.1       harris41  179: 
1.18      raeburn   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");
1.7       harris41  183: 
1.18      raeburn   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);
                    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: i             &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: i             &mt('Please try again.')."\n");
                    207:     } else {
                    208:         my $pbad=0;
                    209:         foreach (split(//,$passwd)) {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:     }
1.1       harris41  226: }
1.18      raeburn   227: if (!$got_passwd) {
                    228:     exit;
1.1       harris41  229: }
1.18      raeburn   230: print "\n";
1.1       harris41  231: 
                    232: =pod
                    233: 
                    234: =head1 MANUAL PROCEDURE
                    235: 
1.7       harris41  236: There are 10 steps to manually recreating what this script performs
                    237: automatically.
1.1       harris41  238: 
                    239: You need to decide on three pieces of information
                    240: to create a domain coordinator.
                    241: 
                    242:  * USERNAME (kermit, albert, joe, etc)
1.6       harris41  243:  * DOMAIN (should be the same as lonDefDomain in /etc/httpd/conf/loncapa.conf)
1.1       harris41  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: 
1.7       harris41  267: if ($< != 0) { # Am I root?
1.18      raeburn   268:    print(&mt('You must be root in order to generate a domain coordinator.').
                    269:          "\n");
1.1       harris41  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: 
1.11      raeburn   281: # ----------------------------------------------------------- /usr/sbin/groupadd
                    282: # -- Add group
                    283: $username=~s/\W//g; # an extra filter, just to be sure
                    284: 
1.18      raeburn   285: print(&mt('adding group: [_1]',$username)."\n");
1.11      raeburn   286: my $status = system('/usr/sbin/groupadd', $username);
                    287: if ($status) {
1.18      raeburn   288:     print(&mt('Error.').' '.
                    289:           &mt('Something went wrong with the addition of group "[_1]".',
                    290:               $username)."\n");
                    291:     exit;
1.11      raeburn   292: }
                    293: my $gid = getgrnam($username);
                    294: 
1.1       harris41  295: # ----------------------------------------------------------- /usr/sbin/useradd
1.11      raeburn   296: # -- Add user
1.1       harris41  297: 
1.18      raeburn   298: print(&mt('adding user: [_1]',$username)."\n");
1.11      raeburn   299: my $status = system('/usr/sbin/useradd','-c','LON-CAPA user','-g',$gid,$username);
                    300: if ($status) {
                    301:     system("/usr/sbin/groupdel $username");
1.18      raeburn   302:     print(&mt('Error.').' '.
                    303:           &mt('Something went wrong with the addition of user "[_1]".',
                    304:               $username)."\n");
                    305:     exit;
1.11      raeburn   306: }
                    307: 
1.18      raeburn   308: print(&mt('Done adding user.')."\n");
1.11      raeburn   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));
1.18      raeburn   318: print(&mt("Putting www in user's group.")."\n");
1.11      raeburn   319: if (system('/usr/sbin/usermod','-G',$gl,'www')) {
1.18      raeburn   320:     print(&mt('Error.').' '.&mt('Could not make www a member of the group "[_1]".',
                    321:               $username)."\n");
                    322:     exit;
1.11      raeburn   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)) {
1.18      raeburn   329:         print(&mt('Error.').' '.&mt('Could not add home directory for "[_1]".',
                    330:                   $username)."\n");
                    331:         exit;
1.11      raeburn   332:     }
                    333: }
1.1       harris41  334: 
1.11      raeburn   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: }
1.1       harris41  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: 
1.7       harris41  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: $pbad = 0;
1.1       harris41  356: foreach (split(//,$passwd)) {if ((ord($_)<32)||(ord($_)>126)){$pbad=1;}}
                    357: if ($pbad) {
1.18      raeburn   358:     print(&mt('Password must consist of standard ASCII characters.').
                    359:           "\n");
1.1       harris41  360: }
1.16      raeburn   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: }
1.1       harris41  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
1.7       harris41  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
1.1       harris41  402: 
                    403: =cut
                    404: 
1.7       harris41  405: # Generate the user directory.
                    406: `install -o www -g www -d $udpath`; # Must be writeable by httpd process.
1.1       harris41  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: 
1.7       harris41  421: # UNIX (/etc/passwd) style authentication is asserted for domain coordinators.
                    422: open(OUT, ">$udpath/passwd");
                    423: print(OUT 'unix:'."\n");
                    424: close(OUT);
1.15      www       425: 
                    426: # Get permissions correct on udpath
                    427: 
1.18      raeburn   428:  print(&mt('Setting permissions on user data directories.').' '.
                    429:        &mt('This may take a moment, please be patient ...')."\n");
1.15      www       430: `chown -R www:www /home/httpd/lonUsers/$domain` ; # Must be writeable by httpd process.
1.1       harris41  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: 
1.7       harris41  441: use GDBM_File; # A simplistic key-value pairing database.
1.1       harris41  442: 
1.10      albertel  443: my $rolesref=&LONCAPA::locking_hash_tie("$udpath/roles.db",&GDBM_WRCREAT());
                    444: if (!$rolesref) {
1.18      raeburn   445:     print(&mt('Error').' '.
                    446:           &mt('unable to tie roles db: [_1]'."$udpath/roles.db")."\n");
                    447:     exit;
1.10      albertel  448: }
1.13      raeburn   449: my $now = time;
                    450: $rolesref->{'/'.$domain.'/_dc'}='dc_0_'.$now; # Set the domain coordinator role.
1.7       harris41  451: open(OUT, ">$udpath/roles.hist"); # roles.hist is the synchronous plain text.
1.10      albertel  452: foreach my $key (keys(%{$rolesref})) {
                    453:     print(OUT $key.' : '.$rolesref->{$key}."\n");
                    454: }
1.7       harris41  455: close(OUT);
1.10      albertel  456: &LONCAPA::locking_hash_untie($rolesref);
                    457: 
1.1       harris41  458: 
1.7       harris41  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.
1.1       harris41  461: 
1.13      raeburn   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) {
1.18      raeburn   467:     print(&mt('Error').' '.&mt('unable to tie nohist_domainroles db: [_1].',
                    468:                                "$dompath/nohist_domainroles.db")."\n");
1.13      raeburn   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: 
1.14      raeburn   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: 
1.13      raeburn   479: #Update allusers MySQL table
                    480: 
1.18      raeburn   481: print(&mt('Adding new user to allusers table.')."\n");
1.13      raeburn   482: &allusers_update($username,$domain,\%perlvar);
                    483: 
1.1       harris41  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: 
1.7       harris41  493: # Output success message, and inform sysadmin about how to further proceed.
1.18      raeburn   494: print("\n".&mt('[_1] is now a domain coordinator',$username)."\n"); # Output success message.
1.7       harris41  495: my $hostname=`hostname`; chomp($hostname); # Read in hostname.
1.18      raeburn   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"); 
1.13      raeburn   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})) {
1.18      raeburn   511:         print(&mt('Cannot connect to database!')."\n");
1.13      raeburn   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) {
1.18      raeburn   520:              print(&mt('Failed to create [_1] table.','allusers')."\n");
1.13      raeburn   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: }
1.1       harris41  555: 
1.18      raeburn   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: 
1.1       harris41  577: =pod
                    578: 
1.2       harris41  579: =head1 AUTHOR
1.1       harris41  580: 
1.7       harris41  581: Written to help the LON-CAPA project.
1.1       harris41  582: 
                    583: =cut
1.13      raeburn   584: 

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