[BACK]Return to loncommon.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / interface

Diff for /loncom/interface/loncommon.pm between versions 1.1330 and 1.1355

version 1.1330, 2019/05/03 00:35:46 version 1.1355, 2021/03/30 23:19:23
Line 80  use Text::Aspell; Line 80  use Text::Aspell;
 use Authen::Captcha;  use Authen::Captcha;
 use Captcha::reCAPTCHA;  use Captcha::reCAPTCHA;
 use JSON::DWIW;  use JSON::DWIW;
 use LWP::UserAgent;  
 use Crypt::DES;  use Crypt::DES;
 use DynaLoader; # for Crypt::DES version  use DynaLoader; # for Crypt::DES version
 use MIME::Lite;  use MIME::Lite;
Line 436  sub studentbrowser_javascript { Line 435  sub studentbrowser_javascript {
 <script type="text/javascript" language="Javascript">  <script type="text/javascript" language="Javascript">
 // <![CDATA[  // <![CDATA[
     var stdeditbrowser;      var stdeditbrowser;
     function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadvonly) {      function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadv) {
         var url = '/adm/pickstudent?';          var url = '/adm/pickstudent?';
         var filter;          var filter;
  if (!ignorefilter) {   if (!ignorefilter) {
Line 451  sub studentbrowser_javascript { Line 450  sub studentbrowser_javascript {
                                     '&udomelement='+udom+                                      '&udomelement='+udom+
                                     '&clicker='+clicker;                                      '&clicker='+clicker;
  if (roleflag) { url+="&roles=1"; }   if (roleflag) { url+="&roles=1"; }
         if (courseadvonly) { url+="&courseadvonly=1"; }          if (courseadv == 'condition') {
               if (document.getElementById('courseadv')) {
                   courseadv = document.getElementById('courseadv').value;
               }
           }
           if ((courseadv == 'only') || (courseadv == 'none')) { url+="&courseadv="+courseadv; }
         var title = 'Student_Browser';          var title = 'Student_Browser';
         var options = 'scrollbars=1,resizable=1,menubar=0';          var options = 'scrollbars=1,resizable=1,menubar=0';
         options += ',width=700,height=600';          options += ',width=700,height=600';
Line 483  ENDRESBRW Line 487  ENDRESBRW
 }  }
   
 sub selectstudent_link {  sub selectstudent_link {
    my ($form,$unameele,$udomele,$courseadvonly,$clickerid)=@_;     my ($form,$unameele,$udomele,$courseadv,$clickerid)=@_;
    my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".     my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
                       &Apache::lonhtmlcommon::entity_encode($unameele)."','".                        &Apache::lonhtmlcommon::entity_encode($unameele)."','".
                       &Apache::lonhtmlcommon::entity_encode($udomele)."'";                        &Apache::lonhtmlcommon::entity_encode($udomele)."'";
Line 494  sub selectstudent_link { Line 498  sub selectstudent_link {
    return '';     return '';
        }         }
        $callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";         $callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";
        if ($courseadvonly)  {         if ($courseadv eq 'only') {
            $callargs .= ",'',1,1";             $callargs .= ",'',1,'$courseadv'";
          } elsif ($courseadv eq 'none') {
              $callargs .= ",'','','$courseadv'";
          } elsif ($courseadv eq 'condition') {
              $callargs .= ",'','','$courseadv'";
        }         }
        return '<span class="LC_nobreak">'.         return '<span class="LC_nobreak">'.
               '<a href="javascript:openstdbrowser('.$callargs.');">'.                '<a href="javascript:openstdbrowser('.$callargs.');">'.
Line 3567  sub get_assignable_auth { Line 3575  sub get_assignable_auth {
     return ($authnum,%can_assign);      return ($authnum,%can_assign);
 }  }
   
   sub check_passwd_rules {
       my ($domain,$plainpass) = @_;
       my %passwdconf = &Apache::lonnet::get_passwdconf($domain);
       my ($min,$max,@chars,@brokerule,$warning);
       $min = $Apache::lonnet::passwdmin;
       if (ref($passwdconf{'chars'}) eq 'ARRAY') {
           if ($passwdconf{'min'} =~ /^\d+$/) {
               if ($passwdconf{'min'} > $min) {
                   $min = $passwdconf{'min'};
               }
           }
           if ($passwdconf{'max'} =~ /^\d+$/) {
               $max = $passwdconf{'max'};
           }
           @chars = @{$passwdconf{'chars'}};
       }
       if (($min) && (length($plainpass) < $min)) {
           push(@brokerule,'min');
       }
       if (($max) && (length($plainpass) > $max)) {
           push(@brokerule,'max');
       }
       if (@chars) {
           my %rules;
           map { $rules{$_} = 1; } @chars;
           if ($rules{'uc'}) {
               unless ($plainpass =~ /[A-Z]/) {
                   push(@brokerule,'uc');
               }
           }
           if ($rules{'lc'}) {
               unless ($plainpass =~ /[a-z]/) {
                   push(@brokerule,'lc');
               }
           }
           if ($rules{'num'}) {
               unless ($plainpass =~ /\d/) {
                   push(@brokerule,'num');
               }
           }
           if ($rules{'spec'}) {
               unless ($plainpass =~ /[!"#$%&'()*+,\-.\/:;<=>?@[\\\]^_`{|}~]/) {
                   push(@brokerule,'spec');
               }
           }
       }
       if (@brokerule) {
           my %rulenames = &Apache::lonlocal::texthash(
               uc   => 'At least one upper case letter',
               lc   => 'At least one lower case letter',
               num  => 'At least one number',
               spec => 'At least one non-alphanumeric',
           );
           $rulenames{'uc'} .= ': ABCDEFGHIJKLMNOPQRSTUVWXYZ';
           $rulenames{'lc'} .= ': abcdefghijklmnopqrstuvwxyz';
           $rulenames{'num'} .= ': 0123456789';
           $rulenames{'spec'} .= ': !&quot;\#$%&amp;\'()*+,-./:;&lt;=&gt;?@[\]^_\`{|}~';
           $rulenames{'min'} = &mt('Minimum password length: [_1]',$min);
           $rulenames{'max'} = &mt('Maximum password length: [_1]',$max);
           $warning = &mt('Password did not satisfy the following:').'<ul>';
           foreach my $rule ('min','max','uc','lc','num','spec') {
               if (grep(/^$rule$/,@brokerule)) {
                   $warning .= '<li>'.$rulenames{$rule}.'</li>';
               }
           }
           $warning .= '</ul>';
       }
       if (wantarray) {
           return @brokerule;
       }
       return $warning;
   }
   
 ###############################################################  ###############################################################
 ##    Get Kerberos Defaults for Domain                 ##  ##    Get Kerberos Defaults for Domain                 ##
 ###############################################################  ###############################################################
Line 4812  sub get_student_view_with_retries { Line 4893  sub get_student_view_with_retries {
     }      }
 }  }
   
   sub css_links {
       my ($currsymb,$level) = @_;
       my ($links,@symbs,%cssrefs,%httpref);
       if ($level eq 'map') {
           my $navmap = Apache::lonnavmaps::navmap->new();
           if (ref($navmap)) {
               my ($map,undef,$url)=&Apache::lonnet::decode_symb($currsymb);
               my @resources = $navmap->retrieveResources($map,sub { $_[0]->is_problem() },0,0);
               foreach my $res (@resources) {
                   if (ref($res) && $res->symb()) {
                       push(@symbs,$res->symb());
                   }
               }
           }
       } else {
           @symbs = ($currsymb);
       }
       foreach my $symb (@symbs) {
           my $css_href = &Apache::lonnet::EXT('resource.0.cssfile',$symb);
           if ($css_href =~ /\S/) {
               unless ($css_href =~ m{https?://}) {
                   my $url = (&Apache::lonnet::decode_symb($symb))[-1];
                   my $proburl =  &Apache::lonnet::clutter($url);
                   my ($probdir) = ($proburl =~ m{(.+)/[^/]+$});
                   unless ($css_href =~ m{^/}) {
                       $css_href = &Apache::lonnet::hreflocation($probdir,$css_href);
                   }
                   if ($css_href =~ m{^/(res|uploaded)/}) {
                       unless (($httpref{'httpref.'.$css_href}) ||
                               (&Apache::lonnet::is_on_map($css_href))) {
                           my $thisurl = $proburl;
                           if ($env{'httpref.'.$proburl}) {
                               $thisurl = $env{'httpref.'.$proburl};
                           }
                           $httpref{'httpref.'.$css_href} = $thisurl;
                       }
                   }
               }
               $cssrefs{$css_href} = 1;
           }
       }
       if (keys(%httpref)) {
           &Apache::lonnet::appenv(\%httpref);
       }
       if (keys(%cssrefs)) {
           foreach my $css_href (keys(%cssrefs)) {
               next unless ($css_href =~ m{^(/res/|/uploaded/|https?://)});
               $links .= '<link rel="stylesheet" type="text/css" href="'.$css_href.'" />'."\n";
           }
       }
       return $links;
   }
   
 =pod  =pod
   
 =item * &get_student_answers()   =item * &get_student_answers() 
Line 5067  sub findallcourses { Line 5201  sub findallcourses {
 ###############################################  ###############################################
   
 sub blockcheck {  sub blockcheck {
     my ($setters,$activity,$uname,$udom,$url,$is_course) = @_;      my ($setters,$activity,$uname,$udom,$url,$is_course,$symb,$caller) = @_;
   
     if (defined($udom) && defined($uname)) {      if (defined($udom) && defined($uname)) {
         # If uname and udom are for a course, check for blocks in the course.          # If uname and udom are for a course, check for blocks in the course.
         if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) {          if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) {
             my ($startblock,$endblock,$triggerblock) =              my ($startblock,$endblock,$triggerblock) =
                 &get_blocks($setters,$activity,$udom,$uname,$url);                  &get_blocks($setters,$activity,$udom,$uname,$url,$symb,$caller);
             return ($startblock,$endblock,$triggerblock);              return ($startblock,$endblock,$triggerblock);
         }          }
     } else {      } else {
Line 5091  sub blockcheck { Line 5225  sub blockcheck {
   
     if (($activity eq 'boards' || $activity eq 'chat' ||      if (($activity eq 'boards' || $activity eq 'chat' ||
          $activity eq 'groups' || $activity eq 'printout' ||           $activity eq 'groups' || $activity eq 'printout' ||
          $activity eq 'reinit' || $activity eq 'alert') &&           $activity eq 'search' || $activity eq 'reinit' ||
            $activity eq 'alert') &&
         ($env{'request.course.id'})) {          ($env{'request.course.id'})) {
         foreach my $key (keys(%live_courses)) {          foreach my $key (keys(%live_courses)) {
             if ($key ne $env{'request.course.id'}) {              if ($key ne $env{'request.course.id'}) {
Line 5201  sub blockcheck { Line 5336  sub blockcheck {
         # of specified user, unless user has 'evb' privilege.          # of specified user, unless user has 'evb' privilege.
   
         my ($start,$end,$trigger) =           my ($start,$end,$trigger) = 
             &get_blocks($setters,$activity,$cdom,$cnum,$url);              &get_blocks($setters,$activity,$cdom,$cnum,$url,$symb,$caller);
         if (($start != 0) &&           if (($start != 0) && 
             (($startblock == 0) || ($startblock > $start))) {              (($startblock == 0) || ($startblock > $start))) {
             $startblock = $start;              $startblock = $start;
Line 5221  sub blockcheck { Line 5356  sub blockcheck {
 }  }
   
 sub get_blocks {  sub get_blocks {
     my ($setters,$activity,$cdom,$cnum,$url) = @_;      my ($setters,$activity,$cdom,$cnum,$url,$symb,$caller) = @_;
     my $startblock = 0;      my $startblock = 0;
     my $endblock = 0;      my $endblock = 0;
     my $triggerblock = '';      my $triggerblock = '';
Line 5234  sub get_blocks { Line 5369  sub get_blocks {
     my $now = time;      my $now = time;
     my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);      my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
     if ($activity eq 'docs') {      if ($activity eq 'docs') {
         @blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks);          my ($blocked,$nosymbcache,$noenccheck);
           if (($caller eq 'blockedaccess') || ($caller eq 'blockingstatus')) {
               $blocked = 1;
               $nosymbcache = 1;
               $noenccheck = 1;
           }
           @blockers = &Apache::lonnet::has_comm_blocking('bre',$symb,$url,$nosymbcache,$noenccheck,$blocked,\%commblocks);
         foreach my $block (@blockers) {          foreach my $block (@blockers) {
             if ($block =~ /^firstaccess____(.+)$/) {              if ($block =~ /^firstaccess____(.+)$/) {
                 my $item = $1;                  my $item = $1;
Line 5362  sub parse_block_record { Line 5503  sub parse_block_record {
 }  }
   
 sub blocking_status {  sub blocking_status {
     my ($activity,$uname,$udom,$url,$is_course) = @_;      my ($activity,$uname,$udom,$url,$is_course,$symb,$caller) = @_;
     my %setters;      my %setters;
   
 # check for active blocking  # check for active blocking
     my ($startblock,$endblock,$triggerblock) =       my ($startblock,$endblock,$triggerblock) = 
         &blockcheck(\%setters,$activity,$uname,$udom,$url,$is_course);          &blockcheck(\%setters,$activity,$uname,$udom,$url,$is_course,$symb,$caller);
     my $blocked = 0;      my $blocked = 0;
     if ($startblock && $endblock) {      if ($startblock && $endblock) {
         $blocked = 1;          $blocked = 1;
Line 5378  sub blocking_status { Line 5519  sub blocking_status {
   
 # build a link to a popup window containing the details  # build a link to a popup window containing the details
     my $querystring  = "?activity=$activity";      my $querystring  = "?activity=$activity";
 # $uname and $udom decide whose portfolio the user is trying to look at  # $uname and $udom decide whose portfolio (or information page) the user is trying to look at
     if (($activity eq 'port') || ($activity eq 'passwd')) {      if (($activity eq 'port') || ($activity eq 'about') || ($activity eq 'passwd')) {
         $querystring .= "&amp;udom=$udom"      if ($udom =~ /^$match_domain$/);           $querystring .= "&amp;udom=$udom"      if ($udom =~ /^$match_domain$/); 
         $querystring .= "&amp;uname=$uname"    if ($uname =~ /^$match_username$/);          $querystring .= "&amp;uname=$uname"    if ($uname =~ /^$match_username$/);
     } elsif ($activity eq 'docs') {      } elsif ($activity eq 'docs') {
         $querystring .= '&amp;url='.&HTML::Entities::encode($url,'&"');          my $showurl = &Apache::lonenc::check_encrypt($url);
           $querystring .= '&amp;url='.&HTML::Entities::encode($showurl,'\'&"<>');
           if ($symb) {
               my $showsymb = &Apache::lonenc::check_encrypt($symb);
               $querystring .= '&amp;symb='.&HTML::Entities::encode($showsymb,'\'&"<>');
           }
     }      }
   
     my $output .= <<'END_MYBLOCK';      my $output .= <<'END_MYBLOCK';
Line 5408  END_MYBLOCK Line 5554  END_MYBLOCK
         $text = &mt('Printing Blocked');          $text = &mt('Printing Blocked');
     } elsif ($activity eq 'passwd') {      } elsif ($activity eq 'passwd') {
         $text = &mt('Password Changing Blocked');          $text = &mt('Password Changing Blocked');
       } elsif ($activity eq 'grades') {
           $text = &mt('Gradebook Blocked');
       } elsif ($activity eq 'search') {
           $text = &mt('Search Blocked');
     } elsif ($activity eq 'alert') {      } elsif ($activity eq 'alert') {
         $text = &mt('Checking Critical Messages Blocked');          $text = &mt('Checking Critical Messages Blocked');
     } elsif ($activity eq 'reinit') {      } elsif ($activity eq 'reinit') {
         $text = &mt('Checking Course Update Blocked');          $text = &mt('Checking Course Update Blocked');
       } elsif ($activity eq 'about') {
           $text = &mt('Access to User Information Pages Blocked');
     }      }
     $output .= <<"END_BLOCK";      $output .= <<"END_BLOCK";
 <div class='$class'>  <div class='$class'>
Line 5435  sub check_ip_acc { Line 5587  sub check_ip_acc {
     if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {      if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
         return 1;          return 1;
     }      }
     my $allowed;      my ($ip,$allowed);
     my $ip=$ENV{'REMOTE_ADDR'} || $clientip || $env{'request.host'};      if (($ENV{'REMOTE_ADDR'} eq '127.0.0.1') ||
           ($ENV{'REMOTE_ADDR'} eq &Apache::lonnet::get_host_ip($Apache::lonnet::perlvar{'lonHostID'}))) {
           $ip = $env{'request.host'} || $ENV{'REMOTE_ADDR'} || $clientip;
       } else {
           my $remote_ip = &Apache::lonnet::get_requestor_ip();
           $ip = $remote_ip || $env{'request.host'} || $clientip;
       }
   
     my $name;      my $name;
     my %access = (      my %access = (
Line 7185  table.LC_prior_tries td { Line 7343  table.LC_prior_tries td {
   padding: 6px;    padding: 6px;
 }  }
   
 .LC_answer_unknown {  .LC_answer_unknown,
   .LC_answer_warning {
   background: orange;    background: orange;
   color: black;    color: black;
   padding: 6px;    padding: 6px;
Line 8181  ul.LC_funclist li { Line 8340  ul.LC_funclist li {
  cursor:pointer;   cursor:pointer;
 }  }
   
   pre.LC_wordwrap {
     white-space: pre-wrap;
     white-space: -moz-pre-wrap;
     white-space: -pre-wrap;
     white-space: -o-pre-wrap;
     word-wrap: break-word;
   }
   
 /*  /*
   styles used for response display    styles used for response display
 */  */
Line 8431  ADDMETA Line 8598  ADDMETA
                 my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};                  my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};
                 unless (&Apache::lonnet::allowed('mau',$dom_in_use)) {                  unless (&Apache::lonnet::allowed('mau',$dom_in_use)) {
                     my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use);                      my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use);
                       my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
                       my ($offload,$offloadoth);
                     if (ref($domdefs{'offloadnow'}) eq 'HASH') {                      if (ref($domdefs{'offloadnow'}) eq 'HASH') {
                         my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};  
                         if ($domdefs{'offloadnow'}{$lonhost}) {                          if ($domdefs{'offloadnow'}{$lonhost}) {
                             my $newserver = &Apache::lonnet::spareserver(30000,undef,1,$dom_in_use);                              $offload = 1;
                             if (($newserver) && ($newserver ne $lonhost)) {                              if (($env{'user.domain'} ne '') && ($env{'user.domain'} ne $dom_in_use) &&
                                 my $numsec = 5;                                  (!(($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')))) {
                                 my $timeout = $numsec * 1000;                                  unless (&Apache::lonnet::shared_institution($env{'user.domain'})) {
                                 my ($newurl,$locknum,%locks,$msg);                                      $offloadoth = 1;
                                 if ($env{'request.role.adv'}) {                                      $dom_in_use = $env{'user.domain'};
                                     ($locknum,%locks) = &Apache::lonnet::get_locks();  
                                 }                                  }
                                 my $disable_submit = 0;                              }
                                 if ($requrl =~ /$LONCAPA::assess_re/) {                          }
                                     $disable_submit = 1;                      }
                       unless ($offload) {
                           if (ref($domdefs{'offloadoth'}) eq 'HASH') {
                               if ($domdefs{'offloadoth'}{$lonhost}) {
                                   if (($env{'user.domain'} ne '') && ($env{'user.domain'} ne $dom_in_use) &&
                                       (!(($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')))) {
                                       unless (&Apache::lonnet::shared_institution($env{'user.domain'})) {
                                           $offload = 1;
                                           $offloadoth = 1;
                                           $dom_in_use = $env{'user.domain'};
                                       }
                                 }                                  }
                                 if ($locknum) {                              }
                                     my @lockinfo = sort(values(%locks));                          }
                                     $msg = &mt('Once the following tasks are complete: ')."\\n".                      }
                                            join(", ",sort(values(%locks)))."\\n".                      if ($offload) {
                                            &mt('your session will be transferred to a different server, after you click "Roles".');                          my $newserver = &Apache::lonnet::spareserver(30000,undef,1,$dom_in_use);
                           if (($newserver eq '') && ($offloadoth)) {
                               my @domains = &Apache::lonnet::current_machine_domains();
                               if (($dom_in_use ne '') && (!grep(/^\Q$dom_in_use\E$/,@domains))) { 
                                   ($newserver) = &Apache::lonnet::choose_server($dom_in_use);
                               }
                           }
                           if (($newserver) && ($newserver ne $lonhost)) {
                               my $numsec = 5;
                               my $timeout = $numsec * 1000;
                               my ($newurl,$locknum,%locks,$msg);
                               if ($env{'request.role.adv'}) {
                                   ($locknum,%locks) = &Apache::lonnet::get_locks();
                               }
                               my $disable_submit = 0;
                               if ($requrl =~ /$LONCAPA::assess_re/) {
                                   $disable_submit = 1;
                               }
                               if ($locknum) {
                                   my @lockinfo = sort(values(%locks));
                                   $msg = &mt('Once the following tasks are complete:')." \n".
                                          join(", ",sort(values(%locks)))."\n";
                                   if (&show_course()) {
                                       $msg .= &mt('your session will be transferred to a different server, after you click "Courses".');
                                 } else {                                  } else {
                                     if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) {                                      $msg .= &mt('your session will be transferred to a different server, after you click "Roles".');
                                         $msg = &mt('Your LON-CAPA submission has been recorded')."\\n";                                  }
                                     }                              } else {
                                     $msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec);                                  if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) {
                                     $newurl = '/adm/switchserver?otherserver='.$newserver;                                      $msg = &mt('Your LON-CAPA submission has been recorded')."\n";
                                     if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) {                                  }
                                         $newurl .= '&role='.$env{'request.role'};                                  $msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec);
                                   $newurl = '/adm/switchserver?otherserver='.$newserver;
                                   if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) {
                                       $newurl .= '&role='.$env{'request.role'};
                                   }
                                   if ($env{'request.symb'}) {
                                       my $shownsymb = &Apache::lonenc::check_encrypt($env{'request.symb'});
                                       if ($shownsymb =~ m{^/enc/}) {
                                           my $reqdmajor = 2;
                                           my $reqdminor = 11;
                                           my $reqdsubminor = 3;
                                           my $newserverrev = &Apache::lonnet::get_server_loncaparev('',$newserver);
                                           my $remoterev = &Apache::lonnet::get_server_loncaparev(undef,$newserver);
                                           my ($major,$minor,$subminor) = ($remoterev =~ /^\'?(\d+)\.(\d+)\.(\d+|)[\w.\-]+\'?$/);
                                           if (($major eq '' && $minor eq '') ||
                                               (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)) ||
                                               (($reqdmajor == $major) && ($reqdminor == $minor) && (($subminor eq '') ||
                                                ($reqdsubminor > $subminor))))) {
                                               undef($shownsymb);
                                           }
                                     }                                      }
                                     if ($env{'request.symb'}) {                                      if ($shownsymb) {
                                         $newurl .= '&symb='.$env{'request.symb'};                                          &js_escape(\$shownsymb);
                                     } else {                                          $newurl .= '&symb='.$shownsymb;
                                         $newurl .= '&origurl='.$requrl;  
                                     }                                      }
                                   } else {
                                       my $shownurl = &Apache::lonenc::check_encrypt($requrl);
                                       &js_escape(\$shownurl);
                                       $newurl .= '&origurl='.$shownurl;
                                 }                                  }
                                 &js_escape(\$msg);                              }
                                 $result.=<<OFFLOAD                              &js_escape(\$msg);
                               $result.=<<OFFLOAD
 <meta http-equiv="pragma" content="no-cache" />  <meta http-equiv="pragma" content="no-cache" />
 <script type="text/javascript">  <script type="text/javascript">
 // <![CDATA[  // <![CDATA[
Line 8488  function LC_Offload_Now() { Line 8711  function LC_Offload_Now() {
 // ]]>  // ]]>
 </script>  </script>
 OFFLOAD  OFFLOAD
                             }  
                         }                          }
                     }                      }
                 }                  }
Line 8937  sub modal_link { Line 9159  sub modal_link {
         $target_attr = 'target="'.$target.'"';          $target_attr = 'target="'.$target.'"';
     }      }
     return <<"ENDLINK";      return <<"ENDLINK";
 <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">  <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">$linktext</a>
            $linktext</a>  
 ENDLINK  ENDLINK
 }  }
   
Line 15094  Inputs: Line 15315  Inputs:
   
 from -              Sender's email address  from -              Sender's email address
   
   replyto -           Reply-To email address
   
 to -                Email address of recipient  to -                Email address of recipient
   
 subject -           Subject of email  subject -           Subject of email
Line 15104  cc_string -         Carbon copy email ad Line 15327  cc_string -         Carbon copy email ad
   
 bcc -               Blind carbon copy email address  bcc -               Blind carbon copy email address
   
 type -              File type of attachment  
   
 attachment_path -   Path of file to be attached  attachment_path -   Path of file to be attached
   
 file_name -         Name of file to be attached  file_name -         Name of file to be attached
Line 15122  attachment_text -   The body of an attac Line 15343  attachment_text -   The body of an attac
 ############################################################  ############################################################
   
 sub mime_email {  sub mime_email {
     my ($from, $to, $subject, $body, $cc_string, $bcc, $attachment_path,       my ($from,$replyto,$to,$subject,$body,$cc_string,$bcc,$attachment_path, 
         $file_name, $attachment_text) = @_;          $file_name,$attachment_text) = @_;
    
     my $msg = MIME::Lite->new(      my $msg = MIME::Lite->new(
              From    => $from,               From    => $from,
              To      => $to,               To      => $to,
Line 15131  sub mime_email { Line 15353  sub mime_email {
              Type    =>'TEXT',               Type    =>'TEXT',
              Data    => $body,               Data    => $body,
              );               );
       if ($replyto ne '') {
           $msg->add("Reply-To" => $replyto);
       }
     if ($cc_string ne '') {      if ($cc_string ne '') {
         $msg->add("Cc" => $cc_string);          $msg->add("Cc" => $cc_string);
     }      }
Line 15729  sub check_clone { Line 15954  sub check_clone {
     my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};      my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
     my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);      my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
     my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);      my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
     my $clonemsg;      my $clonetitle;
       my @clonemsg;
     my $can_clone = 0;      my $can_clone = 0;
     my $lctype = lc($args->{'crstype'});      my $lctype = lc($args->{'crstype'});
     if ($lctype ne 'community') {      if ($lctype ne 'community') {
Line 15737  sub check_clone { Line 15963  sub check_clone {
     }      }
     if ($clonehome eq 'no_host') {      if ($clonehome eq 'no_host') {
         if ($args->{'crstype'} eq 'Community') {          if ($args->{'crstype'} eq 'Community') {
             $clonemsg = &mt('No new community created.').$linefeed.&mt('A new community could not be cloned from the specified original - [_1] - because it is a non-existent community.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});              push(@clonemsg,({
                                 mt => 'No new community created.',
                                 args => [],
                               },
                               {
                                 mt => 'A new community could not be cloned from the specified original - [_1] - because it is a non-existent community.',
                                 args => [$args->{'clonedomain'}.':'.$args->{'clonedomain'}],
                               }));
         } else {          } else {
             $clonemsg = &mt('No new course created.').$linefeed.&mt('A new course could not be cloned from the specified original - [_1] - because it is a non-existent course.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});              push(@clonemsg,({
         }                                     mt => 'No new course created.',
                                 args => [],
                               },
                               {
                                 mt => 'A new course could not be cloned from the specified original - [_1] - because it is a non-existent course.',
                                 args => [$args->{'clonecourse'}.':'.$args->{'clonedomain'}],
                               }));
           }
     } else {      } else {
  my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});   my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
           $clonetitle = $clonedesc{'description'};
         if ($args->{'crstype'} eq 'Community') {          if ($args->{'crstype'} eq 'Community') {
             if ($clonedesc{'type'} ne 'Community') {              if ($clonedesc{'type'} ne 'Community') {
                 $clonemsg = &mt('No new community created.').$linefeed.&mt('A new community could not be cloned from the specified original - [_1] - because it is a course not a community.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});                  push(@clonemsg,({
                 return ($can_clone, $clonemsg, $cloneid, $clonehome);                                    mt => 'No new community created.',
                                     args => [],
                                   },
                                   {
                                     mt => 'A new community could not be cloned from the specified original - [_1] - because it is a course not a community.',
                                     args => [$args->{'clonecourse'}.':'.$args->{'clonedomain'}],
                                   }));
                   return ($can_clone,\@clonemsg,$cloneid,$clonehome);
             }              }
         }          }
  if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&   if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
Line 15835  sub check_clone { Line 16083  sub check_clone {
             }              }
             unless ($can_clone) {              unless ($can_clone) {
                 if ($args->{'crstype'} eq 'Community') {                  if ($args->{'crstype'} eq 'Community') {
                     $clonemsg = &mt('No new community created.').$linefeed.&mt('The new community could not be cloned from the existing community because the new community owner ([_1]) does not have cloning rights in the existing community ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});                      push(@clonemsg,({
                                         mt => 'No new community created.',
                                         args => [],
                                       },
                                       {
                                         mt => 'The new community could not be cloned from the existing community because the new community owner ([_1]) does not have cloning rights in the existing community ([_2]).',
                                         args => [$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}],
                                       }));
                 } else {                  } else {
                     $clonemsg = &mt('No new course created.').$linefeed.&mt('The new course could not be cloned from the existing course because the new course owner ([_1]) does not have cloning rights in the existing course ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});                      push(@clonemsg,({
                                         mt => 'No new course created.',
                                         args => [],
                                       },
                                       {
                                         mt => 'The new course could not be cloned from the existing course because the new course owner ([_1]) does not have cloning rights in the existing course ([_2]).',
                                         args => [$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}],
                                       }));
                 }                  }
     }      }
         }          }
     }      }
     return ($can_clone, $clonemsg, $cloneid, $clonehome);      return ($can_clone,\@clonemsg,$cloneid,$clonehome,$clonetitle);
 }  }
   
 sub construct_course {  sub construct_course {
     my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,      my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,
         $cnum,$category,$coderef) = @_;          $cnum,$category,$coderef,$callercontext,$user_lh) = @_;
     my $outcome;      my ($outcome,$msgref,$clonemsgref);
     my $linefeed =  '<br />'."\n";      my $linefeed =  '<br />'."\n";
     if ($context eq 'auto') {      if ($context eq 'auto') {
         $linefeed = "\n";          $linefeed = "\n";
Line 15857  sub construct_course { Line 16119  sub construct_course {
 #  #
 # Are we cloning?  # Are we cloning?
 #  #
     my ($can_clone, $clonemsg, $cloneid, $clonehome);      my ($can_clone,$cloneid,$clonehome,$clonetitle);
     if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {      if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
  ($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);   ($can_clone,$clonemsgref,$cloneid,$clonehome,$clonetitle) = &check_clone($args,$linefeed);
  if ($context ne 'auto') {  
             if ($clonemsg ne '') {  
         $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';  
             }  
  }  
  $outcome .= $clonemsg.$linefeed;  
   
         if (!$can_clone) {          if (!$can_clone) {
     return (0,$outcome);      return (0,$outcome,$clonemsgref);
  }   }
     }      }
   
Line 15891  sub construct_course { Line 16146  sub construct_course {
                                              $args->{'ccuname'}.':'.                                               $args->{'ccuname'}.':'.
                                              $args->{'ccdomain'},                                               $args->{'ccdomain'},
                                              $args->{'crstype'},                                               $args->{'crstype'},
                                              $cnum,$context,$category);                                               $cnum,$context,$category,
                                                $callercontext);
   
     # Note: The testing routines depend on this being output; see       # Note: The testing routines depend on this being output; see 
     # Utils::Course. This needs to at least be output as a comment      # Utils::Course. This needs to at least be output as a comment
     # if anyone ever decides to not show this, and Utils::Course::new      # if anyone ever decides to not show this, and Utils::Course::new
     # will need to be suitably modified.      # will need to be suitably modified.
     $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$showncrstype,$$courseid).$linefeed;      if (($callercontext eq 'auto') && ($user_lh ne '')) {
           $outcome .= &mt_user($user_lh,'New LON-CAPA [_1] ID: [_2]',$showncrstype,$$courseid).$linefeed;
       } else {
           $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$showncrstype,$$courseid).$linefeed;
       }
     if ($$courseid =~ /^error:/) {      if ($$courseid =~ /^error:/) {
         return (0,$outcome);          return (0,$outcome,$clonemsgref);
     }      }
   
 #  #
Line 15908  sub construct_course { Line 16168  sub construct_course {
     ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);      ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
     my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);      my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
     if ($crsuhome eq 'no_host') {      if ($crsuhome eq 'no_host') {
         $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;          if (($callercontext eq 'auto') && ($user_lh ne '')) {
         return (0,$outcome);              $outcome .= &mt_user($user_lh,
                               'Course creation failed, unrecognized course home server.');
           } else {
               $outcome .= &mt('Course creation failed, unrecognized course home server.');
           }
           $outcome .= $linefeed;
           return (0,$outcome,$clonemsgref);
     }      }
     $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;      $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
   
 #  #
 # Do the cloning  # Do the cloning
 #     #   
       my @clonemsg;
     if ($can_clone && $cloneid) {      if ($can_clone && $cloneid) {
  $clonemsg = &mt('Cloning [_1] from [_2]',$showncrstype,$clonehome);          push(@clonemsg,
  if ($context ne 'auto') {                        {
     $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';                            mt => 'Created [_1] by cloning from [_2]',
  }                            args => [$showncrstype,$clonetitle],
  $outcome .= $clonemsg.$linefeed;                        });
  my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);   my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
 # Copy all files  # Copy all files
  &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});          my @info =
       &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},
                                                $args->{'dateshift'},$args->{'crscode'},
                                                        $args->{'ccuname'}.':'.$args->{'ccdomain'},
                                                        $args->{'tinyurls'});
           if (@info) {
               push(@clonemsg,@info);
           }
 # Restore URL  # Restore URL
  $cenv{'url'}=$oldcenv{'url'};   $cenv{'url'}=$oldcenv{'url'};
 # Restore title  # Restore title
Line 15949  sub construct_course { Line 16223  sub construct_course {
                    'plc.users.denied',                     'plc.users.denied',
                    'hidefromcat',                     'hidefromcat',
                    'checkforpriv',                     'checkforpriv',
                    'categories',                     'categories'],
                    'internal.uniquecode'],  
                    $$crsudom,$$crsunum);                     $$crsudom,$$crsunum);
         if ($args->{'textbook'}) {          if ($args->{'textbook'}) {
             $cenv{'internal.textbook'} = $args->{'textbook'};              $cenv{'internal.textbook'} = $args->{'textbook'};
Line 16191  sub construct_course { Line 16464  sub construct_course {
 # Open all assignments  # Open all assignments
 #  #
     if ($args->{'openall'}) {      if ($args->{'openall'}) {
          my $opendate = time;
          if ($args->{'openallfrom'} =~ /^\d+$/) {
              $opendate = $args->{'openallfrom'};
          }
        my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';         my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
        my %storecontent = ($storeunder         => time,         my %storecontent = ($storeunder         => $opendate,
                            $storeunder.'.type' => 'date_start');                             $storeunder.'.type' => 'date_start');
                 $outcome .= &mt('All assignments open starting [_1]',
        $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput                         &Apache::lonlocal::locallocaltime($opendate)).': '.
                  ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;                     &Apache::lonnet::cput
                          ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
    }     }
 #  #
 # Set first page  # Set first page
Line 16250  sub construct_course { Line 16528  sub construct_course {
                  ('resourcedata',\%storecontent,$$crsudom,$$crsunum);                    ('resourcedata',\%storecontent,$$crsudom,$$crsunum); 
     }      }
   
     return (1,$outcome);      return (1,$outcome,\@clonemsg);
 }  }
   
 sub make_unique_code {  sub make_unique_code {
Line 16539  sub init_user_environment { Line 16817  sub init_user_environment {
 # --------------------------------------------------------- Write first profile  # --------------------------------------------------------- Write first profile
   
     {      {
           my $ip = &Apache::lonnet::get_requestor_ip($r);
  my %initial_env =    my %initial_env = 
     ("user.name"          => $username,      ("user.name"          => $username,
      "user.domain"        => $domain,       "user.domain"        => $domain,
Line 16557  sub init_user_environment { Line 16836  sub init_user_environment {
      "request.course.sec" => '',       "request.course.sec" => '',
      "request.role"       => 'cm',       "request.role"       => 'cm',
      "request.role.adv"   => $env{'user.adv'},       "request.role.adv"   => $env{'user.adv'},
      "request.host"       => $ENV{'REMOTE_ADDR'},);       "request.host"       => $ip,);
   
         if ($form->{'localpath'}) {          if ($form->{'localpath'}) {
     $initial_env{"browser.localpath"}  = $form->{'localpath'};      $initial_env{"browser.localpath"}  = $form->{'localpath'};
Line 17896  sub create_recaptcha { Line 18175  sub create_recaptcha {
 sub check_recaptcha {  sub check_recaptcha {
     my ($privkey,$version) = @_;      my ($privkey,$version) = @_;
     my $captcha_chk;      my $captcha_chk;
       my $ip = &Apache::lonnet::get_requestor_ip();
     if ($version >= 2) {      if ($version >= 2) {
         my %info = (          my %info = (
                      secret   => $privkey,                        secret   => $privkey, 
                      response => $env{'form.g-recaptcha-response'},                       response => $env{'form.g-recaptcha-response'},
                      remoteip => $ENV{'REMOTE_ADDR'},                       remoteip => $ip,
                    );                     );
         my $request=new HTTP::Request('POST','https://www.google.com/recaptcha/api/siteverify');          my $request=new HTTP::Request('POST','https://www.google.com/recaptcha/api/siteverify');
         $request->content(join('&',map {          $request->content(join('&',map {
Line 17923  sub check_recaptcha { Line 18203  sub check_recaptcha {
         my $captcha_result =          my $captcha_result =
             $captcha->check_answer(              $captcha->check_answer(
                                     $privkey,                                      $privkey,
                                     $ENV{'REMOTE_ADDR'},                                      $ip,
                                     $env{'form.recaptcha_challenge_field'},                                      $env{'form.recaptcha_challenge_field'},
                                     $env{'form.recaptcha_response_field'},                                      $env{'form.recaptcha_response_field'},
                                   );                                    );
Line 18056  sub des_decrypt { Line 18336  sub des_decrypt {
     return $plaintext;      return $plaintext;
 }  }
   
 sub make_short_symbs {  sub get_requested_shorturls {
     my ($cdom,$cnum,$navmap) = @_;      my ($cdom,$cnum,$navmap) = @_;
     return unless (ref($navmap));      return unless (ref($navmap));
     my ($numnew,@errors);      my ($numnew,$errors);
     my @toshorten = &Apache::loncommon::get_env_multiple('form.addtiny');      my @toshorten = &Apache::loncommon::get_env_multiple('form.addtiny');
     if (@toshorten) {      if (@toshorten) {
         my (%maps,%resources,%titles);          my (%maps,%resources,%titles);
         &Apache::loncourserespicker::enumerate_course_contents($navmap,\%maps,\%resources,\%titles,          &Apache::loncourserespicker::enumerate_course_contents($navmap,\%maps,\%resources,\%titles,
                                                                'shorturls',$cdom,$cnum);                                                                 'shorturls',$cdom,$cnum);
         my %tocreate;  
         if (keys(%resources)) {          if (keys(%resources)) {
               my %tocreate;
             foreach my $item (sort {$a <=> $b} (@toshorten)) {              foreach my $item (sort {$a <=> $b} (@toshorten)) {
                 my $symb = $resources{$item};                  my $symb = $resources{$item};
                 if ($symb) {                  if ($symb) {
                     $tocreate{$cnum.'&'.$symb} = 1;                      $tocreate{$cnum.'&'.$symb} = 1;
                 }                  }
             }              }
               if (keys(%tocreate)) {
                   ($numnew,$errors) = &make_short_symbs($cdom,$cnum,
                                                         \%tocreate);
               }
         }          }
       }
       return ($numnew,$errors);
   }
   
   sub make_short_symbs {
       my ($cdom,$cnum,$tocreateref,$lockuser) = @_;
       my ($numnew,@errors);
       if (ref($tocreateref) eq 'HASH') {
           my %tocreate = %{$tocreateref};
         if (keys(%tocreate)) {          if (keys(%tocreate)) {
             my %coursetiny = &Apache::lonnet::dump('tiny',$cdom,$cnum);              my %coursetiny = &Apache::lonnet::dump('tiny',$cdom,$cnum);
             my $su = Short::URL->new(no_vowels => 1);              my $su = Short::URL->new(no_vowels => 1);
Line 18081  sub make_short_symbs { Line 18374  sub make_short_symbs {
             my (%newunique,%addcourse,%courseonly,%failed);              my (%newunique,%addcourse,%courseonly,%failed);
             # get lock on tiny db              # get lock on tiny db
             my $now = time;              my $now = time;
               if ($lockuser eq '') {
                   $lockuser = $env{'user.name'}.':'.$env{'user.domain'};
               }
             my $lockhash = {              my $lockhash = {
                                 "lock\0$now" => $env{'user.name'}.                                  "lock\0$now" => $lockuser,
                                                 ':'.$env{'user.domain'},  
                             };                              };
             my $tries = 0;              my $tries = 0;
             my $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom);              my $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom);
Removed from v.1.1330  
changed lines
  Added in v.1.1355

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