version 1.338, 2006/08/25 17:26:26
|
version 1.347, 2006/11/10 02:01:55
|
Line 40 use IO::File;
|
Line 40 use IO::File;
|
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; |
Line 888 sub EditFile {
|
Line 889 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 1250 sub push_file_handler {
|
Line 1251 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 1574 sub change_password_handler {
|
Line 1575 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 1603 sub change_password_handler {
|
Line 1611 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 2123 sub token_auth_user_file_handler {
|
Line 2131 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")) { |
flock(ENVIN,LOCK_SH); |
flock(ENVIN,LOCK_SH); |
while (my $line=<ENVIN>) { |
tie(my %disk_env,'GDBM_File',"$file",&GDBM_READER(),0640); |
my ($envname)=split(/=/,$line,2); |
if (exists($disk_env{"userfile.$fname"})) { |
$envname=&unescape($envname); |
$reply="ok\n"; |
if ($envname=~ m|^userfile\.\Q$fname\E|) { $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 2593 sub get_profile_entry_encrypted {
|
Line 2608 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 3039 sub restore_handler {
|
Line 3054 sub restore_handler {
|
|
|
my $userinput = "$cmd:$tail"; # Only used for logging purposes. |
my $userinput = "$cmd:$tail"; # Only used for logging purposes. |
|
|
my ($cmd,$udom,$uname,$namespace,$rid) = split(/:/,$userinput); |
my ($udom,$uname,$namespace,$rid) = split(/:/,$tail); |
$namespace=~s/\//\_/g; |
$namespace=~s/\//\_/g; |
$namespace=~s/\W//g; |
$namespace=~s/\W//g; |
chomp($rid); |
chomp($rid); |
Line 3214 sub reply_query_handler {
|
Line 3229 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 3350 sub dump_course_id_handler {
|
Line 3365 sub dump_course_id_handler {
|
my $userinput = "$cmd:$tail"; |
my $userinput = "$cmd:$tail"; |
|
|
my ($udom,$since,$description,$instcodefilter,$ownerfilter,$coursefilter, |
my ($udom,$since,$description,$instcodefilter,$ownerfilter,$coursefilter, |
$typefilter) =split(/:/,$tail); |
$typefilter,$regexp_ok) =split(/:/,$tail); |
if (defined($description)) { |
if (defined($description)) { |
$description=&unescape($description); |
$description=&unescape($description); |
} else { |
} else { |
Line 3387 sub dump_course_id_handler {
|
Line 3402 sub dump_course_id_handler {
|
} else { |
} else { |
$typefilter='.'; |
$typefilter='.'; |
} |
} |
|
if (defined($regexp_ok)) { |
|
$regexp_ok=&unescape($regexp_ok); |
|
} |
|
|
unless (defined($since)) { $since=0; } |
unless (defined($since)) { $since=0; } |
my $qresult=''; |
my $qresult=''; |
Line 3407 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)) { |
Line 3454 sub dump_course_id_handler {
|
Line 3478 sub dump_course_id_handler {
|
} |
} |
unless ($typefilter eq '.' || !defined($typefilter)) { |
unless ($typefilter eq '.' || !defined($typefilter)) { |
my $unescapeType = &unescape($type); |
my $unescapeType = &unescape($type); |
if (!defined($type)) { |
if ($type eq '') { |
if ($typefilter ne 'Course') { |
if ($typefilter ne 'Course') { |
$match = 0; |
$match = 0; |
} |
} |
Line 3856 sub tmp_put_handler {
|
Line 3880 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 4179 sub validate_course_section_handler {
|
Line 4211 sub validate_course_section_handler {
|
®ister_handler("autovalidatecourse", \&validate_course_section_handler, 0, 1, 0); |
®ister_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: |
|
# $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: |
|
# $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; |
|
} |
|
®ister_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: |
# 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??). |
# $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 4315 sub get_institutional_code_format_handle
|
Line 4378 sub get_institutional_code_format_handle
|
®ister_handler("autoinstcodeformat", |
®ister_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); |
|
} |
|
} |
|
®ister_handler("autoinstcodedefaults", |
|
\&get_institutional_defaults_handler,0,1,0); |
|
|
|
|
# Get domain specific conditions for import of student photographs to a course |
# Get domain specific conditions for import of student photographs to a course |
# |
# |
# Retrieves information from photo_permission subroutine in localenroll. |
# Retrieves information from photo_permission subroutine in localenroll. |