#!/usr/bin/perl
use strict;
use warnings;
#use POSIX ':fcntl_h';				# S_ISLNK was here in Perl 5.6
#import Fcntl ':mode' unless defined &S_ISLNK;	# but it is here in Perl 5.8
use Fcntl ':mode';

my $CONFIG = "chroot.conf";
my $CHROOT_BASE = "/chroot";


my $configsection = '';
my $curfile = '';
my @filelist;
my @copylist;
open(CONFIG, "<$CONFIG") or die("Unable to open configuration file $CONFIG.");

while (<CONFIG>) {
    chomp;
    my $line = $_;

    # Ignore comments
    $line =~ /^\s*\#.*$/ && do {
        next;
    };

    # Locate configuration sections
    $line =~ /^\[([A-z0-9]+)\]$/ && do {
        $configsection = $1;
        next;
    };

    # Set processing variables
    if ($configsection eq 'config') {
        $line =~ /^CHROOT_BASE (.*)$/ && do {
            print STDERR "Setting CHROOT_BASE to $1\n";
            $CHROOT_BASE = $1;
            next;
        };
    }

    if ($configsection eq 'files' || $configsection eq '') {
        # Symlink request in file
        $line =~ /^\-\>\s+(.*)$/ && do {
           if ($curfile eq '') {
               warn("Symlink to $1 requested but no target file found.");
               next;
           }
           @filelist = insertLink($curfile, $1, @filelist);

           next;
        };

        $line =~ /^(\/.*)\/(.*)$/ && do {
            my $file = $1.'/'.$2;
            my $mode = (lstat($file))[2];
            my $path = $1;

            $curfile = $file;
            
            if (S_ISDIR($mode)) {
                $path = $file;
            }

            copydir($path);

            # Weed out duplicates
            if (array_search($curfile, @filelist) == -1) {
                push @filelist, $curfile;
            }

            next;
        };
    }
}
close(CONFIG);

$curfile = '';
my $i = 0;
FILE: while ($filelist[$i]) {
    my $file = $filelist[$i++];
    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
        $blksize,$blocks) = lstat($file);

    $file =~ /^\-\>\s+(.*)$/ && do {
       if ($curfile eq '') {
           warn("Symlink to $1 requested but no target file found.");
           next;
       }
       @copylist = insertLink($curfile, $1, @copylist);

       next;
    };


    if (S_ISDIR($mode)) { 
        copydir($file);
        next FILE;
    }

    if (S_ISLNK($mode)) {
        my @links;
        while (S_ISLNK($mode)) {
            $curfile = $file;
            $file = readlink($file);
            if (!($file =~ /^\//)) {
                $curfile =~ /^(\/.*)\/(.*)$/;
                $file = $1.'/'.$file;
            }
            if (array_search("-> $curfile", @copylist) == -1) {
                push @links, "-> $curfile";
            }

            $mode = (lstat($file))[2];
        }
        push @copylist, $file;
        push @copylist, @links;
        next FILE;
    }

    # Handle block and character special files
    if (S_ISBLK($mode) || S_ISCHR($mode)) {
        my $type = '';
        my $maj = $rdev >> 8;
        my $min = $rdev & 0xff;

        if (S_ISBLK($mode)) {
            print STDERR "Creating block device $file ($maj, $min)\n";
            $type = "b";
        }
        if (S_ISCHR($mode)) {
            print STDERR "Creating character device $file ($maj, $min)\n";
            $type = "c";
        }
        
        unlink($CHROOT_BASE.$file);
        my @cmd = ("/bin/mknod", $CHROOT_BASE.$file, $type, $maj, $min);
        system(@cmd);
        @cmd = ("/bin/chmod", sprintf("%o", $mode & oct(7777)),
            $CHROOT_BASE.$file);
        system(@cmd);
    }

    if (S_ISREG($mode)) {
        push @copylist, $file;
        $curfile = $file;

        $file =~ /^(\/.*)\/.*$/;
        my $path = $1;
        copydir($path);

        # Determine shared library dependencies
        open(LDD, "/usr/bin/ldd $file 2>/dev/null |") or
            die("Unable to run /usr/bin/ldd against $file\n");
        while(<LDD>) {
            chomp;
            (/not a dynamic executable/ ||
             /statically linked/) && do {
                last;
            };

            /^\s+(.*)\s+=>\s+(\/.*)\s+\(0x[0-9a-fA-F]+\)$/ && do { # Found a link to a shared object.  Push the shared object
                # onto the stack of files to be inspected.
                # libc.so.6 => /lib/tls/libc.so.6 (0x40030000)
                if (array_search($2, @filelist) == -1) {
                    push @filelist, $2;
                }
                next;
            };

            /^\s+(\/.*)\s+\(0x[0-9a-fA-F]+\)$/ && do {
                # Found a link to a shared object.  Push teh shared object
                # onto the stack of files to be inspected.
                # /lib/ld-linux.so.2 (0x40000000)
                if (array_search($1, @filelist) == -1) {
                    push @filelist, $1;
                }
                next;
            };
        }
        close(LDD);
    }
}

