Return to make_test_user.pl CVS log

Up to [LON-CAPA] / loncom / build / weblayer_test

best wishes to all.

    1: #!/usr/bin/perl
    2: 
    3: =pod
    4: 
    5: =head1 NAME
    6: 
    7: make_test_user.pl - Make a test user on a LON-CAPA system to help with automated testing of the web interface
    8: 
    9: =cut
   10: 
   11: # The LearningOnline Network
   12: # make_test_user.pl - Make a test user on the LON-CAPA system
   13: #
   14: # $Id: make_test_user.pl,v 1.2 2003/02/03 18:03:52 harris41 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: # YEAR=2002
   37: #
   38: ###
   39: 
   40: =pod
   41: 
   42: =head1 DESCRIPTION
   43: 
   44: Automates the steps for creating a test user.  This
   45: program also describes a manual procedure (see below).
   46: 
   47: These are the steps that are executed on the linux operating system:
   48: 
   49: =over 4
   50: 
   51: =item * 
   52: 
   53: Tests to see if user already exists for LON-CAPA, if so,
   54: then erase user (to start cleanly).
   55: 
   56: =item *
   57: 
   58: Creates a linux system user
   59: 
   60: =item *
   61: 
   62: Sets password
   63: 
   64: =item *
   65: 
   66: Creates a LON-CAPA lonUsers directory for user
   67: 
   68: =item *
   69: 
   70: Sets LON-CAPA password mechanism to be "crypt"
   71: 
   72: =item *
   73: 
   74: Set roles.hist and roles.db
   75: 
   76: =back
   77: 
   78: =cut
   79: 
   80: print "Making test user ZXQTEST...\n";
   81: 
   82: # ------------------------------------------------------------------ Am I root?
   83: unless ($< == 0) {
   84:     print "**** ERROR **** You need to run this test as 'root'.\n";
   85:     exit 1;
   86: }
   87: 
   88: # ---------------------------------------------------- Configure general values
   89: 
   90: my %perlvar;
   91: $perlvar{'lonUsersDir'}='/home/httpd/lonUsers';
   92: 
   93: =pod
   94: 
   95: =head1 OPTIONS
   96: 
   97: There are no flags to this script.
   98: 
   99: usage: make_test_user.pl [NAME_EXT] [DOMAIN] 
  100: 
  101: The password is accepted through standard input.
  102: 
  103: The first argument specifies
  104: what string to append to "ZXQTEST".
  105: It should consist of only alphanumeric characters.
  106: 
  107: The second argument specifies the password for the test user
  108: coordinator and should only consist of printable ASCII
  109: characters and be a string of length greater than 5 characters.
  110: 
  111: =cut
  112: 
  113: # ----------------------------------------------- So, are we invoked correctly?
  114: # Two arguments or abort
  115: if (@ARGV!=2) {
  116:     die 'usage: make_test_user.pl [USERNAME] [DOMAIN] '."\n".
  117: 	'(and password through standard input)'."\n";
  118: }
  119: my ($username,$domain)=(@ARGV); shift @ARGV; shift @ARGV;
  120: $username='ZXQTEST'.$username;
  121: unless ($username=~/^\w+$/ and $username!~/\_/) {
  122:     die 'Username '.$username.' must consist only of alphanumeric characters'.
  123: 	"\n";
  124: }
  125: unless ($domain=~/^\w+$/ and $domain!~/\_/) {
  126:     die 'Domain '.$domain.' must consist only of alphanumeric characters'.
  127: 	"\n";
  128: }
  129: 
  130: my $passwd=<>; # read in password from standard input
  131: chomp($passwd);
  132: 
  133: if (length($passwd)<6 or length($passwd)>30) {
  134:     die 'Password is an unreasonable length.'."\n";
  135: }
  136: my $pbad=0;
  137: foreach (split(//,$passwd)) {if ((ord($_)<32)||(ord($_)>126)){$pbad=1;}}
  138: if ($pbad) {
  139:     die 'Password must consist of standard ASCII characters'."\n";
  140: }
  141: 
  142: # And does user already exist
  143: 
  144: my $udpath=propath($domain,$username);
  145: if (-d $udpath) {
  146:     print $username.' is already defined as a LON-CAPA user.'."\n";
  147:     print 'Cleaning up ...'."\n";
  148:     `rm -Rf $udpath`
  149: 	if $udpath=~/^\/home\/httpd\/lonUsers\/$domain\/Z\/X\/Q\/ZXQTEST/;
  150:     # SAFETY: must check $udpath above because we are using rm -Rf!!!
  151: }
  152: 
  153: =pod
  154: 
  155: =head1 MANUAL PROCEDURE
  156: 
  157: There are 10 steps to a manual procedure.
  158: 
  159: You need to decide on three pieces of information
  160: to create a domain coordinator.
  161: 
  162:  * USERNAME (ZXQTESTkermit, ZXQTESTalbert, ZXQTESTjoe, etc)
  163:  * DOMAIN (should be the same as lonDefDomain in /etc/httpd/conf/access.conf)
  164:  * PASSWORD (don't tell me)
  165: 
  166: The examples in these instructions will be based
  167: on three example pieces of information:
  168: 
  169:  * USERNAME=ZXQTEST
  170:  * DOMAIN=103
  171:  * PASSWORD=sesame
  172: 
  173: You will also need to know your "root" password
  174: and your "www" password.
  175: 
  176: =over 4
  177: 
  178: =item 1.
  179: 
  180: login as root on your Linux system
  181:  [prompt %] su
  182: 
  183: =cut
  184: 
  185: =item 3 (as root). enter in a password
  186: 
  187:  Command: [prompt %] passwd USERNAME
  188:           New UNIX password: PASSWORD
  189:           Retype new UNIX passwd: PASSWORD
  190:  Example: [prompt %] passwd dc103
  191:           New UNIX password: sesame
  192:           Retype new UNIX passwd: sesame
  193: 
  194: =cut
  195: 
  196: =pod
  197: 
  198: =cut
  199: 
  200: =pod
  201: 
  202: =item 4. login as user=www
  203: 
  204:  Command: [prompt %] su www
  205:  Password: WWWPASSWORD
  206: 
  207: =item 5. (as www). cd /home/httpd/lonUsers
  208: 
  209: =item 6. (as www) Create user directory for your new user.
  210: 
  211:  Let U equal first letter of USERNAME
  212:  Let S equal second letter of USERNAME
  213:  Let E equal third letter of USERNAME
  214:  Command: [prompt %] install -d DOMAIN/U/S/E/USERNAME
  215:  Example: [prompt %] install -d 103/Z/X/Q/ZXQTEST
  216: 
  217: =cut
  218: 
  219: `install -o www -g www -d $udpath`;
  220: 
  221: =pod
  222: 
  223: =item 7. (as www) Enter the newly created user directory.
  224: 
  225:  Command: [prompt %] cd DOMAIN/U/S/E/USERNAME
  226:  Example: [prompt %] cd 103/Z/X/Q/ZXQTEST
  227: 
  228: =item 8. (as www). Set your password mechanism to 'internal' 
  229: 
  230:  Command: [prompt %] echo "internal:$epasswd" > passwd
  231: 
  232: To determine the value of $epasswd, you should look at the
  233: internals of this perl script, make_test_user.pl.
  234: 
  235: =cut
  236: 
  237: my $salt=time;
  238: $salt=substr($salt,6,2);
  239: my $epasswd=crypt($passwd,$salt);
  240: open OUT, ">$udpath/passwd";
  241: print OUT 'internal:'."$epasswd\n";
  242: close OUT;
  243: `chown www:www $udpath/passwd`;
  244: 
  245: =pod
  246: 
  247: =item 9. (as www). Make user to be an author:
  248: 
  249: This will involve manual modification of roles.hist and roles.db.
  250: Please refer to the internals of the make_test_user.pl perl
  251: script.
  252: 
  253: =cut
  254: 
  255: use GDBM_File;
  256: my %hash;
  257:         tie(%hash,'GDBM_File',"$udpath/roles.db",
  258: 	    &GDBM_WRCREAT,0640);
  259: 
  260: $hash{'/'.$domain.'/_au'}='au_0_'.time;
  261: open OUT, ">$udpath/roles.hist";
  262: map {
  263:     print OUT $_.' : '.$hash{$_}."\n";
  264: } keys %hash;
  265: close OUT;
  266: 
  267: untie %hash;
  268: `chown www:www $udpath/roles.hist`;
  269: `chown www:www $udpath/roles.db`;
  270: 
  271: print "$username is now a test user (author)\n";
  272: my $hostname=`hostname`; chomp $hostname;
  273: 
  274: # ----------------------------------------------------------------- SUBROUTINES
  275: sub propath {
  276:     my ($udom,$uname)=@_;
  277:     $udom=~s/\W//g;
  278:     $uname=~s/\W//g;
  279:     my $subdir=$uname.'__';
  280:     $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;
  281:     my $proname="$perlvar{'lonUsersDir'}/$udom/$subdir/$uname";
  282:     return $proname;
  283: }
  284: 
  285: =pod
  286: 
  287: =head1 PREREQUISITES
  288: 
  289: GDBM_File
  290: 
  291: =head1 AUTHOR
  292: 
  293: 
  294: =cut