#!/usr/bin/perl -w # # a2enmod by Stefan Fritsch # 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; } }