--- loncom/interface/loncommon.pm 2022/01/16 23:25:47 1.1075.2.161.2.2 +++ loncom/interface/loncommon.pm 2017/10/13 20:37:35 1.1297 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.1075.2.161.2.2 2022/01/16 23:25:47 raeburn Exp $ +# $Id: loncommon.pm,v 1.1297 2017/10/13 20:37:35 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -71,20 +71,21 @@ use Apache::lonuserutils(); use Apache::lonuserstate(); use Apache::courseclassifier(); use LONCAPA qw(:DEFAULT :match); -use HTTP::Request; +use LONCAPA::LWPReq; use DateTime::TimeZone; use DateTime::Locale; use Encode(); +use Text::Aspell; use Authen::Captcha; use Captcha::reCAPTCHA; use JSON::DWIW; use LWP::UserAgent; use Crypt::DES; use DynaLoader; # for Crypt::DES version +use MIME::Lite; +use MIME::Types; use File::Copy(); -use File::Path(); -use String::CRC32(); -use Short::URL(); +use File::Path::Tiny(); # ---------------------------------------------- Designs use vars qw(%defaultdesign); @@ -169,6 +170,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; @@ -199,18 +201,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); @@ -220,7 +223,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); @@ -234,7 +237,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); @@ -248,7 +251,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); @@ -262,7 +265,7 @@ BEGIN { { my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}. '/filecategories.tab'; - if ( open (my $fh,'<',$categoryfile) ) { + if ( open (my $fh,"<$categoryfile") ) { while (my $line = <$fh>) { next if ($line =~ /^\#/); chomp($line); @@ -277,7 +280,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); @@ -430,7 +433,7 @@ sub studentbrowser_javascript { block @@ -1074,6 +1097,9 @@ linked_select_forms takes the following =item * $onchangesecond, additional javascript call to execute for an onchange event for the second \n"; + $result .= ""; } +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}}))) { + 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; + } + } + 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 @@ -2181,10 +2479,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))]; @@ -2261,7 +2573,7 @@ option_name => displayed text. An option a javascript onchange item, e.g., onchange="this.form.submit();". An optional arg -- $readonly -- if true will cause the select form to be disabled, e.g., for the case where an instructor has a section- -specific role, and is viewing/modifying parameters. +specific role, and is viewing/modifying parameters. See lonrights.pm for an example invocation and use. @@ -2464,7 +2776,7 @@ The optional $incdoms is a reference to 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. +The optional $disabled argument, if true, adds the disabled attribute to the select tag. =cut @@ -2485,7 +2797,7 @@ sub select_dom_form { } if ($includeempty) { @domains=('',@domains); } if (ref($excdoms) eq 'ARRAY') { - map { $exclude{$_} = 1; } @{$excdoms}; + map { $exclude{$_} = 1; } @{$excdoms}; } my $selectdomain = "'; $result = &mt ('[_1] Filesystem Authenticated (with initial password [_2])', - ''.$autharg); + ''); return $result; } @@ -3179,79 +3494,6 @@ sub get_assignable_auth { return ($authnum,%can_assign); } -sub check_passwd_rules { - my ($domain,$plainpass) = @_; - my %passwdconf = &Apache::lonnet::get_passwdconf($domain); - my ($min,$max,@chars,@brokerule,$warning); - $min = $Apache::lonnet::passwdmin; - if (ref($passwdconf{'chars'}) eq 'ARRAY') { - if ($passwdconf{'min'} =~ /^\d+$/) { - if ($passwdconf{'min'} > $min) { - $min = $passwdconf{'min'}; - } - } - if ($passwdconf{'max'} =~ /^\d+$/) { - $max = $passwdconf{'max'}; - } - @chars = @{$passwdconf{'chars'}}; - } - if (($min) && (length($plainpass) < $min)) { - push(@brokerule,'min'); - } - if (($max) && (length($plainpass) > $max)) { - push(@brokerule,'max'); - } - if (@chars) { - my %rules; - map { $rules{$_} = 1; } @chars; - if ($rules{'uc'}) { - unless ($plainpass =~ /[A-Z]/) { - push(@brokerule,'uc'); - } - } - if ($rules{'lc'}) { - unless ($plainpass =~ /[a-z]/) { - push(@brokerule,'lc'); - } - } - if ($rules{'num'}) { - unless ($plainpass =~ /\d/) { - push(@brokerule,'num'); - } - } - if ($rules{'spec'}) { - unless ($plainpass =~ /[!"#$%&'()*+,\-.\/:;<=>?@[\\\]^_`{|}~]/) { - push(@brokerule,'spec'); - } - } - } - if (@brokerule) { - my %rulenames = &Apache::lonlocal::texthash( - uc => 'At least one upper case letter', - lc => 'At least one lower case letter', - num => 'At least one number', - spec => 'At least one non-alphanumeric', - ); - $rulenames{'uc'} .= ': ABCDEFGHIJKLMNOPQRSTUVWXYZ'; - $rulenames{'lc'} .= ': abcdefghijklmnopqrstuvwxyz'; - $rulenames{'num'} .= ': 0123456789'; - $rulenames{'spec'} .= ': !"\#$%&\'()*+,-./:;<=>?@[\]^_\`{|}~'; - $rulenames{'min'} = &mt('Minimum password length: [_1]',$min); - $rulenames{'max'} = &mt('Maximum password length: [_1]',$max); - $warning = &mt('Password did not satisfy the following:').''; - } - if (wantarray) { - return @brokerule; - } - return $warning; -} - ############################################################### ## Get Kerberos Defaults for Domain ## ############################################################### @@ -3419,13 +3661,73 @@ sub get_related_words { untie %thesaurus_db; return @Words; } +############################################################### +# +# Spell checking +# =pod =back +=head1 Spell checking + +=over 4 + +=item * &check_spelling($wordlist $language) + +Takes a string containing words and feeds it to an external +spellcheck program via a pipeline. Returns a string containing +them mis-spelled words. + +Parameters: + +=over 4 + +=item - $wordlist + +String that will be fed into the spellcheck program. + +=item - $language + +Language string that specifies the language for which the spell +check will be performed. + +=back + +=back + +Note: This sub assumes that aspell is installed. + + =cut + +sub check_spelling { + my ($wordlist, $language) = @_; + my @misspellings; + + # Generate the speller and set the langauge. + # if explicitly selected: + + my $speller = Text::Aspell->new; + if ($language) { + $speller->set_option('lang', $language); + } + + # Turn the word list into an array of words by splittingon whitespace + + my @words = split(/\s+/, $wordlist); + + foreach my $word (@words) { + if(! $speller->check($word)) { + push(@misspellings, $word); + } + } + return join(' ', @misspellings); + +} + # -------------------------------------------------------------- Plaintext name =pod @@ -3889,7 +4191,11 @@ category sub filecategorytypes { my ($cat) = @_; - return @{$category_extensions{lc($cat)}}; + if (ref($category_extensions{lc($cat)}) eq 'ARRAY') { + return @{$category_extensions{lc($cat)}}; + } else { + return (); + } } =pod @@ -4056,7 +4362,7 @@ Return string with previous attempt on p =item * $usec: section of the desired student -=item * $identifier: counter for student (multiple students one problem) or +=item * $identifier: counter for student (multiple students one problem) or problem (one student; whole sequence). =back @@ -4143,7 +4449,7 @@ sub get_previous_attempt { my (@hidden,@unsolved); if (%typeparts) { foreach my $id (keys(%typeparts)) { - if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') || + if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') || ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) { push(@hidden,$id); } elsif ($identifier ne '') { @@ -4204,7 +4510,7 @@ sub get_previous_attempt { if ($key =~ /\./) { my $value = $returnhash{$version.':'.$key}; if ($key =~ /\.rndseed$/) { - my ($id) = ($key =~ /^(.+)\.rndseed$/); + my ($id) = ($key =~ /^(.+)\.[^.]+$/); if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) { $value = $returnhash{$version.':'.$id.'.rawrndseed'}; } @@ -4221,7 +4527,7 @@ sub get_previous_attempt { next if ($key =~ /\.foilorder$/); my $value = $returnhash{$version.':'.$key}; if ($key =~ /\.rndseed$/) { - my ($id) = ($key =~ /^(.+)\.rndseed$/); + my ($id) = ($key =~ /^(.+)\.[^.]+$/); if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) { $value = $returnhash{$version.':'.$id.'.rawrndseed'}; } @@ -4252,7 +4558,7 @@ sub get_previous_attempt { if ($key =~/$regexp$/ && (defined &$gradesub)) { $value = &$gradesub($value); } - $prevattempts.=''.$value.' '; + $prevattempts.=''. $value.' '; } else { $prevattempts.=' '; } @@ -4268,7 +4574,7 @@ sub get_previous_attempt { if ($key =~/$regexp$/ && (defined &$gradesub)) { $value = &$gradesub($value); } - $prevattempts.=''.$value.' '; + $prevattempts.=''.$value.' '; } } $prevattempts.= &end_data_table_row().&end_data_table(); @@ -4289,11 +4595,13 @@ sub get_previous_attempt { sub format_previous_attempt_value { my ($key,$value) = @_; if (($key =~ /timestamp/) || ($key=~/duedate/)) { - $value = &Apache::lonlocal::locallocaltime($value); + $value = &Apache::lonlocal::locallocaltime($value); } elsif (ref($value) eq 'ARRAY') { - $value = '('.join(', ', @{ $value }).')'; + $value = &HTML::Entities::encode('('.join(', ', @{ $value }).')','"<>&'); } elsif ($key =~ /answerstring$/) { my %answers = &Apache::lonnet::str2hash($value); + my @answer = %answers; + %answers = map {&HTML::Entities::encode($_, '"<>&')} @answer; my @anskeys = sort(keys(%answers)); if (@anskeys == 1) { my $answer = $answers{$anskeys[0]}; @@ -4316,7 +4624,7 @@ sub format_previous_attempt_value { } } } else { - $value = &unescape($value); + $value = &HTML::Entities::encode(&unescape($value), '"<>&'); } return $value; } @@ -4422,59 +4730,6 @@ sub get_student_view_with_retries { } } -sub css_links { - my ($currsymb,$level) = @_; - my ($links,@symbs,%cssrefs,%httpref); - if ($level eq 'map') { - my $navmap = Apache::lonnavmaps::navmap->new(); - if (ref($navmap)) { - my ($map,undef,$url)=&Apache::lonnet::decode_symb($currsymb); - my @resources = $navmap->retrieveResources($map,sub { $_[0]->is_problem() },0,0); - foreach my $res (@resources) { - if (ref($res) && $res->symb()) { - push(@symbs,$res->symb()); - } - } - } - } else { - @symbs = ($currsymb); - } - foreach my $symb (@symbs) { - my $css_href = &Apache::lonnet::EXT('resource.0.cssfile',$symb); - if ($css_href =~ /\S/) { - unless ($css_href =~ m{https?://}) { - my $url = (&Apache::lonnet::decode_symb($symb))[-1]; - my $proburl = &Apache::lonnet::clutter($url); - my ($probdir) = ($proburl =~ m{(.+)/[^/]+$}); - unless ($css_href =~ m{^/}) { - $css_href = &Apache::lonnet::hreflocation($probdir,$css_href); - } - if ($css_href =~ m{^/(res|uploaded)/}) { - unless (($httpref{'httpref.'.$css_href}) || - (&Apache::lonnet::is_on_map($css_href))) { - my $thisurl = $proburl; - if ($env{'httpref.'.$proburl}) { - $thisurl = $env{'httpref.'.$proburl}; - } - $httpref{'httpref.'.$css_href} = $thisurl; - } - } - } - $cssrefs{$css_href} = 1; - } - } - if (keys(%httpref)) { - &Apache::lonnet::appenv(\%httpref); - } - if (keys(%cssrefs)) { - foreach my $css_href (keys(%cssrefs)) { - next unless ($css_href =~ m{^(/res/|/uploaded/|https?://)}); - $links .= ''."\n"; - } - } - return $links; -} - =pod =item * &get_student_answers() @@ -4730,82 +4985,13 @@ sub findallcourses { ############################################### sub blockcheck { - my ($setters,$activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller) = @_; + my ($setters,$activity,$uname,$udom,$url,$is_course) = @_; - unless ($activity eq 'docs') { - my ($has_evb,$check_ipaccess); - my $dom = $env{'user.domain'}; - if ($env{'request.course.id'}) { - my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; - my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; - my $checkrole = "cm./$cdom/$cnum"; - my $sec = $env{'request.course.sec'}; - if ($sec ne '') { - $checkrole .= "/$sec"; - } - if ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) && - ($env{'request.role'} !~ /^st/)) { - $has_evb = 1; - } - unless ($has_evb) { - if (($activity eq 'printout') || ($activity eq 'grades') || ($activity eq 'search') || - ($activity eq 'boards') || ($activity eq 'groups') || ($activity eq 'chat')) { - if ($udom eq $cdom) { - $check_ipaccess = 1; - } - } - } - } - unless ($has_evb || $check_ipaccess) { - my @machinedoms = &Apache::lonnet::current_machine_domains(); - if (($dom eq 'public') && ($activity eq 'port')) { - $dom = $udom; - } - if (($dom ne '') && (grep(/^\Q$dom\E$/,@machinedoms))) { - $check_ipaccess = 1; - } else { - my $lonhost = $Apache::lonnet::perlvar{'lonHostID'}; - my $internet_names = &Apache::lonnet::get_internet_names($lonhost); - my $prim = &Apache::lonnet::domain($dom,'primary'); - my $intdom = &Apache::lonnet::internet_dom($prim); - if (($intdom ne '') && (ref($internet_names) eq 'ARRAY')) { - if (grep(/^\Q$intdom\E$/,@{$internet_names})) { - $check_ipaccess = 1; - } - } - } - } - if ($check_ipaccess) { - my ($ipaccessref,$cached)=&Apache::lonnet::is_cached_new('ipaccess',$dom); - unless (defined($cached)) { - my %domconfig = - &Apache::lonnet::get_dom('configuration',['ipaccess'],$dom); - $ipaccessref = &Apache::lonnet::do_cache_new('ipaccess',$dom,$domconfig{'ipaccess'},1800); - } - if ((ref($ipaccessref) eq 'HASH') && ($clientip)) { - foreach my $id (keys(%{$ipaccessref})) { - if (ref($ipaccessref->{$id}) eq 'HASH') { - my $range = $ipaccessref->{$id}->{'ip'}; - if ($range) { - if (&Apache::lonnet::ip_match($clientip,$range)) { - if (ref($ipaccessref->{$id}->{'commblocks'}) eq 'HASH') { - if ($ipaccessref->{$id}->{'commblocks'}->{$activity} eq 'on') { - return ('','','',$id,$dom); - last; - } - } - } - } - } - } - } - } - } if (defined($udom) && defined($uname)) { # If uname and udom are for a course, check for blocks in the course. if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) { my ($startblock,$endblock,$triggerblock) = - &get_blocks($setters,$activity,$udom,$uname,$url,$symb,$caller); + &get_blocks($setters,$activity,$udom,$uname,$url); return ($startblock,$endblock,$triggerblock); } } else { @@ -4816,18 +5002,15 @@ sub blockcheck { my $startblock = 0; my $endblock = 0; my $triggerblock = ''; - my %live_courses; - unless (($activity eq 'wishlist') || ($activity eq 'annotate')) { - %live_courses = &findallcourses(undef,$uname,$udom); - } + my %live_courses = &findallcourses(undef,$uname,$udom); # If uname is for a user, and activity is course-specific, i.e., # boards, chat or groups, check for blocking in current course only. if (($activity eq 'boards' || $activity eq 'chat' || $activity eq 'groups' || $activity eq 'printout' || - $activity eq 'search' || $activity eq 'reinit' || - $activity eq 'alert') && ($env{'request.course.id'})) { + $activity eq 'reinit' || $activity eq 'alert') && + ($env{'request.course.id'})) { foreach my $key (keys(%live_courses)) { if ($key ne $env{'request.course.id'}) { delete($live_courses{$key}); @@ -4932,11 +5115,11 @@ sub blockcheck { ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E})); next if ($no_userblock); - # Retrieve blocking times and identity of blocker for course + # Retrieve blocking times and identity of locker for course # of specified user, unless user has 'evb' privilege. - + my ($start,$end,$trigger) = - &get_blocks($setters,$activity,$cdom,$cnum,$url,$symb,$caller); + &get_blocks($setters,$activity,$cdom,$cnum,$url); if (($start != 0) && (($startblock == 0) || ($startblock > $start))) { $startblock = $start; @@ -4956,7 +5139,7 @@ sub blockcheck { } sub get_blocks { - my ($setters,$activity,$cdom,$cnum,$url,$symb,$caller) = @_; + my ($setters,$activity,$cdom,$cnum,$url) = @_; my $startblock = 0; my $endblock = 0; my $triggerblock = ''; @@ -4969,13 +5152,7 @@ sub get_blocks { my $now = time; my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum); if ($activity eq 'docs') { - my ($blocked,$nosymbcache,$noenccheck); - if (($caller eq 'blockedaccess') || ($caller eq 'blockingstatus')) { - $blocked = 1; - $nosymbcache = 1; - $noenccheck = 1; - } - @blockers = &Apache::lonnet::has_comm_blocking('bre',$symb,$url,$nosymbcache,$noenccheck,$blocked,\%commblocks); + @blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks); foreach my $block (@blockers) { if ($block =~ /^firstaccess____(.+)$/) { my $item = $1; @@ -5103,17 +5280,14 @@ sub parse_block_record { } sub blocking_status { - my ($activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller) = @_; + my ($activity,$uname,$udom,$url,$is_course) = @_; my %setters; # check for active blocking - if ($clientip eq '') { - $clientip = &Apache::lonnet::get_requestor_ip(); - } - my ($startblock,$endblock,$triggerblock,$by_ip,$blockdom) = - &blockcheck(\%setters,$activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller); + my ($startblock,$endblock,$triggerblock) = + &blockcheck(\%setters,$activity,$uname,$udom,$url,$is_course); my $blocked = 0; - if (($startblock && $endblock) || ($by_ip)) { + if ($startblock && $endblock) { $blocked = 1; } @@ -5122,17 +5296,12 @@ sub blocking_status { # build a link to a popup window containing the details my $querystring = "?activity=$activity"; -# $uname and $udom decide whose portfolio (or information page) the user is trying to look at - if (($activity eq 'port') || ($activity eq 'about') || ($activity eq 'passwd')) { - $querystring .= "&udom=$udom" if ($udom =~ /^$match_domain$/); +# $uname and $udom decide whose portfolio the user is trying to look at + if (($activity eq 'port') || ($activity eq 'passwd')) { + $querystring .= "&udom=$udom" if ($udom =~ /^$match_domain$/); $querystring .= "&uname=$uname" if ($uname =~ /^$match_username$/); } elsif ($activity eq 'docs') { - my $showurl = &Apache::lonenc::check_encrypt($url); - $querystring .= '&url='.&HTML::Entities::encode($showurl,'\'&"<>'); - if ($symb) { - my $showsymb = &Apache::lonenc::check_encrypt($symb); - $querystring .= '&symb='.&HTML::Entities::encode($showsymb,'\'&"<>'); - } + $querystring .= '&url='.&HTML::Entities::encode($url,'&"'); } my $output .= <<'END_MYBLOCK'; @@ -5157,20 +5326,10 @@ END_MYBLOCK $text = &mt('Printing Blocked'); } elsif ($activity eq 'passwd') { $text = &mt('Password Changing Blocked'); - } elsif ($activity eq 'grades') { - $text = &mt('Gradebook Blocked'); - } elsif ($activity eq 'search') { - $text = &mt('Search Blocked'); } elsif ($activity eq 'alert') { $text = &mt('Checking Critical Messages Blocked'); } elsif ($activity eq 'reinit') { $text = &mt('Checking Course Update Blocked'); - } elsif ($activity eq 'about') { - $text = &mt('Access to User Information Pages Blocked'); - } elsif ($activity eq 'wishlist') { - $text = &mt('Access to Stored Links Blocked'); - } elsif ($activity eq 'annotate') { - $text = &mt('Access to Annotations Blocked'); } $output .= <<"END_BLOCK";
@@ -5194,15 +5353,8 @@ sub check_ip_acc { if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) { return 1; } - my $allowed=0; - my $ip; - if (($ENV{'REMOTE_ADDR'} eq '127.0.0.1') || - ($ENV{'REMOTE_ADDR'} eq &Apache::lonnet::get_host_ip($Apache::lonnet::perlvar{'lonHostID'}))) { - $ip = $env{'request.host'} || $ENV{'REMOTE_ADDR'} || $clientip; - } else { - my $remote_ip = &Apache::lonnet::get_requestor_ip(); - $ip = $remote_ip || $env{'request.host'} || $clientip; - } + my $allowed; + my $ip=$ENV{'REMOTE_ADDR'} || $clientip || $env{'request.host'}; my $name; my %access = ( @@ -5214,17 +5366,18 @@ sub check_ip_acc { 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 $numdenies = scalar(@denies); + my $numallows = scalar(@allows); + my $count = 0; + foreach my $pattern (@denies,@allows) { + $count ++; my $acctype = 'allowfrom'; if ($count <= $numdenies) { $acctype = 'denyfrom'; @@ -5335,6 +5488,7 @@ sub get_domainconf { 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'}; @@ -5351,17 +5505,6 @@ sub get_domainconf { } } } - } elsif ($key eq 'saml') { - if (ref($domconfig{'login'}{$key}) eq 'HASH') { - foreach my $host (keys(%{$domconfig{'login'}{$key}})) { - if (ref($domconfig{'login'}{$key}{$host}) eq 'HASH') { - $designhash{$udom.'.login.'.$key.'_'.$host} = 1; - foreach my $item ('text','img','alt','url','title','notsso') { - $designhash{$udom.'.login.'.$key.'_'.$item.'_'.$host} = $domconfig{'login'}{$key}{$host}{$item}; - } - } - } - } } else { foreach my $img (keys(%{$domconfig{'login'}{$key}})) { $designhash{$udom.'.login.'.$key.'_'.$img} = @@ -5426,7 +5569,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); @@ -5466,12 +5609,8 @@ sub domainlogo { &Apache::lonnet::repcopy($local_name); } $imgsrc = &lonhttpdurl($imgsrc); - } - my $alttext = $domain; - if ($designhash{$domain.'.login.alttext_domlogo'} ne '') { - $alttext = $designhash{$domain.'.login.alttext_domlogo'}; - } - return ''; + } + return ''.$domain.''; } elsif (defined(&Apache::lonnet::domain($domain,'description'))) { return &Apache::lonnet::domain($domain,'description'); } else { @@ -5619,10 +5758,20 @@ 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 $output = '
' .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it? - .''.&mt('Authoring Space:').' ' + .''.$title.' ' .'
' #FIXME lonpubdir: target="_parent" .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef); @@ -5633,13 +5782,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.'/','_top','/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; } @@ -5681,9 +5835,6 @@ 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 use_absolute -> for external resource or syllabus, this will @@ -5695,19 +5846,6 @@ Inputs: inlineremote items to be added in "Functions" menu below breadcrumbs. -=item * $ltiscope, optional argument, will be one of: resource, map or - course, if LON-CAPA is in LTI Provider context. Value is - the scope of use, i.e., launch was for access to a single, a map - or the entire course. - -=item * $ltiuri, optional argument, if LON-CAPA is in LTI Provider - context, this will contain the URL for the landing item in - the course, after launch from an LTI Consumer - -=item * $ltimenu, optional argument, if LON-CAPA is in LTI Provider - context, this will contain a reference to hash of items - to be included in the page header and/or inline menu. - =back Returns: A uniform header for LON-CAPA web pages. @@ -5719,8 +5857,7 @@ other decorations will be returned. sub bodytag { my ($title,$function,$addentries,$bodyonly,$domain,$forcereg, - $no_nav_bar,$bgcolor,$no_inline_link,$args,$advtoolsref, - $ltiscope,$ltiuri,$ltimenu,$menucoll,$menuref)=@_; + $no_nav_bar,$bgcolor,$args,$advtoolsref)=@_; my $public; if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')) @@ -5749,24 +5886,12 @@ sub bodytag { if ($realm) { $realm = '/'.$realm; } - if ($role eq 'ca') { + if ($role eq 'ca') { my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$}); $realm = &plainname($rname,$rdom); } # realm - my ($cid,$sec); if ($env{'request.course.id'}) { - $cid = $env{'request.course.id'}; - if ($env{'request.course.sec'}) { - $sec = $env{'request.course.sec'}; - } - } elsif ($realm =~ m{^/($match_domain)/($match_courseid)(?:|/(\w+))$}) { - if (&Apache::lonnet::is_course($1,$2)) { - $cid = $1.'_'.$2; - $sec = $3; - } - } - if ($cid) { if ($env{'request.role'} !~ /^cr/) { $role = &Apache::lonnet::plaintext($role,&course_type()); } elsif ($role =~ m{^cr/($match_domain)/\1-domainconfig/(\w+)$}) { @@ -5776,12 +5901,12 @@ sub bodytag { $role = &mt('Helpdesk[_1]',' '.$2); } } else { - $role = (split(/\//,$role,4))[-1]; + $role = (split(/\//,$role,4))[-1]; } - if ($sec) { - $role .= (' 'x2).'- '.&mt('section:').' '.$sec; + if ($env{'request.course.sec'}) { + $role .= (' 'x2).'- '.&mt('section:').' '.$env{'request.course.sec'}; } - $realm = $env{'course.'.$cid.'.description'}; + $realm = $env{'course.'.$env{'request.course.id'}.'.description'}; } else { $role = &Apache::lonnet::plaintext($role); } @@ -5803,66 +5928,32 @@ sub bodytag { if ($public) { undef($role); } - - my $showcrstitle = 1; - if (($cid) && ($env{'request.lti.login'})) { - if (ref($ltimenu) eq 'HASH') { - unless ($ltimenu->{'role'}) { - undef($role); - } - unless ($ltimenu->{'coursetitle'}) { - $realm=' '; - $showcrstitle = 0; - } - } - } elsif (($cid) && ($menucoll)) { - if (ref($menuref) eq 'HASH') { - unless ($menuref->{'role'}) { - undef($role); - } - unless ($menuref->{'crs'}) { - $realm=' '; - $showcrstitle = 0; - } - } - } - + my $titleinfo = '

'.$title.'

'; # # Extra info if you are the DC my $dc_info = ''; - if (($env{'user.adv'}) && ($env{'request.course.id'}) && $showcrstitle && - (exists($env{'user.role.dc./'.$env{'course.'.$cid.'.domain'}.'/'}))) { + if ($env{'user.adv'} && exists($env{'user.role.dc./'. + $env{'course.'.$env{'request.course.id'}. + '.domain'}.'/'})) { + my $cid = $env{'request.course.id'}; $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'}; $dc_info =~ s/\s+$//; } my $crstype; - if ($cid) { - $crstype = $env{'course.'.$cid.'.type'}; + if ($env{'request.course.id'}) { + $crstype = $env{'course.'.$env{'request.course.id'}.'.type'}; } elsif ($args->{'crstype'}) { $crstype = $args->{'crstype'}; } - - $role = '('.$role.')' if ($role && !$env{'browser.mobile'}); - - 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; - } + 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 @@ -5871,62 +5962,51 @@ sub bodytag { $bodytag .= Apache::lonhtmlcommon::scripttag( Apache::lonmenu::utilityfunctions($httphost), 'start'); - unless ($args->{'no_primary_menu'}) { - my ($left,$right) = Apache::lonmenu::primary_menu($args->{'links_disabled'}); + my ($left,$right) = Apache::lonmenu::primary_menu($crstype); - if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) { - if ($dc_info) { - $dc_info = qq|$dc_info|; - } - $bodytag .= qq|
$left $role
- $realm $dc_info
|; - return $bodytag; - } + if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) { + if ($dc_info) { + $dc_info = qq|$dc_info|; + } + $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); - } - $bodytag .= qq|
$realm $dc_info
|; + if ($dc_info) { + $dc_info = &dc_courseid_toggle($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){ - unless ($args->{'no_inline_menu'}) { - $bodytag .= Apache::lonmenu::secondary_menu($httphost,$ltiscope,$ltimenu, - $args->{'no_primary_menu'}, - $menucoll,$menuref, - $args->{'links_disabled'}); - } + $bodytag .= Apache::lonmenu::secondary_menu($httphost); $bodytag .= Apache::lonmenu::serverform(); $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end'); if ($env{'request.state'} eq 'construct') { $bodytag .= &Apache::lonmenu::innerregister($forcereg, - $args->{'bread_crumbs'},'','',$hostname,$ltiscope,$ltiuri); + $args->{'bread_crumbs'},'','',$hostname); } elsif ($forcereg) { $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef, $args->{'group'}, $args->{'hide_buttons'}, - $hostname,$ltiscope,$ltiuri); + $hostname); } else { - my $forbodytag; - &Apache::lonmenu::prepare_functions($env{'request.noversionuri'}, - $forcereg,$args->{'group'}, - $args->{'bread_crumbs'}, - $advtoolsref,'',$hostname, - \$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 @@ -5936,54 +6016,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 { @@ -6015,15 +6047,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; @@ -6347,6 +6372,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; } @@ -6438,7 +6469,7 @@ td.LC_menubuttons_text { } td.LC_zero_height { - line-height: 0; + line-height: 0; cellpadding: 0; } @@ -6763,6 +6794,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; @@ -7032,8 +7069,7 @@ table.LC_prior_tries td { padding: 6px; } -.LC_answer_unknown, -.LC_answer_warning { +.LC_answer_unknown { background: orange; color: black; padding: 6px; @@ -7115,7 +7151,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; @@ -7412,7 +7453,7 @@ ol.LC_primary_menu li { 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; @@ -7427,7 +7468,7 @@ ol.LC_primary_menu li p span.LC_primary_ } ol.LC_primary_menu li p span.LC_primary_menu_innerarrow { - display: inline-block; + display: inline-block; width: 5%; float: right; text-align: right; @@ -7462,9 +7503,9 @@ ol.LC_primary_menu li:hover li, ol.LC_pr float: none; border-left: 1px solid black; border-right: 1px solid black; -/* A dark bottom border to visualize different menu options; +/* 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; + border-bottom: 1px solid $data_table_dark; } ol.LC_primary_menu li li p:hover { @@ -8024,24 +8065,14 @@ ul.LC_funclist li { cursor:pointer; } -.LCisDisabled { - cursor: not-allowed; - opacity: 0.5; -} - -a[aria-disabled="true"] { - color: currentColor; - display: inline-block; /* For IE11/ MS Edge bug */ - pointer-events: none; - text-decoration: none; +/* + styles used for response display +*/ +div.LC_radiofoil, div.LC_rankfoil { + margin: .5em 0em .5em 0em; } - -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; +table.LC_itemgroup { + margin-top: 1em; } /* @@ -8065,6 +8096,87 @@ 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%; @@ -8155,8 +8267,8 @@ sub headtag { 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'} @@ -8203,99 +8315,43 @@ ADDMETA my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'}; unless (&Apache::lonnet::allowed('mau',$dom_in_use)) { my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use); - my $lonhost = $Apache::lonnet::perlvar{'lonHostID'}; - my ($offload,$offloadoth); if (ref($domdefs{'offloadnow'}) eq 'HASH') { + my $lonhost = $Apache::lonnet::perlvar{'lonHostID'}; if ($domdefs{'offloadnow'}{$lonhost}) { - $offload = 1; - if (($env{'user.domain'} ne '') && ($env{'user.domain'} ne $dom_in_use) && - (!(($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')))) { - unless (&Apache::lonnet::shared_institution($env{'user.domain'})) { - $offloadoth = 1; - $dom_in_use = $env{'user.domain'}; + my $newserver = &Apache::lonnet::spareserver(30000,undef,1,$dom_in_use); + if (($newserver) && ($newserver ne $lonhost)) { + my $numsec = 5; + my $timeout = $numsec * 1000; + my ($newurl,$locknum,%locks,$msg); + if ($env{'request.role.adv'}) { + ($locknum,%locks) = &Apache::lonnet::get_locks(); } - } - } - } - 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'}; - } + my $disable_submit = 0; + if ($requrl =~ /$LONCAPA::assess_re/) { + $disable_submit = 1; } - } - } - } - if ($offload) { - my $newserver = &Apache::lonnet::spareserver(undef,30000,undef,1,$dom_in_use); - if (($newserver eq '') && ($offloadoth)) { - my @domains = &Apache::lonnet::current_machine_domains(); - if (($dom_in_use ne '') && (!grep(/^\Q$dom_in_use\E$/,@domains))) { - ($newserver) = &Apache::lonnet::choose_server($dom_in_use); - } - } - if (($newserver) && ($newserver ne $lonhost)) { - my $numsec = 5; - my $timeout = $numsec * 1000; - my ($newurl,$locknum,%locks,$msg); - if ($env{'request.role.adv'}) { - ($locknum,%locks) = &Apache::lonnet::get_locks(); - } - my $disable_submit = 0; - if ($requrl =~ /$LONCAPA::assess_re/) { - $disable_submit = 1; - } - if ($locknum) { - my @lockinfo = sort(values(%locks)); - $msg = &mt('Once the following tasks are complete:')." \n". - join(", ",sort(values(%locks)))."\n"; - if (&show_course()) { - $msg .= &mt('your session will be transferred to a different server, after you click "Courses".'); + if ($locknum) { + my @lockinfo = sort(values(%locks)); + $msg = &mt('Once the following tasks are complete: ')."\\n". + join(", ",sort(values(%locks)))."\\n". + &mt('your session will be transferred to a different server, after you click "Roles".'); } else { - $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 (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) { + $msg = &mt('Your LON-CAPA submission has been recorded')."\\n"; } - if ($shownsymb) { - &js_escape(\$shownsymb); - $newurl .= '&symb='.$shownsymb; + $msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec); + $newurl = '/adm/switchserver?otherserver='.$newserver; + if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) { + $newurl .= '&role='.$env{'request.role'}; + } + if ($env{'request.symb'}) { + $newurl .= '&symb='.$env{'request.symb'}; + } else { + $newurl .= '&origurl='.$requrl; } - } else { - my $shownurl = &Apache::lonenc::check_encrypt($requrl); - &js_escape(\$shownurl); - $newurl .= '&origurl='.$shownurl; } - } - &js_escape(\$msg); - $result.=< OFFLOAD + } } } } @@ -8331,7 +8388,7 @@ OFFLOAD if (!$args->{'frameset'}) { $result .= ' /'; } - $result .= '>' + $result .= '>' .$inhibitprint .$head_extra; my $clientmobile; @@ -8364,12 +8421,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; } @@ -8414,8 +8471,7 @@ sub print_suppression { } my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; - my $clientip = &Apache::lonnet::get_requestor_ip(); - my $blocked = &blocking_status('printout',$clientip,$cnum,$cdom,undef,1); + my $blocked = &blocking_status('printout',$cnum,$cdom,undef,1); if ($blocked) { my $checkrole = "cm./$cdom/$cnum"; if ($env{'request.course.sec'} ne '') { @@ -8523,22 +8579,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 bread_crumbs -> Array containing breadcrumbs bread_crumbs_component -> if exists show it as headline else show only the breadcrumbs bread_crumbs_nomenu -> if true will pass false as the value of $menulink to lonhtmlcommon::breadcrumbs - group -> includes the current group, if page is for a + group -> includes the current group, if page is for a specific group use_absolute -> for request for external resource or syllabus, this will contain https:// if server uses https (as per hosts.tab), but request is for http hostname -> hostname, originally from $r->hostname(), (optional). - links_disabled -> Links in primary and secondary menus are disabled - (Can enable them once page has loaded - see lonroles.pm - for an example). =back @@ -8551,81 +8602,11 @@ sub start_page { #&Apache::lonnet::logthis("start_page ".join(':',caller(0))); $env{'internal.start_page'}++; - my ($result,@advtools,$ltiscope,$ltiuri,%ltimenu,$menucoll,%menu); + my ($result,@advtools); if (! exists($args->{'skip_phases'}{'head'}) ) { $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args); } - - if (($env{'request.course.id'}) && ($env{'request.lti.login'})) { - if ($env{'course.'.$env{'request.course.id'}.'.lti.override'}) { - unless ($env{'course.'.$env{'request.course.id'}.'.lti.topmenu'}) { - $args->{'no_primary_menu'} = 1; - } - unless ($env{'course.'.$env{'request.course.id'}.'.lti.inlinemenu'}) { - $args->{'no_inline_menu'} = 1; - } - if ($env{'course.'.$env{'request.course.id'}.'.lti.lcmenu'}) { - map { $ltimenu{$_} = 1; } split(/,/,$env{'course.'.$env{'request.course.id'}.'.lti.lcmenu'}); - } - } else { - my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; - my %lti = &Apache::lonnet::get_domain_lti($cdom,'provider'); - if (ref($lti{$env{'request.lti.login'}}) eq 'HASH') { - unless ($lti{$env{'request.lti.login'}}{'topmenu'}) { - $args->{'no_primary_menu'} = 1; - } - unless ($lti{$env{'request.lti.login'}}{'inlinemenu'}) { - $args->{'no_inline_menu'} = 1; - } - if (ref($lti{$env{'request.lti.login'}}{'lcmenu'}) eq 'ARRAY') { - map { $ltimenu{$_} = 1; } @{$lti{$env{'request.lti.login'}}{'lcmenu'}}; - } - } - } - ($ltiscope,$ltiuri) = &LONCAPA::ltiutils::lti_provider_scope($env{'request.lti.uri'}, - $env{'course.'.$env{'request.course.id'}.'.domain'}, - $env{'course.'.$env{'request.course.id'}.'.num'}); - } elsif ($env{'request.course.id'}) { - my $expiretime=600; - if ((time-$env{'course.'.$env{'request.course.id'}.'.last_cache'}) > $expiretime) { - &Apache::lonnet::coursedescription($env{'request.course.id'},{'freshen_cache' => 1}); - } - my ($deeplinkmenu,$menuref); - ($menucoll,$deeplinkmenu,$menuref) = &menucoll_in_effect(); - if ($menucoll) { - if (ref($menuref) eq 'HASH') { - %menu = %{$menuref}; - } - if ($menu{'top'} eq 'n') { - $args->{'no_primary_menu'} = 1; - } - if ($menu{'inline'} eq 'n') { - unless (&Apache::lonnet::allowed('opa')) { - my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; - my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; - my $crstype = &course_type(); - my $now = time; - my $ccrole; - if ($crstype eq 'Community') { - $ccrole = 'co'; - } else { - $ccrole = 'cc'; - } - if ($env{'user.role.'.$ccrole.'./'.$cdom.'/'.$cnum}) { - my ($start,$end) = split(/\./,$env{'user.role.'.$ccrole.'./'.$cdom.'/'.$cnum}); - if ((($start) && ($start<0)) || - (($end) && ($end<$now)) || - (($start) && ($now<$start))) { - $args->{'no_inline_menu'} = 1; - } - } else { - $args->{'no_inline_menu'} = 1; - } - } - } - } - } if (! exists($args->{'skip_phases'}{'body'}) ) { if ($args->{'frameset'}) { @@ -8638,9 +8619,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, - $ltiscope,$ltiuri,\%ltimenu,$menucoll,\%menu); + $args->{'bgcolor'}, $args, + \@advtools); } } @@ -8676,7 +8656,9 @@ sub start_page { 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); @@ -8684,14 +8666,9 @@ sub start_page { #if bread_crumbs_component exists show it as headline else show only the breadcrumbs if(exists($args->{'bread_crumbs_component'})){ $result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'},'',$menulink); - } else { + } 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; } @@ -8728,103 +8705,6 @@ sub end_page { return $result; } -sub menucoll_in_effect { - my ($menucoll,$deeplinkmenu,%menu); - if ($env{'request.course.id'}) { - $menucoll = $env{'course.'.$env{'request.course.id'}.'.menudefault'}; - if ($env{'request.deeplink.login'}) { - my ($deeplink_symb,$deeplink,$check_login_symb); - my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; - my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; - if ($env{'request.noversionuri'} =~ m{^/(res|uploaded)/}) { - if ($env{'request.noversionuri'} =~ /\.(page|sequence)$/) { - my $navmap = Apache::lonnavmaps::navmap->new(); - if (ref($navmap)) { - $deeplink = $navmap->get_mapparam(undef, - &Apache::lonnet::declutter($env{'request.noversionuri'}), - '0.deeplink'); - } else { - $check_login_symb = 1; - } - } else { - my $symb=&Apache::lonnet::symbread(); - if ($symb) { - $deeplink = &Apache::lonnet::EXT('resource.0.deeplink',$symb); - } else { - $check_login_symb = 1; - } - } - } else { - $check_login_symb = 1; - } - if ($check_login_symb) { - $deeplink_symb = &deeplink_login_symb($cnum,$cdom); - if ($deeplink_symb =~ /\.(page|sequence)$/) { - my $mapname = &Apache::lonnet::deversion((&Apache::lonnet::decode_symb($deeplink_symb))[2]); - my $navmap = Apache::lonnavmaps::navmap->new(); - if (ref($navmap)) { - $deeplink = $navmap->get_mapparam(undef,$mapname,'0.deeplink'); - } - } else { - $deeplink = &Apache::lonnet::EXT('resource.0.deeplink',$deeplink_symb); - } - } - if ($deeplink ne '') { - my ($state,$others,$listed,$scope,$protect,$display) = split(/,/,$deeplink); - if ($display =~ /^\d+$/) { - $deeplinkmenu = 1; - $menucoll = $display; - } - } - } - if ($menucoll) { - %menu = &page_menu($env{'course.'.$env{'request.course.id'}.'.menucollections'},$menucoll); - } - } - return ($menucoll,$deeplinkmenu,\%menu); -} - -sub deeplink_login_symb { - my ($cnum,$cdom) = @_; - my $login_symb; - if ($env{'request.deeplink.login'}) { - $login_symb = &symb_from_tinyurl($env{'request.deeplink.login'},$cnum,$cdom); - } - return $login_symb; -} - -sub symb_from_tinyurl { - my ($url,$cnum,$cdom) = @_; - if ($url =~ m{^\Q/tiny/$cdom/\E(\w+)$}) { - my $key = $1; - my ($tinyurl,$login); - my ($result,$cached)=&Apache::lonnet::is_cached_new('tiny',$cdom."\0".$key); - if (defined($cached)) { - $tinyurl = $result; - } else { - my $configuname = &Apache::lonnet::get_domainconfiguser($cdom); - my %currtiny = &Apache::lonnet::get('tiny',[$key],$cdom,$configuname); - if ($currtiny{$key} ne '') { - $tinyurl = $currtiny{$key}; - &Apache::lonnet::do_cache_new('tiny',$cdom."\0".$key,$currtiny{$key},600); - } - } - if ($tinyurl ne '') { - my ($cnumreq,$symb) = split(/\&/,$tinyurl); - if (wantarray) { - return ($cnumreq,$symb); - } elsif ($cnumreq eq $cnum) { - return $symb; - } - } - } - if (wantarray) { - return (); - } else { - return; - } -} - sub wishlist_window { return(<<'ENDWISHLIST'); @@ -8941,21 +8813,21 @@ ENDADHOC } sub modal_adhoc_inner { - my ($funcname,$width,$height,$content,$possmathjax)=@_; + 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(). &end_page() ); - return &modal_adhoc_script($funcname,$width,$height,$content,$possmathjax); + return &modal_adhoc_script($funcname,$width,$height,$content); } sub modal_adhoc_window { - my ($funcname,$width,$height,$content,$linktext,$possmathjax)=@_; - return &modal_adhoc_inner($funcname,$width,$height,$content,$possmathjax). + my ($funcname,$width,$height,$content,$linktext)=@_; + return &modal_adhoc_inner($funcname,$width,$height,$content). "".$linktext.""; } @@ -9021,9 +8893,8 @@ sub end_togglebox { } sub LCprogressbar_script { - my ($id,$number_to_do)=@_; - if ($number_to_do) { - 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; } @@ -9084,54 +8933,37 @@ my $LCidcnt; my $LCcurrentid; sub LCprogressbar { - my ($r,$number_to_do,$preamble)=@_; + my ($r)=(@_); $LClastpercent=0; $LCidcnt++; $LCcurrentid=$$.'_'.$LCidcnt; - my ($starting,$content); - if ($number_to_do) { - $starting=&mt('Starting'); - $content=(< $starting ENDPROGBAR - } else { - $starting=&mt('Loading...'); - $LClastpercent='false'; - $content=(< -
$starting
- -ENDPROGBAR - } - &r_print($r,$content.&LCprogressbar_script($LCcurrentid,$number_to_do)); + &r_print($r,$content.&LCprogressbar_script($LCcurrentid)); } sub LCprogressbarUpdate { - 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'; + my ($r,$val,$text)=@_; + 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.'%'; } $text=&js_ready($text); &r_print($r,< // ENDUPDATE @@ -9629,7 +9461,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(); @@ -9951,8 +9783,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. @@ -10025,8 +9857,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 '') { @@ -10174,7 +10007,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. @@ -10210,6 +10043,8 @@ sub excess_filesize_warning { ############################################### + + sub get_secgrprole_info { my ($cdom,$cnum,$needroles,$type) = @_; my %sections_count = &get_sections($cdom,$cnum); @@ -10318,7 +10153,16 @@ sub user_picker { $allow_blank = 0; $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,[$currdom]); } else { - $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1); + my $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 = ' {'clonedomain'}.'/'.$args->{'clonecourse'}; my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid); my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom); - my $clonetitle; - my @clonemsg; + my $clonemsg; my $can_clone = 0; my $lctype = lc($args->{'crstype'}); if ($lctype ne 'community') { @@ -15551,38 +15529,16 @@ sub check_clone { } if ($clonehome eq 'no_host') { if ($args->{'crstype'} eq 'Community') { - 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'}], - })); + $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'}); } else { - 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'}], - })); - } + $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'}); + } } else { my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1}); - $clonetitle = $clonedesc{'description'}; if ($args->{'crstype'} eq 'Community') { if ($clonedesc{'type'} ne 'Community') { - 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); + $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); } } if (($env{'request.role.domain'} eq $args->{'clonedomain'}) && @@ -15599,7 +15555,7 @@ sub check_clone { if ($args->{'ccdomain'} eq $args->{'clonedomain'}) { $can_clone = 1; } - } elsif (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) && + } 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'})) { @@ -15618,7 +15574,7 @@ sub check_clone { $can_clone = 1; } unless ($can_clone) { - if (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) && + if (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) && ($args->{'clonedomain'} eq $args->{'course_domain'})) { my (%gotdomdefaults,%gotcodedefaults); foreach my $cloner (@cloners) { @@ -15657,12 +15613,12 @@ sub check_clone { if ($args->{'crstype'} eq 'Community') { $ccrole = 'co'; } - my %roleshash = - &Apache::lonnet::get_my_roles($args->{'ccuname'}, - $args->{'ccdomain'}, + my %roleshash = + &Apache::lonnet::get_my_roles($args->{'ccuname'}, + $args->{'ccdomain'}, 'userroles',['active'],[$ccrole], - [$args->{'clonedomain'}]); - if ($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$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'})) { @@ -15671,34 +15627,20 @@ sub check_clone { } 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'}], - })); + $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 { - 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'}], - })); - } + $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'}); + } } } } - return ($can_clone,\@clonemsg,$cloneid,$clonehome,$clonetitle); + return ($can_clone, $clonemsg, $cloneid, $clonehome); } sub construct_course { my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context, - $cnum,$category,$coderef,$callercontext,$user_lh) = @_; - my ($outcome,$msgref,$clonemsgref); + $cnum,$category,$coderef) = @_; + my $outcome; my $linefeed = '
'."\n"; if ($context eq 'auto') { $linefeed = "\n"; @@ -15707,18 +15649,30 @@ sub construct_course { # # Are we cloning? # - my ($can_clone,$cloneid,$clonehome,$clonetitle); + my ($can_clone, $clonemsg, $cloneid, $clonehome); if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) { - ($can_clone,$clonemsgref,$cloneid,$clonehome,$clonetitle) = &check_clone($args,$linefeed); + ($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed); + if ($context ne 'auto') { + if ($clonemsg ne '') { + $clonemsg = ''.$clonemsg.''; + } + } + $outcome .= $clonemsg.$linefeed; + if (!$can_clone) { - return (0,$outcome,$clonemsgref); + return (0,$outcome); } } # # 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'}, @@ -15729,20 +15683,15 @@ sub construct_course { $args->{'ccuname'}.':'. $args->{'ccdomain'}, $args->{'crstype'}, - $cnum,$context,$category, - $callercontext); + $cnum,$context,$category); # 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. - if (($callercontext eq 'auto') && ($user_lh ne '')) { - $outcome .= &mt_user($user_lh,'New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed; - } else { - $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed; - } + $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$showncrstype,$$courseid).$linefeed; if ($$courseid =~ /^error:/) { - return (0,$outcome,$clonemsgref); + return (0,$outcome); } # @@ -15751,37 +15700,23 @@ sub construct_course { ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid); my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom); if ($crsuhome eq 'no_host') { - 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('Course creation failed, unrecognized course home server.').$linefeed; + return (0,$outcome); } $outcome .= &mt('Created on').': '.$crsuhome.$linefeed; # # Do the cloning -# - my @clonemsg; +# if ($can_clone && $cloneid) { - push(@clonemsg, - { - mt => 'Created [_1] by cloning from [_2]', - args => [$crstype,$clonetitle], - }); + $clonemsg = &mt('Cloning [_1] from [_2]',$showncrstype,$clonehome); + if ($context ne 'auto') { + $clonemsg = ''.$clonemsg.''; + } + $outcome .= $clonemsg.$linefeed; my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum); # Copy all files - my @info = - &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'}, - $args->{'dateshift'},$args->{'crscode'}, - $args->{'ccuname'}.':'.$args->{'ccdomain'}, - $args->{'tinyurls'}); - if (@info) { - push(@clonemsg,@info); - } + &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'}); # Restore URL $cenv{'url'}=$oldcenv{'url'}; # Restore title @@ -15806,7 +15741,8 @@ sub construct_course { 'plc.users.denied', 'hidefromcat', 'checkforpriv', - 'categories'], + 'categories', + 'internal.uniquecode'], $$crsudom,$$crsunum); if ($args->{'textbook'}) { $cenv{'internal.textbook'} = $args->{'textbook'}; @@ -15941,7 +15877,7 @@ sub construct_course { $outcome .= $linefeed; } else { $outcome .= "

