version 1.249, 2004/09/07 10:05:23
|
version 1.258, 2004/09/14 20:18:41
|
Line 331 sub InsecureConnection {
|
Line 331 sub InsecureConnection {
|
|
|
|
|
} |
} |
|
|
# |
# |
|
# Safely execute a command (as long as it's not a shel command and doesn |
|
# not require/rely on shell escapes. The function operates by doing a |
|
# a pipe based fork and capturing stdout and stderr from the pipe. |
|
# |
|
# Formal Parameters: |
|
# $line - A line of text to be executed as a command. |
|
# Returns: |
|
# The output from that command. If the output is multiline the caller |
|
# must know how to split up the output. |
|
# |
|
# |
|
sub execute_command { |
|
my ($line) = @_; |
|
my @words = split(/\s/, $line); # Bust the command up into words. |
|
my $output = ""; |
|
|
|
my $pid = open(CHILD, "-|"); |
|
|
|
if($pid) { # Parent process |
|
Debug("In parent process for execute_command"); |
|
my @data = <CHILD>; # Read the child's outupt... |
|
close CHILD; |
|
foreach my $output_line (@data) { |
|
Debug("Adding $output_line"); |
|
$output .= $output_line; # Presumably has a \n on it. |
|
} |
|
|
|
} else { # Child process |
|
close (STDERR); |
|
open (STDERR, ">&STDOUT");# Combine stderr, and stdout... |
|
exec(@words); # won't return. |
|
} |
|
return $output; |
|
} |
|
|
|
|
# GetCertificate: Given a transaction that requires a certificate, |
# GetCertificate: Given a transaction that requires a certificate, |
# this function will extract the certificate from the transaction |
# this function will extract the certificate from the transaction |
# request. Note that at this point, the only concept of a certificate |
# request. Note that at this point, the only concept of a certificate |
Line 1013 sub tie_user_hash {
|
Line 1048 sub tie_user_hash {
|
$how, 0640)) { |
$how, 0640)) { |
# If this is a namespace for which a history is kept, |
# If this is a namespace for which a history is kept, |
# make the history log entry: |
# make the history log entry: |
if (($namespace =~/^nohist\_/) && (defined($loghead))) { |
if (($namespace !~/^nohist\_/) && (defined($loghead))) { |
my $args = scalar @_; |
my $args = scalar @_; |
Debug(" Opening history: $namespace $args"); |
Debug(" Opening history: $namespace $args"); |
my $hfh = IO::File->new(">>$proname/$namespace.hist"); |
my $hfh = IO::File->new(">>$proname/$namespace.hist"); |
Line 1030 sub tie_user_hash {
|
Line 1065 sub tie_user_hash {
|
|
|
} |
} |
|
|
|
# read_profile |
|
# |
|
# Returns a set of specific entries from a user's profile file. |
|
# this is a utility function that is used by both get_profile_entry and |
|
# get_profile_entry_encrypted. |
|
# |
|
# Parameters: |
|
# udom - Domain in which the user exists. |
|
# uname - User's account name (loncapa account) |
|
# namespace - The profile namespace to open. |
|
# what - A set of & separated queries. |
|
# Returns: |
|
# If all ok: - The string that needs to be shipped back to the user. |
|
# If failure - A string that starts with error: followed by the failure |
|
# reason.. note that this probabyl gets shipped back to the |
|
# user as well. |
|
# |
|
sub read_profile { |
|
my ($udom, $uname, $namespace, $what) = @_; |
|
|
|
my $hashref = &tie_user_hash($udom, $uname, $namespace, |
|
&GDBM_READER()); |
|
if ($hashref) { |
|
my @queries=split(/\&/,$what); |
|
my $qresult=''; |
|
|
|
for (my $i=0;$i<=$#queries;$i++) { |
|
$qresult.="$hashref->{$queries[$i]}&"; # Presumably failure gives empty string. |
|
} |
|
$qresult=~s/\&$//; # Remove trailing & from last lookup. |
|
if (untie %$hashref) { |
|
return $qresult; |
|
} else { |
|
return "error: ".($!+0)." untie (GDBM) Failed"; |
|
} |
|
} else { |
|
if ($!+0 == 2) { |
|
return "error:No such file or GDBM reported bad block error"; |
|
} else { |
|
return "error: ".($!+0)." tie (GDBM) Failed"; |
|
} |
|
} |
|
|
|
} |
#--------------------- Request Handlers -------------------------------------------- |
#--------------------- Request Handlers -------------------------------------------- |
# |
# |
# By convention each request handler registers itself prior to the sub |
# By convention each request handler registers itself prior to the sub |
Line 1302 sub push_file_handler {
|
Line 1381 sub push_file_handler {
|
|
|
sub du_handler { |
sub du_handler { |
my ($cmd, $ududir, $client) = @_; |
my ($cmd, $ududir, $client) = @_; |
|
my ($ududir) = split(/:/,$ududir); # Make 'telnet' testing easier. |
|
my $userinput = "$cmd:$ududir"; |
|
|
if ($ududir=~/\.\./ || $ududir!~m|^/home/httpd/|) { |
if ($ududir=~/\.\./ || $ududir!~m|^/home/httpd/|) { |
&Failure($client,"refused\n","$cmd:$ududir"); |
&Failure($client,"refused\n","$cmd:$ududir"); |
return 1; |
return 1; |
Line 1314 sub du_handler {
|
Line 1396 sub du_handler {
|
# |
# |
if (-d $ududir) { |
if (-d $ududir) { |
# And as Shakespeare would say to make |
# And as Shakespeare would say to make |
# assurance double sure, quote the $ududir |
# assurance double sure, |
# This is in case someone manages to first |
# use execute_command to ensure that the command is not executed in |
# e.g. fabricate a valid directory with a ';' |
# a shell that can screw us up. |
# in it. Quoting the dir will help |
|
# keep $ududir completely interpreted as a |
my $duout = execute_command("du -ks $ududir"); |
# directory. |
|
# |
|
my $duout = `du -ks "$ududir" 2>/dev/null`; |
|
$duout=~s/[^\d]//g; #preserve only the numbers |
$duout=~s/[^\d]//g; #preserve only the numbers |
&Reply($client,"$duout\n","$cmd:$ududir"); |
&Reply($client,"$duout\n","$cmd:$ududir"); |
} else { |
} else { |
&Failure($client, "bad_directory:$ududir", $userinput); |
|
|
&Failure($client, "bad_directory:$ududir\n","$cmd:$ududir"); |
|
|
} |
} |
return 1; |
return 1; |
} |
} |
Line 1730 sub change_authentication_handler {
|
Line 1811 sub change_authentication_handler {
|
my $result=&make_passwd_file($uname, $umode,$npass,$passfilename); |
my $result=&make_passwd_file($uname, $umode,$npass,$passfilename); |
&Reply($client, $result, $userinput); |
&Reply($client, $result, $userinput); |
} else { |
} else { |
&Failure($client, "non_authorized", $userinput); # Fail the user now. |
&Failure($client, "non_authorized\n", $userinput); # Fail the user now. |
} |
} |
} |
} |
return 1; |
return 1; |
Line 1957 sub remove_user_file_handler {
|
Line 2038 sub remove_user_file_handler {
|
if (-e $udir) { |
if (-e $udir) { |
my $file=$udir.'/userfiles/'.$ufile; |
my $file=$udir.'/userfiles/'.$ufile; |
if (-e $file) { |
if (-e $file) { |
|
# |
|
# If the file is a regular file unlink is fine... |
|
# However it's possible the client wants a dir. |
|
# removed, in which case rmdir is more approprate: |
|
# |
if (-f $file){ |
if (-f $file){ |
unlink($file); |
unlink($file); |
} elsif(-d $file) { |
} elsif(-d $file) { |
rmdir($file); |
rmdir($file); |
} |
} |
if (-e $file) { |
if (-e $file) { |
|
# File is still there after we deleted it ?!? |
|
|
&Failure($client, "failed\n", "$cmd:$tail"); |
&Failure($client, "failed\n", "$cmd:$tail"); |
} else { |
} else { |
&Reply($client, "ok\n", "$cmd:$tail"); |
&Reply($client, "ok\n", "$cmd:$tail"); |
Line 2003 sub mkdir_user_file_handler {
|
Line 2091 sub mkdir_user_file_handler {
|
if (-e $udir) { |
if (-e $udir) { |
my $newdir=$udir.'/userfiles/'.$ufile; |
my $newdir=$udir.'/userfiles/'.$ufile; |
if (!-e $newdir) { |
if (!-e $newdir) { |
mkdir($newdir); |
my @parts=split('/',$newdir); |
|
my $path; |
|
foreach my $part (@parts) { |
|
$path .= '/'.$part; |
|
if (!-e $path) { |
|
mkdir($path,0770); |
|
} |
|
} |
if (!-e $newdir) { |
if (!-e $newdir) { |
&Failure($client, "failed\n", "$cmd:$tail"); |
&Failure($client, "failed\n", "$cmd:$tail"); |
} else { |
} else { |
Line 2081 sub token_auth_user_file_handler {
|
Line 2176 sub token_auth_user_file_handler {
|
my ($fname, $session) = split(/:/, $tail); |
my ($fname, $session) = split(/:/, $tail); |
|
|
chomp($session); |
chomp($session); |
my $reply='non_auth'; |
my $reply="non_auth\n"; |
if (open(ENVIN,$perlvar{'lonIDsDir'}.'/'. |
if (open(ENVIN,$perlvar{'lonIDsDir'}.'/'. |
$session.'.id')) { |
$session.'.id')) { |
while (my $line=<ENVIN>) { |
while (my $line=<ENVIN>) { |
if ($line=~ m|userfile\.\Q$fname\E\=|) { $reply='ok'; } |
if ($line=~ m|userfile\.\Q$fname\E\=|) { $reply="ok\n"; } |
} |
} |
close(ENVIN); |
close(ENVIN); |
&Reply($client, $reply); |
&Reply($client, $reply, "$cmd:$tail"); |
} else { |
} else { |
&Failure($client, "invalid_token\n", "$cmd:$tail"); |
&Failure($client, "invalid_token\n", "$cmd:$tail"); |
} |
} |
Line 2449 sub get_profile_entry {
|
Line 2544 sub get_profile_entry {
|
|
|
my ($udom,$uname,$namespace,$what) = split(/:/,$tail); |
my ($udom,$uname,$namespace,$what) = split(/:/,$tail); |
chomp($what); |
chomp($what); |
my $hashref = &tie_user_hash($udom, $uname, $namespace, |
|
&GDBM_READER()); |
my $replystring = read_profile($udom, $uname, $namespace, $what); |
if ($hashref) { |
my ($first) = split(/:/,$replystring); |
my @queries=split(/\&/,$what); |
if($first ne "error") { |
my $qresult=''; |
&Reply($client, "$replystring\n", $userinput); |
|
|
for (my $i=0;$i<=$#queries;$i++) { |
|
$qresult.="$hashref->{$queries[$i]}&"; # Presumably failure gives empty string. |
|
} |
|
$qresult=~s/\&$//; # Remove trailing & from last lookup. |
|
if (untie(%$hashref)) { |
|
&Reply($client, "$qresult\n", $userinput); |
|
} else { |
|
&Failure($client, "error: ".($!+0)." untie(GDBM) Failed ". |
|
"while attempting get\n", $userinput); |
|
} |
|
} else { |
} else { |
if ($!+0 == 2) { # +0 coerces errno -> number 2 is ENOENT |
&Failure($client, $replystring." while attempting get\n", $userinput); |
&Failure($client, "error:No such file or ". |
|
"GDBM reported bad block error\n", $userinput); |
|
} else { # Some other undifferentiated err. |
|
&Failure($client, "error: ".($!+0)." tie(GDBM) Failed ". |
|
"while attempting get\n", $userinput); |
|
} |
|
} |
} |
return 1; |
return 1; |
|
|
|
|
} |
} |
®ister_handler("get", \&get_profile_entry, 0,1,0); |
®ister_handler("get", \&get_profile_entry, 0,1,0); |
|
|
Line 2504 sub get_profile_entry_encrypted {
|
Line 2584 sub get_profile_entry_encrypted {
|
|
|
my ($cmd,$udom,$uname,$namespace,$what) = split(/:/,$userinput); |
my ($cmd,$udom,$uname,$namespace,$what) = split(/:/,$userinput); |
chomp($what); |
chomp($what); |
my $hashref = &tie_user_hash($udom, $uname, $namespace, |
my $qresult = read_profile($udom, $uname, $namespace, $what); |
&GDBM_READER()); |
my ($first) = split(/:/, $qresult); |
if ($hashref) { |
if($first ne "error") { |
my @queries=split(/\&/,$what); |
|
my $qresult=''; |
if ($cipher) { |
for (my $i=0;$i<=$#queries;$i++) { |
my $cmdlength=length($qresult); |
$qresult.="$hashref->{$queries[$i]}&"; |
$qresult.=" "; |
} |
my $encqresult=''; |
if (untie(%$hashref)) { |
for(my $encidx=0;$encidx<=$cmdlength;$encidx+=8) { |
$qresult=~s/\&$//; |
$encqresult.= unpack("H16", |
if ($cipher) { |
$cipher->encrypt(substr($qresult, |
my $cmdlength=length($qresult); |
$encidx, |
$qresult.=" "; |
8))); |
my $encqresult=''; |
|
for(my $encidx=0;$encidx<=$cmdlength;$encidx+=8) { |
|
$encqresult.= unpack("H16", |
|
$cipher->encrypt(substr($qresult, |
|
$encidx, |
|
8))); |
|
} |
|
&Reply( $client, "enc:$cmdlength:$encqresult\n", $userinput); |
|
} else { |
|
&Failure( $client, "error:no_key\n", $userinput); |
|
} |
} |
|
&Reply( $client, "enc:$cmdlength:$encqresult\n", $userinput); |
} else { |
} else { |
&Failure($client, "error: ".($!+0)." untie(GDBM) Failed ". |
&Failure( $client, "error:no_key\n", $userinput); |
"while attempting eget\n", $userinput); |
} |
} |
|
} else { |
} else { |
&Failure($client, "error: ".($!+0)." tie(GDBM) Failed ". |
&Failure($client, "$qresult while attempting eget\n", $userinput); |
"while attempting eget\n", $userinput); |
|
} |
} |
|
|
return 1; |
return 1; |
} |
} |
®ister_handler("eget", \&GetProfileEntryEncrypted, 0, 1, 0); |
®ister_handler("eget", \&get_profile_entry_encrypted, 0, 1, 0); |
# |
# |
# Deletes a key in a user profile database. |
# Deletes a key in a user profile database. |
# |
# |
Line 3087 sub put_course_id_handler {
|
Line 3157 sub put_course_id_handler {
|
my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT()); |
my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT()); |
if ($hashref) { |
if ($hashref) { |
foreach my $pair (@pairs) { |
foreach my $pair (@pairs) { |
my ($key,$value)=split(/=/,$pair); |
my ($key,$descr,$inst_code)=split(/=/,$pair); |
$hashref->{$key}=$value.':'.$now; |
$hashref->{$key}=$descr.':'.$inst_code.':'.$now; |
} |
} |
if (untie(%$hashref)) { |
if (untie(%$hashref)) { |
&Reply($client, "ok\n", $userinput); |
&Reply( $client, "ok\n", $userinput); |
} else { |
} else { |
&Failure( $client, "error: ".($!+0) |
&Failure($client, "error: ".($!+0) |
." untie(GDBM) Failed ". |
." untie(GDBM) Failed ". |
"while attempting courseidput\n", $userinput); |
"while attempting courseidput\n", $userinput); |
} |
} |
} else { |
} else { |
&Failure( $client, "error: ".($!+0) |
&Failure($client, "error: ".($!+0) |
." tie(GDBM) Failed ". |
." tie(GDBM) Failed ". |
"while attempting courseidput\n", $userinput); |
"while attempting courseidput\n", $userinput); |
} |
} |
|
|
|
|
return 1; |
return 1; |
} |
} |
Line 3799 sub process_request {
|
Line 3870 sub process_request {
|
$userinput = decipher($userinput); |
$userinput = decipher($userinput); |
$wasenc=1; |
$wasenc=1; |
if(!$userinput) { # Cipher not defined. |
if(!$userinput) { # Cipher not defined. |
&Failure($client, "error: Encrypted data without negotated key"); |
&Failure($client, "error: Encrypted data without negotated key\n"); |
return 0; |
return 0; |
} |
} |
} |
} |