--- loncom/lond 2006/01/31 16:12:12 1.313 +++ loncom/lond 2006/03/04 04:27:38 1.318.2.6 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.313 2006/01/31 16:12:12 albertel Exp $ +# $Id: lond,v 1.318.2.6 2006/03/04 04:27:38 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.313 $'; #' stupid emacs +my $VERSION='$Revision: 1.318.2.6 $'; #' stupid emacs my $remoteVERSION; my $currenthostid="default"; my $currentdomainid; @@ -1074,10 +1074,8 @@ sub _do_hash_untie { die(); } - &logthis("$$ for $namespace"); $sym=&Symbol::gensym(); open($sym,"$file_prefix.db"); - &logthis("$$ for $namespace attempt lock"); my $failed=0; eval { local $SIG{__DIE__}='DEFAULT'; @@ -1090,11 +1088,9 @@ sub _do_hash_untie { alarm(0); }; if ($failed) { - &logthis("$$ for $namespace got failed lock"); $! = 100; # throwing error # 100 return undef; } - &logthis("$$ for $file_prefix.db got lock"); return &_do_hash_tie($file_prefix,$namespace,$how,$loghead,$what); } @@ -2455,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 { @@ -2491,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; } @@ -2681,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 ". @@ -2822,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 ". @@ -2864,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 { @@ -2919,11 +2915,21 @@ sub dump_profile_database { while (my ($key,$value) = each(%$hashref)) { my ($v,$symb,$param) = split(/:/,$key); next if ($v eq 'version' || $symb eq 'keys'); - next if (exists($data{$symb}) && - exists($data{$symb}->{$param}) && - $data{$symb}->{'v.'.$param} > $v); - $data{$symb}->{$param}=$value; - $data{$symb}->{'v.'.$param}=$v; + # making old style store entries '$ver:$symb:$key = $value' + # look like new '$ver:compressed:$symb = "$key=$value"' + if ($symb eq 'compressed') { + $symb = $param; + } else { + $value = $param.'='.$value; + } + foreach my $pair (split(/\&/,$value)) { + my ($param,$value)=split(/=/,$pair); + next if (exists($data{$symb}) && + exists($data{$symb}->{$param}) && + $data{$symb}->{'v.'.$param} > $v); + $data{$symb}->{$param}=$value; + $data{$symb}->{'v.'.$param}=$v; + } } if (&untie_user_hash($hashref)) { while (my ($symb,$param_hash) = each(%data)) { @@ -3072,11 +3078,10 @@ sub store_handler { my $version=$hashref->{"version:$rid"}; my $allkeys=''; foreach my $pair (@pairs) { - my ($key,$value)=split(/=/,$pair); + my ($key)=split(/=/,$pair); $allkeys.=$key.':'; - $hashref->{"$version:$rid:$key"}=$value; } - $hashref->{"$version:$rid:timestamp"}=$now; + $hashref->{"$version:compressed:$rid"}=$what."\×tamp=$now"; $allkeys.='timestamp'; $hashref->{"$version:keys:$rid"}=$allkeys; if (&untie_user_hash($hashref)) { @@ -3097,6 +3102,75 @@ sub store_handler { } ®ister_handler("store", \&store_handler, 0, 1, 0); +sub putstore_handler { + my ($cmd, $tail, $client) = @_; + + my $userinput = "$cmd:$tail"; + + my ($udom,$uname,$namespace,$rid,$v,$what) =split(/:/,$tail); + if ($namespace ne 'roles') { + + chomp($what); + my $hashref = &tie_user_hash($udom, $uname, $namespace, + &GDBM_WRCREAT(), "C", + "$rid:$what"); + if ($hashref) { + my $now = time; + my %data = &hash_extract($what); + my @allkeys; + if (exists($hashref->{"$v:compressed:$rid"})) { + my %current = &hash_extract($hashref->{"$v:compressed:$rid"}); + while (my($key,$value) = each(%data)) { + push(@allkeys,$key); + $current{$key} = $value; + } + $hashref->{"$v:compressed:$rid"}= &hash_to_str(\%current); + } else { + while (my($key,$value) = each(%data)) { + push(@allkeys,$key); + $hashref->{"$v:$rid:$key"} = $value; + } + } + my $allkeys = join(':',@allkeys); + $hashref->{"$v:keys:$rid"}=$allkeys; + + if (&untie_user_hash($hashref)) { + &Reply($client, "ok\n", $userinput); + } else { + &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ". + "while attempting store\n", $userinput); + } + } else { + &Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ". + "while attempting store\n", $userinput); + } + } else { + &Failure($client, "refused\n", $userinput); + } + + return 1; +} +®ister_handler("putstore", \&putstore_handler, 0, 1, 0); + +sub hash_extract { + my ($str)=@_; + my %hash; + foreach my $pair (split(/\&/,$str)) { + my ($key,$value)=split(/=/,$pair); + $hash{$key}=$value; + } + return (%hash); +} +sub hash_to_str { + my ($hash_ref)=@_; + my $str; + foreach my $key (keys(%$hash_ref)) { + $str.=$key.'='.$hash_ref->{$key}.'&'; + } + $str=~s/\&$//; + return $str; +} + # # 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 @@ -3142,9 +3216,16 @@ sub restore_handler { my @keys=split(/:/,$vkeys); my $key; $qresult.="$scope:keys=$vkeys&"; - foreach $key (@keys) { - $qresult.="$scope:$key=".$hashref->{"$scope:$rid:$key"}."&"; - } + if (exists($hashref->{"$scope:compressed:$rid"})) { + foreach my $pair (split(/\&/,$hashref->{"$scope:compressed:$rid"})) { + my ($key,$value)=split(/=/,$pair); + $qresult.="$scope:".$pair."&"; + } + } else { + foreach $key (@keys) { + $qresult.="$scope:$key=".$hashref->{"$scope:$rid:$key"}."&"; + } + } } if (&untie_user_hash($hashref)) { $qresult=~s/\&$//; @@ -4340,6 +4421,64 @@ 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 = &localenroll::photo_permission($cdom,\$perm_reqd, + \$conditions); + &Reply($client, &escape($outcome.':'.$perm_reqd.':'. $conditions)."\n", + $userinput); +} +®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); +} +®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) = &localenroll::manager_photo_update($cdom); + &Reply($client,&escape($update).':'.&escape($comment)."\n",$userinput); +} +®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. @@ -4352,24 +4491,33 @@ 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') { + $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; }