Return to Autocreate.pl CVS log

Up to [LON-CAPA] / loncom / automation

- Bug 6400
  Options for transfer or creation of tiny URLs when cloning.

    1: #!/usr/bin/perl
    2: #
    3: # Automated Course Creation script
    4: #
    5: # $Id: Autocreate.pl,v 1.22 2020/07/01 20:09:03 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:             &set_dc_env($dcname,$dcdom,$defdom);
  114:             my @permissions = ('mau','ccc','cin','cta','cep','ccr','cst');
  115:             my %permissionflags = ();
  116:             &set_permissions(\%permissionflags,\@permissions);
  117:             my $output = &process_xml($fh,$defdom,$dcname,$dcdom);
  118:             &unset_permissions(\%permissionflags);
  119:             &unset_dc_env();
  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'};
  134:                 my ($dcname,$dcdom);
  135:                 if ($settings->{'xmldc'}) {
  136:                     ($dcname,$dcdom) = split(':',$settings->{'xmldc'});
  137:                 }
  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'}) {
  151:                     &set_dc_env($dcname,$dcdom);
  152:                     my $output = &Apache::loncoursequeueadmin::process_official_reqs('auto',$dom,$dcname,$dcdom);
  153:                     &unset_dc_env();
  154:                     if ($output) {
  155:                         print $fh $output;
  156:                     }
  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) = @_;
  168:     &set_dc_env($dcname,$dcdom,$dom);
  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";
  178:     my ($result,$logmsg,$clonemsg,$keysmsg,$codesref,$instcodesref) =
  179:         &LONCAPA::batchcreatecourse::create_courses(\@requests,\%courseids,'auto',$dom,$dcname,$dcdom);
  180:     my $outcome;
  181:     if ($result ne '') {
  182:         $outcome = $result."\n";
  183:     }
  184:     if ($logmsg ne '') {
  185:         $outcome .= $logmsg."\n";    
  186:     }
  187:     if ($keysmsg ne '') {
  188:         $outcome .=  $keysmsg."\n";
  189:     }
  190:     if ($clonemsg ne '') {
  191:         $outcome .= $clonemsg."\n";
  192:     }
  193:     print $fh $outcome;
  194: 
  195:     my $output;
  196: # Copy requests from pending directory to processed directory and unlink.
  197:     foreach my $request (@requests) {  
  198:         if ((-e "$batchdir/pending/$request") && $request !~ /\.\./ && $request ne '' &&$request ne './') {
  199:             open(FILE,"<$batchdir/pending/$request");
  200:             my @buffer = <FILE>;
  201:             close(FILE);
  202:             if (!-e "$batchdir/processed") {
  203:                 mkdir("$batchdir/processed", 0755);
  204:             }
  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:     }
  213:     foreach my $key (sort(keys(%courseids))) {
  214:         print $fh "created course: $key - $courseids{$key}\n";
  215:         my $newcourse = &LONCAPA::escape($key.':'.$courseids{$key});
  216:         $output .= $newcourse.':';
  217:     }
  218:     $output =~ s/:$//;
  219:     &unset_dc_env();
  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:     }
  236:     return $output;
  237: }
  238: 
  239: sub check_activedc {
  240:     my ($dcdom,$dcname,$defdom) = @_;
  241:     my %roleshash = 
  242:         &Apache::lonnet::get_my_roles($dcname,$dcdom,'userroles',undef,['dc'],[$defdom]);
  243:     if (keys(%roleshash) > 0) {
  244:         return 1;
  245:     }
  246:     return 0;
  247: }
  248: 
  249: sub set_permissions {
  250:     my ($permissionflags,$permissions) = @_;
  251:     foreach my $allowtype (@{$permissions}) {
  252:         unless($env{"allowed.$allowtype"}) {
  253:             $env{"allowed.$allowtype"} = 'F';
  254:             $permissionflags->{$allowtype} = 1;
  255:         }
  256:     }
  257: }
  258: 
  259: sub unset_permissions {
  260:     my ($permissionflags) = @_;
  261:     foreach my $allowtype (keys(%{$permissionflags})) {
  262:         delete($env{"allowed.$allowtype"});
  263:     }
  264: }
  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;
  273:     }
  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: }