#! /usr/bin/perl

use strict;
use File::stat;
use Fcntl ':mode';
use File::Spec;
use Getopt::Std;

my %pwds = ();
my %seen_stat = ();
my %seen_open = ();
my %unfinished = ();
my %fds = ();
my %unknown_calls = ();

my $debug = 0;
my $print_cmdlist = 0;

my @opened_files = ();
my @stated_files = ();
my @stated_dirs = ();
my @stated_alldirs = ();

my %block2file;
my %file2blocks;
my %file2stat;
my %small_files;
my %stat_files;
my %stated_dirs;
my %stated_alldirs;
my %file2size;
my $verbose = 0;

# make_abs (PWD, ARG) makes ARG an absolute pathname if it isn't already
# with PWD being the current dir (i.e. the one to which ARG is relative to)
# Additionally to returning a perl canonical path it also strips
# the trailing part of the path if ARG is '..'.  This makes the output
# nice in case of a chain of chdir(sub)/chdir(..) calls, but in the case
# of softlinked dirs it makes a difference.
sub make_abs($$)
{
    my ($pwd, $f) = @_;
    if ($f eq File::Spec->updir()) {
      ($f = $pwd) =~ s,/[^/]+/*$,,;
      $f = '/' if (!$f);
    } elsif (!File::Spec->file_name_is_absolute( $f)) {
      $f = File::Spec->catfile($pwd, $f);
    }
    return File::Spec->canonpath($f);
}

sub read_strace
{
  while ( <STDIN> ) { 
    chomp;
    my $line;
    if (m/^(\d*)\s+(.*) <unfinished \.\.\.>/) {
      $unfinished{$1} = $2;
      next;
    } elsif (m/^(\d*)\s+<\.\.\..* resumed> (.*)$/) {
      $line = $1 . " " . $unfinished{$1} . " " . $2;
      # print "resume: $line\n";
    } else {
      $line = $_;
    }
    if ($line =~ m/^(\d*)\s+(\w*)\((.*)\)\s+= (\S+)\s*(.*)$/) {
      my $pid = $1;
      my $syscall = $2;
      my $args = $3;
      my $result = $4;
      my $rest = $5;
      # this is incorrect as it splits also inside {...}, like
      #  fstat64(3, {st_mode=S_IFREG|0755, st_size=181212, ...}) = 0
      # But for now this doesn't matter, as we only look at the first
      # argument mostly anyway
      my @args = map {s/^\s*//; s/\s*$//; $_} split (/,\s*/, $args);
      (my $arg = $args[0]) =~ s/^"(.*)"$/\1/;
      if (!defined $pwds{$pid}) {
        $pwds{$pid} = "/";
      }
      $arg = make_abs($pwds{$pid}, $arg);
      if ($syscall eq "chdir" && $result >= 0) {
        $pwds{$pid} = $arg;
        next;
      } elsif ($syscall eq 'fchdir' && $result >= 0) {
	$arg = $fds{$pid}->{$args[0]};
        $pwds{$pid} = $arg;
        next;
      } elsif ($syscall eq "open" && $result >= 0) {
	$fds{$pid}->{$result} = $arg;
	# print "FD $result of $pid now $arg\n";
      }
      next if ($arg =~ m,^/proc/, || $arg =~ m,^/sys/, || $arg =~ m,^/dev/,);
      next if (grep(/^$syscall/, ("mkdir", "chown32", "chown", "unlink", "chmod", "mknod", "statfs", "rename", "rmdir", "link", "getcwd", "creat")));
      next if (defined $seen_open{$arg});
      if (grep(/^$syscall/, ("open", "execve"))) {
	$seen_open{$arg} = 1;
	push @opened_files, $arg;
	print "open $arg\n" if ($print_cmdlist);
      } elsif (grep(/^$syscall$/, ("stat", "stat64", "access", "readlink", "lstat", "lstat64"))) {
	next if (defined $seen_stat{$arg});
	$seen_stat{$arg} = 1;
	push @stated_files, $arg;
	print "stat $arg\n" if ($print_cmdlist);
      } elsif ($syscall =~ m/^(fstat64)$/) {
	my $file = $fds{$pid}->{$args[0]};
	next if (defined $seen_stat{$file});
	$seen_stat{$file} = 1;
	next if ($file =~ m,^/proc/, || $file =~ m,^/sys/, || $file =~ m,^/dev/,);
	push @stated_files, $file;
	print "stat $file\n" if ($print_cmdlist);
      } else {
	$unknown_calls{$syscall} = 1;
      }
    } else {
      print if ($debug);
    }
  }
}

