Annotation of loncom/automation/Autocreate.pl, revision 1.9

1.1       raeburn     1: #!/usr/bin/perl
                      2: #
                      3: # Automated Course Creation script
                      4: #
1.9     ! raeburn     5: # $ 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: #
                     29: # Run as www. Call this from an entry in /etc/cron.d/loncapa
                     30: #
                     31: # www /home/httpd/perl/Autocreate.pl $dom $uname:$udom
                     32: #
                     33: # where $dom is the name of the course domain, $uname and $udom are the 
                     34: # username and domain of a Domain Coordinator in the domain.   
                     35: #
                     36:     use strict;
                     37:     use lib '/home/httpd/lib/perl';
                     38:     use Apache::lonnet;
1.6       raeburn    39:     use Apache::lonlocal;
1.1       raeburn    40:     use LONCAPA::batchcreatecourse;
                     41:     use LONCAPA::Configuration;
                     42: 
                     43:     my $perlvarref = &LONCAPA::Configuration::read_conf('loncapa.conf');
                     44:     my $logfile = $$perlvarref{'lonDaemons'}.'/logs/autocreate.log';
                     45:     my @domains = &Apache::lonnet::current_machine_domains();
                     46:     open (my $fh,">>$logfile");
                     47:     print $fh "********************\n".localtime(time)." Autocreation messages start --\n";
                     48:     if (@ARGV < 2) {
                     49:         print $fh "usage: ./Autocreate <coursedomain  username:domain>.\nPlease provide the username and domain of a Domain Coordinator.\n";
                     50:         exit;  
                     51:     }
                     52: # check if $defdom is a domain hosted on this library server. 
                     53:     my $defdom = $ARGV[0];
                     54:     my ($dcname,$dcdom) = ($ARGV[1] =~ /^([^:]+):([^:]+)$/);
                     55:     if ($defdom eq '' || !grep/^$defdom$/,@domains) {
                     56:         print $fh "The domain you supplied is not a valid domain for this server\n\n";
                     57:         close($fh);
                     58:         exit;
                     59:     }
                     60: # check if user is an active domain coordinator.
                     61:     if (!&check_activedc($dcdom,$dcname,$defdom)) {
                     62:         print $fh "The username you supplied for domain $defdom does not have an active domain coordinator role in the domain\n\n";
                     63:         close($fh);
                     64:         exit;
                     65:     }
1.6       raeburn    66: 
                     67:     # Initialize language handler
                     68:     &Apache::lonlocal::get_language_handle();
                     69: 
1.1       raeburn    70:     my $batchdir = $$perlvarref{'lonDaemons'}.'/tmp/addcourse/'.$defdom.'/auto';
                     71:     opendir(DIR,"$batchdir/pending");
                     72:     my @requests = grep(!/^\.\.?$/,readdir(DIR));
                     73:     closedir(DIR);
                     74:     my %courseids = ();
1.5       raeburn    75:     my @permissions = ('mau','ccc','cin','cta','cep','ccr','cst');
1.3       raeburn    76:     my %permissionflags = ();
                     77:     &set_permissions(\%permissionflags,\@permissions);
1.4       raeburn    78:     $env{'user.name'} = $dcname;
                     79:     $env{'user.domain'} = $dcdom;
1.6       raeburn    80:     $env{'request.role.domain'} = $defdom;
1.1       raeburn    81:     my $wwwid=getpwnam('www');
                     82:     if ($wwwid!=$<) {
                     83:         my $emailto=$$perlvarref{'lonAdmEMail'};
                     84:         my $subj="LON: $$perlvarref{'lonHostID'} User ID mismatch";
                     85:         my $requestmail = "To: $emailto\n";
                     86:         $requestmail .= 
                     87:         "Subject: LON: $$perlvarref{'lonHostID'} User ID mismatch\n".
                     88:         "User ID mismatch. Autocreate.pl must be run as user www\n"; 
                     89:         if ($emailto =~ /^[^\@]+\@[^\@]+$/) {
                     90:             if (open(MAIL, "|/usr/lib/sendmail -oi -t -odb")) {
                     91:                 print MAIL $requestmail;
                     92:                 close(MAIL);
                     93:                 print $fh "Autocreate.pl must be run as user www\n\n";
                     94:             } else {
                     95:                 print $fh "Could not send notification e-mail to $emailto\n\n"; 
                     96:             }
                     97:         } else {
                     98:             print $fh "Notification e-mail address for Administrator is not a valid e-mail address\n\n";
                     99:         }
                    100:         close($fh);
                    101:         exit;
                    102:     }
                    103: 
