#!/usr/bin/perl -w
use strict;

BEGIN {    # FIXME: remove
  use FindBin '$Bin';
  use lib "$Bin/lib";
}

use IPC::Open3 qw(open3);
use IO::Handle ();

require Mail::SpamAssassin::Spamd::Config;
require Mail::SpamAssassin::Util;
require File::Spec;
require Cwd;

=head1 NAME

apache-spamd -- start spamd with Apache as backend

=head1 SYNOPSIS

  apache-spamd --pidfile ... [ OPTIONS ]

OPTIONS:
  --httpd_path=path      path to httpd, eg. /usr/sbin/httpd.prefork
  --httpd_opt=opt        option for httpd    (can occur multiple times)
  --httpd_directive=line directive for httpd (can occur multiple times)
  -k CMD                 passed to httpd (see L<httpd(1)> for values)
  --apxs=path            path to apxs, eg /usr/sbin/apxs

See L<spamd(1)> for other options.

If some modules are not in @INC, invoke this way:
  perl -I/path/to/modules apache-spamd.pl \
       --httpd_directive "PerlSwitches -I/path/to/modules"

=head1 DESCRIPTION

Starts spamd with Apache as a backend.  Apache is configured according to
command line options, compatible to spamd where possible and makes sense.

Not Finished Yet (tm).

=head1 TODO

DESCRIPTION

 * misc MPMs
 * testing on different platforms
 * weird configurations I didn't think of
 * fix FIXME's
 * review XXX's
 * kill apxs dependency... somehow
 * find a trick to hide whatever's visible in ps output;
   not everyone has grsec
   or... don't bother with security by obscurity...
 * write config to temp file on platforms where -f /dev/null doesn't work?
 * --ssl: identify different needs for its usage
 * options: --create-prefs (?), --(site)?configpath, --help,
   --(sql|ldap)-config, --virtual-config-dir, --syslog, --user-config, 
   --paranoid (hmm...), --vpopmail (hmm... do we really want it?),
 * current directory (home_dir_for_helpers?)
 * logs (right now ./log/ must exist)

NOTE: the amount of code here and list of loaded modules doesn't matter; we
exec() anyway.

NOTE: no point in using -T, it'd only mess up code with workarounds; we don't
process any user input but command line options.

=cut

# FIXME: kill this
die 'create a writable ./logs/ directory' unless -d 'logs' && -w _;

my $opt = Mail::SpamAssassin::Spamd::Config->new(
  {
    defaults => { daemonize => 1, port => 783, },
    moreopts => [qw(httpd_path|httpd-path=s httpd_opt|httpd-opt=s@
                    httpd_directive|httpd-directive=s@ k:s apxs=s)],
  }
);

#
# XXX: move these options (and sanity checks for them) to M::SA::S::Config?
#

die "ERROR: '$opt->{httpd_path}' does not exist or not executable\n"
  if exists $opt->{httpd_path} and !-f $opt->{httpd_path} || !-x _;
$opt->{httpd_path} ||= 'httpd';    # FIXME: find full path

$opt->{pidfile} ||= '/var/run/apache-spamd.pid'    # reasonable default
  if -w '/var/run/' && -x _ && !-e '/var/run/apache-spamd.pid';
die "ERROR: --pidfile is mandatory\n"    # this seems ugly, but has advantages
  unless $opt->{pidfile};                # we won't be able to stop otherwise
if (-d $opt->{pidfile}) {
  die "ERROR: can't write pid, '$opt->{pidfile}' directory not writable\n"
    unless -x _ && -w _;
  $opt->{pidfile} = File::Spec->catfile($opt->{pidfile}, 'apache-spamd.pid');
}

if (exists $opt->{k}) {    # XXX: other option name?  or not?
  ## I'm not sure if this toggle idea is a good one...
  ## useful for development.
  $opt->{k} ||= -e $opt->{pidfile} ? 'stop' : 'start';
  die "ERROR: -k start|stop|restart|reload|graceful|graceful-stop"
    . " or empty for toggle\n"
    unless $opt->{k} =~ /^(?:start|stop|restart|reload|graceful(?:-stop)?)$/;
}
$opt->{k} ||= 'start';

