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

Diff for /loncom/lond between versions 1.384 and 1.387

version 1.384, 2007/10/06 04:32:23 version 1.387, 2007/10/08 21:13:52
Line 33  use strict; Line 33  use strict;
 use lib '/home/httpd/lib/perl/';  use lib '/home/httpd/lib/perl/';
 use LONCAPA;  use LONCAPA;
 use LONCAPA::Configuration;  use LONCAPA::Configuration;
 use Apache::lonnet;  
   
 use IO::Socket;  use IO::Socket;
 use IO::File;  use IO::File;
Line 997  sub ping_handler { Line 996  sub ping_handler {
     my ($cmd, $tail, $client) = @_;      my ($cmd, $tail, $client) = @_;
     Debug("$cmd $tail $client .. $currenthostid:");      Debug("$cmd $tail $client .. $currenthostid:");
         
     Reply( $client,"$currenthostid\n","$cmd:$tail");      Reply( $client,\$currenthostid,"$cmd:$tail");
         
     return 1;      return 1;
 }  }
Line 1067  sub establish_key_handler { Line 1066  sub establish_key_handler {
     $key=substr($key,0,32);      $key=substr($key,0,32);
     my $cipherkey=pack("H32",$key);      my $cipherkey=pack("H32",$key);
     $cipher=new IDEA $cipherkey;      $cipher=new IDEA $cipherkey;
     &Reply($replyfd, "$buildkey\n", "$cmd:$tail");       &Reply($replyfd, \$buildkey, "$cmd:$tail"); 
         
     return 1;      return 1;
   
Line 1104  sub load_handler { Line 1103  sub load_handler {
         
     my $loadpercent=100*$loadavg/$perlvar{'lonLoadLim'};      my $loadpercent=100*$loadavg/$perlvar{'lonLoadLim'};
   
     &Reply( $replyfd, "$loadpercent\n", "$cmd:$tail");      &Reply( $replyfd, \$loadpercent, "$cmd:$tail");
         
     return 1;      return 1;
 }  }
Line 1134  sub user_load_handler { Line 1133  sub user_load_handler {
     my ($cmd, $tail, $replyfd) = @_;      my ($cmd, $tail, $replyfd) = @_;
   
     my $userloadpercent=&Apache::lonnet::userload();      my $userloadpercent=&Apache::lonnet::userload();
     &Reply($replyfd, "$userloadpercent\n", "$cmd:$tail");      &Reply($replyfd, \$userloadpercent, "$cmd:$tail");
           
     return 1;      return 1;
 }  }
Line 1177  sub user_authorization_type { Line 1176  sub user_authorization_type {
  } else {   } else {
             $type .= ':';              $type .= ':';
         }          }
  &Reply( $replyfd, "$type\n", $userinput);   &Reply( $replyfd, \$type, $userinput);
     }      }
       
     return 1;      return 1;
Line 1213  sub push_file_handler { Line 1212  sub push_file_handler {
  # process making the request.   # process making the request.
               
  my $reply = &PushFile($userinput);   my $reply = &PushFile($userinput);
  &Reply($client, "$reply\n", $userinput);   &Reply($client, \$reply, $userinput);
   
     } else {      } else {
  &Failure( $client, "refused\n", $userinput);   &Failure( $client, "refused\n", $userinput);
Line 1265  sub du_handler { Line 1264  sub du_handler {
  chdir($ududir);   chdir($ududir);
  find($code,$ududir);   find($code,$ududir);
  $total_size=int($total_size/1024);   $total_size=int($total_size/1024);
  &Reply($client,"$total_size\n","$cmd:$ududir");   &Reply($client,\$total_size,"$cmd:$ududir");
     } else {      } else {
  &Failure($client, "bad_directory:$ududir\n","$cmd:$ududir");    &Failure($client, "bad_directory:$ududir\n","$cmd:$ududir"); 
     }      }
Line 1334  sub ls_handler { Line 1333  sub ls_handler {
  $ulsout='no_such_dir';   $ulsout='no_such_dir';
     }      }
     if ($ulsout eq '') { $ulsout='empty'; }      if ($ulsout eq '') { $ulsout='empty'; }
     &Reply($client, "$ulsout\n", $userinput); # This supports debug logging.      &Reply($client, \$ulsout, $userinput); # This supports debug logging.
           
     return 1;      return 1;
   
Line 1403  sub ls2_handler { Line 1402  sub ls2_handler {
         $ulsout='no_such_dir';          $ulsout='no_such_dir';
    }     }
    if ($ulsout eq '') { $ulsout='empty'; }     if ($ulsout eq '') { $ulsout='empty'; }
    &Reply($client, "$ulsout\n", $userinput); # This supports debug logging.     &Reply($client, \$ulsout, $userinput); # This supports debug logging.
    return 1;     return 1;
 }  }
 &register_handler("ls2", \&ls2_handler, 0, 1, 0);  &register_handler("ls2", \&ls2_handler, 0, 1, 0);
