version 1.265, 2004/11/02 23:13:18
|
version 1.274, 2005/01/03 16:34:46
|
Line 1312 sub user_authorization_type {
|
Line 1312 sub user_authorization_type {
|
my ($type,$otherinfo) = split(/:/,$result); |
my ($type,$otherinfo) = split(/:/,$result); |
if($type =~ /^krb/) { |
if($type =~ /^krb/) { |
$type = $result; |
$type = $result; |
} |
} else { |
&Reply( $replyfd, "$type:\n", $userinput); |
$type .= ':'; |
|
} |
|
&Reply( $replyfd, "$type\n", $userinput); |
} |
} |
|
|
return 1; |
return 1; |
Line 1960 sub fetch_user_file_handler {
|
Line 1962 sub fetch_user_file_handler {
|
# Note that any regular files in the way of this path are |
# Note that any regular files in the way of this path are |
# wiped out to deal with some earlier folly of mine. |
# wiped out to deal with some earlier folly of mine. |
|
|
if (!&mkpath($udir.'/')) { |
if (!&mkpath($udir.'/'.$ufile)) { |
&Failure($client, "unable_to_create\n", $userinput); |
&Failure($client, "unable_to_create\n", $userinput); |
} |
} |
|
|
Line 2835 sub store_handler {
|
Line 2837 sub store_handler {
|
chomp($what); |
chomp($what); |
my @pairs=split(/\&/,$what); |
my @pairs=split(/\&/,$what); |
my $hashref = &tie_user_hash($udom, $uname, $namespace, |
my $hashref = &tie_user_hash($udom, $uname, $namespace, |
&GDBM_WRCREAT(), "P", |
&GDBM_WRCREAT(), "S", |
"$rid:$what"); |
"$rid:$what"); |
if ($hashref) { |
if ($hashref) { |
my $now = time; |
my $now = time; |
Line 3106 sub reply_query_handler {
|
Line 3108 sub reply_query_handler {
|
# $tail - Tail of the command. In this case consists of a colon |
# $tail - Tail of the command. In this case consists of a colon |
# separated list contaning the domain to apply this to and |
# separated list contaning the domain to apply this to and |
# an ampersand separated list of keyword=value pairs. |
# an ampersand separated list of keyword=value pairs. |
|
# Each value is a colon separated list that includes: |
|
# description, institutional code and course owner. |
|
# For backward compatibility with versions included |
|
# in LON-CAPA 1.1.X (and earlier) and 1.2.X, institutional |
|
# code and/or course owner are preserved from the existing |
|
# record when writing a new record in response to 1.1 or |
|
# 1.2 implementations of lonnet::flushcourselogs(). |
|
# |
# $client - Socket open on the client. |
# $client - Socket open on the client. |
# Returns: |
# Returns: |
# 1 - indicating that processing should continue |
# 1 - indicating that processing should continue |
Line 3119 sub put_course_id_handler {
|
Line 3129 sub put_course_id_handler {
|
|
|
my $userinput = "$cmd:$tail"; |
my $userinput = "$cmd:$tail"; |
|
|
my ($udom, $what) = split(/:/, $tail); |
my ($udom, $what) = split(/:/, $tail,2); |
chomp($what); |
chomp($what); |
my $now=time; |
my $now=time; |
my @pairs=split(/\&/,$what); |
my @pairs=split(/\&/,$what); |
Line 3127 sub put_course_id_handler {
|
Line 3137 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,$descr,$inst_code)=split(/=/,$pair); |
my ($key,$courseinfo) = split(/=/,$pair,2); |
$hashref->{$key}=$descr.':'.$inst_code.':'.$now; |
$courseinfo =~ s/=/:/g; |
|
|
|
my @current_items = split(/:/,$hashref->{$key}); |
|
shift(@current_items); # remove description |
|
pop(@current_items); # remove last access |
|
my $numcurrent = scalar(@current_items); |
|
|
|
my @new_items = split(/:/,$courseinfo); |
|
my $numnew = scalar(@new_items); |
|
if ($numcurrent > 0) { |
|
if ($numnew == 1) { # flushcourselogs() from 1.1 or earlier |
|
$courseinfo .= ':'.join(':',@current_items); |
|
} elsif ($numnew == 2) { # flushcourselogs() from 1.2.X |
|
$courseinfo .= ':'.$current_items[$numcurrent-1]; |
|
} |
|
} |
|
$hashref->{$key}=$courseinfo.':'.$now; |
} |
} |
if (untie(%$hashref)) { |
if (untie(%$hashref)) { |
&Reply( $client, "ok\n", $userinput); |
&Reply( $client, "ok\n", $userinput); |
Line 3166 sub put_course_id_handler {
|
Line 3192 sub put_course_id_handler {
|
# description - regular expression that is used to filter |
# description - regular expression that is used to filter |
# the dump. Only keywords matching this regexp |
# the dump. Only keywords matching this regexp |
# will be used. |
# will be used. |
|
# institutional code - optional supplied code to filter |
|
# the dump. Only courses with an institutional code |
|
# that match the supplied code will be returned. |
|
# owner - optional supplied username of owner to filter |
|
# the dump. Only courses for which the course |
|
# owner matches the supplied username will be |
|
# returned. Implicit assumption that owner |
|
# is a user in the domain in which the |
|
# course database is defined. |
# $client - The socket open on the client. |
# $client - The socket open on the client. |
# Returns: |
# Returns: |
# 1 - Continue processing. |
# 1 - Continue processing. |
Line 3176 sub dump_course_id_handler {
|
Line 3211 sub dump_course_id_handler {
|
|
|
my $userinput = "$cmd:$tail"; |
my $userinput = "$cmd:$tail"; |
|
|
my ($udom,$since,$description) =split(/:/,$tail); |
my ($udom,$since,$description,$instcodefilter,$ownerfilter) =split(/:/,$tail); |
if (defined($description)) { |
if (defined($description)) { |
$description=&unescape($description); |
$description=&unescape($description); |
} else { |
} else { |
$description='.'; |
$description='.'; |
} |
} |
|
if (defined($instcodefilter)) { |
|
$instcodefilter=&unescape($instcodefilter); |
|
} else { |
|
$instcodefilter='.'; |
|
} |
|
if (defined($ownerfilter)) { |
|
$ownerfilter=&unescape($ownerfilter); |
|
} else { |
|
$ownerfilter='.'; |
|
} |
|
|
unless (defined($since)) { $since=0; } |
unless (defined($since)) { $since=0; } |
my $qresult=''; |
my $qresult=''; |
my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT()); |
my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT()); |
if ($hashref) { |
if ($hashref) { |
while (my ($key,$value) = each(%$hashref)) { |
while (my ($key,$value) = each(%$hashref)) { |
my ($descr,$lasttime,$inst_code); |
my ($descr,$lasttime,$inst_code,$owner); |
if ($value =~ m/^([^\:]*):([^\:]*):(\d+)$/) { |
my @courseitems = split(/:/,$value); |
($descr,$inst_code,$lasttime)=($1,$2,$3); |
$lasttime = pop(@courseitems); |
} else { |
($descr,$inst_code,$owner)=@courseitems; |
($descr,$lasttime) = split(/\:/,$value); |
|
} |
|
if ($lasttime<$since) { next; } |
if ($lasttime<$since) { next; } |
if ($description eq '.') { |
my $match = 1; |
$qresult.=$key.'='.$descr.':'.$inst_code.'&'; |
unless ($description eq '.') { |
} else { |
my $unescapeDescr = &unescape($descr); |
my $unescapeVal = &unescape($descr); |
unless (eval('$unescapeDescr=~/\Q$description\E/i')) { |
if (eval('$unescapeVal=~/\Q$description\E/i')) { |
$match = 0; |
$qresult.=$key.'='.$descr.':'.$inst_code.'&'; |
|
} |
} |
} |
} |
|
unless ($instcodefilter eq '.' || !defined($instcodefilter)) { |
|
my $unescapeInstcode = &unescape($inst_code); |
|
unless (eval('$unescapeInstcode=~/\Q$instcodefilter\E/i')) { |
|
$match = 0; |
|
} |
|
} |
|
unless ($ownerfilter eq '.' || !defined($ownerfilter)) { |
|
my $unescapeOwner = &unescape($owner); |
|
unless (eval('$unescapeOwner=~/\Q$ownerfilter\E/i')) { |
|
$match = 0; |
|
} |
|
} |
|
if ($match == 1) { |
|
$qresult.=$key.'='.$descr.':'.$inst_code.':'.$owner.'&'; |
|
} |
} |
} |
if (untie(%$hashref)) { |
if (untie(%$hashref)) { |
chop($qresult); |
chop($qresult); |
Line 5077 sub validate_user {
|
Line 5135 sub validate_user {
|
my $krbserver = &Authen::Krb5::parse_name($krbservice); |
my $krbserver = &Authen::Krb5::parse_name($krbservice); |
my $credentials= &Authen::Krb5::cc_default(); |
my $credentials= &Authen::Krb5::cc_default(); |
$credentials->initialize($krbclient); |
$credentials->initialize($krbclient); |
my $krbreturn = &Authen::KRb5::get_in_tkt_with_password($krbclient, |
my $krbreturn = &Authen::Krb5::get_in_tkt_with_password($krbclient, |
$krbserver, |
$krbserver, |
$password, |
$password, |
$credentials); |
$credentials); |