--- loncom/lonnet/perl/lonnet.pm	2000/07/21 00:40:37	1.20
+++ loncom/lonnet/perl/lonnet.pm	2000/07/24 21:22:35	1.21
@@ -4,7 +4,18 @@
 # Functions for use by content handlers:
 #
 # plaintext(short)   : plain text explanation of short term
-# allowed(short,url) : returns codes for allowed actions
+# allowed(short,url) : returns codes for allowed actions F,R,S,C
+# definerole(rolename,sys,dom,cou) : define a custom role rolename
+#                      set priviledges in format of lonTabs/roles.tab for
+#                      system, domain and course level, 
+# assignrole(udom,uname,url,role,end,start) : give a role to a user for the
+#                      level given by url. Optional start and end dates
+#                      (leave empty string or zero for "no date") 
+# assigncustomrole (udom,uname,url,rdom,rnam,rolename,end,start) : give a
+#                      custom role to a user for the level given by url.
+#                      Specify name and domain of role author, and role name
+# revokerole (udom,uname,url,role) : Revoke a role for url
+# revokecustomrole (udom,uname,url,rdom,rnam,rolename) : Revoke a custom role
 # appendenv(hash)    : adds hash to session environment
 # store(hash)        : stores hash permanently for this url
 # restore            : returns hash for this url
@@ -24,7 +35,7 @@
 # 04/05,05/29,05/31,06/01,
 # 06/05,06/26 Gerd Kortemeyer
 # 06/26 Ben Tyszka
-# 06/30,07/15,07/17,07/18 Gerd Kortemeyer
+# 06/30,07/15,07/17,07/18,07/20,07/21,07/22 Gerd Kortemeyer
 
 package Apache::lonnet;
 
