--- loncom/lond 2009/07/31 02:20:12 1.419 +++ loncom/lond 2009/08/22 19:10:01 1.423 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.419 2009/07/31 02:20:12 raeburn Exp $ +# $Id: lond,v 1.423 2009/08/22 19:10:01 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -59,7 +59,7 @@ my $DEBUG = 0; # Non zero to ena my $status=''; my $lastlog=''; -my $VERSION='$Revision: 1.419 $'; #' stupid emacs +my $VERSION='$Revision: 1.423 $'; #' stupid emacs my $remoteVERSION; my $currenthostid="default"; my $currentdomainid; @@ -4052,6 +4052,60 @@ sub put_domain_handler { } ®ister_handler("putdom", \&put_domain_handler, 0, 1, 0); +# +# Puts a piece of new data in a namespace db file at the domain level +# returns error if key already exists +# +# Parameters: +# $cmd - The command that got us here. +# $tail - Tail of the command (remaining parameters). +# $client - File descriptor connected to client. +# Returns +# 0 - Requested to exit, caller should shut down. +# 1 - Continue processing. +# Side effects: +# reply is written to $client. +# +sub newput_domain_handler { + my ($cmd, $tail, $client) = @_; + + my $userinput = "$cmd:$tail"; + + my ($udom,$namespace,$what) =split(/:/,$tail,3); + chomp($what); + my $hashref = &tie_domain_hash($udom, "$namespace", &GDBM_WRCREAT(), + "N", $what); + if(!$hashref) { + &Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ". + "while attempting newputdom\n", $userinput); + return 1; + } + + my @pairs=split(/\&/,$what); + foreach my $pair (@pairs) { + my ($key,$value)=split(/=/,$pair); + if (exists($hashref->{$key})) { + &Failure($client, "key_exists: ".$key."\n",$userinput); + return 1; + } + } + + foreach my $pair (@pairs) { + my ($key,$value)=split(/=/,$pair); + $hashref->{$key}=$value; + } + + if (&untie_domain_hash($hashref)) { + &Reply( $client, "ok\n", $userinput); + } else { + &Failure($client, "error: ".($!+0)." untie(GDBM) failed ". + "while attempting newputdom\n", + $userinput); + } + return 1; +} +®ister_handler("newputdom", \&newput_domain_handler, 0, 1, 0); + # Unencrypted get from the namespace database file at the domain level. # This function retrieves a keyed item from a specific named database in the # domain directory. @@ -4101,6 +4155,49 @@ sub get_domain_handler { } ®ister_handler("getdom", \&get_domain_handler, 0, 1, 0); +# +# Deletes a key in a user profile database. +# +# Parameters: +# $cmd - Command keyword (deldom). +# $tail - Command tail. IN this case a colon +# separated list containing: +# the domain to which the database file belongs; +# the namespace (name of the database file); +# & separated list of keys to delete. +# $client - File open on client socket. +# Returns: +# 1 - Continue processing +# 0 - Exit server. +# +# +sub delete_domain_entry { + my ($cmd, $tail, $client) = @_; + + my $userinput = "cmd:$tail"; + + my ($udom,$namespace,$what) = split(/:/,$tail); + chomp($what); + my $hashref = &tie_domain_hash($udom, $namespace, &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 deldom\n", $userinput); + } + } else { + &Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ". + "while attempting deldom\n", $userinput); + } + return 1; +} +®ister_handler("deldom", \&delete_domain_entry, 0, 1, 0); # # Puts an id to a domains id database. @@ -4199,6 +4296,60 @@ sub get_id_handler { } ®ister_handler("idget", \&get_id_handler, 0, 1, 0); +sub dump_dom_with_regexp { + my ($cmd, $tail, $client) = @_; + my $userinput = "$cmd:$tail"; + my ($udom,$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_domain_hash($udom, $namespace, &GDBM_READER()); + if ($hashref) { + my $qresult=''; + my $count=0; + while (my ($key,$value) = each(%$hashref)) { + 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)) { + 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; +} +®ister_handler("dumpdom", \&dump_dom_with_regexp, 0, 1, 0); + # # Puts broadcast e-mail sent by Domain Coordinator in nohist_dcmail database # @@ -4408,27 +4559,30 @@ sub dump_domainroles_handler { $rolesfilter=&unescape($rolesfilter); @roles = split(/\&/,$rolesfilter); } - + my $hashref = &tie_domain_hash($udom, "nohist_domainroles", &GDBM_WRCREAT()); if ($hashref) { my $qresult = ''; while (my ($key,$value) = each(%$hashref)) { my $match = 1; - my ($start,$end) = split(/:/,&unescape($value)); + my ($end,$start) = split(/:/,&unescape($value)); my ($trole,$uname,$udom,$runame,$rudom,$rsec) = split(/:/,&unescape($key)); - unless ($startfilter eq '.' || !defined($startfilter)) { - if ((defined($start)) && ($start >= $startfilter)) { + unless (@roles < 1) { + unless (grep/^\Q$trole\E$/,@roles) { $match = 0; + next; } } - unless ($endfilter eq '.' || !defined($endfilter)) { - if ((defined($end)) && ($end <= $endfilter)) { + unless ($startfilter eq '.' || !defined($startfilter)) { + if ((defined($start)) && ($start >= $startfilter)) { $match = 0; + next; } } - unless (@roles < 1) { - unless (grep/^\Q$trole\E$/,@roles) { + unless ($endfilter eq '.' || !defined($endfilter)) { + if ((defined($end)) && (($end > 0) && ($end <= $endfilter))) { $match = 0; + next; } } if ($match == 1) { @@ -4716,7 +4870,7 @@ sub enrollment_enabled_handler { ®ister_handler("autorun", \&enrollment_enabled_handler, 0, 1, 0); # -# Validate an institutional code use for a LON-CAPA course. +# Validate an institutional code used for a LON-CAPA course. # # Formal Parameters: # $cmd - The command request that got us dispatched. @@ -4735,6 +4889,8 @@ sub validate_instcode_handler { my ($cmd, $tail, $client) = @_; my $userinput = "$cmd:$tail"; my ($dom,$instcode,$owner) = split(/:/, $tail); + $instcode = &unescape($instcode); + $owner = &unescape($owner); my $outcome=&localenroll::validate_instcode($dom,$instcode,$owner); &Reply($client, \$outcome, $userinput); @@ -4945,6 +5101,59 @@ sub retrieve_auto_file_handler { } ®ister_handler("autoretrieve", \&retrieve_auto_file_handler, 0,1,0); +sub crsreq_checks_handler { + my ($cmd, $tail, $client) = @_; + my $userinput = "$cmd:$tail"; + my $dom = $tail; + my $result; + eval { + local($SIG{__DIE__})='DEFAULT'; + my %validations; + my $response = &localenroll::crsreq_checks($dom,\%validations); + if ($response eq 'ok') { + foreach my $key (keys(%validations)) { + $result .= &escape($key).'='.&Apache::lonnet::freeze_escape($validations{$key}).'&'; + } + $result =~ s/\&$//; + } else { + $result = 'error'; + } + }; + if (!$@) { + &Reply($client, \$result, $userinput); + } else { + &Failure($client,"unknown_cmd\n",$userinput); + } + return 1; +} +®ister_handler("autocrsreqchecks", \&crsreq_checks_handler, 0, 1, 0); + +sub validate_crsreq_handler { + my ($cmd, $tail, $client) = @_; + my $userinput = "$cmd:$tail"; + my ($dom,$owner,$crstype,$inststatuslist,$instcode,$instseclist) = split(/:/, $tail); + $instcode = &unescape($instcode); + $owner = &unescape($owner); + $crstype = &unescape($crstype); + $inststatuslist = &unescape($inststatuslist); + $instcode = &unescape($instcode); + $instseclist = &unescape($instseclist); + my $outcome; + eval { + local($SIG{__DIE__})='DEFAULT'; + $outcome = &localenroll::validate_crsreq($dom,$owner,$crstype, + $inststatuslist,$instcode, + $instseclist); + }; + if (!$@) { + &Reply($client, \$outcome, $userinput); + } else { + &Failure($client,"unknown_cmd\n",$userinput); + } + return 1; +} +®ister_handler("autocrsreqvalidation", \&validate_crsreq_handler, 0, 1, 0); + # # Read and retrieve institutional code format (for support form). # Formal Parameters: