path: root/debian/local/pam-auth-update

#!/usr/bin/perl -w

# pam-auth-update: update /etc/pam.d/common-* from /usr/share/pam-configs
#
# Update the /etc/pam.d/common-* files based on the per-package profiles
# provided in /usr/share/pam-configs/ taking into consideration user's
# preferences (as determined via debconf prompting).
#
# Written by Steve Langasek <steve.langasek@canonical.com>
#
# Copyright (C) 2008 Canonical Ltd.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of version 3 of the GNU General Public License as
# published by the Free Software Foundation.
#
# # This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301,
# USA.

use strict;
use Debconf::Client::ConfModule ':all';

version('2.0');
my $capb=capb('backup');

my $inputdir = '/usr/share/pam-configs';
my $template = 'libpam-runtime/profiles';
my $errtemplate = 'libpam-runtime/conflicts';
my $overridetemplate = 'libpam-runtime/override';
my $confdir = '/etc/pam.d';
my $savedir = '/var/lib/pam';
my (%profiles, @sorted, @enabled, @conflicts);
my $force = 0;
my $priority = 'high';

opendir(DIR, $inputdir) || die "could not open config directory: $!";
while (my $profile = readdir(DIR)) {
	next if ($profile eq '.' || $profile eq '..');
	%{$profiles{$profile}} = parse_pam_profile($inputdir . '/' . $profile);
}
closedir DIR;

# use a '--force' arg to specify that /etc/pam.d should be overwritten; 
# used only on upgrades where the postinst has already determined that the
# checksums match.  Module packages other than libpam-runtime itself must
# NEVER use this option!  Document with big skullses and crossboneses!  It
# needs to be exposed for libpam-runtime because that's the package that
# decides whether we have a pristine config to be converted, and knows
# whether the version being upgraded from is one for which the conversion
# should be done.

while ($#ARGV >= 0) {
	my $opt = shift;
	if ($opt eq '--force') {
		$force = 1;
	} elsif ($opt eq '--package') {
		$priority = 'medium';
	}
	# FIXME: we need an option that will permit us to remove configs in
	# prerm remove, to avoid having a broken config at any point.
}

x_loadtemplatefile('/var/lib/dpkg/info/libpam-runtime.templates','libpam-runtime');

# always sort by priority, so we have consistency and don't have to
# shuffle later
@sorted = sort { $profiles{$b}->{'Priority'} <=> $profiles{$a}->{'Priority'} }
	keys(%profiles);
subst($template, 'profile_names', join(', ',@sorted));
subst($template, 'profiles',
	join(', ', map { $profiles{$_}->{'Name'} } @sorted));

# FIXME:
# this needs to be replaced by proper detection of any profiles that are
# already enabled; i.e., use diff_profiles() to figure out what's
# currently selected
fset($template,'seen','false');
set($template,
	join(', ', grep { $profiles{$_}->{'Default'} eq 'yes' } @sorted));

my $diff = diff_profiles($confdir,$savedir);

# if diff_profiles() fails, and we weren't passed a 'force' argument
# (because this isn't an upgrade from an old version, or the checksum
# didn't match, or we're being called by some other module package), prompt
# the user whether to override.  If the user declines (the default), we
# never again manage this config unless manually called with '--force'.
if (!$diff && !$force) {
	input('high',$overridetemplate);
	go();
	$force = 1 if (get($overridetemplate) eq 'true');
}

if (!$diff && !$force) {
	print STDERR <<EOF;

pam-auth-update: Local modifications to /etc/pam.d/common-*, not updating.
pam-auth-update: Run pam-auth-config --force to override.

EOF
	exit;
}

