#!/usr/bin/perl -w
# mkservice---create service directory usable with daemontools.
# Chris K. Jester-Young <cky944@gmail.com>, March 2010.
#
# Copyright (c) 2010 Chris K. Jester-Young.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are
# met:
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
# IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
# WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
# DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT,
# INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
# (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
# SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
# STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING
# IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.

use strict;
use Fcntl;
use Getopt::Long qw(:config gnu_getopt);
use IO::File;

sub usage {
    die "usage: $0 -d dir [-lUTQ] [-u user] [-L user] [[-e name=val] ...] cmdline\n";
}

sub chown_by_name {
    my ($user, @files) = @_;
    my (undef, undef, $uid, $gid) = getpwnam $user
        or die "Can't find user $user\n";
    chown $uid, $gid, @files;
}

sub create_script {
    my ($file, $prefix, $cmd, $redir) = @_;
    $cmd = "$prefix$cmd" if $prefix;
    my $fh = IO::File->new($file, O_WRONLY | O_CREAT | O_EXCL, 0777)
        or die "Can't create script $file: $!\n";
    $fh->print("#!/bin/sh\n");
    $fh->print("exec 2>&1\n") if $redir;
    $fh->print("exec $cmd\n");
}

sub create_file {
    my ($file, $contents) = @_;
    my $fh = IO::File->new($file, O_WRONLY | O_CREAT | O_EXCL)
        or die "Can't create file $file: $!\n";
    $fh->print($contents);
}

my ($dir, $log, $user, $loguser, $envug, $tcps, $qmails, %env);
GetOptions('dir|d=s' => \$dir,         # the service directory to create
           'log|l!' => \$log,          # whether to create a log service
           'user|u=s' => \$user,       # the user to run the service as
           'loguser|L=s' => \$loguser, # the user to run the log service as
           'envuidgid|U!' => \$envug,  # whether to use envuidgid
           'tcpserver|T!' => \$tcps,   # whether log lines use tcpserver format
           'qmails|Q!' => \$qmails,    # whether log lines use qmail-send format
           'environ|e=s' => \%env)     # environment variables to set up
or usage();
@ARGV && defined $dir or usage();

# STEP 1: Create all the necessary directories. If logging is used, make
# the service directory sticky.
my $dirmode = $log ? 01777 : 0777;
mkdir $dir, $dirmode or die "Can't create service directory: $!\n";
if ($log) {
    mkdir "$dir/log" or die "Can't create logging service directory: $!\n";
    mkdir "$dir/log/main" or die "Can't create logging directory: $!\n";
    chown_by_name $loguser, "$dir/log/main"
        or die "Can't change ownership of logging directory: $!\n";
    if ($tcps || $qmails) {
        my $fh = IO::File->new("$dir/log/status", O_WRONLY | O_CREAT | O_EXCL)
            or die "Can't create status file: $!\n";
        chown_by_name $loguser, $fh
            or die "Can't change ownership of status file: $!\n";
    }
}
if (%env) {
    mkdir "$dir/env" or die "Can't create environment directory: $!\n";
}

# STEP 2: Create actual service scripts.
my $prefix = ($envug ? 'envuidgid' : 'setuidgid') . " $user " if $user;
my $cmd = "@ARGV";
$cmd = "envdir ./env $cmd" if %env;
create_script "$dir/run", $prefix, $cmd, 1;

if ($log) {
    my $prefix = "setuidgid $loguser " if $loguser;
    my $cmd = 'multilog t ./main';
    $cmd .= " '-*' '+* * status: *' =status" if $tcps;
    $cmd .= " '-*' '+* status: *' =status" if $qmails;
    create_script "$dir/log/run", $prefix, $cmd, 0;
}

# STEP 3: Populate environment directory if necessary
while (my ($k, $v) = each %env) {
    create_file "$dir/env/$k", "$v\n";
}
