Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
branch: master
Fetching contributors…

Cannot retrieve contributors at this time

137 lines (122 sloc) 2.395 kB
#!/usr/bin/perl
=pod
required modules
=cut
use IO::Socket;
use YAML qw/LoadFile DumpFile/;
use v5.14;
no strict;
=pod
set signal handlers
=cut
$SIG{HUP} = \&start;
$SIG{INT} = \&closeup;
$SIG{KILL} = \&closeup;
$SIG{ABRT} = \&closeup;
$SIG{TERM} = \&closeup;
$SIG{PWR} = \&closeup;
$SIG{CHLD} = 'IGNORE';
=pod
program loop
=cut
#[[func:start]]
logmsg("Starting System");
start();
#[[func:spawn]]
logmsg("Accepting Clients $conf->{host}\:8899");
spawn();
#[[func:cleanup]]
logmsg("System Shutting down");
cleanup();
sub start{
$conf = LoadFile("./srserver.yaml");
if($conf->{authtype} eq "upass"){
$auth = LoadFile("./auth.yaml");
$auther = sub {
print $client "auth:`:";
($user, $pass) = split /:/, <$client>;
if($auth->{$user} eq $pass){
return 1;
}else{
return 0;
}
};
}elsif($conf->{authtype} eq "key"){
$auth = LoadFile("./auth.yaml");
$auther = sub{
print $client "auth:`:";
$key = <$client>;
if($key ~~ @{$auth}){
return 1;
}else{
return 0;
}
};
}else{
$auther = sub {
return 1;
};
}
open LOGF, ">", $conf->{logfile};
#get searchers
$moddir = $conf->{moddir};
foreach $module (<$moddir/*.spm>){
do $module;
}
$mods = (keys(%providers));
our $sock = new IO::Socket::INET(
LocalHost => $conf->{host},
LocalPort => $conf->{port},
Proto => 'tcp',
Listen => 5,
Reuse => 1,
);
}
sub spawn{
while(my $client = $sock->accept()){
my $pid = fork();
if($pid == 1){
#[[func:proccess]]
proccess();
exit 0;
}
}
}
sub cleanup{
close($client) if $pid == 0;
exit;
}
sub process{
$acode = $auther->();
print $client "DENIED" && exit if($acode == 0);
print $client Dump($mods);
print $client '::::'."\n";
print $client "CONTINUE\n";
$buf = "";
while ($line = <$client>){
if($line !~ /::::/){
$buf .= $line;
}else{
$request = Load($buf);
$buf = "";
$ret = ();
given($request->{command}){
when ("search") {...}
when ("quit") {cleanup();}
when ("special") {...}
when ("display") {...}
when ("version") {...}
when ("specret") {
foreach (@{$conf->{mods}}){
$ret->{$_} .= $providers{$_}->{specialinfo};
}
when ("info") {...}
}
}
print $client dump($ret);
#process
}
}
}
sub logmsg { print "$$: @_ at ".localtime()."\n" }
__END__
Jump to Line
Something went wrong with that request. Please try again.