#!/usr/bin/perl

use strict;
use warnings;
use DBI;
use IO::Socket qw(:DEFAULT :crlf);
use POSIX qw(WNOHANG setsid);
use Fcntl qw(:DEFAULT :flock);
use MLDBM 'DB_File';

#-----------------------------------
# socket parameters
use constant PORT => 7789;
use constant IPADDR => '192.168.3.231';
use constant PID_FILE => "/home/msfw/msfwsvr.pid";
use constant SOCK_LOCK => "/home/msfw/msfw.lock";

# the flow limit
use constant LIMIT => dddddddd;

# the child process number
use constant PREFORK_CHILD => 5;

# the max request numbers which each child can handle
use constant MAX_REQUEST => 500;

# some global vars
my $DONE = 0;    # used for signal switch
my %CHILDREN;    # keep the child id in this hash
my $CHILD_COUNT = 0; # the child count

# redefine SIG handler
$SIG{CHLD}=sub {while((my $child=waitpid(-1,WNOHANG))>0){delete $CHILD
+REN{$child};$CHILD_COUNT--}};
$SIG{TERM}=$SIG{INT}=sub {$DONE++};
$SIG{__DIE__}=\&log_die;
$SIG{__WARN__}=\&log_warn;

# running environment
my $rundir='/home/msfw/xyz';
my $domain='xyz';
my $db="$rundir/msfw.db";

# define log
# there are 3 logLevel:0,1,2; level 0 is fulllog; set logLevel >=3 to 
+disable log
my $logLevel = 0;  
my $log="msfwsvr.log";
my $err_log="msfwsvr.err";

#-----------------------------------


#-----------------------------------
if (-e PID_FILE)
{
    open (HD,PID_FILE) or die "$!";
    my $pid=<HD>;
    close HD;

    die "process is still run" if kill 0 => $pid;
    die "can't remove pid file" unless -w PID_FILE && unlink PID_FILE;
}

if (-e SOCK_LOCK)
{
    die "can't remove socket lock file" unless -w SOCK_LOCK && unlink 
+SOCK_LOCK;
    open (HDW,">",SOCK_LOCK) or die "$!";
    close HDW;
}else{
    open (HDW,">",SOCK_LOCK) or die "$!";
    close HDW;
}
    


open (HDW,">",PID_FILE) or die "$!";
my $pid=daemon();
print HDW $pid;
close HDW;

my %records;

my $listen_socket = IO::Socket::INET->new( 
                                           LocalAddr => IPADDR,
                                           LocalPort => PORT,
                                           Listen    => 1000,
                                           Proto     => 'tcp',
                                           Reuse     => 1,
                                           Timeout   => 30,
                                         );
die "can't create socket: $@" unless defined $listen_socket;

while(!$DONE)
{
    make_new_child() while $CHILD_COUNT < PREFORK_CHILD;
    sleep;
}

kill_children();

warn "msfwsvr exit normally";
exit 0;


#-----------------------------------
sub make_new_child
{
    my $child = fork();
    die "can't fork $!" unless defined $child;

    
    if ($child)
    {
        warn "launching child $child";
        $CHILDREN{$child} = 1;
        $CHILD_COUNT++;
    }else{
        handle($listen_socket);
        exit 0;
    }
}

sub lock_it
{
    open (SOCKLOCK,SOCK_LOCK) or die "open lock file fail: $!";
    flock (SOCKLOCK,LOCK_EX);
}

sub unlock_it
{
    flock (SOCKLOCK,LOCK_UN);
    close SOCKLOCK;
}

sub lock_tie
{
    open (HD,PID_FILE) or die "open lock file fail: $!";
    flock (HD,LOCK_EX);

    tie(%records, 'MLDBM', $db, O_CREAT|O_RDWR, 0644) 
        or die "Can't open DB_File $db : $!\n";
}

sub unlock_tie
{
    untie %records;

    flock (HD,LOCK_UN);
    close HD;
}

sub handle
{
    my $sock = shift;
    my $cycles = MAX_REQUEST;
    while ($cycles--)
    {
        lock_it();
        last unless my $c = $sock->accept;
        unlock_it();
        
        my $line = <$c>;
        close $c;
        
        do_real_thing($line);
    }
    close $sock;
}

sub do_real_thing
{
    my $line = shift;

    {
        local $/=CRLF;
        chomp $line;
    }

    return unless $line =~ /^(.*):(\d+):(get|put)$/;

    my ($mid,$size,$type) = split(/:/,$line);
    my $timestamp = time();

    lock_tie();

    my $entry = $records{$mid};                      # RIGHT
    $entry->{$timestamp} += $size;
    $records{$mid} = $entry;

    unlock_tie();

    write_log("current socket info:",$$,$timestamp,$mid,$entry->{$time
+stamp},
               scalar keys %{$entry}) if $logLevel == 0;

    my $sum;
    for my $time (keys %{$entry})
    {
        if ($time < $timestamp - 3600)
        {
            lock_tie();

            my $tmp = $records{$mid};
            delete $tmp->{$time};
            $records{$mid} = $tmp;
    
            unlock_tie();

            if ($logLevel == 0 or $logLevel == 1)
            {
                my $tmp = $records{$mid};
                unless (defined $tmp->{$time}){
                    write_log("delete old timestamp success:",$$,$mid,
+$time);
                }else{
                    write_log("can't delete old timestamp:",$$,$mid,$t
+ime);
                }
            }
        }else{
            $sum += $entry->{$time};
        }
    }

    if ($sum > LIMIT)
    {
        insertDB($mid,$sum);

        write_log("insert to db:",$$,$mid,$sum) 
            if $logLevel == 0 or $logLevel == 1 or $logLevel == 2;

        lock_tie();

        delete $records{$mid};

        unlock_tie();

        if ($logLevel == 0 or $logLevel == 1)
        {
            unless (defined $records{$mid})
            {
                write_log("clean item success:",$$,$mid);
            }else{
                write_log("can't clean item:",$$,$mid);
            }
        }
    }
}

sub kill_children
{
    local $SIG{TERM} = $SIG{INT} = 'DEFAULT';
    kill TERM => keys %CHILDREN;
    sleep while %CHILDREN;
}

sub daemon
{
    my $child = fork();
    die "can't fork" unless defined $child;
    exit 0 if $child;
    setsid();
    
    open (STDIN, "</dev/null");
    open (STDOUT, ">/dev/null");
    open (STDERR,">&STDOUT");

    chdir $rundir;
    umask(022);
    $ENV{PATH}='/bin:/usr/bin:/sbin:/usr/sbin';

    return $$;
}


sub insertDB
{

   # some codes for database here
}

sub write_log
{
    my $time=scalar localtime;
    open (HDW,">>",$log);
    flock (HDW,LOCK_EX);
    print HDW $time,"  ",join ' ',@_,"\n";
    flock (HDW,LOCK_UN);
    close HDW;
}

sub log_die
{
    my $time=scalar localtime;
    open (HDW,">>",$err_log);
    print HDW $time,"  ",@_;
    close HDW;
    die @_;
}

sub log_warn
{
    my $time=scalar localtime;
    open (HDW,">>",$err_log);
    print HDW $time,"  ",@_;
    close HDW;
}

#-----------------------------------
[download]