--- loncom/interface/loncommon.pm 2014/03/18 01:49:39 1.1075.2.69 +++ loncom/interface/loncommon.pm 2021/01/28 22:12:53 1.1352 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.1075.2.69 2014/03/18 01:49:39 raeburn Exp $ +# $Id: loncommon.pm,v 1.1352 2021/01/28 22:12:53 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -71,12 +71,23 @@ use Apache::lonuserutils(); use Apache::lonuserstate(); use Apache::courseclassifier(); use LONCAPA qw(:DEFAULT :match); +use LONCAPA::LWPReq; +use HTTP::Request; use DateTime::TimeZone; -use DateTime::Locale::Catalog; +use DateTime::Locale; +use Encode(); +use Text::Aspell; use Authen::Captcha; use Captcha::reCAPTCHA; +use JSON::DWIW; use Crypt::DES; use DynaLoader; # for Crypt::DES version +use MIME::Lite; +use MIME::Types; +use File::Copy(); +use File::Path(); +use String::CRC32(); +use Short::URL(); # ---------------------------------------------- Designs use vars qw(%defaultdesign); @@ -161,6 +172,7 @@ sub ssi_with_retries { # ----------------------------------------------- Filetypes/Languages/Copyright my %language; my %supported_language; +my %supported_codes; my %latex_language; # For choosing hyphenation in my %latex_language_bykey; # for choosing hyphenation from metadata my %cprtag; @@ -191,18 +203,19 @@ 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); - my ($key,$two,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line)); + my ($key,$code,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line)); $language{$key}=$val.' - '.$enc; if ($sup) { $supported_language{$key}=$sup; + $supported_codes{$key} = $code; } if ($latex) { $latex_language_bykey{$key} = $latex; - $latex_language{$two} = $latex; + $latex_language{$code} = $latex; } } close($fh); @@ -212,7 +225,7 @@ BEGIN { { my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}. '/copyright.tab'; - if ( open (my $fh,"<$copyrightfile") ) { + if ( open (my $fh,'<',$copyrightfile) ) { while (my $line = <$fh>) { next if ($line=~/^\#/); chomp($line); @@ -226,7 +239,7 @@ BEGIN { { my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}. '/source_copyright.tab'; - if ( open (my $fh,"<$sourcecopyrightfile") ) { + if ( open (my $fh,'<',$sourcecopyrightfile) ) { while (my $line = <$fh>) { next if ($line =~ /^\#/); chomp($line); @@ -240,7 +253,7 @@ BEGIN { # -------------------------------------------------------------- default domain designs my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors'; my $designfile = $designdir.'/default.tab'; - if ( open (my $fh,"<$designfile") ) { + if ( open (my $fh,'<',$designfile) ) { while (my $line = <$fh>) { next if ($line =~ /^\#/); chomp($line); @@ -254,12 +267,12 @@ BEGIN { { my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}. '/filecategories.tab'; - if ( open (my $fh,"<$categoryfile") ) { + if ( open (my $fh,'<',$categoryfile) ) { while (my $line = <$fh>) { next if ($line =~ /^\#/); chomp($line); my ($extension,$category)=(split(/\s+/,$line,2)); - push @{$category_extensions{lc($category)}},$extension; + push(@{$category_extensions{lc($category)}},$extension); } close($fh); } @@ -269,7 +282,7 @@ BEGIN { { my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}. '/filetypes.tab'; - if ( open (my $fh,"<$typesfile") ) { + if ( open (my $fh,'<',$typesfile) ) { while (my $line = <$fh>) { next if ($line =~ /^\#/); chomp($line); @@ -422,7 +435,7 @@ sub studentbrowser_javascript { END # output the initial values for the selection lists - $result .= "\n"; my @order = sort(keys(%{$hashref})); if (ref($menuorder) eq 'ARRAY') { @order = @{$menuorder}; @@ -1237,11 +1298,7 @@ sub help_open_topic { $topic=~s/\W/\_/g; if (!$stayOnPage) { - if ($env{'browser.mobile'}) { - $link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');"; - } else { - $link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))"; - } + $link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');"; } elsif ($stayOnPage eq 'popup') { $link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))"; } else { @@ -1249,9 +1306,13 @@ sub help_open_topic { } # Add the text + my $target = ' target="_top"'; + if (($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) { + $target = ''; + } if ($text ne "") { $template.='' - .'' + .'' .$text.''; } @@ -1261,7 +1322,7 @@ sub help_open_topic { if ($imgid ne '') { $imgid = ' id="'.$imgid.'"'; } - $template.=' ' + $template.=' ' .''.&mt('Help: [_1]',$topic).''; unless ($not_author) { - $out .= ' ' - .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600) + $out .= '' + .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600) + .' ' + .&help_open_topic('Authoring_Multilingual_Problems',&mt('How to create problems in different languages'),$stayOnPage,undef,600) .''; } $out .= ''; # End cheatsheet @@ -1355,10 +1418,8 @@ sub help_open_menu { sub top_nav_help { my ($text) = @_; $text = &mt($text); - my $stay_on_page; - unless ($env{'environment.remote'} eq 'on') { - $stay_on_page = 1; - } + my $stay_on_page = 1; + my ($link,$banner_link); unless ($env{'request.noversionuri'} =~ m{^/adm/helpmenu}) { $link = ($stay_on_page) ? "javascript:helpMenu('display')" @@ -1388,9 +1449,9 @@ sub help_menu_js { &Apache::loncommon::start_page('Help Menu', undef, {'frameset' => 1, 'js_ready' => 1, - 'use_absolute' => $httphost, + 'use_absolute' => $httphost, 'add_entries' => { - 'border' => '0', + 'border' => '0', 'rows' => "110,*",},}); my $end_page = &Apache::loncommon::end_page({'frameset' => 1, @@ -1454,19 +1515,24 @@ sub help_open_bug { { $link = $url; } + + my $target = ' target="_top"'; + if (($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) { + $target = ''; + } # Add the text if ($text ne "") { $template .= "". - "
$text"; + "$text"; } # Add the graphic my $title = &mt('Report a Bug'); my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif"); $template .= <<"ENDTEMPLATE"; - (Bug: $topic) + (Bug: $topic) ENDTEMPLATE if ($text ne '') { $template.='
' }; return $template; @@ -1731,6 +1797,524 @@ RESIZE } +sub colorfuleditor_js { + my $browse_or_search; + my $respath; + my ($cnum,$cdom) = &crsauthor_url(); + if ($cnum) { + $respath = "/res/$cdom/$cnum/"; + my %js_lt = &Apache::lonlocal::texthash( + sunm => 'Sub-directory name', + save => 'Save page to make this permanent', + ); + &js_escape(\%js_lt); + $browse_or_search = <<"END"; + + function toggleChooser(form,element,titleid,only,search) { + var disp = 'none'; + if (document.getElementById('chooser_'+element)) { + var curr = document.getElementById('chooser_'+element).style.display; + if (curr == 'none') { + disp='inline'; + if (form.elements['chooser_'+element].length) { + for (var i=0; i 1) { + window['select1'+element+'_changed'](); + } + } + } + document.getElementById('chooser_'+element+'_crsres').style.display = 'block'; + + } + if (document.getElementById('chooser_'+element+'_upload')) { + document.getElementById('chooser_'+element+'_upload').style.display = 'none'; + if (document.getElementById('uploadcrsres_'+element)) { + document.getElementById('uploadcrsres_'+element).value = ''; + } + } + return; + } + + function toggleCrsUpload(form,element,numcrsdirs) { + if (document.getElementById('chooser_'+element+'_crsres')) { + document.getElementById('chooser_'+element+'_crsres').style.display = 'none'; + } + if (document.getElementById('chooser_'+element+'_upload')) { + var curr = document.getElementById('chooser_'+element+'_upload').style.display; + if (curr == 'none') { + if (numcrsdirs) { + form.elements['crsauthorpath_'+element].selectedIndex = 0; + form.elements['newsubdir_'+element][0].checked = true; + toggleNewsubdir(form,element); + } + } + document.getElementById('chooser_'+element+'_upload').style.display = 'block'; + } + return; + } + + function toggleResImport(form,element) { + var choices = new Array('crsres','upload'); + for (var i=0; i +// + function fold_box(curDepth, lastresource){ + + // we need a list because there can be several blocks you need to fold in one tag + var block = document.getElementsByName('foldblock_'+curDepth); + // but there is only one folding button per tag + var foldbutton = document.getElementById('folding_btn_'+curDepth); + + if(block.item(0).style.display == 'none'){ + + foldbutton.value = '@{[&mt("Hide")]}'; + for (i = 0; i < block.length; i++){ + block.item(i).style.display = ''; + } + }else{ + + foldbutton.value = '@{[&mt("Show")]}'; + for (i = 0; i < block.length; i++){ + // block.item(i).style.visibility = 'collapse'; + block.item(i).style.display = 'none'; + } + }; + saveState(lastresource); + } + + function saveState (lastresource) { + + var tag_list = getTagList(); + if(tag_list != null){ + var timestamp = new Date().getTime(); + var key = lastresource; + + // the value pattern is: 'time;key1,value1;key2,value2; ... ' + // starting with timestamp + var value = timestamp+';'; + + // building the list of key-value pairs + for(var i = 0; i < tag_list.length; i++){ + value += tag_list[i]+','; + value += document.getElementsByName(tag_list[i])[0].style.display+';'; + } + + // only iterate whole storage if nothing to override + if(localStorage.getItem(key) == null){ + + // prevent storage from growing large + if(localStorage.length > 50){ + var regex_getTimestamp = /^(?:\d)+;/; + var oldest_timestamp = regex_getTimestamp.exec(localStorage.key(0)); + var oldest_key; + + for(var i = 1; i < localStorage.length; i++){ + if (regex_getTimestamp.exec(localStorage.key(i)) < oldest_timestamp) { + oldest_key = localStorage.key(i); + oldest_timestamp = regex_getTimestamp.exec(oldest_key); + } + } + localStorage.removeItem(oldest_key); + } + } + localStorage.setItem(key,value); + } + } + + // restore folding status of blocks (on page load) + function restoreState (lastresource) { + if(localStorage.getItem(lastresource) != null){ + var key = lastresource; + var value = localStorage.getItem(key); + var regex_delTimestamp = /^\d+;/; + + value.replace(regex_delTimestamp, ''); + + var valueArr = value.split(';'); + var pairs; + var elements; + for (var i = 0; i < valueArr.length; i++){ + pairs = valueArr[i].split(','); + elements = document.getElementsByName(pairs[0]); + + for (var j = 0; j < elements.length; j++){ + elements[j].style.display = pairs[1]; + if (pairs[1] == "none"){ + var regex_id = /([_\\d]+)\$/; + regex_id.exec(pairs[0]); + document.getElementById("folding_btn"+RegExp.\$1).value = "Show"; + } + } + } + } + } + + function getTagList () { + + var stringToSearch = document.lonhomework.innerHTML; + + var ret = new Array(); + var regex_findBlock = /(foldblock_.*?)"/g; + var tag_list = stringToSearch.match(regex_findBlock); + + if(tag_list != null){ + for(var i = 0; i < tag_list.length; i++){ + ret.push(tag_list[i].replace(/"/, '')); + } + } + return ret; + } + + function saveScrollPosition (resource) { + var tag_list = getTagList(); + + // we dont always want to jump to the first block + // 170 is roughly above the "Problem Editing" header. we just want to save if the user scrolled down further than this + if(\$(window).scrollTop() > 170){ + if(tag_list != null){ + var result; + for(var i = 0; i < tag_list.length; i++){ + if(isElementInViewport(tag_list[i])){ + result += tag_list[i]+';'; + } + } + sessionStorage.setItem('anchor_'+resource, result); + } + } else { + // we dont need to save zero, just delete the item to leave everything tidy + sessionStorage.removeItem('anchor_'+resource); + } + } + + function restoreScrollPosition(resource){ + + var elem = sessionStorage.getItem('anchor_'+resource); + if(elem != null){ + var tag_list = elem.split(';'); + var elem_list; + + for(var i = 0; i < tag_list.length; i++){ + elem_list = document.getElementsByName(tag_list[i]); + + if(elem_list.length > 0){ + elem = elem_list[0]; + break; + } + } + elem.scrollIntoView(); + } + } + + function isElementInViewport(el) { + + // change to last element instead of first + var elem = document.getElementsByName(el); + var rect = elem[0].getBoundingClientRect(); + + return ( + rect.top >= 0 && + rect.left >= 0 && + rect.bottom <= (window.innerHeight || document.documentElement.clientHeight) && /*or $(window).height() */ + rect.right <= (window.innerWidth || document.documentElement.clientWidth) /*or $(window).width() */ + ); + } + + function autosize(depth){ + var cmInst = window['cm'+depth]; + var fitsizeButton = document.getElementById('fitsize'+depth); + + // is fixed size, switching to dynamic + if (sessionStorage.getItem("autosized_"+depth) == null) { + cmInst.setSize("","auto"); + fitsizeButton.value = "@{[&mt('Fixed size')]}"; + sessionStorage.setItem("autosized_"+depth, "yes"); + + // is dynamic size, switching to fixed + } else { + cmInst.setSize("","300px"); + fitsizeButton.value = "@{[&mt('Dynamic size')]}"; + sessionStorage.removeItem("autosized_"+depth); + } + } + +$browse_or_search + +// ]]> + +COLORFULEDIT +} + +sub xmleditor_js { + return < + +XMLEDIT +} + +sub insert_folding_button { + my $curDepth = $Apache::lonxml::curdepth; + my $lastresource = $env{'request.ambiguous'}; + + return ""; +} + +sub crsauthor_url { + my ($url) = @_; + if ($url eq '') { + $url = $ENV{'REQUEST_URI'}; + } + my ($cnum,$cdom); + if ($env{'request.course.id'}) { + my ($audom,$auname) = ($url =~ m{^/priv/($match_domain)/($match_name)/}); + if ($audom ne '' && $auname ne '') { + if (($env{'course.'.$env{'request.course.id'}.'.num'} eq $auname) && + ($env{'course.'.$env{'request.course.id'}.'.domain'} eq $audom)) { + $cnum = $auname; + $cdom = $audom; + } + } + } + return ($cnum,$cdom); +} + +sub import_crsauthor_form { + my ($form,$firstselectname,$secondselectname,$onchangefirst,$only,$suffix,$disabled) = @_; + return (0) unless ($env{'request.course.id'}); + my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; + my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; + my $crshome = $env{'course.'.$env{'request.course.id'}.'.home'}; + return (0) unless (($cnum ne '') && ($cdom ne '')); + my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'}; + my @ids=&Apache::lonnet::current_machine_ids(); + my ($output,$is_home,$relpath,%subdirs,%files,%selimport_menus); + + if (grep(/^\Q$crshome\E$/,@ids)) { + $is_home = 1; + } + $relpath = "/priv/$cdom/$cnum"; + &Apache::lonnet::recursedirs($is_home,'priv',$londocroot,$relpath,'',\%subdirs,\%files); + my %lt = &Apache::lonlocal::texthash ( + fnam => 'Filename', + dire => 'Directory', + ); + my $numdirs = scalar(keys(%files)); + my (%possexts,$singledir,@singledirfiles); + if ($only) { + map { $possexts{$_} = 1; } split(/\s*,\s*/,$only); + } + my (%nonemptydirs,$possdirs); + if ($numdirs > 1) { + my @order; + foreach my $key (sort { lc($a) cmp lc($b) } (keys(%files))) { + if (ref($files{$key}) eq 'HASH') { + my $shown = $key; + if ($key eq '') { + $shown = '/'; + } + my @ordered = (); + foreach my $file (sort { lc($a) cmp lc($b) } (keys(%{$files{$key}}))) { + next if ($file =~ /\.rights$/); + if ($only) { + my ($ext) = ($file =~ /\.([^.]+)$/); + unless ($possexts{lc($ext)}) { + next; + } + } + $selimport_menus{$key}->{'select2'}->{$file} = $file; + push(@ordered,$file); + } + if (@ordered) { + push(@order,$key); + $nonemptydirs{$key} = 1; + $selimport_menus{$key}->{'text'} = $shown; + $selimport_menus{$key}->{'default'} = ''; + $selimport_menus{$key}->{'select2'}->{''} = ''; + $selimport_menus{$key}->{'order'} = \@ordered; + } + } + } + $possdirs = scalar(keys(%nonemptydirs)); + if ($possdirs > 1) { + my @order = sort { lc($a) cmp lc($b) } (keys(%nonemptydirs)); + $output = $lt{'dire'}. + &linked_select_forms($form,'
'. + $lt{'fnam'},'', + $firstselectname,$secondselectname, + \%selimport_menus,\@order, + $onchangefirst,'',$suffix).'
'; + } elsif ($possdirs == 1) { + $singledir = (keys(%nonemptydirs))[0]; + if (ref($selimport_menus{$singledir}->{'order'}) eq 'ARRAY') { + @singledirfiles = @{$selimport_menus{$singledir}->{'order'}}; + } + delete($selimport_menus{$singledir}); + } + } elsif ($numdirs == 1) { + $singledir = (keys(%files))[0]; + foreach my $file (sort { lc($a) cmp lc($b) } (keys(%{$files{$singledir}}))) { + if ($only) { + my ($ext) = ($file =~ /\.([^.]+)$/); + unless ($possexts{lc($ext)}) { + next; + } + } else { + next if ($file =~ /\.rights$/); + } + push(@singledirfiles,$file); + } + if (@singledirfiles) { + $possdirs = 1; + } + } + if (($possdirs == 1) && (@singledirfiles)) { + my $showdir = $singledir; + if ($singledir eq '') { + $showdir = '/'; + } + $output = $lt{'dire'}. + '
'. + $lt{'fnam'}.'
'."\n"; + } + return ($possdirs,$output); +} + =pod =head1 Excel and CSV file utility routines @@ -1918,10 +2502,24 @@ sub create_text_file { # ------------------------------------------ sub domain_select { - my ($name,$value,$multiple)=@_; + my ($name,$value,$multiple,$incdoms,$excdoms)=@_; + my @possdoms; + if (ref($incdoms) eq 'ARRAY') { + @possdoms = @{$incdoms}; + } else { + @possdoms = &Apache::lonnet::all_domains(); + } + my %domains=map { $_ => $_.' '. &Apache::lonnet::domain($_,'description') - } &Apache::lonnet::all_domains(); + } @possdoms; + + if ((ref($excdoms) eq 'ARRAY') && (@{$excdoms} > 0)) { + foreach my $dom (@{$excdoms}) { + delete($domains{$dom}); + } + } + if ($multiple) { $domains{''}=&mt('Any domain'); $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))]; @@ -1990,12 +2588,15 @@ sub multiple_select_form { =pod -=item * &select_form($defdom,$name,$hashref,$onchange) +=item * &select_form($defdom,$name,$hashref,$onchange,$readonly) Returns a string containing a \n"; + my $disabled; + if ($readonly) { + $disabled = ' disabled="disabled"'; + } + my $selectform = " form to allow a user to select the domain to preform an operation in. @@ -2192,16 +2797,21 @@ The optional $onchange argument specifie The optional $incdoms is a reference to an array of domains which will be the only available options. -The optional $excdoms is a reference to an array of domains which will be excluded from the available options. +The optional $excdoms is a reference to an array of domains which will be excluded from the available options. + +The optional $disabled argument, if true, adds the disabled attribute to the select tag. =cut #------------------------------------------- sub select_dom_form { - my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms) = @_; + my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms,$disabled) = @_; if ($onchange) { $onchange = ' onchange="'.$onchange.'"'; } + if ($disabled) { + $disabled = ' disabled="disabled"'; + } my (@domains,%exclude); if (ref($incdoms) eq 'ARRAY') { @domains = sort {lc($a) cmp lc($b)} (@{$incdoms}); @@ -2210,9 +2820,9 @@ sub select_dom_form { } if ($includeempty) { @domains=('',@domains); } if (ref($excdoms) eq 'ARRAY') { - map { $exclude{$_} = 1; } @{$excdoms}; + map { $exclude{$_} = 1; } @{$excdoms}; } - my $selectdomain = "\n"; foreach my $dom (@domains) { next if ($exclude{$dom}); $selectdomain.="
+
$text @@ -4584,22 +5582,50 @@ END_BLOCK ############################################### sub check_ip_acc { - my ($acc)=@_; + my ($acc,$clientip)=@_; &Apache::lonxml::debug("acc is $acc"); if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) { return 1; } - my $allowed=0; - my $ip=$env{'request.host'} || $ENV{'REMOTE_ADDR'}; + my ($ip,$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; - foreach my $pattern (split(',',$acc)) { - $pattern =~ s/^\s*//; - $pattern =~ s/\s*$//; + my %access = ( + allowfrom => 1, + denyfrom => 0, + ); + my @allows; + my @denies; + foreach my $item (split(',',$acc)) { + $item =~ s/^\s*//; + $item =~ s/\s*$//; + my $pattern; + if ($item =~ /^\!(.+)$/) { + push(@denies,$1); + } else { + push(@allows,$item); + } + } + my $numdenies = scalar(@denies); + my $numallows = scalar(@allows); + my $count = 0; + foreach my $pattern (@denies,@allows) { + $count ++; + my $acctype = 'allowfrom'; + if ($count <= $numdenies) { + $acctype = 'denyfrom'; + } if ($pattern =~ /\*$/) { #35.8.* $pattern=~s/\*//; - if ($ip =~ /^\Q$pattern\E/) { $allowed=1; } + if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; } } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) { #35.8.3.[34-56] my $low=$2; @@ -4607,7 +5633,7 @@ sub check_ip_acc { $pattern=$1; if ($ip =~ /^\Q$pattern\E/) { my $last=(split(/\./,$ip))[3]; - if ($last <=$high && $last >=$low) { $allowed=1; } + if ($last <=$high && $last >=$low) { $allowed=$access{$acctype}; } } } elsif ($pattern =~ /^\*/) { #*.msu.edu @@ -4617,10 +5643,10 @@ sub check_ip_acc { my $netaddr=inet_aton($ip); ($name)=gethostbyaddr($netaddr,AF_INET); } - if ($name =~ /\Q$pattern\E$/i) { $allowed=1; } + if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; } } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) { #127.0.0.1 - if ($ip =~ /^\Q$pattern\E/) { $allowed=1; } + if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; } } else { #some.name.com if (!defined($name)) { @@ -4628,9 +5654,16 @@ sub check_ip_acc { my $netaddr=inet_aton($ip); ($name)=gethostbyaddr($netaddr,AF_INET); } - if ($name =~ /\Q$pattern\E$/i) { $allowed=1; } + if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; } + } + if ($allowed =~ /^(0|1)$/) { last; } + } + if ($allowed eq '') { + if ($numdenies && !$numallows) { + $allowed = 1; + } else { + $allowed = 0; } - if ($allowed) { last; } } return $allowed; } @@ -4686,23 +5719,29 @@ sub get_domainconf { if (keys(%{$domconfig{'login'}})) { foreach my $key (keys(%{$domconfig{'login'}})) { if (ref($domconfig{'login'}{$key}) eq 'HASH') { - if ($key eq 'loginvia') { - if (ref($domconfig{'login'}{'loginvia'}) eq 'HASH') { - foreach my $hostname (keys(%{$domconfig{'login'}{'loginvia'}})) { - if (ref($domconfig{'login'}{'loginvia'}{$hostname}) eq 'HASH') { - if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) { - my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'}; - $designhash{$udom.'.login.loginvia'} = $server; - if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') { - - $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'}; - } else { - $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'}; + if (($key eq 'loginvia') || ($key eq 'headtag')) { + if (ref($domconfig{'login'}{$key}) eq 'HASH') { + foreach my $hostname (keys(%{$domconfig{'login'}{$key}})) { + if (ref($domconfig{'login'}{$key}{$hostname}) eq 'HASH') { + if ($key eq 'loginvia') { + if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) { + my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'}; + $designhash{$udom.'.login.loginvia'} = $server; + if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') { + + $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'}; + } else { + $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'}; + } } - if ($domconfig{'login'}{'loginvia'}{$hostname}{'exempt'}) { - $designhash{$udom.'.login.loginvia_exempt_'.$hostname} = $domconfig{'login'}{'loginvia'}{$hostname}{'exempt'}; + } elsif ($key eq 'headtag') { + if ($domconfig{'login'}{'headtag'}{$hostname}{'url'}) { + $designhash{$udom.'.login.headtag_'.$hostname} = $domconfig{'login'}{'headtag'}{$hostname}{'url'}; } } + if ($domconfig{'login'}{$key}{$hostname}{'exempt'}) { + $designhash{$udom.'.login.'.$key.'_exempt_'.$hostname} = $domconfig{'login'}{$key}{$hostname}{'exempt'}; + } } } } @@ -4770,7 +5809,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); @@ -4959,13 +5998,28 @@ sub CSTR_pageheader { $lastitem = $thisdisfn; } + my ($crsauthor,$title); + 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 { + $title = &mt('Authoring Space'); + } + + my ($target,$crumbtarget) = (' target="_top"','_top'); #FIXME lonpubdir: target="_parent" + if (($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) { + $target = ''; + $crumbtarget = ''; + } + my $output = '
' .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it? - .''.&mt('Authoring Space:').' ' - .'
' #FIXME lonpubdir: target="_parent" - .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef); + .''.$title.' ' + .'' + .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,$crumbtarget,'/priv/'.$udom,undef,undef); if ($lastitem) { $output .= @@ -4973,13 +6027,18 @@ sub CSTR_pageheader { .$lastitem .''; } - $output .= - '
' - #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."
" - .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()') - .'
' - .&Apache::lonmenu::constspaceform() - .'
'; + + if ($crsauthor) { + $output .= ''.&Apache::lonmenu::constspaceform(); + } else { + $output .= + '
' + #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(); + } + $output .= '
'; return $output; } @@ -5021,19 +6080,30 @@ Inputs: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value -=item * $no_inline_link, if true and in remote mode, don't show the - 'Switch To Inline Menu' link - =item * $args, optional argument valid values are no_auto_mt_title -> prevents &mt()ing the title arg - inherit_jsmath -> when creating popup window in a page, - should it have jsmath forced on by the - current page + use_absolute -> for external resource or syllabus, this will + contain https:// if server uses + https (as per hosts.tab), but request is for http + hostname -> hostname, from $r->hostname(). =item * $advtoolsref, optional argument, ref to an array containing inlineremote items to be added in "Functions" menu below 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. + =back Returns: A uniform header for LON-CAPA web pages. @@ -5045,7 +6115,7 @@ other decorations will be returned. sub bodytag { my ($title,$function,$addentries,$bodyonly,$domain,$forcereg, - $no_nav_bar,$bgcolor,$no_inline_link,$args,$advtoolsref)=@_; + $no_nav_bar,$bgcolor,$args,$advtoolsref,$ltiscope,$ltiuri,$ltimenu)=@_; my $public; if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')) @@ -5054,6 +6124,7 @@ sub bodytag { } if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); } my $httphost = $args->{'use_absolute'}; + my $hostname = $args->{'hostname'}; $function = &get_users_function() if (!$function); my $img = &designparm($function.'.img',$domain); @@ -5081,6 +6152,14 @@ sub bodytag { if ($env{'request.course.id'}) { if ($env{'request.role'} !~ /^cr/) { $role = &Apache::lonnet::plaintext($role,&course_type()); + } elsif ($role =~ m{^cr/($match_domain)/\1-domainconfig/(\w+)$}) { + if ($env{'request.role.desc'}) { + $role = $env{'request.role.desc'}; + } else { + $role = &mt('Helpdesk[_1]',' '.$2); + } + } else { + $role = (split(/\//,$role,4))[-1]; } if ($env{'request.course.sec'}) { $role .= (' 'x2).'- '.&mt('section:').' '.$env{'request.course.sec'}; @@ -5096,7 +6175,7 @@ sub bodytag { # construct main body tag my $bodytag = "". - &Apache::lontexconvert::init_math_support($args->{'inherit_jsmath'}); + &Apache::lontexconvert::init_math_support(); &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']); @@ -5107,7 +6186,18 @@ sub bodytag { if ($public) { undef($role); } - + + if (($env{'request.course.id'}) && ($env{'request.lti.login'})) { + if (ref($ltimenu) eq 'HASH') { + unless ($ltimenu->{'role'}) { + undef($role); + } + unless ($ltimenu->{'coursetitle'}) { + $realm=' '; + } + } + } + my $titleinfo = '

'.$title.'

'; # # Extra info if you are the DC @@ -5120,25 +6210,19 @@ sub bodytag { $dc_info =~ s/\s+$//; } - $role = '('.$role.')' if $role; - - if ($env{'request.state'} eq 'construct') { $forcereg=1; } - - - - my $funclist; - if (($env{'environment.remote'} eq 'on') && ($env{'request.state'} ne 'construct')) { - $bodytag .= Apache::lonhtmlcommon::scripttag(Apache::lonmenu::utilityfunctions($httphost), 'start')."\n". - Apache::lonmenu::serverform(); - my $forbodytag; - &Apache::lonmenu::prepare_functions($env{'request.noversionuri'}, - $forcereg,$args->{'group'}, - $args->{'bread_crumbs'}, - $advtoolsref,'',\$forbodytag); - unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') { - $funclist = $forbodytag; - } + my $crstype; + if ($env{'request.course.id'}) { + $crstype = $env{'course.'.$env{'request.course.id'}.'.type'}; + } elsif ($args->{'crstype'}) { + $crstype = $args->{'crstype'}; + } + if (($crstype eq 'Placement') && (!$env{'request.role.adv'})) { + undef($role); } else { + $role = '('.$role.')' if ($role && !$env{'browser.mobile'}); + } + + if ($env{'request.state'} eq 'construct') { $forcereg=1; } # if ($env{'request.state'} eq 'construct') { # $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls @@ -5147,52 +6231,56 @@ sub bodytag { $bodytag .= Apache::lonhtmlcommon::scripttag( Apache::lonmenu::utilityfunctions($httphost), 'start'); - my ($left,$right) = Apache::lonmenu::primary_menu(); + unless ($args->{'no_primary_menu'}) { + my ($left,$right) = Apache::lonmenu::primary_menu($crstype,$ltimenu); - if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) { - if ($dc_info) { - $dc_info = qq|$dc_info|; + 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; } - $bodytag .= qq|
$left $role
- $realm $dc_info
|; - return $bodytag; - } - unless ($env{'request.symb'} =~ m/\.page___\d+___/) { - $bodytag .= qq|
$left $role
|; - } + unless ($env{'request.symb'} =~ m/\.page___\d+___/) { + $bodytag .= qq|
$left $role
|; + } - $bodytag .= $right; + $bodytag .= $right; - if ($dc_info) { - $dc_info = &dc_courseid_toggle($dc_info); + if ($dc_info) { + $dc_info = &dc_courseid_toggle($dc_info); + } + $bodytag .= qq|
$realm $dc_info
|; } - $bodytag .= qq|
$realm $dc_info
|; - #if directed to not display the secondary menu, don't. + #if directed to not display the secondary menu, don't. if ($args->{'no_secondary_menu'}) { return $bodytag; } #don't show menus for public users if (!$public){ - $bodytag .= Apache::lonmenu::secondary_menu($httphost); + unless ($args->{'no_inline_menu'}) { + $bodytag .= Apache::lonmenu::secondary_menu($httphost,$ltiscope,$ltimenu, + $args->{'no_primary_menu'}); + } $bodytag .= Apache::lonmenu::serverform(); $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end'); if ($env{'request.state'} eq 'construct') { $bodytag .= &Apache::lonmenu::innerregister($forcereg, - $args->{'bread_crumbs'}); - } elsif ($forcereg) { + $args->{'bread_crumbs'},'','',$hostname,$ltiscope,$ltiuri); + } elsif ($forcereg) { $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef, - $args->{'group'}); + $args->{'group'}, + $args->{'hide_buttons'}, + $hostname,$ltiscope,$ltiuri); } else { - my $forbodytag; - &Apache::lonmenu::prepare_functions($env{'request.noversionuri'}, - $forcereg,$args->{'group'}, - $args->{'bread_crumbs'}, - $advtoolsref,'',\$forbodytag); - unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') { - $bodytag .= $forbodytag; - } + $bodytag .= + &Apache::lonmenu::prepare_functions($env{'request.noversionuri'}, + $forcereg,$args->{'group'}, + $args->{'bread_crumbs'}, + $advtoolsref,'',$hostname); } }else{ # this is to seperate menu from content when there's no secondary @@ -5202,54 +6290,6 @@ sub bodytag { } return $bodytag; - } - -# -# Top frame rendering, Remote is up -# - - my $imgsrc = $img; - if ($img =~ /^\/adm/) { - $imgsrc = &lonhttpdurl($img); - } - my $upperleft=''.$function.''; - - my $help=($no_inline_link?'' - :&Apache::loncommon::top_nav_help('Help')); - - # Explicit link to get inline menu - my $menu= ($no_inline_link?'' - :''.&mt('Switch to Inline Menu Mode').''); - - if ($dc_info) { - $dc_info = qq|($dc_info)|; - } - - my $name = &plainname($env{'user.name'},$env{'user.domain'}); - unless ($public) { - $name = &aboutmewrapper($name,$env{'user.name'},$env{'user.domain'}, - undef,'LC_menubuttons_link'); - } - - unless ($env{'form.inhibitmenu'}) { - $bodytag .= qq|
$name $role
-
    -
  1. $help
    2. -
  2. $menu
    3. -
$realm $dc_info
|; - } - if ($env{'request.state'} eq 'construct') { - if (!$public){ - if ($env{'request.state'} eq 'construct') { - $funclist = &Apache::lonhtmlcommon::scripttag( - &Apache::lonmenu::utilityfunctions($httphost), 'start'). - &Apache::lonhtmlcommon::scripttag('','end'). - &Apache::lonmenu::innerregister($forcereg, - $args->{'bread_crumbs'}); - } - } - } - return $bodytag."\n".$funclist; } sub dc_courseid_toggle { @@ -5281,15 +6321,8 @@ sub make_attr_string { delete($attr_ref->{$key}); } } - if ($env{'environment.remote'} eq 'on') { - $attr_ref->{'onload'} = - &Apache::lonmenu::loadevents(). $on_load; - $attr_ref->{'onunload'}= - &Apache::lonmenu::unloadevents().$on_unload; - } else { - $attr_ref->{'onload'} = $on_load; - $attr_ref->{'onunload'}= $on_unload; - } + $attr_ref->{'onload'} = $on_load; + $attr_ref->{'onunload'}= $on_unload; } my $attr_string; @@ -5323,7 +6356,6 @@ sub endbodytag { unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) { $endbodytag=''; } - $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag; if ( exists( $env{'internal.head.redirect'} ) ) { if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) { $endbodytag= @@ -5498,6 +6530,17 @@ div.LC_confirm_box .LC_success img { vertical-align: middle; } +.LC_maxwidth { + max-width: 100%; + height: auto; +} + +.LC_textsize_mobile { + \@media only screen and (max-device-width: 480px) { + -webkit-text-size-adjust:100%; -moz-text-size-adjust:100%; -ms-text-size-adjust:100%; + } +} + .LC_icon { border: none; vertical-align: middle; @@ -5603,6 +6646,12 @@ ul.LC_breadcrumb_tools_outerlist li { float: right; } +.LC_placement_prog { + padding-right: 20px; + font-weight: bold; + font-size: 90%; +} + table#LC_title_bar td { background: $tabbg; } @@ -5619,6 +6668,10 @@ table#LC_menubuttons img { vertical-align: middle; } +.LC_breadcrumbs_hoverable { + background: $sidebg; +} + td.LC_table_cell_checkbox { text-align: center; } @@ -5689,6 +6742,11 @@ td.LC_menubuttons_text { background: $tabbg; } +td.LC_zero_height { + line-height: 0; + cellpadding: 0; +} + table.LC_data_table { border: 1px solid #000000; border-collapse: separate; @@ -6010,6 +7068,12 @@ td.LC_parm_overview_restrictions { border-collapse: collapse; } +span.LC_parm_recursive, +td.LC_parm_recursive { + font-weight: bold; + font-size: smaller; +} + table.LC_parm_overview_restrictions td { border-width: 1px 4px 1px 4px; border-style: solid; @@ -6279,7 +7343,8 @@ table.LC_prior_tries td { padding: 6px; } -.LC_answer_unknown { +.LC_answer_unknown, +.LC_answer_warning { background: orange; color: black; padding: 6px; @@ -6361,6 +7426,12 @@ table.LC_data_table tr > td.LC_docs_entr color: #990000; } +.LC_docs_alias { + color: #440055; +} + +.LC_domprefs_email, +.LC_docs_alias_name, .LC_docs_reinit_warn, .LC_docs_ext_edit { font-size: x-small; @@ -6476,7 +7547,7 @@ div.LC_edit_problem_footer, div.LC_edit_problem_footer div, div.LC_edit_problem_editxml_header, div.LC_edit_problem_editxml_header div { - margin-top: 5px; + z-index: 100; } div.LC_edit_problem_header_title { @@ -6492,14 +7563,17 @@ table.LC_edit_problem_header_title { background: $tabbg; } -div.LC_edit_problem_discards { - float: left; - padding-bottom: 5px; +div.LC_edit_actionbar { + background-color: $sidebg; + margin: 0; + padding: 0; + line-height: 200%; } -div.LC_edit_problem_saves { - float: right; - padding-bottom: 5px; +div.LC_edit_actionbar div{ + padding: 0; + margin: 0; + display: inline-block; } .LC_edit_opt { @@ -6515,6 +7589,10 @@ div.LC_edit_problem_saves { margin-left: 40px; } +#LC_edit_problem_codemirror div{ + margin-left: 0px; +} + img.stift { border-width: 0; vertical-align: middle; @@ -6602,6 +7680,10 @@ fieldset { /* overflow: hidden; */ } +article.geogebraweb div { + margin: 0; +} + fieldset > legend { font-weight: bold; padding: 0 5px 0 5px; @@ -6629,7 +7711,6 @@ fieldset > legend { ol.LC_primary_menu { margin: 0; padding: 0; - background-color: $pgbg_or_bgcolor; } ol#LC_PathBreadcrumbs { @@ -6641,23 +7722,48 @@ ol.LC_primary_menu li { vertical-align: middle; text-align: left; list-style: none; + position: relative; float: left; + z-index: 100; /* will be displayed above codemirror and underneath the help-layer */ + line-height: 1.5em; } -ol.LC_primary_menu li a { +ol.LC_primary_menu li a, +ol.LC_primary_menu li p { display: block; margin: 0; padding: 0 5px 0 10px; text-decoration: none; } -ol.LC_primary_menu li ul { +ol.LC_primary_menu li p span.LC_primary_menu_innertitle { + display: inline-block; + width: 95%; + text-align: left; +} + +ol.LC_primary_menu li p span.LC_primary_menu_innerarrow { + display: inline-block; + width: 5%; + float: right; + text-align: right; + font-size: 70%; +} + +ol.LC_primary_menu ul { display: none; - width: 10em; + width: 15em; background-color: $data_table_light; + position: absolute; + top: 100%; +} + +ol.LC_primary_menu ul ul { + left: 100%; + top: 0; } -ol.LC_primary_menu li:hover ul, ol.LC_primary_menu li.hover ul { +ol.LC_primary_menu li:hover > ul, ol.LC_primary_menu li.hover > ul { display: block; position: absolute; margin: 0; @@ -6666,15 +7772,21 @@ ol.LC_primary_menu li:hover ul, ol.LC_pr } ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li { +/* First Submenu -> size should be smaller than the menu title of the whole menu */ font-size: 90%; vertical-align: top; float: none; border-left: 1px solid black; border-right: 1px solid black; +/* A dark bottom border to visualize different menu options; +overwritten in the create_submenu routine for the last border-bottom of the menu */ + border-bottom: 1px solid $data_table_dark; } -ol.LC_primary_menu li:hover li a, ol.LC_primary_menu li.hover li a { - background-color:$data_table_light; +ol.LC_primary_menu li li p:hover { + color:$button_hover; + text-decoration:none; + background-color:$data_table_dark; } ol.LC_primary_menu li li a:hover { @@ -6682,6 +7794,11 @@ ol.LC_primary_menu li li a:hover { background-color:$data_table_dark; } +/* Font-size equal to the size of the predecessors*/ +ol.LC_primary_menu li:hover li li { + font-size: 100%; +} + ol.LC_primary_menu li img { vertical-align: bottom; height: 1.1em; @@ -6738,7 +7855,6 @@ ul#LC_secondary_menu li { font-weight: bold; line-height: 1.8em; border-right: 1px solid black; - vertical-align: middle; float: left; } @@ -7224,6 +8340,24 @@ ul.LC_funclist li { cursor:pointer; } +pre.LC_wordwrap { + white-space: pre-wrap; + white-space: -moz-pre-wrap; + white-space: -pre-wrap; + white-space: -o-pre-wrap; + word-wrap: break-word; +} + +/* + styles used for response display +*/ +div.LC_radiofoil, div.LC_rankfoil { + margin: .5em 0em .5em 0em; +} +table.LC_itemgroup { + margin-top: 1em; +} + /* styles used by TTH when "Default set of options to pass to tth/m when converting TeX" in course settings has been set @@ -7245,6 +8379,120 @@ span.roman {font-family: serif; font-sty span.overacc2 {position: relative; left: .8em; top: -1.2ex;} span.overacc1 {position: relative; left: .6em; top: -1.2ex;} +/* + sections with roles, for content only +*/ +section[class^="role-"] { + padding-left: 10px; + padding-right: 5px; + margin-top: 8px; + margin-bottom: 8px; + border: 1px solid #2A4; + border-radius: 5px; + box-shadow: 0px 1px 1px #BBB; +} +section[class^="role-"]>h1 { + position: relative; + margin: 0px; + padding-top: 10px; + padding-left: 40px; +} +section[class^="role-"]>h1:before { + position: absolute; + left: -5px; + top: 5px; +} +section.role-activity>h1:before { + content:url('/adm/daxe/images/section_icons/activity.png'); +} +section.role-advice>h1:before { + content:url('/adm/daxe/images/section_icons/advice.png'); +} +section.role-bibliography>h1:before { + content:url('/adm/daxe/images/section_icons/bibliography.png'); +} +section.role-citation>h1:before { + content:url('/adm/daxe/images/section_icons/citation.png'); +} +section.role-conclusion>h1:before { + content:url('/adm/daxe/images/section_icons/conclusion.png'); +} +section.role-definition>h1:before { + content:url('/adm/daxe/images/section_icons/definition.png'); +} +section.role-demonstration>h1:before { + content:url('/adm/daxe/images/section_icons/demonstration.png'); +} +section.role-example>h1:before { + content:url('/adm/daxe/images/section_icons/example.png'); +} +section.role-explanation>h1:before { + content:url('/adm/daxe/images/section_icons/explanation.png'); +} +section.role-introduction>h1:before { + content:url('/adm/daxe/images/section_icons/introduction.png'); +} +section.role-method>h1:before { + content:url('/adm/daxe/images/section_icons/method.png'); +} +section.role-more_information>h1:before { + content:url('/adm/daxe/images/section_icons/more_information.png'); +} +section.role-objectives>h1:before { + content:url('/adm/daxe/images/section_icons/objectives.png'); +} +section.role-prerequisites>h1:before { + content:url('/adm/daxe/images/section_icons/prerequisites.png'); +} +section.role-remark>h1:before { + content:url('/adm/daxe/images/section_icons/remark.png'); +} +section.role-reminder>h1:before { + content:url('/adm/daxe/images/section_icons/reminder.png'); +} +section.role-summary>h1:before { + content:url('/adm/daxe/images/section_icons/summary.png'); +} +section.role-syntax>h1:before { + content:url('/adm/daxe/images/section_icons/syntax.png'); +} +section.role-warning>h1:before { + content:url('/adm/daxe/images/section_icons/warning.png'); +} + +#LC_minitab_header { + float:left; + width:100%; + background:#DAE0D2 url("/res/adm/pages/minitabmenu_bg.gif") repeat-x bottom; + font-size:93%; + line-height:normal; + margin: 0.5em 0 0.5em 0; +} +#LC_minitab_header ul { + margin:0; + padding:10px 10px 0; + list-style:none; +} +#LC_minitab_header li { + float:left; + background:url("/res/adm/pages/minitabmenu_left.gif") no-repeat left top; + margin:0; + padding:0 0 0 9px; +} +#LC_minitab_header a { + display:block; + background:url("/res/adm/pages/minitabmenu_right.gif") no-repeat right top; + padding:5px 15px 4px 6px; +} +#LC_minitab_header #LC_current_minitab { + background-image:url("/res/adm/pages/minitabmenu_left_on.gif"); +} +#LC_minitab_header #LC_current_minitab a { + background-image:url("/res/adm/pages/minitabmenu_right_on.gif"); + padding-bottom:5px; +} + + END } @@ -7294,13 +8542,16 @@ sub headtag { ''. &font_settings($args); - my $inhibitprint = &print_suppression(); + my $inhibitprint; + if ($args->{'print_suppress'}) { + $inhibitprint = &print_suppression(); + } if (!$args->{'frameset'}) { $result .= &Apache::lonhtmlcommon::htmlareaheaders(); } - if ($args->{'force_register'}) { - $result .= &Apache::lonmenu::registerurl(1); + if ($args->{'force_register'} && $env{'request.noversionuri'} !~ m{^/res/adm/pages/}) { + $result .= Apache::lonxml::display_title(); } if (!$args->{'no_nav_bar'} && !$args->{'only_body'} @@ -7334,6 +8585,130 @@ sub headtag { ADDMETA + } else { + unless (($args->{'frameset'}) || ($args->{'js_ready'}) || ($args->{'only_body'}) || ($args->{'no_nav_bar'})) { + my $requrl = $env{'request.uri'}; + if ($requrl eq '') { + $requrl = $ENV{'REQUEST_URI'}; + $requrl =~ s/\?.+$//; + } + unless (($requrl =~ m{^/adm/(?:switchserver|login|authenticate|logout|groupsort|cleanup|helper|slotrequest|grades)(\?|$)}) || + (($requrl =~ m{^/res/}) && (($env{'form.submitted'} eq 'scantron') || + ($env{'form.grade_symb'}) || ($Apache::lonhomework::scantronmode)))) { + my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'}; + unless (&Apache::lonnet::allowed('mau',$dom_in_use)) { + my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use); + my $lonhost = $Apache::lonnet::perlvar{'lonHostID'}; + my ($offload,$offloadoth); + if (ref($domdefs{'offloadnow'}) eq 'HASH') { + if ($domdefs{'offloadnow'}{$lonhost}) { + $offload = 1; + } + } + unless ($offload) { + if (ref($domdefs{'offloadoth'}) eq 'HASH') { + if ($domdefs{'offloadoth'}{$lonhost}) { + if (($env{'user.domain'} ne '') && ($env{'user.domain'} ne $dom_in_use) && + (!(($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')))) { + unless (&Apache::lonnet::shared_institution($env{'user.domain'})) { + $offload = 1; + $offloadoth = 1; + $dom_in_use = $env{'user.domain'}; + } + } + } + } + } + if ($offload) { + my $newserver = &Apache::lonnet::spareserver(30000,undef,1,$dom_in_use); + if (($newserver eq '') && ($offloadoth)) { + my @domains = &Apache::lonnet::current_machine_domains(); + if (($dom_in_use ne '') && (!grep(/^\Q$dom_in_use\E$/,@domains))) { + ($newserver) = &Apache::lonnet::choose_server($dom_in_use); + } + } + if (($newserver) && ($newserver ne $lonhost)) { + my $numsec = 5; + my $timeout = $numsec * 1000; + my ($newurl,$locknum,%locks,$msg); + if ($env{'request.role.adv'}) { + ($locknum,%locks) = &Apache::lonnet::get_locks(); + } + my $disable_submit = 0; + if ($requrl =~ /$LONCAPA::assess_re/) { + $disable_submit = 1; + } + if ($locknum) { + my @lockinfo = sort(values(%locks)); + $msg = &mt('Once the following tasks are complete: ')."\n". + join(", ",sort(values(%locks)))."\n"; + if (&show_course()) { + $msg .= &mt('your session will be transferred to a different server, after you click "Courses".'); + } else { + $msg .= &mt('your session will be transferred to a different server, after you click "Roles".'); + } + } else { + if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) { + $msg = &mt('Your LON-CAPA submission has been recorded')."\n"; + } + $msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec); + $newurl = '/adm/switchserver?otherserver='.$newserver; + if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) { + $newurl .= '&role='.$env{'request.role'}; + } + if ($env{'request.symb'}) { + my $shownsymb = &Apache::lonenc::check_encrypt($env{'request.symb'}); + if ($shownsymb =~ m{^/enc/}) { + my $reqdmajor = 2; + my $reqdminor = 11; + my $reqdsubminor = 3; + my $newserverrev = &Apache::lonnet::get_server_loncaparev('',$newserver); + my $remoterev = &Apache::lonnet::get_server_loncaparev(undef,$newserver); + my ($major,$minor,$subminor) = ($remoterev =~ /^\'?(\d+)\.(\d+)\.(\d+|)[\w.\-]+\'?$/); + if (($major eq '' && $minor eq '') || + (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)) || + (($reqdmajor == $major) && ($reqdminor == $minor) && (($subminor eq '') || + ($reqdsubminor > $subminor))))) { + undef($shownsymb); + } + } + if ($shownsymb) { + &js_escape(\$shownsymb); + $newurl .= '&symb='.$shownsymb; + } + } else { + my $shownurl = &Apache::lonenc::check_encrypt($requrl); + &js_escape(\$shownurl); + $newurl .= '&origurl='.$shownurl; + } + } + &js_escape(\$msg); + $result.=< + +OFFLOAD + } + } + } + } + } } if (!defined($title)) { $title = 'The LearningOnline Network with CAPA'; @@ -7344,14 +8719,21 @@ ADDMETA if (!$args->{'frameset'}) { $result .= ' /'; } - $result .= '>' + $result .= '>' .$inhibitprint .$head_extra; - if ($env{'browser.mobile'}) { + my $clientmobile; + if (($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) { + (undef,undef,undef,undef,undef,undef,$clientmobile) = &decode_user_agent(); + } else { + $clientmobile = $env{'browser.mobile'}; + } + if ($clientmobile) { $result .= ' '; } + $result .= ''."\n"; return $result.''; } @@ -7370,12 +8752,12 @@ sub font_settings { my $headerstring=''; if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) || ((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) { - $headerstring.= - '{'frameset'}) { - $headerstring.= ' /'; + $headerstring.= ' /'; } - $headerstring .= '>'."\n"; + $headerstring .= '>'."\n"; } return $headerstring; } @@ -7420,7 +8802,7 @@ sub print_suppression { } my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; - my $blocked = &blocking_status('printout',$cnum,$cdom); + my $blocked = &blocking_status('printout',$cnum,$cdom,undef,1); if ($blocked) { my $checkrole = "cm./$cdom/$cnum"; if ($env{'request.course.sec'} ne '') { @@ -7528,16 +8910,17 @@ $args - additional optional args support skip_phases -> hash ref of head -> skip the generation body -> skip all generation - no_inline_link -> if true and in remote mode, don't show the - 'Switch To Inline Menu' link no_auto_mt_title -> prevent &mt()ing the title arg - inherit_jsmath -> when creating popup window in a page, - should it have jsmath forced on by the - current page bread_crumbs -> Array containing breadcrumbs bread_crumbs_component -> if exists show it as headline else show only the breadcrumbs - group -> includes the current group, if page is for a + bread_crumbs_nomenu -> if true will pass false as the value of $menulink + to lonhtmlcommon::breadcrumbs + group -> includes the current group, if page is for a specific group + use_absolute -> for request for external resource or syllabus, this + will contain https:// if server uses + https (as per hosts.tab), but request is for http + hostname -> hostname, originally from $r->hostname(), (optional). =back @@ -7550,11 +8933,42 @@ sub start_page { #&Apache::lonnet::logthis("start_page ".join(':',caller(0))); $env{'internal.start_page'}++; - my ($result,@advtools); + my ($result,@advtools,$ltiscope,$ltiuri,%ltimenu); 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'}); + } if (! exists($args->{'skip_phases'}{'body'}) ) { if ($args->{'frameset'}) { @@ -7567,8 +8981,8 @@ sub start_page { $args->{'function'}, $args->{'add_entries'}, $args->{'only_body'}, $args->{'domain'}, $args->{'force_register'}, $args->{'no_nav_bar'}, - $args->{'bgcolor'}, $args->{'no_inline_link'}, - $args, \@advtools); + $args->{'bgcolor'}, $args, + \@advtools,$ltiscope,$ltiuri,\%ltimenu); } } @@ -7601,18 +9015,23 @@ sub start_page { if (@advtools > 0) { &Apache::lonmenu::advtools_crumbs(@advtools); } - + my $menulink; + # if arg: bread_crumbs_nomenu is true pass 0 as $menulink item. + if ((exists($args->{'bread_crumbs_nomenu'})) || + ($ltiscope eq 'map') || ($ltiscope eq 'resource') || + ((($args->{'crstype'} eq 'Placement') || (($env{'request.course.id'}) && + ($env{'course.'.$env{'request.course.id'}.'.type'} eq 'Placement'))) && + (!$env{'request.role.adv'}))) { + $menulink = 0; + } else { + undef($menulink); + } #if bread_crumbs_component exists show it as headline else show only the breadcrumbs if(exists($args->{'bread_crumbs_component'})){ - $result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'}); - }else{ - $result .= &Apache::lonhtmlcommon::breadcrumbs(); + $result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'},'',$menulink); + } else { + $result .= &Apache::lonhtmlcommon::breadcrumbs('','',$menulink); } - } elsif (($env{'environment.remote'} eq 'on') && - ($env{'form.inhibitmenu'} ne 'yes') && - ($env{'request.noversionuri'} =~ m{^/res/}) && - ($env{'request.noversionuri'} !~ m{^/res/adm/pages/})) { - $result .= '
'; } return $result; } @@ -7660,10 +9079,12 @@ function set_wishlistlink(title, path) { title = title.replace(/^LON-CAPA /,''); } title = encodeURIComponent(title); + title = title.replace("'","\\\'"); if (!path) { path = location.pathname; } path = encodeURIComponent(path); + path = path.replace("'","\\\'"); Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path, 'wishlistNewLink','width=560,height=350,scrollbars=0'); } @@ -7706,12 +9127,13 @@ var modalWindow = { }; var openMyModal = function(source,width,height,scrolling,transparency,style) { + source = source.replace(/'/g,"'"); modalWindow.windowId = "myModal"; modalWindow.width = width; modalWindow.height = height; - modalWindow.content = ""; modalWindow.open(); - }; + }; // END LON-CAPA Internal --> // ]]> @@ -7730,8 +9152,7 @@ sub modal_link { $target_attr = 'target="'.$target.'"'; } return <<"ENDLINK"; - - $linktext +$linktext ENDLINK } @@ -7757,7 +9178,7 @@ sub modal_adhoc_inner { my ($funcname,$width,$height,$content)=@_; my $innerwidth=$width-20; $content=&js_ready( - &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}). + &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}). &start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1). $content. &end_scrollbox(). @@ -7834,8 +9255,9 @@ sub end_togglebox { } sub LCprogressbar_script { - my ($id)=@_; - return(< // ENDPROGRESS + } else { + return(< +// + +ENDPROGRESS + } } sub LCprogressbarUpdate_script { return(< .ui-progressbar { position:relative; } +.progress-label {position: absolute; width: 100%; text-align: center; top: 1px; font-weight: bold; text-shadow: 1px 1px 0 #fff;margin: 0; line-height: 200%; } .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; } @@ -7874,37 +9318,54 @@ my $LCidcnt; my $LCcurrentid; sub LCprogressbar { - my ($r)=(@_); + my ($r,$number_to_do,$preamble)=@_; $LClastpercent=0; $LCidcnt++; $LCcurrentid=$$.'_'.$LCidcnt; - my $starting=&mt('Starting'); - my $content=(< $starting
ENDPROGBAR - &r_print($r,$content.&LCprogressbar_script($LCcurrentid)); + } else { + $starting=&mt('Loading...'); + $LClastpercent='false'; + $content=(< +
$starting
+ +ENDPROGBAR + } + &r_print($r,$content.&LCprogressbar_script($LCcurrentid,$number_to_do)); } sub LCprogressbarUpdate { - my ($r,$val,$text)=@_; - unless ($val) { - if ($LClastpercent) { - $val=$LClastpercent; - } else { - $val=0; - } + my ($r,$val,$text,$number_to_do)=@_; + if ($number_to_do) { + unless ($val) { + if ($LClastpercent) { + $val=$LClastpercent; + } else { + $val=0; + } + } + if ($val<0) { $val=0; } + if ($val>100) { $val=0; } + $LClastpercent=$val; + unless ($text) { $text=$val.'%'; } + } else { + $val = 'false'; } - if ($val<0) { $val=0; } - if ($val>100) { $val=0; } - $LClastpercent=$val; - unless ($text) { $text=$val.'%'; } $text=&js_ready($text); &r_print($r,< // ENDUPDATE @@ -8089,14 +9550,21 @@ function expand_div(caller) { sub simple_error_page { my ($r,$title,$msg,$args) = @_; + my %displayargs; if (ref($args) eq 'HASH') { if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); } + if ($args->{'only_body'}) { + $displayargs{'only_body'} = 1; + } + if ($args->{'no_nav_bar'}) { + $displayargs{'no_nav_bar'} = 1; + } } else { $msg = &mt($msg); } my $page = - &Apache::loncommon::start_page($title). + &Apache::loncommon::start_page($title,'',\%displayargs). '

'.$msg.'

'. &Apache::loncommon::end_page(); if (ref($r)) { @@ -8313,7 +9781,7 @@ role status: active, previous or future. sub check_user_status { my ($udom,$uname,$cdom,$crs,$role,$sec) = @_; my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname); - my @uroles = keys %userinfo; + my @uroles = keys(%userinfo); my $srchstr; my $active_chk = 'none'; my $now = time; @@ -8402,7 +9870,7 @@ sub get_sections { } } - if ($check_students) { + if ($check_students) { my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum); my $sec_index = &Apache::loncoursedata::CL_SECTION(); my $status_index = &Apache::loncoursedata::CL_STATUS(); @@ -8724,8 +10192,8 @@ Incoming parameters: 2. user's domain 3. quota name - portfolio, author, or course (if no quota name provided, defaults to portfolio). -4. crstype - official, unofficial, textbook or community, if quota name is - course +4. crstype - official, unofficial, textbook, placement or community, + if quota name is course Returns: 1. Disk quota (in MB) assigned to student. @@ -8798,8 +10266,9 @@ sub get_user_quota { if ($quota eq '' || wantarray) { if ($quotaname eq 'course') { my %domdefs = &Apache::lonnet::get_domain_defaults($udom); - if (($crstype eq 'official') || ($crstype eq 'unofficial') || - ($crstype eq 'community') || ($crstype eq 'textbook')) { + if (($crstype eq 'official') || ($crstype eq 'unofficial') || + ($crstype eq 'community') || ($crstype eq 'textbook') || + ($crstype eq 'placement')) { $defquota = $domdefs{$crstype.'quota'}; } if ($defquota eq '') { @@ -8947,7 +10416,7 @@ Inputs: 7 4. filename of file for which action is being requested 5. filesize (kB) of file 6. action being taken: copy or upload. -7. quotatype (in course context -- official, unofficial, community or textbook). +7. quotatype (in course context -- official, unofficial, textbook, placement or community). Returns: 1 scalar: HTML to display containing warning if quota would be exceeded, otherwise return null. @@ -8983,6 +10452,8 @@ sub excess_filesize_warning { ############################################### + + sub get_secgrprole_info { my ($cdom,$cnum,$needroles,$type) = @_; my %sections_count = &get_sections($cdom,$cnum); @@ -9021,8 +10492,24 @@ sub get_secgrprole_info { } sub user_picker { - my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context) = @_; + my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context,$fixeddom,$noinstd) = @_; my $currdom = $dom; + my @alldoms = &Apache::lonnet::all_domains(); + if (@alldoms == 1) { + my %domsrch = &Apache::lonnet::get_dom('configuration', + ['directorysrch'],$alldoms[0]); + my $domdesc = &Apache::lonnet::domain($alldoms[0],'description'); + my $showdom = $domdesc; + if ($showdom eq '') { + $showdom = $dom; + } + if (ref($domsrch{'directorysrch'}) eq 'HASH') { + if ((!$domsrch{'directorysrch'}{'available'}) && + ($domsrch{'directorysrch'}{'lcavailable'} eq '0')) { + return (&mt('LON-CAPA directory search is not available in domain: [_1]',$showdom),0); + } + } + } my %curr_selected = ( srchin => 'dom', srchby => 'lastname', @@ -9043,7 +10530,7 @@ sub user_picker { } $srchterm = $srch->{'srchterm'}; } - my %lt=&Apache::lonlocal::texthash( + my %html_lt=&Apache::lonlocal::texthash( 'usr' => 'Search criteria', 'doma' => 'Domain/institution to search', 'uname' => 'username', @@ -9056,6 +10543,8 @@ sub user_picker { 'exact' => 'is', 'contains' => 'contains', 'begins' => 'begins with', + ); + my %js_lt=&Apache::lonlocal::texthash( 'youm' => "You must include some text to search for.", 'thte' => "The text you are searching for must contain at least two characters when using a 'begins' type search.", 'thet' => "The text you are searching for must contain at least three characters when using a 'contains' type search.", @@ -9065,7 +10554,25 @@ sub user_picker { 'whse' => "When searching by last,first you must include at least one character in the first name.", 'thfo' => "The following need to be corrected before the search can be run:", ); - my $domform = &select_dom_form($currdom,'srchdomain',1,1); + &html_escape(\%html_lt); + &js_escape(\%js_lt); + my $domform; + my $allow_blank = 1; + if ($fixeddom) { + $allow_blank = 0; + $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,[$currdom]); + } else { + my $defdom = $env{'request.role.domain'}; + my ($trusted,$untrusted); + if (($context eq 'requestcrs') || ($context eq 'course')) { + ($trusted,$untrusted) = &Apache::lonnet::trusted_domains('enroll',$defdom); + } elsif ($context eq 'author') { + ($trusted,$untrusted) = &Apache::lonnet::trusted_domains('othcoau',$defdom); + } elsif ($context eq 'domain') { + ($trusted,$untrusted) = &Apache::lonnet::trusted_domains('domroles',$defdom); + } + $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,$trusted,$untrusted); + } my $srchinsel = ' \n"; @@ -9091,10 +10599,10 @@ sub user_picker { foreach my $option ('lastname','lastfirst','uname') { if ($curr_selected{'srchby'} eq $option) { $srchbysel .= ' - '; + '; } else { $srchbysel .= ' - '; + '; } } $srchbysel .= "\n \n"; @@ -9103,10 +10611,10 @@ sub user_picker { foreach my $option ('begins','contains','exact') { if ($curr_selected{'srchtype'} eq $option) { $srchtypesel .= ' - '; + '; } else { $srchtypesel .= ' - '; + '; } } $srchtypesel .= "\n \n"; @@ -9191,46 +10699,46 @@ function validateEntry(callingForm) { if (srchterm == "") { checkok = 0; - msg += "$lt{'youm'}\\n"; + msg += "$js_lt{'youm'}\\n"; } if (srchtype== 'begins') { if (srchterm.length < 2) { checkok = 0; - msg += "$lt{'thte'}\\n"; + msg += "$js_lt{'thte'}\\n"; } } if (srchtype== 'contains') { if (srchterm.length < 3) { checkok = 0; - msg += "$lt{'thet'}\\n"; + msg += "$js_lt{'thet'}\\n"; } } if (srchin == 'instd') { if (srchdomain == '') { checkok = 0; - msg += "$lt{'yomc'}\\n"; + msg += "$js_lt{'yomc'}\\n"; } } if (srchin == 'dom') { if (srchdomain == '') { checkok = 0; - msg += "$lt{'ymcd'}\\n"; + msg += "$js_lt{'ymcd'}\\n"; } } if (srchby == 'lastfirst') { if (srchterm.indexOf(",") == -1) { checkok = 0; - msg += "$lt{'whus'}\\n"; + msg += "$js_lt{'whus'}\\n"; } if (srchterm.indexOf(",") == srchterm.length -1) { checkok = 0; - msg += "$lt{'whse'}\\n"; + msg += "$js_lt{'whse'}\\n"; } } if (checkok == 0) { - alert("$lt{'thfo'}\\n"+msg); + alert("$js_lt{'thfo'}\\n"+msg); return; } if (checkok == 1) { @@ -9248,10 +10756,10 @@ $new_user_create END_BLOCK $output .= &Apache::lonhtmlcommon::start_pick_box(). - &Apache::lonhtmlcommon::row_title($lt{'doma'}). + &Apache::lonhtmlcommon::row_title($html_lt{'doma'}). $domform. &Apache::lonhtmlcommon::row_closure(). - &Apache::lonhtmlcommon::row_title($lt{'usr'}). + &Apache::lonhtmlcommon::row_title($html_lt{'usr'}). $srchbysel. $srchtypesel. ''. @@ -9259,61 +10767,165 @@ END_BLOCK &Apache::lonhtmlcommon::row_closure(1). &Apache::lonhtmlcommon::end_pick_box(). '
'; - return $output; + return ($output,1); } sub user_rule_check { my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_; - my $response; + my ($response,%inst_response); if (ref($usershash) eq 'HASH') { - foreach my $user (keys(%{$usershash})) { - my ($uname,$udom) = split(/:/,$user); - next if ($udom eq '' || $uname eq ''); - my ($id,$newuser); - if (ref($usershash->{$user}) eq 'HASH') { - $newuser = $usershash->{$user}->{'newuser'}; - $id = $usershash->{$user}->{'id'}; - } - my $inst_response; + if (keys(%{$usershash}) > 1) { + my (%by_username,%by_id,%userdoms); + my $checkid; if (ref($checks) eq 'HASH') { - if (defined($checks->{'username'})) { - ($inst_response,%{$inst_results->{$user}}) = - &Apache::lonnet::get_instuser($udom,$uname); - } elsif (defined($checks->{'id'})) { - ($inst_response,%{$inst_results->{$user}}) = - &Apache::lonnet::get_instuser($udom,undef,$id); + if ((!defined($checks->{'username'})) && (defined($checks->{'id'}))) { + $checkid = 1; + } + } + foreach my $user (keys(%{$usershash})) { + my ($uname,$udom) = split(/:/,$user); + if ($checkid) { + if (ref($usershash->{$user}) eq 'HASH') { + if ($usershash->{$user}->{'id'} ne '') { + $by_id{$udom}{$usershash->{$user}->{'id'}} = $uname; + $userdoms{$udom} = 1; + if (ref($inst_results) eq 'HASH') { + $inst_results->{$uname.':'.$udom} = {}; + } + } + } + } else { + $by_username{$udom}{$uname} = 1; + $userdoms{$udom} = 1; + if (ref($inst_results) eq 'HASH') { + $inst_results->{$uname.':'.$udom} = {}; + } + } + } + foreach my $udom (keys(%userdoms)) { + if (!$got_rules->{$udom}) { + my %domconfig = &Apache::lonnet::get_dom('configuration', + ['usercreation'],$udom); + if (ref($domconfig{'usercreation'}) eq 'HASH') { + foreach my $item ('username','id') { + if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') { + $$curr_rules{$udom}{$item} = + $domconfig{'usercreation'}{$item.'_rule'}; + } + } + } + $got_rules->{$udom} = 1; + } + } + if ($checkid) { + foreach my $udom (keys(%by_id)) { + my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_id{$udom},'id'); + if ($outcome eq 'ok') { + foreach my $id (keys(%{$by_id{$udom}})) { + my $uname = $by_id{$udom}{$id}; + $inst_response{$uname.':'.$udom} = $outcome; + } + if (ref($results) eq 'HASH') { + foreach my $uname (keys(%{$results})) { + if (exists($inst_response{$uname.':'.$udom})) { + $inst_response{$uname.':'.$udom} = $outcome; + $inst_results->{$uname.':'.$udom} = $results->{$uname}; + } + } + } + } } } else { - ($inst_response,%{$inst_results->{$user}}) = - &Apache::lonnet::get_instuser($udom,$uname); - return; + foreach my $udom (keys(%by_username)) { + my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_username{$udom}); + if ($outcome eq 'ok') { + foreach my $uname (keys(%{$by_username{$udom}})) { + $inst_response{$uname.':'.$udom} = $outcome; + } + if (ref($results) eq 'HASH') { + foreach my $uname (keys(%{$results})) { + $inst_results->{$uname.':'.$udom} = $results->{$uname}; + } + } + } + } } - if (!$got_rules->{$udom}) { - my %domconfig = &Apache::lonnet::get_dom('configuration', - ['usercreation'],$udom); - if (ref($domconfig{'usercreation'}) eq 'HASH') { - foreach my $item ('username','id') { - if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') { - $$curr_rules{$udom}{$item} = - $domconfig{'usercreation'}{$item.'_rule'}; + } elsif (keys(%{$usershash}) == 1) { + my $user = (keys(%{$usershash}))[0]; + my ($uname,$udom) = split(/:/,$user); + if (($udom ne '') && ($uname ne '')) { + if (ref($usershash->{$user}) eq 'HASH') { + if (ref($checks) eq 'HASH') { + if (defined($checks->{'username'})) { + ($inst_response{$user},%{$inst_results->{$user}}) = + &Apache::lonnet::get_instuser($udom,$uname); + } elsif (defined($checks->{'id'})) { + if ($usershash->{$user}->{'id'} ne '') { + ($inst_response{$user},%{$inst_results->{$user}}) = + &Apache::lonnet::get_instuser($udom,undef, + $usershash->{$user}->{'id'}); + } else { + ($inst_response{$user},%{$inst_results->{$user}}) = + &Apache::lonnet::get_instuser($udom,$uname); + } + } + } else { + ($inst_response{$user},%{$inst_results->{$user}}) = + &Apache::lonnet::get_instuser($udom,$uname); + return; + } + if (!$got_rules->{$udom}) { + my %domconfig = &Apache::lonnet::get_dom('configuration', + ['usercreation'],$udom); + if (ref($domconfig{'usercreation'}) eq 'HASH') { + foreach my $item ('username','id') { + if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') { + $$curr_rules{$udom}{$item} = + $domconfig{'usercreation'}{$item.'_rule'}; + } + } } + $got_rules->{$udom} = 1; } } - $got_rules->{$udom} = 1; + } else { + return; + } + } else { + return; + } + foreach my $user (keys(%{$usershash})) { + my ($uname,$udom) = split(/:/,$user); + next if (($udom eq '') || ($uname eq '')); + my $id; + if (ref($inst_results) eq 'HASH') { + if (ref($inst_results->{$user}) eq 'HASH') { + $id = $inst_results->{$user}->{'id'}; + } + } + if ($id eq '') { + if (ref($usershash->{$user})) { + $id = $usershash->{$user}->{'id'}; + } } foreach my $item (keys(%{$checks})) { if (ref($$curr_rules{$udom}) eq 'HASH') { if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') { if (@{$$curr_rules{$udom}{$item}} > 0) { - my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,$$curr_rules{$udom}{$item}); + my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item, + $$curr_rules{$udom}{$item}); foreach my $rule (@{$$curr_rules{$udom}{$item}}) { if ($rule_check{$rule}) { $$rulematch{$user}{$item} = $rule; - if ($inst_response eq 'ok') { + if ($inst_response{$user} eq 'ok') { if (ref($inst_results) eq 'HASH') { if (ref($inst_results->{$user}) eq 'HASH') { if (keys(%{$inst_results->{$user}}) == 0) { $$alerts{$item}{$udom}{$uname} = 1; + } elsif ($item eq 'id') { + if ($inst_results->{$user}->{'id'} eq '') { + $$alerts{$item}{$udom}{$uname} = 1; + } } } } @@ -9424,7 +11036,14 @@ sub personal_data_fieldtitles { sub sorted_inst_types { my ($dom) = @_; - my ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom); + my ($usertypes,$order); + my %domdefaults = &Apache::lonnet::get_domain_defaults($dom); + if (ref($domdefaults{'inststatus'}) eq 'HASH') { + $usertypes = $domdefaults{'inststatus'}{'inststatustypes'}; + $order = $domdefaults{'inststatus'}{'inststatusorder'}; + } else { + ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom); + } my $othertitle = &mt('All users'); if ($env{'request.course.id'}) { $othertitle = &mt('Any users'); @@ -9463,7 +11082,7 @@ sub get_institutional_codes { foreach (@currxlists) { if (m/^([^:]+):(\w*)$/) { unless (grep/^$1$/,@{$allcourses}) { - push @{$allcourses},$1; + push(@{$allcourses},$1); $$LC_code{$1} = $2; } } @@ -9476,7 +11095,7 @@ sub get_institutional_codes { my $sec = $coursecode.$1; my $lc_sec = $2; unless (grep/^$sec$/,@{$allcourses}) { - push @{$allcourses},$sec; + push(@{$allcourses},$sec); $$LC_code{$sec} = $lc_sec; } } @@ -9574,7 +11193,9 @@ reservable_now - ref to hash of student_ Keys in inner hash are: (a) symb: either blank or symb to which slot use is restricted. - (b) endreserve: end date of reservation period. + (b) endreserve: end date of reservation period. + (c) uniqueperiod: start,end dates when slot is to be uniquely + selected. sorted_future - ref to array of student_schedulable slots reservable in the future, ordered by start date of reservation period. @@ -9584,7 +11205,9 @@ future_reservable - ref to hash of stude Keys in inner hash are: (a) symb: either blank or symb to which slot use is restricted. - (b) startreserve: start date of reservation period. + (b) startreserve: start date of reservation period. + (c) uniqueperiod: start,end dates when slot is to be uniquely + selected. =back @@ -9592,13 +11215,35 @@ future_reservable - ref to hash of stude sub get_future_slots { my ($cnum,$cdom,$now,$symb) = @_; + my $map; + if ($symb) { + ($map) = &Apache::lonnet::decode_symb($symb); + } my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future); my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom); foreach my $slot (keys(%slots)) { next unless($slots{$slot}->{'type'} eq 'schedulable_student'); if ($symb) { - next if (($slots{$slot}->{'symb'} ne '') && - ($slots{$slot}->{'symb'} ne $symb)); + if ($slots{$slot}->{'symb'} ne '') { + my $canuse; + my %oksymbs; + my @slotsymbs = split(/\s*,\s*/,$slots{$slot}->{'symb'}); + map { $oksymbs{$_} = 1; } @slotsymbs; + if ($oksymbs{$symb}) { + $canuse = 1; + } else { + foreach my $item (@slotsymbs) { + if ($item =~ /\.(page|sequence)$/) { + (undef,undef,my $sloturl) = &Apache::lonnet::decode_symb($item); + if (($map ne '') && ($map eq $sloturl)) { + $canuse = 1; + last; + } + } + } + } + next unless ($canuse); + } } if (($slots{$slot}->{'starttime'} > $now) && ($slots{$slot}->{'endtime'} > $now)) { @@ -9638,6 +11283,10 @@ sub get_future_slots { my $startreserve = $slots{$slot}->{'startreserve'}; my $endreserve = $slots{$slot}->{'endreserve'}; my $symb = $slots{$slot}->{'symb'}; + my $uniqueperiod; + if (ref($slots{$slot}->{'uniqueperiod'}) eq 'ARRAY') { + $uniqueperiod = join(',',@{$slots{$slot}->{'uniqueperiod'}}); + } if (($startreserve < $now) && (!$endreserve || $endreserve > $now)) { my $lastres = $endreserve; @@ -9646,13 +11295,15 @@ sub get_future_slots { } $reservable_now{$slot} = { symb => $symb, - endreserve => $lastres + endreserve => $lastres, + uniqueperiod => $uniqueperiod, }; } elsif (($startreserve > $now) && (!$endreserve || $endreserve > $startreserve)) { $future_reservable{$slot} = { symb => $symb, - startreserve => $startreserve + startreserve => $startreserve, + uniqueperiod => $uniqueperiod, }; } } @@ -9810,7 +11461,23 @@ sub get_env_multiple { return(@values); } +# Looks at given dependencies, and returns something depending on the context. +# For coursedocs paste, returns (undef, $counter, $numpathchg, \%existing). +# For syllabus rewrites, returns (undef, $counter, $numpathchg, \%existing, \%mapping). +# For all other contexts, returns ($output, $counter, $numpathchg). +# $output: string with the HTML output. Can contain missing dependencies with an upload form, existing dependencies, and dependencies no longer in use. +# $counter: integer with the number of existing dependencies when no HTML output is returned, and the number of missing dependencies when an HTML output is returned. +# $numpathchg: integer with the number of cleaned up dependency paths. +# \%existing: hash reference clean path -> 1 only for existing dependencies. +# \%mapping: hash reference clean path -> original path for all dependencies. +# @param {string} actionurl - The path to the handler, indicative of the context. +# @param {string} state - Can contain HTML with hidden inputs that will be added to the output form. +# @param {hash reference} allfiles - List of file info from lonnet::extract_embedded_items +# @param {hash reference} codebase - undef, not modified by lonnet::extract_embedded_items ? +# @param {hash reference} args - More parameters ! Possible keys: error_on_invalid_names (boolean), ignore_remote_references (boolean), current_path (string), docs_url (string), docs_title (string), context (string) +# @return {Array} - array depending on the context (not a reference) sub ask_for_embedded_content { + # NOTE: documentation was added afterwards, it could be wrong my ($actionurl,$state,$allfiles,$codebase,$args)=@_; my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges, %currsubfile,%unused,$rem); @@ -9826,6 +11493,9 @@ sub ask_for_embedded_content { my $heading = &mt('Upload embedded files'); my $buttontext = &mt('Upload'); + # fills these variables based on the context: + # $navmap, $cdom, $cnum, $udom, $uname, $url, $toplevel, $getpropath, + # $path, $fileloc, $title, $rem, $filename if ($env{'request.course.id'}) { if ($actionurl eq '/adm/dependencies') { $navmap = Apache::lonnavmaps::navmap->new(); @@ -9833,7 +11503,7 @@ sub ask_for_embedded_content { $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; } - if (($actionurl eq '/adm/portfolio') || + if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) { my $current_path='/'; if ($env{'form.currentpath'}) { @@ -9865,18 +11535,18 @@ sub ask_for_embedded_content { $toplevel = $url; if ($args->{'context'} eq 'paste') { ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/}); - ($path) = + ($path) = ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/}); $fileloc = &Apache::lonnet::filelocation('',$toplevel); $fileloc =~ s{^/}{}; } } - } elsif ($actionurl eq '/adm/dependencies') { + } elsif ($actionurl eq '/adm/dependencies') { if ($env{'request.course.id'} ne '') { if (ref($args) eq 'HASH') { $url = $args->{'docs_url'}; $title = $args->{'docs_title'}; - $toplevel = $url; + $toplevel = $url; unless ($toplevel =~ m{^/}) { $toplevel = "/$url"; } @@ -9887,7 +11557,15 @@ sub ask_for_embedded_content { ($path) = ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/}); } - $fileloc = &Apache::lonnet::filelocation('',$toplevel); + if ($toplevel=~/^\/*(uploaded|editupload)/) { + $fileloc = $toplevel; + $fileloc=~ s/^\s*(\S+)\s*$/$1/; + my ($udom,$uname,$fname) = + ($fileloc=~ m{^/+(?:uploaded|editupload)/+($match_domain)/+($match_name)/+(.*)$}); + $fileloc = propath($udom,$uname).'/userfiles/'.$fname; + } else { + $fileloc = &Apache::lonnet::filelocation('',$toplevel); + } $fileloc =~ s{^/}{}; ($filename) = ($fileloc =~ m{.+/([^/]+)$}); $heading = &mt('Status of dependencies in [_1]',"$title ($filename)"); @@ -9902,6 +11580,16 @@ sub ask_for_embedded_content { $fileloc = &Apache::lonnet::filelocation('',$toplevel).'/'; $fileloc =~ s{^/}{}; } + + # parses the dependency paths to get some info + # fills $newfiles, $mapping, $subdependencies, $dependencies + # $newfiles: hash URL -> 1 for new files or external URLs + # (will be completed later) + # $mapping: + # for external URLs: external URL -> external URL + # for relative paths: clean path -> original path + # $subdependencies: hash clean path -> clean file name -> 1 for relative paths in subdirectories + # $dependencies: hash clean or not file name -> 1 for relative paths not in subdirectories foreach my $file (keys(%{$allfiles})) { my $embed_file; if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) { @@ -9944,11 +11632,24 @@ sub ask_for_embedded_content { } } } + + # looks for all existing files in dependency subdirectories (from $subdependencies filled above) + # and lists + # fills $currsubfile, $pathchanges, $existing, $numexisting, $newfiles, $unused + # $currsubfile: hash clean path -> file name -> 1 for all existing files in the path + # $pathchanges: hash clean path -> 1 if the file in subdirectory exists and + # the path had to be cleaned up + # $existing: hash clean path -> 1 if the file exists + # $numexisting: number of keys in $existing + # $newfiles: updated with clean path -> 1 for files in subdirectories that do not exist + # $unused: only for /adm/dependencies, hash clean path -> 1 for existing files in + # dependency subdirectories that are + # not listed as dependencies, with some exceptions using $rem my $dirptr = 16384; foreach my $path (keys(%subdependencies)) { $currsubfile{$path} = {}; - if (($actionurl eq '/adm/portfolio') || - ($actionurl eq '/adm/coursegrp_portfolio')) { + if (($actionurl eq '/adm/portfolio') || + ($actionurl eq '/adm/coursegrp_portfolio')) { my ($sublistref,$listerror) = &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath); if (ref($sublistref) eq 'ARRAY') { @@ -10019,6 +11720,9 @@ sub ask_for_embedded_content { } } } + + # fills $currfile, hash file name -> 1 or [$size,$mtime] + # for files in $url or $fileloc (target directory) in some contexts my %currfile; if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) { @@ -10057,6 +11761,8 @@ sub ask_for_embedded_content { } } } + # updates $pathchanges, $existing, $numexisting, $newfiles and $unused for files that + # are not in subdirectories, using $currfile foreach my $file (keys(%dependencies)) { if (exists($currfile{$file})) { unless ($mapping{$file} eq $file) { @@ -10085,17 +11791,25 @@ sub ask_for_embedded_content { $unused{$file} = 1; } } + + # returns some results for coursedocs paste and syllabus rewrites ($output is undef) if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') && ($args->{'context'} eq 'paste')) { $counter = scalar(keys(%existing)); $numpathchg = scalar(keys(%pathchanges)); return ($output,$counter,$numpathchg,\%existing); - } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") && + } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") && (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) { $counter = scalar(keys(%existing)); $numpathchg = scalar(keys(%pathchanges)); return ($output,$counter,$numpathchg,\%existing,\%mapping); } + + # returns HTML otherwise, with dependency results and to ask for more uploads + + # $upload_output: missing dependencies (with upload form) + # $modify_output: uploaded dependencies (in use) + # $delete_output: files no longer in use (unused files are not listed for londocs, bug?) foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) { if ($actionurl eq '/adm/dependencies') { next if ($embed_file =~ m{^\w+://}); @@ -10319,7 +12033,7 @@ sub ask_for_embedded_content { Performs clean-up of directories, subdirectories and filename in an embedded object, referenced in an HTML file which is being uploaded -to a course or portfolio, where +to a course or portfolio, where "Upload embedded images/multimedia files if HTML file" checkbox was checked. @@ -10338,7 +12052,7 @@ sub clean_path { @contents = ($embed_file); } my $lastidx = scalar(@contents)-1; - for (my $i=0; $i<=$lastidx; $i++) { + for (my $i=0; $i<=$lastidx; $i++) { $contents[$i]=~s{\\}{/}g; $contents[$i]=~s/\s+/\_/g; $contents[$i]=~s{[^/\w\.\-]}{}g; @@ -10677,7 +12391,7 @@ sub modify_html_refs { } my (%allfiles,%codebase,$output,$content); my @changes = &get_env_multiple('form.namechange'); - unless ((@changes > 0) || ($context eq 'syllabus')) { + unless ((@changes > 0) || ($context eq 'syllabus')) { if (wantarray) { return ('',0,0); } else { @@ -10709,7 +12423,7 @@ sub modify_html_refs { return; } } - if (open(my $fh,"<$container")) { + if (open(my $fh,'<',$container)) { $content = join('', <$fh>); close($fh); } else { @@ -10774,7 +12488,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].', @@ -10812,7 +12526,7 @@ sub modify_html_refs { } } if ($rewrites) { - my $saveresult; + my $saveresult; my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult); if ($url eq $container) { my ($fname) = ($container =~ m{/([^/]+)$}); @@ -11043,7 +12757,7 @@ sub decompress_form { "$topdir/media/player.swf", "$topdir/media/swfobject.js", "$topdir/media/expressInstall.swf"); - my @camtasia8 = ("$topdir/","$topdir/$topdir.html", + my @camtasia8_1 = ("$topdir/","$topdir/$topdir.html", "$topdir/$topdir.mp4", "$topdir/$topdir\_config.xml", "$topdir/$topdir\_controller.swf", @@ -11065,13 +12779,36 @@ sub decompress_form { "$topdir/skins/express_show/", "$topdir/skins/express_show/player-min.css", "$topdir/skins/express_show/spritesheet.png"); + my @camtasia8_4 = ("$topdir/","$topdir/$topdir.html", + "$topdir/$topdir.mp4", + "$topdir/$topdir\_config.xml", + "$topdir/$topdir\_controller.swf", + "$topdir/$topdir\_embed.css", + "$topdir/$topdir\_First_Frame.png", + "$topdir/$topdir\_player.html", + "$topdir/$topdir\_Thumbnails.png", + "$topdir/playerProductInstall.swf", + "$topdir/scripts/", + "$topdir/scripts/config_xml.js", + "$topdir/scripts/techsmith-smart-player.min.js", + "$topdir/skins/", + "$topdir/skins/configuration_express.xml", + "$topdir/skins/express_show/", + "$topdir/skins/express_show/spritesheet.min.css", + "$topdir/skins/express_show/spritesheet.png", + "$topdir/skins/express_show/techsmith-smart-player.min.css"); my @diffs = &compare_arrays(\@paths,\@camtasia6); if (@diffs == 0) { $is_camtasia = 6; } else { - @diffs = &compare_arrays(\@paths,\@camtasia8); + @diffs = &compare_arrays(\@paths,\@camtasia8_1); if (@diffs == 0) { $is_camtasia = 8; + } else { + @diffs = &compare_arrays(\@paths,\@camtasia8_4); + if (@diffs == 0) { + $is_camtasia = 8; + } } } } @@ -11268,6 +13005,18 @@ sub decompress_uploaded_file { sub process_decompression { my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_; + unless (($dir_root eq '/userfiles') && ($destination =~ m{^(docs|supplemental)/(default|\d+)/\d+$})) { + return '

