Annotation of loncom/automation/Autocreate.pl, revision 1.22
1.1 raeburn 1: #!/usr/bin/perl
2: #
3: # Automated Course Creation script
4: #
1.22 ! raeburn 5: # $Id: Autocreate.pl,v 1.21 2019/07/26 02:28:28 raeburn Exp $
1.9 raeburn 6: #
1.1 raeburn 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: #
1.12 raeburn 29: # Run as www. Called from an entry in /etc/cron.d/loncapa
30: # either with command line args:
1.1 raeburn 31: #
32: # www /home/httpd/perl/Autocreate.pl $dom $uname:$udom
33: #
1.12 raeburn 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
1.1 raeburn 40: #
41: use strict;
42: use lib '/home/httpd/lib/perl';
43: use Apache::lonnet;
1.6 raeburn 44: use Apache::lonlocal;
1.12 raeburn 45: use Apache::loncoursequeueadmin;
1.1 raeburn 46: use LONCAPA::batchcreatecourse;
47: use LONCAPA::Configuration;
1.11 raeburn 48: use LONCAPA();
1.1 raeburn 49:
50: my $perlvarref = &LONCAPA::Configuration::read_conf('loncapa.conf');
51: my $logfile = $$perlvarref{'lonDaemons'}.'/logs/autocreate.log';
1.12 raeburn 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);
1.1 raeburn 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";
1.12 raeburn 77: $requestmail .=
1.1 raeburn 78: "Subject: LON: $$perlvarref{'lonHostID'} User ID mismatch\n".
1.12 raeburn 79: "User ID mismatch. Autocreate.pl must be run as user www\n";
1.1 raeburn 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 {
1.12 raeburn 86: print $fh "Could not send notification e-mail to $emailto\n\n";
1.1 raeburn 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: }
1.12 raeburn 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: }
1.19 raeburn 113: &set_dc_env($dcname,$dcdom,$defdom);
1.14 raeburn 114: my @permissions = ('mau','ccc','cin','cta','cep','ccr','cst');
115: my %permissionflags = ();
116: &set_permissions(\%permissionflags,\@permissions);
1.12 raeburn 117: my $output = &process_xml($fh,$defdom,$dcname,$dcdom);
1.19 raeburn 118: &unset_permissions(\%permissionflags);
119: &unset_dc_env();
1.12 raeburn 120: print $output;
121: }
122: } else {
123: my @permissions = ('mau','ccc','cin','cta','cep','ccr','cst');
124: my %permissionflags = ();
125: &set_permissions(\%permissionflags,\@permissions);
126: foreach my $dom (@domains) {
127: my %domconfig = &Apache::lonnet::get_dom('configuration',
128: ['autocreate'],$dom);
129: #only run if configured to
130: my $xml_update = 0;
131: my $settings;
132: if (ref($domconfig{'autocreate'}) eq 'HASH') {
133: $settings = $domconfig{'autocreate'};
1.18 raeburn 134: my ($dcname,$dcdom);
135: if ($settings->{'xmldc'}) {
136: ($dcname,$dcdom) = split(':',$settings->{'xmldc'});
137: }
1.12 raeburn 138: if ($settings->{'xml'}) {
139: if ($settings->{'xmldc'}) {
140: if (!&check_activedc($dcdom,$dcname,$dom)) {
141: 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";
142: next;
143: } else {
144: &process_xml($fh,$dom,$dcname,$dcdom);
145: }
146: } else {
147: print $fh "Autocreate.pl in domain $dom - no specified DC under whose identity course creation will occur - domain skipped.\n\n";
148: }
149: }
150: if ($settings->{'req'}) {
1.19 raeburn 151: &set_dc_env($dcname,$dcdom);
1.17 raeburn 152: my $output = &Apache::loncoursequeueadmin::process_official_reqs('auto',$dom,$dcname,$dcdom);
1.19 raeburn 153: &unset_dc_env();
1.13 raeburn 154: if ($output) {
155: print $fh $output;
156: }
1.12 raeburn 157: }
158: }
159: }
160: &unset_permissions(\%permissionflags);
161: }
162: print $fh "-- ".localtime(time)." Autocreation messages end\n*******************\n\n";
163: close($fh);
164:
165:
166: sub process_xml {
167: my ($fh,$dom,$dcname,$dcdom) = @_;
1.20 raeburn 168: &set_dc_env($dcname,$dcdom,$dom);
1.12 raeburn 169: # Initialize language handler
170: &Apache::lonlocal::get_language_handle();
171:
172: my $batchdir = $$perlvarref{'lonDaemons'}.'/tmp/addcourse/'.$dom.'/auto';
173: opendir(DIR,"$batchdir/pending");
174: my @requests = grep(!/^\.\.?$/,readdir(DIR));
175: closedir(DIR);
176: my %courseids = ();
177: print $fh "Sending to batch - auto,$dom,$dcname,$dcdom ".join(":",@requests)."\n";
1.22 ! raeburn 178: my ($result,$logmsg,$clonemsg,$keysmsg,$codesref,$instcodesref) =
1.21 raeburn 179: &LONCAPA::batchcreatecourse::create_courses(\@requests,\%courseids,'auto',$dom,$dcname,$dcdom);
1.8 raeburn 180: my $outcome;
1.7 raeburn 181: if ($result ne '') {
1.8 raeburn 182: $outcome = $result."\n";
1.7 raeburn 183: }
184: if ($logmsg ne '') {
1.8 raeburn 185: $outcome .= $logmsg."\n";
1.7 raeburn 186: }
1.21 raeburn 187: if ($keysmsg ne '') {
188: $outcome .= $keysmsg."\n";
189: }
1.22 ! raeburn 190: if ($clonemsg ne '') {
! 191: $outcome .= $clonemsg."\n";
! 192: }
1.8 raeburn 193: print $fh $outcome;
1.1 raeburn 194:
1.8 raeburn 195: my $output;
1.1 raeburn 196: # Copy requests from pending directory to processed directory and unlink.
1.8 raeburn 197: foreach my $request (@requests) {
1.1 raeburn 198: if ((-e "$batchdir/pending/$request") && $request !~ /\.\./ && $request ne '' &&$request ne './') {
199: open(FILE,"<$batchdir/pending/$request");
200: my @buffer = <FILE>;
201: close(FILE);
1.3 raeburn 202: if (!-e "$batchdir/processed") {
203: mkdir("$batchdir/processed", 0755);
204: }
1.1 raeburn 205: open(FILE,">$batchdir/processed/$request");
206: print FILE @buffer;
207: close(FILE);
208: if (-e "$batchdir/processed/$request") {
209: unlink("$batchdir/pending/$request");
210: }
211: }
212: }
1.12 raeburn 213: foreach my $key (sort(keys(%courseids))) {
1.3 raeburn 214: print $fh "created course: $key - $courseids{$key}\n";
1.11 raeburn 215: my $newcourse = &LONCAPA::escape($key.':'.$courseids{$key});
1.12 raeburn 216: $output .= $newcourse.':';
1.1 raeburn 217: }
1.3 raeburn 218: $output =~ s/:$//;
1.19 raeburn 219: &unset_dc_env();
1.21 raeburn 220: if (ref($instcodesref) eq 'HASH') {
221: if (keys(%{$instcodesref}) > 0) {
222: &Apache::lonnet::devalidate_cache_new('instcats',$dom);
223: if (&Apache::lonnet::shared_institution($dom)) {
224: my %servers = &Apache::lonnet::internet_dom_servers($dom);
225: my %thismachine;
226: map { $thismachine{$_} = 1; } &Apache::lonnet::current_machine_ids();
227: if (keys(%servers)) {
228: foreach my $server (keys(%servers)) {
229: next if ($thismachine{$server});
230: &Apache::lonnet::remote_devalidate_cache($server,['instcats:'.$dom]);
231: }
232: }
233: }
234: }
235: }
1.12 raeburn 236: return $output;
237: }
238:
1.1 raeburn 239: sub check_activedc {
240: my ($dcdom,$dcname,$defdom) = @_;
1.16 raeburn 241: my %roleshash =
242: &Apache::lonnet::get_my_roles($dcname,$dcdom,'userroles',undef,['dc'],[$defdom]);
243: if (keys(%roleshash) > 0) {
244: return 1;
1.1 raeburn 245: }
1.16 raeburn 246: return 0;
1.1 raeburn 247: }
1.3 raeburn 248:
249: sub set_permissions {
250: my ($permissionflags,$permissions) = @_;
251: foreach my $allowtype (@{$permissions}) {
1.4 raeburn 252: unless($env{"allowed.$allowtype"}) {
253: $env{"allowed.$allowtype"} = 'F';
1.12 raeburn 254: $permissionflags->{$allowtype} = 1;
1.3 raeburn 255: }
256: }
257: }
258:
259: sub unset_permissions {
260: my ($permissionflags) = @_;
1.12 raeburn 261: foreach my $allowtype (keys(%{$permissionflags})) {
1.4 raeburn 262: delete($env{"allowed.$allowtype"});
1.3 raeburn 263: }
264: }
1.19 raeburn 265:
266: sub set_dc_env {
267: my ($dcname,$dcdom,$defdom) = @_;
268: $env{'user.name'} = $dcname;
269: $env{'user.domain'} = $dcdom;
270: $env{'user.home'} = &Apache::lonnet::homeserver($dcname,$dcdom);
271: if ($defdom ne '') {
272: $env{'request.role.domain'} = $defdom;
1.22 ! raeburn 273: }
1.19 raeburn 274: return;
275: }
276:
277: sub unset_dc_env {
278: delete($env{'user.name'});
279: delete($env{'user.domain'});
280: delete($env{'user.home'});
281: if ($env{'request.role.domain'}) {
282: delete($env{'request.role.domain'});
283: }
284: return;
285: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to Autocreate.pl CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / automation