version 1.1025, 2009/09/03 21:23:36
|
version 1.1031, 2009/10/19 02:15:33
|
Line 785 sub changepass {
|
Line 785 sub changepass {
|
my ($uname,$udom,$currentpass,$newpass,$server,$context)=@_; |
my ($uname,$udom,$currentpass,$newpass,$server,$context)=@_; |
$currentpass = &escape($currentpass); |
$currentpass = &escape($currentpass); |
$newpass = &escape($newpass); |
$newpass = &escape($newpass); |
my $answer = reply("encrypt:passwd:$udom:$uname:$currentpass:$newpass:$context", |
my $lonhost = $perlvar{'lonHostID'}; |
|
my $answer = reply("encrypt:passwd:$udom:$uname:$currentpass:$newpass:$context:$lonhost", |
$server); |
$server); |
if (! $answer) { |
if (! $answer) { |
&logthis("No reply on password change request to $server ". |
&logthis("No reply on password change request to $server ". |
Line 810 sub changepass {
|
Line 811 sub changepass {
|
} elsif ($answer =~ "^refused") { |
} elsif ($answer =~ "^refused") { |
&logthis("$server refused to change $uname in $udom password because ". |
&logthis("$server refused to change $uname in $udom password because ". |
"it was sent an unencrypted request to change the password."); |
"it was sent an unencrypted request to change the password."); |
|
} elsif ($answer =~ "invalid_client") { |
|
&logthis("$server refused to change $uname in $udom password because ". |
|
"it was a reset by e-mail originating from an invalid server."); |
} |
} |
return $answer; |
return $answer; |
} |
} |
Line 3027 sub courseidput {
|
Line 3031 sub courseidput {
|
sub courseiddump { |
sub courseiddump { |
my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter, |
my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter, |
$coursefilter,$hostidflag,$hostidref,$typefilter,$regexp_ok, |
$coursefilter,$hostidflag,$hostidref,$typefilter,$regexp_ok, |
$selfenrollonly,$catfilter,$showhidden,$caller,$cloner,$cc_clone,$cloneonly)=@_; |
$selfenrollonly,$catfilter,$showhidden,$caller,$cloner,$cc_clone, |
|
$cloneonly,$createdbefore,$createdafter,$creationcontext)=@_; |
my $as_hash = 1; |
my $as_hash = 1; |
my %returnhash; |
my %returnhash; |
if (!$domfilter) { $domfilter=''; } |
if (!$domfilter) { $domfilter=''; } |
Line 3047 sub courseiddump {
|
Line 3052 sub courseiddump {
|
':'.&escape($regexp_ok).':'.$as_hash.':'. |
':'.&escape($regexp_ok).':'.$as_hash.':'. |
&escape($selfenrollonly).':'.&escape($catfilter).':'. |
&escape($selfenrollonly).':'.&escape($catfilter).':'. |
$showhidden.':'.$caller.':'.&escape($cloner).':'. |
$showhidden.':'.$caller.':'.&escape($cloner).':'. |
&escape($cc_clone).':'.$cloneonly,$tryserver); |
&escape($cc_clone).':'.$cloneonly.':'. |
|
&escape($createdbefore).':'.&escape($createdafter).':'. |
|
&escape($creationcontext),$tryserver); |
my @pairs=split(/\&/,$rep); |
my @pairs=split(/\&/,$rep); |
foreach my $item (@pairs) { |
foreach my $item (@pairs) { |
my ($key,$value)=split(/\=/,$item,2); |
my ($key,$value)=split(/\=/,$item,2); |
Line 5613 sub auto_validate_instcode {
|
Line 5620 sub auto_validate_instcode {
|
} |
} |
my $response=&unescape(&reply('autovalidateinstcode:'.$cdom.':'. |
my $response=&unescape(&reply('autovalidateinstcode:'.$cdom.':'. |
&escape($instcode).':'.&escape($owner),$homeserver)); |
&escape($instcode).':'.&escape($owner),$homeserver)); |
return $response; |
my ($outcome,$description) = map { &unescape($_); } split('&',$response,2); |
|
return ($outcome,$description); |
} |
} |
|
|
sub auto_create_password { |
sub auto_create_password { |
Line 6058 sub assignrole {
|
Line 6066 sub assignrole {
|
my $cwosec=$url; |
my $cwosec=$url; |
$cwosec=~s/^\/($match_domain)\/($match_courseid)\/.*/$1\/$2/; |
$cwosec=~s/^\/($match_domain)\/($match_courseid)\/.*/$1\/$2/; |
unless (&allowed('ccr',$cwosec)) { |
unless (&allowed('ccr',$cwosec)) { |
&logthis('Refused custom assignrole: '. |
my $refused = 1; |
$udom.' '.$uname.' '.$url.' '.$role.' '.$end.' '.$start.' by '. |
if ($context eq 'requestcourses') { |
$env{'user.name'}.' at '.$env{'user.domain'}); |
if (($env{'user.name'} ne '') && ($env{'user.domain'} ne '')) { |
return 'refused'; |
if ($role =~ m{^cr/($match_domain)/($match_username)/([^/]+)$}) { |
|
if (($1 eq $env{'user.domain'}) && ($2 eq $env{'user.name'})) { |
|
my ($cdom,$cnum) = ($cwosec =~ m{^/?($match_domain)/($match_courseid)$}); |
|
my %crsenv = &userenvironment($cdom,$cnum,('internal.courseowner')); |
|
if ($crsenv{'internal.courseowner'} eq |
|
$env{'user.name'}.':'.$env{'user.domain'}) { |
|
$refused = ''; |
|
} |
|
} |
|
} |
|
} |
|
} |
|
if ($refused) { |
|
&logthis('Refused custom assignrole: '. |
|
$udom.' '.$uname.' '.$url.' '.$role.' '.$end.' '.$start. |
|
' by '.$env{'user.name'}.' at '.$env{'user.domain'}); |
|
return 'refused'; |
|
} |
} |
} |
$mrole='cr'; |
$mrole='cr'; |
} elsif ($role =~ /^gr\//) { |
} elsif ($role =~ /^gr\//) { |
Line 6090 sub assignrole {
|
Line 6115 sub assignrole {
|
if (($selfenroll == 1) && ($role eq 'st') && ($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'})) { |
if (($selfenroll == 1) && ($role eq 'st') && ($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'})) { |
$refused = ''; |
$refused = ''; |
} elsif ($context eq 'requestcourses') { |
} elsif ($context eq 'requestcourses') { |
if (($role eq 'cc') && ($env{'user.name'} ne '' && $env{'user.domain'} ne '')) { |
my @possroles = ('st','ta','ep','in','cc'); |
my ($cdom,$cnum) = ($cwosec =~ m{^/($match_domain)/($match_courseid)$}); |
if ((grep(/^\Q$role\E$/,@possroles)) && ($env{'user.name'} ne '' && $env{'user.domain'} ne '')) { |
|
my ($cdom,$cnum) = ($cwosec =~ m{^/?($match_domain)/($match_courseid)$}); |
my %crsenv = &userenvironment($cdom,$cnum,('internal.courseowner')); |
my %crsenv = &userenvironment($cdom,$cnum,('internal.courseowner')); |
if ($crsenv{'internal.courseowner'} eq |
if ($crsenv{'internal.courseowner'} eq |
$env{'user.name'}.':'.$env{'user.domain'}) { |
$env{'user.name'}.':'.$env{'user.domain'}) { |
Line 6426 sub createcourse {
|
Line 6452 sub createcourse {
|
$course_owner,$crstype,$cnum,$context,$category)=@_; |
$course_owner,$crstype,$cnum,$context,$category)=@_; |
$url=&declutter($url); |
$url=&declutter($url); |
my $cid=''; |
my $cid=''; |
unless (&allowed('ccc',$udom)) { |
if ($context eq 'requestcourses') { |
if ($context eq 'requestcourses') { |
my $can_create = 0; |
unless (&usertools_access($course_owner,$udom,$category,undef,$context)) { |
my ($ownername,$ownerdom) = split(':',$course_owner); |
return 'refused'; |
if ($udom eq $ownerdom) { |
|
if (&usertools_access($ownername,$ownerdom,$category,undef, |
|
$context)) { |
|
$can_create = 1; |
|
} |
|
} else { |
|
my %userenv = &userenvironment($ownerdom,$ownername,'reqcrsotherdom.'. |
|
$category); |
|
if ($userenv{'reqcrsotherdom.'.$category} ne '') { |
|
my @curr = split(',',$userenv{'reqcrsotherdom.'.$category}); |
|
if (@curr > 0) { |
|
my @options = qw(approval validate autolimit); |
|
my $optregex = join('|',@options); |
|
if (grep(/^\Q$udom\E:($optregex)(=?\d*)$/,@curr)) { |
|
$can_create = 1; |
|
} |
|
} |
|
} |
|
} |
|
if ($can_create) { |
|
unless ($ownername eq $env{'user.name'} && $ownerdom eq $env{'user.domain'}) { |
|
unless (&allowed('ccc',$udom)) { |
|
return 'refused'; |
|
} |
} |
} |
} else { |
} else { |
return 'refused'; |
return 'refused'; |
} |
} |
|
} elsif (!&allowed('ccc',$udom)) { |
|
return 'refused'; |
} |
} |
# --------------------------------------------------------------- Get Unique ID |
# --------------------------------------------------------------- Get Unique ID |
my $uname; |
my $uname; |
Line 6463 sub createcourse {
|
Line 6514 sub createcourse {
|
} |
} |
# ----------------------------------------------------------------- Course made |
# ----------------------------------------------------------------- Course made |
# log existence |
# log existence |
|
my $now = time; |
my $newcourse = { |
my $newcourse = { |
$udom.'_'.$uname => { |
$udom.'_'.$uname => { |
description => $description, |
description => $description, |
inst_code => $inst_code, |
inst_code => $inst_code, |
owner => $course_owner, |
owner => $course_owner, |
type => $crstype, |
type => $crstype, |
|
creator => $env{'user.name'}.':'. |
|
$env{'user.domain'}, |
|
created => $now, |
|
context => $context, |
}, |
}, |
}; |
}; |
&courseidput($udom,$newcourse,$uhome,'notime'); |
&courseidput($udom,$newcourse,$uhome,'notime'); |
Line 9058 sub clutter {
|
Line 9114 sub clutter {
|
|| $thisfn =~ m{^/adm/(includes|pages)} ) { |
|| $thisfn =~ m{^/adm/(includes|pages)} ) { |
$thisfn='/res'.$thisfn; |
$thisfn='/res'.$thisfn; |
} |
} |
if ($thisfn !~m|/adm|) { |
if ($thisfn !~m|^/adm|) { |
if ($thisfn =~ m|/ext/|) { |
if ($thisfn =~ m|^/ext/|) { |
$thisfn='/adm/wrapper'.$thisfn; |
$thisfn='/adm/wrapper'.$thisfn; |
} else { |
} else { |
my ($ext) = ($thisfn =~ /\.(\w+)$/); |
my ($ext) = ($thisfn =~ /\.(\w+)$/); |