--- loncom/lonnet/perl/lonnet.pm 2002/02/19 21:53:42 1.202
+++ loncom/lonnet/perl/lonnet.pm 2002/04/04 20:37:05 1.207
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.202 2002/02/19 21:53:42 matthew Exp $
+# $Id: lonnet.pm,v 1.207 2002/04/04 20:37:05 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -137,8 +137,24 @@ 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') { $answer=subreply($cmd,$server); }
+ if ($answer eq 'con_lost') {
+ sleep 5;
+ $answer=subreply($cmd,$server);
+ if ($answer eq 'con_lost') {
+ &logthis("Second attempt con_lost on $server");
+ my $peerfile="$perlvar{'lonSockDir'}/$server";
+ my $client=IO::Socket::UNIX->new(Peer =>"$peerfile",
+ Type => SOCK_STREAM,
+ Timeout => 10)
+ or return "con_lost";
+ &logthis("Killing socket");
+ print $client "close_connection_exit\n";
+ sleep 5;
+ $answer=subreply($cmd,$server);
+ }
+ }
if (($answer=~/^refused/) || ($answer=~/^rejected/)) {
&logthis("<font color=blue>WARNING:".
" $cmd to $server returned $answer</font>");
@@ -700,6 +716,7 @@ sub flushcourselogs {
&logthis('Flushing course log buffers');
foreach (keys %courselogs) {
my $crsid=$_;
+ &logthis(":$crsid:$coursehombuf{$crsid}");
if (&reply('log:'.$coursedombuf{$crsid}.':'.
&escape($courselogs{$crsid}),
$coursehombuf{$crsid}) eq 'ok') {
@@ -897,10 +914,55 @@ sub devalidate {
}
}
+sub arrayref2str {
+ my ($arrayref) = @_;
+ my $result='_ARRAY_REF__';
+ foreach my $elem (@$arrayref) {
+ if (ref($elem) eq 'ARRAY') {
+ $result.=&escape(&arrayref2str($elem)).'&';
+ } elsif (ref($elem) eq 'HASH') {
+ $result.=&escape(&hashref2str($elem)).'&';
+ } elsif (ref($elem)) {
+ &logthis("Got a ref of ".(ref($elem))." skipping.");
+ } else {
+ $result.=&escape($elem).'&';
+ }
+ }
+ $result=~s/\&$//;
+ return $result;
+}
+
sub hash2str {
- my (%hash)=@_;
- my $result='';
- foreach (keys %hash) { $result.=escape($_).'='.escape($hash{$_}).'&'; }
+ my (%hash) = @_;
+ my $result=&hashref2str(\%hash);
+ $result=~s/^_HASH_REF__//;
+ return $result;
+}
+
+sub hashref2str {
+ my ($hashref)=@_;
+ my $result='_HASH_REF__';
+ foreach (keys(%$hashref)) {
+ if (ref($_) eq 'ARRAY') {
+ $result.=&escape(&arrayref2str($_)).'=';
+ } elsif (ref($_) eq 'HASH') {
+ $result.=&escape(&hashref2str($_)).'=';
+ } elsif (ref($_)) {
+ &logthis("Got a ref of ".(ref($_))." skipping.");
+ } else {
+ $result.=&escape($_).'=';
+ }
+
+ if (ref($$hashref{$_}) eq 'ARRAY') {
+ $result.=&escape(&arrayref2str($$hashref{$_})).'&';
+ } elsif (ref($$hashref{$_}) eq 'HASH') {
+ $result.=&escape(&hashref2str($$hashref{$_})).'&';
+ } elsif (ref($$hashref{$_})) {
+ &logthis("Got a ref of ".(ref($$hashref{$_}))." skipping.");
+ } else {
+ $result.=&escape($$hashref{$_}).'&';
+ }
+ }
$result=~s/\&$//;
return $result;
}
@@ -910,9 +972,39 @@ sub str2hash {
my %returnhash;
foreach (split(/\&/,$string)) {
my ($name,$value)=split(/\=/,$_);
- $returnhash{&unescape($name)}=&unescape($value);
+ $name=&unescape($name);
+ $value=&unescape($value);
+ if ($value =~ /^_HASH_REF__/) {
+ $value =~ s/^_HASH_REF__//;
+ my %hash=&str2hash($value);
+ $value=\%hash;
+ } elsif ($value =~ /^_ARRAY_REF__/) {
+ $value =~ s/^_ARRAY_REF__//;
+ my @array=&str2array($value);
+ $value=\@array;
+ }
+ $returnhash{$name}=$value;
}
- return %returnhash;
+ return (%returnhash);
+}
+
+sub str2array {
+ my ($string) = @_;
+ my @returnarray;
+ foreach my $value (split(/\&/,$string)) {
+ $value=&unescape($value);
+ if ($value =~ /^_HASH_REF__/) {
+ $value =~ s/^_HASH_REF__//;
+ my %hash=&str2hash($value);
+ $value=\%hash;
+ } elsif ($value =~ /^_ARRAY_REF__/) {
+ $value =~ s/^_ARRAY_REF__//;
+ my @array=&str2array($value);
+ $value=\@array;
+ }
+ push(@returnarray,$value);
+ }
+ return (@returnarray);
}
# -------------------------------------------------------------------Temp Store
@@ -1768,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;
@@ -1798,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);
@@ -1827,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; }
@@ -2620,6 +2719,7 @@ sub unescape {
# ================================================================ Main Program
sub goodbye {
+ &logthis("Starting Shut down");
&flushcourselogs();
&logthis("Shutting down");
}
@@ -2882,12 +2982,30 @@ devalidate($symb) : devalidate spreadshe
=item *
hash2str(%hash) : convert a hash into a string complete with escaping and '='
-and '&' separators
+and '&' separators, supports elements that are arrayrefs and hashrefs
+
+=item *
+
+hashref2str($hashref) : convert a hashref into a string complete with
+escaping and '=' and '&' separators, supports elements that are
+arrayrefs and hashrefs
+
+=item *
+
+arrayref2str($arrayref) : convert an arrayref into a string complete
+with escaping and '&' separators, supports elements that are arrayrefs
+and hashrefs
+
+=item *
+
+str2hash($string) : convert string to hash using unescaping and
+splitting on '=' and '&', supports elements that are arrayrefs and
+hashrefs
=item *
-str2hash($string) : convert string to hash using unescaping and splitting on
-'=' and '&'
+str2array($string) : convert string to hash using unescaping and
+splitting on '&', supports elements that are arrayrefs and hashrefs
=item *