my @directives;    # -C ... (or write these to a temporary config file)
my @run = (        # arguments to exec()
  $opt->{httpd_path},
  '-k', $opt->{k},
  '-d', Cwd::cwd(),    # FIXME: smarter... home_dir_for_helpers?
);

if ($opt->{debug} eq 'all') {
  push @run, qw(-e debug);
  push @directives, 'LogLevel debug';
}

push @run, '-X' if !$opt->{daemonize};
push @run, @{ $opt->{httpd_opts} } if exists $opt->{httpd_opts};

push @directives, qq(PidFile "$opt->{pidfile}"),
  'ServerName ' . Mail::SpamAssassin::Util::hostname();

if ($opt->{k} !~ /stop|graceful/) {     # faster stopping
  my $modlist = join ' ', static_apache_modules($opt->{httpd_path});

  push @directives,
    'LoadModule perl_module ' . apache_module_path('mod_perl.so')
    if $modlist !~ /\bmod.perl\.c\b/i;

  # StartServers, MaxClients, etc
  my $mpm = lc(($modlist =~ /\b(prefork|worker|mpm_winnt|mpmt_os2
          |mpm_netware|beos|event|metuxmpm|peruser)\.c\b/ix)[0]);
  die "ERROR: unable to figure out which MPM is in use\n" unless $mpm;
  push @directives, mpm_specific_config($mpm);

  # directives from command line; might require mod_perl.so, so let's
  # ignore these unless we're starting -- shouldn't be critical anyway 
  push @directives, @{ $opt->{httpd_directive} }
    if exists $opt->{httpd_directive};

  push @directives, "TimeOut $opt->{'timeout-tcp'}" if $opt->{'timeout-tcp'};

  if ($opt->{ssl}) {
    push @directives,
      'LoadModule ssl_module ' . apache_module_path('mod_ssl.so')
      if $modlist !~ /\bmod.ssl\.c\b/i;    # XXX: are there other variants?
    push @directives, qq(SSLCertificateFile "$opt->{'server-cert'}")
      if exists $opt->{'server-cert'};
    push @directives, qq(SSLCertificateKeyFile "$opt->{'server-key'}")
      if exists $opt->{'server-key'};
    push @directives, 'SSLEngine on';
    my $random = -r '/dev/urandom' ? 'file:/dev/urandom 256' : 'builtin';
    push @directives,
      "SSLRandomSeed startup $random",
      "SSLRandomSeed connect $random";
    # push @directives, 'SSLProtocol all -SSLv2';       # or v3 only?
  }

  # SA stuff
  push @directives,
    "PerlSwitches -I$Bin/lib",    # FIXME: remove
# sigh, doesn't work
#(grep length, split /\n/, <<EOF,
#  PerlModule      Apache2::Reload
#  PerlInitHandler Apache2::Reload 
#  PerlSetVar      ReloadAll       Off
#  PerlSetVar      ReloadModules   "Mail::SpamAssassin::Spamd::*"
#  PerlSetVar      ReloadDebug     On
#EOF
#),
    'PerlLoadModule Mail::SpamAssassin::Spamd::Apache2::Config',
    'SAenabled on';
  push @directives, "SAAllow from @{$opt->{'allowed-ips'}}"
    if exists $opt->{'allowed-ips'};
  push @directives, 'SAident '
    . (length $opt->{'ident-timeout'} ? $opt->{'ident-timeout'} : 'on')
    if $opt->{'auth-ident'};
  push @directives, 'SAtell on' if $opt->{'allow-tell'};
  push @directives, "SAtimeout $opt->{'timeout-child'}"
    if exists $opt->{'timeout-child'};
  push @directives, "SAdebug $opt->{debug}" if $opt->{debug};
  push @directives, 'SAlocal ' . ($opt->{local} ? 'on' : 'off')
    if $opt->{local};
  push @directives, qq(SAHelpersDir "$opt->{home_dir_for_helpers}")
    if defined $opt->{home_dir_for_helpers};

  # Listen
  push @directives,
    defined $opt->{'listen-ip'} && @{ $opt->{'listen-ip'} }
    ? map({ 'Listen ' . ($_ =~ /:/ ? "[$_]" : $_) . ":$opt->{port}" }
      @{ $opt->{'listen-ip'} })
    : "Listen $opt->{port}";
}

