dwww 1.13.4 / config

#!/usr/bin/perl -w
# vim:ft=perl:cindent:ts=4:sts=4:et:sw
# config for dwww

use Debconf::Client::ConfModule qw(:all);
use strict;

version('2.0');
capb('backup');

my $cfgfile  = '/etc/dwww/dwww.conf';
my %dwwwcfg;

# Create directories we need, see bug #188267
&mkdir_p("/usr/lib/cgi-bin");
&mkdir_p("/var/www");


if ( -r $cfgfile )
{
    &ScanDwwwConfFile ( $cfgfile );

    foreach my $cfgvar (('docrootdir', 'cgidir', 'cgiuser', 'serverport', 'servername'))
    {
        my $val = $dwwwcfg{'DWWW_' . uc($cfgvar)};
        if ($val)
        {
            set("dwww/$cfgvar",  $val);
            fset("dwww/$cfgvar", 'seen', 'true');
        }
    }
}

if (not defined $dwwwcfg{'DWWW_SERVERNAME'})
{
    my $host=`hostname --fqdn`;
    chomp($host);
    set('dwww/servername', $host) if $host =~ /\w/;
}

my $state = 1;
while ($state > 0 && $state < 4)
{
    my @ret;
    if ($state == 1)
    {
        beginblock();
         input('medium', 'dwww/docrootdir');
         input('medium', 'dwww/cgidir');
         input('medium', 'dwww/cgiuser');
        endblock();
        @ret = go();

        # error handling
        my $dir = scalar get('dwww/docrootdir');
        while ( ($ret[0] == 0) and
                not (($dir =~ m|^/|) and (-d $dir))
              )
        {
            subst('dwww/nosuchdir', 'dir', $dir);
            fset('dwww/nosuchdir', 'seen', 'false');
            fset('dwww/docrootdir', 'seen', 'false');
            set('dwww/docrootdir', '/var/www');

            beginblock();
             input('high', 'dwww/nosuchdir');
             input('high', 'dwww/docrootdir');
            endblock();
            @ret = go();

            $dir = scalar get('dwww/docrootdir');
        }

        set('dwww/docrootdir', canondir($dir));


        $dir = scalar get('dwww/cgidir');
        while ( ($ret[0] == 0) and
                not (($dir =~ m|^/|) and (-d $dir))
              )
        {
            subst('dwww/nosuchdir', 'dir', $dir);
            fset('dwww/nosuchdir', 'seen', 'false');
            fset('dwww/cgidir', 'seen', 'false');
            set('dwww/cgidir', '/usr/lib/cgi-bin');

            beginblock();
             input('high', 'dwww/nosuchdir');
             input('high', 'dwww/cgidir');
            endblock();
            @ret = go();

            $dir = scalar get('dwww/cgidir');
        }

        set('dwww/cgidir', canondir($dir));


        my $usr = scalar get('dwww/cgiuser');
        while ( ($ret[0] == 0) and
                not (($usr =~  m/^\s*\d+\s*$/) or (defined getpwnam($usr)))
               )
        {
            subst('dwww/nosuchuser', 'user', $usr);
            fset('dwww/nosuchuser', 'seen', 'false');
            fset('dwww/cgiuser', 'seen', 'false');
            set('dwww/cgiuser', 'www-data');

            beginblock();
             input('high', 'dwww/nosuchuser');
             input('high', 'dwww/cgiuser');
            endblock();
            @ret = go();

            $usr = scalar get('dwww/cgiuser');
        }

    }

    elsif ($state == 2)
    {
        beginblock();
         input('medium', 'dwww/servername');
         input('medium', 'dwww/serverport');
        endblock();
        @ret = go();

        my $port = scalar get('dwww/serverport');
        while ( ($ret[0] == 0) and ($port !~ /^\s*\d+\s*$/))
        {
            subst('dwww/badport', 'port', $port);
            fset('dwww/badport', 'seen', 'false');
            fset('dwww/serverport', 'seen', 'false');
            set('dwww/serverport', '80');

            beginblock();
             input('high', 'dwww/badport');
             input('high', 'dwww/serverport');
            endblock();
            @ret = go();

            $port = scalar get('dwww/serverport');
        }
        $port =~ s/\s+//g;
        set('dwww/serverport', $port);
    }

    elsif ($state == 3) {
        if (-x '/usr/bin/index++'
                and not -s '/var/cache/dwww/dwww.swish++.index') {
            beginblock();
             input('low', 'dwww/index_docs');
            endblock();
            @ret = go();
        }
    }


    if ( @ret and $ret[0] == 30 ) {
        $state--;   # go back
    }
    else {
        $state++;   # go forward
    }
}



# SUBROUTINES

# Subroutine to Scan Dwww configuration file
# Configfile to parse is the argument to the subroutine
sub ScanDwwwConfFile($)
{
    my $filename = shift;
    $dwwwcfg{'DWWW_SERVERPORT'}  = 80;

    if ($filename && -r $filename)
    {
        open DWWWCONF, "<", $filename or die "Can't open $filename: $!\n";
        while (<DWWWCONF>) {
            chomp();
            # Note: the same regexp is used in Debian::Dwww:ConfigFile.
            next if /^\s*#/;
            if (m/^\s*([^=]+)\s*=\s*['"]?([^'"\s]+)['"]?\s*$/) {
                $dwwwcfg{$1} = $2
            }
        }
        close DWWWCONF or die "Can't close $filename: $!\n";
    }
}


sub canondir
{
    my $dir = $_[0];

    $dir =~ s|/+|/|g;
    $dir =~ s|/$||;
    return $dir;
}

# Check if $a exists in @_
sub exists_in
{
    my $a = lc (shift);

    foreach $b (@_)
    {
        return 1 if ($a cmp (lc $b)) == 0;
    }
    return 0;
}


# Same as `mkdir -p'
sub mkdir_p
{
    my $dir = shift;
    return if (-d $dir);
    my $p = "";
    foreach my $f (split "/", $dir)
    {
        $p .=  $f . "/";
        (-d $p) or (mkdir $p, 0755) or die "Can't create directory $p: $!\n";
    }
}