do {
	@conflicts = ();
	# FIXME: we probably need this priority to be 'high' in the
	# case that we've managed to get an empty set of packages
	input($priority,$template);
	go();

	@enabled = split(/, /, get($template));

	# in case of conflicts, automatically unset the lower priority
	# item of each pair
	foreach my $elem (@enabled)
	{
		for (my $i=$#enabled; $i >= 0; $i--)
		{
			my $conflict = $enabled[$i];
			if ($profiles{$elem}->{'Conflicts'}->{$conflict}) {
				splice(@enabled,$i,1);
				my $desc = $profiles{$elem}->{'Name'}
					. ', ' . $profiles{$conflict}->{'Name'};
				push(@conflicts,$desc);
			}
		}
	}
	if (@conflicts) {
		subst($errtemplate, 'conflicts', join("\n", @conflicts));
		input('high',$errtemplate);
	}
	fset($template,'seen','false');
	set($template, join(', ', @enabled));
} while (@conflicts);

# @enabled now contains our list of profiles to use for piecing together
# a config
# we have:
# - templates into which we insert the specialness
# - magic comments denoting the beginning and end of our managed block;
#   looking at only the functional config lines would potentially let us
#   handle more cases, at the expense of much greater complexity, so
#   pass on this at least for the first round
# - a representation of the autogenerated config stored in /var/lib/pam,
#   that we can diff against in order to account for changed options or
#   manually dropped modules
# - a hash describing the local modifications the user has made to the
#   config; these are always preserved unless manually overridden with
#   the --force option

write_profiles(\%profiles, \@enabled, $confdir, $savedir, $diff, $force);


# take a single line from a stock config, and merge it with the
# information about local admin edits
sub merge_one_line
{
	my ($line,$diff,$count) = @_;
	my (@opts,$modline);

	my ($adds,$removes);

	$line =~ /^((\[[^]]+\]|\w+)\s+\S+)\s*(.*)/;

	@opts = split(/\s+/,$3);
	$modline = $1;
	$modline =~ s/end/$count/g;
	if ($diff) {
		my $mod = $modline;
		$mod =~ s/[0-9]+//g;
		$adds = \%{$diff->{'add'}{$mod}};
		$removes = \%{$diff->{'remove'}{$mod}};
	} else {
		$adds = $removes = undef;
	}

	for (my $i = 0; $i <= $#opts; $i++) {
		if ($adds->{$opts[$i]}) {
			delete $adds->{$opts[$i]};
		}
		if ($removes->{$opts[$i]}) {
			splice(@opts,$i,1);
			$i--;
		}
	}
	return $modline . " " . join(' ',@opts,keys(%{$adds})) . "\n";
}

# create a single PAM config from the indicated template and selections,
# writing to a new file
sub create_from_template
{
	my($template,$dest,$profiles,$enabled,$diff,$type) = @_;
	my $state = 0;
	my $uctype = ucfirst($type);

	open(INPUT,$template) || return 0;
	open(OUTPUT,">$dest") || return 0;

	while (<INPUT>) {
		if ($state == 1) {
			if (/^# here's the fallback if no module succeeds/) {
				print OUTPUT;
				$state++;
			}
			next;
		}
		if ($state == 3) {
			if (/^# end of pam-auth-update config/) {
				print OUTPUT;
				$state++;
			}
			next;
		}

		print OUTPUT;

		my ($pattern,$val);
		if ($state == 0) {
			$pattern = '^# here are the per-package modules \(the "Primary" block\)';
			$val = 'Primary';
		} elsif ($state == 2) {
			$pattern = '^# and here are more per-package modules \(the "Additional" block\)';
			$val = 'Additional';
		}

		if (/$pattern/) {
			my $i = 0;
			my $count = 0;
			# first we need to get a count of lines that we're
			# going to output, so we can fix up the jumps correctly
			for my $mod (@{$enabled}) {
				my $output;
				next if (!$profiles->{$mod}{$uctype . '-Type'});
				next if $profiles->{$mod}{$uctype . '-Type'} ne $val;
				if ($i == 0
				    && $profiles->{$mod}{$uctype . '-Initial'})
				{
					$output = $profiles->{$mod}{$uctype . '-Initial'};
					$i++;
				} else {
					$output = $profiles->{$mod}{$uctype . '-Final'};
				}
				# bypasses a perl warning about @_, sigh
				my @tmparr = split("\n+",$output);
				$count += @tmparr;
			}

			# in case anything tries to jump in the 'additional'
			# block, let's try not to jump off the stack...
			$count-- if ($val eq 'Additional');

			$i = 0;
			for my $mod (@{$enabled}) {
				my $output;
				my @output;
				next if (!$profiles->{$mod}{$uctype . '-Type'});
				next if $profiles->{$mod}{$uctype . '-Type'} ne $val;
				if ($i == 0
				    && $profiles->{$mod}{$uctype . '-Initial'})
				{
					$output = $profiles->{$mod}{$uctype . '-Initial'};
					$i++;
				} else {
					$output = $profiles->{$mod}{$uctype . '-Final'};
				}
				for my $line (split("\n",$output)) {
					$line = merge_one_line($line,$diff,
					                       $count);
					print OUTPUT "$type\t$line";
					$count--;
				}
			}
			$state++;
		}
	}
	close(INPUT);
	close(OUTPUT);

	if ($state < 4) {
		unlink($dest);
		return 0;
	}
	return 1;
}

