version 1.1172.2.118.2.14, 2021/01/04 13:41:25
|
version 1.1172.2.133, 2021/01/02 23:04:20
|
Line 125 our @EXPORT = qw(%env);
|
Line 125 our @EXPORT = qw(%env);
|
$logid ++; |
$logid ++; |
my $now = time(); |
my $now = time(); |
my $id=$now.'00000'.$$.'00000'.$logid; |
my $id=$now.'00000'.$$.'00000'.$logid; |
my $ip = &get_requestor_ip(); |
|
my $logentry = { |
my $logentry = { |
$id => { |
$id => { |
'exe_uname' => $env{'user.name'}, |
'exe_uname' => $env{'user.name'}, |
'exe_udom' => $env{'user.domain'}, |
'exe_udom' => $env{'user.domain'}, |
'exe_time' => $now, |
'exe_time' => $now, |
'exe_ip' => $ip, |
'exe_ip' => $ENV{'REMOTE_ADDR'}, |
'delflag' => $delflag, |
'delflag' => $delflag, |
'logentry' => $storehash, |
'logentry' => $storehash, |
'uname' => $uname, |
'uname' => $uname, |
Line 1889 sub get_dom {
|
Line 1888 sub get_dom {
|
} |
} |
} |
} |
if ($udom && $uhome && ($uhome ne 'no_host')) { |
if ($udom && $uhome && ($uhome ne 'no_host')) { |
my $rep; |
my $rep=&reply("getdom:$udom:$namespace:$items",$uhome); |
if ($namespace =~ /^enc/) { |
|
$rep=&reply("encrypt:egetdom:$udom:$namespace:$items",$uhome); |
|
} else { |
|
$rep=&reply("getdom:$udom:$namespace:$items",$uhome); |
|
} |
|
my %returnhash; |
my %returnhash; |
if ($rep eq '' || $rep =~ /^error: 2 /) { |
if ($rep eq '' || $rep =~ /^error: 2 /) { |
return %returnhash; |
return %returnhash; |
Line 1938 sub put_dom {
|
Line 1932 sub put_dom {
|
$items.=&escape($item).'='.&freeze_escape($$storehash{$item}).'&'; |
$items.=&escape($item).'='.&freeze_escape($$storehash{$item}).'&'; |
} |
} |
$items=~s/\&$//; |
$items=~s/\&$//; |
if ($namespace =~ /^enc/) { |
return &reply("putdom:$udom:$namespace:$items",$uhome); |
return &reply("encrypt:putdom:$udom:$namespace:$items",$uhome); |
|
} else { |
|
return &reply("putdom:$udom:$namespace:$items",$uhome); |
|
} |
|
} else { |
} else { |
&logthis("put_dom failed - no homeserver and/or domain"); |
&logthis("put_dom failed - no homeserver and/or domain"); |
} |
} |
Line 2559 sub get_passwdconf {
|
Line 2549 sub get_passwdconf {
|
return %passwdconf; |
return %passwdconf; |
} |
} |
|
|
sub course_portal_url { |
|
my ($cnum,$cdom) = @_; |
|
my $chome = &homeserver($cnum,$cdom); |
|
my $hostname = &hostname($chome); |
|
my $protocol = $protocol{$chome}; |
|
$protocol = 'http' if ($protocol ne 'https'); |
|
my %domdefaults = &get_domain_defaults($cdom); |
|
my $firsturl; |
|
if ($domdefaults{'portal_def'}) { |
|
$firsturl = $domdefaults{'portal_def'}; |
|
} else { |
|
$firsturl = $protocol.'://'.$hostname; |
|
} |
|
return $firsturl; |
|
} |
|
|
|
# --------------------------------------------------- Assign a key to a student |
# --------------------------------------------------- Assign a key to a student |
|
|
sub assign_access_key { |
sub assign_access_key { |
Line 3462 sub can_edit_resource {
|
Line 3436 sub can_edit_resource {
|
$cfile = '/adm/wrapper'.$resurl; |
$cfile = '/adm/wrapper'.$resurl; |
} |
} |
} |
} |
} elsif ($resurl =~ m{^/adm/wrapper/adm/$cdom/$cnum/\d+/ext\.tool$}) { |
|
$incourse = 1; |
|
if ($env{'form.forceedit'}) { |
|
$forceview = 1; |
|
} else { |
|
$forceedit = 1; |
|
} |
|
$cfile = $resurl; |
|
} elsif ($resurl =~ m{^/?adm/viewclasslist$}) { |
} elsif ($resurl =~ m{^/?adm/viewclasslist$}) { |
$incourse = 1; |
$incourse = 1; |
if ($env{'form.forceedit'}) { |
if ($env{'form.forceedit'}) { |
Line 3494 sub can_edit_resource {
|
Line 3460 sub can_edit_resource {
|
$forceedit = 1; |
$forceedit = 1; |
} |
} |
$cfile = $resurl; |
$cfile = $resurl; |
} elsif (($resurl =~ m{^/adm/wrapper/adm/$cdom/$cnum/\d+/ext\.tool$}) && ($env{'form.folderpath'} =~ /^supplemental/)) { |
|
$incourse = 1; |
|
if ($env{'form.forceedit'}) { |
|
$forceview = 1; |
|
} else { |
|
$forceedit = 1; |
|
} |
|
$cfile = $resurl; |
|
} elsif (($resurl eq '/adm/extresedit') && ($symb || $env{'form.folderpath'})) { |
} elsif (($resurl eq '/adm/extresedit') && ($symb || $env{'form.folderpath'})) { |
$incourse = 1; |
$incourse = 1; |
$forceview = 1; |
$forceview = 1; |
Line 3511 sub can_edit_resource {
|
Line 3469 sub can_edit_resource {
|
$cfile = &clutter($res); |
$cfile = &clutter($res); |
} else { |
} else { |
$cfile = $env{'form.suppurl'}; |
$cfile = $env{'form.suppurl'}; |
my $escfile = &unescape($cfile); |
$cfile =~ s{^http://}{}; |
if ($escfile =~ m{^/adm/$cdom/$cnum/\d+/ext\.tool$}) { |
$cfile = '/adm/wrapper/ext/'.$cfile; |
$cfile = '/adm/wrapper'.$escfile; |
|
} else { |
|
$escfile =~ s{^http://}{}; |
|
$cfile = &escape("/adm/wrapper/ext/$escfile"); |
|
} |
|
} |
} |
} elsif ($resurl =~ m{^/?adm/viewclasslist$}) { |
} elsif ($resurl =~ m{^/?adm/viewclasslist$}) { |
if ($env{'form.forceedit'}) { |
if ($env{'form.forceedit'}) { |
Line 5494 my %cachedtimes=();
|
Line 5447 my %cachedtimes=();
|
my $cachedtime=''; |
my $cachedtime=''; |
|
|
sub load_all_first_access { |
sub load_all_first_access { |
my ($uname,$udom,$ignorecache)=@_; |
my ($uname,$udom)=@_; |
if (($cachedkey eq $uname.':'.$udom) && |
if (($cachedkey eq $uname.':'.$udom) && |
(abs($cachedtime-time)<5) && (!$env{'form.markaccess'}) && |
(abs($cachedtime-time)<5) && (!$env{'form.markaccess'})) { |
(!$ignorecache)) { |
|
return; |
return; |
} |
} |
$cachedtime=time; |
$cachedtime=time; |
Line 5506 sub load_all_first_access {
|
Line 5458 sub load_all_first_access {
|
} |
} |
|
|
sub get_first_access { |
sub get_first_access { |
my ($type,$argsymb,$argmap,$ignorecache)=@_; |
my ($type,$argsymb,$argmap)=@_; |
my ($symb,$courseid,$udom,$uname)=&whichuser(); |
my ($symb,$courseid,$udom,$uname)=&whichuser(); |
if ($argsymb) { $symb=$argsymb; } |
if ($argsymb) { $symb=$argsymb; } |
my ($map,$id,$res)=&decode_symb($symb); |
my ($map,$id,$res)=&decode_symb($symb); |
Line 5518 sub get_first_access {
|
Line 5470 sub get_first_access {
|
} else { |
} else { |
$res=$symb; |
$res=$symb; |
} |
} |
&load_all_first_access($uname,$udom,$ignorecache); |
&load_all_first_access($uname,$udom); |
return $cachedtimes{"$courseid\0$res"}; |
return $cachedtimes{"$courseid\0$res"}; |
} |
} |
|
|
Line 5570 sub checkout {
|
Line 5522 sub checkout {
|
my ($symb,$tuname,$tudom,$tcrsid)=@_; |
my ($symb,$tuname,$tudom,$tcrsid)=@_; |
my $now=time; |
my $now=time; |
my $lonhost=$perlvar{'lonHostID'}; |
my $lonhost=$perlvar{'lonHostID'}; |
my $ip = &get_requestor_ip(); |
|
my $infostr=&escape( |
my $infostr=&escape( |
'CHECKOUTTOKEN&'. |
'CHECKOUTTOKEN&'. |
$tuname.'&'. |
$tuname.'&'. |
$tudom.'&'. |
$tudom.'&'. |
$tcrsid.'&'. |
$tcrsid.'&'. |
$symb.'&'. |
$symb.'&'. |
$now.'&'.$ip); |
$now.'&'.$ENV{'REMOTE_ADDR'}); |
my $token=&reply('tmpput:'.$infostr,$lonhost); |
my $token=&reply('tmpput:'.$infostr,$lonhost); |
if ($token=~/^error\:/) { |
if ($token=~/^error\:/) { |
&logthis("<font color=\"blue\">WARNING: ". |
&logthis("<font color=\"blue\">WARNING: ". |
Line 5591 sub checkout {
|
Line 5542 sub checkout {
|
|
|
my %infohash=('resource.0.outtoken' => $token, |
my %infohash=('resource.0.outtoken' => $token, |
'resource.0.checkouttime' => $now, |
'resource.0.checkouttime' => $now, |
'resource.0.outremote' => $ip); |
'resource.0.outremote' => $ENV{'REMOTE_ADDR'}); |
|
|
unless (&cstore(\%infohash,$symb,$tcrsid,$tudom,$tuname) eq 'ok') { |
unless (&cstore(\%infohash,$symb,$tcrsid,$tudom,$tuname) eq 'ok') { |
return ''; |
return ''; |
Line 5622 sub checkin {
|
Line 5573 sub checkin {
|
$lonhost=~tr/A-Z/a-z/; |
$lonhost=~tr/A-Z/a-z/; |
my $dtoken=$ta.'_'.&hostname($lonhost).'_'.$tb; |
my $dtoken=$ta.'_'.&hostname($lonhost).'_'.$tb; |
$dtoken=~s/\W/\_/g; |
$dtoken=~s/\W/\_/g; |
my $ip = &get_requestor_ip(); |
|
my ($dummy,$tuname,$tudom,$tcrsid,$symb,$chtim,$rmaddr)= |
my ($dummy,$tuname,$tudom,$tcrsid,$symb,$chtim,$rmaddr)= |
split(/\&/,&unescape(&reply('tmpget:'.$dtoken,$lonhost))); |
split(/\&/,&unescape(&reply('tmpget:'.$dtoken,$lonhost))); |
|
|
Line 5639 sub checkin {
|
Line 5589 sub checkin {
|
|
|
my %infohash=('resource.0.intoken' => $token, |
my %infohash=('resource.0.intoken' => $token, |
'resource.0.checkintime' => $now, |
'resource.0.checkintime' => $now, |
'resource.0.inremote' => $ip); |
'resource.0.inremote' => $ENV{'REMOTE_ADDR'}); |
|
|
unless (&cstore(\%infohash,$symb,$tcrsid,$tudom,$tuname) eq 'ok') { |
unless (&cstore(\%infohash,$symb,$tcrsid,$tudom,$tuname) eq 'ok') { |
return ''; |
return ''; |
Line 6937 sub currentdump {
|
Line 6887 sub currentdump {
|
# |
# |
my %returnhash=(); |
my %returnhash=(); |
# |
# |
if ($rep eq 'unknown_cmd') { |
if ($rep eq "unknown_cmd") { |
# an old lond will not know currentdump |
# an old lond will not know currentdump |
# Do a dump and make it look like a currentdump |
# Do a dump and make it look like a currentdump |
my @tmp = &dumpstore($courseid,$sdom,$sname,'.'); |
my @tmp = &dumpstore($courseid,$sdom,$sname,'.'); |
Line 7072 sub putstore {
|
Line 7022 sub putstore {
|
foreach my $key (keys(%{$storehash})) { |
foreach my $key (keys(%{$storehash})) { |
$namevalue.=&escape($key).'='.&freeze_escape($storehash->{$key}).'&'; |
$namevalue.=&escape($key).'='.&freeze_escape($storehash->{$key}).'&'; |
} |
} |
my $ip = &get_requestor_ip(); |
$namevalue .= 'ip='.&escape($ENV{'REMOTE_ADDR'}). |
$namevalue .= 'ip='.&escape($ip). |
|
'&host='.&escape($perlvar{'lonHostID'}). |
'&host='.&escape($perlvar{'lonHostID'}). |
'&version='.$esc_v. |
'&version='.$esc_v. |
'&by='.&escape($env{'user.name'}.':'.$env{'user.domain'}); |
'&by='.&escape($env{'user.name'}.':'.$env{'user.domain'}); |
Line 7871 sub allowed {
|
Line 7820 sub allowed {
|
|
|
if (defined($env{'allowed.'.$priv})) { return $env{'allowed.'.$priv}; } |
if (defined($env{'allowed.'.$priv})) { return $env{'allowed.'.$priv}; } |
# Free bre access to adm and meta resources |
# Free bre access to adm and meta resources |
if (((($uri=~/^adm\//) && ($uri !~ m{/(?:smppg|bulletinboard|viewclasslist|aboutme|ext\.tool)$})) |
if (((($uri=~/^adm\//) && ($uri !~ m{/(?:smppg|bulletinboard|viewclasslist|aboutme)$})) |
|| (($uri=~/\.meta$/) && ($uri!~m|^uploaded/|) )) |
|| (($uri=~/\.meta$/) && ($uri!~m|^uploaded/|) )) |
&& ($priv eq 'bre')) { |
&& ($priv eq 'bre')) { |
return 'F'; |
return 'F'; |
Line 8118 sub allowed {
|
Line 8067 sub allowed {
|
&& &is_portfolio_url($uri)) { |
&& &is_portfolio_url($uri)) { |
$thisallowed = &portfolio_access($uri,$clientip); |
$thisallowed = &portfolio_access($uri,$clientip); |
} |
} |
|
|
# Full access at system, domain or course-wide level? Exit. |
# Full access at system, domain or course-wide level? Exit. |
if ($thisallowed=~/F/) { |
if ($thisallowed=~/F/) { |
return 'F'; |
return 'F'; |
Line 8582 sub get_commblock_resources {
|
Line 8531 sub get_commblock_resources {
|
} |
} |
} |
} |
} |
} |
if ($interval[0] =~ /^(\d+)/) { |
if ($interval[0] =~ /^\d+$/) { |
my $timelimit = $1; |
|
my $first_access; |
my $first_access; |
if ($type eq 'resource') { |
if ($type eq 'resource') { |
$first_access=&get_first_access($interval[1],$item); |
$first_access=&get_first_access($interval[1],$item); |
Line 8593 sub get_commblock_resources {
|
Line 8541 sub get_commblock_resources {
|
$first_access=&get_first_access($interval[1]); |
$first_access=&get_first_access($interval[1]); |
} |
} |
if ($first_access) { |
if ($first_access) { |
my $timesup = $first_access+$timelimit; |
my $timesup = $first_access+$interval[0]; |
if ($timesup > $now) { |
if ($timesup > $now) { |
my $activeblock; |
my $activeblock; |
foreach my $res (@to_test) { |
foreach my $res (@to_test) { |
Line 9998 sub modifyuserauth {
|
Line 9946 sub modifyuserauth {
|
' in domain '.$env{'request.role.domain'}); |
' in domain '.$env{'request.role.domain'}); |
my $reply=&reply('encrypt:changeuserauth:'.$udom.':'.$uname.':'.$umode.':'. |
my $reply=&reply('encrypt:changeuserauth:'.$udom.':'.$uname.':'.$umode.':'. |
&escape($upass),$uhome); |
&escape($upass),$uhome); |
my $ip = &get_requestor_ip(); |
|
&log($env{'user.domain'},$env{'user.name'},$env{'user.home'}, |
&log($env{'user.domain'},$env{'user.name'},$env{'user.home'}, |
'Authentication changed for '.$udom.', '.$uname.', '.$umode. |
'Authentication changed for '.$udom.', '.$uname.', '.$umode. |
'(Remote '.$ip.'): '.$reply); |
'(Remote '.$ENV{'REMOTE_ADDR'}.'): '.$reply); |
&log($udom,,$uname,$uhome, |
&log($udom,,$uname,$uhome, |
'Authentication changed by '.$env{'user.domain'}.', '. |
'Authentication changed by '.$env{'user.domain'}.', '. |
$env{'user.name'}.', '.$umode. |
$env{'user.name'}.', '.$umode. |
'(Remote '.$ip.'): '.$reply); |
'(Remote '.$ENV{'REMOTE_ADDR'}.'): '.$reply); |
unless ($reply eq 'ok') { |
unless ($reply eq 'ok') { |
&logthis('Authentication mode error: '.$reply); |
&logthis('Authentication mode error: '.$reply); |
return 'error: '.$reply; |
return 'error: '.$reply; |
Line 10330 sub writecoursepref {
|
Line 10277 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,$callercontext)=@_; |
$course_owner,$crstype,$cnum,$context,$category)=@_; |
$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) { |
my $reload; |
if (&usertools_access($ownername,$ownerdom,$category,undef, |
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 10526 sub store_userdata {
|
Line 10468 sub store_userdata {
|
if (($uhome eq '') || ($uhome eq 'no_host')) { |
if (($uhome eq '') || ($uhome eq 'no_host')) { |
$result = 'error: no_host'; |
$result = 'error: no_host'; |
} else { |
} else { |
$storehash->{'ip'} = &get_requestor_ip(); |
$storehash->{'ip'} = $ENV{'REMOTE_ADDR'}; |
$storehash->{'host'} = $perlvar{'lonHostID'}; |
$storehash->{'host'} = $perlvar{'lonHostID'}; |
|
|
my $namevalue=''; |
my $namevalue=''; |
Line 11351 sub get_userresdata {
|
Line 11293 sub get_userresdata {
|
# Parameters: |
# Parameters: |
# $name - Course/user name. |
# $name - Course/user name. |
# $domain - Name of the domain the user/course is registered on. |
# $domain - Name of the domain the user/course is registered on. |
# $type - Type of thing $name is (must be 'course' or 'user') |
# $type - Type of thing $name is (must be 'course' or 'user' |
# @which - Array of names of resources desired. |
# @which - Array of names of resources desired. |
# Returns: |
# Returns: |
# The value of the first reasource in @which that is found in the |
# The value of the first reasource in @which that is found in the |
Line 11372 sub resdata {
|
Line 11314 sub resdata {
|
foreach my $item (@which) { |
foreach my $item (@which) { |
if (defined($result->{$item->[0]})) { |
if (defined($result->{$item->[0]})) { |
return [$result->{$item->[0]},$item->[1]]; |
return [$result->{$item->[0]},$item->[1]]; |
} |
} |
} |
} |
return undef; |
return undef; |
} |
} |
|
|
sub get_domain_lti { |
|
my ($cdom,$context) = @_; |
|
my ($name,%lti); |
|
if ($context eq 'consumer') { |
|
$name = 'ltitools'; |
|
} elsif ($context eq 'provider') { |
|
$name = 'lti'; |
|
} else { |
|
return %lti; |
|
} |
|
my ($result,$cached)=&is_cached_new($name,$cdom); |
|
if (defined($cached)) { |
|
if (ref($result) eq 'HASH') { |
|
%lti = %{$result}; |
|
} |
|
} else { |
|
my %domconfig = &get_dom('configuration',[$name],$cdom); |
|
if (ref($domconfig{$name}) eq 'HASH') { |
|
%lti = %{$domconfig{$name}}; |
|
my %encdomconfig = &get_dom('encconfig',[$name],$cdom); |
|
if (ref($encdomconfig{$name}) eq 'HASH') { |
|
foreach my $id (keys(%lti)) { |
|
if (ref($encdomconfig{$name}{$id}) eq 'HASH') { |
|
foreach my $item ('key','secret') { |
|
$lti{$id}{$item} = $encdomconfig{$name}{$id}{$item}; |
|
} |
|
} |
|
} |
|
} |
|
} |
|
my $cachetime = 24*60*60; |
|
&do_cache_new($name,$cdom,\%lti,$cachetime); |
|
} |
|
return %lti; |
|
} |
|
|
|
sub get_numsuppfiles { |
sub get_numsuppfiles { |
my ($cnum,$cdom,$ignorecache)=@_; |
my ($cnum,$cdom,$ignorecache)=@_; |
my $hashid=$cnum.':'.$cdom; |
my $hashid=$cnum.':'.$cdom; |
Line 11868 sub metadata {
|
Line 11774 sub metadata {
|
# if it is a non metadata possible uri return quickly |
# if it is a non metadata possible uri return quickly |
if (($uri eq '') || |
if (($uri eq '') || |
(($uri =~ m|^/*adm/|) && |
(($uri =~ m|^/*adm/|) && |
($uri !~ m|^adm/includes|) && ($uri !~ m{/(smppg|bulletinboard|ext\.tool)$})) || |
($uri !~ m|^adm/includes|) && ($uri !~ m{/(smppg|bulletinboard)$})) || |
($uri =~ m|/$|) || ($uri =~ m|/.meta$|) || ($uri =~ m{^/*uploaded/.+\.sequence$})) { |
($uri =~ m|/$|) || ($uri =~ m|/.meta$|) || ($uri =~ m{^/*uploaded/.+\.sequence$})) { |
return undef; |
return undef; |
} |
} |
Line 13495 sub uses_sts {
|
Line 13401 sub uses_sts {
|
return; |
return; |
} |
} |
|
|
sub get_requestor_ip { |
|
my ($r,$nolookup,$noproxy) = @_; |
|
my $from_ip; |
|
if (ref($r)) { |
|
$from_ip = $r->get_remote_host($nolookup); |
|
} else { |
|
$from_ip = $ENV{'REMOTE_ADDR'}; |
|
} |
|
return $from_ip; |
|
} |
|
|
|
# ------------------------------------------------------------- Declutters URLs |
# ------------------------------------------------------------- Declutters URLs |
|
|
sub declutter { |
sub declutter { |
Line 13556 sub clutter {
|
Line 13451 sub clutter {
|
# &logthis("Got a blank emb style"); |
# &logthis("Got a blank emb style"); |
} |
} |
} |
} |
} elsif ($thisfn =~ m{^/adm/$match_domain/$match_courseid/\d+/ext\.tool$}) { |
|
$thisfn='/adm/wrapper'.$thisfn; |
|
} |
} |
return $thisfn; |
return $thisfn; |
} |
} |