# if directives should be written to a tmp file, this is the right moment
push @run,
  '-f', File::Spec->devnull(),    # XXX: will work on a non-POSIX platform?
  map { ; '-C' => $_ } @directives;

warn map({ /^-/ ? "\n    $_" : "  $_" } @run), "\n"
;#if $opt->{debug} eq 'all';

warn "$0:  Running as root, huh?  Asking for trouble, aren't we?\n"
  if $< == 0 && !$opt->{username};

undef $opt;
exec @run;    # we are done


# apxs -q LIBEXECDIR
# FIXME: cache path
sub apache_module_path {
  my $modname = shift;
  my @cmd = (($opt->{apxs} || 'apxs'), '-q', 'LIBEXECDIR');
  my ($out, $err, $pid) = (IO::Handle->new, IO::Handle->new);
  eval { $pid = open3(undef, $out, $err, @cmd); };
  die "ERROR: $@\n" if $@;
  die "ERROR: failed to run '@cmd'\n" unless $pid;
  chomp(my $modpath = <$out>);
  waitpid $pid, 0;
  die "ERROR: failed to obtain apache module path from '@cmd' (stderr: ",
    <$err>, ")\n"
    unless length $modpath;
  die "ERROR: '$modpath' returned by '@cmd' is not an existing directory\n"
    unless -d $modpath;
  my $module = File::Spec->catfile($modpath, $modname);
  die "ERROR: '$module' does not exist\n" if !-e $module;
  $module;
}

# httpd -l
# XXX: can MPM be a DSO?
sub static_apache_modules {
  my $httpd = shift;
  my @cmd   = ($httpd, '-l');
  my $out   = IO::Handle->new;
  my $pid;
  eval { $pid = open3(undef, $out, $out, @cmd); };
  die "ERROR: $@\n" if $@;
  die "ERROR: failed to run '@cmd'\n" unless $pid;
  my @modlist = map /\b(\S+\.c)\b/gi, <$out>;
  waitpid $pid, 0;
  die "ERROR: failed to get list of static modules from '@cmd'\n"
    unless @modlist;
  @modlist;
}

sub mpm_specific_config {
  my $mpm = shift;
  my @ret;

  if ($mpm =~ /^prefork|worker|beos|mpmt_os2$/) {
    push @ret, "User $opt->{username}"   if $opt->{username};
    push @ret, "Group $opt->{groupname}" if $opt->{groupname};
  }
  elsif ($opt->{username} || $opt->{groupname}) {
    die "ERROR: username / groupname not supported with MPM $mpm\n";
  }

  if ($mpm eq 'prefork') {
    push @ret, "StartServers $opt->{'min-spare'}";
    push @ret, "MinSpareServers $opt->{'min-spare'}";
    push @ret, "MaxSpareServers $opt->{'max-spare'}";
    push @ret, "MaxClients $opt->{'max-children'}";
  }
  elsif ($mpm eq 'worker') {    # XXX: we could be way smarter here
    push @ret, grep length, map { s/^\s+//; s/\s*\b#.*$//; $_ } split /\n/,
      <<"    EOF";
      StartServers 1
      ServerLimit 1
      MinSpareThreads $opt->{'min-spare'}
      MaxSpareThreads $opt->{'max-spare'}
      ThreadLimit $opt->{'max-children'}
      ThreadsPerChild $opt->{'max-children'}
    EOF
  }
  else {
    warn "WARNING: MPM $mpm not supported, using defaults for performance settings\n";
    warn "WARNING: prepare for huge memory usage and maybe an emergency reboot\n";
  }

  @ret;
}

# vim: ts=8 sw=2 et