--- loncom/lond 2009/02/10 11:31:26 1.411
+++ loncom/lond 2009/08/22 19:52:08 1.424
@@ -2,7 +2,7 @@
# The LearningOnline Network
# lond "LON Daemon" Server (port "LOND" 5663)
#
-# $Id: lond,v 1.411 2009/02/10 11:31:26 foxr Exp $
+# $Id: lond,v 1.424 2009/08/22 19:52:08 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.411 $'; #' stupid emacs
+my $VERSION='$Revision: 1.424 $'; #' stupid emacs
my $remoteVERSION;
my $currenthostid="default";
my $currentdomainid;
@@ -142,6 +142,16 @@ my @adderrors = ("ok",
"lcuseradd Password mismatch");
+# This array are the errors from lcinstallfile:
+
+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",
+ "Some file operation failed",
+ "Invalid table filename."
+ );
#
# Statistics that are maintained and dislayed in the status line.
@@ -398,6 +408,7 @@ sub isClient {
#
sub ReadManagerTable {
+ &Debug("Reading manager table");
# Clean out the old table first..
foreach my $key (keys %managers) {
@@ -520,11 +531,9 @@ sub AdjustHostContents {
}
#
# InstallFile: Called to install an administrative file:
-# - The file is created with <name>.tmp
-# - The <name>.tmp file is then mv'd to <name>
-# This lugubrious procedure is done to ensure that we are never without
-# a valid, even if dated, version of the file regardless of who crashes
-# and when the crash occurs.
+# - The file is created int a temp directory called <name>.tmp
+# - lcinstall file is called to install the file.
+# since the web app has no direct write access to the table directory
#
# Parameters:
# Name of the file
@@ -532,11 +541,16 @@ sub AdjustHostContents {
# Return:
# nonzero - success.
# 0 - failure and $! has an errno.
+# Assumptions:
+# File installtion is a relatively infrequent
#
sub InstallFile {
my ($Filename, $Contents) = @_;
- my $TempFile = $Filename.".tmp";
+# my $TempFile = $Filename.".tmp";
+ my $exedir = $perlvar{'lonDaemons'};
+ my $tmpdir = $exedir.'/tmp/';
+ my $TempFile = $tmpdir."TempTableFile.tmp";
# Open the file for write:
@@ -550,11 +564,27 @@ sub InstallFile {
print $fh ($Contents);
$fh->close; # In case we ever have a filesystem w. locking
- chmod(0660, $TempFile);
+ chmod(0664, $TempFile); # Everyone can write it.
- # Now we can move install the file in position.
-
- move($TempFile, $Filename);
+ # Use lcinstall file to put the file in the table directory...
+
+ &Debug("Opening pipe to $exedir/lcinstallfile $TempFile $Filename");
+ my $pf = IO::File->new("| $exedir/lcinstallfile $TempFile $Filename > $exedir/logs/lcinstallfile.log");
+ close $pf;
+ my $err = $?;
+ &Debug("Status is $err");
+ if ($err != 0) {
+ my $msg = $err;
+ if ($err < @installerrors) {
+ $msg = $installerrors[$err];
+ }
+ &logthis("Install failed for table file $Filename : $msg");
+ return 0;
+ }
+
+ # Remove the temp file:
+
+ unlink($TempFile);
return 1;
}
@@ -608,6 +638,7 @@ sub ConfigFileFromSelector {
sub PushFile {
my $request = shift;
my ($command, $filename, $contents) = split(":", $request, 3);
+ &Debug("PushFile");
# At this point in time, pushes for only the following tables are
# supported:
@@ -624,20 +655,7 @@ sub PushFile {
if(! (defined $tablefile)) {
return "refused";
}
- #
- # >copy< the old table to the backup table
- # don't rename in case system crashes/reboots etc. in the time
- # window between a rename and write.
- #
- my $backupfile = $tablefile;
- $backupfile =~ s/\.tab$/.old/;
- if(!CopyFile($tablefile, $backupfile)) {
- &logthis('<font color="green"> CopyFile from '.$tablefile." to ".$backupfile." failed </font>");
- return "error:$!";
- }
- &logthis('<font color="green"> Pushfile: backed up '
- .$tablefile." to $backupfile</font>");
-
+
# If the file being pushed is the host file, we adjust the entry for ourself so that the
# IP will be our current IP as looked up in dns. Note this is only 99% good as it's possible
# to conceive of conditions where we don't have a DNS entry locally. This is possible in a
@@ -650,6 +668,7 @@ sub PushFile {
# Install the new file:
+ &logthis("Installing new $tablefile contents:\n$contents");
if(!InstallFile($tablefile, $contents)) {
&logthis('<font color="red"> Pushfile: unable to install '
.$tablefile." $! </font>");
@@ -1203,7 +1222,7 @@ sub user_authorization_type {
# a reply is written to the client.
sub push_file_handler {
my ($cmd, $tail, $client) = @_;
-
+ &Debug("In push file handler");
my $userinput = "$cmd:$tail";
# At this time we only know that the IP of our partner is a valid manager
@@ -1211,7 +1230,8 @@ sub push_file_handler {
# spoofing).
my $cert = &GetCertificate($userinput);
- if(&ValidManager($cert)) {
+ if(&ValidManager($cert)) {
+ &Debug("Valid manager: $client");
# Now presumably we have the bona fides of both the peer host and the
# process making the request.
@@ -1220,6 +1240,7 @@ sub push_file_handler {
&Reply($client, \$reply, $userinput);
} else {
+ &logthis("push_file_handler $client is not valid");
&Failure( $client, "refused\n", $userinput);
}
return 1;
@@ -1624,6 +1645,14 @@ sub server_timezone_handler {
}
®ister_handler("servertimezone", \&server_timezone_handler, 0, 1, 0);
+sub server_loncaparev_handler {
+ my ($cmd,$tail,$client) = @_;
+ my $userinput = "$cmd:$tail";
+ &Reply($client,\$perlvar{'lonVersion'},$userinput);
+ return 1;
+}
+®ister_handler("serverloncaparev", \&server_loncaparev_handler, 0, 1, 0);
+
# Process a reinit request. Reinit requests that either
# lonc or lond be reinitialized so that an updated
# host.tab or domain.tab can be processed.
@@ -3645,8 +3674,10 @@ sub put_course_id_hash_handler {
# will be returned. Pre-2.2.0 legacy entries from
# nohist_courseiddump will only contain usernames.
# type - optional parameter for selection
-# regexp_ok - if true, allow the supplied institutional code
-# filter to behave as a regular expression.
+# regexp_ok - if 1 or -1 allow the supplied institutional code
+# filter to behave as a regular expression:
+# 1 will not exclude the course if the instcode matches the RE
+# -1 will exclude the course if the instcode matches the RE
# rtn_as_hash - whether to return the information available for
# each matched item as a frozen hash of all
# key, value pairs in the item's hash, or as a
@@ -3662,6 +3693,12 @@ sub put_course_id_hash_handler {
# caller - if set to 'coursecatalog', courses set to be hidden
# from course catalog will be excluded from results (unless
# overridden by "showhidden".
+# cloner - escaped username:domain of course cloner (if picking course to#
+# clone).
+# cc_clone_list - escaped comma separated list of courses for which
+# course cloner has active CC role (and so can clone
+# automatically).
+# cloneonly - filter by courses for which cloner has rights to clone.
#
# $client - The socket open on the client.
# Returns:
@@ -3674,8 +3711,9 @@ sub dump_course_id_handler {
my ($udom,$since,$description,$instcodefilter,$ownerfilter,$coursefilter,
$typefilter,$regexp_ok,$rtn_as_hash,$selfenrollonly,$catfilter,$showhidden,
- $caller) =split(/:/,$tail);
+ $caller,$cloner,$cc_clone_list,$cloneonly) =split(/:/,$tail);
my $now = time;
+ my ($cloneruname,$clonerudom,%cc_clone);
if (defined($description)) {
$description=&unescape($description);
} else {
@@ -3718,6 +3756,20 @@ sub dump_course_id_handler {
if (defined($catfilter)) {
$catfilter=&unescape($catfilter);
}
+ if (defined($cloner)) {
+ $cloner = &unescape($cloner);
+ ($cloneruname,$clonerudom) = ($cloner =~ /^($LONCAPA::match_username):($LONCAPA::match_domain)$/);
+ }
+ if (defined($cc_clone_list)) {
+ $cc_clone_list = &unescape($cc_clone_list);
+ my @cc_cloners = split('&',$cc_clone_list);
+ foreach my $cid (@cc_cloners) {
+ my ($clonedom,$clonenum) = split(':',$cid);
+ next if ($clonedom ne $udom);
+ $cc_clone{$clonedom.'_'.$clonenum} = 1;
+ }
+ }
+
my $unpack = 1;
if ($description eq '.' && $instcodefilter eq '.' && $coursefilter eq '.' &&
$typefilter eq '.') {
@@ -3740,14 +3792,46 @@ sub dump_course_id_handler {
$lasttime = $hashref->{$lasttime_key};
next if ($lasttime<$since);
}
+ my ($canclone,$valchange);
my $items = &Apache::lonnet::thaw_unescape($value);
if (ref($items) eq 'HASH') {
$is_hash = 1;
+ if (defined($clonerudom)) {
+ if ($items->{'cloners'}) {
+ my @cloneable = split(',',$items->{'cloners'});
+ if (@cloneable) {
+ if (grep(/^\*$/,@cloneable)) {
+ $canclone = 1;
+ } elsif (grep(/^\*:\Q$clonerudom\E$/,@cloneable)) {
+ $canclone = 1;
+ } elsif (grep(/^\Q$cloneruname\E:\Q$clonerudom\E$/,@cloneable)) {
+ $canclone = 1;
+ }
+ }
+ unless ($canclone) {
+ if ($cloneruname ne '' && $clonerudom ne '') {
+ if ($cc_clone{$unesc_key}) {
+ $canclone = 1;
+ $items->{'cloners'} .= ','.$cloneruname.':'.
+ $clonerudom;
+ $valchange = 1;
+ }
+ }
+ }
+ } elsif (defined($cloneruname)) {
+ if ($cc_clone{$unesc_key}) {
+ $canclone = 1;
+ $items->{'cloners'} = $cloneruname.':'.$clonerudom;
+ $valchange = 1;
+ }
+ }
+ }
if ($unpack || !$rtn_as_hash) {
$unesc_val{'descr'} = $items->{'description'};
$unesc_val{'inst_code'} = $items->{'inst_code'};
$unesc_val{'owner'} = $items->{'owner'};
$unesc_val{'type'} = $items->{'type'};
+ $unesc_val{'cloners'} = $items->{'cloners'};
}
$selfenroll_types = $items->{'selfenroll_types'};
$selfenroll_end = $items->{'selfenroll_end_date'};
@@ -3778,7 +3862,13 @@ sub dump_course_id_handler {
}
} else {
next if ($catfilter ne '');
- next if ($selfenrollonly);
+ next if ($selfenrollonly);
+ if ((defined($clonerudom)) && (defined($cloneruname))) {
+ if ($cc_clone{$unesc_key}) {
+ $canclone = 1;
+ $val{'cloners'} = &escape($cloneruname.':'.$clonerudom);
+ }
+ }
$is_hash = 0;
my @courseitems = split(/:/,$value);
$lasttime = pop(@courseitems);
@@ -3787,6 +3877,9 @@ sub dump_course_id_handler {
}
($val{'descr'},$val{'inst_code'},$val{'owner'},$val{'type'}) = @courseitems;
}
+ if ($cloneonly) {
+ next unless ($canclone);
+ }
my $match = 1;
if ($description ne '.') {
if (!$is_hash) {
@@ -3800,10 +3893,14 @@ sub dump_course_id_handler {
if (!$is_hash) {
$unesc_val{'inst_code'} = &unescape($val{'inst_code'});
}
- if ($regexp_ok) {
+ if ($regexp_ok == 1) {
if (eval{$unesc_val{'inst_code'} !~ /$instcodefilter/}) {
$match = 0;
}
+ } elsif ($regexp_ok == -1) {
+ if (eval{$unesc_val{'inst_code'} =~ /$instcodefilter/}) {
+ $match = 0;
+ }
} else {
if (eval{$unesc_val{'inst_code'} !~ /\Q$instcodefilter\E/i}) {
$match = 0;
@@ -3869,12 +3966,18 @@ sub dump_course_id_handler {
if ($match == 1) {
if ($rtn_as_hash) {
if ($is_hash) {
- $qresult.=$key.'='.$value.'&';
+ if ($valchange) {
+ my $newvalue = &Apache::lonnet::freeze_escape($items);
+ $qresult.=$key.'='.$newvalue.'&';
+ } else {
+ $qresult.=$key.'='.$value.'&';
+ }
} else {
my %rtnhash = ( 'description' => &unescape($val{'descr'}),
'inst_code' => &unescape($val{'inst_code'}),
'owner' => &unescape($val{'owner'}),
'type' => &unescape($val{'type'}),
+ 'cloners' => &unescape($val{'cloners'}),
);
my $items = &Apache::lonnet::freeze_escape(\%rtnhash);
$qresult.=$key.'='.$items.'&';
@@ -3949,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.
@@ -3998,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.
@@ -4096,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
#
@@ -4305,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 ($start >= $startfilter) {
+ unless (@roles < 1) {
+ unless (grep/^\Q$trole\E$/,@roles) {
$match = 0;
+ next;
}
}
- unless ($endfilter eq '.' || !defined($endfilter)) {
- if ($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) {
@@ -4612,6 +4869,41 @@ sub enrollment_enabled_handler {
}
®ister_handler("autorun", \&enrollment_enabled_handler, 0, 1, 0);
+#
+# Validate an institutional code used for a LON-CAPA course.
+#
+# Formal Parameters:
+# $cmd - The command request that got us dispatched.
+# $tail - The tail of the command. In this case,
+# this is a colon separated set of words that will be split
+# into:
+# $dom - The domain for which the check of
+# institutional course code will occur.
+#
+# $instcode - The institutional code for the course
+# being requested, or validated for rights
+# to request.
+#
+# $owner - The course requestor (who will be the
+# course owner, in the form username:domain
+#
+# $client - Socket open on the client.
+# Returns:
+# 1 - Indicating processing should continue.
+#
+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);
+
+ return 1;
+}
+®ister_handler("autovalidateinstcode", \&validate_instcode_handler, 0, 1, 0);
+
# Get the official sections for which auto-enrollment is possible.
# Since the admin people won't know about 'unofficial sections'
# we cannot auto-enroll on them.
@@ -4815,6 +5107,61 @@ 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;
+ my @reqtypes = ('official','unofficial','community');
+ eval {
+ local($SIG{__DIE__})='DEFAULT';
+ my %validations;
+ my $response = &localenroll::crsreq_checks($dom,\@reqtypes,
+ \%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:
@@ -4899,6 +5246,39 @@ sub get_institutional_defaults_handler {
®ister_handler("autoinstcodedefaults",
\&get_institutional_defaults_handler,0,1,0);
+sub get_possible_instcodes_handler {
+ my ($cmd, $tail, $client) = @_;
+ my $userinput = "$cmd:$tail";
+
+ my $reply;
+ my $cdom = $tail;
+ my (@codetitles,%cat_titles,%cat_order,@code_order);
+ my $formatreply = &localenroll::possible_instcodes($cdom,
+ \@codetitles,
+ \%cat_titles,
+ \%cat_order,
+ \@code_order);
+ if ($formatreply eq 'ok') {
+ my $result = join('&',map {&escape($_);} (@codetitles)).':';
+ $result .= join('&',map {&escape($_);} (@code_order)).':';
+ foreach my $key (keys(%cat_titles)) {
+ $result .= &escape($key).'='.&Apache::lonnet::freeze_escape($cat_titles{$key}).'&';
+ }
+ $result =~ s/\&$//;
+ $result .= ':';
+ foreach my $key (keys(%cat_order)) {
+ $result .= &escape($key).'='.&Apache::lonnet::freeze_escape($cat_order{$key}).'&';
+ }
+ $result =~ s/\&$//;
+ &Reply($client,\$result,$userinput);
+ } else {
+ &Reply($client, "format_error\n", $userinput);
+ }
+ return 1;
+}
+®ister_handler("autopossibleinstcodes",
+ \&get_possible_instcodes_handler,0,1,0);
+
sub get_institutional_user_rules {
my ($cmd, $tail, $client) = @_;
my $userinput = "$cmd:$tail";
@@ -5981,7 +6361,7 @@ sub make_new_child {
if ($clientip eq '127.0.0.1') {
$outsideip=&Apache::lonnet::get_host_ip($perlvar{'lonHostID'});
}
-
+ &ReadManagerTable();
my $clientrec=defined(&Apache::lonnet::get_hosts_from_ip($outsideip));
my $ismanager=($managers{$outsideip} ne undef);
$clientname = "[unknonwn]";