sub read_cmdlist
{
  my $arch = `uname -m`;
  chomp $arch;
  $arch =~ s/i.86/i586/;  # we substed "i586" (and only that) into @ARCH@
  my $kernel_version = `uname -r`;
  chomp $kernel_version;
  while (<STDIN>) {
    chomp;
    s/\@ARCH\@/$arch/g;
    s/\@KERNEL_VERSION\@/$kernel_version/g;
    my ($cmd, $file) = split (/ +/);
    if ($cmd eq 'open') {
      push @opened_files, $file;
    } elsif ($cmd eq 'stat') {
      push @stated_files, $file;
    } elsif ($cmd eq 'statdir') {
      push @stated_dirs, $file;
    } elsif ($cmd eq 'statalldirs') {
      push @stated_alldirs, $file;
    } else {
      print "Unknown cmd $cmd\n";
    }
  }
}

# Invariant: No fragments overlap (except the pseudo fragment on block 0,
# for holes).  Hence we can represent each fragment just by its starting
# block, and don't check for overlap.
sub add_blocks ($$$$)
{
  my ($file, $startblock, $stride, $file_ofs) = @_;
  push (@{$file2blocks{$file}}, [$startblock, $stride, $file_ofs]);
  if (exists $block2file{$startblock}) {
    # This can happen with soft links.  We don't ignore softlinks
    # and instead look at the block of the file linked to
    #print "Block $startblock already seen (in $file vs. $block2file{$startblock}->[1]).\n";
  } else {
    $block2file{$startblock} = [$stride, $file, $file_ofs];
  }
}

sub gather_layout
{
  foreach my $f (@opened_files) {
    if (-e $f) {
      my $st = stat ($f);
      $file2stat{$f} = $st;
      my $blocks = qx{/sbin/print-bmap $f 2>/dev/null};
      if ($blocks) {
	chomp $blocks;
	my @blocks = split (/ +/, $blocks);
	my $num_holes = 0;
	my $file_ofs = 0;
	foreach my $block (@blocks) {
	  print "$f $block\n" if ($verbose);
	  if ($block eq 'e') {
	    $stat_files{$f} = 1;
	  } elsif ($block eq 't') {
	    if (exists $file2blocks{$f}) {
	      printf "Huh?  $f has tail _and_ normal blocks.\n";
	    } else {
	      $small_files{$f} = 1;
	    }
	    $num_holes = 0;
	  } elsif ($block eq 'h') {
	    # We handle holes by accounting them to the next fragment
	    # As holes are cheap to read, it's most efficient to include
	    # them in a normal read() call, instead of doing them out-of-order
	    $num_holes++;
	  } else {
	    my ($start_block, $stride) = split (/\+/, $block);
	    add_blocks ($f, $start_block, $stride + $num_holes, $file_ofs);
	    $file_ofs += $stride + $num_holes;
	    $num_holes = 0;
	  }
	}
	$file2size{$f} = $file_ofs;
      }
    } else {
      # We want to only stat non-existent files, as this will create
      # a dentry pointing to nothing
      $stat_files{$f} = 1;
    }
  }
  foreach my $f (@stated_files, @stated_dirs, @stated_alldirs) {
    $stat_files{$f} = 1;
    if (-e $f) {
      my $st = stat($f);
      $file2stat{$f} = $st;
    }
  }
  $stated_dirs{$_} = 1 foreach @stated_dirs;
  $stated_alldirs{$_} = 1 foreach @stated_alldirs;
}

my %file2state = ();
my @current_stack = ();
my ($last_file, $last_ofs, $last_len, $last_idx) = ('', 0, 0, -1);

