#!/usr/bin/perl -w

# Space, Vendor, Number tuple for attributes we use

$INT		    = "\x00\x00\x00\x64\x80\x00\x00\x00\x00\x00\x00\x01";
$OP		    = "\x00\x00\x00\x64\x80\x00\x00\x00\x00\x00\x00\x84";
$KEY		    = "\x00\x00\x00\x64\x80\x00\x00\x00\x00\x00\x00\x85";

# Values for item OP

$OP_Store	    = 1;
$OP_Store_Newkey    = 2;
# Not implemented:
# $OP_Replace	    = 3;
# $OP_Add	    = 4;
# $OP_Concat	    = 5;
$OP_Load	    = 6;
$OP_Load_Purge	    = 7;
$OP_Purge	    = 8;

use bytes;	# not unicode

$DEBUG = 0;

$| = 1;
my $header;
my $message;
my %memory;
while(sysread(STDIN, $header, 8) == 8) {

  (my $magic, my $length) = unpack('N2', $header);
  if ($magic != 0xbeefdead || $length < 8) { 
    die("Bad header: " . unpack('H*', $header) . "!\n"); 
  }
  $length -= 8;
  
  if (sysread(STDIN, $message, $length) != $length) { 
    die("read($length): $!\n"); 
  }

  # Walk through the message

  undef $op;
  undef $key;
  undef $pairs;
  for(my $ofs = 0; $ofs < $length; $ofs += $skiplen) {

    # Decode the pair 

    (my $sva, my $len) = unpack('@' . $ofs . 'A[12] N', $message);
    $ofs += 16;
    $skiplen = ($len + 3) & ~3;
    my $val = unpack('@' . $ofs . 'a[' . $skiplen . ']', $message);

    $DEBUG and print STDERR unpack('H*', $sva) . "\t" . 
			    unpack('H*', $val) . "\n";

    # Save last instances of 'op' and 'key'; save rest in our pairs structure,
    # which is a hash keyed by the attribute tuple, containing a reference to
    # an array containing instances, each being a reference to a two element
    # array containing the value's length and the value.

    if ($sva eq $OP)	  { $op = unpack('N', $val); }
    elsif ($sva eq $KEY)  { $key = $val; } 
    else		  { push @{$pairs->{$sva}}, [ $len, $val ]; }
  }

  # If we didn't get a key, respond with int=-1 and we're done.

  unless (defined $key) {
    print STDERR "Didn't get a key, ignorning message.\n";
    print "\xde\xad\xbe\xef\x00\x00\x00\x1c" .
	  "\x00\x00\x00\x64\x80\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x04" .
	    "\xff\xff\xff\xff";
    next;
  }

  $DEBUG and print STDERR "Got request " . $op . " for key [" . $key . "]\n";

  # Act on the requested operation
  
  $ret = defined $memory{$key};
  $reppkt = '';

  if ($op == $OP_Store || $op == $OP_Store_Newkey) {

    # Store, Store-Newkey

    if ($op == $OP_Store_Newkey) {

      # Increment key while exists and return the generated key

      $key++ while(defined $memory{$key});
      $reppkt .= $KEY . pack('Na*x![N]', length($key), $key);
    }
    $memory{$key} = $pairs;
  } 
  elsif ($op == $OP_Load || $op == $OP_Load_Purge) {
  
    # Load, Load-Purge

    $ret = 0;
    $pairs = $memory{$key};
    foreach my $sva (keys %$pairs) {
      foreach my $pair (@{$pairs->{$sva}}) {
	$DEBUG and print STDERR "Adding " . unpack("H*", $pair->[1]) . "\n";
	$reppkt .= $sva . pack('Na*x![N]', $pair->[0], $pair->[1]);
	$ret++;
      }
    }
  }

  if ($op == $OP_Load_Purge || $op == $OP_Purge) { 

    # Load-Purge, Purge

    undef $memory{$key}; 
  }  

  # Respond with an instance of 'int' containing the value of $ret

  print "\xde\xad\xbe\xef" . pack('N', length($reppkt) + 0x1c) . 
	$reppkt . $INT . pack('NN', 4, $ret);
}

die("EOF on input - exiting"); 

# vim:softtabstop=2:sw=2

