#!perl -w
use strict;
# z:/sources/wince420/PRIVATE/WINCEOS/COMM/BLUETOOTH/SDP/PARSER
# z:/sources/wince600/PRIVATE/WINCEOS/COMM/BLUETOOTH/SDP/INC/sdplib.h

# see Z:\sources\wince420\PUBLIC\COMMON\SDK\INC\bt_sdp.h
my %sdpattributes= (
    0x0000 => 'RECORD_HANDLE',
    0x0001 => 'CLASS_ID_LIST',
    0x0002 => 'RECORD_STATE',
    0x0003 => 'SERVICE_ID',
    0x0004 => 'PROTOCOL_DESCRIPTOR_LIST',
    0x0005 => 'BROWSE_GROUP_LIST',
    0x0006 => 'LANG_BASE_ATTRIB_ID_LIST',
    0x0007 => 'INFO_TIME_TO_LIVE',
    0x0008 => 'AVAILABILITY',
    0x0009 => 'PROFILE_DESCRIPTOR_LIST',
    0x000A => 'DOCUMENTATION_URL',
    0x000B => 'CLIENT_EXECUTABLE_URL',
    0x000C => 'ICON_URL',
    0x000D => 'ADDITIONAL_PROTOCOL_DESC_LISTS',
);

# Bluetooth_Base_UUID  : xxxxxxxx-0000-1000-8000-00805F9B34FB
#   where xxxxxxxx is one of protocol_uuids or ServiceClass_uuids

my %protocol_uuids=(
    0x0001=>'SDP',
    0x0002=>'UDP',
    0x0003=>'RFCOMM',
    0x0004=>'TCP',
    0x0005=>'TCSBIN',
    0x0006=>'TCSAT',
    0x0008=>'OBEX',
    0x0009=>'IP',
    0x000A=>'FTP',
    0x000C=>'HTTP',
    0x000E=>'WSP',
    0x000F=>'BNEP',
    0x0010=>'UPNP',
    0x0011=>'HID',
    0x0012=>'HCCC',
    0x0014=>'HCDC',
    0x0016=>'HN',
    0x0017=>'AVCTP',
    0x0019=>'AVDTP',
    0x001B=>'CMPT',
    0x001D=>'UDI_C_PLANE',
    0x0100=>'L2CAP',
);

my %ServiceClass_uuids=(
    0x1000=>'ServiceDiscoveryServer',
    0x1001=>'BrowseGroupDescriptor',
    0x1002=>'PublicBrowseGroup',
    0x1101=>'SerialPort',
    0x1102=>'LANAccessUsingPPP',
    0x1103=>'DialupNetworking',
    0x1104=>'IrMCSync',
    0x1105=>'OBEXObjectPush',
    0x1106=>'OBEXFileTransfer',
    0x1107=>'IrMCSyncCommand',
    0x1108=>'Headset',
    0x1109=>'CordlessTelephony',
    0x110A=>'AudioSource',
    0x110B=>'AudioSink',
    0x110C=>'AVRemoteControlTarget',
    0x110D=>'AdvancedAudioDistribution',
    0x110E=>'AVRemoteControl',
    0x110F=>'VideoConferencing',
    0x1110=>'Intercom',
    0x1111=>'Fax',
    0x1112=>'HeadsetAudioGateway',
    0x1113=>'WAP',
    0x1114=>'WAPClient',
    0x1115=>'PANU',
    0x1116=>'NAP',
    0x1117=>'GN',
    0x1118=>'DirectPrinting',
    0x1119=>'ReferencePrinting',
    0x111A=>'Imaging',
    0x111B=>'ImagingResponder',
    0x111C=>'ImagingAutomaticArchive',
    0x111D=>'ImagingReferenceObjects',
    0x111E=>'Handsfree',
    0x111F=>'HandsfreeAudioGateway',
    0x1120=>'DirectPrintingReferenceObjects',
    0x1121=>'ReflectedUI',
    0x1122=>'BasicPringing',
    0x1123=>'PrintingStatus',
    0x1124=>'HumanInterfaceDevice',
    0x1125=>'HardcopyCableReplacement',
    0x1126=>'HCRPrint',
    0x1127=>'HCRScan',
    0x1128=>'CommonISDNAccess',
    0x1129=>'VideoConferencingGW',
    0x112A=>'UDIMT',
    0x112B=>'UDITA',
    0x112C=>'AudioVideo',
    0x112D=>'SimAccess',
    0x1200=>'PnPInformation',
    0x1201=>'GenericNetworking',
    0x1202=>'GenericFileTransfer',
    0x1203=>'GenericAudio',
    0x1203=>'GenericAudio',
    0x1204=>'GenericTelephony',
    0x1205=>'UPnP',
    0x1206=>'UPnPIp',
    0x1300=>'ESdpUPnPIpPan',
    0x1301=>'ESdpUPnPIpLap',
    0x1302=>'EdpUPnpIpL2CAP',
);
use constant {
    NIL=>0x00,
    UINT=>0x01,
    INT=>0x02,
    UUID=>0x03,
    STRING=>0x04,
    BOOLEAN=>0x05,
    SEQUENCE=>0x06,
    ALTERNATIVE=>0x07,
    URL=>0x08,
};
my %sdptypes= (
    NIL()=>'NIL',
    UINT()=>'UINT',
    INT()=>'INT',
    UUID()=>'UUID',
    STRING()=>'STRING',
    BOOLEAN()=>'BOOLEAN',
    SEQUENCE()=>'SEQUENCE',
    ALTERNATIVE()=>'ALTERNATIVE',
    URL()=>'URL',
);

