--- loncom/interface/loncommon.pm 2015/03/06 23:05:07 1.1075.2.87 +++ loncom/interface/loncommon.pm 2016/09/01 01:27:25 1.1075.2.111 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.1075.2.87 2015/03/06 23:05:07 raeburn Exp $ +# $Id: loncommon.pm,v 1.1075.2.111 2016/09/01 01:27:25 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -72,9 +72,12 @@ use Apache::lonuserstate(); use Apache::courseclassifier(); use LONCAPA qw(:DEFAULT :match); use DateTime::TimeZone; -use DateTime::Locale::Catalog; +use DateTime::Locale; +use Encode(); use Authen::Captcha; use Captcha::reCAPTCHA; +use JSON::DWIW; +use LWP::UserAgent; use Crypt::DES; use DynaLoader; # for Crypt::DES version @@ -532,7 +535,7 @@ ENDAUTHORBRW sub coursebrowser_javascript { my ($domainfilter,$sec_element,$formname,$role_element,$crstype, - $credits_element) = @_; + $credits_element,$instcode) = @_; my $wintitle = 'Course_Browser'; if ($crstype eq 'Community') { $wintitle = 'Community_Browser'; @@ -583,6 +586,12 @@ sub coursebrowser_javascript { var ownername = document.forms[formid].ccuname.value; var ownerdom = document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value; url += '&cloner='+ownername+':'+ownerdom; + if (type == 'Course') { + url += '&crscode='+document.forms[formid].crscode.value; + } + } + if (formname == 'requestcrs') { + url += '&crsdom=$domainfilter&crscode=$instcode'; } if (multflag !=null && multflag != '') { url += '&multiple='+multflag; @@ -958,15 +967,16 @@ sub select_datelocale { } $output .= '> '; } + my @languages = &Apache::lonlocal::preferred_languages(); my (@possibles,%locale_names); - my @locales = DateTime::Locale::Catalog::Locales; - foreach my $locale (@locales) { - if (ref($locale) eq 'HASH') { - my $id = $locale->{'id'}; - if ($id ne '') { - my $en_terr = $locale->{'en_territory'}; - my $native_terr = $locale->{'native_territory'}; - my @languages = &Apache::lonlocal::preferred_languages(); + my @locales = DateTime::Locale->ids(); + foreach my $id (@locales) { + if ($id ne '') { + my ($en_terr,$native_terr); + my $loc = DateTime::Locale->load($id); + if (ref($loc)) { + $en_terr = $loc->name(); + $native_terr = $loc->native_name(); if (grep(/^en$/,@languages) || !@languages) { if ($en_terr ne '') { $locale_names{$id} = '('.$en_terr.')'; @@ -980,7 +990,8 @@ sub select_datelocale { $locale_names{$id} = '('.$en_terr.')'; } } - push (@possibles,$id); + $locale_names{$id} = Encode::encode('UTF-8',$locale_names{$id}); + push(@possibles,$id); } } } @@ -991,7 +1002,7 @@ sub select_datelocale { } $output.=">$item"; if ($locale_names{$item} ne '') { - $output.=" $locale_names{$item}\n"; + $output.=' '.$locale_names{$item}; } $output.="\n"; } @@ -3721,8 +3732,13 @@ sub get_previous_attempt { my %lasthash=(); my $version; for ($version=1;$version<=$returnhash{'version'};$version++) { - foreach my $key (sort(split(/\:/,$returnhash{$version.':keys'}))) { - $lasthash{$key}=$returnhash{$version.':'.$key}; + foreach my $key (reverse(sort(split(/\:/,$returnhash{$version.':keys'})))) { + if ($key =~ /\.rawrndseed$/) { + my ($id) = ($key =~ /^(.+)\.rawrndseed$/); + $lasthash{$id.'.rndseed'} = $returnhash{$version.':'.$key}; + } else { + $lasthash{$key}=$returnhash{$version.':'.$key}; + } } } $prevattempts=&start_data_table().&start_data_table_header_row(); @@ -3842,9 +3858,15 @@ sub get_previous_attempt { } } else { if ($key =~ /\./) { - my $value = &format_previous_attempt_value($key, - $returnhash{$version.':'.$key}); - $prevattempts.=''.$value.' '; + my $value = $returnhash{$version.':'.$key}; + if ($key =~ /\.rndseed$/) { + my ($id) = ($key =~ /^(.+)\.rndseed$/); + if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) { + $value = $returnhash{$version.':'.$id.'.rawrndseed'}; + } + } + $prevattempts.=''.&format_previous_attempt_value($key,$value). + ' '; } else { $prevattempts.=' '; } @@ -3853,9 +3875,15 @@ sub get_previous_attempt { } else { foreach my $key (sort(keys(%lasthash))) { next if ($key =~ /\.foilorder$/); - my $value = &format_previous_attempt_value($key, - $returnhash{$version.':'.$key}); - $prevattempts.=''.$value.' '; + my $value = $returnhash{$version.':'.$key}; + if ($key =~ /\.rndseed$/) { + my ($id) = ($key =~ /^(.+)\.rndseed$/); + if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) { + $value = $returnhash{$version.':'.$id.'.rawrndseed'}; + } + } + $prevattempts.=''.&format_previous_attempt_value($key,$value). + ' '; } } $prevattempts.=&end_data_table_row(); @@ -4610,9 +4638,9 @@ sub blocking_status { # build a link to a popup window containing the details my $querystring = "?activity=$activity"; # $uname and $udom decide whose portfolio the user is trying to look at - if ($activity eq 'port') { - $querystring .= "&udom=$udom" if $udom; - $querystring .= "&uname=$uname" if $uname; + if (($activity eq 'port') || ($activity eq 'passwd')) { + $querystring .= "&udom=$udom" if ($udom =~ /^$match_domain$/); + $querystring .= "&uname=$uname" if ($uname =~ /^$match_username$/); } elsif ($activity eq 'docs') { $querystring .= '&url='.&HTML::Entities::encode($url,'&"'); } @@ -4631,13 +4659,17 @@ END_MYBLOCK my $popupUrl = "/adm/blockingstatus/$querystring"; my $text = &mt('Communication Blocked'); + my $class = 'LC_comblock'; if ($activity eq 'docs') { $text = &mt('Content Access Blocked'); + $class = ''; } elsif ($activity eq 'printout') { $text = &mt('Printing Blocked'); + } elsif ($activity eq 'passwd') { + $text = &mt('Password Changing Blocked'); } $output .= <<"END_BLOCK"; -
+
$text @@ -4653,13 +4685,13 @@ END_BLOCK ############################################### sub check_ip_acc { - my ($acc)=@_; + my ($acc,$clientip)=@_; &Apache::lonxml::debug("acc is $acc"); if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) { return 1; } my $allowed=0; - my $ip=$env{'request.host'} || $ENV{'REMOTE_ADDR'}; + my $ip=$ENV{'REMOTE_ADDR'} || $clientip || $env{'request.host'}; my $name; foreach my $pattern (split(',',$acc)) { @@ -5100,9 +5132,6 @@ Inputs: =item * $args, optional argument valid values are no_auto_mt_title -> prevents &mt()ing the title arg - inherit_jsmath -> when creating popup window in a page, - should it have jsmath forced on by the - current page =item * $advtoolsref, optional argument, ref to an array containing inlineremote items to be added in "Functions" menu below @@ -5170,7 +5199,7 @@ sub bodytag { # construct main body tag my $bodytag = "". - &Apache::lontexconvert::init_math_support($args->{'inherit_jsmath'}); + &Apache::lontexconvert::init_math_support(); &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']); @@ -5194,7 +5223,7 @@ sub bodytag { $dc_info =~ s/\s+$//; } - $role = '('.$role.')' if $role; + $role = '('.$role.')' if ($role && !$env{'browser.mobile'}); if ($env{'request.state'} eq 'construct') { $forcereg=1; } @@ -5397,7 +5426,6 @@ sub endbodytag { unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) { $endbodytag=''; } - $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag; if ( exists( $env{'internal.head.redirect'} ) ) { if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) { $endbodytag= @@ -5572,6 +5600,17 @@ div.LC_confirm_box .LC_success img { vertical-align: middle; } +.LC_maxwidth { + max-width: 100%; + height: auto; +} + +.LC_textsize_mobile { + \@media only screen and (max-device-width: 480px) { + -webkit-text-size-adjust:100%; -moz-text-size-adjust:100%; -ms-text-size-adjust:100%; + } +} + .LC_icon { border: none; vertical-align: middle; @@ -5693,6 +5732,10 @@ table#LC_menubuttons img { vertical-align: middle; } +.LC_breadcrumbs_hoverable { + background: $sidebg; +} + td.LC_table_cell_checkbox { text-align: center; } @@ -6676,6 +6719,10 @@ fieldset { /* overflow: hidden; */ } +article.geogebraweb div { + margin: 0; +} + fieldset > legend { font-weight: bold; padding: 0 5px 0 5px; @@ -7411,6 +7458,82 @@ sub headtag { ADDMETA + } else { + unless (($args->{'frameset'}) || ($args->{'js_ready'}) || ($args->{'only_body'}) || ($args->{'no_nav_bar'})) { + my $requrl = $env{'request.uri'}; + if ($requrl eq '') { + $requrl = $ENV{'REQUEST_URI'}; + $requrl =~ s/\?.+$//; + } + unless (($requrl =~ m{^/adm/(?:switchserver|login|authenticate|logout|groupsort|cleanup|helper|slotrequest|grades)(\?|$)}) || + (($requrl =~ m{^/res/}) && (($env{'form.submitted'} eq 'scantron') || + ($env{'form.grade_symb'}) || ($Apache::lonhomework::scantronmode)))) { + my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'}; + unless (&Apache::lonnet::allowed('mau',$dom_in_use)) { + my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use); + if (ref($domdefs{'offloadnow'}) eq 'HASH') { + my $lonhost = $Apache::lonnet::perlvar{'lonHostID'}; + if ($domdefs{'offloadnow'}{$lonhost}) { + my $newserver = &Apache::lonnet::spareserver(30000,undef,1,$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". + &mt('your session will be transferred to a different server, after you click "Roles".'); + } else { + if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) { + $msg = &mt('Your LON-CAPA submission has been recorded')."\\n"; + } + $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'}) { + $newurl .= '&symb='.$env{'request.symb'}; + } else { + $newurl .= '&origurl='.$requrl; + } + } + &js_escape(\$msg); + $result.=< + +OFFLOAD + } + } + } + } + } + } } if (!defined($title)) { $title = 'The LearningOnline Network with CAPA'; @@ -7424,7 +7547,13 @@ ADDMETA $result .= '>' .$inhibitprint .$head_extra; - if ($env{'browser.mobile'}) { + my $clientmobile; + if (($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) { + (undef,undef,undef,undef,undef,undef,$clientmobile) = &decode_user_agent(); + } else { + $clientmobile = $env{'browser.mobile'}; + } + if ($clientmobile) { $result .= ' '; @@ -7608,9 +7737,6 @@ $args - additional optional args support no_inline_link -> if true and in remote mode, don't show the 'Switch To Inline Menu' link no_auto_mt_title -> prevent &mt()ing the title arg - inherit_jsmath -> when creating popup window in a page, - should it have jsmath forced on by the - current page bread_crumbs -> Array containing breadcrumbs bread_crumbs_component -> if exists show it as headline else show only the breadcrumbs group -> includes the current group, if page is for a @@ -9123,7 +9249,7 @@ sub user_picker { } $srchterm = $srch->{'srchterm'}; } - my %lt=&Apache::lonlocal::texthash( + my %html_lt=&Apache::lonlocal::texthash( 'usr' => 'Search criteria', 'doma' => 'Domain/institution to search', 'uname' => 'username', @@ -9136,6 +9262,8 @@ sub user_picker { 'exact' => 'is', 'contains' => 'contains', 'begins' => 'begins with', + ); + my %js_lt=&Apache::lonlocal::texthash( 'youm' => "You must include some text to search for.", 'thte' => "The text you are searching for must contain at least two characters when using a 'begins' type search.", 'thet' => "The text you are searching for must contain at least three characters when using a 'contains' type search.", @@ -9145,6 +9273,8 @@ sub user_picker { 'whse' => "When searching by last,first you must include at least one character in the first name.", 'thfo' => "The following need to be corrected before the search can be run:", ); + &html_escape(\%html_lt); + &js_escape(\%js_lt); my $domform = &select_dom_form($currdom,'srchdomain',1,1); my $srchinsel = ' \n"; @@ -9171,10 +9301,10 @@ sub user_picker { foreach my $option ('lastname','lastfirst','uname') { if ($curr_selected{'srchby'} eq $option) { $srchbysel .= ' - '; + '; } else { $srchbysel .= ' - '; + '; } } $srchbysel .= "\n \n"; @@ -9183,10 +9313,10 @@ sub user_picker { foreach my $option ('begins','contains','exact') { if ($curr_selected{'srchtype'} eq $option) { $srchtypesel .= ' - '; + '; } else { $srchtypesel .= ' - '; + '; } } $srchtypesel .= "\n \n"; @@ -9271,46 +9401,46 @@ function validateEntry(callingForm) { if (srchterm == "") { checkok = 0; - msg += "$lt{'youm'}\\n"; + msg += "$js_lt{'youm'}\\n"; } if (srchtype== 'begins') { if (srchterm.length < 2) { checkok = 0; - msg += "$lt{'thte'}\\n"; + msg += "$js_lt{'thte'}\\n"; } } if (srchtype== 'contains') { if (srchterm.length < 3) { checkok = 0; - msg += "$lt{'thet'}\\n"; + msg += "$js_lt{'thet'}\\n"; } } if (srchin == 'instd') { if (srchdomain == '') { checkok = 0; - msg += "$lt{'yomc'}\\n"; + msg += "$js_lt{'yomc'}\\n"; } } if (srchin == 'dom') { if (srchdomain == '') { checkok = 0; - msg += "$lt{'ymcd'}\\n"; + msg += "$js_lt{'ymcd'}\\n"; } } if (srchby == 'lastfirst') { if (srchterm.indexOf(",") == -1) { checkok = 0; - msg += "$lt{'whus'}\\n"; + msg += "$js_lt{'whus'}\\n"; } if (srchterm.indexOf(",") == srchterm.length -1) { checkok = 0; - msg += "$lt{'whse'}\\n"; + msg += "$js_lt{'whse'}\\n"; } } if (checkok == 0) { - alert("$lt{'thfo'}\\n"+msg); + alert("$js_lt{'thfo'}\\n"+msg); return; } if (checkok == 1) { @@ -9328,10 +9458,10 @@ $new_user_create END_BLOCK $output .= &Apache::lonhtmlcommon::start_pick_box(). - &Apache::lonhtmlcommon::row_title($lt{'doma'}). + &Apache::lonhtmlcommon::row_title($html_lt{'doma'}). $domform. &Apache::lonhtmlcommon::row_closure(). - &Apache::lonhtmlcommon::row_title($lt{'usr'}). + &Apache::lonhtmlcommon::row_title($html_lt{'usr'}). $srchbysel. $srchtypesel. ''. @@ -9344,56 +9474,160 @@ END_BLOCK sub user_rule_check { my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_; - my $response; + my ($response,%inst_response); if (ref($usershash) eq 'HASH') { - foreach my $user (keys(%{$usershash})) { - my ($uname,$udom) = split(/:/,$user); - next if ($udom eq '' || $uname eq ''); - my ($id,$newuser); - if (ref($usershash->{$user}) eq 'HASH') { - $newuser = $usershash->{$user}->{'newuser'}; - $id = $usershash->{$user}->{'id'}; - } - my $inst_response; + if (keys(%{$usershash}) > 1) { + my (%by_username,%by_id,%userdoms); + my $checkid; if (ref($checks) eq 'HASH') { - if (defined($checks->{'username'})) { - ($inst_response,%{$inst_results->{$user}}) = - &Apache::lonnet::get_instuser($udom,$uname); - } elsif (defined($checks->{'id'})) { - ($inst_response,%{$inst_results->{$user}}) = - &Apache::lonnet::get_instuser($udom,undef,$id); + if ((!defined($checks->{'username'})) && (defined($checks->{'id'}))) { + $checkid = 1; + } + } + foreach my $user (keys(%{$usershash})) { + my ($uname,$udom) = split(/:/,$user); + if ($checkid) { + if (ref($usershash->{$user}) eq 'HASH') { + if ($usershash->{$user}->{'id'} ne '') { + $by_id{$udom}{$usershash->{$user}->{'id'}} = $uname; + $userdoms{$udom} = 1; + if (ref($inst_results) eq 'HASH') { + $inst_results->{$uname.':'.$udom} = {}; + } + } + } + } else { + $by_username{$udom}{$uname} = 1; + $userdoms{$udom} = 1; + if (ref($inst_results) eq 'HASH') { + $inst_results->{$uname.':'.$udom} = {}; + } + } + } + foreach my $udom (keys(%userdoms)) { + if (!$got_rules->{$udom}) { + my %domconfig = &Apache::lonnet::get_dom('configuration', + ['usercreation'],$udom); + if (ref($domconfig{'usercreation'}) eq 'HASH') { + foreach my $item ('username','id') { + if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') { + $$curr_rules{$udom}{$item} = + $domconfig{'usercreation'}{$item.'_rule'}; + } + } + } + $got_rules->{$udom} = 1; + } + } + if ($checkid) { + foreach my $udom (keys(%by_id)) { + my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_id{$udom},'id'); + if ($outcome eq 'ok') { + foreach my $id (keys(%{$by_id{$udom}})) { + my $uname = $by_id{$udom}{$id}; + $inst_response{$uname.':'.$udom} = $outcome; + } + if (ref($results) eq 'HASH') { + foreach my $uname (keys(%{$results})) { + if (exists($inst_response{$uname.':'.$udom})) { + $inst_response{$uname.':'.$udom} = $outcome; + $inst_results->{$uname.':'.$udom} = $results->{$uname}; + } + } + } + } } } else { - ($inst_response,%{$inst_results->{$user}}) = - &Apache::lonnet::get_instuser($udom,$uname); - return; + foreach my $udom (keys(%by_username)) { + my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_username{$udom}); + if ($outcome eq 'ok') { + foreach my $uname (keys(%{$by_username{$udom}})) { + $inst_response{$uname.':'.$udom} = $outcome; + } + if (ref($results) eq 'HASH') { + foreach my $uname (keys(%{$results})) { + $inst_results->{$uname.':'.$udom} = $results->{$uname}; + } + } + } + } } - if (!$got_rules->{$udom}) { - my %domconfig = &Apache::lonnet::get_dom('configuration', - ['usercreation'],$udom); - if (ref($domconfig{'usercreation'}) eq 'HASH') { - foreach my $item ('username','id') { - if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') { - $$curr_rules{$udom}{$item} = - $domconfig{'usercreation'}{$item.'_rule'}; + } elsif (keys(%{$usershash}) == 1) { + my $user = (keys(%{$usershash}))[0]; + my ($uname,$udom) = split(/:/,$user); + if (($udom ne '') && ($uname ne '')) { + if (ref($usershash->{$user}) eq 'HASH') { + if (ref($checks) eq 'HASH') { + if (defined($checks->{'username'})) { + ($inst_response{$user},%{$inst_results->{$user}}) = + &Apache::lonnet::get_instuser($udom,$uname); + } elsif (defined($checks->{'id'})) { + if ($usershash->{$user}->{'id'} ne '') { + ($inst_response{$user},%{$inst_results->{$user}}) = + &Apache::lonnet::get_instuser($udom,undef, + $usershash->{$user}->{'id'}); + } else { + ($inst_response{$user},%{$inst_results->{$user}}) = + &Apache::lonnet::get_instuser($udom,$uname); + } + } + } else { + ($inst_response{$user},%{$inst_results->{$user}}) = + &Apache::lonnet::get_instuser($udom,$uname); + return; + } + if (!$got_rules->{$udom}) { + my %domconfig = &Apache::lonnet::get_dom('configuration', + ['usercreation'],$udom); + if (ref($domconfig{'usercreation'}) eq 'HASH') { + foreach my $item ('username','id') { + if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') { + $$curr_rules{$udom}{$item} = + $domconfig{'usercreation'}{$item.'_rule'}; + } + } } + $got_rules->{$udom} = 1; } } - $got_rules->{$udom} = 1; + } else { + return; + } + } else { + return; + } + foreach my $user (keys(%{$usershash})) { + my ($uname,$udom) = split(/:/,$user); + next if (($udom eq '') || ($uname eq '')); + my $id; + if (ref($inst_results) eq 'HASH') { + if (ref($inst_results->{$user}) eq 'HASH') { + $id = $inst_results->{$user}->{'id'}; + } + } + if ($id eq '') { + if (ref($usershash->{$user})) { + $id = $usershash->{$user}->{'id'}; + } } foreach my $item (keys(%{$checks})) { if (ref($$curr_rules{$udom}) eq 'HASH') { if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') { if (@{$$curr_rules{$udom}{$item}} > 0) { - my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,$$curr_rules{$udom}{$item}); + my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item, + $$curr_rules{$udom}{$item}); foreach my $rule (@{$$curr_rules{$udom}{$item}}) { if ($rule_check{$rule}) { $$rulematch{$user}{$item} = $rule; - if ($inst_response eq 'ok') { + if ($inst_response{$user} eq 'ok') { if (ref($inst_results) eq 'HASH') { if (ref($inst_results->{$user}) eq 'HASH') { if (keys(%{$inst_results->{$user}}) == 0) { $$alerts{$item}{$udom}{$uname} = 1; + } elsif ($item eq 'id') { + if ($inst_results->{$user}->{'id'} eq '') { + $$alerts{$item}{$udom}{$uname} = 1; + } } } } @@ -9661,7 +9895,9 @@ reservable_now - ref to hash of student_ Keys in inner hash are: (a) symb: either blank or symb to which slot use is restricted. - (b) endreserve: end date of reservation period. + (b) endreserve: end date of reservation period. + (c) uniqueperiod: start,end dates when slot is to be uniquely + selected. sorted_future - ref to array of student_schedulable slots reservable in the future, ordered by start date of reservation period. @@ -9672,6 +9908,8 @@ future_reservable - ref to hash of stude Keys in inner hash are: (a) symb: either blank or symb to which slot use is restricted. (b) startreserve: start date of reservation period. + (c) uniqueperiod: start,end dates when slot is to be uniquely + selected. =back @@ -9725,6 +9963,10 @@ sub get_future_slots { my $startreserve = $slots{$slot}->{'startreserve'}; my $endreserve = $slots{$slot}->{'endreserve'}; my $symb = $slots{$slot}->{'symb'}; + my $uniqueperiod; + if (ref($slots{$slot}->{'uniqueperiod'}) eq 'ARRAY') { + $uniqueperiod = join(',',@{$slots{$slot}->{'uniqueperiod'}}); + } if (($startreserve < $now) && (!$endreserve || $endreserve > $now)) { my $lastres = $endreserve; @@ -9733,13 +9975,15 @@ sub get_future_slots { } $reservable_now{$slot} = { symb => $symb, - endreserve => $lastres + endreserve => $lastres, + uniqueperiod => $uniqueperiod, }; } elsif (($startreserve > $now) && (!$endreserve || $endreserve > $startreserve)) { $future_reservable{$slot} = { symb => $symb, - startreserve => $startreserve + startreserve => $startreserve, + uniqueperiod => $uniqueperiod, }; } } @@ -14001,33 +14245,91 @@ sub check_clone { (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) { $can_clone = 1; } else { - my %clonehash = &Apache::lonnet::get('environment',['cloners'], + my %clonehash = &Apache::lonnet::get('environment',['cloners','internal.coursecode'], $args->{'clonedomain'},$args->{'clonecourse'}); - my @cloners = split(/,/,$clonehash{'cloners'}); - if (grep(/^\*$/,@cloners)) { - $can_clone = 1; - } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) { - $can_clone = 1; + if ($clonehash{'cloners'} eq '') { + my %domdefs = &Apache::lonnet::get_domain_defaults($args->{'course_domain'}); + if ($domdefs{'canclone'}) { + unless ($domdefs{'canclone'} eq 'none') { + if ($domdefs{'canclone'} eq 'domain') { + if ($args->{'ccdomain'} eq $args->{'clonedomain'}) { + $can_clone = 1; + } + } elsif (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) && + ($args->{'clonedomain'} eq $args->{'course_domain'})) { + if (&Apache::lonnet::default_instcode_cloning($args->{'clonedomain'},$domdefs{'canclone'}, + $clonehash{'internal.coursecode'},$args->{'crscode'})) { + $can_clone = 1; + } + } + } + } } else { + my @cloners = split(/,/,$clonehash{'cloners'}); + if (grep(/^\*$/,@cloners)) { + $can_clone = 1; + } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) { + $can_clone = 1; + } elsif (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners)) { + $can_clone = 1; + } + unless ($can_clone) { + if (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) && + ($args->{'clonedomain'} eq $args->{'course_domain'})) { + my (%gotdomdefaults,%gotcodedefaults); + foreach my $cloner (@cloners) { + if (($cloner ne '*') && ($cloner !~ /^\*\:$match_domain$/) && + ($cloner !~ /^$match_username\:$match_domain$/) && ($cloner ne '')) { + my (%codedefaults,@code_order); + if (ref($gotcodedefaults{$args->{'clonedomain'}}) eq 'HASH') { + if (ref($gotcodedefaults{$args->{'clonedomain'}}{'defaults'}) eq 'HASH') { + %codedefaults = %{$gotcodedefaults{$args->{'clonedomain'}}{'defaults'}}; + } + if (ref($gotcodedefaults{$args->{'clonedomain'}}{'order'}) eq 'ARRAY') { + @code_order = @{$gotcodedefaults{$args->{'clonedomain'}}{'order'}}; + } + } else { + &Apache::lonnet::auto_instcode_defaults($args->{'clonedomain'}, + \%codedefaults, + \@code_order); + $gotcodedefaults{$args->{'clonedomain'}}{'defaults'} = \%codedefaults; + $gotcodedefaults{$args->{'clonedomain'}}{'order'} = \@code_order; + } + if (@code_order > 0) { + if (&Apache::lonnet::check_instcode_cloning(\%codedefaults,\@code_order, + $cloner,$clonehash{'internal.coursecode'}, + $args->{'crscode'})) { + $can_clone = 1; + last; + } + } + } + } + } + } + } + unless ($can_clone) { my $ccrole = 'cc'; if ($args->{'crstype'} eq 'Community') { $ccrole = 'co'; } - my %roleshash = - &Apache::lonnet::get_my_roles($args->{'ccuname'}, - $args->{'ccdomain'}, - 'userroles',['active'],[$ccrole], - [$args->{'clonedomain'}]); - if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) { + my %roleshash = + &Apache::lonnet::get_my_roles($args->{'ccuname'}, + $args->{'ccdomain'}, + 'userroles',['active'],[$ccrole], + [$args->{'clonedomain'}]); + if ($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) { $can_clone = 1; - } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},$args->{'ccuname'},$args->{'ccdomain'})) { + } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'}, + $args->{'ccuname'},$args->{'ccdomain'})) { $can_clone = 1; + } + } + unless ($can_clone) { + 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'}); } else { - 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'}); - } 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'}); - } + $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'}); } } } @@ -14300,6 +14602,9 @@ sub construct_course { if ($args->{'setcontent'}) { $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'}; } + if ($args->{'setcomment'}) { + $cenv{'comment.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'}; + } } if ($args->{'reshome'}) { $cenv{'reshome'}=$args->{'reshome'}.'/'; @@ -15241,11 +15546,18 @@ cloneruname - optional username of new c clonerudom - optional domain of new course owner -domcloner - Optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by, +domcloner - optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by, (used when DC is using course creation form) codetitles - reference to array of titles of components in institutional codes (official courses). +cc_clone - escaped comma separated list of courses for which course cloner has active CC role + (and so can clone automatically) + +reqcrsdom - domain of new course, where search_courses is used to identify potential courses to clone + +reqinstcode - institutional code of new course, where search_courses is used to identify potential + courses to clone Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type. @@ -15256,7 +15568,8 @@ Side Effects: None sub search_courses { - my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles) = @_; + my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles, + $cc_clone,$reqcrsdom,$reqinstcode) = @_; my (%courses,%showcourses,$cloner); if (($filter->{'ownerfilter'} ne '') || ($filter->{'ownerdomfilter'} ne '')) { @@ -15304,10 +15617,10 @@ sub search_courses { $filter->{'combownerfilter'}, $filter->{'coursefilter'}, undef,undef,$type,$regexpok,undef,undef, - undef,undef,$cloner,$env{'form.cc_clone'}, + undef,undef,$cloner,$cc_clone, $filter->{'cloneableonly'}, $createdbefore,$createdafter,undef, - $domcloner); + $domcloner,undef,$reqcrsdom,$reqinstcode); if (($filter->{'personfilter'} ne '') && ($filter->{'persondomfilter'} ne '')) { my $ccrole; if ($type eq 'Community') { @@ -15345,8 +15658,206 @@ sub search_courses { =back +=head1 Routines for version requirements for current course. + +=over 4 + +=item * &check_release_required() + +Compares required LON-CAPA version with version on server, and +if required version is newer looks for a server with the required version. + +Looks first at servers in user's owen domain; if none suitable, looks at +servers in course's domain are permitted to host sessions for user's domain. + +Inputs: + +$loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp) + +$courseid - Course ID of current course + +$rolecode - User's current role in course (for switchserver query string). + +$required - LON-CAPA version needed by course (format: Major.Minor). + + +Returns: + +$switchserver - query string tp append to /adm/switchserver call (if + current server's LON-CAPA version is too old. + +$warning - Message is displayed if no suitable server could be found. + =cut +sub check_release_required { + my ($loncaparev,$courseid,$rolecode,$required) = @_; + my ($switchserver,$warning); + if ($required ne '') { + my ($reqdmajor,$reqdminor) = ($required =~ /^(\d+)\.(\d+)$/); + my ($major,$minor) = ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/); + if ($reqdmajor ne '' && $reqdminor ne '') { + my $otherserver; + if (($major eq '' && $minor eq '') || + (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)))) { + my ($userdomserver) = &Apache::lonnet::choose_server($env{'user.domain'},undef,$required,1); + my $switchlcrev = + &Apache::lonnet::get_server_loncaparev($env{'user.domain'}, + $userdomserver); + my ($swmajor,$swminor) = ($switchlcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/); + if (($swmajor eq '' && $swminor eq '') || ($reqdmajor > $swmajor) || + (($reqdmajor == $swmajor) && ($reqdminor > $swminor))) { + my $cdom = $env{'course.'.$courseid.'.domain'}; + if ($cdom ne $env{'user.domain'}) { + my ($coursedomserver,$coursehostname) = &Apache::lonnet::choose_server($cdom,undef,$required,1); + my $serverhomeID = &Apache::lonnet::get_server_homeID($coursehostname); + my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID); + my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom); + my %udomdefaults = &Apache::lonnet::get_domain_defaults($env{'user.domain'}); + my $remoterev = &Apache::lonnet::get_server_loncaparev($serverhomedom,$coursedomserver); + my $canhost = + &Apache::lonnet::can_host_session($env{'user.domain'}, + $coursedomserver, + $remoterev, + $udomdefaults{'remotesessions'}, + $defdomdefaults{'hostedsessions'}); + + if ($canhost) { + $otherserver = $coursedomserver; + } else { + $warning = &mt('Requires LON-CAPA version [_1].',$env{'course.'.$courseid.'.internal.releaserequired'}).'
'. &mt("No suitable server could be found amongst servers in either your own domain or in the course's domain."); + } + } else { + $warning = &mt('Requires LON-CAPA version [_1].',$env{'course.'.$courseid.'.internal.releaserequired'}).'
'.&mt("No suitable server could be found amongst servers in your own domain (which is also the course's domain)."); + } + } else { + $otherserver = $userdomserver; + } + } + if ($otherserver ne '') { + $switchserver = 'otherserver='.$otherserver.'&role='.$rolecode; + } + } + } + return ($switchserver,$warning); +} + +=pod + +=item * &check_release_result() + +Inputs: + +$switchwarning - Warning message if no suitable server found to host session. + +$switchserver - query string to append to /adm/switchserver containing lonHostID + and current role. + +Returns: HTML to display with information about requirement to switch server. + Either displaying warning with link to Roles/Courses screen or + display link to switchserver. + +=cut + +sub check_release_result { + my ($switchwarning,$switchserver) = @_; + my $output = &start_page('Selected course unavailable on this server'). + '

