--- loncom/lond 2006/03/04 04:27:38 1.318.2.6 +++ loncom/lond 2006/03/04 00:59:59 1.323 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.318.2.6 2006/03/04 04:27:38 albertel Exp $ +# $Id: lond,v 1.323 2006/03/04 00:59:59 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.318.2.6 $'; #' stupid emacs +my $VERSION='$Revision: 1.323 $'; #' stupid emacs my $remoteVERSION; my $currenthostid="default"; my $currentdomainid; @@ -2915,21 +2915,11 @@ sub dump_profile_database { while (my ($key,$value) = each(%$hashref)) { my ($v,$symb,$param) = split(/:/,$key); next if ($v eq 'version' || $symb eq 'keys'); - # 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; - } + 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)) { @@ -3078,10 +3068,11 @@ sub store_handler { my $version=$hashref->{"version:$rid"}; my $allkeys=''; foreach my $pair (@pairs) { - my ($key)=split(/=/,$pair); + my ($key,$value)=split(/=/,$pair); $allkeys.=$key.':'; + $hashref->{"$version:$rid:$key"}=$value; } - $hashref->{"$version:compressed:$rid"}=$what."\×tamp=$now"; + $hashref->{"$version:$rid:timestamp"}=$now; $allkeys.='timestamp'; $hashref->{"$version:keys:$rid"}=$allkeys; if (&untie_user_hash($hashref)) { @@ -3102,6 +3093,25 @@ sub store_handler { } ®ister_handler("store", \&store_handler, 0, 1, 0); +# Modify a set of key=value pairs associated with a versioned name. +# +# Parameters: +# $cmd - Request command keyword. +# $tail - Tail of the request. This is a colon +# separated list containing: +# domain/user - User and authentication domain. +# namespace - Name of the database being modified +# rid - Resource keyword to modify. +# v - Version item to modify +# what - new value associated with rid. +# +# $client - Socket open on the client. +# +# +# Returns: +# 1 (keep on processing). +# Side-Effects: +# Writes to the client sub putstore_handler { my ($cmd, $tail, $client) = @_; @@ -3112,24 +3122,15 @@ sub putstore_handler { chomp($what); my $hashref = &tie_user_hash($udom, $uname, $namespace, - &GDBM_WRCREAT(), "C", - "$rid:$what"); + &GDBM_WRCREAT(), "M", + "$rid:$v:$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; - } + while (my($key,$value) = each(%data)) { + push(@allkeys,$key); + $hashref->{"$v:$rid:$key"} = $value; } my $allkeys = join(':',@allkeys); $hashref->{"$v:keys:$rid"}=$allkeys; @@ -3216,16 +3217,9 @@ sub restore_handler { my @keys=split(/:/,$vkeys); my $key; $qresult.="$scope:keys=$vkeys&"; - 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"}."&"; - } - } + foreach $key (@keys) { + $qresult.="$scope:$key=".$hashref->{"$scope:$rid:$key"}."&"; + } } if (&untie_user_hash($hashref)) { $qresult=~s/\&$//; @@ -4433,10 +4427,19 @@ sub photo_permission_handler { 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); + 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); @@ -4461,6 +4464,7 @@ sub photo_check_handler { 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); @@ -4474,8 +4478,17 @@ 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); + 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); @@ -4508,7 +4521,10 @@ sub student_photo_handler { &mkpath($path); my $file; if ($type eq 'thumbnail') { - $file=&localstudentphoto::fetch_thumbnail($domain,$uname); + eval { + local($SIG{__DIE__})='DEFAULT'; + $file=&localstudentphoto::fetch_thumbnail($domain,$uname); + }; } else { $file=&localstudentphoto::fetch($domain,$uname); } @@ -4578,6 +4594,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; @@ -5231,7 +5263,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"; } @@ -5566,8 +5598,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"); @@ -6167,6 +6202,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;