Line 1431  sub reinit_process_handler { Line 1430  sub reinit_process_handler {
     if(&ValidManager($cert)) {      if(&ValidManager($cert)) {
  chomp($userinput);   chomp($userinput);
  my $reply = &ReinitProcess($userinput);   my $reply = &ReinitProcess($userinput);
  &Reply( $client,  "$reply\n", $userinput);   &Reply( $client,  \$reply, $userinput);
     } else {      } else {
  &Failure( $client, "refused\n", $userinput);   &Failure( $client, "refused\n", $userinput);
     }      }
Line 1606  sub change_password_handler { Line 1605  sub change_password_handler {
     my $result = &change_unix_password($uname, $npass);      my $result = &change_unix_password($uname, $npass);
     &logthis("Result of password change for $uname: ".      &logthis("Result of password change for $uname: ".
      $result);       $result);
     &Reply($client, "$result\n", $userinput);      &Reply($client, \$result, $userinput);
  } else {   } else {
     # this just means that the current password mode is not      # this just means that the current password mode is not
     # one we know how to change (e.g the kerberos auth modes or      # one we know how to change (e.g the kerberos auth modes or
Line 1669  sub add_user_handler { Line 1668  sub add_user_handler {
  my $result=&make_passwd_file($uname, $umode,$npass, $passfilename);   my $result=&make_passwd_file($uname, $umode,$npass, $passfilename);
  &Reply($client, $result, $userinput);     #BUGBUG - could be fail   &Reply($client, $result, $userinput);     #BUGBUG - could be fail
     } else {      } else {
  &Failure($client, "$fperror\n", $userinput);   &Failure($client, \$fperror, $userinput);
     }      }
  }   }
  umask($oldumask);   umask($oldumask);
Line 1736  sub change_authentication_handler { Line 1735  sub change_authentication_handler {
  my $result = &change_unix_password($uname, $npass);   my $result = &change_unix_password($uname, $npass);
  &logthis("Result of password change for $uname: ".$result);   &logthis("Result of password change for $uname: ".$result);
  if ($result eq "ok") {   if ($result eq "ok") {
     &Reply($client, "$result\n")      &Reply($client, \$result)
  } else {   } else {
     &Failure($client, "$result\n");      &Failure($client, \$result);
  }   }
     } else {      } else {
  my $result=&make_passwd_file($uname, $umode,$npass,$passfilename);   my $result=&make_passwd_file($uname, $umode,$npass,$passfilename);
Line 1757  sub change_authentication_handler { Line 1756  sub change_authentication_handler {
  &manage_permissions("/$udom/_au", $udom, $uname, "$umode:");   &manage_permissions("/$udom/_au", $udom, $uname, "$umode:");
     }      }
  }   }
  &Reply($client, $result, $userinput);   &Reply($client, \$result, $userinput);
     }      }
                 
   