\n"; - } + } } if ($args->{'no_end_date'}) { $args->{'endaccess'} = 0; @@ -16010,7 +15946,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; } @@ -16047,17 +15983,12 @@ 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 => $opendate, + my %storecontent = ($storeunder => time, $storeunder.'.type' => 'date_start'); - $outcome .= &mt('All assignments open starting [_1]', - &Apache::lonlocal::locallocaltime($opendate)).': '. - &Apache::lonnet::cput - ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed; + + $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput + ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed; } # # Set first page @@ -16087,7 +16018,31 @@ sub construct_course { $outcome .= ($fatal?$errtext:'write ok').$linefeed; } - return (1,$outcome,\@clonemsg); +# +# 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); } sub make_unique_code { @@ -16100,7 +16055,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; @@ -16147,8 +16102,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)) { @@ -16166,17 +16120,19 @@ 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'); my %typename = ( official => 'Official course', unofficial => 'Unofficial course', community => 'Community', textbook => 'Textbook course', + placement => 'Placement test', ); return (\@types,\%typename); } @@ -16256,24 +16212,6 @@ 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) = @_; @@ -16281,8 +16219,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; @@ -16304,23 +16240,24 @@ 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$/) { - if (tie(my %oldenv,'GDBM_File',"$lonids/$filename", - &GDBM_READER(),0640)) { + if ($ENV{'SERVER_PORT'} == 443) { my $linkedfile; - if (exists($oldenv{'user.linkedenv'})) { - $linkedfile = $oldenv{'user.linkedenv'}; + if (tie(my %oldenv,'GDBM_File',"$lonids/$cookie.id", + &GDBM_READER(),0640)) { + if (exists($oldenv{'user.linkedenv'})) { + $linkedfile = $oldenv{'user.linkedenv'}; + } + untie(%oldenv); } - untie(%oldenv); - if (unlink("$lonids/$filename")) { - if ($linkedfile =~ /^[a-f0-9]+_linked$/) { - if (-l "$lonids/$linkedfile.id") { - unlink("$lonids/$linkedfile.id"); - } + if (unlink($lonids.'/'.$filename)) { + if ($linkedfile =~ /^[a-f0-9]+_linked\.id$/) { + unlink($lonids.'/'.$linkedfile); } } } else { @@ -16360,8 +16297,7 @@ sub init_user_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'})) { @@ -16376,7 +16312,6 @@ sub init_user_environment { # --------------------------------------------------------- Write first profile { - my $ip = &Apache::lonnet::get_requestor_ip(); my %initial_env = ("user.name" => $username, "user.domain" => $domain, @@ -16395,7 +16330,7 @@ sub init_user_environment { "request.course.sec" => '', "request.role" => 'cm', "request.role.adv" => $env{'user.adv'}, - "request.host" => $ip,); + "request.host" => $ENV{'REMOTE_ADDR'},); if ($form->{'localpath'}) { $initial_env{"browser.localpath"} = $form->{'localpath'}; @@ -16433,7 +16368,7 @@ sub init_user_environment { undef,\%userenv,\%domdef,\%is_adv); } - foreach my $crstype ('official','unofficial','community','textbook') { + foreach my $crstype ('official','unofficial','community','textbook','placement') { $userenv{'canrequest.'.$crstype} = &Apache::lonnet::usertools_access($username,$domain,$crstype, 'reload','requestcourses', @@ -16447,14 +16382,42 @@ sub init_user_environment { my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'], $domain,$username); my $reqstatus = $reqauthor{'author_status'}; - if ($reqstatus eq 'approval' || $reqstatus eq 'approved') { + 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", @@ -16558,12 +16521,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 @@ -16579,19 +16542,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 @@ -16682,15 +16645,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', ); @@ -16698,6 +16665,8 @@ sub build_filters { my $typeval = 'Course'; if ($crstype eq 'Community') { $typeval = 'Community'; + } elsif ($crstype eq 'Placement') { + $typeval = 'Placement'; } $typeselectform = ''; } else { @@ -16706,9 +16675,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.=""; } @@ -16733,7 +16708,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', @@ -16862,7 +16837,7 @@ $typeelement return $jscript.$clonewarning.$output; } -=pod +=pod =item * &timebased_select_form() @@ -16877,7 +16852,7 @@ item - name of form element (sincefilter filter - anonymous hash of criteria and their values Returns: HTML for a select box contained a blank, then six time selections, - with value set in incoming form variables currently selected. + with value set in incoming form variables currently selected. Side Effects: None @@ -16914,7 +16889,7 @@ page load completion for page showing se Inputs: None -Returns: markup containing updateFilters() and hideSearching() javascript functions. +Returns: markup containing updateFilters() and hideSearching() javascript functions. Side Effects: None @@ -16953,7 +16928,7 @@ to retrieve a hash for which keys are co Inputs: -dom - domain being searched +dom - domain being searched type - course type ('Course' or 'Community' or '.' if any). @@ -16965,7 +16940,7 @@ cloneruname - optional username of new c clonerudom - optional domain of new course owner -domcloner - optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by, +domcloner - optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by, (used when DC is using course creation form) codetitles - reference to array of titles of components in institutional codes (official courses). @@ -16975,8 +16950,8 @@ cc_clone - escaped comma separated list reqcrsdom - domain of new course, where search_courses is used to identify potential courses to clone -reqinstcode - institutional code of new course, where search_courses is used to identify potential - courses to clone +reqinstcode - institutional code of new course, where search_courses is used to identify potential + courses to clone Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type. @@ -17102,8 +17077,8 @@ $required - LON-CAPA version needed by c Returns: -$switchserver - query string tp append to /adm/switchserver call (if - current server's LON-CAPA version is too old. +$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. @@ -17216,7 +17191,7 @@ 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). + change in current course. (default: 600 s). Returns: an array; first element is: @@ -17224,9 +17199,9 @@ Returns: an array; first element is: '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 + on current server hosting user's session '' - if no action required. @@ -17234,10 +17209,10 @@ Returns: an array; first element is: If first item element is 'switch': -second item is $switchwarning - Warning message if no suitable server found to host session. +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. + and current role. otherwise: no other elements returned. @@ -17463,10 +17438,10 @@ sub symb_to_docspath { } sub captcha_display { - my ($context,$lonhost,$defdom) = @_; + my ($context,$lonhost) = @_; my ($output,$error); - my ($captcha,$pubkey,$privkey,$version) = - &get_captcha_config($context,$lonhost,$defdom); + my ($captcha,$pubkey,$privkey,$version) = + &get_captcha_config($context,$lonhost); if ($captcha eq 'original') { $output = &create_captcha(); unless ($output) { @@ -17482,9 +17457,9 @@ sub captcha_display { } sub captcha_response { - my ($context,$lonhost,$defdom) = @_; + my ($context,$lonhost) = @_; my ($captcha_chk,$captcha_error); - my ($captcha,$pubkey,$privkey,$version) = &get_captcha_config($context,$lonhost,$defdom); + my ($captcha,$pubkey,$privkey,$version) = &get_captcha_config($context,$lonhost); if ($captcha eq 'original') { ($captcha_chk,$captcha_error) = &check_captcha(); } elsif ($captcha eq 'recaptcha') { @@ -17496,7 +17471,7 @@ sub captcha_response { } sub get_captcha_config { - my ($context,$lonhost,$dom_in_effect) = @_; + my ($context,$lonhost) = @_; my ($captcha,$pubkey,$privkey,$version,$hashtocheck); my $hostname = &Apache::lonnet::hostname($lonhost); my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname); @@ -17536,7 +17511,7 @@ sub get_captcha_config { $captcha = 'recaptcha'; $version = $domconfhash{$serverhomedom.'.login.recaptchaversion'}; if ($version ne '2') { - $version = 1; + $version = 1; } } else { $captcha = 'original'; @@ -17544,27 +17519,6 @@ sub get_captcha_config { } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') { $captcha = 'original'; } - } elsif ($context eq 'passwords') { - if ($dom_in_effect) { - my %passwdconf = &Apache::lonnet::get_passwdconf($dom_in_effect); - if ($passwdconf{'captcha'} eq 'recaptcha') { - if (ref($passwdconf{'recaptchakeys'}) eq 'HASH') { - $pubkey = $passwdconf{'recaptchakeys'}{'public'}; - $privkey = $passwdconf{'recaptchakeys'}{'private'}; - } - if ($privkey && $pubkey) { - $captcha = 'recaptcha'; - $version = $passwdconf{'recaptchaversion'}; - if ($version ne '2') { - $version = 1; - } - } else { - $captcha = 'original'; - } - } elsif ($passwdconf{'captcha'} ne 'notused') { - $captcha = 'original'; - } - } } return ($captcha,$pubkey,$privkey,$version); } @@ -17582,17 +17536,13 @@ sub create_captcha { if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') { $output = ''."\n". - ''. &mt('Type in the letters/numbers shown below').' '. ''. - '
'. + '
'. 'captcha'; last; } } - if ($output eq '') { - &Apache::lonnet::logthis("Failed to create Captcha code after $tries attempts."); - } return $output; } @@ -17631,8 +17581,7 @@ sub check_captcha { sub create_recaptcha { my ($pubkey,$version) = @_; if ($version >= 2) { - return '
'. - '
'; + return '
'; } else { my $use_ssl; if ($ENV{'SERVER_PORT'} == 443) { @@ -17644,22 +17593,26 @@ sub create_recaptcha { &mt('If the text is hard to read, [_1] will replace them.', 'reCAPTCHA refresh'). '

'; - } + } } sub check_recaptcha { my ($privkey,$version) = @_; my $captcha_chk; - my $ip = &Apache::lonnet::get_requestor_ip(); if ($version >= 2) { - my $ua = LWP::UserAgent->new; - $ua->timeout(10); my %info = ( - secret => $privkey, + secret => $privkey, response => $env{'form.g-recaptcha-response'}, - remoteip => $ip, + remoteip => $ENV{'REMOTE_ADDR'}, ); - my $response = $ua->post('https://www.google.com/recaptcha/api/siteverify',\%info); + 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') { @@ -17673,7 +17626,7 @@ sub check_recaptcha { my $captcha_result = $captcha->check_answer( $privkey, - $ip, + $ENV{'REMOTE_ADDR'}, $env{'form.recaptcha_challenge_field'}, $env{'form.recaptcha_response_field'}, ); @@ -17722,12 +17675,9 @@ sub cleanup_html { # 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. +# $context is the calling context -- roles, grades, contents, menu or flip. sub critical_redirect { my ($interval,$context) = @_; - unless (($env{'user.domain'} ne '') && ($env{'user.name'} ne '')) { - return (); - } if ((time-$env{'user.criticalcheck.time'})>$interval) { if (($env{'request.course.id'}) && (($context eq 'flip') || ($context eq 'contents'))) { my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; @@ -17744,18 +17694,18 @@ sub critical_redirect { } } } - my @what=&Apache::lonnet::dump('critical', $env{'user.domain'}, + my @what=&Apache::lonnet::dump('critical', $env{'user.domain'}, $env{'user.name'}); &Apache::lonnet::appenv({'user.criticalcheck.time'=>time}); my $redirecturl; if ($what[0]) { - if (($what[0] ne 'con_lost') && ($what[0] ne 'no_such_host') && ($what[0]!~/^error\:/)) { - $redirecturl='/adm/email?critical=display'; - my $url=&Apache::lonnet::absolute_url().$redirecturl; + 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 (); } @@ -17809,342 +17759,6 @@ sub des_decrypt { 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; - $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 $ua = LWP::UserAgent->new; - $ua->timeout(5); - my $response=$ua->request($request); - if ($response->is_success()) { - my $secpolicy = lc($response->header('content-security-policy')); - my $xframeop = lc($response->header('x-frame-options')); - $secpolicy =~ s/^\s+|\s+$//g; - $xframeop =~ s/^\s+|\s+$//g; - if (($secpolicy ne '') || ($xframeop ne '')) { - my $remotehost = $remprotocol.'://'.$remhost; - my ($origin,$protocol,$port); - if ($ENV{'SERVER_PORT'} =~/^\d+$/) { - $port = $ENV{'SERVER_PORT'}; - } else { - $port = 80; - } - if ($absolute eq '') { - $protocol = 'http:'; - if ($port == 443) { - $protocol = 'https:'; - } - $origin = $protocol.'//'.lc($hostname); - } else { - $origin = lc($absolute); - ($protocol,$hostname) = ($absolute =~ m{^(https?:)//([^/]+)$}); - } - if (($secpolicy) && ($secpolicy =~ /\Qframe-ancestors\E([^;]*)(;|$)/)) { - my $framepolicy = $1; - $framepolicy =~ s/^\s+|\s+$//g; - my @policies = split(/\s+/,$framepolicy); - if (@policies) { - if (grep(/^\Q'none'\E$/,@policies)) { - $uselink = 1; - } else { - $uselink = 1; - if ((grep(/^\Q*\E$/,@policies)) || (grep(/^\Q$protocol\E$/,@policies)) || - (($origin ne '') && (grep(/^\Q$origin\E$/,@policies))) || - (($ip ne '') && (grep(/^\Q$ip\E$/,@policies)))) { - undef($uselink); - } - if ($uselink) { - if (grep(/^\Q'self'\E$/,@policies)) { - if (($origin ne '') && ($remotehost eq $origin)) { - undef($uselink); - } - } - } - if ($uselink) { - my @possok; - if ($ip ne '') { - push(@possok,$ip); - } - my $hoststr = ''; - foreach my $part (reverse(split(/\./,$hostname))) { - if ($hoststr eq '') { - $hoststr = $part; - } else { - $hoststr = "$part.$hoststr"; - } - if ($hoststr eq $hostname) { - push(@possok,$hostname); - } else { - push(@possok,"*.$hoststr"); - } - } - if (@possok) { - foreach my $poss (@possok) { - last if (!$uselink); - foreach my $policy (@policies) { - if ($policy =~ m{^(\Q$protocol\E//|)\Q$poss\E(\Q:$port\E|)$}) { - undef($uselink); - last; - } - } - } - } - } - } - } - } elsif ($xframeop ne '') { - $uselink = 1; - my @policies = split(/\s*,\s*/,$xframeop); - if (@policies) { - unless (grep(/^deny$/,@policies)) { - if ($origin ne '') { - if (grep(/^sameorigin$/,@policies)) { - if ($remotehost eq $origin) { - undef($uselink); - } - } - if ($uselink) { - foreach my $policy (@policies) { - if ($policy =~ /^allow-from\s*(.+)$/) { - my $allowfrom = $1; - if (($allowfrom ne '') && ($allowfrom eq $origin)) { - undef($uselink); - last; - } - } - } - } - } - } - } - } - } - } - if ($nocache) { - if ($cached) { - my $devalidate; - if ($uselink && !$result) { - $devalidate = 1; - } elsif (!$uselink && $result) { - $devalidate = 1; - } - if ($devalidate) { - &Apache::lonnet::devalidate_cache_new('noiframe',$remhost.':'.$remport); - } - } - } else { - if ($uselink) { - $result = 1; - } else { - $result = 0; - } - &Apache::lonnet::do_cache_new('noiframe',$remhost.':'.$remport,$result,3600); - } - return $uselink; -} - -sub page_menu { - my ($menucolls,$menunum) = @_; - my %menu; - foreach my $item (split(/;/,$menucolls)) { - my ($num,$value) = split(/\%/,$item); - if ($num eq $menunum) { - my @entries = split(/\&/,$value); - foreach my $entry (@entries) { - my ($name,$fields) = split(/=/,$entry); - if (($name eq 'top') || ($name eq 'inline') || ($name eq 'foot') || ($name eq 'main')) { - $menu{$name} = $fields; - } else { - my @shown; - if ($fields =~ /,/) { - @shown = split(/,/,$fields); - } else { - @shown = ($fields); - } - if (@shown) { - foreach my $field (@shown) { - next if ($field eq ''); - $menu{$field} = 1; - } - } - } - } - } - } - return %menu; -} - 1; __END__;