@@ -402,15 +413,18 @@ sub rolesinit {
     if (($rolesdump eq 'con_lost') || ($rolesdump eq '')) { return ''; }
     my %allroles=();
     my %thesepriv=();
-    my $userroles='';
     my $now=time;
+    my $userroles="user.login.time=$now\n";
     my $thesestr;
 
     if ($rolesdump ne '') {
         map {
-	  if ($_!~/rolesdef\&/) {
+	  if ($_!~/^rolesdef\&/) {
             my ($area,$role)=split(/=/,$_);
+            $area=~s/\_\w\w$//;
             my ($trole,$tend,$tstart)=split(/_/,$role);
+            $userroles.='user.role.'.$trole.'.'.$area.'='.
+                        $tstart.'.'.$tend."\n";
             if ($tend!=0) {
 	        if ($tend<$now) {
 	            $trole='';
@@ -422,19 +436,17 @@ sub rolesinit {
                 }
             }
             if (($area ne '') && ($trole ne '')) {
-               $userroles.='user.role.'.$trole.'.'.$area.'='.
-                           $tstart.'.'.$tend."\n";
                my ($tdummy,$tdomain,$trest)=split(/\//,$area);
                if ($trole =~ /^cr\//) {
 		   my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$trole);
                    my $homsvr=homeserver($rauthor,$rdomain);
                    if ($hostname{$homsvr} ne '') {
                       my $roledef=
-			  reply("get:$rdomain:$rauthor:roles:rolesdef&$rrole",
+			  reply("get:$rdomain:$rauthor:roles:rolesdef_$rrole",
                                 $homsvr);
                       if (($roledef ne 'con_lost') && ($roledef ne '')) {
                          my ($syspriv,$dompriv,$coursepriv)=
-			     split(/&&/,$roledef);
+			     split(/\_/,unescape($roledef));
  	                 $allroles{'/'}.=':'.$syspriv;
                          if ($tdomain ne '') {
                              $allroles{'/'.$tdomain.'/'}.=':'.$dompriv;
@@ -573,9 +585,37 @@ sub allowed {
 sub definerole {
   if (allowed('mcr','/')) {
     my ($rolename,$sysrole,$domrole,$courole)=@_;
+    map {
+	my ($crole,$cqual)=split(/\&/,$_);
+        if ($pr{'cr:s'}!~/$crole/) { return "refused:s:$crole"; }
+        if ($pr{'cr:s'}=~/$crole\&/) {
+	    if ($pr{'cr:s'}!~/$crole\&\w*$cqual/) { 
+               return "refused:s:$crole&$cqual"; 
+            }
+        }
+    } split('/',$sysrole);
+    map {
+	my ($crole,$cqual)=split(/\&/,$_);
+        if ($pr{'cr:d'}!~/$crole/) { return "refused:d:$crole"; }
+        if ($pr{'cr:d'}=~/$crole\&/) {
+	    if ($pr{'cr:d'}!~/$crole\&\w*$cqual/) { 
+               return "refused:d:$crole&$cqual"; 
+            }
+        }
+    } split('/',$domrole);
+    map {
+	my ($crole,$cqual)=split(/\&/,$_);
+        if ($pr{'cr:c'}!~/$crole/) { return "refused:c:$crole"; }
+        if ($pr{'cr:c'}=~/$crole\&/) {
+	    if ($pr{'cr:c'}!~/$crole\&\w*$cqual/) { 
+               return "refused:c:$crole&$cqual"; 
+            }
+        }
+    } split('/',$courole);
     my $command="encrypt:rolesput:$ENV{'user.domain'}:$ENV{'user.name'}:".
                 "$ENV{'user.domain'}:$ENV{'user.name'}:".
-	        "rolesdef&$rolename=$sysrole&&$domrole&&$courole";
+	        "rolesdef_$rolename=".
+                escape($sysrole.'_'.$domrole.'_'.$courole);
     return reply($command,$ENV{'user.home'});
   } else {
     return 'refused';
@@ -591,6 +631,52 @@ sub plaintext {
 # ----------------------------------------------------------------- Assign Role
 
 sub assignrole {
+    my ($udom,$uname,$url,$role,$end,$start)=@_;
+    my $mrole;
+    if ($role =~ /^cr\//) {
+        unless ($url=~/\.course$/) { return 'invalid'; }
+	unless (allowed('ccr',$url)) { return 'refused'; }
+        $mrole='cr';
+    } else {
+        unless (($url=~/\.course$/) || ($url=~/\/$/)) { return 'invalid'; }
+        unless (allowed('c'+$role)) { return 'refused'; }
+        $mrole=$role;
+    }
+    my $command="encrypt:rolesput:$ENV{'user.domain'}:$ENV{'user.name'}:".
+                "$udom:$uname:$url".'_'."$mrole=$role";
+    if ($end) { $command.='_$end'; }
+    if ($start) {
+	if ($end) { 
+           $command.='_$start'; 
+        } else {
+           $command.='_0_$start';
+        }
+    }
+    return &reply($command,&homeserver($uname,$udom));
+}
+
+# ---------------------------------------------------------- Assign Custom Role
+
+sub assigncustomrole {
+    my ($udom,$uname,$url,$rdom,$rnam,$rolename,$end,$start)=@_;
+    return &assignrole($udom,$uname,$url,'cr/'.$rdom.'/'.$rnam.'/'.$rolename,
+                       $end,$start);
+}
+
+# ----------------------------------------------------------------- Revoke Role
+
+sub revokerole {
+    my ($udom,$uname,$url,$role)=@_;
+    my $now=time;
+    return &assignrole($udom,$uname,$url,$role,$now);
+}
+
+# ---------------------------------------------------------- Revoke Custom Role
+
+sub revokecustomrole {
+    my ($udom,$uname,$url,$rdom,$rnam,$rolename)=@_;
+    my $now=time;
+    return &assigncustomrole($udom,$uname,$url,$rdom,$rnam,$rolename,$now);
 }
 
 # ------------------------------------------------------------ Directory lister