--- loncom/lonnet/perl/lonnet.pm 2003/02/11 16:42:27 1.325 +++ loncom/lonnet/perl/lonnet.pm 2003/02/13 21:35:50 1.327 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.325 2003/02/11 16:42:27 www Exp $ +# $Id: lonnet.pm,v 1.327 2003/02/13 21:35:50 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -76,7 +76,7 @@ qw(%perlvar %hostname %homecache %badSer %libserv %pr %prp %metacache %packagetab %titlecache %courselogs %accesshash $processmarker $dumpcount %coursedombuf %coursehombuf %courseresdatacache - %domaindescription); + %domaindescription %domain_auth_def %domain_auth_arg_def); use IO::Socket; use GDBM_File; use Apache::Constants qw(:common :http); @@ -1755,11 +1755,12 @@ sub dump { # --------------------------------------------------------------- currentdump sub currentdump { - my ($namespace,$udomain,$uname)=@_; - if (!$udomain) { $udomain = $ENV{'user.domain'}; } - if (!$uname) { $uname = $ENV{'user.name'}; } - my $uhome = &homeserver($uname,$udomain); - my $rep=reply("currentdump:$udomain:$uname:$namespace",$uhome); + my ($sname,$sdom,$courseid)=@_; + $courseid = $ENV{'request.course.id'} if (! defined($courseid)); + $sdom = $ENV{'user.domain'} if (! defined($sdom)); + $sname = $ENV{'user.name'} if (! defined($sname)); + my $uhome = &homeserver($sname,$sdom); + my $rep=reply('currentdump:'.$sdom.':'.$sname.':'.$courseid,$uhome); return if ($rep =~ /^(error:|no_such_host)/); # my %returnhash=(); @@ -1767,7 +1768,7 @@ sub currentdump { if ($rep eq "unknown_cmd") { # an old lond will not know currentdump # Do a dump and make it look like a currentdump - my @tmp = &dump($namespace,$udomain,$uname,'.'); + my @tmp = &dump($courseid,$sdom,$sname,'.'); return if ($tmp[0] =~ /^(error:|no_such_host)/); my %hash = @tmp; @tmp=(); @@ -3572,6 +3573,29 @@ BEGIN { } } +# ------------------------------------------------------------ Read domain file +{ + my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}. + '/domain.tab'); + %domaindescription = (); + %domain_auth_def = (); + %domain_auth_arg_def = (); + if ($fh) { + while (<$fh>) { + next if /^\#/; + chomp; + my ($domain, $domain_description, $def_auth, $def_auth_arg) + = split(/:/,$_,4); + $domain_auth_def{$domain}=$def_auth; + $domain_auth_arg_def{$domain}=$def_auth_arg; + $domaindescription{$domain}=$domain_description; +# &logthis("Domain.tab: $domain, $domain_auth_def{$domain}, $domain_auth_arg_def{$domain},$domaindescription{$domain}"); +# &logthis("Domain.tab: $domain ".$domaindescription{$domain} ); + } + } +} + + # ------------------------------------------------------------- Read hosts file { my $config=Apache::File->new("$perlvar{'lonTabDir'}/hosts.tab"); @@ -3585,7 +3609,6 @@ BEGIN { $hostdom{$id}=$domain; $hostip{$id}=$ip; $iphost{$ip}=$id; - if ($domdescr) { $domaindescription{$domain}=$domdescr; } if ($role eq 'library') { $libserv{$id}=$name; } } else { if ($configline) {