--- loncom/lond 2004/06/17 09:26:56 1.194 +++ loncom/lond 2004/06/29 15:31:32 1.204 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.194 2004/06/17 09:26:56 foxr Exp $ +# $Id: lond,v 1.204 2004/06/29 15:31:32 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -51,12 +51,12 @@ use LONCAPA::ConfigFileEdit; use LONCAPA::lonlocal; use LONCAPA::lonssl; -my $DEBUG = 1; # Non zero to enable debug log entries. +my $DEBUG = 0; # Non zero to enable debug log entries. my $status=''; my $lastlog=''; -my $VERSION='$Revision: 1.194 $'; #' stupid emacs +my $VERSION='$Revision: 1.204 $'; #' stupid emacs my $remoteVERSION; my $currenthostid; my $currentdomainid; @@ -69,6 +69,8 @@ my $clientname; # LonCAPA name of clie my $server; my $thisserver; # DNS of us. +my $keymode; + # # Connection type is: # client - All client actions are allowed @@ -352,7 +354,6 @@ sub ReadManagerTable { while(my $host = ) { chomp($host); if ($host =~ "^#") { # Comment line. - logthis(' Skipping line: '. "$host\n"); next; } if (!defined $hostip{$host}) { # This is a non cluster member @@ -1218,13 +1219,13 @@ sub logstatus { { my $fh=IO::File->new(">>$docdir/lon-status/londstatus.txt"); print $fh $$."\t".$clientname."\t".$currenthostid."\t" - .$status."\t".$lastlog."\n"; + .$status."\t".$lastlog."\t $keymode\n"; $fh->close(); } &status("Finished londstatus.txt"); { my $fh=IO::File->new(">$docdir/lon-status/londchld/$$.txt"); - print $fh $status."\n".$lastlog."\n".time; + print $fh $status."\n".$lastlog."\n".time."\n$keymode"; $fh->close(); } &status("Finished logging"); @@ -1527,6 +1528,25 @@ sub make_new_child { # If the remote is attempting a local init... give that a try: # my ($i, $inittype) = split(/:/, $remotereq); + + # If the connection type is ssl, but I didn't get my + # certificate files yet, then I'll drop back to + # insecure (if allowed). + + if($inittype eq "ssl") { + my ($ca, $cert) = lonssl::CertificateFile; + my $kfile = lonssl::KeyFile; + if((!$ca) || + (!$cert) || + (!$kfile)) { + $inittype = ""; # This forces insecure attempt. + &logthis(" Certificates not " + ."installed -- trying insecure auth"); + } + else { # SSL certificates are in place so + } # Leave the inittype alone. + } + if($inittype eq "local") { my $key = LocalConnection($client, $remotereq); if($key) { @@ -1537,6 +1557,7 @@ sub make_new_child { print $client "ok:local\n"; &logthis('"); + $keymode = "local" } else { Debug("Failed to get local key"); $clientok = 0; @@ -1550,7 +1571,8 @@ sub make_new_child { my $cipherkey = pack("H32", $key); $cipher = new IDEA($cipherkey); &logthis('' - ."Successfull ssl authentication "); + ."Successfull ssl authentication with $clientname "); + $keymode = "ssl"; } else { $clientok = 0; @@ -1562,8 +1584,9 @@ sub make_new_child { if($ok) { $clientok = 1; &logthis('' - ."Successful insecure authentication "); + ."Successful insecure authentication with $clientname "); print $client "ok\n"; + $keymode = "insecure"; } else { &logthis('' ."Attempted insecure connection disallowed "); @@ -2812,8 +2835,8 @@ sub make_new_child { my %hash; if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_WRCREAT(),0640)) { foreach my $pair (@pairs) { - my ($key,$value)=split(/=/,$pair); - $hash{$key}=$value.':'.$now; + my ($key,$descr,$inst_code)=split(/=/,$pair); + $hash{$key}=$descr.':'.$inst_code.':'.$now; } if (untie(%hash)) { print $client "ok\n"; @@ -2848,14 +2871,19 @@ sub make_new_child { my %hash; if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_READER(),0640)) { while (my ($key,$value) = each(%hash)) { - my ($descr,$lasttime)=split(/\:/,$value); + my ($descr,$lasttime,$inst_code); + if ($value =~ m/^([^\:]*):([^\:]*):(\d+)$/) { + ($descr,$inst_code,$lasttime)=($1,$2,$3); + } else { + ($descr,$lasttime) = split(/\:/,$value); + } if ($lasttime<$since) { next; } if ($description eq '.') { - $qresult.=$key.'='.$descr.'&'; + $qresult.=$key.'='.$descr.':'.$inst_code.'&'; } else { my $unescapeVal = &unescape($descr); if (eval('$unescapeVal=~/\Q$description\E/i')) { - $qresult.="$key=$descr&"; + $qresult.=$key.'='.$descr.':'.$inst_code.'&'; } } } @@ -3009,6 +3037,24 @@ sub make_new_child { Reply($client, "refused\n", $userinput); } +# ----------------------------------------- portfolio directory list (portls) + } elsif ($userinput =~ /^portls/) { + if(isClient) { + my ($cmd,$uname,$udom)=split(/:/,$userinput); + my $udir=propath($udom,$uname).'/userfiles/portfolio'; + my $dirLine=''; + my $dirContents=''; + if (opendir(LSDIR,$udir.'/')){ + while ($dirLine = readdir(LSDIR)){ + $dirContents = $dirContents.$dirLine.'
'; + } + } else { + $dirContents = "No directory found\n"; + } + print $client $dirContents."\n"; + } else { + Reply($client, "refused\n", $userinput); + } # -------------------------------------------------------------------------- ls } elsif ($userinput =~ /^ls/) { if(isClient) { @@ -3096,53 +3142,54 @@ sub make_new_child { print $client "refused\n"; } #------------------------------- is auto-enrollment enabled? - } elsif ($userinput =~/^autorun/) { + } elsif ($userinput =~/^autorun:/) { if (isClient) { - my $outcome = &localenroll::run(); + my ($cmd,$cdom) = split(/:/,$userinput); + my $outcome = &localenroll::run($cdom); print $client "$outcome\n"; } else { print $client "0\n"; } #------------------------------- get official sections (for auto-enrollment). - } elsif ($userinput =~/^autogetsections/) { + } elsif ($userinput =~/^autogetsections:/) { if (isClient) { - my ($cmd,$coursecode)=split(/:/,$userinput); - my @secs = &localenroll::get_sections($coursecode); + my ($cmd,$coursecode,$cdom)=split(/:/,$userinput); + my @secs = &localenroll::get_sections($coursecode,$cdom); 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/) { + } elsif ($userinput =~/^autonewcourse:/) { if (isClient) { - my ($cmd,$course_id,$owner)=split(/:/,$userinput); - my $outcome = &localenroll::new_course($course_id,$owner); + my ($cmd,$inst_course_id,$owner,$cdom)=split(/:/,$userinput); + my $outcome = &localenroll::new_course($inst_course_id,$owner,$cdom); print $client "$outcome\n"; } else { print $client "refused\n"; } #-------------- validate course section in schedule of classes (for auto-enrollment). - } elsif ($userinput =~/^autovalidatecourse/) { + } elsif ($userinput =~/^autovalidatecourse:/) { if (isClient) { - my ($cmd,$course_id)=split(/:/,$userinput); - my $outcome=&localenroll::validate_courseID($course_id); + my ($cmd,$inst_course_id,$cdom)=split(/:/,$userinput); + my $outcome=&localenroll::validate_courseID($inst_course_id,$cdom); print $client "$outcome\n"; } else { print $client "refused\n"; } #--------------------------- create password for new user (for auto-enrollment). - } elsif ($userinput =~/^autocreatepassword/) { + } elsif ($userinput =~/^autocreatepassword:/) { if (isClient) { - my ($cmd,$authparam)=split(/:/,$userinput); - my ($create_passwd,$authchk) = @_; - ($authparam,$create_passwd,$authchk) = &localenroll::create_password($authparam); + my ($cmd,$authparam,$cdom)=split(/:/,$userinput); + my ($create_passwd,$authchk); + ($authparam,$create_passwd,$authchk) = &localenroll::create_password($authparam,$cdom); print $client &escape($authparam.':'.$create_passwd.':'.$authchk)."\n"; } else { print $client "refused\n"; } #--------------------------- read and remove temporary files (for auto-enrollment). - } elsif ($userinput =~/^autoretrieve/) { + } elsif ($userinput =~/^autoretrieve:/) { if (isClient) { my ($cmd,$filename) = split(/:/,$userinput); my $source = $perlvar{'lonDaemons'}.'/tmp/'.$filename; @@ -3175,7 +3222,7 @@ sub make_new_child { } # -------------------------------------------------------------------- complete alarm(0); - &status('Listening to '.$clientname); + &status('Listening to '.$clientname." ($keymode)"); } # --------------------------------------------- client unknown or fishy, refuse } else {