--- loncom/lonnet/perl/lonnet.pm 2007/05/17 09:31:13 1.879 +++ loncom/lonnet/perl/lonnet.pm 2007/06/18 22:49:57 1.891 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.879 2007/05/17 09:31:13 foxr Exp $ +# $Id: lonnet.pm,v 1.891 2007/06/18 22:49:57 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'); @@ -214,6 +214,24 @@ sub reply { # ----------------------------------------------------------- Send USR1 to lonc sub reconlonc { + my ($lonid) = @_; + my $hostname = &hostname($lonid); + if ($lonid) { + my $peerfile="$perlvar{'lonSockDir'}/$hostname"; + if ($hostname && -e $peerfile) { + &logthis("Trying to reconnect lonc for $lonid ($hostname)"); + my $client=IO::Socket::UNIX->new(Peer => $peerfile, + Type => SOCK_STREAM, + Timeout => 10); + if ($client) { + print $client ("reset_retries\n"); + my $answer=<$client>; + #reset just this one. + } + } + return; + } + &logthis("Trying to reconnect lonc"); my $loncfile="$perlvar{'lonDaemons'}/logs/lonc.pid"; if (open(my $fh,"<$loncfile")) { @@ -770,7 +788,7 @@ sub get_dom { } return %returnhash; } else { - &logthis("get_dom failed - no homeserver and/or domain"); + &logthis("get_dom failed - no homeserver and/or domain ($udom) ($uhome)"); } } @@ -1739,13 +1757,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 +3154,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 +6359,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 +6576,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 +7536,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 +7557,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 +7618,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 +7666,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 +7850,7 @@ sub get_dns { my %hostdom; my %libserv; my $loaded; + my %name_to_host; sub parse_hosts_tab { my ($file) = @_; @@ -7834,6 +7862,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; } } @@ -7872,6 +7901,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); @@ -7990,14 +8025,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 +8039,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],