--- loncom/interface/loncommon.pm 2014/05/04 15:44:46 1.1075.2.71 +++ loncom/interface/loncommon.pm 2021/12/24 22:04:54 1.1075.2.160 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.1075.2.71 2014/05/04 15:44:46 raeburn Exp $ +# $Id: loncommon.pm,v 1.1075.2.160 2021/12/24 22:04:54 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -71,12 +71,18 @@ use Apache::lonuserutils(); use Apache::lonuserstate(); use Apache::courseclassifier(); use LONCAPA qw(:DEFAULT :match); +use HTTP::Request; 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 +use File::Copy(); +use File::Path(); # ---------------------------------------------- Designs use vars qw(%defaultdesign); @@ -191,7 +197,7 @@ BEGIN { { my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}. '/language.tab'; - if ( open(my $fh,"<$langtabfile") ) { + if ( open(my $fh,'<',$langtabfile) ) { while (my $line = <$fh>) { next if ($line=~/^\#/); chomp($line); @@ -212,7 +218,7 @@ BEGIN { { my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}. '/copyright.tab'; - if ( open (my $fh,"<$copyrightfile") ) { + if ( open (my $fh,'<',$copyrightfile) ) { while (my $line = <$fh>) { next if ($line=~/^\#/); chomp($line); @@ -226,7 +232,7 @@ BEGIN { { my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}. '/source_copyright.tab'; - if ( open (my $fh,"<$sourcecopyrightfile") ) { + if ( open (my $fh,'<',$sourcecopyrightfile) ) { while (my $line = <$fh>) { next if ($line =~ /^\#/); chomp($line); @@ -240,7 +246,7 @@ BEGIN { # -------------------------------------------------------------- default domain designs my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors'; my $designfile = $designdir.'/default.tab'; - if ( open (my $fh,"<$designfile") ) { + if ( open (my $fh,'<',$designfile) ) { while (my $line = <$fh>) { next if ($line =~ /^\#/); chomp($line); @@ -254,12 +260,12 @@ BEGIN { { my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}. '/filecategories.tab'; - if ( open (my $fh,"<$categoryfile") ) { + if ( open (my $fh,'<',$categoryfile) ) { while (my $line = <$fh>) { next if ($line =~ /^\#/); chomp($line); my ($extension,$category)=(split(/\s+/,$line,2)); - push @{$category_extensions{lc($category)}},$extension; + push(@{$category_extensions{lc($category)}},$extension); } close($fh); } @@ -269,7 +275,7 @@ BEGIN { { my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}. '/filetypes.tab'; - if ( open (my $fh,"<$typesfile") ) { + if ( open (my $fh,'<',$typesfile) ) { while (my $line = <$fh>) { next if ($line =~ /^\#/); chomp($line); @@ -422,7 +428,7 @@ sub studentbrowser_javascript { +COLORFULEDIT +} + +sub xmleditor_js { + return < + +XMLEDIT +} + +sub insert_folding_button { + my $curDepth = $Apache::lonxml::curdepth; + my $lastresource = $env{'request.ambiguous'}; + + return ""; +} + + =pod =head1 Excel and CSV file utility routines @@ -1992,12 +2251,15 @@ sub multiple_select_form { =pod -=item * &select_form($defdom,$name,$hashref,$onchange) +=item * &select_form($defdom,$name,$hashref,$onchange,$readonly) Returns a string containing a form to allow a user to select options from a ref to a hash containing: option_name => displayed text. An optional $onchange can include -a javascript onchange item, e.g., onchange="this.form.submit();" +a javascript onchange item, e.g., onchange="this.form.submit();". +An optional arg -- $readonly -- if true will cause the select form +to be disabled, e.g., for the case where an instructor has a section- +specific role, and is viewing/modifying parameters. See lonrights.pm for an example invocation and use. @@ -2005,12 +2267,16 @@ See lonrights.pm for an example invocati #------------------------------------------- sub select_form { - my ($def,$name,$hashref,$onchange) = @_; + my ($def,$name,$hashref,$onchange,$readonly) = @_; return unless (ref($hashref) eq 'HASH'); if ($onchange) { $onchange = ' onchange="'.$onchange.'"'; } - my $selectform = "\n"; + my $disabled; + if ($readonly) { + $disabled = ' disabled="disabled"'; + } + my $selectform = "\n"; my @keys; if (exists($hashref->{'select_form_order'})) { @keys=@{$hashref->{'select_form_order'}}; @@ -2179,7 +2445,7 @@ sub select_level_form { =pod -=item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms) +=item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms,$disabled) Returns a string containing a form to allow a user to select the domain to preform an operation in. @@ -2194,16 +2460,21 @@ The optional $onchange argument specifie The optional $incdoms is a reference to an array of domains which will be the only available options. -The optional $excdoms is a reference to an array of domains which will be excluded from the available options. +The optional $excdoms is a reference to an array of domains which will be excluded from the available options. + +The optional $disabled argument, if true, adds the disabled attribute to the select tag. =cut #------------------------------------------- sub select_dom_form { - my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms) = @_; + my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms,$disabled) = @_; if ($onchange) { $onchange = ' onchange="'.$onchange.'"'; } + if ($disabled) { + $disabled = ' disabled="disabled"'; + } my (@domains,%exclude); if (ref($incdoms) eq 'ARRAY') { @domains = sort {lc($a) cmp lc($b)} (@{$incdoms}); @@ -2214,7 +2485,7 @@ sub select_dom_form { if (ref($excdoms) eq 'ARRAY') { map { $exclude{$_} = 1; } @{$excdoms}; } - my $selectdomain = "\n"; + my $selectdomain = "\n"; foreach my $dom (@domains) { next if ($exclude{$dom}); $selectdomain.="'; + $authtype = ''; } } } @@ -2641,7 +2924,7 @@ sub authform_kerberos { if ($authtype eq '') { $authtype = ''; + $krbcheck.$disabled.' />'; } if (($can_assign{'krb4'} && $can_assign{'krb5'}) || ($can_assign{'krb4'} && !$can_assign{'krb5'} && @@ -2654,9 +2937,9 @@ sub authform_kerberos { ''.$authtype, '', - '', - '', + 'onchange="'.$jscall.'"'.$disabled.' />', + '', + '', ''); } elsif ($can_assign{'krb4'}) { $result .= &mt @@ -2665,7 +2948,7 @@ sub authform_kerberos { ''.$authtype, '', + 'onchange="'.$jscall.'"'.$disabled.' />', '', ''); } elsif ($can_assign{'krb5'}) { @@ -2675,7 +2958,7 @@ sub authform_kerberos { ''.$authtype, '', + 'onchange="'.$jscall.'"'.$disabled.' />', '', ''); } @@ -2688,8 +2971,11 @@ sub authform_internal { kerb_def_dom => 'MSU.EDU', @_, ); - my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall); + my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall,$disabled); my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'}); + if ($in{'readonly'}) { + $disabled = ' disabled="disabled"'; + } if (defined($in{'curr_authtype'})) { if ($in{'curr_authtype'} eq 'int') { if ($can_assign{'int'}) { @@ -2718,7 +3004,7 @@ sub authform_internal { if (defined($in{'mode'})) { if ($in{'mode'} eq 'modifycourse') { if ($authnum == 1) { - $authtype = ''; + $authtype = ''; } } } @@ -2726,14 +3012,14 @@ sub authform_internal { $jscall = "javascript:changed_radio('int',$in{'formname'});"; if ($authtype eq '') { $authtype = ''; + ' onchange="'.$jscall.'" onclick="'.$jscall.'"'.$disabled.' />'; } $autharg = ''; + $intarg.'" onchange="'.$jscall.'"'.$disabled.' />'; $result = &mt ('[_1] Internally authenticated (with initial password [_2])', ''.$authtype,''.$autharg); - $result.="".&mt('Visible input').''; + $result.=''.&mt('Visible input').''; return $result; } @@ -2743,8 +3029,11 @@ sub authform_local { kerb_def_dom => 'MSU.EDU', @_, ); - my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall); + my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall,$disabled); my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'}); + if ($in{'readonly'}) { + $disabled = ' disabled="disabled"'; + } if (defined($in{'curr_authtype'})) { if ($in{'curr_authtype'} eq 'loc') { if ($can_assign{'loc'}) { @@ -2773,7 +3062,7 @@ sub authform_local { if (defined($in{'mode'})) { if ($in{'mode'} eq 'modifycourse') { if ($authnum == 1) { - $authtype = ''; + $authtype = ''; } } } @@ -2782,10 +3071,10 @@ sub authform_local { if ($authtype eq '') { $authtype = ''; + $jscall.'"'.$disabled.' />'; } $autharg = ''; + $locarg.'" onchange="'.$jscall.'"'.$disabled.' />'; $result = &mt('[_1] Local Authentication with argument [_2]', ''.$authtype,''.$autharg); return $result; @@ -2797,8 +3086,11 @@ sub authform_filesystem { kerb_def_dom => 'MSU.EDU', @_, ); - my ($fsyscheck,$result,$authtype,$autharg,$jscall); + my ($fsyscheck,$result,$authtype,$autharg,$jscall,$disabled); my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'}); + if ($in{'readonly'}) { + $disabled = ' disabled="disabled"'; + } if (defined($in{'curr_authtype'})) { if ($in{'curr_authtype'} eq 'fsys') { if ($can_assign{'fsys'}) { @@ -2824,7 +3116,7 @@ sub authform_filesystem { if (defined($in{'mode'})) { if ($in{'mode'} eq 'modifycourse') { if ($authnum == 1) { - $authtype = ''; + $authtype = ''; } } } @@ -2833,16 +3125,13 @@ sub authform_filesystem { if ($authtype eq '') { $authtype = ''; + $jscall.'"'.$disabled.' />'; } - $autharg = ''; + $autharg = ''; $result = &mt ('[_1] Filesystem Authenticated (with initial password [_2])', - '', - ''); + ''.$authtype,''.$autharg); return $result; } @@ -2864,7 +3153,7 @@ sub get_assignable_auth { my $context; if ($env{'request.role'} =~ /^au/) { $context = 'author'; - } elsif ($env{'request.role'} =~ /^dc/) { + } elsif ($env{'request.role'} =~ /^(dc|dh)/) { $context = 'domain'; } elsif ($env{'request.course.id'}) { $context = 'course'; @@ -2888,6 +3177,79 @@ sub get_assignable_auth { 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'} .= ': !"\#$%&\'()*+,-./:;<=>?@[\]^_\`{|}~'; + $rulenames{'min'} = &mt('Minimum password length: [_1]',$min); + $rulenames{'max'} = &mt('Maximum password length: [_1]',$max); + $warning = &mt('Password did not satisfy the following:').''; + foreach my $rule ('min','max','uc','lc','num','spec') { + if (grep(/^$rule$/,@brokerule)) { + $warning .= ''.$rulenames{$rule}.''; + } + } + $warning .= ''; + } + if (wantarray) { + return @brokerule; + } + return $warning; +} + ############################################################### ## Get Kerberos Defaults for Domain ## ############################################################### @@ -3668,7 +4030,7 @@ sub user_lang { =over 4 =item * &get_previous_attempt($symb, $username, $domain, $course, - $getattempt, $regexp, $gradesub) + $getattempt, $regexp, $gradesub, $usec, $identifier) Return string with previous attempt on problem. Arguments: @@ -3690,6 +4052,11 @@ Return string with previous attempt on p =item * $gradesub: routine that processes the string if it matches $regexp +=item * $usec: section of the desired student + +=item * $identifier: counter for student (multiple students one problem) or + problem (one student; whole sequence). + =back The output string is a table containing all desired attempts, if any. @@ -3697,7 +4064,7 @@ The output string is a table containing =cut sub get_previous_attempt { - my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub)=@_; + my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub,$usec,$identifier)=@_; my $prevattempts=''; no strict 'refs'; if ($symb) { @@ -3707,13 +4074,18 @@ 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(); $prevattempts.=''.&mt('History').''; - my (%typeparts,%lasthidden); + my (%typeparts,%lasthidden,%regraded,%hidestatus); my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'}); foreach my $key (sort(keys(%lasthash))) { my ($ign,@parts) = split(/\./,$key); @@ -3730,6 +4102,18 @@ sub get_previous_attempt { $lasthidden{$ign.'.'.$id} = 1; } } + if ($identifier ne '') { + my $id = join(',',@parts); + if (&Apache::lonnet::EXT("resource.$id.problemstatus",$symb, + $domain,$username,$usec,undef,$course) =~ /^no/) { + $hidestatus{$ign.'.'.$id} = 1; + } + } + } elsif ($data eq 'regrader') { + if (($identifier ne '') && (@parts)) { + my $id = join(',',@parts); + $regraded{$ign.'.'.$id} = 1; + } } } else { if ($#parts == 0) { @@ -3741,17 +4125,60 @@ sub get_previous_attempt { } $prevattempts.=&end_data_table_header_row(); if ($getattempt eq '') { + my (%solved,%resets,%probstatus); + if (($identifier ne '') && (keys(%regraded) > 0)) { + for ($version=1;$version<=$returnhash{'version'};$version++) { + foreach my $id (keys(%regraded)) { + if (($returnhash{$version.':'.$id.'.regrader'}) && + ($returnhash{$version.':'.$id.'.tries'} eq '') && + ($returnhash{$version.':'.$id.'.award'} eq '')) { + push(@{$resets{$id}},$version); + } + } + } + } for ($version=1;$version<=$returnhash{'version'};$version++) { - my @hidden; + my (@hidden,@unsolved); if (%typeparts) { foreach my $id (keys(%typeparts)) { - if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') || ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) { + if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') || + ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) { push(@hidden,$id); + } elsif ($identifier ne '') { + unless (($returnhash{$version.':'.$id.'.type'} eq 'survey') || + ($returnhash{$version.':'.$id.'.type'} eq 'surveycred') || + ($hidestatus{$id})) { + next if ((ref($resets{$id}) eq 'ARRAY') && grep(/^\Q$version\E$/,@{$resets{$id}})); + if ($returnhash{$version.':'.$id.'.solved'} eq 'correct_by_student') { + push(@{$solved{$id}},$version); + } elsif (($returnhash{$version.':'.$id.'.solved'} ne '') && + (ref($solved{$id}) eq 'ARRAY')) { + my $skip; + if (ref($resets{$id}) eq 'ARRAY') { + foreach my $reset (@{$resets{$id}}) { + if ($reset > $solved{$id}[-1]) { + $skip=1; + last; + } + } + } + unless ($skip) { + my ($ign,$partslist) = split(/\./,$id,2); + push(@unsolved,$partslist); + } + } + } } } } $prevattempts.=&start_data_table_row(). - ''.&mt('Transaction [_1]',$version).''; + ''.&mt('Transaction [_1]',$version); + if (@unsolved) { + $prevattempts .= ''. + ''. + &mt('Hide').''; + } + $prevattempts .= ''; if (@hidden) { foreach my $key (sort(keys(%lasthash))) { next if ($key =~ /\.foilorder$/); @@ -3773,9 +4200,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.=' '; } @@ -3784,9 +4217,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(); @@ -3981,6 +4420,59 @@ 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 .= ''."\n"; + } + } + return $links; +} + =pod =item * &get_student_answers() @@ -4236,33 +4728,103 @@ sub findallcourses { ############################################### sub blockcheck { - my ($setters,$activity,$uname,$udom,$url) = @_; + my ($setters,$activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller) = @_; - if (!defined($udom)) { - $udom = $env{'user.domain'}; + unless ($activity eq 'docs') { + my ($has_evb,$check_ipaccess); + my $dom = $env{'user.domain'}; + if ($env{'request.course.id'}) { + my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; + my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; + my $checkrole = "cm./$cdom/$cnum"; + my $sec = $env{'request.course.sec'}; + if ($sec ne '') { + $checkrole .= "/$sec"; + } + if ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) && + ($env{'request.role'} !~ /^st/)) { + $has_evb = 1; + } + unless ($has_evb) { + if (($activity eq 'printout') || ($activity eq 'grades') || ($activity eq 'search') || + ($activity eq 'boards') || ($activity eq 'groups') || ($activity eq 'chat')) { + if ($udom eq $cdom) { + $check_ipaccess = 1; + } + } + } + } + unless ($has_evb || $check_ipaccess) { + my @machinedoms = &Apache::lonnet::current_machine_domains(); + if (($dom eq 'public') && ($activity eq 'port')) { + $dom = $udom; + } + if (($dom ne '') && (grep(/^\Q$dom\E$/,@machinedoms))) { + $check_ipaccess = 1; + } else { + my $lonhost = $Apache::lonnet::perlvar{'lonHostID'}; + my $internet_names = &Apache::lonnet::get_internet_names($lonhost); + my $prim = &Apache::lonnet::domain($dom,'primary'); + my $intdom = &Apache::lonnet::internet_dom($prim); + if (($intdom ne '') && (ref($internet_names) eq 'ARRAY')) { + if (grep(/^\Q$intdom\E$/,@{$internet_names})) { + $check_ipaccess = 1; + } + } + } + } + if ($check_ipaccess) { + my ($ipaccessref,$cached)=&Apache::lonnet::is_cached_new('ipaccess',$dom); + unless (defined($cached)) { + my %domconfig = + &Apache::lonnet::get_dom('configuration',['ipaccess'],$dom); + $ipaccessref = &Apache::lonnet::do_cache_new('ipaccess',$dom,$domconfig{'ipaccess'},1800); + } + if ((ref($ipaccessref) eq 'HASH') && ($clientip)) { + foreach my $id (keys(%{$ipaccessref})) { + if (ref($ipaccessref->{$id}) eq 'HASH') { + my $range = $ipaccessref->{$id}->{'ip'}; + if ($range) { + if (&Apache::lonnet::ip_match($clientip,$range)) { + if (ref($ipaccessref->{$id}->{'commblocks'}) eq 'HASH') { + if ($ipaccessref->{$id}->{'commblocks'}->{$activity} eq 'on') { + return ('','','',$id,$dom); + last; + } + } + } + } + } + } + } + } } - if (!defined($uname)) { + if (defined($udom) && defined($uname)) { + # If uname and udom are for a course, check for blocks in the course. + if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) { + my ($startblock,$endblock,$triggerblock) = + &get_blocks($setters,$activity,$udom,$uname,$url,$symb,$caller); + return ($startblock,$endblock,$triggerblock); + } + } else { + $udom = $env{'user.domain'}; $uname = $env{'user.name'}; } - # If uname and udom are for a course, check for blocks in the course. - - if (&Apache::lonnet::is_course($udom,$uname)) { - my ($startblock,$endblock,$triggerblock) = - &get_blocks($setters,$activity,$udom,$uname,$url); - return ($startblock,$endblock,$triggerblock); - } - my $startblock = 0; my $endblock = 0; my $triggerblock = ''; - my %live_courses = &findallcourses(undef,$uname,$udom); + my %live_courses; + unless (($activity eq 'wishlist') || ($activity eq 'annotate')) { + %live_courses = &findallcourses(undef,$uname,$udom); + } # If uname is for a user, and activity is course-specific, i.e., # boards, chat or groups, check for blocking in current course only. if (($activity eq 'boards' || $activity eq 'chat' || - $activity eq 'groups') && ($env{'request.course.id'})) { + $activity eq 'groups' || $activity eq 'printout') && + ($env{'request.course.id'})) { foreach my $key (keys(%live_courses)) { if ($key ne $env{'request.course.id'}) { delete($live_courses{$key}); @@ -4345,7 +4907,7 @@ sub blockcheck { $tdom,$spec,$trest,$area); } } - my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles); + my ($author,$adv,$rar) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles); if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) { if ($1) { $no_userblock = 1; @@ -4367,11 +4929,11 @@ sub blockcheck { ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E})); next if ($no_userblock); - # Retrieve blocking times and identity of locker for course + # Retrieve blocking times and identity of blocker for course # of specified user, unless user has 'evb' privilege. my ($start,$end,$trigger) = - &get_blocks($setters,$activity,$cdom,$cnum,$url); + &get_blocks($setters,$activity,$cdom,$cnum,$url,$symb,$caller); if (($start != 0) && (($startblock == 0) || ($startblock > $start))) { $startblock = $start; @@ -4391,7 +4953,7 @@ sub blockcheck { } sub get_blocks { - my ($setters,$activity,$cdom,$cnum,$url) = @_; + my ($setters,$activity,$cdom,$cnum,$url,$symb,$caller) = @_; my $startblock = 0; my $endblock = 0; my $triggerblock = ''; @@ -4404,7 +4966,13 @@ sub get_blocks { my $now = time; my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum); 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) { if ($block =~ /^firstaccess____(.+)$/) { my $item = $1; @@ -4456,13 +5024,19 @@ sub get_blocks { my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb}; if ($start && $end) { if (($start <= time) && ($end >= time)) { - unless (grep(/^\Q$block\E$/,@blockers)) { - push(@blockers,$block); - $triggered{$block} = { - start => $start, - end => $end, - type => $type, - }; + if (ref($commblocks{$block}) eq 'HASH') { + if (ref($commblocks{$block}{'blocks'}) eq 'HASH') { + if ($commblocks{$block}{'blocks'}{$activity} eq 'on') { + unless(grep(/^\Q$block\E$/,@blockers)) { + push(@blockers,$block); + $triggered{$block} = { + start => $start, + end => $end, + type => $type, + }; + } + } + } } } } @@ -4526,14 +5100,17 @@ sub parse_block_record { } sub blocking_status { - my ($activity,$uname,$udom,$url) = @_; + my ($activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller) = @_; my %setters; # check for active blocking - my ($startblock,$endblock,$triggerblock) = - &blockcheck(\%setters,$activity,$uname,$udom,$url); + if ($clientip eq '') { + $clientip = &Apache::lonnet::get_requestor_ip(); + } + my ($startblock,$endblock,$triggerblock,$by_ip,$blockdom) = + &blockcheck(\%setters,$activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller); my $blocked = 0; - if ($startblock && $endblock) { + if (($startblock && $endblock) || ($by_ip)) { $blocked = 1; } @@ -4542,12 +5119,17 @@ 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; +# $uname and $udom decide whose portfolio (or information page) the user is trying to look at + if (($activity eq 'port') || ($activity eq 'about') || ($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,'&"'); + my $showurl = &Apache::lonenc::check_encrypt($url); + $querystring .= '&url='.&HTML::Entities::encode($showurl,'\'&"<>'); + if ($symb) { + my $showsymb = &Apache::lonenc::check_encrypt($symb); + $querystring .= '&symb='.&HTML::Entities::encode($showsymb,'\'&"<>'); + } } my $output .= <<'END_MYBLOCK'; @@ -4564,13 +5146,27 @@ 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'); + } elsif ($activity eq 'grades') { + $text = &mt('Gradebook Blocked'); + } elsif ($activity eq 'search') { + $text = &mt('Search Blocked'); + } elsif ($activity eq 'about') { + $text = &mt('Access to User Information Pages Blocked'); + } elsif ($activity eq 'wishlist') { + $text = &mt('Access to Stored Links Blocked'); + } elsif ($activity eq 'annotate') { + $text = &mt('Access to Annotations Blocked'); } $output .= <<"END_BLOCK"; - + @@ -4586,13 +5182,20 @@ 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; + 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; foreach my $pattern (split(',',$acc)) { @@ -4688,23 +5291,39 @@ sub get_domainconf { if (keys(%{$domconfig{'login'}})) { foreach my $key (keys(%{$domconfig{'login'}})) { if (ref($domconfig{'login'}{$key}) eq 'HASH') { - if ($key eq 'loginvia') { - if (ref($domconfig{'login'}{'loginvia'}) eq 'HASH') { - foreach my $hostname (keys(%{$domconfig{'login'}{'loginvia'}})) { - if (ref($domconfig{'login'}{'loginvia'}{$hostname}) eq 'HASH') { - if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) { - my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'}; - $designhash{$udom.'.login.loginvia'} = $server; - if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') { - - $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'}; - } else { - $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'}; + if (($key eq 'loginvia') || ($key eq 'headtag')) { + if (ref($domconfig{'login'}{$key}) eq 'HASH') { + foreach my $hostname (keys(%{$domconfig{'login'}{$key}})) { + if (ref($domconfig{'login'}{$key}{$hostname}) eq 'HASH') { + if ($key eq 'loginvia') { + if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) { + my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'}; + $designhash{$udom.'.login.loginvia'} = $server; + if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') { + $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'}; + } else { + $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'}; + } } - if ($domconfig{'login'}{'loginvia'}{$hostname}{'exempt'}) { - $designhash{$udom.'.login.loginvia_exempt_'.$hostname} = $domconfig{'login'}{'loginvia'}{$hostname}{'exempt'}; + } elsif ($key eq 'headtag') { + if ($domconfig{'login'}{'headtag'}{$hostname}{'url'}) { + $designhash{$udom.'.login.headtag_'.$hostname} = $domconfig{'login'}{'headtag'}{$hostname}{'url'}; } } + if ($domconfig{'login'}{$key}{$hostname}{'exempt'}) { + $designhash{$udom.'.login.'.$key.'_exempt_'.$hostname} = $domconfig{'login'}{$key}{$hostname}{'exempt'}; + } + } + } + } + } elsif ($key eq 'saml') { + if (ref($domconfig{'login'}{$key}) eq 'HASH') { + foreach my $host (keys(%{$domconfig{'login'}{$key}})) { + if (ref($domconfig{'login'}{$key}{$host}) eq 'HASH') { + $designhash{$udom.'.login.'.$key.'_'.$host} = 1; + foreach my $item ('text','img','alt','url','title','notsso') { + $designhash{$udom.'.login.'.$key.'_'.$item.'_'.$host} = $domconfig{'login'}{$key}{$host}{$item}; + } } } } @@ -4772,7 +5391,7 @@ sub get_legacy_domconf { my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors'; my $designfile = $designdir.'/'.$udom.'.tab'; if (-e $designfile) { - if ( open (my $fh,"<$designfile") ) { + if ( open (my $fh,'<',$designfile) ) { while (my $line = <$fh>) { next if ($line =~ /^\#/); chomp($line); @@ -5028,9 +5647,10 @@ 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 + use_absolute -> for external resource or syllabus, this will + contain https:// if server uses + https (as per hosts.tab), but request is for http + hostname -> hostname, from $r->hostname(). =item * $advtoolsref, optional argument, ref to an array containing inlineremote items to be added in "Functions" menu below @@ -5056,6 +5676,7 @@ sub bodytag { } if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); } my $httphost = $args->{'use_absolute'}; + my $hostname = $args->{'hostname'}; $function = &get_users_function() if (!$function); my $img = &designparm($function.'.img',$domain); @@ -5075,19 +5696,39 @@ sub bodytag { if ($realm) { $realm = '/'.$realm; } - if ($role eq 'ca') { + if ($role eq 'ca') { my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$}); $realm = &plainname($rname,$rdom); } # realm + my ($cid,$sec); if ($env{'request.course.id'}) { + $cid = $env{'request.course.id'}; + if ($env{'request.course.sec'}) { + $sec = $env{'request.course.sec'}; + } + } elsif ($realm =~ m{^/($match_domain)/($match_courseid)(?:|/(\w+))$}) { + if (&Apache::lonnet::is_course($1,$2)) { + $cid = $1.'_'.$2; + $sec = $3; + } + } + if ($cid) { if ($env{'request.role'} !~ /^cr/) { $role = &Apache::lonnet::plaintext($role,&course_type()); + } elsif ($role =~ m{^cr/($match_domain)/\1-domainconfig/(\w+)$}) { + if ($env{'request.role.desc'}) { + $role = $env{'request.role.desc'}; + } else { + $role = &mt('Helpdesk[_1]',' '.$2); + } + } else { + $role = (split(/\//,$role,4))[-1]; } - if ($env{'request.course.sec'}) { - $role .= (' 'x2).'- '.&mt('section:').' '.$env{'request.course.sec'}; + if ($sec) { + $role .= (' 'x2).'- '.&mt('section:').' '.$sec; } - $realm = $env{'course.'.$env{'request.course.id'}.'.description'}; + $realm = $env{'course.'.$cid.'.description'}; } else { $role = &Apache::lonnet::plaintext($role); } @@ -5098,7 +5739,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']); @@ -5109,20 +5750,18 @@ sub bodytag { if ($public) { undef($role); } - + my $titleinfo = ''.$title.''; # # Extra info if you are the DC my $dc_info = ''; - if ($env{'user.adv'} && exists($env{'user.role.dc./'. - $env{'course.'.$env{'request.course.id'}. - '.domain'}.'/'})) { - my $cid = $env{'request.course.id'}; + if (($env{'user.adv'}) && ($env{'request.course.id'}) && + (exists($env{'user.role.dc./'.$env{'course.'.$cid.'.domain'}.'/'}))) { $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'}; $dc_info =~ s/\s+$//; } - $role = '('.$role.')' if $role; + $role = '('.$role.')' if ($role && !$env{'browser.mobile'}); if ($env{'request.state'} eq 'construct') { $forcereg=1; } @@ -5136,7 +5775,7 @@ sub bodytag { &Apache::lonmenu::prepare_functions($env{'request.noversionuri'}, $forcereg,$args->{'group'}, $args->{'bread_crumbs'}, - $advtoolsref,'',\$forbodytag); + $advtoolsref,'','',\$forbodytag); unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') { $funclist = $forbodytag; } @@ -5149,11 +5788,11 @@ sub bodytag { $bodytag .= Apache::lonhtmlcommon::scripttag( Apache::lonmenu::utilityfunctions($httphost), 'start'); - my ($left,$right) = Apache::lonmenu::primary_menu(); + my ($left,$right) = Apache::lonmenu::primary_menu($args->{'links_disabled'}); if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) { if ($dc_info) { - $dc_info = qq|$dc_info|; + $dc_info = qq|$dc_info|; } $bodytag .= qq|$left $role $realm $dc_info|; @@ -5177,21 +5816,24 @@ sub bodytag { } #don't show menus for public users if (!$public){ - $bodytag .= Apache::lonmenu::secondary_menu($httphost); + $bodytag .= Apache::lonmenu::secondary_menu($httphost,$args->{'links_disabled'}); $bodytag .= Apache::lonmenu::serverform(); $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end'); if ($env{'request.state'} eq 'construct') { $bodytag .= &Apache::lonmenu::innerregister($forcereg, - $args->{'bread_crumbs'}); - } elsif ($forcereg) { + $args->{'bread_crumbs'},'','',$hostname); + } elsif ($forcereg) { $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef, - $args->{'group'}); + $args->{'group'}, + $args->{'hide_buttons', + $hostname}); } else { my $forbodytag; &Apache::lonmenu::prepare_functions($env{'request.noversionuri'}, $forcereg,$args->{'group'}, $args->{'bread_crumbs'}, - $advtoolsref,'',\$forbodytag); + $advtoolsref,'',$hostname, + \$forbodytag); unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') { $bodytag .= $forbodytag; } @@ -5325,7 +5967,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= @@ -5500,6 +6141,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; @@ -5621,6 +6273,10 @@ table#LC_menubuttons img { vertical-align: middle; } +.LC_breadcrumbs_hoverable { + background: $sidebg; +} + td.LC_table_cell_checkbox { text-align: center; } @@ -5691,6 +6347,11 @@ td.LC_menubuttons_text { background: $tabbg; } +td.LC_zero_height { + line-height: 0; + cellpadding: 0; +} + table.LC_data_table { border: 1px solid #000000; border-collapse: separate; @@ -6281,7 +6942,8 @@ table.LC_prior_tries td { padding: 6px; } -.LC_answer_unknown { +.LC_answer_unknown, +.LC_answer_warning { background: orange; color: black; padding: 6px; @@ -6363,6 +7025,7 @@ table.LC_data_table tr > td.LC_docs_entr color: #990000; } +.LC_domprefs_email, .LC_docs_reinit_warn, .LC_docs_ext_edit { font-size: x-small; @@ -6478,7 +7141,7 @@ div.LC_edit_problem_footer, div.LC_edit_problem_footer div, div.LC_edit_problem_editxml_header, div.LC_edit_problem_editxml_header div { - margin-top: 5px; + z-index: 100; } div.LC_edit_problem_header_title { @@ -6494,14 +7157,17 @@ table.LC_edit_problem_header_title { background: $tabbg; } -div.LC_edit_problem_discards { - float: left; - padding-bottom: 5px; +div.LC_edit_actionbar { + background-color: $sidebg; + margin: 0; + padding: 0; + line-height: 200%; } -div.LC_edit_problem_saves { - float: right; - padding-bottom: 5px; +div.LC_edit_actionbar div{ + padding: 0; + margin: 0; + display: inline-block; } .LC_edit_opt { @@ -6517,6 +7183,10 @@ div.LC_edit_problem_saves { margin-left: 40px; } +#LC_edit_problem_codemirror div{ + margin-left: 0px; +} + img.stift { border-width: 0; vertical-align: middle; @@ -6604,6 +7274,10 @@ fieldset { /* overflow: hidden; */ } +article.geogebraweb div { + margin: 0; +} + fieldset > legend { font-weight: bold; padding: 0 5px 0 5px; @@ -6631,7 +7305,6 @@ fieldset > legend { ol.LC_primary_menu { margin: 0; padding: 0; - background-color: $pgbg_or_bgcolor; } ol#LC_PathBreadcrumbs { @@ -6643,23 +7316,48 @@ ol.LC_primary_menu li { vertical-align: middle; text-align: left; list-style: none; + position: relative; float: left; + z-index: 100; /* will be displayed above codemirror and underneath the help-layer */ + line-height: 1.5em; } -ol.LC_primary_menu li a { +ol.LC_primary_menu li a, +ol.LC_primary_menu li p { display: block; margin: 0; padding: 0 5px 0 10px; text-decoration: none; } -ol.LC_primary_menu li ul { +ol.LC_primary_menu li p span.LC_primary_menu_innertitle { + display: inline-block; + width: 95%; + text-align: left; +} + +ol.LC_primary_menu li p span.LC_primary_menu_innerarrow { + display: inline-block; + width: 5%; + float: right; + text-align: right; + font-size: 70%; +} + +ol.LC_primary_menu ul { display: none; - width: 10em; + width: 15em; background-color: $data_table_light; + position: absolute; + top: 100%; +} + +ol.LC_primary_menu ul ul { + left: 100%; + top: 0; } -ol.LC_primary_menu li:hover ul, ol.LC_primary_menu li.hover ul { +ol.LC_primary_menu li:hover > ul, ol.LC_primary_menu li.hover > ul { display: block; position: absolute; margin: 0; @@ -6668,15 +7366,21 @@ ol.LC_primary_menu li:hover ul, ol.LC_pr } ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li { +/* First Submenu -> size should be smaller than the menu title of the whole menu */ font-size: 90%; vertical-align: top; float: none; border-left: 1px solid black; border-right: 1px solid black; +/* A dark bottom border to visualize different menu options; +overwritten in the create_submenu routine for the last border-bottom of the menu */ + border-bottom: 1px solid $data_table_dark; } -ol.LC_primary_menu li:hover li a, ol.LC_primary_menu li.hover li a { - background-color:$data_table_light; +ol.LC_primary_menu li li p:hover { + color:$button_hover; + text-decoration:none; + background-color:$data_table_dark; } ol.LC_primary_menu li li a:hover { @@ -6684,6 +7388,11 @@ ol.LC_primary_menu li li a:hover { background-color:$data_table_dark; } +/* Font-size equal to the size of the predecessors*/ +ol.LC_primary_menu li:hover li li { + font-size: 100%; +} + ol.LC_primary_menu li img { vertical-align: bottom; height: 1.1em; @@ -6740,7 +7449,6 @@ ul#LC_secondary_menu li { font-weight: bold; line-height: 1.8em; border-right: 1px solid black; - vertical-align: middle; float: left; } @@ -7226,6 +7934,26 @@ ul.LC_funclist li { cursor:pointer; } +.LCisDisabled { + cursor: not-allowed; + opacity: 0.5; +} + +a[aria-disabled="true"] { + color: currentColor; + display: inline-block; /* For IE11/ MS Edge bug */ + pointer-events: none; + text-decoration: none; +} + +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 by TTH when "Default set of options to pass to tth/m when converting TeX" in course settings has been set @@ -7247,6 +7975,39 @@ span.roman {font-family: serif; font-sty span.overacc2 {position: relative; left: .8em; top: -1.2ex;} span.overacc1 {position: relative; left: .6em; top: -1.2ex;} +#LC_minitab_header { + float:left; + width:100%; + background:#DAE0D2 url("/res/adm/pages/minitabmenu_bg.gif") repeat-x bottom; + font-size:93%; + line-height:normal; + margin: 0.5em 0 0.5em 0; +} +#LC_minitab_header ul { + margin:0; + padding:10px 10px 0; + list-style:none; +} +#LC_minitab_header li { + float:left; + background:url("/res/adm/pages/minitabmenu_left.gif") no-repeat left top; + margin:0; + padding:0 0 0 9px; +} +#LC_minitab_header a { + display:block; + background:url("/res/adm/pages/minitabmenu_right.gif") no-repeat right top; + padding:5px 15px 4px 6px; +} +#LC_minitab_header #LC_current_minitab { + background-image:url("/res/adm/pages/minitabmenu_left_on.gif"); +} +#LC_minitab_header #LC_current_minitab a { + background-image:url("/res/adm/pages/minitabmenu_right_on.gif"); + padding-bottom:5px; +} + + END } @@ -7296,7 +8057,10 @@ sub headtag { ''. &font_settings($args); - my $inhibitprint = &print_suppression(); + my $inhibitprint; + if ($args->{'print_suppress'}) { + $inhibitprint = &print_suppression(); + } if (!$args->{'frameset'}) { $result .= &Apache::lonhtmlcommon::htmlareaheaders(); @@ -7336,6 +8100,137 @@ 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); + my $lonhost = $Apache::lonnet::perlvar{'lonHostID'}; + my ($offload,$offloadoth); + if (ref($domdefs{'offloadnow'}) eq 'HASH') { + if ($domdefs{'offloadnow'}{$lonhost}) { + $offload = 1; + 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'})) { + $offloadoth = 1; + $dom_in_use = $env{'user.domain'}; + } + } + } + } + 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 ($offload) { + my $newserver = &Apache::lonnet::spareserver(undef,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 { + $msg .= &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'}) { + 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 ($shownsymb) { + &js_escape(\$shownsymb); + $newurl .= '&symb='.$shownsymb; + } + } else { + my $shownurl = &Apache::lonenc::check_encrypt($requrl); + &js_escape(\$shownurl); + $newurl .= '&origurl='.$shownurl; + } + } + &js_escape(\$msg); + $result.=< + +OFFLOAD + } + } + } + } + } } if (!defined($title)) { $title = 'The LearningOnline Network with CAPA'; @@ -7349,11 +8244,18 @@ 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 .= ' '; } + $result .= ''."\n"; return $result.''; } @@ -7422,7 +8324,8 @@ sub print_suppression { } my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; - my $blocked = &blocking_status('printout',$cnum,$cdom); + my $clientip = &Apache::lonnet::get_requestor_ip(); + my $blocked = &blocking_status('printout',$clientip,$cnum,$cdom,undef,1); if ($blocked) { my $checkrole = "cm./$cdom/$cnum"; if ($env{'request.course.sec'} ne '') { @@ -7533,13 +8436,19 @@ $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 + bread_crumbs_nomenu -> if true will pass false as the value of $menulink + to lonhtmlcommon::breadcrumbs group -> includes the current group, if page is for a specific group + use_absolute -> for request for external resource or syllabus, this + will contain https:// if server uses + https (as per hosts.tab), but request is for http + hostname -> hostname, originally from $r->hostname(), (optional). + links_disabled -> Links in primary and secondary menus are disabled + (Can enable them once page has loaded - see lonroles.pm + for an example). =back @@ -7603,12 +8512,18 @@ sub start_page { if (@advtools > 0) { &Apache::lonmenu::advtools_crumbs(@advtools); } - + my $menulink; + # if arg: bread_crumbs_nomenu is true pass 0 as $menulink item. + if (exists($args->{'bread_crumbs_nomenu'})) { + $menulink = 0; + } else { + undef($menulink); + } #if bread_crumbs_component exists show it as headline else show only the breadcrumbs if(exists($args->{'bread_crumbs_component'})){ - $result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'}); + $result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'},'',$menulink); }else{ - $result .= &Apache::lonhtmlcommon::breadcrumbs(); + $result .= &Apache::lonhtmlcommon::breadcrumbs('','',$menulink); } } elsif (($env{'environment.remote'} eq 'on') && ($env{'form.inhibitmenu'} ne 'yes') && @@ -7662,10 +8577,12 @@ function set_wishlistlink(title, path) { title = title.replace(/^LON-CAPA /,''); } title = encodeURIComponent(title); + title = title.replace("'","\\\'"); if (!path) { path = location.pathname; } path = encodeURIComponent(path); + path = path.replace("'","\\\'"); Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path, 'wishlistNewLink','width=560,height=350,scrollbars=0'); } @@ -7708,12 +8625,13 @@ var modalWindow = { }; var openMyModal = function(source,width,height,scrolling,transparency,style) { + source = source.replace(/'/g,"'"); modalWindow.windowId = "myModal"; modalWindow.width = width; modalWindow.height = height; - modalWindow.content = "</iframe>"; + modalWindow.content = ""; modalWindow.open(); - }; + }; // END LON-CAPA Internal --> // ]]> @@ -7732,13 +8650,20 @@ sub modal_link { $target_attr = 'target="'.$target.'"'; } return <<"ENDLINK"; - - $linktext +$linktext ENDLINK } sub modal_adhoc_script { - my ($funcname,$width,$height,$content)=@_; + my ($funcname,$width,$height,$content,$possmathjax)=@_; + my $mathjax; + if ($possmathjax) { + $mathjax = <<'ENDJAX'; + if (typeof MathJax == 'object') { + MathJax.Hub.Queue(["Typeset",MathJax.Hub]); + } +ENDJAX + } return (< // @@ -7756,7 +8682,7 @@ ENDADHOC } sub modal_adhoc_inner { - my ($funcname,$width,$height,$content)=@_; + my ($funcname,$width,$height,$content,$possmathjax)=@_; my $innerwidth=$width-20; $content=&js_ready( &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}). @@ -7765,12 +8691,12 @@ sub modal_adhoc_inner { &end_scrollbox(). &end_page() ); - return &modal_adhoc_script($funcname,$width,$height,$content); + return &modal_adhoc_script($funcname,$width,$height,$content,$possmathjax); } sub modal_adhoc_window { - my ($funcname,$width,$height,$content,$linktext)=@_; - return &modal_adhoc_inner($funcname,$width,$height,$content). + my ($funcname,$width,$height,$content,$linktext,$possmathjax)=@_; + return &modal_adhoc_inner($funcname,$width,$height,$content,$possmathjax). "".$linktext.""; } @@ -7836,8 +8762,9 @@ sub end_togglebox { } sub LCprogressbar_script { - my ($id)=@_; - return(< // ENDPROGRESS + } else { + return(< +// + +ENDPROGRESS + } } sub LCprogressbarUpdate_script { return(< .ui-progressbar { position:relative; } +.progress-label {position: absolute; width: 100%; text-align: center; top: 1px; font-weight: bold; text-shadow: 1px 1px 0 #fff;margin: 0; line-height: 200%; } .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; } @@ -7876,37 +8825,54 @@ my $LCidcnt; my $LCcurrentid; sub LCprogressbar { - my ($r)=(@_); + my ($r,$number_to_do,$preamble)=@_; $LClastpercent=0; $LCidcnt++; $LCcurrentid=$$.'_'.$LCidcnt; - my $starting=&mt('Starting'); - my $content=(< $starting ENDPROGBAR - &r_print($r,$content.&LCprogressbar_script($LCcurrentid)); + } else { + $starting=&mt('Loading...'); + $LClastpercent='false'; + $content=(< + $starting + +ENDPROGBAR + } + &r_print($r,$content.&LCprogressbar_script($LCcurrentid,$number_to_do)); } sub LCprogressbarUpdate { - my ($r,$val,$text)=@_; - unless ($val) { - if ($LClastpercent) { - $val=$LClastpercent; - } else { - $val=0; - } + my ($r,$val,$text,$number_to_do)=@_; + if ($number_to_do) { + unless ($val) { + if ($LClastpercent) { + $val=$LClastpercent; + } else { + $val=0; + } + } + if ($val<0) { $val=0; } + if ($val>100) { $val=0; } + $LClastpercent=$val; + unless ($text) { $text=$val.'%'; } + } else { + $val = 'false'; } - if ($val<0) { $val=0; } - if ($val>100) { $val=0; } - $LClastpercent=$val; - unless ($text) { $text=$val.'%'; } $text=&js_ready($text); &r_print($r,< // ENDUPDATE @@ -8315,7 +9281,7 @@ role status: active, previous or future. sub check_user_status { my ($udom,$uname,$cdom,$crs,$role,$sec) = @_; my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname); - my @uroles = keys %userinfo; + my @uroles = keys(%userinfo); my $srchstr; my $active_chk = 'none'; my $now = time; @@ -9023,8 +9989,24 @@ sub get_secgrprole_info { } sub user_picker { - my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context) = @_; + my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context,$fixeddom,$noinstd) = @_; my $currdom = $dom; + my @alldoms = &Apache::lonnet::all_domains(); + if (@alldoms == 1) { + my %domsrch = &Apache::lonnet::get_dom('configuration', + ['directorysrch'],$alldoms[0]); + my $domdesc = &Apache::lonnet::domain($alldoms[0],'description'); + my $showdom = $domdesc; + if ($showdom eq '') { + $showdom = $dom; + } + if (ref($domsrch{'directorysrch'}) eq 'HASH') { + if ((!$domsrch{'directorysrch'}{'available'}) && + ($domsrch{'directorysrch'}{'lcavailable'} eq '0')) { + return (&mt('LON-CAPA directory search is not available in domain: [_1]',$showdom),0); + } + } + } my %curr_selected = ( srchin => 'dom', srchby => 'lastname', @@ -9045,7 +10027,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', @@ -9058,6 +10040,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.", @@ -9067,7 +10051,16 @@ 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:", ); - my $domform = &select_dom_form($currdom,'srchdomain',1,1); + &html_escape(\%html_lt); + &js_escape(\%js_lt); + my $domform; + my $allow_blank = 1; + if ($fixeddom) { + $allow_blank = 0; + $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,[$currdom]); + } else { + $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1); + } my $srchinsel = ' '; my @srchins = ('crs','dom','alc','instd'); @@ -9079,12 +10072,13 @@ sub user_picker { next if ($option eq 'alc'); next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs')); next if ($option eq 'crs' && !$env{'request.course.id'}); + next if (($option eq 'instd') && ($noinstd)); if ($curr_selected{'srchin'} eq $option) { $srchinsel .= ' - '.$lt{$option}.''; + '.$html_lt{$option}.''; } else { $srchinsel .= ' - '.$lt{$option}.''; + '.$html_lt{$option}.''; } } $srchinsel .= "\n \n"; @@ -9093,10 +10087,10 @@ sub user_picker { foreach my $option ('lastname','lastfirst','uname') { if ($curr_selected{'srchby'} eq $option) { $srchbysel .= ' - '.$lt{$option}.''; + '.$html_lt{$option}.''; } else { $srchbysel .= ' - '.$lt{$option}.''; + '.$html_lt{$option}.''; } } $srchbysel .= "\n \n"; @@ -9105,10 +10099,10 @@ sub user_picker { foreach my $option ('begins','contains','exact') { if ($curr_selected{'srchtype'} eq $option) { $srchtypesel .= ' - '.$lt{$option}.''; + '.$html_lt{$option}.''; } else { $srchtypesel .= ' - '.$lt{$option}.''; + '.$html_lt{$option}.''; } } $srchtypesel .= "\n \n"; @@ -9193,46 +10187,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) { @@ -9250,10 +10244,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. ''. @@ -9261,61 +10255,165 @@ END_BLOCK &Apache::lonhtmlcommon::row_closure(1). &Apache::lonhtmlcommon::end_pick_box(). ''; - return $output; + return ($output,1); } 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; + } } } } @@ -9454,11 +10552,15 @@ sub sorted_inst_types { } sub get_institutional_codes { - my ($settings,$allcourses,$LC_code) = @_; + my ($cdom,$crs,$settings,$allcourses,$LC_code) = @_; # Get complete list of course sections to update my @currsections = (); my @currxlists = (); + my (%unclutteredsec,%unclutteredlcsec); my $coursecode = $$settings{'internal.coursecode'}; + my $crskey = $crs.':'.$coursecode; + @{$unclutteredsec{$crskey}} = (); + @{$unclutteredlcsec{$crskey}} = (); if ($$settings{'internal.sectionnums'} ne '') { @currsections = split(/,/,$$settings{'internal.sectionnums'}); @@ -9469,24 +10571,37 @@ sub get_institutional_codes { } if (@currxlists > 0) { - foreach (@currxlists) { - if (m/^([^:]+):(\w*)$/) { + foreach my $xl (@currxlists) { + if ($xl =~ /^([^:]+):(\w*)$/) { unless (grep/^$1$/,@{$allcourses}) { - push @{$allcourses},$1; + push(@{$allcourses},$1); $$LC_code{$1} = $2; } } } } - + if (@currsections > 0) { - foreach (@currsections) { - if (m/^(\w+):(\w*)$/) { - my $sec = $coursecode.$1; + foreach my $sec (@currsections) { + if ($sec =~ m/^(\w+):(\w*)$/ ) { + my $instsec = $1; my $lc_sec = $2; - unless (grep/^$sec$/,@{$allcourses}) { - push @{$allcourses},$sec; - $$LC_code{$sec} = $lc_sec; + unless (grep/^\Q$instsec\E$/,@{$unclutteredsec{$crskey}}) { + push(@{$unclutteredsec{$crskey}},$instsec); + push(@{$unclutteredlcsec{$crskey}},$lc_sec); + } + } + } + } + + if (@{$unclutteredsec{$crskey}} > 0) { + my %formattedsec = &Apache::lonnet::auto_instsec_reformat($cdom,'clutter',\%unclutteredsec); + if ((ref($formattedsec{$crskey}) eq 'ARRAY') && (ref($unclutteredlcsec{$crskey}) eq 'ARRAY')) { + for (my $i=0; $i<@{$formattedsec{$crskey}}; $i++) { + my $sec = $coursecode.$formattedsec{$crskey}[$i]; + unless (grep/^\Q$sec\E$/,@{$allcourses}) { + push(@{$allcourses},$sec); + $$LC_code{$sec} = $unclutteredlcsec{$crskey}[$i]; } } } @@ -9583,7 +10698,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. @@ -9594,6 +10711,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 @@ -9647,6 +10766,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; @@ -9655,13 +10778,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, }; } } @@ -9896,7 +11021,15 @@ sub ask_for_embedded_content { ($path) = ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/}); } - $fileloc = &Apache::lonnet::filelocation('',$toplevel); + if ($toplevel=~/^\/*(uploaded|editupload)/) { + $fileloc = $toplevel; + $fileloc=~ s/^\s*(\S+)\s*$/$1/; + my ($udom,$uname,$fname) = + ($fileloc=~ m{^/+(?:uploaded|editupload)/+($match_domain)/+($match_name)/+(.*)$}); + $fileloc = propath($udom,$uname).'/userfiles/'.$fname; + } else { + $fileloc = &Apache::lonnet::filelocation('',$toplevel); + } $fileloc =~ s{^/}{}; ($filename) = ($fileloc =~ m{.+/([^/]+)$}); $heading = &mt('Status of dependencies in [_1]',"$title ($filename)"); @@ -10718,7 +11851,7 @@ sub modify_html_refs { return; } } - if (open(my $fh,"<$container")) { + if (open(my $fh,'<',$container)) { $content = join('', <$fh>); close($fh); } else { @@ -10783,7 +11916,7 @@ sub modify_html_refs { } } } else { - if (open(my $fh,">$container")) { + if (open(my $fh,'>',$container)) { print $fh $content; close($fh); $output = ''.&mt('Updated [quant,_1,reference] in [_2].', @@ -11052,7 +12185,7 @@ sub decompress_form { "$topdir/media/player.swf", "$topdir/media/swfobject.js", "$topdir/media/expressInstall.swf"); - my @camtasia8 = ("$topdir/","$topdir/$topdir.html", + my @camtasia8_1 = ("$topdir/","$topdir/$topdir.html", "$topdir/$topdir.mp4", "$topdir/$topdir\_config.xml", "$topdir/$topdir\_controller.swf", @@ -11074,13 +12207,36 @@ sub decompress_form { "$topdir/skins/express_show/", "$topdir/skins/express_show/player-min.css", "$topdir/skins/express_show/spritesheet.png"); + my @camtasia8_4 = ("$topdir/","$topdir/$topdir.html", + "$topdir/$topdir.mp4", + "$topdir/$topdir\_config.xml", + "$topdir/$topdir\_controller.swf", + "$topdir/$topdir\_embed.css", + "$topdir/$topdir\_First_Frame.png", + "$topdir/$topdir\_player.html", + "$topdir/$topdir\_Thumbnails.png", + "$topdir/playerProductInstall.swf", + "$topdir/scripts/", + "$topdir/scripts/config_xml.js", + "$topdir/scripts/techsmith-smart-player.min.js", + "$topdir/skins/", + "$topdir/skins/configuration_express.xml", + "$topdir/skins/express_show/", + "$topdir/skins/express_show/spritesheet.min.css", + "$topdir/skins/express_show/spritesheet.png", + "$topdir/skins/express_show/techsmith-smart-player.min.css"); my @diffs = &compare_arrays(\@paths,\@camtasia6); if (@diffs == 0) { $is_camtasia = 6; } else { - @diffs = &compare_arrays(\@paths,\@camtasia8); + @diffs = &compare_arrays(\@paths,\@camtasia8_1); if (@diffs == 0) { $is_camtasia = 8; + } else { + @diffs = &compare_arrays(\@paths,\@camtasia8_4); + if (@diffs == 0) { + $is_camtasia = 8; + } } } } @@ -11277,6 +12433,18 @@ sub decompress_uploaded_file { sub process_decompression { my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_; + unless (($dir_root eq '/userfiles') && ($destination =~ m{^(docs|supplemental)/(default|\d+)/\d+$})) { + return ''.&mt('Not extracted.').''. + &mt('Unexpected file path.').''."\n"; + } + unless (($docudom =~ /^$match_domain$/) && ($docuname =~ /^$match_courseid$/)) { + return ''.&mt('Not extracted.').''. + &mt('Unexpected course context.').''."\n"; + } + unless ($file eq &Apache::lonnet::clean_filename($file)) { + return ''.&mt('Not extracted.').''. + &mt('Filename contained unexpected characters.').''."\n"; + } my ($dir,$error,$warning,$output); if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) { $error = &mt('Filename not a supported archive file type.'). @@ -11311,30 +12479,44 @@ sub process_decompression { } } my $numskip = scalar(@to_skip); - if (($numskip > 0) && - ($numskip == $env{'form.archive_itemcount'})) { + my $numoverwrite = scalar(@to_overwrite); + if (($numskip) && (!$numoverwrite)) { $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.'); } elsif ($dir eq '') { $error = &mt('Directory containing archive file unavailable.'); } elsif (!$error) { my ($decompressed,$display); - if ($numskip > 0) { + if (($numskip) || ($numoverwrite)) { my $tempdir = time.'_'.$$.int(rand(10000)); mkdir("$dir/$tempdir",0755); - system("mv $dir/$file $dir/$tempdir/$file"); - ($decompressed,$display) = - &decompress_uploaded_file($file,"$dir/$tempdir"); - foreach my $item (@to_skip) { - if (($item ne '') && ($item !~ /\.\./)) { - if (-f "$dir/$tempdir/$item") { - unlink("$dir/$tempdir/$item"); - } elsif (-d "$dir/$tempdir/$item") { - system("rm -rf $dir/$tempdir/$item"); + if (&File::Copy::move("$dir/$file","$dir/$tempdir/$file")) { + ($decompressed,$display) = + &decompress_uploaded_file($file,"$dir/$tempdir"); + foreach my $item (@to_skip) { + if (($item ne '') && ($item !~ /\.\./)) { + if (-f "$dir/$tempdir/$item") { + unlink("$dir/$tempdir/$item"); + } elsif (-d "$dir/$tempdir/$item") { + &File::Path::remove_tree("$dir/$tempdir/$item",{ safe => 1 }); + } } } + foreach my $item (@to_overwrite) { + if ((-e "$dir/$tempdir/$item") && (-e "$dir/$item")) { + if (($item ne '') && ($item !~ /\.\./)) { + if (-f "$dir/$item") { + unlink("$dir/$item"); + } elsif (-d "$dir/$item") { + &File::Path::remove_tree("$dir/$item",{ safe => 1 }); + } + &File::Copy::move("$dir/$tempdir/$item","$dir/$item"); + } + } + } + if (&File::Copy::move("$dir/$tempdir/$file","$dir/$file")) { + &File::Path::remove_tree("$dir/$tempdir",{ safe => 1 }); + } } - system("mv $dir/$tempdir/* $dir"); - rmdir("$dir/$tempdir"); } else { ($decompressed,$display) = &decompress_uploaded_file($file,$dir); @@ -11352,8 +12534,7 @@ sub process_decompression { if (ref($newdirlistref) eq 'ARRAY') { foreach my $dir_line (@{$newdirlistref}) { my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5); - unless (($item =~ /^\.+$/) || ($item eq $file) || - ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) { + unless (($item =~ /^\.+$/) || ($item eq $file)) { push(@newitems,$item); if ($dirptr&$testdir) { $is_dir{$item} = 1; @@ -11838,7 +13019,7 @@ END sub process_extracted_files { my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_; my $numitems = $env{'form.archive_count'}; - return unless ($numitems); + return if ((!$numitems) || ($numitems =~ /\D/)); my @ids=&Apache::lonnet::current_machine_ids(); my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir, %folders,%containers,%mapinner,%prompttofetch); @@ -11851,7 +13032,7 @@ sub process_extracted_files { } else { $prefix = $Apache::lonnet::perlvar{'lonDocRoot'}; $pathtocheck = "$dir_root/$docudom/$docuname/$destination"; - $dir = "$dir_root/$docudom/$docuname"; + $dir = "$dir_root/$docudom/$docuname"; } my $currdir = "$dir_root/$destination"; (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/}); @@ -11940,7 +13121,9 @@ sub process_extracted_files { '.'.$containers{$outer},1,1); $newseqid{$i} = $newidx; unless ($errtext) { - $result .= ''.&mt('Folder: [_1] added to course',$docstitle).''."\n"; + $result .= ''.&mt('Folder: [_1] added to course', + &HTML::Entities::encode($docstitle,'<>&"')).. + ''."\n"; } } } else { @@ -11949,38 +13132,47 @@ sub process_extracted_files { my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'. $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'. $title; - if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") { - mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755); - } - if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") { - mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx"); - } - if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") { - system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title"); - $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx"; - unless ($ishome) { - my $fetch = "$newdest{$i}/$title"; - $fetch =~ s/^\Q$prefix$dir\E//; - $prompttofetch{$fetch} = 1; + if (($outer !~ /\D/) && ($mapinner{$outer} !~ /\D/) && ($newidx !~ /\D/)) { + if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") { + mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755); } - } - $LONCAPA::map::resources[$newidx]= - $docstitle.':'.$url.':false:normal:res'; - push(@LONCAPA::map::order, $newidx); - my ($outtext,$errtext)= - &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'. - $docuname.'/'.$folders{$outer}. - '.'.$containers{$outer},1,1); - unless ($errtext) { - if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") { - $result .= ''.&mt('File: [_1] added to course',$docstitle).''."\n"; + if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") { + mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx"); + } + if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") { + if (rename("$prefix$path","$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title")) { + $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx"; + unless ($ishome) { + my $fetch = "$newdest{$i}/$title"; + $fetch =~ s/^\Q$prefix$dir\E//; + $prompttofetch{$fetch} = 1; + } + } + } + $LONCAPA::map::resources[$newidx]= + $docstitle.':'.$url.':false:normal:res'; + push(@LONCAPA::map::order, $newidx); + my ($outtext,$errtext)= + &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'. + $docuname.'/'.$folders{$outer}. + '.'.$containers{$outer},1,1); + unless ($errtext) { + if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") { + $result .= ''.&mt('File: [_1] added to course', + &HTML::Entities::encode($docstitle,'<>&"')). + ''."\n"; + } } + } else { + $warning .= &mt('Item extracted from archive: [_1] has unexpected path.', + &HTML::Entities::encode($path,'<>&"')).''; } } } } } else { - $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).''; + $warning .= &mt('Item extracted from archive: [_1] has unexpected path.', + &HTML::Entities::encode($path,'<>&"')).''; } } for (my $i=1; $i<=$numitems; $i++) { @@ -12041,7 +13233,9 @@ sub process_extracted_files { } if ($fullpath ne '') { if (-e "$prefix$path") { - system("mv $prefix$path $fullpath/$title"); + unless (rename("$prefix$path","$fullpath/$title")) { + $warning .= &mt('Failed to rename dependency').''; + } } if (-e "$fullpath/$title") { my $showpath; @@ -12050,21 +13244,26 @@ sub process_extracted_files { } else { $showpath = "/$title"; } - $result .= ''.&mt('[_1] included as a dependency',$showpath).''."\n"; - } - unless ($ishome) { - my $fetch = "$fullpath/$title"; - $fetch =~ s/^\Q$prefix$dir\E//; - $prompttofetch{$fetch} = 1; + $result .= ''.&mt('[_1] included as a dependency', + &HTML::Entities::encode($showpath,'<>&"')). + ''."\n"; + unless ($ishome) { + my $fetch = "$fullpath/$title"; + $fetch =~ s/^\Q$prefix$dir\E//; + $prompttofetch{$fetch} = 1; + } } } } } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') { $warning .= &mt('[_1] is a dependency of [_2], which was discarded.', - $path,$env{'form.archive_content_'.$referrer{$i}}).''; + &HTML::Entities::encode($path,'<>&"'), + &HTML::Entities::encode($env{'form.archive_content_'.$referrer{$i}},'<>&"')). + ''; } } else { - $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).''; + $warning .= &mt('Item extracted from archive: [_1] has unexpected path.', + &HTML::Entities::encode($path)).''; } } if (keys(%todelete)) { @@ -12338,12 +13537,15 @@ sub upfile_store { $env{'form.upfile'}=~s/\n+/\n/gs; $env{'form.upfile'}=~s/\n+$//gs; - my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}. - '_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$; + my $datatoken = &valid_datatoken($env{'user.name'}.'_'.$env{'user.domain'}. + '_enroll_'.$env{'request.course.id'}.'_'. + time.'_'.$$); + return if ($datatoken eq ''); + { my $datafile = $r->dir_config('lonDaemons'). '/tmp/'.$datatoken.'.tmp'; - if ( open(my $fh,">$datafile") ) { + if ( open(my $fh,'>',$datafile) ) { print $fh $env{'form.upfile'}; close($fh); } @@ -12353,21 +13555,22 @@ sub upfile_store { =pod -=item * &load_tmp_file($r) +=item * &load_tmp_file($r,$datatoken) Load uploaded file from tmp, $r should be the HTTP Request object, -needs $env{'form.datatoken'}, +$datatoken is the name to assign to the temporary file. sets $env{'form.upfile'} to the contents of the file =cut sub load_tmp_file { - my $r=shift; + my ($r,$datatoken) = @_; + return if ($datatoken eq ''); my @studentdata=(); { my $studentfile = $r->dir_config('lonDaemons'). - '/tmp/'.$env{'form.datatoken'}.'.tmp'; - if ( open(my $fh,"<$studentfile") ) { + '/tmp/'.$datatoken.'.tmp'; + if ( open(my $fh,'<',$studentfile) ) { @studentdata=<$fh>; close($fh); } @@ -12375,6 +13578,14 @@ sub load_tmp_file { $env{'form.upfile'}=join('',@studentdata); } +sub valid_datatoken { + my ($datatoken) = @_; + if ($datatoken =~ /^$match_username\_$match_domain\_enroll_(|$match_domain\_$match_courseid)\_\d+_\d+$/) { + return $datatoken; + } + return; +} + =pod =item * &upfile_record_sep() @@ -12815,7 +14026,7 @@ sub DrawBarGraph { @Labels = @$labels; } else { for (my $i=0;$i<@{$Values[0]};$i++) { - push (@Labels,$i+1); + push(@Labels,$i+1); } } # @@ -13263,6 +14474,12 @@ defdom (domain for which to retrieve con origmail (scalar - email address of recipient from loncapa.conf, i.e., predates configuration by DC via domainprefs.pm +$requname username of requester (if mailing type is helpdeskmail) + +$requdom domain of requester (if mailing type is helpdeskmail) + +$reqemail e-mail address of requester (if mailing type is helpdeskmail) + Returns: comma separated list of addresses to which to send e-mail. =back @@ -13272,11 +14489,11 @@ Returns: comma separated list of address ############################################################ ############################################################ sub build_recipient_list { - my ($defmail,$mailing,$defdom,$origmail) = @_; + my ($defmail,$mailing,$defdom,$origmail,$requname,$requdom,$reqemail) = @_; my @recipients; - my $otheremails; + my ($otheremails,$lastresort,$allbcc,$addtext); my %domconfig = - &Apache::lonnet::get_dom('configuration',['contacts'],$defdom); + &Apache::lonnet::get_dom('configuration',['contacts'],$defdom); if (ref($domconfig{'contacts'}) eq 'HASH') { if (exists($domconfig{'contacts'}{$mailing})) { if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') { @@ -13288,14 +14505,183 @@ sub build_recipient_list { push(@recipients,$addr); } } - $otheremails = $domconfig{'contacts'}{$mailing}{'others'}; + } + $otheremails = $domconfig{'contacts'}{$mailing}{'others'}; + if ($mailing eq 'helpdeskmail') { + if ($domconfig{'contacts'}{$mailing}{'bcc'}) { + my @bccs = split(/,/,$domconfig{'contacts'}{$mailing}{'bcc'}); + my @ok_bccs; + foreach my $bcc (@bccs) { + $bcc =~ s/^\s+//g; + $bcc =~ s/\s+$//g; + if ($bcc =~ m/^[^\@]+\@[^\@]+$/) { + if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) { + push(@ok_bccs,$bcc); + } + } + } + if (@ok_bccs > 0) { + $allbcc = join(', ',@ok_bccs); + } + } + $addtext = $domconfig{'contacts'}{$mailing}{'include'}; } } } elsif ($origmail ne '') { - push(@recipients,$origmail); + $lastresort = $origmail; + } + if ($mailing eq 'helpdeskmail') { + if ((ref($domconfig{'contacts'}{'overrides'}) eq 'HASH') && + (keys(%{$domconfig{'contacts'}{'overrides'}}))) { + my ($inststatus,$inststatus_checked); + if (($env{'user.name'} ne '') && ($env{'user.domain'} ne '') && + ($env{'user.domain'} ne 'public')) { + $inststatus_checked = 1; + $inststatus = $env{'environment.inststatus'}; + } + unless ($inststatus_checked) { + if (($requname ne '') && ($requdom ne '')) { + if (($requname =~ /^$match_username$/) && + ($requdom =~ /^$match_domain$/) && + (&Apache::lonnet::domain($requdom))) { + my $requhome = &Apache::lonnet::homeserver($requname, + $requdom); + unless ($requhome eq 'no_host') { + my %userenv = &Apache::lonnet::userenvironment($requdom,$requname,'inststatus'); + $inststatus = $userenv{'inststatus'}; + $inststatus_checked = 1; + } + } + } + } + unless ($inststatus_checked) { + if ($reqemail =~ /^[^\@]+\@[^\@]+$/) { + my %srch = (srchby => 'email', + srchdomain => $defdom, + srchterm => $reqemail, + srchtype => 'exact'); + my %srch_results = &Apache::lonnet::usersearch(\%srch); + foreach my $uname (keys(%srch_results)) { + if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') { + $inststatus = join(',',@{$srch_results{$uname}{'inststatus'}}); + $inststatus_checked = 1; + last; + } + } + unless ($inststatus_checked) { + my ($dirsrchres,%srch_results) = &Apache::lonnet::inst_directory_query(\%srch); + if ($dirsrchres eq 'ok') { + foreach my $uname (keys(%srch_results)) { + if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') { + $inststatus = join(',',@{$srch_results{$uname}{'inststatus'}}); + $inststatus_checked = 1; + last; + } + } + } + } + } + } + if ($inststatus ne '') { + foreach my $status (split(/\:/,$inststatus)) { + if (ref($domconfig{'contacts'}{'overrides'}{$status}) eq 'HASH') { + my @contacts = ('adminemail','supportemail'); + foreach my $item (@contacts) { + if ($domconfig{'contacts'}{'overrides'}{$status}{$item}) { + my $addr = $domconfig{'contacts'}{'overrides'}{$status}; + if (!grep(/^\Q$addr\E$/,@recipients)) { + push(@recipients,$addr); + } + } + } + $otheremails = $domconfig{'contacts'}{'overrides'}{$status}{'others'}; + if ($domconfig{'contacts'}{'overrides'}{$status}{'bcc'}) { + my @bccs = split(/,/,$domconfig{'contacts'}{'overrides'}{$status}{'bcc'}); + my @ok_bccs; + foreach my $bcc (@bccs) { + $bcc =~ s/^\s+//g; + $bcc =~ s/\s+$//g; + if ($bcc =~ m/^[^\@]+\@[^\@]+$/) { + if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) { + push(@ok_bccs,$bcc); + } + } + } + if (@ok_bccs > 0) { + $allbcc = join(', ',@ok_bccs); + } + } + $addtext = $domconfig{'contacts'}{'overrides'}{$status}{'include'}; + last; + } + } + } + } } } elsif ($origmail ne '') { - push(@recipients,$origmail); + $lastresort = $origmail; + } + if (($mailing eq 'helpdeskmail') && ($lastresort ne '')) { + unless (grep(/^\Q$defdom\E$/,&Apache::lonnet::current_machine_domains())) { + my $lonhost = $Apache::lonnet::perlvar{'lonHostID'}; + my $machinedom = $Apache::lonnet::perlvar{'lonDefDomain'}; + my %what = ( + perlvar => 1, + ); + my $primary = &Apache::lonnet::domain($defdom,'primary'); + if ($primary) { + my $gotaddr; + my ($result,$returnhash) = + &Apache::lonnet::get_remote_globals($primary,{ perlvar => 1 }); + if (($result eq 'ok') && (ref($returnhash) eq 'HASH')) { + if ($returnhash->{'lonSupportEMail'} =~ /^[^\@]+\@[^\@]+$/) { + $lastresort = $returnhash->{'lonSupportEMail'}; + $gotaddr = 1; + } + } + unless ($gotaddr) { + my $uintdom = &Apache::lonnet::internet_dom($primary); + my $intdom = &Apache::lonnet::internet_dom($lonhost); + unless ($uintdom eq $intdom) { + my %domconfig = + &Apache::lonnet::get_dom('configuration',['contacts'],$machinedom); + if (ref($domconfig{'contacts'}) eq 'HASH') { + if (ref($domconfig{'contacts'}{'otherdomsmail'}) eq 'HASH') { + my @contacts = ('adminemail','supportemail'); + foreach my $item (@contacts) { + if ($domconfig{'contacts'}{'otherdomsmail'}{$item}) { + my $addr = $domconfig{'contacts'}{$item}; + if (!grep(/^\Q$addr\E$/,@recipients)) { + push(@recipients,$addr); + } + } + } + if ($domconfig{'contacts'}{'otherdomsmail'}{'others'}) { + $otheremails = $domconfig{'contacts'}{'otherdomsmail'}{'others'}; + } + if ($domconfig{'contacts'}{'otherdomsmail'}{'bcc'}) { + my @bccs = split(/,/,$domconfig{'contacts'}{'otherdomsmail'}{'bcc'}); + my @ok_bccs; + foreach my $bcc (@bccs) { + $bcc =~ s/^\s+//g; + $bcc =~ s/\s+$//g; + if ($bcc =~ m/^[^\@]+\@[^\@]+$/) { + if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) { + push(@ok_bccs,$bcc); + } + } + } + if (@ok_bccs > 0) { + $allbcc = join(', ',@ok_bccs); + } + } + $addtext = $domconfig{'contacts'}{'otherdomsmail'}{'include'}; + } + } + } + } + } + } } if (defined($defmail)) { if ($defmail ne '') { @@ -13315,8 +14701,21 @@ sub build_recipient_list { } } } - my $recipientlist = join(',',@recipients); - return $recipientlist; + if ($mailing eq 'helpdeskmail') { + if ((!@recipients) && ($lastresort ne '')) { + push(@recipients,$lastresort); + } + } elsif ($lastresort ne '') { + if (!grep(/^\Q$lastresort\E$/,@recipients)) { + push(@recipients,$lastresort); + } + } + my $recipientlist = join(',',@recipients); + if (wantarray) { + return ($recipientlist,$allbcc,$addtext); + } else { + return $recipientlist; + } } ############################################################ @@ -13407,6 +14806,8 @@ jsarray (reference to array of categorie subcats (reference to hash of arrays containing all subcategories within each category, -recursive) +maxd (reference to hash used to hold max depth for all top-level categories). + Returns: nothing Side effects: populates trails and allitems hash references. @@ -13414,7 +14815,7 @@ Side effects: populates trails and allit =cut sub extract_categories { - my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_; + my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats,$maxd) = @_; if (ref($categories) eq 'HASH') { &gather_categories($categories,$cats,$idx,$jsarray); if (ref($cats->[0]) eq 'ARRAY') { @@ -13440,12 +14841,15 @@ sub extract_categories { if (ref($subcats) eq 'HASH') { push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1'); } - &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats); + &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats,$maxd); } } else { if (ref($subcats) eq 'HASH') { $subcats->{$item} = []; } + if (ref($maxd) eq 'HASH') { + $maxd->{$name} = 1; + } } } } @@ -13483,7 +14887,7 @@ Side effects: populates trails and allit =cut sub recurse_categories { - my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_; + my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats,$maxd) = @_; my $shallower = $depth - 1; if (ref($cats->[$depth]{$category}) eq 'ARRAY') { for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) { @@ -13510,16 +14914,21 @@ sub recurse_categories { } } &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents, - $subcats); + $subcats,$maxd); pop(@{$parents}); } } else { my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower; - my $trailstr = join(' -> ',(@{$parents},$category)); + my $trailstr = join(' » ',(@{$parents},$category)); if ($allitems->{$item} eq '') { push(@{$trails},$trailstr); $allitems->{$item} = scalar(@{$trails})-1; } + if (ref($maxd) eq 'HASH') { + if ($depth > $maxd->{$parents->[0]}) { + $maxd->{$parents->[0]} = $depth; + } + } } return; } @@ -13540,16 +14949,19 @@ currcat - scalar with an & separated lis type - scalar contains course type (Course or Community). +disabled - scalar (optional) contains disabled="disabled" if input elements are + to be readonly (e.g., Domain Helpdesk role viewing course settings). + Returns: $output (markup to be displayed) =cut sub assign_categories_table { - my ($cathash,$currcat,$type) = @_; + my ($cathash,$currcat,$type,$disabled) = @_; my $output; if (ref($cathash) eq 'HASH') { - my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth); - &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray); + my (@cats,@trails,%allitems,%idx,@jsarray,%maxd,@path,$maxdepth); + &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray,\%maxd); $maxdepth = scalar(@cats); if (@cats > 0) { my $itemcount = 0; @@ -13581,11 +14993,11 @@ sub assign_categories_table { } $table .= ''. ''.$parent_title.''. + $item.'"'.$checked.$disabled.' />'.$parent_title.''. ''; my $depth = 1; push(@path,$parent); - $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories); + $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories,$disabled); pop(@path); $table .= ''; $itemcount ++; @@ -13624,12 +15036,15 @@ path - Array containing all categories b currcategories - reference to array of current categories assigned to the course +disabled - scalar (optional) contains disabled="disabled" if input elements are + to be readonly (e.g., Domain Helpdesk role viewing course settings). + Returns: $output (markup to be displayed). =cut sub assign_category_rows { - my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_; + my ($itemcount,$cats,$depth,$parent,$path,$currcategories,$disabled) = @_; my ($text,$name,$item,$chgstr); if (ref($cats) eq 'ARRAY') { my $maxdepth = scalar(@{$cats}); @@ -13652,12 +15067,12 @@ sub assign_category_rows { } $text .= ''. ''.$name.''. + $item.'"'.$checked.$disabled.' />'.$name.''. ''. ''; if (ref($path) eq 'ARRAY') { push(@{$path},$name); - $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories); + $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories,$disabled); pop(@{$path}); } $text .= ''; @@ -13888,37 +15303,95 @@ sub check_clone { return ($can_clone, $clonemsg, $cloneid, $clonehome); } } - if (($env{'request.role.domain'} eq $args->{'clonedomain'}) && + if (($env{'request.role.domain'} eq $args->{'clonedomain'}) && (&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'}); } } } @@ -13927,7 +15400,8 @@ sub check_clone { } sub construct_course { - my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category,$coderef) = @_; + my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context, + $cnum,$category,$coderef) = @_; my $outcome; my $linefeed = ''."\n"; if ($context eq 'auto') { @@ -14024,8 +15498,7 @@ sub construct_course { 'plc.users.denied', 'hidefromcat', 'checkforpriv', - 'categories', - 'internal.uniquecode'], + 'categories'], $$crsudom,$$crsunum); if ($args->{'textbook'}) { $cenv{'internal.textbook'} = $args->{'textbook'}; @@ -14075,7 +15548,7 @@ sub construct_course { my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'}); $cenv{'internal.sectionnums'} .= $item.','; unless ($addcheck eq 'ok') { - push @badclasses, $class; + push(@badclasses,$class); } } $cenv{'internal.sectionnums'} =~ s/,$//; @@ -14103,7 +15576,7 @@ sub construct_course { my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'}); $cenv{'internal.crosslistings'} .= $item.','; unless ($addcheck eq 'ok') { - push @badclasses, $xl; + push(@badclasses,$xl); } } $cenv{'internal.crosslistings'} =~ s/,$//; @@ -14138,28 +15611,29 @@ sub construct_course { } if (@badclasses > 0) { my %lt=&Apache::lonlocal::texthash( - 'tclb' => 'The courses listed below were included as sections or crosslistings affiliated with your new LON-CAPA course. However, if automated course roster updates are enabled for this class, these particular sections/crosslistings will not contribute towards enrollment, because the user identified as the course owner for this LON-CAPA course', - 'dnhr' => 'does not have rights to access enrollment in these classes', - 'adby' => 'as determined by the policies of your institution on access to official classlists' + 'tclb' => 'The courses listed below were included as sections or crosslistings affiliated with your new LON-CAPA course.', + 'howi' => 'However, if automated course roster updates are enabled for this class, these particular sections/crosslistings are not guaranteed to contribute towards enrollment.', + 'itis' => 'It is possible that rights to access enrollment for these classes will be available through assignment of co-owners.', ); - my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}. - ' ('.$lt{'adby'}.')'; + my $badclass_msg = $lt{'tclb'}.$linefeed.$lt{'howi'}.$linefeed. + &mt('That is because the user identified as the course owner ([_1]) does not have rights to access enrollment in these classes, as determined by the policies of your institution on access to official classlists',$cenv{'internal.courseowner'}).$linefeed.$lt{'itis'}; if ($context eq 'auto') { $outcome .= $badclass_msg.$linefeed; + } else { $outcome .= ''.$badclass_msg.$linefeed.''."\n"; - foreach my $item (@badclasses) { - if ($context eq 'auto') { - $outcome .= " - $item\n"; - } else { - $outcome .= "$item\n"; - } - } + } + foreach my $item (@badclasses) { if ($context eq 'auto') { - $outcome .= $linefeed; + $outcome .= " - $item\n"; } else { - $outcome .= "\n"; + $outcome .= "$item\n"; } - } + } + if ($context eq 'auto') { + $outcome .= $linefeed; + } else { + $outcome .= "\n"; + } } if ($args->{'no_end_date'}) { $args->{'endaccess'} = 0; @@ -14191,6 +15665,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'}.'/'; @@ -14262,12 +15739,17 @@ sub construct_course { # Open all assignments # if ($args->{'openall'}) { + my $opendate = time; + if ($args->{'openallfrom'} =~ /^\d+$/) { + $opendate = $args->{'openallfrom'}; + } my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate'; - my %storecontent = ($storeunder => time, + my %storecontent = ($storeunder => $opendate, $storeunder.'.type' => 'date_start'); - - $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput - ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed; + $outcome .= &mt('All assignments open starting [_1]', + &Apache::lonlocal::locallocaltime($opendate)).': '. + &Apache::lonnet::cput + ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed; } # # Set first page @@ -14447,7 +15929,7 @@ sub escape_url { my ($url) = @_; my @urlslices = split(/\//, $url,-1); my $lastitem = &escape(pop(@urlslices)); - return join('/',@urlslices).'/'.$lastitem; + return &HTML::Entities::encode(join('/',@urlslices),"'").'/'.$lastitem; } sub compare_arrays { @@ -14466,6 +15948,24 @@ sub compare_arrays { return @difference; } +sub lon_status_items { + my %defaults = ( + E => 100, + W => 4, + N => 1, + U => 5, + threshold => 200, + sysmail => 2500, + ); + my %names = ( + E => 'Errors', + W => 'Warnings', + N => 'Notices', + U => 'Unsent', + ); + return (\%defaults,\%names); +} + # -------------------------------------------------------- Initialize user login sub init_user_environment { my ($r, $username, $domain, $authhost, $form, $args) = @_; @@ -14501,10 +16001,37 @@ sub init_user_environment { opendir(DIR,$lonids); while ($filename=readdir(DIR)) { if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) { - unlink($lonids.'/'.$filename); + if (tie(my %oldenv,'GDBM_File',"$lonids/$filename", + &GDBM_READER(),0640)) { + my $linkedfile; + if (exists($oldenv{'user.linkedenv'})) { + $linkedfile = $oldenv{'user.linkedenv'}; + } + untie(%oldenv); + if (unlink("$lonids/$filename")) { + if ($linkedfile =~ /^[a-f0-9]+_linked$/) { + if (-l "$lonids/$linkedfile.id") { + unlink("$lonids/$linkedfile.id"); + } + } + } + } else { + unlink($lonids.'/'.$filename); + } } } closedir(DIR); +# If there is a undeleted lockfile for the user's paste buffer remove it. + my $namespace = 'nohist_courseeditor'; + my $lockingkey = 'paste'."\0".'locked_num'; + my %lockhash = &Apache::lonnet::get($namespace,[$lockingkey], + $domain,$username); + if (exists($lockhash{$lockingkey})) { + my $delresult = &Apache::lonnet::del($namespace,[$lockingkey],$domain,$username); + unless ($delresult eq 'ok') { + &Apache::lonnet::logthis("Failed to delete paste buffer locking key in $namespace for ".$username.":".$domain." Result was: $delresult"); + } + } } # Give them a new cookie my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'} @@ -14518,8 +16045,8 @@ sub init_user_environment { } # ------------------------------------ Check browser type and MathML capability - my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml, - $clientunicode,$clientos,$clientmobile,$clientinfo) = &decode_user_agent($r); + my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,$clientunicode, + $clientos,$clientmobile,$clientinfo,$clientosversion) = &decode_user_agent($r); # ------------------------------------------------------------- Get environment @@ -14541,6 +16068,7 @@ sub init_user_environment { # --------------------------------------------------------- Write first profile { + my $ip = &Apache::lonnet::get_requestor_ip(); my %initial_env = ("user.name" => $username, "user.domain" => $domain, @@ -14552,13 +16080,14 @@ sub init_user_environment { "browser.os" => $clientos, "browser.mobile" => $clientmobile, "browser.info" => $clientinfo, + "browser.osversion" => $clientosversion, "server.domain" => $Apache::lonnet::perlvar{'lonDefDomain'}, "request.course.fn" => '', "request.course.uri" => '', "request.course.sec" => '', "request.role" => 'cm', "request.role.adv" => $env{'user.adv'}, - "request.host" => $ENV{'REMOTE_ADDR'},); + "request.host" => $ip,); if ($form->{'localpath'}) { $initial_env{"browser.localpath"} = $form->{'localpath'}; @@ -14577,36 +16106,44 @@ sub init_user_environment { $env{'user.noloadbalance'} = $lonhost; } - my %is_adv = ( is_adv => $env{'user.adv'} ); - my %domdef; - unless ($domain eq 'public') { - %domdef = &Apache::lonnet::get_domain_defaults($domain); + if ($form->{'noloadbalance'}) { + my @hosts = &Apache::lonnet::current_machine_ids(); + my $hosthere = $form->{'noloadbalance'}; + if (grep(/^\Q$hosthere\E$/,@hosts)) { + $initial_env{"user.noloadbalance"} = $hosthere; + $env{'user.noloadbalance'} = $hosthere; + } } - foreach my $tool ('aboutme','blog','webdav','portfolio') { - $userenv{'availabletools.'.$tool} = - &Apache::lonnet::usertools_access($username,$domain,$tool,'reload', - undef,\%userenv,\%domdef,\%is_adv); - } + unless ($domain eq 'public') { + my %is_adv = ( is_adv => $env{'user.adv'} ); + my %domdef = &Apache::lonnet::get_domain_defaults($domain); - foreach my $crstype ('official','unofficial','community','textbook') { - $userenv{'canrequest.'.$crstype} = - &Apache::lonnet::usertools_access($username,$domain,$crstype, - 'reload','requestcourses', - \%userenv,\%domdef,\%is_adv); - } + foreach my $tool ('aboutme','blog','webdav','portfolio') { + $userenv{'availabletools.'.$tool} = + &Apache::lonnet::usertools_access($username,$domain,$tool,'reload', + undef,\%userenv,\%domdef,\%is_adv); + } + + foreach my $crstype ('official','unofficial','community','textbook') { + $userenv{'canrequest.'.$crstype} = + &Apache::lonnet::usertools_access($username,$domain,$crstype, + 'reload','requestcourses', + \%userenv,\%domdef,\%is_adv); + } - $userenv{'canrequest.author'} = - &Apache::lonnet::usertools_access($username,$domain,'requestauthor', - 'reload','requestauthor', - \%userenv,\%domdef,\%is_adv); - my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'], - $domain,$username); - my $reqstatus = $reqauthor{'author_status'}; - if ($reqstatus eq 'approval' || $reqstatus eq 'approved') { - if (ref($reqauthor{'author'}) eq 'HASH') { - $userenv{'requestauthorqueued'} = $reqstatus.':'. - $reqauthor{'author'}{'timestamp'}; + $userenv{'canrequest.author'} = + &Apache::lonnet::usertools_access($username,$domain,'requestauthor', + 'reload','requestauthor', + \%userenv,\%domdef,\%is_adv); + my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'], + $domain,$username); + my $reqstatus = $reqauthor{'author_status'}; + if ($reqstatus eq 'approval' || $reqstatus eq 'approved') { + if (ref($reqauthor{'author'}) eq 'HASH') { + $userenv{'requestauthorqueued'} = $reqstatus.':'. + $reqauthor{'author'}{'timestamp'}; + } } } @@ -14922,7 +16459,12 @@ sub build_filters { $output .= ''."\n". ''."\n"; - } elsif ($formname ne 'quotacheck') { + } elsif ($formname eq 'quotacheck') { + $output .= qq| + + +|; + } else { my $name_input; if ($cnameelement ne '') { $name_input = '{'ownerfilter'} ne '') || ($filter->{'ownerdomfilter'} ne '')) { @@ -15178,10 +16728,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') { @@ -15201,7 +16751,7 @@ sub search_courses { if (ref($courses{$cid}) eq 'HASH') { if (ref($courses{$cid}{roles}) eq 'ARRAY') { if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) { - push (@{$courses{$cid}{roles}},$courserole); + push(@{$courses{$cid}{roles}},$courserole); } } else { $courses{$cid}{roles} = [$courserole]; @@ -15215,42 +16765,209 @@ sub search_courses { return %courses; } - =pod =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'}); -sub build_release_hashes { - my ($checkparms,$checkresponsetypes,$checkcrstypes,$anonsurvey,$randomizetry) = @_; - return unless((ref($checkparms) eq 'HASH') && (ref($checkresponsetypes) eq 'HASH') && - (ref($checkcrstypes) eq 'HASH') && (ref($anonsurvey) eq 'HASH') && - (ref($randomizetry) eq 'HASH')); - foreach my $key (keys(%Apache::lonnet::needsrelease)) { - my ($item,$name,$value) = split(/:/,$key); - if ($item eq 'parameter') { - if (ref($checkparms->{$name}) eq 'ARRAY') { - unless(grep(/^\Q$name\E$/,@{$checkparms->{$name}})) { - push(@{$checkparms->{$name}},$value); + 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; } - } else { - push(@{$checkparms->{$name}},$value); } - } elsif ($item eq 'resourcetag') { - if ($name eq 'responsetype') { - $checkresponsetypes->{$value} = $Apache::lonnet::needsrelease{$key} + if ($otherserver ne '') { + $switchserver = 'otherserver='.$otherserver.'&role='.$rolecode; } - } elsif ($item eq 'course') { - if ($name eq 'crstype') { - $checkcrstypes->{$value} = $Apache::lonnet::needsrelease{$key}; + } + } + 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'); } } - ($anonsurvey->{major},$anonsurvey->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:anonsurvey'}); - ($randomizetry->{major},$randomizetry->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:randomizetry'}); - return; + return (); } sub update_content_constraints { @@ -15364,8 +17081,8 @@ sub recurse_supplemental { } sub symb_to_docspath { - my ($symb) = @_; - return unless ($symb); + my ($symb,$navmapref) = @_; + return unless ($symb && ref($navmapref)); my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb); if ($resurl=~/\.(sequence|page)$/) { $mapurl=$resurl; @@ -15373,9 +17090,11 @@ sub symb_to_docspath { $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'}; } my $mapresobj; - my $navmap = Apache::lonnavmaps::navmap->new(); - if (ref($navmap)) { - $mapresobj = $navmap->getResourceByUrl($mapurl); + unless (ref($$navmapref)) { + $$navmapref = Apache::lonnavmaps::navmap->new(); + } + if (ref($$navmapref)) { + $mapresobj = $$navmapref->getResourceByUrl($mapurl); } $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1}; my $type=$2; @@ -15385,7 +17104,7 @@ sub symb_to_docspath { if ($pcslist ne '') { foreach my $pc (split(/,/,$pcslist)) { next if ($pc <= 1); - my $res = $navmap->getByMapPc($pc); + my $res = $$navmapref->getByMapPc($pc); if (ref($res)) { my $thisurl = $res->src(); $thisurl=~s{^.*/([^/]+)\.\w+$}{$1}; @@ -15432,31 +17151,32 @@ sub symb_to_docspath { } sub captcha_display { - my ($context,$lonhost) = @_; + my ($context,$lonhost,$defdom) = @_; my ($output,$error); - my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost); + my ($captcha,$pubkey,$privkey,$version) = + &get_captcha_config($context,$lonhost,$defdom); 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 ($context,$lonhost,$defdom) = @_; my ($captcha_chk,$captcha_error); - my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost); + my ($captcha,$pubkey,$privkey,$version) = &get_captcha_config($context,$lonhost,$defdom); 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; } @@ -15464,8 +17184,8 @@ sub captcha_response { } sub get_captcha_config { - my ($context,$lonhost) = @_; - my ($captcha,$pubkey,$privkey,$hashtocheck); + my ($context,$lonhost,$dom_in_effect) = @_; + 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); @@ -15481,6 +17201,10 @@ sub get_captcha_config { } if ($privkey && $pubkey) { $captcha = 'recaptcha'; + $version = $hashtocheck->{'recaptchaversion'}; + if ($version ne '2') { + $version = 1; + } } else { $captcha = 'original'; } @@ -15498,14 +17222,39 @@ 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'; } } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') { $captcha = 'original'; } + } elsif ($context eq 'passwords') { + if ($dom_in_effect) { + my %passwdconf = &Apache::lonnet::get_passwdconf($dom_in_effect); + if ($passwdconf{'captcha'} eq 'recaptcha') { + if (ref($passwdconf{'recaptchakeys'}) eq 'HASH') { + $pubkey = $passwdconf{'recaptchakeys'}{'public'}; + $privkey = $passwdconf{'recaptchakeys'}{'private'}; + } + if ($privkey && $pubkey) { + $captcha = 'recaptcha'; + $version = $passwdconf{'recaptchaversion'}; + if ($version ne '2') { + $version = 1; + } + } else { + $captcha = 'original'; + } + } elsif ($passwdconf{'captcha'} ne 'notused') { + $captcha = 'original'; + } + } } - return ($captcha,$pubkey,$privkey); + return ($captcha,$pubkey,$privkey,$version); } sub create_captcha { @@ -15521,13 +17270,17 @@ sub create_captcha { if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') { $output = ''."\n". + ''. &mt('Type in the letters/numbers shown below').' '. ''. - ''. + ''. ''; last; } } + if ($output eq '') { + &Apache::lonnet::logthis("Failed to create Captcha code after $tries attempts."); + } return $output; } @@ -15564,38 +17317,63 @@ 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.', - ''). - ''; + 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.', + ''). + ''; + } } 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; + my $ip = &Apache::lonnet::get_requestor_ip(); + if ($version >= 2) { + my $ua = LWP::UserAgent->new; + $ua->timeout(10); + my %info = ( + secret => $privkey, + response => $env{'form.g-recaptcha-response'}, + remoteip => $ip, + ); + 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, + $ip, + $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', @@ -15603,6 +17381,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); } @@ -15629,6 +17408,29 @@ sub cleanup_html { return $outgoing; } +# Checks for critical messages and returns a redirect url if one exists. +# $interval indicates how often to check for messages. +sub critical_redirect { + my ($interval) = @_; + unless (($env{'user.domain'} ne '') && ($env{'user.name'} ne '')) { + return (); + } + if ((time-$env{'user.criticalcheck.time'})>$interval) { + my @what=&Apache::lonnet::dump('critical', $env{'user.domain'}, + $env{'user.name'}); + &Apache::lonnet::appenv({'user.criticalcheck.time'=>time}); + my $redirecturl; + if ($what[0]) { + if (($what[0] ne 'con_lost') && ($what[0] ne 'no_such_host') && ($what[0]!~/^error\:/)) { + $redirecturl='/adm/email?critical=display'; + my $url=&Apache::lonnet::absolute_url().$redirecturl; + return (1, $url); + } + } + } + return (); +} + # Use: # my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver); # @@ -15663,14 +17465,175 @@ 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; } +sub is_nonframeable { + my ($url,$absolute,$hostname,$ip,$nocache) = @_; + my ($remprotocol,$remhost) = ($url =~ m{^(https?)\://(([a-z0-9]+(-[a-z0-9]+)*\.)+[a-z]{2,})}i); + return if (($remprotocol eq '') || ($remhost eq '')); + + $remprotocol = lc($remprotocol); + $remhost = lc($remhost); + my $remport = 80; + if ($remprotocol eq 'https') { + $remport = 443; + } + my ($result,$cached) = &Apache::lonnet::is_cached_new('noiframe',$remhost.':'.$remport); + if ($cached) { + unless ($nocache) { + if ($result) { + return 1; + } else { + return 0; + } + } + } + my $uselink; + my $request = new HTTP::Request('HEAD',$url); + my $ua = LWP::UserAgent->new; + $ua->timeout(5); + my $response=$ua->request($request); + if ($response->is_success()) { + my $secpolicy = lc($response->header('content-security-policy')); + my $xframeop = lc($response->header('x-frame-options')); + $secpolicy =~ s/^\s+|\s+$//g; + $xframeop =~ s/^\s+|\s+$//g; + if (($secpolicy ne '') || ($xframeop ne '')) { + my $remotehost = $remprotocol.'://'.$remhost; + my ($origin,$protocol,$port); + if ($ENV{'SERVER_PORT'} =~/^\d+$/) { + $port = $ENV{'SERVER_PORT'}; + } else { + $port = 80; + } + if ($absolute eq '') { + $protocol = 'http:'; + if ($port == 443) { + $protocol = 'https:'; + } + $origin = $protocol.'//'.lc($hostname); + } else { + $origin = lc($absolute); + ($protocol,$hostname) = ($absolute =~ m{^(https?:)//([^/]+)$}); + } + if (($secpolicy) && ($secpolicy =~ /\Qframe-ancestors\E([^;]*)(;|$)/)) { + my $framepolicy = $1; + $framepolicy =~ s/^\s+|\s+$//g; + my @policies = split(/\s+/,$framepolicy); + if (@policies) { + if (grep(/^\Q'none'\E$/,@policies)) { + $uselink = 1; + } else { + $uselink = 1; + if ((grep(/^\Q*\E$/,@policies)) || (grep(/^\Q$protocol\E$/,@policies)) || + (($origin ne '') && (grep(/^\Q$origin\E$/,@policies))) || + (($ip ne '') && (grep(/^\Q$ip\E$/,@policies)))) { + undef($uselink); + } + if ($uselink) { + if (grep(/^\Q'self'\E$/,@policies)) { + if (($origin ne '') && ($remotehost eq $origin)) { + undef($uselink); + } + } + } + if ($uselink) { + my @possok; + if ($ip ne '') { + push(@possok,$ip); + } + my $hoststr = ''; + foreach my $part (reverse(split(/\./,$hostname))) { + if ($hoststr eq '') { + $hoststr = $part; + } else { + $hoststr = "$part.$hoststr"; + } + if ($hoststr eq $hostname) { + push(@possok,$hostname); + } else { + push(@possok,"*.$hoststr"); + } + } + if (@possok) { + foreach my $poss (@possok) { + last if (!$uselink); + foreach my $policy (@policies) { + if ($policy =~ m{^(\Q$protocol\E//|)\Q$poss\E(\Q:$port\E|)$}) { + undef($uselink); + last; + } + } + } + } + } + } + } + } elsif ($xframeop ne '') { + $uselink = 1; + my @policies = split(/\s*,\s*/,$xframeop); + if (@policies) { + unless (grep(/^deny$/,@policies)) { + if ($origin ne '') { + if (grep(/^sameorigin$/,@policies)) { + if ($remotehost eq $origin) { + undef($uselink); + } + } + if ($uselink) { + foreach my $policy (@policies) { + if ($policy =~ /^allow-from\s*(.+)$/) { + my $allowfrom = $1; + if (($allowfrom ne '') && ($allowfrom eq $origin)) { + undef($uselink); + last; + } + } + } + } + } + } + } + } + } + } + if ($nocache) { + if ($cached) { + my $devalidate; + if ($uselink && !$result) { + $devalidate = 1; + } elsif (!$uselink && $result) { + $devalidate = 1; + } + if ($devalidate) { + &Apache::lonnet::devalidate_cache_new('noiframe',$remhost.':'.$remport); + } + } + } else { + if ($uselink) { + $result = 1; + } else { + $result = 0; + } + &Apache::lonnet::do_cache_new('noiframe',$remhost.':'.$remport,$result,3600); + } + return $uselink; +} + 1; __END__;
'.&mt('Updated [quant,_1,reference] in [_2].', @@ -11052,7 +12185,7 @@ sub decompress_form { "$topdir/media/player.swf", "$topdir/media/swfobject.js", "$topdir/media/expressInstall.swf"); - my @camtasia8 = ("$topdir/","$topdir/$topdir.html", + my @camtasia8_1 = ("$topdir/","$topdir/$topdir.html", "$topdir/$topdir.mp4", "$topdir/$topdir\_config.xml", "$topdir/$topdir\_controller.swf", @@ -11074,13 +12207,36 @@ sub decompress_form { "$topdir/skins/express_show/", "$topdir/skins/express_show/player-min.css", "$topdir/skins/express_show/spritesheet.png"); + my @camtasia8_4 = ("$topdir/","$topdir/$topdir.html", + "$topdir/$topdir.mp4", + "$topdir/$topdir\_config.xml", + "$topdir/$topdir\_controller.swf", + "$topdir/$topdir\_embed.css", + "$topdir/$topdir\_First_Frame.png", + "$topdir/$topdir\_player.html", + "$topdir/$topdir\_Thumbnails.png", + "$topdir/playerProductInstall.swf", + "$topdir/scripts/", + "$topdir/scripts/config_xml.js", + "$topdir/scripts/techsmith-smart-player.min.js", + "$topdir/skins/", + "$topdir/skins/configuration_express.xml", + "$topdir/skins/express_show/", + "$topdir/skins/express_show/spritesheet.min.css", + "$topdir/skins/express_show/spritesheet.png", + "$topdir/skins/express_show/techsmith-smart-player.min.css"); my @diffs = &compare_arrays(\@paths,\@camtasia6); if (@diffs == 0) { $is_camtasia = 6; } else { - @diffs = &compare_arrays(\@paths,\@camtasia8); + @diffs = &compare_arrays(\@paths,\@camtasia8_1); if (@diffs == 0) { $is_camtasia = 8; + } else { + @diffs = &compare_arrays(\@paths,\@camtasia8_4); + if (@diffs == 0) { + $is_camtasia = 8; + } } } } @@ -11277,6 +12433,18 @@ sub decompress_uploaded_file { sub process_decompression { my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_; + unless (($dir_root eq '/userfiles') && ($destination =~ m{^(docs|supplemental)/(default|\d+)/\d+$})) { + return '
'.&mt('Not extracted.').''. + &mt('Unexpected file path.').'
'.&mt('Not extracted.').''. + &mt('Unexpected course context.').'
'.&mt('Not extracted.').''. + &mt('Filename contained unexpected characters.').'
'; + 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 .= '