Return to make_test_user.pl CVS log

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

creates a test user with a username beginning with ZXQTEST
(followed by host and process specific strings)...
user is an author

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