version 1.252, 2004/09/08 18:57:33
|
version 1.259, 2004/09/24 14:15:03
|
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 1994 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 2040 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 2486 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 2541 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 3124 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 5006 sub get_auth_type
|
Line 5040 sub get_auth_type
|
Debug("Password info = $realpassword\n"); |
Debug("Password info = $realpassword\n"); |
my ($authtype, $contentpwd) = split(/:/, $realpassword); |
my ($authtype, $contentpwd) = split(/:/, $realpassword); |
Debug("Authtype = $authtype, content = $contentpwd\n"); |
Debug("Authtype = $authtype, content = $contentpwd\n"); |
my $availinfo = ''; |
return "$authtype:$contentpwd"; |
if($authtype eq 'krb4' or $authtype eq 'krb5') { |
|
$availinfo = $contentpwd; |
|
} |
|
|
|
return "$authtype:$availinfo"; |
|
} else { |
} else { |
Debug("Returning nouser"); |
Debug("Returning nouser"); |
return "nouser"; |
return "nouser"; |