--- loncom/lond 2010/02/21 02:02:51 1.437 +++ loncom/lond 2010/07/17 19:14:35 1.446 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.437 2010/02/21 02:02:51 raeburn Exp $ +# $Id: lond,v 1.446 2010/07/17 19:14:35 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.437 $'; #' stupid emacs +my $VERSION='$Revision: 1.446 $'; #' 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++) { @@ -3125,11 +3127,16 @@ 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|co|in|ta|ep|ad|st|cr)/) { - if ($clientversion =~ /^(\d+)\.(\d+)$/) { + if ($key =~ m{^/($LONCAPA::match_domain)/($LONCAPA::match_community)_(cc|co|in|ta|ep|ad|st|cr)}) { + my $cdom = $1; + my $cnum = $2; + if ($clientversion =~ /^['"]?(\d+)\.(\d+)[.\d\-]+['"]?$/) { my $major = $1; my $minor = $2; next if (($major < 2) || (($major == 2) && ($minor < 9))); + } else { + my $homeserver = &Apache::lonnet::homeserver($cnum,$cdom); + next unless ($currenthostid eq $homeserver); } } } @@ -3726,6 +3733,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. @@ -3738,7 +3748,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)) { @@ -3811,7 +3821,6 @@ sub dump_course_id_handler { } else { $creationcontext = '.'; } - my $unpack = 1; if ($description eq '.' && $instcodefilter eq '.' && $coursefilter eq '.' && $typefilter eq '.') { @@ -3842,7 +3851,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) { @@ -3875,7 +3886,7 @@ sub dump_course_id_handler { if ($items->{'owner'} eq $cloner) { $canclone = 1; } - } elsif ($cloner eq $udom.':'.$items->{'owner'}) { + } elsif ($cloner eq $items->{'owner'}.':'.$udom) { $canclone = 1; } if ($canclone) { @@ -4083,6 +4094,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 # @@ -6344,7 +6402,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 { @@ -6661,54 +6719,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, @@ -6739,6 +6767,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)=@_; @@ -7109,7 +7196,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"); @@ -7859,5 +7946,7 @@ string. =back +=back + =cut