version 1.140, 2003/08/26 11:15:57
|
version 1.142, 2003/09/09 20:47:46
|
Line 57
|
Line 57
|
# Management functions supported include: |
# Management functions supported include: |
# - pushing /home/httpd/lonTabs/hosts.tab |
# - pushing /home/httpd/lonTabs/hosts.tab |
# - pushing /home/httpd/lonTabs/domain.tab |
# - pushing /home/httpd/lonTabs/domain.tab |
### |
# 09/08/2003 Ron Fox: Told lond to take care of change logging so we |
|
# don't have to remember it: |
|
# $Log$ |
|
# Revision 1.142 2003/09/09 20:47:46 www |
|
# Permanently store chatroom entries in chatroom.log |
|
# |
|
# Revision 1.141 2003/09/08 10:32:07 foxr |
|
# Added PushFile sub This sub oversees the push of a new configuration table file |
|
# Currently supported files are: |
|
# - hosts.tab (transaction pushfile:hosts:contents) |
|
# - domain.tab (transaction pushfile:domain:contents) |
|
# |
|
|
|
|
use strict; |
use strict; |
use lib '/home/httpd/lib/perl/'; |
use lib '/home/httpd/lib/perl/'; |
Line 95 my $thisserver;
|
Line 107 my $thisserver;
|
my %hostid; |
my %hostid; |
my %hostdom; |
my %hostdom; |
my %hostip; |
my %hostip; |
|
my %perlvar; # Will have the apache conf defined perl vars. |
|
|
# |
# |
# The array below are password error strings." |
# The array below are password error strings." |
Line 173 sub ValidManager {
|
Line 186 sub ValidManager {
|
} |
} |
} |
} |
# |
# |
|
# PushFile: Called to do an administrative push of a file. |
|
# - Ensure the file being pushed is one we support. |
|
# - Backup the old file to <filename.saved> |
|
# - Separate the contents of the new file out from the |
|
# rest of the request. |
|
# - Write the new file. |
|
# Parameter: |
|
# Request - The entire user request. This consists of a : separated |
|
# string pushfile:tablename:contents. |
|
# NOTE: The contents may have :'s in it as well making things a bit |
|
# more interesting... but not much. |
|
# Returns: |
|
# String to send to client ("ok" or "refused" if bad file). |
|
# |
|
sub PushFile { |
|
my $request = shift; |
|
my ($command, $filename, $contents) = split(":", $request, 3); |
|
|
|
# At this point in time, pushes for only the following tables are |
|
# supported: |
|
# hosts.tab ($filename eq host). |
|
# domain.tab ($filename eq domain). |
|
# Construct the destination filename or reject the request. |
|
# |
|
# lonManage is supposed to ensure this, however this session could be |
|
# part of some elaborate spoof that managed somehow to authenticate. |
|
# |
|
|
|
my $tablefile = $perlvar{'lonTabDir'}.'/'; # need to precede with dir. |
|
if ($filename eq "host") { |
|
$tablefile .= "hosts.tab"; |
|
} elsif ($filename eq "domain") { |
|
$tablefile .= "domain.tab"; |
|
} else { |
|
return "refused"; |
|
} |
|
# |
|
# >copy< the old table to the backup table |
|
# don't rename in case system crashes/reboots etc. in the time |
|
# window between a rename and write. |
|
# |
|
my $backupfile = $tablefile; |
|
$backupfile =~ s/\.tab$/.old/; |
|
# CopyFile($tablefile, $backupfile); |
|
&logthis('<font color="green"> Pushfile: backed up ' |
|
.$tablefile." to $backupfile</font>"); |
|
|
|
# Install the new file: |
|
|
|
# InstallFile($tablefile, $contents); |
|
|
|
# Indicate success: |
|
|
|
return "ok"; |
|
|
|
} |
|
# |
# Convert an error return code from lcpasswd to a string value. |
# Convert an error return code from lcpasswd to a string value. |
# |
# |
sub lcpasswdstrerror { |
sub lcpasswdstrerror { |
Line 222 $SIG{__DIE__}=\&catchexception;
|
Line 292 $SIG{__DIE__}=\&catchexception;
|
# ---------------------------------- Read loncapa_apache.conf and loncapa.conf |
# ---------------------------------- Read loncapa_apache.conf and loncapa.conf |
&status("Read loncapa.conf and loncapa_apache.conf"); |
&status("Read loncapa.conf and loncapa_apache.conf"); |
my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf'); |
my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf'); |
my %perlvar=%{$perlvarref}; |
%perlvar=%{$perlvarref}; |
undef $perlvarref; |
undef $perlvarref; |
|
|
# ----------------------------- Make sure this process is running from user=www |
# ----------------------------- Make sure this process is running from user=www |
Line 745 sub make_new_child {
|
Line 815 sub make_new_child {
|
if($wasenc == 1) { |
if($wasenc == 1) { |
my $cert = GetCertificate($userinput); |
my $cert = GetCertificate($userinput); |
if(ValidManager($cert)) { |
if(ValidManager($cert)) { |
print $client "ok\n"; |
my $reply = PushFile($userinput); |
|
print $client "$reply\n"; |
} else { |
} else { |
print $client "refused\n"; |
print $client "refused\n"; |
} |
} |
Line 1975 sub chatadd {
|
Line 2046 sub chatadd {
|
my %hash; |
my %hash; |
my $proname=&propath($cdom,$cname); |
my $proname=&propath($cdom,$cname); |
my @entries=(); |
my @entries=(); |
|
my $time=time; |
if (tie(%hash,'GDBM_File',"$proname/nohist_chatroom.db", |
if (tie(%hash,'GDBM_File',"$proname/nohist_chatroom.db", |
&GDBM_WRCREAT(),0640)) { |
&GDBM_WRCREAT(),0640)) { |
@entries=map { $_.':'.$hash{$_} } sort keys %hash; |
@entries=map { $_.':'.$hash{$_} } sort keys %hash; |
my $time=time; |
|
my ($lastid)=($entries[$#entries]=~/^(\w+)\:/); |
my ($lastid)=($entries[$#entries]=~/^(\w+)\:/); |
my ($thentime,$idnum)=split(/\_/,$lastid); |
my ($thentime,$idnum)=split(/\_/,$lastid); |
my $newid=$time.'_000000'; |
my $newid=$time.'_000000'; |
Line 1998 sub chatadd {
|
Line 2069 sub chatadd {
|
} |
} |
untie %hash; |
untie %hash; |
} |
} |
|
{ |
|
my $hfh; |
|
if ($hfh=IO::File->new(">>$proname/chatroom.log")) { |
|
print $hfh "$time:".&unescape($newchat)."\n"; |
|
} |
|
} |
} |
} |
|
|
sub unsub { |
sub unsub { |