version 1.1, 2005/03/04 15:09:06
|
version 1.21, 2019/07/26 02:28:28
|
Line 2
|
Line 2
|
# |
# |
# Automated Course Creation script |
# Automated Course Creation script |
# |
# |
|
# $Id$ |
|
# |
# Copyright Michigan State University Board of Trustees |
# Copyright Michigan State University Board of Trustees |
# |
# |
# This file is part of the LearningOnline Network with CAPA (LON-CAPA). |
# This file is part of the LearningOnline Network with CAPA (LON-CAPA). |
Line 24
|
Line 26
|
# |
# |
# http://www.lon-capa.org/ |
# http://www.lon-capa.org/ |
# |
# |
# Run as www. Call this from an entry in /etc/cron.d/loncapa |
# Run as www. Called from an entry in /etc/cron.d/loncapa |
|
# either with command line args: |
# |
# |
# www /home/httpd/perl/Autocreate.pl $dom $uname:$udom |
# www /home/httpd/perl/Autocreate.pl $dom $uname:$udom |
# |
# |
# where $dom is the name of the course domain, $uname and $udom are the |
# where $dom is the name of the course domain, $uname and $udom are the |
# username and domain of a Domain Coordinator in the domain. |
# username and domain of a Domain Coordinator in the domain. |
|
# |
|
# or without args (default) controlled by domain configuration settings: |
|
# |
|
# www /home/httpd/perl/Autocreate.pl |
# |
# |
use strict; |
use strict; |
use lib '/home/httpd/lib/perl'; |
use lib '/home/httpd/lib/perl'; |
use Apache::lonnet; |
use Apache::lonnet; |
|
use Apache::lonlocal; |
|
use Apache::loncoursequeueadmin; |
use LONCAPA::batchcreatecourse; |
use LONCAPA::batchcreatecourse; |
use LONCAPA::Configuration; |
use LONCAPA::Configuration; |
|
use LONCAPA(); |
|
|
my $perlvarref = &LONCAPA::Configuration::read_conf('loncapa.conf'); |
my $perlvarref = &LONCAPA::Configuration::read_conf('loncapa.conf'); |
my $logfile = $$perlvarref{'lonDaemons'}.'/logs/autocreate.log'; |
my $logfile = $$perlvarref{'lonDaemons'}.'/logs/autocreate.log'; |
my @domains = &Apache::lonnet::current_machine_domains(); |
my @machinedoms = sort(&Apache::lonnet::current_machine_domains()); |
open (my $fh,">>$logfile"); |
my @ids=&Apache::lonnet::current_machine_ids(); |
print $fh "********************\n".localtime(time)." Autocreation messages start --\n"; |
my (@libids,@domains); |
if (@ARGV < 2) { |
foreach my $id (@ids) { |
print $fh "usage: ./Autocreate <coursedomain username:domain>.\nPlease provide the username and domain of a Domain Coordinator.\n"; |
if (&Apache::lonnet::is_library($id)) { |
exit; |
push(@libids,$id); |
} |
} |
# check if $defdom is a domain hosted on this library server. |
|
my $defdom = $ARGV[0]; |
|
my ($dcname,$dcdom) = ($ARGV[1] =~ /^([^:]+):([^:]+)$/); |
|
if ($defdom eq '' || !grep/^$defdom$/,@domains) { |
|
print $fh "The domain you supplied is not a valid domain for this server\n\n"; |
|
close($fh); |
|
exit; |
|
} |
|
# check if user is an active domain coordinator. |
|
if (!&check_activedc($dcdom,$dcname,$defdom)) { |
|
print $fh "The username you supplied for domain $defdom does not have an active domain coordinator role in the domain\n\n"; |
|
close($fh); |
|
exit; |
|
} |
} |
|
exit if (!@libids); |
my $batchdir = $$perlvarref{'lonDaemons'}.'/tmp/addcourse/'.$defdom.'/auto'; |
foreach my $dom (@machinedoms) { |
opendir(DIR,"$batchdir/pending"); |
my $primary = &Apache::lonnet::domain($dom,'primary'); |
my @requests = grep(!/^\.\.?$/,readdir(DIR)); |
if (grep(/^\Q$primary\E$/,@libids)) { |
closedir(DIR); |
unless (grep(/^\Q$dom\E$/,@domains)) { |
my %courseids = (); |
push(@domains,$dom); |
my $cccflag = 0; |
} |
unless ($ENV{'allowed.ccc'}) { |
} |
$ENV{'allowed.ccc'} = 'F'; |
|
$cccflag = 1; |
|
} |
} |
|
exit if (!@domains); |
|
open (my $fh,">>$logfile"); |
|
print $fh "********************\n".localtime(time)." Autocreation messages start --\n"; |
my $wwwid=getpwnam('www'); |
my $wwwid=getpwnam('www'); |
if ($wwwid!=$<) { |
if ($wwwid!=$<) { |
my $emailto=$$perlvarref{'lonAdmEMail'}; |
my $emailto=$$perlvarref{'lonAdmEMail'}; |
my $subj="LON: $$perlvarref{'lonHostID'} User ID mismatch"; |
my $subj="LON: $$perlvarref{'lonHostID'} User ID mismatch"; |
my $requestmail = "To: $emailto\n"; |
my $requestmail = "To: $emailto\n"; |
$requestmail .= |
$requestmail .= |
"Subject: LON: $$perlvarref{'lonHostID'} User ID mismatch\n". |
"Subject: LON: $$perlvarref{'lonHostID'} User ID mismatch\n". |
"User ID mismatch. Autocreate.pl must be run as user www\n"; |
"User ID mismatch. Autocreate.pl must be run as user www\n"; |
if ($emailto =~ /^[^\@]+\@[^\@]+$/) { |
if ($emailto =~ /^[^\@]+\@[^\@]+$/) { |
if (open(MAIL, "|/usr/lib/sendmail -oi -t -odb")) { |
if (open(MAIL, "|/usr/lib/sendmail -oi -t -odb")) { |
print MAIL $requestmail; |
print MAIL $requestmail; |
close(MAIL); |
close(MAIL); |
print $fh "Autocreate.pl must be run as user www\n\n"; |
print $fh "Autocreate.pl must be run as user www\n\n"; |
} else { |
} else { |
print $fh "Could not send notification e-mail to $emailto\n\n"; |
print $fh "Could not send notification e-mail to $emailto\n\n"; |
} |
} |
} else { |
} else { |
print $fh "Notification e-mail address for Administrator is not a valid e-mail address\n\n"; |
print $fh "Notification e-mail address for Administrator is not a valid e-mail address\n\n"; |
Line 93
|
Line 91
|
close($fh); |
close($fh); |
exit; |
exit; |
} |
} |
|
if (@ARGV) { |
|
# check if specified course domain is a domain hosted on this library server. |
|
if (!grep(/^\Q$ARGV[0]\E$/,@domains)) { |
|
print $fh "The domain you supplied is not a valid domain for this server\n"; |
|
close($fh); |
|
exit; |
|
} elsif (@ARGV < 2) { |
|
print $fh "usage: ./Autocreate <coursedomain username:domain>.\nPlease provide the username and domain of a Domain Coordinator, if you provide a coursedomain.\nThe script can also be called without any arguments, in which case domain configuration data for domains hosted on this server will be used.\n"; |
|
close($fh); |
|
exit; |
|
} else { |
|
my $defdom = $ARGV[0]; |
|
my ($dcname,$dcdom) = ($ARGV[1] =~ /^([^:]+):([^:]+)$/); |
|
# check if user is an active domain coordinator. |
|
if (!&check_activedc($dcdom,$dcname,$defdom)) { |
|
print $fh "The username you supplied for domain $defdom does not have an active domain coordinator role in the domain\n\n"; |
|
close($fh); |
|
exit; |
|
} |
|
&set_dc_env($dcname,$dcdom,$defdom); |
|
my @permissions = ('mau','ccc','cin','cta','cep','ccr','cst'); |
|
my %permissionflags = (); |
|
&set_permissions(\%permissionflags,\@permissions); |
|
my $output = &process_xml($fh,$defdom,$dcname,$dcdom); |
|
&unset_permissions(\%permissionflags); |
|
&unset_dc_env(); |
|
print $output; |
|
} |
|
} else { |
|
my @permissions = ('mau','ccc','cin','cta','cep','ccr','cst'); |
|
my %permissionflags = (); |
|
&set_permissions(\%permissionflags,\@permissions); |
|
foreach my $dom (@domains) { |
|
my %domconfig = &Apache::lonnet::get_dom('configuration', |
|
['autocreate'],$dom); |
|
#only run if configured to |
|
my $xml_update = 0; |
|
my $settings; |
|
if (ref($domconfig{'autocreate'}) eq 'HASH') { |
|
$settings = $domconfig{'autocreate'}; |
|
my ($dcname,$dcdom); |
|
if ($settings->{'xmldc'}) { |
|
($dcname,$dcdom) = split(':',$settings->{'xmldc'}); |
|
} |
|
if ($settings->{'xml'}) { |
|
if ($settings->{'xmldc'}) { |
|
if (!&check_activedc($dcdom,$dcname,$dom)) { |
|
print $fh "Autocreate.pl in domain $dom configured to run under the auspices of a user without an active domain coordinator role in the domain - course creation will be skipped.\n\n"; |
|
next; |
|
} else { |
|
&process_xml($fh,$dom,$dcname,$dcdom); |
|
} |
|
} else { |
|
print $fh "Autocreate.pl in domain $dom - no specified DC under whose identity course creation will occur - domain skipped.\n\n"; |
|
} |
|
} |
|
if ($settings->{'req'}) { |
|
&set_dc_env($dcname,$dcdom); |
|
my $output = &Apache::loncoursequeueadmin::process_official_reqs('auto',$dom,$dcname,$dcdom); |
|
&unset_dc_env(); |
|
if ($output) { |
|
print $fh $output; |
|
} |
|
} |
|
} |
|
} |
|
&unset_permissions(\%permissionflags); |
|
} |
|
print $fh "-- ".localtime(time)." Autocreation messages end\n*******************\n\n"; |
|
close($fh); |
|
|
my ($output,$logmsg) = &LONCAPA::batchcreatecourse::create_courses(\@requests,\%courseids,'auto',$defdom,$dcname,$dcdom); |
|
|
|
|
sub process_xml { |
|
my ($fh,$dom,$dcname,$dcdom) = @_; |
|
&set_dc_env($dcname,$dcdom,$dom); |
|
# Initialize language handler |
|
&Apache::lonlocal::get_language_handle(); |
|
|
|
my $batchdir = $$perlvarref{'lonDaemons'}.'/tmp/addcourse/'.$dom.'/auto'; |
|
opendir(DIR,"$batchdir/pending"); |
|
my @requests = grep(!/^\.\.?$/,readdir(DIR)); |
|
closedir(DIR); |
|
my %courseids = (); |
|
print $fh "Sending to batch - auto,$dom,$dcname,$dcdom ".join(":",@requests)."\n"; |
|
my ($result,$logmsg,$keysmsg,$codesref,$instcodesref) = |
|
&LONCAPA::batchcreatecourse::create_courses(\@requests,\%courseids,'auto',$dom,$dcname,$dcdom); |
|
my $outcome; |
|
if ($result ne '') { |
|
$outcome = $result."\n"; |
|
} |
|
if ($logmsg ne '') { |
|
$outcome .= $logmsg."\n"; |
|
} |
|
if ($keysmsg ne '') { |
|
$outcome .= $keysmsg."\n"; |
|
} |
|
print $fh $outcome; |
|
|
|
my $output; |
# Copy requests from pending directory to processed directory and unlink. |
# Copy requests from pending directory to processed directory and unlink. |
foreach my $request (@requests) { |
foreach my $request (@requests) { |
if ((-e "$batchdir/pending/$request") && $request !~ /\.\./ && $request ne '' &&$request ne './') { |
if ((-e "$batchdir/pending/$request") && $request !~ /\.\./ && $request ne '' &&$request ne './') { |
open(FILE,"<$batchdir/pending/$request"); |
open(FILE,"<$batchdir/pending/$request"); |
my @buffer = <FILE>; |
my @buffer = <FILE>; |
close(FILE); |
close(FILE); |
|
if (!-e "$batchdir/processed") { |
|
mkdir("$batchdir/processed", 0755); |
|
} |
open(FILE,">$batchdir/processed/$request"); |
open(FILE,">$batchdir/processed/$request"); |
print FILE @buffer; |
print FILE @buffer; |
close(FILE); |
close(FILE); |
Line 110
|
Line 207
|
} |
} |
} |
} |
} |
} |
|
foreach my $key (sort(keys(%courseids))) { |
foreach my $key (sort keys %courseids) { |
print $fh "created course: $key - $courseids{$key}\n"; |
print $fh "created course: $key\n"; |
my $newcourse = &LONCAPA::escape($key.':'.$courseids{$key}); |
|
$output .= $newcourse.':'; |
} |
} |
|
$output =~ s/:$//; |
if ($cccflag) { |
&unset_dc_env(); |
delete($ENV{'allowed.ccc'}); |
if (ref($instcodesref) eq 'HASH') { |
|
if (keys(%{$instcodesref}) > 0) { |
|
&Apache::lonnet::devalidate_cache_new('instcats',$dom); |
|
if (&Apache::lonnet::shared_institution($dom)) { |
|
my %servers = &Apache::lonnet::internet_dom_servers($dom); |
|
my %thismachine; |
|
map { $thismachine{$_} = 1; } &Apache::lonnet::current_machine_ids(); |
|
if (keys(%servers)) { |
|
foreach my $server (keys(%servers)) { |
|
next if ($thismachine{$server}); |
|
&Apache::lonnet::remote_devalidate_cache($server,['instcats:'.$dom]); |
|
} |
|
} |
|
} |
|
} |
} |
} |
print $fh "-- ".localtime(time)." Autocreation messages end\n*******************\n\n"; |
return $output; |
close($fh); |
} |
|
|
sub check_activedc { |
sub check_activedc { |
my ($dcdom,$dcname,$defdom) = @_; |
my ($dcdom,$dcname,$defdom) = @_; |
my %dumphash= |
my %roleshash = |
&Apache::lonnet::dump('roles',$dcdom,$dcname); |
&Apache::lonnet::get_my_roles($dcname,$dcdom,'userroles',undef,['dc'],[$defdom]); |
my $now=time; |
if (keys(%roleshash) > 0) { |
my $activedc = 0; |
return 1; |
foreach my $item (keys %dumphash) { |
} |
my ($domain,$role) = ($item =~ m-^/([^/]+)/[^_]*_(\w+)$-); |
return 0; |
if ($role eq 'dc' && $domain eq $defdom) { |
} |
my ($trole,$tend,$tstart)=split(/_/,$dumphash{$item}); |
|
if (($tend) && ($tend<$now)) { next; } |
sub set_permissions { |
if (($tstart) && ($now<$tstart)) { next; } |
my ($permissionflags,$permissions) = @_; |
$activedc = 1; |
foreach my $allowtype (@{$permissions}) { |
last; |
unless($env{"allowed.$allowtype"}) { |
|
$env{"allowed.$allowtype"} = 'F'; |
|
$permissionflags->{$allowtype} = 1; |
} |
} |
} |
} |
return $activedc; |
} |
|
|
|
sub unset_permissions { |
|
my ($permissionflags) = @_; |
|
foreach my $allowtype (keys(%{$permissionflags})) { |
|
delete($env{"allowed.$allowtype"}); |
|
} |
|
} |
|
|
|
sub set_dc_env { |
|
my ($dcname,$dcdom,$defdom) = @_; |
|
$env{'user.name'} = $dcname; |
|
$env{'user.domain'} = $dcdom; |
|
$env{'user.home'} = &Apache::lonnet::homeserver($dcname,$dcdom); |
|
if ($defdom ne '') { |
|
$env{'request.role.domain'} = $defdom; |
|
} |
|
return; |
|
} |
|
|
|
sub unset_dc_env { |
|
delete($env{'user.name'}); |
|
delete($env{'user.domain'}); |
|
delete($env{'user.home'}); |
|
if ($env{'request.role.domain'}) { |
|
delete($env{'request.role.domain'}); |
|
} |
|
return; |
} |
} |