daemon

#!/opt/perl5/perls/perl-5.14.2/bin/perl5.14.2

use Modern::Perl '2012';
use Socket;
use POE qw(
  Wheel::SocketFactory
  Wheel::ReadWrite
  Driver::SysRW
  Filter::Stream
);
use Log::Log4perl;
use bytes;
use Nohmad;
use Database;
use Data::Dumper;

#####
# MAIN
#####

local $|        = 0;    #flush after every write or print
our $debug      = 1;    #be very very noisy
our $serverport = 8888; #daemon port

#-------------------------------------------------------------------------------
#  Logger
#-------------------------------------------------------------------------------
my $log_conf = "log4perl.conf";
Log::Log4perl::init($log_conf);
my $logger = Log::Log4perl->get_logger();
$Log::Log4perl::JOIN_MSG_ARRAY_CHAR = " <*> ";

fork and exit unless $debug;

#Connected devices
my $devices = {};

POE::Session->create(
    inline_states => {
        _start => \&parent_start,
        _stop  => \&parent_stop,

        socket_birth => \&socket_birth,
        socket_death => \&socket_death,
    }
);

# $poe_kernel is exported from POE
$poe_kernel->run();

exit;

####################################

sub parent_start {
    my $heap = $_[HEAP];

    $logger->debug( "= L = Listener birth", "" );

    $heap->{listener} = POE::Wheel::SocketFactory->new(
        BindPort     => $serverport,
        Reuse        => 'yes',
        SuccessEvent => 'socket_birth',
        FailureEvent => 'socket_death',
    );
}

sub parent_stop {
    my $heap = $_[HEAP];
    delete $heap->{listener};
    delete $heap->{session};
    $logger->debug( "= L = Listener death", "" );
}

##########
# SOCKET #
##########

sub socket_birth {
    my ( $socket, $address, $port ) = @_[ ARG0, ARG1, ARG2 ];
    $address = inet_ntoa($address);

    $logger->debug( "= S = Socket birth", "" );

    POE::Session->create(
        inline_states => {
            _start => \&socket_success,
            _stop  => \&socket_death,

            #Remote enrolling request
            remote_enrol => \&remote_enrol,

            socket_input => \&socket_input,
            socket_death => \&socket_death,
        },
        args => [ $socket, $address, $port ],
    );

}

sub socket_death {
    my $heap = $_[HEAP];
    my ( $operation, $errnum, $errstr, $wheel_id ) = @_[ ARG0 .. ARG3 ];

    if ( defined $wheel_id ) {
        $logger->error(
            "Wheel $wheel_id generated $operation error $errnum: $errstr", "" );
    }

    if ( $heap->{socket_wheel} ) {
        $logger->debug( "= S = Socket death", "" );
        delete $heap->{socket_wheel};

        #Remove device from active sessions
        delete $devices->{ $heap->{imei} } if exists $heap->{imei};
    }
}

sub socket_success {
    my ( $heap, $connected_socket, $address, $port ) =
      @_[ HEAP, ARG0, ARG1, ARG2 ];

    $logger->debug( "= I = CONNECTION from $address : $port", "" );

    $heap->{socket_wheel} = POE::Wheel::ReadWrite->new(
        Handle => $connected_socket,
        Driver => POE::Driver::SysRW->new(),
        Filter => POE::Filter::Stream->new(),

        InputEvent => 'socket_input',
        ErrorEvent => 'socket_death',
    );
}

#===  FUNCTION  ================================================================
#         NAME: find_package_length
#      PURPOSE:
#   PARAMETERS: ????
#      RETURNS: ????
#  DESCRIPTION: ????
#       THROWS: no exceptions
#     COMMENTS: none
#     SEE ALSO: n/a
#===============================================================================
sub find_package_length {
    my ( $buf ) = @_;

    my ( $length, $pkg_id, $pkg_type ) = unpack("H2H2H2", $buf);
    print Dumper(unpack("H2H2H2", $buf));
    $length = (( hex $length ) + 1);
    say $length;

    if ( $pkg_type eq '21' ) {
        say 'Dreaded 21->', $length;
        my @l = unpack("H2H2H2H2v", $buf);
        print Dumper(unpack("H2H2H2H2v", $buf));

        $length += $l[4];
        say "New length:", $length;
        say "BufLen:", length($buf);

    }

    return $length;
} ## --- end sub find_package_length

