version 1.393, 2008/01/07 02:21:35
|
version 1.403, 2008/05/30 21:33:21
|
Line 1221 sub push_file_handler {
|
Line 1221 sub push_file_handler {
|
} |
} |
®ister_handler("pushfile", \&push_file_handler, 1, 0, 1); |
®ister_handler("pushfile", \&push_file_handler, 1, 0, 1); |
|
|
|
# The du_handler routine should be considered obsolete and is retained |
|
# for communication with legacy servers. Please see the du2_handler. |
# |
# |
# du - list the disk usuage of a directory recursively. |
# du - list the disk usage of a directory recursively. |
# |
# |
# note: stolen code from the ls file handler |
# note: stolen code from the ls file handler |
# under construction by Rick Banghart |
# under construction by Rick Banghart |
Line 1272 sub du_handler {
|
Line 1274 sub du_handler {
|
} |
} |
®ister_handler("du", \&du_handler, 0, 1, 0); |
®ister_handler("du", \&du_handler, 0, 1, 0); |
|
|
|
# Please also see the du_handler, which is obsoleted by du2. |
|
# du2_handler differs from du_handler in that required path to directory |
|
# provided by &propath() is prepended in the handler instead of on the |
|
# client side. |
# |
# |
# The ls_handler routine should be considered obosolete and is retained |
# du2 - list the disk usage of a directory recursively. |
# for communication with legacy servers. Please see the ls2_handler. |
# |
|
# Parameters: |
|
# $cmd - The command that dispatched us (du). |
|
# $tail - The tail of the request that invoked us. |
|
# $tail is a : separated list of the following: |
|
# - $ududir - directory path to list (before prepending) |
|
# - $getpropath = 1 if &propath() should prepend |
|
# - $uname - username to use for &propath or user dir |
|
# - $udom - domain to use for &propath or user dir |
|
# All are escaped. |
|
# $client - Socket open on the client. |
|
# Returns: |
|
# 1 - indicating that the daemon should not disconnect. |
|
# Side Effects: |
|
# The reply is written to $client. |
|
# |
|
|
|
sub du2_handler { |
|
my ($cmd, $tail, $client) = @_; |
|
my ($ududir,$getpropath,$uname,$udom) = map { &unescape($_) } (split(/:/, $tail)); |
|
my $userinput = "$cmd:$tail"; |
|
if (($ududir=~/\.\./) || (($ududir!~m|^/home/httpd/|) && (!$getpropath))) { |
|
&Failure($client,"refused\n","$cmd:$tail"); |
|
return 1; |
|
} |
|
if ($getpropath) { |
|
if (($uname =~ /^$LONCAPA::match_name$/) && ($udom =~ /^$LONCAPA::match_domain$/)) { |
|
$ududir = &propath($udom,$uname).'/'.$ududir; |
|
} else { |
|
&Failure($client,"refused\n","$cmd:$tail"); |
|
return 1; |
|
} |
|
} |
|
# Since $ududir could have some nasties in it, |
|
# we will require that ududir is a valid |
|
# directory. Just in case someone tries to |
|
# slip us a line like .;(cd /home/httpd rm -rf*) |
|
# etc. |
|
# |
|
if (-d $ududir) { |
|
my $total_size=0; |
|
my $code=sub { |
|
if ($_=~/\.\d+\./) { return;} |
|
if ($_=~/\.meta$/) { return;} |
|
if (-d $_) { return;} |
|
$total_size+=(stat($_))[7]; |
|
}; |
|
chdir($ududir); |
|
find($code,$ududir); |
|
$total_size=int($total_size/1024); |
|
&Reply($client,\$total_size,"$cmd:$ududir"); |
|
} else { |
|
&Failure($client, "bad_directory:$ududir\n","$cmd:$tail"); |
|
} |
|
return 1; |
|
} |
|
®ister_handler("du2", \&du2_handler, 0, 1, 0); |
|
|
|
# |
|
# The ls_handler routine should be considered obsolete and is retained |
|
# for communication with legacy servers. Please see the ls3_handler. |
# |
# |
# ls - list the contents of a directory. For each file in the |
# ls - list the contents of a directory. For each file in the |
# selected directory the filename followed by the full output of |
# selected directory the filename followed by the full output of |
Line 1340 sub ls_handler {
|
Line 1406 sub ls_handler {
|
} |
} |
®ister_handler("ls", \&ls_handler, 0, 1, 0); |
®ister_handler("ls", \&ls_handler, 0, 1, 0); |
|
|
# |
# The ls2_handler routine should be considered obsolete and is retained |
# Please also see the ls_handler, which this routine obosolets. |
# for communication with legacy servers. Please see the ls3_handler. |
|
# Please also see the ls_handler, which was itself obsoleted by ls2. |
# ls2_handler differs from ls_handler in that it escapes its return |
# ls2_handler differs from ls_handler in that it escapes its return |
# values before concatenating them together with ':'s. |
# values before concatenating them together with ':'s. |
# |
# |
Line 1406 sub ls2_handler {
|
Line 1473 sub ls2_handler {
|
return 1; |
return 1; |
} |
} |
®ister_handler("ls2", \&ls2_handler, 0, 1, 0); |
®ister_handler("ls2", \&ls2_handler, 0, 1, 0); |
|
# |
|
# ls3 - list the contents of a directory. For each file in the |
|
# selected directory the filename followed by the full output of |
|
# the stat function is returned. The returned info for each |
|
# file are separated by ':'. The stat fields are separated by &'s. |
|
# Parameters: |
|
# $cmd - The command that dispatched us (ls). |
|
# $tail - The tail of the request that invoked us. |
|
# $tail is a : separated list of the following: |
|
# - $ulsdir - directory path to list (before prepending) |
|
# - $getpropath = 1 if &propath() should prepend |
|
# - $getuserdir = 1 if path to user dir in lonUsers should |
|
# prepend |
|
# - $alternate_root - path to prepend |
|
# - $uname - username to use for &propath or user dir |
|
# - $udom - domain to use for &propath or user dir |
|
# All of these except $getpropath and &getuserdir are escaped. |
|
# no_such_dir. |
|
# $client - Socket open on the client. |
|
# Returns: |
|
# 1 - indicating that the daemon should not disconnect. |
|
# Side Effects: |
|
# The reply is written to $client. |
|
# |
|
|
|
sub ls3_handler { |
|
my ($cmd, $tail, $client) = @_; |
|
my $userinput = "$cmd:$tail"; |
|
my ($ulsdir,$getpropath,$getuserdir,$alternate_root,$uname,$udom) = |
|
split(/:/,$tail); |
|
if (defined($ulsdir)) { |
|
$ulsdir = &unescape($ulsdir); |
|
} |
|
if (defined($alternate_root)) { |
|
$alternate_root = &unescape($alternate_root); |
|
} |
|
if (defined($uname)) { |
|
$uname = &unescape($uname); |
|
} |
|
if (defined($udom)) { |
|
$udom = &unescape($udom); |
|
} |
|
|
|
my $dir_root = $perlvar{'lonDocRoot'}; |
|
if ($getpropath) { |
|
if (($uname =~ /^$LONCAPA::match_name$/) && ($udom =~ /^$LONCAPA::match_domain$/)) { |
|
$dir_root = &propath($udom,$uname); |
|
$dir_root =~ s/\/$//; |
|
} else { |
|
&Failure($client,"refused\n","$cmd:$tail"); |
|
return 1; |
|
} |
|
} elsif ($getuserdir) { |
|
if (($uname =~ /^$LONCAPA::match_name$/) && ($udom =~ /^$LONCAPA::match_domain$/)) { |
|
my $subdir=$uname.'__'; |
|
$subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/; |
|
$dir_root = $Apache::lonnet::perlvar{'lonUsersDir'} |
|
."/$udom/$subdir/$uname"; |
|
} else { |
|
&Failure($client,"refused\n","$cmd:$tail"); |
|
return 1; |
|
} |
|
} elsif ($alternate_root ne '') { |
|
$dir_root = $alternate_root; |
|
} |
|
if ($dir_root ne '') { |
|
if ($ulsdir =~ /^\//) { |
|
$ulsdir = $dir_root.$ulsdir; |
|
} else { |
|
$ulsdir = $dir_root.'/'.$ulsdir; |
|
} |
|
} |
|
my $obs; |
|
my $rights; |
|
my $ulsout=''; |
|
my $ulsfn; |
|
if (-e $ulsdir) { |
|
if(-d $ulsdir) { |
|
if (opendir(LSDIR,$ulsdir)) { |
|
while ($ulsfn=readdir(LSDIR)) { |
|
undef($obs); |
|
undef($rights); |
|
my @ulsstats=stat($ulsdir.'/'.$ulsfn); |
|
#We do some obsolete checking here |
|
if(-e $ulsdir.'/'.$ulsfn.".meta") { |
|
open(FILE, $ulsdir.'/'.$ulsfn.".meta"); |
|
my @obsolete=<FILE>; |
|
foreach my $obsolete (@obsolete) { |
|
if($obsolete =~ m/(<obsolete>)(on|1)/) { $obs = 1; } |
|
if($obsolete =~ m|(<copyright>)(default)|) { |
|
$rights = 1; |
|
} |
|
} |
|
} |
|
my $tmp = $ulsfn.'&'.join('&',@ulsstats); |
|
if ($obs eq '1') { $tmp.="&1"; } else { $tmp.="&0"; } |
|
if ($rights eq '1') { $tmp.="&1"; } else { $tmp.="&0"; } |
|
$ulsout.= &escape($tmp).':'; |
|
} |
|
closedir(LSDIR); |
|
} |
|
} else { |
|
my @ulsstats=stat($ulsdir); |
|
$ulsout.=$ulsfn.'&'.join('&',@ulsstats).':'; |
|
} |
|
} else { |
|
$ulsout='no_such_dir'; |
|
} |
|
if ($ulsout eq '') { $ulsout='empty'; } |
|
&Reply($client, \$ulsout, $userinput); # This supports debug logging. |
|
return 1; |
|
} |
|
®ister_handler("ls3", \&ls3_handler, 0, 1, 0); |
|
|
# Process a reinit request. Reinit requests that either |
# Process a reinit request. Reinit requests that either |
# lonc or lond be reinitialized so that an updated |
# lonc or lond be reinitialized so that an updated |
Line 1514 sub authenticate_handler {
|
Line 1694 sub authenticate_handler {
|
# udom - User's domain. |
# udom - User's domain. |
# uname - Username. |
# uname - Username. |
# upass - User's password. |
# upass - User's password. |
|
# checkdefauth - Pass to validate_user() to try authentication |
|
# with default auth type(s) if no user account. |
|
|
my ($udom,$uname,$upass)=split(/:/,$tail); |
my ($udom, $uname, $upass, $checkdefauth)=split(/:/,$tail); |
&Debug(" Authenticate domain = $udom, user = $uname, password = $upass"); |
&Debug(" Authenticate domain = $udom, user = $uname, password = $upass, checkdefauth = $checkdefauth"); |
chomp($upass); |
chomp($upass); |
$upass=&unescape($upass); |
$upass=&unescape($upass); |
|
|
my $pwdcorrect = &validate_user($udom, $uname, $upass); |
my $pwdcorrect = &validate_user($udom,$uname,$upass,$checkdefauth); |
if($pwdcorrect) { |
if($pwdcorrect) { |
&Reply( $client, "authorized\n", $userinput); |
&Reply( $client, "authorized\n", $userinput); |
# |
# |
Line 3444 sub dump_course_id_handler {
|
Line 3626 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,$regexp_ok,$rtn_as_hash) =split(/:/,$tail); |
$typefilter,$regexp_ok,$rtn_as_hash,$selfenrollonly,$catfilter) =split(/:/,$tail); |
|
my $now = time; |
if (defined($description)) { |
if (defined($description)) { |
$description=&unescape($description); |
$description=&unescape($description); |
} else { |
} else { |
Line 3484 sub dump_course_id_handler {
|
Line 3667 sub dump_course_id_handler {
|
if (defined($regexp_ok)) { |
if (defined($regexp_ok)) { |
$regexp_ok=&unescape($regexp_ok); |
$regexp_ok=&unescape($regexp_ok); |
} |
} |
|
if (defined($catfilter)) { |
|
$catfilter=&unescape($catfilter); |
|
} |
my $unpack = 1; |
my $unpack = 1; |
if ($description eq '.' && $instcodefilter eq '.' && $coursefilter eq '.' && |
if ($description eq '.' && $instcodefilter eq '.' && $coursefilter eq '.' && |
$typefilter eq '.') { |
$typefilter eq '.') { |
Line 3494 sub dump_course_id_handler {
|
Line 3680 sub dump_course_id_handler {
|
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 ($unesc_key,$lasttime_key,$lasttime,$is_hash,%val,%unesc_val); |
my ($unesc_key,$lasttime_key,$lasttime,$is_hash,%val, |
|
%unesc_val,$selfenroll_end,$selfenroll_types); |
$unesc_key = &unescape($key); |
$unesc_key = &unescape($key); |
if ($unesc_key =~ /^lasttime:/) { |
if ($unesc_key =~ /^lasttime:/) { |
next; |
next; |
Line 3513 sub dump_course_id_handler {
|
Line 3700 sub dump_course_id_handler {
|
$unesc_val{'inst_code'} = $items->{'inst_code'}; |
$unesc_val{'inst_code'} = $items->{'inst_code'}; |
$unesc_val{'owner'} = $items->{'owner'}; |
$unesc_val{'owner'} = $items->{'owner'}; |
$unesc_val{'type'} = $items->{'type'}; |
$unesc_val{'type'} = $items->{'type'}; |
|
$selfenroll_types = $items->{'selfenroll_types'}; |
|
$selfenroll_end = $items->{'selfenroll_end_date'}; |
|
if ($selfenrollonly) { |
|
next if (!$selfenroll_types); |
|
if (($selfenroll_end > 0) && ($selfenroll_end <= $now)) { |
|
next; |
|
} |
|
} |
|
if ($catfilter ne '') { |
|
next if ($items->{'category'} ne $catfilter); |
|
} |
} |
} |
} else { |
} else { |
|
next if ($catfilter ne ''); |
|
next if ($selfenrollonly); |
$is_hash = 0; |
$is_hash = 0; |
my @courseitems = split(/:/,$value); |
my @courseitems = split(/:/,$value); |
$lasttime = pop(@courseitems); |
$lasttime = pop(@courseitems); |
next if ($lasttime<$since); |
if ($hashref->{$lasttime_key} eq '') { |
|
next if ($lasttime<$since); |
|
} |
($val{'descr'},$val{'inst_code'},$val{'owner'},$val{'type'}) = @courseitems; |
($val{'descr'},$val{'inst_code'},$val{'owner'},$val{'type'}) = @courseitems; |
} |
} |
my $match = 1; |
my $match = 1; |
Line 4701 sub get_institutional_id_rules {
|
Line 4903 sub get_institutional_id_rules {
|
} |
} |
®ister_handler("instidrules",\&get_institutional_id_rules,0,1,0); |
®ister_handler("instidrules",\&get_institutional_id_rules,0,1,0); |
|
|
|
sub get_institutional_selfcreate_rules { |
|
my ($cmd, $tail, $client) = @_; |
|
my $userinput = "$cmd:$tail"; |
|
my $dom = &unescape($tail); |
|
my (%rules_hash,@rules_order); |
|
my $outcome; |
|
eval { |
|
local($SIG{__DIE__})='DEFAULT'; |
|
$outcome = &localenroll::selfcreate_rules($dom,\%rules_hash,\@rules_order); |
|
}; |
|
if (!$@) { |
|
if ($outcome eq 'ok') { |
|
my $result; |
|
foreach my $key (keys(%rules_hash)) { |
|
$result .= &escape($key).'='.&Apache::lonnet::freeze_escape($rules_hash{$key}).'&'; |
|
} |
|
$result =~ s/\&$//; |
|
$result .= ':'; |
|
if (@rules_order > 0) { |
|
foreach my $item (@rules_order) { |
|
$result .= &escape($item).'&'; |
|
} |
|
} |
|
$result =~ s/\&$//; |
|
&Reply($client,\$result,$userinput); |
|
} else { |
|
&Reply($client,"error\n", $userinput); |
|
} |
|
} else { |
|
&Failure($client,"unknown_cmd\n",$userinput); |
|
} |
|
} |
|
®ister_handler("instemailrules",\&get_institutional_selfcreate_rules,0,1,0); |
|
|
|
|
sub institutional_username_check { |
sub institutional_username_check { |
my ($cmd, $tail, $client) = @_; |
my ($cmd, $tail, $client) = @_; |
Line 4760 sub institutional_id_check {
|
Line 4996 sub institutional_id_check {
|
} |
} |
®ister_handler("instidrulecheck",\&institutional_id_check,0,1,0); |
®ister_handler("instidrulecheck",\&institutional_id_check,0,1,0); |
|
|
|
sub institutional_selfcreate_check { |
|
my ($cmd, $tail, $client) = @_; |
|
my $userinput = "$cmd:$tail"; |
|
my %rulecheck; |
|
my $outcome; |
|
my ($udom,$email,@rules) = split(/:/,$tail); |
|
$udom = &unescape($udom); |
|
$email = &unescape($email); |
|
@rules = map {&unescape($_);} (@rules); |
|
eval { |
|
local($SIG{__DIE__})='DEFAULT'; |
|
$outcome = &localenroll::selfcreate_check($udom,$email,\@rules,\%rulecheck); |
|
}; |
|
if (!$@) { |
|
if ($outcome eq 'ok') { |
|
my $result=''; |
|
foreach my $key (keys(%rulecheck)) { |
|
$result.=&escape($key).'='.&Apache::lonnet::freeze_escape($rulecheck{$key}).'&'; |
|
} |
|
&Reply($client,\$result,$userinput); |
|
} else { |
|
&Reply($client,"error\n", $userinput); |
|
} |
|
} else { |
|
&Failure($client,"unknown_cmd\n",$userinput); |
|
} |
|
} |
|
®ister_handler("instselfcreatecheck",\&institutional_selfcreate_check,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. |
Line 5970 sub get_auth_type
|
Line 6235 sub get_auth_type
|
# 0 - The domain,user,password triplet is not a valid user. |
# 0 - The domain,user,password triplet is not a valid user. |
# |
# |
sub validate_user { |
sub validate_user { |
my ($domain, $user, $password) = @_; |
my ($domain, $user, $password, $checkdefauth) = @_; |
|
|
|
|
# Why negative ~pi you may well ask? Well this function is about |
# Why negative ~pi you may well ask? Well this function is about |
# authentication, and therefore very important to get right. |
# authentication, and therefore very important to get right. |
Line 5994 sub validate_user {
|
Line 6258 sub validate_user {
|
|
|
my $null = pack("C",0); # Used by kerberos auth types. |
my $null = pack("C",0); # Used by kerberos auth types. |
|
|
|
if ($howpwd eq 'nouser') { |
|
if ($checkdefauth) { |
|
my %domdefaults = &Apache::lonnet::get_domain_defaults($domain); |
|
if ($domdefaults{'auth_def'} eq 'localauth') { |
|
$howpwd = $domdefaults{'auth_def'}; |
|
$contentpwd = $domdefaults{'auth_arg_def'}; |
|
} elsif ((($domdefaults{'auth_def'} eq 'krb4') || |
|
($domdefaults{'auth_def'} eq 'krb5')) && |
|
($domdefaults{'auth_arg_def'} ne '')) { |
|
$howpwd = $domdefaults{'auth_def'}; |
|
$contentpwd = $domdefaults{'auth_arg_def'}; |
|
} |
|
} |
|
} |
if ($howpwd ne 'nouser') { |
if ($howpwd ne 'nouser') { |
|
|
if($howpwd eq "internal") { # Encrypted is in local password file. |
if($howpwd eq "internal") { # Encrypted is in local password file. |
$validated = (crypt($password, $contentpwd) eq $contentpwd); |
$validated = (crypt($password, $contentpwd) eq $contentpwd); |
} |
} |
Line 6046 sub validate_user {
|
Line 6323 sub validate_user {
|
my $credentials= &Authen::Krb5::cc_default(); |
my $credentials= &Authen::Krb5::cc_default(); |
$credentials->initialize(&Authen::Krb5::parse_name($user.'@' |
$credentials->initialize(&Authen::Krb5::parse_name($user.'@' |
.$contentpwd)); |
.$contentpwd)); |
my $krbreturn = &Authen::Krb5::get_in_tkt_with_password($krbclient, |
my $krbreturn; |
$krbserver, |
if (exists(&Authen::Krb5::get_init_creds_password)) { |
$password, |
$krbreturn = |
$credentials); |
&Authen::Krb5::get_init_creds_password($krbclient,$password, |
$validated = ($krbreturn == 1); |
$krbservice); |
|
$validated = (ref($krbreturn) eq 'Authen::Krb5::Creds'); |
|
} else { |
|
$krbreturn = |
|
&Authen::Krb5::get_in_tkt_with_password($krbclient,$krbserver, |
|
$password,$credentials); |
|
$validated = ($krbreturn == 1); |
|
} |
if (!$validated) { |
if (!$validated) { |
&logthis('krb5: '.$user.', '.$contentpwd.', '. |
&logthis('krb5: '.$user.', '.$contentpwd.', '. |
&Authen::Krb5::error()); |
&Authen::Krb5::error()); |