version 1.871, 2007/04/20 21:48:09
|
version 1.888, 2007/06/13 01:43:54
|
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 1735 sub extract_embedded_items {
|
Line 1739 sub extract_embedded_items {
|
while (my $t=$p->get_token()) { |
while (my $t=$p->get_token()) { |
if ($t->[0] eq 'S') { |
if ($t->[0] eq 'S') { |
my ($tagname, $attr) = ($t->[1],$t->[2]); |
my ($tagname, $attr) = ($t->[1],$t->[2]); |
push (@state, $tagname); |
push(@state, $tagname); |
if (lc($tagname) eq 'allow') { |
if (lc($tagname) eq 'allow') { |
&add_filetype($allfiles,$attr->{'src'},'src'); |
&add_filetype($allfiles,$attr->{'src'},'src'); |
} |
} |
if (lc($tagname) eq 'img') { |
if (lc($tagname) eq 'img') { |
&add_filetype($allfiles,$attr->{'src'},'src'); |
&add_filetype($allfiles,$attr->{'src'},'src'); |
} |
} |
|
if (lc($tagname) eq 'a') { |
|
&add_filetype($allfiles,$attr->{'href'},'href'); |
|
} |
if (lc($tagname) eq 'script') { |
if (lc($tagname) eq 'script') { |
if ($attr->{'archive'} =~ /\.jar$/i) { |
if ($attr->{'archive'} =~ /\.jar$/i) { |
&add_filetype($allfiles,$attr->{'archive'},'archive'); |
&add_filetype($allfiles,$attr->{'archive'},'archive'); |
Line 3129 sub set_userprivs {
|
Line 3136 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 4457 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 4498 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 5915 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 5980 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 6341 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 6558 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 7518 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 7539 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 7542 sub machine_ids {
|
Line 7600 sub machine_ids {
|
my ($hostname) = @_; |
my ($hostname) = @_; |
$hostname ||= &hostname($perlvar{'lonHostID'}); |
$hostname ||= &hostname($perlvar{'lonHostID'}); |
my @ids; |
my @ids; |
my %hostname = &all_hostnames(); |
my %name_to_host = &all_names(); |
while( my($id, $name) = each(%hostname)) { |
return @{ $name_to_host{$hostname} }; |
# &logthis("-$id-$name-$hostname-"); |
|
if ($hostname eq $name) { |
|
push(@ids,$id); |
|
} |
|
} |
|
return @ids; |
|
} |
} |
|
|
sub additional_machine_domains { |
sub additional_machine_domains { |
Line 7593 sub declutter {
|
Line 7645 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|adm|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 7661 sub correct_line_ends {
|
Line 7714 sub correct_line_ends {
|
|
|
sub goodbye { |
sub goodbye { |
&logthis("Starting Shut down"); |
&logthis("Starting Shut down"); |
|
&logthis("test"); |
#not converted to using infrastruture and probably shouldn't be |
#not converted to using infrastruture and probably shouldn't be |
&logthis(sprintf("%-20s is %s",'%badServerCache',length(&nfreeze(\%badServerCache)))); |
&logthis(sprintf("%-20s is %s",'%badServerCache',length(&nfreeze(\%badServerCache)))); |
#converted |
#converted |
Line 7776 sub get_dns {
|
Line 7830 sub get_dns {
|
my %hostdom; |
my %hostdom; |
my %libserv; |
my %libserv; |
my $loaded; |
my $loaded; |
|
my %name_to_host; |
|
|
sub parse_hosts_tab { |
sub parse_hosts_tab { |
my ($file) = @_; |
my ($file) = @_; |
Line 7787 sub get_dns {
|
Line 7842 sub get_dns {
|
$name=~s/\s//g; |
$name=~s/\s//g; |
if ($id && $domain && $role && $name) { |
if ($id && $domain && $role && $name) { |
$hostname{$id}=$name; |
$hostname{$id}=$name; |
|
push(@{$name_to_host{$name}}, $id); |
$hostdom{$id}=$domain; |
$hostdom{$id}=$domain; |
if ($role eq 'library') { $libserv{$id}=$name; } |
if ($role eq 'library') { $libserv{$id}=$name; } |
} |
} |
Line 7825 sub get_dns {
|
Line 7881 sub get_dns {
|
return %hostname; |
return %hostname; |
} |
} |
|
|
|
sub all_names { |
|
&load_hosts_tab() if (!$loaded); |
|
|
|
return %name_to_host; |
|
} |
|
|
sub is_library { |
sub is_library { |
&load_hosts_tab() if (!$loaded); |
&load_hosts_tab() if (!$loaded); |
|
|
Line 7943 sub get_dns {
|
Line 8005 sub get_dns {
|
return %iphost; |
return %iphost; |
} |
} |
} |
} |
my %hostname = &all_hostnames(); |
my %name_to_host = &all_names(); |
foreach my $id (keys(%hostname)) { |
foreach my $name (keys(%name_to_host)) { |
my $name=&hostname($id); |
|
my $ip; |
my $ip; |
if (!exists($name_to_ip{$name})) { |
if (!exists($name_to_ip{$name})) { |
$ip = gethostbyname($name); |
$ip = gethostbyname($name); |
if (!$ip || length($ip) ne 4) { |
if (!$ip || length($ip) ne 4) { |
&logthis("Skipping host $id name $name no IP found"); |
&logthis("Skipping name $name no IP found"); |
next; |
next; |
} |
} |
$ip=inet_ntoa($ip); |
$ip=inet_ntoa($ip); |
Line 7958 sub get_dns {
|
Line 8019 sub get_dns {
|
} else { |
} else { |
$ip = $name_to_ip{$name}; |
$ip = $name_to_ip{$name}; |
} |
} |
$lonid_to_ip{$id} = $ip; |
foreach my $id (@{ $name_to_host{$name} }) { |
push(@{$iphost{$ip}},$id); |
$lonid_to_ip{$id} = $ip; |
|
} |
|
push(@{$iphost{$ip}},@{$name_to_host{$name}}); |
} |
} |
&Apache::lonnet::do_cache_new('iphost','iphost', |
&Apache::lonnet::do_cache_new('iphost','iphost', |
[\%iphost,\%name_to_ip,\%lonid_to_ip], |
[\%iphost,\%name_to_ip,\%lonid_to_ip], |
Line 8504 setting for a specific $type, where $typ
|
Line 8567 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 9257 symblist($mapname,%newhash) : update sym
|
=back |
=back |
|
|
=cut |
=cut |
|
|