--- loncom/lond 2004/10/18 10:13:46 1.261 +++ loncom/lond 2005/02/06 07:39:49 1.277 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.261 2004/10/18 10:13:46 foxr Exp $ +# $Id: lond,v 1.277 2005/02/06 07:39:49 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -46,6 +46,7 @@ use Authen::Krb5; use lib '/home/httpd/lib/perl/'; use localauth; use localenroll; +use localstudentphoto; use File::Copy; use LONCAPA::ConfigFileEdit; use LONCAPA::lonlocal; @@ -57,14 +58,13 @@ my $DEBUG = 0; # Non zero to ena my $status=''; my $lastlog=''; -my $VERSION='$Revision: 1.261 $'; #' stupid emacs +my $VERSION='$Revision: 1.277 $'; #' stupid emacs my $remoteVERSION; my $currenthostid="default"; my $currentdomainid; my $client; my $clientip; # IP address of client. -my $clientdns; # DNS name of client. my $clientname; # LonCAPA name of client. my $server; @@ -177,7 +177,6 @@ sub ResetStatistics { # $initcmd - The full text of the init command. # # Implicit inputs: -# $clientdns - The DNS name of the remote client. # $thisserver - Our DNS name. # # Returns: @@ -186,10 +185,10 @@ sub ResetStatistics { # sub LocalConnection { my ($Socket, $initcmd) = @_; - Debug("Attempting local connection: $initcmd client: $clientdns me: $thisserver"); - if($clientdns ne $thisserver) { + Debug("Attempting local connection: $initcmd client: $clientip me: $thisserver"); + if($clientip ne "127.0.0.1") { &logthis(' LocalConnection rejecting non local: ' - ."$clientdns ne $thisserver "); + ."$clientip ne $thisserver "); close $Socket; return undef; } else { @@ -1130,7 +1129,6 @@ sub read_profile { # 0 - Program should exit. # Side effects: # Reply information is sent to the client. - sub ping_handler { my ($cmd, $tail, $client) = @_; Debug("$cmd $tail $client .. $currenthostid:"); @@ -1158,7 +1156,6 @@ sub ping_handler { # 0 - Program should exit. # Side effects: # Reply information is sent to the client. - sub pong_handler { my ($cmd, $tail, $replyfd) = @_; @@ -1213,7 +1210,6 @@ sub establish_key_handler { } ®ister_handler("ekey", \&establish_key_handler, 0, 1,1); - # Handler for the load command. Returns the current system load average # to the requestor. # @@ -1248,7 +1244,7 @@ sub load_handler { return 1; } -register_handler("load", \&load_handler, 0, 1, 0); +®ister_handler("load", \&load_handler, 0, 1, 0); # # Process the userload request. This sub returns to the client the current @@ -1278,7 +1274,7 @@ sub user_load_handler { return 1; } -register_handler("userload", \&user_load_handler, 0, 1, 0); +®ister_handler("userload", \&user_load_handler, 0, 1, 0); # Process a request for the authorization type of a user: # (userauth). @@ -1314,8 +1310,10 @@ sub user_authorization_type { my ($type,$otherinfo) = split(/:/,$result); if($type =~ /^krb/) { $type = $result; - } - &Reply( $replyfd, "$type:\n", $userinput); + } else { + $type .= ':'; + } + &Reply( $replyfd, "$type\n", $userinput); } return 1; @@ -1335,7 +1333,6 @@ sub user_authorization_type { # 0 - Program should exit # Implicit Output: # a reply is written to the client. - sub push_file_handler { my ($cmd, $tail, $client) = @_; @@ -1378,7 +1375,6 @@ sub push_file_handler { # Side Effects: # The reply is written to $client. # - sub du_handler { my ($cmd, $ududir, $client) = @_; my ($ududir) = split(/:/,$ududir); # Make 'telnet' testing easier. @@ -1412,7 +1408,6 @@ sub du_handler { } ®ister_handler("du", \&du_handler, 0, 1, 0); - # # ls - list the contents of a directory. For each file in the # selected directory the filename followed by the full output of @@ -1476,9 +1471,6 @@ sub ls_handler { } ®ister_handler("ls", \&ls_handler, 0, 1, 0); - - - # Process a reinit request. Reinit requests that either # lonc or lond be reinitialized so that an updated # host.tab or domain.tab can be processed. @@ -1508,7 +1500,6 @@ sub reinit_process_handler { } return 1; } - ®ister_handler("reinit", \&reinit_process_handler, 1, 0, 1); # Process the editing script for a table edit operation. @@ -1550,8 +1541,7 @@ sub edit_table_handler { } return 1; } -register_handler("edit", \&edit_table_handler, 1, 0, 1); - +®ister_handler("edit", \&edit_table_handler, 1, 0, 1); # # Authenticate a user against the LonCAPA authentication @@ -1606,8 +1596,7 @@ sub authenticate_handler { return 1; } - -register_handler("auth", \&authenticate_handler, 1, 1, 0); +®ister_handler("auth", \&authenticate_handler, 1, 1, 0); # # Change a user's password. Note that this function is complicated by @@ -1698,8 +1687,7 @@ sub change_password_handler { return 1; } -register_handler("passwd", \&change_password_handler, 1, 1, 0); - +®ister_handler("passwd", \&change_password_handler, 1, 1, 0); # # Create a new user. User in this case means a lon-capa user. @@ -1738,18 +1726,10 @@ sub add_user_handler { if (-e $passfilename) { &Failure( $client, "already_exists\n", $userinput); } else { - my @fpparts=split(/\//,$passfilename); - my $fpnow=$fpparts[0].'/'.$fpparts[1].'/'.$fpparts[2]; my $fperror=''; - for (my $i=3;$i<= ($#fpparts-1);$i++) { - $fpnow.='/'.$fpparts[$i]; - unless (-e $fpnow) { - &logthis("mkdir $fpnow"); - unless (mkdir($fpnow,0777)) { - $fperror="error: ".($!+0)." mkdir failed while attempting " - ."makeuser"; - } - } + if (!&mkpath($passfilename)) { + $fperror="error: ".($!+0)." mkdir failed while attempting " + ."makeuser"; } unless ($fperror) { my $result=&make_passwd_file($uname, $umode,$npass, $passfilename); @@ -1817,10 +1797,11 @@ sub change_authentication_handler { # to take ownership of the construction space back to www:www # - if( ($oldauth =~ /^unix/) && ($umode eq "internal")) { # unix -> internal + if( (($oldauth =~ /^unix/) && ($umode eq "internal")) || + (($oldauth =~ /^internal/) && ($umode eq "unix")) ) { if(&is_author($udom, $uname)) { &Debug(" Need to manage author permissions..."); - &manage_permissions("/$udom/_au", $udom, $uname, "internal:"); + &manage_permissions("/$udom/_au", $udom, $uname, "$umode:"); } } @@ -1980,21 +1961,10 @@ sub fetch_user_file_handler { # Note that any regular files in the way of this path are # wiped out to deal with some earlier folly of mine. - my $path = $udir; - if ($ufile =~m|(.+)/([^/]+)$|) { - my @parts=split('/',$1); - foreach my $part (@parts) { - $path .= '/'.$part; - if( -f $path) { - unlink($path); - } - if ((-e $path)!=1) { - mkdir($path,0770); - } - } + if (!&mkpath($udir.'/'.$ufile)) { + &Failure($client, "unable_to_create\n", $userinput); } - my $destname=$udir.'/'.$ufile; my $transname=$udir.'/'.$ufile.'.in.transit'; my $remoteurl='http://'.$clientip.'/userfiles/'.$fname; @@ -2038,7 +2008,6 @@ sub fetch_user_file_handler { # # Returns: # 1 - Continue processing. - sub remove_user_file_handler { my ($cmd, $tail, $client) = @_; @@ -2091,7 +2060,6 @@ sub remove_user_file_handler { # # Returns: # 1 - Continue processing. - sub mkdir_user_file_handler { my ($cmd, $tail, $client) = @_; @@ -2105,24 +2073,11 @@ sub mkdir_user_file_handler { } else { my $udir = &propath($udom,$uname); if (-e $udir) { - my $newdir=$udir.'/userfiles/'.$ufile; - if (!-e $newdir) { - my @parts=split('/',$newdir); - my $path; - foreach my $part (@parts) { - $path .= '/'.$part; - if (!-e $path) { - mkdir($path,0770); - } - } - if (!-e $newdir) { - &Failure($client, "failed\n", "$cmd:$tail"); - } else { - &Reply($client, "ok\n", "$cmd:$tail"); - } - } else { - &Failure($client, "not_found\n", "$cmd:$tail"); + my $newdir=$udir.'/userfiles/'.$ufile.'/'; + if (!&mkpath($newdir)) { + &Failure($client, "failed\n", "$cmd:$tail"); } + &Reply($client, "ok\n", "$cmd:$tail"); } else { &Failure($client, "not_home\n", "$cmd:$tail"); } @@ -2140,7 +2095,6 @@ sub mkdir_user_file_handler { # # Returns: # 1 - Continue processing. - sub rename_user_file_handler { my ($cmd, $tail, $client) = @_; @@ -2174,10 +2128,9 @@ sub rename_user_file_handler { } ®ister_handler("renameuserfile", \&rename_user_file_handler, 0,1,0); - # -# Authenticate access to a user file by checking the user's -# session token(?) +# Authenticate access to a user file by checking that the token the user's +# passed also exists in their session file # # Parameters: # cmd - The request keyword that dispatched to tus. @@ -2185,7 +2138,6 @@ sub rename_user_file_handler { # client - Filehandle open on the client. # Return: # 1. - sub token_auth_user_file_handler { my ($cmd, $tail, $client) = @_; @@ -2206,10 +2158,8 @@ sub token_auth_user_file_handler { return 1; } - ®ister_handler("tokenauthuserfile", \&token_auth_user_file_handler, 0,1,0); - # # Unsubscribe from a resource. # @@ -2238,6 +2188,7 @@ sub unsubscribe_handler { return 1; } ®ister_handler("unsub", \&unsubscribe_handler, 0, 1, 0); + # Subscribe to a resource # # Parameters: @@ -2316,7 +2267,7 @@ sub activity_log_handler { return 1; } -register_handler("log", \&activity_log_handler, 0, 1, 0); +®ister_handler("log", \&activity_log_handler, 0, 1, 0); # # Put a namespace entry in a user profile hash. @@ -2421,7 +2372,6 @@ sub increment_user_value_handler { } ®ister_handler("inc", \&increment_user_value_handler, 0, 1, 0); - # # 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 @@ -2629,6 +2579,7 @@ sub get_profile_entry_encrypted { return 1; } ®ister_handler("eget", \&get_profile_entry_encrypted, 0, 1, 0); + # # Deletes a key in a user profile database. # @@ -2647,7 +2598,6 @@ sub get_profile_entry_encrypted { # 0 - Exit server. # # - sub delete_profile_entry { my ($cmd, $tail, $client) = @_; @@ -2676,6 +2626,7 @@ sub delete_profile_entry { return 1; } ®ister_handler("del", \&delete_profile_entry, 0, 1, 0); + # # List the set of keys that are defined in a profile database file. # A successful reply from this will contain an & separated list of @@ -2854,7 +2805,6 @@ sub dump_with_regexp { return 1; } - ®ister_handler("dump", \&dump_with_regexp, 0, 1, 0); # Store a set of key=value pairs associated with a versioned name. @@ -2886,7 +2836,7 @@ sub store_handler { chomp($what); my @pairs=split(/\&/,$what); my $hashref = &tie_user_hash($udom, $uname, $namespace, - &GDBM_WRCREAT(), "P", + &GDBM_WRCREAT(), "S", "$rid:$what"); if ($hashref) { my $now = time; @@ -2920,6 +2870,7 @@ sub store_handler { return 1; } ®ister_handler("store", \&store_handler, 0, 1, 0); + # # 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 @@ -3020,6 +2971,7 @@ sub send_chat_handler { return 1; } ®ister_handler("chatsend", \&send_chat_handler, 0, 1, 0); + # # Retrieve the set of chat messagss from a discussion board. # @@ -3155,6 +3107,14 @@ sub reply_query_handler { # $tail - Tail of the command. In this case consists of a colon # separated list contaning the domain to apply this to and # an ampersand separated list of keyword=value pairs. +# Each value is a colon separated list that includes: +# description, institutional code and course owner. +# For backward compatibility with versions included +# in LON-CAPA 1.1.X (and earlier) and 1.2.X, institutional +# code and/or course owner are preserved from the existing +# record when writing a new record in response to 1.1 or +# 1.2 implementations of lonnet::flushcourselogs(). +# # $client - Socket open on the client. # Returns: # 1 - indicating that processing should continue @@ -3168,7 +3128,7 @@ sub put_course_id_handler { my $userinput = "$cmd:$tail"; - my ($udom, $what) = split(/:/, $tail); + my ($udom, $what) = split(/:/, $tail,2); chomp($what); my $now=time; my @pairs=split(/\&/,$what); @@ -3176,8 +3136,24 @@ sub put_course_id_handler { my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT()); if ($hashref) { foreach my $pair (@pairs) { - my ($key,$descr,$inst_code)=split(/=/,$pair); - $hashref->{$key}=$descr.':'.$inst_code.':'.$now; + my ($key,$courseinfo) = split(/=/,$pair,2); + $courseinfo =~ s/=/:/g; + + my @current_items = split(/:/,$hashref->{$key}); + shift(@current_items); # remove description + pop(@current_items); # remove last access + my $numcurrent = scalar(@current_items); + + my @new_items = split(/:/,$courseinfo); + my $numnew = scalar(@new_items); + if ($numcurrent > 0) { + if ($numnew == 1) { # flushcourselogs() from 1.1 or earlier + $courseinfo .= ':'.join(':',@current_items); + } elsif ($numnew == 2) { # flushcourselogs() from 1.2.X + $courseinfo .= ':'.$current_items[$numcurrent-1]; + } + } + $hashref->{$key}=$courseinfo.':'.$now; } if (untie(%$hashref)) { &Reply( $client, "ok\n", $userinput); @@ -3215,6 +3191,15 @@ sub put_course_id_handler { # description - regular expression that is used to filter # the dump. Only keywords matching this regexp # will be used. +# institutional code - optional supplied code to filter +# the dump. Only courses with an institutional code +# that match the supplied code will be returned. +# owner - optional supplied username of owner to filter +# the dump. Only courses for which the course +# owner matches the supplied username will be +# returned. Implicit assumption that owner +# is a user in the domain in which the +# course database is defined. # $client - The socket open on the client. # Returns: # 1 - Continue processing. @@ -3225,32 +3210,55 @@ sub dump_course_id_handler { my $userinput = "$cmd:$tail"; - my ($udom,$since,$description) =split(/:/,$tail); + my ($udom,$since,$description,$instcodefilter,$ownerfilter) =split(/:/,$tail); if (defined($description)) { $description=&unescape($description); } else { $description='.'; } + if (defined($instcodefilter)) { + $instcodefilter=&unescape($instcodefilter); + } else { + $instcodefilter='.'; + } + if (defined($ownerfilter)) { + $ownerfilter=&unescape($ownerfilter); + } else { + $ownerfilter='.'; + } + unless (defined($since)) { $since=0; } my $qresult=''; my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT()); if ($hashref) { while (my ($key,$value) = each(%$hashref)) { - my ($descr,$lasttime,$inst_code); - if ($value =~ m/^([^\:]*):([^\:]*):(\d+)$/) { - ($descr,$inst_code,$lasttime)=($1,$2,$3); - } else { - ($descr,$lasttime) = split(/\:/,$value); - } + my ($descr,$lasttime,$inst_code,$owner); + my @courseitems = split(/:/,$value); + $lasttime = pop(@courseitems); + ($descr,$inst_code,$owner)=@courseitems; if ($lasttime<$since) { next; } - if ($description eq '.') { - $qresult.=$key.'='.$descr.':'.$inst_code.'&'; - } else { - my $unescapeVal = &unescape($descr); - if (eval('$unescapeVal=~/\Q$description\E/i')) { - $qresult.=$key.'='.$descr.':'.$inst_code.'&'; + my $match = 1; + unless ($description eq '.') { + my $unescapeDescr = &unescape($descr); + unless (eval('$unescapeDescr=~/\Q$description\E/i')) { + $match = 0; } + } + unless ($instcodefilter eq '.' || !defined($instcodefilter)) { + my $unescapeInstcode = &unescape($inst_code); + unless (eval('$unescapeInstcode=~/\Q$instcodefilter\E/i')) { + $match = 0; + } } + unless ($ownerfilter eq '.' || !defined($ownerfilter)) { + my $unescapeOwner = &unescape($owner); + unless (eval('$unescapeOwner=~/\Q$ownerfilter\E/i')) { + $match = 0; + } + } + if ($match == 1) { + $qresult.=$key.'='.$descr.':'.$inst_code.':'.$owner.'&'; + } } if (untie(%$hashref)) { chop($qresult); @@ -3314,8 +3322,8 @@ sub put_id_handler { return 1; } - ®ister_handler("idput", \&put_id_handler, 0, 1, 0); + # # Retrieves a set of id values from the id database. # Returns an & separated list of results, one for each requested id to the @@ -3364,8 +3372,7 @@ sub get_id_handler { return 1; } - -register_handler("idget", \&get_id_handler, 0, 1, 0); +®ister_handler("idget", \&get_id_handler, 0, 1, 0); # # Process the tmpput command I'm not sure what this does.. Seems to @@ -3408,6 +3415,7 @@ sub tmp_put_handler { } ®ister_handler("tmpput", \&tmp_put_handler, 0, 1, 0); + # Processes the tmpget command. This command returns the contents # of a temporary resource file(?) created via tmpput. # @@ -3420,7 +3428,6 @@ sub tmp_put_handler { # 1 - Inidcating processing can continue. # Side effects: # A reply is sent to the client. - # sub tmp_get_handler { my ($cmd, $id, $client) = @_; @@ -3443,6 +3450,7 @@ sub tmp_get_handler { return 1; } ®ister_handler("tmpget", \&tmp_get_handler, 0, 1, 0); + # # Process the tmpdel command. This command deletes a temp resource # created by the tmpput command. @@ -3476,6 +3484,7 @@ sub tmp_del_handler { } ®ister_handler("tmpdel", \&tmp_del_handler, 0, 1, 0); + # # Processes the setannounce command. This command # creates a file named announce.txt in the top directory of @@ -3514,6 +3523,7 @@ sub set_announce_handler { return 1; } ®ister_handler("setannounce", \&set_announce_handler, 0, 1, 0); + # # Return the version of the daemon. This can be used to determine # the compatibility of cross version installations or, alternatively to @@ -3538,6 +3548,7 @@ sub get_version_handler { return 1; } ®ister_handler("version", \&get_version_handler, 0, 1, 0); + # Set the current host and domain. This is used to support # multihomed systems. Each IP of the system, or even separate daemons # on the same IP can be treated as handling a separate lonCAPA virtual @@ -3674,6 +3685,7 @@ sub validate_course_owner_handler { return 1; } ®ister_handler("autonewcourse", \&validate_course_owner_handler, 0, 1, 0); + # # Validate a course section in the official schedule of classes # from the institutions point of view (part of autoenrollment). @@ -3754,7 +3766,6 @@ sub create_auto_enroll_password_handler # # Returns: # 1 - Continue processing. - sub retrieve_auto_file_handler { my ($cmd, $tail, $client) = @_; my $userinput = "cmd:$tail"; @@ -3839,20 +3850,67 @@ sub get_institutional_code_format_handle return 1; } +®ister_handler("autoinstcodeformat", + \&get_institutional_code_format_handler,0,1,0); -®ister_handler("autoinstcodeformat", \&get_institutional_code_format_handler, - 0,1,0); - -# -# -# -# # +# Gets a student's photo to exist (in the correct image type) in the user's +# directory. +# Formal Parameters: +# $cmd - The command request that got us dispatched. +# $tail - A colon separated set of words that will be split into: +# $domain - student's domain +# $uname - student username +# $type - image type desired +# $client - The socket open on the client. +# Returns: +# 1 - continue processing. +sub student_photo_handler { + my ($cmd, $tail, $client) = @_; + my ($domain,$uname,$type) = split(/:/, $tail); + + my $path=&propath($domain,$uname). + '/userfiles/internal/studentphoto.'.$type; + if (-e $path) { + &Reply($client,"ok\n","$cmd:$tail"); + return 1; + } + &mkpath($path); + my $file=&localstudentphoto::fetch($domain,$uname); + if (!$file) { + &Failure($client,"unavailable\n","$cmd:$tail"); + return 1; + } + if (!-e $path) { &convert_photo($file,$path); } + if (-e $path) { + &Reply($client,"ok\n","$cmd:$tail"); + return 1; + } + &Failure($client,"unable_to_convert\n","$cmd:$tail"); + return 1; +} +®ister_handler("studentphoto", \&student_photo_handler, 0, 1, 0); + +# mkpath makes all directories for a file, expects an absolute path with a +# file or a trailing / if just a dir is passed +# returns 1 on success 0 on failure +sub mkpath { + my ($file)=@_; + my @parts=split(/\//,$file,-1); + my $now=$parts[0].'/'.$parts[1].'/'.$parts[2]; + for (my $i=3;$i<= ($#parts-1);$i++) { + $now.='/'.$parts[$i]; + if (!-e $now) { + if (!mkdir($now,0770)) { return 0; } + } + } + return 1; +} + #--------------------------------------------------------------- # # Getting, decoding and dispatching requests: # - # # Get a Request: # Gets a Request message from the client. The transaction @@ -3959,114 +4017,7 @@ sub process_request { } -#------------------- Commands not yet in spearate handlers. -------------- - -#------------------------------- 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"; - } + print $client "unknown_cmd\n"; # -------------------------------------------------------------------- complete Debug("process_request - returning 1"); return 1; @@ -4328,12 +4279,18 @@ sub ReadHostTable { my $myloncapaname = $perlvar{'lonHostID'}; Debug("My loncapa name is : $myloncapaname"); while (my $configline=) { - if (!($configline =~ /^\s*\#/)) { - my ($id,$domain,$role,$name,$ip)=split(/:/,$configline); - chomp($ip); $ip=~s/\D+$//; + if ($configline !~ /^\s*\#/ && $configline !~ /^\s*$/ ) { + my ($id,$domain,$role,$name)=split(/:/,$configline); + $name=~s/\s//g; + my (undef,undef,undef,undef,$ip) = gethostbyname($name); + if (length($ip) ne 4) { + &logthis("Skipping host $id name $name no IP $ip found\n"); + next; + } + $ip=inet_ntoa($ip); $hostid{$ip}=$id; # LonCAPA name of host by IP. $hostdom{$id}=$domain; # LonCAPA domain name of host. - $hostip{$id}=$ip; # IP address of host. + $hostip{$id}=$ip; # IP address of host. $hostdns{$name} = $id; # LonCAPA name of host by DNS. if ($id eq $perlvar{'lonHostID'}) { @@ -4514,7 +4471,7 @@ sub logstatus { flock(LOG,LOCK_EX); print LOG $$."\t".$clientname."\t".$currenthostid."\t" .$status."\t".$lastlog."\t $keymode\n"; - flock(DB,LOCK_UN); + flock(LOG,LOCK_UN); close(LOG); } &status("Finished logging"); @@ -4745,8 +4702,6 @@ sub make_new_child { if (defined($iaddr)) { $clientip = inet_ntoa($iaddr); Debug("Connected with $clientip"); - $clientdns = gethostbyaddr($iaddr, AF_INET); - Debug("Connected with $clientdns by name"); } else { &logthis("Unable to determine clientip"); $clientip='Unavailable'; @@ -5010,12 +4965,7 @@ sub manage_permissions # sub password_path { my ($domain, $user) = @_; - - - my $path = &propath($domain, $user); - $path .= "/passwd"; - - return $path; + return &propath($domain, $user).'/passwd'; } # Password Filename @@ -5188,7 +5138,7 @@ sub validate_user { my $krbserver = &Authen::Krb5::parse_name($krbservice); my $credentials= &Authen::Krb5::cc_default(); $credentials->initialize($krbclient); - my $krbreturn = &Authen::KRb5::get_in_tkt_with_password($krbclient, + my $krbreturn = &Authen::Krb5::get_in_tkt_with_password($krbclient, $krbserver, $password, $credentials); @@ -5526,6 +5476,11 @@ sub make_passwd_file { return $result; } +sub convert_photo { + my ($start,$dest)=@_; + system("convert $start $dest"); +} + sub sethost { my ($remotereq) = @_; my (undef,$hostid)=split(/:/,$remotereq);