version 1.197, 2004/06/17 18:48:05
|
version 1.206, 2004/07/22 23:08:43
|
Line 51 use LONCAPA::ConfigFileEdit;
|
Line 51 use LONCAPA::ConfigFileEdit;
|
use LONCAPA::lonlocal; |
use LONCAPA::lonlocal; |
use LONCAPA::lonssl; |
use LONCAPA::lonssl; |
|
|
my $DEBUG = 11; # Non zero to enable debug log entries. |
my $DEBUG = 0; # Non zero to enable debug log entries. |
|
|
my $status=''; |
my $status=''; |
my $lastlog=''; |
my $lastlog=''; |
Line 69 my $clientname; # LonCAPA name of clie
|
Line 69 my $clientname; # LonCAPA name of clie
|
my $server; |
my $server; |
my $thisserver; # DNS of us. |
my $thisserver; # DNS of us. |
|
|
|
my $keymode; |
|
|
# |
# |
# Connection type is: |
# Connection type is: |
# client - All client actions are allowed |
# client - All client actions are allowed |
Line 352 sub ReadManagerTable {
|
Line 354 sub ReadManagerTable {
|
while(my $host = <MANAGERS>) { |
while(my $host = <MANAGERS>) { |
chomp($host); |
chomp($host); |
if ($host =~ "^#") { # Comment line. |
if ($host =~ "^#") { # Comment line. |
logthis('<font color="green"> Skipping line: '. "$host</font>\n"); |
|
next; |
next; |
} |
} |
if (!defined $hostip{$host}) { # This is a non cluster member |
if (!defined $hostip{$host}) { # This is a non cluster member |
Line 1218 sub logstatus {
|
Line 1219 sub logstatus {
|
{ |
{ |
my $fh=IO::File->new(">>$docdir/lon-status/londstatus.txt"); |
my $fh=IO::File->new(">>$docdir/lon-status/londstatus.txt"); |
print $fh $$."\t".$clientname."\t".$currenthostid."\t" |
print $fh $$."\t".$clientname."\t".$currenthostid."\t" |
.$status."\t".$lastlog."\n"; |
.$status."\t".$lastlog."\t $keymode\n"; |
$fh->close(); |
$fh->close(); |
} |
} |
&status("Finished londstatus.txt"); |
&status("Finished londstatus.txt"); |
{ |
{ |
my $fh=IO::File->new(">$docdir/lon-status/londchld/$$.txt"); |
my $fh=IO::File->new(">$docdir/lon-status/londchld/$$.txt"); |
print $fh $status."\n".$lastlog."\n".time; |
print $fh $status."\n".$lastlog."\n".time."\n$keymode"; |
$fh->close(); |
$fh->close(); |
} |
} |
&status("Finished logging"); |
&status("Finished logging"); |
Line 1556 sub make_new_child {
|
Line 1557 sub make_new_child {
|
print $client "ok:local\n"; |
print $client "ok:local\n"; |
&logthis('<font color="green"' |
&logthis('<font color="green"' |
. "Successful local authentication </font>"); |
. "Successful local authentication </font>"); |
|
$keymode = "local" |
} else { |
} else { |
Debug("Failed to get local key"); |
Debug("Failed to get local key"); |
$clientok = 0; |
$clientok = 0; |
Line 1570 sub make_new_child {
|
Line 1572 sub make_new_child {
|
$cipher = new IDEA($cipherkey); |
$cipher = new IDEA($cipherkey); |
&logthis('<font color="green">' |
&logthis('<font color="green">' |
."Successfull ssl authentication with $clientname </font>"); |
."Successfull ssl authentication with $clientname </font>"); |
|
$keymode = "ssl"; |
|
|
} else { |
} else { |
$clientok = 0; |
$clientok = 0; |
Line 1583 sub make_new_child {
|
Line 1586 sub make_new_child {
|
&logthis('<font color="green">' |
&logthis('<font color="green">' |
."Successful insecure authentication with $clientname </font>"); |
."Successful insecure authentication with $clientname </font>"); |
print $client "ok\n"; |
print $client "ok\n"; |
|
$keymode = "insecure"; |
} else { |
} else { |
&logthis('<font color="yellow">' |
&logthis('<font color="yellow">' |
."Attempted insecure connection disallowed </font>"); |
."Attempted insecure connection disallowed </font>"); |
Line 2228 sub make_new_child {
|
Line 2232 sub make_new_child {
|
# ------------------------------------------------------------------------- put |
# ------------------------------------------------------------------------- put |
} elsif ($userinput =~ /^put/) { |
} elsif ($userinput =~ /^put/) { |
if(isClient) { |
if(isClient) { |
my ($cmd,$udom,$uname,$namespace,$what) |
my ($cmd,$udom,$uname,$namespace,$what,@extras) |
=split(/:/,$userinput); |
=split(/:/,$userinput); |
$namespace=~s/\//\_/g; |
$namespace=~s/\//\_/g; |
$namespace=~s/\W//g; |
$namespace=~s/\W//g; |
if ($namespace ne 'roles') { |
if ($namespace ne 'roles') { |
|
if (@extras) { |
|
$what .= ':'.join(':',@extras); |
|
} |
chomp($what); |
chomp($what); |
my $proname=propath($udom,$uname); |
my $proname=propath($udom,$uname); |
my $now=time; |
my $now=time; |
Line 2831 sub make_new_child {
|
Line 2838 sub make_new_child {
|
my %hash; |
my %hash; |
if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_WRCREAT(),0640)) { |
if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_WRCREAT(),0640)) { |
foreach my $pair (@pairs) { |
foreach my $pair (@pairs) { |
my ($key,$value)=split(/=/,$pair); |
my ($key,$descr,$inst_code)=split(/=/,$pair); |
$hash{$key}=$value.':'.$now; |
$hash{$key}=$descr.':'.$inst_code.':'.$now; |
} |
} |
if (untie(%hash)) { |
if (untie(%hash)) { |
print $client "ok\n"; |
print $client "ok\n"; |
Line 2867 sub make_new_child {
|
Line 2874 sub make_new_child {
|
my %hash; |
my %hash; |
if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_READER(),0640)) { |
if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_READER(),0640)) { |
while (my ($key,$value) = each(%hash)) { |
while (my ($key,$value) = each(%hash)) { |
my ($descr,$lasttime)=split(/\:/,$value); |
my ($descr,$lasttime,$inst_code); |
|
if ($value =~ m/^([^\:]*):([^\:]*):(\d+)$/) { |
|
($descr,$inst_code,$lasttime)=($1,$2,$3); |
|
} else { |
|
($descr,$lasttime) = split(/\:/,$value); |
|
} |
if ($lasttime<$since) { next; } |
if ($lasttime<$since) { next; } |
if ($description eq '.') { |
if ($description eq '.') { |
$qresult.=$key.'='.$descr.'&'; |
$qresult.=$key.'='.$descr.':'.$inst_code.'&'; |
} else { |
} else { |
my $unescapeVal = &unescape($descr); |
my $unescapeVal = &unescape($descr); |
if (eval('$unescapeVal=~/\Q$description\E/i')) { |
if (eval('$unescapeVal=~/\Q$description\E/i')) { |
$qresult.="$key=$descr&"; |
$qresult.=$key.'='.$descr.':'.$inst_code.'&'; |
} |
} |
} |
} |
} |
} |
Line 3028 sub make_new_child {
|
Line 3040 sub make_new_child {
|
Reply($client, "refused\n", $userinput); |
Reply($client, "refused\n", $userinput); |
|
|
} |
} |
|
# ----------------------------------------- portfolio directory list (portls) |
|
} elsif ($userinput =~ /^portls/) { |
|
if(isClient) { |
|
my ($cmd,$uname,$udom)=split(/:/,$userinput); |
|
my $udir=propath($udom,$uname).'/userfiles/portfolio'; |
|
my $dirLine=''; |
|
my $dirContents=''; |
|
if (opendir(LSDIR,$udir.'/')){ |
|
while ($dirLine = readdir(LSDIR)){ |
|
$dirContents = $dirContents.$dirLine.'<br />'; |
|
} |
|
} else { |
|
$dirContents = "No directory found\n"; |
|
} |
|
print $client $dirContents."\n"; |
|
} else { |
|
Reply($client, "refused\n", $userinput); |
|
} |
# -------------------------------------------------------------------------- ls |
# -------------------------------------------------------------------------- ls |
} elsif ($userinput =~ /^ls/) { |
} elsif ($userinput =~ /^ls/) { |
if(isClient) { |
if(isClient) { |
Line 3187 sub make_new_child {
|
Line 3217 sub make_new_child {
|
} else { |
} else { |
print $client "refused\n"; |
print $client "refused\n"; |
} |
} |
|
#--------------------- read and retrieve institutional code format (for support form). |
|
} elsif ($userinput =~/^autoinstcodeformat:/) { |
|
if (isClient) { |
|
my $reply; |
|
my($cmd,$cdom,$course) = split(/:/,$userinput); |
|
my @pairs = split/\&/,$course; |
|
my %instcodes = (); |
|
my %codes = (); |
|
my @codetitles = (); |
|
my %cat_titles = (); |
|
my %cat_order = (); |
|
foreach (@pairs) { |
|
my ($key,$value) = split/=/,$_; |
|
$instcodes{&unescape($key)} = &unescape($value); |
|
} |
|
my $formatreply = &localenroll::instcode_format($cdom,\%instcodes,\%codes,\@codetitles,\%cat_titles,\%cat_order); |
|
if ($formatreply eq 'ok') { |
|
my $codes_str = &hash2str(%codes); |
|
my $codetitles_str = &array2str(@codetitles); |
|
my $cat_titles_str = &hash2str(%cat_titles); |
|
my $cat_order_str = &hash2str(%cat_order); |
|
print $client $codes_str.':'.$codetitles_str.':'.$cat_titles_str.':'.$cat_order_str."\n"; |
|
} |
|
} else { |
|
print $client "refused\n"; |
|
} |
# ------------------------------------------------------------- unknown command |
# ------------------------------------------------------------- unknown command |
|
|
} else { |
} else { |
Line 3195 sub make_new_child {
|
Line 3251 sub make_new_child {
|
} |
} |
# -------------------------------------------------------------------- complete |
# -------------------------------------------------------------------- complete |
alarm(0); |
alarm(0); |
&status('Listening to '.$clientname); |
&status('Listening to '.$clientname." ($keymode)"); |
} |
} |
# --------------------------------------------- client unknown or fishy, refuse |
# --------------------------------------------- client unknown or fishy, refuse |
} else { |
} else { |
Line 3594 sub userload {
|
Line 3650 sub userload {
|
return $userloadpercent; |
return $userloadpercent; |
} |
} |
|
|
|
# Routines for serializing arrays and hashes (copies from lonnet) |
|
|
|
sub array2str { |
|
my (@array) = @_; |
|
my $result=&arrayref2str(\@array); |
|
$result=~s/^__ARRAY_REF__//; |
|
$result=~s/__END_ARRAY_REF__$//; |
|
return $result; |
|
} |
|
|
|
sub arrayref2str { |
|
my ($arrayref) = @_; |
|
my $result='__ARRAY_REF__'; |
|
foreach my $elem (@$arrayref) { |
|
if(ref($elem) eq 'ARRAY') { |
|
$result.=&arrayref2str($elem).'&'; |
|
} elsif(ref($elem) eq 'HASH') { |
|
$result.=&hashref2str($elem).'&'; |
|
} elsif(ref($elem)) { |
|
#print("Got a ref of ".(ref($elem))." skipping."); |
|
} else { |
|
$result.=&escape($elem).'&'; |
|
} |
|
} |
|
$result=~s/\&$//; |
|
$result .= '__END_ARRAY_REF__'; |
|
return $result; |
|
} |
|
|
|
sub hash2str { |
|
my (%hash) = @_; |
|
my $result=&hashref2str(\%hash); |
|
$result=~s/^__HASH_REF__//; |
|
$result=~s/__END_HASH_REF__$//; |
|
return $result; |
|
} |
|
|
|
sub hashref2str { |
|
my ($hashref)=@_; |
|
my $result='__HASH_REF__'; |
|
foreach (sort(keys(%$hashref))) { |
|
if (ref($_) eq 'ARRAY') { |
|
$result.=&arrayref2str($_).'='; |
|
} elsif (ref($_) eq 'HASH') { |
|
$result.=&hashref2str($_).'='; |
|
} elsif (ref($_)) { |
|
$result.='='; |
|
#print("Got a ref of ".(ref($_))." skipping."); |
|
} else { |
|
if ($_) {$result.=&escape($_).'=';} else { last; } |
|
} |
|
|
|
if(ref($hashref->{$_}) eq 'ARRAY') { |
|
$result.=&arrayref2str($hashref->{$_}).'&'; |
|
} elsif(ref($hashref->{$_}) eq 'HASH') { |
|
$result.=&hashref2str($hashref->{$_}).'&'; |
|
} elsif(ref($hashref->{$_})) { |
|
$result.='&'; |
|
#print("Got a ref of ".(ref($hashref->{$_}))." skipping."); |
|
} else { |
|
$result.=&escape($hashref->{$_}).'&'; |
|
} |
|
} |
|
$result=~s/\&$//; |
|
$result .= '__END_HASH_REF__'; |
|
return $result; |
|
} |
|
|
# ----------------------------------- POD (plain old documentation, CPAN style) |
# ----------------------------------- POD (plain old documentation, CPAN style) |
|
|