version 1.200, 2004/06/21 13:25:53
|
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 354 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 2233 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 2836 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 2872 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 3033 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 3192 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 3599 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) |
|
|