--- loncom/lond 2012/04/26 20:00:57 1.493 +++ loncom/lond 2013/07/25 19:11:07 1.501 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.493 2012/04/26 20:00:57 droeschl Exp $ +# $Id: lond,v 1.501 2013/07/25 19:11:07 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.493 $'; #' stupid emacs +my $VERSION='$Revision: 1.501 $'; #' stupid emacs my $remoteVERSION; my $currenthostid="default"; my $currentdomainid; @@ -154,8 +154,8 @@ my @adderrors = ("ok", my @installerrors = ("ok", "Initial user id of client not that of www", "Usage error, not enough command line arguments", - "Source file name does not exist", - "Destination file name does not exist", + "Source filename does not exist", + "Destination filename does not exist", "Some file operation failed", "Invalid table filename." ); @@ -2370,6 +2370,24 @@ sub fetch_user_file_handler { unlink($transname); &Failure($client, "failed\n", $userinput); } else { + if ($fname =~ /^default.+\.(page|sequence)$/) { + my ($major,$minor) = split(/\./,$clientversion); + if (($major < 2) || ($major == 2 && $minor < 11)) { + my $now = time; + &Apache::lonnet::do_cache_new('crschange',$udom.'_'.$uname,$now,600); + my $key = &escape('internal.contentchange'); + my $what = "$key=$now"; + my $hashref = &tie_user_hash($udom,$uname,'environment', + &GDBM_WRCREAT(),"P",$what); + if ($hashref) { + $hashref->{$key}=$now; + if (!&untie_user_hash($hashref)) { + &logthis("error: ".($!+0)." untie (GDBM) failed ". + "when updating internal.contentchange"); + } + } + } + } &Reply($client, "ok\n", $userinput); } } @@ -3176,6 +3194,17 @@ sub get_profile_keys { sub dump_profile_database { my ($cmd, $tail, $client) = @_; + my $res = LONCAPA::Lond::dump_profile_database($tail); + + if ($res =~ /^error:/) { + Failure($client, \$res, "$cmd:$tail"); + } else { + Reply($client, \$res, "$cmd:$tail"); + } + + return 1; + + #TODO remove my $userinput = "$cmd:$tail"; my ($udom,$uname,$namespace) = split(/:/,$tail); @@ -3254,7 +3283,7 @@ sub dump_profile_database { sub dump_with_regexp { my ($cmd, $tail, $client) = @_; - my $res = LONCAPA::Lond::dump_with_regexp($tail, $clientname, $clientversion); + my $res = LONCAPA::Lond::dump_with_regexp($tail, $clientversion); if ($res =~ /^error:/) { Failure($client, \$res, "$cmd:$tail"); @@ -3838,6 +3867,17 @@ sub put_course_id_hash_handler { # a reply is written to $client. sub dump_course_id_handler { my ($cmd, $tail, $client) = @_; + + my $res = LONCAPA::Lond::dump_course_id_handler($tail); + if ($res =~ /^error:/) { + Failure($client, \$res, "$cmd:$tail"); + } else { + Reply($client, \$res, "$cmd:$tail"); + } + + return 1; + + #TODO remove my $userinput = "$cmd:$tail"; my ($udom,$since,$description,$instcodefilter,$ownerfilter,$coursefilter, @@ -4426,6 +4466,49 @@ sub get_id_handler { } ®ister_handler("idget", \&get_id_handler, 0, 1, 0); +# Deletes one or more ids in a domain's id database. +# +# Parameters: +# $cmd - Command keyword (iddel). +# $tail - Command tail. In this case a colon +# separated list containing: +# The domain for which we are deleting the id(s). +# &-separated list of id(s) to delete. +# $client - File open on client socket. +# Returns: +# 1 - Continue processing +# 0 - Exit server. +# +# + +sub del_id_handler { + my ($cmd,$tail,$client) = @_; + + my $userinput = "$cmd:$tail"; + + my ($udom,$what)=split(/:/,$tail); + chomp($what); + my $hashref = &tie_domain_hash($udom, "ids", &GDBM_WRCREAT(), + "D", $what); + if ($hashref) { + my @keys=split(/\&/,$what); + foreach my $key (@keys) { + delete($hashref->{$key}); + } + if (&untie_user_hash($hashref)) { + &Reply($client, "ok\n", $userinput); + } else { + &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ". + "while attempting iddel\n", $userinput); + } + } else { + &Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ". + "while attempting iddel\n", $userinput); + } + return 1; +} +®ister_handler("iddel", \&del_id_handler, 0, 1, 0); + # # Puts broadcast e-mail sent by Domain Coordinator in nohist_dcmail database # @@ -4974,9 +5057,10 @@ sub validate_instcode_handler { my ($dom,$instcode,$owner) = split(/:/, $tail); $instcode = &unescape($instcode); $owner = &unescape($owner); - my ($outcome,$description) = + my ($outcome,$description,$credits) = &localenroll::validate_instcode($dom,$instcode,$owner); - my $result = &escape($outcome).'&'.&escape($description); + my $result = &escape($outcome).'&'.&escape($description).'&'. + &escape($credits); &Reply($client, \$result, $userinput); return 1; @@ -6450,7 +6534,8 @@ sub make_new_child { #---------------------------------------------------- kerberos 5 initialization &Authen::Krb5::init_context(); unless (($dist eq 'fedora5') || ($dist eq 'fedora4') || - ($dist eq 'fedora6') || ($dist eq 'suse9.3')) { + ($dist eq 'fedora6') || ($dist eq 'suse9.3') || + ($dist eq 'suse12.2') || ($dist eq 'suse12.3')) { &Authen::Krb5::init_ets(); } @@ -6495,10 +6580,13 @@ sub make_new_child { # # If the remote is attempting a local init... give that a try: # + logthis("remotereq: $remotereq"); (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 contains path to keyfile if $inittype eq 'local' + # it's overridden below in this case $clientversion ||= $Apache::lonnet::loncaparevs{$clientname}; # If the connection type is ssl, but I didn't get my @@ -7577,7 +7665,7 @@ Place in B stores hash in namespace -=item rolesputy +=item rolesput put a role into a user's environment