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