#!/usr/bin/perl
#
# Copyright (c) 2001 BalaBit IT Ltd.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# 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., 675 Mass Ave, Cambridge, MA 02139, USA.
#
# $Id: jailer.pl,v 1.13 2001/08/10 13:46:08 marci Exp $
#
# Simple perl script to generate and maintain chrooted enviroments(jails).

use strict;

sub get_config {
	my ($conffile) = @_;
	my %co;
	my @jails;
	my @config;
	my $block = 0;
	my $block_id;
	my $lineno = 0;
	my %gen = {};

	open(F,"<$conffile") || die "No config file by the name $conffile\n";
	while (<F>) {
		chomp;
		if (/^#/) {
			next;
		}
		elsif (!$block && /<([\w]+)>/) {
			$block = 1;
			$block_id = $1;
			%co = {};
			$co{"jail"} = $block_id, if($block_id ne "general");
		}
		elsif ($block && /<\/?([\w]+)>/) {
			push(@config, {%co}), if($block_id ne "general");
			%gen = %co, if($block_id eq "general");
			$block = 0;
			$block_id = '';
		}
		elsif ($block) {
			# process a line

			if (/^Root:\s*(.+)/i) {
				$co{"root"} = $1;
			} 
			elsif (/^Debs:\s*(.+)/i) {
				$co{"debs"} = $1;
			}
			elsif (/^Junk:\s*(.+)/i) {
				$co{"junk"} = $1;
			}
			elsif (/^Junk-Debs:\s*(.+)/i) {
				$co{"junk-debs"} = $1;
			}
			elsif (/^Extra:\s*(.+)/i) {
				$co{"extra"} = $1;
			}
			elsif (/^Links:\s*(.+)/i) {
				$co{"links"} = $1;
			}
			elsif (/^Conf:\s*(.+)/i) {
				$co{"conf"} = $1;
			}
		}
		elsif (!/\s*/) {
			print "junk at line $lineno\n";
			exit 1;
		}
		$lineno++;
	}
	close(F);

	if (%gen) {
		foreach (@config) {
			my $key;
			#Adding general rules
			if ($_->{"jail"} ne "general") {
				foreach $key (keys %gen) {
					$_->{$key} .= " " . $gen{$key};
				}
			}
		}
	}
	return (@config);
}

sub get_deps {
        my (@debs) = @_;
        my %deps;
        my ($br, $i, @b);
        undef $/;
        open(F, "</var/lib/dpkg/available") || die "Unable to open: /var/lib/dpkg/available\n";
        my $available = <F>;
        close(F);
        foreach (@debs) {
                s/\+/\\\+/g;
                s/\./\\\./g;
                if ($available =~ m/(Package: $_\n(.+\n)+)/) {
                        my $tmp = $1;
                        if ($tmp =~ /Depends/g) {
                                $tmp =~ /Depends: (.*)/;
                                my @b = split(", ", $1);
                                foreach $br (@b) {
                                        if ($br =~ /\|/g) {
                                                foreach $i (split(' \| ', $br)) {
                                                        $i =~ /^([a-z\d\-\+\.]+).*$/;
                                                        $deps{"$1"} = 1;
                                                }
                                        } else {
                                                $br =~ /^([a-z\d\-\+\.]+).*$/;
                                                $deps{"$1"} = 1;
                                        }
                                }
                        }
                }
        }
        return (keys %deps);
}

sub get_all_deps {
	my (%debs) = @_;
	my $num;

	while ((keys %debs) > $num) {
		$num = keys %debs;
		foreach (get_deps(keys %debs)) {
			$debs{"$_"} = 1;
		}
	}
	return (%debs);
}

sub get_files {
	my (%debs) = @_;
	my $deb;
	my %files;
	foreach $deb (keys %debs) {
		print "Using deb: $deb\n";
		open(F,"</var/lib/dpkg/info/$deb.list") || warn "Unable to open: /var/lib/dpkg/info/$deb.list!\n";
		foreach (split("\n",<F>)) {
			$files{"$_"} = 1;
		}
		close(F);
	}
	return (%files);
}

### START ###

my @config;
my $conf;

#Prase arguments and the config file
if ($#ARGV ge 0) {
	print "Using config file: $ARGV[0]\n";
	@config = get_config($ARGV[0]);
} else {
	print STDERR "No config file is given!\n";
	print "Usage:\njailer.pl conffile [jail]: Config file, jail to (re)build\n";
	exit 1;
}

#Do the jails one by one
foreach $conf (@config) {
	if (length($ARGV[1])) {
		next, if ($conf->{"jail"} ne $ARGV[1]);
	}

	my $junk;
	my $tmp;
	my %files;
	my %debs;

	print "Generating \"$conf->{jail}\" jail in \"$conf->{root}\" with \"$conf->{debs}\" debs.\n";

	#Get the base debs
	foreach $tmp (split(" ", $conf->{"debs"})) {
		$debs{"$tmp"} = 1;
	}

	#Get all the needed debs
	%debs = get_all_deps(%debs);
	#Throw out the junk
	foreach $tmp (split(" ", $conf->{"junk-debs"})) {
		delete $debs{"$tmp"};
	}

	#Get the files
	%files = get_files(%debs);

	#Throw out the junk
	foreach $junk (split(" ", $conf->{"junk"})) {
		print "Droping junk: $junk\n";
		$junk =~ s/\//\\\//g;
		$junk =~ s/\+/\\\+/g;
		$junk =~ s/\./\\\./g;
		$junk =~ s/\*/\.\*/g;
		foreach (keys %files) {
			delete $files{$_}, if (/^$junk$/);
		}
	}

	#Prepare extra plus conf-files
	my @conffile;
	my @extrafile;
	foreach (split(" ", $conf->{"extra"})) {
		my $tmp_dir;
		chop($tmp_dir = `dirname '$_'`);
		my @tmpfile = `find $tmp_dir -path '$_'`;
		push (@extrafile, $tmp_dir, @tmpfile);
	}
	foreach (split(" ", $conf->{"conf"})) {
		my $tmp_dir;
		chop($tmp_dir = `dirname '$_'`);
		my @tmpfile = `find $tmp_dir -path '$_'`;
		push (@conffile, $tmp_dir, @tmpfile);
	}

	#Start cpio in pass mode
	open(CPIO, "|cpio -pd --quiet $conf->{root} 2> /dev/null");

	#Add the normal files
	foreach (sort(keys %files)) {
		print CPIO "$_\n";
	}
	#Add the extra files
	foreach (@extrafile) {
		print CPIO "$_\n";
		print "Adding extra: $_\n";
	}
	#Add conf files
	foreach (@conffile) {
		print CPIO "$_\n", if ( ! -e "$conf->{root}" . "$_");
		print "Adding config files: $_\n";
	}
	close(CPIO);

	#Generate links
	foreach (split(" ", $conf->{"links"})) {
		my ($base, $link) = split("<=>", $_);
		if (-l ($conf->{"root"} . $link)) {
			unlink ($conf->{"root"} . $link);
			print "Deleting old link: $link\n";
			symlink($base, $conf->{"root"} . $link);
			print "Creating link $link to $base\n";
		} elsif (-e ($conf->{"root"} . $link)) {
			print "$link can't be deleted!\n";
		} else {
			symlink($base, $conf->{"root"} . $link);
			print "Creating link $link to $base\n";
		}
	}
	
	#Finished with this jail
	print "Finished!\n";
}