--- loncom/lonnet/perl/lonnet.pm	2015/09/20 18:31:43	1.1293
+++ loncom/lonnet/perl/lonnet.pm	2016/01/31 21:25:57	1.1300
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1293 2015/09/20 18:31:43 raeburn Exp $
+# $Id: lonnet.pm,v 1.1300 2016/01/31 21:25:57 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -422,8 +422,8 @@ sub reply {
 
 sub reconlonc {
     my ($lonid) = @_;
-    my $hostname = &hostname($lonid);
     if ($lonid) {
+        my $hostname = &hostname($lonid);
 	my $peerfile="$perlvar{'lonSockDir'}/$hostname";
 	if ($hostname && -e $peerfile) {
 	    &logthis("Trying to reconnect lonc for $lonid ($hostname)");
@@ -448,7 +448,7 @@ sub reconlonc {
 	    &logthis("lonc at pid $loncpid responding, sending USR1");
             kill USR1 => $loncpid;
             sleep 1;
-         } else {
+        } else {
 	    &logthis(
                "<font color=\"blue\">WARNING:".
                " lonc at pid $loncpid not responding, giving up</font>");
@@ -469,7 +469,7 @@ sub critical {
     }
     my $answer=reply($cmd,$server);
     if ($answer eq 'con_lost') {
-	&reconlonc("$perlvar{'lonSockDir'}/$server");
+	&reconlonc($server);
 	my $answer=reply($cmd,$server);
         if ($answer eq 'con_lost') {
             my $now=time;
@@ -1551,17 +1551,33 @@ sub homeserver {
     return 'no_host';
 }
 
-# ------------------------------------- Find the usernames behind a list of IDs
+# ----- Find the usernames behind a list of student/employee IDs or clicker IDs
 
 sub idget {
-    my ($udom,@ids)=@_;
+    my ($udom,$idsref,$namespace)=@_;
     my %returnhash=();
+    my @ids=(); 
+    if (ref($idsref) eq 'ARRAY') {
+        @ids = @{$idsref};
+    } else {
+        return %returnhash; 
+    }
+    if ($namespace eq '') {
+        $namespace = 'ids';
+    }
     
     my %servers = &get_servers($udom,'library');
     foreach my $tryserver (keys(%servers)) {
-	my $idlist=join('&',@ids);
-	$idlist=~tr/A-Z/a-z/; 
-	my $reply=&reply("idget:$udom:".$idlist,$tryserver);
+	my $idlist=join('&', map { &escape($_); } @ids);
+	if ($namespace eq 'ids') {
+	    $idlist=~tr/A-Z/a-z/;
+	}
+	my $reply;
+	if ($namespace eq 'ids') {
+	    $reply=&reply("idget:$udom:".$idlist,$tryserver);
+	} else {
+	    $reply=&reply("getdom:$udom:$namespace:$idlist",$tryserver);
+	}
 	my @answer=();
 	if (($reply ne 'con_lost') && ($reply!~/^error\:/)) {
 	    @answer=split(/\&/,$reply);
@@ -1569,10 +1585,10 @@ sub idget {
 	my $i;
 	for ($i=0;$i<=$#ids;$i++) {
 	    if ($answer[$i]) {
-		$returnhash{$ids[$i]}=$answer[$i];
-	    } 
+		$returnhash{$ids[$i]}=&unescape($answer[$i]);
+	    }
 	}
-    } 
+    }
     return %returnhash;
 }
 
@@ -1587,60 +1603,141 @@ sub idrget {
     return %returnhash;
 }
 
-# ------------------------------- Store away a list of names and associated IDs
+# Store away a list of names and associated student/employee IDs or clicker IDs
 
 sub idput {
-    my ($udom,%ids)=@_;
+    my ($udom,$idsref,$uhom,$namespace)=@_;
     my %servers=();
+    my %ids=();
+    my %byid = ();
+    if (ref($idsref) eq 'HASH') {
+        %ids=%{$idsref};
+    }
+    if ($namespace eq '') {
+        $namespace = 'ids'; 
+    }
     foreach my $uname (keys(%ids)) {
 	&cput('environment',{'id'=>$ids{$uname}},$udom,$uname);
-        my $uhom=&homeserver($uname,$udom);
+        if ($uhom eq '') {
+            $uhom=&homeserver($uname,$udom);
+        }
         if ($uhom ne 'no_host') {
-            my $id=&escape($ids{$uname});
-            $id=~tr/A-Z/a-z/;
             my $esc_unam=&escape($uname);
-	    if ($servers{$uhom}) {
-		$servers{$uhom}.='&'.$id.'='.$esc_unam;
+            if ($namespace eq 'ids') {
+                my $id=&escape($ids{$uname});
+                $id=~tr/A-Z/a-z/;
+                my $esc_unam=&escape($uname);
+                $servers{$uhom}.=$id.'='.$esc_unam.'&';
             } else {
-                $servers{$uhom}=$id.'='.$esc_unam;
+                my @currids = split(/,/,$ids{$uname});
+                foreach my $id (@currids) {
+                    $byid{$uhom}{$id} .= $uname.',';
+                }
+            }
+        }
+    }
+    if ($namespace eq 'clickers') {
+        foreach my $server (keys(%byid)) {
+            if (ref($byid{$server}) eq 'HASH') {
+                foreach my $id (keys(%{$byid{$server}})) {
+                    $byid{$server} =~ s/,$//;
+                    $servers{$uhom}.=&escape($id).'='.&escape($byid{$server}).'&'; 
+                }
             }
         }
     }
     foreach my $server (keys(%servers)) {
-        &critical('idput:'.$udom.':'.$servers{$server},$server);
+        $servers{$server} =~ s/\&$//;
+        if ($namespace eq 'ids') {     
+            &critical('idput:'.$udom.':'.$servers{$server},$server);
+        } else {
+            &critical('updateclickers:'.$udom.':add:'.$servers{$server},$server);
+        }
     }
 }
 
-# ---------------------------------------- Delete unwanted IDs from ids.db file 
+# ------------- Delete unwanted student/employee IDs or clicker IDs from domain
 
 sub iddel {
-    my ($udom,$idshashref,$uhome)=@_;
+    my ($udom,$idshashref,$uhome,$namespace)=@_;
     my %result=();
-    unless (ref($idshashref) eq 'HASH') {
+    my %ids=();
+    my %byid = ();
+    if (ref($idshashref) eq 'HASH') {
+        %ids=%{$idshashref};
+    } else {
         return %result;
     }
+    if ($namespace eq '') {
+        $namespace = 'ids';
+    }
     my %servers=();
-    while (my ($id,$uname) = each(%{$idshashref})) {
-        my $uhom;
-        if ($uhome) {
-            $uhom = $uhome;
-        } else {
-            $uhom=&homeserver($uname,$udom);
-        }
-        if ($uhom ne 'no_host') {
-            if ($servers{$uhom}) {
+    while (my ($id,$unamestr) = each(%ids)) {
+        if ($namespace eq 'ids') {
+            my $uhom = $uhome;
+            if ($uhom eq '') { 
+                $uhom=&homeserver($unamestr,$udom);
+            }
+            if ($uhom ne 'no_host') {
                 $servers{$uhom}.='&'.&escape($id);
-            } else {
-                $servers{$uhom}=&escape($id);
+            }
+         } else {
+            my @curritems = split(/,/,$ids{$id});
+            foreach my $uname (@curritems) {
+                my $uhom = $uhome;
+                if ($uhom eq '') {
+                    $uhom=&homeserver($uname,$udom);
+                }
+                if ($uhom ne 'no_host') { 
+                    $byid{$uhom}{$id} .= $uname.',';
+                }
+            }
+        }
+    }
+    if ($namespace eq 'clickers') {
+        foreach my $server (keys(%byid)) {
+            if (ref($byid{$server}) eq 'HASH') {
+                foreach my $id (keys(%{$byid{$server}})) {
+                    $byid{$server}{$id} =~ s/,$//;
+                    $servers{$server}.=&escape($id).'='.&escape($byid{$server}{$id}).'&';
+                }
             }
         }
     }
     foreach my $server (keys(%servers)) {
-        $result{$server} = &critical('iddel:'.$udom.':'.$servers{$server},$uhome);
+        $servers{$server} =~ s/\&$//;
+        if ($namespace eq 'ids') {
+            $result{$server} = &critical('iddel:'.$udom.':'.$servers{$server},$uhome);
+        } elsif ($namespace eq 'clickers') {
+            $result{$server} = &critical('updateclickers:'.$udom.':del:'.$servers{$server},$server);
+        }
     }
     return %result;
 }
 
+# ----- Update clicker ID-to-username look-ups in clickers.db on library server 
+
+sub updateclickers {
+    my ($udom,$action,$idshashref,$uhome,$critical) = @_;
+    my %clickers;
+    if (ref($idshashref) eq 'HASH') {
+        %clickers=%{$idshashref};
+    } else {
+        return;
+    }
+    my $items='';
+    foreach my $item (keys(%clickers)) {
+        $items.=&escape($item).'='.&escape($clickers{$item}).'&';
+    }
+    $items=~s/\&$//;
+    my $request = "updateclickers:$udom:$action:$items";
+    if ($critical) {
+        return &critical($request,$uhome);
+    } else {
+        return &reply($request,$uhome);
+    }
+}
+
 # ------------------------------dump from db file owned by domainconfig user
 sub dump_dom {
     my ($namespace, $udom, $regexp) = @_;
@@ -2980,6 +3077,14 @@ sub can_edit_resource {
                         $forceedit = 1;
                     }
                     $cfile = $resurl;
+                } elsif ($resurl =~ m{^/adm/wrapper/adm/$cdom/$cnum/\d+/exttools?$}) {
+                    $incourse = 1;
+                    if ($env{'form.forceedit'}) {
+                        $forceview = 1;
+                    } else {
+                        $forceedit = 1;
+                    }
+                    $cfile = $resurl;
                 } elsif ($resurl =~ m{^/?adm/viewclasslist$}) {
                     $incourse = 1;
                     if ($env{'form.forceedit'}) {
@@ -3004,6 +3109,14 @@ sub can_edit_resource {
                         $forceedit = 1;
                     }
                     $cfile = $resurl;
+            } elsif (($resurl =~ m{^/adm/wrapper/adm/$cdom/$cnum/\d+/exttools?$}) && ($env{'form.folderpath'} =~ /^supplemental/)) {
+                $incourse = 1;
+                if ($env{'form.forceedit'}) {
+                    $forceview = 1;
+                } else {
+                    $forceedit = 1;
+                }
+                $cfile = $resurl;
             } elsif (($resurl eq '/adm/extresedit') && ($symb || $env{'form.folderpath'})) {
                 $incourse = 1;
                 $forceview = 1;
@@ -3013,8 +3126,13 @@ sub can_edit_resource {
                     $cfile = &clutter($res);
                 } else {
                     $cfile = $env{'form.suppurl'};
-                    $cfile =~ s{^http://}{};
-                    $cfile = '/adm/wrapper/ext/'.$cfile;
+                    my $escfile = &unescape($cfile);
+                    if ($escfile =~ m{^/adm/$cdom/$cnum/\d+/exttools?$}) {
+                        $cfile = '/adm/wrapper'.$escfile;
+                    } else {
+                        $escfile =~ s{^http://}{};
+                        $cfile = &escape("/adm/wrapper/ext/$escfile");
+                    }
                 }
             } elsif ($resurl =~ m{^/?adm/viewclasslist$}) {
                 if ($env{'form.forceedit'}) {
@@ -7213,7 +7331,7 @@ sub constructaccess {
     my ($ownername,$ownerdomain,$ownerhome);
 
     ($ownerdomain,$ownername) =
-        ($url=~ m{^(?:\Q$perlvar{'lonDocRoot'}\E|)/priv/($match_domain)/($match_username)/});
+        ($url=~ m{^(?:\Q$perlvar{'lonDocRoot'}\E|)(?:/daxepage|/daxeopen)?/priv/($match_domain)/($match_username)/});
 
 # The URL does not really point to any authorspace, forget it
     unless (($ownername) && ($ownerdomain)) { return ''; }
@@ -8792,7 +8910,7 @@ sub modifyuser {
                   'current user id "'.$uidhash{$uname}.'".';
           }
        } else {
-	  &idput($udom,($uname => $uid));
+	  &idput($udom,{$uname => $uid},$uhome,'ids');
        }
     }
 # -------------------------------------------------------------- Add names, etc
@@ -10174,10 +10292,12 @@ sub get_userresdata {
     }
     #error 2 occurs when the .db doesn't exist
     if ($tmp!~/error: 2 /) {
-	&logthis("<font color=\"blue\">WARNING:".
-		 " Trying to get resource data for ".
-		 $uname." at ".$udom.": ".
-		 $tmp."</font>");
+        if ((!defined($cached)) || ($tmp ne 'con_lost')) {
+	    &logthis("<font color=\"blue\">WARNING:".
+		     " Trying to get resource data for ".
+		     $uname." at ".$udom.": ".
+		     $tmp."</font>");
+        }
     } elsif ($tmp=~/error: 2 /) {
 	#&EXT_cache_set($udom,$uname);
 	&do_cache_new('userres',$hashid,undef,600);
@@ -10217,6 +10337,25 @@ sub resdata {
     return undef;
 }
 
+sub get_domain_ltitools {
+    my ($cdom) = @_;
+    my %ltitools;
+    my ($result,$cached)=&is_cached_new('ltitools',$cdom);
+    if (defined($cached)) {
+        if (ref($result) eq 'HASH') {
+            %ltitools = %{$result};
+        }
+    } else {
+        my %domconfig = &get_dom('configuration',['ltitools'],$cdom);
+        if (ref($domconfig{'ltitools'}) eq 'HASH') {
+            %ltitools = %{$domconfig{'ltitools'}};
+        }
+        my $cachetime = 24*60*60;
+        &do_cache_new('ltitools',$cdom,\%ltitools,$cachetime);
+    }
+    return %ltitools;
+}
+
 sub get_numsuppfiles {
     my ($cnum,$cdom,$ignorecache)=@_;
     my $hashid=$cnum.':'.$cdom;
@@ -10671,7 +10810,7 @@ sub metadata {
     # if it is a non metadata possible uri return quickly
     if (($uri eq '') || 
 	(($uri =~ m|^/*adm/|) && 
-	     ($uri !~ m|^adm/includes|) && ($uri !~ m{/(smppg|bulletinboard)$})) ||
+	     ($uri !~ m|^adm/includes|) && ($uri !~ m{/(smppg|bulletinboard|exttools?)$})) ||
         ($uri =~ m|/$|) || ($uri =~ m|/.meta$|) || ($uri =~ m{^/*uploaded/.+\.sequence$})) {
 	return undef;
     }
@@ -12204,6 +12343,8 @@ sub clutter {
 #		&logthis("Got a blank emb style");
 	    }
 	}
+    } elsif ($thisfn =~ m{^/adm/$match_domain/$match_courseid/\d+/exttools?$}) {
+        $thisfn='/adm/wrapper'.$thisfn;
     }
     return $thisfn;
 }
@@ -13146,10 +13287,12 @@ the answer, and also caches if there is
 
 =item *
 X<idget()>
-B<idget($udom,@ids)>: find the usernames behind a list of IDs
-(IDs are a unique resource in a domain, there must be only 1 ID per
-username, and only 1 username per ID in a specific domain) (returns
-hash: id=>name,id=>name)
+B<idget($udom,$idsref,$namespace)>: find the usernames behind either 
+a list of student/employee IDs or clicker IDs
+(student/employee IDs are a unique resource in a domain, there must be 
+only 1 ID per username, and only 1 username per ID in a specific domain).
+clickerIDs are not necessarily unique, as students might share clickers.
+(returns hash: id=>name,id=>name)
 
 =item *
 X<idrget()>
@@ -13158,7 +13301,27 @@ usernames (returns hash: name=>id,name=>
 
 =item *
 X<idput()>
-B<idput($udom,%ids)>: store away a list of names and associated IDs
+B<idput($udom,$idsref,$uhome,$namespace)>: store away a list of 
+names and associated student/employee IDs or clicker IDs.
+
+=item *
+X<iddel()>
+B<iddel($udom,$idshashref,$uhome,$namespace)>: delete unwanted 
+student/employee ID or clicker ID username look-ups from domain.
+The homeserver ($uhome) and namespace ($namespace) are optional.
+If no $uhome is provided, it will be determined usig &homeserver()
+for each user.  If no $namespace is provided, the default is ids.
+
+=item *
+X<updateclickers()>
+B<updateclickers($udom,$action,$idshashref,$uhome,$critical)>: update 
+clicker ID-to-username look-ups in clickers.db on library server.
+Permitted actions are add or del (i.e., add or delete). The 
+clickers.db contains clickerID as keys (escaped), and each corresponding
+value is an escaped comma-separated list of usernames (for whom the
+library server is the homeserver), who registered that particular ID.
+If $critical is true, the update will be sent via &critical, otherwise
+&reply() will be used.
 
 =item *
 X<rolesinit()>