--- loncom/lond 1999/10/13 17:48:51 1.1 +++ loncom/lond 1999/12/15 22:01:14 1.6 @@ -2,7 +2,9 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # 5/26/99,6/4,6/10,6/11,6/14,6/15,6/26,6/28,6/30, -# 7/8,7/9,7/10,7/12,7/17,7/19,9/21,10/7,10/8,10/9,10/11 Gerd Kortemeyer +# 7/8,7/9,7/10,7/12,7/17,7/19,9/21, +# 10/7,10/8,10/9,10/11,10/13,10/15,11/4,11/16, +# 12/7,12/15 Gerd Kortemeyer # based on "Perl Cookbook" ISBN 1-56592-243-3 # preforker - server who forks first # runs as a daemon @@ -16,6 +18,8 @@ use Symbol; use POSIX; use Crypt::IDEA; use LWP::UserAgent(); +use GDBM_File; +use Authen::Krb4; # ------------------------------------ Read httpd access.conf and get variables @@ -253,13 +257,34 @@ sub make_new_child { # ============================================================================= # do something with the connection # ----------------------------------------------------------------------------- - # see if we know client + # see if we know client and check for spoof IP by challenge my $caller=getpeername($client); my ($port,$iaddr)=unpack_sockaddr_in($caller); my $clientip=inet_ntoa($iaddr); my $clientrec=($hostid{$clientip} ne undef); &logthis("Connect from $clientip ($hostid{$clientip})"); + my $clientok; if ($clientrec) { + my $remotereq=<$client>; + $remotereq=~s/\W//g; + if ($remotereq eq 'init') { + my $challenge="$$".time; + print $client "$challenge\n"; + $remotereq=<$client>; + $remotereq=~s/\W//g; + if ($challenge eq $remotereq) { + $clientok=1; + print $client "ok\n"; + } else { + &logthis("$clientip did not reply challenge"); + } + } else { + &logthis("$clientip failed to initialize: >$remotereq<"); + } + } else { + &logthis("Unknown client $clientip"); + } + if ($clientok) { # ---------------- New known client connecting, could mean machine online again &reconlonc("$perlvar{'lonSockDir'}/$hostid{$clientip}"); # ------------------------------------------------------------ Process requests @@ -324,7 +349,22 @@ sub make_new_child { my $pf = IO::File->new($passfilename); my $realpasswd=<$pf>; chomp($realpasswd); - if ($realpasswd eq $upass ) { + my ($howpwd,$contentpwd)=split(/:/,$realpasswd); + my $pwdcorrect=0; + if ($howpwd eq 'internal') { + $pwdcorrect= + (crypt($upass,$contentpwd) eq $contentpwd); + } elsif ($howpwd eq 'unix') { + $contentpwd=(getpwnam($uname))[1]; + $pwdcorrect= + (crypt($upass,$contentpwd) eq $contentpwd); + } elsif ($howpwd eq 'krb4') { + $pwdcorrect=( + Authen::Krb4::get_pw_in_tkt($uname,"", + $contentpwd,'krbtgt',$contentpwd,1, + $upass) == 0); + } + if ($pwdcorrect) { print $client "authorized\n"; } else { print $client "non_authorized\n"; @@ -348,12 +388,20 @@ sub make_new_child { { my $pf = IO::File->new($passfilename); $realpasswd=<$pf>; } chomp($realpasswd); - if ($realpasswd eq $upass ) { + my ($howpwd,$contentpwd)=split(/:/,$realpasswd); + if ($howpwd eq 'internal') { + if (crypt($upass,$contentpwd) eq $contentpwd) { + my $salt=time; + $salt=substr($salt,6,2); + my $ncpass=crypt($npass,$salt); { my $pf = IO::File->new(">$passfilename"); - print $pf "$npass\n";; } + print $pf "internal:$ncpass\n";; } print $client "ok\n"; - } else { + } else { print $client "non_authorized\n"; + } + } else { + print $client "auth_mode_error\n"; } } else { print $client "unknown_user\n"; @@ -447,9 +495,10 @@ sub make_new_child { } # ------------------------------------------------------------------------- put } elsif ($userinput =~ /^put/) { - my ($cmd,$udom,$uname,$namespace,$what) + my ($cmd,$udom,$uname,$namespace,$what) =split(/:/,$userinput); - $namespace=~s/\W//g; + $namespace=~s/\W//g; + if ($namespace ne 'roles') { chomp($what); my $proname=propath($udom,$uname); my $now=time; @@ -460,12 +509,12 @@ sub make_new_child { ) { print $hfh "P:$now:$what\n"; } } my @pairs=split(/\&/,$what); - if (dbmopen(%hash,"$proname/$namespace.db",0644)) { + if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) { foreach $pair (@pairs) { ($key,$value)=split(/=/,$pair); $hash{$key}=$value; } - if (dbmclose(%hash)) { + if (untie(%hash)) { print $client "ok\n"; } else { print $client "error:$!\n"; @@ -473,6 +522,43 @@ sub make_new_child { } else { print $client "error:$!\n"; } + } else { + print $client "refused\n"; + } +# -------------------------------------------------------------------- rolesput + } elsif ($userinput =~ /^rolesput/) { + if ($wasenc==1) { + my ($cmd,$exedom,$exeuser,$udom,$uname,$what) + =split(/:/,$userinput); + my $namespace='roles'; + chomp($what); + my $proname=propath($udom,$uname); + my $now=time; + { + my $hfh; + if ( + $hfh=IO::File->new(">>$proname/$namespace.hist") + ) { + print $hfh "P:$now:$exedom:$exeuser:$what\n"; + } + } + my @pairs=split(/\&/,$what); + if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) { + foreach $pair (@pairs) { + ($key,$value)=split(/=/,$pair); + $hash{$key}=$value; + } + if (untie(%hash)) { + print $client "ok\n"; + } else { + print $client "error:$!\n"; + } + } else { + print $client "error:$!\n"; + } + } else { + print $client "refused\n"; + } # ------------------------------------------------------------------------- get } elsif ($userinput =~ /^get/) { my ($cmd,$udom,$uname,$namespace,$what) @@ -482,11 +568,11 @@ sub make_new_child { my @queries=split(/\&/,$what); my $proname=propath($udom,$uname); my $qresult=''; - if (dbmopen(%hash,"$proname/$namespace.db",0644)) { + if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) { for ($i=0;$i<=$#queries;$i++) { $qresult.="$hash{$queries[$i]}&"; } - if (dbmclose(%hash)) { + if (untie(%hash)) { $qresult=~s/\&$//; print $client "$qresult\n"; } else { @@ -504,11 +590,11 @@ sub make_new_child { my @queries=split(/\&/,$what); my $proname=propath($udom,$uname); my $qresult=''; - if (dbmopen(%hash,"$proname/$namespace.db",0644)) { + if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) { for ($i=0;$i<=$#queries;$i++) { $qresult.="$hash{$queries[$i]}&"; } - if (dbmclose(%hash)) { + if (untie(%hash)) { $qresult=~s/\&$//; if ($cipher) { my $cmdlength=length($qresult); @@ -545,11 +631,11 @@ sub make_new_child { ) { print $hfh "D:$now:$what\n"; } } my @keys=split(/\&/,$what); - if (dbmopen(%hash,"$proname/$namespace.db",0644)) { + if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) { foreach $key (@keys) { delete($hash{$key}); } - if (dbmclose(%hash)) { + if (untie(%hash)) { print $client "ok\n"; } else { print $client "error:$!\n"; @@ -565,11 +651,11 @@ sub make_new_child { chomp($namespace); my $proname=propath($udom,$uname); my $qresult=''; - if (dbmopen(%hash,"$proname/$namespace.db",0644)) { + if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) { foreach $key (keys %hash) { $qresult.="$key&"; } - if (dbmclose(%hash)) { + if (untie(%hash)) { $qresult=~s/\&$//; print $client "$qresult\n"; } else { @@ -586,11 +672,11 @@ sub make_new_child { chomp($namespace); my $proname=propath($udom,$uname); my $qresult=''; - if (dbmopen(%hash,"$proname/$namespace.db",0644)) { + if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) { foreach $key (keys %hash) { $qresult.="$key=$hash{$key}&"; } - if (dbmclose(%hash)) { + if (untie(%hash)) { $qresult=~s/\&$//; print $client "$qresult\n"; } else { @@ -613,12 +699,12 @@ sub make_new_child { ) { print $hfh "P:$now:$what\n"; } } my @pairs=split(/\&/,$what); - if (dbmopen(%hash,"$proname.db",0644)) { + if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_WRCREAT,0640)) { foreach $pair (@pairs) { ($key,$value)=split(/=/,$pair); $hash{$key}=$value; } - if (dbmclose(%hash)) { + if (untie(%hash)) { print $client "ok\n"; } else { print $client "error:$!\n"; @@ -634,11 +720,11 @@ sub make_new_child { my $proname="$perlvar{'lonUsersDir'}/$udom/ids"; my @queries=split(/\&/,$what); my $qresult=''; - if (dbmopen(%hash,"$proname.db",0644)) { + if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_WRCREAT,0640)) { for ($i=0;$i<=$#queries;$i++) { $qresult.="$hash{$queries[$i]}&"; } - if (dbmclose(%hash)) { + if (untie(%hash)) { $qresult=~s/\&$//; print $client "$qresult\n"; } else { @@ -647,6 +733,20 @@ sub make_new_child { } else { print $client "error:$!\n"; } +# -------------------------------------------------------------------------- ls + } elsif ($userinput =~ /^ls/) { + my ($cmd,$ulsdir)=split(/:/,$userinput); + my $ulsout=''; + my $ulsfn; + if (-e $ulsdir) { + while ($ulsfn=<$ulsdir/*>) { + my @ulsstats=stat($ulsfn); + $ulsout.=$ulsfn.'&'.join('&',@ulsstats).':'; + } + } else { + $ulsout='no_such_dir'; + } + print $client "$ulsout\n"; # ------------------------------------------------------------- unknown command } else { # unknown command @@ -656,7 +756,7 @@ sub make_new_child { } } else { print $client "refused\n"; - &logthis("Unknown client $clientip, closing connection"); + &logthis("Rejected client $clientip, closing connection"); } &logthis("Disconnect from $clientip ($hostid{$clientip})"); # =============================================================================