Return to lond CVS log

Up to [LON-CAPA] / loncom

Diff for /loncom/lond between versions 1.302 and 1.357

version 1.302, 2005/12/09 20:54:23	version 1.357, 2007/01/19 02:58:17
Line 31	Line 31

use strict;	use strict;
use lib '/home/httpd/lib/perl/';	use lib '/home/httpd/lib/perl/';
	use LONCAPA;
use LONCAPA::Configuration;	use LONCAPA::Configuration;

use IO::Socket;	use IO::Socket;
use IO::File;	use IO::File;
#use Apache::File;	#use Apache::File;
use Symbol;
use POSIX;	use POSIX;
use Crypt::IDEA;	use Crypt::IDEA;
use LWP::UserAgent();	use LWP::UserAgent();
	use Digest::MD5 qw(md5_hex);
use GDBM_File;	use GDBM_File;
use Authen::Krb4;	use Authen::Krb4;
use Authen::Krb5;	use Authen::Krb5;
use lib '/home/httpd/lib/perl/';
use localauth;	use localauth;
use localenroll;	use localenroll;
use localstudentphoto;	use localstudentphoto;
Line 87 my $ConnectionType;	Line 87 my $ConnectionType;

my %hostid; # ID's for hosts in cluster by ip.	my %hostid; # ID's for hosts in cluster by ip.
my %hostdom; # LonCAPA domain for hosts in cluster.	my %hostdom; # LonCAPA domain for hosts in cluster.
	my %hostname; # DNSname -> ID's mapping.
my %hostip; # IPs for hosts in cluster.	my %hostip; # IPs for hosts in cluster.
my %hostdns; # ID's of hosts looked up by DNS name.	my %hostdns; # ID's of hosts looked up by DNS name.

