--- loncom/lond 2006/01/31 16:32:00 1.314 +++ loncom/lond 2006/03/03 20:06:21 1.322 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.314 2006/01/31 16:32:00 albertel Exp $ +# $Id: lond,v 1.322 2006/03/03 20:06:21 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -61,7 +61,7 @@ my $status=''; my $lastlog=''; my $lond_max_wait_time = 13; -my $VERSION='$Revision: 1.314 $'; #' stupid emacs +my $VERSION='$Revision: 1.322 $'; #' stupid emacs my $remoteVERSION; my $currenthostid="default"; my $currentdomainid; @@ -2451,7 +2451,7 @@ sub put_user_profile_entry { $userinput); } } else { - &Failure( $client, "error: ".($!)." tie(GDBM) Failed ". + &Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ". "while attempting put\n", $userinput); } } else { @@ -2487,7 +2487,7 @@ sub newput_user_profile_entry { my $hashref = &tie_user_hash($udom, $uname, $namespace, &GDBM_WRCREAT(),"N",$what); if(!$hashref) { - &Failure( $client, "error: ".($!)." tie(GDBM) Failed ". + &Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ". "while attempting put\n", $userinput); return 1; } @@ -2677,7 +2677,7 @@ sub roles_delete_handler { foreach my $key (@rolekeys) { delete $hashref->{$key}; } - if (&untie_user_hash(%$hashref)) { + if (&untie_user_hash($hashref)) { &Reply($client, "ok\n", $userinput); } else { &Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ". @@ -2818,7 +2818,7 @@ sub delete_profile_entry { foreach my $key (@keys) { delete($hashref->{$key}); } - if (&untie_user_hash(%$hashref)) { + if (&untie_user_hash($hashref)) { &Reply($client, "ok\n", $userinput); } else { &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ". @@ -2860,7 +2860,7 @@ sub get_profile_keys { foreach my $key (keys %$hashref) { $qresult.="$key&"; } - if (&untie_user_hash(%$hashref)) { + if (&untie_user_hash($hashref)) { $qresult=~s/\&$//; &Reply($client, "$qresult\n", $userinput); } else { @@ -4336,6 +4336,83 @@ sub get_institutional_code_format_handle ®ister_handler("autoinstcodeformat", \&get_institutional_code_format_handler,0,1,0); +# Get domain specific conditions for import of student photographs to a course +# +# Retrieves information from photo_permission subroutine in localenroll. +# Returns outcome (ok) if no processing errors, and whether course owner is +# required to accept conditions of use (yes/no). +# +# +sub photo_permission_handler { + my ($cmd, $tail, $client) = @_; + my $userinput = "$cmd:$tail"; + my $cdom = $tail; + my ($perm_reqd,$conditions); + my $outcome; + eval { + local($SIG{__DIE__})='DEFAULT'; + $outcome = &localenroll::photo_permission($cdom,\$perm_reqd, + \$conditions); + }; + if (!$@) { + &Reply($client, &escape($outcome.':'.$perm_reqd.':'. $conditions)."\n", + $userinput); + } else { + &Failure($client,"unknown_cmd\n",$userinput); + } + return 1; +} +®ister_handler("autophotopermission",\&photo_permission_handler,0,1,0); + +# +# Checks if student photo is available for a user in the domain, in the user's +# directory (in /userfiles/internal/studentphoto.jpg). +# Uses localstudentphoto:fetch() to ensure there is an up to date copy of +# the student's photo. + +sub photo_check_handler { + my ($cmd, $tail, $client) = @_; + my $userinput = "$cmd:$tail"; + my ($udom,$uname,$pid) = split(/:/,$tail); + $udom = &unescape($udom); + $uname = &unescape($uname); + $pid = &unescape($pid); + my $path=&propath($udom,$uname).'/userfiles/internal/'; + if (!-e $path) { + &mkpath($path); + } + my $response; + my $result = &localstudentphoto::fetch($udom,$uname,$pid,\$response); + $result .= ':'.$response; + &Reply($client, &escape($result)."\n",$userinput); + return 1; +} +®ister_handler("autophotocheck",\&photo_check_handler,0,1,0); + +# +# Retrieve information from localenroll about whether to provide a button +# for users who have enbled import of student photos to initiate an +# update of photo files for registered students. Also include +# comment to display alongside button. + +sub photo_choice_handler { + my ($cmd, $tail, $client) = @_; + my $userinput = "$cmd:$tail"; + my $cdom = &unescape($tail); + my ($update,$comment); + eval { + local($SIG{__DIE__})='DEFAULT'; + ($update,$comment) = &localenroll::manager_photo_update($cdom); + }; + if (!$@) { + &Reply($client,&escape($update).':'.&escape($comment)."\n",$userinput); + } else { + &Failure($client,"unknown_cmd\n",$userinput); + } + return 1; +} +®ister_handler("autophotochoice",\&photo_choice_handler,0,1,0); + # # Gets a student's photo to exist (in the correct image type) in the user's # directory. @@ -4348,24 +4425,36 @@ sub get_institutional_code_format_handle # $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 ($domain,$uname,$ext,$type) = split(/:/, $tail); - my $path=&propath($domain,$uname). - '/userfiles/internal/studentphoto.'.$type; - if (-e $path) { + my $path=&propath($domain,$uname). '/userfiles/internal/'; + my $filename = 'studentphoto.'.$ext; + if ($type eq 'thumbnail') { + $filename = 'studentphoto_tn.'.$ext; + } + if (-e $path.$filename) { &Reply($client,"ok\n","$cmd:$tail"); return 1; } &mkpath($path); - my $file=&localstudentphoto::fetch($domain,$uname); + my $file; + if ($type eq 'thumbnail') { + eval { + local($SIG{__DIE__})='DEFAULT'; + $file=&localstudentphoto::fetch_thumbnail($domain,$uname); + }; + } else { + $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) { + if (!-e $path.$filename) { &convert_photo($file,$path.$filename); } + if (-e $path.$filename) { &Reply($client,"ok\n","$cmd:$tail"); return 1; } @@ -4426,6 +4515,22 @@ sub process_request { # fix all the userinput -> user_input. my $wasenc = 0; # True if request was encrypted. # ------------------------------------------------------------ See if encrypted + # for command + # sethost: + # : + # we just send it to the processor + # for + # sethost::: + # we do the implict set host and then do the command + if ($userinput =~ /^sethost:/) { + (my $cmd,my $newid,$userinput) = split(':',$userinput,3); + if (defined($userinput)) { + &sethost("$cmd:$newid"); + } else { + $userinput = "$cmd:$newid"; + } + } + if ($userinput =~ /^enc/) { $userinput = decipher($userinput); $wasenc=1; @@ -5079,7 +5184,7 @@ sub sub_sql_reply { Type => SOCK_STREAM, Timeout => 10) or return "con_lost"; - print $sclient "$cmd\n"; + print $sclient "$cmd:$currentdomainid\n"; my $answer=<$sclient>; chomp($answer); if (!$answer) { $answer="con_lost"; } @@ -5414,8 +5519,11 @@ sub is_author { # Author role should show up as a key /domain/_au - my $key = "/$domain/_au"; - my $value = $hashref->{$key}; + my $key = "/$domain/_au"; + my $value; + if (defined($hashref)) { + $value = $hashref->{$key}; + } if(defined($value)) { &Debug("$user @ $domain is an author"); @@ -6015,6 +6123,11 @@ sub convert_photo { sub sethost { my ($remotereq) = @_; my (undef,$hostid)=split(/:/,$remotereq); + # ignore sethost if we are already correct + if ($hostid eq $currenthostid) { + return 'ok'; + } + if (!defined($hostid)) { $hostid=$perlvar{'lonHostID'}; } if ($hostip{$perlvar{'lonHostID'}} eq $hostip{$hostid}) { $currenthostid =$hostid;