version 1.386, 2003/07/03 19:26:21
|
version 1.394, 2003/07/25 01:18:04
|
Line 1425 sub devalidate {
|
Line 1425 sub devalidate {
|
my ($symb,$uname,$udom)=@_; |
my ($symb,$uname,$udom)=@_; |
my $cid=$ENV{'request.course.id'}; |
my $cid=$ENV{'request.course.id'}; |
if ($cid) { |
if ($cid) { |
# delete the stored spreadsheets for |
# delete the stored spreadsheets for |
# - the student level sheet of this user in course's homespace |
# - the student level sheet of this user in course's homespace |
# - the assessment level sheet for this resource |
# - the assessment level sheet for this resource |
# for this user in user's homespace |
# for this user in user's homespace |
my $key=$uname.':'.$udom.':'; |
my $key=$uname.':'.$udom.':'; |
my $status= |
my $status= |
&del('nohist_calculatedsheets', |
&del('nohist_calculatedsheets', |
[$key.'studentcalc'], |
[$key.'studentcalc:'], |
$ENV{'course.'.$cid.'.domain'}, |
$ENV{'course.'.$cid.'.domain'}, |
$ENV{'course.'.$cid.'.num'}) |
$ENV{'course.'.$cid.'.num'}) |
.' '. |
.' '. |
&del('nohist_calculatedsheets_'.$cid, |
&del('nohist_calculatedsheets_'.$cid, |
[$key.'assesscalc:'.$symb]); |
[$key.'assesscalc:'.$symb],$udom,$uname); |
unless ($status eq 'ok ok') { |
unless ($status eq 'ok ok') { |
&logthis('Could not devalidate spreadsheet '. |
&logthis('Could not devalidate spreadsheet '. |
$uname.' at '.$udom.' for '. |
$uname.' at '.$udom.' for '. |
Line 1936 sub rolesinit {
|
Line 1936 sub rolesinit {
|
my ($tdummy,$tdomain,$trest)=split(/\//,$area); |
my ($tdummy,$tdomain,$trest)=split(/\//,$area); |
if ($trole =~ /^cr\//) { |
if ($trole =~ /^cr\//) { |
my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$trole); |
my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$trole); |
my $homsvr=homeserver($rauthor,$rdomain); |
my $homsvr=homeserver($rauthor,$rdomain); |
if ($hostname{$homsvr} ne '') { |
if ($hostname{$homsvr} ne '') { |
my $roledef= |
my ($rdummy,$roledef)= |
reply("get:$rdomain:$rauthor:roles:rolesdef_$rrole", |
&get('roles',["rolesdef_$rrole"],$rdomain,$rauthor); |
$homsvr); |
|
if (($roledef ne 'con_lost') && ($roledef ne '')) { |
if (($rdummy ne 'con_lost') && ($roledef ne '')) { |
my ($syspriv,$dompriv,$coursepriv)= |
my ($syspriv,$dompriv,$coursepriv)= |
split(/\_/,unescape($roledef)); |
split(/\_/,$roledef); |
if (defined($syspriv)) { |
if (defined($syspriv)) { |
$allroles{'cm./'}.=':'.$syspriv; |
$allroles{'cm./'}.=':'.$syspriv; |
$allroles{$spec.'./'}.=':'.$syspriv; |
$allroles{$spec.'./'}.=':'.$syspriv; |
Line 2521 sub is_on_map {
|
Line 2521 sub is_on_map {
|
sub definerole { |
sub definerole { |
if (allowed('mcr','/')) { |
if (allowed('mcr','/')) { |
my ($rolename,$sysrole,$domrole,$courole)=@_; |
my ($rolename,$sysrole,$domrole,$courole)=@_; |
foreach (split('/',$sysrole)) { |
foreach (split(':',$sysrole)) { |
my ($crole,$cqual)=split(/\&/,$_); |
my ($crole,$cqual)=split(/\&/,$_); |
if ($pr{'cr:s'}!~/$crole/) { return "refused:s:$crole"; } |
if ($pr{'cr:s'}!~/$crole/) { return "refused:s:$crole"; } |
if ($pr{'cr:s'}=~/$crole\&/) { |
if ($pr{'cr:s'}=~/$crole\&/) { |
Line 2530 sub definerole {
|
Line 2530 sub definerole {
|
} |
} |
} |
} |
} |
} |
foreach (split('/',$domrole)) { |
foreach (split(':',$domrole)) { |
my ($crole,$cqual)=split(/\&/,$_); |
my ($crole,$cqual)=split(/\&/,$_); |
if ($pr{'cr:d'}!~/$crole/) { return "refused:d:$crole"; } |
if ($pr{'cr:d'}!~/$crole/) { return "refused:d:$crole"; } |
if ($pr{'cr:d'}=~/$crole\&/) { |
if ($pr{'cr:d'}=~/$crole\&/) { |
Line 2539 sub definerole {
|
Line 2539 sub definerole {
|
} |
} |
} |
} |
} |
} |
foreach (split('/',$courole)) { |
foreach (split(':',$courole)) { |
my ($crole,$cqual)=split(/\&/,$_); |
my ($crole,$cqual)=split(/\&/,$_); |
if ($pr{'cr:c'}!~/$crole/) { return "refused:c:$crole"; } |
if ($pr{'cr:c'}!~/$crole/) { return "refused:c:$crole"; } |
if ($pr{'cr:c'}=~/$crole\&/) { |
if ($pr{'cr:c'}=~/$crole\&/) { |
Line 2651 sub assignrole {
|
Line 2651 sub assignrole {
|
my ($udom,$uname,$url,$role,$end,$start,$deleteflag)=@_; |
my ($udom,$uname,$url,$role,$end,$start,$deleteflag)=@_; |
my $mrole; |
my $mrole; |
if ($role =~ /^cr\//) { |
if ($role =~ /^cr\//) { |
unless (&allowed('ccr',$url)) { |
my $cwosec=$url; |
|
$cwosec=~s/^\/(\w+)\/(\w+)\/.*/$1\/$2/; |
|
unless (&allowed('ccr',$cwosec)) { |
&logthis('Refused custom assignrole: '. |
&logthis('Refused custom assignrole: '. |
$udom.' '.$uname.' '.$url.' '.$role.' '.$end.' '.$start.' by '. |
$udom.' '.$uname.' '.$url.' '.$role.' '.$end.' '.$start.' by '. |
$ENV{'user.name'}.' at '.$ENV{'user.domain'}); |
$ENV{'user.name'}.' at '.$ENV{'user.domain'}); |
Line 2732 sub modifyuser {
|
Line 2734 sub modifyuser {
|
my ($udom, $uname, $uid, |
my ($udom, $uname, $uid, |
$umode, $upass, $first, |
$umode, $upass, $first, |
$middle, $last, $gene, |
$middle, $last, $gene, |
$forceid, $desiredhome)=@_; |
$forceid, $desiredhome, $email)=@_; |
$udom=~s/\W//g; |
$udom=~s/\W//g; |
$uname=~s/\W//g; |
$uname=~s/\W//g; |
&logthis('Call to modify user '.$udom.', '.$uname.', '.$uid.', '. |
&logthis('Call to modify user '.$udom.', '.$uname.', '.$uid.', '. |
Line 2801 sub modifyuser {
|
Line 2803 sub modifyuser {
|
} else { |
} else { |
%names = @tmp; |
%names = @tmp; |
} |
} |
if (defined($first)) { $names{'firstname'} = $first; } |
# |
|
# Make sure to not trash student environment if instructor does not bother |
|
# to supply name and email information |
|
# |
|
if ($first) { $names{'firstname'} = $first; } |
if (defined($middle)) { $names{'middlename'} = $middle; } |
if (defined($middle)) { $names{'middlename'} = $middle; } |
if (defined($last)) { $names{'lastname'} = $last; } |
if ($last) { $names{'lastname'} = $last; } |
if (defined($gene)) { $names{'generation'} = $gene; } |
if (defined($gene)) { $names{'generation'} = $gene; } |
|
if ($email) { $names{'notification'} = $email; |
|
$names{'critnotification'} = $email; } |
|
|
my $reply = &put('environment', \%names, $udom,$uname); |
my $reply = &put('environment', \%names, $udom,$uname); |
if ($reply ne 'ok') { return 'error: '.$reply; } |
if ($reply ne 'ok') { return 'error: '.$reply; } |
&logthis('Success modifying user '.$udom.', '.$uname.', '.$uid.', '. |
&logthis('Success modifying user '.$udom.', '.$uname.', '.$uid.', '. |
Line 2818 sub modifyuser {
|
Line 2827 sub modifyuser {
|
|
|
sub modifystudent { |
sub modifystudent { |
my ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$usec, |
my ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$usec, |
$end,$start,$forceid,$desiredhome)=@_; |
$end,$start,$forceid,$desiredhome,$email)=@_; |
my $cid=''; |
my $cid=''; |
unless ($cid=$ENV{'request.course.id'}) { |
unless ($cid=$ENV{'request.course.id'}) { |
return 'not_in_class'; |
return 'not_in_class'; |
Line 2826 sub modifystudent {
|
Line 2835 sub modifystudent {
|
# --------------------------------------------------------------- Make the user |
# --------------------------------------------------------------- Make the user |
my $reply=&modifyuser |
my $reply=&modifyuser |
($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$forceid, |
($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$forceid, |
$desiredhome); |
$desiredhome,$email); |
unless ($reply eq 'ok') { return $reply; } |
unless ($reply eq 'ok') { return $reply; } |
# This will cause &modify_student_enrollment to get the uid from the |
# This will cause &modify_student_enrollment to get the uid from the |
# students environment |
# students environment |
Line 3197 sub clear_EXT_cache_status {
|
Line 3206 sub clear_EXT_cache_status {
|
sub EXT_cache_status { |
sub EXT_cache_status { |
my ($target_domain,$target_user) = @_; |
my ($target_domain,$target_user) = @_; |
my $cachename = 'cache.EXT.'.$target_user.'.'.$target_domain; |
my $cachename = 'cache.EXT.'.$target_user.'.'.$target_domain; |
if (exists($ENV{$cachename}) && ($ENV{$cachename}+1800) > time) { |
if (exists($ENV{$cachename}) && ($ENV{$cachename}+600) > time) { |
# We know already the user has no data |
# We know already the user has no data |
return 1; |
return 1; |
} else { |
} else { |
Line 4093 BEGIN {
|
Line 4102 BEGIN {
|
%domain_auth_arg_def = (); |
%domain_auth_arg_def = (); |
if ($fh) { |
if ($fh) { |
while (<$fh>) { |
while (<$fh>) { |
next if /^\#/; |
next if (/^(\#|\s*$)/); |
|
# next if /^\#/; |
chomp; |
chomp; |
my ($domain, $domain_description, $def_auth, $def_auth_arg) |
my ($domain, $domain_description, $def_auth, $def_auth_arg) |
= split(/:/,$_,4); |
= split(/:/,$_,4); |
Line 4236 being set.
|
Line 4246 being set.
|
|
|
=back |
=back |
|
|
=head1 INTRODUCTION |
=head1 OVERVIEW |
|
|
This module provides subroutines which interact with the |
lonnet provides subroutines which interact with the |
lonc/lond (TCP) network layer of LON-CAPA. And Can be used to ask about |
lonc/lond (TCP) network layer of LON-CAPA. They can be used to ask |
- classes |
about classes, users, and resources. |
- users |
|
- resources |
|
|
|
For many of these objects you can also use this to store data about |
For many of these objects you can also use this to store data about |
them or modify them in various ways. |
them or modify them in various ways. |
|
|
This is part of the LearningOnline Network with CAPA project |
=head2 Symbs |
described at http://www.lon-capa.org. |
|
|
|
=head1 RETURN MESSAGES |
To identify a specific instance of a resource, LON-CAPA uses symbols |
|
or "symbs"X<symb>. These identifiers are built from the URL of the |
|
map, the resource number of the resource in the map, and the URL of |
|
the resource itself. The latter is somewhat redundant, but might help |
|
if maps change. |
|
|
=over 4 |
An example is |
|
|
=item * |
msu/korte/parts/part1.sequence___19___msu/korte/tests/part12.problem |
|
|
con_lost : unable to contact remote host |
The respective map entry is |
|
|
=item * |
<resource id="19" src="/res/msu/korte/tests/part12.problem" |
|
title="Problem 2"> |
|
</resource> |
|
|
con_delayed : unable to contact remote host, message will be delivered |
Symbs are used by the random number generator, as well as to store and |
when the connection is brought back up |
restore data specific to a certain instance of for example a problem. |
|
|
=item * |
=head2 Storing And Retrieving Data |
|
|
con_failed : unable to contact remote host and unable to save message |
X<store()>X<cstore()>X<restore()>Three of the most important functions |
for later delivery |
in C<lonnet.pm> are C<&Apache::lonnet::cstore()>, |
|
C<&Apache::lonnet:restore()>, and C<&Apache::lonnet::store()>, which |
|
is is the non-critical message twin of cstore. These functions are for |
|
handlers to store a perl hash to a user's permanent data space in an |
|
easy manner, and to retrieve it again on another call. It is expected |
|
that a handler would use this once at the beginning to retrieve data, |
|
and then again once at the end to send only the new data back. |
|
|
=item * |
The data is stored in the user's data directory on the user's |
|
homeserver under the ID of the course. |
|
|
error: : an error a occured, a description of the error follows the : |
The hash that is returned by restore will have all of the previous |
|
value for all of the elements of the hash. |
|
|
=item * |
Example: |
|
|
|
#creating a hash |
|
my %hash; |
|
$hash{'foo'}='bar'; |
|
|
|
#storing it |
|
&Apache::lonnet::cstore(\%hash); |
|
|
|
#changing a value |
|
$hash{'foo'}='notbar'; |
|
|
|
#adding a new value |
|
$hash{'bar'}='foo'; |
|
&Apache::lonnet::cstore(\%hash); |
|
|
|
#retrieving the hash |
|
my %history=&Apache::lonnet::restore(); |
|
|
|
#print the hash |
|
foreach my $key (sort(keys(%history))) { |
|
print("\%history{$key} = $history{$key}"); |
|
} |
|
|
|
Will print out: |
|
|
|
%history{1:foo} = bar |
|
%history{1:keys} = foo:timestamp |
|
%history{1:timestamp} = 990455579 |
|
%history{2:bar} = foo |
|
%history{2:foo} = notbar |
|
%history{2:keys} = foo:bar:timestamp |
|
%history{2:timestamp} = 990455580 |
|
%history{bar} = foo |
|
%history{foo} = notbar |
|
%history{timestamp} = 990455580 |
|
%history{version} = 2 |
|
|
|
Note that the special hash entries C<keys>, C<version> and |
|
C<timestamp> were added to the hash. C<version> will be equal to the |
|
total number of versions of the data that have been stored. The |
|
C<timestamp> attribute will be the UNIX time the hash was |
|
stored. C<keys> is available in every historical section to list which |
|
keys were added or changed at a specific historical revision of a |
|
hash. |
|
|
|
B<Warning>: do not store the hash that restore returns directly. This |
|
will cause a mess since it will restore the historical keys as if the |
|
were new keys. I.E. 1:foo will become 1:1:foo etc. |
|
|
|
Calling convention: |
|
|
no_such_host : unable to fund a host associated with the user/domain |
my %record=&Apache::lonnet::restore($symb,$courseid,$domain,$uname,$home); |
|
&Apache::lonnet::cstore(\%newrecord,$symb,$courseid,$domain,$uname,$home); |
|
|
|
For more detailed information, see lonnet specific documentation. |
|
|
|
=head1 RETURN MESSAGES |
|
|
|
=over 4 |
|
|
|
=item * B<con_lost>: unable to contact remote host |
|
|
|
=item * B<con_delayed>: unable to contact remote host, message will be delivered |
|
when the connection is brought back up |
|
|
|
=item * B<con_failed>: unable to contact remote host and unable to save message |
|
for later delivery |
|
|
|
=item * B<error:>: an error a occured, a description of the error follows the : |
|
|
|
=item * B<no_such_host>: unable to fund a host associated with the user/domain |
that was requested |
that was requested |
|
|
=back |
=back |
Line 4285 that was requested
|
Line 4375 that was requested
|
|
|
=over 4 |
=over 4 |
|
|
=item * |
=item * |
|
X<appenv()> |
appenv(%hash) : the value of %hash is written to the user envirnoment |
B<appenv(%hash)>: the value of %hash is written to |
file, and will be restored for each access this user makes during this |
the user envirnoment file, and will be restored for each access this |
session, also modifies the %ENV for the current process |
user makes during this session, also modifies the %ENV for the current |
|
process |
|
|
=item * |
=item * |
|
X<delenv()> |
delenv($regexp) : removes all items from the session environment file that matches the regular expression in $regexp. The values are also delted from the current processes %ENV. |
B<delenv($regexp)>: removes all items from the session |
|
environment file that matches the regular expression in $regexp. The |
|
values are also delted from the current processes %ENV. |
|
|
=back |
=back |
|
|
Line 4302 delenv($regexp) : removes all items from
|
Line 4395 delenv($regexp) : removes all items from
|
=over 4 |
=over 4 |
|
|
=item * |
=item * |
|
X<queryauthenticate()> |
queryauthenticate($uname,$udom) : try to determine user's current |
B<queryauthenticate($uname,$udom)>: try to determine user's current |
authentication scheme |
authentication scheme |
|
|
=item * |
=item * |
|
X<authenticate()> |
authenticate($uname,$upass,$udom) : try to authenticate user from domain's lib |
B<authenticate($uname,$upass,$udom)>: try to |
servers (first use the current one), $upass should be the users password |
authenticate user from domain's lib servers (first use the current |
|
one). C<$upass> should be the users password. |
|
|
=item * |
=item * |
|
X<homeserver()> |
homeserver($uname,$udom) : find the server which has the user's |
B<homeserver($uname,$udom)>: find the server which has |
directory and files (there must be only one), this caches the answer, |
the user's directory and files (there must be only one), this caches |
and also caches if there is a borken connection. |
the answer, and also caches if there is a borken connection. |
|
|
=item * |
=item * |
|
X<idget()> |
idget($udom,@ids) : find the usernames behind a list of IDs (IDs are a |
B<idget($udom,@ids)>: find the usernames behind a list of IDs |
unique resource in a domain, there must be only 1 ID per username, and |
(IDs are a unique resource in a domain, there must be only 1 ID per |
only 1 username per ID in a specific domain) (returns hash: |
username, and only 1 username per ID in a specific domain) (returns |
id=>name,id=>name) |
hash: id=>name,id=>name) |
|
|
=item * |
=item * |
|
X<idrget()> |
idrget($udom,@unames) : find the IDs behind a list of usernames (returns hash: |
B<idrget($udom,@unames)>: find the IDs behind a list of |
name=>id,name=>id) |
usernames (returns hash: name=>id,name=>id) |
|
|
=item * |
=item * |
|
X<idput()> |
idput($udom,%ids) : store away a list of names and associated IDs |
B<idput($udom,%ids)>: store away a list of names and associated IDs |
|
|
=item * |
=item * |
|
X<rolesinit()> |
rolesinit($udom,$username,$authhost) : get user privileges |
B<rolesinit($udom,$username,$authhost)>: get user privileges |
|
|
=item * |
=item * |
|
X<usection()> |
usection($udom,$uname,$cname) : finds the section of student in the |
B<usection($udom,$uname,$cname)>: finds the section of student in the |
course $cname, return section name/number or '' for "not in course" |
course $cname, return section name/number or '' for "not in course" |
and '-1' for "no section" |
and '-1' for "no section" |
|
|
=item * |
=item * |
|
X<userenvironment()> |
userenvironment($udom,$uname,@what) : gets the values of the keys |
B<userenvironment($udom,$uname,@what)>: gets the values of the keys |
passed in @what from the requested user's environment, returns a hash |
passed in @what from the requested user's environment, returns a hash |
|
|
=back |
=back |