$curfile = '';
foreach my $file (@copylist) {
    if($file =~ /^->\s+(.*)$/) {
        if ($curfile eq '') {
            warn("Symlink to $1 requested but no target file found.");
            next;
        }
        print STDERR "Linking $curfile to $1\n";
        unlink($CHROOT_BASE.$1);
        my @cmd = ("/bin/ln", "-s", $curfile, $CHROOT_BASE.$1);
        system(@cmd);
        next;
    }
    $curfile = $file;
    my $realpath = '';
    my $basename = '';
    if ($file =~ /^(\/.*)\/(.*)$/) {
        $realpath = $1;
        $basename = $2;
    } else {
        warn("Unable to determine path for $file\n");
        next;
    }
    copydir($realpath);

    print STDERR "Copying $curfile\n";
    my @cmd = ("/bin/cp", "-p", $curfile, $CHROOT_BASE.$realpath.'/'.$basename);
    system(@cmd);
}


sub insertLink {
    my $file = shift(@_);
    my $link = shift(@_);
    my @filelist = @_;
    my $index = 0;

    $index = array_search($file, @filelist);
 
    if ($index == -1) {
        push @filelist, $file;
        push @filelist, "-> $link";
        return @filelist;
    }

    # Append the link to the related file
    my @a = splice(@filelist, 0, $index + 1);
    push @a, "-> $link";
    push @a, @filelist;
    return @a;
}

sub array_search {
    my $key = shift(@_);
    my @array = @_;

    my $index = 0;
    while ($array[$index]) {
        my $v = $array[$index];
        if ($v eq $key) {
            last;
        }
        $index++;
    }

    if ($index > $#array) {
        return -1;
    }
    return $index;
}

sub copydir {
    my $dir = shift(@_);

    if (!lstat($CHROOT_BASE.$dir)) {
        my @dirstack = split('/', $dir);
        my $realpath = '';
        foreach my $node (@dirstack) {
            my $mode;
            # Prune empty nodes so we don't get multiple consecutive '/'s
            if ($node =~ /^$/) {
                next;
            }

            $realpath = $realpath.'/'.$node;
        
            # Copy the realpath to a tmppath in case we need to mangle
            my $tmppath = $realpath;
            $mode = (lstat($tmppath))[2];
            # If the directory we're inspecting is a symlink, get the
            # get the permissions of the target dir
            if (S_ISLNK($mode)) {
                $tmppath = readlink($realpath);
                print STDERR "Found a symbolic link from $realpath to $tmppath\n";
                $mode = (lstat($tmppath))[2];
            }
        
            # Create the directory in the jail
            if (!lstat($CHROOT_BASE.$realpath)) {
                printf STDERR "Creating directory %s (%4o) in chroot jail.\n", ($realpath,$mode);
                mkdir($CHROOT_BASE.$realpath, $mode);
            }
        }
    }
    return 1;
}