--- loncom/lond	2009/03/03 12:08:07	1.412
+++ loncom/lond	2009/09/13 03:13:21	1.426
@@ -2,7 +2,7 @@
 # The LearningOnline Network
 # lond "LON Daemon" Server (port "LOND" 5663)
 #
-# $Id: lond,v 1.412 2009/03/03 12:08:07 foxr Exp $
+# $Id: lond,v 1.426 2009/09/13 03:13:21 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -54,12 +54,12 @@ use LONCAPA::lonssl;
 use Fcntl qw(:flock);
 use Apache::lonnet;
 
-my $DEBUG = 1;		       # Non zero to enable debug log entries.
+my $DEBUG = 0;		       # Non zero to enable debug log entries.
 
 my $status='';
 my $lastlog='';
 
-my $VERSION='$Revision: 1.412 $'; #' stupid emacs
+my $VERSION='$Revision: 1.426 $'; #' stupid emacs
 my $remoteVERSION;
 my $currenthostid="default";
 my $currentdomainid;
@@ -1645,6 +1645,14 @@ sub server_timezone_handler {
 }
 &register_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;
+}
+&register_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.
@@ -3666,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 
@@ -3683,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:
@@ -3695,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 {
@@ -3739,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 '.') {
@@ -3761,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'};
@@ -3799,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);
@@ -3808,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) {
@@ -3821,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;
@@ -3890,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.'&';
@@ -4019,7 +4101,6 @@ sub get_domain_handler {
 }
 &register_handler("getdom", \&get_domain_handler, 0, 1, 0);
 
-
 #
 #  Puts an id to a domains id database. 
 #
@@ -4326,27 +4407,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) {
@@ -4633,6 +4717,43 @@ sub enrollment_enabled_handler {
 }
 &register_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;
+}
+&register_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.
@@ -4836,6 +4957,61 @@ sub retrieve_auto_file_handler {
 }
 &register_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;
+}
+&register_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;
+}
+&register_handler("autocrsreqvalidation", \&validate_crsreq_handler, 0, 1, 0);
+
 #
 #   Read and retrieve institutional code format (for support form).
 # Formal Parameters:
@@ -4920,6 +5096,39 @@ sub get_institutional_defaults_handler {
 &register_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;
+}
+&register_handler("autopossibleinstcodes",
+                  \&get_possible_instcodes_handler,0,1,0);
+
 sub get_institutional_user_rules {
     my ($cmd, $tail, $client)   = @_;
     my $userinput               = "$cmd:$tail";