version 1.254, 2004/09/14 10:27:22
|
version 1.258, 2004/09/14 20:18:41
|
Line 1065 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 2047 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 2493 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 2548 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 3799 sub get_institutional_code_format_handle
|
Line 3825 sub get_institutional_code_format_handle
|
0,1,0); |
0,1,0); |
|
|
# |
# |
# Portofolio directory list: |
|
# |
|
# Parameters: |
|
# cmd - Command request that got us called. |
|
# tail - the remainder of the command line. In this case this is a colon |
|
# separated list containing the username and domain. |
|
# used to locate their portfolio. |
|
# client - Socket openon the client. |
|
# Returns: |
|
# 1 indicating processing should continue. |
|
# |
|
sub list_portfolio { |
|
my ($cmd, $tail, $client) = @_; |
|
my ($uname, $udom) = split(/:/, $tail); |
|
my $userinput = "$cmd:$tail"; |
|
|
|
my $udir=propath($udom,$uname).'/userfiles/portfolio'; |
|
my $dirLine=''; |
|
my $dirContents=''; |
|
if (opendir(LSDIR,$udir.'/')){ |
|
while ($dirLine = readdir(LSDIR)){ |
|
$dirContents = $dirContents.$dirLine.'<br />'; |
|
} |
|
} else { |
|
$dirContents = "No directory found\n"; |
|
} |
|
&Reply( $client, $dirContents."\n", $userinput); |
|
|
|
|
|
|
|
return 1; |
|
} |
|
®ister_handler("portls", \&list_portfolio, 0,1,0); |
|
|
|
# |
|
# |
# |
# |
# |
# |
# |