--- loncom/lonnet/perl/lonnet.pm	2003/04/03 22:17:09	1.359
+++ loncom/lonnet/perl/lonnet.pm	2003/05/04 07:38:32	1.368
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.359 2003/04/03 22:17:09 albertel Exp $
+# $Id: lonnet.pm,v 1.368 2003/05/04 07:38:32 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -591,7 +591,11 @@ sub idput {
 # --------------------------------------------------- Assign a key to a student
 
 sub assign_access_key {
-    my ($ckey,$cdom,$cnum,$udom,$uname)=@_;
+#
+# a valid key looks like uname:udom#comments
+# comments are being appended
+#
+    my ($ckey,$cdom,$cnum,$udom,$uname,$logentry)=@_;
     $cdom=
    $ENV{'course.'.$ENV{'request.course.id'}.'.domain'} unless (defined($cdom));
     $cnum=
@@ -599,13 +603,16 @@ sub assign_access_key {
     $udom=$ENV{'user.name'} unless (defined($udom));
     $uname=$ENV{'user.domain'} unless (defined($uname));
     my %existing=&get('accesskeys',[$ckey],$cdom,$cnum);
-    if (($existing{$ckey}=~/^\d+$/) || # has time - new key
-        ($existing{$ckey} eq $uname.':'.$udom)) { # this should not happen,
+    if (($existing{$ckey}=~/^\#(.*)$/) || # - new key
+        ($existing{$ckey}=~/^$uname\:$udom\#(.*)$/)) { 
+                                                  # assigned to this person
+                                                  # - this should not happen,
                                                   # unless something went wrong
                                                   # the first time around
 # ready to assign
-    } elsif (!$existing{$ckey}) {
-        if (&put('accesskey',{$ckey=>$uname.':'.$udom},$cdom,$cnum) eq 'ok') {
+        $logentry=$1.'; '.$logentry;
+        if (&put('accesskey',{$ckey=>$uname.':'.$udom.'#'.$logentry},
+                                                 $cdom,$cnum) eq 'ok') {
 # key now belongs to user
 	    my $envkey='key.'.$cdom.'_'.$cnum;
             if (&put('environment',{$envkey => $ckey}) eq 'ok') {
@@ -618,6 +625,7 @@ sub assign_access_key {
         } else {
             return 'error: Could not assign key, try again later.';
         }
+    } elsif (!$existing{$ckey}) {
 # the key does not exist
 	return 'error: The key does not exist';
     } else {
@@ -626,15 +634,43 @@ sub assign_access_key {
     }
 }
 
+# ------------------------------------------ put an additional comment on a key
+
+sub comment_access_key {
+#
+# a valid key looks like uname:udom#comments
+# comments are being appended
+#
+    my ($ckey,$cdom,$cnum,$logentry)=@_;
+    $cdom=
+   $ENV{'course.'.$ENV{'request.course.id'}.'.domain'} unless (defined($cdom));
+    $cnum=
+   $ENV{'course.'.$ENV{'request.course.id'}.'.num'} unless (defined($cnum));
+    my %existing=&get('accesskeys',[$ckey],$cdom,$cnum);
+    if ($existing{$ckey}) {
+        $existing{$ckey}.='; '.$logentry;
+# ready to assign
+        if (&put('accesskeys',{$ckey=>$existing{$ckey}},
+                                                 $cdom,$cnum) eq 'ok') {
+	    return 'ok';
+        } else {
+	    return 'error: Count not store comment.';
+        }
+    } else {
+# the key does not exist
+	return 'error: The key does not exist';
+    }
+}
+
 # ------------------------------------------------------ Generate a set of keys
 
 sub generate_access_keys {
-    my ($number,$cdom,$cnum)=@_;
+    my ($number,$cdom,$cnum,$logentry)=@_;
     $cdom=
    $ENV{'course.'.$ENV{'request.course.id'}.'.domain'} unless (defined($cdom));
     $cnum=
    $ENV{'course.'.$ENV{'request.course.id'}.'.num'} unless (defined($cnum));
-    unless (&allowed('ccc',$cdom)) { return 0; }
+    unless (&allowed('mky',$cdom)) { return 0; }
     unless (($cdom) && ($cnum)) { return 0; }
     if ($number>10000) { return 0; }
     sleep(2); # make sure don't get same seed twice
@@ -650,7 +686,11 @@ sub generate_access_keys {
        if ($existing{$newkey}) {
            $i--;
        } else {
-	  if (&put('accesskeys',{ $newkey => time() },$cdom,$cnum) eq 'ok') {
+	  if (&put('accesskeys',
+              { $newkey => '# generated '.localtime().
+                           ' by '.$ENV{'user.name'}.'@'.$ENV{'user.domain'}.
+                           '; '.$logentry },
+		   $cdom,$cnum) eq 'ok') {
               $total++;
 	  }
        }
@@ -671,7 +711,7 @@ sub validate_access_key {
     $udom=$ENV{'user.name'} unless (defined($udom));
     $uname=$ENV{'user.domain'} unless (defined($uname));
     my %existing=&get('accesskeys',[$ckey],$cdom,$cnum);
-    return ($existing{$ckey} eq $uname.':'.$udom);
+    return ($existing{$ckey}=~/^$uname\:$udom\#/);
 }
 
 # ------------------------------------- Find the section of student in a course
@@ -1149,6 +1189,14 @@ sub countacc {
     }
 }
 
+sub linklog {
+    my ($from,$to)=@_;
+    $from=&declutter($from);
+    $to=&declutter($to);
+    $accesshash{$from.'___'.$to.'___comefrom'}=1;
+    $accesshash{$to.'___'.$from.'___goto'}=1;
+}
+  
 sub userrolelog {
     my ($trole,$username,$domain,$area,$tstart,$tend)=@_;
     if (($trole=~/^ca/) || ($trole=~/^in/) || 
@@ -3096,8 +3144,8 @@ sub EXT {
     my $courseid;
     my $publicuser;
     if (!($uname && $udom)) {
-      (my $cursymb,$courseid,$udom,$uname)=&Apache::lonxml::whichuser();
-      if ($udom eq 'public' and $uname =~ /^public/) { $publicuser='1'; }
+      (my $cursymb,$courseid,$udom,$uname,$publicuser)=
+	  &Apache::lonxml::whichuser();
       if (!$symbparm) {	$symbparm=$cursymb; }
     } else {
 	$courseid=$ENV{'request.course.id'};
@@ -3363,6 +3411,7 @@ sub metadata {
         my $parser=HTML::LCParser->new(\$metastring);
         my $token;
         undef %metathesekeys;
+	delete($metacache{$uri.':packages'});
         while ($token=$parser->get_token) {
 	    if ($token->[0] eq 'S') {
 		if (defined($token->[2]->{'package'})) {
@@ -3538,6 +3587,7 @@ sub gettitle {
         $title=$bighash{'title_'.$mapid.'.'.$resid};
         untie %bighash;
     }
+    $title=~s/\&colon\;/\:/gs;
     if ($title) {
         $titlecache{$symb}=$title;
         return $title;
@@ -3711,29 +3761,92 @@ sub numval {
     $txt=~tr/u-z/0-5/;
     $txt=~s/\D//g;
     return int($txt);
-}    
+}
+
+sub latest_rnd_algorithm_id {
+    return '64bit';
+}
 
 sub rndseed {
     my ($symb,$courseid,$domain,$username)=@_;
+
+    my ($wsymb,$wcourseid,$wdomain,$wusername)=&Apache::lonxml::whichuser();
     if (!$symb) {
-      unless ($symb=&symbread()) { return time; }
+	unless ($symb=$wsymb) { return time; }
+    }
+    if (!$courseid) { $courseid=$wcourseid; }
+    if (!$domain) { $domain=$wdomain; }
+    if (!$username) { $username=$wusername }
+    my $which=$ENV{"course.$courseid.rndseed"};
+    my $CODE=$ENV{'scantron.CODE'};
+    if (defined($CODE)) {
+	&rndseed_CODE_64bit($symb,$courseid,$domain,$username);
+    } elsif ($which eq '64bit') {
+	return &rndseed_64bit($symb,$courseid,$domain,$username);
+    }
+    return &rndseed_32bit($symb,$courseid,$domain,$username);
+}
+
+sub rndseed_32bit {
+    my ($symb,$courseid,$domain,$username)=@_;
+    {
+	use integer;
+	my $symbchck=unpack("%32C*",$symb) << 27;
+	my $symbseed=numval($symb) << 22;
+	my $namechck=unpack("%32C*",$username) << 17;
+	my $nameseed=numval($username) << 12;
+	my $domainseed=unpack("%32C*",$domain) << 7;
+	my $courseseed=unpack("%32C*",$courseid);
+	my $num=$symbseed+$nameseed+$domainseed+$courseseed+$namechck+$symbchck;
+	#&Apache::lonxml::debug("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck");
+	#&Apache::lonxml::debug("rndseed :$num:$symb");
+	return $num;
+    }
+}
+
+sub rndseed_64bit {
+    my ($symb,$courseid,$domain,$username)=@_;
+    {
+	use integer;
+	my $symbchck=unpack("%32S*",$symb) << 21;
+	my $symbseed=numval($symb) << 10;
+	my $namechck=unpack("%32S*",$username);
+	
+	my $nameseed=numval($username) << 21;
+	my $domainseed=unpack("%32S*",$domain) << 10;
+	my $courseseed=unpack("%32S*",$courseid);
+	
+	my $num1=$symbchck+$symbseed+$namechck;
+	my $num2=$nameseed+$domainseed+$courseseed;
+	#&Apache::lonxml::debug("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck");
+	#&Apache::lonxml::debug("rndseed :$num:$symb");
+	return "$num1,$num2";
     }
-    if (!$courseid) { $courseid=$ENV{'request.course.id'};}
-    if (!$domain) {$domain=$ENV{'user.domain'};}
-    if (!$username) {$username=$ENV{'user.name'};}
+}
+
+sub rndseed_CODE_64bit {
+    my ($symb,$courseid,$domain,$username)=@_;
     {
-      use integer;
-      my $symbchck=unpack("%32C*",$symb) << 27;
-      my $symbseed=numval($symb) << 22;
-      my $namechck=unpack("%32C*",$username) << 17;
-      my $nameseed=numval($username) << 12;
-      my $domainseed=unpack("%32C*",$domain) << 7;
-      my $courseseed=unpack("%32C*",$courseid);
-      my $num=$symbseed+$nameseed+$domainseed+$courseseed+$namechck+$symbchck;
-      #uncommenting these lines can break things!
-      #&Apache::lonxml::debug("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck");
-      #&Apache::lonxml::debug("rndseed :$num:$symb");
-      return $num;
+	use integer;
+	my $symbchck=unpack("%32S*",$symb) << 16;
+	my $symbseed=numval($symb);
+	my $CODEseed=numval($ENV{'scantron.CODE'}) << 16;
+	my $courseseed=unpack("%32S*",$courseid);
+	my $num1=$symbseed+$CODEseed;
+	my $num2=$courseseed+$symbchck;
+	#&Apache::lonxml::debug("$symbseed:$CODEseed|$courseseed:$symbchck");
+	#&Apache::lonxml::debug("rndseed :$num1:$num2:$symb");
+	return "$num1,$num2";
+    }
+}
+
+sub setup_random_from_rndseed {
+    my ($rndseed)=@_;
+    if ($rndseed =~/,/) {
+	my ($num1,$num2)=split(/,/,$rndseed);
+	&Math::Random::random_set_seed(abs($num1),abs($num2));
+    } else {
+	&Math::Random::random_set_seed_from_phrase($rndseed);
     }
 }
 
@@ -3859,6 +3972,7 @@ sub goodbye {
    &logthis("Starting Shut down");
    &flushcourselogs();
    &logthis("Shutting down");
+   return DONE;
 }
 
 BEGIN {