Line 502 sub AdjustHostContents {	Line 503 sub AdjustHostContents {
my $adjusted;	my $adjusted;
my $me = $perlvar{'lonHostID'};	my $me = $perlvar{'lonHostID'};

foreach my $line (split(/\n/,$contents)) {	foreach my $line (split(/\n/,$contents)) {
if(!(($line eq "") \|\| ($line =~ /^ \#/) \|\| ($line =~ /^ $/))) {	if(!(($line eq "") \|\| ($line =~ /^ \#/) \|\| ($line =~ /^ $/))) {
chomp($line);	chomp($line);
my ($id,$domain,$role,$name,$ip,$maxcon,$idleto,$mincon)=split(/:/,$line);	my ($id,$domain,$role,$name,$ip,$maxcon,$idleto,$mincon)=split(/:/,$line);
if ($id eq $me) {	if ($id eq $me) {
my $ip = gethostbyname($name);	my $ip = gethostbyname($name);
my $ipnew = inet_ntoa($ip);	my $ipnew = inet_ntoa($ip);
$ip = $ipnew;	$ip = $ipnew;
# Reconstruct the host line and append to adjusted:	# Reconstruct the host line and append to adjusted:

my $newline = "$id:$domain:$role:$name:$ip";	my $newline = "$id:$domain:$role:$name:$ip";
if($maxcon ne "") { # Not all hosts have loncnew tuning params	if($maxcon ne "") { # Not all hosts have loncnew tuning params
$newline .= ":$maxcon:$idleto:$mincon";	$newline .= ":$maxcon:$idleto:$mincon";
}	}
$adjusted .= $newline."\n";	$adjusted .= $newline."\n";

} else { # Not me, pass unmodified.	} else { # Not me, pass unmodified.
$adjusted .= $line."\n";	$adjusted .= $line."\n";
}	}
} else { # Blank or comment never re-written.	} else { # Blank or comment never re-written.
$adjusted .= $line."\n"; # Pass blanks and comments as is.	$adjusted .= $line."\n"; # Pass blanks and comments as is.
}	}
}	}
return $adjusted;	return $adjusted;
}	}
#	#
# InstallFile: Called to install an administrative file:	# InstallFile: Called to install an administrative file:
Line 834 sub AdjustOurHost {	Line 835 sub AdjustOurHost {
# Use the config line to get my hostname.	# Use the config line to get my hostname.
# Use gethostbyname to translate that into an IP address.	# Use gethostbyname to translate that into an IP address.
#	#
my ($id,$domain,$role,$name,$ip,$maxcon,$idleto,$mincon) = split(/:/,$ConfigLine);	my ($id,$domain,$role,$name,$maxcon,$idleto,$mincon) = split(/:/,$ConfigLine);
my $BinaryIp = gethostbyname($name);
my $ip = inet_ntoa($ip);
#	#
# Reassemble the config line from the elements in the list.	# Reassemble the config line from the elements in the list.
# Note that if the loncnew items were not present before, they will	# Note that if the loncnew items were not present before, they will
# be now even if they would be empty	# be now even if they would be empty
#	#
my $newConfigLine = $id;	my $newConfigLine = $id;
foreach my $item ($domain, $role, $name, $ip, $maxcon, $idleto, $mincon) {	foreach my $item ($domain, $role, $name, $maxcon, $idleto, $mincon) {
$newConfigLine .= ":".$item;	$newConfigLine .= ":".$item;
}	}
# Replace the line:	# Replace the line:
Line 889 sub EditFile {	Line 888 sub EditFile {

# Split the command into it's pieces: edit:filetype:script	# Split the command into it's pieces: edit:filetype:script

my ($request, $filetype, $script) = split(/:/, $request,3); # : in script	my ($cmd, $filetype, $script) = split(/:/, $request,3); # : in script

# Check the pre-coditions for success:	# Check the pre-coditions for success:

if($request != "edit") { # Something is amiss afoot alack.	if($cmd != "edit") { # Something is amiss afoot alack.
return "error:edit request detected, but request != 'edit'\n";	return "error:edit request detected, but request != 'edit'\n";
}	}
if( ($filetype ne "hosts") &&	if( ($filetype ne "hosts") &&
Line 938 sub EditFile {	Line 937 sub EditFile {
return "ok\n";	return "ok\n";
}	}

#---------------------------------------------------------------
#
# Manipulation of hash based databases (factoring out common code
# for later use as we refactor.
#
# Ties a domain level resource file to a hash.
# If requested a history entry is created in the associated hist file.
#
# Parameters:
# domain - Name of the domain in which the resource file lives.
# namespace - Name of the hash within that domain.
# how - How to tie the hash (e.g. GDBM_WRCREAT()).
# loghead - Optional parameter, if present a log entry is created
# in the associated history file and this is the first part
# of that entry.
# logtail - Goes along with loghead, The actual logentry is of the
# form $loghead:<timestamp>:logtail.
# Returns:
# Reference to a hash bound to the db file or alternatively undef
# if the tie failed.
#
sub tie_domain_hash {
my ($domain,$namespace,$how,$loghead,$logtail) = @_;

# Filter out any whitespace in the domain name:

$domain =~ s/\W//g;

# We have enough to go on to tie the hash:

my $user_top_dir = $perlvar{'lonUsersDir'};
my $domain_dir = $user_top_dir."/$domain";
my $resource_file = $domain_dir."/$namespace.db";
my %hash;
if(tie(%hash, 'GDBM_File', $resource_file, $how, 0640)) {
if (defined($loghead)) { # Need to log the operation.
my $logFh = IO::File->new(">>$domain_dir/$namespace.hist");
if($logFh) {
my $timestamp = time;
print $logFh "$loghead:$timestamp:$logtail\n";
}
$logFh->close;
}
return \%hash; # Return the tied hash.
} else {
return undef; # Tie failed.
}
}

#
# Ties a user's resource file to a hash.
# If necessary, an appropriate history
# log file entry is made as well.
# This sub factors out common code from the subs that manipulate
# the various gdbm files that keep keyword value pairs.
# Parameters:
# domain - Name of the domain the user is in.
# user - Name of the 'current user'.
# namespace - Namespace representing the file to tie.
# how - What the tie is done to (e.g. GDBM_WRCREAT().
# loghead - Optional first part of log entry if there may be a
# history file.
# what - Optional tail of log entry if there may be a history
# file.
# Returns:
# hash to which the database is tied. It's up to the caller to untie.
# undef if the has could not be tied.
#
sub tie_user_hash {
my ($domain,$user,$namespace,$how,$loghead,$what) = @_;

$namespace=~s/\//\_/g; # / -> _
$namespace=~s/\W//g; # whitespace eliminated.
my $proname = propath($domain, $user);

# Tie the database.

my %hash;
if(tie(%hash, 'GDBM_File', "$proname/$namespace.db",
$how, 0640)) {
# If this is a namespace for which a history is kept,
# make the history log entry:
if (($namespace !~/^nohist\_/) && (defined($loghead))) {
my $args = scalar @_;
Debug(" Opening history: $namespace $args");
my $hfh = IO::File->new(">>$proname/$namespace.hist");
if($hfh) {
my $now = time;
print $hfh "$loghead:$now:$what\n";
}
$hfh->close;
}
return \%hash;
} else {
return undef;
}

}

# read_profile	# read_profile
#	#
# Returns a set of specific entries from a user's profile file.	# Returns a set of specific entries from a user's profile file.
Line 1067 sub read_profile {	Line 967 sub read_profile {
$qresult.="$hashref->{$queries[$i]}&"; # Presumably failure gives empty string.	$qresult.="$hashref->{$queries[$i]}&"; # Presumably failure gives empty string.
}	}
$qresult=~s/\&$//; # Remove trailing & from last lookup.	$qresult=~s/\&$//; # Remove trailing & from last lookup.
if (untie %$hashref) {	if (&untie_user_hash($hashref)) {
return $qresult;	return $qresult;
} else {	} else {
return "error: ".($!+0)." untie (GDBM) Failed";	return "error: ".($!+0)." untie (GDBM) Failed";
Line 1350 sub push_file_handler {	Line 1250 sub push_file_handler {
#	#
sub du_handler {	sub du_handler {
my ($cmd, $ududir, $client) = @_;	my ($cmd, $ududir, $client) = @_;
my ($ududir) = split(/:/,$ududir); # Make 'telnet' testing easier.	($ududir) = split(/:/,$ududir); # Make 'telnet' testing easier.
my $userinput = "$cmd:$ududir";	my $userinput = "$cmd:$ududir";

if ($ududir=~/\.\./ \|\| $ududir!~m\|^/home/httpd/\|) {	if ($ududir=~/\.\./ \|\| $ududir!~m\|^/home/httpd/\|) {
Line 1674 sub change_password_handler {	Line 1574 sub change_password_handler {
# uname - Username.	# uname - Username.
# upass - Current password.	# upass - Current password.
# npass - New password.	# npass - New password.
	# context - Context in which this was called
	# (preferences or reset_by_email).

my ($udom,$uname,$upass,$npass)=split(/:/,$tail);	my ($udom,$uname,$upass,$npass,$context)=split(/:/,$tail);

$upass=&unescape($upass);	$upass=&unescape($upass);
$npass=&unescape($npass);	$npass=&unescape($npass);
&Debug("Trying to change password for $uname");	&Debug("Trying to change password for $uname");

# First require that the user can be authenticated with their	# First require that the user can be authenticated with their
# old password:	# old password unless context was 'reset_by_email':

my $validated = &validate_user($udom, $uname, $upass);	my $validated;
	if ($context eq 'reset_by_email') {
	$validated = 1;
	} else {
	$validated = &validate_user($udom, $uname, $upass);
	}
if($validated) {	if($validated) {
my $realpasswd = &get_auth_type($udom, $uname); # Defined since authd.	my $realpasswd = &get_auth_type($udom, $uname); # Defined since authd.

Line 1703 sub change_password_handler {	Line 1610 sub change_password_handler {
."to change password");	."to change password");
&Failure( $client, "non_authorized\n",$userinput);	&Failure( $client, "non_authorized\n",$userinput);
}	}
} elsif ($howpwd eq 'unix') {	} elsif ($howpwd eq 'unix' && $context ne 'reset_by_email') {
my $result = &change_unix_password($uname, $npass);	my $result = &change_unix_password($uname, $npass);
&logthis("Result of password change for $uname: ".	&logthis("Result of password change for $uname: ".
$result);	$result);
Line 1943 sub update_resource_handler {	Line 1850 sub update_resource_handler {
my $since=$now-$atime;	my $since=$now-$atime;
if ($since>$perlvar{'lonExpire'}) {	if ($since>$perlvar{'lonExpire'}) {
my $reply=&reply("unsub:$fname","$clientname");	my $reply=&reply("unsub:$fname","$clientname");
	&devalidate_meta_cache($fname);
unlink("$fname");	unlink("$fname");
	unlink("$fname.meta");
} else {	} else {
my $transname="$fname.in.transfer";	my $transname="$fname.in.transfer";
my $remoteurl=&reply("sub:$fname","$clientname");	my $remoteurl=&reply("sub:$fname","$clientname");
Line 1973 sub update_resource_handler {	Line 1882 sub update_resource_handler {
alarm(0);	alarm(0);
}	}
rename($transname,$fname);	rename($transname,$fname);
use Cache::Memcached;	&devalidate_meta_cache($fname);
my $memcache=
new Cache::Memcached({'servers'=>['127.0.0.1:11211']});
my $url=$fname;
$url=~s-^/home/httpd/html--;
my $id=&escape('meta:'.$url);
$memcache->delete($id);
}	}
}	}
&Reply( $client, "ok\n", $userinput);	&Reply( $client, "ok\n", $userinput);
Line 1993 sub update_resource_handler {	Line 1896 sub update_resource_handler {
}	}
&register_handler("update", \&update_resource_handler, 0 ,1, 0);	&register_handler("update", \&update_resource_handler, 0 ,1, 0);

	sub devalidate_meta_cache {
	my ($url) = @_;
	use Cache::Memcached;
	my $memcache = new Cache::Memcached({'servers'=>['127.0.0.1:11211']});
	$url = &declutter($url);
	$url =~ s-\.meta$--;
	my $id = &escape('meta:'.$url);
	$memcache->delete($id);
	}

	sub declutter {
	my $thisfn=shift;
	$thisfn=~s/^\Q$perlvar{'lonDocRoot'}\E//;
	$thisfn=~s/^\///;
	$thisfn=~s\|^adm/wrapper/\|\|;
	$thisfn=~s\|^adm/coursedocs/showdoc/\|\|;
	$thisfn=~s/^res\///;
	$thisfn=~s/\?.+$//;
	return $thisfn;
	}
#	#
# Fetch a user file from a remote server to the user's home directory	# Fetch a user file from a remote server to the user's home directory
# userfiles subdir.	# userfiles subdir.
Line 2207 sub token_auth_user_file_handler {	Line 2130 sub token_auth_user_file_handler {

chomp($session);	chomp($session);
my $reply="non_auth\n";	my $reply="non_auth\n";
if (open(ENVIN,$perlvar{'lonIDsDir'}.'/'.	my $file = $perlvar{'lonIDsDir'}.'/'.$session.'.id';
$session.'.id')) {	if (open(ENVIN,"$file")) {
while (my $line=<ENVIN>) {	flock(ENVIN,LOCK_SH);
if ($line=~ m\|userfile\.\Q$fname\E\=\|) { $reply="ok\n"; }	tie(my %disk_env,'GDBM_File',"$file",&GDBM_READER(),0640);
	if (exists($disk_env{"userfile.$fname"})) {
	$reply="ok\n";
	} else {
	foreach my $envname (keys(%disk_env)) {
	if ($envname=~ m\|^userfile\.\Q$fname\E\|) {
	$reply="ok\n";
	last;
	}
	}
}	}
	untie(%disk_env);
close(ENVIN);	close(ENVIN);
&Reply($client, $reply, "$cmd:$tail");	&Reply($client, $reply, "$cmd:$tail");
} else {	} else {
Line 2361 sub put_user_profile_entry {	Line 2294 sub put_user_profile_entry {
my ($key,$value)=split(/=/,$pair);	my ($key,$value)=split(/=/,$pair);
$hashref->{$key}=$value;	$hashref->{$key}=$value;
}	}
if (untie(%$hashref)) {	if (&untie_user_hash($hashref)) {
&Reply( $client, "ok\n", $userinput);	&Reply( $client, "ok\n", $userinput);
} else {	} else {
&Failure($client, "error: ".($!+0)." untie(GDBM) failed ".	&Failure($client, "error: ".($!+0)." untie(GDBM) failed ".
Line 2369 sub put_user_profile_entry {	Line 2302 sub put_user_profile_entry {
$userinput);	$userinput);
}	}
} else {	} else {
&Failure( $client, "error: ".($!)." tie(GDBM) Failed ".	&Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ".
"while attempting put\n", $userinput);	"while attempting put\n", $userinput);
}	}
} else {	} else {
Line 2405 sub newput_user_profile_entry {	Line 2338 sub newput_user_profile_entry {
my $hashref = &tie_user_hash($udom, $uname, $namespace,	my $hashref = &tie_user_hash($udom, $uname, $namespace,
&GDBM_WRCREAT(),"N",$what);	&GDBM_WRCREAT(),"N",$what);
if(!$hashref) {	if(!$hashref) {
&Failure( $client, "error: ".($!)." tie(GDBM) Failed ".	&Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ".
"while attempting put\n", $userinput);	"while attempting put\n", $userinput);
return 1;	return 1;
}	}
Line 2424 sub newput_user_profile_entry {	Line 2357 sub newput_user_profile_entry {
$hashref->{$key}=$value;	$hashref->{$key}=$value;
}	}

if (untie(%$hashref)) {	if (&untie_user_hash($hashref)) {
&Reply( $client, "ok\n", $userinput);	&Reply( $client, "ok\n", $userinput);
} else {	} else {
&Failure($client, "error: ".($!+0)." untie(GDBM) failed ".	&Failure($client, "error: ".($!+0)." untie(GDBM) failed ".
Line 2477 sub increment_user_value_handler {	Line 2410 sub increment_user_value_handler {
}	}
}	}
}	}
if (untie(%$hashref)) {	if (&untie_user_hash($hashref)) {
&Reply( $client, "ok\n", $userinput);	&Reply( $client, "ok\n", $userinput);
} else {	} else {
&Failure($client, "error: ".($!+0)." untie(GDBM) failed ".	&Failure($client, "error: ".($!+0)." untie(GDBM) failed ".
Line 2544 sub roles_put_handler {	Line 2477 sub roles_put_handler {
$auth_type);	$auth_type);
$hashref->{$key}=$value;	$hashref->{$key}=$value;
}	}
if (untie($hashref)) {	if (&untie_user_hash($hashref)) {
&Reply($client, "ok\n", $userinput);	&Reply($client, "ok\n", $userinput);
} else {	} else {
&Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".	&Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".
Line 2595 sub roles_delete_handler {	Line 2528 sub roles_delete_handler {
foreach my $key (@rolekeys) {	foreach my $key (@rolekeys) {
delete $hashref->{$key};	delete $hashref->{$key};
}	}
if (untie(%$hashref)) {	if (&untie_user_hash($hashref)) {
&Reply($client, "ok\n", $userinput);	&Reply($client, "ok\n", $userinput);
} else {	} else {
&Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".	&Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".
Line 2674 sub get_profile_entry_encrypted {	Line 2607 sub get_profile_entry_encrypted {

my $userinput = "$cmd:$tail";	my $userinput = "$cmd:$tail";

my ($cmd,$udom,$uname,$namespace,$what) = split(/:/,$userinput);	my ($udom,$uname,$namespace,$what) = split(/:/,$tail);
chomp($what);	chomp($what);
my $qresult = read_profile($udom, $uname, $namespace, $what);	my $qresult = read_profile($udom, $uname, $namespace, $what);
my ($first) = split(/:/, $qresult);	my ($first) = split(/:/, $qresult);
Line 2736 sub delete_profile_entry {	Line 2669 sub delete_profile_entry {
foreach my $key (@keys) {	foreach my $key (@keys) {
delete($hashref->{$key});	delete($hashref->{$key});
}	}
if (untie(%$hashref)) {	if (&untie_user_hash($hashref)) {
&Reply($client, "ok\n", $userinput);	&Reply($client, "ok\n", $userinput);
} else {	} else {
&Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".	&Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
Line 2778 sub get_profile_keys {	Line 2711 sub get_profile_keys {
foreach my $key (keys %$hashref) {	foreach my $key (keys %$hashref) {
$qresult.="$key&";	$qresult.="$key&";
}	}
if (untie(%$hashref)) {	if (&untie_user_hash($hashref)) {
$qresult=~s/\&$//;	$qresult=~s/\&$//;
&Reply($client, "$qresult\n", $userinput);	&Reply($client, "$qresult\n", $userinput);
} else {	} else {
Line 2839 sub dump_profile_database {	Line 2772 sub dump_profile_database {
$data{$symb}->{$param}=$value;	$data{$symb}->{$param}=$value;
$data{$symb}->{'v.'.$param}=$v;	$data{$symb}->{'v.'.$param}=$v;
}	}
if (untie(%$hashref)) {	if (&untie_user_hash($hashref)) {
while (my ($symb,$param_hash) = each(%data)) {	while (my ($symb,$param_hash) = each(%data)) {
while(my ($param,$value) = each (%$param_hash)){	while(my ($param,$value) = each (%$param_hash)){
next if ($param =~ /^v\./); # Ignore versions...	next if ($param =~ /^v\./); # Ignore versions...
Line 2894 sub dump_with_regexp {	Line 2827 sub dump_with_regexp {

my $userinput = "$cmd:$tail";	my $userinput = "$cmd:$tail";

my ($udom,$uname,$namespace,$regexp)=split(/:/,$tail);	my ($udom,$uname,$namespace,$regexp,$range)=split(/:/,$tail);
if (defined($regexp)) {	if (defined($regexp)) {
$regexp=&unescape($regexp);	$regexp=&unescape($regexp);
} else {	} else {
$regexp='.';	$regexp='.';
}	}
	my ($start,$end);
	if (defined($range)) {
	if ($range =~/^(\d+)\-(\d+)$/) {
	($start,$end) = ($1,$2);
	} elsif ($range =~/^(\d+)$/) {
	($start,$end) = (0,$1);
	} else {
	undef($range);
	}
	}
my $hashref = &tie_user_hash($udom, $uname, $namespace,	my $hashref = &tie_user_hash($udom, $uname, $namespace,
&GDBM_READER());	&GDBM_READER());
if ($hashref) {	if ($hashref) {
my $qresult='';	my $qresult='';
	my $count=0;
while (my ($key,$value) = each(%$hashref)) {	while (my ($key,$value) = each(%$hashref)) {
if ($regexp eq '.') {	if ($regexp eq '.') {
	$count++;
	if (defined($range) && $count >= $end) { last; }
	if (defined($range) && $count < $start) { next; }
$qresult.=$key.'='.$value.'&';	$qresult.=$key.'='.$value.'&';
} else {	} else {
my $unescapeKey = &unescape($key);	my $unescapeKey = &unescape($key);
if (eval('$unescapeKey=~/$regexp/')) {	if (eval('$unescapeKey=~/$regexp/')) {
	$count++;
	if (defined($range) && $count >= $end) { last; }
	if (defined($range) && $count < $start) { next; }
$qresult.="$key=$value&";	$qresult.="$key=$value&";
}	}
}	}
}	}
if (untie(%$hashref)) {	if (&untie_user_hash($hashref)) {
chop($qresult);	chop($qresult);
&Reply($client, "$qresult\n", $userinput);	&Reply($client, "$qresult\n", $userinput);
} else {	} else {
Line 2976 sub store_handler {	Line 2926 sub store_handler {
$hashref->{"$version:$rid:timestamp"}=$now;	$hashref->{"$version:$rid:timestamp"}=$now;
$allkeys.='timestamp';	$allkeys.='timestamp';
$hashref->{"$version:keys:$rid"}=$allkeys;	$hashref->{"$version:keys:$rid"}=$allkeys;
if (untie($hashref)) {	if (&untie_user_hash($hashref)) {
&Reply($client, "ok\n", $userinput);	&Reply($client, "ok\n", $userinput);
} else {	} else {
&Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".	&Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
Line 2994 sub store_handler {	Line 2944 sub store_handler {
}	}
&register_handler("store", \&store_handler, 0, 1, 0);	&register_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) = @_;

	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(), "M",
	"$rid:$v:$what");
	if ($hashref) {
	my $now = time;
	my %data = &hash_extract($what);
	my @allkeys;
	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;
	}
	&register_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	# 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	# with it for each version. These resources are built up via the store
Line 3023 sub restore_handler {	Line 3052 sub restore_handler {
my ($cmd, $tail, $client) = @_;	my ($cmd, $tail, $client) = @_;

my $userinput = "$cmd:$tail"; # Only used for logging purposes.	my $userinput = "$cmd:$tail"; # Only used for logging purposes.
	my ($udom,$uname,$namespace,$rid) = split(/:/,$tail);
my ($cmd,$udom,$uname,$namespace,$rid) = split(/:/,$userinput);
$namespace=~s/\//\_/g;	$namespace=~s/\//\_/g;
$namespace=~s/\W//g;	$namespace = &LONCAPA::clean_username($namespace);

chomp($rid);	chomp($rid);
my $proname=&propath($udom,$uname);
my $qresult='';	my $qresult='';
my %hash;	my $hashref = &tie_user_hash($udom, $uname, $namespace, &GDBM_READER());
if (tie(%hash,'GDBM_File',"$proname/$namespace.db",	if ($hashref) {
&GDBM_READER(),0640)) {	my $version=$hashref->{"version:$rid"};
my $version=$hash{"version:$rid"};
$qresult.="version=$version&";	$qresult.="version=$version&";
my $scope;	my $scope;
for ($scope=1;$scope<=$version;$scope++) {	for ($scope=1;$scope<=$version;$scope++) {
my $vkeys=$hash{"$scope:keys:$rid"};	my $vkeys=$hashref->{"$scope:keys:$rid"};
my @keys=split(/:/,$vkeys);	my @keys=split(/:/,$vkeys);
my $key;	my $key;
$qresult.="$scope:keys=$vkeys&";	$qresult.="$scope:keys=$vkeys&";
foreach $key (@keys) {	foreach $key (@keys) {
$qresult.="$scope:$key=".$hash{"$scope:$rid:$key"}."&";	$qresult.="$scope:$key=".$hashref->{"$scope:$rid:$key"}."&";
}	}
}	}
if (untie(%hash)) {	if (&untie_user_hash($hashref)) {
$qresult=~s/\&$//;	$qresult=~s/\&$//;
&Reply( $client, "$qresult\n", $userinput);	&Reply( $client, "$qresult\n", $userinput);
} else {	} else {
Line 3064 sub restore_handler {	Line 3091 sub restore_handler {
&register_handler("restore", \&restore_handler, 0,1,0);	&register_handler("restore", \&restore_handler, 0,1,0);

#	#
# Add a chat message to to a discussion board.	# Add a chat message to a synchronous discussion board.
#	#
# Parameters:	# Parameters:
# $cmd - Request keyword.	# $cmd - Request keyword.
# $tail - Tail of the command. A colon separated list	# $tail - Tail of the command. A colon separated list
# containing:	# containing:
# cdom - Domain on which the chat board lives	# cdom - Domain on which the chat board lives
# cnum - Identifier of the discussion group.	# cnum - Course containing the chat board.
# post - Body of the posting.	# newpost - Body of the posting.
	# group - Optional group, if chat board is only
	# accessible in a group within the course
# $client - Socket open on the client.	# $client - Socket open on the client.
# Returns:	# Returns:
# 1 - Indicating caller should keep on processing.	# 1 - Indicating caller should keep on processing.
Line 3087 sub send_chat_handler {	Line 3116 sub send_chat_handler {

my $userinput = "$cmd:$tail";	my $userinput = "$cmd:$tail";

my ($cdom,$cnum,$newpost)=split(/\:/,$tail);	my ($cdom,$cnum,$newpost,$group)=split(/\:/,$tail);
&chat_add($cdom,$cnum,$newpost);	&chat_add($cdom,$cnum,$newpost,$group);
&Reply($client, "ok\n", $userinput);	&Reply($client, "ok\n", $userinput);

return 1;	return 1;
Line 3096 sub send_chat_handler {	Line 3125 sub send_chat_handler {
&register_handler("chatsend", \&send_chat_handler, 0, 1, 0);	&register_handler("chatsend", \&send_chat_handler, 0, 1, 0);

#	#
# Retrieve the set of chat messagss from a discussion board.	# Retrieve the set of chat messages from a discussion board.
#	#
# Parameters:	# Parameters:
# $cmd - Command keyword that initiated the request.	# $cmd - Command keyword that initiated the request.
Line 3106 sub send_chat_handler {	Line 3135 sub send_chat_handler {
# chat id - Discussion thread(?)	# chat id - Discussion thread(?)
# domain/user - Authentication domain and username	# domain/user - Authentication domain and username
# of the requesting person.	# of the requesting person.
	# group - Optional course group containing
	# the board.
# $client - Socket open on the client program.	# $client - Socket open on the client program.
# Returns:	# Returns:
# 1 - continue processing	# 1 - continue processing
Line 3118 sub retrieve_chat_handler {	Line 3149 sub retrieve_chat_handler {

my $userinput = "$cmd:$tail";	my $userinput = "$cmd:$tail";

my ($cdom,$cnum,$udom,$uname)=split(/\:/,$tail);	my ($cdom,$cnum,$udom,$uname,$group)=split(/\:/,$tail);
my $reply='';	my $reply='';
foreach (&get_chat($cdom,$cnum,$udom,$uname)) {	foreach (&get_chat($cdom,$cnum,$udom,$uname,$group)) {
$reply.=&escape($_).':';	$reply.=&escape($_).':';
}	}
$reply=~s/\:$//;	$reply=~s/\:$//;
Line 3197 sub reply_query_handler {	Line 3228 sub reply_query_handler {

my $userinput = "$cmd:$tail";	my $userinput = "$cmd:$tail";

my ($cmd,$id,$reply)=split(/:/,$userinput);	my ($id,$reply)=split(/:/,$tail);
my $store;	my $store;
my $execdir=$perlvar{'lonDaemons'};	my $execdir=$perlvar{'lonDaemons'};
if ($store=IO::File->new(">$execdir/tmp/$id")) {	if ($store=IO::File->new(">$execdir/tmp/$id")) {
Line 3261 sub put_course_id_handler {	Line 3292 sub put_course_id_handler {
foreach my $pair (@pairs) {	foreach my $pair (@pairs) {
my ($key,$courseinfo) = split(/=/,$pair,2);	my ($key,$courseinfo) = split(/=/,$pair,2);
$courseinfo =~ s/=/:/g;	$courseinfo =~ s/=/:/g;
	my @current_items = split(/:/,$hashref->{$key},-1);
my @current_items = split(/:/,$hashref->{$key});
shift(@current_items); # remove description	shift(@current_items); # remove description
pop(@current_items); # remove last access	pop(@current_items); # remove last access
my $numcurrent = scalar(@current_items);	my $numcurrent = scalar(@current_items);
	if ($numcurrent > 3) {
my @new_items = split(/:/,$courseinfo);	$numcurrent = 3;
	}
	my @new_items = split(/:/,$courseinfo,-1);
my $numnew = scalar(@new_items);	my $numnew = scalar(@new_items);
if ($numcurrent > 0) {	if ($numcurrent > 0) {
if ($numnew == 1) { # flushcourselogs() from 1.1 or earlier	if ($numnew <= $numcurrent) { # flushcourselogs() from pre 2.2
$courseinfo .= ':'.join(':',@current_items);	for (my $j=$numcurrent-$numnew; $j>=0; $j--) {
} elsif ($numnew == 2) { # flushcourselogs() from 1.2.X	$courseinfo .= ':'.$current_items[$numcurrent-$j-1];
$courseinfo .= ':'.$current_items[$numcurrent-1];	}
}	}
}	}
$hashref->{$key}=$courseinfo.':'.$now;	$hashref->{$key}=$courseinfo.':'.$now;
}	}
if (untie(%$hashref)) {	if (&untie_domain_hash($hashref)) {
&Reply( $client, "ok\n", $userinput);	&Reply( $client, "ok\n", $userinput);
} else {	} else {
&Failure($client, "error: ".($!+0)	&Failure($client, "error: ".($!+0)
Line 3317 sub put_course_id_handler {	Line 3349 sub put_course_id_handler {
# institutional code - optional supplied code to filter	# institutional code - optional supplied code to filter
# the dump. Only courses with an institutional code	# the dump. Only courses with an institutional code
# that match the supplied code will be returned.	# that match the supplied code will be returned.
# owner - optional supplied username of owner to filter	# owner - optional supplied username and domain of owner to
# the dump. Only courses for which the course	# filter the dump. Only courses for which the course
# owner matches the supplied username will be	# owner matches the supplied username and/or domain
# returned. Implicit assumption that owner	# will be returned. Pre-2.2.0 legacy entries from
# is a user in the domain in which the	# nohist_courseiddump will only contain usernames.
# course database is defined.
# $client - The socket open on the client.	# $client - The socket open on the client.
# Returns:	# Returns:
# 1 - Continue processing.	# 1 - Continue processing.
Line 3333 sub dump_course_id_handler {	Line 3364 sub dump_course_id_handler {

my $userinput = "$cmd:$tail";	my $userinput = "$cmd:$tail";

my ($udom,$since,$description,$instcodefilter,$ownerfilter,$coursefilter) =split(/:/,$tail);	my ($udom,$since,$description,$instcodefilter,$ownerfilter,$coursefilter,
	$typefilter,$regexp_ok) =split(/:/,$tail);
if (defined($description)) {	if (defined($description)) {
$description=&unescape($description);	$description=&unescape($description);
} else {	} else {
Line 3344 sub dump_course_id_handler {	Line 3376 sub dump_course_id_handler {
} else {	} else {
$instcodefilter='.';	$instcodefilter='.';
}	}
	my ($ownerunamefilter,$ownerdomfilter);
if (defined($ownerfilter)) {	if (defined($ownerfilter)) {
$ownerfilter=&unescape($ownerfilter);	$ownerfilter=&unescape($ownerfilter);
	if ($ownerfilter ne '.' && defined($ownerfilter)) {
	if ($ownerfilter =~ /^([^:]):([^:])$/) {
	$ownerunamefilter = $1;
	$ownerdomfilter = $2;
	} else {
	$ownerunamefilter = $ownerfilter;
	$ownerdomfilter = '';
	}
	}
} else {	} else {
$ownerfilter='.';	$ownerfilter='.';
}	}

if (defined($coursefilter)) {	if (defined($coursefilter)) {
$coursefilter=&unescape($coursefilter);	$coursefilter=&unescape($coursefilter);
} else {	} else {
$coursefilter='.';	$coursefilter='.';
}	}
	if (defined($typefilter)) {
	$typefilter=&unescape($typefilter);
	} else {
	$typefilter='.';
	}
	if (defined($regexp_ok)) {
	$regexp_ok=&unescape($regexp_ok);
	}

unless (defined($since)) { $since=0; }	unless (defined($since)) { $since=0; }
my $qresult='';	my $qresult='';
my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT());	my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT());
if ($hashref) {	if ($hashref) {
while (my ($key,$value) = each(%$hashref)) {	while (my ($key,$value) = each(%$hashref)) {
my ($descr,$lasttime,$inst_code,$owner);	my ($descr,$lasttime,$inst_code,$owner,$type);
my @courseitems = split(/:/,$value);	my @courseitems = split(/:/,$value);
$lasttime = pop(@courseitems);	$lasttime = pop(@courseitems);
($descr,$inst_code,$owner)=@courseitems;	($descr,$inst_code,$owner,$type)=@courseitems;
if ($lasttime<$since) { next; }	if ($lasttime<$since) { next; }
my $match = 1;	my $match = 1;
unless ($description eq '.') {	unless ($description eq '.') {
Line 3374 sub dump_course_id_handler {	Line 3425 sub dump_course_id_handler {
}	}
unless ($instcodefilter eq '.' \|\| !defined($instcodefilter)) {	unless ($instcodefilter eq '.' \|\| !defined($instcodefilter)) {
my $unescapeInstcode = &unescape($inst_code);	my $unescapeInstcode = &unescape($inst_code);
unless (eval('$unescapeInstcode=~/\Q$instcodefilter\E/i')) {	if ($regexp_ok) {
$match = 0;	unless (eval('$unescapeInstcode=~/$instcodefilter/')) {
	$match = 0;
	}
	} else {
	unless (eval('$unescapeInstcode=~/\Q$instcodefilter\E/i')) {
	$match = 0;
	}
}	}
}	}
unless ($ownerfilter eq '.' \|\| !defined($ownerfilter)) {	unless ($ownerfilter eq '.' \|\| !defined($ownerfilter)) {
my $unescapeOwner = &unescape($owner);	my $unescapeOwner = &unescape($owner);
unless (eval('$unescapeOwner=~/\Q$ownerfilter\E/i')) {	if (($ownerunamefilter ne '') && ($ownerdomfilter ne '')) {
$match = 0;	if ($unescapeOwner =~ /:/) {
	if (eval('$unescapeOwner !~
	/\Q$ownerunamefilter\E:\Q$ownerdomfilter\E$/i')) {
	$match = 0;
	}
	} else {
	if (eval('$unescapeOwner!~/\Q$ownerunamefilter\E/i')) {
	$match = 0;
	}
	}
	} elsif ($ownerunamefilter ne '') {
	if ($unescapeOwner =~ /:/) {
	if (eval('$unescapeOwner!~/\Q$ownerunamefilter\E:[^:]+$/i')) {
	$match = 0;
	}
	} else {
	if (eval('$unescapeOwner!~/\Q$ownerunamefilter\E/i')) {
	$match = 0;
	}
	}
	} elsif ($ownerdomfilter ne '') {
	if ($unescapeOwner =~ /:/) {
	if (eval('$unescapeOwner!~/^[^:]+:\Q$ownerdomfilter\E/')) {
	$match = 0;
	}
	} else {
	if ($ownerdomfilter ne $udom) {
	$match = 0;
	}
	}
}	}
}	}
unless ($coursefilter eq '.' \|\| !defined($coursefilter)) {	unless ($coursefilter eq '.' \|\| !defined($coursefilter)) {
Line 3390 sub dump_course_id_handler {	Line 3476 sub dump_course_id_handler {
$match = 0;	$match = 0;
}	}
}	}
	unless ($typefilter eq '.' \|\| !defined($typefilter)) {
	my $unescapeType = &unescape($type);
	if ($type eq '') {
	if ($typefilter ne 'Course') {
	$match = 0;
	}
	} else {
	unless (eval('$unescapeType=~/^\Q$typefilter\E$/')) {
	$match = 0;
	}
	}
	}
if ($match == 1) {	if ($match == 1) {
$qresult.=$key.'='.$descr.':'.$inst_code.':'.$owner.'&';	$qresult.=$key.'='.$descr.':'.$inst_code.':'.$owner.'&';
}	}
}	}
if (untie(%$hashref)) {	if (&untie_domain_hash($hashref)) {
chop($qresult);	chop($qresult);
&Reply($client, "$qresult\n", $userinput);	&Reply($client, "$qresult\n", $userinput);
} else {	} else {
Line 3412 sub dump_course_id_handler {	Line 3510 sub dump_course_id_handler {
&register_handler("courseiddump", \&dump_course_id_handler, 0, 1, 0);	&register_handler("courseiddump", \&dump_course_id_handler, 0, 1, 0);

#	#
	# Puts an unencrypted entry in a namespace db file at the domain level
	#
	# Parameters:
	# $cmd - The command that got us here.
	# $tail - Tail of the command (remaining parameters).
	# $client - File descriptor connected to client.
	# Returns
	# 0 - Requested to exit, caller should shut down.
	# 1 - Continue processing.
	# Side effects:
	# reply is written to $client.
	#
	sub put_domain_handler {
	my ($cmd,$tail,$client) = @_;

	my $userinput = "$cmd:$tail";

	my ($udom,$namespace,$what) =split(/:/,$tail,3);
	chomp($what);
	my @pairs=split(/\&/,$what);
	my $hashref = &tie_domain_hash($udom, "$namespace", &GDBM_WRCREAT(),
	"P", $what);
	if ($hashref) {
	foreach my $pair (@pairs) {
	my ($key,$value)=split(/=/,$pair);
	$hashref->{$key}=$value;
	}
	if (&untie_domain_hash($hashref)) {
	&Reply($client, "ok\n", $userinput);
	} else {
	&Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
	"while attempting putdom\n", $userinput);
	}
	} else {
	&Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ".
	"while attempting putdom\n", $userinput);
	}

	return 1;
	}
	&register_handler("putdom", \&put_domain_handler, 0, 1, 0);

	# Unencrypted get from the namespace database file at the domain level.
	# This function retrieves a keyed item from a specific named database in the
	# domain directory.
	#
	# Parameters:
	# $cmd - Command request keyword (get).
	# $tail - Tail of the command. This is a colon separated list
	# consisting of the domain and the 'namespace'
	# which selects the gdbm file to do the lookup in,
	# & separated list of keys to lookup. Note that
	# the values are returned as an & separated list too.
	# $client - File descriptor open on the client.
	# Returns:
	# 1 - Continue processing.
	# 0 - Exit.
	# Side effects:
	# reply is written to $client.
	#

	sub get_domain_handler {
	my ($cmd, $tail, $client) = @_;

	my $userinput = "$client:$tail";

	my ($udom,$namespace,$what)=split(/:/,$tail,3);
	chomp($what);
	my @queries=split(/\&/,$what);
	my $qresult='';
	my $hashref = &tie_domain_hash($udom, "$namespace", &GDBM_READER());
	if ($hashref) {
	for (my $i=0;$i<=$#queries;$i++) {
	$qresult.="$hashref->{$queries[$i]}&";
	}
	if (&untie_domain_hash($hashref)) {
	$qresult=~s/\&$//;
	&Reply($client, "$qresult\n", $userinput);
	} else {
	&Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".
	"while attempting getdom\n",$userinput);
	}
	} else {
	&Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".
	"while attempting getdom\n",$userinput);
	}

	return 1;
	}
	&register_handler("getdom", \&get_id_handler, 0, 1, 0);


	#
# Puts an id to a domains id database.	# Puts an id to a domains id database.
#	#
# Parameters:	# Parameters:
Line 3443 sub put_id_handler {	Line 3634 sub put_id_handler {
my ($key,$value)=split(/=/,$pair);	my ($key,$value)=split(/=/,$pair);
$hashref->{$key}=$value;	$hashref->{$key}=$value;
}	}
if (untie(%$hashref)) {	if (&untie_domain_hash($hashref)) {
&Reply($client, "ok\n", $userinput);	&Reply($client, "ok\n", $userinput);
} else {	} else {
&Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".	&Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
Line 3492 sub get_id_handler {	Line 3683 sub get_id_handler {
for (my $i=0;$i<=$#queries;$i++) {	for (my $i=0;$i<=$#queries;$i++) {
$qresult.="$hashref->{$queries[$i]}&";	$qresult.="$hashref->{$queries[$i]}&";
}	}
if (untie(%$hashref)) {	if (&untie_domain_hash($hashref)) {
$qresult=~s/\&$//;	$qresult=~s/\&$//;
&Reply($client, "$qresult\n", $userinput);	&Reply($client, "$qresult\n", $userinput);
} else {	} else {
Line 3536 sub put_dcmail_handler {	Line 3727 sub put_dcmail_handler {
my ($key,$value)=split(/=/,$what);	my ($key,$value)=split(/=/,$what);
$hashref->{$key}=$value;	$hashref->{$key}=$value;
}	}
if (untie(%$hashref)) {	if (&untie_domain_hash($hashref)) {
&Reply($client, "ok\n", $userinput);	&Reply($client, "ok\n", $userinput);
} else {	} else {
&Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".	&Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
Line 3594 sub dump_dcmail_handler {	Line 3785 sub dump_dcmail_handler {
if ($hashref) {	if ($hashref) {
while (my ($key,$value) = each(%$hashref)) {	while (my ($key,$value) = each(%$hashref)) {
my $match = 1;	my $match = 1;
$key = &unescape($key);	my ($timestamp,$subj,$uname,$udom) =
my ($timestamp,$subj,$uname,$udom) = split(/:/,&unescape($key),5);	split(/:/,&unescape(&unescape($key)),5); # yes, twice really
$timestamp = &unescape($timestamp);
$subj = &unescape($subj);	$subj = &unescape($subj);
$uname = &unescape($uname);
$udom = &unescape($udom);
unless ($startfilter eq '.' \|\| !defined($startfilter)) {	unless ($startfilter eq '.' \|\| !defined($startfilter)) {
if ($timestamp < $startfilter) {	if ($timestamp < $startfilter) {
$match = 0;	$match = 0;
Line 3619 sub dump_dcmail_handler {	Line 3807 sub dump_dcmail_handler {
$qresult.=$key.'='.$value.'&';	$qresult.=$key.'='.$value.'&';
}	}
}	}
if (untie(%$hashref)) {	if (&untie_domain_hash($hashref)) {
chop($qresult);	chop($qresult);
&Reply($client, "$qresult\n", $userinput);	&Reply($client, "$qresult\n", $userinput);
} else {	} else {
Line 3666 sub put_domainroles_handler {	Line 3854 sub put_domainroles_handler {
my ($key,$value)=split(/=/,$pair);	my ($key,$value)=split(/=/,$pair);
$hashref->{$key}=$value;	$hashref->{$key}=$value;
}	}
if (untie(%$hashref)) {	if (&untie_domain_hash($hashref)) {
&Reply($client, "ok\n", $userinput);	&Reply($client, "ok\n", $userinput);
} else {	} else {
&Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".	&Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
Line 3747 sub dump_domainroles_handler {	Line 3935 sub dump_domainroles_handler {
$qresult.=$key.'='.$value.'&';	$qresult.=$key.'='.$value.'&';
}	}
}	}
if (untie(%$hashref)) {	if (&untie_domain_hash($hashref)) {
chop($qresult);	chop($qresult);
&Reply($client, "$qresult\n", $userinput);	&Reply($client, "$qresult\n", $userinput);
} else {	} else {
Line 3785 sub tmp_put_handler {	Line 3973 sub tmp_put_handler {

my $userinput = "$cmd:$what"; # Reconstruct for logging.	my $userinput = "$cmd:$what"; # Reconstruct for logging.

	my ($record,$context) = split(/:/,$what);
my $store;	if ($context ne '') {
	chomp($context);
	$context = &unescape($context);
	}
	my ($id,$store);
$tmpsnum++;	$tmpsnum++;
my $id=$$.'_'.$clientip.'_'.$tmpsnum;	if ($context eq 'resetpw') {
	$id = &md5_hex(&md5_hex(time.{}.rand().$$));
	} else {
	$id = $$.'_'.$clientip.'_'.$tmpsnum;
	}
$id=~s/\W/\_/g;	$id=~s/\W/\_/g;
$what=~s/\n//g;	$record=~s/\n//g;
my $execdir=$perlvar{'lonDaemons'};	my $execdir=$perlvar{'lonDaemons'};
if ($store=IO::File->new(">$execdir/tmp/$id.tmp")) {	if ($store=IO::File->new(">$execdir/tmp/$id.tmp")) {
print $store $what;	print $store $record;
close $store;	close $store;
&Reply($client, "$id\n", $userinput);	&Reply($client, "$id\n", $userinput);
} else {	} else {
Line 4010 sub enrollment_enabled_handler {	Line 4206 sub enrollment_enabled_handler {
my $userinput = $cmd.":".$tail; # For logging purposes.	my $userinput = $cmd.":".$tail; # For logging purposes.


my $cdom = split(/:/, $tail); # Domain we're asking about.	my ($cdom) = split(/:/, $tail, 2); # Domain we're asking about.

my $outcome = &localenroll::run($cdom);	my $outcome = &localenroll::run($cdom);
&Reply($client, "$outcome\n", $userinput);	&Reply($client, "$outcome\n", $userinput);

Line 4066 sub validate_course_owner_handler {	Line 4263 sub validate_course_owner_handler {
my $userinput = "$cmd:$tail";	my $userinput = "$cmd:$tail";
my ($inst_course_id, $owner, $cdom) = split(/:/, $tail);	my ($inst_course_id, $owner, $cdom) = split(/:/, $tail);

	$owner = &unescape($owner);
my $outcome = &localenroll::new_course($inst_course_id,$owner,$cdom);	my $outcome = &localenroll::new_course($inst_course_id,$owner,$cdom);
&Reply($client, "$outcome\n", $userinput);	&Reply($client, "$outcome\n", $userinput);

Line 4106 sub validate_course_section_handler {	Line 4304 sub validate_course_section_handler {
&register_handler("autovalidatecourse", \&validate_course_section_handler, 0, 1, 0);	&register_handler("autovalidatecourse", \&validate_course_section_handler, 0, 1, 0);

#	#
# Create a password for a new auto-enrollment user.	# Validate course owner's access to enrollment data for specific class section.
# I think/guess, this password allows access to the institutions	#
# AIS class list server/services. Stuart can correct this comment
# when he finds out how wrong I am.
#	#
# Formal Parameters:	# Formal Parameters:
# $cmd - The command request that got us dispatched.	# $cmd - The command request that got us dispatched.
# $tail - The tail of the command. In this case this is a colon separated	# $tail - The tail of the command. In this case this is a colon separated
# set of words that will be split into:	# set of words that will be split into:
# $authparam - An authentication parameter (username??).	# $inst_class - Institutional code for the specific class section
	# $courseowner - The escaped username:domain of the course owner
	# $cdom - The domain of the course from the institution's
	# point of view.
	# $client - The socket open on the client.
	# Returns:
	# 1 - continue processing.
	#

	sub validate_class_access_handler {
	my ($cmd, $tail, $client) = @_;
	my $userinput = "$cmd:$tail";
	my ($inst_class,$courseowner,$cdom) = split(/:/, $tail);
	$courseowner = &unescape($courseowner);
	my $outcome;
	eval {
	local($SIG{__DIE__})='DEFAULT';
	$outcome=&localenroll::check_section($inst_class,$courseowner,$cdom);
	};
	&Reply($client,"$outcome\n", $userinput);

	return 1;
	}
	&register_handler("autovalidateclass_sec", \&validate_class_access_handler, 0, 1, 0);

	#
	# Create a password for a new LON-CAPA user added by auto-enrollment.
	# Only used for case where authentication method for new user is localauth
	#
	# Formal Parameters:
	# $cmd - The command request that got us dispatched.
	# $tail - The tail of the command. In this case this is a colon separated
	# set of words that will be split into:
	# $authparam - An authentication parameter (localauth parameter).
# $cdom - The domain of the course from the institution's	# $cdom - The domain of the course from the institution's
# point of view.	# point of view.
# $client - The socket open on the client.	# $client - The socket open on the client.
Line 4242 sub get_institutional_code_format_handle	Line 4471 sub get_institutional_code_format_handle
&register_handler("autoinstcodeformat",	&register_handler("autoinstcodeformat",
\&get_institutional_code_format_handler,0,1,0);	\&get_institutional_code_format_handler,0,1,0);

	sub get_institutional_defaults_handler {
	my ($cmd, $tail, $client) = @_;
	my $userinput = "$cmd:$tail";

	my $dom = $tail;
	my %defaults_hash;
	my @code_order;
	my $outcome;
	eval {
	local($SIG{__DIE__})='DEFAULT';
	$outcome = &localenroll::instcode_defaults($dom,\%defaults_hash,
	\@code_order);
	};
	if (!$@) {
	if ($outcome eq 'ok') {
	my $result='';
	while (my ($key,$value) = each(%defaults_hash)) {
	$result.=&escape($key).'='.&escape($value).'&';
	}
	$result .= 'code_order='.&escape(join('&',@code_order));
	&Reply($client,$result."\n",$userinput);
	} else {
	&Reply($client,"error\n", $userinput);
	}
	} else {
	&Failure($client,"unknown_cmd\n",$userinput);
	}
	}
	&register_handler("autoinstcodedefaults",
	\&get_institutional_defaults_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;
	}
	&register_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;
	}
	&register_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;
	}
	&register_handler("autophotochoice",\&photo_choice_handler,0,1,0);

#	#
# Gets a student's photo to exist (in the correct image type) in the user's	# Gets a student's photo to exist (in the correct image type) in the user's
# directory.	# directory.
Line 4254 sub get_institutional_code_format_handle	Line 4592 sub get_institutional_code_format_handle
# $client - The socket open on the client.	# $client - The socket open on the client.
# Returns:	# Returns:
# 1 - continue processing.	# 1 - continue processing.

sub student_photo_handler {	sub student_photo_handler {
my ($cmd, $tail, $client) = @_;	my ($cmd, $tail, $client) = @_;
my ($domain,$uname,$type) = split(/:/, $tail);	my ($domain,$uname,$ext,$type) = split(/:/, $tail);

my $path=&propath($domain,$uname).	my $path=&propath($domain,$uname). '/userfiles/internal/';
'/userfiles/internal/studentphoto.'.$type;	my $filename = 'studentphoto.'.$ext;
if (-e $path) {	if ($type eq 'thumbnail') {
	$filename = 'studentphoto_tn.'.$ext;
	}
	if (-e $path.$filename) {
&Reply($client,"ok\n","$cmd:$tail");	&Reply($client,"ok\n","$cmd:$tail");
return 1;	return 1;
}	}
&mkpath($path);	&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) {	if (!$file) {
&Failure($client,"unavailable\n","$cmd:$tail");	&Failure($client,"unavailable\n","$cmd:$tail");
return 1;	return 1;
}	}
if (!-e $path) { &convert_photo($file,$path); }	if (!-e $path.$filename) { &convert_photo($file,$path.$filename); }
if (-e $path) {	if (-e $path.$filename) {
&Reply($client,"ok\n","$cmd:$tail");	&Reply($client,"ok\n","$cmd:$tail");
return 1;	return 1;
}	}
Line 4332 sub process_request {	Line 4682 sub process_request {
# fix all the userinput -> user_input.	# fix all the userinput -> user_input.
my $wasenc = 0; # True if request was encrypted.	my $wasenc = 0; # True if request was encrypted.
# ------------------------------------------------------------ See if encrypted	# ------------------------------------------------------------ See if encrypted
	# for command
	# sethost:<server>
	# <command>:<args>
	# we just send it to the processor
	# for
	# sethost:<server>:<command>:<args>
	# 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/) {	if ($userinput =~ /^enc/) {
$userinput = decipher($userinput);	$userinput = decipher($userinput);
$wasenc=1;	$wasenc=1;
Line 4686 sub ReadHostTable {	Line 5052 sub ReadHostTable {
}	}
$hostid{$ip}=$id; # LonCAPA name of host by IP.	$hostid{$ip}=$id; # LonCAPA name of host by IP.
$hostdom{$id}=$domain; # LonCAPA domain name of host.	$hostdom{$id}=$domain; # LonCAPA domain name of host.
	$hostname{$id}=$name; # LonCAPA name -> DNS name
$hostip{$id}=$ip; # IP address of host.	$hostip{$id}=$ip; # IP address of host.
$hostdns{$name} = $id; # LonCAPA name of host by DNS.	$hostdns{$name} = $id; # LonCAPA name of host by DNS.

Line 4894 sub status {	Line 5261 sub status {
$0='lond: '.$what.' '.$local;	$0='lond: '.$what.' '.$local;
}	}

# -------------------------------------------------------- Escape Special Chars

sub escape {
my $str=shift;
$str =~ s/(\W)/"%".unpack('H2',$1)/eg;
return $str;
}

# ----------------------------------------------------- Un-Escape Special Chars

sub unescape {
my $str=shift;
$str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
return $str;
}

# ----------------------------------------------------------- Send USR1 to lonc	# ----------------------------------------------------------- Send USR1 to lonc

sub reconlonc {	sub reconlonc {
Line 4936 sub reconlonc {	Line 5287 sub reconlonc {

sub subreply {	sub subreply {
my ($cmd,$server)=@_;	my ($cmd,$server)=@_;
my $peerfile="$perlvar{'lonSockDir'}/$server";	my $peerfile="$perlvar{'lonSockDir'}/".$hostname{$server};
my $sclient=IO::Socket::UNIX->new(Peer =>"$peerfile",	my $sclient=IO::Socket::UNIX->new(Peer =>"$peerfile",
Type => SOCK_STREAM,	Type => SOCK_STREAM,
Timeout => 10)	Timeout => 10)
or return "con_lost";	or return "con_lost";
print $sclient "$cmd\n";	print $sclient "sethost:$server:$cmd\n";
my $answer=<$sclient>;	my $answer=<$sclient>;
chomp($answer);	chomp($answer);
if (!$answer) { $answer="con_lost"; }	if (!$answer) { $answer="con_lost"; }
Line 4957 sub reply {	Line 5308 sub reply {
$answer=subreply("ping",$server);	$answer=subreply("ping",$server);
if ($answer ne $server) {	if ($answer ne $server) {
&logthis("sub reply: answer != server answer is $answer, server is $server");	&logthis("sub reply: answer != server answer is $answer, server is $server");
&reconlonc("$perlvar{'lonSockDir'}/$server");	&reconlonc("$perlvar{'lonSockDir'}/".$hostname{$server});
}	}
$answer=subreply($cmd,$server);	$answer=subreply($cmd,$server);
}	}
Line 4984 sub sub_sql_reply {	Line 5335 sub sub_sql_reply {
Type => SOCK_STREAM,	Type => SOCK_STREAM,
Timeout => 10)	Timeout => 10)
or return "con_lost";	or return "con_lost";
print $sclient "$cmd\n";	print $sclient "$cmd:$currentdomainid\n";
my $answer=<$sclient>;	my $answer=<$sclient>;
chomp($answer);	chomp($answer);
if (!$answer) { $answer="con_lost"; }	if (!$answer) { $answer="con_lost"; }
return $answer;	return $answer;
}	}

# -------------------------------------------- Return path to profile directory

sub propath {
my ($udom,$uname)=@_;
$udom=~s/\W//g;
$uname=~s/\W//g;
my $subdir=$uname.'__';
$subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;
my $proname="$perlvar{'lonUsersDir'}/$udom/$subdir/$uname";
return $proname;
}

# --------------------------------------- Is this the home server of an author?	# --------------------------------------- Is this the home server of an author?

sub ishome {	sub ishome {
Line 5127 sub make_new_child {	Line 5466 sub make_new_child {
# my $tmpsnum=0; # Now global	# my $tmpsnum=0; # Now global
#---------------------------------------------------- kerberos 5 initialization	#---------------------------------------------------- kerberos 5 initialization
&Authen::Krb5::init_context();	&Authen::Krb5::init_context();
unless (($dist eq 'fedora4') \|\| ($dist eq 'suse9.3')) {	unless (($dist eq 'fedora5') \|\| ($dist eq 'fedora4')
	\|\| ($dist eq 'suse9.3')) {
&Authen::Krb5::init_ets();	&Authen::Krb5::init_ets();
}	}

Line 5168 sub make_new_child {	Line 5508 sub make_new_child {
my $remotereq=<$client>;	my $remotereq=<$client>;
chomp($remotereq);	chomp($remotereq);
Debug("Got init: $remotereq");	Debug("Got init: $remotereq");
my $inikeyword = split(/:/, $remotereq);
if ($remotereq =~ /^init/) {	if ($remotereq =~ /^init/) {
&sethost("sethost:$perlvar{'lonHostID'}");	&sethost("sethost:$perlvar{'lonHostID'}");
#	#
Line 5263 sub make_new_child {	Line 5603 sub make_new_child {
# no need to try to do recon's to myself	# no need to try to do recon's to myself
next;	next;
}	}
&reconlonc("$perlvar{'lonSockDir'}/$id");	&reconlonc("$perlvar{'lonSockDir'}/".$hostname{$id});
}	}
&logthis("<font color='green'>Established connection: $clientname</font>");	&logthis("<font color='green'>Established connection: $clientname</font>");
&status('Will listen to '.$clientname);	&status('Will listen to '.$clientname);
Line 5319 sub is_author {	Line 5659 sub is_author {

# Author role should show up as a key /domain/_au	# Author role should show up as a key /domain/_au

my $key = "/$domain/_au";	my $key = "/$domain/_au";
my $value = $hashref->{$key};	my $value;
	if (defined($hashref)) {
	$value = $hashref->{$key};
	}

if(defined($value)) {	if(defined($value)) {
&Debug("$user @ $domain is an author");	&Debug("$user @ $domain is an author");
Line 5550 sub validate_user {	Line 5893 sub validate_user {
# Authenticate via installation specific authentcation method:	# Authenticate via installation specific authentcation method:
$validated = &localauth::localauth($user,	$validated = &localauth::localauth($user,
$password,	$password,
$contentpwd);	$contentpwd,
	$domain);
	if ($validate < 0) {
	&logthis("localauth for $contentpwd $user:$domain returned a $validated");
	$validated = 0;
	}
} else { # Unrecognized auth is also bad.	} else { # Unrecognized auth is also bad.
$validated = 0;	$validated = 0;
}	}
Line 5576 sub addline {	Line 5924 sub addline {
my ($fname,$hostid,$ip,$newline)=@_;	my ($fname,$hostid,$ip,$newline)=@_;
my $contents;	my $contents;
my $found=0;	my $found=0;
my $expr='^'.$hostid.':'.$ip.':';	my $expr='^'.quotemeta($hostid).':'.quotemeta($ip).':';
$expr =~ s/\./\\\./g;
my $sh;	my $sh;
if ($sh=IO::File->new("$fname.subscription")) {	if ($sh=IO::File->new("$fname.subscription")) {
while (my $subline=<$sh>) {	while (my $subline=<$sh>) {
Line 5593 sub addline {	Line 5940 sub addline {
}	}

sub get_chat {	sub get_chat {
my ($cdom,$cname,$udom,$uname)=@_;	my ($cdom,$cname,$udom,$uname,$group)=@_;
my %hash;
my $proname=&propath($cdom,$cname);
my @entries=();	my @entries=();
if (tie(%hash,'GDBM_File',"$proname/nohist_chatroom.db",	my $namespace = 'nohist_chatroom';
&GDBM_READER(),0640)) {	my $namespace_inroom = 'nohist_inchatroom';
@entries=map { $_.':'.$hash{$_} } sort keys %hash;	if ($group ne '') {
untie %hash;	$namespace .= '_'.$group;
	$namespace_inroom .= '_'.$group;
	}
	my $hashref = &tie_user_hash($cdom, $cname, $namespace,
	&GDBM_READER());
	if ($hashref) {
	@entries=map { $_.':'.$hashref->{$_} } sort(keys(%$hashref));
	&untie_user_hash($hashref);
}	}
my @participants=();	my @participants=();
my $cutoff=time-60;	my $cutoff=time-60;
if (tie(%hash,'GDBM_File',"$proname/nohist_inchatroom.db",	$hashref = &tie_user_hash($cdom, $cname, $namespace_inroom,
&GDBM_WRCREAT(),0640)) {	&GDBM_WRCREAT());
$hash{$uname.':'.$udom}=time;	if ($hashref) {
foreach (sort keys %hash) {	$hashref->{$uname.':'.$udom}=time;
if ($hash{$_}>$cutoff) {	foreach my $user (sort(keys(%$hashref))) {
$participants[$#participants+1]='active_participant:'.$_;	if ($hashref->{$user}>$cutoff) {
	push(@participants, 'active_participant:'.$user);
}	}
}	}
untie %hash;	&untie_user_hash($hashref);
}	}
return (@participants,@entries);	return (@participants,@entries);
}	}

sub chat_add {	sub chat_add {
my ($cdom,$cname,$newchat)=@_;	my ($cdom,$cname,$newchat,$group)=@_;
my %hash;
my $proname=&propath($cdom,$cname);
my @entries=();	my @entries=();
my $time=time;	my $time=time;
if (tie(%hash,'GDBM_File',"$proname/nohist_chatroom.db",	my $namespace = 'nohist_chatroom';
&GDBM_WRCREAT(),0640)) {	my $logfile = 'chatroom.log';
@entries=map { $_.':'.$hash{$_} } sort keys %hash;	if ($group ne '') {
	$namespace .= '_'.$group;
	$logfile = 'chatroom_'.$group.'.log';
	}
	my $hashref = &tie_user_hash($cdom, $cname, $namespace,
	&GDBM_WRCREAT());
	if ($hashref) {
	@entries=map { $_.':'.$hashref->{$_} } sort(keys(%$hashref));
my ($lastid)=($entries[$#entries]=~/^(\w+)\:/);	my ($lastid)=($entries[$#entries]=~/^(\w+)\:/);
my ($thentime,$idnum)=split(/\_/,$lastid);	my ($thentime,$idnum)=split(/\_/,$lastid);
my $newid=$time.'_000000';	my $newid=$time.'_000000';
Line 5635 sub chat_add {	Line 5994 sub chat_add {
$idnum=substr('000000'.$idnum,-6,6);	$idnum=substr('000000'.$idnum,-6,6);
$newid=$time.'_'.$idnum;	$newid=$time.'_'.$idnum;
}	}
$hash{$newid}=$newchat;	$hashref->{$newid}=$newchat;
my $expired=$time-3600;	my $expired=$time-3600;
foreach (keys %hash) {	foreach my $comment (keys(%$hashref)) {
my ($thistime)=($_=~/(\d+)\_/);	my ($thistime) = ($comment=~/(\d+)\_/);
if ($thistime<$expired) {	if ($thistime<$expired) {
delete $hash{$_};	delete $hashref->{$comment};
}	}
}	}
untie %hash;	{
}	my $proname=&propath($cdom,$cname);
{	if (open(CHATLOG,">>$proname/$logfile")) {
my $hfh;	print CHATLOG ("$time:".&unescape($newchat)."\n");
if ($hfh=IO::File->new(">>$proname/chatroom.log")) {	}
print $hfh "$time:".&unescape($newchat)."\n";	close(CHATLOG);
}	}
	&untie_user_hash($hashref);
}	}
}	}

Line 5919 sub convert_photo {	Line 6279 sub convert_photo {
sub sethost {	sub sethost {
my ($remotereq) = @_;	my ($remotereq) = @_;
my (undef,$hostid)=split(/:/,$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 (!defined($hostid)) { $hostid=$perlvar{'lonHostID'}; }
if ($hostip{$perlvar{'lonHostID'}} eq $hostip{$hostid}) {	if ($hostip{$perlvar{'lonHostID'}} eq $hostip{$hostid}) {
$currenthostid =$hostid;	$currenthostid =$hostid;
Line 6344 to the client, and the connection is clo	Line 6709 to the client, and the connection is clo
IO::Socket	IO::Socket
IO::File	IO::File
Apache::File	Apache::File
Symbol
POSIX	POSIX
Crypt::IDEA	Crypt::IDEA
LWP::UserAgent()	LWP::UserAgent()

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>

500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.

Removed from v.1.302
changed lines
	Added in v.1.357