--- loncom/lond 2012/04/25 21:22:28 1.491 +++ loncom/lond 2012/04/26 19:51:40 1.492 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.491 2012/04/25 21:22:28 raeburn Exp $ +# $Id: lond,v 1.492 2012/04/26 19:51:40 droeschl Exp $ # # Copyright Michigan State University Board of Trustees # @@ -61,7 +61,7 @@ my $DEBUG = 0; # Non zero to ena my $status=''; my $lastlog=''; -my $VERSION='$Revision: 1.491 $'; #' stupid emacs +my $VERSION='$Revision: 1.492 $'; #' stupid emacs my $remoteVERSION; my $currenthostid="default"; my $currentdomainid; @@ -1907,12 +1907,8 @@ sub authenticate_handler { if (ref($hostedsession) eq 'HASH') { $hosted = $hostedsession->{'hosted'}; } - my $loncaparev = $clientversion; - if ($loncaparev eq '') { - $loncaparev = $Apache::lonnet::loncaparevs{$clientname}; - } $canhost = &Apache::lonnet::can_host_session($udom,$clientname, - $loncaparev, + $clientversion, $remote,$hosted); } } @@ -3258,130 +3254,13 @@ sub dump_profile_database { sub dump_with_regexp { my ($cmd, $tail, $client) = @_; - #TODO encapsulate $clientname and $clientversion in a object. - my $res = LONCAPA::Lond::dump_with_regexp($cmd, $tail, $clientname, $clientversion); + my $res = LONCAPA::Lond::dump_with_regexp($tail, $clientname, $clientversion); if ($res =~ /^error:/) { Failure($client, \$res, "$cmd:$tail"); } else { Reply($client, \$res, "$cmd:$tail"); } - return 1; - - my $userinput = "$cmd:$tail"; - - my ($udom,$uname,$namespace,$regexp,$range)=split(/:/,$tail); - if (defined($regexp)) { - $regexp=&unescape($regexp); - } else { - $regexp='.'; - } - my ($start,$end); - if (defined($range)) { - if ($range =~/^(\d+)\-(\d+)$/) { - ($start,$end) = ($1,$2); - } elsif ($range =~/^(\d+)$/) { - ($start,$end) = (0,$1); - } else { - undef($range); - } - } - my $hashref = &tie_user_hash($udom, $uname, $namespace, - &GDBM_READER()); - if ($hashref) { - my $qresult=''; - my $count=0; -# -# When dump is for roles.db, determine if LON-CAPA version checking is needed. -# Sessions on 2.10 and later do not require version checking, as that occurs -# on the server hosting the user session, when constructing the roles/courses -# screen). -# - my $skipcheck; - my @ids = &Apache::lonnet::current_machine_ids(); - my (%homecourses,$major,$minor,$now); -# -# If dump is for roles.db from a pre-2.10 server, determine the LON-CAPA -# version on the server which requested the data. For LON-CAPA 2.9, the -# client session will have sent its LON-CAPA version when initiating the -# connection. For LON-CAPA 2.8 and older, the version is retrieved from -# the global %loncaparevs in lonnet.pm. -# - if ($namespace eq 'roles') { - my $loncaparev = $clientversion; - if ($loncaparev eq '') { - $loncaparev = $Apache::lonnet::loncaparevs{$clientname}; - } - if ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?/) { - $major = $1; - $minor = $2; - } - if (($major > 2) || (($major == 2) && ($minor > 9))) { - $skipcheck = 1; - } - $now = time; - } - while (my ($key,$value) = each(%$hashref)) { - if (($namespace eq 'roles') && (!$skipcheck)) { - if ($key =~ m{^/($LONCAPA::match_domain)/($LONCAPA::match_courseid)(/?[^_]*)_(cc|co|in|ta|ep|ad|st|cr)$}) { - my $cdom = $1; - my $cnum = $2; - my ($role,$roleend,$rolestart) = split(/\_/,$value); - if (!$roleend || $roleend > $now) { -# -# For active course roles, check that requesting server is running a LON-CAPA -# version which meets any version requirements for the course. Do not include -# the role amongst the results returned if the requesting server's version is -# too old. -# -# This determination is handled differently depending on whether the course's -# homeserver is the current server, or whether it is a different server. -# In both cases, the course's version requirement needs to be retrieved. -# - next unless (&releasereqd_check($cnum,$cdom,$key,$value,$major, - $minor,\%homecourses,\@ids)); - } - } - } - if ($regexp eq '.') { - $count++; - if (defined($range) && $count >= $end) { last; } - if (defined($range) && $count < $start) { next; } - $qresult.=$key.'='.$value.'&'; - } else { - my $unescapeKey = &unescape($key); - if (eval('$unescapeKey=~/$regexp/')) { - $count++; - if (defined($range) && $count >= $end) { last; } - if (defined($range) && $count < $start) { next; } - $qresult.="$key=$value&"; - } - } - } - if (&untie_user_hash($hashref)) { -# -# If dump is for roles.db from a pre-2.10 server, check if the LON-CAPA -# version requirements for courses for which the current server is the home -# server permit course roles to be usable on the client server hosting the -# user's session. If so, include those role results in the data returned to -# the client server. -# - if (($namespace eq 'roles') && (!$skipcheck)) { - if (keys(%homecourses) > 0) { - $qresult .= &check_homecourses(\%homecourses,$regexp,$count, - $range,$start,$end,$major,$minor); - } - } - chop($qresult); - &Reply($client, \$qresult, $userinput); - } else { - &Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ". - "while attempting dump\n", $userinput); - } - } else { - &Failure($client, "error: ".($!+0)." tie(GDBM) Failed ". - "while attempting dump\n", $userinput); - } return 1; } @@ -6617,6 +6496,10 @@ sub make_new_child { # If the remote is attempting a local init... give that a try: # (my $i, my $inittype, $clientversion) = split(/:/, $remotereq); + # For LON-CAPA 2.9, the client session will have sent its LON-CAPA + # version when initiating the connection. For LON-CAPA 2.8 and older, + # the version is retrieved from the global %loncaparevs in lonnet.pm. + $clientversion ||= $Apache::lonnet::loncaparevs{$clientname}; # If the connection type is ssl, but I didn't get my # certificate files yet, then I'll drop back to @@ -7480,78 +7363,6 @@ sub get_usersession_config { return; } -# -# releasereqd_check() will determine if a LON-CAPA version (defined in the -# $major,$minor args passed) is not too old to allow use of a role in a -# course ($cnum,$cdom args passed), if at least one of the following applies: -# (a) the course is a Community, (b) the course's home server is *not* the -# current server, or (c) cached course information is not stale. -# -# For the case where none of these apply, the course is added to the -# $homecourse hash ref (keys = courseIDs, values = array of a hash of roles). -# The $homecourse hash ref is for courses for which the current server is the -# home server. LON-CAPA version requirements are checked elsewhere for the -# items in $homecourse. -# - -sub releasereqd_check { - my ($cnum,$cdom,$key,$value,$major,$minor,$homecourses,$ids) = @_; - my $home = &Apache::lonnet::homeserver($cnum,$cdom); - return if ($home eq 'no_host'); - my ($reqdmajor,$reqdminor,$displayrole); - if ($cnum =~ /$LONCAPA::match_community/) { - if ($major eq '' && $minor eq '') { - return unless ((ref($ids) eq 'ARRAY') && - (grep(/^\Q$home\E$/,@{$ids}))); - } else { - $reqdmajor = 2; - $reqdminor = 9; - return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor)); - } - } - my $hashid = $cdom.':'.$cnum; - my ($courseinfo,$cached) = - &Apache::lonnet::is_cached_new('courseinfo',$hashid); - if (defined($cached)) { - if (ref($courseinfo) eq 'HASH') { - if (exists($courseinfo->{'releaserequired'})) { - my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'}); - return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor)); - } - } - } else { - if (ref($ids) eq 'ARRAY') { - if (grep(/^\Q$home\E$/,@{$ids})) { - if (ref($homecourses) eq 'HASH') { - if (ref($homecourses->{$cdom}) eq 'HASH') { - if (ref($homecourses->{$cdom}{$cnum}) eq 'HASH') { - if (ref($homecourses->{$cdom}{$cnum}) eq 'ARRAY') { - push(@{$homecourses->{$cdom}{$cnum}},{$key=>$value}); - } else { - $homecourses->{$cdom}{$cnum} = [{$key=>$value}]; - } - } else { - $homecourses->{$cdom}{$cnum} = [{$key=>$value}]; - } - } else { - $homecourses->{$cdom}{$cnum} = [{$key=>$value}]; - } - } - return; - } - } - my $courseinfo = &get_courseinfo_hash($cnum,$cdom,$home); - if (ref($courseinfo) eq 'HASH') { - if (exists($courseinfo->{'releaserequired'})) { - my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'}); - return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor)); - } - } else { - return; - } - } - return 1; -} # # get_courseinfo_hash() is used to retrieve course information from the db @@ -7589,125 +7400,6 @@ sub get_courseinfo_hash { return; } -# -# check_homecourses() will retrieve course information for those courses which -# are keys of the $homecourses hash ref (first arg). The nohist_courseids.db -# GDBM file is tied and course information for each course retrieved. Last -# visit (lasttime key) is also retrieved for each, and cached values updated -# for any courses last visited less than 24 hours ago. Cached values are also -# updated for any courses included in the $homecourses hash ref. -# -# The reason for the 24 hours constraint is that the cron entry in -# /etc/cron.d/loncapa for /home/httpd/perl/refresh_courseids_db.pl causes -# cached course information to be updated nightly for courses with activity -# within the past 24 hours. -# -# Role information for the user (included in a ref to an array of hashes as the -# value for each key in $homecourses) is appended to the result returned by the -# routine, which will in turn be appended to the string returned to the client -# hosting the user's session. -# - -sub check_homecourses { - my ($homecourses,$regexp,$count,$range,$start,$end,$major,$minor) = @_; - my ($result,%addtocache); - my $yesterday = time - 24*3600; - if (ref($homecourses) eq 'HASH') { - my (%okcourses,%courseinfo,%recent); - foreach my $domain (keys(%{$homecourses})) { - my $hashref = - &tie_domain_hash($domain, "nohist_courseids", &GDBM_WRCREAT()); - if (ref($hashref) eq 'HASH') { - while (my ($key,$value) = each(%$hashref)) { - my $unesc_key = &unescape($key); - if ($unesc_key =~ /^lasttime:(\w+)$/) { - my $cid = $1; - $cid =~ s/_/:/; - if ($value > $yesterday ) { - $recent{$cid} = 1; - } - next; - } - my $items = &Apache::lonnet::thaw_unescape($value); - if (ref($items) eq 'HASH') { - my ($cdom,$cnum) = split(/_/,$unesc_key); - my $hashid = $cdom.':'.$cnum; - $courseinfo{$hashid} = $items; - if (ref($homecourses->{$cdom}{$cnum}) eq 'ARRAY') { - my ($reqdmajor,$reqdminor) = split(/\./,$items->{'releaserequired'}); - if (&useable_role($reqdmajor,$reqdminor,$major,$minor)) { - $okcourses{$hashid} = 1; - } - } - } - } - unless (&untie_domain_hash($hashref)) { - &logthis("Failed to untie tied hash for nohist_courseids.db for $domain"); - } - } else { - &logthis("Failed to tie hash for nohist_courseids.db for $domain"); - } - } - foreach my $hashid (keys(%recent)) { - my ($result,$cached)=&Apache::lonnet::is_cached_new('courseinfo',$hashid); - unless ($cached) { - &Apache::lonnet::do_cache_new('courseinfo',$hashid,$courseinfo{$hashid},600); - } - } - foreach my $cdom (keys(%{$homecourses})) { - if (ref($homecourses->{$cdom}) eq 'HASH') { - foreach my $cnum (keys(%{$homecourses->{$cdom}})) { - my $hashid = $cdom.':'.$cnum; - next if ($recent{$hashid}); - &Apache::lonnet::do_cache_new('courseinfo',$hashid,$courseinfo{$hashid},600); - } - } - } - foreach my $hashid (keys(%okcourses)) { - my ($cdom,$cnum) = split(/:/,$hashid); - if ((ref($homecourses->{$cdom}) eq 'HASH') && - (ref($homecourses->{$cdom}{$cnum}) eq 'ARRAY')) { - foreach my $role (@{$homecourses->{$cdom}{$cnum}}) { - if (ref($role) eq 'HASH') { - while (my ($key,$value) = each(%{$role})) { - if ($regexp eq '.') { - $count++; - if (defined($range) && $count >= $end) { last; } - if (defined($range) && $count < $start) { next; } - $result.=$key.'='.$value.'&'; - } else { - my $unescapeKey = &unescape($key); - if (eval('$unescapeKey=~/$regexp/')) { - $count++; - if (defined($range) && $count >= $end) { last; } - if (defined($range) && $count < $start) { next; } - $result.="$key=$value&"; - } - } - } - } - } - } - } - } - return $result; -} - -# -# useable_role() will compare the LON-CAPA version required by a course with -# the version available on the client server. If the client server's version -# is compatible, 1 will be returned. -# - -sub useable_role { - my ($reqdmajor,$reqdminor,$major,$minor) = @_; - if ($reqdmajor ne '' && $reqdminor ne '') { - return if (($major eq '' && $minor eq '') || - ($major < $reqdmajor) || - (($major == $reqdmajor) && ($minor < $reqdminor))); - } - return 1; -} sub distro_and_arch { return $dist.':'.$arch;