--- loncom/lond 2009/02/10 11:31:26 1.411 +++ loncom/lond 2010/01/02 23:56:06 1.435 @@ -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.435 2010/01/02 23:56:06 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.435 $'; #' stupid emacs my $remoteVERSION; my $currenthostid="default"; my $currentdomainid; @@ -67,6 +67,7 @@ my $currentdomainid; my $client; my $clientip; # IP address of client. my $clientname; # LonCAPA name of client. +my $clientversion; # LonCAPA version running on client my $server; @@ -142,6 +143,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 +409,7 @@ sub isClient { # sub ReadManagerTable { + &Debug("Reading manager table"); # Clean out the old table first.. foreach my $key (keys %managers) { @@ -520,11 +532,9 @@ sub AdjustHostContents { } # # InstallFile: Called to install an administrative file: -# - The file is created with .tmp -# - The .tmp file is then mv'd to -# 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 .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 +542,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 +565,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 +639,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 +656,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(' CopyFile from '.$tablefile." to ".$backupfile." failed "); - return "error:$!"; - } - &logthis(' Pushfile: backed up ' - .$tablefile." to $backupfile"); - + # 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 +669,7 @@ sub PushFile { # Install the new file: + &logthis("Installing new $tablefile contents:\n$contents"); if(!InstallFile($tablefile, $contents)) { &logthis(' Pushfile: unable to install ' .$tablefile." $! "); @@ -1203,7 +1223,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 +1231,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 +1241,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 +1646,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. @@ -1786,8 +1816,9 @@ sub change_password_handler { # npass - New password. # context - Context in which this was called # (preferences or reset_by_email). + # lonhost - HostID of server where request originated - my ($udom,$uname,$upass,$npass,$context)=split(/:/,$tail); + my ($udom,$uname,$upass,$npass,$context,$lonhost)=split(/:/,$tail); $upass=&unescape($upass); $npass=&unescape($npass); @@ -1796,9 +1827,13 @@ sub change_password_handler { # First require that the user can be authenticated with their # old password unless context was 'reset_by_email': - my $validated; + my ($validated,$failure); if ($context eq 'reset_by_email') { - $validated = 1; + if ($lonhost eq '') { + $failure = 'invalid_client'; + } else { + $validated = 1; + } } else { $validated = &validate_user($udom, $uname, $upass); } @@ -1812,8 +1847,11 @@ sub change_password_handler { $salt=substr($salt,6,2); my $ncpass=crypt($npass,$salt); if(&rewrite_password_file($udom, $uname, "internal:$ncpass")) { - &logthis("Result of password change for " - ."$uname: pwchange_success"); + my $msg="Result of password change for $uname: pwchange_success"; + if ($lonhost) { + $msg .= " - request originated from: $lonhost"; + } + &logthis($msg); &Reply($client, "ok\n", $userinput); } else { &logthis("Unable to open $uname passwd " @@ -1834,7 +1872,10 @@ sub change_password_handler { } } else { - &Failure( $client, "non_authorized\n", $userinput); + if ($failure eq '') { + $failure = 'non_authorized'; + } + &Failure( $client, "$failure\n", $userinput); } return 1; @@ -2021,16 +2062,10 @@ sub is_home_handler { ®ister_handler("home", \&is_home_handler, 0,1,0); # -# Process an update request for a resource?? I think what's going on here is -# that a resource has been modified that we hold a subscription to. +# Process an update request for a resource. +# A resource has been modified that we hold a subscription to. # If the resource is not local, then we must update, or at least invalidate our # cached copy of the resource. -# FUTURE WORK: -# I need to look at this logic carefully. My druthers would be to follow -# typical caching logic, and simple invalidate the cache, drop any subscription -# an let the next fetch start the ball rolling again... however that may -# actually be more difficult than it looks given the complex web of -# proxy servers. # Parameters: # $cmd - The command that got us here. # $tail - Tail of the command (remaining parameters). @@ -2054,16 +2089,23 @@ sub update_resource_handler { my $ownership=ishome($fname); if ($ownership eq 'not_owner') { if (-e $fname) { + # Delete preview file, if exists + unlink("$fname.tmp"); + # Get usage stats my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size, $atime,$mtime,$ctime,$blksize,$blocks)=stat($fname); my $now=time; my $since=$now-$atime; + # If the file has not been used within lonExpire seconds, + # unsubscribe from it and delete local copy if ($since>$perlvar{'lonExpire'}) { my $reply=&Apache::lonnet::reply("unsub:$fname","$clientname"); &devalidate_meta_cache($fname); unlink("$fname"); unlink("$fname.meta"); } else { + # Yes, this is in active use. Get a fresh copy. Since it might be in + # very active use and huge (like a movie), copy it to "in.transfer" filename first. my $transname="$fname.in.transfer"; my $remoteurl=&Apache::lonnet::reply("sub:$fname","$clientname"); my $response; @@ -2091,6 +2133,7 @@ sub update_resource_handler { } alarm(0); } + # we successfully transfered, copy file over to real name rename($transname,$fname); &devalidate_meta_cache($fname); } @@ -3081,6 +3124,15 @@ sub dump_with_regexp { my $qresult=''; my $count=0; while (my ($key,$value) = each(%$hashref)) { + if ($namespace eq 'roles') { + if ($key =~ /^($LONCAPA::match_domain)_($LONCAPA::match_community)_(cc|co|in|ta|ep|ad|st|cr)/) { + if ($clientversion =~ /^(\d+)\.(\d+)$/) { + my $major = $1; + my $minor = $2; + next if (($major < 2) || (($major == 2) && ($minor < 9))); + } + } + } if ($regexp eq '.') { $count++; if (defined($range) && $count >= $end) { last; } @@ -3645,8 +3697,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 +3716,15 @@ 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. +# createdbefore - include courses for which creation date preceeded this date. +# createdafter - include courses for which creation date followed this date. +# creationcontext - include courses created in specified context # # $client - The socket open on the client. # Returns: @@ -3674,8 +3737,10 @@ 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,$createdbefore,$createdafter, + $creationcontext) =split(/:/,$tail); my $now = time; + my ($cloneruname,$clonerudom,%cc_clone); if (defined($description)) { $description=&unescape($description); } else { @@ -3718,6 +3783,35 @@ 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; + } + } + if ($createdbefore ne '') { + $createdbefore = &unescape($createdbefore); + } else { + $createdbefore = 0; + } + if ($createdafter ne '') { + $createdafter = &unescape($createdafter); + } else { + $createdafter = 0; + } + if ($creationcontext ne '') { + $creationcontext = &unescape($creationcontext); + } else { + $creationcontext = '.'; + } + my $unpack = 1; if ($description eq '.' && $instcodefilter eq '.' && $coursefilter eq '.' && $typefilter eq '.') { @@ -3729,7 +3823,8 @@ sub dump_course_id_handler { if ($hashref) { while (my ($key,$value) = each(%$hashref)) { my ($unesc_key,$lasttime_key,$lasttime,$is_hash,%val, - %unesc_val,$selfenroll_end,$selfenroll_types); + %unesc_val,$selfenroll_end,$selfenroll_types,$created, + $context); $unesc_key = &unescape($key); if ($unesc_key =~ /^lasttime:/) { next; @@ -3740,23 +3835,71 @@ 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') { + if ($hashref->{$lasttime_key} eq '') { + next if ($since > 1); + } $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'}; + $unesc_val{'created'} = $items->{'created'}; + $unesc_val{'context'} = $items->{'context'}; } $selfenroll_types = $items->{'selfenroll_types'}; $selfenroll_end = $items->{'selfenroll_end_date'}; + $created = $items->{'created'}; + $context = $items->{'context'}; if ($selfenrollonly) { next if (!$selfenroll_types); if (($selfenroll_end > 0) && ($selfenroll_end <= $now)) { next; } } + if ($creationcontext ne '.') { + next if (($context ne '') && ($context ne $creationcontext)); + } + if ($createdbefore > 0) { + next if (($created eq '') || ($created > $createdbefore)); + } + if ($createdafter > 0) { + next if (($created eq '') || ($created <= $createdafter)); + } if ($catfilter ne '') { next if ($items->{'categories'} eq ''); my @categories = split('&',$items->{'categories'}); @@ -3778,7 +3921,15 @@ sub dump_course_id_handler { } } else { next if ($catfilter ne ''); - next if ($selfenrollonly); + next if ($selfenrollonly); + next if ($createdbefore || $createdafter); + next if ($creationcontext ne '.'); + 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 +3938,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 +3954,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 +4027,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.'&'; @@ -3998,7 +4162,6 @@ sub get_domain_handler { } ®ister_handler("getdom", \&get_domain_handler, 0, 1, 0); - # # Puts an id to a domains id database. # @@ -4305,27 +4468,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 +4778,43 @@ 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,$description) = + &localenroll::validate_instcode($dom,$instcode,$owner); + my $result = &escape($outcome).'&'.&escape($description); + &Reply($client, \$result, $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 +5018,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 +5157,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,10 +6272,10 @@ 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]"; + $clientname = "[unknown]"; if($clientrec) { # Establish client type. $ConnectionType = "client"; $clientname = (&Apache::lonnet::get_hosts_from_ip($outsideip))[-1]; @@ -6012,7 +6303,7 @@ sub make_new_child { # # If the remote is attempting a local init... give that a try: # - my ($i, $inittype) = split(/:/, $remotereq); + (my $i, my $inittype, $clientversion) = split(/:/, $remotereq); # If the connection type is ssl, but I didn't get my # certificate files yet, then I'll drop back to @@ -6032,6 +6323,7 @@ sub make_new_child { } if($inittype eq "local") { + $clientversion = $perlvar{'lonVersion'}; my $key = LocalConnection($client, $remotereq); if($key) { Debug("Got local key $key");