flamethrower 0.1.8-4 / usr / bin / flamethrowerd

#!/usr/bin/perl -w

eval 'exec /usr/bin/perl -w -S $0 ${1+"$@"}'
    if 0; # not running under some shell
#
#   "Flamethrower"
#
#   Copyright (C) 2003 Bald Guy Software 
#                      Brian Elliott Finley <brian@bgsw.net>
#
#   $Id: flamethrowerd 59 2006-04-18 23:05:44Z dannf $
#

$0 = "flamethrowerd";

use strict;
use File::stat;
use Getopt::Long;
use POSIX qw(setsid);

use lib "/usr/lib/flamethrower";
use Flamethrower;

use vars qw($config $ft_config $VERSION);

#
# Set some defaults
#
my $last_time       = 0;
my $conf_file       = '/etc/flamethrower/flamethrower.conf';
my $pid_file        = '/var/run/flamethrower-server.pid';
my $version_number  = "0.1.8";
my $program_name    = "flamethrowerd";
my $get_help        = "         Try \"$program_name -help\" for more options.";


#
# Command line options
#
# set version information
my $version_info = <<"EOF";
$program_name (part of Flamethrower) version $version_number

Copyright (C) 2003 Brian Elliott Finley <brian\@bgsw.net>
This is free software; see the source for copying conditions.  There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
EOF

# set help information
my $help_info = $version_info . <<"EOF";

Usage: $program_name [OPTION]... -server HOSTNAME -image IMAGENAME

Options: (options can be presented in any order)

 --help
    Display this output.

 --version
    Display version and copyright information.

 --config-file FILE
    Alternate config file location.  Defaults to: $conf_file.

 --pid-file FILE
    Name of pid file.  Defaults to: $pid_file.

Download, report bugs, and make suggestions at:
http://systemimager.org/support/
EOF

# interpret command line options
GetOptions( 
    "help"            => \my $help,
    "version"         => \my $version,
    "config-file=s"   => \$conf_file,
    "pid-file=s"      => \$pid_file,
) or die qq($help_info);

# if requested, print help information
if($help) {
    print qq($help_info);
    exit 0;
}

# if requested, print version and copyright information
if($version) {
    print qq($version_info);
    exit 0;
}

# Read the config file and update the directory
read_config_file($conf_file);

# Turn on in flamethrower.conf file to see debug output.
my $debug;
if ( lc $ft_config->debug() eq "on" ) {
    $debug = 1;
    print "Flamethrower debug output turned on\n" if($debug);
}

# Should we start up?
if ( $ft_config->start_flamethrower_daemon() ne "yes" ) {
    exit 0;
}

# Warn if specified interface doesn't exist.
my $interface = $ft_config->interface();
if (( ! -d "/proc/sys/net/ipv4/conf/$interface" ) and ( ! -d "/proc/sys/net/ipv6/conf/$interface" )) {
    print STDERR "\n\n";
    print STDERR "FATAL:  Interface $interface, as specified in your flamethrowerd.conf file,\n";
    print STDERR "        does not appear to be configured on this machine.\n";
    print STDERR "\n";
    exit 1;
}

my $file = "udp-sender";
unless( Flamethrower->which($file,$ENV{PATH}) ){
    print ("Couldn't find $file in path: $ENV{PATH}\n");
    print ("Please install udp-sender, then try again.\n");
    exit 1;
}

&daemonize;

while(1) {
    &main;
    sleep 2;
}

exit 0;


################################################################################
#
# BEGIN subroutines 
#

