X-Git-Url: http://git.maemo.org/git/?p=xmlrpc-c;a=blobdiff_plain;f=tools%2Fbinmode-rpc-kit%2Fbinmode-rpc2xml-rpc;fp=tools%2Fbinmode-rpc-kit%2Fbinmode-rpc2xml-rpc;h=2625629bd98772e1818af51c9d3592278025d9bf;hp=0000000000000000000000000000000000000000;hb=ce67d0cdeaa37c3e856e23ae4010480887165630;hpb=e355d4e7962400470f467b88f5568de9c8324475;ds=sidebyside diff --git a/tools/binmode-rpc-kit/binmode-rpc2xml-rpc b/tools/binmode-rpc-kit/binmode-rpc2xml-rpc new file mode 100755 index 0000000..2625629 --- /dev/null +++ b/tools/binmode-rpc-kit/binmode-rpc2xml-rpc @@ -0,0 +1,552 @@ +#!/usr/bin/perl -w + +use strict; + +# Some constants. +my $crlf = "\015\012"; + +# Try to load our external libraries, but fail gracefully. +eval { + require Frontier::Client; + require MIME::Base64; +}; +if ($@) { + print STDERR <<"EOD"; +This script requires Ken MacLeod\'s Frontier::RPC2 module. You can get this +from CPAN or from his website at http://bitsko.slc.ut.us/~ken/xml-rpc/ . + +For installation instructions, see the XML-RPC HOWTO at: + http://www.linuxdoc.org/HOWTO/XML-RPC-HOWTO/index.html + +This script also requires MIME::Base64. You can get this from CPAN. +EOD + exit 1; +} + +# Parse our command-line arguments. +if (@ARGV != 0) { + print STDERR "Usage: binmode-rpc2xml-rpc < data.binmode > data.xml\n"; + exit 1; +} + +# Perform our I/O in binary mode (hence the name of the protocol). +binmode STDIN; # Because we're reading raw binary data. +binmode STDOUT; # Because we want our XML left unmolested. + +# Just suck all our input into one string and glom it together. +my $binmode_data = join('', ); + +# Check for the mandatory header. +unless ($binmode_data =~ /^binmode-rpc:/) { + die "$0: No 'binmode-rpc:' header present, stopping"; +} + +# Set our decoding-position counter to point just past the header, and +# our end pointer to just beyond the end of the entire message. +my $position = length('binmode-rpc:'); +my $end = length($binmode_data); + +# Set our starting output indentation to zero (for the pretty-printer). +my $indentation = 0; + +# Build an empty codebook of strings. +my @codebook; + +# Begin the hard work. +decode_call_or_response(); + +# Print a warning if there's leftover data. +if ($position != $end) { + printf STDERR "binmode-rpc2xml-rpc: warning: Trailing data ignored\n"; +} + +# We're done! +exit (0); + + +#-------------------------------------------------------------------------- +# Pretty-printing +#-------------------------------------------------------------------------- + +sub escape_string ($) { + my ($string) = @_; + $string =~ s/&/&/g; + $string =~ s/= 0) { + die "Perl can't handle 32-bit unsigned integers portably, stopping"; + } + return $integer; +} + +sub read_signed_lsb () { + die "Unexpected end of input" unless ($position + 4 <= $end); + my $integer = unpack('V', substr($binmode_data, $position, 4)); + $position += 4; + die "Weird error decoding integer" unless (defined $integer); + return $integer; +} + +sub read_data ($) { + my ($length) = @_; + die "Unexpected end of input" unless ($position + $length <= $end); + my $data = unpack("a$length", substr($binmode_data, $position, $length)); + $position += $length; + die "Weird error decoding data" unless (defined $data); + die "Wrong data length" unless (length($data) == $length); + return $data; +} + +sub read_data_w_byte_length () { + my $length = read_byte(); + return read_data($length); +} + +sub read_data_w_unsigned_lsb_length () { + my $length = read_unsigned_lsb(); + return read_data($length) +} + +sub read_string_data () { + my $string = read_data_w_unsigned_lsb_length(); + validate_utf8($string); + return $string; +} + + +#-------------------------------------------------------------------------- +# High-level input routines +#-------------------------------------------------------------------------- +# These use the low-level input routines to read data from the buffer, +# and then convert it into Frontier::RPC2 objects. + +sub read_value () { + my $type = read_character(); + #print STDERR "DEBUG: Reading from '$type'\n"; + if ($type eq 'I') { + return _read_int_value(); + } elsif ($type eq 't') { + return Frontier::RPC2::Boolean->new(1); + } elsif ($type eq 'f') { + return Frontier::RPC2::Boolean->new(0); + } elsif ($type eq 'D') { + return _read_double_value(); + } elsif ($type eq '8') { + return _read_dateTime_value(); + } elsif ($type eq 'B') { + return _read_base64_value(); + } elsif ($type eq 'A') { + return _read_array_value(); + } elsif ($type eq 'S') { + return _read_struct_value(); + } elsif ($type eq 'U') { + return _read_regular_string_value(); + } elsif ($type eq '>') { + return _read_recorded_string_value(); + } elsif ($type eq '<') { + return _read_recalled_string_value(); + } elsif ($type eq 'O') { + die "Type 'O' Binmode RPC data not supported"; + } else { + die "Type '$type' Binmode RPC data does not exist"; + } +} + +sub read_value_and_typecheck ($) { + my ($wanted_type) = @_; + my $value = read_value(); + my $value_type = ref($value); + die "$0: Expected $wanted_type, got $value_type, stopping" + unless ($wanted_type eq $value_type); + return $value; +} + +sub _read_int_value () { + return Frontier::RPC2::Integer->new(read_signed_lsb); +} + +sub _read_double_value () { + return Frontier::RPC2::Double->new(read_data_w_byte_length); +} + +sub _read_dateTime_value () { + return Frontier::RPC2::DateTime::ISO8601->new(read_data_w_byte_length); +} + +sub _read_base64_value () { + my $binary = read_data_w_unsigned_lsb_length; + my $encoded = MIME::Base64::encode_base64($binary, $crlf); + return Frontier::RPC2::Base64->new($encoded); +} + +sub _read_array_value () { + my $size = read_unsigned_lsb; + my @values; + for (my $i = 0; $i < $size; $i++) { + push @values, read_value; + } + return \@values; +} + +sub _read_struct_value () { + my $size = read_unsigned_lsb; + my %struct; + for (my $i = 0; $i < $size; $i++) { + my $key = read_value_and_typecheck('Frontier::RPC2::String'); + $struct{$key->value} = read_value; + } + return \%struct; +} + +sub _read_regular_string_value () { + return Frontier::RPC2::String->new(read_string_data); +} + +sub _read_recorded_string_value () { + my $codebook_entry = read_byte; + my $string = Frontier::RPC2::String->new(read_string_data); + $codebook[$codebook_entry] = $string; + return $string; +} + +sub _read_recalled_string_value () { + my $codebook_entry = read_byte; + my $string = $codebook[$codebook_entry]; + unless (defined $string) { + die "$0: Attempted to use undefined codebook position $codebook_entry"; + } + return $string; +} + + +#-------------------------------------------------------------------------- +# High-level output routines +#-------------------------------------------------------------------------- +# We don't use Frontier::RPC2's output routines, because we're looking +# for maximum readability. This is a debugging tool, after all. + +sub print_xml_header () { + print_xml_line ''; +} + +sub get_escaped_string ($) { + my ($value) = @_; + return escape_string($value->value); +} + +sub print_simple_value ($$) { + my ($tag, $value) = @_; + my $string = get_escaped_string($value); + print_xml_line "<$tag>$string"; +} + +sub print_value ($) { + my ($value) = @_; + my $type = ref($value); + if ($type eq 'Frontier::RPC2::Integer') { + print_simple_value("int", $value); + } elsif ($type eq 'Frontier::RPC2::Double') { + print_simple_value("double", $value); + } elsif ($type eq 'Frontier::RPC2::Boolean') { + print_simple_value("boolean", $value); + } elsif ($type eq 'Frontier::RPC2::String') { + print_simple_value("string", $value); + } elsif ($type eq 'Frontier::RPC2::DateTime::ISO8601') { + print_simple_value("dateTime.iso8601", $value); + } elsif ($type eq 'Frontier::RPC2::Base64') { + print_base64_data($value); + } elsif ($type eq 'ARRAY') { + print_array_value($value); + } elsif ($type eq 'HASH') { + print_struct_value($value); + } else { + die "Unxpected type '$type', stopping"; + } +} + +sub print_params ($) { + my ($params) = @_; + + die "Wanted array" unless (ref($params) eq 'ARRAY'); + + print_xml_line ''; + push_indentation_level; + + foreach my $item (@$params) { + print_xml_line ''; + push_indentation_level; + print_value($item); + pop_indentation_level; + print_xml_line ''; + } + + pop_indentation_level; + print_xml_line ''; +} + +sub print_base64_data ($) { + my ($value) = @_; + print_xml_line ''; + push_indentation_level; + print_xml_line ''; + print $value->value; + print_xml_line ''; + pop_indentation_level; + print_xml_line ''; +} + +sub print_array_value ($) { + my ($array) = @_; + + print_xml_line ''; + push_indentation_level; + print_xml_line ''; + push_indentation_level; + print_xml_line ''; + push_indentation_level; + + foreach my $item (@$array) { + print_value($item); + } + + pop_indentation_level; + print_xml_line ''; + pop_indentation_level; + print_xml_line ''; + pop_indentation_level; + print_xml_line ''; +} + +sub print_struct_value ($) { + my ($struct) = @_; + + print_xml_line ''; + push_indentation_level; + print_xml_line ''; + push_indentation_level; + + for my $key (keys %$struct) { + print_xml_line ''; + push_indentation_level; + + my $name = escape_string($key); + print_xml_line "$name"; + print_value($struct->{$key}); + + pop_indentation_level; + print_xml_line ''; + } + + pop_indentation_level; + print_xml_line ''; + pop_indentation_level; + print_xml_line ''; +} + + +#-------------------------------------------------------------------------- +# High-level decoder routines +#-------------------------------------------------------------------------- +# These routines convert Binmode RPC data into the corresponding XML-RPC +# documents. + +sub decode_call_or_response () { + my $type = read_character(); + if ($type eq 'C') { + decode_call(); + } elsif ($type eq 'R') { + decode_response(); + } else { + die "$0: Unknown binmode-rpc request type '$type', stopping"; + } +} + +sub decode_call () { + my $namevalue = read_value_and_typecheck('Frontier::RPC2::String'); + my $params = read_value_and_typecheck('ARRAY'); + + print_xml_header; + print_xml_line ''; + push_indentation_level; + + my $name = get_escaped_string($namevalue); + print_xml_line "$name"; + + print_params($params); + + pop_indentation_level; + print_xml_line ''; +} + +sub decode_response () { + my $maybe_fault = peek_character; + if ($maybe_fault eq 'F') { + read_character; + my $fault = read_value_and_typecheck('HASH'); + print_xml_header; + + print_xml_line ''; + push_indentation_level; + print_xml_line ''; + push_indentation_level; + + print_value $fault; + + pop_indentation_level; + print_xml_line ''; + pop_indentation_level; + print_xml_line ''; + } else { + my $value = read_value; + print_xml_header; + print_xml_line ''; + push_indentation_level; + print_params [$value]; + pop_indentation_level; + print_xml_line ''; + } +} + + +#-------------------------------------------------------------------------- +# UTF-8 Validation +#-------------------------------------------------------------------------- +# This is based on the UTF-8 section of the Secure Programs HOWTO. +# http://new.linuxnow.com/docs/content/HOWTO/Secure-Programs-HOWTO/ +# This code *hasn't* been stress-tested for correctness yet; please see: +# http://www.cl.cam.ac.uk/~mgk25/ucs/examples/UTF-8-test.txt +# This is not yet good enough to be used as part of a UTF-8 decoder or +# security validator, but it's OK to make sure nobody is sending Latin-1. + +BEGIN { + + use vars qw{@illegal_initial_bytes @sequence_length_info}; + + # Bytes are represented as data/mask pairs. + @illegal_initial_bytes = + (# 10xxxxxx illegal as initial byte of char (80..BF) + [0x80, 0xC0], + # 1100000x illegal, overlong (C0..C1 80..BF) + [0xC0, 0xFE], + # 11100000 100xxxxx illegal, overlong (E0 80..9F) + [0xE0, 0xFF, 0x80, 0xE0], + # 11110000 1000xxxx illegal, overlong (F0 80..8F) + [0xF0, 0xFF, 0x80, 0xF0], + # 11111000 10000xxx illegal, overlong (F8 80..87) + [0xF8, 0xFF, 0x80, 0xF8], + # 11111100 100000xx illegal, overlong (FC 80..83) + [0xFC, 0xFF, 0x80, 0xFC], + # 1111111x illegal; prohibited by spec + [0xFE, 0xFE]); + + # Items are byte, mask, sequence length. + @sequence_length_info = + (# 110xxxxx 10xxxxxx + [0xC0, 0xE0, 2], + # 1110xxxx 10xxxxxx 10xxxxxx + [0xE0, 0xF0, 3], + # 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx + [0xF0, 0xF8, 4], + # 111110xx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx + [0xF8, 0xFC, 5], + # 1111110x 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx + [0xFC, 0xFE, 6]); +} + +sub validate_utf8 ($) { + my ($string) = @_; + my $end = length($string); + + my $i = 0; + while ($i < $end) { + my $byte = ord(substr($string, $i, 1)); + #print STDERR "Checking byte $byte\n"; + + # Check for illegal bytes at the start of this sequence. + NEXT_CANDIDATE: + foreach my $illegal_byte_info (@illegal_initial_bytes) { + my $offset = 0; + for (my $j = 0; $j < @$illegal_byte_info; $j += 2) { + my $pattern = $illegal_byte_info->[$j]; + my $mask = $illegal_byte_info->[$j+1]; + my $data = ord(substr($string, $i+$offset, 1)); + #print STDERR " B: $byte P: $pattern M: $mask D: $data\n"; + next NEXT_CANDIDATE unless ($data & $mask) == $pattern; + $offset++; + } + die "Illegal UTF-8 sequence (" . substr($string, $i, 2) . ")"; + } + + # Find the length of the sequence, and make sure we have enough data. + my $length = 1; + foreach my $length_info (@sequence_length_info) { + my ($pattern, $mask, $length_candidate) = @$length_info; + if (($byte & $mask) == $pattern) { + $length = $length_candidate; + last; + } + } + die "$0: Unexpected end of UTF-8 sequence, stopping" + unless $i + $length <= $end; + + # Verify the sequence is well-formed. + $i++, $length--; + while ($length > 0) { + die "$0: Malformed UTF-8 sequence, stopping" + unless (ord(substr($string, $i, 1)) & 0xC0) == 0x80; + $i++, $length--; + } + } + #printf STDERR "DEBUG: Verified $i bytes\n"; +}