'; + if ($switchwarning) { + $output .= $switchwarning.'
'; + if (&show_course()) { + $output .= &mt('Display courses'); + } else { + $output .= &mt('Display roles'); + } + $output .= ''; + } elsif ($switchserver) { + $output .= &mt('This course requires a newer version of LON-CAPA than is installed on this server.'). + '
'. + ''. + &mt('Switch Server'). + ''; + } + $output .= '

'.&end_page(); + return $output; +} + +=pod + +=item * &needs_coursereinit() + +Determine if course contents stored for user's session needs to be +refreshed, because content has changed since "Big Hash" last tied. + +Check for change is made if time last checked is more than 10 minutes ago +(by default). + +Inputs: + +$loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp) + +$interval (optional) - Time which may elapse (in s) between last check for content + change in current course. (default: 600 s). + +Returns: an array; first element is: + +=over 4 + +'switch' - if content updates mean user's session + needs to be switched to a server running a newer LON-CAPA version + +'update' - if course session needs to be refreshed (i.e., Big Hash needs to be reloaded) + on current server hosting user's session + +'' - if no action required. + +=back + +If first item element is 'switch': + +second item is $switchwarning - Warning message if no suitable server found to host session. + +third item is $switchserver - query string to append to /adm/switchserver containing lonHostID + and current role. + +otherwise: no other elements returned. + +=back + +=cut + +sub needs_coursereinit { + my ($loncaparev,$interval) = @_; + return() unless ($env{'request.course.id'} && $env{'request.course.tied'}); + my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; + my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; + my $now = time; + if ($interval eq '') { + $interval = 600; + } + if (($now-$env{'request.course.timechecked'})>$interval) { + my $lastchange = &Apache::lonnet::get_coursechange($cdom,$cnum); + &Apache::lonnet::appenv({'request.course.timechecked'=>$now}); + if ($lastchange > $env{'request.course.tied'}) { + my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired'); + if ($curr_reqd_hash{'internal.releaserequired'} ne '') { + my $required = $env{'course.'.$cdom.'_'.$cnum.'.internal.releaserequired'}; + if ($curr_reqd_hash{'internal.releaserequired'} ne $required) { + &Apache::lonnet::appenv({'course.'.$cdom.'_'.$cnum.'.internal.releaserequired' => + $curr_reqd_hash{'internal.releaserequired'}}); + my ($switchserver,$switchwarning) = + &check_release_required($loncaparev,$cdom.'_'.$cnum,$env{'request.role'}, + $curr_reqd_hash{'internal.releaserequired'}); + if ($switchwarning ne '' || $switchserver ne '') { + return ('switch',$switchwarning,$switchserver); + } + } + } + return ('update'); + } + } + return (); +} sub update_content_constraints { my ($cdom,$cnum,$chome,$cid) = @_; @@ -15529,29 +16040,30 @@ sub symb_to_docspath { sub captcha_display { my ($context,$lonhost) = @_; my ($output,$error); - my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost); + my ($captcha,$pubkey,$privkey,$version) = + &get_captcha_config($context,$lonhost); if ($captcha eq 'original') { $output = &create_captcha(); unless ($output) { $error = 'captcha'; } } elsif ($captcha eq 'recaptcha') { - $output = &create_recaptcha($pubkey); + $output = &create_recaptcha($pubkey,$version); unless ($output) { $error = 'recaptcha'; } } - return ($output,$error,$captcha); + return ($output,$error,$captcha,$version); } sub captcha_response { my ($context,$lonhost) = @_; my ($captcha_chk,$captcha_error); - my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost); + my ($captcha,$pubkey,$privkey,$version) = &get_captcha_config($context,$lonhost); if ($captcha eq 'original') { ($captcha_chk,$captcha_error) = &check_captcha(); } elsif ($captcha eq 'recaptcha') { - $captcha_chk = &check_recaptcha($privkey); + $captcha_chk = &check_recaptcha($privkey,$version); } else { $captcha_chk = 1; } @@ -15560,7 +16072,7 @@ sub captcha_response { sub get_captcha_config { my ($context,$lonhost) = @_; - my ($captcha,$pubkey,$privkey,$hashtocheck); + my ($captcha,$pubkey,$privkey,$version,$hashtocheck); my $hostname = &Apache::lonnet::hostname($lonhost); my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname); my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID); @@ -15576,6 +16088,10 @@ sub get_captcha_config { } if ($privkey && $pubkey) { $captcha = 'recaptcha'; + $version = $hashtocheck->{'recaptchaversion'}; + if ($version ne '2') { + $version = 1; + } } else { $captcha = 'original'; } @@ -15593,6 +16109,10 @@ sub get_captcha_config { $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'}; if ($privkey && $pubkey) { $captcha = 'recaptcha'; + $version = $domconfhash{$serverhomedom.'.login.recaptchaversion'}; + if ($version ne '2') { + $version = 1; + } } else { $captcha = 'original'; } @@ -15600,7 +16120,7 @@ sub get_captcha_config { $captcha = 'original'; } } - return ($captcha,$pubkey,$privkey); + return ($captcha,$pubkey,$privkey,$version); } sub create_captcha { @@ -15659,38 +16179,61 @@ sub check_captcha { } sub create_recaptcha { - my ($pubkey) = @_; - my $use_ssl; - if ($ENV{'SERVER_PORT'} == 443) { - $use_ssl = 1; - } - my $captcha = Captcha::reCAPTCHA->new; - return $captcha->get_options_setter({theme => 'white'})."\n". - $captcha->get_html($pubkey,undef,$use_ssl). - &mt('If either word is hard to read, [_1] will replace them.', - 'reCAPTCHA refresh'). - '

'; + my ($pubkey,$version) = @_; + if ($version >= 2) { + return '
'; + } else { + my $use_ssl; + if ($ENV{'SERVER_PORT'} == 443) { + $use_ssl = 1; + } + my $captcha = Captcha::reCAPTCHA->new; + return $captcha->get_options_setter({theme => 'white'})."\n". + $captcha->get_html($pubkey,undef,$use_ssl). + &mt('If the text is hard to read, [_1] will replace them.', + 'reCAPTCHA refresh'). + '

'; + } } sub check_recaptcha { - my ($privkey) = @_; + my ($privkey,$version) = @_; my $captcha_chk; - my $captcha = Captcha::reCAPTCHA->new; - my $captcha_result = - $captcha->check_answer( - $privkey, - $ENV{'REMOTE_ADDR'}, - $env{'form.recaptcha_challenge_field'}, - $env{'form.recaptcha_response_field'}, - ); - if ($captcha_result->{is_valid}) { - $captcha_chk = 1; + if ($version >= 2) { + my $ua = LWP::UserAgent->new; + $ua->timeout(10); + my %info = ( + secret => $privkey, + response => $env{'form.g-recaptcha-response'}, + remoteip => $ENV{'REMOTE_ADDR'}, + ); + my $response = $ua->post('https://www.google.com/recaptcha/api/siteverify',\%info); + if ($response->is_success) { + my $data = JSON::DWIW->from_json($response->decoded_content); + if (ref($data) eq 'HASH') { + if ($data->{'success'}) { + $captcha_chk = 1; + } + } + } + } else { + my $captcha = Captcha::reCAPTCHA->new; + my $captcha_result = + $captcha->check_answer( + $privkey, + $ENV{'REMOTE_ADDR'}, + $env{'form.recaptcha_challenge_field'}, + $env{'form.recaptcha_response_field'}, + ); + if ($captcha_result->{is_valid}) { + $captcha_chk = 1; + } } return $captcha_chk; } sub emailusername_info { - my @fields = ('firstname','lastname','institution','web','location','officialemail'); + my @fields = ('firstname','lastname','institution','web','location','officialemail','id'); my %titles = &Apache::lonlocal::texthash ( lastname => 'Last Name', firstname => 'First Name', @@ -15698,6 +16241,7 @@ sub emailusername_info { location => "School's city, state/province, country", web => "School's web address", officialemail => 'E-mail address at institution (if different)', + id => 'Student/Employee ID', ); return (\@fields,\%titles); } @@ -15778,11 +16322,19 @@ sub des_decrypt { } else { $cypher=new DES $keybin; } - my $plaintext= - $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,0,16)))); - $plaintext.= - $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,16,16)))); - $plaintext=substr($plaintext,1,ord(substr($plaintext,0,1)) ); + my $plaintext=''; + my $cypherlength = length($cyphertext); + my $numchunks = int($cypherlength/32); + for (my $j=0; $j<$numchunks; $j++) { + my $start = $j*32; + my $cypherblock = substr($cyphertext,$start,32); + my $chunk = + $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,0,16)))); + $chunk .= + $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,16,16)))); + $chunk=substr($chunk,1,ord(substr($chunk,0,1)) ); + $plaintext .= $chunk; + } return $plaintext; }