version 1.183, 2004/03/09 21:05:13
|
version 1.189, 2004/05/07 17:51:58
|
Line 1827 sub make_new_child {
|
Line 1827 sub make_new_child {
|
# -------------------------------------- fetch a user file from a remote server |
# -------------------------------------- fetch a user file from a remote server |
} elsif ($userinput =~ /^fetchuserfile/) { # Client clear or enc. |
} elsif ($userinput =~ /^fetchuserfile/) { # Client clear or enc. |
if(isClient) { |
if(isClient) { |
my ($cmd,$fname,$fpath)=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) { |
unless ($fpath eq '') { |
$ufile=~s/^[\.\~]+//; |
my $filepath = $udir; |
my $path = $udir; |
my @parts=split(/\//,$fpath); |
if ($ufile =~m|(.+)/([^/]+)$|) { |
my $count; |
my @parts=split('/',$1); |
for ($count=0;$count<=$#parts;$count++) { |
foreach my $part (@parts) { |
$filepath .="/$parts[$count]"; |
$path .= '/'.$part; |
if ((-e $filepath)!=1) { |
if ((-e $path)!=1) { |
mkdir($filepath,0770); |
mkdir($path,0770); |
} |
} |
} |
} |
} |
} |
$ufile=~s/^[\.\~]+//; |
my $destname=$udir.'/'.$ufile; |
$ufile=~s/\///g; |
my $transname=$udir.'/'.$ufile.'.in.transit'; |
my $destname=$udir.'/'.$fpath.$ufile; |
my $remoteurl='http://'.$clientip.'/userfiles/'.$fname; |
my $transname=$udir.'/'.$fpath.$ufile.'.in.transit'; |
|
my $remoteurl='http://'.$clientip.'/userfiles/'.$udom.'/'.$uname.'/'.$fpath.$ufile; |
|
my $response; |
my $response; |
{ |
{ |
my $ua=new LWP::UserAgent; |
my $ua=new LWP::UserAgent; |
Line 1857 sub make_new_child {
|
Line 1855 sub make_new_child {
|
if ($response->is_error()) { |
if ($response->is_error()) { |
unlink($transname); |
unlink($transname); |
my $message=$response->status_line; |
my $message=$response->status_line; |
&logthis("LWP GET: $message for $fpath $fname ($remoteurl)"); |
&logthis("LWP GET: $message for $fname ($remoteurl)"); |
print $client "failed\n"; |
print $client "failed\n"; |
} else { |
} else { |
if (!rename($transname,$destname)) { |
if (!rename($transname,$destname)) { |
Line 1873 sub make_new_child {
|
Line 1871 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 1884 sub make_new_child {
|
Line 1912 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 1900 sub make_new_child {
|
Line 1928 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 2595 sub make_new_child {
|
Line 2623 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 3012 sub chatadd {
|
Line 3040 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 3144 sub make_passwd_file {
|
Line 3191 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); |