--- loncom/lond 2014/01/03 19:36:47 1.489.2.11 +++ loncom/lond 2016/08/11 09:52:39 1.489.2.20 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.489.2.11 2014/01/03 19:36:47 raeburn Exp $ +# $Id: lond,v 1.489.2.20 2016/08/11 09:52:39 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.11 $'; #' stupid emacs +my $VERSION='$Revision: 1.489.2.20 $'; #' 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: @@ -2407,11 +2445,20 @@ sub remove_user_file_handler { if (-e $file) { # # If the file is a regular file unlink is fine... - # However it's possible the client wants a dir. - # removed, in which case rmdir is more approprate: + # However it's possible the client wants a dir + # removed, in which case rmdir is more appropriate + # Note: rmdir will only remove an empty directory. # if (-f $file){ unlink($file); + # for html files remove the associated .bak file + # which may have been created by the editor. + if ($ufile =~ m{^((docs|supplemental)/(?:\d+|default)/\d+(?:|/.+)/)[^/]+\.x?html?$}i) { + my $path = $1; + if (-e $file.'.bak') { + unlink($file.'.bak'); + } + } } elsif(-d $file) { rmdir($file); } @@ -2774,6 +2821,10 @@ sub newput_user_profile_entry { foreach my $pair (@pairs) { my ($key,$value)=split(/=/,$pair); if (exists($hashref->{$key})) { + if (!&untie_user_hash($hashref)) { + &logthis("error: ".($!+0)." untie (GDBM) failed ". + "while attempting newput - early out as key exists"); + } &Failure($client, "key_exists: ".$key."\n",$userinput); return 1; } @@ -3277,6 +3328,9 @@ sub dump_with_regexp { # namespace - Name of the database being modified # rid - Resource keyword to modify. # what - new value associated with rid. +# laststore - (optional) version=timestamp +# for most recent transaction for rid +# in namespace, when cstore was called # # $client - Socket open on the client. # @@ -3285,23 +3339,47 @@ sub dump_with_regexp { # 1 (keep on processing). # Side-Effects: # Writes to the client +# Successful storage will cause either 'ok', or, if $laststore was included +# in the tail of the request, and the version number for the last transaction +# is larger than the version in $laststore, delay:$numtrans , where $numtrans +# is the number of store evevnts recorded for rid in namespace since +# lonnet::store() was called by the client. +# sub store_handler { my ($cmd, $tail, $client) = @_; my $userinput = "$cmd:$tail"; - my ($udom,$uname,$namespace,$rid,$what) =split(/:/,$tail); + chomp($tail); + my ($udom,$uname,$namespace,$rid,$what,$laststore) =split(/:/,$tail); if ($namespace ne 'roles') { - chomp($what); my @pairs=split(/\&/,$what); my $hashref = &tie_user_hash($udom, $uname, $namespace, &GDBM_WRCREAT(), "S", "$rid:$what"); if ($hashref) { my $now = time; - my @previouskeys=split(/&/,$hashref->{"keys:$rid"}); - my $key; + my $numtrans; + if ($laststore) { + my ($previousversion,$previoustime) = split(/\=/,$laststore); + my ($lastversion,$lasttime) = (0,0); + $lastversion = $hashref->{"version:$rid"}; + if ($lastversion) { + $lasttime = $hashref->{"$lastversion:$rid:timestamp"}; + } + if (($previousversion) && ($previousversion !~ /\D/)) { + if (($lastversion > $previousversion) && ($lasttime >= $previoustime)) { + $numtrans = $lastversion - $previousversion; + } + } elsif ($lastversion) { + $numtrans = $lastversion; + } + if ($numtrans) { + $numtrans =~ s/D//g; + } + } + $hashref->{"version:$rid"}++; my $version=$hashref->{"version:$rid"}; my $allkeys=''; @@ -3314,7 +3392,11 @@ sub store_handler { $allkeys.='timestamp'; $hashref->{"$version:keys:$rid"}=$allkeys; if (&untie_user_hash($hashref)) { - &Reply($client, "ok\n", $userinput); + my $msg = 'ok'; + if ($numtrans) { + $msg = 'delay:'.$numtrans; + } + &Reply($client, "$msg\n", $userinput); } else { &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ". "while attempting store\n", $userinput); @@ -5213,7 +5295,9 @@ sub retrieve_auto_file_handler { my ($filename) = split(/:/, $tail); my $source = $perlvar{'lonDaemons'}.'/tmp/'.$filename; - if ( (-e $source) && ($filename ne '') ) { + if ($filename =~m{/\.\./}) { + &Failure($client, "refused\n", $userinput); + } elsif ( (-e $source) && ($filename ne '') ) { my $reply = ''; if (open(my $fh,$source)) { while (<$fh>) { @@ -5245,7 +5329,7 @@ sub crsreq_checks_handler { my $userinput = "$cmd:$tail"; my $dom = $tail; my $result; - my @reqtypes = ('official','unofficial','community'); + my @reqtypes = ('official','unofficial','community','textbook'); eval { local($SIG{__DIE__})='DEFAULT'; my %validations; @@ -5272,19 +5356,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 +5383,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 +5393,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,9 +5402,10 @@ 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); + my @posskeys = qw(createdweb createdmsg createdcustomized createdactions queuedweb queuedmsg formitems reviewweb validationjs onload javascript); foreach my $key (keys(%rtnhash)) { if (grep(/^\Q$key\E/,@posskeys)) { $result .= &escape($key).'='.&Apache::lonnet::freeze_escape($rtnhash{$key}).'&'; @@ -6530,12 +6619,28 @@ sub make_new_child { # my $tmpsnum=0; # Now global #---------------------------------------------------- kerberos 5 initialization &Authen::Krb5::init_context(); - unless (($dist eq 'fedora5') || ($dist eq 'fedora4') || - ($dist eq 'fedora6') || ($dist eq 'suse9.3') || - ($dist eq 'suse12.2') || ($dist eq 'suse12.3') || - ($dist eq 'suse13.1')) { - &Authen::Krb5::init_ets(); - } + + my $no_ets; + if ($dist =~ /^(?:centos|rhes|scientific)(\d+)$/) { + if ($1 >= 7) { + $no_ets = 1; + } + } elsif ($dist =~ /^suse(\d+\.\d+)$/) { + if (($1 eq '9.3') || ($1 >= 12.2)) { + $no_ets = 1; + } + } elsif ($dist =~ /^sles(\d+)$/) { + if ($1 > 11) { + $no_ets = 1; + } + } elsif ($dist =~ /^fedora(\d+)$/) { + if ($1 < 7) { + $no_ets = 1; + } + } + unless ($no_ets) { + &Authen::Krb5::init_ets(); + } &status('Accepted connection'); # ============================================================================= 500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.