--- loncom/interface/loncommon.pm 2018/04/15 00:28:07 1.1313 +++ loncom/interface/loncommon.pm 2023/11/28 17:53:15 1.1424 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.1313 2018/04/15 00:28:07 raeburn Exp $ +# $Id: loncommon.pm,v 1.1424 2023/11/28 17:53:15 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -61,7 +61,7 @@ use POSIX qw(strftime mktime); use Apache::lonmenu(); use Apache::lonenc(); use Apache::lonlocal; -use Apache::lonnet(); +use Apache::lonnavmaps(); use HTML::Entities; use Apache::lonhtmlcommon(); use Apache::loncoursedata(); @@ -71,7 +71,10 @@ use Apache::lonuserutils(); use Apache::lonuserstate(); use Apache::courseclassifier(); use LONCAPA qw(:DEFAULT :match); +use LONCAPA::ltiutils; use LONCAPA::LWPReq; +use LONCAPA::map(); +use HTTP::Request; use DateTime::TimeZone; use DateTime::Locale; use Encode(); @@ -79,7 +82,6 @@ use Text::Aspell; use Authen::Captcha; use Captcha::reCAPTCHA; use JSON::DWIW; -use LWP::UserAgent; use Crypt::DES; use DynaLoader; # for Crypt::DES version use MIME::Lite; @@ -203,7 +205,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); @@ -225,7 +227,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); @@ -239,7 +241,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); @@ -253,7 +255,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); @@ -267,7 +269,7 @@ 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); @@ -282,7 +284,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); @@ -435,7 +437,7 @@ sub studentbrowser_javascript { + +ENDJS + +} + +=pod + +=item * &iframe_wrapper_resizejs() + +# +# jQuery to use when iframe is in use and a page resize occurs. +# This script will ensure that the iframe does not obscure any +# standard LON-CAPA inline menus (primary, secondary, and/or +# breadcrumbs and Functions menus. Expects javascript from +# &iframe_wrapper_headjs() to be in head portion of the web page, +# e.g., by inclusion in second arg passed to &start_page(). +# + +=back + +=cut + +sub iframe_wrapper_resizejs { + my $offset = 5; + &get_unprocessed_cgi($ENV{'QUERY_STRING'},['inhibitmenu']); + if (($env{'form.inhibitmenu'} eq 'yes') || ($env{'form.only_body'})) { + $offset = 0; + } + return &Apache::lonhtmlcommon::scripttag(< '. &mt('Filter: [_1]', @@ -3554,6 +3796,228 @@ 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:').''; + } + if (wantarray) { + return @brokerule; + } + return $warning; +} + +sub passwd_validation_js { + my ($currpasswdval,$domain,$context,$id) = @_; + my (%passwdconf,$alertmsg); + if ($context eq 'linkprot') { + my %domconfig = &Apache::lonnet::get_dom('configuration',['ltisec'],$domain); + if (ref($domconfig{'ltisec'}) eq 'HASH') { + if (ref($domconfig{'ltisec'}{'rules'}) eq 'HASH') { + %passwdconf = %{$domconfig{'ltisec'}{'rules'}}; + } + } + if ($id eq 'add') { + $alertmsg = &mt('Secret for added launcher did not satisfy requirement(s):').'\n\n'; + } elsif ($id =~ /^\d+$/) { + my $pos = $id+1; + $alertmsg = &mt('Secret for launcher [_1] did not satisfy requirement(s):','#'.$pos).'\n\n'; + } else { + $alertmsg = &mt('A secret did not satisfy requirement(s):').'\n\n'; + } + } else { + %passwdconf = &Apache::lonnet::get_passwdconf($domain); + $alertmsg = &mt('Initial password did not satisfy requirement(s):').'\n\n'; + } + my ($min,$max,@chars,$numrules,$intargjs,%alert); + $numrules = 0; + $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'}; + $numrules ++; + } + @chars = @{$passwdconf{'chars'}}; + if (@chars) { + $numrules ++; + } + } + if ($min > 0) { + $numrules ++; + } + if (($min > 0) || ($max ne '') || (@chars > 0)) { + if ($min) { + $alert{'min'} = &mt('minimum [quant,_1,character]',$min).'\n'; + } + if ($max) { + $alert{'max'} = &mt('maximum [quant,_1,character]',$max).'\n'; + } + my (@charalerts,@charrules); + if (@chars) { + if (grep(/^uc$/,@chars)) { + push(@charalerts,&mt('contain at least one upper case letter')); + push(@charrules,'uc'); + } + if (grep(/^lc$/,@chars)) { + push(@charalerts,&mt('contain at least one lower case letter')); + push(@charrules,'lc'); + } + if (grep(/^num$/,@chars)) { + push(@charalerts,&mt('contain at least one number')); + push(@charrules,'num'); + } + if (grep(/^spec$/,@chars)) { + push(@charalerts,&mt('contain at least one non-alphanumeric')); + push(@charrules,'spec'); + } + } + $intargjs = qq| var rulesmsg = '';\n|. + qq| var currpwval = $currpasswdval;\n|; + if ($min) { + $intargjs .= qq| + if (currpwval.length < $min) { + rulesmsg += ' - $alert{min}'; + } +|; + } + if ($max) { + $intargjs .= qq| + if (currpwval.length > $max) { + rulesmsg += ' - $alert{max}'; + } +|; + } + if (@chars > 0) { + my $charrulestr = '"'.join('","',@charrules).'"'; + my $charalertstr = '"'.join('","',@charalerts).'"'; + $intargjs .= qq| var brokerules = new Array();\n|. + qq| var charrules = new Array($charrulestr);\n|. + qq| var charalerts = new Array($charalertstr);\n|; + my %rules; + map { $rules{$_} = 1; } @chars; + if ($rules{'uc'}) { + $intargjs .= qq| + var ucRegExp = /[A-Z]/; + if (!ucRegExp.test(currpwval)) { + brokerules.push('uc'); + } +|; + } + if ($rules{'lc'}) { + $intargjs .= qq| + var lcRegExp = /[a-z]/; + if (!lcRegExp.test(currpwval)) { + brokerules.push('lc'); + } +|; + } + if ($rules{'num'}) { + $intargjs .= qq| + var numRegExp = /[0-9]/; + if (!numRegExp.test(currpwval)) { + brokerules.push('num'); + } +|; + } + if ($rules{'spec'}) { + $intargjs .= q| + var specRegExp = /[!"#$%&'()*+,\-.\/:;<=>?@[\\^\]_`{\|}~]/; + if (!specRegExp.test(currpwval)) { + brokerules.push('spec'); + } +|; + } + $intargjs .= qq| + if (brokerules.length > 0) { + for (var i=0; inew(); + 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() @@ -5054,13 +5595,95 @@ sub findallcourses { ############################################### sub blockcheck { - my ($setters,$activity,$uname,$udom,$url,$is_course) = @_; - + my ($setters,$activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller) = @_; + unless (($activity eq 'docs') || ($activity eq 'reinit') || ($activity eq 'alert')) { + 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; + } + } + } + } elsif (($activity eq 'com') || ($activity eq 'port') || ($activity eq 'blogs') || + ($activity eq 'about') || ($activity eq 'wishlist') || ($activity eq 'passwd')) { + my $checkrole; + if ($env{'request.role.domain'} eq '') { + $checkrole = "cm./$env{'user.domain'}/"; + } else { + $checkrole = "cm./$env{'request.role.domain'}/"; + } + if (($checkrole) && (&Apache::lonnet::allowed('evb',undef,undef,$checkrole))) { + $has_evb = 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 (($activity eq 'wishlist') || ($activity eq 'annotate')) { + return (); + } + } 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); + &get_blocks($setters,$activity,$udom,$uname,$url,$symb,$caller); return ($startblock,$endblock,$triggerblock); } } else { @@ -5071,14 +5694,18 @@ sub blockcheck { 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' || $activity eq 'printout' || - $activity eq 'reinit' || $activity eq 'alert') && + $activity eq 'search' || $activity eq 'reinit' || + $activity eq 'alert') && ($env{'request.course.id'})) { foreach my $key (keys(%live_courses)) { if ($key ne $env{'request.course.id'}) { @@ -5188,7 +5815,7 @@ sub blockcheck { # 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; @@ -5208,7 +5835,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 = ''; @@ -5221,7 +5848,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; @@ -5349,14 +5982,17 @@ sub parse_block_record { } sub blocking_status { - my ($activity,$uname,$udom,$url,$is_course) = @_; + 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,$is_course); + 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; } @@ -5365,12 +6001,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') || ($activity eq 'passwd')) { +# $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'; @@ -5395,10 +6036,20 @@ END_MYBLOCK $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 'alert') { $text = &mt('Checking Critical Messages Blocked'); } elsif ($activity eq 'reinit') { $text = &mt('Checking Course Update 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";
@@ -5422,8 +6073,14 @@ sub check_ip_acc { if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) { return 1; } - my $allowed; - my $ip=$ENV{'REMOTE_ADDR'} || $clientip || $env{'request.host'}; + my ($ip,$allowed); + if (($ENV{'REMOTE_ADDR'} eq '127.0.0.1') || + ($ENV{'REMOTE_ADDR'} eq &Apache::lonnet::get_host_ip($Apache::lonnet::perlvar{'lonHostID'}))) { + $ip = $env{'request.host'} || $ENV{'REMOTE_ADDR'} || $clientip; + } else { + my $remote_ip = &Apache::lonnet::get_requestor_ip(); + $ip = $remote_ip || $env{'request.host'} || $clientip; + } my $name; my %access = ( @@ -5574,6 +6231,17 @@ sub get_domainconf { } } } + } 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','window','notsso') { + $designhash{$udom.'.login.'.$key.'_'.$item.'_'.$host} = $domconfig{'login'}{$key}{$host}{$item}; + } + } + } + } } else { foreach my $img (keys(%{$domconfig{'login'}{$key}})) { $designhash{$udom.'.login.'.$key.'_'.$img} = @@ -5638,7 +6306,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); @@ -5678,8 +6346,12 @@ sub domainlogo { &Apache::lonnet::repcopy($local_name); } $imgsrc = &lonhttpdurl($imgsrc); - } - return ''.$domain.''; + } + my $alttext = $domain; + if ($designhash{$domain.'.login.alttext_domlogo'} ne '') { + $alttext = $designhash{$domain.'.login.alttext_domlogo'}; + } + return ''; } elsif (defined(&Apache::lonnet::domain($domain,'description'))) { return &Apache::lonnet::domain($domain,'description'); } else { @@ -5797,6 +6469,12 @@ sub head_subbox { Input: (optional) filename from which breadcrumb trail is built. In most cases no input as needed, as $env{'request.filename'} is appropriate for use in building the breadcrumb trail. + frameset flag + If page header is being requested for use in a frameset, then + the second (option) argument -- frameset will be true, and + the target attribute set for links should be target="_parent". + If $title is supplied as the thitd arg, that will be used to + the left of the breadcrumbs tail for the current path. Returns: HTML div with CSTR path and recent box To be included on Authoring Space pages @@ -5804,7 +6482,7 @@ Returns: HTML div with CSTR path and rec =cut sub CSTR_pageheader { - my ($trailfile) = @_; + my ($trailfile,$frameset,$title) = @_; if ($trailfile eq '') { $trailfile = $env{'request.filename'}; } @@ -5827,27 +6505,36 @@ sub CSTR_pageheader { $lastitem = $thisdisfn; } - my ($crsauthor,$title); + my $crsauthor; if (($env{'request.course.id'}) && ($env{'course.'.$env{'request.course.id'}.'.num'} eq $uname) && ($env{'course.'.$env{'request.course.id'}.'.domain'} eq $udom)) { $crsauthor = 1; - $title = &mt('Course Authoring Space'); - } else { + if ($title eq '') { + $title = &mt('Course Authoring Space'); + } + } elsif ($title eq '') { $title = &mt('Authoring Space'); } - my $target; - if (($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) { - $target = ' target="_top"'; #FIXME lonpubdir: target="_parent" + my ($target,$crumbtarget) = (' target="_top"','_top'); + if ($frameset) { + $target = ' target="_parent"'; + $crumbtarget = '_parent'; + } elsif (($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) { + $target = ''; + $crumbtarget = ''; + } elsif (($env{'request.deeplink.login'}) && ($env{'request.deeplink.target'})) { + $target = ' target="'.$env{'request.deeplink.target'}.'"'; + $crumbtarget = $env{'request.deeplink.target'}; } my $output = '
' .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it? .''.$title.' ' - .'
' + .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,$crumbtarget,'/priv/'.$udom,undef,undef); if ($lastitem) { $output .= @@ -5857,20 +6544,123 @@ sub CSTR_pageheader { } if ($crsauthor) { - $output .= '
'.&Apache::lonmenu::constspaceform(); + $output .= ''.&Apache::lonmenu::constspaceform($frameset); } else { $output .= '
' - #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."
" + #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/',$crumbtarget,'/priv','','+1',1)."
" .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()') .'' - .&Apache::lonmenu::constspaceform(); + .&Apache::lonmenu::constspaceform($frameset); } $output .= '
'; return $output; } +############################################## +=pod + +=item * &nocodemirror() + +Input: None + +Returns: 1 if CodeMirror is deactivated based on + user's preference, or domain default, + if user indicated use of default. + +=cut + +sub nocodemirror { + my $nocodem = $env{'environment.nocodemirror'}; + unless ($nocodem) { + my %domdefs = &Apache::lonnet::get_domain_defaults($env{'user.domain'}); + if ($domdefs{'nocodemirror'}) { + $nocodem = 'yes'; + } + } + if ($nocodem eq 'yes') { + return 1; + } + return; +} + +############################################## +=pod + +=item * &permitted_editors() + +Input: $uri (optional) + +Returns: %editors hash in which keys are editors + permitted in current Authoring Space. + Value for each key is 1. Possible keys + are: edit, xml, and daxe. If no specific + set of editors has been set for the Author + who owns the Authoring Space, then the + domain default will be used. If no domain + default has been set, then the keys will be + edit and xml. + +=cut + +sub permitted_editors { + my ($uri) = @_; + my ($is_author,$is_coauthor,$auname,$audom,%editors); + if ($env{'request.role'} =~ m{^au\./}) { + $is_author = 1; + } elsif ($env{'request.role'} =~ m{^(?:ca|aa)\./($match_domain)/($match_username)}) { + ($audom,$auname) = ($1,$2); + if (($audom ne '') && ($auname ne '')) { + if (($env{'user.domain'} eq $audom) && + ($env{'user.name'} eq $auname)) { + $is_author = 1; + } else { + $is_coauthor = 1; + } + } + } elsif ($env{'request.course.id'}) { + if ($env{'request.editurl'} =~ m{^/priv/($match_domain)/($match_username)/}) { + ($audom,$auname) = ($1,$2); + } elsif ($env{'request.uri'} =~ m{^/priv/($match_domain)/($match_username)/}) { + ($audom,$auname) = ($1,$2); + } elsif (($uri eq '/daxesave') && + ($env{'form.path'} =~ m{^/daxeopen/priv/($match_domain)/($match_username)/})) { + ($audom,$auname) = ($1,$2); + } + if (($audom ne '') && ($auname ne '')) { + if (($env{'user.domain'} eq $audom) && + ($env{'user.name'} eq $auname)) { + $is_author = 1; + } else { + $is_coauthor = 1; + } + } + } + if ($is_author) { + if (exists($env{'environment.editors'})) { + map { $editors{$_} = 1; } split(/,/,$env{'environment.editors'}); + } else { + %editors = ( edit => 1, + xml => 1, + ); + } + } elsif ($is_coauthor) { + if (exists($env{"environment.internal.editors./$audom/$auname"})) { + map { $editors{$_} = 1; } split(/,/,$env{"environment.internal.editors./$audom/$auname"}); + } else { + %editors = ( edit => 1, + xml => 1, + ); + } + } else { + %editors = ( edit => 1, + xml => 1, + ); + } + return %editors; +} + ############################################### ############################################### @@ -5919,6 +6709,34 @@ Inputs: inlineremote items to be added in "Functions" menu below breadcrumbs. +=item * $ltiscope, optional argument, will be one of: resource, map or + course, if LON-CAPA is in LTI Provider context. Value is + the scope of use, i.e., launch was for access to a single, a map + or the entire course. + +=item * $ltiuri, optional argument, if LON-CAPA is in LTI Provider + context, this will contain the URL for the landing item in + the course, after launch from an LTI Consumer + +=item * $ltimenu, optional argument, if LON-CAPA is in LTI Provider + context, this will contain a reference to hash of items + to be included in the page header and/or inline menu. + +=item * $menucoll, optional argument, if specific menu collection is in + effect, either set as the default for the course, or set for + the deeplink paramater for $env{'request.deeplink.login'} + then $menucoll will be the number of that collection. + +=item * $menuref, optional argument, reference to a hash, containing the + menu options included for the menu in effect, based on the + configuration for the numbered menu collection in use. + +=item * $showncrumbsref, reference to a scalar. Calls to lonmenu::innerregister + within &bodytag() can result in calls to lonhtmlcommon::breadcrumbs(), + if so, $showncrumbsref is set there to 1, and will propagate back + via &bodytag() to &start_page(), to prevent lonhtmlcommon::breadcrumbs() + being called a second time. + =back Returns: A uniform header for LON-CAPA web pages. @@ -5930,7 +6748,8 @@ other decorations will be returned. sub bodytag { my ($title,$function,$addentries,$bodyonly,$domain,$forcereg, - $no_nav_bar,$bgcolor,$args,$advtoolsref)=@_; + $no_nav_bar,$bgcolor,$args,$advtoolsref,$ltiscope,$ltiuri, + $ltimenu,$menucoll,$menuref,$showncrumbsref)=@_; my $public; if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')) @@ -5959,12 +6778,24 @@ 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+)$}) { @@ -5976,10 +6807,10 @@ sub bodytag { } 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); } @@ -6001,22 +6832,43 @@ sub bodytag { if ($public) { undef($role); } - + + my $showcrstitle = 1; + if (($cid) && ($env{'request.lti.login'})) { + if (ref($ltimenu) eq 'HASH') { + unless ($ltimenu->{'role'}) { + undef($role); + } + unless ($ltimenu->{'coursetitle'}) { + $realm=' '; + $showcrstitle = 0; + } + } + } elsif (($cid) && ($menucoll)) { + if (ref($menuref) eq 'HASH') { + unless ($menuref->{'role'}) { + undef($role); + } + unless ($menuref->{'crs'}) { + $realm=' '; + $showcrstitle = 0; + } + } + } + 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'}) && $showcrstitle && + (exists($env{'user.role.dc./'.$env{'course.'.$cid.'.domain'}.'/'}))) { $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'}; $dc_info =~ s/\s+$//; } my $crstype; - if ($env{'request.course.id'}) { - $crstype = $env{'course.'.$env{'request.course.id'}.'.type'}; + if ($cid) { + $crstype = $env{'course.'.$cid.'.type'}; } elsif ($args->{'crstype'}) { $crstype = $args->{'crstype'}; } @@ -6035,27 +6887,42 @@ sub bodytag { $bodytag .= Apache::lonhtmlcommon::scripttag( Apache::lonmenu::utilityfunctions($httphost), 'start'); - my ($left,$right) = Apache::lonmenu::primary_menu($crstype); - - if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) { - if ($dc_info) { - $dc_info = qq|$dc_info|; - } - $bodytag .= qq|
$left $role
- $realm $dc_info
|; - return $bodytag; + if ($args->{'collapsible_header'} ne '') { + my $alttext = &mt('menu state: collapsed'); + my $tooltip = &mt('display standard menus'); + $bodytag .= <<"END"; +
+
+$alttext
+
'; + } return $bodytag; } @@ -6157,12 +7034,45 @@ sub endbodytag { } if ( exists( $env{'internal.head.redirect'} ) ) { if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) { + my ($endbodyjs,$idattr); + if ($env{'internal.head.to_opener'}) { + my $linkid = 'LC_continue_link'; + $idattr = ' id="'.$linkid.'"'; + my $redirect_for_js = &js_escape($env{'internal.head.redirect'}); + $endbodyjs=< +// + +ENDJS + } $endbodytag= - "
". + "$endbodyjs
". &mt('Continue').''. $endbodytag; } } + if ((ref($args) eq 'HASH') && ($args->{'dashjs'})) { + $endbodytag = &Apache::lonhtmlcommon::dash_to_minus_js().$endbodytag; + } return $endbodytag; } @@ -6247,6 +7157,14 @@ form, .inline { display: inline; } +.LC_menus_content.shown{ + display: inline; +} + +.LC_menus_content.hidden { + display: none; +} + .LC_right { text-align:right; } @@ -6267,6 +7185,12 @@ form, .inline { width:400px; } +#LC_collapsible_separator { + border: 1px solid black; + width: 99.9%; + height: 0px; +} + .LC_iframecontainer { width: 98%; margin: 0; @@ -7142,7 +8066,8 @@ table.LC_prior_tries td { padding: 6px; } -.LC_answer_unknown { +.LC_answer_unknown, +.LC_answer_warning { background: orange; color: black; padding: 6px; @@ -7478,6 +8403,11 @@ fieldset { /* overflow: hidden; */ } +fieldset#LC_selectuser { + margin: 0; + padding: 0; +} + article.geogebraweb div { margin: 0; } @@ -8021,6 +8951,10 @@ a#LC_content_toolbar_edittoplevel { background-image:url(/res/adm/pages/edittoplevel.gif); } +a#LC_content_toolbar_printout { + background-image:url(/res/adm/pages/printout.gif); +} + ul#LC_toolbar li a:hover { background-position: bottom center; } @@ -8138,6 +9072,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 for response display */ @@ -8303,7 +9257,13 @@ Inputs: $title - optional title for the 3- whether the side effect should occur (side effect of setting $env{'internal.head.redirect'} to the url - redirected too) + redirected to) + 4- whether the redirect target should be + the opener of the current (pop-up) + window (side effect of setting + $env{'internal.head.to_opener'} to + 1, if true. + 5- whether encrypt check should be skipped domain -> force to color decorate a page for a specific domain function -> force usage of a specific rolish color scheme @@ -8366,15 +9326,45 @@ sub headtag { } } if (ref($args->{'redirect'})) { - my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}}; - $url = &Apache::lonenc::check_encrypt($url); + my ($time,$url,$inhibit_continue,$to_opener,$skip_enc_check) = @{$args->{'redirect'}}; + if (!$skip_enc_check) { + $url = &Apache::lonenc::check_encrypt($url); + } if (!$inhibit_continue) { $env{'internal.head.redirect'} = $url; } - $result.=< +ADDMETA + if ($to_opener) { + $env{'internal.head.to_opener'} = 1; + my $dest = &js_escape($url); + my $timeout = int($time * 1000); + $result .=<<"ENDJS"; + +ENDJS + } else { + $result.=<<"ADDMETA"; ADDMETA + } } else { unless (($args->{'frameset'}) || ($args->{'js_ready'}) || ($args->{'only_body'}) || ($args->{'no_nav_bar'})) { my $requrl = $env{'request.uri'}; @@ -8388,43 +9378,99 @@ ADDMETA 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') { - my $lonhost = $Apache::lonnet::perlvar{'lonHostID'}; if ($domdefs{'offloadnow'}{$lonhost}) { - my $newserver = &Apache::lonnet::spareserver(30000,undef,1,$dom_in_use); - if (($newserver) && ($newserver ne $lonhost)) { - my $numsec = 5; - my $timeout = $numsec * 1000; - my ($newurl,$locknum,%locks,$msg); - if ($env{'request.role.adv'}) { - ($locknum,%locks) = &Apache::lonnet::get_locks(); + $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'}; } - my $disable_submit = 0; - if ($requrl =~ /$LONCAPA::assess_re/) { - $disable_submit = 1; + } + } + } + unless ($offload) { + if (ref($domdefs{'offloadoth'}) eq 'HASH') { + if ($domdefs{'offloadoth'}{$lonhost}) { + if (($env{'user.domain'} ne '') && ($env{'user.domain'} ne $dom_in_use) && + (!(($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')))) { + unless (&Apache::lonnet::shared_institution($env{'user.domain'})) { + $offload = 1; + $offloadoth = 1; + $dom_in_use = $env{'user.domain'}; + } } - if ($locknum) { - my @lockinfo = sort(values(%locks)); - $msg = &mt('Once the following tasks are complete: ')."\\n". - join(", ",sort(values(%locks)))."\\n". - &mt('your session will be transferred to a different server, after you click "Roles".'); + } + } + } + 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 { - 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'}; + $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 ($env{'request.symb'}) { - $newurl .= '&symb='.$env{'request.symb'}; - } else { - $newurl .= '&origurl='.$requrl; + 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 - } } } } @@ -8544,7 +9589,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,undef,1); + 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 '') { @@ -8663,6 +9709,10 @@ $args - additional optional args support 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). + links_target -> Target for links, e.g., _parent (optional). =back @@ -8675,12 +9725,83 @@ sub start_page { #&Apache::lonnet::logthis("start_page ".join(':',caller(0))); $env{'internal.start_page'}++; - my ($result,@advtools); + my ($result,@advtools,$ltiscope,$ltiuri,%ltimenu,$menucoll,%menu); if (! exists($args->{'skip_phases'}{'head'}) ) { $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args); } - + + if (($env{'request.course.id'}) && ($env{'request.lti.login'})) { + if ($env{'course.'.$env{'request.course.id'}.'.lti.override'}) { + unless ($env{'course.'.$env{'request.course.id'}.'.lti.topmenu'}) { + $args->{'no_primary_menu'} = 1; + } + unless ($env{'course.'.$env{'request.course.id'}.'.lti.inlinemenu'}) { + $args->{'no_inline_menu'} = 1; + } + if ($env{'course.'.$env{'request.course.id'}.'.lti.lcmenu'}) { + map { $ltimenu{$_} = 1; } split(/,/,$env{'course.'.$env{'request.course.id'}.'.lti.lcmenu'}); + } + } else { + my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; + my %lti = &Apache::lonnet::get_domain_lti($cdom,'provider'); + if (ref($lti{$env{'request.lti.login'}}) eq 'HASH') { + unless ($lti{$env{'request.lti.login'}}{'topmenu'}) { + $args->{'no_primary_menu'} = 1; + } + unless ($lti{$env{'request.lti.login'}}{'inlinemenu'}) { + $args->{'no_inline_menu'} = 1; + } + if (ref($lti{$env{'request.lti.login'}}{'lcmenu'}) eq 'ARRAY') { + map { $ltimenu{$_} = 1; } @{$lti{$env{'request.lti.login'}}{'lcmenu'}}; + } + } + } + ($ltiscope,$ltiuri) = &LONCAPA::ltiutils::lti_provider_scope($env{'request.lti.uri'}, + $env{'course.'.$env{'request.course.id'}.'.domain'}, + $env{'course.'.$env{'request.course.id'}.'.num'}); + } elsif ($env{'request.course.id'}) { + my $expiretime=600; + if ((time-$env{'course.'.$env{'request.course.id'}.'.last_cache'}) > $expiretime) { + &Apache::lonnet::coursedescription($env{'request.course.id'},{'freshen_cache' => 1}); + } + my ($deeplinkmenu,$menuref); + ($menucoll,$deeplinkmenu,$menuref) = &menucoll_in_effect(); + if ($menucoll) { + if (ref($menuref) eq 'HASH') { + %menu = %{$menuref}; + } + if ($menu{'top'} eq 'n') { + $args->{'no_primary_menu'} = 1; + } + if ($menu{'inline'} eq 'n') { + unless (&Apache::lonnet::allowed('opa')) { + my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; + my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; + my $crstype = &course_type(); + my $now = time; + my $ccrole; + if ($crstype eq 'Community') { + $ccrole = 'co'; + } else { + $ccrole = 'cc'; + } + if ($env{'user.role.'.$ccrole.'./'.$cdom.'/'.$cnum}) { + my ($start,$end) = split(/\./,$env{'user.role.'.$ccrole.'./'.$cdom.'/'.$cnum}); + if ((($start) && ($start<0)) || + (($end) && ($end<$now)) || + (($start) && ($now<$start))) { + $args->{'no_inline_menu'} = 1; + } + } else { + $args->{'no_inline_menu'} = 1; + } + } + } + } + } + + my $showncrumbs; if (! exists($args->{'skip_phases'}{'body'}) ) { if ($args->{'frameset'}) { my $attr_string = &make_attr_string($args->{'force_register'}, @@ -8693,7 +9814,8 @@ sub start_page { $args->{'only_body'}, $args->{'domain'}, $args->{'force_register'}, $args->{'no_nav_bar'}, $args->{'bgcolor'}, $args, - \@advtools); + \@advtools,$ltiscope,$ltiuri,\%ltimenu,$menucoll, + \%menu,\$showncrumbs); } } @@ -8715,6 +9837,7 @@ sub start_page { #Breadcrumbs if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) { + unless ($showncrumbs) { &Apache::lonhtmlcommon::clear_breadcrumbs(); #if any br links exists, add them to the breadcrumbs if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') { @@ -8726,12 +9849,6 @@ sub start_page { if (@advtools > 0) { &Apache::lonmenu::advtools_crumbs(@advtools); } - my $ltiscope; - if (($env{'request.course.id'}) && ($env{'request.lti.login'})) { - my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; - my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; - ($ltiscope) = &LONCAPA::ltiutils::lti_provider_scope($env{'request.lti.uri'},$cdom,$cnum); - } my $menulink; # if arg: bread_crumbs_nomenu is true pass 0 as $menulink item. if ((exists($args->{'bread_crumbs_nomenu'})) || @@ -8743,12 +9860,20 @@ sub start_page { } else { undef($menulink); } + my $linkprotout; + if ($env{'request.deeplink.login'}) { + my $linkprotout = &Apache::lonmenu::linkprot_exit(); + if ($linkprotout) { + &Apache::lonhtmlcommon::add_breadcrumb_tool('tools',$linkprotout); + } + } #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'},'',$menulink); } else { $result .= &Apache::lonhtmlcommon::breadcrumbs('','',$menulink); } + } } return $result; } @@ -8785,6 +9910,147 @@ sub end_page { return $result; } +sub menucoll_in_effect { + my ($menucoll,$deeplinkmenu,%menu); + if ($env{'request.course.id'}) { + $menucoll = $env{'course.'.$env{'request.course.id'}.'.menudefault'}; + if ($env{'request.deeplink.login'}) { + my ($deeplink_symb,$deeplink,$check_login_symb); + my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; + my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; + if ($env{'request.noversionuri'} =~ m{^/(res|uploaded)/}) { + if ($env{'request.noversionuri'} =~ /\.(page|sequence)$/) { + my $navmap = Apache::lonnavmaps::navmap->new(); + if (ref($navmap)) { + $deeplink = $navmap->get_mapparam(undef, + &Apache::lonnet::declutter($env{'request.noversionuri'}), + '0.deeplink'); + } else { + $check_login_symb = 1; + } + } else { + my $symb = &Apache::lonnet::symbread(); + if ($symb) { + $deeplink = &Apache::lonnet::EXT('resource.0.deeplink',$symb); + } else { + $check_login_symb = 1; + } + } + } else { + $check_login_symb = 1; + } + if ($check_login_symb) { + $deeplink_symb = &deeplink_login_symb($cnum,$cdom); + if ($deeplink_symb =~ /\.(page|sequence)$/) { + my $mapname = &Apache::lonnet::deversion((&Apache::lonnet::decode_symb($deeplink_symb))[2]); + my $navmap = Apache::lonnavmaps::navmap->new(); + if (ref($navmap)) { + $deeplink = $navmap->get_mapparam(undef,$mapname,'0.deeplink'); + } + } else { + $deeplink = &Apache::lonnet::EXT('resource.0.deeplink',$deeplink_symb); + } + } + if ($deeplink ne '') { + my ($state,$others,$listed,$scope,$protect,$display,$target) = split(/,/,$deeplink); + if ($display =~ /^\d+$/) { + $deeplinkmenu = 1; + $menucoll = $display; + } + } + } + if ($menucoll) { + %menu = &page_menu($env{'course.'.$env{'request.course.id'}.'.menucollections'},$menucoll); + } + } + return ($menucoll,$deeplinkmenu,\%menu); +} + +sub deeplink_login_symb { + my ($cnum,$cdom) = @_; + my $login_symb; + if ($env{'request.deeplink.login'}) { + $login_symb = &symb_from_tinyurl($env{'request.deeplink.login'},$cnum,$cdom); + } + return $login_symb; +} + +sub symb_from_tinyurl { + my ($url,$cnum,$cdom) = @_; + if ($url =~ m{^\Q/tiny/$cdom/\E(\w+)$}) { + my $key = $1; + my ($tinyurl,$login); + my ($result,$cached)=&Apache::lonnet::is_cached_new('tiny',$cdom."\0".$key); + if (defined($cached)) { + $tinyurl = $result; + } else { + my $configuname = &Apache::lonnet::get_domainconfiguser($cdom); + my %currtiny = &Apache::lonnet::get('tiny',[$key],$cdom,$configuname); + if ($currtiny{$key} ne '') { + $tinyurl = $currtiny{$key}; + &Apache::lonnet::do_cache_new('tiny',$cdom."\0".$key,$currtiny{$key},600); + } + } + if ($tinyurl ne '') { + my ($cnumreq,$symb) = split(/\&/,$tinyurl); + if (wantarray) { + return ($cnumreq,$symb); + } elsif ($cnumreq eq $cnum) { + return $symb; + } + } + } + if (wantarray) { + return (); + } else { + return; + } +} + +sub usable_exttools { + my %tooltypes; + if ($env{'request.course.id'}) { + if ($env{'course.'.$env{'request.course.id'}.'.internal.exttool'}) { + if ($env{'course.'.$env{'request.course.id'}.'.internal.exttool'} eq 'both') { + %tooltypes = ( + crs => 1, + dom => 1, + ); + } elsif ($env{'course.'.$env{'request.course.id'}.'.internal.exttool'} eq 'crs') { + $tooltypes{'crs'} = 1; + } elsif ($env{'course.'.$env{'request.course.id'}.'.internal.exttool'} eq 'dom') { + $tooltypes{'dom'} = 1; + } + } else { + my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; + my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; + my $crstype = lc($env{'course.'.$env{'request.course.id'}.'.type'}); + if ($crstype eq '') { + $crstype = 'course'; + } + if ($crstype eq 'course') { + if ($env{'course.'.$env{'request.course.id'}.'internal.coursecode'}) { + $crstype = 'official'; + } elsif ($env{'course.'.$env{'request.course.id'}.'.internal.textbook'}) { + $crstype = 'textbook'; + } elsif ($env{'course.'.$env{'request.course.id'}.'.internal.lti'}) { + $crstype = 'lti'; + } else { + $crstype = 'unofficial'; + } + } + my %domdefaults = &Apache::lonnet::get_domain_defaults($cdom); + if ($domdefaults{$crstype.'domexttool'}) { + $tooltypes{'dom'} = 1; + } + if ($domdefaults{$crstype.'exttool'}) { + $tooltypes{'crs'} = 1; + } + } + } + return %tooltypes; +} + sub wishlist_window { return(<<'ENDWISHLIST'); @@ -8893,7 +10167,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'}). @@ -8902,12 +10176,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.""; } @@ -9465,6 +10739,16 @@ Scalar: 1 if 'Course' to be used, 0 othe ############################################### sub show_course { + my ($udom,$uname) = @_; + if (($udom ne '') && ($uname ne '')) { + if (($udom ne $env{'user.domain'}) || ($uname ne $env{'user.name'})) { + if (&Apache::lonnet::is_advanced_user($udom,$uname)) { + return 0; + } else { + return 1; + } + } + } my $course = !$env{'user.adv'}; if (!$env{'user.adv'}) { foreach my $env (keys(%env)) { @@ -10782,11 +12066,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'}); @@ -10797,8 +12085,8 @@ 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); $$LC_code{$1} = $2; @@ -10806,15 +12094,28 @@ sub get_institutional_codes { } } } - + 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}) { + 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} = $lc_sec; + $$LC_code{$sec} = $unclutteredlcsec{$crskey}[$i]; } } } @@ -12141,7 +13442,7 @@ sub modify_html_refs { return; } } - if (open(my $fh,"<$container")) { + if (open(my $fh,'<',$container)) { $content = join('', <$fh>); close($fh); } else { @@ -12206,7 +13507,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].', @@ -13422,7 +14723,9 @@ sub process_extracted_files { my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'. $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'. $title; - if (($outer !~ /\D/) && ($mapinner{$outer} !~ /\D/) && ($newidx !~ /\D/)) { + if (($outer !~ /\D/) && + (($mapinner{$outer} eq 'default') || ($mapinner{$outer} !~ /\D/)) && + ($newidx !~ /\D/)) { if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") { mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755); } @@ -13835,7 +15138,7 @@ sub upfile_store { { 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); } @@ -13860,7 +15163,7 @@ sub load_tmp_file { { my $studentfile = $r->dir_config('lonDaemons'). '/tmp/'.$datatoken.'.tmp'; - if ( open(my $fh,"<$studentfile") ) { + if ( open(my $fh,'<',$studentfile) ) { @studentdata=<$fh>; close($fh); } @@ -13870,7 +15173,7 @@ sub load_tmp_file { sub valid_datatoken { my ($datatoken) = @_; - if ($datatoken =~ /^$match_username\_$match_domain\_enroll_$match_domain\_$match_courseid\_\d+_\d+$/) { + if ($datatoken =~ /^$match_username\_$match_domain\_enroll_(|$match_domain\_$match_courseid)\_\d+_\d+$/) { return $datatoken; } return; @@ -15026,6 +16329,8 @@ Inputs: from - Sender's email address +replyto - Reply-To email address + to - Email address of recipient subject - Subject of email @@ -15036,8 +16341,6 @@ cc_string - Carbon copy email ad bcc - Blind carbon copy email address -type - File type of attachment - attachment_path - Path of file to be attached file_name - Name of file to be attached @@ -15054,8 +16357,9 @@ attachment_text - The body of an attac ############################################################ sub mime_email { - my ($from, $to, $subject, $body, $cc_string, $bcc, $attachment_path, - $file_name, $attachment_text) = @_; + my ($from,$replyto,$to,$subject,$body,$cc_string,$bcc,$attachment_path, + $file_name,$attachment_text) = @_; + my $msg = MIME::Lite->new( From => $from, To => $to, @@ -15063,6 +16367,9 @@ sub mime_email { Type =>'TEXT', Data => $body, ); + if ($replyto ne '') { + $msg->add("Reply-To" => $replyto); + } if ($cc_string ne '') { $msg->add("Cc" => $cc_string); } @@ -15178,6 +16485,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. @@ -15185,7 +16494,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') { @@ -15213,12 +16522,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; + } } } } @@ -15256,13 +16568,13 @@ 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++) { my $name = $cats->[$depth]{$category}[$k]; 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; @@ -15283,16 +16595,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; } @@ -15324,8 +16641,8 @@ sub assign_categories_table { 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; @@ -15463,27 +16780,33 @@ sub assign_category_rows { sub commit_customrole { - my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_; + my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context,$othdomby,$requester) = @_; + my $result = &Apache::lonnet::assigncustomrole( + $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef, + $context,$othdomby,$requester); my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url. ($start?', '.&mt('starting').' '.localtime($start):''). - ($end?', ending '.localtime($end):'').': '. - &Apache::lonnet::assigncustomrole( - $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context). - '
'; - return $output; + ($end?', ending '.localtime($end):'').': '.$result.'
'; + if (wantarray) { + return ($output,$result); + } else { + return $output; + } } sub commit_standardrole { - my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits) = @_; - my ($output,$logmsg,$linefeed); + my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits, + $othdomby,$requester) = @_; + my ($output,$logmsg,$linefeed,$result); if ($context eq 'auto') { $linefeed = "\n"; } else { $linefeed = "
\n"; } if ($three eq 'st') { - my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end, - $one,$two,$sec,$context,$credits); + $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end, + $one,$two,$sec,$context,$credits,$othdomby, + $requester); if (($result =~ /^error/) || ($result eq 'not_in_class') || ($result eq 'unknown_course') || ($result eq 'refused')) { $output = $logmsg.' '.&mt('Error: ').$result."\n"; @@ -15503,19 +16826,24 @@ sub commit_standardrole { $output = &mt('Assigning').' '.$three.' in '.$url. ($start?', '.&mt('starting').' '.localtime($start):''). ($end?', '.&mt('ending').' '.localtime($end):'').': '; - my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context); + $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start, + '','',$context,$othdomby,$requester); if ($context eq 'auto') { $output .= $result.$linefeed; } else { $output .= ''.$result.''.$linefeed; } } - return $output; + if (wantarray) { + return ($output,$result); + } else { + return $output; + } } sub commit_studentrole { my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context, - $credits) = @_; + $credits,$othdomby,$requester) = @_; my ($result,$linefeed,$oldsecurl,$newsecurl); if ($context eq 'auto') { $linefeed = "\n"; @@ -15539,8 +16867,9 @@ sub commit_studentrole { } $oldsecurl = $uurl; $expire_role_result = - &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context); - if ($env{'request.course.sec'} ne '') { + &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now, + '','','',$context,$othdomby,$requester); + if ($env{'request.course.sec'} ne '') { if ($expire_role_result eq 'refused') { my @roles = ('st'); my @statuses = ('previous'); @@ -15566,7 +16895,8 @@ sub commit_studentrole { &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef, undef,undef,undef,$sec, $end,$start,'','',$cid, - '',$context,$credits); + '',$context,$credits,'', + $othdomby,$requester); if ($modify_section_result =~ /^ok/) { if ($secchange == 1) { if ($sec eq '') { @@ -15651,7 +16981,8 @@ sub check_clone { my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'}; my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid); my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom); - my $clonemsg; + my $clonetitle; + my @clonemsg; my $can_clone = 0; my $lctype = lc($args->{'crstype'}); if ($lctype ne 'community') { @@ -15659,16 +16990,38 @@ sub check_clone { } if ($clonehome eq 'no_host') { if ($args->{'crstype'} eq 'Community') { - $clonemsg = &mt('No new community created.').$linefeed.&mt('A new community could not be cloned from the specified original - [_1] - because it is a non-existent community.',$args->{'clonecourse'}.':'.$args->{'clonedomain'}); + push(@clonemsg,({ + mt => 'No new community created.', + args => [], + }, + { + mt => 'A new community could not be cloned from the specified original - [_1] - because it is a non-existent community.', + args => [$args->{'clonedomain'}.':'.$args->{'clonedomain'}], + })); } else { - $clonemsg = &mt('No new course created.').$linefeed.&mt('A new course could not be cloned from the specified original - [_1] - because it is a non-existent course.',$args->{'clonecourse'}.':'.$args->{'clonedomain'}); - } + push(@clonemsg,({ + mt => 'No new course created.', + args => [], + }, + { + mt => 'A new course could not be cloned from the specified original - [_1] - because it is a non-existent course.', + args => [$args->{'clonecourse'}.':'.$args->{'clonedomain'}], + })); + } } else { my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1}); + $clonetitle = $clonedesc{'description'}; if ($args->{'crstype'} eq 'Community') { if ($clonedesc{'type'} ne 'Community') { - $clonemsg = &mt('No new community created.').$linefeed.&mt('A new community could not be cloned from the specified original - [_1] - because it is a course not a community.',$args->{'clonecourse'}.':'.$args->{'clonedomain'}); - return ($can_clone, $clonemsg, $cloneid, $clonehome); + push(@clonemsg,({ + mt => 'No new community created.', + args => [], + }, + { + mt => 'A new community could not be cloned from the specified original - [_1] - because it is a course not a community.', + args => [$args->{'clonecourse'}.':'.$args->{'clonedomain'}], + })); + return ($can_clone,\@clonemsg,$cloneid,$clonehome); } } if (($env{'request.role.domain'} eq $args->{'clonedomain'}) && @@ -15757,20 +17110,34 @@ sub check_clone { } 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'}); + push(@clonemsg,({ + mt => 'No new community created.', + args => [], + }, + { + mt => 'The new community could not be cloned from the existing community because the new community owner ([_1]) does not have cloning rights in the existing community ([_2]).', + args => [$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}], + })); } else { - $clonemsg = &mt('No new course created.').$linefeed.&mt('The new course could not be cloned from the existing course because the new course owner ([_1]) does not have cloning rights in the existing course ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}); + push(@clonemsg,({ + mt => 'No new course created.', + args => [], + }, + { + mt => 'The new course could not be cloned from the existing course because the new course owner ([_1]) does not have cloning rights in the existing course ([_2]).', + args => [$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}], + })); } } } } - return ($can_clone, $clonemsg, $cloneid, $clonehome); + return ($can_clone,\@clonemsg,$cloneid,$clonehome,$clonetitle); } sub construct_course { my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context, - $cnum,$category,$coderef) = @_; - my $outcome; + $cnum,$category,$coderef,$callercontext,$user_lh) = @_; + my ($outcome,$msgref,$clonemsgref); my $linefeed = '
'."\n"; if ($context eq 'auto') { $linefeed = "\n"; @@ -15779,18 +17146,11 @@ sub construct_course { # # Are we cloning? # - my ($can_clone, $clonemsg, $cloneid, $clonehome); + my ($can_clone,$cloneid,$clonehome,$clonetitle); if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) { - ($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed); - if ($context ne 'auto') { - if ($clonemsg ne '') { - $clonemsg = ''.$clonemsg.''; - } - } - $outcome .= $clonemsg.$linefeed; - + ($can_clone,$clonemsgref,$cloneid,$clonehome,$clonetitle) = &check_clone($args,$linefeed); if (!$can_clone) { - return (0,$outcome); + return (0,$outcome,$clonemsgref); } } @@ -15813,15 +17173,20 @@ sub construct_course { $args->{'ccuname'}.':'. $args->{'ccdomain'}, $args->{'crstype'}, - $cnum,$context,$category); + $cnum,$context,$category, + $callercontext); # Note: The testing routines depend on this being output; see # Utils::Course. This needs to at least be output as a comment # if anyone ever decides to not show this, and Utils::Course::new # will need to be suitably modified. - $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$showncrstype,$$courseid).$linefeed; + if (($callercontext eq 'auto') && ($user_lh ne '')) { + $outcome .= &mt_user($user_lh,'New LON-CAPA [_1] ID: [_2]',$showncrstype,$$courseid).$linefeed; + } else { + $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$showncrstype,$$courseid).$linefeed; + } if ($$courseid =~ /^error:/) { - return (0,$outcome); + return (0,$outcome,$clonemsgref); } # @@ -15830,23 +17195,37 @@ sub construct_course { ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid); my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom); if ($crsuhome eq 'no_host') { - $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed; - return (0,$outcome); + if (($callercontext eq 'auto') && ($user_lh ne '')) { + $outcome .= &mt_user($user_lh, + 'Course creation failed, unrecognized course home server.'); + } else { + $outcome .= &mt('Course creation failed, unrecognized course home server.'); + } + $outcome .= $linefeed; + return (0,$outcome,$clonemsgref); } $outcome .= &mt('Created on').': '.$crsuhome.$linefeed; # # Do the cloning # + my @clonemsg; if ($can_clone && $cloneid) { - $clonemsg = &mt('Cloning [_1] from [_2]',$showncrstype,$clonehome); - if ($context ne 'auto') { - $clonemsg = ''.$clonemsg.''; - } - $outcome .= $clonemsg.$linefeed; + push(@clonemsg, + { + mt => 'Created [_1] by cloning from [_2]', + args => [$showncrstype,$clonetitle], + }); my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum); # Copy all files - &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'}); + my @info = + &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'}, + $args->{'dateshift'},$args->{'crscode'}, + $args->{'ccuname'}.':'.$args->{'ccdomain'}, + $args->{'tinyurls'}); + if (@info) { + push(@clonemsg,@info); + } # Restore URL $cenv{'url'}=$oldcenv{'url'}; # Restore title @@ -15871,8 +17250,7 @@ sub construct_course { 'plc.users.denied', 'hidefromcat', 'checkforpriv', - 'categories', - 'internal.uniquecode'], + 'categories'], $$crsudom,$$crsunum); if ($args->{'textbook'}) { $cenv{'internal.textbook'} = $args->{'textbook'}; @@ -15887,6 +17265,9 @@ sub construct_course { if ($args->{'crstype'}) { $cenv{'type'}=$args->{'crstype'}; } + if ($args->{'lti'}) { + $cenv{'internal.lti'}=$args->{'lti'}; + } if ($args->{'crsid'}) { $cenv{'courseid'}=$args->{'crsid'}; } @@ -15908,6 +17289,7 @@ sub construct_course { $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'}; } my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner. + my @oklcsecs = (); # Used to accumulate LON-CAPA sections for validated institutional sections. if ($args->{'crssections'}) { $cenv{'internal.sectionnums'} = ''; if ($args->{'crssections'} =~ m/,/) { @@ -15921,7 +17303,11 @@ sub construct_course { my $class = $args->{'crscode'}.$sec; my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'}); $cenv{'internal.sectionnums'} .= $item.','; - unless ($addcheck eq 'ok') { + if ($addcheck eq 'ok') { + unless (grep(/^\Q$gp\E$/,@oklcsecs)) { + push(@oklcsecs,$gp); + } + } else { push(@badclasses,$class); } } @@ -15949,7 +17335,11 @@ sub construct_course { my ($xl,$gp) = split/:/,$item; my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'}); $cenv{'internal.crosslistings'} .= $item.','; - unless ($addcheck eq 'ok') { + if ($addcheck eq 'ok') { + unless (grep(/^\Q$gp\E$/,@oklcsecs)) { + push(@oklcsecs,$gp); + } + } else { push(@badclasses,$xl); } } @@ -16012,6 +17402,36 @@ sub construct_course { if ($args->{'no_end_date'}) { $args->{'endaccess'} = 0; } +# If an official course with institutional sections is created by cloning +# an existing course, section-specific hiding of course totals in student's +# view of grades as copied from cloned course, will be checked for valid +# sections. + if (($can_clone && $cloneid) && + ($cenv{'internal.coursecode'} ne '') && + ($cenv{'grading'} eq 'standard') && + ($cenv{'hidetotals'} ne '') && + ($cenv{'hidetotals'} ne 'all')) { + my @hidesecs; + my $deletehidetotals; + if (@oklcsecs) { + foreach my $sec (split(/,/,$cenv{'hidetotals'})) { + if (grep(/^\Q$sec$/,@oklcsecs)) { + push(@hidesecs,$sec); + } + } + if (@hidesecs) { + $cenv{'hidetotals'} = join(',',@hidesecs); + } else { + $deletehidetotals = 1; + } + } else { + $deletehidetotals = 1; + } + if ($deletehidetotals) { + delete($cenv{'hidetotals'}); + &Apache::lonnet::del('environment',['hidetotals'],$$crsudom,$$crsunum); + } + } $cenv{'internal.autostart'}=$args->{'enrollstart'}; $cenv{'internal.autoend'}=$args->{'enrollend'}; $cenv{'default_enrollment_start_date'}=$args->{'startaccess'}; @@ -16113,19 +17533,23 @@ 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 # unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank') || ($cloneid)) { - use LONCAPA::map; $outcome .= &mt('Setting first resource').': '; my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence'; @@ -16172,7 +17596,7 @@ sub construct_course { ('resourcedata',\%storecontent,$$crsudom,$$crsunum); } - return (1,$outcome); + return (1,$outcome,\@clonemsg); } sub make_unique_code { @@ -16343,6 +17767,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) = @_; @@ -16350,7 +17792,8 @@ sub init_user_environment { my $public=($username eq 'public' && $domain eq 'public'); - my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv); + my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv, + $coauthorenv); my $now=time; if ($public) { @@ -16377,18 +17820,18 @@ sub init_user_environment { opendir(DIR,$lonids); while ($filename=readdir(DIR)) { if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) { - if ($ENV{'SERVER_PORT'} == 443) { + if (tie(my %oldenv,'GDBM_File',"$lonids/$filename", + &GDBM_READER(),0640)) { my $linkedfile; - if (tie(my %oldenv,'GDBM_File',"$lonids/$cookie.id", - &GDBM_READER(),0640)) { - if (exists($oldenv{'user.linkedenv'})) { - $linkedfile = $oldenv{'user.linkedenv'}; - } - untie(%oldenv); + if (exists($oldenv{'user.linkedenv'})) { + $linkedfile = $oldenv{'user.linkedenv'}; } - if (unlink($lonids.'/'.$filename)) { - if ($linkedfile =~ /^[a-f0-9]+_linked\.id$/) { - unlink($lonids.'/'.$linkedfile); + untie(%oldenv); + if (unlink("$lonids/$filename")) { + if ($linkedfile =~ /^[a-f0-9]+_linked$/) { + if (-l "$lonids/$linkedfile.id") { + unlink("$lonids/$linkedfile.id"); + } } } } else { @@ -16416,7 +17859,7 @@ sub init_user_environment { # Initialize roles - ($userroles,$firstaccenv,$timerintenv) = + ($userroles,$firstaccenv,$timerintenv,$coauthorenv) = &Apache::lonnet::rolesinit($domain,$username,$authhost); } # ------------------------------------ Check browser type and MathML capability @@ -16443,6 +17886,7 @@ sub init_user_environment { # --------------------------------------------------------- Write first profile { + my $ip = &Apache::lonnet::get_requestor_ip($r); my %initial_env = ("user.name" => $username, "user.domain" => $domain, @@ -16461,7 +17905,7 @@ sub init_user_environment { "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'}; @@ -16493,8 +17937,8 @@ sub init_user_environment { my %is_adv = ( is_adv => $env{'user.adv'} ); my %domdef = &Apache::lonnet::get_domain_defaults($domain); - foreach my $tool ('aboutme','blog','webdav','portfolio') { - $userenv{'availabletools.'.$tool} = + foreach my $tool ('aboutme','blog','webdav','portfolio','portaccess','timezone') { + $userenv{'availabletools.'.$tool} = &Apache::lonnet::usertools_access($username,$domain,$tool,'reload', undef,\%userenv,\%domdef,\%is_adv); } @@ -16506,6 +17950,17 @@ sub init_user_environment { \%userenv,\%domdef,\%is_adv); } + if ((ref($userroles) eq 'HASH') && ($userroles->{'user.author'}) && + (exists($userroles->{"user.role.au./$domain/"}))) { + if ($userenv{'authoreditors'}) { + $userenv{'editors'} = $userenv{'authoreditors'}; + } elsif ($domdef{'editors'} ne '') { + $userenv{'editors'} = $domdef{'editors'}; + } else { + $userenv{'editors'} = 'edit,xml'; + } + } + $userenv{'canrequest.author'} = &Apache::lonnet::usertools_access($username,$domain,'requestauthor', 'reload','requestauthor', @@ -16562,6 +18017,11 @@ sub init_user_environment { if (ref($timerintenv) eq 'HASH') { &_add_to_env(\%disk_env,$timerintenv); } + if (ref($coauthorenv) eq 'HASH') { + if (keys(%{$coauthorenv})) { + &_add_to_env(\%disk_env,$coauthorenv); + } + } if (ref($args->{'extra_env'})) { &_add_to_env(\%disk_env,$args->{'extra_env'}); } @@ -17362,27 +18822,51 @@ sub needs_coursereinit { } if (($now-$env{'request.course.timechecked'})>$interval) { &Apache::lonnet::appenv({'request.course.timechecked'=>$now}); - my $blocked = &blocking_status('reinit',$cnum,$cdom,undef,1); + my $blocked = &blocking_status('reinit',undef,$cnum,$cdom,undef,1); if ($blocked) { return (); } - my $lastchange = &Apache::lonnet::get_coursechange($cdom,$cnum); - 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); - } + my $update; + my $lastmainchange = &Apache::lonnet::get_coursechange($cdom,$cnum); + my $lastsuppchange = &Apache::lonnet::get_suppchange($cdom,$cnum); + if ($lastmainchange > $env{'request.course.tied'}) { + my ($needswitch,$switchwarning,$switchserver) = &switch_for_update($loncaparev,$cdom,$cnum); + if ($needswitch) { + return ('switch',$switchwarning,$switchserver); + } + $update = 'main'; + } + if ($lastsuppchange > $env{'request.course.suppupdated'}) { + if ($update) { + $update = 'both'; + } else { + my ($needswitch,$switchwarning,$switchserver) = &switch_for_update($loncaparev,$cdom,$cnum); + if ($needswitch) { + return ('switch',$switchwarning,$switchserver); + } else { + $update = 'supp'; } } - return ('update'); + return ($update); + } + } + return (); +} + +sub switch_for_update { + my ($loncaparev,$cdom,$cnum) = @_; + 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 (); @@ -17437,11 +18921,7 @@ sub update_content_constraints { } undef($navmap); } - my $suppmap = 'supplemental.sequence'; - my ($suppcount,$supptools,$errors) = (0,0,0); - ($suppcount,$supptools,$errors) = &recurse_supplemental($cnum,$cdom,$suppmap, - $suppcount,$supptools,$errors); - if ($supptools) { + if (&Apache::lonnet::count_supptools($cnum,$cdom,1)) { my ($major,$minor) = split(/\./,$checkcrsrestypes{'exttool'}); if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) { ($reqdmajor,$reqdminor) = ($major,$minor); @@ -17493,8 +18973,10 @@ sub parse_supplemental_title { my $name = &plainname($uname,$udom); $name = &HTML::Entities::encode($name,'"<>&\''); $renametitle = &HTML::Entities::encode($renametitle,'"<>&\''); - $title=''.&Apache::lonlocal::locallocaltime($time).' '. - $name.':
'.$foldertitle; + $title=''.&Apache::lonlocal::locallocaltime($time).' '.$name; + if ($foldertitle ne '') { + $title .= ':
'.$foldertitle; + } } if (wantarray) { return ($title,$foldertitle,$renametitle); @@ -17502,32 +18984,147 @@ sub parse_supplemental_title { return $title; } +sub get_supplemental { + my ($cnum,$cdom,$ignorecache,$possdel)=@_; + my $hashid=$cnum.':'.$cdom; + my ($supplemental,$cached,$set_httprefs); + unless ($ignorecache) { + ($supplemental,$cached) = &Apache::lonnet::is_cached_new('supplemental',$hashid); + } + unless (defined($cached)) { + my $chome=&Apache::lonnet::homeserver($cnum,$cdom); + unless ($chome eq 'no_host') { + my @order = @LONCAPA::map::order; + my @resources = @LONCAPA::map::resources; + my @resparms = @LONCAPA::map::resparms; + my @zombies = @LONCAPA::map::zombies; + my ($errors,%ids,%hidden); + $errors = + &recurse_supplemental($cnum,$cdom,'supplemental.sequence', + $errors,$possdel,\%ids,\%hidden); + @LONCAPA::map::order = @order; + @LONCAPA::map::resources = @resources; + @LONCAPA::map::resparms = @resparms; + @LONCAPA::map::zombies = @zombies; + $set_httprefs = 1; + if ($env{'request.course.id'} eq $cdom.'_'.$cnum) { + &Apache::lonnet::appenv({'request.course.suppupdated' => time}); + } + $supplemental = { + ids => \%ids, + hidden => \%hidden, + }; + &Apache::lonnet::do_cache_new('supplemental',$hashid,$supplemental,600); + } + } + return ($supplemental,$set_httprefs); +} + sub recurse_supplemental { - my ($cnum,$cdom,$suppmap,$numfiles,$numexttools,$errors) = @_; - if ($suppmap) { + my ($cnum,$cdom,$suppmap,$errors,$possdel,$suppids,$hiddensupp,$hidden) = @_; + if (($suppmap) && (ref($suppids) eq 'HASH') && (ref($hiddensupp) eq 'HASH')) { + my $mapnum; + if ($suppmap eq 'supplemental.sequence') { + $mapnum = 0; + } else { + ($mapnum) = ($suppmap =~ /^supplemental_(\d+)\.sequence$/); + } my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap); if ($fatal) { $errors ++; } else { - if ($#LONCAPA::map::resources > 0) { - foreach my $res (@LONCAPA::map::resources) { - my ($title,$src,$ext,$type,$status)=split(/\:/,$res); + my @order = @LONCAPA::map::order; + if (@order > 0) { + my @resources = @LONCAPA::map::resources; + my @resparms = @LONCAPA::map::resparms; + foreach my $idx (@order) { + my ($title,$src,$ext,$type,$status)=split(/\:/,$resources[$idx]); if (($src ne '') && ($status eq 'res')) { + my $id = $mapnum.':'.$idx; + push(@{$suppids->{$src}},$id); + if (($hidden) || (&get_supp_parameter($resparms[$idx],'parameter_hiddenresource') =~ /^yes/i)) { + $hiddensupp->{$id} = 1; + } if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) { - ($numfiles,$numexttools,$errors) = &recurse_supplemental($cnum,$cdom,$1, - $numfiles,$numexttools,$errors); + $errors = &recurse_supplemental($cnum,$cdom,$1,$errors,$possdel,$suppids, + $hiddensupp,$hiddensupp->{$id}); } else { - if ($src =~ m{^/adm/$cdom/$cnum/\d+/ext\.tool$}) { - $numexttools ++; + my $allowed; + if (($env{'request.role.adv'}) || (!$hiddensupp->{$id})) { + $allowed = 1; + } elsif ($possdel) { + foreach my $item (@{$suppids->{$src}}) { + next if ($item eq $id); + unless ($hiddensupp->{$item}) { + $allowed = 1; + last; + } + } + if ((!$allowed) && (exists($env{'httpref.'.$src}))) { + &Apache::lonnet::delenv('httpref.'.$src); + } + } + if ($allowed && (!exists($env{'httpref.'.$src}))) { + &Apache::lonnet::allowuploaded('/adm/coursedoc',$src); } - $numfiles ++; } } } } } } - return ($numfiles,$numexttools,$errors); + return $errors; +} + +sub set_supp_httprefs { + my ($cnum,$cdom,$supplemental,$possdel) = @_; + if (ref($supplemental) eq 'HASH') { + if ((ref($supplemental->{'ids'}) eq 'HASH') && (ref($supplemental->{'hidden'}) eq 'HASH')) { + foreach my $src (keys(%{$supplemental->{'ids'}})) { + next if ($src =~ /\.sequence$/); + if (ref($supplemental->{'ids'}->{$src}) eq 'ARRAY') { + my $allowed; + if ($env{'request.role.adv'}) { + $allowed = 1; + } else { + foreach my $id (@{$supplemental->{'ids'}->{$src}}) { + unless ($supplemental->{'hidden'}->{$id}) { + $allowed = 1; + last; + } + } + } + if (exists($env{'httpref.'.$src})) { + if ($possdel) { + unless ($allowed) { + &Apache::lonnet::delenv('httpref.'.$src); + } + } + } elsif ($allowed) { + &Apache::lonnet::allowuploaded('/adm/coursedoc',$src); + } + } + } + if ($env{'request.course.id'} eq $cdom.'_'.$cnum) { + &Apache::lonnet::appenv({'request.course.suppupdated' => time}); + } + } + } +} + +sub get_supp_parameter { + my ($resparm,$name)=@_; + return if ($resparm eq ''); + my $value=undef; + my $ptype=undef; + foreach (split('&&&',$resparm)) { + my ($thistype,$thisname,$thisvalue)=split('___',$_); + if ($thisname eq $name) { + $value=$thisvalue; + $ptype=$thistype; + } + } + return $value; } sub symb_to_docspath { @@ -17600,11 +19197,72 @@ sub symb_to_docspath { return $path; } +sub validate_folderpath { + my ($supplementalflag,$allowed,$coursenum,$coursedom) = @_; + if ($env{'form.folderpath'} ne '') { + my @items = split(/\&/,$env{'form.folderpath'}); + my ($badpath,$changed,$got_supp,$supppath,%supphidden,%suppids); + for (my $i=0; $i<@items; $i++) { + my $odd = $i%2; + if (($odd) && (!$supplementalflag) && ($items[$i] !~ /^[^:]*:(|\d+):(|1):(|1):(|1):(|1)$/)) { + $badpath = 1; + } elsif ($odd && $supplementalflag) { + my $idx = $i-1; + if ($items[$i] =~ /^([^:]*)::(|1):::$/) { + my $esc_name = $1; + if ((!$allowed) || ($items[$idx] eq 'supplemental')) { + $supppath .= '&'.$esc_name; + $changed = 1; + } else { + $supppath .= '&'.$items[$i]; + } + } elsif (($allowed) && ($items[$idx] ne 'supplemental')) { + $changed = 1; + my $is_hidden; + unless ($got_supp) { + my ($supplemental) = &get_supplemental($coursenum,$coursedom); + if (ref($supplemental) eq 'HASH') { + if (ref($supplemental->{'hidden'}) eq 'HASH') { + %supphidden = %{$supplemental->{'hidden'}}; + } + if (ref($supplemental->{'ids'}) eq 'HASH') { + %suppids = %{$supplemental->{'ids'}}; + } + } + $got_supp = 1; + } + if (ref($suppids{"/uploaded/$coursedom/$coursenum/$items[$idx].sequence"}) eq 'ARRAY') { + my $mapid = $suppids{"/uploaded/$coursedom/$coursenum/$items[$idx].sequence"}->[0]; + if ($supphidden{$mapid}) { + $is_hidden = 1; + } + } + $supppath .= '&'.$items[$i].'::'.$is_hidden.':::'; + } else { + $supppath .= '&'.$items[$i]; + } + } elsif ((!$odd) && ($items[$i] !~ /^(default|supplemental)(|_\d+)$/)) { + $badpath = 1; + } elsif ($supplementalflag) { + $supppath .= '&'.$items[$i]; + } + last if ($badpath); + } + if ($badpath) { + delete($env{'form.folderpath'}); + } elsif ($changed && $supplementalflag) { + $supppath =~ s/^\&//; + $env{'form.folderpath'} = $supppath; + } + } + return; +} + sub captcha_display { - my ($context,$lonhost) = @_; + my ($context,$lonhost,$defdom) = @_; my ($output,$error); my ($captcha,$pubkey,$privkey,$version) = - &get_captcha_config($context,$lonhost); + &get_captcha_config($context,$lonhost,$defdom); if ($captcha eq 'original') { $output = &create_captcha(); unless ($output) { @@ -17620,9 +19278,9 @@ sub captcha_display { } sub captcha_response { - my ($context,$lonhost) = @_; + my ($context,$lonhost,$defdom) = @_; my ($captcha_chk,$captcha_error); - my ($captcha,$pubkey,$privkey,$version) = &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') { @@ -17634,7 +19292,7 @@ sub captcha_response { } sub get_captcha_config { - my ($context,$lonhost) = @_; + 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); @@ -17682,7 +19340,28 @@ sub get_captcha_config { } 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,$version); } @@ -17699,13 +19378,17 @@ sub create_captcha { if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') { $output = ''."\n". + ''. &mt('Type in the letters/numbers shown below').' '. - ''. - '
'. + ''. + '
'. 'captcha'; last; } } + if ($output eq '') { + &Apache::lonnet::logthis("Failed to create Captcha code after $tries attempts."); + } return $output; } @@ -17744,7 +19427,8 @@ sub check_captcha { sub create_recaptcha { my ($pubkey,$version) = @_; if ($version >= 2) { - return '

'; + return '
'. + '
'; } else { my $use_ssl; if ($ENV{'SERVER_PORT'} == 443) { @@ -17762,11 +19446,12 @@ sub create_recaptcha { sub check_recaptcha { my ($privkey,$version) = @_; my $captcha_chk; + my $ip = &Apache::lonnet::get_requestor_ip(); if ($version >= 2) { my %info = ( secret => $privkey, response => $env{'form.g-recaptcha-response'}, - remoteip => $ENV{'REMOTE_ADDR'}, + remoteip => $ip, ); my $request=new HTTP::Request('POST','https://www.google.com/recaptcha/api/siteverify'); $request->content(join('&',map { @@ -17789,7 +19474,7 @@ sub check_recaptcha { my $captcha_result = $captcha->check_answer( $privkey, - $ENV{'REMOTE_ADDR'}, + $ip, $env{'form.recaptcha_challenge_field'}, $env{'form.recaptcha_response_field'}, ); @@ -17841,11 +19526,14 @@ sub cleanup_html { # $context is the calling context -- roles, grades, contents, menu or flip. sub critical_redirect { my ($interval,$context) = @_; + unless (($env{'user.domain'} ne '') && ($env{'user.name'} ne '')) { + return (); + } if ((time-$env{'user.criticalcheck.time'})>$interval) { if (($env{'request.course.id'}) && (($context eq 'flip') || ($context eq 'contents'))) { my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; - my $blocked = &blocking_status('alert',$cnum,$cdom,undef,1); + my $blocked = &blocking_status('alert',undef,$cnum,$cdom,undef,1); if ($blocked) { my $checkrole = "cm./$cdom/$cnum"; if ($env{'request.course.sec'} ne '') { @@ -17862,7 +19550,7 @@ sub critical_redirect { &Apache::lonnet::appenv({'user.criticalcheck.time'=>time}); my $redirecturl; if ($what[0]) { - if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) { + 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); @@ -17922,24 +19610,37 @@ sub des_decrypt { return $plaintext; } -sub make_short_symbs { +sub get_requested_shorturls { my ($cdom,$cnum,$navmap) = @_; return unless (ref($navmap)); - my ($numnew,@errors); + my ($numnew,$errors); my @toshorten = &Apache::loncommon::get_env_multiple('form.addtiny'); if (@toshorten) { my (%maps,%resources,%titles); &Apache::loncourserespicker::enumerate_course_contents($navmap,\%maps,\%resources,\%titles, 'shorturls',$cdom,$cnum); - my %tocreate; if (keys(%resources)) { + my %tocreate; foreach my $item (sort {$a <=> $b} (@toshorten)) { my $symb = $resources{$item}; if ($symb) { $tocreate{$cnum.'&'.$symb} = 1; } } + if (keys(%tocreate)) { + ($numnew,$errors) = &make_short_symbs($cdom,$cnum, + \%tocreate); + } } + } + return ($numnew,$errors); +} + +sub make_short_symbs { + my ($cdom,$cnum,$tocreateref,$lockuser) = @_; + my ($numnew,@errors); + if (ref($tocreateref) eq 'HASH') { + my %tocreate = %{$tocreateref}; if (keys(%tocreate)) { my %coursetiny = &Apache::lonnet::dump('tiny',$cdom,$cnum); my $su = Short::URL->new(no_vowels => 1); @@ -17947,9 +19648,11 @@ sub make_short_symbs { my (%newunique,%addcourse,%courseonly,%failed); # get lock on tiny db my $now = time; + if ($lockuser eq '') { + $lockuser = $env{'user.name'}.':'.$env{'user.domain'}; + } my $lockhash = { - "lock\0$now" => $env{'user.name'}. - ':'.$env{'user.domain'}, + "lock\0$now" => $lockuser, }; my $tries = 0; my $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom); @@ -17957,7 +19660,7 @@ sub make_short_symbs { while (($gotlock ne 'ok') && ($tries<3)) { $tries ++; sleep 1; - $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom); + $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom); } if ($gotlock eq 'ok') { $init = &shorten_symbs($cdom,$init,$su,\%coursetiny,\%tocreate,\%newunique, @@ -18058,6 +19761,188 @@ sub shorten_symbs { return $init; } +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 $response = &LONCAPA::LWPReq::makerequest('',$request,'','',5); + 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; +} + +sub page_menu { + my ($menucolls,$menunum) = @_; + my %menu; + foreach my $item (split(/;/,$menucolls)) { + my ($num,$value) = split(/\%/,$item); + if ($num eq $menunum) { + my @entries = split(/\&/,$value); + foreach my $entry (@entries) { + my ($name,$fields) = split(/=/,$entry); + if (($name eq 'top') || ($name eq 'inline') || ($name eq 'foot') || ($name eq 'main')) { + $menu{$name} = $fields; + } else { + my @shown; + if ($fields =~ /,/) { + @shown = split(/,/,$fields); + } else { + @shown = ($fields); + } + if (@shown) { + foreach my $field (@shown) { + next if ($field eq ''); + $menu{$field} = 1; + } + } + } + } + } + } + return %menu; +} + 1; __END__;