# merge a set of module declarations into a set of new config files,
# using the information returned from diff_profiles().
sub write_profiles
{
	my($profiles,$enabled,$confdir,$savedir,$diff,$force) = @_;

	if (! -d $savedir) {
		mkdir($savedir);
	}
		
	# because we can't atomically replace both /var/lib/pam/$foo and
	# /etc/pam.d/common-$foo at the same time, take steps to make this
	# somewhat robust
	for my $type ('auth','account','password','session') {
		my $target = $confdir . '/common-' . $type;
		my $template = $target;
		my $dest = $template . '.pam-new';

		my $diff = $diff;
		if ($diff) {
			$diff = \%{$diff->{$type}};
		}

		# first, write out the new config
		if (!create_from_template($template,$dest,$profiles,$enabled,
		                          $diff,$type))
		{
			if (!$force) {
				return 0;
			}
			$template = '/usr/share/pam/common-' . $type;
			if (!create_from_template($template,$dest,$profiles,
			                          $enabled,$diff,$type))
			{
				return 0;
			}
		}

		# then write out the saved config
		if (!open(OUTPUT, "> $savedir/$type.new")) {
			unlink($dest);
			return 0;
		}
		my $i = 0;
		my $uctype = ucfirst($type);
		for my $mod (@enabled) {
			my $output;
			if ($i == 0 && $profiles->{$mod}{$uctype . '-Initial'})
			{
				$output = $profiles->{$mod}{$uctype . '-Initial'};
				$i++;
			} else {
				$output = $profiles->{$mod}{$uctype . '-Final'};
			}
			if ($output) {
				print OUTPUT "Module: $mod\n";
				print OUTPUT $output . "\n";
			}
		}

		close(OUTPUT);

		# then do the renames, back-to-back
		# we have to use system because File::Copy is in
		# perl-modules, not perl-base
		system('cp','-f',$target,$target . '.pam-old');
		rename($dest,$target);
		rename("$savedir/$type.new","$savedir/$type");
		unlink($target . '.pam-old') if (!$force);
	}

	# at the end of a successful write, reset the 'seen' flag and the
	# value of the debconf override question.
	fset($errtemplate,'seen','false');
	set($errtemplate,'false');
}

