version 1.266, 2004/11/27 17:23:08
|
version 1.276, 2005/01/26 12:13:58
|
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 1797 sub change_authentication_handler {
|
Line 1799 sub change_authentication_handler {
|
# to take ownership of the construction space back to www:www |
# to take ownership of the construction space back to www:www |
# |
# |
|
|
if( ($oldauth =~ /^unix/) && ($umode eq "internal")) { # unix -> internal |
if( (($oldauth =~ /^unix/) && ($umode eq "internal")) || |
|
(($oldauth =~ /^internal/) && ($umode eq "unix")) ) { |
if(&is_author($udom, $uname)) { |
if(&is_author($udom, $uname)) { |
&Debug(" Need to manage author permissions..."); |
&Debug(" Need to manage author permissions..."); |
&manage_permissions("/$udom/_au", $udom, $uname, "internal:"); |
&manage_permissions("/$udom/_au", $udom, $uname, "$umode:"); |
} |
} |
} |
} |
|
|
Line 1960 sub fetch_user_file_handler {
|
Line 1963 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 2838 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 3109 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 3127 sub put_course_id_handler {
|
Line 3138 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,$courseinfo) = split(/=/,$pair); |
my ($key,$courseinfo) = split(/=/,$pair,2); |
|
$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; |
$hashref->{$key}=$courseinfo.':'.$now; |
} |
} |
if (untie(%$hashref)) { |
if (untie(%$hashref)) { |
Line 3166 sub put_course_id_handler {
|
Line 3193 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 3199 sub dump_course_id_handler {
|
Line 3235 sub dump_course_id_handler {
|
if ($hashref) { |
if ($hashref) { |
while (my ($key,$value) = each(%$hashref)) { |
while (my ($key,$value) = each(%$hashref)) { |
my ($descr,$lasttime,$inst_code,$owner); |
my ($descr,$lasttime,$inst_code,$owner); |
if ($value =~ m/^([^\:]*):([^\:]*):([^\:]*):(\d+)$/) { |
my @courseitems = split(/:/,$value); |
($descr,$inst_code,$owner,$lasttime)=($1,$2,$3,$4); |
$lasttime = pop(@courseitems); |
} elsif ($value =~ m/^([^\:]*):([^\:]*):(\d+)$/) { |
($descr,$inst_code,$owner)=@courseitems; |
($descr,$inst_code,$lasttime)=($1,$2,$3); |
|
} else { |
|
($descr,$lasttime) = split(/\:/,$value); |
|
} |
|
if ($lasttime<$since) { next; } |
if ($lasttime<$since) { next; } |
my $match = 1; |
my $match = 1; |
unless ($description eq '.') { |
unless ($description eq '.') { |
Line 4435 sub logstatus {
|
Line 4467 sub logstatus {
|
flock(LOG,LOCK_EX); |
flock(LOG,LOCK_EX); |
print LOG $$."\t".$clientname."\t".$currenthostid."\t" |
print LOG $$."\t".$clientname."\t".$currenthostid."\t" |
.$status."\t".$lastlog."\t $keymode\n"; |
.$status."\t".$lastlog."\t $keymode\n"; |
flock(DB,LOCK_UN); |
flock(LOG,LOCK_UN); |
close(LOG); |
close(LOG); |
} |
} |
&status("Finished logging"); |
&status("Finished logging"); |
Line 5104 sub validate_user {
|
Line 5136 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); |