version 1.1172.2.118.2.3, 2020/01/21 15:36:29
|
version 1.1172.2.118.2.7, 2020/09/08 02:08:27
|
Line 1162 sub choose_server {
|
Line 1162 sub choose_server {
|
return ($login_host,$hostname,$portal_path,$isredirect,$lowest_load); |
return ($login_host,$hostname,$portal_path,$isredirect,$lowest_load); |
} |
} |
|
|
|
sub get_course_sessions { |
|
my ($cnum,$cdom,$lastactivity) = @_; |
|
my %servers = &internet_dom_servers($cdom); |
|
my %returnhash; |
|
foreach my $server (sort(keys(%servers))) { |
|
my $rep = &reply("coursesessions:$cdom:$cnum:$lastactivity",$server); |
|
my @pairs=split(/\&/,$rep); |
|
unless (($rep eq 'unknown_cmd') || ($rep =~ /^error/)) { |
|
foreach my $item (@pairs) { |
|
my ($key,$value)=split(/=/,$item,2); |
|
$key = &unescape($key); |
|
next if ($key =~ /^error: 2 /); |
|
if (exists($returnhash{$key})) { |
|
next if ($value < $returnhash{$key}); |
|
} |
|
$returnhash{$key}=$value; |
|
} |
|
} |
|
} |
|
return %returnhash; |
|
} |
|
|
# --------------------------------------------- Try to change a user's password |
# --------------------------------------------- Try to change a user's password |
|
|
sub changepass { |
sub changepass { |
Line 3072 sub repcopy {
|
Line 3094 sub repcopy {
|
} |
} |
} |
} |
|
|
|
# ------------------------------------------------- Unsubscribe from a resource |
|
|
|
sub unsubscribe { |
|
my ($fname) = @_; |
|
my $answer; |
|
if ($fname=~/\/(aboutme|syllabus|bulletinboard|smppg)$/) { return $answer; } |
|
$fname=~s/[\n\r]//g; |
|
my $author=$fname; |
|
$author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/; |
|
my ($udom,$uname)=split(/\//,$author); |
|
my $home=homeserver($uname,$udom); |
|
if ($home eq 'no_host') { |
|
$answer = 'no_host'; |
|
} elsif (grep { $_ eq $home } ¤t_machine_ids()) { |
|
$answer = 'home'; |
|
} else { |
|
$answer = reply("unsub:$fname",$home); |
|
} |
|
return $answer; |
|
} |
|
|
# ------------------------------------------------ Get server side include body |
# ------------------------------------------------ Get server side include body |
sub ssi_body { |
sub ssi_body { |
my ($filelink,%form)=@_; |
my ($filelink,%form)=@_; |
Line 3230 sub remove_stale_resfile {
|
Line 3273 sub remove_stale_resfile {
|
$stale = 1; |
$stale = 1; |
} |
} |
if ($stale) { |
if ($stale) { |
unlink($fname); |
if (unlink($fname)) { |
if ($uri!~/\.meta$/) { |
if ($uri!~/\.meta$/) { |
unlink($fname.'.meta'); |
if (-e $fname.'.meta') { |
|
unlink($fname.'.meta'); |
|
} |
|
} |
|
my $unsubresult = &unsubscribe($fname); |
|
unless ($unsubresult eq 'ok') { |
|
&logthis("no unsub of $fname from $homeserver, reason: $unsubresult"); |
|
} |
|
$removed = 1; |
} |
} |
&reply("unsub:$fname",$homeserver); |
|
$removed = 1; |
|
} |
} |
} |
} |
} |
} |
Line 3385 sub can_edit_resource {
|
Line 3434 sub can_edit_resource {
|
$forceedit = 1; |
$forceedit = 1; |
} |
} |
$cfile = $resurl; |
$cfile = $resurl; |
|
} elsif (($resurl =~ m{^/ext/}) && ($symb ne '')) { |
|
my ($map,$id,$res) = &decode_symb($symb); |
|
if ($map =~ /\.page$/) { |
|
$incourse = 1; |
|
if ($env{'form.forceedit'}) { |
|
$forceview = 1; |
|
$cfile = $map; |
|
} else { |
|
$forceedit = 1; |
|
$cfile = '/adm/wrapper'.$resurl; |
|
} |
|
} |
} elsif ($resurl =~ m{^/adm/wrapper/adm/$cdom/$cnum/\d+/ext\.tool$}) { |
} elsif ($resurl =~ m{^/adm/wrapper/adm/$cdom/$cnum/\d+/ext\.tool$}) { |
$incourse = 1; |
$incourse = 1; |
if ($env{'form.forceedit'}) { |
if ($env{'form.forceedit'}) { |
Line 10221 sub writecoursepref {
|
Line 10282 sub writecoursepref {
|
|
|
sub createcourse { |
sub createcourse { |
my ($udom,$description,$url,$course_server,$nonstandard,$inst_code, |
my ($udom,$description,$url,$course_server,$nonstandard,$inst_code, |
$course_owner,$crstype,$cnum,$context,$category)=@_; |
$course_owner,$crstype,$cnum,$context,$category,$callercontext)=@_; |
$url=&declutter($url); |
$url=&declutter($url); |
my $cid=''; |
my $cid=''; |
if ($context eq 'requestcourses') { |
if ($context eq 'requestcourses') { |
my $can_create = 0; |
my $can_create = 0; |
my ($ownername,$ownerdom) = split(':',$course_owner); |
my ($ownername,$ownerdom) = split(':',$course_owner); |
if ($udom eq $ownerdom) { |
if ($udom eq $ownerdom) { |
if (&usertools_access($ownername,$ownerdom,$category,undef, |
my $reload; |
|
if (($callercontext eq 'auto') && |
|
($ownerdom eq $env{'user.domain'}) && ($ownername eq $env{'user.name'})) { |
|
$reload = 'reload'; |
|
} |
|
if (&usertools_access($ownername,$ownerdom,$category,$reload, |
$context)) { |
$context)) { |
$can_create = 1; |
$can_create = 1; |
} |
} |
Line 12336 sub symbverify {
|
Line 12402 sub symbverify {
|
|
|
if (tie(%bighash,'GDBM_File',$env{'request.course.fn'}.'.db', |
if (tie(%bighash,'GDBM_File',$env{'request.course.fn'}.'.db', |
&GDBM_READER(),0640)) { |
&GDBM_READER(),0640)) { |
my $noclutter; |
|
if (($thisurl =~ m{^/adm/wrapper/ext/}) || ($thisurl =~ m{^ext/})) { |
if (($thisurl =~ m{^/adm/wrapper/ext/}) || ($thisurl =~ m{^ext/})) { |
$thisurl =~ s/\?.+$//; |
$thisurl =~ s/\?.+$//; |
if ($map =~ m{^uploaded/.+\.page$}) { |
if ($map =~ m{^uploaded/.+\.page$}) { |
$thisurl =~ s{^(/adm/wrapper|)/ext/}{http://}; |
$thisurl =~ s{^(/adm/wrapper|)/ext/}{http://}; |
$thisurl =~ s{^\Qhttp://https://\E}{https://}; |
$thisurl =~ s{^\Qhttp://https://\E}{https://}; |
$noclutter = 1; |
|
} |
} |
} |
} |
my $ids; |
my $ids; |
if ($noclutter) { |
if ($map =~ m{^uploaded/.+\.page$}) { |
$ids=$bighash{'ids_'.$thisurl}; |
$ids=$bighash{'ids_'.&clutter_with_no_wrapper($thisurl)}; |
} else { |
} else { |
$ids=$bighash{'ids_'.&clutter($thisurl)}; |
$ids=$bighash{'ids_'.&clutter($thisurl)}; |
} |
} |
Line 13330 sub uses_sts {
|
Line 13394 sub uses_sts {
|
return $sts_on; |
return $sts_on; |
} |
} |
} |
} |
|
my $ua=new LWP::UserAgent; |
my $url = $protocol{$lonhost}.'://'.$hostname.'/index.html'; |
my $url = $protocol{$lonhost}.'://'.$hostname.'/index.html'; |
my $request=new HTTP::Request('HEAD',$url); |
my $request=new HTTP::Request('HEAD',$url); |
my $response=&LONCAPA::LWPReq::makerequest($lonhost,$request,'',\%perlvar,'','','',1); |
my $response=$ua->request($request); |
if ($response->is_success) { |
if ($response->is_success) { |
my $has_sts = $response->header('Strict-Transport-Security'); |
my $has_sts = $response->header('Strict-Transport-Security'); |
if ($has_sts eq '') { |
if ($has_sts eq '') { |