# reconcile the current config in /etc/pam.d with the saved ones in
# /var/lib/pam; returns a hash of profile names and the corresponding
# options that should be added/removed relative to the stock config.
# returns false if any of the markers are missing that permit a merge,
# or on any other failure.
sub diff_profiles
{
	my ($sourcedir,$savedir) = @_;
	my (%diff);

	# Load the saved config from /var/lib/pam, then iterate through all
	# lines in the current config that are in the managed block.
	# If anything fails here, just return immediately since we then
	# have nothing to merge; instead, the caller will decide later
	# whether to force an overwrite.
	for my $type ('auth','account','password','session') {
		my (@saved,$modname);

		open(SAVED,$savedir . '/' . $type) || return 0;
		while (<SAVED>) {
			if (/^Module: (.*)/) {
				$modname = $1;
				next;
			}
			chomp;
			# trim out the destination of any jumps; this saves
			# us from having to re-parse everything just to fix
			# up the jump lengths, when changes to these will
			# already show up as inconsistencies elsewhere
			s/(end|[0-9]+)//g;
			my (@temp) = ($modname,$_);
			push(@saved,\@temp);
		}
		close(SAVED);

		my $state = 0;
		my (@prev_opts,$curmod);

		open(CURRENT,$sourcedir . '/common-' . $type) || return 0;
		while (<CURRENT>) {
			if ($state == 0) {
				$state = 1
				   if (/^# here are the per-package modules \(the "Primary" block\)/);
				next;
			}
			if ($state == 1) {
				s/^$type\s+//;
				if (/^# here's the fallback if no module succeeds/) {
					$state = 2;
					next;
				}
			}
			if ($state == 2) {
				$state = 3
				   if (/^# and here are more per-package modules \(the "Additional" block\)/);
				next;
			}
			if ($state == 3) {
				last if (/^# end of pam-auth-update config/);
				s/^$type\s+//;
			}

			my $found = 0;
			my $curopts;
			while (!$found && $#saved >= 0) {
				my $line;
				($modname,$line) = @{$saved[0]};
				shift(@saved);
				$line =~ /^((\[[^]]+\]|\w+)\s+\S+)\s*(.*)/;
				@prev_opts = split(/\s+/,$3);
				$curmod = $1;
				# FIXME: the key isn't derived from the config
				# name, so collisions are possible if more
				# than one config references the same module

				$_ =~ s/(\[[^0-9]*)[0-9]+(.*\])/$1$2/g;
				# check if this is a match for the current line
				if ($_ =~ /^\Q$curmod\E\s*(.*)$/) {
					$found = 1;
					$curopts = $1;
				} else {
					push(@{$diff{$type}{'del'}},$modname);
				}
			}

			# there's a line in the live config that doesn't
			# correspond to anything from the saved config.
			# treat this as a failure; it's very error-prone
			# to decide what to do with an added line that
			# didn't come from a package.
			return 0 if (!$found);

			for my $opt (split(/\s+/,$curopts)) {
				my $found = 0;
				for (my $i = 0; $i <= $#prev_opts; $i++) {
					if ($prev_opts[$i] eq $opt) {
						$found = 1;
						splice(@prev_opts,$i,1);
					}
				}
				$diff{$type}{'add'}{$curmod}{$opt} = 1 if (!$found);
			}
			for my $opt (@prev_opts) {
				$diff{$type}{'remove'}{$curmod}{$opt} = 1;
			}
		}
		close(CURRENT);

		# we couldn't parse the config, so the merge fails
		return 0 if ($state < 3);
	}
	return \%diff;
}

# simple function to parse a provided config file, in pseudo-RFC822
# format,
sub parse_pam_profile
{
	my ($profile) = $_[0];
	my $fieldname;
	my %profile;
	open(PROFILE, $profile) || die "could not read profile $profile: $!";
	while (<PROFILE>) {
		if (/^(\S+):\s+(.*)$/) {
			$fieldname = $1;
			if ($fieldname eq 'Conflicts') {
				foreach my $elem (split(/, /, $2)) {
					$profile{'Conflicts'}->{$elem} = 1;
				}
			} else {
				$profile{$1} = $2;
			}
		} else {
			chomp;
			$profile{$fieldname} .= "\n$_";
			$profile{$fieldname} =~ s/^[\n\s]+//;
		}
	}
	close(PROFILE);
	return %profile;
}