version 1.130, 2001/07/26 18:15:39
|
version 1.134, 2001/07/27 20:17:14
|
Line 40
|
Line 40
|
# : returns hash for this symb, all args are optional |
# : returns hash for this symb, all args are optional |
# if they aren't given they will be derived from the |
# if they aren't given they will be derived from the |
# current enviroment |
# current enviroment |
# eget(namesp,array) : returns hash with keys from array filled in from namesp |
# |
# get(namesp,array) : returns hash with keys from array filled in from namesp |
# |
# del(namesp,array) : deletes keys out of array from namesp |
# for the next 6 functions udom and uname are optional |
# put(namesp,hash) : stores hash in namesp |
# if supplied they use udom as the domain and uname |
# cput(namesp,hash) : critical put |
# as the username for the function (supply a courseid |
|
# for the uname if you want a course database) |
|
# if not supplied it uses %ENV and looks at |
|
# user. attribute for the values |
|
# |
|
# eget(namesp,arrayref,udom,uname) |
|
# : returns hash with keys from array reference filled |
|
# in from namesp (encrypts the return communication) |
|
# get(namesp,arrayref,udom,uname) |
|
# : returns hash with keys from array reference filled |
|
# in from namesp |
# dump(namesp,udom,uname) : dumps the complete namespace into a hash |
# dump(namesp,udom,uname) : dumps the complete namespace into a hash |
# if supplied uses udom as the domain and uname |
# del(namesp,array,udom,uname) : deletes keys out of array from namesp |
# as the username for the dump (supply a courseid |
# put(namesp,hash,udom,uname) : stores hash in namesp |
# for the uname if you want a course database) |
# cput(namesp,hash,udom,uname) : critical put |
|
# |
|
# |
# ssi(url,hash) : does a complete request cycle on url to localhost, posts |
# ssi(url,hash) : does a complete request cycle on url to localhost, posts |
# hash |
# hash |
# coursedescription(id) : returns and caches course description for id |
# coursedescription(id) : returns and caches course description for id |
Line 671 sub devalidate {
|
Line 683 sub devalidate {
|
if ($cid) { |
if ($cid) { |
my $key=$ENV{'user.name'}.':'.$ENV{'user.domain'}.':'; |
my $key=$ENV{'user.name'}.':'.$ENV{'user.domain'}.':'; |
my $status= |
my $status= |
&reply('del:'.$ENV{'course.'.$cid.'.domain'}.':'. |
&del('nohist_calculatedsheet', |
$ENV{'course.'.$cid.'.num'}. |
[$key.'studentcalc'], |
':nohist_calculatedsheets:'. |
$ENV{'course.'.$cid.'.domain'}, |
&escape($key.'studentcalc:'), |
$ENV{'course.'.$cid.'.num'}) |
$ENV{'course.'.$cid.'.home'}) |
.' '. |
.' '. |
&del('nohist_calculatedsheets_'.$cid, |
&reply('del:'.$ENV{'user.domain'}.':'. |
[$key.'assesscalc:'.$symb]); |
$ENV{'user.name'}. |
|
':nohist_calculatedsheets_'.$cid.':'. |
|
&escape($key.'assesscalc:'.$symb), |
|
$ENV{'user.home'}); |
|
unless ($status eq 'ok ok') { |
unless ($status eq 'ok ok') { |
&logthis('Could not devalidate spreadsheet '. |
&logthis('Could not devalidate spreadsheet '. |
$ENV{'user.name'}.' at '.$ENV{'user.domain'}.' for '. |
$ENV{'user.name'}.' at '.$ENV{'user.domain'}.' for '. |
$symb.': '.$status); |
$symb.': '.$status); |
} |
} |
} |
} |
} |
} |
|
|
Line 915 sub rolesinit {
|
Line 923 sub rolesinit {
|
# --------------------------------------------------------------- get interface |
# --------------------------------------------------------------- get interface |
|
|
sub get { |
sub get { |
my ($namespace,@storearr)=@_; |
my ($namespace,$storearr,$udomain,$uname)=@_; |
my $items=''; |
my $items=''; |
map { |
map { |
$items.=escape($_).'&'; |
$items.=escape($_).'&'; |
} @storearr; |
} @$storearr; |
$items=~s/\&$//; |
$items=~s/\&$//; |
my $rep=reply("get:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$items", |
if (!$udomain) { $udomain=$ENV{'user.domain'}; } |
$ENV{'user.home'}); |
if (!$uname) { $uname=$ENV{'user.name'}; } |
|
my $uhome=&homeserver($uname,$udomain); |
|
|
|
my $rep=&reply("get:$udomain:$uname:$namespace:$items",$uhome); |
my @pairs=split(/\&/,$rep); |
my @pairs=split(/\&/,$rep); |
my %returnhash=(); |
my %returnhash=(); |
my $i=0; |
my $i=0; |
map { |
map { |
$returnhash{$_}=unescape($pairs[$i]); |
$returnhash{$_}=unescape($pairs[$i]); |
$i++; |
$i++; |
} @storearr; |
} @$storearr; |
return %returnhash; |
return %returnhash; |
} |
} |
|
|
# --------------------------------------------------------------- del interface |
# --------------------------------------------------------------- del interface |
|
|
sub del { |
sub del { |
my ($namespace,@storearr)=@_; |
my ($namespace,$storearr,$udomain,$uname)=@_; |
my $items=''; |
my $items=''; |
map { |
map { |
$items.=escape($_).'&'; |
$items.=escape($_).'&'; |
} @storearr; |
} @$storearr; |
$items=~s/\&$//; |
$items=~s/\&$//; |
return reply("del:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$items", |
if (!$udomain) { $udomain=$ENV{'user.domain'}; } |
$ENV{'user.home'}); |
if (!$uname) { $uname=$ENV{'user.name'}; } |
|
my $uhome=&homeserver($uname,$udomain); |
|
|
|
return &reply("del:$udomain:$uname:$namespace:$items",$uhome); |
} |
} |
|
|
# -------------------------------------------------------------- dump interface |
# -------------------------------------------------------------- dump interface |
Line 966 sub dump {
|
Line 980 sub dump {
|
# --------------------------------------------------------------- put interface |
# --------------------------------------------------------------- put interface |
|
|
sub put { |
sub put { |
my ($namespace,%storehash)=@_; |
my ($namespace,$storehash,$udomain,$uname)=@_; |
|
if (!$udomain) { $udomain=$ENV{'user.domain'}; } |
|
if (!$uname) { $uname=$ENV{'user.name'}; } |
|
my $uhome=&homeserver($uname,$udomain); |
my $items=''; |
my $items=''; |
map { |
map { |
$items.=escape($_).'='.escape($storehash{$_}).'&'; |
$items.=&escape($_).'='.&escape($$storehash{$_}).'&'; |
} keys %storehash; |
} keys %$storehash; |
$items=~s/\&$//; |
$items=~s/\&$//; |
return reply("put:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$items", |
return &reply("put:$udomain:$uname:$namespace:$items",$uhome); |
$ENV{'user.home'}); |
|
} |
} |
|
|
# ------------------------------------------------------ critical put interface |
# ------------------------------------------------------ critical put interface |
|
|
sub cput { |
sub cput { |
my ($namespace,%storehash)=@_; |
my ($namespace,$storehash,$udomain,$uname)=@_; |
|
if (!$udomain) { $udomain=$ENV{'user.domain'}; } |
|
if (!$uname) { $uname=$ENV{'user.name'}; } |
|
my $uhome=&homeserver($uname,$udomain); |
my $items=''; |
my $items=''; |
map { |
map { |
$items.=escape($_).'='.escape($storehash{$_}).'&'; |
$items.=escape($_).'='.escape($$storehash{$_}).'&'; |
} keys %storehash; |
} keys %$storehash; |
$items=~s/\&$//; |
$items=~s/\&$//; |
return critical |
return &critical("put:$udomain:$uname:$namespace:$items",$uhome); |
("put:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$items", |
|
$ENV{'user.home'}); |
|
} |
} |
|
|
# -------------------------------------------------------------- eget interface |
# -------------------------------------------------------------- eget interface |
|
|
sub eget { |
sub eget { |
my ($namespace,@storearr)=@_; |
my ($namespace,$storearr,$udomain,$uname)=@_; |
my $items=''; |
my $items=''; |
map { |
map { |
$items.=escape($_).'&'; |
$items.=escape($_).'&'; |
} @storearr; |
} @$storearr; |
$items=~s/\&$//; |
$items=~s/\&$//; |
my $rep=reply("eget:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$items", |
if (!$udomain) { $udomain=$ENV{'user.domain'}; } |
$ENV{'user.home'}); |
if (!$uname) { $uname=$ENV{'user.name'}; } |
|
my $uhome=&homeserver($uname,$udomain); |
|
my $rep=&reply("eget:$udomain:$uname:$namespace:$items",$uhome); |
my @pairs=split(/\&/,$rep); |
my @pairs=split(/\&/,$rep); |
my %returnhash=(); |
my %returnhash=(); |
my $i=0; |
my $i=0; |
map { |
map { |
$returnhash{$_}=unescape($pairs[$i]); |
$returnhash{$_}=unescape($pairs[$i]); |
$i++; |
$i++; |
} @storearr; |
} @$storearr; |
return %returnhash; |
return %returnhash; |
} |
} |
|
|
Line 1416 sub modifyuser {
|
Line 1435 sub modifyuser {
|
} |
} |
} |
} |
# -------------------------------------------------------------- Add names, etc |
# -------------------------------------------------------------- Add names, etc |
my $names=&reply('get:'.$udom.':'.$uname. |
my %names=&get('environment', |
':environment:firstname&middlename&lastname&generation', |
['firstname','middlename','lastname','generation'], |
$uhome); |
$udom,$uname); |
my ($efirst,$emiddle,$elast,$egene)=split(/\&/,$names); |
if ($first) { $names{'firstname'} = $first; } |
if ($first) { $efirst = &escape($first); } |
if ($middle) { $names{'middlename'} = $middle; } |
if ($middle) { $emiddle = &escape($middle); } |
if ($last) { $names{'lastname'} = $last; } |
if ($last) { $elast = &escape($last); } |
if ($gene) { $names{'generation'} = $gene; } |
if ($gene) { $egene = &escape($gene); } |
my $reply = &put('environment', \%names, $udom,$uname); |
my $reply=&reply('put:'.$udom.':'.$uname. |
if ($reply ne 'ok') { return 'error: '.$reply; } |
':environment:firstname='.$efirst. |
|
'&middlename='.$emiddle. |
|
'&lastname='.$elast. |
|
'&generation='.$egene,$uhome); |
|
if ($reply ne 'ok') { |
|
return 'error: '.$reply; |
|
} |
|
&logthis('Success modifying user '.$udom.', '.$uname.', '.$uid.', '. |
&logthis('Success modifying user '.$udom.', '.$uname.', '.$uid.', '. |
$umode.', '.$first.', '.$middle.', '. |
$umode.', '.$first.', '.$middle.', '. |
$last.', '.$gene.' by '. |
$last.', '.$gene.' by '. |
$ENV{'user.name'}.' at '.$ENV{'user.domain'}); |
$ENV{'user.name'}.' at '.$ENV{'user.domain'}); |
return 'ok'; |
return 'ok'; |
} |
} |
|
|
# -------------------------------------------------------------- Modify student |
# -------------------------------------------------------------- Modify student |
Line 1705 sub EXT {
|
Line 1717 sub EXT {
|
# ---------------------------------------------------- Any other user namespace |
# ---------------------------------------------------- Any other user namespace |
} else { |
} else { |
my $item=($rest)?$qualifier.'.'.$rest:$qualifier; |
my $item=($rest)?$qualifier.'.'.$rest:$qualifier; |
my %reply=&get($space,$item); |
my %reply=&get($space,[$item]); |
return $reply{$item}; |
return $reply{$item}; |
} |
} |
} elsif ($realm eq 'request') { |
} elsif ($realm eq 'request') { |
Line 1748 sub EXT {
|
Line 1760 sub EXT {
|
|
|
# ----------------------------------------------------------- first, check user |
# ----------------------------------------------------------- first, check user |
my %resourcedata=get('resourcedata', |
my %resourcedata=get('resourcedata', |
($courselevelr,$courselevelm,$courselevel)); |
[$courselevelr,$courselevelm,$courselevel]); |
if (($resourcedata{$courselevelr}!~/^error\:/) && |
if (($resourcedata{$courselevelr}!~/^error\:/) && |
($resourcedata{$courselevelr}!~/^con_lost/)) { |
($resourcedata{$courselevelr}!~/^con_lost/)) { |
|
|