File:  [LON-CAPA] / loncom / build / make_domain_coordinator.pl
Revision 1.27: download - view: text, annotated - select for diffs
Sat Jan 3 02:45:22 2015 UTC (9 years, 3 months ago) by raeburn
Branches: MAIN
CVS tags: version_2_11_2_uiuc, version_2_11_2_msu, version_2_11_2_educog, version_2_11_2, version_2_11_1, HEAD
- Support SLES12.

    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.27 2015/01/03 02:45: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 Storable qw(nfreeze);
  100: use strict;
  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: 
  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.
  113: 
  114: The first argument
  115: specifies the user name of the domain coordinator and
  116: should consist of only alphanumeric characters.
  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.
  121: 
  122: The second argument specifies the domain of the computer
  123: coordinator.
  124: 
  125: =cut
  126: 
  127: my $lang = &Apache::lonlocal::choose_language();
  128: &Apache::lonlocal::get_language_handle(undef,$lang);
  129: print"\n";
  130: 
  131: # ----------------------------------------------- So, are we invoked correctly?
  132: # Two arguments or abort
  133: if (@ARGV!=2) {
  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;
  139: }
  140: my ($username,$domain)=(@ARGV);
  141: if ($username=~/$LONCAPA::not_username_re/) {
  142:     print(&mt('**** ERROR **** Username [_1] must consist only of - . and alphanumeric characters.',$username)."\n");
  143:     exit;
  144: }
  145: if ($domain=~/$LONCAPA::not_domain_re/) {
  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;
  156: }
  157: 
  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;
  164: }
  165: 
  166: if (-d "/home/$username") {
  167:     $is_user = 1;
  168: }
  169: 
  170: if ($is_user) {
  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: }
  180: 
  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");
  184: 
  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: 
  195: my ($got_passwd,$firstpass,$secondpass,$passwd);
  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".
  203:               &mt('Please try again.')."\n");
  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".
  207:               &mt('Please try again.')."\n");
  208:     } else {
  209:         my $pbad=0;
  210:         foreach (split(//,$firstpass)) {if ((ord($_)<32)||(ord($_)>126)){$pbad=1;}}
  211:         if ($pbad) {
  212:             print(&mt('Password contains invalid characters.')."\n".
  213:                   &mt('Password must consist of standard ASCII characters.')."\n".
  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:     }
  227: }
  228: if (!$got_passwd) {
  229:     exit;
  230: }
  231: print "\n";
  232: 
  233: =pod
  234: 
  235: =head1 MANUAL PROCEDURE
  236: 
  237: There are 10 steps to manually recreating what this script performs
  238: automatically.
  239: 
  240: You need to decide on three pieces of information
  241: to create a domain coordinator.
  242: 
  243:  * USERNAME (kermit, albert, joe, etc)
  244:  * DOMAIN (should be the same as lonDefDomain in /etc/httpd/conf/loncapa.conf)
  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: 
  268: if ($< != 0) { # Am I root?
  269:    print(&mt('You must be root in order to generate a domain coordinator.').
  270:          "\n");
  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: 
  282: # ----------------------------------------------------------- /usr/sbin/groupadd
  283: # -- Add group
  284: $username=~s/\W//g; # an extra filter, just to be sure
  285: 
  286: print(&mt('adding group: [_1]',$username)."\n");
  287: my $status = system('/usr/sbin/groupadd', $username);
  288: if ($status) {
  289:     print(&mt('Error.').' '.
  290:           &mt('Something went wrong with the addition of group "[_1]".',
  291:               $username)."\n");
  292:     exit;
  293: }
  294: my $gid = getgrnam($username);
  295: 
  296: # ----------------------------------------------------------- /usr/sbin/useradd
  297: # -- Add user
  298: 
  299: print(&mt('adding user: [_1]',$username)."\n");
  300: my $status = system('/usr/sbin/useradd','-c','LON-CAPA user','-g',$gid,$username);
  301: if ($status) {
  302:     system("/usr/sbin/groupdel $username");
  303:     print(&mt('Error.').' '.
  304:           &mt('Something went wrong with the addition of user "[_1]".',
  305:               $username)."\n");
  306:     exit;
  307: }
  308: 
  309: print(&mt('Done adding user.')."\n");
  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));
  319: print(&mt("Putting www in user's group.")."\n");
  320: if (system('/usr/sbin/usermod','-G',$gl,'www')) {
  321:     print(&mt('Error.').' '.&mt('Could not make www a member of the group "[_1]".',
  322:               $username)."\n");
  323:     exit;
  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)) {
  330:         print(&mt('Error.').' '.&mt('Could not add home directory for "[_1]".',
  331:                   $username)."\n");
  332:         exit;
  333:     }
  334: }
  335: 
  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: }
  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: 
  354: # Process password (taint-check, then pass to the UNIX passwd command).
  355: $username =~ s/\W//g; # an extra filter, just to be sure
  356: my $pbad = 0;
  357: foreach (split(//,$passwd)) {if ((ord($_)<32)||(ord($_)>126)){$pbad=1;}}
  358: if ($pbad) {
  359:     print(&mt('Password must consist of standard ASCII characters.').
  360:           "\n");
  361: }
  362:  
  363: my ($distro,$nostdin);
  364: if (open(PIPE,"perl distprobe|")) {
  365:     $distro = <PIPE>;
  366:     close(PIPE);
  367: }
  368: if ($distro =~ /^ubuntu|debian/) {
  369:     $nostdin = 1;
  370: } elsif ($distro =~ /^suse([\d.]+)$/) {
  371:     if ($1 > 12.2) {
  372:         $nostdin = 1;
  373:     }
  374: } elsif ($distro =~ /^sles(\d+)$/) {
  375:     if ($1 > 11) {
  376:         $nostdin = 1;
  377:     }
  378: }
  379: if ($nostdin) {
  380:     open(OUT,"|usermod -p `mkpasswd $passwd` $username");
  381:     close(OUT);
  382: } else {
  383:     open(OUT,"|passwd --stdin $username");
  384:     print(OUT $passwd."\n");
  385:     close(OUT);
  386: }
  387: 
  388: =pod
  389: 
  390: =cut
  391: 
  392: =pod
  393: 
  394: =item 4. login as user=www
  395: 
  396:  Command: [prompt %] su www
  397:  Password: WWWPASSWORD
  398: 
  399: =item 5. (as www). cd /home/httpd/lonUsers
  400: 
  401: =item 6. (as www) Create user directory for your new user.
  402: 
  403:  Let U equal first letter of USERNAME
  404:  Let S equal second letter of USERNAME
  405:  Let E equal third letter of USERNAME
  406:  Command: [prompt %] install -d DOMAIN/U/S/E/USERNAME
  407: 
  408:  Here are three examples of the commands that would be needed
  409:  for different domain coordinator names (dc103, morphy, or ng):
  410: 
  411:  Example #1 (dc103):  [prompt %] install -d 103/d/c/1/dc103
  412:  Example #2 (morphy): [prompt %] install -d 103/m/o/r/morphy
  413:  Example #3 (ng):     [prompt %] install -d 103/n/g/_/ng
  414: 
  415: =cut
  416: 
  417: # Generate the user directory.
  418: `install -o www -g www -d $udpath`; # Must be writeable by httpd process.
  419: 
  420: =pod
  421: 
  422: =item 7. (as www) Enter the newly created user directory.
  423: 
  424:  Command: [prompt %] cd DOMAIN/U/S/E/USERNAME
  425:  Example: [prompt %] cd 103/d/c/1/dc103
  426: 
  427: =item 8. (as www). Set your password mechanism to 'unix' 
  428: 
  429:  Command: [prompt %] echo "unix:" > passwd
  430: 
  431: =cut
  432: 
  433: # UNIX (/etc/passwd) style authentication is asserted for domain coordinators.
  434: open(OUT, ">$udpath/passwd");
  435: print(OUT 'unix:'."\n");
  436: close(OUT);
  437: 
  438: # Get permissions correct on udpath
  439: 
  440:  print(&mt('Setting permissions on user data directories.').' '.
  441:        &mt('This may take a moment, please be patient ...')."\n");
  442: `chown -R www:www /home/httpd/lonUsers/$domain` ; # Must be writeable by httpd process.
  443: 
  444: =pod
  445: 
  446: =item 9. (as www). Run CVS:loncapa/doc/rolesmanip.pl:
  447: 
  448:  Command: [prompt %] perl rolesmanip.pl DOMAIN USERNAME
  449:  Example: [prompt %] perl rolesmanip.pl 103 dc103
  450: 
  451: =cut
  452: 
  453: use GDBM_File; # A simplistic key-value pairing database.
  454: 
  455: my $rolesref=&LONCAPA::locking_hash_tie("$udpath/roles.db",&GDBM_WRCREAT());
  456: if (!$rolesref) {
  457:     print(&mt('Error').' '.
  458:           &mt('unable to tie roles db: [_1].',"$udpath/roles.db")."\n");
  459:     exit;
  460: }
  461: my $now = time;
  462: $rolesref->{'/'.$domain.'/_dc'}='dc_0_'.$now; # Set the domain coordinator role.
  463: open(OUT, ">$udpath/roles.hist"); # roles.hist is the synchronous plain text.
  464: foreach my $key (keys(%{$rolesref})) {
  465:     print(OUT $key.' : '.$rolesref->{$key}."\n");
  466: }
  467: close(OUT);
  468: &LONCAPA::locking_hash_untie($rolesref);
  469: 
  470: 
  471: `chown www:www $udpath/roles.hist`; # Must be writeable by httpd process.
  472: `chown www:www $udpath/roles.db`; # Must be writeable by httpd process.
  473: 
  474: my %perlvar = %{&LONCAPA::Configuration::read_conf('loncapa.conf')};
  475: my $dompath = $perlvar{'lonUsersDir'}.'/'.$domain;
  476: my $domrolesref = &LONCAPA::locking_hash_tie("$dompath/nohist_domainroles.db",&GDBM_WRCREAT());
  477: 
  478: if (!$domrolesref) {
  479:     print(&mt('Error').' '.&mt('unable to tie nohist_domainroles db: [_1].',
  480:                                "$dompath/nohist_domainroles.db")."\n");
  481: }
  482: 
  483: # Store in nohist_domainroles.db
  484: my $domkey=&LONCAPA::escape('dc:'.$username.':'.$domain.'::'.$domain.':');
  485: $domrolesref->{$domkey}= &LONCAPA::escape('0:'.$now);
  486: &LONCAPA::locking_hash_untie($domrolesref);
  487: 
  488:  system('/bin/chown',"www:www","$dompath/nohist_domainroles.db"); # Must be writeable by httpd process.
  489:  system('/bin/chown',"www:www","$dompath/nohist_domainroles.db.lock");
  490: 
  491: # Log with domainconfiguser in nohist_rolelog.db
  492: my $domconfiguser = $domain.'-domainconfig';
  493: my $subdir = $domconfiguser;
  494: $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;
  495: $subdir .= "/$domconfiguser";
  496: 
  497: if (-d "$dompath/$subdir") {
  498:     my $rolelogref = &LONCAPA::locking_hash_tie("$dompath/$subdir/nohist_rolelog.db",&GDBM_WRCREAT());
  499:     my $domlogkey = &LONCAPA::escape($now.'00000'.$$.'000000'); 
  500:     my $storehash = {
  501:                        role    => 'dc',
  502:                        start   => $now,
  503:                        end     => 0,
  504:                        context => 'server',
  505:                     };
  506:     my $domlogvalue = {
  507:                         'exe_uname' => '',
  508:                         'exe_udom'  => $domain,
  509:                         'exe_time'  => $now,
  510:                         'exe_ip'    => '127.0.0.1',
  511:                         'delflag'   => '',
  512:                         'logentry'  => $storehash,
  513:                         'uname'     => $username,
  514:                         'udom'      => $domain,
  515:                      };
  516:     $rolelogref->{$domlogkey}=&freeze_escape($domlogvalue);
  517:     &LONCAPA::locking_hash_untie($rolelogref);
  518: 
  519:     system('/bin/chown',"www:www","$dompath/$subdir/nohist_rolelog.db"); # Must be writeable by httpd process.
  520:     system('/bin/chown',"www:www","$dompath/$subdir/nohist_rolelog.db.lock");
  521: } else {
  522:     print(&mt('Failed to log role creation as the path to the directory: "[_1]" does not exist.',"$dompath/$subdir/")."\n".
  523:           &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).'));
  524: }
  525: 
  526: #Update allusers MySQL table
  527: 
  528: print(&mt('Adding new user to allusers table.')."\n");
  529: &allusers_update($username,$domain,\%perlvar);
  530: 
  531: =pod
  532: 
  533: =item 10.
  534: 
  535: You may further define the domain coordinator user (i.e. dc103)
  536: by going to http://MACHINENAME/adm/createuser.
  537: 
  538: =cut
  539: 
  540: # Output success message, and inform sysadmin about how to further proceed.
  541: print("\n".&mt('[_1] is now a domain coordinator',$username)."\n"); # Output success message.
  542: my $hostname=`hostname`; chomp($hostname); # Read in hostname.
  543: print("\n".
  544:       &mt('Once LON-CAPA is running, you should log-in and use: [_1] to further define this user.',
  545:           "\nhttp://$hostname/adm/createuser\n")."\n\n".
  546:       &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"); 
  547: # Output a suggested URL.
  548: 
  549: sub allusers_update {
  550:     my ($username,$domain,$perlvar) = @_;
  551:     my %tablenames = (
  552:                        'allusers'   => 'allusers',
  553:                      );
  554:     my $dbh;
  555:     unless ($dbh = DBI->connect("DBI:mysql:loncapa","www",
  556:                             $perlvar->{'lonSqlAccess'},
  557:                             { RaiseError =>0,PrintError=>0})) {
  558:         print(&mt('Cannot connect to database!')."\n");
  559:         return;
  560:     }
  561:     my $tablechk = &allusers_table_exists($dbh);
  562:     if ($tablechk == 0) {
  563:         my $request =
  564:    &LONCAPA::lonmetadata::create_metadata_storage('allusers','allusers');
  565:         $dbh->do($request);
  566:         if ($dbh->err) {
  567:              print(&mt('Failed to create [_1] table.','allusers')."\n");
  568:              return;
  569:         }
  570:     }
  571:     my %userdata =  (
  572:                 username => $username,
  573:                 domain   => $domain,
  574:     );
  575:     my %loghash =
  576:         &LONCAPA::lonmetadata::process_allusers_data($dbh,undef,
  577:             \%tablenames,$username,$domain,\%userdata,'update');
  578:     foreach my $key (keys(%loghash)) {
  579:         print $loghash{$key}."\n";
  580:     }
  581:     return;
  582: }
  583: 
  584: sub allusers_table_exists {
  585:     my ($dbh) = @_;
  586:     my $sth=$dbh->prepare('SHOW TABLES');
  587:     $sth->execute();
  588:     my $aref = $sth->fetchall_arrayref;
  589:     $sth->finish();
  590:     if ($sth->err()) {
  591:         return undef;
  592:     }
  593:     my $result = 0;
  594:     foreach my $table (@{$aref}) {
  595:         if ($table->[0] eq 'allusers') {
  596:             $result = 1;
  597:             last;
  598:         }
  599:     }
  600:     return $result;
  601: }
  602: 
  603: sub get_password {
  604:     my ($prompt) = @_;
  605:     local $| = 1;
  606:     print $prompt.': ';
  607:     my $newpasswd = '';
  608:     ReadMode 'raw';
  609:     my $key;
  610:     while(ord($key = ReadKey(0)) != 10) {
  611:         if(ord($key) == 127 || ord($key) == 8) {
  612:             chop($newpasswd);
  613:             print "\b \b";
  614:         } elsif(!ord($key) < 32) {
  615:             $newpasswd .= $key;
  616:             print '*';
  617:         }
  618:     }
  619:     ReadMode 'normal';
  620:     print "\n";
  621:     return $newpasswd;
  622: }
  623: 
  624: sub freeze_escape {
  625:     my ($value)=@_;
  626:     if (ref($value)) {
  627:         $value=&nfreeze($value);
  628:         return '__FROZEN__'.&LONCAPA::escape($value);
  629:     }
  630:     return &LONCAPA::escape($value);
  631: }
  632: 
  633: =pod
  634: 
  635: =head1 AUTHOR
  636: 
  637: Written to help the LON-CAPA project.
  638: 
  639: =cut
  640: 

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