#===  FUNCTION  ================================================================
#         NAME: post_package
#      PURPOSE:
#   PARAMETERS: ????
#      RETURNS: undef
#  DESCRIPTION: ????
#       THROWS: no exceptions
#     COMMENTS: none
#     SEE ALSO: n/a
#===============================================================================
sub post_package {
    my ( $kernel, $heap, $package, $sessionID ) = @_;

    my $reply = Nohmad::packet( $heap, $package, $devices, $sessionID );
    if ( ref $reply eq "ARRAY" && $reply->[0] eq "A" ) {
        # :TODO      :03/31/2012 11:35:11 AM:: admin_id=256, change it
        $kernel->post( $reply->[1], "remote_enrol", 1, $reply->[2], 256 );
    }
    elsif ( ref $reply eq "HASH" ) {
        my $package_content = Database::_assemble_package( $heap, $reply, "N" );
        $heap->{socket_wheel}->put($package_content);
    }
    return;
} ## --- end sub post_package

sub find_package {
#===  FUNCTION  ================================================================
#         NAME: find_package
#      PURPOSE: Verify completeness and assemble if necessary
#   PARAMETERS: $heap - POE heap
#               $buf - read chunk from socket
#      RETURNS: undef
#  DESCRIPTION: Assembly of packages
#       THROWS: no exceptions
#     COMMENTS: none
#     SEE ALSO: n/a
#===============================================================================
    my ( $kernel, $heap, $buf, $sessionID ) = @_;

    if ( exists $heap->{trailing} ) {
 # :TODO      :05/05/2012 11:35:38 PM:: $heap->{pkg} puudub?
        if ( length($buf) + length( $heap->{pkg} ) == $heap->{pkg_len} ) {

            $logger->debug(
                "PackageASS["
                  . join( ' ', unpack( "(H2)*", $heap->{pkg} . $buf ) ) . "]",
                $heap->{imei} || ''
            );
            post_package( $kernel, $heap, $heap->{pkg} . $buf, $sessionID );
            delete $heap->{trailing};
            delete $heap->{pkg};
            delete $heap->{pkg_len};

            return;
        }
 # :TODO      :05/05/2012 11:36:32 PM:: $heap->{pkg} puudub?
        elsif ( length($buf) + length( $heap->{pkg} ) > $heap->{pkg_len} )
        {
            my $missing_part =
              substr( $buf, 0, $heap->{pkg_len} - length( $heap->{pkg} ), '' );
            $logger->debug(
                "PackageASS["
                  . join( ' ', unpack( "(H2)*", $heap->{pkg} . $missing_part ) )
                  . "]",
                $heap->{imei} || ''
            );
            post_package( $kernel, $heap, $heap->{pkg} . $missing_part,
                $sessionID );

            delete $heap->{trailing};
            delete $heap->{pkg};
            delete $heap->{pkg_len};

            find_package( $kernel, $heap, $buf, $sessionID );
        }
        else {
            $heap->{pkg} .= $buf;

            return;
        }
    }
#-------------------------------------------------------------------------------
#  No pending data
#-------------------------------------------------------------------------------
    else {
        my $length = find_package_length( $buf );
        print "LENGTH:(buf, calc)", length( $buf ), "|", $length, "\n";
        if ( length($buf) == $length ) {
            $logger->debug(
                "PackageASS[" . join( ' ', unpack( "(H2)*", $buf ) ) . "]",
                $heap->{imei} || '' );
            post_package( $kernel, $heap, $buf, $sessionID );

            return;
        }
        else {
            $heap->{trailing} = 1;
            $heap->{pkg_len}  = $length;
            $heap->{pkg} = "";
            find_package( $kernel, $heap, $buf, $sessionID );
        }
    }
}

sub socket_input {
    my ( $kernel, $heap, $session, $buf ) = @_[ KERNEL, HEAP, SESSION, ARG0 ];
    #Package ID for sequence
    my ( $pkg_len, $pkg_id, $pkg_type ) = unpack( "H2" x 3, $buf );
    $heap->{package_id} = hex $pkg_id;
#    open FILE, ">", $heap->{package_id}. ".pkg";
#    binmode FILE;
#    print FILE $buf;
#    close FILE;

    $logger->debug(
        "PackageIN["
          . join( ' ', unpack( "(H2)*", $buf ) ) . "]",
            $heap->{imei} || '' );

    find_package( $kernel, $heap, $buf, $session->ID );

    if ( !$heap->{once} ) {
        $heap->{socket_wheel}->put( Nohmad::_update_date_time($heap) );
        $heap->{socket_wheel}->put( Nohmad::_update_locale($heap) );
    }
    $heap->{once} = 1;
}

sub remote_enrol {
    my ( $heap, $command, $finger_count, $admin_id ) =
      @_[ HEAP, ARG0, ARG1, ARG2 ];

    my $reply =
      Nohmad::_start_enrol( $command, $finger_count, $admin_id, 0, $heap );

    my $package_content = Database::_assemble_package( $heap, $reply, "Y" );

    if ( exists $heap->{pending_processes} ) {
        $heap->{blocked_payload} = $package_content;
    }
    else {
        $heap->{socket_wheel}->put( $package_content );
    }
}