Annotation of loncom/build/weblayer_test/make_test_user.pl, revision 1.1
1.1 ! harris41 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$
! 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
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>