--- loncom/lonnet/perl/lonnet.pm	2009/09/03 21:23:36	1.1025
+++ loncom/lonnet/perl/lonnet.pm	2009/10/31 21:38:00	1.1039
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1025 2009/09/03 21:23:36 raeburn Exp $
+# $Id: lonnet.pm,v 1.1039 2009/10/31 21:38:00 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);
@@ -3795,7 +3802,10 @@ sub privileged {
     my ($username,$domain)=@_;
     my $rolesdump=&reply("dump:$domain:$username:roles",
 			&homeserver($username,$domain));
-    if (($rolesdump eq 'con_lost') || ($rolesdump eq '')) { return 0; }
+    if (($rolesdump eq 'con_lost') || ($rolesdump eq '') || 
+        ($rolesdump =~ /^error:/)) {
+        return 0;
+    }
     my $now=time;
     if ($rolesdump ne '') {
         foreach my $entry (split(/&/,$rolesdump)) {
@@ -3823,13 +3833,15 @@ sub privileged {
 
 sub rolesinit {
     my ($domain,$username,$authhost)=@_;
-    my %userroles;
+    my $now=time;
+    my %userroles = ('user.login.time' => $now);
     my $rolesdump=reply("dump:$domain:$username:roles",$authhost);
-    if (($rolesdump eq 'con_lost') || ($rolesdump eq '')) { return \%userroles; }
+    if (($rolesdump eq 'con_lost') || ($rolesdump eq '') || 
+        ($rolesdump =~ /^error:/)) { 
+        return \%userroles;
+    }
     my %allroles=();
     my %allgroups=();   
-    my $now=time;
-    %userroles = ('user.login.time' => $now);
     my $group_privs;
 
     if ($rolesdump ne '') {
@@ -4003,8 +4015,8 @@ sub role_status {
             $$tstatus='is';
             if ($$tstart && $$tstart>$then) {
                 $$tstatus='future';
-                if ($$tstart && $$tstart>$refresh) {
-                    if ($$tstart<$now) {
+                if ($$tstart<$now) {
+                    if ($$tstart && $$tstart>$refresh) {
                         if (($$where ne '') && ($$role ne '')) {
                             my (%allroles,%allgroups,$group_privs);
                             my %userroles = (
@@ -4034,9 +4046,9 @@ sub role_status {
                             my ($author,$adv)= &set_userprivs(\%userroles,\%allroles,\%allgroups);
                             &appenv(\%userroles,[$$role,'cm']);
                             &log($env{'user.domain'},$env{'user.name'},$env{'user.home'},"Role ".$role);
-                            $$tstatus = 'is';
                         }
                     }
+                    $$tstatus = 'is';
                 }
             }
             if ($$tend) {
@@ -4829,6 +4841,55 @@ sub is_advanced_user {
     return $is_adv;
 }
 
+sub check_can_request {
+    my ($dom,$can_request,$request_domains) = @_;
+    my $canreq = 0;
+    my ($types,$typename) = &Apache::loncommon::course_types();
+    my @options = ('approval','validate','autolimit');
+    my $optregex = join('|',@options);
+    if ((ref($can_request) eq 'HASH') && (ref($types) eq 'ARRAY')) {
+        foreach my $type (@{$types}) {
+            if (&usertools_access($env{'user.name'},
+                                  $env{'user.domain'},
+                                  $type,undef,'requestcourses')) {
+                $canreq ++;
+                if (ref($request_domains) eq 'HASH') {
+                    push(@{$request_domains->{$type}},$env{'user.domain'});
+                }
+                if ($dom eq $env{'user.domain'}) {
+                    $can_request->{$type} = 1;
+                }
+            }
+            if ($env{'environment.reqcrsotherdom.'.$type} ne '') {
+                my @curr = split(',',$env{'environment.reqcrsotherdom.'.$type});
+                if (@curr > 0) {
+                    foreach my $item (@curr) {
+                        if (ref($request_domains) eq 'HASH') {
+                            my ($otherdom) = ($item =~ /^($match_domain):($optregex)(=?\d*)$/);
+                            if ($otherdom ne '') {
+                                if (ref($request_domains->{$type}) eq 'ARRAY') {
+                                    unless (grep(/^\Q$otherdom\E$/,@{$request_domains->{$type}})) {
+                                        push(@{$request_domains->{$type}},$otherdom);
+                                    }
+                                } else {
+                                    push(@{$request_domains->{$type}},$otherdom);
+                                }
+                            }
+                        }
+                    }
+                    unless($dom eq $env{'user.domain'}) {
+                        $canreq ++;
+                        if (grep(/^\Q$dom\E:($optregex)(=?\d*)$/,@curr)) {
+                            $can_request->{$type} = 1;
+                        }
+                    }
+                }
+            }
+        }
+    }
+    return $canreq;
+}
+
 # ---------------------------------------------- Custom access rule evaluation
 
 sub customaccess {
@@ -4983,17 +5044,65 @@ sub allowed {
     my $statecond=0;
     my $courseprivid='';
 
+    my $ownaccess;
+    # Community Coordinator browsing resource space.
+    if (($priv eq 'bro') && ($env{'user.author'})) {
+        if ($uri eq '') {
+            $ownaccess = 1;
+        } else {
+            if (($env{'user.domain'} ne '') && ($env{'user.name'} ne '')) {
+                my $udom = $env{'user.domain'};
+                my $uname = $env{'user.name'};
+                if ($uri =~ m{^\Q$udom\E/?$}) {
+                    $ownaccess = 1;
+                } elsif ($uri =~ m{^\Q$udom/\E/$uname/}) {
+                    unless ($uri =~ m{\.\./}) {
+                        $ownaccess = 1;
+                    }
+                } elsif (($udom ne 'public') && ($uname ne 'public')) {
+                    my $now = time;
+                    if ($uri =~ m{^([^/]+)/?$}) {
+                        my $adom = $1;
+                        foreach my $key (keys(%env)) {
+                            if ($key =~ m{^user\.role\.ca/\Q$adom\E}) {
+                                my ($start,$end) = split('.',$env{$key});
+                                if (($now >= $start) && (!$end || $end < $now)) {
+                                    $ownaccess = 1;
+                                    last;
+                                }
+                            }
+                        }
+                    } elsif ($uri =~ m{^([^/]+)/([^/]+)/?}) {
+                        my $adom = $1;
+                        my $aname = $2;
+                        if ($env{"user.role.ca./$adom/$aname"}) {
+                            my ($start,$end) =
+                                split('.',$env{"user.role.ca./$adom/$aname"});
+                            if (($now >= $start) && (!$end || $end < $now)) {
+                                $ownaccess = 1;
+                            }
+                        }
+                    }
+                }
+            }
+        }
+    }
+
 # Course
 
     if ($env{'user.priv.'.$env{'request.role'}.'./'}=~/\Q$priv\E\&([^\:]*)/) {
-       $thisallowed.=$1;
+        unless (($priv eq 'bro' && !$ownaccess)) {
+            $thisallowed.=$1;
+        }
     }
 
 # Domain
 
     if ($env{'user.priv.'.$env{'request.role'}.'./'.(split(/\//,$uri))[0].'/'}
        =~/\Q$priv\E\&([^\:]*)/) {
-       $thisallowed.=$1;
+        unless (($priv eq 'bro' && !$ownaccess)) {
+            $thisallowed.=$1;
+        }
     }
 
 # Course: uri itself is a course
@@ -5003,7 +5112,9 @@ sub allowed {
 
     if ($env{'user.priv.'.$env{'request.role'}.'.'.$courseuri}
        =~/\Q$priv\E\&([^\:]*)/) {
-       $thisallowed.=$1;
+        unless (($priv eq 'bro' && !$ownaccess)) {
+            $thisallowed.=$1;
+        }
     }
 
 # URI is an uploaded document for this course, default permissions don't matter
@@ -5613,7 +5724,8 @@ sub auto_validate_instcode {
     }
     my $response=&unescape(&reply('autovalidateinstcode:'.$cdom.':'.
                            &escape($instcode).':'.&escape($owner),$homeserver));
-    return $response;
+    my ($outcome,$description) = map { &unescape($_); } split('&',$response,2);
+    return ($outcome,$description);
 }
 
 sub auto_create_password {
@@ -6028,24 +6140,31 @@ sub plaintext {
     if (!defined($cid)) {
         $cid = $env{'request.course.id'};
     }
-    if (defined($cid) && ($env{'course.'.$cid.'.'.$short.'.plaintext'} ne '')) {
-        unless ($forcedefault) {
-            my $roletext = $env{'course.'.$cid.'.'.$short.'.plaintext'}; 
-            &Apache::lonlocal::mt_escape(\$roletext);
-            return &Apache::lonlocal::mt($roletext);
-        }
-    }
     my %rolenames = (
                       Course    => 'std',
                       Community => 'alt1',
                     );
-    if (defined($type) && 
-         defined($rolenames{$type}) && 
-         defined($prp{$short}{$rolenames{$type}})) {
+    if ($cid ne '') {
+        if ($env{'course.'.$cid.'.'.$short.'.plaintext'} ne '') {
+            unless ($forcedefault) {
+                my $roletext = $env{'course.'.$cid.'.'.$short.'.plaintext'}; 
+                &Apache::lonlocal::mt_escape(\$roletext);
+                return &Apache::lonlocal::mt($roletext);
+            }
+        }
+    }
+    if ((defined($type)) && (defined($rolenames{$type})) &&
+        (defined($rolenames{$type})) && 
+        (defined($prp{$short}{$rolenames{$type}}))) {
         return &Apache::lonlocal::mt($prp{$short}{$rolenames{$type}});
-    } else {
-        return &Apache::lonlocal::mt($prp{$short}{'std'});
+    } elsif ($cid ne '') {
+        my $crstype = $env{'course.'.$cid.'.type'};
+        if (($crstype ne '') && (defined($rolenames{$crstype})) &&
+            (defined($prp{$short}{$rolenames{$crstype}}))) {
+            return &Apache::lonlocal::mt($prp{$short}{$rolenames{$crstype}});
+        }
     }
+    return &Apache::lonlocal::mt($prp{$short}{'std'});
 }
 
 # ----------------------------------------------------------------- Assign Role
@@ -6058,10 +6177,27 @@ sub assignrole {
         my $cwosec=$url;
         $cwosec=~s/^\/($match_domain)\/($match_courseid)\/.*/$1\/$2/;
 	unless (&allowed('ccr',$cwosec)) {
-           &logthis('Refused custom assignrole: '.
-             $udom.' '.$uname.' '.$url.' '.$role.' '.$end.' '.$start.' by '.
-		    $env{'user.name'}.' at '.$env{'user.domain'});
-           return 'refused'; 
+           my $refused = 1;
+           if ($context eq 'requestcourses') {
+               if (($env{'user.name'} ne '') && ($env{'user.domain'} ne '')) {
+                   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';
     } elsif ($role =~ /^gr\//) {
@@ -6090,8 +6226,9 @@ sub assignrole {
                 if (($selfenroll == 1) && ($role eq 'st') && ($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'})) {
                     $refused = '';
                 } elsif ($context eq 'requestcourses') {
-                    if (($role eq 'cc') && ($env{'user.name'} ne '' && $env{'user.domain'} ne '')) {
-                        my ($cdom,$cnum) = ($cwosec =~ m{^/($match_domain)/($match_courseid)$});
+                    my @possroles = ('st','ta','ep','in','cc');
+                    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'));
                         if ($crsenv{'internal.courseowner'} eq 
                              $env{'user.name'}.':'.$env{'user.domain'}) {
@@ -6426,14 +6563,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;
@@ -6442,10 +6604,10 @@ sub createcourse {
         if (($chome eq '') || ($chome eq 'no_host')) {
             $uname = $cnum;
         } else {
-            $uname = &generate_coursenum($udom);
+            $uname = &generate_coursenum($udom,$crstype);
         }
     } else {
-        $uname = &generate_coursenum($udom);
+        $uname = &generate_coursenum($udom,$crstype);
     }
     return $uname if ($uname =~ /^error/);
 # -------------------------------------------------- Check supplied server name
@@ -6463,12 +6625,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');
@@ -6500,17 +6667,28 @@ ENDINITMAP
 
 # ------------------------------------------------------------------- Create ID
 sub generate_coursenum {
-    my ($udom) = @_;
+    my ($udom,$crstype) = @_;
     my $domdesc = &domain($udom);
     return 'error: invalid domain' if ($domdesc eq '');
-    my $uname=int(1+rand(9)).
+    my $first;
+    if ($crstype eq 'Community') {
+        $first = '0';
+    } else {
+        $first = int(1+rand(9)); 
+    } 
+    my $uname=$first.
         ('a'..'z','A'..'Z','0'..'9')[int(rand(62))].
         substr($$.time,0,5).unpack("H8",pack("I32",time)).
         unpack("H2",pack("I32",int(rand(255)))).$perlvar{'lonHostID'};
 # ----------------------------------------------- Make sure that does not exist
     my $uhome=&homeserver($uname,$udom,'true');
     unless (($uhome eq '') || ($uhome eq 'no_host')) {
-        $uname=int(1+rand(9)).
+        if ($crstype eq 'Community') {
+            $first = '0';
+        } else {
+            $first = int(1+rand(9));
+        }
+        $uname=$first.
                ('a'..'z','A'..'Z','0'..'9')[int(rand(62))].
                substr($$.time,0,5).unpack("H8",pack("I32",time)).
                unpack("H2",pack("I32",int(rand(255)))).$perlvar{'lonHostID'};
@@ -8162,6 +8340,9 @@ sub symbverify {
 
     if (tie(%bighash,'GDBM_File',$env{'request.course.fn'}.'.db',
                             &GDBM_READER(),0640)) {
+        if (($thisurl =~ m{^/adm/wrapper/ext/}) || ($thisurl =~ m{^ext/})) {
+            $thisurl =~ s/\?.+$//;
+        }
         my $ids=$bighash{'ids_'.&clutter($thisurl)};
         unless ($ids) { 
            $ids=$bighash{'ids_/'.$thisurl};
@@ -8170,6 +8351,9 @@ sub symbverify {
 # ------------------------------------------------------------------- Has ID(s)
 	    foreach my $id (split(/\,/,$ids)) {
 	       my ($mapid,$resid)=split(/\./,$id);
+               if ($thisfn =~ m{^/adm/wrapper/ext/}) {
+                   $symb =~ s/\?.+$//;
+               }
                if (
   &symbclean(&declutter($bighash{'map_id_'.$mapid}).'___'.$resid.'___'.$thisfn)
    eq $symb) { 
@@ -9046,7 +9230,9 @@ sub declutter {
     $thisfn=~s|^adm/wrapper/||;
     $thisfn=~s|^adm/coursedocs/showdoc/||;
     $thisfn=~s/^res\///;
-    $thisfn=~s/\?.+$//;
+    unless (($thisfn =~ /^ext/) || ($thisfn =~ /\.(page|sequence)___\d+___ext/)) {
+        $thisfn=~s/\?.+$//;
+    }
     return $thisfn;
 }
 
@@ -9058,8 +9244,8 @@ sub clutter {
 	|| $thisfn =~ m{^/adm/(includes|pages)} ) { 
        $thisfn='/res'.$thisfn; 
     }
-    if ($thisfn !~m|/adm|) {
-	if ($thisfn =~ m|/ext/|) {
+    if ($thisfn !~m|^/adm|) {
+	if ($thisfn =~ m|^/ext/|) {
 	    $thisfn='/adm/wrapper'.$thisfn;
 	} else {
 	    my ($ext) = ($thisfn =~ /\.(\w+)$/);
@@ -10086,7 +10272,7 @@ createcourse($udom,$description,$url,$co
 
 =item *
 
-generate_coursenum($udom) : get a unique (unused) course number in domain $udom
+generate_coursenum($udom,$crstype) : get a unique (unused) course number in domain $udom for course type $crstype (Course or Community).
 
 =back