apache2.2-common 2.2.22-13+deb7u6 / usr / sbin / a2enmod

#!/usr/bin/perl -w
#
# a2enmod by Stefan Fritsch <sf@debian.org>
# Licensed under Apache License 2.0

use strict;
use Cwd 'realpath';
use File::Spec;
use File::Basename;
use Getopt::Long;

my $quiet;
my $force;
Getopt::Long::Configure('bundling');
GetOptions(
    'quiet|q' => \$quiet,
    'force|f' => \$force
) or exit 2;

my $basename = basename($0);
$basename =~ /^a2(en|dis)(mod|site)((?:-.+)?)$/
    or die "$basename call name unknown\n";
my $act        = $1;
my $obj        = $2;
my $dir_suffix = $3;

my $env_file = $ENV{APACHE_ENVVARS}
    || (
    $ENV{APACHE_CONFDIR}
    ? "$ENV{APACHE_CONFDIR}/envvars"
    : "/etc/apache2$dir_suffix/envvars"
    );
$ENV{LANG}='C';
read_env_file($env_file);

$act .= 'able';
my ( $name, $dir, $sffx, $reload );
if ( $obj eq 'mod' ) {
    $obj    = 'module';
    $dir    = 'mods';
    $sffx   = '.load';
    $reload = 'restart';
}
else {
    $dir    = 'sites';
    $sffx   = '';
    $reload = 'reload';
}
$name = ucfirst($obj);

my $confdir  = $ENV{APACHE_CONFDIR}                  || "/etc/apache2$dir_suffix";
my $availdir = $ENV{ uc("APACHE_${dir}_AVAILABLE") } || "$confdir/$dir-available";
my $enabldir = $ENV{ uc("APACHE_${dir}_ENABLED") }   || "$confdir/$dir-enabled";

my $choicedir = $act eq 'enable' ? $availdir : $enabldir;
my $linkdir = File::Spec->abs2rel( $availdir, $enabldir );

my $request_reload = 0;

my $rc = 0;

if ( !scalar @ARGV ) {
    my @choices = myglob('*');
    print "Your choices are: @choices\n";
    print "Which ${obj}(s) do you want to $act (wildcards ok)?\n";
    my $input = <>;
    @ARGV = split /\s+/, $input;

}

my @objs;
foreach my $arg (@ARGV) {
    my @glob = myglob($arg);
    if ( !@glob ) {
        error("No $obj found matching $arg!\n");
        $rc = 1;
    }
    else {
        push @objs, @glob;
    }
}

foreach my $acton (@objs) {
    doit($acton) or $rc = 1;
}

info("To activate the new configuration, you need to run:\n  service apache2 $reload\n")
    if $request_reload;

exit($rc);

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

sub myglob {
    my $arg = shift;

    my @glob = map {
        s{^$choicedir/}{};
        s{$sffx$}{};
        s{^000-default$}{default};
        $_
    } glob("$choicedir/$arg$sffx");

    # use same rules as apache's Include directive
    @glob = grep( /^[[:alnum:]][-._[:alnum:]]*$/, @glob );
    @glob = grep( !/\.dpkg/, @glob );

    return @glob;
}