# Usage: my $cmd = build_udp_sender_cmd($module);
sub build_udp_sender_cmd {

    my $module = shift;

    ############################################################################
    #
    # Set vars for all options
    #
    ############################################################################
    
    ############################################################################
    #
    # Global settings
    #
    my $min_clients;
    if ( $ft_config->get("min_clients") ) {
        $min_clients = " --min-clients " . $ft_config->get("min_clients");
    }
    
    my $max_wait;
    if ( $ft_config->get("max_wait") ) {
        $max_wait = " --max-wait " . $ft_config->get("max_wait");
    }
    
    my $min_wait;
    if ( $ft_config->get("min_wait") ) {
        $min_wait = " --min-wait " . $ft_config->get("min_wait");
    }
    
    my $async;
    if ( $ft_config->get("async") ) {
        if ( lc ($ft_config->get("async")) eq "on" ) {
            $async = " --async";
        }
    }
    
    my $autostart;
    if ( $ft_config->get("autostart") ) {
        $autostart = " --autostart " . $ft_config->get("autostart");
    }
    
    my $blocksize;
    if ( $ft_config->get("blocksize") ) {
        $blocksize = " --blocksize " . $ft_config->get("blocksize");
    }
    
    my $broadcast;
    if ( $ft_config->get("broadcast") ) {
        if ( lc ($ft_config->get("broadcast")) eq "on" ) {
            $broadcast = " --broadcast";
        }
    }
    
    my $fec;
    if ( $ft_config->get("fec") ) {
        $fec = " --fec " . $ft_config->get("fec");
    }
    
    my $interface;
    if ( $ft_config->get("interface") ) {
        $interface = " --interface " . $ft_config->get("interface");
    }
    
    my $log;
    if ( $ft_config->get("log") ) {
        $log = " --log " . $ft_config->get("log") . ".$module";
    }
    
    my $max_bitrate;
    if ( $ft_config->get("max_bitrate") ) {
        $max_bitrate = " --max-bitrate " . $ft_config->get("max_bitrate");
    }
    
    my $full_duplex;
    if ( $ft_config->get("full_duplex") ) {
        if ( lc ($ft_config->get("full_duplex")) eq "on" ) {
            $full_duplex = " --full-duplex";
        }
    }
    
    my $mcast_addr;
    if ( $ft_config->get("mcast_addr") ) {
        $mcast_addr = " --mcast-addr " . $ft_config->get("mcast_addr");
    }
    
    my $mcast_all_addr;
    if ( $ft_config->get("mcast_all_addr") ) {
        $mcast_all_addr = " --mcast-all-addr " . $ft_config->get("mcast_all_addr");
    }
    
    my $min_slice_size;
    if ( $ft_config->get("min_slice_size") ) {
        $min_slice_size = " --min-slice-size " . $ft_config->get("min_slice_size");
    }
    
    my $slice_size;
    if ( $ft_config->get("slice_size") ) {
        $slice_size = " --slice-size " . $ft_config->get("slice_size");
    }
    
    my $pointopoint;
    if ( $ft_config->get("pointopoint") ) {
        if ( lc ($ft_config->get("pointopoint")) eq "on" ) {
            $pointopoint = " --pointopoint";
        }
    }
    
    my $rexmit_hello_interval;
    if ( $ft_config->get("rexmit_hello_interval") ) {
        $rexmit_hello_interval = " --rexmit-hello-interval " . $ft_config->get("rexmit_hello_interval");
    }
    
    my $ttl;
    if ( $ft_config->get("ttl") ) {
        $ttl = " --ttl " . $ft_config->get("ttl");
    }
    #
    ############################################################################
    
    
    ############################################################################
    #
    # Module specific overrides
    #
    my $dir;
    if ( $ft_config->get("${module}_dir") ) {
        $dir = $ft_config->get("${module}_dir");
    }
    
    my $portbase;
    if ( $ft_config->get("${module}_portbase") ) {
        $portbase = " --portbase " . $ft_config->get("${module}_portbase");
    }
    
    if ($ft_config->varlist("${module}_async")) {
        if ( $ft_config->get("${module}_async") ) {
            if ( lc ($ft_config->get("${module}_async")) eq "on" ) {
                $async = " --async";
            }
        }
    }

    if ($ft_config->varlist("${module}_ttl")) {
        if ( $ft_config->get("${module}_ttl") ) {
            $ttl = " --ttl " . $ft_config->get("${module}_ttl");
        }
    }

    if ($ft_config->varlist("${module}_mcast_all_addr")) {
        if ( $ft_config->get("${module}_mcast_all_addr") ) {
            $mcast_all_addr = " --mcast-all-addr " . $ft_config->get("${module}_mcast_all_addr");
        }
    }
    
    if ($ft_config->varlist("${module}_log")) {
        if ( $ft_config->get("${module}_log") ) {
            $log = " --log " . $ft_config->get("${module}_log");
        }
    }
    
    if ($ft_config->varlist("${module}_interface")) {
        if ( $ft_config->get("${module}_interface") ) {
            $interface = " --interface " . $ft_config->get("${module}_interface");
        }
    }
    #
    ############################################################################

    # Build command
    #
    # GNU tar opts explained:
    # -B, --read-full-records / reblock as we read (for reading 4.2BSD pipes)
    #
    # -S, --sparse / handle sparse files efficiently
    #
    my $cmd = qq(udp-sender --pipe 'tar -B -S -cpf - -C $dir .');
    #my $cmd = qq(udp-sender --pipe 'tar -czpf - -C $dir .');
    $cmd .= $portbase               if(defined $portbase);
    $cmd .= $min_clients            if(defined $min_clients);
    $cmd .= $max_wait               if(defined $max_wait);
    $cmd .= $min_wait               if(defined $min_wait);
    $cmd .= $async                  if(defined $async);
    $cmd .= $autostart              if(defined $autostart);
    $cmd .= $blocksize              if(defined $blocksize);
    $cmd .= $broadcast              if(defined $broadcast);
    $cmd .= $fec                    if(defined $fec);
    $cmd .= $interface              if(defined $interface);
    $cmd .= $log                    if(defined $log);
    $cmd .= $max_bitrate            if(defined $max_bitrate);
    $cmd .= $full_duplex            if(defined $full_duplex);
    $cmd .= $mcast_addr             if(defined $mcast_addr);
    $cmd .= $mcast_all_addr         if(defined $mcast_all_addr);
    $cmd .= $min_slice_size         if(defined $min_slice_size);
    $cmd .= $slice_size             if(defined $slice_size);
    $cmd .= $pointopoint            if(defined $pointopoint);
    $cmd .= $rexmit_hello_interval  if(defined $rexmit_hello_interval);
    $cmd .= $ttl                    if(defined $ttl);

    return $cmd;
}

