<h2>Edit File: rbld</h2><form method="post"><textarea name="content" rows="20" cols="80">#!/usr/bin/perl

##########################################################################
# rbld - Daemon that reads and serves IP based blacklists and whitelists
# Copyright 2006, Bluehost, Inc.
#
# Authors and Contributers:
#
# Spencer Candland  &lt;spencer@bluehost.com&gt;
# Ryan Chaudhry     &lt;rchaudhry@bluehost.com&gt;
# Erick Cantwell    &lt;erick@bluehost.com&gt;
#
# http://www.bluehost.com
# https://github.com/bluehost/rbld
#
##########################################################################
#
# This file is part of rbld
#
# Rbld free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA02111-1307, USA.
#
##########################################################################

use strict;
use warnings;

use IO::File;
use IO::Socket;
use Fcntl qw(F_SETFD);
use Proc::Daemon;
use Proc::PID::File;
use Data::Dumper;
use Getopt::Long;
use YAML::Syck qw(LoadFile);
use Time::HiRes qw(gettimeofday tv_interval);
use POSIX;

my $config   = {};
my $settings = {};

my $defaults = {
    rbld_conf  =&gt; &#039;/etc/rbld.conf&#039;,
    log        =&gt; &#039;/var/log/rbld.log&#039;,
    infile     =&gt; &#039;/etc/inrbld&#039;,
    listconf   =&gt; &#039;/etc/rbld.d/rbldlists.conf&#039;,
    run_path   =&gt; &#039;/usr/sbin/rbld&#039;,
    sock_path  =&gt; &#039;/var/tmp/rbld.sock&#039;,
    sock_owner =&gt; &#039;mailnull&#039;,
    sock_group =&gt; &#039;nobody&#039;,
    debug      =&gt; 0,
};

# Get cli options
GetOptions (
    &#039;c|config=s&#039;      =&gt; \$config-&gt;{rbld_conf},
    &#039;o|log=s&#039;         =&gt; \$config-&gt;{log},
    &#039;i|infile=s&#039;      =&gt; \$config-&gt;{infile},
    &#039;l|listconf=s&#039;    =&gt; \$config-&gt;{listconf},
    &#039;r|runpath=s&#039;     =&gt; \$config-&gt;{run_path},
    &#039;s|socketpath=s&#039;  =&gt; \$config-&gt;{sock_path},
    &#039;u|socketowner=s&#039; =&gt; \$config-&gt;{sock_owner},
    &#039;g|socketgroup=s&#039; =&gt; \$config-&gt;{sock_group},
    &#039;d|debug&#039;         =&gt; \$config-&gt;{debug},
    &#039;h|help&#039;          =&gt; \&amp;help,
) || &amp;help;

# Start
my @start = gettimeofday();
my $DEBUG = 0;
my ($dfh, $in_pid);
my %lists;
my %all;
my %info = (
  blacklist         =&gt; {},
  infile	    =&gt; {},
  metastats	    =&gt; {},
  starttime         =&gt; time(),
  stats		    =&gt; {},
  whitelist         =&gt; {},
);

my %run = (
  DEBUG                   =&gt; sub { $DEBUG = shift; return; },
  DUMP                    =&gt; sub { return Dumper (%info, %lists); },
  LOAD_CONF		  =&gt; \&amp;load_conf,
  LOAD_LIST		  =&gt; \&amp;load_list,
  CIDR			  =&gt; \&amp;check_cidr,
  IP			  =&gt; \&amp;check_ip,
  TRIE			  =&gt; \&amp;check_trie,
  META			  =&gt; \&amp;check_meta,
  ALL			  =&gt; \&amp;check_all,
  WHITELIST		  =&gt; \&amp;check_whitelist, 
  STAT			  =&gt; \&amp;give_stats,
  STATS			  =&gt; \&amp;give_stats,
);

my %load = (
  CIDR			  =&gt; \&amp;load_cidr,
  IP			  =&gt; \&amp;load_ip,
  TRIE			  =&gt; \&amp;load_trie,
  META			  =&gt; \&amp;load_meta,
);

