version 1.183, 2004/03/09 21:05:13
|
version 1.191, 2004/05/20 18:17:12
|
Line 749 sub catchexception {
|
Line 749 sub catchexception {
|
$SIG{'QUIT'}='DEFAULT'; |
$SIG{'QUIT'}='DEFAULT'; |
$SIG{__DIE__}='DEFAULT'; |
$SIG{__DIE__}='DEFAULT'; |
&status("Catching exception"); |
&status("Catching exception"); |
&logthis("<font color=red>CRITICAL: " |
&logthis("<font color='red'>CRITICAL: " |
."ABNORMAL EXIT. Child $$ for server $thisserver died through " |
."ABNORMAL EXIT. Child $$ for server $thisserver died through " |
."a crash with this error msg->[$error]</font>"); |
."a crash with this error msg->[$error]</font>"); |
&logthis('Famous last words: '.$status.' - '.$lastlog); |
&logthis('Famous last words: '.$status.' - '.$lastlog); |
Line 760 sub catchexception {
|
Line 760 sub catchexception {
|
|
|
sub timeout { |
sub timeout { |
&status("Handling Timeout"); |
&status("Handling Timeout"); |
&logthis("<font color=ref>CRITICAL: TIME OUT ".$$."</font>"); |
&logthis("<font color='red'>CRITICAL: TIME OUT ".$$."</font>"); |
&catchexception('Timeout'); |
&catchexception('Timeout'); |
} |
} |
# -------------------------------- Set signal handlers to record abnormal exits |
# -------------------------------- Set signal handlers to record abnormal exits |
Line 843 sub HUNTSMAN { # si
|
Line 843 sub HUNTSMAN { # si
|
&logthis("Free socket: ".shutdown($server,2)); # free up socket |
&logthis("Free socket: ".shutdown($server,2)); # free up socket |
my $execdir=$perlvar{'lonDaemons'}; |
my $execdir=$perlvar{'lonDaemons'}; |
unlink("$execdir/logs/lond.pid"); |
unlink("$execdir/logs/lond.pid"); |
&logthis("<font color=red>CRITICAL: Shutting down</font>"); |
&logthis("<font color='red'>CRITICAL: Shutting down</font>"); |
&status("Done killing children"); |
&status("Done killing children"); |
exit; # clean up with dignity |
exit; # clean up with dignity |
} |
} |
Line 853 sub HUPSMAN { # sig
|
Line 853 sub HUPSMAN { # sig
|
&status("Killing children for restart (HUP)"); |
&status("Killing children for restart (HUP)"); |
kill 'INT' => keys %children; |
kill 'INT' => keys %children; |
&logthis("Free socket: ".shutdown($server,2)); # free up socket |
&logthis("Free socket: ".shutdown($server,2)); # free up socket |
&logthis("<font color=red>CRITICAL: Restarting</font>"); |
&logthis("<font color='red'>CRITICAL: Restarting</font>"); |
my $execdir=$perlvar{'lonDaemons'}; |
my $execdir=$perlvar{'lonDaemons'}; |
unlink("$execdir/logs/lond.pid"); |
unlink("$execdir/logs/lond.pid"); |
&status("Restarting self (HUP)"); |
&status("Restarting self (HUP)"); |
Line 1095 sub reconlonc {
|
Line 1095 sub reconlonc {
|
kill USR1 => $loncpid; |
kill USR1 => $loncpid; |
} else { |
} else { |
&logthis( |
&logthis( |
"<font color=red>CRITICAL: " |
"<font color='red'>CRITICAL: " |
."lonc at pid $loncpid not responding, giving up</font>"); |
."lonc at pid $loncpid not responding, giving up</font>"); |
} |
} |
} else { |
} else { |
&logthis('<font color=red>CRITICAL: lonc not running, giving up</font>'); |
&logthis('<font color="red">CRITICAL: lonc not running, giving up</font>'); |
} |
} |
} |
} |
|
|
Line 1203 my $execdir=$perlvar{'lonDaemons'};
|
Line 1203 my $execdir=$perlvar{'lonDaemons'};
|
open (PIDSAVE,">$execdir/logs/lond.pid"); |
open (PIDSAVE,">$execdir/logs/lond.pid"); |
print PIDSAVE "$$\n"; |
print PIDSAVE "$$\n"; |
close(PIDSAVE); |
close(PIDSAVE); |
&logthis("<font color=red>CRITICAL: ---------- Starting ----------</font>"); |
&logthis("<font color='red'>CRITICAL: ---------- Starting ----------</font>"); |
&status('Starting'); |
&status('Starting'); |
|
|
|
|
Line 1340 sub make_new_child {
|
Line 1340 sub make_new_child {
|
print $client "ok\n"; |
print $client "ok\n"; |
} else { |
} else { |
&logthis( |
&logthis( |
"<font color=blue>WARNING: $clientip did not reply challenge</font>"); |
"<font color='blue'>WARNING: $clientip did not reply challenge</font>"); |
&status('No challenge reply '.$clientip); |
&status('No challenge reply '.$clientip); |
} |
} |
} else { |
} else { |
&logthis( |
&logthis( |
"<font color=blue>WARNING: " |
"<font color='blue'>WARNING: " |
."$clientip failed to initialize: >$remotereq< </font>"); |
."$clientip failed to initialize: >$remotereq< </font>"); |
&status('No init '.$clientip); |
&status('No init '.$clientip); |
} |
} |
} else { |
} else { |
&logthis( |
&logthis( |
"<font color=blue>WARNING: Unknown client $clientip</font>"); |
"<font color='blue'>WARNING: Unknown client $clientip</font>"); |
&status('Hung up on '.$clientip); |
&status('Hung up on '.$clientip); |
} |
} |
if ($clientok) { |
if ($clientok) { |
Line 1365 sub make_new_child {
|
Line 1365 sub make_new_child {
|
} |
} |
&reconlonc("$perlvar{'lonSockDir'}/$id"); |
&reconlonc("$perlvar{'lonSockDir'}/$id"); |
} |
} |
&logthis("<font color=green>Established connection: $clientname</font>"); |
&logthis("<font color='green'>Established connection: $clientname</font>"); |
&status('Will listen to '.$clientname); |
&status('Will listen to '.$clientname); |
# ------------------------------------------------------------ Process requests |
# ------------------------------------------------------------ Process requests |
while (my $userinput=<$client>) { |
while (my $userinput=<$client>) { |
Line 1562 sub make_new_child {
|
Line 1562 sub make_new_child {
|
$pwdcorrect=0; |
$pwdcorrect=0; |
# log error if it is not a bad password |
# log error if it is not a bad password |
if ($krb4_error != 62) { |
if ($krb4_error != 62) { |
&logthis('krb4:'.$uname.','.$contentpwd.','. |
&logthis('krb4:'.$uname.','. |
&Authen::Krb4::get_err_txt($Authen::Krb4::error)); |
&Authen::Krb4::get_err_txt($Authen::Krb4::error)); |
} |
} |
} |
} |
Line 1827 sub make_new_child {
|
Line 1827 sub make_new_child {
|
# -------------------------------------- fetch a user file from a remote server |
# -------------------------------------- fetch a user file from a remote server |
} elsif ($userinput =~ /^fetchuserfile/) { # Client clear or enc. |
} elsif ($userinput =~ /^fetchuserfile/) { # Client clear or enc. |
if(isClient) { |
if(isClient) { |
my ($cmd,$fname,$fpath)=split(/:/,$userinput); |
my ($cmd,$fname)=split(/:/,$userinput); |
my ($udom,$uname,$ufile)=split(/\//,$fname); |
my ($udom,$uname,$ufile) = ($fname =~ m|^([^/]+)/([^/]+)/(.+)$|); |
my $udir=propath($udom,$uname).'/userfiles'; |
my $udir=propath($udom,$uname).'/userfiles'; |
unless (-e $udir) { mkdir($udir,0770); } |
unless (-e $udir) { mkdir($udir,0770); } |
if (-e $udir) { |
if (-e $udir) { |
unless ($fpath eq '') { |
$ufile=~s/^[\.\~]+//; |
my $filepath = $udir; |
my $path = $udir; |
my @parts=split(/\//,$fpath); |
if ($ufile =~m|(.+)/([^/]+)$|) { |
my $count; |
my @parts=split('/',$1); |
for ($count=0;$count<=$#parts;$count++) { |
foreach my $part (@parts) { |
$filepath .="/$parts[$count]"; |
$path .= '/'.$part; |
if ((-e $filepath)!=1) { |
if ((-e $path)!=1) { |
mkdir($filepath,0770); |
mkdir($path,0770); |
} |
} |
} |
} |
} |
} |
$ufile=~s/^[\.\~]+//; |
my $destname=$udir.'/'.$ufile; |
$ufile=~s/\///g; |
my $transname=$udir.'/'.$ufile.'.in.transit'; |
my $destname=$udir.'/'.$fpath.$ufile; |
my $remoteurl='http://'.$clientip.'/userfiles/'.$fname; |
my $transname=$udir.'/'.$fpath.$ufile.'.in.transit'; |
|
my $remoteurl='http://'.$clientip.'/userfiles/'.$udom.'/'.$uname.'/'.$fpath.$ufile; |
|
my $response; |
my $response; |
{ |
{ |
my $ua=new LWP::UserAgent; |
my $ua=new LWP::UserAgent; |
Line 1857 sub make_new_child {
|
Line 1855 sub make_new_child {
|
if ($response->is_error()) { |
if ($response->is_error()) { |
unlink($transname); |
unlink($transname); |
my $message=$response->status_line; |
my $message=$response->status_line; |
&logthis("LWP GET: $message for $fpath $fname ($remoteurl)"); |
&logthis("LWP GET: $message for $fname ($remoteurl)"); |
print $client "failed\n"; |
print $client "failed\n"; |
} else { |
} else { |
if (!rename($transname,$destname)) { |
if (!rename($transname,$destname)) { |
Line 1873 sub make_new_child {
|
Line 1871 sub make_new_child {
|
} |
} |
} else { |
} else { |
Reply($client, "refused\n", $userinput); |
Reply($client, "refused\n", $userinput); |
|
} |
|
# --------------------------------------------------------- remove a user file |
|
} elsif ($userinput =~ /^removeuserfile/) { # Client clear or enc. |
|
if(isClient) { |
|
my ($cmd,$fname)=split(/:/,$userinput); |
|
my ($udom,$uname,$ufile) = ($fname =~ m|^([^/]+)/([^/]+)/(.+)$|); |
|
&logthis("$udom - $uname - $ufile"); |
|
if ($ufile =~m|/\.\./|) { |
|
# any files paths with /../ in them refuse |
|
# to deal with |
|
print $client "refused\n"; |
|
} else { |
|
my $udir=propath($udom,$uname); |
|
if (-e $udir) { |
|
my $file=$udir.'/userfiles/'.$ufile; |
|
if (-e $file) { |
|
unlink($file); |
|
if (-e $file) { |
|
print $client "failed\n"; |
|
} else { |
|
print $client "ok\n"; |
|
} |
|
} else { |
|
print $client "not_found\n"; |
|
} |
|
} else { |
|
print $client "not_home\n"; |
|
} |
|
} |
|
} else { |
|
Reply($client, "refused\n", $userinput); |
} |
} |
# ------------------------------------------ authenticate access to a user file |
# ------------------------------------------ authenticate access to a user file |
} elsif ($userinput =~ /^tokenauthuserfile/) { # Client only |
} elsif ($userinput =~ /^tokenauthuserfile/) { # Client only |
Line 1884 sub make_new_child {
|
Line 1912 sub make_new_child {
|
if (open(ENVIN,$perlvar{'lonIDsDir'}.'/'. |
if (open(ENVIN,$perlvar{'lonIDsDir'}.'/'. |
$session.'.id')) { |
$session.'.id')) { |
while (my $line=<ENVIN>) { |
while (my $line=<ENVIN>) { |
if ($line=~/userfile\.$fname\=/) { $reply='ok'; } |
if ($line=~ m|userfile\.\Q$fname\E\=|) { $reply='ok'; } |
} |
} |
close(ENVIN); |
close(ENVIN); |
print $client $reply."\n"; |
print $client $reply."\n"; |
Line 1900 sub make_new_child {
|
Line 1928 sub make_new_child {
|
if(isClient) { |
if(isClient) { |
my ($cmd,$fname)=split(/:/,$userinput); |
my ($cmd,$fname)=split(/:/,$userinput); |
if (-e $fname) { |
if (-e $fname) { |
print $client &unsub($client,$fname,$clientip); |
print $client &unsub($fname,$clientip); |
} else { |
} else { |
print $client "not_found\n"; |
print $client "not_found\n"; |
} |
} |
Line 2595 sub make_new_child {
|
Line 2623 sub make_new_child {
|
$qresult.=$key.'='.$descr.'&'; |
$qresult.=$key.'='.$descr.'&'; |
} else { |
} else { |
my $unescapeVal = &unescape($descr); |
my $unescapeVal = &unescape($descr); |
if (eval('$unescapeVal=~/$description/i')) { |
if (eval('$unescapeVal=~/\Q$description\E/i')) { |
$qresult.="$key=$descr&"; |
$qresult.="$key=$descr&"; |
} |
} |
} |
} |
Line 2850 sub make_new_child {
|
Line 2878 sub make_new_child {
|
} else { |
} else { |
print $client "refused\n"; |
print $client "refused\n"; |
$client->close(); |
$client->close(); |
&logthis("<font color=blue>WARNING: " |
&logthis("<font color='blue'>WARNING: " |
."Rejected client $clientip, closing connection</font>"); |
."Rejected client $clientip, closing connection</font>"); |
} |
} |
} |
} |
|
|
# ============================================================================= |
# ============================================================================= |
|
|
&logthis("<font color=red>CRITICAL: " |
&logthis("<font color='red'>CRITICAL: " |
."Disconnect from $clientip ($clientname)</font>"); |
."Disconnect from $clientip ($clientname)</font>"); |
|
|
|
|
Line 3012 sub chatadd {
|
Line 3040 sub chatadd {
|
sub unsub { |
sub unsub { |
my ($fname,$clientip)=@_; |
my ($fname,$clientip)=@_; |
my $result; |
my $result; |
|
my $unsubs = 0; # Number of successful unsubscribes: |
|
|
|
|
|
# An old way subscriptions were handled was to have a |
|
# subscription marker file: |
|
|
|
Debug("Attempting unlink of $fname.$clientname"); |
if (unlink("$fname.$clientname")) { |
if (unlink("$fname.$clientname")) { |
$result="ok\n"; |
$unsubs++; # Successful unsub via marker file. |
} else { |
} |
$result="not_subscribed\n"; |
|
} |
# The more modern way to do it is to have a subscription list |
|
# file: |
|
|
if (-e "$fname.subscription") { |
if (-e "$fname.subscription") { |
my $found=&addline($fname,$clientname,$clientip,''); |
my $found=&addline($fname,$clientname,$clientip,''); |
if ($found) { $result="ok\n"; } |
if ($found) { |
|
$unsubs++; |
|
} |
|
} |
|
|
|
# If either or both of these mechanisms succeeded in unsubscribing a |
|
# resource we can return ok: |
|
|
|
if($unsubs) { |
|
$result = "ok\n"; |
} else { |
} else { |
if ($result != "ok\n") { $result="not_subscribed\n"; } |
$result = "not_subscribed\n"; |
} |
} |
|
|
return $result; |
return $result; |
} |
} |
|
|
Line 3144 sub make_passwd_file {
|
Line 3191 sub make_passwd_file {
|
} |
} |
} elsif ($umode eq 'unix') { |
} elsif ($umode eq 'unix') { |
{ |
{ |
|
# |
|
# Don't allow the creation of privileged accounts!!! that would |
|
# be real bad!!! |
|
# |
|
my $uid = getpwnam($uname); |
|
if((defined $uid) && ($uid == 0)) { |
|
&logthis(">>>Attempted to create privilged account blocked"); |
|
return "no_priv_account_error\n"; |
|
} |
|
|
my $execpath="$perlvar{'lonDaemons'}/"."lcuseradd"; |
my $execpath="$perlvar{'lonDaemons'}/"."lcuseradd"; |
{ |
{ |
&Debug("Executing external: ".$execpath); |
&Debug("Executing external: ".$execpath); |