--- loncom/lond 2014/04/07 23:39:21 1.489.2.12 +++ loncom/lond 2014/06/09 19:47:51 1.489.2.15 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.489.2.12 2014/04/07 23:39:21 raeburn Exp $ +# $Id: lond,v 1.489.2.15 2014/06/09 19:47:51 raeburn 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.489.2.12 $'; #' stupid emacs +my $VERSION='$Revision: 1.489.2.15 $'; #' stupid emacs my $remoteVERSION; my $currenthostid="default"; my $currentdomainid; @@ -621,7 +621,7 @@ sub ConfigFileFromSelector { # String to send to client ("ok" or "refused" if bad file). # sub PushFile { - my $request = shift; + my $request = shift; my ($command, $filename, $contents) = split(":", $request, 3); &Debug("PushFile"); @@ -651,6 +651,44 @@ sub PushFile { if($filename eq "host") { $contents = AdjustHostContents($contents); + } elsif ($filename eq 'dns_host' || $filename eq 'dns_domain') { + if ($contents eq '') { + &logthis(' Pushfile: unable to install ' + .$tablefile." - no data received from push. "); + return 'error: push had no data'; + } + if (&Apache::lonnet::get_host_ip($clientname)) { + my $clienthost = &Apache::lonnet::hostname($clientname); + if ($managers{$clientip} eq $clientname) { + my $clientprotocol = $Apache::lonnet::protocol{$clientname}; + $clientprotocol = 'http' if ($clientprotocol ne 'https'); + my $url = '/adm/'.$filename; + $url =~ s{_}{/}; + my $ua=new LWP::UserAgent; + $ua->timeout(60); + my $request=new HTTP::Request('GET',"$clientprotocol://$clienthost$url"); + my $response=$ua->request($request); + if ($response->is_error()) { + &logthis(' Pushfile: unable to install ' + .$tablefile." - error attempting to pull data. "); + return 'error: pull failed'; + } else { + my $result = $response->content; + chomp($result); + unless ($result eq $contents) { + &logthis(' Pushfile: unable to install ' + .$tablefile." - pushed data and pulled data differ. "); + my $pushleng = length($contents); + my $pullleng = length($result); + if ($pushleng != $pullleng) { + return "error: $pushleng vs $pullleng bytes"; + } else { + return "error: mismatch push and pull"; + } + } + } + } + } } # Install the new file: @@ -5272,19 +5310,20 @@ sub crsreq_checks_handler { sub validate_crsreq_handler { my ($cmd, $tail, $client) = @_; my $userinput = "$cmd:$tail"; - my ($dom,$owner,$crstype,$inststatuslist,$instcode,$instseclist) = split(/:/, $tail); + my ($dom,$owner,$crstype,$inststatuslist,$instcode,$instseclist,$customdata) = split(/:/, $tail); $instcode = &unescape($instcode); $owner = &unescape($owner); $crstype = &unescape($crstype); $inststatuslist = &unescape($inststatuslist); $instcode = &unescape($instcode); $instseclist = &unescape($instseclist); + my $custominfo = &Apache::lonnet::thaw_unescape($customdata); my $outcome; eval { local($SIG{__DIE__})='DEFAULT'; $outcome = &localenroll::validate_crsreq($dom,$owner,$crstype, $inststatuslist,$instcode, - $instseclist); + $instseclist,$custominfo); }; if (!$@) { &Reply($client, \$outcome, $userinput); @@ -5298,7 +5337,8 @@ sub validate_crsreq_handler { sub crsreq_update_handler { my ($cmd, $tail, $client) = @_; my $userinput = "$cmd:$tail"; - my ($cdom,$cnum,$crstype,$action,$ownername,$ownerdomain,$fullname,$title,$code,$infohashref) = + my ($cdom,$cnum,$crstype,$action,$ownername,$ownerdomain,$fullname,$title,$code, + $accessstart,$accessend,$infohashref) = split(/:/, $tail); $crstype = &unescape($crstype); $action = &unescape($action); @@ -5307,6 +5347,8 @@ sub crsreq_update_handler { $fullname = &unescape($fullname); $title = &unescape($title); $code = &unescape($code); + $accessstart = &unescape($accessstart); + $accessend = &unescape($accessend); my $incoming = &Apache::lonnet::thaw_unescape($infohashref); my ($result,$outcome); eval { @@ -5314,7 +5356,8 @@ sub crsreq_update_handler { my %rtnhash; $outcome = &localenroll::crsreq_updates($cdom,$cnum,$crstype,$action, $ownername,$ownerdomain,$fullname, - $title,$code,$incoming,\%rtnhash); + $title,$code,$accessstart,$accessend, + $incoming,\%rtnhash); if ($outcome eq 'ok') { my @posskeys = qw(createdweb createdmsg queuedweb queuedmsg formitems reviewweb); foreach my $key (keys(%rtnhash)) {