#!/usr/bin/perl
# The LearningOnline Network with CAPA
# Generate Demo Users on Demo Server
#
# Only works on a library server!!!
# Has to be the only library server in the domain!!!
# Should not be used on a real production server.
use strict;
my $demodomain='msudemo';
my $demohome='msudemol1';
my $admemail='lon-capa@lon-capa.org';
my $demoserver='demo.lon-capa.org';
my %perlvar=();
my %form=();
my %democourses=();
my $courses;
my %hostname=();
my %hostdom=();
my %domaindescription=();
my %libserv=();
my %hostip=();
my %formfields=('afirst' => 'First Name',
'blast' => 'Last Name',
'ctitle' => 'Title',
'dinst' => 'Company/School',
'eaddr' => 'Street Address',
'fcity' => 'City, State, ZIP',
'gemail' => 'EMail Address',
'huser' => 'Desired Username',
'icomm' => 'Area of Interest/Comments');
use lib '/home/httpd/lib/perl/';
use LONCAPA::Configuration;
use IO::File;
use IO::Socket;
# ------------------------------------------------------------- Declutters URLs
sub declutter {
my $thisfn=shift;
$thisfn=~s/^$perlvar{'lonDocRoot'}//;
$thisfn=~s/^\///;
$thisfn=~s/^res\///;
$thisfn=~s/\?.+$//;
return $thisfn;
}
# -------------------------------------------------------- Escape Special Chars
sub escape {
my $str=shift;
$str =~ s/(\W)/"%".unpack('H2',$1)/eg;
return $str;
}
# ----------------------------------------------------- Un-Escape Special Chars
sub unescape {
my $str=shift;
$str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
return $str;
}
# ------------------------------------------------------------------- Log stuff
sub logthis {
my $message=shift;
my $execdir=$perlvar{'lonDaemons'};
my $now=time;
my $local=localtime($now);
open(FH,">>$execdir/logs/demo.log");
print FH "$local ($$): $message\n";
close(FH);
return 1;
}
# -------------------------------------------------- Non-critical communication
sub reply {
my ($cmd,$server)=@_;
my $peerfile="$perlvar{'lonSockDir'}/$server";
my $client=IO::Socket::UNIX->new(Peer =>"$peerfile",
Type => SOCK_STREAM,
Timeout => 10)
or return "con_lost";
print $client "$cmd\n";
my $answer=<$client>;
chomp($answer);
if (!$answer) { $answer="con_lost"; }
return $answer;
}
sub put {
my ($namespace,$storehash,$udomain,$uname)=@_;
my $uhome=&homeserver($uname,$udomain);
my $items='';
foreach (keys %$storehash) {
$items.=&escape($_).'='.&escape($$storehash{$_}).'&';
}
$items=~s/\&$//;
return &reply("put:$udomain:$uname:$namespace:$items",$uhome);
}
# ------------- Modified routines from lonnet to make a new student in a course
# ---------------------- Find the homebase for a user from domain's lib servers
sub homeserver {
my ($uname,$udom)=@_;
my $index="$uname:$udom";
my $tryserver;
foreach $tryserver (keys %libserv) {
if ($hostdom{$tryserver} eq $udom) {
my $answer=reply("home:$udom:$uname",$tryserver);
if ($answer eq 'found') {
return $tryserver;
}
}
}
return 'no_host';
}
# ----------------------------------------------------------------- Assign Role
sub assignrole {
my ($uname,$url,$role,$end,$start)=@_;
my $command="encrypt:rolesput:$demodomain:auto:".
"$demodomain:$uname:$url".'_'."$role=$role";
if ($end) { $command.='_'.$end; }
if ($start) {
if ($end) {
$command.='_'.$start;
} else {
$command.='_0_'.$start;
}
}
return &reply($command,$demohome);
}
# --------------------------------------------------------------- Modify a user
sub modifyuser {
my ($uname, $upass, $first, $last)=@_;
my $udom=$demodomain;
my $desiredhome=$demohome;
my $middle='';
my $gene='';
my $umode='internal';
$udom=~s/\W//g;
$uname=~s/\W//g;
&logthis('Call to modify user '.$udom.', '.$uname.', '.
$umode.', '.$first.', '.
$last.', '.$desiredhome);
my $uhome=$demohome;
# ----------------------------------------------------------------- Create User
if (($umode) && ($upass)) {
my $unhome=$desiredhome;
if (($unhome eq '') || ($unhome eq 'no_host')) {
return 'error: unable to find a home server for '.$uname.
' in domain '.$udom;
}
my $reply=&reply('encrypt:makeuser:'.$udom.':'.$uname.':'.$umode.':'.
&escape($upass),$unhome);
unless ($reply eq 'ok') {
return 'error makeuser '.$udom.' '.$unhome.': '.$reply;
}
$uhome=&homeserver($uname,$udom,'true');
if (($uhome eq '') || ($uhome eq 'no_host') || ($uhome ne $unhome)) {
return 'error: verify home';
}
} # End of creation of new user
# -------------------------------------------------------------- Add names, etc
my %names;
if ($first) { $names{'firstname'} = $first; }
if ($last) { $names{'lastname'} = $last; }
my $reply = &put('environment', \%names, $udom,$uname);
if ($reply ne 'ok') { return 'error: '.$reply; }
&logthis('Success modifying user '.$udom.', '.$uname.', '.
$umode.', '.$first.', '.
$last);
return 'ok';
}
# -------------------------------------------------------------- Modify student
sub modifystudent {
my ($uname,$upass,$first,$last,$cnum,$cdom,$chome)=@_;
my $udom=$demodomain;
my $start=time;
my $end=$start+60*60*24*100;
# --------------------------------------------------------------- Make the user
my $reply=&modifyuser($uname,$upass,$first,$last);
unless ($reply eq 'ok') { return $reply; }
# -------------------------------------------------- Add student to course list
$reply=reply('put:'.$cdom.':'.$cnum.':classlist:'.
&escape($uname.':'.$udom).'='.
&escape($end.':'.$start),
$chome);
unless (($reply eq 'ok') || ($reply eq 'delayed')) {
return "error course list ".$reply;
}
# ---------------------------------------------------- Add student role to user
my $uurl='/'.$cdom.'_'.$cnum;
$uurl=~s/\_/\//g;
return &assignrole($uname,$uurl,'st',$end,$start);
}
sub enroll {
my ($uname,$upass,$first,$last)=@_;
&logthis("Going to enroll $uname for $courses");
my $returnval='';
foreach (split(/\&/,$courses)) {
my ($cdom,$chome,$cid)=split(/\:/,$democourses{$_});
if ($cid) {
$returnval.=
&modifystudent
($uname,$upass,$first,$last,$cid,$cdom,$chome)."
\n";
}
}
return $returnval;
}
# ------------------------------------------------------------- Make a password
sub genpass {
srand($$);
my @chars=('A'..'Z','a'..'z',0..9);
return join('',@chars[map{ rand @chars } (1..8)]);
}
sub inputline {
my ($name,$output)=@_;
print "\n
$error"; &makeform(); } else { my $upass=&genpass(); my $result=&enroll($form{'huser'},$upass,$form{'afirst'},$form{'blast'}); if ($result=~/error/) { &logthis($result); print &errorwrap('Sorry, demo functionality currently not available'); } else { print "Your access information will be emailed to ".$form{'gemail'}; &sendemail($upass); } } # ------------------------------------------------------------------------- End print('
'.&footer()."\n"); 1;