1#!/usr/bin/perl -w
2
3use bytes;	# no unicode
4
5$| = 1;
6my $header;
7my $message;
8my %memory;
9while(sysread(STDIN, $header, 8) == 8) {
10
11  (my $magic, my $length) = unpack('N2', $header);
12  if ($magic != 0xbeefdead || $length < 8) {
13    die("Bad header: " . unpack('H*', $header) . "!\n");
14  }
15  $length -= 8;
16
17  if (sysread(STDIN, $message, $length) != $length) {
18    die("read($length): $!\n");
19  }
20
21  # Walk through the message
22
23  undef $op;
24  undef $key;
25  undef $pairs;
26  for(my $ofs = 0; $ofs < $length; $ofs += $skiplen) {
27
28    # Decode the pair
29
30    (my $sva, my $len) = unpack('@' . $ofs . 'A[12] N', $message);
31    $ofs += 16;
32    $skiplen = ($len + 3) & ~3;
33    my $val = unpack('@' . $ofs . 'a[' . $skiplen . ']', $message);
34
35    print STDERR  unpack('H*', $sva) . "\t" .
36		  unpack('H*', $val) . "\n";
37
38    # Save last instances of 'op' and 'key'; save rest in our pairs structure,
39    # which is a hash keyed by the attribute tuple, containing an array
40    # reference
41    # to by a hash element with the space, vendor attribute tuple as the key.
42
43    if ($sva eq "\x00\x00\x00\x64\x80\x00\x00\x00\x00\x00\x00\x84") {
44      $op = unpack('N', $val);
45    } elsif ($sva eq "\x00\x00\x00\x64\x80\x00\x00\x00\x00\x00\x00\x85") {
46      $key = $val;
47    } else {
48      push @{$pairs->{$sva}}, [ $len, $val ];
49    }
50  }
51
52  # If we didn't get a key, respond with int=-1 and we're done.
53
54  unless (defined $key) {
55    print STDERR "Didn't get a key, ignorning message.\n";
56    print "\xde\xad\xbe\xef\x00\x00\x00\x1c" .
57	  "\x00\x00\x00\x64\x80\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x04" .
58	    "\xff\xff\xff\xff";
59    next;
60  }
61
62  print STDERR "Got request " . $op . " for key [" . $key . "]\n";
63
64  # Act on the requested operation
65
66  $ret = defined $memory{$key};
67  $reppkt = '';
68
69  if ($op == 1) {				  # Store
70    $memory{$key} = $pairs;
71  } elsif ($op == 4 || $op == 5) {		  # Load, Load-Purge
72    $pairs = $memory{$key};
73    $ret = 0;
74    foreach my $sva (keys %$pairs) {
75      foreach my $pair (@{$pairs->{$sva}}) {
76	print STDERR unpack('H*', $sva) . ":\t" . $pair->[0] . "\t" . unpack('H8', $pair->[1]) . "\t" . $pair->[1] . "\n";
77	$reppkt .= $sva . pack('Na*x![N]', $pair->[0], $pair->[1]);
78	$ret++;
79      }
80    }
81  }
82  if ($op == 5 || $op == 6) { undef $memory{$key}; }  # Load-Purge, Purge
83
84  # Respond with an instance of 'int'
85
86  print "\xde\xad\xbe\xef" . pack('N', length($reppkt) + 0x1c) .
87	$reppkt .
88        "\x00\x00\x00\x64\x80\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x04" .
89	  pack('N', $ret);
90}
91
92die("EOF on input - exiting");
93
94# vim:softtabstop=2:sw=2
95
96