Diff for /loncom/lond between versions 1.261 and 1.263

version 1.261, 2004/10/18 10:13:46 version 1.263, 2004/10/21 16:05:50
Line 1130  sub read_profile { Line 1130  sub read_profile {
 #      0       - Program should exit.  #      0       - Program should exit.
 #  Side effects:  #  Side effects:
 #      Reply information is sent to the client.  #      Reply information is sent to the client.
   
 sub ping_handler {  sub ping_handler {
     my ($cmd, $tail, $client) = @_;      my ($cmd, $tail, $client) = @_;
     Debug("$cmd $tail $client .. $currenthostid:");      Debug("$cmd $tail $client .. $currenthostid:");
Line 1158  sub ping_handler { Line 1157  sub ping_handler {
 #      0       - Program should exit.  #      0       - Program should exit.
 #  Side effects:  #  Side effects:
 #      Reply information is sent to the client.  #      Reply information is sent to the client.
   
 sub pong_handler {  sub pong_handler {
     my ($cmd, $tail, $replyfd) = @_;      my ($cmd, $tail, $replyfd) = @_;
   
Line 1213  sub establish_key_handler { Line 1211  sub establish_key_handler {
 }  }
 &register_handler("ekey", \&establish_key_handler, 0, 1,1);  &register_handler("ekey", \&establish_key_handler, 0, 1,1);
   
   
 #     Handler for the load command.  Returns the current system load average  #     Handler for the load command.  Returns the current system load average
 #     to the requestor.  #     to the requestor.
 #  #
Line 1248  sub load_handler { Line 1245  sub load_handler {
         
     return 1;      return 1;
 }  }
 register_handler("load", \&load_handler, 0, 1, 0);  &register_handler("load", \&load_handler, 0, 1, 0);
   
 #  #
 #   Process the userload request.  This sub returns to the client the current  #   Process the userload request.  This sub returns to the client the current
Line 1278  sub user_load_handler { Line 1275  sub user_load_handler {
           
     return 1;      return 1;
 }  }
 register_handler("userload", \&user_load_handler, 0, 1, 0);  &register_handler("userload", \&user_load_handler, 0, 1, 0);
   
 #   Process a request for the authorization type of a user:  #   Process a request for the authorization type of a user:
 #   (userauth).  #   (userauth).
Line 1335  sub user_authorization_type { Line 1332  sub user_authorization_type {
 #      0       - Program should exit  #      0       - Program should exit
 # Implicit Output:  # Implicit Output:
 #    a reply is written to the client.  #    a reply is written to the client.
   
 sub push_file_handler {  sub push_file_handler {
     my ($cmd, $tail, $client) = @_;      my ($cmd, $tail, $client) = @_;
   
Line 1378  sub push_file_handler { Line 1374  sub push_file_handler {
 # Side Effects:  # Side Effects:
 #   The reply is written to  $client.  #   The reply is written to  $client.
 #  #
   
 sub du_handler {  sub du_handler {
     my ($cmd, $ududir, $client) = @_;      my ($cmd, $ududir, $client) = @_;
     my ($ududir) = split(/:/,$ududir); # Make 'telnet' testing easier.      my ($ududir) = split(/:/,$ududir); # Make 'telnet' testing easier.
Line 1412  sub du_handler { Line 1407  sub du_handler {
 }  }
 &register_handler("du", \&du_handler, 0, 1, 0);  &register_handler("du", \&du_handler, 0, 1, 0);
   
   
 #  #
 #   ls  - list the contents of a directory.  For each file in the  #   ls  - list the contents of a directory.  For each file in the
 #    selected directory the filename followed by the full output of  #    selected directory the filename followed by the full output of
Line 1476  sub ls_handler { Line 1470  sub ls_handler {
 }  }
 &register_handler("ls", \&ls_handler, 0, 1, 0);  &register_handler("ls", \&ls_handler, 0, 1, 0);
   
   
   
   
 #   Process a reinit request.  Reinit requests that either  #   Process a reinit request.  Reinit requests that either
 #   lonc or lond be reinitialized so that an updated   #   lonc or lond be reinitialized so that an updated 
 #   host.tab or domain.tab can be processed.  #   host.tab or domain.tab can be processed.
Line 1508  sub reinit_process_handler { Line 1499  sub reinit_process_handler {
     }      }
     return 1;      return 1;
 }  }
   
 &register_handler("reinit", \&reinit_process_handler, 1, 0, 1);  &register_handler("reinit", \&reinit_process_handler, 1, 0, 1);
   
 #  Process the editing script for a table edit operation.  #  Process the editing script for a table edit operation.
Line 1550  sub edit_table_handler { Line 1540  sub edit_table_handler {
     }      }
     return 1;      return 1;
 }  }
 register_handler("edit", \&edit_table_handler, 1, 0, 1);  &register_handler("edit", \&edit_table_handler, 1, 0, 1);
   
   
 #  #
 #   Authenticate a user against the LonCAPA authentication  #   Authenticate a user against the LonCAPA authentication
Line 1606  sub authenticate_handler { Line 1595  sub authenticate_handler {
   
     return 1;      return 1;
 }  }
   &register_handler("auth", \&authenticate_handler, 1, 1, 0);
 register_handler("auth", \&authenticate_handler, 1, 1, 0);  
   
 #  #
 #   Change a user's password.  Note that this function is complicated by  #   Change a user's password.  Note that this function is complicated by
Line 1698  sub change_password_handler { Line 1686  sub change_password_handler {
   
     return 1;      return 1;
 }  }
 register_handler("passwd", \&change_password_handler, 1, 1, 0);  &register_handler("passwd", \&change_password_handler, 1, 1, 0);
   
   
 #  #
 #   Create a new user.  User in this case means a lon-capa user.  #   Create a new user.  User in this case means a lon-capa user.
Line 2038  sub fetch_user_file_handler { Line 2025  sub fetch_user_file_handler {
 #  #
 # Returns:  # Returns:
 #    1    - Continue processing.  #    1    - Continue processing.
   
 sub remove_user_file_handler {  sub remove_user_file_handler {
     my ($cmd, $tail, $client) = @_;      my ($cmd, $tail, $client) = @_;
   
Line 2091  sub remove_user_file_handler { Line 2077  sub remove_user_file_handler {
 #  #
 # Returns:  # Returns:
 #    1    - Continue processing.  #    1    - Continue processing.
   
 sub mkdir_user_file_handler {  sub mkdir_user_file_handler {
     my ($cmd, $tail, $client) = @_;      my ($cmd, $tail, $client) = @_;
   
Line 2140  sub mkdir_user_file_handler { Line 2125  sub mkdir_user_file_handler {
 #  #
 # Returns:  # Returns:
 #    1    - Continue processing.  #    1    - Continue processing.
   
 sub rename_user_file_handler {  sub rename_user_file_handler {
     my ($cmd, $tail, $client) = @_;      my ($cmd, $tail, $client) = @_;
   
Line 2174  sub rename_user_file_handler { Line 2158  sub rename_user_file_handler {
 }  }
 &register_handler("renameuserfile", \&rename_user_file_handler, 0,1,0);  &register_handler("renameuserfile", \&rename_user_file_handler, 0,1,0);
   
   
 #  #
 #  Authenticate access to a user file by checking the user's   #  Authenticate access to a user file by checking that the token the user's 
 #  session token(?)  #  passed also exists in their session file
 #  #
 # Parameters:  # Parameters:
 #   cmd      - The request keyword that dispatched to tus.  #   cmd      - The request keyword that dispatched to tus.
Line 2185  sub rename_user_file_handler { Line 2168  sub rename_user_file_handler {
 #   client   - Filehandle open on the client.  #   client   - Filehandle open on the client.
 # Return:  # Return:
 #    1.  #    1.
   
 sub token_auth_user_file_handler {  sub token_auth_user_file_handler {
     my ($cmd, $tail, $client) = @_;      my ($cmd, $tail, $client) = @_;
   
Line 2206  sub token_auth_user_file_handler { Line 2188  sub token_auth_user_file_handler {
     return 1;      return 1;
   
 }  }
   
 &register_handler("tokenauthuserfile", \&token_auth_user_file_handler, 0,1,0);  &register_handler("tokenauthuserfile", \&token_auth_user_file_handler, 0,1,0);
   
   
 #  #
 #   Unsubscribe from a resource.  #   Unsubscribe from a resource.
 #  #
Line 2238  sub unsubscribe_handler { Line 2218  sub unsubscribe_handler {
     return 1;      return 1;
 }  }
 &register_handler("unsub", \&unsubscribe_handler, 0, 1, 0);  &register_handler("unsub", \&unsubscribe_handler, 0, 1, 0);
   
 #   Subscribe to a resource  #   Subscribe to a resource
 #  #
 # Parameters:  # Parameters:
Line 2316  sub activity_log_handler { Line 2297  sub activity_log_handler {
   
     return 1;      return 1;
 }  }
 register_handler("log", \&activity_log_handler, 0, 1, 0);  &register_handler("log", \&activity_log_handler, 0, 1, 0);
   
 #  #
 #   Put a namespace entry in a user profile hash.  #   Put a namespace entry in a user profile hash.
Line 2421  sub increment_user_value_handler { Line 2402  sub increment_user_value_handler {
 }  }
 &register_handler("inc", \&increment_user_value_handler, 0, 1, 0);  &register_handler("inc", \&increment_user_value_handler, 0, 1, 0);
   
   
 #  #
 #   Put a new role for a user.  Roles are LonCAPA's packaging of permissions.  #   Put a new role for a user.  Roles are LonCAPA's packaging of permissions.
 #   Each 'role' a user has implies a set of permissions.  Adding a new role  #   Each 'role' a user has implies a set of permissions.  Adding a new role
Line 2629  sub get_profile_entry_encrypted { Line 2609  sub get_profile_entry_encrypted {
     return 1;      return 1;
 }  }
 &register_handler("eget", \&get_profile_entry_encrypted, 0, 1, 0);  &register_handler("eget", \&get_profile_entry_encrypted, 0, 1, 0);
   
 #  #
 #   Deletes a key in a user profile database.  #   Deletes a key in a user profile database.
 #     #   
Line 2647  sub get_profile_entry_encrypted { Line 2628  sub get_profile_entry_encrypted {
 #     0   - Exit server.  #     0   - Exit server.
 #  #
 #  #
   
 sub delete_profile_entry {  sub delete_profile_entry {
     my ($cmd, $tail, $client) = @_;      my ($cmd, $tail, $client) = @_;
   
Line 2676  sub delete_profile_entry { Line 2656  sub delete_profile_entry {
     return 1;      return 1;
 }  }
 &register_handler("del", \&delete_profile_entry, 0, 1, 0);  &register_handler("del", \&delete_profile_entry, 0, 1, 0);
   
 #  #
 #  List the set of keys that are defined in a profile database file.  #  List the set of keys that are defined in a profile database file.
 #  A successful reply from this will contain an & separated list of  #  A successful reply from this will contain an & separated list of
Line 2854  sub dump_with_regexp { Line 2835  sub dump_with_regexp {
   
     return 1;      return 1;
 }  }
   
 &register_handler("dump", \&dump_with_regexp, 0, 1, 0);  &register_handler("dump", \&dump_with_regexp, 0, 1, 0);
   
 #  Store a set of key=value pairs associated with a versioned name.  #  Store a set of key=value pairs associated with a versioned name.
Line 2920  sub store_handler { Line 2900  sub store_handler {
     return 1;      return 1;
 }  }
 &register_handler("store", \&store_handler, 0, 1, 0);  &register_handler("store", \&store_handler, 0, 1, 0);
   
 #  #
 #  Dump out all versions of a resource that has key=value pairs associated  #  Dump out all versions of a resource that has key=value pairs associated
 # with it for each version.  These resources are built up via the store  # with it for each version.  These resources are built up via the store
Line 3020  sub send_chat_handler { Line 3001  sub send_chat_handler {
     return 1;      return 1;
 }  }
 &register_handler("chatsend", \&send_chat_handler, 0, 1, 0);  &register_handler("chatsend", \&send_chat_handler, 0, 1, 0);
   
 #  #
 #   Retrieve the set of chat messagss from a discussion board.  #   Retrieve the set of chat messagss from a discussion board.
 #  #
Line 3314  sub put_id_handler { Line 3296  sub put_id_handler {
   
     return 1;      return 1;
 }  }
   
 &register_handler("idput", \&put_id_handler, 0, 1, 0);  &register_handler("idput", \&put_id_handler, 0, 1, 0);
   
 #  #
 #  Retrieves a set of id values from the id database.  #  Retrieves a set of id values from the id database.
 #  Returns an & separated list of results, one for each requested id to the  #  Returns an & separated list of results, one for each requested id to the
Line 3364  sub get_id_handler { Line 3346  sub get_id_handler {
           
     return 1;      return 1;
 }  }
   &register_handler("idget", \&get_id_handler, 0, 1, 0);
 register_handler("idget", \&get_id_handler, 0, 1, 0);  
   
 #  #
 #  Process the tmpput command I'm not sure what this does.. Seems to  #  Process the tmpput command I'm not sure what this does.. Seems to
Line 3408  sub tmp_put_handler { Line 3389  sub tmp_put_handler {
       
 }  }
 &register_handler("tmpput", \&tmp_put_handler, 0, 1, 0);  &register_handler("tmpput", \&tmp_put_handler, 0, 1, 0);
   
 #   Processes the tmpget command.  This command returns the contents  #   Processes the tmpget command.  This command returns the contents
 #  of a temporary resource file(?) created via tmpput.  #  of a temporary resource file(?) created via tmpput.
 #  #
Line 3420  sub tmp_put_handler { Line 3402  sub tmp_put_handler {
 #    1         - Inidcating processing can continue.  #    1         - Inidcating processing can continue.
 # Side effects:  # Side effects:
 #   A reply is sent to the client.  #   A reply is sent to the client.
   
 #  #
 sub tmp_get_handler {  sub tmp_get_handler {
     my ($cmd, $id, $client) = @_;      my ($cmd, $id, $client) = @_;
Line 3443  sub tmp_get_handler { Line 3424  sub tmp_get_handler {
     return 1;      return 1;
 }  }
 &register_handler("tmpget", \&tmp_get_handler, 0, 1, 0);  &register_handler("tmpget", \&tmp_get_handler, 0, 1, 0);
   
 #  #
 #  Process the tmpdel command.  This command deletes a temp resource  #  Process the tmpdel command.  This command deletes a temp resource
 #  created by the tmpput command.  #  created by the tmpput command.
Line 3476  sub tmp_del_handler { Line 3458  sub tmp_del_handler {
   
 }  }
 &register_handler("tmpdel", \&tmp_del_handler, 0, 1, 0);  &register_handler("tmpdel", \&tmp_del_handler, 0, 1, 0);
   
 #  #
 #   Processes the setannounce command.  This command  #   Processes the setannounce command.  This command
 #   creates a file named announce.txt in the top directory of  #   creates a file named announce.txt in the top directory of
Line 3514  sub set_announce_handler { Line 3497  sub set_announce_handler {
     return 1;      return 1;
 }  }
 &register_handler("setannounce", \&set_announce_handler, 0, 1, 0);  &register_handler("setannounce", \&set_announce_handler, 0, 1, 0);
   
 #  #
 #  Return the version of the daemon.  This can be used to determine  #  Return the version of the daemon.  This can be used to determine
 #  the compatibility of cross version installations or, alternatively to  #  the compatibility of cross version installations or, alternatively to
Line 3538  sub get_version_handler { Line 3522  sub get_version_handler {
     return 1;      return 1;
 }  }
 &register_handler("version", \&get_version_handler, 0, 1, 0);  &register_handler("version", \&get_version_handler, 0, 1, 0);
   
 #  Set the current host and domain.  This is used to support  #  Set the current host and domain.  This is used to support
 #  multihomed systems.  Each IP of the system, or even separate daemons  #  multihomed systems.  Each IP of the system, or even separate daemons
 #  on the same IP can be treated as handling a separate lonCAPA virtual  #  on the same IP can be treated as handling a separate lonCAPA virtual
Line 3674  sub validate_course_owner_handler { Line 3659  sub validate_course_owner_handler {
     return 1;      return 1;
 }  }
 &register_handler("autonewcourse", \&validate_course_owner_handler, 0, 1, 0);  &register_handler("autonewcourse", \&validate_course_owner_handler, 0, 1, 0);
   
 #  #
 #   Validate a course section in the official schedule of classes  #   Validate a course section in the official schedule of classes
 #   from the institutions point of view (part of autoenrollment).  #   from the institutions point of view (part of autoenrollment).
Line 3754  sub create_auto_enroll_password_handler Line 3740  sub create_auto_enroll_password_handler
 #  #
 # Returns:  # Returns:
 #   1     - Continue processing.  #   1     - Continue processing.
   
 sub retrieve_auto_file_handler {  sub retrieve_auto_file_handler {
     my ($cmd, $tail, $client)    = @_;      my ($cmd, $tail, $client)    = @_;
     my $userinput                = "cmd:$tail";      my $userinput                = "cmd:$tail";
Line 3852  sub get_institutional_code_format_handle Line 3837  sub get_institutional_code_format_handle
 #  #
 #   Getting, decoding and dispatching requests:  #   Getting, decoding and dispatching requests:
 #  #
   
 #  #
 #   Get a Request:  #   Get a Request:
 #   Gets a Request message from the client.  The transaction  #   Gets a Request message from the client.  The transaction
Line 3959  sub process_request { Line 3943  sub process_request {
   
     }          }    
   
 #------------------- Commands not yet in spearate handlers. --------------      print $client "unknown_cmd\n";
   
 #------------------------------- is auto-enrollment enabled?  
     if ($userinput =~/^autorun/) {  
  if (isClient) {  
     my ($cmd,$cdom) = split(/:/,$userinput);  
     my $outcome = &localenroll::run($cdom);  
     print $client "$outcome\n";  
  } else {  
     print $client "0\n";  
  }  
 #------------------------------- get official sections (for auto-enrollment).  
     } elsif ($userinput =~/^autogetsections/) {  
  if (isClient) {  
     my ($cmd,$coursecode,$cdom)=split(/:/,$userinput);  
     my @secs = &localenroll::get_sections($coursecode,$cdom);  
     my $seclist = &escape(join(':',@secs));  
     print $client "$seclist\n";  
  } else {  
     print $client "refused\n";  
  }  
 #----------------------- validate owner of new course section (for auto-enrollment).  
     } elsif ($userinput =~/^autonewcourse/) {  
  if (isClient) {  
     my ($cmd,$inst_course_id,$owner,$cdom)=split(/:/,$userinput);  
     my $outcome = &localenroll::new_course($inst_course_id,$owner,$cdom);  
     print $client "$outcome\n";  
  } else {  
     print $client "refused\n";  
  }  
 #-------------- validate course section in schedule of classes (for auto-enrollment).  
     } elsif ($userinput =~/^autovalidatecourse/) {  
  if (isClient) {  
     my ($cmd,$inst_course_id,$cdom)=split(/:/,$userinput);  
     my $outcome=&localenroll::validate_courseID($inst_course_id,$cdom);  
     print $client "$outcome\n";  
  } else {  
     print $client "refused\n";  
  }  
 #--------------------------- create password for new user (for auto-enrollment).  
     } elsif ($userinput =~/^autocreatepassword/) {  
  if (isClient) {  
     my ($cmd,$authparam,$cdom)=split(/:/,$userinput);  
     my ($create_passwd,$authchk);  
     ($authparam,$create_passwd,$authchk) = &localenroll::create_password($authparam,$cdom);  
     print $client &escape($authparam.':'.$create_passwd.':'.$authchk)."\n";  
  } else {  
     print $client "refused\n";  
  }  
 #---------------------------  read and remove temporary files (for auto-enrollment).  
     } elsif ($userinput =~/^autoretrieve/) {  
  if (isClient) {  
     my ($cmd,$filename) = split(/:/,$userinput);  
     my $source = $perlvar{'lonDaemons'}.'/tmp/'.$filename;  
     if ( (-e $source) && ($filename ne '') ) {  
  my $reply = '';  
  if (open(my $fh,$source)) {  
     while (<$fh>) {  
  chomp($_);  
  $_ =~ s/^\s+//g;  
  $_ =~ s/\s+$//g;  
  $reply .= $_;  
     }  
     close($fh);  
     print $client &escape($reply)."\n";  
 #                                unlink($source);  
  } else {  
     print $client "error\n";  
  }  
     } else {  
  print $client "error\n";  
     }  
  } else {  
     print $client "refused\n";  
  }  
 #---------------------  read and retrieve institutional code format   
 #                          (for support form).  
     } elsif ($userinput =~/^autoinstcodeformat/) {  
  if (isClient) {  
     my $reply;  
     my($cmd,$cdom,$course) = split(/:/,$userinput);  
     my @pairs = split/\&/,$course;  
     my %instcodes = ();  
     my %codes = ();  
     my @codetitles = ();  
     my %cat_titles = ();  
     my %cat_order = ();  
     foreach (@pairs) {  
  my ($key,$value) = split/=/,$_;  
  $instcodes{&unescape($key)} = &unescape($value);  
     }  
     my $formatreply = &localenroll::instcode_format($cdom,\%instcodes,\%codes,\@codetitles,\%cat_titles,\%cat_order);  
     if ($formatreply eq 'ok') {  
  my $codes_str = &hash2str(%codes);  
  my $codetitles_str = &array2str(@codetitles);  
  my $cat_titles_str = &hash2str(%cat_titles);  
  my $cat_order_str = &hash2str(%cat_order);  
  print $client $codes_str.':'.$codetitles_str.':'.$cat_titles_str.':'.$cat_order_str."\n";  
     }  
  } else {  
     print $client "refused\n";  
  }  
 # ------------------------------------------------------------- unknown command  
   
     } else {  
  # unknown command  
  print $client "unknown_cmd\n";  
     }  
 # -------------------------------------------------------------------- complete  # -------------------------------------------------------------------- complete
     Debug("process_request - returning 1");      Debug("process_request - returning 1");
     return 1;      return 1;

Removed from v.1.261  
changed lines
  Added in v.1.263


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