--- loncom/lond 2017/02/28 05:42:06 1.532 +++ loncom/lond 2017/06/06 13:32:38 1.538 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.532 2017/02/28 05:42:06 raeburn Exp $ +# $Id: lond,v 1.538 2017/06/06 13:32:38 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -65,7 +65,7 @@ my $DEBUG = 0; # Non zero to ena my $status=''; my $lastlog=''; -my $VERSION='$Revision: 1.532 $'; #' stupid emacs +my $VERSION='$Revision: 1.538 $'; #' stupid emacs my $remoteVERSION; my $currenthostid="default"; my $currentdomainid; @@ -229,6 +229,7 @@ my %trust = ( dump => {remote => 1, enroll => 1, domroles => 1}, edit => {institutiononly => 1}, #not used currently eget => {remote => 1, domroles => 1, enroll => 1}, #not used currently + egetdom => {remote => 1, domroles => 1, enroll => 1, }, ekey => {}, #not used currently exit => {anywhere => 1}, fetchuserfile => {remote => 1, enroll => 1}, @@ -265,6 +266,17 @@ my %trust = ( putstore => {remote => 1, enroll => 1}, queryreply => {anywhere => 1}, querysend => {anywhere => 1}, + querysend_activitylog => {remote => 1}, + querysend_allusers => {remote => 1, domroles => 1}, + querysend_courselog => {remote => 1}, + querysend_fetchenrollment => {remote => 1}, + querysend_getinstuser => {remote => 1}, + querysend_getmultinstusers => {remote => 1}, + querysend_instdirsearch => {remote => 1, domroles => 1, coaurem => 1}, + querysend_institutionalphotos => {remote => 1}, + querysend_portfolio_metadata => {remote => 1, content => 1}, + querysend_userlog => {remote => 1, domroles => 1}, + querysend_usersearch => {remote => 1, enroll => 1, coaurem => 1}, quit => {anywhere => 1}, readlonnetglobal => {institutiononly => 1}, reinit => {manageronly => 1}, #not used currently @@ -1598,8 +1610,9 @@ sub du2_handler { # (c) /home/httpd/lonUsers//<1>/<2>/<3>//userfiles # or is: # -# 2. for a file, and the path (after prepending) does not begin with: -# /home/httpd/lonUsers//<1>/<2>/<3>// +# 2. for a file, and the path (after prepending) does not begin with one of: +# (a) /home/httpd/lonUsers//<1>/<2>/<3>// +# (b) /home/httpd/html/res/// # # the response will be "refused". # @@ -1658,7 +1671,8 @@ sub ls_handler { closedir(LSDIR); } } else { - unless ($ulsdir =~ m{/home/httpd/lonUsers/$LONCAPA::match_domain(?:/[\w\-.@]){3}/$LONCAPA::match_username/}) { + unless (($ulsdir =~ m{/home/httpd/lonUsers/$LONCAPA::match_domain(?:/[\w\-.@]){3}/$LONCAPA::match_username/}) || + ($ulsdir =~ m{/home/httpd/html/res/$LONCAPA::match_domain/$LONCAPA::match_username/})) { &Failure($client,"refused\n",$userinput); return 1; } @@ -1695,8 +1709,9 @@ sub ls_handler { # (c) /home/httpd/lonUsers//<1>/<2>/<3>//userfiles # or is: # -# 2. for a file, and the path (after prepending) does not begin with: -# /home/httpd/lonUsers//<1>/<2>/<3>// +# 2. for a file, and the path (after prepending) does not begin with one of: +# (a) /home/httpd/lonUsers//<1>/<2>/<3>// +# (b) /home/httpd/html/res/// # # the response will be "refused". # @@ -1755,7 +1770,9 @@ sub ls2_handler { closedir(LSDIR); } } else { - unless ($ulsdir =~ m{/home/httpd/lonUsers/$LONCAPA::match_domain(?:/[\w\-.@]){3}/$LONCAPA::match_username/}) { + unless (($ulsdir =~ m{/home/httpd/lonUsers/$LONCAPA::match_domain(?:/[\w\-.@]){3}/$LONCAPA::match_username/}) || + ($ulsdir =~ m{/home/httpd/html/res/$LONCAPA::match_domain/$LONCAPA::match_username/})) { + &Failure($client,"refused\n",$userinput); return 1; } @@ -1786,8 +1803,9 @@ sub ls2_handler { # # or is: # -# 2. for a file, and the path (after prepending) does not begin with: -# /home/httpd/lonUsers//<1>/<2>/<3>// +# 2. for a file, and the path (after prepending) does not begin with one of: +# (a) /home/httpd/lonUsers//<1>/<2>/<3>// +# (b) /home/httpd/html/res/// # # the response will be "refused". # @@ -1895,7 +1913,8 @@ sub ls3_handler { } } else { unless (($getpropath) || ($getuserdir) || - ($ulsdir =~ m{/home/httpd/lonUsers/$LONCAPA::match_domain(?:/[\w\-.@]){3}/$LONCAPA::match_username/})) { + ($ulsdir =~ m{/home/httpd/lonUsers/$LONCAPA::match_domain(?:/[\w\-.@]){3}/$LONCAPA::match_username/}) || + ($ulsdir =~ m{/home/httpd/html/res/$LONCAPA::match_domain/$LONCAPA::match_username/})) { &Failure($client,"refused\n",$userinput); return 1; } @@ -2323,12 +2342,8 @@ sub hash_passwd { my $plainsalt = substr($rest[1],0,22); $salt = Crypt::Eksblowfish::Bcrypt::de_base64($plainsalt); } else { - my $defaultcost; - my %domconfig = - &Apache::lonnet::get_dom('configuration',['password'],$domain); - if (ref($domconfig{'password'}) eq 'HASH') { - $defaultcost = $domconfig{'password'}{'cost'}; - } + my %domdefaults = &Apache::lonnet::get_domain_defaults($domain); + my $defaultcost = $domdefaults{'intauth_cost'}; if (($defaultcost eq '') || ($defaultcost =~ /D/)) { $cost = 10; } else { @@ -2583,15 +2598,10 @@ sub update_resource_handler { my $transname="$fname.in.transfer"; my $remoteurl=&Apache::lonnet::reply("sub:$fname","$clientname"); my $response; -# FIXME: cannot replicate files that take more than two minutes to transfer? -# alarm(120); -# FIXME: this should use the LWP mechanism, not internal alarms. - alarm(1200); - { - my $request=new HTTP::Request('GET',"$remoteurl"); - $response=&LONCAPA::LWPReq::makerequest($clientname,$request,$transname,\%perlvar,1200,0,1); - } - alarm(0); +# FIXME: cannot replicate files that take more than two minutes to transfer -- needs checking now 1200s timeout used +# for LWP request. + my $request=new HTTP::Request('GET',"$remoteurl"); + $response=&LONCAPA::LWPReq::makerequest($clientname,$request,$transname,\%perlvar,1200,0,1); if ($response->is_error()) { # FIXME: we should probably clean up here instead of just whine unlink($transname); @@ -2599,16 +2609,11 @@ sub update_resource_handler { &logthis("LWP GET: $message for $fname ($remoteurl)"); } else { if ($remoteurl!~/\.meta$/) { -# FIXME: isn't there an internal LWP mechanism for this? - alarm(120); - { - my $mrequest=new HTTP::Request('GET',$remoteurl.'.meta'); - my $mresponse = &LONCAPA::LWPReq::makerequest($clientname,$mrequest,$fname.'.meta',\%perlvar,120,0,1); - if ($mresponse->is_error()) { - unlink($fname.'.meta'); - } + my $mrequest=new HTTP::Request('GET',$remoteurl.'.meta'); + my $mresponse = &LONCAPA::LWPReq::makerequest($clientname,$mrequest,$fname.'.meta',\%perlvar,120,0,1); + if ($mresponse->is_error()) { + unlink($fname.'.meta'); } - alarm(0); } # we successfully transfered, copy file over to real name rename($transname,$fname); @@ -2678,17 +2683,13 @@ sub fetch_user_file_handler { my $remoteurl=$clientprotocol.'://'.$clienthost.'/userfiles/'.$fname; my $response; Debug("Remote URL : $remoteurl Transfername $transname Destname: $destname"); - alarm(1200); - { - my $request=new HTTP::Request('GET',"$remoteurl"); - my $verifycert = 1; - my @machine_ids = &Apache::lonnet::current_machine_ids(); - if (grep(/^\Q$clientname\E$/,@machine_ids)) { - $verifycert = 0; - } - $response = &LONCAPA::LWPReq::makerequest($clientname,$request,$transname,\%perlvar,1200,$verifycert); - } - alarm(0); + my $request=new HTTP::Request('GET',"$remoteurl"); + my $verifycert = 1; + my @machine_ids = &Apache::lonnet::current_machine_ids(); + if (grep(/^\Q$clientname\E$/,@machine_ids)) { + $verifycert = 0; + } + $response = &LONCAPA::LWPReq::makerequest($clientname,$request,$transname,\%perlvar,1200,$verifycert); if ($response->is_error()) { unlink($transname); my $message=$response->status_line; @@ -3386,7 +3387,8 @@ sub get_profile_entry { # # Parameters: # $cmd - Command keyword of request (eget). -# $tail - Tail of the command. See GetProfileEntry # for more information about this. +# $tail - Tail of the command. See GetProfileEntry +# for more information about this. # $client - File open on the client. # Returns: # 1 - Continue processing @@ -3958,7 +3960,7 @@ sub retrieve_chat_handler { # serviced. # # Parameters: -# $cmd - COmmand keyword that initiated the request. +# $cmd - Command keyword that initiated the request. # $tail - Remainder of the command after the keyword. # For this function, this consists of a query and # 3 arguments that are self-documentingly labelled @@ -3972,11 +3974,41 @@ sub retrieve_chat_handler { sub send_query_handler { my ($cmd, $tail, $client) = @_; - my $userinput = "$cmd:$tail"; my ($query,$arg1,$arg2,$arg3)=split(/\:/,$tail); $query=~s/\n*$//g; + if (($query eq 'usersearch') || ($query eq 'instdirsearch')) { + my $usersearchconf = &get_usersearch_config($currentdomainid,'directorysrch'); + my $earlyout; + if (ref($usersearchconf) eq 'HASH') { + if ($currentdomainid eq $clienthomedom) { + if ($query eq 'usersearch') { + if ($usersearchconf->{'lcavailable'} eq '0') { + $earlyout = 1; + } + } else { + if ($usersearchconf->{'available'} eq '0') { + $earlyout = 1; + } + } + } else { + if ($query eq 'usersearch') { + if ($usersearchconf->{'lclocalonly'}) { + $earlyout = 1; + } + } else { + if ($usersearchconf->{'localonly'}) { + $earlyout = 1; + } + } + } + } + if ($earlyout) { + &Reply($client, "query_not_authorized\n"); + return 1; + } + } &Reply($client, "". &sql_reply("$clientname\&$query". "\&$arg1"."\&$arg2"."\&$arg3")."\n", $userinput); @@ -4839,7 +4871,41 @@ sub get_domain_handler { my ($cmd, $tail, $client) = @_; - my $userinput = "$client:$tail"; + my $userinput = "$cmd:$tail"; + + my ($udom,$namespace,$what)=split(/:/,$tail,3); + chomp($what); + if ($namespace =~ /^enc/) { + &Failure( $client, "refused\n", $userinput); + } else { + 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, $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; +} +®ister_handler("getdom", \&get_domain_handler, 0, 1, 0); + +sub encrypted_get_domain_handler { + my ($cmd, $tail, $client) = @_; + + my $userinput = "$cmd:$tail"; my ($udom,$namespace,$what)=split(/:/,$tail,3); chomp($what); @@ -4852,19 +4918,31 @@ sub get_domain_handler { } if (&untie_domain_hash($hashref)) { $qresult=~s/\&$//; - &Reply($client, \$qresult, $userinput); + if ($cipher) { + my $cmdlength=length($qresult); + $qresult.=" "; + my $encqresult=''; + for (my $encidx=0;$encidx<=$cmdlength;$encidx+=8) { + $encqresult.= unpack("H16", + $cipher->encrypt(substr($qresult, + $encidx, + 8))); + } + &Reply( $client, "enc:$cmdlength:$encqresult\n", $userinput); + } else { + &Failure( $client, "error:no_key\n", $userinput); + } } else { &Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ". - "while attempting getdom\n",$userinput); + "while attempting egetdom\n",$userinput); } } else { &Failure($client, "error: ".($!+0)." tie(GDBM) Failed ". - "while attempting getdom\n",$userinput); + "while attempting egetdom\n",$userinput); } - return 1; } -®ister_handler("getdom", \&get_domain_handler, 0, 1, 0); +®ister_handler("egetdom", \&encrypted_get_domain_handler, 1, 1, 0); # # Puts an id to a domains id database. @@ -5764,7 +5842,7 @@ sub auto_export_grades_handler { return 1; } ®ister_handler("autoexportgrades", \&auto_export_grades_handler, - 0, 1, 0); + 1, 1, 0); # Retrieve and remove temporary files created by/during autoenrollment. # @@ -6515,6 +6593,18 @@ sub process_request { $ok = 0; } if ($ok) { + my $realcommand = $command; + if ($command eq 'querysend') { + my ($query,$rest)=split(/\:/,$tail,2); + $query=~s/\n*$//g; + my @possqueries = + qw(userlog courselog fetchenrollment institutionalphotos usersearch instdirsearch getinstuser getmultinstusers); + if (grep(/^\Q$query\E$/,@possqueries)) { + $command .= '_'.$query; + } elsif ($query eq 'prepare activity log') { + $command .= '_activitylog'; + } + } if (ref($trust{$command}) eq 'HASH') { my $donechecks; if ($trust{$command}{'anywhere'}) { @@ -6556,6 +6646,7 @@ sub process_request { } } } + $command = $realcommand; } if($ok) { @@ -7372,7 +7463,6 @@ sub make_new_child { ."Attempted insecure connection disallowed "); close $client; $clientok = 0; - } } } else { @@ -7381,7 +7471,6 @@ sub make_new_child { ."$clientip failed to initialize: >$remotereq< "); &status('No init '.$clientip); } - } else { &logthis( "WARNING: Unknown client $clientip"); @@ -7618,15 +7707,25 @@ sub password_filename { # domain - domain of the user. # name - User's name. # contents - New contents of the file. +# saveold - (optional). If true save old file in a passwd.bak file. # Returns: # 0 - Failed. # 1 - Success. # sub rewrite_password_file { - my ($domain, $user, $contents) = @_; + my ($domain, $user, $contents, $saveold) = @_; my $file = &password_filename($domain, $user); if (defined $file) { + if ($saveold) { + my $bakfile = $file.'.bak'; + if (CopyFile($file,$bakfile)) { + chmod(0400,$bakfile); + &logthis("Old password saved in passwd.bak for internally authenticated user: $user:$domain"); + } else { + &logthis("Failed to save old password in passwd.bak for internally authenticated user: $user:$domain"); + } + } my $pf = IO::File->new(">$file"); if($pf) { print $pf "$contents\n"; @@ -7717,20 +7816,27 @@ sub validate_user { $contentpwd = $domdefaults{'auth_arg_def'}; } } - } + } if ($howpwd ne 'nouser') { if($howpwd eq "internal") { # Encrypted is in local password file. if (length($contentpwd) == 13) { $validated = (crypt($password,$contentpwd) eq $contentpwd); if ($validated) { - my $ncpass = &hash_passwd($domain,$password); - if (&rewrite_password_file($domain,$user,"$howpwd:$ncpass")) { - &update_passwd_history($user,$domain,$howpwd,'conversion'); - &logthis("Validated password hashed with bcrypt for $user:$domain"); + my %domdefaults = &Apache::lonnet::get_domain_defaults($domain); + if ($domdefaults{'intauth_switch'}) { + my $ncpass = &hash_passwd($domain,$password); + my $saveold; + if ($domdefaults{'intauth_switch'} == 2) { + $saveold = 1; + } + if (&rewrite_password_file($domain,$user,"$howpwd:$ncpass",$saveold)) { + &update_passwd_history($user,$domain,$howpwd,'conversion'); + &logthis("Validated password hashed with bcrypt for $user:$domain"); + } } } } else { - $validated = &check_internal_passwd($password,$contentpwd,$domain); + $validated = &check_internal_passwd($password,$contentpwd,$domain,$user); } } elsif ($howpwd eq "unix") { # User is a normal unix user. @@ -7800,24 +7906,35 @@ sub validate_user { } sub check_internal_passwd { - my ($plainpass,$stored,$domain) = @_; + my ($plainpass,$stored,$domain,$user) = @_; my (undef,$method,@rest) = split(/!/,$stored); - if ($method eq "bcrypt") { + if ($method eq 'bcrypt') { my $result = &hash_passwd($domain,$plainpass,@rest); if ($result ne $stored) { return 0; } - # Upgrade to a larger number of rounds if necessary - my $defaultcost; - my %domconfig = - &Apache::lonnet::get_dom('configuration',['password'],$domain); - if (ref($domconfig{'password'}) eq 'HASH') { - $defaultcost = $domconfig{'password'}{'cost'}; - } - if (($defaultcost eq '') || ($defaultcost =~ /D/)) { - $defaultcost = 10; + my %domdefaults = &Apache::lonnet::get_domain_defaults($domain); + if ($domdefaults{'intauth_check'}) { + # Upgrade to a larger number of rounds if necessary + my $defaultcost = $domdefaults{'intauth_cost'}; + if (($defaultcost eq '') || ($defaultcost =~ /D/)) { + $defaultcost = 10; + } + if (int($rest[0])