1.3       raeburn   104:     print $fh "Sending to batch - auto,$defdom,$dcname,$dcdom ".join(":",@requests)."\n";
                    105:     my ($result,$logmsg) = &LONCAPA::batchcreatecourse::create_courses(\@requests,\%courseids,'auto',$defdom,$dcname,$dcdom);
1.8       raeburn   106:     my $outcome;
1.7       raeburn   107:     if ($result ne '') {
1.8       raeburn   108:         $outcome = $result."\n";
1.7       raeburn   109:     }
                    110:     if ($logmsg ne '') {
1.8       raeburn   111:         $outcome .= $logmsg."\n";    
1.7       raeburn   112:     }
1.8       raeburn   113:     print $fh $outcome;
1.1       raeburn   114: 
1.8       raeburn   115:     my $output;
1.1       raeburn   116: # Copy requests from pending directory to processed directory and unlink.
1.8       raeburn   117:     foreach my $request (@requests) {  
1.1       raeburn   118:         if ((-e "$batchdir/pending/$request") && $request !~ /\.\./ && $request ne '' &&$request ne './') {
                    119:             open(FILE,"<$batchdir/pending/$request");
                    120:             my @buffer = <FILE>;
                    121:             close(FILE);
1.3       raeburn   122:             if (!-e "$batchdir/processed") {
                    123:                 mkdir("$batchdir/processed", 0755);
                    124:             }
1.1       raeburn   125:             open(FILE,">$batchdir/processed/$request");
                    126:             print FILE @buffer;
                    127:             close(FILE);
                    128:             if (-e "$batchdir/processed/$request") {
                    129:                 unlink("$batchdir/pending/$request");
                    130:             }
                    131:         }
                    132:     }
                    133: 
                    134:     foreach my $key (sort keys %courseids) {
1.3       raeburn   135:         print $fh "created course: $key - $courseids{$key}\n";
                    136:         my $newcourse = &Apache::lonnet::escape($key.':'.$courseids{$key});
                    137:         $output .= $newcourse.':'; 
1.1       raeburn   138:     }
1.3       raeburn   139:     $output =~ s/:$//;
                    140:     print $output;
1.1       raeburn   141: 
1.3       raeburn   142:     &unset_permissions(\%permissionflags);
1.4       raeburn   143:     delete($env{'user.name'});
                    144:     delete($env{'user.domain'});
1.6       raeburn   145:     delete($env{'request.role.domain'});
1.1       raeburn   146:     print $fh "-- ".localtime(time)." Autocreation messages end\n*******************\n\n";
                    147:     close($fh);
                    148: 
                    149: sub check_activedc {
                    150:     my ($dcdom,$dcname,$defdom) = @_;
                    151:     my %dumphash=
                    152:             &Apache::lonnet::dump('roles',$dcdom,$dcname);
                    153:     my $now=time;
                    154:     my $activedc = 0;
                    155:     foreach my $item (keys %dumphash) {
                    156:         my ($domain,$role) = ($item =~ m-^/([^/]+)/[^_]*_(\w+)$-);
                    157:         if ($role eq 'dc' && $domain eq $defdom) {
                    158:             my ($trole,$tend,$tstart)=split(/_/,$dumphash{$item});
                    159:             if (($tend) && ($tend<$now)) { next; }
                    160:             if (($tstart) && ($now<$tstart)) { next; }
                    161:             $activedc = 1;
                    162:             last;
                    163:         }
                    164:     }
                    165:     return $activedc;
                    166: }
1.3       raeburn   167: 
                    168: sub set_permissions {
                    169:     my ($permissionflags,$permissions) = @_;
                    170:     foreach my $allowtype (@{$permissions}) {
1.4       raeburn   171:         unless($env{"allowed.$allowtype"}) {
                    172:             $env{"allowed.$allowtype"} = 'F';
1.3       raeburn   173:             $permissionflags{$allowtype} = 1;
                    174:         }
                    175:     }
                    176: }
                    177: 
                    178: sub unset_permissions {
                    179:     my ($permissionflags) = @_;
                    180:     foreach my $allowtype (keys %{$permissionflags}) {
1.4       raeburn   181:         delete($env{"allowed.$allowtype"});
1.3       raeburn   182:     }
                    183: }

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>