--- loncom/lond 2004/10/19 10:57:06 1.262 +++ loncom/lond 2004/12/08 22:45:33 1.267 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.262 2004/10/19 10:57:06 foxr Exp $ +# $Id: lond,v 1.267 2004/12/08 22:45:33 raeburn 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,7 +58,7 @@ my $DEBUG = 0; # Non zero to ena my $status=''; my $lastlog=''; -my $VERSION='$Revision: 1.262 $'; #' stupid emacs +my $VERSION='$Revision: 1.267 $'; #' stupid emacs my $remoteVERSION; my $currenthostid="default"; my $currentdomainid; @@ -1130,7 +1131,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 +1158,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 +1212,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 +1246,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 +1276,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). @@ -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); @@ -1980,21 +1960,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 +2007,6 @@ sub fetch_user_file_handler { # # Returns: # 1 - Continue processing. - sub remove_user_file_handler { my ($cmd, $tail, $client) = @_; @@ -2091,7 +2059,6 @@ sub remove_user_file_handler { # # Returns: # 1 - Continue processing. - sub mkdir_user_file_handler { my ($cmd, $tail, $client) = @_; @@ -2105,24 +2072,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 +2094,6 @@ sub mkdir_user_file_handler { # # Returns: # 1 - Continue processing. - sub rename_user_file_handler { my ($cmd, $tail, $client) = @_; @@ -2174,10 +2127,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 +2137,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 +2157,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 +2187,7 @@ sub unsubscribe_handler { return 1; } ®ister_handler("unsub", \&unsubscribe_handler, 0, 1, 0); + # Subscribe to a resource # # Parameters: @@ -2316,7 +2266,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 +2371,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 +2578,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 +2597,6 @@ sub get_profile_entry_encrypted { # 0 - Exit server. # # - sub delete_profile_entry { my ($cmd, $tail, $client) = @_; @@ -2676,6 +2625,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 +2804,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. @@ -2920,6 +2869,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 +2970,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. # @@ -3168,7 +3119,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 +3127,8 @@ 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); + $hashref->{$key}=$courseinfo.':'.$now; } if (untie(%$hashref)) { &Reply( $client, "ok\n", $userinput); @@ -3225,32 +3176,59 @@ 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+)$/) { + my ($descr,$lasttime,$inst_code,$owner); + if ($value =~ m/^([^\:]*):([^\:]*):([^\:]*):(\d+)$/) { + ($descr,$inst_code,$owner,$lasttime)=($1,$2,$3,$4); + } elsif ($value =~ m/^([^\:]*):([^\:]*):(\d+)$/) { ($descr,$inst_code,$lasttime)=($1,$2,$3); } else { ($descr,$lasttime) = split(/\:/,$value); } 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 +3292,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 +3342,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 +3385,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 +3398,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 +3420,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 +3454,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 +3493,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 +3518,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 +3655,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 +3736,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 +3820,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 @@ -4903,12 +4931,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 @@ -5419,6 +5442,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);