#!/usr/local/bin/perl5 -w
#
# This program generates a command script for the 'mkfs' utility.
# It adds two significant features:
#
#  - hides the challenging, unforgiving mkfs command syntax
#  - directory expansion, either single-level or recursive
#
#
# See the companion file 'commented-profile.bld' for input description.

open(STDOUT, ">$ARGV[1]") if $ARGV[1];
select(STDOUT); $| = 1;	# To unbuffer output. Useful for debugging.

$block_count = 0;
$default_size = 100000;

sub convertPerm {
    my(@perm) = split('', $_[0]);
    my($octal) = 0;
    my($i);   

    @perm = reverse(@perm);	
    for ($i = 0; $i < 3; $i++) {
        $octal += 2 ** $i if $perm[$i] ne '-';
    } 
    $octal;
}

#
# code from here to the end rewritten by jchapin to allow
# relocating directories, and excluding directories and their
# children from the middle of a recursive tree descent, and creating
# directories on new fs that don't exist on old fs.
# See main for new input format.
#
# Subtle, important change due to this: we now iterate over
# TARGET files, not files in the source file system, except when
# processing the contents of a directory.
#

# output_from_local and output_no_local print an output line
# and answer whether the output was a directory or not.  Side effect
# is to increment block_count.

sub output_from_local {
    my($targetbase) = $_[0];
    my($fulllocal)  = $_[1];
    my(@lsEntry)    = split(/[ ,]+/, " " . $_[2]);  
    # add space so all lines will have
    # initial spaces and indexes will work
    my($tabs) = $_[3];

    # workaround a bizarre bug: cannot output filenames starting with : 
    # because it is the comment character

    if ($targetbase =~ /^:/o) {
        print STDERR "Cannot output $targetbase ($fulllocal) initial ':'.\n";
        return 0;       
    }

    my(@perm) = unpack("aa3a3a3", $lsEntry[2]); # parse permissions
    my($type) = $perm[0];

    my($major,$minor);
    if ($type =~ /[cb]/) {	# character or block dev file
        $major = $lsEntry[6];
        $minor = $lsEntry[7];
    }

    $setuid = ($perm[1] =~ /[sS]/ ? 'u' : '-');	# set if setuid or setgid
    $setgid = ($perm[2] =~ /[sS]/ ? 'g' : '-');	# bits are set

    print "   " x $tabs;
    print "$targetbase ", $type, $setuid, $setgid;
    print &convertPerm($perm[1]), &convertPerm($perm[2]),
    &convertPerm($perm[3]), " $lsEntry[4] $lsEntry[5]";
    if ($type =~ /[cb]/) {
        print " $major $minor";
    } elsif ($type eq 'l') {
        print " $lsEntry[12]";
    } elsif ($type eq '-') {
        print " $fulllocal";
    }	

    $block_count += $lsEntry[1];
    print "\n";
    return ($type eq 'd');
}

sub output_no_local {
    my($targetbase) = $_[0];
    my($action) = $_[1];
    my($linkfield) = $_[2];
    my($tabs) = $_[3];

    if ($targetbase =~ /^:/o) {
        print STDERR "Cannot output target $targetbase -- initial ':'.\n";
        return 0;
    }

    print "   " x $tabs;
    if ($action eq "e") {
        print "$targetbase d--755 0 0\n";
    } elsif ($action eq "n") {
        print "$targetbase ---644 0 0 /dev/null\n";
    } elsif ($action eq "l") {
        print "$targetbase l--644 0 0 $linkfield\n";
    } else {
        die "bad output_no_local: $targetbase $action $linkfield $tabs\n";
    }
    # assume one block for each directory, link, empty file
    $block_count += 1;
    return ($action eq "e");
}

sub filename {
    my(@lsEntry) = split(/[ ,]+/, " " . $_[0]);
    my(@perm) = unpack("aa3a3a3", $lsEntry[2]); # parse permissions
    my($type) = $perm[0];

    if ($type =~ /[cb]/o) {
        return $lsEntry[11];
    } else {
        return $lsEntry[10];
    }
}

sub extend_name {
    my($path) = $_[0];
    my($base) = $_[1];

    if ($path eq "/") {
        return $path . $base;
    } else {
        return $path . "/" . $base;
    }
}