Line 2159  sub token_auth_user_file_handler { Line 2158  sub token_auth_user_file_handler {
  }   }
  untie(%disk_env);   untie(%disk_env);
  close(ENVIN);   close(ENVIN);
  &Reply($client, $reply, "$cmd:$tail");   &Reply($client, \$reply, "$cmd:$tail");
     } else {      } else {
  &Failure($client, "invalid_token\n", "$cmd:$tail");   &Failure($client, "invalid_token\n", "$cmd:$tail");
     }      }
Line 2586  sub get_profile_entry { Line 2585  sub get_profile_entry {
     my $replystring = read_profile($udom, $uname, $namespace, $what);      my $replystring = read_profile($udom, $uname, $namespace, $what);
     my ($first) = split(/:/,$replystring);      my ($first) = split(/:/,$replystring);
     if($first ne "error") {      if($first ne "error") {
  &Reply($client, "$replystring\n", $userinput);   &Reply($client, \$replystring, $userinput);
     } else {      } else {
  &Failure($client, $replystring." while attempting get\n", $userinput);   &Failure($client, $replystring." while attempting get\n", $userinput);
     }      }
Line 2726  sub get_profile_keys { Line 2725  sub get_profile_keys {
  }   }
  if (&untie_user_hash($hashref)) {   if (&untie_user_hash($hashref)) {
     $qresult=~s/\&$//;      $qresult=~s/\&$//;
     &Reply($client, "$qresult\n", $userinput);      &Reply($client, \$qresult, $userinput);
  } else {   } else {
     &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".      &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
     "while attempting keys\n", $userinput);      "while attempting keys\n", $userinput);
Line 2796  sub dump_profile_database { Line 2795  sub dump_profile_database {
  }   }
     }      }
     chop($qresult);      chop($qresult);
     &Reply($client , "$qresult\n", $userinput);      &Reply($client , \$qresult, $userinput);
  } else {   } else {
     &Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".      &Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".
      "while attempting currentdump\n", $userinput);       "while attempting currentdump\n", $userinput);
Line 2879  sub dump_with_regexp { Line 2878  sub dump_with_regexp {
  }   }
  if (&untie_user_hash($hashref)) {   if (&untie_user_hash($hashref)) {
     chop($qresult);      chop($qresult);
     &Reply($client, "$qresult\n", $userinput);      &Reply($client, \$qresult, $userinput);
  } else {   } else {
     &Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".      &Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".
      "while attempting dump\n", $userinput);       "while attempting dump\n", $userinput);
Line 3087  sub restore_handler { Line 3086  sub restore_handler {
  }   }
  if (&untie_user_hash($hashref)) {   if (&untie_user_hash($hashref)) {
     $qresult=~s/\&$//;      $qresult=~s/\&$//;
     &Reply( $client, "$qresult\n", $userinput);      &Reply( $client, \$qresult, $userinput);
  } else {   } else {
     &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".      &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
     "while attempting restore\n", $userinput);      "while attempting restore\n", $userinput);
Line 3168  sub retrieve_chat_handler { Line 3167  sub retrieve_chat_handler {
  $reply.=&escape($_).':';   $reply.=&escape($_).':';
     }      }
     $reply=~s/\:$//;      $reply=~s/\:$//;
     &Reply($client, $reply."\n", $userinput);      &Reply($client, \$reply, $userinput);
   
   
     return 1;      return 1;
Line 3627  sub dump_course_id_handler { Line 3626  sub dump_course_id_handler {
  }   }
  if (&untie_domain_hash($hashref)) {   if (&untie_domain_hash($hashref)) {
     chop($qresult);      chop($qresult);
     &Reply($client, "$qresult\n", $userinput);      &Reply($client, \$qresult, $userinput);
  } else {   } else {
     &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".      &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
     "while attempting courseiddump\n", $userinput);      "while attempting courseiddump\n", $userinput);
Line 3718  sub get_domain_handler { Line 3717  sub get_domain_handler {
         }          }
         if (&untie_domain_hash($hashref)) {          if (&untie_domain_hash($hashref)) {
             $qresult=~s/\&$//;              $qresult=~s/\&$//;
             &Reply($client, "$qresult\n", $userinput);              &Reply($client, \$qresult, $userinput);
         } else {          } else {
             &Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".              &Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".
                       "while attempting getdom\n",$userinput);                        "while attempting getdom\n",$userinput);
