version 1.1075.2.158, 2021/12/13 19:55:44
|
version 1.1075.2.161.2.4, 2022/01/23 02:02:48
|
Line 83 use Crypt::DES;
|
Line 83 use Crypt::DES;
|
use DynaLoader; # for Crypt::DES version |
use DynaLoader; # for Crypt::DES version |
use File::Copy(); |
use File::Copy(); |
use File::Path(); |
use File::Path(); |
|
use String::CRC32(); |
|
use Short::URL(); |
|
|
# ---------------------------------------------- Designs |
# ---------------------------------------------- Designs |
use vars qw(%defaultdesign); |
use vars qw(%defaultdesign); |
Line 4730 sub findallcourses {
|
Line 4732 sub findallcourses {
|
sub blockcheck { |
sub blockcheck { |
my ($setters,$activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller) = @_; |
my ($setters,$activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller) = @_; |
|
|
unless ($activity eq 'docs') { |
unless (($activity eq 'docs') || ($activity eq 'reinit') || ($activity eq 'alert')) { |
my ($has_evb,$check_ipaccess); |
my ($has_evb,$check_ipaccess); |
my $dom = $env{'user.domain'}; |
my $dom = $env{'user.domain'}; |
if ($env{'request.course.id'}) { |
if ($env{'request.course.id'}) { |
Line 4753 sub blockcheck {
|
Line 4755 sub blockcheck {
|
} |
} |
} |
} |
} |
} |
|
} elsif (($activity eq 'com') || ($activity eq 'port') || ($activity eq 'blogs') || |
|
($activity eq 'about') || ($activity eq 'wishlist') || ($activity eq 'passwd')) { |
|
my $checkrole; |
|
if ($env{'request.role.domain'} eq '') { |
|
$checkrole = "cm./$env{'user.domain'}/"; |
|
} else { |
|
$checkrole = "cm./$env{'request.role.domain'}/"; |
|
} |
|
if (($checkrole) && (&Apache::lonnet::allowed('evb',undef,undef,$checkrole))) { |
|
$has_evb = 1; |
|
} |
} |
} |
unless ($has_evb || $check_ipaccess) { |
unless ($has_evb || $check_ipaccess) { |
my @machinedoms = &Apache::lonnet::current_machine_domains(); |
my @machinedoms = &Apache::lonnet::current_machine_domains(); |
Line 4798 sub blockcheck {
|
Line 4811 sub blockcheck {
|
} |
} |
} |
} |
} |
} |
|
if (($activity eq 'wishlist') || ($activity eq 'annotate')) { |
|
return (); |
|
} |
} |
} |
if (defined($udom) && defined($uname)) { |
if (defined($udom) && defined($uname)) { |
# If uname and udom are for a course, check for blocks in the course. |
# If uname and udom are for a course, check for blocks in the course. |
Line 4814 sub blockcheck {
|
Line 4830 sub blockcheck {
|
my $startblock = 0; |
my $startblock = 0; |
my $endblock = 0; |
my $endblock = 0; |
my $triggerblock = ''; |
my $triggerblock = ''; |
my %live_courses = &findallcourses(undef,$uname,$udom); |
my %live_courses; |
|
unless (($activity eq 'wishlist') || ($activity eq 'annotate')) { |
|
%live_courses = &findallcourses(undef,$uname,$udom); |
|
} |
|
|
# If uname is for a user, and activity is course-specific, i.e., |
# If uname is for a user, and activity is course-specific, i.e., |
# boards, chat or groups, check for blocking in current course only. |
# boards, chat or groups, check for blocking in current course only. |
|
|
if (($activity eq 'boards' || $activity eq 'chat' || |
if (($activity eq 'boards' || $activity eq 'chat' || |
$activity eq 'groups' || $activity eq 'printout') && |
$activity eq 'groups' || $activity eq 'printout' || |
($env{'request.course.id'})) { |
$activity eq 'search' || $activity eq 'reinit' || |
|
$activity eq 'alert') && ($env{'request.course.id'})) { |
foreach my $key (keys(%live_courses)) { |
foreach my $key (keys(%live_courses)) { |
if ($key ne $env{'request.course.id'}) { |
if ($key ne $env{'request.course.id'}) { |
delete($live_courses{$key}); |
delete($live_courses{$key}); |
Line 5155 END_MYBLOCK
|
Line 5175 END_MYBLOCK
|
$text = &mt('Gradebook Blocked'); |
$text = &mt('Gradebook Blocked'); |
} elsif ($activity eq 'search') { |
} elsif ($activity eq 'search') { |
$text = &mt('Search Blocked'); |
$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') { |
} elsif ($activity eq 'about') { |
$text = &mt('Access to User Information Pages Blocked'); |
$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"; |
$output .= <<"END_BLOCK"; |
<div class='$class'> |
<div class='$class'> |
Line 5191 sub check_ip_acc {
|
Line 5219 sub check_ip_acc {
|
} |
} |
|
|
my $name; |
my $name; |
foreach my $pattern (split(',',$acc)) { |
my %access = ( |
$pattern =~ s/^\s*//; |
allowfrom => 1, |
$pattern =~ s/\s*$//; |
denyfrom => 0, |
|
); |
|
my @allows; |
|
my @denies; |
|
foreach my $item (split(',',$acc)) { |
|
$item =~ s/^\s*//; |
|
$item =~ s/\s*$//; |
|
if ($item =~ /^\!(.+)$/) { |
|
push(@denies,$1); |
|
} else { |
|
push(@allows,$item); |
|
} |
|
} |
|
my $numdenies = scalar(@denies); |
|
my $numallows = scalar(@allows); |
|
my $count = 0; |
|
foreach my $pattern (@denies,@allows) { |
|
$count ++; |
|
my $acctype = 'allowfrom'; |
|
if ($count <= $numdenies) { |
|
$acctype = 'denyfrom'; |
|
} |
if ($pattern =~ /\*$/) { |
if ($pattern =~ /\*$/) { |
#35.8.* |
#35.8.* |
$pattern=~s/\*//; |
$pattern=~s/\*//; |
if ($ip =~ /^\Q$pattern\E/) { $allowed=1; } |
if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; } |
} elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) { |
} elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) { |
#35.8.3.[34-56] |
#35.8.3.[34-56] |
my $low=$2; |
my $low=$2; |
Line 5205 sub check_ip_acc {
|
Line 5254 sub check_ip_acc {
|
$pattern=$1; |
$pattern=$1; |
if ($ip =~ /^\Q$pattern\E/) { |
if ($ip =~ /^\Q$pattern\E/) { |
my $last=(split(/\./,$ip))[3]; |
my $last=(split(/\./,$ip))[3]; |
if ($last <=$high && $last >=$low) { $allowed=1; } |
if ($last <=$high && $last >=$low) { $allowed=$access{$acctype}; } |
} |
} |
} elsif ($pattern =~ /^\*/) { |
} elsif ($pattern =~ /^\*/) { |
#*.msu.edu |
#*.msu.edu |
Line 5215 sub check_ip_acc {
|
Line 5264 sub check_ip_acc {
|
my $netaddr=inet_aton($ip); |
my $netaddr=inet_aton($ip); |
($name)=gethostbyaddr($netaddr,AF_INET); |
($name)=gethostbyaddr($netaddr,AF_INET); |
} |
} |
if ($name =~ /\Q$pattern\E$/i) { $allowed=1; } |
if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; } |
} elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) { |
} elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) { |
#127.0.0.1 |
#127.0.0.1 |
if ($ip =~ /^\Q$pattern\E/) { $allowed=1; } |
if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; } |
} else { |
} else { |
#some.name.com |
#some.name.com |
if (!defined($name)) { |
if (!defined($name)) { |
Line 5226 sub check_ip_acc {
|
Line 5275 sub check_ip_acc {
|
my $netaddr=inet_aton($ip); |
my $netaddr=inet_aton($ip); |
($name)=gethostbyaddr($netaddr,AF_INET); |
($name)=gethostbyaddr($netaddr,AF_INET); |
} |
} |
if ($name =~ /\Q$pattern\E$/i) { $allowed=1; } |
if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; } |
|
} |
|
if ($allowed =~ /^(0|1)$/) { last; } |
|
} |
|
if ($allowed eq '') { |
|
if ($numdenies && !$numallows) { |
|
$allowed = 1; |
|
} else { |
|
$allowed = 0; |
} |
} |
if ($allowed) { last; } |
|
} |
} |
return $allowed; |
return $allowed; |
} |
} |
Line 5424 sub domainlogo {
|
Line 5480 sub domainlogo {
|
&Apache::lonnet::repcopy($local_name); |
&Apache::lonnet::repcopy($local_name); |
} |
} |
$imgsrc = &lonhttpdurl($imgsrc); |
$imgsrc = &lonhttpdurl($imgsrc); |
} |
} |
return '<img src="'.$imgsrc.'" alt="'.$domain.'" />'; |
my $alttext = $domain; |
|
if ($designhash{$domain.'.login.alttext_domlogo'} ne '') { |
|
$alttext = $designhash{$domain.'.login.alttext_domlogo'}; |
|
} |
|
return '<img src="'.$imgsrc.'" alt="'.$alttext.'" id="lclogindomlogo" />'; |
} elsif (defined(&Apache::lonnet::domain($domain,'description'))) { |
} elsif (defined(&Apache::lonnet::domain($domain,'description'))) { |
return &Apache::lonnet::domain($domain,'description'); |
return &Apache::lonnet::domain($domain,'description'); |
} else { |
} else { |
Line 5649 Inputs:
|
Line 5709 Inputs:
|
inlineremote items to be added in "Functions" menu below |
inlineremote items to be added in "Functions" menu below |
breadcrumbs. |
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 |
=back |
|
|
Returns: A uniform header for LON-CAPA web pages. |
Returns: A uniform header for LON-CAPA web pages. |
Line 5660 other decorations will be returned.
|
Line 5733 other decorations will be returned.
|
|
|
sub bodytag { |
sub bodytag { |
my ($title,$function,$addentries,$bodyonly,$domain,$forcereg, |
my ($title,$function,$addentries,$bodyonly,$domain,$forcereg, |
$no_nav_bar,$bgcolor,$no_inline_link,$args,$advtoolsref)=@_; |
$no_nav_bar,$bgcolor,$no_inline_link,$args,$advtoolsref, |
|
$ltiscope,$ltiuri,$ltimenu,$menucoll,$menuref)=@_; |
|
|
my $public; |
my $public; |
if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')) |
if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')) |
Line 5689 sub bodytag {
|
Line 5763 sub bodytag {
|
if ($realm) { |
if ($realm) { |
$realm = '/'.$realm; |
$realm = '/'.$realm; |
} |
} |
if ($rol eq 'ca') { |
if ($role eq 'ca') { |
my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$}); |
my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$}); |
$realm = &plainname($rname,$rdom); |
$realm = &plainname($rname,$rdom); |
} |
} |
Line 5744 sub bodytag {
|
Line 5818 sub bodytag {
|
undef($role); |
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 = '<h1>'.$title.'</h1>'; |
my $titleinfo = '<h1>'.$title.'</h1>'; |
# |
# |
# Extra info if you are the DC |
# Extra info if you are the DC |
my $dc_info = ''; |
my $dc_info = ''; |
if (($env{'user.adv'} && ($env{'request.course.id'}) && |
if (($env{'user.adv'}) && ($env{'request.course.id'}) && $showcrstitle && |
(exists($env{'user.role.dc./'.$env{'course.'.$cid.'.domain'}.'/'}))) { |
(exists($env{'user.role.dc./'.$env{'course.'.$cid.'.domain'}.'/'}))) { |
$dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'}; |
$dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'}; |
$dc_info =~ s/\s+$//; |
$dc_info =~ s/\s+$//; |
} |
} |
|
|
|
my $crstype; |
|
if ($cid) { |
|
$crstype = $env{'course.'.$cid.'.type'}; |
|
} elsif ($args->{'crstype'}) { |
|
$crstype = $args->{'crstype'}; |
|
} |
|
|
$role = '<span class="LC_nobreak">('.$role.')</span>' if ($role && !$env{'browser.mobile'}); |
$role = '<span class="LC_nobreak">('.$role.')</span>' if ($role && !$env{'browser.mobile'}); |
|
|
if ($env{'request.state'} eq 'construct') { $forcereg=1; } |
if ($env{'request.state'} eq 'construct') { $forcereg=1; } |
Line 5781 sub bodytag {
|
Line 5885 sub bodytag {
|
$bodytag .= Apache::lonhtmlcommon::scripttag( |
$bodytag .= Apache::lonhtmlcommon::scripttag( |
Apache::lonmenu::utilityfunctions($httphost), 'start'); |
Apache::lonmenu::utilityfunctions($httphost), 'start'); |
|
|
my ($left,$right) = Apache::lonmenu::primary_menu($args->{'links_disabled'}); |
unless ($args->{'no_primary_menu'}) { |
|
my ($left,$right) = Apache::lonmenu::primary_menu($crstype,$ltimenu,$menucoll,$menuref, |
if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) { |
$args->{'links_disabled'}); |
if ($dc_info) { |
if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) { |
$dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|; |
if ($dc_info) { |
|
$dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|; |
|
} |
|
$bodytag .= qq|<div id="LC_nav_bar">$left $role<br /> |
|
<em>$realm</em> $dc_info</div>|; |
|
return $bodytag; |
} |
} |
$bodytag .= qq|<div id="LC_nav_bar">$left $role<br /> |
|
<em>$realm</em> $dc_info</div>|; |
|
return $bodytag; |
|
} |
|
|
|
unless ($env{'request.symb'} =~ m/\.page___\d+___/) { |
unless ($env{'request.symb'} =~ m/\.page___\d+___/) { |
$bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|; |
$bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|; |
} |
} |
|
|
$bodytag .= $right; |
$bodytag .= $right; |
|
|
if ($dc_info) { |
if ($dc_info) { |
$dc_info = &dc_courseid_toggle($dc_info); |
$dc_info = &dc_courseid_toggle($dc_info); |
|
} |
|
$bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|; |
} |
} |
$bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|; |
|
|
|
#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'}) { |
if ($args->{'no_secondary_menu'}) { |
Line 5809 sub bodytag {
|
Line 5915 sub bodytag {
|
} |
} |
#don't show menus for public users |
#don't show menus for public users |
if (!$public){ |
if (!$public){ |
$bodytag .= Apache::lonmenu::secondary_menu($httphost,$args->{'links_disabled'}); |
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::serverform(); |
$bodytag .= Apache::lonmenu::serverform(); |
$bodytag .= Apache::lonhtmlcommon::scripttag('', 'end'); |
$bodytag .= Apache::lonhtmlcommon::scripttag('', 'end'); |
if ($env{'request.state'} eq 'construct') { |
if ($env{'request.state'} eq 'construct') { |
$bodytag .= &Apache::lonmenu::innerregister($forcereg, |
$bodytag .= &Apache::lonmenu::innerregister($forcereg, |
$args->{'bread_crumbs'},'','',$hostname); |
$args->{'bread_crumbs'},'','',$hostname,$ltiscope,$ltiuri); |
} elsif ($forcereg) { |
} elsif ($forcereg) { |
$bodytag .= &Apache::lonmenu::innerregister($forcereg,undef, |
$bodytag .= &Apache::lonmenu::innerregister($forcereg,undef, |
$args->{'group'}, |
$args->{'group'}, |
$args->{'hide_buttons', |
$args->{'hide_buttons'}, |
$hostname}); |
$hostname,$ltiscope,$ltiuri); |
} else { |
} else { |
my $forbodytag; |
my $forbodytag; |
&Apache::lonmenu::prepare_functions($env{'request.noversionuri'}, |
&Apache::lonmenu::prepare_functions($env{'request.noversionuri'}, |
Line 8138 ADDMETA
|
Line 8249 ADDMETA
|
my $newserver = &Apache::lonnet::spareserver(undef,30000,undef,1,$dom_in_use); |
my $newserver = &Apache::lonnet::spareserver(undef,30000,undef,1,$dom_in_use); |
if (($newserver eq '') && ($offloadoth)) { |
if (($newserver eq '') && ($offloadoth)) { |
my @domains = &Apache::lonnet::current_machine_domains(); |
my @domains = &Apache::lonnet::current_machine_domains(); |
if (($dom_in_use ne '') && (!grep(/^\Q$dom_in_use\E$/,@domains))) { |
if (($dom_in_use ne '') && (!grep(/^\Q$dom_in_use\E$/,@domains))) { |
($newserver) = &Apache::lonnet::choose_server($dom_in_use); |
($newserver) = &Apache::lonnet::choose_server($dom_in_use); |
} |
} |
} |
} |
Line 8454 sub start_page {
|
Line 8565 sub start_page {
|
#&Apache::lonnet::logthis("start_page ".join(':',caller(0))); |
#&Apache::lonnet::logthis("start_page ".join(':',caller(0))); |
|
|
$env{'internal.start_page'}++; |
$env{'internal.start_page'}++; |
my ($result,@advtools); |
my ($result,@advtools,$ltiscope,$ltiuri,%ltimenu,$menucoll,%menu); |
|
|
if (! exists($args->{'skip_phases'}{'head'}) ) { |
if (! exists($args->{'skip_phases'}{'head'}) ) { |
$result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args); |
$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 (! exists($args->{'skip_phases'}{'body'}) ) { |
if ($args->{'frameset'}) { |
if ($args->{'frameset'}) { |
my $attr_string = &make_attr_string($args->{'force_register'}, |
my $attr_string = &make_attr_string($args->{'force_register'}, |
Line 8472 sub start_page {
|
Line 8653 sub start_page {
|
$args->{'only_body'}, $args->{'domain'}, |
$args->{'only_body'}, $args->{'domain'}, |
$args->{'force_register'}, $args->{'no_nav_bar'}, |
$args->{'force_register'}, $args->{'no_nav_bar'}, |
$args->{'bgcolor'}, $args->{'no_inline_link'}, |
$args->{'bgcolor'}, $args->{'no_inline_link'}, |
$args, \@advtools); |
$args, \@advtools, |
|
$ltiscope,$ltiuri,\%ltimenu,$menucoll,\%menu); |
} |
} |
} |
} |
|
|
Line 8507 sub start_page {
|
Line 8689 sub start_page {
|
} |
} |
my $menulink; |
my $menulink; |
# if arg: bread_crumbs_nomenu is true pass 0 as $menulink item. |
# if arg: bread_crumbs_nomenu is true pass 0 as $menulink item. |
if (exists($args->{'bread_crumbs_nomenu'})) { |
if ((exists($args->{'bread_crumbs_nomenu'})) || |
|
($ltiscope eq 'map') || ($ltiscope eq 'resource')) { |
$menulink = 0; |
$menulink = 0; |
} else { |
} else { |
undef($menulink); |
undef($menulink); |
Line 8515 sub start_page {
|
Line 8698 sub start_page {
|
#if bread_crumbs_component exists show it as headline else show only the breadcrumbs |
#if bread_crumbs_component exists show it as headline else show only the breadcrumbs |
if(exists($args->{'bread_crumbs_component'})){ |
if(exists($args->{'bread_crumbs_component'})){ |
$result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'},'',$menulink); |
$result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'},'',$menulink); |
}else{ |
} else { |
$result .= &Apache::lonhtmlcommon::breadcrumbs('','',$menulink); |
$result .= &Apache::lonhtmlcommon::breadcrumbs('','',$menulink); |
} |
} |
} elsif (($env{'environment.remote'} eq 'on') && |
} elsif (($env{'environment.remote'} eq 'on') && |
Line 8559 sub end_page {
|
Line 8742 sub end_page {
|
return $result; |
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 { |
sub wishlist_window { |
return(<<'ENDWISHLIST'); |
return(<<'ENDWISHLIST'); |
<script type="text/javascript"> |
<script type="text/javascript"> |
Line 9050 function expand_div(caller) {
|
Line 9330 function expand_div(caller) {
|
|
|
sub simple_error_page { |
sub simple_error_page { |
my ($r,$title,$msg,$args) = @_; |
my ($r,$title,$msg,$args) = @_; |
|
my %displayargs; |
if (ref($args) eq 'HASH') { |
if (ref($args) eq 'HASH') { |
if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); } |
if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); } |
|
if ($args->{'only_body'}) { |
|
$displayargs{'only_body'} = 1; |
|
} |
|
if ($args->{'no_nav_bar'}) { |
|
$displayargs{'no_nav_bar'} = 1; |
|
} |
} else { |
} else { |
$msg = &mt($msg); |
$msg = &mt($msg); |
} |
} |
|
|
my $page = |
my $page = |
&Apache::loncommon::start_page($title). |
&Apache::loncommon::start_page($title,'',\%displayargs). |
'<p class="LC_error">'.$msg.'</p>'. |
'<p class="LC_error">'.$msg.'</p>'. |
&Apache::loncommon::end_page(); |
&Apache::loncommon::end_page(); |
if (ref($r)) { |
if (ref($r)) { |
Line 14886 sub recurse_categories {
|
Line 15173 sub recurse_categories {
|
for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) { |
for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) { |
my $name = $cats->[$depth]{$category}[$k]; |
my $name = $cats->[$depth]{$category}[$k]; |
my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower; |
my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower; |
my $trailstr = join(' -> ',(@{$parents},$category)); |
my $trailstr = join(' » ',(@{$parents},$category)); |
if ($allitems->{$item} eq '') { |
if ($allitems->{$item} eq '') { |
push(@{$trails},$trailstr); |
push(@{$trails},$trailstr); |
$allitems->{$item} = scalar(@{$trails})-1; |
$allitems->{$item} = scalar(@{$trails})-1; |
Line 15276 sub check_clone {
|
Line 15563 sub check_clone {
|
my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'}; |
my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'}; |
my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid); |
my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid); |
my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom); |
my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom); |
my $clonemsg; |
my $clonetitle; |
|
my @clonemsg; |
my $can_clone = 0; |
my $can_clone = 0; |
my $lctype = lc($args->{'crstype'}); |
my $lctype = lc($args->{'crstype'}); |
if ($lctype ne 'community') { |
if ($lctype ne 'community') { |
Line 15284 sub check_clone {
|
Line 15572 sub check_clone {
|
} |
} |
if ($clonehome eq 'no_host') { |
if ($clonehome eq 'no_host') { |
if ($args->{'crstype'} eq 'Community') { |
if ($args->{'crstype'} eq 'Community') { |
$clonemsg = &mt('No new community created.').$linefeed.&mt('A new community could not be cloned from the specified original - [_1] - because it is a non-existent community.',$args->{'clonecourse'}.':'.$args->{'clonedomain'}); |
push(@clonemsg,({ |
|
mt => 'No new community created.', |
|
args => [], |
|
}, |
|
{ |
|
mt => 'A new community could not be cloned from the specified original - [_1] - because it is a non-existent community.', |
|
args => [$args->{'clonedomain'}.':'.$args->{'clonedomain'}], |
|
})); |
} else { |
} else { |
$clonemsg = &mt('No new course created.').$linefeed.&mt('A new course could not be cloned from the specified original - [_1] - because it is a non-existent course.',$args->{'clonecourse'}.':'.$args->{'clonedomain'}); |
push(@clonemsg,({ |
} |
mt => 'No new course created.', |
|
args => [], |
|
}, |
|
{ |
|
mt => 'A new course could not be cloned from the specified original - [_1] - because it is a non-existent course.', |
|
args => [$args->{'clonecourse'}.':'.$args->{'clonedomain'}], |
|
})); |
|
} |
} else { |
} else { |
my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1}); |
my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1}); |
|
$clonetitle = $clonedesc{'description'}; |
if ($args->{'crstype'} eq 'Community') { |
if ($args->{'crstype'} eq 'Community') { |
if ($clonedesc{'type'} ne 'Community') { |
if ($clonedesc{'type'} ne 'Community') { |
$clonemsg = &mt('No new community created.').$linefeed.&mt('A new community could not be cloned from the specified original - [_1] - because it is a course not a community.',$args->{'clonecourse'}.':'.$args->{'clonedomain'}); |
push(@clonemsg,({ |
return ($can_clone, $clonemsg, $cloneid, $clonehome); |
mt => 'No new community created.', |
|
args => [], |
|
}, |
|
{ |
|
mt => 'A new community could not be cloned from the specified original - [_1] - because it is a course not a community.', |
|
args => [$args->{'clonecourse'}.':'.$args->{'clonedomain'}], |
|
})); |
|
return ($can_clone,\@clonemsg,$cloneid,$clonehome); |
} |
} |
} |
} |
if (($env{'request.role.domain'} eq $args->{'clonedomain'}) && |
if (($env{'request.role.domain'} eq $args->{'clonedomain'}) && |
Line 15382 sub check_clone {
|
Line 15692 sub check_clone {
|
} |
} |
unless ($can_clone) { |
unless ($can_clone) { |
if ($args->{'crstype'} eq 'Community') { |
if ($args->{'crstype'} eq 'Community') { |
$clonemsg = &mt('No new community created.').$linefeed.&mt('The new community could not be cloned from the existing community because the new community owner ([_1]) does not have cloning rights in the existing community ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}); |
push(@clonemsg,({ |
|
mt => 'No new community created.', |
|
args => [], |
|
}, |
|
{ |
|
mt => 'The new community could not be cloned from the existing community because the new community owner ([_1]) does not have cloning rights in the existing community ([_2]).', |
|
args => [$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}], |
|
})); |
} else { |
} else { |
$clonemsg = &mt('No new course created.').$linefeed.&mt('The new course could not be cloned from the existing course because the new course owner ([_1]) does not have cloning rights in the existing course ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}); |
push(@clonemsg,({ |
|
mt => 'No new course created.', |
|
args => [], |
|
}, |
|
{ |
|
mt => 'The new course could not be cloned from the existing course because the new course owner ([_1]) does not have cloning rights in the existing course ([_2]).', |
|
args => [$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}], |
|
})); |
} |
} |
} |
} |
} |
} |
} |
} |
return ($can_clone, $clonemsg, $cloneid, $clonehome); |
return ($can_clone,\@clonemsg,$cloneid,$clonehome,$clonetitle); |
} |
} |
|
|
sub construct_course { |
sub construct_course { |
my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context, |
my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context, |
$cnum,$category,$coderef) = @_; |
$cnum,$category,$coderef,$callercontext,$user_lh) = @_; |
my $outcome; |
my ($outcome,$msgref,$clonemsgref); |
my $linefeed = '<br />'."\n"; |
my $linefeed = '<br />'."\n"; |
if ($context eq 'auto') { |
if ($context eq 'auto') { |
$linefeed = "\n"; |
$linefeed = "\n"; |
Line 15404 sub construct_course {
|
Line 15728 sub construct_course {
|
# |
# |
# Are we cloning? |
# Are we cloning? |
# |
# |
my ($can_clone, $clonemsg, $cloneid, $clonehome); |
my ($can_clone,$cloneid,$clonehome,$clonetitle); |
if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) { |
if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) { |
($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed); |
($can_clone,$clonemsgref,$cloneid,$clonehome,$clonetitle) = &check_clone($args,$linefeed); |
if ($context ne 'auto') { |
|
if ($clonemsg ne '') { |
|
$clonemsg = '<span class="LC_error">'.$clonemsg.'</span>'; |
|
} |
|
} |
|
$outcome .= $clonemsg.$linefeed; |
|
|
|
if (!$can_clone) { |
if (!$can_clone) { |
return (0,$outcome); |
return (0,$outcome,$clonemsgref); |
} |
} |
} |
} |
|
|
Line 15433 sub construct_course {
|
Line 15750 sub construct_course {
|
$args->{'ccuname'}.':'. |
$args->{'ccuname'}.':'. |
$args->{'ccdomain'}, |
$args->{'ccdomain'}, |
$args->{'crstype'}, |
$args->{'crstype'}, |
$cnum,$context,$category); |
$cnum,$context,$category, |
|
$callercontext); |
|
|
# Note: The testing routines depend on this being output; see |
# Note: The testing routines depend on this being output; see |
# Utils::Course. This needs to at least be output as a comment |
# Utils::Course. This needs to at least be output as a comment |
# if anyone ever decides to not show this, and Utils::Course::new |
# if anyone ever decides to not show this, and Utils::Course::new |
# will need to be suitably modified. |
# will need to be suitably modified. |
$outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed; |
if (($callercontext eq 'auto') && ($user_lh ne '')) { |
|
$outcome .= &mt_user($user_lh,'New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed; |
|
} else { |
|
$outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed; |
|
} |
if ($$courseid =~ /^error:/) { |
if ($$courseid =~ /^error:/) { |
return (0,$outcome); |
return (0,$outcome,$clonemsgref); |
} |
} |
|
|
# |
# |
Line 15450 sub construct_course {
|
Line 15772 sub construct_course {
|
($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid); |
($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid); |
my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom); |
my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom); |
if ($crsuhome eq 'no_host') { |
if ($crsuhome eq 'no_host') { |
$outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed; |
if (($callercontext eq 'auto') && ($user_lh ne '')) { |
return (0,$outcome); |
$outcome .= &mt_user($user_lh, |
|
'Course creation failed, unrecognized course home server.'); |
|
} else { |
|
$outcome .= &mt('Course creation failed, unrecognized course home server.'); |
|
} |
|
$outcome .= $linefeed; |
|
return (0,$outcome,$clonemsgref); |
} |
} |
$outcome .= &mt('Created on').': '.$crsuhome.$linefeed; |
$outcome .= &mt('Created on').': '.$crsuhome.$linefeed; |
|
|
# |
# |
# Do the cloning |
# Do the cloning |
# |
# |
|
my @clonemsg; |
if ($can_clone && $cloneid) { |
if ($can_clone && $cloneid) { |
$clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome); |
push(@clonemsg, |
if ($context ne 'auto') { |
{ |
$clonemsg = '<span class="LC_success">'.$clonemsg.'</span>'; |
mt => 'Created [_1] by cloning from [_2]', |
} |
args => [$crstype,$clonetitle], |
$outcome .= $clonemsg.$linefeed; |
}); |
my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum); |
my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum); |
# Copy all files |
# Copy all files |
&Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'}); |
my @info = |
|
&Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'}, |
|
$args->{'dateshift'},$args->{'crscode'}, |
|
$args->{'ccuname'}.':'.$args->{'ccdomain'}, |
|
$args->{'tinyurls'}); |
|
if (@info) { |
|
push(@clonemsg,@info); |
|
} |
# Restore URL |
# Restore URL |
$cenv{'url'}=$oldcenv{'url'}; |
$cenv{'url'}=$oldcenv{'url'}; |
# Restore title |
# Restore title |
Line 15772 sub construct_course {
|
Line 16108 sub construct_course {
|
$outcome .= ($fatal?$errtext:'write ok').$linefeed; |
$outcome .= ($fatal?$errtext:'write ok').$linefeed; |
} |
} |
|
|
return (1,$outcome); |
return (1,$outcome,\@clonemsg); |
} |
} |
|
|
sub make_unique_code { |
sub make_unique_code { |
Line 16940 sub needs_coursereinit {
|
Line 17276 sub needs_coursereinit {
|
$interval = 600; |
$interval = 600; |
} |
} |
if (($now-$env{'request.course.timechecked'})>$interval) { |
if (($now-$env{'request.course.timechecked'})>$interval) { |
my $lastchange = &Apache::lonnet::get_coursechange($cdom,$cnum); |
|
&Apache::lonnet::appenv({'request.course.timechecked'=>$now}); |
&Apache::lonnet::appenv({'request.course.timechecked'=>$now}); |
|
my $blocked = &blocking_status('reinit',undef,$cnum,$cdom,undef,1); |
|
if ($blocked) { |
|
return (); |
|
} |
|
my $lastchange = &Apache::lonnet::get_coursechange($cdom,$cnum); |
if ($lastchange > $env{'request.course.tied'}) { |
if ($lastchange > $env{'request.course.tied'}) { |
my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired'); |
my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired'); |
if ($curr_reqd_hash{'internal.releaserequired'} ne '') { |
if ($curr_reqd_hash{'internal.releaserequired'} ne '') { |
Line 17403 sub cleanup_html {
|
Line 17743 sub cleanup_html {
|
|
|
# Checks for critical messages and returns a redirect url if one exists. |
# Checks for critical messages and returns a redirect url if one exists. |
# $interval indicates how often to check for messages. |
# $interval indicates how often to check for messages. |
|
# $context is the calling context -- roles, grades, contents, menu or flip. |
sub critical_redirect { |
sub critical_redirect { |
my ($interval) = @_; |
my ($interval,$context) = @_; |
unless (($env{'user.domain'} ne '') && ($env{'user.name'} ne '')) { |
unless (($env{'user.domain'} ne '') && ($env{'user.name'} ne '')) { |
return (); |
return (); |
} |
} |
if ((time-$env{'user.criticalcheck.time'})>$interval) { |
if ((time-$env{'user.criticalcheck.time'})>$interval) { |
|
if (($env{'request.course.id'}) && (($context eq 'flip') || ($context eq 'contents'))) { |
|
my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; |
|
my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; |
|
my $blocked = &blocking_status('alert',undef,$cnum,$cdom,undef,1); |
|
if ($blocked) { |
|
my $checkrole = "cm./$cdom/$cnum"; |
|
if ($env{'request.course.sec'} ne '') { |
|
$checkrole .= "/$env{'request.course.sec'}"; |
|
} |
|
unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) && |
|
($env{'request.role'} !~ m{^st\./$cdom/$cnum})) { |
|
return; |
|
} |
|
} |
|
} |
my @what=&Apache::lonnet::dump('critical', $env{'user.domain'}, |
my @what=&Apache::lonnet::dump('critical', $env{'user.domain'}, |
$env{'user.name'}); |
$env{'user.name'}); |
&Apache::lonnet::appenv({'user.criticalcheck.time'=>time}); |
&Apache::lonnet::appenv({'user.criticalcheck.time'=>time}); |
Line 17474 sub des_decrypt {
|
Line 17830 sub des_decrypt {
|
return $plaintext; |
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 { |
sub is_nonframeable { |
my ($url,$absolute,$hostname,$ip,$nocache) = @_; |
my ($url,$absolute,$hostname,$ip,$nocache) = @_; |
my ($remprotocol,$remhost) = ($url =~ m{^(https?)\://(([a-z0-9]+(-[a-z0-9]+)*\.)+[a-z]{2,})}i); |
my ($remprotocol,$remhost) = ($url =~ m{^(https?)\://(([a-z0-9]+(-[a-z0-9]+)*\.)+[a-z]{2,})}i); |
Line 17627 sub is_nonframeable {
|
Line 18135 sub is_nonframeable {
|
return $uselink; |
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; |
1; |
__END__; |
__END__; |
|
|