AC-DC

 view release on metacpan or  search on metacpan

lib/AC/ConfigFile/Simple.pm  view on Meta::CPAN

    $me->{_lastconf} = $now;

    eval {
	$me->_read();
        verbose("installed new config file");
        if( my $f = $me->{onreload} ){
            $f->();
        }
    };
    if(my $e = $@){
        problem("error reading new config file: $e");
        return;
    }

    return 1;
}

sub _read {
    my $me = shift;

    delete $me->{_pending};

lib/AC/DC/IO.pm  view on Meta::CPAN

# Created: 2009-Mar-27 10:36 (EDT)
# Function: async multiplexed io
#
# $Id$

# callbacks:
#  readable
#  writeable
#  write_buffer_empty
#  timeout
#  error	=> shut()
#  shutdown

package AC::DC::IO;

use AC::DC::Debug 'io';
use AC::DC::IO::TCP;
use AC::DC::IO::UDP;
use AC::DC::IO::Forked;
use AC::DC::Callback;
use AC::DC::Sched;

lib/AC/DC/IO.pm  view on Meta::CPAN

        substr($me->{_wbuffer}, 0, $i) = '';
        if( length($me->{_wbuffer}) ){
            $me->timeout_rel( $me->{writebuf_timeout} ) if $me->{writebuf_timeout};
        }else{
            $me->wantwrite(0);
            $me->run_callback('write_buffer_empty', undef);
        }
    }else{
        my $e = $!;
        debug( "write failed ($e) for $me->{info}");
        $me->run_callback('error', {
            cause	=> 'write',
            error	=> $e,
        });
        $me->shut();
    }
}

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

sub _readable {
    my $me = shift;

lib/AC/DC/IO/Forked.pm  view on Meta::CPAN

        kill 15, $me->{pid};
        my $v = waitpid $me->{pid}, WNOHANG;

        if( $v == 0 ){
            # but I'm not dead yet
            debug("not dead yet");

            for(1..3){
                sleep 1;
                my $v = waitpid $me->{pid}, WNOHANG;
                last if $v;	# error or dead
                kill 9, $me->{pid};
            }
        }

        $me->{exitval} = $?;
        delete $me->{pid};
    }

    $me->SUPER::shut();
}