Line 3816  sub get_id_handler { Line 3815  sub get_id_handler {
  }   }
  if (&untie_domain_hash($hashref)) {   if (&untie_domain_hash($hashref)) {
     $qresult=~s/\&$//;      $qresult=~s/\&$//;
     &Reply($client, "$qresult\n", $userinput);      &Reply($client, \$qresult, $userinput);
  } else {   } else {
     &Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".      &Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".
       "while attempting idget\n",$userinput);        "while attempting idget\n",$userinput);
Line 3940  sub dump_dcmail_handler { Line 3939  sub dump_dcmail_handler {
         }          }
         if (&untie_domain_hash($hashref)) {          if (&untie_domain_hash($hashref)) {
             chop($qresult);              chop($qresult);
             &Reply($client, "$qresult\n", $userinput);              &Reply($client, \$qresult, $userinput);
         } else {          } else {
             &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".              &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
                     "while attempting dcmaildump\n", $userinput);                      "while attempting dcmaildump\n", $userinput);
Line 4068  sub dump_domainroles_handler { Line 4067  sub dump_domainroles_handler {
         }          }
         if (&untie_domain_hash($hashref)) {          if (&untie_domain_hash($hashref)) {
             chop($qresult);              chop($qresult);
             &Reply($client, "$qresult\n", $userinput);              &Reply($client, \$qresult, $userinput);
         } else {          } else {
             &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".              &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
                     "while attempting domrolesdump\n", $userinput);                      "while attempting domrolesdump\n", $userinput);