sub doit {
    my $acton = shift;

    my $prio = "";
    if ( $obj eq 'site' && $acton eq 'default' ) {
        $prio = '000-';
    }

    my ( $conftgt, $conflink );
    if ( $obj eq 'module' ) {
        if ( $acton eq 'cgi' && threaded() ) {
            print "Your MPM seems to be threaded. Selecting cgid instead of cgi.\n";
            $acton = 'cgid';
        }

        $conftgt = "$availdir/$acton.conf";
        if ( -e $conftgt ) {
            $conflink = "$enabldir/$acton.conf";
        }
    }

    my $tgt  = "$availdir/$acton$sffx";
    my $link = "$enabldir/$prio$acton$sffx";

    if ( !-e $tgt ) {
        if ( -l $link && !-e $link ) {
		if ( $act eq 'disable' ) {
			info("removing dangling symlink $link\n");
			unlink($link);
			return 1;
		}
		else {
			error("$link is a dangling symlink!\n");
		}
	}

        error("$name $acton does not exist!\n");
        return 0;
    }

    # handle module dependencies
    if ( $obj eq 'module' ) {
        if ( $act eq 'enable' ) {
            my $depends = qx{grep "# Depends:" "$availdir/$acton.load"|cut -f2 -d:};
            $depends =~ s,^[\s\n]+,,;
            $depends =~ s,[\s\n]+$,,;
            do_deps( $acton, split( /[\n\s]+/, $depends ) ) or return 0;
        }
        else {
            my @depends = qx{egrep "# Depends:.*${acton}( |\$)" $enabldir/*.load};
            @depends = grep {s{^.*?/([^/]*?)\.load:.*}{$1}s} @depends;
            if ( scalar @depends ) {
                if ($force) {
                    do_deps( $acton, @depends ) or return 0;
                }
                else {
                    error(
                        "The following modules depend on $acton ",
                        "and need to be disabled first: @depends\n"
                    );
                    return 0;
                }
            }
        }
    }

    if ( $act eq 'enable' ) {
        my $check = check_link( $tgt, $link );
        if ( $check eq 'ok' ) {
            if ($conflink) {

                # handle .conf file
                my $confcheck = check_link( $conftgt, $conflink );
                if ( $confcheck eq 'ok' ) {
                    info("$name $acton already enabled\n");
                    return 1;
                }
                elsif ( $confcheck eq 'missing' ) {
                    print "Enabling config file $acton.conf.\n";
                    add_link( $conftgt, $conflink ) or return 0;
                }
                else {
                    error("Config file $acton.conf not properly enabled: $confcheck\n");
                    return 0;
                }
            }
            else {
                info("$name $acton already enabled\n");
                return 1;
            }
        }
        elsif ( $check eq 'missing' ) {
            if ($conflink) {

                # handle .conf file
                my $confcheck = check_link( $conftgt, $conflink );
                if ( $confcheck eq 'missing' ) {
                    add_link( $conftgt, $conflink ) or return 0;
                }
                elsif ( $confcheck ne 'ok' ) {
                    error("Config file $acton.conf not properly enabled: $confcheck\n");
                    return 0;
                }
            }

            print "Enabling $obj $acton.\n";
            if ( $acton eq 'ssl' ) {
                info("See /usr/share/doc/apache2.2-common/README.Debian.gz on " .
                     "how to configure SSL and create self-signed certificates.\n");
	    }
            return add_link( $tgt, $link );
        }
        else {
            error("$name $acton not properly enabled: $check\n");
            return 0;
        }
    }
    else {
        if ( -e $link || -l $link ) {
            remove_link($link);
            if ( $conflink && -e $conflink ) {
                remove_link($conflink);
            }
            print "$name $acton disabled.\n";
        }
        elsif ( $conflink && -e $conflink ) {
            print "Disabling stale config file $acton.conf.\n";
            remove_link($conflink);
        }
        else {
            info("$name $acton already disabled\n");
            return 1;
        }
    }

    return 1;
}

sub do_deps {
    my $acton = shift;
    foreach my $d (@_) {
        info("Considering dependency $d for $acton:\n");
        if ( !doit($d) ) {
            error("Could not $act dependency $d for $acton, aborting\n");
            return 0;
        }
    }
    return 1;
}

sub add_link {
    my ( $tgt, $link ) = @_;

    # create relative link
    if ( !symlink( File::Spec->abs2rel( $tgt, dirname($link) ), $link ) ) {
        die("Could not create $link: $!\n");
    }
    $request_reload = 1;
    return 1;
}

sub check_link {
    my ( $tgt, $link ) = @_;

    if ( !-e $link ) {
        if ( -l $link ) {

            # points to nowhere
            info("Removing dangling link $link");
            unlink($link) or die "Could not remove $link\n";
        }
        return 'missing';
    }

    if ( -e $link && !-l $link ) {
        return "$link is a real file, not touching it";
    }
    if ( realpath($link) ne realpath($tgt) ) {
        return "$link exists but does not point to $tgt, not touching it";
    }
    return 'ok';
}

sub remove_link {
    my ($link) = @_;

    if ( -l $link ) {
        unlink($link) or die "Could not remove $link: $!\n";
    }
    elsif ( -e $link ) {
        error("$link is not a symbolic link, not deleting\n");
        return 0;
    }
    $request_reload = 1;
    return 1;
}

sub threaded {
    my $result = "";
    $result = qx{/usr/sbin/apache2 -V | grep 'threaded'} if -x '/usr/sbin/apache2';
    if ( $result =~ / no/ ) {
        return 0;
    }
    else {
        return 1;
    }
}

sub info {
    print @_ if !$quiet;
}

sub error {
    print STDERR 'ERROR: ', @_;
}

sub read_env_file {
    my $file = shift;

    -r $file or return;
    my @lines = qx{env - sh -c '. $file && env'};
    if ($?) {
        die "Could not read $file\n";
    }

    foreach my $l (@lines) {
        chomp $l;
        $l =~ /^(.*)?=(.*)$/ or die "Could not parse $file\n";
        $ENV{$1} = $2;
    }
}