--- loncom/lond 2009/10/29 03:23:52 1.432 +++ loncom/lond 2010/06/25 04:37:44 1.445 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.432 2009/10/29 03:23:52 raeburn Exp $ +# $Id: lond,v 1.445 2010/06/25 04:37:44 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -42,7 +42,6 @@ use Crypt::IDEA; use LWP::UserAgent(); use Digest::MD5 qw(md5_hex); use GDBM_File; -use Authen::Krb4; use Authen::Krb5; use localauth; use localenroll; @@ -59,7 +58,7 @@ my $DEBUG = 0; # Non zero to ena my $status=''; my $lastlog=''; -my $VERSION='$Revision: 1.432 $'; #' stupid emacs +my $VERSION='$Revision: 1.445 $'; #' stupid emacs my $remoteVERSION; my $currenthostid="default"; my $currentdomainid; @@ -976,6 +975,9 @@ sub read_profile { &GDBM_READER()); if ($hashref) { my @queries=split(/\&/,$what); + if ($namespace eq 'roles') { + @queries = map { &unescape($_); } @queries; + } my $qresult=''; for (my $i=0;$i<=$#queries;$i++) { @@ -2062,16 +2064,10 @@ sub is_home_handler { ®ister_handler("home", \&is_home_handler, 0,1,0); # -# Process an update request for a resource?? I think what's going on here is -# that a resource has been modified that we hold a subscription to. +# Process an update request for a resource. +# A resource has been modified that we hold a subscription to. # If the resource is not local, then we must update, or at least invalidate our # cached copy of the resource. -# FUTURE WORK: -# I need to look at this logic carefully. My druthers would be to follow -# typical caching logic, and simple invalidate the cache, drop any subscription -# an let the next fetch start the ball rolling again... however that may -# actually be more difficult than it looks given the complex web of -# proxy servers. # Parameters: # $cmd - The command that got us here. # $tail - Tail of the command (remaining parameters). @@ -2095,16 +2091,23 @@ sub update_resource_handler { my $ownership=ishome($fname); if ($ownership eq 'not_owner') { if (-e $fname) { + # Delete preview file, if exists + unlink("$fname.tmp"); + # Get usage stats my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size, $atime,$mtime,$ctime,$blksize,$blocks)=stat($fname); my $now=time; my $since=$now-$atime; + # If the file has not been used within lonExpire seconds, + # unsubscribe from it and delete local copy if ($since>$perlvar{'lonExpire'}) { my $reply=&Apache::lonnet::reply("unsub:$fname","$clientname"); &devalidate_meta_cache($fname); unlink("$fname"); unlink("$fname.meta"); } else { + # Yes, this is in active use. Get a fresh copy. Since it might be in + # very active use and huge (like a movie), copy it to "in.transfer" filename first. my $transname="$fname.in.transfer"; my $remoteurl=&Apache::lonnet::reply("sub:$fname","$clientname"); my $response; @@ -2132,6 +2135,7 @@ sub update_resource_handler { } alarm(0); } + # we successfully transfered, copy file over to real name rename($transname,$fname); &devalidate_meta_cache($fname); } @@ -3123,9 +3127,11 @@ sub dump_with_regexp { my $count=0; while (my ($key,$value) = each(%$hashref)) { if ($namespace eq 'roles') { - if ($key =~ /^($LONCAPA::match_domain)_($LONCAPA::match_community)_cc$/) { - if ($clientversion =~ /^(\d+\.\d+)$/) { - next if ($1 <= 2.9); + if ($key =~ /^($LONCAPA::match_domain)_($LONCAPA::match_community)_(cc|co|in|ta|ep|ad|st|cr)/) { + if ($clientversion =~ /^(\d+)\.(\d+)$/) { + my $major = $1; + my $minor = $2; + next if (($major < 2) || (($major == 2) && ($minor < 9))); } } } @@ -3722,6 +3728,9 @@ sub put_course_id_hash_handler { # createdafter - include courses for which creation date followed this date. # creationcontext - include courses created in specified context # +# domcloner - flag to indicate if user can create CCs in course's domain. +# If so, ability to clone course is automatic. +# # $client - The socket open on the client. # Returns: # 1 - Continue processing. @@ -3734,7 +3743,7 @@ sub dump_course_id_handler { my ($udom,$since,$description,$instcodefilter,$ownerfilter,$coursefilter, $typefilter,$regexp_ok,$rtn_as_hash,$selfenrollonly,$catfilter,$showhidden, $caller,$cloner,$cc_clone_list,$cloneonly,$createdbefore,$createdafter, - $creationcontext) =split(/:/,$tail); + $creationcontext,$domcloner) =split(/:/,$tail); my $now = time; my ($cloneruname,$clonerudom,%cc_clone); if (defined($description)) { @@ -3807,7 +3816,6 @@ sub dump_course_id_handler { } else { $creationcontext = '.'; } - my $unpack = 1; if ($description eq '.' && $instcodefilter eq '.' && $coursefilter eq '.' && $typefilter eq '.') { @@ -3838,7 +3846,9 @@ sub dump_course_id_handler { next if ($since > 1); } $is_hash = 1; - if (defined($clonerudom)) { + if ($domcloner) { + $canclone = 1; + } elsif (defined($clonerudom)) { if ($items->{'cloners'}) { my @cloneable = split(',',$items->{'cloners'}); if (@cloneable) { @@ -3866,6 +3876,19 @@ sub dump_course_id_handler { $items->{'cloners'} = $cloneruname.':'.$clonerudom; $valchange = 1; } + unless ($canclone) { + if ($items->{'owner'} =~ /:/) { + if ($items->{'owner'} eq $cloner) { + $canclone = 1; + } + } elsif ($cloner eq $items->{'owner'}.':'.$udom) { + $canclone = 1; + } + if ($canclone) { + $items->{'cloners'} = $cloneruname.':'.$clonerudom; + $valchange = 1; + } + } } } if ($unpack || !$rtn_as_hash) { @@ -4066,6 +4089,53 @@ sub dump_course_id_handler { } ®ister_handler("courseiddump", \&dump_course_id_handler, 0, 1, 0); +sub course_lastaccess_handler { + my ($cmd, $tail, $client) = @_; + my $userinput = "$cmd:$tail"; + my ($cdom,$cnum) = split(':',$tail); + my (%lastaccess,$qresult); + my $hashref = &tie_domain_hash($cdom, "nohist_courseids", &GDBM_WRCREAT()); + if ($hashref) { + while (my ($key,$value) = each(%$hashref)) { + my ($unesc_key,$lasttime); + $unesc_key = &unescape($key); + if ($cnum) { + next unless ($unesc_key =~ /\Q$cdom\E_\Q$cnum\E$/); + } + if ($unesc_key =~ /^lasttime:($LONCAPA::match_domain\_$LONCAPA::match_courseid)/) { + $lastaccess{$1} = $value; + } else { + my $items = &Apache::lonnet::thaw_unescape($value); + if (ref($items) eq 'HASH') { + unless ($lastaccess{$unesc_key}) { + $lastaccess{$unesc_key} = ''; + } + } else { + my @courseitems = split(':',$value); + $lastaccess{$unesc_key} = pop(@courseitems); + } + } + } + foreach my $cid (sort(keys(%lastaccess))) { + $qresult.=&escape($cid).'='.$lastaccess{$cid}.'&'; + } + if (&untie_domain_hash($hashref)) { + if ($qresult) { + chop($qresult); + } + &Reply($client, \$qresult, $userinput); + } else { + &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ". + "while attempting lastacourseaccess\n", $userinput); + } + } else { + &Failure($client, "error: ".($!+0)." tie(GDBM) Failed ". + "while attempting lastcourseaccess\n", $userinput); + } + return 1; +} +®ister_handler("courselastaccess",\&course_lastaccess_handler, 0, 1, 0); + # # Puts an unencrypted entry in a namespace db file at the domain level # @@ -6327,7 +6397,7 @@ sub make_new_child { my $cipherkey = pack("H32", $key); $cipher = new IDEA($cipherkey); print $client "ok:local\n"; - &logthis('' . "Successful local authentication "); $keymode = "local" } else { @@ -6549,9 +6619,7 @@ sub rewrite_password_file { # Returns the authorization type or nouser if there is no such user. # -sub get_auth_type -{ - +sub get_auth_type { my ($domain, $user) = @_; Debug("get_auth_type( $domain, $user ) \n"); @@ -6646,54 +6714,24 @@ sub validate_user { } else { $validated = 0; } - } - elsif ($howpwd eq "krb4") { # user is in kerberos 4 auth. domain. - if(! ($password =~ /$null/) ) { - my $k4error = &Authen::Krb4::get_pw_in_tkt($user, - "", - $contentpwd,, - 'krbtgt', - $contentpwd, - 1, - $password); - if(!$k4error) { - $validated = 1; - } else { - $validated = 0; - &logthis('krb4: '.$user.', '.$contentpwd.', '. - &Authen::Krb4::get_err_txt($Authen::Krb4::error)); - } - } else { - $validated = 0; # Password has a match with null. - } + } elsif ($howpwd eq "krb4") { # user is in kerberos 4 auth. domain. + my $checkwithkrb5 = 0; + if ($dist =~/^fedora(\d+)$/) { + if ($1 > 11) { + $checkwithkrb5 = 1; + } + } elsif ($dist =~ /^suse([\d.]+)$/) { + if ($1 > 11.1) { + $checkwithkrb5 = 1; + } + } + if ($checkwithkrb5) { + $validated = &krb5_authen($password,$null,$user,$contentpwd); + } else { + $validated = &krb4_authen($password,$null,$user,$contentpwd); + } } elsif ($howpwd eq "krb5") { # User is in kerberos 5 auth. domain. - if(!($password =~ /$null/)) { # Null password not allowed. - my $krbclient = &Authen::Krb5::parse_name($user.'@' - .$contentpwd); - my $krbservice = "krbtgt/".$contentpwd."\@".$contentpwd; - my $krbserver = &Authen::Krb5::parse_name($krbservice); - my $credentials= &Authen::Krb5::cc_default(); - $credentials->initialize(&Authen::Krb5::parse_name($user.'@' - .$contentpwd)); - my $krbreturn; - if (exists(&Authen::Krb5::get_init_creds_password)) { - $krbreturn = - &Authen::Krb5::get_init_creds_password($krbclient,$password, - $krbservice); - $validated = (ref($krbreturn) eq 'Authen::Krb5::Creds'); - } else { - $krbreturn = - &Authen::Krb5::get_in_tkt_with_password($krbclient,$krbserver, - $password,$credentials); - $validated = ($krbreturn == 1); - } - if (!$validated) { - &logthis('krb5: '.$user.', '.$contentpwd.', '. - &Authen::Krb5::error()); - } - } else { - $validated = 0; - } + $validated = &krb5_authen($password,$null,$user,$contentpwd); } elsif ($howpwd eq "localauth") { # Authenticate via installation specific authentcation method: $validated = &localauth::localauth($user, @@ -6724,6 +6762,65 @@ sub validate_user { return $validated; } +sub krb4_authen { + my ($password,$null,$user,$contentpwd) = @_; + my $validated = 0; + if (!($password =~ /$null/) ) { # Null password not allowed. + eval { + require Authen::Krb4; + }; + if (!$@) { + my $k4error = &Authen::Krb4::get_pw_in_tkt($user, + "", + $contentpwd,, + 'krbtgt', + $contentpwd, + 1, + $password); + if(!$k4error) { + $validated = 1; + } else { + $validated = 0; + &logthis('krb4: '.$user.', '.$contentpwd.', '. + &Authen::Krb4::get_err_txt($Authen::Krb4::error)); + } + } else { + $validated = krb5_authen($password,$null,$user,$contentpwd); + } + } + return $validated; +} + +sub krb5_authen { + my ($password,$null,$user,$contentpwd) = @_; + my $validated = 0; + if(!($password =~ /$null/)) { # Null password not allowed. + my $krbclient = &Authen::Krb5::parse_name($user.'@' + .$contentpwd); + my $krbservice = "krbtgt/".$contentpwd."\@".$contentpwd; + my $krbserver = &Authen::Krb5::parse_name($krbservice); + my $credentials= &Authen::Krb5::cc_default(); + $credentials->initialize(&Authen::Krb5::parse_name($user.'@' + .$contentpwd)); + my $krbreturn; + if (exists(&Authen::Krb5::get_init_creds_password)) { + $krbreturn = + &Authen::Krb5::get_init_creds_password($krbclient,$password, + $krbservice); + $validated = (ref($krbreturn) eq 'Authen::Krb5::Creds'); + } else { + $krbreturn = + &Authen::Krb5::get_in_tkt_with_password($krbclient,$krbserver, + $password,$credentials); + $validated = ($krbreturn == 1); + } + if (!$validated) { + &logthis('krb5: '.$user.', '.$contentpwd.', '. + &Authen::Krb5::error()); + } + } + return $validated; +} sub addline { my ($fname,$hostid,$ip,$newline)=@_; @@ -7094,7 +7191,7 @@ sub sethost { eq &Apache::lonnet::get_host_ip($hostid)) { $currenthostid =$hostid; $currentdomainid=&Apache::lonnet::host_domain($hostid); - &logthis("Setting hostid to $hostid, and domain to $currentdomainid"); +# &logthis("Setting hostid to $hostid, and domain to $currentdomainid"); } else { &logthis("Requested host id $hostid not an alias of ". $perlvar{'lonHostID'}." refusing connection"); @@ -7844,5 +7941,7 @@ string. =back +=back + =cut