Line 4122  sub tmp_put_handler { Line 4121  sub tmp_put_handler {
     if ($store=IO::File->new(">$execdir/tmp/$id.tmp")) {      if ($store=IO::File->new(">$execdir/tmp/$id.tmp")) {
  print $store $record;   print $store $record;
  close $store;   close $store;
  &Reply($client, "$id\n", $userinput);   &Reply($client, \$id, $userinput);
     } else {      } else {
  &Failure( $client, "error: ".($!+0)."IO::File->new Failed ".   &Failure( $client, "error: ".($!+0)."IO::File->new Failed ".
   "while attempting tmpput\n", $userinput);    "while attempting tmpput\n", $userinput);
Line 4156  sub tmp_get_handler { Line 4155  sub tmp_get_handler {
     my $execdir=$perlvar{'lonDaemons'};      my $execdir=$perlvar{'lonDaemons'};
     if ($store=IO::File->new("$execdir/tmp/$id.tmp")) {      if ($store=IO::File->new("$execdir/tmp/$id.tmp")) {
  my $reply=<$store>;   my $reply=<$store>;
  &Reply( $client, "$reply\n", $userinput);   &Reply( $client, \$reply, $userinput);
  close $store;   close $store;
     } else {      } else {
  &Failure( $client, "error: ".($!+0)."IO::File->new Failed ".   &Failure( $client, "error: ".($!+0)."IO::File->new Failed ".
Line 4340  sub enrollment_enabled_handler { Line 4339  sub enrollment_enabled_handler {
     my ($cdom) = split(/:/, $tail, 2);   # 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, $userinput);
   
     return 1;      return 1;
 }  }
Line 4367  sub get_sections_handler { Line 4366  sub get_sections_handler {
     my @secs = &localenroll::get_sections($coursecode,$cdom);      my @secs = &localenroll::get_sections($coursecode,$cdom);
     my $seclist = &escape(join(':',@secs));      my $seclist = &escape(join(':',@secs));
   
     &Reply($client, "$seclist\n", $userinput);      &Reply($client, \$seclist, $userinput);
           
   
     return 1;      return 1;
Line 4396  sub validate_course_owner_handler { Line 4395  sub validate_course_owner_handler {
   
     $owner = &unescape($owner);      $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, $userinput);
   
   
   
Line 4427  sub validate_course_section_handler { Line 4426  sub validate_course_section_handler {
     my ($inst_course_id, $cdom) = split(/:/, $tail);      my ($inst_course_id, $cdom) = split(/:/, $tail);
   
     my $outcome=&localenroll::validate_courseID($inst_course_id,$cdom);      my $outcome=&localenroll::validate_courseID($inst_course_id,$cdom);
     &Reply($client, "$outcome\n", $userinput);      &Reply($client, \$outcome, $userinput);
   
   
     return 1;      return 1;
Line 4461  sub validate_class_access_handler { Line 4460  sub validate_class_access_handler {
  local($SIG{__DIE__})='DEFAULT';   local($SIG{__DIE__})='DEFAULT';
  $outcome=&localenroll::check_section($inst_class,\@owners,$cdom);   $outcome=&localenroll::check_section($inst_class,\@owners,$cdom);
     };      };
     &Reply($client,"$outcome\n", $userinput);      &Reply($client,\$outcome, $userinput);
   
     return 1;      return 1;
 }  }
Line 4622  sub get_institutional_defaults_handler { Line 4621  sub get_institutional_defaults_handler {
                 $result.=&escape($key).'='.&escape($value).'&';                  $result.=&escape($key).'='.&escape($value).'&';
             }              }
             $result .= 'code_order='.&escape(join('&',@code_order));              $result .= 'code_order='.&escape(join('&',@code_order));
             &Reply($client,$result."\n",$userinput);              &Reply($client,\$result,$userinput);
         } else {          } else {
             &Reply($client,"error\n", $userinput);              &Reply($client,"error\n", $userinput);
         }          }
Line 4657  sub get_institutional_user_rules { Line 4656  sub get_institutional_user_rules {
                 }                  }
             }              }
             $result =~ s/\&$//;              $result =~ s/\&$//;
             &Reply($client,$result."\n",$userinput);              &Reply($client,\$result,$userinput);
         } else {          } else {
             &Reply($client,"error\n", $userinput);              &Reply($client,"error\n", $userinput);
         }          }
Line 4687  sub institutional_username_check { Line 4686  sub institutional_username_check {
             foreach my $key (keys(%rulecheck)) {              foreach my $key (keys(%rulecheck)) {
                 $result.=&escape($key).'='.&Apache::lonnet::freeze_escape($rulecheck{$key}).'&';                  $result.=&escape($key).'='.&Apache::lonnet::freeze_escape($rulecheck{$key}).'&';
             }              }
             &Reply($client,$result."\n",$userinput);              &Reply($client,\$result,$userinput);
         } else {          } else {
             &Reply($client,"error\n", $userinput);              &Reply($client,"error\n", $userinput);
         }          }
Line 4849  sub inst_usertypes_handler { Line 4848  sub inst_usertypes_handler {
         }          }
         $res=~s/\&$//;          $res=~s/\&$//;
     }      }
     &Reply($client, "$res\n", $userinput);      &Reply($client, \$res, $userinput);
     return 1;      return 1;
 }  }
 &register_handler("inst_usertypes", \&inst_usertypes_handler, 0, 1, 0);  &register_handler("inst_usertypes", \&inst_usertypes_handler, 0, 1, 0);
Line 5348  sub Debug { Line 5347  sub Debug {
 #  #
 sub Reply {  sub Reply {
     my ($fd, $reply, $request) = @_;      my ($fd, $reply, $request) = @_;
     print $fd $reply;      if (ref($reply)) {
     Debug("Request was $request  Reply was $reply");   print $fd $$reply;
    print $fd "\n";
    if ($DEBUG) { Debug("Request was $request  Reply was $$reply"); }
       } else {
    print $fd $reply;
    if ($DEBUG) { Debug("Request was $request  Reply was $reply"); }
       }
     $Transactions++;      $Transactions++;
 }  }
   
Removed from v.1.384  
changed lines
  Added in v.1.387

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