--- loncom/lonnet/perl/lonnet.pm 2007/05/22 21:56:32 1.880
+++ loncom/lonnet/perl/lonnet.pm 2007/06/25 23:30:27 1.890.2.1
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.880 2007/05/22 21:56:32 banghart Exp $
+# $Id: lonnet.pm,v 1.890.2.1 2007/06/25 23:30:27 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -149,7 +149,7 @@ sub create_connection {
Type => SOCK_STREAM,
Timeout => 10);
return 0 if (!$client);
- print $client (join(':',$hostname,$lonid,&machine_ids($lonid))."\n");
+ print $client (join(':',$hostname,$lonid,&machine_ids($hostname))."\n");
my $result = <$client>;
chomp($result);
return 1 if ($result eq 'done');
@@ -1739,13 +1739,16 @@ sub extract_embedded_items {
while (my $t=$p->get_token()) {
if ($t->[0] eq 'S') {
my ($tagname, $attr) = ($t->[1],$t->[2]);
- push (@state, $tagname);
+ push(@state, $tagname);
if (lc($tagname) eq 'allow') {
&add_filetype($allfiles,$attr->{'src'},'src');
}
if (lc($tagname) eq 'img') {
&add_filetype($allfiles,$attr->{'src'},'src');
}
+ if (lc($tagname) eq 'a') {
+ &add_filetype($allfiles,$attr->{'href'},'href');
+ }
if (lc($tagname) eq 'script') {
if ($attr->{'archive'} =~ /\.jar$/i) {
&add_filetype($allfiles,$attr->{'archive'},'archive');
@@ -3133,7 +3136,7 @@ sub set_userprivs {
if (keys(%{$allgroups}) > 0) {
foreach my $role (keys %{$allroles}) {
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;
$area = $2;
$sec = $3;
@@ -6338,7 +6341,7 @@ sub packages_tab_default {
$do_default=1;
} elsif ($pack_type eq 'extension') {
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
push(@specifics,[$package,$pack_type,$pack_part]);
}
@@ -6555,13 +6558,18 @@ sub metadata {
}
}
my ($extension) = ($uri =~ /\.(\w+)$/);
+ $extension = lc($extension);
+ if ($extension eq 'htm') { $extension='html'; }
+
foreach my $key (keys(%packagetab)) {
#no specific packages #how's our extension
if ($key!~/^extension_\Q$extension\E&/) { next; }
&metadata_create_package_def($uri,$key,'extension_'.$extension,
\%metathesekeys);
}
- if (!exists($metaentry{':packages'})) {
+
+ if (!exists($metaentry{':packages'})
+ || $packagetab{"import_defaults&extension_$extension"}) {
foreach my $key (keys(%packagetab)) {
#no specific packages well let's get default then
if ($key!~/^default&/) { next; }
@@ -7510,6 +7518,7 @@ sub filelocation {
$file=~s-^/adm/wrapper/-/-;
$file=~s-^/adm/coursedocs/showdoc/-/-;
}
+
if ($file=~m:^/~:) { # is a contruction space reference
$location = $file;
$location =~ s:/~(.*?)/(.*):/home/$1/public_html/$2:;
@@ -7530,6 +7539,8 @@ sub filelocation {
$location=$Apache::lonnet::perlvar{'lonDocRoot'}.'/userfiles/'.
$udom.'/'.$uname.'/'.$filename;
}
+ } elsif ($file =~ m-^/adm/-) {
+ $location = $perlvar{'lonDocRoot'}.'/'.$file;
} else {
$file=~s/^\Q$perlvar{'lonDocRoot'}\E//;
$file=~s:^/res/:/:;
@@ -7589,14 +7600,11 @@ sub machine_ids {
my ($hostname) = @_;
$hostname ||= &hostname($perlvar{'lonHostID'});
my @ids;
- my %hostname = &all_hostnames();
- while( my($id, $name) = each(%hostname)) {
-# &logthis("-$id-$name-$hostname-");
- if ($hostname eq $name) {
- push(@ids,$id);
- }
+ my %name_to_host = &all_names();
+ if (ref($name_to_host{$hostname}) eq 'ARRAY') {
+ return @{ $name_to_host{$hostname} };
}
- return @ids;
+ return;
}
sub additional_machine_domains {
@@ -7640,7 +7648,8 @@ sub declutter {
sub clutter {
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;
}
if ($thisfn !~m|/adm|) {
@@ -7823,6 +7832,7 @@ sub get_dns {
my %hostdom;
my %libserv;
my $loaded;
+ my %name_to_host;
sub parse_hosts_tab {
my ($file) = @_;
@@ -7834,6 +7844,7 @@ sub get_dns {
$name=~s/\s//g;
if ($id && $domain && $role && $name) {
$hostname{$id}=$name;
+ push(@{$name_to_host{$name}}, $id);
$hostdom{$id}=$domain;
if ($role eq 'library') { $libserv{$id}=$name; }
}
@@ -7843,6 +7854,7 @@ sub get_dns {
sub reset_hosts_info {
&reset_domain_info();
&reset_hosts_ip_info();
+ undef(%name_to_host);
undef(%hostname);
undef(%hostdom);
undef(%libserv);
@@ -7872,6 +7884,12 @@ sub get_dns {
return %hostname;
}
+ sub all_names {
+ &load_hosts_tab() if (!$loaded);
+
+ return %name_to_host;
+ }
+
sub is_library {
&load_hosts_tab() if (!$loaded);
@@ -7928,24 +7946,6 @@ sub get_dns {
my %name_to_ip;
my %lonid_to_ip;
- my %valid_ip;
- sub valid_ip {
- my ($ip) = @_;
- if (exists($iphost{$ip}) || exists($valid_ip{$ip})) {
- return 1;
- }
- my $name = gethostbyip($ip);
- my $lonid = &hostname($name);
- if (defined($lonid)) {
- $valid_ip{$ip} = $lonid;
- return 1;
- }
- my %iphosts = &get_iphost();
- if (ref($iphost{$ip})) {
- return 1;
- }
- }
-
sub get_hosts_from_ip {
my ($ip) = @_;
my %iphosts = &get_iphost();
@@ -7990,14 +7990,13 @@ sub get_dns {
return %iphost;
}
}
- my %hostname = &all_hostnames();
- foreach my $id (keys(%hostname)) {
- my $name=&hostname($id);
+ my %name_to_host = &all_names();
+ foreach my $name (keys(%name_to_host)) {
my $ip;
if (!exists($name_to_ip{$name})) {
$ip = gethostbyname($name);
if (!$ip || length($ip) ne 4) {
- &logthis("Skipping host $id name $name no IP found");
+ &logthis("Skipping name $name no IP found");
next;
}
$ip=inet_ntoa($ip);
@@ -8005,8 +8004,10 @@ sub get_dns {
} else {
$ip = $name_to_ip{$name};
}
- $lonid_to_ip{$id} = $ip;
- push(@{$iphost{$ip}},$id);
+ foreach my $id (@{ $name_to_host{$name} }) {
+ $lonid_to_ip{$id} = $ip;
+ }
+ push(@{$iphost{$ip}},@{$name_to_host{$name}});
}
&Apache::lonnet::do_cache_new('iphost','iphost',
[\%iphost,\%name_to_ip,\%lonid_to_ip],