--- loncom/lond 2009/09/13 03:13:21 1.426 +++ loncom/lond 2009/10/29 03:23:52 1.432 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.426 2009/09/13 03:13:21 raeburn Exp $ +# $Id: lond,v 1.432 2009/10/29 03:23:52 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -59,7 +59,7 @@ my $DEBUG = 0; # Non zero to ena my $status=''; my $lastlog=''; -my $VERSION='$Revision: 1.426 $'; #' stupid emacs +my $VERSION='$Revision: 1.432 $'; #' stupid emacs my $remoteVERSION; my $currenthostid="default"; my $currentdomainid; @@ -67,6 +67,7 @@ my $currentdomainid; my $client; my $clientip; # IP address of client. my $clientname; # LonCAPA name of client. +my $clientversion; # LonCAPA version running on client my $server; @@ -1815,8 +1816,9 @@ sub change_password_handler { # npass - New password. # context - Context in which this was called # (preferences or reset_by_email). + # lonhost - HostID of server where request originated - my ($udom,$uname,$upass,$npass,$context)=split(/:/,$tail); + my ($udom,$uname,$upass,$npass,$context,$lonhost)=split(/:/,$tail); $upass=&unescape($upass); $npass=&unescape($npass); @@ -1825,9 +1827,13 @@ sub change_password_handler { # First require that the user can be authenticated with their # old password unless context was 'reset_by_email': - my $validated; + my ($validated,$failure); if ($context eq 'reset_by_email') { - $validated = 1; + if ($lonhost eq '') { + $failure = 'invalid_client'; + } else { + $validated = 1; + } } else { $validated = &validate_user($udom, $uname, $upass); } @@ -1841,8 +1847,11 @@ sub change_password_handler { $salt=substr($salt,6,2); my $ncpass=crypt($npass,$salt); if(&rewrite_password_file($udom, $uname, "internal:$ncpass")) { - &logthis("Result of password change for " - ."$uname: pwchange_success"); + my $msg="Result of password change for $uname: pwchange_success"; + if ($lonhost) { + $msg .= " - request originated from: $lonhost"; + } + &logthis($msg); &Reply($client, "ok\n", $userinput); } else { &logthis("Unable to open $uname passwd " @@ -1863,7 +1872,10 @@ sub change_password_handler { } } else { - &Failure( $client, "non_authorized\n", $userinput); + if ($failure eq '') { + $failure = 'non_authorized'; + } + &Failure( $client, "$failure\n", $userinput); } return 1; @@ -3110,6 +3122,13 @@ sub dump_with_regexp { my $qresult=''; 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 ($regexp eq '.') { $count++; if (defined($range) && $count >= $end) { last; } @@ -3693,12 +3712,15 @@ sub put_course_id_hash_handler { # caller - if set to 'coursecatalog', courses set to be hidden # from course catalog will be excluded from results (unless # overridden by "showhidden". -# cloner - escaped username:domain of course cloner (if picking course to# +# cloner - escaped username:domain of course cloner (if picking course to # clone). # cc_clone_list - escaped comma separated list of courses for which # course cloner has active CC role (and so can clone # automatically). -# cloneonly - filter by courses for which cloner has rights to clone. +# cloneonly - filter by courses for which cloner has rights to clone. +# createdbefore - include courses for which creation date preceeded this date. +# createdafter - include courses for which creation date followed this date. +# creationcontext - include courses created in specified context # # $client - The socket open on the client. # Returns: @@ -3711,7 +3733,8 @@ 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) =split(/:/,$tail); + $caller,$cloner,$cc_clone_list,$cloneonly,$createdbefore,$createdafter, + $creationcontext) =split(/:/,$tail); my $now = time; my ($cloneruname,$clonerudom,%cc_clone); if (defined($description)) { @@ -3769,6 +3792,21 @@ sub dump_course_id_handler { $cc_clone{$clonedom.'_'.$clonenum} = 1; } } + if ($createdbefore ne '') { + $createdbefore = &unescape($createdbefore); + } else { + $createdbefore = 0; + } + if ($createdafter ne '') { + $createdafter = &unescape($createdafter); + } else { + $createdafter = 0; + } + if ($creationcontext ne '') { + $creationcontext = &unescape($creationcontext); + } else { + $creationcontext = '.'; + } my $unpack = 1; if ($description eq '.' && $instcodefilter eq '.' && $coursefilter eq '.' && @@ -3781,7 +3819,8 @@ sub dump_course_id_handler { if ($hashref) { while (my ($key,$value) = each(%$hashref)) { my ($unesc_key,$lasttime_key,$lasttime,$is_hash,%val, - %unesc_val,$selfenroll_end,$selfenroll_types); + %unesc_val,$selfenroll_end,$selfenroll_types,$created, + $context); $unesc_key = &unescape($key); if ($unesc_key =~ /^lasttime:/) { next; @@ -3795,6 +3834,9 @@ sub dump_course_id_handler { my ($canclone,$valchange); my $items = &Apache::lonnet::thaw_unescape($value); if (ref($items) eq 'HASH') { + if ($hashref->{$lasttime_key} eq '') { + next if ($since > 1); + } $is_hash = 1; if (defined($clonerudom)) { if ($items->{'cloners'}) { @@ -3832,15 +3874,28 @@ sub dump_course_id_handler { $unesc_val{'owner'} = $items->{'owner'}; $unesc_val{'type'} = $items->{'type'}; $unesc_val{'cloners'} = $items->{'cloners'}; + $unesc_val{'created'} = $items->{'created'}; + $unesc_val{'context'} = $items->{'context'}; } $selfenroll_types = $items->{'selfenroll_types'}; $selfenroll_end = $items->{'selfenroll_end_date'}; + $created = $items->{'created'}; + $context = $items->{'context'}; if ($selfenrollonly) { next if (!$selfenroll_types); if (($selfenroll_end > 0) && ($selfenroll_end <= $now)) { next; } } + if ($creationcontext ne '.') { + next if (($context ne '') && ($context ne $creationcontext)); + } + if ($createdbefore > 0) { + next if (($created eq '') || ($created > $createdbefore)); + } + if ($createdafter > 0) { + next if (($created eq '') || ($created <= $createdafter)); + } if ($catfilter ne '') { next if ($items->{'categories'} eq ''); my @categories = split('&',$items->{'categories'}); @@ -3863,6 +3918,8 @@ sub dump_course_id_handler { } else { next if ($catfilter ne ''); next if ($selfenrollonly); + next if ($createdbefore || $createdafter); + next if ($creationcontext ne '.'); if ((defined($clonerudom)) && (defined($cloneruname))) { if ($cc_clone{$unesc_key}) { $canclone = 1; @@ -6214,7 +6271,7 @@ sub make_new_child { &ReadManagerTable(); my $clientrec=defined(&Apache::lonnet::get_hosts_from_ip($outsideip)); my $ismanager=($managers{$outsideip} ne undef); - $clientname = "[unknonwn]"; + $clientname = "[unknown]"; if($clientrec) { # Establish client type. $ConnectionType = "client"; $clientname = (&Apache::lonnet::get_hosts_from_ip($outsideip))[-1]; @@ -6242,7 +6299,7 @@ sub make_new_child { # # If the remote is attempting a local init... give that a try: # - my ($i, $inittype) = split(/:/, $remotereq); + (my $i, my $inittype, $clientversion) = split(/:/, $remotereq); # If the connection type is ssl, but I didn't get my # certificate files yet, then I'll drop back to @@ -6262,6 +6319,7 @@ sub make_new_child { } if($inittype eq "local") { + $clientversion = $perlvar{'lonVersion'}; my $key = LocalConnection($client, $remotereq); if($key) { Debug("Got local key $key");