#!/usr/local/bin/perl5 -w
#
# nasd_shell
#
# Scriptable NASD command shell
#
# Author: Nat Lanza
#
# Copyright (c) of Carnegie Mellon University, 1999.
#
# Permission to reproduce, use, and prepare derivative works of
# this software for internal use is granted provided the copyright
# and "No Warranty" statements are included with all reproductions
# and derivative works. This software may also be redistributed
# without charge provided that the copyright and "No Warranty"
# statements are included in all redistributions.
#
# NO WARRANTY. THIS SOFTWARE IS FURNISHED ON AN "AS IS" BASIS.
# CARNEGIE MELLON UNIVERSITY MAKES NO WARRANTIES OF ANY KIND, EITHER
# EXPRESSED OR IMPLIED AS TO THE MATTER INCLUDING, BUT NOT LIMITED
# TO: WARRANTY OF FITNESS FOR PURPOSE OR MERCHANTABILITY, EXCLUSIVITY
# OF RESULTS OR RESULTS OBTAINED FROM USE OF THIS SOFTWARE. CARNEGIE
# MELLON UNIVERSITY DOES NOT MAKE ANY WARRANTY OF ANY KIND WITH RESPECT
# TO FREEDOM FROM PATENT, TRADEMARK, OR COPYRIGHT INFRINGEMENT.
#

BEGIN {
  if (defined $ENV{NASD_ROOT}) { push @INC, "$ENV{NASD_ROOT}/utils/perl"; }
  elsif (-e "../perl/NASD/Shell.pm") { push @INC, "../perl"; }
  else { die "I can't find my libraries; please set NASD_ROOT "
	   . "to the top of your NASD tree.\n"; }
}

use strict;

use NASD::Shell qw(set_variable get_variable);
use NASD::PdriveClient;

my %commands = (bind        => \&nasd_shell_bind,
		create      => \&nasd_shell_create,
		driveinfo   => \&nasd_shell_driveinfo,
		eject       => \&nasd_shell_eject,
		flush       => \&nasd_shell_flush,
		getattr     => \&nasd_shell_getattr,
		initialize  => \&nasd_shell_initialize,
		listpart    => \&nasd_shell_listpart,
		noop        => \&nasd_shell_noop,
		null        => \&nasd_shell_null,
		partinfo    => \&nasd_shell_partinfo,
		partition   => \&nasd_shell_partition,
		password    => \&set_password,
		rangeread   => \&nasd_shell_rangeread,
		rangetread  => \&nasd_shell_rangetread,
		rangewrite  => \&nasd_shell_rangewrite,
		read        => \&nasd_shell_read,
		remove      => \&nasd_shell_remove,
		security    => \&set_security,
		setattr     => \&nasd_shell_setattr,
		sync        => \&nasd_shell_sync,
		tread       => \&nasd_shell_tread,
		unbind      => \&nasd_shell_unbind,
		write       => \&nasd_shell_write);

my %completions = (eject   => \&complete_ident_part,
		   flush   => \&complete_ident_part,
		   getattr => \&complete_ident_part,
		   remove  => \&complete_ident_part,
		   );

my %passwords; # partition passwords
my $default_password = 'password';
my $security_level = 0;

my %objects; # cached object list

my $pc = new NASD::PdriveClient;

if (@ARGV) { # implicit bind
  my $drive = shift;
  my ($rc, $response) = $pc->bind($drive);
  die "Couldn't bind to drive '$drive':\n\t$response\n" unless $rc;
}

print "NASD pdrive shell, enter 'help' for a list of commands\n";

NASD::Shell::register_commands(\%commands);
NASD::Shell::register_completions(\%completions);
NASD::Shell::set_prompt_func( sub { return "NASD> "; } );
  
NASD::Shell::shell_loop();

$pc->shutdown_client();

######################################################################
# command functions

sub handle_generic_response {
  my ($rc, $response) = @_;
  
  if ($rc) { if ($response =~ /^OK/) { return;                      }
	     else                    { print "$response\n";         }  }
  else     { if (defined $rc)        { print "$response\n";         }
	     else                    { print "huh?: '$response'\n"; }  }
}


sub set_password {
  my ($command, @args) = @_;
  if      (@args == 1) {
    my ($partnum) = @args;
    if (defined $passwords{$partnum}) {
      print "Partition $partnum password is '", $passwords{$partnum}, "'.\n";
    } else {
      print "Partition $partnum password unset, using default '",
            $default_password, "'.\n";
    }
  } elsif (@args == 2) {
    my ($partnum, $password) = @args;
    $passwords{$partnum} = $password;
    print "Partition $partnum password set to '", $passwords{$partnum}, "'.\n";
  } else {
    print "usage: password <partition> <password>\n";
    return;
  }
}


sub get_password {
  my ($partnum) = @_;

  if (defined $passwords{$partnum}) { return $passwords{$partnum}; }
  else                              { return $default_password;    }
}


