#!/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 listopen(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"