![]() ![]() | ![]() |
- Correct path to &process_official_reqs().
1: #!/usr/bin/perl 2: # 3: # Automated Course Creation script 4: # 5: # $Id: Autocreate.pl,v 1.15 2010/08/28 19:00:42 raeburn Exp $ 6: # 7: # Copyright Michigan State University Board of Trustees 8: # 9: # This file is part of the LearningOnline Network with CAPA (LON-CAPA). 10: # 11: # LON-CAPA is free software; you can redistribute it and/or modify 12: # it under the terms of the GNU General Public License as published by 13: # the Free Software Foundation; either version 2 of the License, or 14: # (at your option) any later version. 15: # 16: # LON-CAPA is distributed in the hope that it will be useful, 17: # but WITHOUT ANY WARRANTY; without even the implied warranty of 18: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19: # GNU General Public License for more details. 20: # 21: # You should have received a copy of the GNU General Public License 22: # along with LON-CAPA; if not, write to the Free Software 23: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 24: # 25: # /home/httpd/html/adm/gpl.txt 26: # 27: # http://www.lon-capa.org/ 28: # 29: # Run as www. Called from an entry in /etc/cron.d/loncapa 30: # either with command line args: 31: # 32: # www /home/httpd/perl/Autocreate.pl $dom $uname:$udom 33: # 34: # where $dom is the name of the course domain, $uname and $udom are the 35: # username and domain of a Domain Coordinator in the domain. 36: # 37: # or without args (default) controlled by domain configuration settings: 38: # 39: # www /home/httpd/perl/Autocreate.pl 40: # 41: use strict; 42: use lib '/home/httpd/lib/perl'; 43: use Apache::lonnet; 44: use Apache::lonlocal; 45: use Apache::loncoursequeueadmin; 46: use LONCAPA::batchcreatecourse; 47: use LONCAPA::Configuration; 48: use LONCAPA(); 49: 50: my $perlvarref = &LONCAPA::Configuration::read_conf('loncapa.conf'); 51: my $logfile = $$perlvarref{'lonDaemons'}.'/logs/autocreate.log'; 52: my @machinedoms = sort(&Apache::lonnet::current_machine_domains()); 53: my @ids=&Apache::lonnet::current_machine_ids(); 54: my (@libids,@domains); 55: foreach my $id (@ids) { 56: if (&Apache::lonnet::is_library($id)) { 57: push(@libids,$id); 58: } 59: } 60: exit if (!@libids); 61: foreach my $dom (@machinedoms) { 62: my $primary = &Apache::lonnet::domain($dom,'primary'); 63: if (grep(/^\Q$primary\E$/,@libids)) { 64: unless (grep(/^\Q$dom\E$/,@domains)) { 65: push(@domains,$dom); 66: } 67: } 68: } 69: exit if (!@domains); 70: open (my $fh,">>$logfile"); 71: print $fh "********************\n".localtime(time)." Autocreation messages start --\n"; 72: my $wwwid=getpwnam('www'); 73: if ($wwwid!=$<) { 74: my $emailto=$$perlvarref{'lonAdmEMail'}; 75: my $subj="LON: $$perlvarref{'lonHostID'} User ID mismatch"; 76: my $requestmail = "To: $emailto\n"; 77: $requestmail .= 78: "Subject: LON: $$perlvarref{'lonHostID'} User ID mismatch\n". 79: "User ID mismatch. Autocreate.pl must be run as user www\n"; 80: if ($emailto =~ /^[^\@]+\@[^\@]+$/) { 81: if (open(MAIL, "|/usr/lib/sendmail -oi -t -odb")) { 82: print MAIL $requestmail; 83: close(MAIL); 84: print $fh "Autocreate.pl must be run as user www\n\n"; 85: } else { 86: print $fh "Could not send notification e-mail to $emailto\n\n"; 87: } 88: } else { 89: print $fh "Notification e-mail address for Administrator is not a valid e-mail address\n\n"; 90: } 91: close($fh); 92: exit; 93: } 94: if (@ARGV) { 95: # check if specified course domain is a domain hosted on this library server. 96: if (!grep(/^\Q$ARGV[0]\E$/,@domains)) { 97: print $fh "The domain you supplied is not a valid domain for this server\n"; 98: close($fh); 99: exit; 100: } elsif (@ARGV < 2) { 101: 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"; 102: close($fh); 103: exit; 104: } else { 105: my $defdom = $ARGV[0]; 106: my ($dcname,$dcdom) = ($ARGV[1] =~ /^([^:]+):([^:]+)$/); 107: # check if user is an active domain coordinator. 108: if (!&check_activedc($dcdom,$dcname,$defdom)) { 109: print $fh "The username you supplied for domain $defdom does not have an active domain coordinator role in the domain\n\n"; 110: close($fh); 111: exit; 112: } 113: $env{'user.name'} = $dcname; 114: $env{'user.domain'} = $dcdom; 115: $env{'request.role.domain'} = $defdom; 116: my @permissions = ('mau','ccc','cin','cta','cep','ccr','cst'); 117: my %permissionflags = (); 118: &set_permissions(\%permissionflags,\@permissions); 119: my $output = &process_xml($fh,$defdom,$dcname,$dcdom); 120: print $output; 121: &unset_permissions(\%permissionflags); 122: } 123: } else { 124: my @permissions = ('mau','ccc','cin','cta','cep','ccr','cst'); 125: my %permissionflags = (); 126: &set_permissions(\%permissionflags,\@permissions); 127: foreach my $dom (@domains) { 128: my %domconfig = &Apache::lonnet::get_dom('configuration', 129: ['autocreate'],$dom); 130: #only run if configured to 131: my $xml_update = 0; 132: my $settings; 133: if (ref($domconfig{'autocreate'}) eq 'HASH') { 134: $settings = $domconfig{'autocreate'}; 135: if ($settings->{'xml'}) { 136: if ($settings->{'xmldc'}) { 137: my ($dcname,$dcdom) = split(':',$settings->{'xmldc'}); 138: $env{'user.name'} = $dcname; 139: $env{'user.domain'} = $dcdom; 140: $env{'request.role.domain'} = $dom; 141: if (!&check_activedc($dcdom,$dcname,$dom)) { 142: 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"; 143: next; 144: } else { 145: &process_xml($fh,$dom,$dcname,$dcdom); 146: } 147: } else { 148: print $fh "Autocreate.pl in domain $dom - no specified DC under whose identity course creation will occur - domain skipped.\n\n"; 149: } 150: } 151: if ($settings->{'req'}) { 152: my $output = &Apache::loncoursequeueadmin::process_official_reqs('auto',$dom); 153: if ($output) { 154: print $fh $output; 155: } 156: } 157: } 158: } 159: &unset_permissions(\%permissionflags); 160: } 161: print $fh "-- ".localtime(time)." Autocreation messages end\n*******************\n\n"; 162: close($fh); 163: 164: 165: sub process_xml { 166: my ($fh,$dom,$dcname,$dcdom) = @_; 167: $env{'user.name'} = $dcname; 168: $env{'user.domain'} = $dcdom; 169: $env{'request.role.domain'} = $dom; 170: 171: # Initialize language handler 172: &Apache::lonlocal::get_language_handle(); 173: 174: my $batchdir = $$perlvarref{'lonDaemons'}.'/tmp/addcourse/'.$dom.'/auto'; 175: opendir(DIR,"$batchdir/pending"); 176: my @requests = grep(!/^\.\.?$/,readdir(DIR)); 177: closedir(DIR); 178: my %courseids = (); 179: print $fh "Sending to batch - auto,$dom,$dcname,$dcdom ".join(":",@requests)."\n"; 180: my ($result,$logmsg) = &LONCAPA::batchcreatecourse::create_courses(\@requests,\%courseids,'auto',$dom,$dcname,$dcdom); 181: my $outcome; 182: if ($result ne '') { 183: $outcome = $result."\n"; 184: } 185: if ($logmsg ne '') { 186: $outcome .= $logmsg."\n"; 187: } 188: print $fh $outcome; 189: 190: my $output; 191: # Copy requests from pending directory to processed directory and unlink. 192: foreach my $request (@requests) { 193: if ((-e "$batchdir/pending/$request") && $request !~ /\.\./ && $request ne '' &&$request ne './') { 194: open(FILE,"<$batchdir/pending/$request"); 195: my @buffer = <FILE>; 196: close(FILE); 197: if (!-e "$batchdir/processed") { 198: mkdir("$batchdir/processed", 0755); 199: } 200: open(FILE,">$batchdir/processed/$request"); 201: print FILE @buffer; 202: close(FILE); 203: if (-e "$batchdir/processed/$request") { 204: unlink("$batchdir/pending/$request"); 205: } 206: } 207: } 208: foreach my $key (sort(keys(%courseids))) { 209: print $fh "created course: $key - $courseids{$key}\n"; 210: my $newcourse = &LONCAPA::escape($key.':'.$courseids{$key}); 211: $output .= $newcourse.':'; 212: } 213: $output =~ s/:$//; 214: delete($env{'user.name'}); 215: delete($env{'user.domain'}); 216: delete($env{'request.role.domain'}); 217: return $output; 218: } 219: 220: sub check_activedc { 221: my ($dcdom,$dcname,$defdom) = @_; 222: my %dumphash= 223: &Apache::lonnet::dump('roles',$dcdom,$dcname); 224: my $now=time; 225: my $activedc = 0; 226: foreach my $item (keys %dumphash) { 227: my ($domain,$role) = ($item =~ m-^/([^/]+)/[^_]*_(\w+)$-); 228: if ($role eq 'dc' && $domain eq $defdom) { 229: my ($trole,$tend,$tstart)=split(/_/,$dumphash{$item}); 230: if (($tend) && ($tend<$now)) { next; } 231: if (($tstart) && ($now<$tstart)) { next; } 232: $activedc = 1; 233: last; 234: } 235: } 236: return $activedc; 237: } 238: 239: sub set_permissions { 240: my ($permissionflags,$permissions) = @_; 241: foreach my $allowtype (@{$permissions}) { 242: unless($env{"allowed.$allowtype"}) { 243: $env{"allowed.$allowtype"} = 'F'; 244: $permissionflags->{$allowtype} = 1; 245: } 246: } 247: } 248: 249: sub unset_permissions { 250: my ($permissionflags) = @_; 251: foreach my $allowtype (keys(%{$permissionflags})) { 252: delete($env{"allowed.$allowtype"}); 253: } 254: }