--- loncom/lonnet/perl/lonnet.pm 2009/09/13 03:13:38 1.1027 +++ loncom/lonnet/perl/lonnet.pm 2009/10/08 19:54:31 1.1030 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1027 2009/09/13 03:13:38 raeburn Exp $ +# $Id: lonnet.pm,v 1.1030 2009/10/08 19:54:31 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -785,7 +785,8 @@ sub changepass { my ($uname,$udom,$currentpass,$newpass,$server,$context)=@_; $currentpass = &escape($currentpass); $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); if (! $answer) { &logthis("No reply on password change request to $server ". @@ -810,6 +811,9 @@ sub changepass { } elsif ($answer =~ "^refused") { &logthis("$server refused to change $uname in $udom password because ". "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; } @@ -3027,7 +3031,8 @@ sub courseidput { sub courseiddump { my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter, $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 %returnhash; if (!$domfilter) { $domfilter=''; } @@ -3047,7 +3052,9 @@ sub courseiddump { ':'.&escape($regexp_ok).':'.$as_hash.':'. &escape($selfenrollonly).':'.&escape($catfilter).':'. $showhidden.':'.$caller.':'.&escape($cloner).':'. - &escape($cc_clone).':'.$cloneonly,$tryserver); + &escape($cc_clone).':'.$cloneonly.':'. + &escape($createdbefore).':'.&escape($createdafter).':'. + &escape($creationcontext),$tryserver); my @pairs=split(/\&/,$rep); foreach my $item (@pairs) { my ($key,$value)=split(/\=/,$item,2); @@ -6445,14 +6452,39 @@ sub createcourse { $course_owner,$crstype,$cnum,$context,$category)=@_; $url=&declutter($url); my $cid=''; - unless (&allowed('ccc',$udom)) { - if ($context eq 'requestcourses') { - unless (&usertools_access($course_owner,$udom,$category,undef,$context)) { - return 'refused'; + if ($context eq 'requestcourses') { + my $can_create = 0; + my ($ownername,$ownerdom) = split(':',$course_owner); + 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 { return 'refused'; } + } elsif (!&allowed('ccc',$udom)) { + return 'refused'; } # --------------------------------------------------------------- Get Unique ID my $uname; @@ -6482,12 +6514,17 @@ sub createcourse { } # ----------------------------------------------------------------- Course made # log existence + my $now = time; my $newcourse = { $udom.'_'.$uname => { description => $description, inst_code => $inst_code, owner => $course_owner, type => $crstype, + creator => $env{'user.name'}.':'. + $env{'user.domain'}, + created => $now, + context => $context, }, }; &courseidput($udom,$newcourse,$uhome,'notime');