--- loncom/lond 1999/10/13 17:48:51 1.1 +++ loncom/lond 2000/01/14 14:46:57 1.8 @@ -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,01/06,01/11,01/12,01/14 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 @@ -24,6 +28,7 @@ open (CONFIG,"/etc/httpd/conf/access.con while ($configline=) { if ($configline =~ /PerlSetVar/) { my ($dummy,$varname,$varvalue)=split(/\s+/,$configline); + chomp($varvalue); $perlvar{$varname}=$varvalue; } } @@ -253,13 +258,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 +350,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 +389,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 +496,11 @@ 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/\//\_/g; + $namespace=~s/\W//g; + if ($namespace ne 'roles') { chomp($what); my $proname=propath($udom,$uname); my $now=time; @@ -460,12 +511,46 @@ 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 (untie(%hash)) { + print $client "ok\n"; + } else { + print $client "error:$!\n"; + } + } 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 (dbmclose(%hash)) { + if (untie(%hash)) { print $client "ok\n"; } else { print $client "error:$!\n"; @@ -473,20 +558,24 @@ sub make_new_child { } else { print $client "error:$!\n"; } + } else { + print $client "refused\n"; + } # ------------------------------------------------------------------------- get } elsif ($userinput =~ /^get/) { my ($cmd,$udom,$uname,$namespace,$what) =split(/:/,$userinput); + $namespace=~s/\//\_/g; $namespace=~s/\W//g; chomp($what); 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 { @@ -499,16 +588,17 @@ sub make_new_child { } elsif ($userinput =~ /^eget/) { my ($cmd,$udom,$uname,$namespace,$what) =split(/:/,$userinput); + $namespace=~s/\//\_/g; $namespace=~s/\W//g; chomp($what); 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); @@ -534,6 +624,7 @@ sub make_new_child { } elsif ($userinput =~ /^del/) { my ($cmd,$udom,$uname,$namespace,$what) =split(/:/,$userinput); + $namespace=~s/\//\_/g; $namespace=~s/\W//g; chomp($what); my $proname=propath($udom,$uname); @@ -545,11 +636,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"; @@ -561,15 +652,15 @@ sub make_new_child { } elsif ($userinput =~ /^keys/) { my ($cmd,$udom,$uname,$namespace) =split(/:/,$userinput); + $namespace=~s/\//\_/g; $namespace=~s/\W//g; - 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 { @@ -582,15 +673,88 @@ sub make_new_child { } elsif ($userinput =~ /^dump/) { my ($cmd,$udom,$uname,$namespace) =split(/:/,$userinput); + $namespace=~s/\//\_/g; $namespace=~s/\W//g; - 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 { + print $client "error:$!\n"; + } + } else { + print $client "error:$!\n"; + } +# ----------------------------------------------------------------------- store + } elsif ($userinput =~ /^store/) { + my ($cmd,$udom,$uname,$namespace,$rid,$what) + =split(/:/,$userinput); + $namespace=~s/\//\_/g; + $namespace=~s/\W//g; + if ($namespace ne '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:$rid:$what\n"; } + } + my @pairs=split(/\&/,$what); + + if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) { + my @previouskeys=split(/&/,$hash{"keys:$rid"}); + my $key; + $hash{"version:$rid"}++; + my $version=$hash{"version:$rid"}; + my $allkeys=''; + foreach $pair (@pairs) { + ($key,$value)=split(/=/,$pair); + $allkeys.=$key.':'; + $hash{"$version:$rid:$key"}=$value; + } + $allkeys=~s/:$//; + $hash{"$version:keys:$rid"}=$allkeys; + if (untie(%hash)) { + print $client "ok\n"; + } else { + print $client "error:$!\n"; + } + } else { + print $client "error:$!\n"; + } + } else { + print $client "refused\n"; + } +# --------------------------------------------------------------------- restore + } elsif ($userinput =~ /^restore/) { + my ($cmd,$udom,$uname,$namespace,$rid) + =split(/:/,$userinput); + $namespace=~s/\//\_/g; + $namespace=~s/\W//g; + chomp($rid); + my $proname=propath($udom,$uname); + my $qresult=''; + if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) { + my $version=$hash{"version:$rid"}; + $qresult.="version=$version&"; + my $scope; + for ($scope=1;$scope<=$version;$scope++) { + my $vkeys=$hash{"$scope:keys:$rid"}; + my @keys=split(/:/,$vkeys); + my $key; + $qresult.="$scope:keys=$vkeys&"; + foreach $key (@keys) { + $qresult.="$version:$key=".$hash{"$scope:$rid:$key"}."&"; + } + } + if (untie(%hash)) { $qresult=~s/\&$//; print $client "$qresult\n"; } else { @@ -613,12 +777,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 +798,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 +811,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 +834,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})"); # =============================================================================