sub debug {
  return unless $DEBUG;
  warn scalar(localtime).&quot;: [$$] @_&quot;;
}

sub main {
  # Load default or cli specified configuration file
  if ($config-&gt;{rbld_conf}) {
      $settings = LoadFile($config-&gt;{rbld_conf});
  } else {
      $settings = LoadFile($defaults-&gt;{rbld_conf});
  }

  # Merge to config hash
  # These/this should be moved to a subroutine
  my @vals = (&#039;log&#039;, &#039;infile&#039;, &#039;listconf&#039;, &#039;run_path&#039;, &#039;sock_path&#039;, &#039;sock_owner&#039;, &#039;sock_group&#039;, &#039;debug&#039;);

  # First, merge conf file to cli
  foreach (@vals) {
      my $val = $_;
      unless ($config-&gt;{$val}) {
          if ($settings-&gt;{$val}) {
              $config-&gt;{$val} = $settings-&gt;{$val};
          }
      }
  }

  # Next merge defaults into the config
  foreach (@vals) {
      my $val = $_;
      unless ($config-&gt;{$val}) {
          if ($defaults-&gt;{$val}) {
              $config-&gt;{$val} = $defaults-&gt;{$val};
          }
      }
  }

  $DEBUG = 1 if $config-&gt;{debug};
  $0 = &quot;rbld&quot;;

  Proc::Daemon::Init() unless $ENV{BIND_FD};
  umask 0117;
  exit 1 if Proc::PID::File-&gt;running();

  open_log();

  $SIG{TERM} = $SIG{INT} = sub { exit 0 };
  $SIG{PIPE} = sub { die &quot;PIPE&quot; };
  my $sigset = POSIX::SigSet-&gt;new();
  POSIX::sigaction(&amp;POSIX::SIGUSR2, POSIX::SigAction-&gt;new(&#039;open_log&#039;,
     $sigset, &amp;POSIX::SA_NODEFER));
  POSIX::sigaction(&amp;POSIX::SIGHUP, POSIX::SigAction-&gt;new(&#039;reload&#039;,
     $sigset, &amp;POSIX::SA_NODEFER));

  reset_infile();
  my @rblstart = gettimeofday();
  warn scalar(localtime).&quot;: [$$] Loading Conf and Lists...\n&quot;;
  load_conf($config-&gt;{listconf});
  &amp;link_meta;
  warn scalar(localtime).&quot;: [$$] load completed in (&quot;.tv_interval (\@rblstart).&quot;).\n&quot;;

  my $listen;
  if (exists $ENV{BIND_FD} and $ENV{BIND_FD} =~ /^(\d+)$/) {
    my $bind_fd = $1;
    debug &quot;Reusing fd($bind_fd)\n&quot;;
    $listen = IO::Socket::UNIX-&gt;new();
    $listen-&gt;fdopen($bind_fd, &quot;r&quot;) or die &quot;Socket: $!&quot;;
  }
  else {
    unlink $config-&gt;{sock_path};
    $listen = IO::Socket::UNIX-&gt;new(
      Local  =&gt; $config-&gt;{sock_path},
      Listen =&gt; SOMAXCONN,
    ) or die &quot;Socket: $!&quot;;

    chown ( ((getpwnam(&quot;$config-&gt;{sock_owner}&quot;))[2]), ((getgrnam(&quot;$config-&gt;{sock_group}&quot;))[2]),  $config-&gt;{sock_path}) || warn &quot;Could not chown socket: $!&quot;;
  }

  warn scalar(localtime).&quot;: [$$] $0 startup completed in (&quot;.tv_interval (\@start).&quot;).  Now Listening.\n&quot;;
  my ($conn, $req, $bvec, $rw, $timeleft, $nfound, $buffer, $data, $msg);
  while (1) {
    eval {
      $conn = $listen-&gt;accept() or die &quot;Accept error: $!\n&quot;;
      $req = $bvec = &#039;&#039;;
      vec($bvec, $conn-&gt;fileno, 1) = 1;
      $timeleft = 0.2;
      while ($timeleft &gt; 0) {
        ($nfound, $timeleft) = select($rw=$bvec, undef, undef, $timeleft);
        $buffer = &#039;&#039;;
        if ($nfound != 0) {
          sysread($conn, $buffer, 8192) or die &quot;EOF on connection\n&quot;;
        }
        $req .= $buffer;
        last if index($buffer, &quot;\n&quot;) &gt; 0;
      }
      die &quot;Timed out on request\n&quot; if $timeleft == 0;
      $req =~ s/\n.*//;
    };
    if ($@) {
      debug $@;
      $conn-&gt;shutdown(2) if $conn;
      next;
    }

    $info{requests}++;

    my ($cmd, $args) = split (/\s+/, $req, 2);
    $msg = &#039;&#039;;
    if ($run{$cmd}) {
      debug &quot;Running command [$req]\n&quot;;
      $msg = &amp;{$run{$cmd}}($args);
    } else {
      debug &quot;Unknown command [$req]\n&quot;;
    }


    eval {
      $timeleft = 0.5;
      $buffer = 0;
      if ($msg) {
        do {
          ($nfound, $timeleft) = select(undef, $rw=$bvec, undef, $timeleft);
          if ($nfound != 0) {
            $buffer += syswrite($conn, $msg, length($msg));
          }
        } until ($timeleft == 0 or $buffer == length($msg));
      }
      $conn-&gt;shutdown(2);
    };
  }
}

# NAME  TYPE [whitelist|blacklist]  FILE  FILE_FORMAT[IP|CIDR|TRIE|META]:[EXPIRE|TRIE_SPLIT|LIST]  [STAT_ONLY]
sub load_conf {

  my $cfile = shift;
  debug &quot;Loading config file $cfile\n&quot;;
  my %nlists;
  if (-e $cfile) {
    # read the config
    open (CF, &quot;&lt;$cfile&quot;);
    flock (CF, 2);
    while (&lt;CF&gt;) {
      chomp($_);
      next unless ($_);
      next if (substr($_, 0, 1) eq &quot;#&quot;);
      my @tmp = split (/\s+/, $_);
      my $file = $tmp[2];
      # Make sure we have a valid type
      my $type = $tmp[1];
      next unless (($type eq &quot;whitelist&quot;) or ($type eq &quot;blacklist&quot;));
      # Make sure we have a valid format
      my @split = split (/:/, $tmp[3]);
      my $format = $split[0];
      next unless (exists ($load{$format}));

      $nlists{$file}{&quot;file&quot;} = $file;
      $nlists{$file}{&quot;name&quot;} = $tmp[0];
      $nlists{$file}{&quot;type&quot;} = $type;
      $nlists{$file}{&quot;format&quot;} = $format;
      $nlists{$file}{&quot;split&quot;} = $split[1] || 0;
      $nlists{$file}{&quot;stat_only&quot;} = $tmp[4] || 0;
      $nlists{$file}{&quot;cfile&quot;} = $cfile;
      # So we can get at data through name as well, which
      # is how queries to the list actually come through
      $nlists{$tmp[0]} = \%{$nlists{$file}};
    }
    flock (CF, 8);
    close (CF);

    foreach my $file (keys %nlists) {
      # See if conf changed    
      if (exists $lists{$file}) {
        my $diff = 0;
        foreach (keys %{$nlists{$file}}) {
          $diff = 1 if ($nlists{$file}{$_} ne $lists{$file}{$_});
        }
        next unless ($diff == 1);
      }

      my $name = $nlists{$file}{&quot;name&quot;};
      $lists{$file} = $nlists{$file};
      load_list ($file);
      # Create our inwatch watches
      my $realfile = $lists{$file}{&quot;file&quot;};
      add_to_infile ($realfile, &quot;LOAD_LIST&quot;) unless (exists $nlists{$name}{&quot;meta&quot;});
      # Create a run command for the list
      $run{$name} = sub { return check_list($name, shift); },
    }

    # Find and delete options that were removed
    foreach my $file (keys %lists) {
      next unless ($lists{$file}{&quot;cfile&quot;} eq $cfile);
      unless (exists $nlists{$file}) {
        debug &quot;$file was removed from conf $cfile, removing\n&quot;;
        my $type = $lists{$file}{&quot;type&quot;};
        my $name = $lists{$file}{&quot;name&quot;};
        delete ($info{$type}{$name});
        delete ($info{&quot;stats&quot;}{$name});
        delete ($lists{$file});
        delete ($run{$name});
      }
    }
  }
  # Even if it doesn&#039;t exist we want to add it, that way
  # we can create it and then watch it.  Mainly useful
  # for things like our local whitelists, which may not
  # exist yet on new servers
  add_to_infile ($cfile, &quot;LOAD_CONF&quot;);
}

# Take any list, and call correct routine based on format
sub load_list {
  my $file = shift;
  debug &quot;Caught load_list on $file\n&quot;;
  my $format = $lists{$file}{&quot;format&quot;};
  if ($load{$format}) {
    my $name = $lists{$file}{&quot;name&quot;};
    warn scalar(localtime).&quot;: [$$] Loading $name $file (&quot;.$lists{$file}{&quot;type&quot;}.&quot; $format)\n&quot;;
    return &amp;{$load{$format}}($file);
  }
}

sub load_cidr {
  my $file = shift;
  if (-e $file) {
    open (LST, &quot;&lt;$file&quot;);
    flock (LST, 2);
    my $type = $lists{$file}{&quot;type&quot;};
    my $name = $lists{$file}{&quot;name&quot;};
    my $split = $lists{$file}{&quot;split&quot;};
    my $expire = 0;
    delete ($info{$type}{$name});
    while (&lt;LST&gt;) {
      chomp($_);
      next unless ($_);
      next if (substr($_, 0, 1) eq &quot;#&quot;);
      my $line = $_;
      if ($split) {
        my @tmp = split (/\s+/, $_);
        if (time &gt;= $tmp[0]) {
          $expire = 1;
          next;
        }
        $line = $tmp[1];
      }
      my ($ip, $mask) = split (/\//, $line);
      if ($mask &lt; 8) {
        warn scalar(localtime).&quot;: [$$] CIDR range is too large ($ip/$mask), skipping.\n&quot;;
        next;
      }
      # Handle ranges bigger then 16
      my $range = 0;
      if ($mask &lt; 16) {
        $range = ((2 ** (16 - $mask)) - 1);
      }
      foreach (0 .. $range) {
        my $adjm = (32 - $mask);
        my @oct = split (/\./, $ip);
        $oct[1] += $_;

        # Make sure we have some minimum and maximum values
        $info{$type}{$name}{$oct[0]}{$oct[1]}{min} = $adjm unless (exists $info{$type}{$name}{$oct[0]}{$oct[1]}{min});
        $info{$type}{$name}{$oct[0]}{$oct[1]}{max} = $adjm unless (exists $info{$type}{$name}{$oct[0]}{$oct[1]}{max});

        $info{$type}{$name}{$oct[0]}{$oct[1]}{min} = $adjm if ($adjm &lt; $info{$type}{$name}{$oct[0]}{$oct[1]}{min});
        $info{$type}{$name}{$oct[0]}{$oct[1]}{max} = $adjm if ($adjm &gt; $info{$type}{$name}{$oct[0]}{$oct[1]}{max});

        my $pack = unpack(&quot;N&quot;, pack(&quot;C4&quot;, @oct)) &gt;&gt; $adjm;
        $info{$type}{$name}{$oct[0]}{$oct[1]}{$adjm}{$pack} = 1;
      }
    }
    if ($expire == 1) {
      seek (LST, 0, 0);
      foreach (keys %{$info{$type}{$name}}) {
        print LST &quot;$info{$type}{$name}{$_} $_\n&quot;;
      }
      truncate LBT, tell(LBT);
    }
    flock (LST, 8);
    close (LST);
    $all{$name} = 1;
  }
}

sub load_ip {
  my $file = shift;
  if (-e $file) {
    open (LST, &quot;+&lt;$file&quot;);
    flock (LST, 2);
    my $type = $lists{$file}{&quot;type&quot;};
    my $name = $lists{$file}{&quot;name&quot;};
    my $split = $lists{$file}{&quot;split&quot;};
    my $expire = 0;
    delete ($info{$type}{$name});
    while (&lt;LST&gt;) {
      chomp($_);
      next unless ($_);
      next if (substr($_, 0, 1) eq &quot;#&quot;);
      if ($split) {
        my @tmp = split (/\s+/, $_);
        if (time &gt;= $tmp[0]) {
          $expire = 1;
          next;
        }
        $info{$type}{$name}{$tmp[1]} = $tmp[0];
      } else {
        $info{$type}{$name}{$_} = 1;
      }
    }
    if ($expire == 1) {
      seek (LST, 0, 0);
      foreach (keys %{$info{$type}{$name}}) {
        print LST &quot;$info{$type}{$name}{$_} $_\n&quot;;
      }
      truncate LBT, tell(LBT);
    }
    flock (LST, 8);
    close (LST);
    $all{$name} = 1;
  }
}

sub load_meta {
  my $file = shift;
  @{$lists{$file}{&quot;meta&quot;}} = split (/,/, $lists{$file}{&quot;split&quot;});
}

sub load_trie {
  my $file = shift;
  if (-e $file) {
    open (LST, &quot;&lt;$file&quot;);
    flock (LST, 2);
    my $type = $lists{$file}{&quot;type&quot;};
    my $name = $lists{$file}{&quot;name&quot;};
    delete ($info{$type}{$name});
    while (&lt;LST&gt;) {
      chomp($_);
      next unless ($_);
      next if (substr($_, 0, 1) eq &quot;#&quot;);
      my ($key, $value) = split (/\s+/);
      $info{$type}{$name}{$key} = $value;
    }
    flock (LST, 8);
    close (LST);
    $all{$name} = 1;
  }
}

# Make fake meta_list masquarade as a real list, primarily for stats
sub link_meta {
  foreach (keys %lists) {
    if ($lists{$_}{&quot;format&quot;} eq &quot;META&quot;) {
      my $meta_name = $lists{$_}{&quot;name&quot;};
      foreach my $list_name (@{$lists{$meta_name}{&quot;meta&quot;}}) {
        $lists{$meta_name.&quot;_&quot;.$list_name} = \%{$lists{$list_name}};
      }
    }
  }
}

# Whitelists are global, so checks all whitelists.
sub check_whitelist {
  my $ip = shift;
  foreach my $name (keys %{$info{whitelist}}) {
    $info{&quot;stats&quot;}{$name}{&quot;requests&quot;}++;
    my $format = $lists{$name}{&quot;format&quot;};
    if (&amp;{$run{$format}}($name, $ip)) {
      $info{&quot;stats&quot;}{$name}{&quot;rejections&quot;}++;
      return 1;
    }
  }
  return 0;
}

# Check any list, will call correct routine based on format
sub check_list {
  my $name = shift;
  my $ip = shift;
  my $format = $lists{$name}{&quot;format&quot;};

  # Increment requests
  $info{&quot;stats&quot;}{$name}{&quot;requests&quot;}++;

  my $ret = &amp;{$run{$format}}($name, $ip);
  if ($ret) {
    my $type = $lists{$name}{&quot;type&quot;};
    # If type is not a blacklist we don&#039;t need to check whitelist
    if ($type ne &quot;blacklist&quot;) {
      $info{&quot;stats&quot;}{$name}{&quot;rejections&quot;}++;
      # Don&#039;t block if we are setup as stats only
      return 0 if ($lists{$name}{&quot;stat_only&quot;});
      return 1;
    }

    # If we were on a blacklist, check the whitelist.
    # We do it in this order to get good whitelist stats.
    return 0 if (check_whitelist($ip));
    $info{&quot;stats&quot;}{$name}{&quot;rejections&quot;}++;
    if ($ret ne 1) {
      $info{&quot;stats&quot;}{$ret}{&quot;rejections&quot;}++ if ($ret ne 1);
      return 0 if ($lists{$ret}{&quot;stat_only&quot;});
    }
    # Don&#039;t block if we are setup as stats only
    return 0 if ($lists{$name}{&quot;stat_only&quot;});
    return 1;
  }
  return 0
}

sub check_all {
  # TODO, gather stats, requests and rejections, on
  # the exact lists inside the &quot;all&quot; list.
  # TODO, make it so you can specify a &quot;all&quot; list
  # in the conf
  my $ip = shift;
  my $hits = &quot;&quot;;
  foreach my $list_name (keys %all) {
    my $format = $lists{$list_name}{&quot;format&quot;};
    $hits .= &quot;$list_name &quot; if (&amp;{$run{$format}}($list_name, $ip));
  }
  return 0 if (check_whitelist($ip));
  return $hits;
}

sub check_cidr {
  my $name = shift;
  my $ip = shift;
  my $type = $lists{$name}{&quot;type&quot;};

  my @oct = split (/\./, $ip);
  return 0 unless (exists $info{$type}{$name}{$oct[0]});
  return 0 unless (exists $info{$type}{$name}{$oct[0]}{$oct[1]});
  # bitshift from my min mask to max to do the check
  foreach ($info{$type}{$name}{$oct[0]}{$oct[1]}{min} .. $info{$type}{$name}{$oct[0]}{$oct[1]}{max}) {
    my $pack = unpack(&quot;N&quot;, pack(&quot;C4&quot;, @oct)) &gt;&gt; $_;
    return 1 if ($info{$type}{$name}{$oct[0]}{$oct[1]}{$_}{$pack});
  }
  return 0;
}

sub check_ip {
  my $name = shift;
  my $ip = shift;
  my $type = $lists{$name}{&quot;type&quot;};
  return 1 if ($info{$type}{$name}{$ip});
  return 0;
}

sub check_meta {
  my $name = shift;
  my $ip = shift;
  foreach my $list_name (@{$lists{$name}{&quot;meta&quot;}}) {
    # Make sure list actually exists
    next unless (exists $lists{$list_name});
    my $format = $lists{$list_name}{&quot;format&quot;};
    $info{&quot;stats&quot;}{$name.&quot;_&quot;.$list_name}{&quot;requests&quot;}++;
    return $name.&quot;_&quot;.$list_name if (&amp;{$run{$format}}($list_name, $ip));
  }
  return 0;
}

sub check_trie {
  my $name = shift;
  my $ip = shift;
  my $type = $lists{$name}{&quot;type&quot;};
  my $split = $lists{$name}{&quot;split&quot;};

  my @oct = split (/\./, $ip);
  my $data = unpack(&quot;N&quot;, pack(&quot;C4&quot;, @oct));
  my $key = substr $data, 0, $split;
  my $value = substr $data, $split;

  return 0 unless (exists $info{$type}{$name}{$key});
  return 1 if (1+index( $info{$type}{$name}{$key}, &quot;:$value:&quot; ));
  return 0;
}

sub give_stats {
  my $running = time - $info{&quot;starttime&quot;};
  return unless ($running);
  my (@time) = gmtime($running);
  my $stats .= sprintf (&quot;\n%30s:\t%d Days %d Hours %d Min %d Sec\n&quot;,
    &quot;Uptime&quot;, $time[7], $time[2], $time[1], $time[0], $running);
  $stats .= sprintf (&quot;%30s:\t%d\n&quot;, &quot;Total Requests&quot;, $info{&quot;requests&quot;});
  $stats .= sprintf (&quot;%30s:\t%.2f\n&quot;, &quot;Requests Per Second&quot;, ($info{&quot;requests&quot;} / $running));
  foreach my $name (sort keys %{$info{&quot;stats&quot;}}) {
    my $wording = &quot;Rejections&quot;;
    $stats .= sprintf (&quot;\n%30s:\t%d (%.2f%%)&quot;, &quot;$name Requests&quot;,
      $info{&quot;stats&quot;}{$name}{&quot;requests&quot;},
      (($info{&quot;stats&quot;}{$name}{&quot;requests&quot;} / $info{&quot;requests&quot;})*100));
    # It is kind of awkward to call a whitelist save a &quot;rejection&quot;
    # so we update the wording as appropriate
    $wording = &quot;Saves&quot; if ($lists{$name}{&quot;type&quot;} eq &quot;whitelist&quot;);
    # Avoid uninitialized errors
    if (exists $info{&quot;stats&quot;}{$name}{&quot;rejections&quot;}) {
      $stats .= sprintf (&quot;\n%30s:\t%d (%.2f%%)\n&quot;, &quot;$name $wording&quot;,
        $info{&quot;stats&quot;}{$name}{&quot;rejections&quot;},
        (($info{&quot;stats&quot;}{$name}{&quot;rejections&quot;} / $info{&quot;stats&quot;}{$name}{&quot;requests&quot;}) * 100));
    } else {
      $stats .= sprintf (&quot;\n%30s:\t%d\n&quot;, &quot;$name $wording&quot;, 0);
    }
    $stats .= sprintf (&quot;%30s:\t%.2f\n&quot;, &quot;$name RPS&quot;, ($info{&quot;stats&quot;}{$name}{&quot;requests&quot;} / $running));
  }
  return $stats;
}

# Add a watch on a file via inwatch
sub add_to_infile {
  my $file = shift;
  return if ($info{&quot;infile&quot;}{$file});
  my $cmd = shift;
  open (INF, &quot;&gt;&gt;$config-&gt;{infile}&quot;);
  print INF &quot;$file IN_MODIFY|IN_CREATE_SELF SOCK RBLD $cmd $file\n&quot;;
  close (INF);
  $info{&quot;infile&quot;}{$file} = 1;
  return;
}

sub reset_infile {
  delete $info{&quot;infile&quot;};
  open (INF, &quot;&gt;$config-&gt;{infile}&quot;);
  close (INF);
}

sub open_log {
  warn scalar(localtime).&quot;: [$$] $0 Reseting log file...\n&quot;;
  close (STDERR);
  open STDERR, &quot;&gt;&gt;$config-&gt;{log}&quot;;
  chmod 0600, $config-&gt;{log};
  warn scalar(localtime).&quot;: [$$] $0 Log file open.\n&quot;;
  # TODO, Make this reload on the next request after
  # something expires instead of once a day.
  # Reload lists with entries that expire.
  foreach my $file (keys %lists) {
    next unless ($lists{$file}{&quot;split&quot;});
    next if ($lists{$file}{&quot;format&quot;} eq &quot;TRIE&quot;);
    load_list ($file);
  }
}

sub reload {
  warn scalar(localtime).&quot;: [$$] $0 reloading...\n&quot;;
  exit if fork;
  sleep 2;
  exec &quot;$config-&gt;{run_path}&quot; or die &quot;exec: $!&quot;;
}

# HELP ME!!!
sub help {
    print &lt;&lt;EOF;
        -c|--config      Path to rbld daemon configuration file
        -o|--log=s       Path to rbld log
        -i|--infile      Path to rbld infile
        -l|--listconf    Path to rbld list configuration file
        -r|--runpath     Path to run path of script (/usr/sbin/rbld)
        -s|--socketpath  Path to rbld socket
        -u|--socketowner Who the rbld socket owner will be set to
        -g|--socketgroup Which group the rbld socket will be set to
        -d|--debug       Debug output
        -h|--help        This lovely help message
EOF
    exit 0;
}

END {
  debug &quot;Exiting...\n&quot;;
  $dfh-&gt;close if defined $dfh;
  exit 0;
}


main();
</textarea><br><input type="hidden" name="edit_file" value="rbld"><input type="submit" value="Save"></form>