# type=>{name=>'..', len=>'..', fmt=>'..'};
my %sdpsizes= (
    0=>{name=>'s01', len=>1},
    1=>{name=>'s02', len=>2},
    2=>{name=>'s04', len=>4},
    3=>{name=>'s08', len=>8},
    4=>{name=>'s10', len=>16},

    5=>{name=>'int8', len=>1, fmt=>'C'},
    6=>{name=>'int16', len=>2, fmt=>'n'},
    7=>{name=>'int32', len=>4, fmt=>'N'},
);
my @sdprecs= qw(
    355535530900000a000100030900013503191103090004350c350319010035051900030803090006350909656e09006a0901000900093508350619110309010009010025124469616c2d7570204e6574776f726b696e67
    354e354c0900000a000100000900013503191101090004350c350319010035051900030801090006350909656e09006a09010009000935083506191101090100090100250b53657269616c20506f7274
    3600483600450900000a000100000900013503191103090004350c3503190100350519000308010900093508350619110309010009010025124469616c2d7570204e6574776f726b696e67
    3600343600310900000a000100010900013503191101090004350c350319010035051900030801090100250b53657269616c20706f7274
    35590900013503191105090004351135031901003505190003080A3503190008090006350909656E09006A0901000900093508350619110509010009010025104F424558204F626A65637420507573680903033506080108020803
    35410900013503191106090004351135031901003505190003080A3503190008090006350909656E09006A090100090009350835061911060901000901002503465450
3550354e0900000a00010004090001350619111f191203090004350c3503190100350519000308020900093508350619111e090101090100250d566f69636520476174657761790903010801090311090005
354535430900000a000100030900013506191112191203090004350c35031901003505190003080109000935083506191108090100090100250d566f6963652047617465776179
357d357b0900000a000100020900013503191105090004351335051a000001003505190003080a35031900080900053503191002090006350909656e09006a0901000900093508350619110509010009010025104f424558204f626a6563742050757368090303350208ff0907771c6f6d98f23c3a11d6956a00039353e858
356535630900000a000100010900013506191112191203090004350c3503190100350519000308010900053503191002090006350909656e09006a090100090009350835061911030911080901002517426c7565746f6f746820417564696f2047617465776179
355d355b0900000a000100040900013503191101090004350c3503190100350519000308030900053503191002090006350909656e09006a090100090009350835061911010901000901002512426c7565746f6f74682d5044412d53796e63
35440900013503191101090004350c35031901003505190003080a090006350909656e09006a09010009000935083506191101090100090100250b53657269616c20506f7274
354B0900013503191103090004350C350319010035051900030801090006350909656E09006A0901000900093508350619110309010009010025124469616C2D7570204E6574776F726B696E67
35370900013503191111090004350C35031901003505190003080109030435022800090009350A35081A000011110901000901002503466178
353B0900013506191112191203090004350C35031901003505190003080A09000935083506191108090100090100250D566F6963652047617465776179
3546090001350619111F191203090004350C35031901003505190003080A0900093508350619111E090101090100250D566F69636520476174657761790903010801090311090000
    );