sub output_dir {
    my($fulltarget) = $_[0];
    my($fulllocal) = $_[1];
    my($action) = $_[2];
    my($tabs) = $_[3];

    if ($action eq "r" || $action eq "a") {

        # need to expand filenames.  Only process those names not
        # explicitly specified in input spec.

        if (-d $fulllocal) {
            my(@listing) = `/bin/ls -Anls $fulllocal`;
            foreach $line (@listing[1..$#listing]) {
                chomp($line);
                my($childname) = &filename($line);
                #print "Processing $childname\n";
                my($targetchildname) = &extend_name($fulltarget, $childname);
                my($localchildname) = &extend_name($fulllocal, $childname);
                if (! $what{$targetchildname}) {
                    if (-r $localchildname || ! -f $localchildname) {
                        my($was_directory) = &output_from_local($childname,
                                                                $localchildname,
                                                                $line, $tabs);
                        if ($was_directory) {
                            if ($action eq "r") {
                                &output_dir($targetchildname, 
                                            $localchildname, 
                                            $action, 
                                            $tabs+1);
                            }
                            print "   " x ($tabs+1), "\$\n";
                        }
                    } else {
                        print STDERR "$localchildname unreadable, skipped\n";
                    }
                }
            }
        }
    }

    # now process explicitly specified child directories and files

    if ($fulltarget && $children{$fulltarget}) {
        #print STDERR "###$fulltarget\n$children{$fulltarget}####\n";
        my(@listing) = split(/\s+/o, $children{$fulltarget});
        foreach $line (@listing) {
            #if( defined $line ) {
            #    print STDERR "%%% $line DO $what{$line} %%%\n";
            #} else {
            #    print "Line UNDEF!\n";
            #    print STDERR "###$fulltarget\n$children{$fulltarget}####\n";
            #    print join("\t", @listing);
            #}
            my($childaction) = $what{$line};
            next if $childaction eq "x";

            my($childname) = substr($line, rindex($line, "/")+1);
            #print STDERR "Processing2 $childname\n";
            my($targetchildname) = $line;
            my($localchildname) = $localname{$line};

            my($was_directory) = 0;
            if ($childaction eq "l" || ! -e $localchildname) {
                $was_directory = &output_no_local($childname,
                                                  $childaction,
                                                  $localchildname,
                                                  $tabs);
            } else {
                if (-r $localchildname || ! -f $localchildname) {
                    my($lsout) = `/bin/ls -Anlsd $localchildname`;
                    chop($lsout);
                    $was_directory = &output_from_local($childname, 
                                                        $localchildname,
                                                        $lsout,
                                                        $tabs);
                } else {
                    print STDERR "$localchildname unreadable, skipped\n";
                }
            }
            if ($was_directory) {
                &output_dir($targetchildname, 
                            $localchildname, 
                            $childaction, 
                            $tabs+1);
                print "   " x ($tabs+1), "\$\n";
            }
        }
    }
}

#
# begin main program
#

# initialize the filespec list

open(FILELIST, $ARGV[0]);

while (<FILELIST>) {
    ($targetfile, $what_to_do, $localfile) = split;
    next if (!$targetfile || ($targetfile =~ /^\#/)) ;

    die "all input lines must specify what_to_do field" if ! $what_to_do;
    if (! $localfile) {
        $localfile = $targetfile;
    }

    $what{$targetfile} = $what_to_do;
    #if( defined $what_to_do ) {
    #    print STDERR "^^^ $targetfile DO $what_to_do ^^^\n";
    #} else {
    #    print STDERR "What_to_do UNDEF\n";
    #}
    $localname{$targetfile} = $localfile;

    if ($targetfile ne "/") {
        $target_parent = substr($targetfile, 0, rindex($targetfile,'/'));
        if (! $target_parent) {
            $target_parent = "/";
        }

        if (! $children{$target_parent}) {
            # $children{$target_parent} = "";
            $children{$target_parent} =  $targetfile;
        } else {
            $children{$target_parent} .= " " . $targetfile;
        }
    }
}

close(FILELIST);

print "fakedisk\n";
print "$default_size 80\n";
print "d--777 0 0\n";

&output_dir("/", $localname{"/"}, $what{"/"}, 1);

print "   ", "\$\n";
print ":\tFile system tree done.\n";
print ":\tApproximate block count: $block_count\n";

if ($block_count > $default_size) {
#    print STDERR "Warning: block count $block_count > specified size $default_size.\n";
#    print STDERR "Edit output file before running mkfs!\n";
}

close(STDOUT);

#print STDERR "Mkfs script created.  Remember to change size of disk (second line) to match\n";
#print STDERR "actual block count of disk (printed at end of file).\n"