#!/usr/bin/env perl # This script can be used as template for daemons using IOMux. # The code is more verbose than needed in the common case. # # Purpose: the daemon returns the text it receives. # You may run the test with # ls | netcat localhost 5422 || echo 'not running' use warnings; use strict; use Log::Report; use Any::Daemon; #use IOMux::Select; use IOMux::Poll; use IOMux::Service::TCP; use Getopt::Long qw/GetOptions :config no_ignore_case bundling/; use File::Basename qw/basename/; #use IO::Socket::SSL; # when SSL is used anywhere # ## get command-line options # my $mode = 0; # increase output my %os_opts = ( pid_file => basename($0). '.pid' # usually in /var/run , user => undef , group => undef ); my %run_opts = ( background => 1 , max_childs => 1 # all done in 1 task ); my %net_opts = ( host => 'localhost:5422' , port => undef ); GetOptions 'background|bg!' => \$run_opts{background} , 'group|g=s' => \$os_opts{group} , 'host|h=s' => \$net_opts{host} , 'pid-file|p=s' => \$os_opts{pid_file} , 'port|p=s' => \$net_opts{port} , 'user|u=s' => \$os_opts{user} , 'v+' => \$mode # -v -vv -vvv or exit 1; unless(defined $net_opts{port}) { my $port = $net_opts{port} = $1 if $net_opts{host} =~ s/\:([0-9]+)$//; defined $port or error "no port specified"; } # ## initialize the daemon activities # # From now on, all errors and warnings are also sent to syslog, # provided by Log::Report. Output still also to the screen. dispatcher SYSLOG => 'syslog', accept => 'INFO-' , identity => 'iomux', facility => 'local0'; dispatcher mode => $mode, 'ALL' if $mode; # close output to stderr/die/warn when in background dispatcher close => 'default' if $run_opts{background}; my $daemon = Any::Daemon->new(%os_opts); $daemon->run ( child_task => \&run_multiplexer , %run_opts ); exit 1; # will never be called sub run_multiplexer() { # my $mux = IOMux::Select->new; my $mux = IOMux::Poll->new; # Create one or more listening TCP or UDP sockets. my $addr = "$net_opts{host}:$net_opts{port}"; my $server = IOMux::Socket::TCP->new ( # Options which start with Caps are for IO::Socket::INET/::SSL # you may also pass a prepared socket. LocalAddr => $addr , Listen => 5 , Proto => 'tcp' #, use_ssl => 1 # for SSL socket # more options , name => 'echo' # improves error msgs , conn_type => 'IOMux::Echo' # required, see below ); $mux->add($server); $mux->loop(\&heartbeat); exit 0; } ##### HELPERS # When added to the loop, it will be called each time the select has # received something. sub heartbeat($$$) { my ($mux, $numready, $timeleft) = @_; # info "*$numready $timeleft\n"; } ##### PROTOCOL HANDLER # Simple echo service which puts back all data it received. # Usually in a seperate file. package IOMux::Echo; use base 'IOMux::Net::TCP'; use warnings; use strict; sub mux_input($) { my ($self, $input) = @_; $self->write($input); # write expects SCALAR $$input = ''; # all bytes processed } 1;