--- loncom/lonnet/perl/lonnet.pm 2002/03/29 18:23:50 1.204 +++ loncom/lonnet/perl/lonnet.pm 2002/04/10 15:28:45 1.208 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.204 2002/03/29 18:23:50 albertel Exp $ +# $Id: lonnet.pm,v 1.208 2002/04/10 15:28:45 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -84,7 +84,7 @@ qw(%perlvar %hostname %homecache %hostip use IO::Socket; use GDBM_File; use Apache::Constants qw(:common :http); -use HTML::TokeParser; +use HTML::LCParser; use Fcntl qw(:flock); my $readit; @@ -137,6 +137,7 @@ sub subreply { sub reply { my ($cmd,$server)=@_; + unless (defined($hostname{$server})) { return 'no_such_host'; } my $answer=subreply($cmd,$server); if ($answer eq 'con_lost') { sleep 5; @@ -1859,22 +1860,27 @@ sub modifyuserauth { # --------------------------------------------------------------- Modify a user - sub modifyuser { - my ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene, - $forceid)=@_; + my ($udom, $uname, $uid, + $umode, $upass, $first, + $middle, $last, $gene, + $forceid, $desiredhome)=@_; $udom=~s/\W//g; $uname=~s/\W//g; &logthis('Call to modify user '.$udom.', '.$uname.', '.$uid.', '. $umode.', '.$first.', '.$middle.', '. - $last.', '.$gene.'(forceid: '.$forceid.') by '. - $ENV{'user.name'}.' at '.$ENV{'user.domain'}); + $last.', '.$gene.'(forceid: '.$forceid.')'. + (defined($desiredhome) ? ' desiredhome = '.$desiredhome : + ' desiredhome not specified'). + ' by '.$ENV{'user.name'}.' at '.$ENV{'user.domain'}); my $uhome=&homeserver($uname,$udom); # ----------------------------------------------------------------- Create User if (($uhome eq 'no_host') && ($umode) && ($upass)) { my $unhome=''; if ($ENV{'course.'.$ENV{'request.course.id'}.'.domain'} eq $udom) { $unhome=$ENV{'course.'.$ENV{'request.course.id'}.'.home'}; + } elsif (defined($desiredhome) && $hostdom{$desiredhome} eq $udom) { + $unhome = $desiredhome; } else { my $tryserver; my $loadm=10000000; @@ -1889,7 +1895,8 @@ sub modifyuser { } } if (($unhome eq '') || ($unhome eq 'no_host')) { - return 'error: find home'; + return 'error: unable to find a home server for '.$uname. + ' in domain '.$udom; } my $reply=&reply('encrypt:makeuser:'.$udom.':'.$uname.':'.$umode.':'. &escape($upass),$unhome); @@ -1918,6 +1925,7 @@ sub modifyuser { my %names=&get('environment', ['firstname','middlename','lastname','generation'], $udom,$uname); + if ($names{'firstname'} =~ m/^error:.*/) { %names=(); } if ($first) { $names{'firstname'} = $first; } if ($middle) { $names{'middlename'} = $middle; } if ($last) { $names{'lastname'} = $last; } @@ -2381,7 +2389,7 @@ sub metadata { my %metathesekeys=(); unless ($filename=~/\.meta$/) { $filename.='.meta'; } my $metastring=&getfile($perlvar{'lonDocRoot'}.'/res/'.$filename); - my $parser=HTML::TokeParser->new(\$metastring); + my $parser=HTML::LCParser->new(\$metastring); my $token; undef %metathesekeys; while ($token=$parser->get_token) { @@ -2470,7 +2478,7 @@ sub metadata { $metacache{$uri.':'.$unikey.'.'.$_}=$token->[2]->{$_}; } unless ( - $metacache{$uri.':'.$unikey}=$parser->get_text('/'.$entry) + $metacache{$uri.':'.$unikey}=&HTML::Entities::decode($parser->get_text('/'.$entry)) ) { $metacache{$uri.':'.$unikey}= $metacache{$uri.':'.$unikey.'.default'}; }