version 1.871, 2007/04/20 21:48:09
|
version 1.885, 2007/06/07 22:09:59
|
Line 744 sub get_dom {
|
Line 744 sub get_dom {
|
if (defined(&domain($udom,'primary'))) { |
if (defined(&domain($udom,'primary'))) { |
$uhome=&domain($udom,'primary'); |
$uhome=&domain($udom,'primary'); |
} else { |
} else { |
$uhome eq ''; |
undef($uhome); |
} |
} |
} else { |
} else { |
if (!$uhome) { |
if (!$uhome) { |
Line 756 sub get_dom {
|
Line 756 sub get_dom {
|
if ($udom && $uhome && ($uhome ne 'no_host')) { |
if ($udom && $uhome && ($uhome ne 'no_host')) { |
my $rep=&reply("getdom:$udom:$namespace:$items",$uhome); |
my $rep=&reply("getdom:$udom:$namespace:$items",$uhome); |
my %returnhash; |
my %returnhash; |
if ($rep =~ /^error: 2 /) { |
if ($rep eq '' || $rep =~ /^error: 2 /) { |
return %returnhash; |
return %returnhash; |
} |
} |
my @pairs=split(/\&/,$rep); |
my @pairs=split(/\&/,$rep); |
if ( $#pairs==0 && $pairs[0] =~ /^(con_lost|error|no_such_host)/i) { |
if ( $#pairs==0 && $pairs[0] =~ /^(con_lost|error|no_such_host)/i) { |
return @pairs; |
return @pairs; |
} |
} |
my %returnhash=(); |
|
my $i=0; |
my $i=0; |
foreach my $item (@$storearr) { |
foreach my $item (@$storearr) { |
$returnhash{$item}=&thaw_unescape($pairs[$i]); |
$returnhash{$item}=&thaw_unescape($pairs[$i]); |
Line 771 sub get_dom {
|
Line 770 sub get_dom {
|
} |
} |
return %returnhash; |
return %returnhash; |
} else { |
} else { |
&logthis("get_dom failed - no homeserver and/or domain"); |
&logthis("get_dom failed - no homeserver and/or domain ($udom) ($uhome)"); |
} |
} |
} |
} |
|
|
Line 784 sub put_dom {
|
Line 783 sub put_dom {
|
if (defined(&domain($udom,'primary'))) { |
if (defined(&domain($udom,'primary'))) { |
$uhome=&domain($udom,'primary'); |
$uhome=&domain($udom,'primary'); |
} else { |
} else { |
$uhome eq ''; |
undef($uhome); |
} |
} |
} else { |
} else { |
if (!$uhome) { |
if (!$uhome) { |
Line 1065 my $kicks=0;
|
Line 1064 my $kicks=0;
|
my $hits=0; |
my $hits=0; |
sub make_key { |
sub make_key { |
my ($name,$id) = @_; |
my ($name,$id) = @_; |
if (length($id) > 200) { $id=length($id).':'.&Digest::MD5::md5_hex($id); } |
if (length($id) > 65 |
|
&& length(&escape($id)) > 200) { |
|
$id=length($id).':'.&Digest::MD5::md5_hex($id); |
|
} |
return &escape($name.':'.$id); |
return &escape($name.':'.$id); |
} |
} |
|
|
Line 1112 sub do_cache_new {
|
Line 1114 sub do_cache_new {
|
$time=600; |
$time=600; |
} |
} |
if ($debug) { &Apache::lonnet::logthis("Setting $id to $value"); } |
if ($debug) { &Apache::lonnet::logthis("Setting $id to $value"); } |
$memcache->set($id,$setvalue,$time); |
if (!($memcache->set($id,$setvalue,$time))) { |
|
&logthis("caching of id -> $id failed"); |
|
} |
# 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; |
Line 3129 sub set_userprivs {
|
Line 3133 sub set_userprivs {
|
if (keys(%{$allgroups}) > 0) { |
if (keys(%{$allgroups}) > 0) { |
foreach my $role (keys %{$allroles}) { |
foreach my $role (keys %{$allroles}) { |
my ($trole,$area,$sec,$extendedarea); |
my ($trole,$area,$sec,$extendedarea); |
if ($role =~ m-^(\w+|cr/$match_domain/$match_username/\w+)\.(/$match_domain/$match_courseid)(/?\w*)-) { |
if ($role =~ m-^(\w+|cr/$match_domain/$match_username/\w+)\.(/$match_domain/$match_courseid)(/?\w*)\.-) { |
$trole = $1; |
$trole = $1; |
$area = $2; |
$area = $2; |
$sec = $3; |
$sec = $3; |
Line 4450 sub userlog_query {
|
Line 4454 sub userlog_query {
|
|
|
sub auto_run { |
sub auto_run { |
my ($cnum,$cdom) = @_; |
my ($cnum,$cdom) = @_; |
my $homeserver = &homeserver($cnum,$cdom); |
my $response = 0; |
my $response = &reply('autorun:'.$cdom,$homeserver); |
my $settings; |
|
my %domconfig = &get_dom('configuration',['autoenroll'],$cdom); |
|
if (ref($domconfig{'autoenroll'}) eq 'HASH') { |
|
$settings = $domconfig{'autoenroll'}; |
|
if ($settings->{'run'} eq '1') { |
|
$response = 1; |
|
} |
|
} else { |
|
my $homeserver = &homeserver($cnum,$cdom); |
|
$response = &reply('autorun:'.$cdom,$homeserver); |
|
} |
return $response; |
return $response; |
} |
} |
|
|
Line 4481 sub auto_validate_courseID {
|
Line 4495 sub auto_validate_courseID {
|
} |
} |
|
|
sub auto_create_password { |
sub auto_create_password { |
my ($cnum,$cdom,$authparam) = @_; |
my ($cnum,$cdom,$authparam,$udom) = @_; |
my $homeserver = &homeserver($cnum,$cdom); |
my ($homeserver,$response); |
my $create_passwd = 0; |
my $create_passwd = 0; |
my $authchk = ''; |
my $authchk = ''; |
my $response=&unescape(&reply('autocreatepassword:'.$authparam.':'.$cdom,$homeserver)); |
if ($udom =~ /^$match_domain$/) { |
if ($response eq 'refused') { |
$homeserver = &domain($udom,'primary'); |
$authchk = 'refused'; |
} |
|
if ($homeserver eq '') { |
|
if (($cdom =~ /^$match_domain$/) && ($cnum =~ /^$match_courseid$/)) { |
|
$homeserver = &homeserver($cnum,$cdom); |
|
} |
|
} |
|
if ($homeserver eq '') { |
|
$authchk = 'nodomain'; |
} else { |
} else { |
($authparam,$create_passwd,$authchk) = split/:/,$response; |
$response=&unescape(&reply('autocreatepassword:'.$authparam.':'.$cdom,$homeserver)); |
|
if ($response eq 'refused') { |
|
$authchk = 'refused'; |
|
} else { |
|
($authparam,$create_passwd,$authchk) = split/:/,$response; |
|
} |
} |
} |
return ($authparam,$create_passwd,$authchk); |
return ($authparam,$create_passwd,$authchk); |
} |
} |
Line 5886 sub devalidatecourseresdata {
|
Line 5912 sub devalidatecourseresdata {
|
|
|
|
|
# --------------------------------------------------- Course Resourcedata Query |
# --------------------------------------------------- Course Resourcedata Query |
|
# |
|
# Parameters: |
|
# $coursenum - Number of the course. |
|
# $coursedomain - Domain at which the course was created. |
|
# Returns: |
|
# A hash of the course parameters along (I think) with timestamps |
|
# and version info. |
|
|
sub get_courseresdata { |
sub get_courseresdata { |
my ($coursenum,$coursedomain)=@_; |
my ($coursenum,$coursedomain)=@_; |
Line 5944 sub get_userresdata {
|
Line 5977 sub get_userresdata {
|
} |
} |
return $tmp; |
return $tmp; |
} |
} |
|
#----------------------------------------------- resdata - return resource data |
|
# Purpose: |
|
# Return resource data for either users or for a course. |
|
# Parameters: |
|
# $name - Course/user name. |
|
# $domain - Name of the domain the user/course is registered on. |
|
# $type - Type of thing $name is (must be 'course' or 'user' |
|
# @which - Array of names of resources desired. |
|
# Returns: |
|
# The value of the first reasource in @which that is found in the |
|
# resource hash. |
|
# Exceptional Conditions: |
|
# If the $type passed in is not valid (not the string 'course' or |
|
# 'user', an undefined reference is returned. |
|
# If none of the resources are found, an undef is returned |
sub resdata { |
sub resdata { |
my ($name,$domain,$type,@which)=@_; |
my ($name,$domain,$type,@which)=@_; |
my $result; |
my $result; |
Line 6291 sub packages_tab_default {
|
Line 6338 sub packages_tab_default {
|
$do_default=1; |
$do_default=1; |
} elsif ($pack_type eq 'extension') { |
} elsif ($pack_type eq 'extension') { |
push(@extension,[$package,$pack_type,$pack_part]); |
push(@extension,[$package,$pack_type,$pack_part]); |
} elsif ($pack_part eq $part) { |
} elsif ($pack_part eq $part || $pack_type eq 'part') { |
# only look at packages defaults for packages that this id is |
# only look at packages defaults for packages that this id is |
push(@specifics,[$package,$pack_type,$pack_part]); |
push(@specifics,[$package,$pack_type,$pack_part]); |
} |
} |
Line 6508 sub metadata {
|
Line 6555 sub metadata {
|
} |
} |
} |
} |
my ($extension) = ($uri =~ /\.(\w+)$/); |
my ($extension) = ($uri =~ /\.(\w+)$/); |
|
$extension = lc($extension); |
|
if ($extension eq 'htm') { $extension='html'; } |
|
|
foreach my $key (keys(%packagetab)) { |
foreach my $key (keys(%packagetab)) { |
#no specific packages #how's our extension |
#no specific packages #how's our extension |
if ($key!~/^extension_\Q$extension\E&/) { next; } |
if ($key!~/^extension_\Q$extension\E&/) { next; } |
&metadata_create_package_def($uri,$key,'extension_'.$extension, |
&metadata_create_package_def($uri,$key,'extension_'.$extension, |
\%metathesekeys); |
\%metathesekeys); |
} |
} |
if (!exists($metaentry{':packages'})) { |
|
|
if (!exists($metaentry{':packages'}) |
|
|| $packagetab{"import_defaults&extension_$extension"}) { |
foreach my $key (keys(%packagetab)) { |
foreach my $key (keys(%packagetab)) { |
#no specific packages well let's get default then |
#no specific packages well let's get default then |
if ($key!~/^default&/) { next; } |
if ($key!~/^default&/) { next; } |
Line 7463 sub filelocation {
|
Line 7515 sub filelocation {
|
$file=~s-^/adm/wrapper/-/-; |
$file=~s-^/adm/wrapper/-/-; |
$file=~s-^/adm/coursedocs/showdoc/-/-; |
$file=~s-^/adm/coursedocs/showdoc/-/-; |
} |
} |
|
|
if ($file=~m:^/~:) { # is a contruction space reference |
if ($file=~m:^/~:) { # is a contruction space reference |
$location = $file; |
$location = $file; |
$location =~ s:/~(.*?)/(.*):/home/$1/public_html/$2:; |
$location =~ s:/~(.*?)/(.*):/home/$1/public_html/$2:; |
Line 7483 sub filelocation {
|
Line 7536 sub filelocation {
|
$location=$Apache::lonnet::perlvar{'lonDocRoot'}.'/userfiles/'. |
$location=$Apache::lonnet::perlvar{'lonDocRoot'}.'/userfiles/'. |
$udom.'/'.$uname.'/'.$filename; |
$udom.'/'.$uname.'/'.$filename; |
} |
} |
|
} elsif ($file =~ m-^/adm/-) { |
|
$location = $perlvar{'lonDocRoot'}.'/'.$file; |
} else { |
} else { |
$file=~s/^\Q$perlvar{'lonDocRoot'}\E//; |
$file=~s/^\Q$perlvar{'lonDocRoot'}\E//; |
$file=~s:^/res/:/:; |
$file=~s:^/res/:/:; |
Line 7593 sub declutter {
|
Line 7648 sub declutter {
|
|
|
sub clutter { |
sub clutter { |
my $thisfn='/'.&declutter(shift); |
my $thisfn='/'.&declutter(shift); |
unless ($thisfn=~/^\/(uploaded|editupload|adm|userfiles|ext|raw|priv|public)\//) { |
if ($thisfn !~ m{^/(uploaded|editupload|userfiles|ext|raw|priv|public)/} |
|
|| $thisfn =~ m{^/adm/(includes|pages)} ) { |
$thisfn='/res'.$thisfn; |
$thisfn='/res'.$thisfn; |
} |
} |
if ($thisfn !~m|/adm|) { |
if ($thisfn !~m|/adm|) { |
Line 8504 setting for a specific $type, where $typ
|
Line 8560 setting for a specific $type, where $typ
|
@what should be a list of parameters to ask about. This routine caches |
@what should be a list of parameters to ask about. This routine caches |
answers for 5 minutes. |
answers for 5 minutes. |
|
|
|
=item * |
|
|
|
get_courseresdata($courseid, $domain) : dump the entire course resource |
|
data base, returning a hash that is keyed by the resource name and has |
|
values that are the resource value. I believe that the timestamps and |
|
versions are also returned. |
|
|
|
|
=back |
=back |
|
|
=head2 Course Modification |
=head2 Course Modification |
Line 9186 symblist($mapname,%newhash) : update sym
|
Line 9250 symblist($mapname,%newhash) : update sym
|
=back |
=back |
|
|
=cut |
=cut |
|
|