version 1.918, 2007/10/03 19:57:26
|
version 1.923, 2007/11/10 03:51:10
|
Line 1047 sub get_instuser {
|
Line 1047 sub get_instuser {
|
} |
} |
|
|
sub inst_rulecheck { |
sub inst_rulecheck { |
my ($udom,$uname,$rules) = @_; |
my ($udom,$uname,$id,$item,$rules) = @_; |
my %returnhash; |
my %returnhash; |
if ($udom ne '') { |
if ($udom ne '') { |
if (ref($rules) eq 'ARRAY') { |
if (ref($rules) eq 'ARRAY') { |
Line 1055 sub inst_rulecheck {
|
Line 1055 sub inst_rulecheck {
|
my $rulestr = join(':',@{$rules}); |
my $rulestr = join(':',@{$rules}); |
my $homeserver=&domain($udom,'primary'); |
my $homeserver=&domain($udom,'primary'); |
if (($homeserver ne '') && ($homeserver ne 'no_host')) { |
if (($homeserver ne '') && ($homeserver ne 'no_host')) { |
my $response=&unescape(&reply('instrulecheck:'.&escape($udom).':'. |
my $response; |
&escape($uname).':'.$rulestr, |
if ($item eq 'username') { |
|
$response=&unescape(&reply('instrulecheck:'.&escape($udom). |
|
':'.&escape($uname).':'.$rulestr, |
$homeserver)); |
$homeserver)); |
|
} elsif ($item eq 'id') { |
|
$response=&unescape(&reply('instidrulecheck:'.&escape($udom). |
|
':'.&escape($id).':'.$rulestr, |
|
$homeserver)); |
|
} |
if ($response ne 'refused') { |
if ($response ne 'refused') { |
my @pairs=split(/\&/,$response); |
my @pairs=split(/\&/,$response); |
foreach my $item (@pairs) { |
foreach my $item (@pairs) { |
Line 1074 sub inst_rulecheck {
|
Line 1081 sub inst_rulecheck {
|
} |
} |
|
|
sub inst_userrules { |
sub inst_userrules { |
my ($udom) = @_; |
my ($udom,$check) = @_; |
my (%ruleshash,@ruleorder); |
my (%ruleshash,@ruleorder); |
if ($udom ne '') { |
if ($udom ne '') { |
my $homeserver=&domain($udom,'primary'); |
my $homeserver=&domain($udom,'primary'); |
if (($homeserver ne '') && ($homeserver ne 'no_host')) { |
if (($homeserver ne '') && ($homeserver ne 'no_host')) { |
my $response=&reply('instuserrules:'.&escape($udom), |
my $response; |
|
if ($check eq 'id') { |
|
$response=&reply('instidrules:'.&escape($udom), |
$homeserver); |
$homeserver); |
|
} else { |
|
$response=&reply('instuserrules:'.&escape($udom), |
|
$homeserver); |
|
} |
if (($response ne 'refused') && ($response ne 'error') && |
if (($response ne 'refused') && ($response ne 'error') && |
|
($response ne 'unknown_cmd') && |
($response ne 'no_such_host')) { |
($response ne 'no_such_host')) { |
my ($hashitems,$orderitems) = split(/:/,$response); |
my ($hashitems,$orderitems) = split(/:/,$response); |
my @pairs=split(/\&/,$hashitems); |
my @pairs=split(/\&/,$hashitems); |
Line 1383 sub do_cache_new {
|
Line 1397 sub do_cache_new {
|
$memcache->disconnect_all(); |
$memcache->disconnect_all(); |
} |
} |
# need to make a copy of $value |
# need to make a copy of $value |
#&make_room($id,$value,$debug); |
&make_room($id,$value,$debug); |
return $value; |
return $value; |
} |
} |
|
|
sub make_room { |
sub make_room { |
my ($id,$value,$debug)=@_; |
my ($id,$value,$debug)=@_; |
$remembered{$id}=$value; |
|
|
$remembered{$id}= (ref($value)) ? &Storable::dclone($value) |
|
: $value; |
if ($to_remember<0) { return; } |
if ($to_remember<0) { return; } |
$accessed{$id}=[&gettimeofday()]; |
$accessed{$id}=[&gettimeofday()]; |
if (scalar(keys(%remembered)) <= $to_remember) { return; } |
if (scalar(keys(%remembered)) <= $to_remember) { return; } |
Line 2170 sub flushcourselogs {
|
Line 2186 sub flushcourselogs {
|
# times and course titles for all courseids |
# times and course titles for all courseids |
# |
# |
my %courseidbuffer=(); |
my %courseidbuffer=(); |
foreach my $crsid (keys %courselogs) { |
foreach my $crsid (keys(%courselogs)) { |
if (&reply('log:'.$coursedombuf{$crsid}.':'.$coursenumbuf{$crsid}.':'. |
if (&reply('log:'.$coursedombuf{$crsid}.':'.$coursenumbuf{$crsid}.':'. |
&escape($courselogs{$crsid}), |
&escape($courselogs{$crsid}), |
$coursehombuf{$crsid}) eq 'ok') { |
$coursehombuf{$crsid}) eq 'ok') { |
Line 2183 sub flushcourselogs {
|
Line 2199 sub flushcourselogs {
|
delete $courselogs{$crsid}; |
delete $courselogs{$crsid}; |
} |
} |
} |
} |
$courseidbuffer{$coursehombuf{$crsid}}{$crsid} = ( |
$courseidbuffer{$coursehombuf{$crsid}}{$crsid} = { |
'description' => &escape($coursedescrbuf{$crsid}), |
'description' => &escape($coursedescrbuf{$crsid}), |
'instcode' => &escape($courseinstcodebuf{$crsid}), |
'inst_code' => &escape($courseinstcodebuf{$crsid}), |
'type' => &escape($coursetypebuf{$crsid}), |
'type' => &escape($coursetypebuf{$crsid}), |
'owner' => &escape($courseownerbuf{$crsid}), |
'owner' => &escape($courseownerbuf{$crsid}), |
); |
}; |
} |
} |
# |
# |
# Write course id database (reverse lookup) to homeserver of courses |
# Write course id database (reverse lookup) to homeserver of courses |
Line 2196 sub flushcourselogs {
|
Line 2212 sub flushcourselogs {
|
# |
# |
foreach my $crs_home (keys(%courseidbuffer)) { |
foreach my $crs_home (keys(%courseidbuffer)) { |
my $response = &courseidput(&host_domain($crs_home), |
my $response = &courseidput(&host_domain($crs_home), |
$courseidbuffer{$crs_home},$crs_home); |
$courseidbuffer{$crs_home}, |
|
$crs_home,'timeonly'); |
} |
} |
# |
# |
# File accesses |
# File accesses |
Line 2460 sub get_my_roles {
|
Line 2477 sub get_my_roles {
|
} |
} |
if (ref($roles) eq 'ARRAY') { |
if (ref($roles) eq 'ARRAY') { |
if (!grep(/^\Q$role\E$/,@{$roles})) { |
if (!grep(/^\Q$role\E$/,@{$roles})) { |
next; |
if ($role =~ /^cr\//) { |
|
if (!grep(/^cr$/,@{$roles})) { |
|
next; |
|
} |
|
} else { |
|
next; |
|
} |
} |
} |
} |
} |
$returnhash{$username.':'.$domain.':'.$role}=$tstart.':'.$tend; |
$returnhash{$username.':'.$domain.':'.$role}=$tstart.':'.$tend; |
Line 2502 sub getannounce {
|
Line 2525 sub getannounce {
|
# |
# |
|
|
sub courseidput { |
sub courseidput { |
my ($domain,$storehash,$coursehome)=@_; |
my ($domain,$storehash,$coursehome,$caller) = @_; |
my $items=''; |
my $outcome; |
my $now = time; |
if ($caller eq 'timeonly') { |
foreach my $item (keys(%$storehash)) { |
my $cids = ''; |
$storehash->{$item}{'lasttime'} = $now; |
foreach my $item (keys(%$storehash)) { |
$items.=&escape($item).'='.&freeze_escape($$storehash{$item}).'&'; |
$cids.=&escape($item).'&'; |
|
} |
|
$cids=~s/\&$//; |
|
$outcome = &reply('courseidputhash:'.$domain.':'.$caller.':'.$cids, |
|
$coursehome); |
|
} else { |
|
my $items = ''; |
|
foreach my $item (keys(%$storehash)) { |
|
$items.= &escape($item).'='. |
|
&freeze_escape($$storehash{$item}).'&'; |
|
} |
|
$items=~s/\&$//; |
|
$outcome = &reply('courseidputhash:'.$domain.':'.$caller.':'.$items, |
|
$coursehome); |
} |
} |
$items=~s/\&$//; |
|
my $outcome = &reply('courseidputhash:'.$domain.':'.$items,$coursehome); |
|
if ($outcome eq 'unknown_cmd') { |
if ($outcome eq 'unknown_cmd') { |
my $what; |
my $what; |
foreach my $cid (keys(%$storehash)) { |
foreach my $cid (keys(%$storehash)) { |
$what .= &escape($cid).'='; |
$what .= &escape($cid).'='; |
foreach my $item ('description','instcode','owner','type') { |
foreach my $item ('description','inst_code','owner','type') { |
$what .= $storehash->{$item}.':'; |
$what .= &escape($storehash->{$item}).':'; |
} |
} |
$what =~ s/\:$/&/; |
$what =~ s/\:$/&/; |
} |
} |
Line 2528 sub courseidput {
|
Line 2562 sub courseidput {
|
} |
} |
|
|
sub courseiddump { |
sub courseiddump { |
my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter,$coursefilter,$hostidflag,$hostidref,$typefilter,$regexp_ok)=@_; |
my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter, |
|
$coursefilter,$hostidflag,$hostidref,$typefilter,$regexp_ok)=@_; |
my $as_hash = 1; |
my $as_hash = 1; |
my %returnhash; |
my %returnhash; |
if (!$domfilter) { $domfilter=''; } |
if (!$domfilter) { $domfilter=''; } |
Line 2545 sub courseiddump {
|
Line 2580 sub courseiddump {
|
$sincefilter.':'.&escape($descfilter).':'. |
$sincefilter.':'.&escape($descfilter).':'. |
&escape($instcodefilter).':'.&escape($ownerfilter). |
&escape($instcodefilter).':'.&escape($ownerfilter). |
':'.&escape($coursefilter).':'.&escape($typefilter). |
':'.&escape($coursefilter).':'.&escape($typefilter). |
':'.&escape($regexp_ok).':'.$as_hash,$tryserver); |
':'.&escape($regexp_ok).':'.$as_hash,$tryserver); |
my @pairs=split(/\&/,$rep); |
my @pairs=split(/\&/,$rep); |
foreach my $item (@pairs) { |
foreach my $item (@pairs) { |
my ($key,$value)=split(/\=/,$item,2); |
my ($key,$value)=split(/\=/,$item,2); |
Line 2555 sub courseiddump {
|
Line 2590 sub courseiddump {
|
if (ref($result) eq 'HASH') { |
if (ref($result) eq 'HASH') { |
$returnhash{$key}=$result; |
$returnhash{$key}=$result; |
} else { |
} else { |
my @responses = split(/:/,$result); |
my @responses = split(/:/,$value); |
my @items = ('description','instcode','owner','type'); |
my @items = ('description','inst_code','owner','type'); |
for (my $i=0; $i<@responses; $i++) { |
for (my $i=0; $i<@responses; $i++) { |
$returnhash{$key}{$items[$i]} = $responses[$i]; |
$returnhash{$key}{$items[$i]} = &unescape($responses[$i]); |
} |
} |
} |
} |
} |
} |
Line 2606 sub get_domain_roles {
|
Line 2641 sub get_domain_roles {
|
if (undef($enddate) || $enddate eq '') { |
if (undef($enddate) || $enddate eq '') { |
$enddate = '.'; |
$enddate = '.'; |
} |
} |
my $rolelist = join(':',@{$roles}); |
my $rolelist; |
|
if (ref($roles) eq 'ARRAY') { |
|
$rolelist = join(':',@{$roles}); |
|
} |
my %personnel = (); |
my %personnel = (); |
|
|
my %servers = &get_servers($dom,'library'); |
my %servers = &get_servers($dom,'library'); |
Line 5546 sub createcourse {
|
Line 5584 sub createcourse {
|
# log existence |
# log existence |
my $newcourse = { |
my $newcourse = { |
$udom.'_'.$uname => { |
$udom.'_'.$uname => { |
description => &escape($description), |
description => $description, |
inst_code => &escape($inst_code), |
inst_code => $inst_code, |
owner => &escape($course_owner), |
owner => $course_owner, |
type => &escape($crstype), |
type => $crstype, |
}, |
}, |
}; |
}; |
&courseidput($udom,$newcourse); |
&courseidput($udom,$newcourse,$uhome,'notime'); |
&flushcourselogs(); |
|
# set toplevel url |
# set toplevel url |
my $topurl=$url; |
my $topurl=$url; |
unless ($nonstandard) { |
unless ($nonstandard) { |