sub _readable {
    my $me = shift;

    my $buf;
    my $bs = $me->{rbufsize} || $BUFSIZ;
    my $i = sysread($me->{fd}, $buf, $bs);

    unless( defined $i ){
        my $e = $!;
        debug("read error");
        $me->run_callback('error', {
            cause	=> 'read',
            error	=> $e,
        });
        $me->shut();
        return ;
    }
    unless( $i ){
        debug("read eof");
        $me->run_callback('read_eof', undef);
        $me->shut();
        return ;
    }

lib/AC/DC/IO/TCP.pm  view on Meta::CPAN

# -*- perl -*-

# Copyright (c) 2009 AdCopy
# Author: Jeff Weisberg
# Created: 2009-Mar-27 13:41 (EDT)
# Function: tcp
#
# $Id$

# callbacks:
#  error	=> shut()
#  read_eof	=> shut()
#  read


package AC::DC::IO::TCP;

use AC::DC::Debug 'tcp';
use AC::DC::IO::TCP::Server;
use AC::DC::IO::TCP::Client;

lib/AC/DC/IO/TCP.pm  view on Meta::CPAN

    my $me = shift;

    my $buf;
    my $bs = $me->{rbufsize} || $BUFSIZ;
    my $i = sysread($me->{fd}, $buf, $bs);

    # debug("tcp read $i bytes");

    unless( defined $i ){
        my $e = $!;
        debug("read error - $me->{info}");
        $me->run_callback('error', {
            cause	=> 'read',
            error	=> $e,
        });
        $me->shut();
        return ;
    }
    unless( $i ){
        debug("read eof - $me->{info}");
        $me->run_callback('read_eof', undef);
        $me->shut();
        return ;
    }

lib/AC/DC/IO/TCP/Client.pm  view on Meta::CPAN

# Copyright (c) 2009 AdCopy
# Author: Jeff Weisberg
# Created: 2009-Mar-27 15:11 (EDT)
# Function: tcp client
#
# $Id$

# callbacks:
#  connect
#  error	=> shut()

package AC::DC::IO::TCP::Client;
use AC::DC::Debug 'tcp_client';
use Socket;
use POSIX;
use strict;

our @ISA = 'AC::DC::IO::TCP';

sub new {

lib/AC/DC/IO/TCP/Client.pm  view on Meta::CPAN

}

sub start {
    my $me = shift;

    my $fd;
    my $i = socket($fd, PF_INET, SOCK_STREAM, 0);
    $me->SUPER::start($fd);
    unless( $i ){
        verbose("tcp client socket failed: $! ($me->{info})");
        $me->run_callback('error', { cause => 'socket', error => "socket failed: $!" });
        $me->shut();
        return ;
    }

    while(1){
        my $i = connect($fd, sockaddr_in($me->{tcp_server_port}, $me->{tcp_server_ip}) );
        last if $i;		# success
        next if $! == EINTR;	# signal, retry
        last if $! == EISCONN || $! == EALREADY || $! == EINPROGRESS;

        debug("tcp client connect failed: $! ($me->{info})");
        $me->run_callback('error', { cause => 'connect', error => "connect failed: $!" });
        $me->shut();
        return ;
    }

    $me->wantwrite(1);
    return $me;
}

sub _writable {
    my $me = shift;

    # socket will elect as writable once the connect completes
    unless( $me->{_connected} ){
        my $fd = $me->{fd};
        my $i = unpack('L', getsockopt($fd, SOL_SOCKET, SO_ERROR));
        if( $i ){
            my $e = $! = $i;
            debug("tcp client connect failed: $! ($me->{info})");
            $me->run_callback('error', { cause => 'connect', error => "connect failed: $e" });
            $me->shut();
            return;
        }

        debug("tcp client connected $me->{info}");
        $me->{_connected} = 1;
        $me->run_callback('connect', undef);
    }

    $me->SUPER::_writable(@_);

lib/AC/DC/Protocol.pm  view on Meta::CPAN

use Time::HiRes 'time';
use strict;

# header:
#	 proto version(32)
#	 message type(32)
#	 auth length(32)
#	 data length(32)
#	 content length(32)
#	 msgidno(32)
#	 flags(32):	is-reply(0), want-reply(1), is-error(2), data-encrypted(3), content-encrypted(4)
#
# followed by:
#       Auth PB(auth-length)
#	Data PB(data-length)
#       Content(content-length)


my $VERSION = 0x41433032;
my $BUFSIZ  = 65536;

lib/AC/DC/Protocol.pm  view on Meta::CPAN

    $MSGREV{$num}   = $name;

}

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

sub encode_header {
    my $me = shift;
    my %p = @_;
    # type, auth_length, data_length, content_length, msgidno,
    # is_reply, want_reply, is_error

    my $mt = $MSGTYPE{ $p{type} };
    confess "unknown message type $p{type}\n" unless defined $mt;

    my $flags = ( $p{is_reply}         ? 1 : 0 )
	     | ( $p{want_reply}        ? 2 : 0 )
	     | ( $p{is_error}          ? 4 : 0 )
             | ( $p{data_encrypted}    ? 8 : 0 )
             | ( $p{content_encrypted} ? 16 : 0 );

    return pack( "NNNNNNN",
		 $VERSION, $mt->{num}, $p{auth_length}, $p{data_length}, $p{content_length}, $p{msgidno}, $flags );

}

sub decode_header {
    my $me    = shift;

lib/AC/DC/Protocol.pm  view on Meta::CPAN

	content_length	=> $cl,
	msgidno		=> $id,
	type		=> $MSGREV{$mt},
    );

    confess "unknown protocol version $ver\n" unless $ver == $VERSION;
    confess "unknown protocol message $mt\n"  unless $p{type};

    $p{is_reply}   = ($fl & 1) ? 1 : 0;
    $p{want_reply} = ($fl & 2) ? 1 : 0;
    $p{is_error}   = ($fl & 4) ? 1 : 0;
    $p{data_encrypted} = ($fl & 8) ? 1 : 0;
    $p{content_encrypted} = ($fl & 16) ? 1 : 0;

    return \%p;
}

sub encrypt {
    my $me = shift;
    # NYI - placeholder
}

lib/AC/Daemon.pm  view on Meta::CPAN

use Time::HiRes;
use POSIX;
use strict;

BEGIN {
    # use it if we've got it
    eval {
        require AC::Error; AC::Error->import();
    };
    if($@){
        *daemon_error = sub {};
        *stack_trace  = sub {};
    }
}

our @EXPORT = qw(daemonize run_and_watch initlog debugmsg verbose problem fatal);

my $childpid;
my $verbose = 1;
my $nomail  = 0;
my $syslog;

lib/AC/Daemon.pm  view on Meta::CPAN

	}else{
	    fatal( "UNCAUGHT ERROR: $e" );
	}
    }
}

sub debugmsg {
    my $msg = shift;

    syslog( 'debug', '%s', $msg ) if $syslog;
    _to_stderr( $msg ) if $verbose;
}

sub verbose {
    my $msg = shift;

    syslog( 'info', '%s', $msg ) if $syslog;
    _to_stderr( $msg ) if $verbose;
}

sub problem {
    my $msg = shift;

    daemon_error( $msg ) unless $nomail;
    syslog( 'err', '%s', $msg ) if $syslog;
    _to_stderr( $msg );
}

sub fatal {
    my $msg = shift;

    daemon_error( $msg ) unless $nomail;
    syslog( 'err', '%s', $msg ) if $syslog;
    _to_stderr( $msg );
    exit -1;
}

sub _to_stderr {
    my $msg = shift;

    my $tx = Time::HiRes::time();
    my $f  = $tx - int($tx);
    $f = sprintf('%.6f', $f);
    $f =~ s/^0\.//;
    my $t = strftime '%H:%M:%S', localtime($tx);
    print STDERR "[$$ $t.$f] $msg\n";

}