sub set_security {
  my ($command, @args) = @_;
  if (@args < 1) { 
    print "Security level is $security_level.\n";
  } elsif (@args == 1) {
    $security_level = $args[0];
    print "Security level set to $security_level.\n";
  } else {
    print "usage: security [securelevel]\n";
  }
}


sub add_security_info {
  my ($partition, @args) = @_;
  my $part = $args[0];
  push @args, $security_level, get_password($part);
  return @args;
}


sub nasd_shell_bind {
  my ($command, @args) = @_;

  my ($rc, $response, $unused) = $pc->bind(@args);

  handle_generic_response($rc, $response);
  return unless $rc;

  set_variable("drive", $args[0]);
}


sub nasd_shell_create {
  my ($command, @args) = @_;

  do { print "usage: create <partnum>\n"; return; } unless @args == 1;

  my ($rc, $response, $object) =
    $pc->create(add_security_info($args[0], @args));
  
  handle_generic_response($rc, $response);
  return unless $rc;

  print "Created object $object.\n";

  $objects{$object} = 1; # cache the object ID

  set_variable("lastobj", $object);
}


sub nasd_shell_driveinfo {
  my ($command, @args) = @_;

  do { print "usage: driveinfo\n"; return; } if @args;

  my ($rc, $response, $dinfo) = 
    $pc->driveinfo(add_security_info($args[0], @args));
  
  handle_generic_response($rc, $response);
  return unless $rc;

  my $free_blocks = $dinfo->{num_blocks} - $dinfo->{blocks_allocated};

  my $total_space = $dinfo->{num_blocks}       * $dinfo->{blocksize} / 1048576;
  my $free_space  = $free_blocks               * $dinfo->{blocksize} / 1048576;
  my $used_space  = $dinfo->{blocks_allocated} * $dinfo->{blocksize} / 1048576;

  print $dinfo->{num_parts}, " of a maximum of ", $dinfo->{max_parts},
    " partition", ($dinfo->{max_parts} == 1 ? "" : "s"),
      " currently configured.\n";
  print $dinfo->{blocks_allocated}, " of a maximum of ", $dinfo->{num_blocks},
    " block", ($dinfo->{num_blocks} == 1 ? "" : "s"),
      " allocated, $free_blocks block", ($free_blocks == 1 ? "" : "s"),
	" free.\n";
  printf "Using %d byte blocks, %.01f MB of %.01f MB used, %.01f MB free.\n",
    $dinfo->{blocksize}, $used_space, $total_space, $free_space;
}


sub nasd_shell_eject {
  my ($command, @args) = @_;

  do { print "usage: eject <identifier> <partition>\n"; return; }
    unless @args == 2;

  my ($rc, $response, $unused) =
    $pc->eject(add_security_info($args[1], @args));

  handle_generic_response($rc, $response);
  return unless $rc;

  print "Ejected object $args[0]:$args[1] from the drive cache.\n";
}


sub nasd_shell_flush {
  my ($command, @args) = @_;

  do { print "usage: flush <identifier> <partition>\n"; return; }
    unless @args == 2;

  my ($rc, $response, $unused) = 
    $pc->flush(add_security_info($args[1], @args));

  handle_generic_response($rc, $response);
  return unless $rc;

  print "Flushed object $args[0]:$args[1] to stable store.\n";
}


sub nasd_shell_getattr {
  my ($command, @args) = @_;
  
  do { print "usage: getattr <identifier> <partnum>\n"; return; }
    unless @args == 2;
  
  my ($rc, $response, $attr) =
    $pc->getattr(add_security_info($args[0], @args));

  handle_generic_response($rc, $response);
  return unless $rc;

  $attr->{attr_modify_time}      =~ s/:.*$//;
  $attr->{object_modify_time}    =~ s/:.*$//;
  $attr->{object_create_time}    =~ s/:.*$//;
  $attr->{fs_attr_modify_time}   =~ s/:.*$//;
  $attr->{fs_object_modify_time} =~ s/:.*$//;

  print "Object size is ", ($attr->{blocks_used} * $attr->{block_size}),
    " bytes ($attr->{blocks_used} blocks, ",
      "$attr->{block_size} bytes per block).\n";
  print "Object length is              $attr->{object_len}.\n";
  print "Object attribute version is   $attr->{av}.\n";
  print "Object layout hint is         $attr->{layout_hint}.\n";
  print "Object block preallocation is $attr->{block_preallocation}.\n";

  print "Object created:               ",
    scalar(localtime($attr->{object_create_time})), ".\n";
  print "Object last modified:         ",
    scalar(localtime($attr->{object_modify_time})), ".\n";
  print "Attributes last modified:     ",
    scalar(localtime($attr->{attr_modify_time})), ".\n";
  print "FS attributes last modified:  ",
    scalar(localtime($attr->{fs_attr_modify_time})), ".\n";
  print "FS Object last modified:      ",
    scalar(localtime($attr->{fs_object_modify_time})), ".\n";
}