# Usage: update_directory();
sub update_directory {

    print "update_directory()\n" if ($debug);

    # Create our directory directory, if necessary.
    my $dir = $ft_config->get("flamethrower_directory_dir");
    if ( ! -e $dir ) {
        mkdir("$dir", 0755) or die("Couldn't mkdir $dir!");
    }
    unlink <$dir/*>;

    # Make sure our state directory exists, if necessary, and clean it up.
    $dir = $ft_config->get("flamethrower_state_dir");
    if ( ! -e $dir ) {
        print "FATAL: Flamethrower state dir $dir doesn't exist!\n";
        print "Please create it and restart flamethrowerd!\n";
        exit 1;
    }
    unlink <$dir/*>;


    ############################################################################
    #
    # Get list of explicitly specified portbase numbers so we don't 
    # dynamically use one that already exists.
    #
    my %portbases = $ft_config->varlist('_portbase$');

    # Be sure to include the flamethrower_directory port.
    $_ = $ft_config->get("flamethrower_directory_portbase");
    $portbases{$_} = $_;

    #
    # Make the values the keys, so we can simply to an 
    # if (defined()) in the module loop below.
    #
    foreach my $portbase (values %portbases) {
        #
        # Test to be sure portbase is an even number.
        #
        $_ = $portbase / 2;
        if (m/\./) {
            print qq(FATAL: portbases must be even numbers!  Failed on "PORTBASE=$portbase"\n);
            print qq(Please check your config file.\n);
            exit 1;
        }
        $portbases{$portbase} = $portbase;
    }

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

    ############################################################################
    #
    # Create the Flamethrower "directory" (sourceable files) for each module.
    #
    my $flamethrower_directory_dir = $ft_config->get("flamethrower_directory_dir");
    my $modules = $ft_config->modules();
    foreach my $module ( @$modules ) {

        #
        # Put directory information that is useful to clients in
        # sourceable files.
        #
        my $file = $flamethrower_directory_dir . "/" . $module;
        open(FILE, ">$file") or die("Couldn't open $file for writing!");

            print FILE "MODULE=$module\n";
            
            # DIR
            if ( ! defined($ft_config->get("${module}_dir")) ) {
                die("Please set DIR in flamethrower.conf for [$module]!");
            }
            
            # PORTBASE
            my $portbase;
            if ($ft_config->varlist("${module}_portbase")) {
                
                # portbase is already set
                $portbase = $ft_config->get("${module}_portbase");

            } else {
            
                # Start with flamethrower_directory_portbase + 2.
                $portbase = $ft_config->get("flamethrower_directory_portbase") + 2;
            
                # If that port is already in use, increment by two until we
                # get a free one.
                while ( defined($portbases{$portbase}) ) {
                    $portbase += 2;
                }
            
                # Put it into module specific data structure
                $ft_config->set("${module}_portbase", $portbase);

                # Add our new portbase to the existing list.
                $portbases{$portbase} = $portbase;
            
            }
            print FILE "PORTBASE=$portbase\n";

            # ASYNC
            my $async;
            if ($ft_config->varlist("${module}_async")) {
                # async is already set
                $async = $ft_config->get("${module}_async");
            } else {
                # get it from global setting
                $async = $ft_config->get("async");

                # Put it into module specific data structure
                $ft_config->set("${module}_async", $async);

            }
            print FILE "ASYNC=$async\n" if ($async);

            # TTL
            my $ttl;
            if ($ft_config->varlist("${module}_ttl")) {
                # ttl is already set
                $ttl = $ft_config->get("${module}_ttl");
            } else {

                # May or may not be set
                # get it from global setting (if it exists)
                if ($ft_config->varlist("^ttl")) {
                    $ttl = $ft_config->get("ttl");

                    # Put it into module specific data structure
                    $ft_config->set("${module}_ttl", $ttl);
                }
            }
            print FILE "TTL=$ttl\n" if ($ttl);

            # MCAST_ALL_ADDR
            my $mcast_all_addr;
            if ($ft_config->varlist("${module}_mcast_all_addr")) {
                # mcast_all_addr is already set
                $mcast_all_addr = $ft_config->get("${module}_mcast_all_addr");
            } else {

                # May or may not be set
                # get it from global setting (if it exists)
                if ($ft_config->varlist("^mcast_all_addr")) {
                    $mcast_all_addr = $ft_config->get("mcast_all_addr");

                    # Put it into module specific data structure
                    $ft_config->set("${module}_mcast_all_addr", $mcast_all_addr);
                }
            }
            print FILE "MCAST_ALL_ADDR=$mcast_all_addr\n" if ($mcast_all_addr);

            # NOSYNC
            my $nosync;
            if ($ft_config->varlist("${module}_nosync")) {
                # nosync is already set
                $nosync = $ft_config->get("${module}_nosync");
            } else {

                # May or may not be set
                # get it from global setting (if it exists)
                if ($ft_config->varlist("^nosync")) {
                    $nosync = $ft_config->get("nosync");

                    # Put it into module specific data structure
                    $ft_config->set("${module}_nosync", $nosync);
                }
            }
            print FILE "NOSYNC=$nosync\n" if ($nosync);


        close(FILE);

    }
    #
    ############################################################################
}

# Usage: main();
sub main {
    print "main()\n" if($debug); 
    if(conf_file_updated($conf_file)) {
        read_config_file($conf_file);
    }
    my $dir = $ft_config->get("flamethrower_state_dir");
    my $modules = $ft_config->modules();
    foreach my $module ( @$modules ) {
        my $file = "${dir}/flamethrowerd.${module}.pid";
        unless(-e "$file") {
                        # In case this happens to get started *immediately* 
            sleep 1;    # after the cast() function does it's unlink, give 
                        # the child time to die.
            cast($module, $dir);
        }
    }
}

# Usage: record_pid($file, $pid);
sub record_pid {

    my $file = shift;
    my $pid = shift;

    print "record_pid($file, $pid)\n" if($debug);

    open(FILE, ">$file") or die("Couldn't open $file!");
        print FILE "$pid\n";
    close(FILE);
}

# Usage: cast($module, $state_dir);
sub cast {

    my $module = shift;
    my $state_dir = shift;

    my $parent_file = "${state_dir}/flamethrowerd.${module}.pid";
    my $child_file  = "${state_dir}/flamethrowerd.${module}.udp-sender.pid";

    my $file;
    my $parent_pid;
    my $child_pid;

    print "cast($module, $state_dir)\n" if($debug);
    
    # Fork and cast
    if ($parent_pid = fork) {
        record_pid($parent_file, $parent_pid);
    } elsif (defined $parent_pid) { # send the forked child off

        setsid or die "Can't start a new session: $!";

        print "casting $module\n" if($debug);

        my $cmd = build_udp_sender_cmd($module);
        print "cmd $cmd\n" if($debug);

        my $child_pid = open(SENDER, "$cmd|") or die "Couldn't fork: $cmd";
            record_pid($child_file, $child_pid);
            while(<SENDER>){
                print $_ if($debug);
            }
        close(SENDER);

        $file = $child_file;
        print "    unlinking $file\n" if($debug);
        unlink($file) or die("Couldn't remove $file!\n");

        $file = $parent_file;
        print "    unlinking $file\n" if($debug);
        unlink($file) or die("Couldn't remove $file!\n");

        exit 0;

    } else {
        die "Can't fork: $!\n";
    }
}

# Usage: read_config_file($file);
sub read_config_file {
    my $file = shift;
    Flamethrower->read_config($file) or die("Couldn't read $file!");
    &update_directory;
}

# Usage: if(conf_file_updated($conf_file)) {};
sub conf_file_updated {

    my $file = shift;

    my $st = stat($file);
    my $this_time = $st->ctime;

    if($this_time ne $last_time) {
        print "    $file updated\n" if($debug);
        $last_time = $this_time;
        return 1;
    }
    return undef;
}

# Usage: $SIG{CHLD} = \&REAPER;
sub REAPER {
    $SIG{CHLD} = \&REAPER;
    my $waitedpid = wait;
    print STDERR "    Process $waitedpid has exited.\n" if($debug);
}

# Usage: &daemonize;
sub daemonize {

    chdir '/'                  or die "Can't chdir to /: $!";
    #
    # Commenting out the line below allows the udp-senders to behave in the way
    # you would expect, by automatically starting according to the --min-client, 
    # --min-wait, and --max-wait parameters.
    #
    #open STDIN, '/dev/null'   or die "Can't read /dev/null: $!";
    open STDOUT, '>>/dev/null' or die "Can't write to /dev/null: $!" unless($debug);
    open STDERR, '>>/dev/null' or die "Can't write to /dev/null: $!" unless($debug);
    defined(my $pid = fork)    or die "Can't fork: $!";
    exit if $pid;
    setsid                     or die "Can't start a new session: $!";

    my $file = $pid_file;
    local *FILE;
    open(FILE,">$file") or die ("FATAL: Can't open file: $file\n");
        print FILE "$$\n";
    close(FILE);

    $SIG{CHLD} = \&REAPER;
}

#
# END subroutines
#
################################################################################