--- loncom/lonnet/perl/lonnet.pm	2007/03/03 02:10:59	1.843
+++ loncom/lonnet/perl/lonnet.pm	2007/04/03 17:51:50	1.858
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.843 2007/03/03 02:10:59 albertel Exp $
+# $Id: lonnet.pm,v 1.858 2007/04/03 17:51:50 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -35,12 +35,10 @@ use HTTP::Headers;
 use HTTP::Date;
 # use Date::Parse;
 use vars 
-qw(%perlvar %badServerCache %iphost %spareid %hostdom 
-   %libserv %pr %prp $memcache %packagetab 
+qw(%perlvar %badServerCache %spareid 
+   %pr %prp $memcache %packagetab 
    %courselogs %accesshash %userrolehash %domainrolehash $processmarker $dumpcount 
    %coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseinstcodebuf %courseownerbuf %coursetypebuf
-   %domaindescription %domain_auth_def %domain_auth_arg_def 
-   %domain_lang_def %domain_city %domain_longi %domain_lati %domain_primary
    $tmpdir $_64bit %env);
 
 use IO::Socket;
@@ -146,6 +144,20 @@ sub logperm {
     return 1;
 }
 
+sub create_connection {
+    my ($hostname,$lonid) = @_;
+    my $client=IO::Socket::UNIX->new(Peer    => $perlvar{'lonSockCreate'},
+				     Type    => SOCK_STREAM,
+				     Timeout => 10);
+    return 0 if (!$client);
+    print $client (join(':',$hostname,$lonid,&machine_ids($lonid))."\n");
+    my $result = <$client>;
+    chomp($result);
+    return 1 if ($result eq 'done');
+    return 0;
+}
+
+
 # -------------------------------------------------- Non-critical communication
 sub subreply {
     my ($cmd,$server)=@_;
@@ -172,8 +184,10 @@ sub subreply {
 				      Timeout => 10);
 	if($client) {
 	    last;		# Connected!
+	} else {
+	    &create_connection(&hostname($server),$server);
 	}
-	sleep(1);		# Try again later if failed connection.
+        sleep(1);		# Try again later if failed connection.
     }
     my $answer;
     if ($client) {
@@ -727,8 +741,8 @@ sub get_dom {
     }
     $items=~s/\&$//;
     if (!$udom) { $udom=$env{'user.domain'}; }
-    if (exists($domain_primary{$udom})) {
-        my $uhome=$domain_primary{$udom};
+    if (defined(&domain($udom,'primary'))) {
+        my $uhome=&domain($udom,'primary');
         my $rep=&reply("getdom:$udom:$namespace:$items",$uhome);
         my @pairs=split(/\&/,$rep);
         if ( $#pairs==0 && $pairs[0] =~ /^(con_lost|error|no_such_host)/i) {
@@ -751,8 +765,8 @@ sub get_dom {
 sub put_dom {
     my ($namespace,$storehash,$udom)=@_;
     if (!$udom) { $udom=$env{'user.domain'}; }
-    if (exists($domain_primary{$udom})) {
-        my $uhome=$domain_primary{$udom};
+    if (defined(&domain($udom,'primary'))) {
+        my $uhome=&domain($udom,'primary');
         my $items='';
         foreach my $item (keys(%$storehash)) {
             $items.=&escape($item).'='.&freeze_escape($$storehash{$item}).'&';
@@ -767,8 +781,8 @@ sub put_dom {
 sub retrieve_inst_usertypes {
     my ($udom) = @_;
     my (%returnhash,@order);
-    if (exists($domain_primary{$udom})) {
-        my $uhome=$domain_primary{$udom};
+    if (defined(&domain($udom,'primary'))) {
+        my $uhome=&domain($udom,'primary');
         my $rep=&reply("inst_usertypes:$udom",$uhome);
         my ($hashitems,$orderitems) = split(/:/,$rep); 
         my @pairs=split(/\&/,$hashitems);
@@ -1012,10 +1026,16 @@ my %remembered;
 my %accessed;
 my $kicks=0;
 my $hits=0;
+sub make_key {
+    my ($name,$id) = @_;
+    if (length($id) > 200) { $id=length($id).':'.&Digest::MD5::md5_hex($id); }
+    return &escape($name.':'.$id);
+}
+
 sub devalidate_cache_new {
     my ($name,$id,$debug) = @_;
     if ($debug) { &Apache::lonnet::logthis("deleting $name:$id"); }
-    $id=&escape($name.':'.$id);
+    $id=&make_key($name,$id);
     $memcache->delete($id);
     delete($remembered{$id});
     delete($accessed{$id});
@@ -1023,7 +1043,7 @@ sub devalidate_cache_new {
 
 sub is_cached_new {
     my ($name,$id,$debug) = @_;
-    $id=&escape($name.':'.$id);
+    $id=&make_key($name,$id);
     if (exists($remembered{$id})) {
 	if ($debug) { &Apache::lonnet::logthis("Earyl return $id of $remembered{$id} "); }
 	$accessed{$id}=[&gettimeofday()];
@@ -1046,7 +1066,7 @@ sub is_cached_new {
 
 sub do_cache_new {
     my ($name,$id,$value,$time,$debug) = @_;
-    $id=&escape($name.':'.$id);
+    $id=&make_key($name,$id);
     my $setvalue=$value;
     if (!defined($setvalue)) {
 	$setvalue='__undef__';
@@ -1496,8 +1516,12 @@ sub clean_filename {
 #        $coursedoc - if true up to the current course
 #                     if false
 #        $subdir - directory in userfile to store the file into
-#        $parser, $allfiles, $codebase - unknown
-#
+#        $parser - instruction to parse file for objects ($parser = parse)    
+#        $allfiles - reference to hash for embedded objects
+#        $codebase - reference to hash for codebase of java objects
+#        $desuname - username for permanent storage of uploaded file
+#        $dsetudom - domain for permanaent storage of uploaded file
+# 
 # output: url of file in userspace, or error: <message> 
 #             or /adm/notfound.html if failure to upload occurse
 
@@ -1615,6 +1639,7 @@ sub finishuserfileupload {
 		     ' for embedded media: '.$parse_result); 
         }
     }
+ 
 # Notify homeserver to grep it
 #
     my $docuhome=&homeserver($docuname,$docudom);
@@ -1627,7 +1652,7 @@ sub finishuserfileupload {
         &logthis('Failed to transfer '.$path.$file.' to host '.$docuhome.
 		 ': '.$fetchresult);
         return '/adm/notfound.html';
-    }    
+    }
 }
 
 sub extract_embedded_items {
@@ -1842,7 +1867,7 @@ sub flushcourselogs {
 # Is used in pickcourse
 #
     foreach my $crs_home (keys(%courseidbuffer)) {
-        &courseidput($hostdom{$crs_home},$courseidbuffer{$crs_home},
+        &courseidput(&host_domain($crs_home),$courseidbuffer{$crs_home},
 		     $crs_home);
     }
 #
@@ -2049,11 +2074,16 @@ sub get_course_adv_roles {
 }
 
 sub get_my_roles {
-    my ($uname,$udom,$types,$roles,$roledoms)=@_;
+    my ($uname,$udom,$context,$types,$roles,$roledoms)=@_;
     unless (defined($uname)) { $uname=$env{'user.name'}; }
     unless (defined($udom)) { $udom=$env{'user.domain'}; }
-    my %dumphash=
+    my %dumphash;
+    if ($context eq 'userroles') { 
+        %dumphash = &dump('roles',$udom,$uname);
+    } else {
+        %dumphash=
             &dump('nohist_userroles',$udom,$uname);
+    }
     my %returnhash=();
     my $now=time;
     foreach my $entry (keys(%dumphash)) {
@@ -2097,7 +2127,7 @@ sub get_my_roles {
 
 sub postannounce {
     my ($server,$text)=@_;
-    unless (&allowed('psa',$hostdom{$server})) { return 'refused'; }
+    unless (&allowed('psa',&host_domain($server))) { return 'refused'; }
     unless ($text=~/\w/) { $text=''; }
     return &reply('setannounce:'.&escape($text),$server);
 }
@@ -2133,11 +2163,16 @@ sub courseiddump {
     my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter,$coursefilter,$hostidflag,$hostidref,$typefilter,$regexp_ok)=@_;
     my %returnhash=();
     unless ($domfilter) { $domfilter=''; }
-    foreach my $tryserver (keys %libserv) {
-        if ( ($hostidflag == 1 && grep/^$tryserver$/,@{$hostidref}) || (!defined($hostidflag)) ) {
-	    if ((!$domfilter) || ($hostdom{$tryserver} eq $domfilter)) {
+    my %libserv = &all_library();
+    foreach my $tryserver (keys(%libserv)) {
+        if ( (  $hostidflag == 1 
+	        && grep(/^\Q$tryserver\E$/,@{$hostidref}) ) 
+	     || (!defined($hostidflag)) ) {
+
+	    if ($domfilter eq ''
+		|| (&host_domain($tryserver) eq $domfilter)) {
 	        foreach my $line (
-                 split(/\&/,&reply('courseiddump:'.$hostdom{$tryserver}.':'.
+                 split(/\&/,&reply('courseiddump:'.&host_domain($tryserver).':'.
 			       $sincefilter.':'.&escape($descfilter).':'.
                                &escape($instcodefilter).':'.&escape($ownerfilter).':'.&escape($coursefilter).':'.&escape($typefilter).':'.&escape($regexp_ok),
                                $tryserver))) {
@@ -2165,12 +2200,13 @@ sub dcmailput {
 sub dcmaildump {
     my ($dom,$startdate,$enddate,$senders) = @_;
     my %returnhash=();
-    if (exists($domain_primary{$dom})) {
+
+    if (defined(&domain($dom,'primary'))) {
         my $cmd='dcmaildump:'.$dom.':'.&escape($startdate).':'.
                                                          &escape($enddate).':';
 	my @esc_senders=map { &escape($_)} @$senders;
 	$cmd.=&escape(join('&',@esc_senders));
-	foreach my $line (split(/\&/,&reply($cmd,$domain_primary{$dom}))) {
+	foreach my $line (split(/\&/,&reply($cmd,&domain($dom,'primary')))) {
             my ($key,$value) = split(/\=/,$line,2);
             if (($key) && ($value)) {
                 $returnhash{&unescape($key)} = &unescape($value);
@@ -4170,6 +4206,7 @@ sub definerole {
 sub metadata_query {
     my ($query,$custom,$customshow,$server_array)=@_;
     my %rhash;
+    my %libserv = &all_library();
     my @server_list = (defined($server_array) ? @$server_array
                                               : keys(%libserv) );
     for my $server (@server_list) {
@@ -4322,6 +4359,12 @@ sub courselog_query {
 }
 
 sub userlog_query {
+#
+# possible filters:
+# action: log check role
+# start: timestamp
+# end: timestamp
+#
     my ($uname,$udom,%filters)=@_;
     return &log_query($uname,$udom,'userlog',%filters);
 }
@@ -4811,7 +4854,7 @@ sub modifyuser {
     if (($uhome eq 'no_host') && 
 	(($umode && $upass) || ($umode eq 'localauth'))) {
         my $unhome='';
-        if (defined($desiredhome) && $hostdom{$desiredhome} eq $udom) { 
+        if (defined($desiredhome) && &host_domain($desiredhome) eq $udom) { 
             $unhome = $desiredhome;
 	} elsif($env{'course.'.$env{'request.course.id'}.'.domain'} eq $udom) {
 	    $unhome=$env{'course.'.$env{'request.course.id'}.'.home'};
@@ -5038,7 +5081,7 @@ sub createcourse {
    }
 # ------------------------------------------------ Check supplied server name
     $course_server = $env{'user.homeserver'} if (! defined($course_server));
-    if (! exists($libserv{$course_server})) {
+    if (! &is_library($course_server)) {
         return 'error:bad server name '.$course_server;
     }
 # ------------------------------------------------------------- Make the course
@@ -6171,7 +6214,8 @@ sub packages_tab_default {
 	    $do_default=1;
 	} elsif ($pack_type eq 'extension') {
 	    push(@extension,[$package,$pack_type,$pack_part]);
-	} else {
+	} elsif ($pack_part eq $part) {
+	    # only look at packages defaults for packages that this id is
 	    push(@specifics,[$package,$pack_type,$pack_part]);
 	}
     }
@@ -6889,7 +6933,6 @@ sub getCODE {
 
 sub rndseed {
     my ($symb,$courseid,$domain,$username)=@_;
-
     my ($wsymb,$wcourseid,$wdomain,$wusername)=&whichuser();
     if (!$symb) {
 	unless ($symb=$wsymb) { return time; }
@@ -7398,20 +7441,29 @@ sub hreflocation {
 }
 
 sub current_machine_domains {
-    my $hostname=&hostname($perlvar{'lonHostID'});
+    return &machine_domains(&hostname($perlvar{'lonHostID'}));
+}
+
+sub machine_domains {
+    my ($hostname) = @_;
     my @domains;
     my %hostname = &all_hostnames();
     while( my($id, $name) = each(%hostname)) {
 #	&logthis("-$id-$name-$hostname-");
 	if ($hostname eq $name) {
-	    push(@domains,$hostdom{$id});
+	    push(@domains,&host_domain($id));
 	}
     }
     return @domains;
 }
 
 sub current_machine_ids {
-    my $hostname=&hostname($perlvar{'lonHostID'});
+    return &machine_ids(&hostname($perlvar{'lonHostID'}));
+}
+
+sub machine_ids {
+    my ($hostname) = @_;
+    $hostname ||= &hostname($perlvar{'lonHostID'});
     my @ids;
     my %hostname = &all_hostnames();
     while( my($id, $name) = each(%hostname)) {
@@ -7552,6 +7604,7 @@ sub goodbye {
 }
 
 BEGIN {
+
 # ----------------------------------- Read loncapa.conf and loncapa_apache.conf
     unless ($readit) {
 {
@@ -7559,64 +7612,133 @@ BEGIN {
     %perlvar = (%perlvar,%{$configvars});
 }
 
+sub get_dns {
+    my ($url,$func) = @_;
+    open(my $config,"<$perlvar{'lonTabDir'}/hosts.tab");
+    foreach my $dns (<$config>) {
+	next if ($dns !~ /^\^(\S*)/x);
+	$dns = $1;
+	my $ua=new LWP::UserAgent;
+	my $request=new HTTP::Request('GET',"http://$dns$url");
+	my $response=$ua->request($request);
+	next if ($response->is_error());
+	my @content = split("\n",$response->content);
+	&$func(\@content);
+    }
+    close($config);
+}
 # ------------------------------------------------------------ Read domain file
 {
-    %domaindescription = ();
-    %domain_auth_def = ();
-    %domain_auth_arg_def = ();
-    my $fh;
-    if (open($fh,"<".$Apache::lonnet::perlvar{'lonTabDir'}.'/domain.tab')) {
-	while (my $line = <$fh>) {
-           next if ($line =~ /^(\#|\s*$)/);
-#           next if /^\#/;
-           chomp $line;
-           my ($domain, $domain_description, $def_auth, $def_auth_arg,
-	       $def_lang, $city, $longi, $lati, $primary) = split(/:/,$line,9);
-	   $domain_auth_def{$domain}=$def_auth;
-           $domain_auth_arg_def{$domain}=$def_auth_arg;
-	   $domaindescription{$domain}=$domain_description;
-	   $domain_lang_def{$domain}=$def_lang;
-	   $domain_city{$domain}=$city;
-	   $domain_longi{$domain}=$longi;
-	   $domain_lati{$domain}=$lati;
-           $domain_primary{$domain}=$primary;
+    my $loaded;
+    my %domain;
+
+    sub parse_domain_tab {
+	my ($lines) = @_;
+	foreach my $line (@$lines) {
+	    next if ($line =~ /^(\#|\s*$ )/x);
+
+	    chomp($line);
+	    my ($name,@elements) = split(/:/,$line,9);
+	    my %this_domain;
+	    foreach my $field ('description', 'auth_def', 'auth_arg_def',
+			       'lang_def', 'city', 'longi', 'lati',
+			       'primary') {
+		$this_domain{$field} = shift(@elements);
+	    }
+	    $domain{$name} = \%this_domain;
+	    &logthis("Domain.tab: $name ".$domain{$name}{'description'} );
+	}
+    }
+    
+    sub load_domain_tab {
+	&get_dns('/adm/dns/domain',\&parse_domain_tab);
+	my $fh;
+	if (open($fh,"<".$perlvar{'lonTabDir'}.'/domain.tab')) {
+	    my @lines = <$fh>;
+	    &parse_domain_tab(\@lines);
+	}
+	close($fh);
+	$loaded = 1;
+    }
+
+    sub domain {
+	&load_domain_tab() if (!$loaded);
 
- #         &logthis("Domain.tab: $domain, $domain_auth_def{$domain}, $domain_auth_arg_def{$domain},$domaindescription{$domain}");
-#          &logthis("Domain.tab: $domain ".$domaindescription{$domain} );
+	my ($name,$what) = @_;
+	return if ( !exists($domain{$name}) );
+
+	if (!$what) {
+	    return $domain{$name}{'description'};
 	}
+	return $domain{$name}{$what};
     }
-    close ($fh);
 }
 
 
 # ------------------------------------------------------------- Read hosts file
 {
     my %hostname;
-    open(my $config,"<$perlvar{'lonTabDir'}/hosts.tab");
+    my %hostdom;
+    my %libserv;
+    my $loaded;
+
+    sub parse_hosts_tab {
+	my ($file) = @_;
+	foreach my $configline (@$file) {
+	    next if ($configline =~ /^(\#|\s*$ )/x);
+	    next if ($configline =~ /^\^/);
+	    chomp($configline);
+	    my ($id,$domain,$role,$name)=split(/:/,$configline);
+	    $name=~s/\s//g;
+	    if ($id && $domain && $role && $name) {
+		$hostname{$id}=$name;
+		$hostdom{$id}=$domain;
+		if ($role eq 'library') { $libserv{$id}=$name; }
+	    }
+	    &logthis("Hosts.tab: $name ".$id );
+	}
+    }
 
-    while (my $configline=<$config>) {
-       next if ($configline =~ /^(\#|\s*$)/);
-       chomp($configline);
-       my ($id,$domain,$role,$name)=split(/:/,$configline);
-       $name=~s/\s//g;
-       if ($id && $domain && $role && $name) {
-	 $hostname{$id}=$name;
-	 $hostdom{$id}=$domain;
-	 if ($role eq 'library') { $libserv{$id}=$name; }
-       }
+    sub load_hosts_tab {
+	&get_dns('/adm/dns/hosts',\&parse_hosts_tab);
+	open(my $config,"<$perlvar{'lonTabDir'}/hosts.tab");
+	my @config = <$config>;
+	&parse_hosts_tab(\@config);
+	close($config);
+	$loaded=1;
     }
-    close($config);
+
     # FIXME: dev server don't want this, production servers _do_ want this
     #&get_iphost();
 
     sub hostname {
+	&load_hosts_tab() if (!$loaded);
+
 	my ($lonid) = @_;
 	return $hostname{$lonid};
     }
+
     sub all_hostnames {
+	&load_hosts_tab() if (!$loaded);
+
 	return %hostname;
     }
+
+    sub is_library {
+	&load_hosts_tab() if (!$loaded);
+
+	return exists($libserv{$_[0]});
+    }
+
+    sub all_library {
+	&load_hosts_tab() if (!$loaded);
+
+	return %libserv;
+    }
+
     sub get_servers {
+	&load_hosts_tab() if (!$loaded);
+
 	my ($domain,$type) = @_;
 	my %possible_hosts = ($type eq 'library') ? %libserv
 	                                          : %hostname;
@@ -7636,43 +7758,72 @@ BEGIN {
 	}
 	return %result;
     }
+
+    sub host_domain {
+	&load_hosts_tab() if (!$loaded);
+
+	my ($lonid) = @_;
+	return $hostdom{$lonid};
+    }
+
     sub all_domains {
+	&load_hosts_tab() if (!$loaded);
+
 	my %seen;
 	my @uniq = grep(!$seen{$_}++, values(%hostdom));
 	return @uniq;
     }
 }
 
-sub get_hosts_from_ip {
-    my ($ip) = @_;
-    my %iphosts = &get_iphost();
-    if (ref($iphosts{$ip})) {
-	return @{$iphosts{$ip}};
+{ 
+    my %iphost;
+    my %name_to_ip;
+    my %lonid_to_ip;
+    sub get_hosts_from_ip {
+	my ($ip) = @_;
+	my %iphosts = &get_iphost();
+	if (ref($iphosts{$ip})) {
+	    return @{$iphosts{$ip}};
+	}
+	return;
     }
-    return;
-}
 
-sub get_iphost {
-    if (%iphost) { return %iphost; }
-    my %name_to_ip;
-    my %hostname = &all_hostnames();
-    foreach my $id (keys(%hostname)) {
-	my $name=$hostname{$id};
-	my $ip;
-	if (!exists($name_to_ip{$name})) {
-	    $ip = gethostbyname($name);
-	    if (!$ip || length($ip) ne 4) {
-		&logthis("Skipping host $id name $name no IP found");
-		next;
+    sub get_host_ip {
+	my ($lonid) = @_;
+	if (exists($lonid_to_ip{$lonid})) {
+	    return $lonid_to_ip{$lonid};
+	}
+	my $name=&hostname($lonid);
+   	my $ip = gethostbyname($name);
+	return if (!$ip || length($ip) ne 4);
+	$ip=inet_ntoa($ip);
+	$name_to_ip{$name}   = $ip;
+	$lonid_to_ip{$lonid} = $ip;
+	return $ip;
+    }
+    
+    sub get_iphost {
+	if (%iphost) { return %iphost; }
+	my %hostname = &all_hostnames();
+	foreach my $id (keys(%hostname)) {
+	    my $name=$hostname{$id};
+	    my $ip;
+	    if (!exists($name_to_ip{$name})) {
+		$ip = gethostbyname($name);
+		if (!$ip || length($ip) ne 4) {
+		    &logthis("Skipping host $id name $name no IP found");
+		    next;
+		}
+		$ip=inet_ntoa($ip);
+		$name_to_ip{$name} = $ip;
+	    } else {
+		$ip = $name_to_ip{$name};
 	    }
-	    $ip=inet_ntoa($ip);
-	    $name_to_ip{$name} = $ip;
-	} else {
-	    $ip = $name_to_ip{$name};
+	    $lonid_to_ip{$id} = $ip;
+	    push(@{$iphost{$ip}},$id);
 	}
-	push(@{$iphost{$ip}},$id);
+	return %iphost;
     }
-    return %iphost;
 }
 
 # ------------------------------------------------------ Read spare server file
@@ -8006,6 +8157,10 @@ X<userenvironment()>
 B<userenvironment($udom,$uname,@what)>: gets the values of the keys
 passed in @what from the requested user's environment, returns a hash
 
+=item * 
+X<userlog_query()>
+B<userlog_query($uname,$udom,%filters)>: retrieves data from a user's activity.log file. %filters defines filters applied when parsing the log file. These can be start or end timestamps, or the type of action - log to look for Login or Logout events, check for Checkin or Checkout, role for role selection. The response is in the form timestamp1:hostid1:event1&timestamp2:hostid2:event2 where events are escaped strings of the action recorded in the activity.log file.
+
 =back
 
 =head2 User Roles
@@ -8035,16 +8190,18 @@ explanation of a user role term
 
 =item *
 
-get_my_roles($uname,$udom,$types,$roles,$roledoms) : All arguments are
-optional.  Returns a hash of a user's roles, with keys set to
-colon-sparated $uname,$udom,and $role, and value set to
-colon-separated start and end times for the role. If no username and
-domain are specified, will default to current user/domain. Types,
-roles, and roledoms are references to arrays, of role statuses
-(active, future or previous), roles (e.g., cc,in, st etc.) and domains
-of the roles which can be used to restrict the list if roles
-reported. If no array ref is provided for types, will default to
-return only active roles.
+get_my_roles($uname,$udom,$context,$types,$roles,$roledoms) :
+All arguments are optional. Returns a hash of a roles, either for
+co-author/assistant author roles for a user's Construction Space
+(default), or if $context is 'user', roles for the user himself,
+In the hash, keys are set to colon-sparated $uname,$udom,and $role,
+and value is set to colon-separated start and end times for the role.
+If no username and domain are specified, will default to current
+user/domain. Types, roles, and roledoms are references to arrays,
+of role statuses (active, future or previous), roles 
+(e.g., cc,in, st etc.) and domains of the roles which can be used
+to restrict the list of roles reported. If no array ref is 
+provided for types, will default to return only active roles.
 
 =back