version 1.77, 2002/04/27 13:10:47
|
version 1.82, 2002/06/18 19:39:13
|
Line 53
|
Line 53
|
# 02/12 Gerd Kortemeyer |
# 02/12 Gerd Kortemeyer |
# 02/19 Matthew Hall |
# 02/19 Matthew Hall |
# 02/25 Gerd Kortemeyer |
# 02/25 Gerd Kortemeyer |
|
# 05/11 Scott Harrison |
### |
### |
|
|
# based on "Perl Cookbook" ISBN 1-56592-243-3 |
# based on "Perl Cookbook" ISBN 1-56592-243-3 |
Line 61
|
Line 62
|
# HUPs |
# HUPs |
# uses IDEA encryption |
# uses IDEA encryption |
|
|
|
use lib '/home/httpd/lib/perl/'; |
|
use LONCAPA::Configuration; |
|
|
use IO::Socket; |
use IO::Socket; |
use IO::File; |
use IO::File; |
use Apache::File; |
use Apache::File; |
Line 101 sub timeout {
|
Line 105 sub timeout {
|
$SIG{'QUIT'}=\&catchexception; |
$SIG{'QUIT'}=\&catchexception; |
$SIG{__DIE__}=\&catchexception; |
$SIG{__DIE__}=\&catchexception; |
|
|
# ------------------------------------ Read httpd access.conf and get variables |
# ---------------------------------- Read loncapa_apache.conf and loncapa.conf |
|
&status("Read loncapa_apache.conf and loncapa.conf"); |
open (CONFIG,"/etc/httpd/conf/access.conf") || die "Can't read access.conf"; |
my $perlvarref=LONCAPA::Configuration::read_conf('loncapa_apache.conf', |
|
'loncapa.conf'); |
while ($configline=<CONFIG>) { |
my %perlvar=%{$perlvarref}; |
if ($configline =~ /PerlSetVar/) { |
undef $perlvarref; |
my ($dummy,$varname,$varvalue)=split(/\s+/,$configline); |
|
chomp($varvalue); |
|
$perlvar{$varname}=$varvalue; |
|
} |
|
} |
|
close(CONFIG); |
|
|
|
# ----------------------------- Make sure this process is running from user=www |
# ----------------------------- Make sure this process is running from user=www |
my $wwwid=getpwnam('www'); |
my $wwwid=getpwnam('www'); |
Line 549 sub make_new_child {
|
Line 547 sub make_new_child {
|
# ------------------------------------------------------------ Process requests |
# ------------------------------------------------------------ Process requests |
while (my $userinput=<$client>) { |
while (my $userinput=<$client>) { |
chomp($userinput); |
chomp($userinput); |
|
Debug("Request = $userinput\n"); |
&status('Processing '.$hostid{$clientip}.': '.$userinput); |
&status('Processing '.$hostid{$clientip}.': '.$userinput); |
my $wasenc=0; |
my $wasenc=0; |
alarm(120); |
alarm(120); |
Line 604 sub make_new_child {
|
Line 603 sub make_new_child {
|
} elsif ($userinput =~ /^currentauth/) { |
} elsif ($userinput =~ /^currentauth/) { |
if ($wasenc==1) { |
if ($wasenc==1) { |
my ($cmd,$udom,$uname)=split(/:/,$userinput); |
my ($cmd,$udom,$uname)=split(/:/,$userinput); |
my $proname=propath($udom,$uname); |
my $result = GetAuthType($udom, $uname); |
my $passfilename="$proname/passwd"; |
if($result eq "nouser") { |
if (-e $passfilename) { |
print $client "unknown_user\n"; |
my $pf = IO::File->new($passfilename); |
} |
my $realpasswd=<$pf>; |
else { |
chomp($realpasswd); |
print $client "$result\n" |
my ($howpwd,$contentpwd)=split(/:/,$realpasswd); |
} |
my $availablecontent=''; |
|
if ($howpwd eq 'krb4') { |
|
$availablecontent=$contentpwd; |
|
} |
|
print $client "$howpwd:$availablecontent\n"; |
|
} else { |
|
print $client "unknown_user\n"; |
|
} |
|
} else { |
} else { |
print $client "refused\n"; |
print $client "refused\n"; |
} |
} |
Line 1071 sub make_new_child {
|
Line 1062 sub make_new_child {
|
if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) { |
if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) { |
foreach $pair (@pairs) { |
foreach $pair (@pairs) { |
($key,$value)=split(/=/,$pair); |
($key,$value)=split(/=/,$pair); |
|
&ManagePermissions($key, $udom, $uname, |
|
&GetAuthType( $udom, |
|
$uname)); |
$hash{$key}=$value; |
$hash{$key}=$value; |
|
|
} |
} |
if (untie(%hash)) { |
if (untie(%hash)) { |
print $client "ok\n"; |
print $client "ok\n"; |
Line 1297 sub make_new_child {
|
Line 1292 sub make_new_child {
|
# ------------------------------------------------------------------- querysend |
# ------------------------------------------------------------------- querysend |
} elsif ($userinput =~ /^querysend/) { |
} elsif ($userinput =~ /^querysend/) { |
my ($cmd,$query, |
my ($cmd,$query, |
$custom,$customshow)=split(/:/,$userinput); |
$arg1,$arg2,$arg3)=split(/\:/,$userinput); |
$query=~s/\n*$//g; |
$query=~s/\n*$//g; |
unless ($custom or $customshow) { |
print $client "". |
print $client "". |
|
sqlreply("$hostid{$clientip}\&$query")."\n"; |
|
} |
|
else { |
|
print $client "". |
|
sqlreply("$hostid{$clientip}\&$query". |
sqlreply("$hostid{$clientip}\&$query". |
"\&$custom"."\&$customshow")."\n"; |
"\&$arg1"."\&$arg2"."\&$arg3")."\n"; |
} |
|
# ------------------------------------------------------------------ queryreply |
# ------------------------------------------------------------------ queryreply |
} elsif ($userinput =~ /^queryreply/) { |
} elsif ($userinput =~ /^queryreply/) { |
my ($cmd,$id,$reply)=split(/:/,$userinput); |
my ($cmd,$id,$reply)=split(/:/,$userinput); |
Line 1466 sub make_new_child {
|
Line 1455 sub make_new_child {
|
} |
} |
} |
} |
|
|
|
|
|
# |
|
# Checks to see if the input roleput request was to set |
|
# an author role. If so, invokes the lchtmldir script to set |
|
# up a correct public_html |
|
# Parameters: |
|
# request - The request sent to the rolesput subchunk. |
|
# We're looking for /domain/_au |
|
# domain - The domain in which the user is having roles doctored. |
|
# user - Name of the user for which the role is being put. |
|
# authtype - The authentication type associated with the user. |
|
# |
|
sub ManagePermissions |
|
{ |
|
my $request = shift; |
|
my $domain = shift; |
|
my $user = shift; |
|
my $authtype= shift; |
|
|
|
# See if the request is of the form /$domain/_au |
|
|
|
if($request =~ /^(\/$domain\/_au)$/) { # It's an author rolesput... |
|
my $execdir = $perlvar{'lonDaemons'}; |
|
my $userhome= "/home/$user" ; |
|
Debug("system $execdir/lchtmldir $userhome $system $authtype"); |
|
system("$execdir/lchtmldir $userhome $user $authtype"); |
|
} |
|
} |
|
# |
|
# GetAuthType - Determines the authorization type of a user in a domain. |
|
|
|
# Returns the authorization type or nouser if there is no such user. |
|
# |
|
sub GetAuthType |
|
{ |
|
my $domain = shift; |
|
my $user = shift; |
|
|
|
Debug("GetAuthType( $domain, $user ) \n"); |
|
my $proname = &propath($domain, $user); |
|
my $passwdfile = "$proname/passwd"; |
|
if( -e $passwdfile ) { |
|
my $pf = IO::File->new($passwdfile); |
|
my $realpassword = <$pf>; |
|
chomp($realpassword); |
|
Debug("Password info = $realpassword\n"); |
|
my ($authtype, $contentpwd) = split(/:/, $realpassword); |
|
Debug("Authtype = $authtype, content = $contentpwd\n"); |
|
my $availinfo = ''; |
|
if($authtype eq 'krb4') { |
|
$availinfo = $contentpwd; |
|
} |
|
|
|
return "$authtype:$availinfo"; |
|
} |
|
else { |
|
Debug("Returning nouser"); |
|
return "nouser"; |
|
} |
|
|
|
} |
|
|
# ----------------------------------- POD (plain old documentation, CPAN style) |
# ----------------------------------- POD (plain old documentation, CPAN style) |
|
|
=head1 NAME |
=head1 NAME |