--- loncom/lond 2010/07/22 22:08:06 1.449
+++ loncom/lond 2010/09/27 00:21:02 1.459
@@ -2,7 +2,7 @@
# The LearningOnline Network
# lond "LON Daemon" Server (port "LOND" 5663)
#
-# $Id: lond,v 1.449 2010/07/22 22:08:06 raeburn Exp $
+# $Id: lond,v 1.459 2010/09/27 00:21:02 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -58,7 +58,7 @@ my $DEBUG = 0; # Non zero to ena
my $status='';
my $lastlog='';
-my $VERSION='$Revision: 1.449 $'; #' stupid emacs
+my $VERSION='$Revision: 1.459 $'; #' stupid emacs
my $remoteVERSION;
my $currenthostid="default";
my $currentdomainid;
@@ -1789,7 +1789,11 @@ sub authenticate_handler {
unless ($clientcancheckhost) {
my $uprimary_id = &Apache::lonnet::domain($udom,'primary');
my $uint_dom = &Apache::lonnet::internet_dom($uprimary_id);
- my @intdoms = &Apache::lonnet::get_internet_names($clientname);
+ my @intdoms;
+ my $internet_names = &Apache::lonnet::get_internet_names($clientname);
+ if (ref($internet_names) eq 'ARRAY') {
+ @intdoms = @{$internet_names};
+ }
unless ($uint_dom ne '' && grep(/^\Q$uint_dom\E$/,@intdoms)) {
my ($remote,$hosted);
my $remotesession = &get_usersession_config($udom,'remotesession');
@@ -2151,7 +2155,10 @@ sub update_resource_handler {
my $transname="$fname.in.transfer";
my $remoteurl=&Apache::lonnet::reply("sub:$fname","$clientname");
my $response;
- alarm(120);
+# FIXME: cannot replicate files that take more than two minutes to transfer?
+# alarm(120);
+# FIXME: this should use the LWP mechanism, not internal alarms.
+ alarm(1200);
{
my $ua=new LWP::UserAgent;
my $request=new HTTP::Request('GET',"$remoteurl");
@@ -2159,11 +2166,13 @@ sub update_resource_handler {
}
alarm(0);
if ($response->is_error()) {
+# FIXME: we should probably clean up here instead of just whine
unlink($transname);
my $message=$response->status_line;
&logthis("LWP GET: $message for $fname ($remoteurl)");
} else {
if ($remoteurl!~/\.meta$/) {
+# FIXME: isn't there an internal LWP mechanism for this?
alarm(120);
{
my $ua=new LWP::UserAgent;
@@ -3144,7 +3153,7 @@ sub dump_with_regexp {
my $userinput = "$cmd:$tail";
- my ($udom,$uname,$namespace,$regexp,$range)=split(/:/,$tail);
+ my ($udom,$uname,$namespace,$regexp,$range,$extra)=split(/:/,$tail);
if (defined($regexp)) {
$regexp=&unescape($regexp);
} else {
@@ -3162,21 +3171,38 @@ sub dump_with_regexp {
}
my $hashref = &tie_user_hash($udom, $uname, $namespace,
&GDBM_READER());
+ my $skipcheck;
if ($hashref) {
my $qresult='';
my $count=0;
+ if ($extra ne '') {
+ $extra = &Apache::lonnet::thaw_unescape($extra);
+ $skipcheck = $extra->{'skipcheck'};
+ }
+ my @ids = &Apache::lonnet::current_machine_ids();
+ my (%homecourses,$major,$minor,$now);
+ if (($namespace eq 'roles') && (!$skipcheck)) {
+ my $loncaparev = $clientversion;
+ if ($loncaparev eq '') {
+ $loncaparev = $Apache::lonnet::loncaparevs{$clientname};
+ }
+ if ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?/) {
+ $major = $1;
+ $minor = $2;
+ }
+ $now = time;
+ }
while (my ($key,$value) = each(%$hashref)) {
if ($namespace eq 'roles') {
- if ($key =~ m{^/($LONCAPA::match_domain)/($LONCAPA::match_community)_(cc|co|in|ta|ep|ad|st|cr)}) {
+ if ($key =~ m{^/($LONCAPA::match_domain)/($LONCAPA::match_courseid)(/?[^_]*)_(cc|co|in|ta|ep|ad|st|cr)$}) {
my $cdom = $1;
my $cnum = $2;
- if ($clientversion =~ /^\'?(\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);
+ unless ($skipcheck) {
+ my ($role,$end,$start) = split(/\_/,$value);
+ if (!$end || $end > $now) {
+ next unless (&releasereqd_check($cnum,$cdom,$key,$value,$major,
+ $minor,\%homecourses,\@ids));
+ }
}
}
}
@@ -3196,6 +3222,12 @@ sub dump_with_regexp {
}
}
if (&untie_user_hash($hashref)) {
+ if (($namespace eq 'roles') && (!$skipcheck)) {
+ if (keys(%homecourses) > 0) {
+ $qresult .= &check_homecourses(\%homecourses,$udom,$regexp,$count,
+ $range,$start,$end,$major,$minor);
+ }
+ }
chop($qresult);
&Reply($client, \$qresult, $userinput);
} else {
@@ -4654,7 +4686,7 @@ sub tmp_put_handler {
}
my ($id,$store);
$tmpsnum++;
- if ($context eq 'resetpw') {
+ if (($context eq 'resetpw') || ($context eq 'createaccount')) {
$id = &md5_hex(&md5_hex(time.{}.rand().$$));
} else {
$id = $$.'_'.$clientip.'_'.$tmpsnum;
@@ -7270,6 +7302,148 @@ sub get_usersession_config {
return;
}
+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->{$hashid}) eq 'ARRAY') {
+ push(@{$homecourses->{$hashid}},{$key=>$value});
+ } else {
+ $homecourses->{$hashid} = [{$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));
+ }
+ }
+ }
+ return 1;
+}
+
+sub get_courseinfo_hash {
+ my ($cnum,$cdom,$home) = @_;
+ my $hashid = $cdom.':'.$cnum;
+ my %info = &Apache::lonnet::courseiddump($cdom,'.',1,'.','.',$cnum,1,[$home],'.');
+ if (ref($info{$cdom.'_'.$cnum}) eq 'HASH') {
+ return &Apache::lonnet::do_cache_new('courseinfo',$hashid,$info{$cdom.'_'.$cnum},600);
+ }
+ return;
+}
+
+sub check_homecourses {
+ my ($homecourses,$udom,$regexp,$count,$range,$start,$end,$major,$minor) = @_;
+ my ($result,%addtocache);
+ my $yesterday = time - 24*3600;
+ if (ref($homecourses) eq 'HASH') {
+ my (%okcourses,%courseinfo,%recent);
+ my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT());
+ if ($hashref) {
+ 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 $hashid = $unesc_key;
+ $hashid =~ s/_/:/;
+ $courseinfo{$hashid} = $items;
+ if (ref($homecourses->{$hashid}) 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');
+ }
+ } else {
+ &logthis('Failed to tie hash for nohist_courseids.db');
+ return;
+ }
+ foreach my $hashid (keys(%recent)) {
+ &Apache::lonnet::do_cache_new('courseinfo',$hashid,$courseinfo{$hashid},600);
+ }
+ foreach my $hashid (keys(%{$homecourses})) {
+ next if ($recent{$hashid});
+ &Apache::lonnet::do_cache_new('courseinfo',$hashid,$courseinfo{$hashid},600);
+ }
+ foreach my $hashid (keys(%okcourses)) {
+ if (ref($homecourses->{$hashid}) eq 'ARRAY') {
+ foreach my $role (@{$homecourses->{$hashid}}) {
+ 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;
+}
+
+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;
+}
+
# ----------------------------------- POD (plain old documentation, CPAN style)
=head1 NAME