@sdprecs=@ARGV if (@ARGV);
for my $sdp (map { pack 'H*',$_ } @sdprecs) {
    printf("\n===============================================================\n");
    my $sdp= parse_sdp($sdp);
    if (my $rc= dumpsdp($sdp)) {
        printf("ERROR-%d\n", $rc);
        use Dumpvalue;
        my $d= new Dumpvalue;
        $d->dumpValue($sdp);
    }
}
sub dumpsdp {
    my $sdp=shift;
    return 1 unless ref $sdp eq "ARRAY";
    return 2 unless @$sdp==1;
    $sdp= $sdp->[0];
    return 3 unless ref $sdp eq "HASH";
    return 4 unless $sdp->{type}==SEQUENCE;
    if (@{$sdp->{items}}==1) {
        $sdp= $sdp->{items}[0];
        return 6 unless ref $sdp eq "HASH";
        return 7 unless $sdp->{type}==SEQUENCE;
        return 8 unless (@{$sdp->{items}}&1)==0;
    }

    my $sdppp= $sdp->{items};
    for (my $i=0 ; $i<@$sdppp ; $i+=2) {
        my ($a, $v)= ($sdppp->[$i+0], $sdppp->[$i+1]);
        if ($a->{type}!=UINT) {
            printf("expected attr with type 0x%x\n", $a->{type});
        }
        printf("%s : %s\n", sdpattrname($a->{data}), sdp_asstring($v));
    }
    return 0;
}
sub sdpattrname {
    my $attr=shift;
    if (!exists $sdpattributes{$attr}) {
        return sprintf("unknown_0x%x", $attr);
    }
    return $sdpattributes{$attr};
}
sub sdp_asstring {
    my $sdp= shift;
    my $indent= shift || "";
    if ($sdp->{type}==SEQUENCE || $sdp->{type}==ALTERNATIVE) {
        return join "",
        sprintf("%s%s[%s]\n", $indent, $sdptypes{$sdp->{type}}, $sdpsizes{$sdp->{size}}{name}),
        sprintf("%s{\n", $indent),
        map( { sdp_asstring($_, $indent."  ") } @{$sdp->{items}}),
        sprintf("%s}\n", $indent);
    }
    else {
        sprintf("%s%s[%s]: %s\n", $indent, $sdptypes{$sdp->{type}}, $sdpsizes{$sdp->{size}}{name}, dataasstring($sdp->{type}, $sdp->{size}, $sdp->{data}));
    }
}
sub parse_sdp {
    my $ofs=0;
    my @seq;
    while ($ofs<length($_[0])) {
        my $type=ord(substr($_[0],$ofs,1)); $ofs++;
        my $size=$type&7;
        $type=$type>>3;
        if (!exists $sdptypes{$type}) {
            printf("WARN: unknown type: %02x, size=%d\n", $type, $size);
            next;
        }
        if (!exists $sdpsizes{$size}) {
            printf("WARN: unknown size: %02x(%s), size=%d\n", $type, $sdptypes{$type}, $size);
            next;
        }
        my $len;
        if (exists $sdpsizes{$size}{fmt}) {
            $len= unpack($sdpsizes{$size}{fmt}, substr($_[0],$ofs,$sdpsizes{$size}{len}));
            $ofs+=$sdpsizes{$size}{len};
        }
        else {
            $len= $sdpsizes{$size}{len};
        }
        my $data= substr($_[0],$ofs, $len); $ofs+=$len;
        if ($type==6 || $type==7) {
            push @seq, {
                type=>$type,
                size=>$size,
                items=>parse_sdp($data),
            };
        }
        else {
            push @seq, {
                type=>$type,
                size=>$size,
                data=>decodedata($type, $data),
            };
        }
    }
    if ($ofs>length($_[0])) {
        printf("WARN: ofs past length\n");
    }
    return \@seq;
}
sub decodedata {
    my ($type, $data)= @_;
    if ($type==NIL) {
        if (length($data)) {
            printf("WARN: unexpected data for NIL\n");
        }
        return $data;
    }
    elsif ($type==UINT || $type==UUID) {
        if (length($data)==1) {
            return unpack("C", $data);
        }
        elsif (length($data)==2) {
            return unpack("n", $data);
        }
        elsif (length($data)==4) {
            return unpack("N", $data);
        }
        else {
            return $data;
        }
    }
    elsif ($type==INT) {
        if (length($data)==1) {
            return unpack("c", $data);
        }
        elsif (length($data)==2) {
            return unpack "s", pack "S", unpack("n", $data);
        }
        elsif (length($data)==4) {
            return unpack "i", pack "I", unpack("N", $data);
        }
        else {
            $data;
        }
    }
    elsif ($type==STRING || $type==URL) {
        return $data;
    }
    elsif ($type==BOOLEAN) {
        if (length($data)!=1) {
            printf("WARN: unexpected bool size\n");
        }
        return unpack("C", $data);
    }
    elsif ($type==SEQUENCE) {
        # .. handled elsewhere
    }
    elsif ($type==ALTERNATIVE) {
        # .. handled elsewhere
    }
    else {
        printf("unhandled type: 0x%x\n", $type);
    }
}
sub dataasstring {
    my ($type, $size, $data)= @_;
    if ($type==NIL) {
        return unpack("H*", $data);
    }
    elsif ($type==UINT || $type==UUID || $type==INT) {
        if ($size==1 || $size==2 || $size==4) {
            return sprintf("0x%x", $data);
        }
        else {
            return '0x'.unpack("H*", $data);
        }
    }
    elsif ($type==STRING) {
        return "\"$data\"";
    }
    elsif ($type==BOOLEAN) {
        return $data;
    }
    elsif ($type==6) {
        # .. handled elsewhere
    }
    elsif ($type==7) {
        # .. handled elsewhere
    }
    else {
        printf("unhandled type2: 0x%x\n", $type);
    }
}