version 1.4, 1999/11/04 20:53:04
|
version 1.6, 1999/12/15 22:01:14
|
Line 3
|
Line 3
|
# lond "LON Daemon" Server (port "LOND" 5663) |
# 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, |
# 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, |
# 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 Gerd Kortemeyer |
# 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 |
# based on "Perl Cookbook" ISBN 1-56592-243-3 |
# preforker - server who forks first |
# preforker - server who forks first |
# runs as a daemon |
# runs as a daemon |
Line 494 sub make_new_child {
|
Line 495 sub make_new_child {
|
} |
} |
# ------------------------------------------------------------------------- put |
# ------------------------------------------------------------------------- put |
} elsif ($userinput =~ /^put/) { |
} elsif ($userinput =~ /^put/) { |
my ($cmd,$udom,$uname,$namespace,$what) |
my ($cmd,$udom,$uname,$namespace,$what) |
=split(/:/,$userinput); |
=split(/:/,$userinput); |
$namespace=~s/\W//g; |
$namespace=~s/\W//g; |
|
if ($namespace ne 'roles') { |
chomp($what); |
chomp($what); |
my $proname=propath($udom,$uname); |
my $proname=propath($udom,$uname); |
my $now=time; |
my $now=time; |
Line 520 sub make_new_child {
|
Line 522 sub make_new_child {
|
} else { |
} else { |
print $client "error:$!\n"; |
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 |
# ------------------------------------------------------------------------- get |
} elsif ($userinput =~ /^get/) { |
} elsif ($userinput =~ /^get/) { |
my ($cmd,$udom,$uname,$namespace,$what) |
my ($cmd,$udom,$uname,$namespace,$what) |
Line 694 sub make_new_child {
|
Line 733 sub make_new_child {
|
} else { |
} else { |
print $client "error:$!\n"; |
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 |
# ------------------------------------------------------------- unknown command |
} else { |
} else { |
# unknown command |
# unknown command |