#!/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 $confdir = '/etc/pam.d';
my (%profiles, @sorted, @enabled, @conflicts);

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;

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));

# 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);

# we need a commandline '--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.

# if diff_profiles() fails, and we weren't passed a 'force' argument
# (either because this isn't an upgrade from an old version, or because the
# checksum didn't match, or because we're being called by some other module
# package), prompt the user whether to override.  If the user declines 
# (which is the default), we never again manage this config unless manually
# called with '--force'.

# at the end of a successful write, reset the 'seen' flag and the value of
# the debconf override question.

# FIXME: none of the above comments are implemented!

if (!$diff) {
	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 = ();
	input('high',$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, $diff);

# merge a set of module declarations into a set of new config files,
# using the information returned from diff_profiles().
sub write_profiles
{
}

# 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) = @_;
	my $savedir = '/var/lib/pam';
	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]+)//;
			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;
			do {
				my $line;
				($modname,$line) = shift(@saved);
				$line =~ /^((\[[^]]+\]|\w+)\s+\S+)\s*(.*)/;
				@prev_opts = split(/\s+/,$3);
				$curmod = $1;
				$curmod =~ s/(end|[0-9]+)//;
				# check if this is a match for the current line
				if ($_ =~ /^$curmod\s*(.*)$/) {
					$found = 1;
				} else {
					push(@{$diff{$type}{'del'}},$modname);
				}
			} while (!$found && $#saved >= 0);

			# 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+/,$1)) {
				my $found = 0;
				for (my $i = 0; $i <= $#prev_opts; $i++) {
					if ($prev_opts[$i] eq $opt) {
						$found = 1;
						splice(@prev_opts,$i,0);
					}
				}
				push(@{$diff{$type}{'add'}{$curmod}},$opt) 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$_";
		}
	}
	close(PROFILE);
	return %profile;
}