sub nasd_shell_initialize {
  my ($command, @args) = @_;
  
  do { print "usage: initialize <password>\n"; return; } unless @args == 1;
  
  my ($rc, $response, $unused) = $pc->initialize(@args);
  handle_generic_response($rc, $response);
  return unless $rc;

  print "Drive initialized.\n";
}

sub nasd_shell_listpart {
  my ($command, @args) = @_;
  
  do { print "usage: listpart <partition>\n"; return; } unless @args == 1;
  
  my ($rc, $response, $objlistref) = 
    $pc->listpart(add_security_info($args[0], @args));
  
  handle_generic_response($rc, $response);
  return unless $rc;

  foreach (@$objlistref) { $objects{$_} = 1; } # cache the object IDs
  print join("\n", @$objlistref, "");
}


sub nasd_shell_noop {
  my ($command, @args) = @_;

  do { print "usage: noop\n"; return; } if @args;

  my ($rc, $response, $unused) = $pc->noop();

  handle_generic_response($rc, $response);
  return unless $rc;

  print "Ok\n";
}


sub nasd_shell_null {
  my ($command, @args) = @_;

  do { print "usage: null\n"; return; } if @args;

  my ($rc, $response, $unused) = $pc->null();

  handle_generic_response($rc, $response);
  return unless $rc;
}


sub nasd_shell_partinfo {
  my ($command, @args) = @_;

  do { print "usage: partinfo <partnum>\n"; return; } unless @args == 1;

  my ($rc, $response, $pinfo) = 
    $pc->partinfo(add_security_info($args[0], @args));
  
  handle_generic_response($rc, $response);
  return unless $rc;

  $objects{$pinfo->{first_obj}} = 1; # cache root object id

  print "Partition base object is ", $pinfo->{first_obj}, "\n";
  print $pinfo->{num_obj}, " of a maximum of ", $pinfo->{max_objs},
    " objects exist.\n";
  print "Partition contains ", $pinfo->{part_size}, " block",
    ($pinfo->{part_size} == 1 ? "" : "s"),
      " (blocksize ", $pinfo->{blocksize}, ")\n";  
  print $pinfo->{blocks_used}, " block",
    ($pinfo->{blocks_used} == 1 ? " is " : "s are"), "used, ", 
      $pinfo->{blocks_allocated}, " ",
	($pinfo->{blocks_allocated} == 1 ? "is" : "are"), " allocated\n";
}


sub nasd_shell_partition {
  my ($command, @args) = @_;

  do { print "usage: partition <partnum> <blocks> <protection> <password>\n";
       return; } unless @args == 4;

  my ($rc, $response, $unused) = $pc->partition(@args);

  handle_generic_response($rc, $response);
}


sub nasd_shell_rangeread { }

sub nasd_shell_rangetread { }

sub nasd_shell_rangewrite { }


sub nasd_shell_read {
  my ($command, @args) = @_;
  $command = lc $command;

  if      (@args == 5) {
    if (!open(OUTPUT, ">$args[4]")) { print "Can't open file!\n"; return; }
  } elsif (@args == 4) {
    *OUTPUT = *STDOUT;  
  } else {
    print "usage: $command <partnum> <ident> <offset> <len> [file]\n";
    return;
  }

  my ($rc, $response, $data) =
    $pc->read(add_security_info($args[0], @args));

  handle_generic_response($rc, $response);
  return unless $rc;
  
  print OUTPUT $data;
}


sub nasd_shell_remove {
  my ($command, @args) = @_;

  do { print "usage: remove <ident> <partnum>\n"; return; } unless @args == 2;

  my ($rc, $response, $unused) =
    $pc->remove(add_security_info($args[0], @args));
  
  handle_generic_response($rc, $response);

  return unless $rc;
  
  if (defined($objects{$args[0]})) { undef $objects{$args[0]}; }
}

sub nasd_shell_setattr { }
sub nasd_shell_sync { }
sub nasd_shell_tread { }

sub nasd_shell_write {
  my ($command, @args) = @_;
  my $data = "";
  $command = lc $command;

  if      (@args == 5) {
    if (!open(INPUT, "<$args[4]")) { print "Can't open file!\n"; return; }
  } elsif (@args == 4) {
    *INPUT = *STDIN;  
  } else {
    print "usage: $command <partnum> <ident> <offset> <len> [file]\n";
    return;
  }

  # get the data
  my $len_wanted = $args[3];
  my $len_read = sysread INPUT, $data, $len_wanted;
  if ($len_read < $len_wanted) {
    print "Got less data than expected; writing $len_read bytes\n";
    $args[3] = $len_read;
  }

  my ($rc, $response, $unused) =
    $pc->write(add_security_info($args[0], @args));

  handle_generic_response($rc, $response);

  return unless $rc;

  send_data($data);
  
  handle_generic_response($rc, $response);
}


sub nasd_shell_unbind { }

######################################################################
# completion commands

sub complete_ident_part {
  my ($word, $pos, $wordno, @words) = @_;
  if ($wordno == 1) { return grep {/^$word/} keys %objects; }
  else              { return (); }
}

