#!/usr/bin/perl -w
#
# smscemulator:
# Emulate an SMSC using the UCP protocol.
#
# Copyright (c) 2002 Chris Lightfoot. All rights reserved.
# Email: chris@ex-parrot.com; WWW: http://www.ex-parrot.com/~chris/
#

my $rcsid = ''; $rcsid .= '$Id: smscemulator,v 1.1 2002/12/03 21:12:58 chris Exp $';

use IO::Socket;
use Data::Dumper;

=item ira_encode ASCII

Encode ASCII string into IRA.

=cut
sub ira_encode ($) {
    my ($x) = unpack("H*", $_[0]);
    return uc($x);
}

=item ira_decode IRA

Decode IRA string into ASCII.

=cut
sub ira_decode ($) {
    my ($x) = pack("H*", $_[0]);
    return $x;
}

=item ucp_parse STRING

Parse STRING as a UCP message, returning a reference to a hash of the message
or an error string on failure.

=cut
sub ucp_parse ($) {
    my $str = shift;
    my %res = ( );
    
    # start/end
    return "STX not present" unless $str =~ /^\x02/;
    return "ETX not present" unless $str =~ /\x03$/;
    
    # split header, message
    my ($hdr, $msg, $csum) = ($str =~ m#^.(.{13})/(.+)/([0-9a-f]{2}).$#i);
    return "bad message format" unless (defined($hdr) and defined($msg) and defined($csum));

    # verify checksum.
    my $sum = 0;
    map { $sum += ord($_); } split(//, substr($str, 1, length($str) - 4));
    $sum = sprintf("%02x", $sum & 0xff);
    return "bad checksum (packet $csum, ours $sum)" unless (lc($sum) eq lc($csum));

    # break up header
    my ($trn, $len, $or, $ot) = ($hdr =~ m#^(\d{2})/(\d{5})/([OR])/(\d{2})#);
    return "bad header format" unless (defined($trn) and defined($len) and defined($or) and defined($ot));

    return "bad message length" unless ($len == (length($str) - 2));

    $res{transno} = int($trn);
    $res{isresult} = ($or eq 'R') ? 1 : 0;
    $res{type} = int($ot);

    # remaining fields....
    $res{fields} = [split(/\//, $msg)];

    return \%res;
}

=item ucp_make HASH

Turn HASH into a UCP message.

=cut
sub ucp_make ($) {
    my $hash = shift;
    my $res = "\x02";

    # assemble message and determine its length
    my $m = join("/", @{$hash->{fields}});
    my $len = 13                    # hdr len
              + 1 + length($m) + 1  # message, enclosing //
              + 2;                  # checksum
    
    
    $res .= sprintf("%02d/%05d/%s/%02d/$m/", $hash->{transno}, $len, $hash->{isresult} ? 'R' : 'O', $hash->{type});

    # compute checksum
    my $sum = 0;
    map { $sum += ord($_); } split(//, substr($res, 1));

    $res .= sprintf("%02X", $sum & 0xff) . "\x03";

    return $res;
}

sub strdump ($) {
    my $txt = shift;
    $txt =~ s#([^A-z0-9/.\-_])#sprintf("\\%02x", ord($1))#gie;
    return $txt;
}

my %handlers = (
        60 => sub ($) {
            my $msg = shift;
            print STDERR "$$: received 60 log on message, acknowledging\n";
            return ucp_make({
                        type => 60,
                        transno => $msg->{transno},
                        isresult => 1,
                        fields => [
                                'A',
                                ira_encode("welcome aboard")
                            ]
                    });
        },

        51 => sub ($) {
            my $msg = shift;
            my ($AdC, $OAdC, $AC, $NRq, $NAdC, $NT, $NPID, $LRq, $LRAd, $LPID, $DD, $DDT, $VP, $RPID, $SCTS, $Dst, $Rsn, $DSCTS, $MT, $NB, $N_or_A_Msg, $MMS, $PR, $DCs, $MCLs, $RPI, $CPg, $RPLy, $OTOA, $HPLMN, $XSer, $RES4, $RES5) = @{$msg->{fields}};
            print STDERR "$$: received 51 send operation\n";
            print STDERR "    recipient is $AdC, message is ";
            if ($MT == 2) {
                print STDERR "$N_or_A_Msg\n";
            } else {
                print STDERR ira_decode($N_or_A_Msg), "\n";
            }
            
            return ucp_make({
                    type => 51,
                    transno => $msg->{transno},
                    isresult => 1,
                    fields => [
                            'A', '', "$AdC:020101120000"
                        ]
                });
        }

    );

=item do_smsc SOCKET

Handle UCP coming in on SOCKET.

=cut
sub do_smsc ($) {
    my $sock = shift;
    my $buf = "";
    my $res;

    while (1) {
        $res = $sock->sysread($buf, 16, length($buf));
        last if (!defined($res) || $res == 0);

        # may have a complete message
        if ($buf =~ /^(\x02[^\x03]+\x03)/) {
            my $msg = ucp_parse($1);
            $buf = substr($buf, length($1));

            if (ref($msg)) {
                if (defined($handlers{$msg->{type}})) {
                    my $a = &{$handlers{$msg->{type}}}($msg);
                    $sock->syswrite($a, length($a)) if defined($a);
                    print Dumper(ucp_parse($a)), strdump($a),"\n";
                } else {
                    print STDERR "$$: message of type $msg->{type} not handled\n";
                    print STDERR Dumper($msg);
                }
            } else {
                print STDERR "$$: $msg; aborting\n";
                exit(0);
            }
        }

    }
    if (!defined($res)) {
        print STDERR "$$: read: $!\n";
    } else {
        print STDERR "$$: connection closed by peer\n";
    }
    exit(0);
}


#
# Listen socket, accept loop.
#
my $port = $ARGV[0];
$port ||= 9999;

my $sock = new IO::Socket::INET(LocalAddr => "0.0.0.0:$port", Proto => "tcp", Reuse => 1, Type => SOCK_STREAM, Listen => 99) or die "socket (port $port): $!";

my %children;
while ($s = $sock->accept()) {
    my $pid = fork();
    if (!defined($pid)) {
        die "fork: $!";
    } elsif ($pid == 0) {
        # Child.
        $sock->close();
        do_smsc($s);
    } else {
        # Parent.
        $s->close();
        $children{$pid} = 1;
        print STDERR "new child: $pid\n";
    }
}