[BACK]Return to lond CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom

Diff for /loncom/lond between versions 1.332 and 1.342

version 1.332, 2006/05/31 14:47:56 version 1.342, 2006/09/05 15:35:14
Line 835  sub AdjustOurHost { Line 835  sub AdjustOurHost {
     #   Use the config line to get my hostname.      #   Use the config line to get my hostname.
     #   Use gethostbyname to translate that into an IP address.      #   Use gethostbyname to translate that into an IP address.
     #      #
     my ($id,$domain,$role,$name,$ip,$maxcon,$idleto,$mincon) = split(/:/,$ConfigLine);      my ($id,$domain,$role,$name,$maxcon,$idleto,$mincon) = split(/:/,$ConfigLine);
     my $BinaryIp = gethostbyname($name);  
     my $ip       = inet_ntoa($ip);  
     #      #
     #  Reassemble the config line from the elements in the list.      #  Reassemble the config line from the elements in the list.
     #  Note that if the loncnew items were not present before, they will      #  Note that if the loncnew items were not present before, they will
     #  be now even if they would be empty      #  be now even if they would be empty
     #      #
     my $newConfigLine = $id;      my $newConfigLine = $id;
     foreach my $item ($domain, $role, $name, $ip, $maxcon, $idleto, $mincon) {      foreach my $item ($domain, $role, $name, $maxcon, $idleto, $mincon) {
  $newConfigLine .= ":".$item;   $newConfigLine .= ":".$item;
     }      }
     #  Replace the line:      #  Replace the line:
Line 890  sub EditFile { Line 888  sub EditFile {
   
     #  Split the command into it's pieces:  edit:filetype:script      #  Split the command into it's pieces:  edit:filetype:script
   
     my ($request, $filetype, $script) = split(/:/, $request,3); # : in script      my ($cmd, $filetype, $script) = split(/:/, $request,3); # : in script
   
     #  Check the pre-coditions for success:      #  Check the pre-coditions for success:
   
     if($request != "edit") { # Something is amiss afoot alack.      if($cmd != "edit") { # Something is amiss afoot alack.
  return "error:edit request detected, but request != 'edit'\n";   return "error:edit request detected, but request != 'edit'\n";
     }      }
     if( ($filetype ne "hosts")  &&      if( ($filetype ne "hosts")  &&
Line 1252  sub push_file_handler { Line 1250  sub push_file_handler {
 #  #
 sub du_handler {  sub du_handler {
     my ($cmd, $ududir, $client) = @_;      my ($cmd, $ududir, $client) = @_;
     my ($ududir) = split(/:/,$ududir); # Make 'telnet' testing easier.      ($ududir) = split(/:/,$ududir); # Make 'telnet' testing easier.
     my $userinput = "$cmd:$ududir";      my $userinput = "$cmd:$ududir";
   
     if ($ududir=~/\.\./ || $ududir!~m|^/home/httpd/|) {      if ($ududir=~/\.\./ || $ududir!~m|^/home/httpd/|) {
Line 1847  sub update_resource_handler { Line 1845  sub update_resource_handler {
  my $reply=&reply("unsub:$fname","$clientname");   my $reply=&reply("unsub:$fname","$clientname");
  &devalidate_meta_cache($fname);   &devalidate_meta_cache($fname);
  unlink("$fname");   unlink("$fname");
    unlink("$fname.meta");
     } else {      } else {
  my $transname="$fname.in.transfer";   my $transname="$fname.in.transfer";
  my $remoteurl=&reply("sub:$fname","$clientname");   my $remoteurl=&reply("sub:$fname","$clientname");
Line 2594  sub get_profile_entry_encrypted { Line 2593  sub get_profile_entry_encrypted {
   
     my $userinput = "$cmd:$tail";      my $userinput = "$cmd:$tail";
         
     my ($cmd,$udom,$uname,$namespace,$what) = split(/:/,$userinput);      my ($udom,$uname,$namespace,$what) = split(/:/,$tail);
     chomp($what);      chomp($what);
     my $qresult = read_profile($udom, $uname, $namespace, $what);      my $qresult = read_profile($udom, $uname, $namespace, $what);
     my ($first) = split(/:/, $qresult);      my ($first) = split(/:/, $qresult);
Line 3040  sub restore_handler { Line 3039  sub restore_handler {
   
     my $userinput = "$cmd:$tail"; # Only used for logging purposes.      my $userinput = "$cmd:$tail"; # Only used for logging purposes.
   
     my ($cmd,$udom,$uname,$namespace,$rid) = split(/:/,$userinput);      my ($udom,$uname,$namespace,$rid) = split(/:/,$tail);
     $namespace=~s/\//\_/g;      $namespace=~s/\//\_/g;
     $namespace=~s/\W//g;      $namespace=~s/\W//g;
     chomp($rid);      chomp($rid);
Line 3215  sub reply_query_handler { Line 3214  sub reply_query_handler {
   
     my $userinput = "$cmd:$tail";      my $userinput = "$cmd:$tail";
   
     my ($cmd,$id,$reply)=split(/:/,$userinput);       my ($id,$reply)=split(/:/,$tail); 
     my $store;      my $store;
     my $execdir=$perlvar{'lonDaemons'};      my $execdir=$perlvar{'lonDaemons'};
     if ($store=IO::File->new(">$execdir/tmp/$id")) {      if ($store=IO::File->new(">$execdir/tmp/$id")) {
Line 3288  sub put_course_id_handler { Line 3287  sub put_course_id_handler {
             my @new_items = split(/:/,$courseinfo);              my @new_items = split(/:/,$courseinfo);
             my $numnew = scalar(@new_items);              my $numnew = scalar(@new_items);
             if ($numcurrent > 0) {              if ($numcurrent > 0) {
                 if ($numnew == 1) { # flushcourselogs() from 1.1 or earlier                  if ($numnew <= $numcurrent) { # flushcourselogs() from pre 2.2 
                     $courseinfo .= ':'.join(':',@current_items);                      for (my $j=$numcurrent-$numnew; $j>=0; $j--) {
                 } elsif ($numnew == 2) { # flushcourselogs() from 1.2.X                          $courseinfo .= ':'.$current_items[$numcurrent-$j-1];
                     $courseinfo .= ':'.$current_items[$numcurrent-1];                      }
                 }                  }
             }              }
     $hashref->{$key}=$courseinfo.':'.$now;      $hashref->{$key}=$courseinfo.':'.$now;
Line 3335  sub put_course_id_handler { Line 3334  sub put_course_id_handler {
 #                 institutional code - optional supplied code to filter   #                 institutional code - optional supplied code to filter 
 #                            the dump. Only courses with an institutional code   #                            the dump. Only courses with an institutional code 
 #                            that match the supplied code will be returned.  #                            that match the supplied code will be returned.
 #                 owner    - optional supplied username of owner to filter  #                 owner    - optional supplied username and domain of owner to
 #                            the dump.  Only courses for which the course   #                            filter the dump.  Only courses for which the course
 #                            owner matches the supplied username will be  #                            owner matches the supplied username and/or domain
 #                            returned. Implicit assumption that owner  #                            will be returned. Pre-2.2.0 legacy entries from 
 #                            is a user in the domain in which the  #                            nohist_courseiddump will only contain usernames.
 #                            course database is defined.  
 #     $client  - The socket open on the client.  #     $client  - The socket open on the client.
 # Returns:  # Returns:
 #    1     - Continue processing.  #    1     - Continue processing.
Line 3351  sub dump_course_id_handler { Line 3349  sub dump_course_id_handler {
   
     my $userinput = "$cmd:$tail";      my $userinput = "$cmd:$tail";
   
     my ($udom,$since,$description,$instcodefilter,$ownerfilter,$coursefilter) =split(/:/,$tail);      my ($udom,$since,$description,$instcodefilter,$ownerfilter,$coursefilter,
           $typefilter) =split(/:/,$tail);
     if (defined($description)) {      if (defined($description)) {
  $description=&unescape($description);   $description=&unescape($description);
     } else {      } else {
Line 3362  sub dump_course_id_handler { Line 3361  sub dump_course_id_handler {
     } else {      } else {
         $instcodefilter='.';          $instcodefilter='.';
     }      }
       my ($ownerunamefilter,$ownerdomfilter);
     if (defined($ownerfilter)) {      if (defined($ownerfilter)) {
         $ownerfilter=&unescape($ownerfilter);          $ownerfilter=&unescape($ownerfilter);
           if ($ownerfilter ne '.' && defined($ownerfilter)) {
               if ($ownerfilter =~ /^([^:]*):([^:]*)$/) {
                    $ownerunamefilter = $1;
                    $ownerdomfilter = $2;
               } else {
                   $ownerunamefilter = $ownerfilter;
                   $ownerdomfilter = '';
               }
           }
     } else {      } else {
         $ownerfilter='.';          $ownerfilter='.';
     }      }
   
     if (defined($coursefilter)) {      if (defined($coursefilter)) {
         $coursefilter=&unescape($coursefilter);          $coursefilter=&unescape($coursefilter);
     } else {      } else {
         $coursefilter='.';          $coursefilter='.';
     }      }
       if (defined($typefilter)) {
           $typefilter=&unescape($typefilter);
       } else {
           $typefilter='.';
       }
   
     unless (defined($since)) { $since=0; }      unless (defined($since)) { $since=0; }
     my $qresult='';      my $qresult='';
     my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT());      my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT());
     if ($hashref) {      if ($hashref) {
  while (my ($key,$value) = each(%$hashref)) {   while (my ($key,$value) = each(%$hashref)) {
     my ($descr,$lasttime,$inst_code,$owner);      my ($descr,$lasttime,$inst_code,$owner,$type);
             my @courseitems = split(/:/,$value);              my @courseitems = split(/:/,$value);
             $lasttime = pop(@courseitems);              $lasttime = pop(@courseitems);
     ($descr,$inst_code,$owner)=@courseitems;      ($descr,$inst_code,$owner,$type)=@courseitems;
     if ($lasttime<$since) { next; }      if ($lasttime<$since) { next; }
             my $match = 1;              my $match = 1;
     unless ($description eq '.') {      unless ($description eq '.') {
Line 3398  sub dump_course_id_handler { Line 3413  sub dump_course_id_handler {
     }      }
             unless ($ownerfilter eq '.' || !defined($ownerfilter)) {              unless ($ownerfilter eq '.' || !defined($ownerfilter)) {
                 my $unescapeOwner = &unescape($owner);                  my $unescapeOwner = &unescape($owner);
                 unless (eval('$unescapeOwner=~/\Q$ownerfilter\E/i')) {                  if (($ownerunamefilter ne '') && ($ownerdomfilter ne '')) {
                     $match = 0;                      if ($unescapeOwner =~ /:/) {
                           if (eval('$unescapeOwner !~ 
                                /\Q$ownerunamefilter\E:\Q$ownerdomfilter\E$/i')) {
                               $match = 0;
                           } 
                       } else {
                           if (eval('$unescapeOwner!~/\Q$ownerunamefilter\E/i')) {
                               $match = 0;
                           }
                       }
                   } elsif ($ownerunamefilter ne '') {
                       if ($unescapeOwner =~ /:/) {
                           if (eval('$unescapeOwner!~/\Q$ownerunamefilter\E:[^:]+$/i')) {
                                $match = 0;
                           }
                       } else {
                           if (eval('$unescapeOwner!~/\Q$ownerunamefilter\E/i')) {
                               $match = 0;
                           }
                       }
                   } elsif ($ownerdomfilter ne '') {
                       if ($unescapeOwner =~ /:/) {
                           if (eval('$unescapeOwner!~/^[^:]+:\Q$ownerdomfilter\E/')) {
                                $match = 0;
                           }
                       } else {
                           if ($ownerdomfilter ne $udom) {
                               $match = 0;
                           }
                       }
                 }                  }
             }              }
             unless ($coursefilter eq '.' || !defined($coursefilter)) {              unless ($coursefilter eq '.' || !defined($coursefilter)) {
Line 3408  sub dump_course_id_handler { Line 3452  sub dump_course_id_handler {
                     $match = 0;                      $match = 0;
                 }                  }
             }              }
               unless ($typefilter eq '.' || !defined($typefilter)) {
                   my $unescapeType = &unescape($type);
                   if ($type eq '') {
                       if ($typefilter ne 'Course') {
                           $match = 0;
                       }
                   } else { 
                       unless (eval('$unescapeType=~/^\Q$typefilter\E$/')) {
                           $match = 0;
                       }
                   }
               }
             if ($match == 1) {              if ($match == 1) {
                 $qresult.=$key.'='.$descr.':'.$inst_code.':'.$owner.'&';                  $qresult.=$key.'='.$descr.':'.$inst_code.':'.$owner.'&';
             }              }
Line 4025  sub enrollment_enabled_handler { Line 4081  sub enrollment_enabled_handler {
     my $userinput = $cmd.":".$tail; # For logging purposes.      my $userinput = $cmd.":".$tail; # For logging purposes.
   
           
     my $cdom = split(/:/, $tail);   # Domain we're asking about.      my ($cdom) = split(/:/, $tail, 2);   # Domain we're asking about.
   
     my $outcome  = &localenroll::run($cdom);      my $outcome  = &localenroll::run($cdom);
     &Reply($client, "$outcome\n", $userinput);      &Reply($client, "$outcome\n", $userinput);
   
Line 4081  sub validate_course_owner_handler { Line 4138  sub validate_course_owner_handler {
     my $userinput = "$cmd:$tail";      my $userinput = "$cmd:$tail";
     my ($inst_course_id, $owner, $cdom) = split(/:/, $tail);      my ($inst_course_id, $owner, $cdom) = split(/:/, $tail);
   
       $owner = &unescape($owner);
     my $outcome = &localenroll::new_course($inst_course_id,$owner,$cdom);      my $outcome = &localenroll::new_course($inst_course_id,$owner,$cdom);
     &Reply($client, "$outcome\n", $userinput);      &Reply($client, "$outcome\n", $userinput);
   
Line 4121  sub validate_course_section_handler { Line 4179  sub validate_course_section_handler {
 &register_handler("autovalidatecourse", \&validate_course_section_handler, 0, 1, 0);  &register_handler("autovalidatecourse", \&validate_course_section_handler, 0, 1, 0);
   
 #  #
 #   Create a password for a new auto-enrollment user.  #   Validate course owner's access to enrollment data for specific class section. 
 #   I think/guess, this password allows access to the institutions   #   
 #   AIS class list server/services.  Stuart can correct this comment  #
 #   when he finds out how wrong I am.  # 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:
   #               $inst_class  - Institutional code for the specific class section   
   #               $courseowner - The escaped username:domain of the course owner 
   #               $cdom        - The domain of the course from the institution's
   #                              point of view.
   #    $client  - The socket open on the client.
   # Returns:
   #    1 - continue processing.
   #
   
   sub validate_class_access_handler {
       my ($cmd, $tail, $client) = @_;
       my $userinput = "$cmd:$tail";
       my ($inst_class,$courseowner,$cdom) = split(/:/, $tail);
       $courseowner = &unescape($courseowner);
       my $outcome;
       eval {
    local($SIG{__DIE__})='DEFAULT';
    $outcome=&localenroll::check_section($inst_class,$courseowner,$cdom);
       };
       &Reply($client,"$outcome\n", $userinput);
   
       return 1;
   }
   &register_handler("autovalidateclass_sec", \&validate_class_access_handler, 0, 1, 0);
   
   #
   #   Create a password for a new LON-CAPA user added by auto-enrollment.
   #   Only used for case where authentication method for new user is localauth
 #  #
 # Formal Parameters:  # Formal Parameters:
 #    $cmd     - The command request that got us dispatched.  #    $cmd     - The command request that got us dispatched.
 #    $tail    - The tail of the command.   In this case this is a colon separated  #    $tail    - The tail of the command.   In this case this is a colon separated
 #               set of words that will be split into:  #               set of words that will be split into:
 #               $authparam - An authentication parameter (username??).  #               $authparam - An authentication parameter (localauth parameter).
 #               $cdom      - The domain of the course from the institution's  #               $cdom      - The domain of the course from the institution's
 #                            point of view.  #                            point of view.
 #    $client  - The socket open on the client.  #    $client  - The socket open on the client.
Line 5261  sub make_new_child { Line 5350  sub make_new_child {
     my $remotereq=<$client>;      my $remotereq=<$client>;
     chomp($remotereq);      chomp($remotereq);
     Debug("Got init: $remotereq");      Debug("Got init: $remotereq");
     my $inikeyword = split(/:/, $remotereq);  
     if ($remotereq =~ /^init/) {      if ($remotereq =~ /^init/) {
  &sethost("sethost:$perlvar{'lonHostID'}");   &sethost("sethost:$perlvar{'lonHostID'}");
  #   #
Line 5694  sub get_chat { Line 5783  sub get_chat {
     my @entries=();      my @entries=();
     my $namespace = 'nohist_chatroom';      my $namespace = 'nohist_chatroom';
     my $namespace_inroom = 'nohist_inchatroom';      my $namespace_inroom = 'nohist_inchatroom';
     if (defined($group)) {      if ($group ne '') {
         $namespace .= '_'.$group;          $namespace .= '_'.$group;
         $namespace_inroom .= '_'.$group;          $namespace_inroom .= '_'.$group;
     }      }
Line 5726  sub chat_add { Line 5815  sub chat_add {
     my $time=time;      my $time=time;
     my $namespace = 'nohist_chatroom';      my $namespace = 'nohist_chatroom';
     my $logfile = 'chatroom.log';      my $logfile = 'chatroom.log';
     if (defined($group)) {      if ($group ne '') {
         $namespace .= '_'.$group;          $namespace .= '_'.$group;
         $logfile = 'chatroom_'.$group.'.log';          $logfile = 'chatroom_'.$group.'.log';
     }      }
Removed from v.1.332  
changed lines
  Added in v.1.342

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>