loncom/lond - diff

Return to lond CVS log

Up to [LON-CAPA] / loncom

Diff for /loncom/lond between versions 1.191 and 1.193

version 1.191, 2004/05/20 18:17:12	version 1.193, 2004/06/08 22:09:44
Line 45 use Authen::Krb4;	Line 45 use Authen::Krb4;
use Authen::Krb5;	use Authen::Krb5;
use lib '/home/httpd/lib/perl/';	use lib '/home/httpd/lib/perl/';
use localauth;	use localauth;
	use localenroll;
use File::Copy;	use File::Copy;
use LONCAPA::ConfigFileEdit;	use LONCAPA::ConfigFileEdit;

Line 225 sub ValidManager {	Line 226 sub ValidManager {
# 1 - Success.	# 1 - Success.
#	#
sub CopyFile {	sub CopyFile {
my $oldfile = shift;
my $newfile = shift;	my ($oldfile, $newfile) = @_;

# The file must exist:	# The file must exist:

Line 326 sub AdjustHostContents {	Line 327 sub AdjustHostContents {
# 0 - failure and $! has an errno.	# 0 - failure and $! has an errno.
#	#
sub InstallFile {	sub InstallFile {
my $Filename = shift;
my $Contents = shift;	my ($Filename, $Contents) = @_;
my $TempFile = $Filename.".tmp";	my $TempFile = $Filename.".tmp";

# Open the file for write:	# Open the file for write:
Line 564 sub isValidEditCommand {	Line 565 sub isValidEditCommand {
# file being edited.	# file being edited.
#	#
sub ApplyEdit {	sub ApplyEdit {
my $directive = shift;
my $editor = shift;	my ($directive, $editor) = @_;

# Break the directive down into its command and its parameters	# Break the directive down into its command and its parameters
# (at most two at this point. The meaning of the parameters, if in fact	# (at most two at this point. The meaning of the parameters, if in fact
Line 649 sub AdjustOurHost {	Line 650 sub AdjustOurHost {
# editor - Editor containing the file.	# editor - Editor containing the file.
#	#
sub ReplaceConfigFile {	sub ReplaceConfigFile {
my $filename = shift;
my $editor = shift;	my ($filename, $editor) = @_;

CopyFile ($filename, $filename.".old");	CopyFile ($filename, $filename.".old");

Line 1015 sub Debug {	Line 1016 sub Debug {
# request - Original request from client.	# request - Original request from client.
#	#
sub Reply {	sub Reply {
my $fd = shift;
my $reply = shift;	my ($fd, $reply, $request) = @_;
my $request = shift;

print $fd $reply;	print $fd $reply;
Debug("Request was $request Reply was $reply");	Debug("Request was $request Reply was $reply");
Line 2533 sub make_new_child {	Line 2533 sub make_new_child {
}	}
# ------------------------------------------------------------------- querysend	# ------------------------------------------------------------------- querysend
} elsif ($userinput =~ /^querysend/) {	} elsif ($userinput =~ /^querysend/) {
if(isClient) {	if (isClient) {
my ($cmd,$query,	my ($cmd,$query,
$arg1,$arg2,$arg3)=split(/\:/,$userinput);	$arg1,$arg2,$arg3)=split(/\:/,$userinput);
$query=~s/\n*$//g;	$query=~s/\n*$//g;
Line 2864 sub make_new_child {	Line 2864 sub make_new_child {
} else {	} else {
print $client "refused\n";	print $client "refused\n";
}	}
	#------------------------------- is auto-enrollment enabled?
	} elsif ($userinput =~/^autorun/) {
	if (isClient) {
	my $outcome = &localenroll::run();
	print $client "$outcome\n";
	} else {
	print $client "0\n";
	}
	#------------------------------- get official sections (for auto-enrollment).
	} elsif ($userinput =~/^autogetsections/) {
	if (isClient) {
	my ($cmd,$coursecode)=split(/:/,$userinput);
	my @secs = &localenroll::get_sections($coursecode);
	my $seclist = &escape(join(':',@secs));
	print $client "$seclist\n";
	} else {
	print $client "refused\n";
	}
	#----------------------- validate owner of new course section (for auto-enrollment).
	} elsif ($userinput =~/^autonewcourse/) {
	if (isClient) {
	my ($cmd,$course_id,$owner)=split(/:/,$userinput);
	my $outcome = &localenroll::new_course($course_id,$owner);
	print $client "$outcome\n";
	} else {
	print $client "refused\n";
	}
	#-------------- validate course section in schedule of classes (for auto-enrollment).
	} elsif ($userinput =~/^autovalidatecourse/) {
	if (isClient) {
	my ($cmd,$course_id)=split(/:/,$userinput);
	my $outcome=&localenroll::validate_courseID($course_id);
	print $client "$outcome\n";
	} else {
	print $client "refused\n";
	}
	#--------------------------- create password for new user (for auto-enrollment).
	} elsif ($userinput =~/^autocreatepassword/) {
	if (isClient) {
	my ($cmd,$authparam)=split(/:/,$userinput);
	my ($create_passwd,$authchk) = @_;
	($authparam,$create_passwd,$authchk) = &localenroll::create_password($authparam);
	print $client &escape($authparam.':'.$create_passwd.':'.$authchk)."\n";
	} else {
	print $client "refused\n";
	}
	#--------------------------- read and remove temporary files (for auto-enrollment).
	} elsif ($userinput =~/^autoretrieve/) {
	if (isClient) {
	my ($cmd,$filename) = split(/:/,$userinput);
	my $source = $perlvar{'lonDaemons'}.'/tmp/'.$filename;
	if ( (-e $source) && ($filename ne '') ) {
	my $reply = '';
	if (open(my $fh,$source)) {
	while (<$fh>) {
	chomp($_);
	$_ =~ s/^\s+//g;
	$_ =~ s/\s+$//g;
	$reply .= $_;
	}
	close($fh);
	print $client &escape($reply)."\n";
	# unlink($source);
	} else {
	print $client "error\n";
	}
	} else {
	print $client "error\n";
	}
	} else {
	print $client "refused\n";
	}
# ------------------------------------------------------------- unknown command	# ------------------------------------------------------------- unknown command

} else {	} else {
Line 2910 sub make_new_child {	Line 2982 sub make_new_child {
#	#
sub ManagePermissions	sub ManagePermissions
{	{
my $request = shift;
my $domain = shift;	my ($request, $domain, $user, $authtype) = @_;
my $user = shift;
my $authtype= shift;

# See if the request is of the form /$domain/_au	# See if the request is of the form /$domain/_au
if($request =~ /^(\/$domain\/_au)$/) { # It's an author rolesput...	if($request =~ /^(\/$domain\/_au)$/) { # It's an author rolesput...
Line 2930 sub ManagePermissions	Line 3000 sub ManagePermissions
#	#
sub GetAuthType	sub GetAuthType
{	{
my $domain = shift;
my $user = shift;	my ($domain, $user) = @_;

Debug("GetAuthType( $domain, $user ) \n");	Debug("GetAuthType( $domain, $user ) \n");
my $proname = &propath($domain, $user);	my $proname = &propath($domain, $user);

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

Removed from v.1.191
changed lines
	Added in v.1.193