)(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);
+ }
+ } else {
+ my @ulsstats=stat($ulsdir);
+ $ulsout.=$ulsfn.'&'.join('&',@ulsstats).':';
+ }
+ } else {
+ $ulsout='no_such_dir';
+ }
+ if ($ulsout eq '') { $ulsout='empty'; }
+ print $client "$ulsout\n";
+ } else {
+ Reply($client, "refused\n", $userinput);
+
+ }
# ----------------------------------------------------------------- setannounce
- } elsif ($userinput =~ /^setannounce/) {
- my ($cmd,$announcement)=split(/:/,$userinput);
- chomp($announcement);
- $announcement=&unescape($announcement);
- if (my $store=IO::File->new('>'.$perlvar{'lonDocRoot'}.
- '/announcement.txt')) {
- print $store $announcement;
- close $store;
- print $client "ok\n";
- } else {
- print $client "error: ".($!+0)."\n";
- }
+ } elsif ($userinput =~ /^setannounce/) {
+ if (isClient) {
+ my ($cmd,$announcement)=split(/:/,$userinput);
+ chomp($announcement);
+ $announcement=&unescape($announcement);
+ if (my $store=IO::File->new('>'.$perlvar{'lonDocRoot'}.
+ '/announcement.txt')) {
+ print $store $announcement;
+ close $store;
+ print $client "ok\n";
+ } else {
+ print $client "error: ".($!+0)."\n";
+ }
+ } else {
+ Reply($client, "refused\n", $userinput);
+
+ }
# ------------------------------------------------------------------ Hanging up
- } elsif (($userinput =~ /^exit/) ||
- ($userinput =~ /^init/)) {
- &logthis(
- "Client $clientip ($hostid{$clientip}) hanging up: $userinput");
- print $client "bye\n";
- $client->close();
- last;
+ } elsif (($userinput =~ /^exit/) ||
+ ($userinput =~ /^init/)) { # no restrictions.
+ &logthis(
+ "Client $clientip ($clientname) hanging up: $userinput");
+ print $client "bye\n";
+ $client->shutdown(2); # shutdown the socket forcibly.
+ $client->close();
+ last;
+
+# ---------------------------------- set current host/domain
+ } elsif ($userinput =~ /^sethost:/) {
+ if (isClient) {
+ print $client &sethost($userinput)."\n";
+ } else {
+ print $client "refused\n";
+ }
+#---------------------------------- request file (?) version.
+ } elsif ($userinput =~/^version:/) {
+ if (isClient) {
+ print $client &version($userinput)."\n";
+ } else {
+ print $client "refused\n";
+ }
# ------------------------------------------------------------- unknown command
- } elsif ($userinput =~ /^sethost:/) {
- print $client &sethost($userinput)."\n";
- } elsif ($userinput =~/^version:/) {
- print $client &version($userinput)."\n";
- } else {
- # unknown command
- print $client "unknown_cmd\n";
- }
+
+ } else {
+ # unknown command
+ print $client "unknown_cmd\n";
+ }
# -------------------------------------------------------------------- complete
- alarm(0);
- &status('Listening to '.$hostid{$clientip});
- }
+ alarm(0);
+ &status('Listening to '.$clientname);
+ }
# --------------------------------------------- client unknown or fishy, refuse
- } else {
- print $client "refused\n";
- $client->close();
- &logthis("WARNING: "
- ."Rejected client $clientip, closing connection");
- }
- }
-
+ } else {
+ print $client "refused\n";
+ $client->close();
+ &logthis("WARNING: "
+ ."Rejected client $clientip, closing connection");
+ }
+ }
+
# =============================================================================
-
- &logthis("CRITICAL: "
- ."Disconnect from $clientip ($hostid{$clientip})");
-
-
- # this exit is VERY important, otherwise the child will become
- # a producer of more and more children, forking yourself into
- # process death.
- exit;
+
+ &logthis("CRITICAL: "
+ ."Disconnect from $clientip ($clientname)");
+
+
+ # this exit is VERY important, otherwise the child will become
+ # a producer of more and more children, forking yourself into
+ # process death.
+ exit;
}
@@ -1884,7 +2916,6 @@ sub ManagePermissions
my $authtype= shift;
# See if the request is of the form /$domain/_au
- &logthis("ruequest is $request");
if($request =~ /^(\/$domain\/_au)$/) { # It's an author rolesput...
my $execdir = $perlvar{'lonDaemons'};
my $userhome= "/home/$user" ;
@@ -1975,10 +3006,10 @@ sub chatadd {
my %hash;
my $proname=&propath($cdom,$cname);
my @entries=();
+ my $time=time;
if (tie(%hash,'GDBM_File',"$proname/nohist_chatroom.db",
&GDBM_WRCREAT(),0640)) {
@entries=map { $_.':'.$hash{$_} } sort keys %hash;
- my $time=time;
my ($lastid)=($entries[$#entries]=~/^(\w+)\:/);
my ($thentime,$idnum)=split(/\_/,$lastid);
my $newid=$time.'_000000';
@@ -1998,22 +3029,47 @@ sub chatadd {
}
untie %hash;
}
+ {
+ my $hfh;
+ if ($hfh=IO::File->new(">>$proname/chatroom.log")) {
+ print $hfh "$time:".&unescape($newchat)."\n";
+ }
+ }
}
sub unsub {
my ($fname,$clientip)=@_;
my $result;
- if (unlink("$fname.$hostid{$clientip}")) {
- $result="ok\n";
- } else {
- $result="not_subscribed\n";
- }
+ 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")) {
+ $unsubs++; # Successful unsub via marker file.
+ }
+
+ # The more modern way to do it is to have a subscription list
+ # file:
+
if (-e "$fname.subscription") {
- my $found=&addline($fname,$hostid{$clientip},$clientip,'');
- if ($found) { $result="ok\n"; }
+ my $found=&addline($fname,$clientname,$clientip,'');
+ 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 {
- if ($result != "ok\n") { $result="not_subscribed\n"; }
+ $result = "not_subscribed\n";
}
+
return $result;
}
@@ -2041,7 +3097,7 @@ sub currentversion {
# see if this is a regular file (ignore links produced earlier)
my $thisfile=$ulsdir.'/'.$ulsfn;
unless (-l $thisfile) {
- if ($thisfile=~/\Q$fnamere1\E(\d+)\Q$fnamere2\E/) {
+ if ($thisfile=~/\Q$fnamere1\E(\d+)\Q$fnamere2\E$/) {
if ($1>$version) { $version=$1; }
}
}
@@ -2089,10 +3145,10 @@ sub subscribe {
if (-d $fname) {
$result="directory\n";
} else {
- if (-e "$fname.$hostid{$clientip}") {&unsub($fname,$clientip);}
+ if (-e "$fname.$clientname") {&unsub($fname,$clientip);}
my $now=time;
- my $found=&addline($fname,$hostid{$clientip},$clientip,
- "$hostid{$clientip}:$clientip:$now\n");
+ my $found=&addline($fname,$clientname,$clientip,
+ "$clientname:$clientip:$now\n");
if ($found) { $result="$fname\n"; }
# if they were subscribed to only meta data, delete that
# subscription, when you subscribe to a file you also get
@@ -2135,6 +3191,16 @@ sub make_passwd_file {
}
} 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";
{
&Debug("Executing external: ".$execpath);
@@ -2194,7 +3260,7 @@ sub userload {
while ($filename=readdir(LONIDS)) {
if ($filename eq '.' || $filename eq '..') {next;}
my ($mtime)=(stat($perlvar{'lonIDsDir'}.'/'.$filename))[9];
- if ($curtime-$mtime < 3600) { $numusers++; }
+ if ($curtime-$mtime < 1800) { $numusers++; }
}
closedir(LONIDS);
}
@@ -2316,6 +3382,17 @@ each connection is logged.
=item *
+SIGUSR2
+
+Parent Signal assignment:
+ $SIG{USR2} = \&UpdateHosts
+
+Child signal assignment:
+ NONE
+
+
+=item *
+
SIGCHLD
Parent signal assignment:
500 Internal Server Error
Internal Server Error
The server encountered an internal error or
misconfiguration and was unable to complete
your request.
Please contact the server administrator at
root@localhost to inform them of the time this error occurred,
and the actions you performed just before this error.
More information about this error may be available
in the server error log.