version 1.79, 2002/05/08 02:31:04
|
version 1.87, 2002/08/09 10:05:00
|
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 949 sub make_new_child {
|
Line 947 sub make_new_child {
|
} else { |
} else { |
print $client "rejected\n"; |
print $client "rejected\n"; |
} |
} |
|
# -------------------------------------- fetch a user file from a remote server |
|
} elsif ($userinput =~ /^fetchuserfile/) { |
|
my ($cmd,$fname)=split(/:/,$userinput); |
|
my ($udom,$uname,$ufile)=split(/\//,$fname); |
|
my $udir=propath($udom,$uname).'/userfiles'; |
|
unless (-e $udir) { mkdir($udir); } |
|
if (-e $udir) { |
|
$ufile=~s/^[\.\~]+//; |
|
$ufile=~s/\///g; |
|
my $transname=$udir.'/'.$ufile; |
|
my $remoteurl='http://'.$clientip.'/userfiles/'.$fname; |
|
my $response; |
|
{ |
|
my $ua=new LWP::UserAgent; |
|
my $request=new HTTP::Request('GET',"$remoteurl"); |
|
$response=$ua->request($request,$transname); |
|
} |
|
if ($response->is_error()) { |
|
unlink($transname); |
|
my $message=$response->status_line; |
|
&logthis( |
|
"LWP GET: $message for $fname ($remoteurl)"); |
|
print $client "failed\n"; |
|
} else { |
|
print $client "ok\n"; |
|
} |
|
} else { |
|
print $client "not_home\n"; |
|
} |
|
# ------------------------------------------ authenticate access to a user file |
|
} elsif ($userinput =~ /^tokenauthuserfile/) { |
|
my ($cmd,$fname,$session)=split(/:/,$userinput); |
|
chomp($session); |
|
$reply='non_auth'; |
|
if (open(ENVIN,$perlvar{'lonIDsDir'}.'/'. |
|
$session.'.id')) { |
|
while ($line=<ENVIN>) { |
|
if ($line=~/userfile\.$fname\=/) { $reply='ok'; } |
|
} |
|
close(ENVIN); |
|
print $client $reply."\n"; |
|
} else { |
|
print $client "invalid_token\n"; |
|
} |
# ----------------------------------------------------------------- unsubscribe |
# ----------------------------------------------------------------- unsubscribe |
} elsif ($userinput =~ /^unsub/) { |
} elsif ($userinput =~ /^unsub/) { |
my ($cmd,$fname)=split(/:/,$userinput); |
my ($cmd,$fname)=split(/:/,$userinput); |
if (-e $fname) { |
if (-e $fname) { |
if (unlink("$fname.$hostid{$clientip}")) { |
print $client &unsub($client,$fname,$clientip); |
print $client "ok\n"; |
|
} else { |
|
print $client "not_subscribed\n"; |
|
} |
|
} else { |
} else { |
print $client "not_found\n"; |
print $client "not_found\n"; |
} |
} |
# ------------------------------------------------------------------- subscribe |
# ------------------------------------------------------------------- subscribe |
} elsif ($userinput =~ /^sub/) { |
} elsif ($userinput =~ /^sub/) { |
my ($cmd,$fname)=split(/:/,$userinput); |
print $client &subscribe($userinput,$clientip); |
my $ownership=ishome($fname); |
|
if ($ownership eq 'owner') { |
|
if (-e $fname) { |
|
if (-d $fname) { |
|
print $client "directory\n"; |
|
} else { |
|
$now=time; |
|
{ |
|
my $sh; |
|
if ($sh= |
|
IO::File->new(">$fname.$hostid{$clientip}")) { |
|
print $sh "$clientip:$now\n"; |
|
} |
|
} |
|
unless ($fname=~/\.meta$/) { |
|
unlink("$fname.meta.$hostid{$clientip}"); |
|
} |
|
$fname=~s/\/home\/httpd\/html\/res/raw/; |
|
$fname="http://$thisserver/".$fname; |
|
print $client "$fname\n"; |
|
} |
|
} else { |
|
print $client "not_found\n"; |
|
} |
|
} else { |
|
print $client "rejected\n"; |
|
} |
|
# ------------------------------------------------------------------------- log |
# ------------------------------------------------------------------------- log |
} elsif ($userinput =~ /^log/) { |
} elsif ($userinput =~ /^log/) { |
my ($cmd,$udom,$uname,$what)=split(/:/,$userinput); |
my ($cmd,$udom,$uname,$what)=split(/:/,$userinput); |
Line 1291 sub make_new_child {
|
Line 1302 sub make_new_child {
|
} else { |
} else { |
print $client "error:$!\n"; |
print $client "error:$!\n"; |
} |
} |
|
# -------------------------------------------------------------------- chatsend |
|
} elsif ($userinput =~ /^chatsend/) { |
|
my ($cmd,$cdom,$cnum,$newpost)=split(/\:/,$userinput); |
|
&chatadd($cdom,$cnum,$newpost); |
|
print $client "ok\n"; |
|
# -------------------------------------------------------------------- chatretr |
|
} elsif ($userinput =~ /^chatretr/) { |
|
my ($cmd,$cdom,$cnum)=split(/\:/,$userinput); |
|
my $reply=''; |
|
foreach (&getchat($cdom,$cnum)) { |
|
$reply.=&escape($_).':'; |
|
} |
|
$reply=~s/\:$//; |
|
print $client $reply."\n"; |
# ------------------------------------------------------------------- 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 1410 sub make_new_child {
|
Line 1429 sub make_new_child {
|
my $ulsout=''; |
my $ulsout=''; |
my $ulsfn; |
my $ulsfn; |
if (-e $ulsdir) { |
if (-e $ulsdir) { |
if (opendir(LSDIR,$ulsdir)) { |
if(-d $ulsdir) { |
while ($ulsfn=readdir(LSDIR)) { |
if (opendir(LSDIR,$ulsdir)) { |
my @ulsstats=stat($ulsdir.'/'.$ulsfn); |
while ($ulsfn=readdir(LSDIR)) { |
$ulsout.=$ulsfn.'&'.join('&',@ulsstats).':'; |
my @ulsstats=stat($ulsdir.'/'.$ulsfn); |
} |
$ulsout.=$ulsfn.'&'. |
closedir(LSDIR); |
join('&',@ulsstats).':'; |
} |
} |
} else { |
closedir(LSDIR); |
|
} |
|
} else { |
|
my @ulsstats=stat($ulsdir); |
|
$ulsout.=$ulsfn.'&'.join('&',@ulsstats).':'; |
|
} |
|
} else { |
$ulsout='no_such_dir'; |
$ulsout='no_such_dir'; |
} |
} |
if ($ulsout eq '') { $ulsout='empty'; } |
if ($ulsout eq '') { $ulsout='empty'; } |
Line 1522 sub GetAuthType
|
Line 1547 sub GetAuthType
|
Debug("Returning nouser"); |
Debug("Returning nouser"); |
return "nouser"; |
return "nouser"; |
} |
} |
|
|
} |
} |
|
|
|
sub addline { |
|
my ($fname,$hostid,$ip,$newline)=@_; |
|
my $contents; |
|
my $found=0; |
|
my $expr='^'.$hostid.':'.$ip.':'; |
|
$expr =~ s/\./\\\./g; |
|
if ($sh=IO::File->new("$fname.subscription")) { |
|
while (my $subline=<$sh>) { |
|
if ($subline !~ /$expr/) {$contents.= $subline;} else {$found=1;} |
|
} |
|
$sh->close(); |
|
} |
|
$sh=IO::File->new(">$fname.subscription"); |
|
if ($contents) { print $sh $contents; } |
|
if ($newline) { print $sh $newline; } |
|
$sh->close(); |
|
return $found; |
|
} |
|
|
|
sub getchat { |
|
my ($cdom,$cname)=@_; |
|
my %hash; |
|
my $proname=&propath($cdom,$cname); |
|
my @entries=(); |
|
if |
|
(tie(%hash,'GDBM_File',"$proname/nohist_chatroom.db",&GDBM_READER(),0640)) |
|
{ |
|
@entries=map { $_.':'.$hash{$_} } sort keys %hash; |
|
untie %hash; |
|
} |
|
return @entries; |
|
} |
|
|
|
sub chatadd { |
|
my ($cdom,$cname,$newchat)=@_; |
|
my %hash; |
|
my $proname=&propath($cdom,$cname); |
|
my @entries=(); |
|
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'; |
|
if ($thentime==$time) { |
|
$idnum=~s/^0+//; |
|
$idnum++; |
|
$idnum=substr('000000'.$idnum,-6,6); |
|
$newid=$time.'_'.$idnum; |
|
} |
|
$hash{$newid}=$newchat; |
|
my $expired=$time-3600; |
|
foreach (keys %hash) { |
|
my ($thistime)=($_=~/(\d+)\_/); |
|
if ($thistime<$expired) { |
|
undef $hash{$_}; |
|
} |
|
} |
|
untie %hash; |
|
} |
|
} |
|
|
|
sub unsub { |
|
my ($fname,$clientip)=@_; |
|
my $result; |
|
if (unlink("$fname.$hostid{$clientip}")) { |
|
$result="ok\n"; |
|
} else { |
|
$result="not_subscribed\n"; |
|
} |
|
if (-e "$fname.subscription") { |
|
my $found=&addline($fname,$hostid{$clientip},$clientip,''); |
|
if ($found) { $result="ok\n"; } |
|
} else { |
|
if ($result != "ok\n") { $result="not_subscribed\n"; } |
|
} |
|
return $result; |
|
} |
|
|
|
sub subscribe { |
|
my ($userinput,$clientip)=@_; |
|
my $result; |
|
my ($cmd,$fname)=split(/:/,$userinput); |
|
my $ownership=&ishome($fname); |
|
if ($ownership eq 'owner') { |
|
if (-e $fname) { |
|
if (-d $fname) { |
|
$result="directory\n"; |
|
} else { |
|
if (-e "$fname.$hostid{$clientip}") {&unsub($fname,$clientip);} |
|
$now=time; |
|
my $found=&addline($fname,$hostid{$clientip},$clientip, |
|
"$hostid{$clientip}:$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 |
|
# the metadata |
|
unless ($fname=~/\.meta$/) { &unsub("$fname.meta",$clientip); } |
|
$fname=~s/\/home\/httpd\/html\/res/raw/; |
|
$fname="http://$thisserver/".$fname; |
|
$result="$fname\n"; |
|
} |
|
} else { |
|
$result="not_found\n"; |
|
} |
|
} else { |
|
$result="rejected\n"; |
|
} |
|
return $result; |
|
} |
# ----------------------------------- POD (plain old documentation, CPAN style) |
# ----------------------------------- POD (plain old documentation, CPAN style) |
|
|
=head1 NAME |
=head1 NAME |