sub flush_queue
{
  if ($verbose) {
    print "read $last_idx, fileofs $last_ofs, stride $last_len\n" if ($last_file);
  } else {
    print "R $last_idx $last_ofs $last_len\n" if ($last_file);
  }
  ($last_file, $last_ofs, $last_len, $last_idx) = ('', 0, 0, -1);
}

sub do_read ($$$$)
{
  my ($file, $idx, $file_ofs, $stride) = @_;
  # Try to merge with last read, but not over file borders
  if ($file eq $last_file && $last_ofs + $last_len == $file_ofs) {
    $last_len += $stride;
  } else {
    flush_queue();
    $last_file = $file;
    $last_ofs = $file_ofs;
    $last_len = $stride;
    $last_idx = $idx;
  }
}

sub print_commands
{
  # First we want all small and stated files sorted by their
  # inode.  file2stat contains the subset of stat and small files, which
  # exist.
  my @ordered = keys %file2stat;
  @ordered = sort { $file2stat{$a}->dev <=> $file2stat{$b}->dev
  		    || $file2stat{$a}->ino <=> $file2stat{$b}->ino } @ordered;
  foreach my $f (@ordered) {
    #print "$f: ". $file2stat{$f}->dev . ":" . $file2stat{$f}->ino . "\n";
    if (exists $small_files{$f}) {
      print "W $f\n";  # W == read Whole file
    } elsif (exists $stated_alldirs{$f}) {
      print "D $f\n";  # D == stat all dir entries, recursive
    } elsif (exists $stated_dirs{$f}) {
      print "d $f\n";  # d == stat all dir entries, nonrecursive
    } else {
      # Must be a simple stat
      print "S $f\n";
    }
  }
  # Stat the non-existent files
  # TODO sort these stats too, based on the inode of the containing
  # directory
  print "S $_\n" foreach sort grep (!exists $file2stat{$_}, keys %stat_files);
  # There are no small files which don't have a file2stat entry.

  # Now do the big files
  foreach my $block (sort {$a <=> $b} keys %block2file) {
    my ($stride, $file, $file_ofs) = @{$block2file{$block}};
    if (!exists $file2state{$file}) {
      push @current_stack, $file;
      print "O $file $#current_stack\n";
      $file2state{$file} = [$#current_stack, 0, 0];
    }
    my ($idx, $cur_ofs, $cur_len) = @{$file2state{$file}};
    do_read ($file, $idx, $file_ofs, $stride);
    $file2state{$file}->[1] += $stride;
    if ($file2state{$file}->[1] == $file2size{$file}) {
      flush_queue();
      print "C $file2state{$file}->[0]\n";
      if ($#current_stack == $file2state{$file}->[0]) {
	pop @current_stack;
      } else {
	$current_stack[$file2state{$file}->[0]] = '';
      }
    }
    #print "$block+".$block2file{$block}->[0]." ".$block2file{$block}->[1]."\@$block2file{$block}->[2] size=$file2size{$file}\n";
  }
  flush_queue();
}

our ($opt_c, $opt_s, $opt_p, $opt_d, $opt_h);
getopts ('cspdh');

if ($opt_h) {
  print "prepare_preload [-cspdh] < input\n";
  print "  -c input is a cmdfile, like in /etc/preload.d/*\n";
  print "  -s input is a strace dump (default)\n";
  print "  -p output is a cmdfile (makes sense only with strace input)\n";
  print "  -d print some debugging info\n";
  print "  -h print this help\n";
  print "By default this program produces output commands consumable by the\n";
  print "preload program.\n";
  exit 0;
}

$print_cmdlist = $opt_p;
$debug = $opt_d;

if (!$opt_p && $< != 0) {
  die "You must be root to get the layout of the disk";
}

if ($opt_c) {
  read_cmdlist;
} else {
  read_strace;
}
if (!$opt_p) {
  gather_layout;
  print_commands;
}

#print "open $_\n" foreach @opened_files;
#print "stat $_\n" foreach @stated_files;
if ($debug) {
  print "unknown syscall $_\n" foreach (keys %unknown_calls);
}
