version 1.170, 2004/01/07 21:13:52
|
version 1.192, 2004/06/01 09:58:30
|
Line 225 sub ValidManager {
|
Line 225 sub ValidManager {
|
# 1 - Success. |
# 1 - Success. |
# |
# |
sub CopyFile { |
sub CopyFile { |
my $oldfile = shift; |
|
my $newfile = shift; |
my ($oldfile, $newfile) = @_; |
|
|
# The file must exist: |
# The file must exist: |
|
|
Line 326 sub AdjustHostContents {
|
Line 326 sub AdjustHostContents {
|
# 0 - failure and $! has an errno. |
# 0 - failure and $! has an errno. |
# |
# |
sub InstallFile { |
sub InstallFile { |
my $Filename = shift; |
|
my $Contents = shift; |
my ($Filename, $Contents) = @_; |
my $TempFile = $Filename.".tmp"; |
my $TempFile = $Filename.".tmp"; |
|
|
# Open the file for write: |
# Open the file for write: |
Line 564 sub isValidEditCommand {
|
Line 564 sub isValidEditCommand {
|
# file being edited. |
# file being edited. |
# |
# |
sub ApplyEdit { |
sub ApplyEdit { |
my $directive = shift; |
|
my $editor = shift; |
my ($directive, $editor) = @_; |
|
|
# Break the directive down into its command and its parameters |
# Break the directive down into its command and its parameters |
# (at most two at this point. The meaning of the parameters, if in fact |
# (at most two at this point. The meaning of the parameters, if in fact |
Line 649 sub AdjustOurHost {
|
Line 649 sub AdjustOurHost {
|
# editor - Editor containing the file. |
# editor - Editor containing the file. |
# |
# |
sub ReplaceConfigFile { |
sub ReplaceConfigFile { |
my $filename = shift; |
|
my $editor = shift; |
my ($filename, $editor) = @_; |
|
|
CopyFile ($filename, $filename.".old"); |
CopyFile ($filename, $filename.".old"); |
|
|
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 812 $server = IO::Socket::INET->new(LocalPor
|
Line 812 $server = IO::Socket::INET->new(LocalPor
|
# global variables |
# global variables |
|
|
my %children = (); # keys are current child process IDs |
my %children = (); # keys are current child process IDs |
my $children = 0; # current number of children |
|
|
|
sub REAPER { # takes care of dead children |
sub REAPER { # takes care of dead children |
$SIG{CHLD} = \&REAPER; |
$SIG{CHLD} = \&REAPER; |
&status("Handling child death"); |
&status("Handling child death"); |
my $pid = wait; |
my $pid; |
if (defined($children{$pid})) { |
do { |
&logthis("Child $pid died"); |
$pid = waitpid(-1,&WNOHANG()); |
$children --; |
if (defined($children{$pid})) { |
delete $children{$pid}; |
&logthis("Child $pid died"); |
} else { |
delete($children{$pid}); |
&logthis("Unknown Child $pid died"); |
} elsif ($pid > 0) { |
|
&logthis("Unknown Child $pid died"); |
|
} |
|
} while ( $pid > 0 ); |
|
foreach my $child (keys(%children)) { |
|
$pid = waitpid($child,&WNOHANG()); |
|
if ($pid > 0) { |
|
&logthis("Child $child - $pid looks like we missed it's death"); |
|
delete($children{$pid}); |
|
} |
} |
} |
&status("Finished Handling child death"); |
&status("Finished Handling child death"); |
} |
} |
Line 835 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 845 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 879 sub ReadHostTable {
|
Line 887 sub ReadHostTable {
|
open (CONFIG,"$perlvar{'lonTabDir'}/hosts.tab") || die "Can't read host file"; |
open (CONFIG,"$perlvar{'lonTabDir'}/hosts.tab") || die "Can't read host file"; |
|
|
while (my $configline=<CONFIG>) { |
while (my $configline=<CONFIG>) { |
my ($id,$domain,$role,$name,$ip)=split(/:/,$configline); |
if (!($configline =~ /^\s*\#/)) { |
chomp($ip); $ip=~s/\D+$//; |
my ($id,$domain,$role,$name,$ip)=split(/:/,$configline); |
$hostid{$ip}=$id; |
chomp($ip); $ip=~s/\D+$//; |
$hostdom{$id}=$domain; |
$hostid{$ip}=$id; |
$hostip{$id}=$ip; |
$hostdom{$id}=$domain; |
if ($id eq $perlvar{'lonHostID'}) { $thisserver=$name; } |
$hostip{$id}=$ip; |
|
if ($id eq $perlvar{'lonHostID'}) { $thisserver=$name; } |
|
} |
} |
} |
close(CONFIG); |
close(CONFIG); |
} |
} |
Line 1005 sub Debug {
|
Line 1015 sub Debug {
|
# request - Original request from client. |
# request - Original request from client. |
# |
# |
sub Reply { |
sub Reply { |
my $fd = shift; |
|
my $reply = shift; |
my ($fd, $reply, $request) = @_; |
my $request = shift; |
|
|
|
print $fd $reply; |
print $fd $reply; |
Debug("Request was $request Reply was $reply"); |
Debug("Request was $request Reply was $reply"); |
Line 1020 sub logstatus {
|
Line 1029 sub logstatus {
|
my $docdir=$perlvar{'lonDocRoot'}; |
my $docdir=$perlvar{'lonDocRoot'}; |
{ |
{ |
my $fh=IO::File->new(">>$docdir/lon-status/londstatus.txt"); |
my $fh=IO::File->new(">>$docdir/lon-status/londstatus.txt"); |
print $fh $$."\t".$currenthostid."\t".$status."\t".$lastlog."\n"; |
print $fh $$."\t".$clientname."\t".$currenthostid."\t".$status."\t".$lastlog."\n"; |
$fh->close(); |
$fh->close(); |
} |
} |
&status("Finished londstatus.txt"); |
&status("Finished londstatus.txt"); |
Line 1085 sub reconlonc {
|
Line 1094 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 1193 my $execdir=$perlvar{'lonDaemons'};
|
Line 1202 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 1248 sub make_new_child {
|
Line 1257 sub make_new_child {
|
# the pid hash. |
# the pid hash. |
# |
# |
my $caller = getpeername($client); |
my $caller = getpeername($client); |
my ($port,$iaddr)=unpack_sockaddr_in($caller); |
my ($port,$iaddr); |
$clientip=inet_ntoa($iaddr); |
if (defined($caller) && length($caller) > 0) { |
|
($port,$iaddr)=unpack_sockaddr_in($caller); |
|
} else { |
|
&logthis("Unable to determine who caller was, getpeername returned nothing"); |
|
} |
|
if (defined($iaddr)) { |
|
$clientip=inet_ntoa($iaddr); |
|
} else { |
|
&logthis("Unable to determine clinetip"); |
|
$clientip='Unavailable'; |
|
} |
|
|
if ($pid) { |
if ($pid) { |
# Parent records the child's birth and returns. |
# Parent records the child's birth and returns. |
sigprocmask(SIG_UNBLOCK, $sigset) |
sigprocmask(SIG_UNBLOCK, $sigset) |
or die "Can't unblock SIGINT for fork: $!\n"; |
or die "Can't unblock SIGINT for fork: $!\n"; |
$children{$pid} = $clientip; |
$children{$pid} = $clientip; |
$children++; |
|
&status('Started child '.$pid); |
&status('Started child '.$pid); |
return; |
return; |
} else { |
} else { |
Line 1321 sub make_new_child {
|
Line 1339 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 1346 sub make_new_child {
|
Line 1364 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 1543 sub make_new_child {
|
Line 1561 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 1693 sub make_new_child {
|
Line 1711 sub make_new_child {
|
unless (mkdir($fpnow,0777)) { |
unless (mkdir($fpnow,0777)) { |
$fperror="error: ".($!+0) |
$fperror="error: ".($!+0) |
." mkdir failed while attempting " |
." mkdir failed while attempting " |
."makeuser\n"; |
."makeuser"; |
} |
} |
} |
} |
} |
} |
Line 1809 sub make_new_child {
|
Line 1827 sub make_new_child {
|
} elsif ($userinput =~ /^fetchuserfile/) { # Client clear or enc. |
} elsif ($userinput =~ /^fetchuserfile/) { # Client clear or enc. |
if(isClient) { |
if(isClient) { |
my ($cmd,$fname)=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) { |
$ufile=~s/^[\.\~]+//; |
$ufile=~s/^[\.\~]+//; |
$ufile=~s/\///g; |
my $path = $udir; |
|
if ($ufile =~m|(.+)/([^/]+)$|) { |
|
my @parts=split('/',$1); |
|
foreach my $part (@parts) { |
|
$path .= '/'.$part; |
|
if ((-e $path)!=1) { |
|
mkdir($path,0770); |
|
} |
|
} |
|
} |
my $destname=$udir.'/'.$ufile; |
my $destname=$udir.'/'.$ufile; |
my $transname=$udir.'/'.$ufile.'.in.transit'; |
my $transname=$udir.'/'.$ufile.'.in.transit'; |
my $remoteurl='http://'.$clientip.'/userfiles/'.$fname; |
my $remoteurl='http://'.$clientip.'/userfiles/'.$fname; |
Line 1843 sub make_new_child {
|
Line 1870 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 1854 sub make_new_child {
|
Line 1911 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 1870 sub make_new_child {
|
Line 1927 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 1997 sub make_new_child {
|
Line 2054 sub make_new_child {
|
} else { |
} else { |
print $client "error: ".($!+0) |
print $client "error: ".($!+0) |
." untie(GDBM) failed ". |
." untie(GDBM) failed ". |
"while attempting put\n"; |
"while attempting inc\n"; |
} |
} |
} else { |
} else { |
print $client "error: ".($!) |
print $client "error: ".($!) |
." tie(GDBM) Failed ". |
." tie(GDBM) Failed ". |
"while attempting put\n"; |
"while attempting inc\n"; |
} |
} |
} else { |
} else { |
print $client "refused\n"; |
print $client "refused\n"; |
Line 2328 sub make_new_child {
|
Line 2385 sub make_new_child {
|
my $proname=propath($udom,$uname); |
my $proname=propath($udom,$uname); |
my %hash; |
my %hash; |
if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER(),0640)) { |
if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER(),0640)) { |
study($regexp); |
|
while (my ($key,$value) = each(%hash)) { |
while (my ($key,$value) = each(%hash)) { |
if ($regexp eq '.') { |
if ($regexp eq '.') { |
$qresult.=$key.'='.$value.'&'; |
$qresult.=$key.'='.$value.'&'; |
Line 2566 sub make_new_child {
|
Line 2622 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 2724 sub make_new_child {
|
Line 2780 sub make_new_child {
|
# -------------------------------------------------------------------------- ls |
# -------------------------------------------------------------------------- ls |
} elsif ($userinput =~ /^ls/) { |
} elsif ($userinput =~ /^ls/) { |
if(isClient) { |
if(isClient) { |
|
my $obs; |
|
my $rights; |
my ($cmd,$ulsdir)=split(/:/,$userinput); |
my ($cmd,$ulsdir)=split(/:/,$userinput); |
my $ulsout=''; |
my $ulsout=''; |
my $ulsfn; |
my $ulsfn; |
Line 2731 sub make_new_child {
|
Line 2789 sub make_new_child {
|
if(-d $ulsdir) { |
if(-d $ulsdir) { |
if (opendir(LSDIR,$ulsdir)) { |
if (opendir(LSDIR,$ulsdir)) { |
while ($ulsfn=readdir(LSDIR)) { |
while ($ulsfn=readdir(LSDIR)) { |
|
undef $obs, $rights; |
my @ulsstats=stat($ulsdir.'/'.$ulsfn); |
my @ulsstats=stat($ulsdir.'/'.$ulsfn); |
$ulsout.=$ulsfn.'&'. |
#We do some obsolete checking here |
join('&',@ulsstats).':'; |
if(-e $ulsdir.'/'.$ulsfn.".meta") { |
|
open(FILE, $ulsdir.'/'.$ulsfn.".meta"); |
|
my @obsolete=<FILE>; |
|
foreach my $obsolete (@obsolete) { |
|
if($obsolete =~ m|(<obsolete>)(on)|) { $obs = 1; } |
|
if($obsolete =~ m|(<copyright>)(default)|) { $rights = 1; } |
|
} |
|
} |
|
$ulsout.=$ulsfn.'&'.join('&',@ulsstats); |
|
if($obs eq '1') { $ulsout.="&1"; } |
|
else { $ulsout.="&0"; } |
|
if($rights eq '1') { $ulsout.="&1:"; } |
|
else { $ulsout.="&0:"; } |
} |
} |
closedir(LSDIR); |
closedir(LSDIR); |
} |
} |
Line 2806 sub make_new_child {
|
Line 2877 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 2838 sub make_new_child {
|
Line 2909 sub make_new_child {
|
# |
# |
sub ManagePermissions |
sub ManagePermissions |
{ |
{ |
my $request = shift; |
|
my $domain = shift; |
my ($request, $domain, $user, $authtype) = @_; |
my $user = shift; |
|
my $authtype= shift; |
|
|
|
# See if the request is of the form /$domain/_au |
# See if the request is of the form /$domain/_au |
if($request =~ /^(\/$domain\/_au)$/) { # It's an author rolesput... |
if($request =~ /^(\/$domain\/_au)$/) { # It's an author rolesput... |
Line 2858 sub ManagePermissions
|
Line 2927 sub ManagePermissions
|
# |
# |
sub GetAuthType |
sub GetAuthType |
{ |
{ |
my $domain = shift; |
|
my $user = shift; |
my ($domain, $user) = @_; |
|
|
Debug("GetAuthType( $domain, $user ) \n"); |
Debug("GetAuthType( $domain, $user ) \n"); |
my $proname = &propath($domain, $user); |
my $proname = &propath($domain, $user); |
Line 2968 sub chatadd {
|
Line 3037 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 3100 sub make_passwd_file {
|
Line 3188 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); |