--- loncom/lond 2008/02/21 16:04:19 1.395 +++ loncom/lond 2008/04/21 15:27:34 1.400 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.395 2008/02/21 16:04:19 raeburn Exp $ +# $Id: lond,v 1.400 2008/04/21 15:27:34 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -59,7 +59,7 @@ my $DEBUG = 0; # Non zero to ena my $status=''; my $lastlog=''; -my $VERSION='$Revision: 1.395 $'; #' stupid emacs +my $VERSION='$Revision: 1.400 $'; #' stupid emacs my $remoteVERSION; my $currenthostid="default"; my $currentdomainid; @@ -1221,8 +1221,10 @@ sub push_file_handler { } ®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 # under construction by Rick Banghart @@ -1272,9 +1274,73 @@ sub du_handler { } ®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 -# for communication with legacy servers. Please see the ls2_handler. +# du2 - list the disk usage of a directory recursively. +# +# 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 # selected directory the filename followed by the full output of @@ -1340,8 +1406,9 @@ sub ls_handler { } ®ister_handler("ls", \&ls_handler, 0, 1, 0); -# -# Please also see the ls_handler, which this routine obosolets. +# The ls2_handler routine should be considered obsolete and is retained +# 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 # values before concatenating them together with ':'s. # @@ -1406,6 +1473,119 @@ sub ls2_handler { return 1; } ®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=; + foreach my $obsolete (@obsolete) { + if($obsolete =~ m/()(on|1)/) { $obs = 1; } + if($obsolete =~ m|()(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 # lonc or lond be reinitialized so that an updated @@ -1514,16 +1694,15 @@ sub authenticate_handler { # udom - User's domain. # uname - Username. # upass - User's password. - # defauthtype - Default authentication types for the domain - # defautharg - Default authentication arg for the domain + # checkdefauth - Pass to validate_user() to try authentication + # with default auth type(s) if no user account. - my ($udom,$uname,$upass,$defauthtype,$defautharg)=split(/:/,$tail); - &Debug(" Authenticate domain = $udom, user = $uname, password = $upass"); + my ($udom, $uname, $upass, $checkdefauth)=split(/:/,$tail); + &Debug(" Authenticate domain = $udom, user = $uname, password = $upass, checkdefauth = $checkdefauth"); chomp($upass); $upass=&unescape($upass); - my $pwdcorrect = &validate_user($udom,$uname,$upass,$defauthtype, - $defautharg); + my $pwdcorrect = &validate_user($udom,$uname,$upass,$checkdefauth); if($pwdcorrect) { &Reply( $client, "authorized\n", $userinput); # @@ -3447,7 +3626,8 @@ sub dump_course_id_handler { my $userinput = "$cmd:$tail"; my ($udom,$since,$description,$instcodefilter,$ownerfilter,$coursefilter, - $typefilter,$regexp_ok,$rtn_as_hash) =split(/:/,$tail); + $typefilter,$regexp_ok,$rtn_as_hash,$selfenrollonly) =split(/:/,$tail); + my $now = time; if (defined($description)) { $description=&unescape($description); } else { @@ -3497,7 +3677,8 @@ sub dump_course_id_handler { my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT()); if ($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); if ($unesc_key =~ /^lasttime:/) { next; @@ -3516,6 +3697,14 @@ sub dump_course_id_handler { $unesc_val{'inst_code'} = $items->{'inst_code'}; $unesc_val{'owner'} = $items->{'owner'}; $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; + } + } } } else { $is_hash = 0; @@ -4704,6 +4893,40 @@ sub get_institutional_id_rules { } ®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 { my ($cmd, $tail, $client) = @_; @@ -4763,6 +4986,35 @@ sub institutional_id_check { } ®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 # # Retrieves information from photo_permission subroutine in localenroll. @@ -5973,7 +6225,7 @@ sub get_auth_type # 0 - The domain,user,password triplet is not a valid user. # sub validate_user { - my ($domain, $user, $password, $defauthtype, $defautharg) = @_; + my ($domain, $user, $password, $checkdefauth) = @_; # Why negative ~pi you may well ask? Well this function is about # authentication, and therefore very important to get right. @@ -5997,13 +6249,17 @@ sub validate_user { my $null = pack("C",0); # Used by kerberos auth types. if ($howpwd eq 'nouser') { - if ($defauthtype eq 'localauth') { - $howpwd = $defauthtype; - $contentpwd = $defautharg; - } elsif ((($defauthtype eq 'krb4') || ($defauthtype eq 'krb5')) && - ($defautharg ne '')) { - $howpwd = $defauthtype; - $contentpwd = $defautharg; + 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') {