--- loncom/lonnet/perl/lonnet.pm 2000/06/30 17:09:51 1.16 +++ 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 @@ -13,6 +24,8 @@ # put(namesp,hash) : stores hash in namesp # dump(namesp) : dumps the complete namespace into a hash # ssi(url) : does a complete request cycle on url to localhost +# repcopy(filename) : replicate file +# dirlist(url) : gets a directory listing # # 6/1/99,6/2,6/10,6/11,6/12,6/14,6/26,6/28,6/29,6/30, # 7/1,7/2,7/9,7/10,7/12,7/14,7/15,7/19, @@ -22,7 +35,7 @@ # 04/05,05/29,05/31,06/01, # 06/05,06/26 Gerd Kortemeyer # 06/26 Ben Tyszka -# 06/30 Gerd Kortemeyer +# 06/30,07/15,07/17,07/18,07/20,07/21,07/22 Gerd Kortemeyer package Apache::lonnet; @@ -291,6 +304,7 @@ sub subscribe { sub repcopy { my $filename=shift; my $transname="$filename.in.transfer"; + if ((-e $filename) || (-e $transname)) { return OK; } my $remoteurl=subscribe($filename); if ($remoteurl eq 'con_lost') { &logthis("Subscribe returned con_lost: $filename"); @@ -298,9 +312,11 @@ sub repcopy { } elsif ($remoteurl eq 'not_found') { &logthis("Subscribe returned not_found: $filename"); return HTTP_NOT_FOUND; - } elsif ($remoteurl eq 'forbidden') { - &logthis("Subscribe returned forbidden: $filename"); + } elsif ($remoteurl eq 'rejected') { + &logthis("Subscribe returned rejected: $filename"); return FORBIDDEN; + } elsif ($remoteurl eq 'directory') { + return OK; } else { my @parts=split(/\//,$filename); my $path="/$parts[1]/$parts[2]/$parts[3]/$parts[4]"; @@ -354,9 +370,6 @@ sub ssi { return $response->content; } - - - # ------------------------------------------------------------------------- Log sub log { @@ -400,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=''; @@ -420,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; @@ -571,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'; @@ -589,6 +631,102 @@ 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 + +sub dirlist { + my $uri=shift; + $uri=~s/^\///; + $uri=~s/\/$//; + my ($res,$udom,$uname,@rest)=split(/\//,$uri); + if ($udom) { + if ($uname) { + my $listing=reply('ls:'.$perlvar{'lonDocRoot'}.'/'.$uri, + homeserver($uname,$udom)); + return split(/:/,$listing); + } else { + my $tryserver; + my %allusers=(); + foreach $tryserver (keys %libserv) { + if ($hostdom{$tryserver} eq $udom) { + my $listing=reply('ls:'.$perlvar{'lonDocRoot'}.'/res/'.$udom, + $tryserver); + if (($listing ne 'no_such_dir') && ($listing ne 'empty') + && ($listing ne 'con_lost')) { + map { + my ($entry,@stat)=split(/&/,$_); + $allusers{$entry}=1; + } split(/:/,$listing); + } + } + } + my $alluserstr=''; + map { + $alluserstr.=$_.'&user:'; + } sort keys %allusers; + $alluserstr=~s/:$//; + return split(/:/,$alluserstr); + } + } else { + my $tryserver; + my %alldom=(); + foreach $tryserver (keys %libserv) { + $alldom{$hostdom{$tryserver}}=1; + } + my $alldomstr=''; + map { + $alldomstr.=$perlvar{'lonDocRoot'}.'/res/'.$_.'&domain:'; + } sort keys %alldom; + $alldomstr=~s/:$//; + return split(/:/,$alldomstr); + } } # -------------------------------------------------------- Escape Special Chars