'.&mt('Not extracted.').'
'. + &mt('Unexpected file path.').'

'."\n"; + } + unless (($docudom =~ /^$match_domain$/) && ($docuname =~ /^$match_courseid$/)) { + return '

'.&mt('Not extracted.').'
'. + &mt('Unexpected course context.').'

'."\n"; + } + unless ($file eq &Apache::lonnet::clean_filename($file)) { + return '

'.&mt('Not extracted.').'
'. + &mt('Filename contained unexpected characters.').'

'."\n"; + } my ($dir,$error,$warning,$output); if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) { $error = &mt('Filename not a supported archive file type.'). @@ -11302,30 +13051,44 @@ sub process_decompression { } } my $numskip = scalar(@to_skip); - if (($numskip > 0) && - ($numskip == $env{'form.archive_itemcount'})) { + my $numoverwrite = scalar(@to_overwrite); + if (($numskip) && (!$numoverwrite)) { $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.'); } elsif ($dir eq '') { $error = &mt('Directory containing archive file unavailable.'); } elsif (!$error) { my ($decompressed,$display); - if ($numskip > 0) { + if (($numskip) || ($numoverwrite)) { my $tempdir = time.'_'.$$.int(rand(10000)); mkdir("$dir/$tempdir",0755); - system("mv $dir/$file $dir/$tempdir/$file"); - ($decompressed,$display) = - &decompress_uploaded_file($file,"$dir/$tempdir"); - foreach my $item (@to_skip) { - if (($item ne '') && ($item !~ /\.\./)) { - if (-f "$dir/$tempdir/$item") { - unlink("$dir/$tempdir/$item"); - } elsif (-d "$dir/$tempdir/$item") { - system("rm -rf $dir/$tempdir/$item"); + if (&File::Copy::move("$dir/$file","$dir/$tempdir/$file")) { + ($decompressed,$display) = + &decompress_uploaded_file($file,"$dir/$tempdir"); + foreach my $item (@to_skip) { + if (($item ne '') && ($item !~ /\.\./)) { + if (-f "$dir/$tempdir/$item") { + unlink("$dir/$tempdir/$item"); + } elsif (-d "$dir/$tempdir/$item") { + &File::Path::remove_tree("$dir/$tempdir/$item",{ safe => 1 }); + } } } + foreach my $item (@to_overwrite) { + if ((-e "$dir/$tempdir/$item") && (-e "$dir/$item")) { + if (($item ne '') && ($item !~ /\.\./)) { + if (-f "$dir/$item") { + unlink("$dir/$item"); + } elsif (-d "$dir/$item") { + &File::Path::remove_tree("$dir/$item",{ safe => 1 }); + } + &File::Copy::move("$dir/$tempdir/$item","$dir/$item"); + } + } + } + if (&File::Copy::move("$dir/$tempdir/$file","$dir/$file")) { + &File::Path::remove_tree("$dir/$tempdir",{ safe => 1 }); + } } - system("mv $dir/$tempdir/* $dir"); - rmdir("$dir/$tempdir"); } else { ($decompressed,$display) = &decompress_uploaded_file($file,$dir); @@ -11343,8 +13106,7 @@ sub process_decompression { if (ref($newdirlistref) eq 'ARRAY') { foreach my $dir_line (@{$newdirlistref}) { my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5); - unless (($item =~ /^\.+$/) || ($item eq $file) || - ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) { + unless (($item =~ /^\.+$/) || ($item eq $file)) { push(@newitems,$item); if ($dirptr&$testdir) { $is_dir{$item} = 1; @@ -11399,7 +13161,7 @@ sub process_decompression { $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'}; $displayed{'folder'} = $i; } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) || - (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) { + (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) { $env{'form.archive_'.$i} = 'display'; $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'}; $displayed{'web'} = $i; @@ -11829,7 +13591,7 @@ END sub process_extracted_files { my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_; my $numitems = $env{'form.archive_count'}; - return unless ($numitems); + return if ((!$numitems) || ($numitems =~ /\D/)); my @ids=&Apache::lonnet::current_machine_ids(); my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir, %folders,%containers,%mapinner,%prompttofetch); @@ -11842,7 +13604,7 @@ sub process_extracted_files { } else { $prefix = $Apache::lonnet::perlvar{'lonDocRoot'}; $pathtocheck = "$dir_root/$docudom/$docuname/$destination"; - $dir = "$dir_root/$docudom/$docuname"; + $dir = "$dir_root/$docudom/$docuname"; } my $currdir = "$dir_root/$destination"; (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/}); @@ -11851,7 +13613,7 @@ sub process_extracted_files { $folders{'0'} = $items[-2]; if ($env{'form.folderpath'} =~ /\:1$/) { $containers{'0'}='page'; - } else { + } else { $containers{'0'}='sequence'; } } @@ -11931,7 +13693,9 @@ sub process_extracted_files { '.'.$containers{$outer},1,1); $newseqid{$i} = $newidx; unless ($errtext) { - $result .= '
  • '.&mt('Folder: [_1] added to course',$docstitle).'
    • '."\n"; + $result .= '
  • '.&mt('Folder: [_1] added to course', + &HTML::Entities::encode($docstitle,'<>&"')). + '
    • '."\n"; } } } else { @@ -11940,38 +13704,47 @@ sub process_extracted_files { my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'. $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'. $title; - if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") { - mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755); - } - if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") { - mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx"); - } - if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") { - system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title"); - $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx"; - unless ($ishome) { - my $fetch = "$newdest{$i}/$title"; - $fetch =~ s/^\Q$prefix$dir\E//; - $prompttofetch{$fetch} = 1; + if (($outer !~ /\D/) && ($mapinner{$outer} !~ /\D/) && ($newidx !~ /\D/)) { + if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") { + mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755); } - } - $LONCAPA::map::resources[$newidx]= - $docstitle.':'.$url.':false:normal:res'; - push(@LONCAPA::map::order, $newidx); - my ($outtext,$errtext)= - &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'. - $docuname.'/'.$folders{$outer}. - '.'.$containers{$outer},1,1); - unless ($errtext) { - if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") { - $result .= '
  • '.&mt('File: [_1] added to course',$docstitle).'
    • '."\n"; + if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") { + mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx"); } + if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") { + if (rename("$prefix$path","$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title")) { + $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx"; + unless ($ishome) { + my $fetch = "$newdest{$i}/$title"; + $fetch =~ s/^\Q$prefix$dir\E//; + $prompttofetch{$fetch} = 1; + } + } + } + $LONCAPA::map::resources[$newidx]= + $docstitle.':'.$url.':false:normal:res'; + push(@LONCAPA::map::order, $newidx); + my ($outtext,$errtext)= + &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'. + $docuname.'/'.$folders{$outer}. + '.'.$containers{$outer},1,1); + unless ($errtext) { + if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") { + $result .= '
  • '.&mt('File: [_1] added to course', + &HTML::Entities::encode($docstitle,'<>&"')). + '
    • '."\n"; + } + } + } else { + $warning .= &mt('Item extracted from archive: [_1] has unexpected path.', + &HTML::Entities::encode($path,'<>&"')).'
    '; } } } } } else { - $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'
    '; + $warning .= &mt('Item extracted from archive: [_1] has unexpected path.', + &HTML::Entities::encode($path,'<>&"')).'
    '; } } for (my $i=1; $i<=$numitems; $i++) { @@ -11993,7 +13766,7 @@ sub process_extracted_files { } if ($itemidx eq '') { $itemidx = 0; - } + } if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) { if ($mapinner{$referrer{$i}}) { $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}"; @@ -12032,7 +13805,9 @@ sub process_extracted_files { } if ($fullpath ne '') { if (-e "$prefix$path") { - system("mv $prefix$path $fullpath/$title"); + unless (rename("$prefix$path","$fullpath/$title")) { + $warning .= &mt('Failed to rename dependency').'
    '; + } } if (-e "$fullpath/$title") { my $showpath; @@ -12040,22 +13815,27 @@ sub process_extracted_files { $showpath = "$relpath/$title"; } else { $showpath = "/$title"; + } + $result .= '
  • '.&mt('[_1] included as a dependency', + &HTML::Entities::encode($showpath,'<>&"')). + '
    • '."\n"; + unless ($ishome) { + my $fetch = "$fullpath/$title"; + $fetch =~ s/^\Q$prefix$dir\E//; + $prompttofetch{$fetch} = 1; } - $result .= '
  • '.&mt('[_1] included as a dependency',$showpath).'
    • '."\n"; - } - unless ($ishome) { - my $fetch = "$fullpath/$title"; - $fetch =~ s/^\Q$prefix$dir\E//; - $prompttofetch{$fetch} = 1; } } } } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') { $warning .= &mt('[_1] is a dependency of [_2], which was discarded.', - $path,$env{'form.archive_content_'.$referrer{$i}}).'
    '; + &HTML::Entities::encode($path,'<>&"'), + &HTML::Entities::encode($env{'form.archive_content_'.$referrer{$i}},'<>&"')). + '
    '; } } else { - $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'
    '; + $warning .= &mt('Item extracted from archive: [_1] has unexpected path.', + &HTML::Entities::encode($path)).'
    '; } } if (keys(%todelete)) { @@ -12329,12 +14109,15 @@ sub upfile_store { $env{'form.upfile'}=~s/\n+/\n/gs; $env{'form.upfile'}=~s/\n+$//gs; - my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}. - '_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$; + my $datatoken = &valid_datatoken($env{'user.name'}.'_'.$env{'user.domain'}. + '_enroll_'.$env{'request.course.id'}.'_'. + time.'_'.$$); + return if ($datatoken eq ''); + { my $datafile = $r->dir_config('lonDaemons'). '/tmp/'.$datatoken.'.tmp'; - if ( open(my $fh,">$datafile") ) { + if ( open(my $fh,'>',$datafile) ) { print $fh $env{'form.upfile'}; close($fh); } @@ -12344,21 +14127,22 @@ sub upfile_store { =pod -=item * &load_tmp_file($r) +=item * &load_tmp_file($r,$datatoken) Load uploaded file from tmp, $r should be the HTTP Request object, -needs $env{'form.datatoken'}, +$datatoken is the name to assign to the temporary file. sets $env{'form.upfile'} to the contents of the file =cut sub load_tmp_file { - my $r=shift; + my ($r,$datatoken) = @_; + return if ($datatoken eq ''); my @studentdata=(); { my $studentfile = $r->dir_config('lonDaemons'). - '/tmp/'.$env{'form.datatoken'}.'.tmp'; - if ( open(my $fh,"<$studentfile") ) { + '/tmp/'.$datatoken.'.tmp'; + if ( open(my $fh,'<',$studentfile) ) { @studentdata=<$fh>; close($fh); } @@ -12366,6 +14150,14 @@ sub load_tmp_file { $env{'form.upfile'}=join('',@studentdata); } +sub valid_datatoken { + my ($datatoken) = @_; + if ($datatoken =~ /^$match_username\_$match_domain\_enroll_(|$match_domain\_$match_courseid)\_\d+_\d+$/) { + return $datatoken; + } + return; +} + =pod =item * &upfile_record_sep() @@ -12806,7 +14598,7 @@ sub DrawBarGraph { @Labels = @$labels; } else { for (my $i=0;$i<@{$Values[0]};$i++) { - push (@Labels,$i+1); + push(@Labels,$i+1); } } # @@ -13245,15 +15037,22 @@ generated by lonerrorhandler.pm, CHECKRP lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively. Inputs: -defmail (scalar - email address of default recipient), +defmail (scalar - email address of default recipient), mailing type (scalar: errormail, packagesmail, helpdeskmail, requestsmail, updatesmail, or idconflictsmail). defdom (domain for which to retrieve configuration settings), -origmail (scalar - email address of recipient from loncapa.conf, +origmail (scalar - email address of recipient from loncapa.conf, i.e., predates configuration by DC via domainprefs.pm +$requname username of requester (if mailing type is helpdeskmail) + +$requdom domain of requester (if mailing type is helpdeskmail) + +$reqemail e-mail address of requester (if mailing type is helpdeskmail) + + Returns: comma separated list of addresses to which to send e-mail. =back @@ -13263,11 +15062,11 @@ Returns: comma separated list of address ############################################################ ############################################################ sub build_recipient_list { - my ($defmail,$mailing,$defdom,$origmail) = @_; + my ($defmail,$mailing,$defdom,$origmail,$requname,$requdom,$reqemail) = @_; my @recipients; - my $otheremails; + my ($otheremails,$lastresort,$allbcc,$addtext); my %domconfig = - &Apache::lonnet::get_dom('configuration',['contacts'],$defdom); + &Apache::lonnet::get_dom('configuration',['contacts'],$defdom); if (ref($domconfig{'contacts'}) eq 'HASH') { if (exists($domconfig{'contacts'}{$mailing})) { if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') { @@ -13279,14 +15078,183 @@ sub build_recipient_list { push(@recipients,$addr); } } - $otheremails = $domconfig{'contacts'}{$mailing}{'others'}; + } + $otheremails = $domconfig{'contacts'}{$mailing}{'others'}; + if ($mailing eq 'helpdeskmail') { + if ($domconfig{'contacts'}{$mailing}{'bcc'}) { + my @bccs = split(/,/,$domconfig{'contacts'}{$mailing}{'bcc'}); + my @ok_bccs; + foreach my $bcc (@bccs) { + $bcc =~ s/^\s+//g; + $bcc =~ s/\s+$//g; + if ($bcc =~ m/^[^\@]+\@[^\@]+$/) { + if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) { + push(@ok_bccs,$bcc); + } + } + } + if (@ok_bccs > 0) { + $allbcc = join(', ',@ok_bccs); + } + } + $addtext = $domconfig{'contacts'}{$mailing}{'include'}; } } } elsif ($origmail ne '') { - push(@recipients,$origmail); + $lastresort = $origmail; + } + if ($mailing eq 'helpdeskmail') { + if ((ref($domconfig{'contacts'}{'overrides'}) eq 'HASH') && + (keys(%{$domconfig{'contacts'}{'overrides'}}))) { + my ($inststatus,$inststatus_checked); + if (($env{'user.name'} ne '') && ($env{'user.domain'} ne '') && + ($env{'user.domain'} ne 'public')) { + $inststatus_checked = 1; + $inststatus = $env{'environment.inststatus'}; + } + unless ($inststatus_checked) { + if (($requname ne '') && ($requdom ne '')) { + if (($requname =~ /^$match_username$/) && + ($requdom =~ /^$match_domain$/) && + (&Apache::lonnet::domain($requdom))) { + my $requhome = &Apache::lonnet::homeserver($requname, + $requdom); + unless ($requhome eq 'no_host') { + my %userenv = &Apache::lonnet::userenvironment($requdom,$requname,'inststatus'); + $inststatus = $userenv{'inststatus'}; + $inststatus_checked = 1; + } + } + } + } + unless ($inststatus_checked) { + if ($reqemail =~ /^[^\@]+\@[^\@]+$/) { + my %srch = (srchby => 'email', + srchdomain => $defdom, + srchterm => $reqemail, + srchtype => 'exact'); + my %srch_results = &Apache::lonnet::usersearch(\%srch); + foreach my $uname (keys(%srch_results)) { + if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') { + $inststatus = join(',',@{$srch_results{$uname}{'inststatus'}}); + $inststatus_checked = 1; + last; + } + } + unless ($inststatus_checked) { + my ($dirsrchres,%srch_results) = &Apache::lonnet::inst_directory_query(\%srch); + if ($dirsrchres eq 'ok') { + foreach my $uname (keys(%srch_results)) { + if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') { + $inststatus = join(',',@{$srch_results{$uname}{'inststatus'}}); + $inststatus_checked = 1; + last; + } + } + } + } + } + } + if ($inststatus ne '') { + foreach my $status (split(/\:/,$inststatus)) { + if (ref($domconfig{'contacts'}{'overrides'}{$status}) eq 'HASH') { + my @contacts = ('adminemail','supportemail'); + foreach my $item (@contacts) { + if ($domconfig{'contacts'}{'overrides'}{$status}{$item}) { + my $addr = $domconfig{'contacts'}{'overrides'}{$status}; + if (!grep(/^\Q$addr\E$/,@recipients)) { + push(@recipients,$addr); + } + } + } + $otheremails = $domconfig{'contacts'}{'overrides'}{$status}{'others'}; + if ($domconfig{'contacts'}{'overrides'}{$status}{'bcc'}) { + my @bccs = split(/,/,$domconfig{'contacts'}{'overrides'}{$status}{'bcc'}); + my @ok_bccs; + foreach my $bcc (@bccs) { + $bcc =~ s/^\s+//g; + $bcc =~ s/\s+$//g; + if ($bcc =~ m/^[^\@]+\@[^\@]+$/) { + if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) { + push(@ok_bccs,$bcc); + } + } + } + if (@ok_bccs > 0) { + $allbcc = join(', ',@ok_bccs); + } + } + $addtext = $domconfig{'contacts'}{'overrides'}{$status}{'include'}; + last; + } + } + } + } } } elsif ($origmail ne '') { - push(@recipients,$origmail); + $lastresort = $origmail; + } + if (($mailing eq 'helpdeskmail') && ($lastresort ne '')) { + unless (grep(/^\Q$defdom\E$/,&Apache::lonnet::current_machine_domains())) { + my $lonhost = $Apache::lonnet::perlvar{'lonHostID'}; + my $machinedom = $Apache::lonnet::perlvar{'lonDefDomain'}; + my %what = ( + perlvar => 1, + ); + my $primary = &Apache::lonnet::domain($defdom,'primary'); + if ($primary) { + my $gotaddr; + my ($result,$returnhash) = + &Apache::lonnet::get_remote_globals($primary,{ perlvar => 1 }); + if (($result eq 'ok') && (ref($returnhash) eq 'HASH')) { + if ($returnhash->{'lonSupportEMail'} =~ /^[^\@]+\@[^\@]+$/) { + $lastresort = $returnhash->{'lonSupportEMail'}; + $gotaddr = 1; + } + } + unless ($gotaddr) { + my $uintdom = &Apache::lonnet::internet_dom($primary); + my $intdom = &Apache::lonnet::internet_dom($lonhost); + unless ($uintdom eq $intdom) { + my %domconfig = + &Apache::lonnet::get_dom('configuration',['contacts'],$machinedom); + if (ref($domconfig{'contacts'}) eq 'HASH') { + if (ref($domconfig{'contacts'}{'otherdomsmail'}) eq 'HASH') { + my @contacts = ('adminemail','supportemail'); + foreach my $item (@contacts) { + if ($domconfig{'contacts'}{'otherdomsmail'}{$item}) { + my $addr = $domconfig{'contacts'}{$item}; + if (!grep(/^\Q$addr\E$/,@recipients)) { + push(@recipients,$addr); + } + } + } + if ($domconfig{'contacts'}{'otherdomsmail'}{'others'}) { + $otheremails = $domconfig{'contacts'}{'otherdomsmail'}{'others'}; + } + if ($domconfig{'contacts'}{'otherdomsmail'}{'bcc'}) { + my @bccs = split(/,/,$domconfig{'contacts'}{'otherdomsmail'}{'bcc'}); + my @ok_bccs; + foreach my $bcc (@bccs) { + $bcc =~ s/^\s+//g; + $bcc =~ s/\s+$//g; + if ($bcc =~ m/^[^\@]+\@[^\@]+$/) { + if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) { + push(@ok_bccs,$bcc); + } + } + } + if (@ok_bccs > 0) { + $allbcc = join(', ',@ok_bccs); + } + } + $addtext = $domconfig{'contacts'}{'otherdomsmail'}{'include'}; + } + } + } + } + } + } } if (defined($defmail)) { if ($defmail ne '') { @@ -13306,8 +15274,106 @@ sub build_recipient_list { } } } - my $recipientlist = join(',',@recipients); - return $recipientlist; + if ($mailing eq 'helpdeskmail') { + if ((!@recipients) && ($lastresort ne '')) { + push(@recipients,$lastresort); + } + } elsif ($lastresort ne '') { + if (!grep(/^\Q$lastresort\E$/,@recipients)) { + push(@recipients,$lastresort); + } + } + my $recipientlist = join(',',@recipients); + if (wantarray) { + return ($recipientlist,$allbcc,$addtext); + } else { + return $recipientlist; + } +} + +############################################################ +############################################################ + +=pod + +=over 4 + +=item * &mime_email() + +Sends an email with a possible attachment + +Inputs: + +=over 4 + +from - Sender's email address + +replyto - Reply-To email address + +to - Email address of recipient + +subject - Subject of email + +body - Body of email + +cc_string - Carbon copy email address + +bcc - Blind carbon copy email address + +attachment_path - Path of file to be attached + +file_name - Name of file to be attached + +attachment_text - The body of an attachment of type "TEXT" + +=back + +=back + +=cut + +############################################################ +############################################################ + +sub mime_email { + my ($from,$replyto,$to,$subject,$body,$cc_string,$bcc,$attachment_path, + $file_name,$attachment_text) = @_; + + my $msg = MIME::Lite->new( + From => $from, + To => $to, + Subject => $subject, + Type =>'TEXT', + Data => $body, + ); + if ($replyto ne '') { + $msg->add("Reply-To" => $replyto); + } + if ($cc_string ne '') { + $msg->add("Cc" => $cc_string); + } + if ($bcc ne '') { + $msg->add("Bcc" => $bcc); + } + $msg->attr("content-type" => "text/plain"); + $msg->attr("content-type.charset" => "UTF-8"); + # Attach file if given + if ($attachment_path) { + unless ($file_name) { + if ($attachment_path =~ m-/([^/]+)$-) { $file_name = $1; } + } + my ($type, $encoding) = MIME::Types::by_suffix($attachment_path); + $msg->attach(Type => $type, + Path => $attachment_path, + Filename => $file_name + ); + # Otherwise attach text if given + } elsif ($attachment_text) { + $msg->attach(Type => 'TEXT', + Data => $attachment_text); + } + # Send it + $msg->send('sendmail'); } ############################################################ @@ -13398,6 +15464,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. @@ -13405,7 +15473,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') { @@ -13417,6 +15485,8 @@ sub extract_categories { $trailstr = &mt('Official courses (with institutional codes)'); } elsif ($name eq 'communities') { $trailstr = &mt('Communities'); + } elsif ($name eq 'placement') { + $trailstr = &mt('Placement Tests'); } else { $trailstr = $name; } @@ -13431,12 +15501,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; + } } } } @@ -13474,13 +15547,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; @@ -13501,16 +15574,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; } @@ -13531,16 +15609,19 @@ currcat - scalar with an & separated lis type - scalar contains course type (Course or Community). +disabled - scalar (optional) contains disabled="disabled" if input elements are + to be readonly (e.g., Domain Helpdesk role viewing course settings). + Returns: $output (markup to be displayed) =cut sub assign_categories_table { - my ($cathash,$currcat,$type) = @_; + my ($cathash,$currcat,$type,$disabled) = @_; my $output; if (ref($cathash) eq 'HASH') { - my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth); - &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray); + my (@cats,@trails,%allitems,%idx,@jsarray,%maxd,@path,$maxdepth); + &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray,\%maxd); $maxdepth = scalar(@cats); if (@cats > 0) { my $itemcount = 0; @@ -13555,8 +15636,10 @@ sub assign_categories_table { next if ($parent eq 'instcode'); if ($type eq 'Community') { next unless ($parent eq 'communities'); + } elsif ($type eq 'Placement') { + next unless ($parent eq 'placement'); } else { - next if ($parent eq 'communities'); + next if (($parent eq 'communities') || ($parent eq 'placement')); } my $css_class = $itemcount%2?' class="LC_odd_row"':''; my $item = &escape($parent).'::0'; @@ -13569,14 +15652,16 @@ sub assign_categories_table { my $parent_title = $parent; if ($parent eq 'communities') { $parent_title = &mt('Communities'); + } elsif ($parent eq 'placement') { + $parent_title = &mt('Placement Tests'); } $table .= ''. ''.$parent_title.''. + $item.'"'.$checked.$disabled.' />'.$parent_title.'    '. ''; my $depth = 1; push(@path,$parent); - $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories); + $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories,$disabled); pop(@path); $table .= ''; $itemcount ++; @@ -13615,12 +15700,15 @@ path - Array containing all categories b currcategories - reference to array of current categories assigned to the course +disabled - scalar (optional) contains disabled="disabled" if input elements are + to be readonly (e.g., Domain Helpdesk role viewing course settings). + Returns: $output (markup to be displayed). =cut sub assign_category_rows { - my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_; + my ($itemcount,$cats,$depth,$parent,$path,$currcategories,$disabled) = @_; my ($text,$name,$item,$chgstr); if (ref($cats) eq 'ARRAY') { my $maxdepth = scalar(@{$cats}); @@ -13643,12 +15731,12 @@ sub assign_category_rows { } $text .= ''. + $item.'"'.$checked.$disabled.' />'.$name.''. ''. ''; if (ref($path) eq 'ARRAY') { push(@{$path},$name); - $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories); + $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories,$disabled); pop(@{$path}); } $text .= ''; @@ -13796,7 +15884,7 @@ sub commit_studentrole { } } } else { - if ($secchange) { + if ($secchange) { $$logmsg .= &mt('Error when attempting section change for [_1] from old section "[_2]" to new section: "[_3]" in course [_4] -error:',$uname,$oldsec,$sec,$cid).' '.$modify_section_result.$linefeed; } else { $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed; @@ -13859,7 +15947,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') { @@ -13867,59 +15956,154 @@ 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'}) && + if (($env{'request.role.domain'} eq $args->{'clonedomain'}) && (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) { $can_clone = 1; } else { - my %clonehash = &Apache::lonnet::get('environment',['cloners'], + my %clonehash = &Apache::lonnet::get('environment',['cloners','internal.coursecode'], $args->{'clonedomain'},$args->{'clonecourse'}); - my @cloners = split(/,/,$clonehash{'cloners'}); - if (grep(/^\*$/,@cloners)) { - $can_clone = 1; - } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) { - $can_clone = 1; + if ($clonehash{'cloners'} eq '') { + my %domdefs = &Apache::lonnet::get_domain_defaults($args->{'course_domain'}); + if ($domdefs{'canclone'}) { + unless ($domdefs{'canclone'} eq 'none') { + if ($domdefs{'canclone'} eq 'domain') { + if ($args->{'ccdomain'} eq $args->{'clonedomain'}) { + $can_clone = 1; + } + } elsif (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) && + ($args->{'clonedomain'} eq $args->{'course_domain'})) { + if (&Apache::lonnet::default_instcode_cloning($args->{'clonedomain'},$domdefs{'canclone'}, + $clonehash{'internal.coursecode'},$args->{'crscode'})) { + $can_clone = 1; + } + } + } + } } else { + my @cloners = split(/,/,$clonehash{'cloners'}); + if (grep(/^\*$/,@cloners)) { + $can_clone = 1; + } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) { + $can_clone = 1; + } elsif (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners)) { + $can_clone = 1; + } + unless ($can_clone) { + if (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) && + ($args->{'clonedomain'} eq $args->{'course_domain'})) { + my (%gotdomdefaults,%gotcodedefaults); + foreach my $cloner (@cloners) { + if (($cloner ne '*') && ($cloner !~ /^\*\:$match_domain$/) && + ($cloner !~ /^$match_username\:$match_domain$/) && ($cloner ne '')) { + my (%codedefaults,@code_order); + if (ref($gotcodedefaults{$args->{'clonedomain'}}) eq 'HASH') { + if (ref($gotcodedefaults{$args->{'clonedomain'}}{'defaults'}) eq 'HASH') { + %codedefaults = %{$gotcodedefaults{$args->{'clonedomain'}}{'defaults'}}; + } + if (ref($gotcodedefaults{$args->{'clonedomain'}}{'order'}) eq 'ARRAY') { + @code_order = @{$gotcodedefaults{$args->{'clonedomain'}}{'order'}}; + } + } else { + &Apache::lonnet::auto_instcode_defaults($args->{'clonedomain'}, + \%codedefaults, + \@code_order); + $gotcodedefaults{$args->{'clonedomain'}}{'defaults'} = \%codedefaults; + $gotcodedefaults{$args->{'clonedomain'}}{'order'} = \@code_order; + } + if (@code_order > 0) { + if (&Apache::lonnet::check_instcode_cloning(\%codedefaults,\@code_order, + $cloner,$clonehash{'internal.coursecode'}, + $args->{'crscode'})) { + $can_clone = 1; + last; + } + } + } + } + } + } + } + unless ($can_clone) { my $ccrole = 'cc'; if ($args->{'crstype'} eq 'Community') { $ccrole = 'co'; } my %roleshash = &Apache::lonnet::get_my_roles($args->{'ccuname'}, - $args->{'ccdomain'}, - 'userroles',['active'],[$ccrole], - [$args->{'clonedomain'}]); - if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) { + $args->{'ccdomain'}, + 'userroles',['active'],[$ccrole], + [$args->{'clonedomain'}]); + if ($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) { $can_clone = 1; - } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},$args->{'ccuname'},$args->{'ccdomain'})) { + } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'}, + $args->{'ccuname'},$args->{'ccdomain'})) { $can_clone = 1; + } + } + unless ($can_clone) { + if ($args->{'crstype'} eq 'Community') { + 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 { - if ($args->{'crstype'} eq 'Community') { - $clonemsg = &mt('No new community created.').$linefeed.&mt('The new community could not be cloned from the existing community because the new community owner ([_1]) does not have cloning rights in the existing community ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}); - } else { - $clonemsg = &mt('No new course created.').$linefeed.&mt('The new course could not be cloned from the existing course because the new course owner ([_1]) does not have cloning rights in the existing course ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}); - } - } + 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; + my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context, + $cnum,$category,$coderef,$callercontext,$user_lh) = @_; + my ($outcome,$msgref,$clonemsgref); my $linefeed = '
    '."\n"; if ($context eq 'auto') { $linefeed = "\n"; @@ -13928,25 +16112,23 @@ 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); } } # # Open course # - my $crstype = lc($args->{'crstype'}); + my $showncrstype; + if ($args->{'crstype'} eq 'Placement') { + $showncrstype = 'placement test'; + } else { + $showncrstype = lc($args->{'crstype'}); + } my %cenv=(); $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'}, $args->{'cdescr'}, @@ -13957,15 +16139,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]',$crstype,$$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); } # @@ -13974,23 +16161,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]',$crstype,$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 @@ -14066,7 +16267,7 @@ sub construct_course { my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'}); $cenv{'internal.sectionnums'} .= $item.','; unless ($addcheck eq 'ok') { - push @badclasses, $class; + push(@badclasses,$class); } } $cenv{'internal.sectionnums'} =~ s/,$//; @@ -14094,7 +16295,7 @@ sub construct_course { my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'}); $cenv{'internal.crosslistings'} .= $item.','; unless ($addcheck eq 'ok') { - push @badclasses, $xl; + push(@badclasses,$xl); } } $cenv{'internal.crosslistings'} =~ s/,$//; @@ -14129,27 +16330,28 @@ sub construct_course { } if (@badclasses > 0) { my %lt=&Apache::lonlocal::texthash( - 'tclb' => 'The courses listed below were included as sections or crosslistings affiliated with your new LON-CAPA course. However, if automated course roster updates are enabled for this class, these particular sections/crosslistings will not contribute towards enrollment, because the user identified as the course owner for this LON-CAPA course', - 'dnhr' => 'does not have rights to access enrollment in these classes', - 'adby' => 'as determined by the policies of your institution on access to official classlists' + 'tclb' => 'The courses listed below were included as sections or crosslistings affiliated with your new LON-CAPA course.', + 'howi' => 'However, if automated course roster updates are enabled for this class, these particular sections/crosslistings are not guaranteed to contribute towards enrollment.', + 'itis' => 'It is possible that rights to access enrollment for these classes will be available through assignment of co-owners.', ); - my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}. - ' ('.$lt{'adby'}.')'; + my $badclass_msg = $lt{'tclb'}.$linefeed.$lt{'howi'}.$linefeed. + &mt('That is because the user identified as the course owner ([_1]) does not have rights to access enrollment in these classes, as determined by the policies of your institution on access to official classlists',$cenv{'internal.courseowner'}).$linefeed.$lt{'itis'}; if ($context eq 'auto') { $outcome .= $badclass_msg.$linefeed; + } else { $outcome .= '
    '.$badclass_msg.$linefeed.'

    \n"; + $outcome .= "
  • $item
    • \n"; } + } + if ($context eq 'auto') { + $outcome .= $linefeed; + } else { + $outcome .= "

    \n"; } } if ($args->{'no_end_date'}) { @@ -14182,6 +16384,9 @@ sub construct_course { if ($args->{'setcontent'}) { $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'}; } + if ($args->{'setcomment'}) { + $cenv{'comment.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'}; + } } if ($args->{'reshome'}) { $cenv{'reshome'}=$args->{'reshome'}.'/'; @@ -14216,7 +16421,7 @@ sub construct_course { if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') { $crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code; my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime'); - } + } if (ref($coderef)) { $$coderef = $code; } @@ -14253,12 +16458,17 @@ sub construct_course { # Open all assignments # if ($args->{'openall'}) { + my $opendate = time; + if ($args->{'openallfrom'} =~ /^\d+$/) { + $opendate = $args->{'openallfrom'}; + } my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate'; - my %storecontent = ($storeunder => time, + my %storecontent = ($storeunder => $opendate, $storeunder.'.type' => 'date_start'); - - $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput - ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed; + $outcome .= &mt('All assignments open starting [_1]', + &Apache::lonlocal::locallocaltime($opendate)).': '. + &Apache::lonnet::cput + ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed; } # # Set first page @@ -14288,7 +16498,31 @@ sub construct_course { $outcome .= ($fatal?$errtext:'write ok').$linefeed; } - return (1,$outcome); +# +# Set params for Placement Tests +# + if ($args->{'crstype'} eq 'Placement') { + my %storecontent; + my $prefix=$$crsudom.'_'.$$crsunum.'.0.'; + my %defaults = ( + buttonshide => { value => 'yes', + type => 'string_yesno',}, + type => { value => 'randomizetry', + type => 'string_questiontype',}, + maxtries => { value => 1, + type => 'int_pos',}, + problemstatus => { value => 'no', + type => 'string_problemstatus',}, + ); + foreach my $key (keys(%defaults)) { + $storecontent{$prefix.$key} = $defaults{$key}{'value'}; + $storecontent{$prefix.$key.'.type'} = $defaults{$key}{'type'}; + } + &Apache::lonnet::cput + ('resourcedata',\%storecontent,$$crsudom,$$crsunum); + } + + return (1,$outcome,\@clonemsg); } sub make_unique_code { @@ -14301,7 +16535,7 @@ sub make_unique_code { my $tries = 0; my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom); my ($code,$error); - + while (($gotlock ne 'ok') && ($tries<3)) { $tries ++; sleep 1; @@ -14348,8 +16582,7 @@ sub generate_code { ############################################################ ############################################################ -#SD -# only Community and Course, or anything else? +# Community, Course and Placement Test sub course_type { my ($cid) = @_; if (!defined($cid)) { @@ -14367,17 +16600,20 @@ sub group_term { my %names = ( 'Course' => 'group', 'Community' => 'group', + 'Placement' => 'group', ); return $names{$crstype}; } sub course_types { - my @types = ('official','unofficial','community','textbook'); + my @types = ('official','unofficial','community','textbook','placement','lti'); my %typename = ( official => 'Official course', unofficial => 'Unofficial course', community => 'Community', textbook => 'Textbook course', + placement => 'Placement test', + lti => 'LTI provider', ); return (\@types,\%typename); } @@ -14438,7 +16674,7 @@ sub escape_url { my ($url) = @_; my @urlslices = split(/\//, $url,-1); my $lastitem = &escape(pop(@urlslices)); - return join('/',@urlslices).'/'.$lastitem; + return &HTML::Entities::encode(join('/',@urlslices),"'").'/'.$lastitem; } sub compare_arrays { @@ -14457,6 +16693,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) = @_; @@ -14464,8 +16718,6 @@ sub init_user_environment { my $public=($username eq 'public' && $domain eq 'public'); -# See if old ID present, if so, remove - my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv); my $now=time; @@ -14487,15 +16739,43 @@ sub init_user_environment { } if (!$cookie) { $cookie="publicuser_$oldest"; } } else { - # if this isn't a robot, kill any existing non-robot sessions + # See if old ID present, if so, remove if this isn't a robot, + # killing any existing non-robot sessions if (!$args->{'robot'}) { opendir(DIR,$lonids); while ($filename=readdir(DIR)) { if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) { - unlink($lonids.'/'.$filename); + if (tie(my %oldenv,'GDBM_File',"$lonids/$filename", + &GDBM_READER(),0640)) { + my $linkedfile; + if (exists($oldenv{'user.linkedenv'})) { + $linkedfile = $oldenv{'user.linkedenv'}; + } + untie(%oldenv); + if (unlink("$lonids/$filename")) { + if ($linkedfile =~ /^[a-f0-9]+_linked$/) { + if (-l "$lonids/$linkedfile.id") { + unlink("$lonids/$linkedfile.id"); + } + } + } + } else { + unlink($lonids.'/'.$filename); + } } } closedir(DIR); +# If there is a undeleted lockfile for the user's paste buffer remove it. + my $namespace = 'nohist_courseeditor'; + my $lockingkey = 'paste'."\0".'locked_num'; + my %lockhash = &Apache::lonnet::get($namespace,[$lockingkey], + $domain,$username); + if (exists($lockhash{$lockingkey})) { + my $delresult = &Apache::lonnet::del($namespace,[$lockingkey],$domain,$username); + unless ($delresult eq 'ok') { + &Apache::lonnet::logthis("Failed to delete paste buffer locking key in $namespace for ".$username.":".$domain." Result was: $delresult"); + } + } } # Give them a new cookie my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'} @@ -14509,15 +16789,14 @@ sub init_user_environment { } # ------------------------------------ Check browser type and MathML capability - my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml, - $clientunicode,$clientos,$clientmobile,$clientinfo) = &decode_user_agent($r); + my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,$clientunicode, + $clientos,$clientmobile,$clientinfo,$clientosversion) = &decode_user_agent($r); # ------------------------------------------------------------- Get environment my %userenv = &Apache::lonnet::dump('environment',$domain,$username); my ($tmp) = keys(%userenv); - if ($tmp !~ /^(con_lost|error|no_such_host)/i) { - } else { + if ($tmp =~ /^(con_lost|error|no_such_host)/i) { undef(%userenv); } if (($userenv{'interface'}) && (!$form->{'interface'})) { @@ -14532,6 +16811,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, @@ -14543,13 +16823,14 @@ sub init_user_environment { "browser.os" => $clientos, "browser.mobile" => $clientmobile, "browser.info" => $clientinfo, + "browser.osversion" => $clientosversion, "server.domain" => $Apache::lonnet::perlvar{'lonDefDomain'}, "request.course.fn" => '', "request.course.uri" => '', "request.course.sec" => '', "request.role" => 'cm', "request.role.adv" => $env{'user.adv'}, - "request.host" => $ENV{'REMOTE_ADDR'},); + "request.host" => $ip,); if ($form->{'localpath'}) { $initial_env{"browser.localpath"} = $form->{'localpath'}; @@ -14568,39 +16849,75 @@ sub init_user_environment { $env{'user.noloadbalance'} = $lonhost; } - my %is_adv = ( is_adv => $env{'user.adv'} ); - my %domdef; - unless ($domain eq 'public') { - %domdef = &Apache::lonnet::get_domain_defaults($domain); + if ($form->{'noloadbalance'}) { + my @hosts = &Apache::lonnet::current_machine_ids(); + my $hosthere = $form->{'noloadbalance'}; + if (grep(/^\Q$hosthere\E$/,@hosts)) { + $initial_env{"user.noloadbalance"} = $hosthere; + $env{'user.noloadbalance'} = $hosthere; + } } - foreach my $tool ('aboutme','blog','webdav','portfolio') { - $userenv{'availabletools.'.$tool} = - &Apache::lonnet::usertools_access($username,$domain,$tool,'reload', - undef,\%userenv,\%domdef,\%is_adv); - } + unless ($domain eq 'public') { + my %is_adv = ( is_adv => $env{'user.adv'} ); + my %domdef = &Apache::lonnet::get_domain_defaults($domain); - foreach my $crstype ('official','unofficial','community','textbook') { - $userenv{'canrequest.'.$crstype} = - &Apache::lonnet::usertools_access($username,$domain,$crstype, - 'reload','requestcourses', - \%userenv,\%domdef,\%is_adv); - } + foreach my $tool ('aboutme','blog','webdav','portfolio') { + $userenv{'availabletools.'.$tool} = + &Apache::lonnet::usertools_access($username,$domain,$tool,'reload', + undef,\%userenv,\%domdef,\%is_adv); + } - $userenv{'canrequest.author'} = - &Apache::lonnet::usertools_access($username,$domain,'requestauthor', - 'reload','requestauthor', - \%userenv,\%domdef,\%is_adv); - my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'], - $domain,$username); - my $reqstatus = $reqauthor{'author_status'}; - if ($reqstatus eq 'approval' || $reqstatus eq 'approved') { - if (ref($reqauthor{'author'}) eq 'HASH') { - $userenv{'requestauthorqueued'} = $reqstatus.':'. - $reqauthor{'author'}{'timestamp'}; + foreach my $crstype ('official','unofficial','community','textbook','placement','lti') { + $userenv{'canrequest.'.$crstype} = + &Apache::lonnet::usertools_access($username,$domain,$crstype, + 'reload','requestcourses', + \%userenv,\%domdef,\%is_adv); } - } + $userenv{'canrequest.author'} = + &Apache::lonnet::usertools_access($username,$domain,'requestauthor', + 'reload','requestauthor', + \%userenv,\%domdef,\%is_adv); + my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'], + $domain,$username); + my $reqstatus = $reqauthor{'author_status'}; + if ($reqstatus eq 'approval' || $reqstatus eq 'approved') { + if (ref($reqauthor{'author'}) eq 'HASH') { + $userenv{'requestauthorqueued'} = $reqstatus.':'. + $reqauthor{'author'}{'timestamp'}; + } + } + my ($types,$typename) = &course_types(); + if (ref($types) eq 'ARRAY') { + my @options = ('approval','validate','autolimit'); + my $optregex = join('|',@options); + my (%willtrust,%trustchecked); + foreach my $type (@{$types}) { + my $dom_str = $env{'environment.reqcrsotherdom.'.$type}; + if ($dom_str ne '') { + my $updatedstr = ''; + my @possdomains = split(',',$dom_str); + foreach my $entry (@possdomains) { + my ($extdom,$extopt) = split(':',$entry); + unless ($trustchecked{$extdom}) { + $willtrust{$extdom} = &Apache::lonnet::will_trust('reqcrs',$domain,$extdom); + $trustchecked{$extdom} = 1; + } + if ($willtrust{$extdom}) { + $updatedstr .= $entry.','; + } + } + $updatedstr =~ s/,$//; + if ($updatedstr) { + $userenv{'reqcrsotherdom.'.$type} = $updatedstr; + } else { + delete($userenv{'reqcrsotherdom.'.$type}); + } + } + } + } + } $env{'user.environment'} = "$lonids/$cookie.id"; if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id", @@ -14704,12 +17021,12 @@ and quotacheck.pl Inputs: -filterlist - anonymous array of fields to include as potential filters +filterlist - anonymous array of fields to include as potential filters crstype - course type roleelement - fifth arg in selectcourse_link() populates fifth arg in javascript: opencrsbrowser() function, used - to pop-open a course selector (will contain "extra element"). + to pop-open a course selector (will contain "extra element"). multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1 @@ -14725,19 +17042,19 @@ cloneruname - username of owner of new c clonerudom - domain of owner of new course who wants to clone -typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community) +typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community) codetitlesref - reference to array of titles of components in institutional codes (official courses) codedom - domain -formname - value of form element named "form". +formname - value of form element named "form". fixeddom - domain, if fixed. -prevphase - value to assign to form element named "phase" when going back to the previous screen +prevphase - value to assign to form element named "phase" when going back to the previous screen -cnameelement - name of form element in form on opener page which will receive title of selected course +cnameelement - name of form element in form on opener page which will receive title of selected course cnumelement - name of form element in form on opener page which will receive courseID of selected course @@ -14828,15 +17145,19 @@ sub build_filters { $createdfilterform = &timebased_select_form('createdfilter',$filter); } + my $prefix = $crstype; + if ($crstype eq 'Placement') { + $prefix = 'Placement Test' + } my %lt = &Apache::lonlocal::texthash( - 'cac' => "$crstype Activity", - 'ccr' => "$crstype Created", - 'cde' => "$crstype Title", - 'cdo' => "$crstype Domain", + 'cac' => "$prefix Activity", + 'ccr' => "$prefix Created", + 'cde' => "$prefix Title", + 'cdo' => "$prefix Domain", 'ins' => 'Institutional Code', 'inc' => 'Institutional Categorization', - 'cow' => "$crstype Owner/Co-owner", - 'cop' => "$crstype Personnel Includes", + 'cow' => "$prefix Owner/Co-owner", + 'cop' => "$prefix Personnel Includes", 'cog' => 'Type', ); @@ -14844,6 +17165,8 @@ sub build_filters { my $typeval = 'Course'; if ($crstype eq 'Community') { $typeval = 'Community'; + } elsif ($crstype eq 'Placement') { + $typeval = 'Placement'; } $typeselectform = ''; } else { @@ -14852,9 +17175,15 @@ sub build_filters { $typeselectform .= ' onchange="'.$onchange.'"'; } $typeselectform .= '>'."\n"; - foreach my $posstype ('Course','Community') { + foreach my $posstype ('Course','Community','Placement') { + my $shown; + if ($posstype eq 'Placement') { + $shown = &mt('Placement Test'); + } else { + $shown = &mt($posstype); + } $typeselectform.='\n"; + ($posstype eq $crstype ? ' selected="selected" ' : ''). ">".$shown."\n"; } $typeselectform.=""; } @@ -14869,7 +17198,7 @@ sub build_filters { } $cloneableonlyform = ''.(' 'x3).''; if ($formname eq 'ccrs') { - $cloneabletitle = &mt('Cloneable for').' '.$cloneruname.':'.$clonerudom; + $cloneabletitle = &mt('Cloneable for [_1]',$cloneruname.':'.$clonerudom); } else { $cloneabletitle = &mt('Cloneable by you'); } @@ -14879,7 +17208,7 @@ sub build_filters { if (exists($filter->{'instcodefilter'})) { # if (($fixeddom) || ($formname eq 'requestcrs') || # ($formname eq 'modifycourse') || ($formname eq 'filterpicker')) { - if ($codedom) { + if ($codedom) { $officialjs = 1; ($instcodeform,$jscript,$$numtitlesref) = &Apache::courseclassifier::instcode_selectors($codedom,'filterpicker', @@ -14913,7 +17242,12 @@ sub build_filters { $output .= ''."\n". ''."\n"; - } elsif ($formname ne 'quotacheck') { + } elsif ($formname eq 'quotacheck') { + $output .= qq| + + +|; + } else { my $name_input; if ($cnameelement ne '') { $name_input = '{'ownerfilter'} ne '') || ($filter->{'ownerdomfilter'} ne '')) { @@ -15169,10 +17511,10 @@ sub search_courses { $filter->{'combownerfilter'}, $filter->{'coursefilter'}, undef,undef,$type,$regexpok,undef,undef, - undef,undef,$cloner,$env{'form.cc_clone'}, + undef,undef,$cloner,$cc_clone, $filter->{'cloneableonly'}, $createdbefore,$createdafter,undef, - $domcloner); + $domcloner,undef,$reqcrsdom,$reqinstcode); if (($filter->{'personfilter'} ne '') && ($filter->{'persondomfilter'} ne '')) { my $ccrole; if ($type eq 'Community') { @@ -15192,7 +17534,7 @@ sub search_courses { if (ref($courses{$cid}) eq 'HASH') { if (ref($courses{$cid}{roles}) eq 'ARRAY') { if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) { - push (@{$courses{$cid}{roles}},$courserole); + push(@{$courses{$cid}{roles}},$courserole); } } else { $courses{$cid}{roles} = [$courserole]; @@ -15206,61 +17548,244 @@ sub search_courses { return %courses; } - =pod =back +=head1 Routines for version requirements for current course. + +=over 4 + +=item * &check_release_required() + +Compares required LON-CAPA version with version on server, and +if required version is newer looks for a server with the required version. + +Looks first at servers in user's owen domain; if none suitable, looks at +servers in course's domain are permitted to host sessions for user's domain. + +Inputs: + +$loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp) + +$courseid - Course ID of current course + +$rolecode - User's current role in course (for switchserver query string). + +$required - LON-CAPA version needed by course (format: Major.Minor). + + +Returns: + +$switchserver - query string tp append to /adm/switchserver call (if + current server's LON-CAPA version is too old. + +$warning - Message is displayed if no suitable server could be found. + =cut +sub check_release_required { + my ($loncaparev,$courseid,$rolecode,$required) = @_; + my ($switchserver,$warning); + if ($required ne '') { + my ($reqdmajor,$reqdminor) = ($required =~ /^(\d+)\.(\d+)$/); + my ($major,$minor) = ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/); + if ($reqdmajor ne '' && $reqdminor ne '') { + my $otherserver; + if (($major eq '' && $minor eq '') || + (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)))) { + my ($userdomserver) = &Apache::lonnet::choose_server($env{'user.domain'},undef,$required,1); + my $switchlcrev = + &Apache::lonnet::get_server_loncaparev($env{'user.domain'}, + $userdomserver); + my ($swmajor,$swminor) = ($switchlcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/); + if (($swmajor eq '' && $swminor eq '') || ($reqdmajor > $swmajor) || + (($reqdmajor == $swmajor) && ($reqdminor > $swminor))) { + my $cdom = $env{'course.'.$courseid.'.domain'}; + if ($cdom ne $env{'user.domain'}) { + my ($coursedomserver,$coursehostname) = &Apache::lonnet::choose_server($cdom,undef,$required,1); + my $serverhomeID = &Apache::lonnet::get_server_homeID($coursehostname); + my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID); + my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom); + my %udomdefaults = &Apache::lonnet::get_domain_defaults($env{'user.domain'}); + my $remoterev = &Apache::lonnet::get_server_loncaparev($serverhomedom,$coursedomserver); + my $canhost = + &Apache::lonnet::can_host_session($env{'user.domain'}, + $coursedomserver, + $remoterev, + $udomdefaults{'remotesessions'}, + $defdomdefaults{'hostedsessions'}); -sub build_release_hashes { - my ($checkparms,$checkresponsetypes,$checkcrstypes,$anonsurvey,$randomizetry) = @_; - return unless((ref($checkparms) eq 'HASH') && (ref($checkresponsetypes) eq 'HASH') && - (ref($checkcrstypes) eq 'HASH') && (ref($anonsurvey) eq 'HASH') && - (ref($randomizetry) eq 'HASH')); - foreach my $key (keys(%Apache::lonnet::needsrelease)) { - my ($item,$name,$value) = split(/:/,$key); - if ($item eq 'parameter') { - if (ref($checkparms->{$name}) eq 'ARRAY') { - unless(grep(/^\Q$name\E$/,@{$checkparms->{$name}})) { - push(@{$checkparms->{$name}},$value); + if ($canhost) { + $otherserver = $coursedomserver; + } else { + $warning = &mt('Requires LON-CAPA version [_1].',$env{'course.'.$courseid.'.internal.releaserequired'}).'
    '. &mt("No suitable server could be found amongst servers in either your own domain or in the course's domain."); + } + } else { + $warning = &mt('Requires LON-CAPA version [_1].',$env{'course.'.$courseid.'.internal.releaserequired'}).'
    '.&mt("No suitable server could be found amongst servers in your own domain (which is also the course's domain)."); + } + } else { + $otherserver = $userdomserver; } - } else { - push(@{$checkparms->{$name}},$value); } - } elsif ($item eq 'resourcetag') { - if ($name eq 'responsetype') { - $checkresponsetypes->{$value} = $Apache::lonnet::needsrelease{$key} + if ($otherserver ne '') { + $switchserver = 'otherserver='.$otherserver.'&role='.$rolecode; } - } elsif ($item eq 'course') { - if ($name eq 'crstype') { - $checkcrstypes->{$value} = $Apache::lonnet::needsrelease{$key}; + } + } + return ($switchserver,$warning); +} + +=pod + +=item * &check_release_result() + +Inputs: + +$switchwarning - Warning message if no suitable server found to host session. + +$switchserver - query string to append to /adm/switchserver containing lonHostID + and current role. + +Returns: HTML to display with information about requirement to switch server. + Either displaying warning with link to Roles/Courses screen or + display link to switchserver. + +=cut + +sub check_release_result { + my ($switchwarning,$switchserver) = @_; + my $output = &start_page('Selected course unavailable on this server'). + '

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

    '.&end_page(); + return $output; +} + +=pod + +=item * &needs_coursereinit() + +Determine if course contents stored for user's session needs to be +refreshed, because content has changed since "Big Hash" last tied. + +Check for change is made if time last checked is more than 10 minutes ago +(by default). + +Inputs: + +$loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp) + +$interval (optional) - Time which may elapse (in s) between last check for content + change in current course. (default: 600 s). + +Returns: an array; first element is: + +=over 4 + +'switch' - if content updates mean user's session + needs to be switched to a server running a newer LON-CAPA version + +'update' - if course session needs to be refreshed (i.e., Big Hash needs to be reloaded) + on current server hosting user's session + +'' - if no action required. + +=back + +If first item element is 'switch': + +second item is $switchwarning - Warning message if no suitable server found to host session. + +third item is $switchserver - query string to append to /adm/switchserver containing lonHostID + and current role. + +otherwise: no other elements returned. + +=back + +=cut + +sub needs_coursereinit { + my ($loncaparev,$interval) = @_; + return() unless ($env{'request.course.id'} && $env{'request.course.tied'}); + my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; + my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; + my $now = time; + if ($interval eq '') { + $interval = 600; + } + if (($now-$env{'request.course.timechecked'})>$interval) { + &Apache::lonnet::appenv({'request.course.timechecked'=>$now}); + my $blocked = &blocking_status('reinit',$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); + } + } } + return ('update'); } } - ($anonsurvey->{major},$anonsurvey->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:anonsurvey'}); - ($randomizetry->{major},$randomizetry->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:randomizetry'}); - return; + return (); } sub update_content_constraints { - my ($cdom,$cnum,$chome,$cid) = @_; + my ($cdom,$cnum,$chome,$cid,$keeporder) = @_; my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired'); my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'}); - my %checkresponsetypes; + my (%checkresponsetypes,%checkcrsrestypes); foreach my $key (keys(%Apache::lonnet::needsrelease)) { my ($item,$name,$value) = split(/:/,$key); if ($item eq 'resourcetag') { if ($name eq 'responsetype') { $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key} } + } elsif ($item eq 'course') { + if ($name eq 'courserestype') { + $checkcrsrestypes{$value} = $Apache::lonnet::needsrelease{$key}; + } } } my $navmap = Apache::lonnavmaps::navmap->new(); if (defined($navmap)) { - my %allresponses; - foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) { + my (%allresponses,%allcrsrestypes); + foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() || $_[0]->is_tool() },1,0)) { + if ($res->is_tool()) { + if ($allcrsrestypes{'exttool'}) { + $allcrsrestypes{'exttool'} ++; + } else { + $allcrsrestypes{'exttool'} = 1; + } + next; + } my %responses = $res->responseTypes(); foreach my $key (keys(%responses)) { next unless(exists($checkresponsetypes{$key})); @@ -15273,8 +17798,38 @@ sub update_content_constraints { ($reqdmajor,$reqdminor) = ($major,$minor); } } + foreach my $key (keys(%allcrsrestypes)) { + my ($major,$minor) = split(/\./,$checkcrsrestypes{$key}); + if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) { + ($reqdmajor,$reqdminor) = ($major,$minor); + } + } undef($navmap); } + my (@resources,@order,@resparms,@zombies); + if ($keeporder) { + use LONCAPA::map; + @resources = @LONCAPA::map::resources; + @order = @LONCAPA::map::order; + @resparms = @LONCAPA::map::resparms; + @zombies = @LONCAPA::map::zombies; + } + my $suppmap = 'supplemental.sequence'; + my ($suppcount,$supptools,$errors) = (0,0,0); + ($suppcount,$supptools,$errors) = &recurse_supplemental($cnum,$cdom,$suppmap, + $suppcount,$supptools,$errors); + if ($keeporder) { + @LONCAPA::map::resources = @resources; + @LONCAPA::map::order = @order; + @LONCAPA::map::resparms = @resparms; + @LONCAPA::map::zombies = @zombies; + } + if ($supptools) { + my ($major,$minor) = split(/\./,$checkcrsrestypes{'exttool'}); + if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) { + ($reqdmajor,$reqdminor) = ($major,$minor); + } + } unless (($reqdmajor eq '') && ($reqdminor eq '')) { &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid); } @@ -15295,7 +17850,7 @@ sub allmaps_incourse { if ($lastchange > $env{'request.course.tied'}) { my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum"); unless ($ferr) { - &update_content_constraints($cdom,$cnum,$chome,$cid); + &update_content_constraints($cdom,$cnum,$chome,$cid,1); } } my $navmap = Apache::lonnavmaps::navmap->new(); @@ -15331,7 +17886,7 @@ sub parse_supplemental_title { } sub recurse_supplemental { - my ($cnum,$cdom,$suppmap,$numfiles,$errors) = @_; + my ($cnum,$cdom,$suppmap,$numfiles,$numexttools,$errors) = @_; if ($suppmap) { my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap); if ($fatal) { @@ -15342,8 +17897,12 @@ sub recurse_supplemental { my ($title,$src,$ext,$type,$status)=split(/\:/,$res); if (($src ne '') && ($status eq 'res')) { if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) { - ($numfiles,$errors) = &recurse_supplemental($cnum,$cdom,$1,$numfiles,$errors); + ($numfiles,$numexttools,$errors) = &recurse_supplemental($cnum,$cdom,$1, + $numfiles,$numexttools,$errors); } else { + if ($src =~ m{^/adm/$cdom/$cnum/\d+/ext\.tool$}) { + $numexttools ++; + } $numfiles ++; } } @@ -15351,12 +17910,12 @@ sub recurse_supplemental { } } } - return ($numfiles,$errors); + return ($numfiles,$numexttools,$errors); } sub symb_to_docspath { - my ($symb) = @_; - return unless ($symb); + my ($symb,$navmapref) = @_; + return unless ($symb && ref($navmapref)); my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb); if ($resurl=~/\.(sequence|page)$/) { $mapurl=$resurl; @@ -15364,9 +17923,11 @@ sub symb_to_docspath { $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'}; } my $mapresobj; - my $navmap = Apache::lonnavmaps::navmap->new(); - if (ref($navmap)) { - $mapresobj = $navmap->getResourceByUrl($mapurl); + unless (ref($$navmapref)) { + $$navmapref = Apache::lonnavmaps::navmap->new(); + } + if (ref($$navmapref)) { + $mapresobj = $$navmapref->getResourceByUrl($mapurl); } $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1}; my $type=$2; @@ -15376,7 +17937,7 @@ sub symb_to_docspath { if ($pcslist ne '') { foreach my $pc (split(/,/,$pcslist)) { next if ($pc <= 1); - my $res = $navmap->getByMapPc($pc); + my $res = $$navmapref->getByMapPc($pc); if (ref($res)) { my $thisurl = $res->src(); $thisurl=~s{^.*/([^/]+)\.\w+$}{$1}; @@ -15423,31 +17984,32 @@ sub symb_to_docspath { } sub captcha_display { - my ($context,$lonhost) = @_; + my ($context,$lonhost,$defdom) = @_; my ($output,$error); - my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost); + my ($captcha,$pubkey,$privkey,$version) = + &get_captcha_config($context,$lonhost,$defdom); if ($captcha eq 'original') { $output = &create_captcha(); unless ($output) { $error = 'captcha'; } } elsif ($captcha eq 'recaptcha') { - $output = &create_recaptcha($pubkey); + $output = &create_recaptcha($pubkey,$version); unless ($output) { $error = 'recaptcha'; } } - return ($output,$error,$captcha); + return ($output,$error,$captcha,$version); } sub captcha_response { - my ($context,$lonhost) = @_; + my ($context,$lonhost,$defdom) = @_; my ($captcha_chk,$captcha_error); - my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost); + my ($captcha,$pubkey,$privkey,$version) = &get_captcha_config($context,$lonhost,$defdom); if ($captcha eq 'original') { ($captcha_chk,$captcha_error) = &check_captcha(); } elsif ($captcha eq 'recaptcha') { - $captcha_chk = &check_recaptcha($privkey); + $captcha_chk = &check_recaptcha($privkey,$version); } else { $captcha_chk = 1; } @@ -15455,8 +18017,8 @@ sub captcha_response { } sub get_captcha_config { - my ($context,$lonhost) = @_; - my ($captcha,$pubkey,$privkey,$hashtocheck); + my ($context,$lonhost,$dom_in_effect) = @_; + my ($captcha,$pubkey,$privkey,$version,$hashtocheck); my $hostname = &Apache::lonnet::hostname($lonhost); my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname); my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID); @@ -15472,6 +18034,10 @@ sub get_captcha_config { } if ($privkey && $pubkey) { $captcha = 'recaptcha'; + $version = $hashtocheck->{'recaptchaversion'}; + if ($version ne '2') { + $version = 1; + } } else { $captcha = 'original'; } @@ -15489,14 +18055,39 @@ sub get_captcha_config { $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'}; if ($privkey && $pubkey) { $captcha = 'recaptcha'; + $version = $domconfhash{$serverhomedom.'.login.recaptchaversion'}; + if ($version ne '2') { + $version = 1; + } } else { $captcha = 'original'; } } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') { $captcha = 'original'; } - } - return ($captcha,$pubkey,$privkey); + } 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); } sub create_captcha { @@ -15519,6 +18110,9 @@ sub create_captcha { last; } } + if ($output eq '') { + &Apache::lonnet::logthis("Failed to create Captcha code after $tries attempts."); + } return $output; } @@ -15555,38 +18149,67 @@ sub check_captcha { } sub create_recaptcha { - my ($pubkey) = @_; - my $use_ssl; - if ($ENV{'SERVER_PORT'} == 443) { - $use_ssl = 1; - } - my $captcha = Captcha::reCAPTCHA->new; - return $captcha->get_options_setter({theme => 'white'})."\n". - $captcha->get_html($pubkey,undef,$use_ssl). - &mt('If either word is hard to read, [_1] will replace them.', - 'reCAPTCHA refresh'). - '

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

    '; + } } sub check_recaptcha { - my ($privkey) = @_; + my ($privkey,$version) = @_; my $captcha_chk; - my $captcha = Captcha::reCAPTCHA->new; - my $captcha_result = - $captcha->check_answer( - $privkey, - $ENV{'REMOTE_ADDR'}, - $env{'form.recaptcha_challenge_field'}, - $env{'form.recaptcha_response_field'}, - ); - if ($captcha_result->{is_valid}) { - $captcha_chk = 1; + my $ip = &Apache::lonnet::get_requestor_ip(); + if ($version >= 2) { + my %info = ( + secret => $privkey, + response => $env{'form.g-recaptcha-response'}, + remoteip => $ip, + ); + my $request=new HTTP::Request('POST','https://www.google.com/recaptcha/api/siteverify'); + $request->content(join('&',map { + my $name = escape($_); + "$name=" . ( ref($info{$_}) eq 'ARRAY' + ? join("&$name=", map {escape($_) } @{$info{$_}}) + : &escape($info{$_}) ); + } keys(%info))); + my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',10,1); + if ($response->is_success) { + my $data = JSON::DWIW->from_json($response->decoded_content); + if (ref($data) eq 'HASH') { + if ($data->{'success'}) { + $captcha_chk = 1; + } + } + } + } else { + my $captcha = Captcha::reCAPTCHA->new; + my $captcha_result = + $captcha->check_answer( + $privkey, + $ip, + $env{'form.recaptcha_challenge_field'}, + $env{'form.recaptcha_response_field'}, + ); + if ($captcha_result->{is_valid}) { + $captcha_chk = 1; + } } return $captcha_chk; } sub emailusername_info { - my @fields = ('firstname','lastname','institution','web','location','officialemail'); + my @fields = ('firstname','lastname','institution','web','location','officialemail','id'); my %titles = &Apache::lonlocal::texthash ( lastname => 'Last Name', firstname => 'First Name', @@ -15594,6 +18217,7 @@ sub emailusername_info { location => "School's city, state/province, country", web => "School's web address", officialemail => 'E-mail address at institution (if different)', + id => 'Student/Employee ID', ); return (\@fields,\%titles); } @@ -15620,6 +18244,42 @@ sub cleanup_html { return $outgoing; } +# Checks for critical messages and returns a redirect url if one exists. +# $interval indicates how often to check for messages. +# $context is the calling context -- roles, grades, contents, menu or flip. +sub critical_redirect { + my ($interval,$context) = @_; + 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); + if ($blocked) { + my $checkrole = "cm./$cdom/$cnum"; + if ($env{'request.course.sec'} ne '') { + $checkrole .= "/$env{'request.course.sec'}"; + } + unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) && + ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) { + return; + } + } + } + my @what=&Apache::lonnet::dump('critical', $env{'user.domain'}, + $env{'user.name'}); + &Apache::lonnet::appenv({'user.criticalcheck.time'=>time}); + my $redirecturl; + if ($what[0]) { + if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) { + $redirecturl='/adm/email?critical=display'; + my $url=&Apache::lonnet::absolute_url().$redirecturl; + return (1, $url); + } + } + } + return (); +} + # Use: # my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver); # @@ -15654,14 +18314,324 @@ sub des_decrypt { } else { $cypher=new DES $keybin; } - my $plaintext= - $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,0,16)))); - $plaintext.= - $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,16,16)))); - $plaintext=substr($plaintext,1,ord(substr($plaintext,0,1)) ); + my $plaintext=''; + my $cypherlength = length($cyphertext); + my $numchunks = int($cypherlength/32); + for (my $j=0; $j<$numchunks; $j++) { + my $start = $j*32; + my $cypherblock = substr($cyphertext,$start,32); + my $chunk = + $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,0,16)))); + $chunk .= + $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,16,16)))); + $chunk=substr($chunk,1,ord(substr($chunk,0,1)) ); + $plaintext .= $chunk; + } return $plaintext; } +sub get_requested_shorturls { + my ($cdom,$cnum,$navmap) = @_; + return unless (ref($navmap)); + 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); + 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); + my $init = ''; + 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" => $lockuser, + }; + my $tries = 0; + my $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom); + my ($code,$error); + while (($gotlock ne 'ok') && ($tries<3)) { + $tries ++; + sleep 1; + $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom); + } + if ($gotlock eq 'ok') { + $init = &shorten_symbs($cdom,$init,$su,\%coursetiny,\%tocreate,\%newunique, + \%addcourse,\%courseonly,\%failed); + if (keys(%failed)) { + my $numfailed = scalar(keys(%failed)); + push(@errors,&mt('error: could not obtain unique six character URL for [quant,_1,resource]',$numfailed)); + } + if (keys(%newunique)) { + my $putres = &Apache::lonnet::newput_dom('tiny',\%newunique,$cdom); + if ($putres eq 'ok') { + $numnew = scalar(keys(%newunique)); + my $newputres = &Apache::lonnet::newput('tiny',\%addcourse,$cdom,$cnum); + unless ($newputres eq 'ok') { + push(@errors,&mt('error: could not store course look-up of short URLs')); + } + } else { + push(@errors,&mt('error: could not store unique six character URLs')); + } + } + my $dellockres = &Apache::lonnet::del_dom('tiny',["lock\0$now"],$cdom); + unless ($dellockres eq 'ok') { + push(@errors,&mt('error: could not release lockfile')); + } + } else { + push(@errors,&mt('error: could not obtain lockfile')); + } + if (keys(%courseonly)) { + my $result = &Apache::lonnet::newput('tiny',\%courseonly,$cdom,$cnum); + if ($result ne 'ok') { + push(@errors,&mt('error: could not update course look-up of short URLs')); + } + } + } + } + return ($numnew,\@errors); +} + +sub shorten_symbs { + my ($cdom,$init,$su,$coursetiny,$tocreate,$newunique,$addcourse,$courseonly,$failed) = @_; + return unless ((ref($su)) && (ref($coursetiny) eq 'HASH') && (ref($tocreate) eq 'HASH') && + (ref($newunique) eq 'HASH') && (ref($addcourse) eq 'HASH') && + (ref($courseonly) eq 'HASH') && (ref($failed) eq 'HASH')); + my (%possibles,%collisions); + foreach my $key (keys(%{$tocreate})) { + my $num = String::CRC32::crc32($key); + my $tiny = $su->encode($num,$init); + if ($tiny) { + $possibles{$tiny} = $key; + } + } + if (!$init) { + $init = 1; + } else { + $init ++; + } + if (keys(%possibles)) { + my @posstiny = keys(%possibles); + my $configuname = &Apache::lonnet::get_domainconfiguser($cdom); + my %currtiny = &Apache::lonnet::get('tiny',\@posstiny,$cdom,$configuname); + if (keys(%currtiny)) { + foreach my $key (keys(%currtiny)) { + next if ($currtiny{$key} eq ''); + if ($currtiny{$key} eq $possibles{$key}) { + my ($tcnum,$tsymb) = split(/\&/,$currtiny{$key}); + unless (($coursetiny->{$tsymb} eq $key) || ($addcourse->{$tsymb} eq $key) || ($courseonly->{$tsymb} eq $key)) { + $courseonly->{$tsymb} = $key; + } + } else { + $collisions{$possibles{$key}} = 1; + } + delete($possibles{$key}); + } + } + foreach my $key (keys(%possibles)) { + $newunique->{$key} = $possibles{$key}; + my ($tcnum,$tsymb) = split(/\&/,$possibles{$key}); + unless (($coursetiny->{$tsymb} eq $key) || ($addcourse->{$tsymb} eq $key) || ($courseonly->{$tsymb} eq $key)) { + $addcourse->{$tsymb} = $key; + } + } + } + if (keys(%collisions)) { + if ($init <5) { + if (!$init) { + $init = 1; + } else { + $init ++; + } + $init = &shorten_symbs($cdom,$init,$su,$coursetiny,\%collisions, + $newunique,$addcourse,$courseonly,$failed); + } else { + foreach my $key (keys(%collisions)) { + $failed->{$key} = 1; + } + } + } + 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; +} + 1; __END__;