#!/usr/bin/perl -w
#  $Id$
# -----------------------------------------------------------------------------
#  Purpose:
#    - probe the camera
#    - pre-tune camera befor for retriever (RC and Audio)
# -----------------------------------------------------------------------------
#  Call:
#    probe DEVID=123
#    probe DEVID=123 PROBE=FAST
#    probe DEVID=123 DEVIP=192.168.17.177 [ ... ]
#    probe DEVIP=192.168.17.177 USRNAME=admin PASSWD=pass PROBE=DEFINE
# -----------------------------------------------------------------------------
#  Does:
#   0. can be called without DEVID argument.
#      In this case DEVIP,USRNAME,PASSWD should be provided in command line
#   1. load $APL_CONF/<DEVID>/conf if DEVID is provided
#   2. combine conf and args into one hash
#   3. connect to camera over http and read MODELID and FIRMWARE
#   4. report MODELID|FIRMWARE|STATUS to $APL_CONF/<DEVID>/conf.probe and stdout
#   5. if PROBE=DEFINE then get
#         IMAGESIZE_LIST,MEDIA_FORMAT_LIST
#         AUDIO_LIST,AUDIO_FORMAT_LIST
#         SNAPSHOT (picture)
#   6. set RC camera attributes    if mpeg4 | h264
#   7. set AUDIO camera attributes if AUDIO is on
#   8. example output:
#       AUDIO_SET=OK
#       FIRMWARE=5.02
#       MODELID=Q1755
#       RC_SET=OK
#       STATUS=OK
#       -------------
#       AUDIO_SET=NONE
#       FIRMWARE=5.02
#       MODELID=Q1755
#       RC_SET=NONE
#       STATUS=OK
#       SNAPSHOT=/tmp/probe/192.168.17.177-12367576123.jpg
#       IMAGESIZE_LIST=640x480,480x360,320x240,240x180,176x144,160x120
#       MEDIA_FORMAT_LIST=mjpeg,h264
#       AUDIO_LIST=off,on
#       AUDIO_FORMAT_LIST=g711,g726,aac
#   9. sample errors:
#       STATUS=ERROR: PCE-0001 [101] configuration is not found
#       STATUS=ERROR: PCE-0002 [101] USRNAME and PASSWD should provided
#       STATUS=ERROR: PCE-0003 [101] DEVIP is not defined
#       STATUS=ERROR: PCE-0500 [101] Device does not respond (http://207.107.163.123:80)
#       STATUS=ERROR: PCE-0401 [101] Authorization error
#       STATUS=ERROR: PCE-0403 [101] Forbidden
#       STATUS=ERROR: PCE-0030 [101] Cannot get MODELID
#       note: [101] is DEVID
#  10. warnings:
#       STATUS=WARNING: PCW-0001 [101] MODELID does not match configuration
#       STATUS=WARNING: PCW-0002 [101] FIRMWARE does not match configuration
#       STATUS=WARNING: PCW-0009 [101] PROBE=RESET is not supported
#
# -----------------------------------------------------------------------------
#  Note:
#   1. CAMERAMODEL file is obsolite. ptz_axisv2.pl & ptz_udp.pl has to be modified
#   2. Script mast be in the directory .../camera/<BRAND>/bin/
# -----------------------------------------------------------------------------
#  Author: teetov, 03/22/10
#  Edited by:
#  QA by:
#  Copyright: videoNEXT Network Solutions, Inc, 2010
# -----------------------------------------------------------------------------
#
use strict;
use Device::Conf ":all";
use Data::Dumper;
use Socket;
use POSIX;
# cons -------------------------------------------------------------------------
# no code for Bosch

my $CONF_RCP_CLIENT_REGISTRATION = hex 'ff00';
my $CONF_RCP_CLIENT_UNREGISTER = hex 'ff01';

my $CONF_OEM_DEVICE_NAME = hex '097c';
my $CONF_OEM_EXT_ID = hex '097d';
my $CONF_OEM_DEVICE_DOMAIN = hex '09e9';

my $CONF_NBR_OF_VIDEO_IN = hex '01d6';

my $CONF_UNIT_NAME = hex '0024';
my $CONF_CAMNAME = hex '0019';
my $CONF_HARDWARE_VERSION = hex '002e';
my $CONF_SOFTWARE_VERSION = hex '002f';

my $CONF_MPEG2_RESOLUTION = hex '0x0507';
my $CONF_MPEG2_CURRENT_PARAMS = hex '0x050b';

my $CONF_MPEG4_CURRENT_PARAMS = hex '0600';
my $CONF_MPEG4_NAME = hex '0602';
my $CONF_MPEG4_RESOLUTION = hex '0608';
my $CONF_MPEG4_BANDWIDTH_KBPS = hex '0607';
my $CONF_MPEG4_BANDWIDTH_KBPS_SOFT_LIMIT = hex '0x0612';
my $CONF_MPEG4_BANDWIDTH_KBPS_HARD_LIMIT = hex '0x0613';
my $CONF_MPEG4_INTRA_FRAME_DISTANCE = hex '0604';
my $CONF_MPEG4_FIELD_MODE = hex '0x060e';
my $CONF_MPEG4_I_FRAME_QUANT = hex '0x060a';
my $CONF_MPEG4_P_FRAME_QUANT = hex '0x060b';
my $CONF_MPEG4_PARAMS_MAX_NUM = hex '0x0614';
my $CONF_MPEG4_FRAME_SKIP_RATIO = hex '0x0606';

my $CONF_VIDEO_CURRENT_PARAMS_CODNBR = hex '0x0982';

my $CONF_DEFAULT_CONNECTION_MODE = hex '0x0289';
my $CONF_STD_MEDIA_CONNECTION_DIRECTION = hex '0x030c';
my $CONF_STD_MEDIA_ENCAPSULATION_PROTOCOL = hex '0x0309'; # PROTOKOL in docs

my $CONF_VID_ENCODER_ON = hex '0262';

my $CONF_CAPABILITY_LIST = hex '0xff10';

my $CONF_RCP_CODER_LIST = hex '0xff11';

my $CONF_AUDIO_G711 = hex '0x000c';

my $DTYPE_FLAG = hex '0x00';
my $DTYPE_T_OCTET = hex '0x01'; # (1 Byte)
my $DTYPE_T_WORD = hex '0x02'; # (2 Byte)
my $DTYPE_T_INT = hex '0x04'; # (4 Byte)
my $DTYPE_T_DWORD = hex '0x08'; # (4 Byte)
my $DTYPE_P_OCTET = hex '0x0C'; # (N Byte)
my $DTYPE_P_STRING = hex '0x10'; # (N Byte)
my $DTYPE_P_UNICODE = hex '0x14'; # (N Byte)

my $RW_GET = 0;
my $RW_SET = 1;

my $CONT_NO = 0;
my $CONT_YES = 1;

my $ACTION_REQUEST = 0;
my $ACTION_REPLY = 1;
my $ACTION_MESSAGE = 2;
my $ACTION_ERROR = 3;
my $ACTION_SPECIFIC_ERROR = 4;

# FIXME: set from conf
#my $ip = '173.84.33.104';
my $ip = '207.207.163.163';
my $user = 'service';
my $pass = '';
my $timeout = 16;

my @resolutionid = (
    'QCIF',
    'CIF',
    '2CIF',
    '4CIF',
    '1/2 D1',
    '2/3 D1',
    'QVGA',
    'VGA'
);
my @resolution = (
    '0:QCIF',
    '6:QVGA',
    '1:CIF',
    '4:1/2 D1',
    '5:2/3 D1',
    '7:VGA',
    '2:2CIF',
    '3:4CIF/D1'
);
#my @resolution = (
#    '0:176x144/120 (QCIF)',
#    '6:320x240 (QVGA)',
#    '1:352x288/240 (CIF)',
#    '4:352x576/480 (1/2 D1)',
#    '5:464x288/240 (2/3 D1)',
#    '7:640x480 (VGA)',
#    '2:704x288/240 (2CIF)',
#    '3:704x576/480 (4CIF/D1)'
#);
#my @resol_order = (0,1,4,5,2,3);

my @frame_rate = (
    '30:1',
    '15:2',
    '10:3',
    '6:5',
    '5:6',
    '3:10',
    '2:15',
    '1:30'
);

my $bosch_old_nvr = 1;
my $bosch_old_vj8000 = 2;
my $bosch_old_vip10 = 3;
my $bosch_old_vip1000 = 4;
my $bosch_old_vj400 = 6;
my $bosch_old_vip100 = 7;
my $bosch_old_vjex = 8;
my $bosch_old_vj1000 = 9;
my $bosch_old_vj100 = 10;
my $bosch_old_vj10 = 11;
my $bosch_old_vj8008 = 12;
my $bosch_old_vj8004 = 13;

my %modelnames_old = (
     0 => 'Unknown Bosch',
     1 => 'NVR',
     2 => 'VideoJet 8000',
     3 => 'VIP 10',
     4 => 'VIP 1000',
     6 => 'VideoJet 400',
     7 => 'VIP 100',
     8 => 'VideoJet EX',
     9 => 'VideoJet 1000',
    10 => 'VideoJet 100',
    11 => 'VideoJet 10',
    12 => 'VideoJet 8008',
    13 => 'VideoJet 8004',
);

my $bosch_new_vipx1 = 1;
my $bosch_new_vipx2 = 2;
my $bosch_new_vipxdec = 3;
my $bosch_new_ippanel = 13;
my $bosch_new_gen4 = 14;
my $bosch_new_m1600 = 15;
my $bosch_new_nbc = 32;
my $bosch_new_vidos_srv = 253;
my $bosch_new_vidos_mon = 254;

my %modelnames_new = (
     0 => 'Unknown Bosch',
     1 => 'VIP X1',
     2 => 'VIP X2',
     3 => 'VIP XDEC',
    13 => 'NWC-0495',
    14 => 'GEN4',
    15 => 'M1600',
    32 => 'NBC-255-P',
   253 => 'VIDOS SERVER',
   254 => 'VIDOS MONITOR',
   61  => 'IP Dome Camera 200 Series',
   100 => 'Flexidome outdoor 5000 HD',
   113 => 'DINION IP starlight 8000 MP',
   89  => 'FLEXIDOME HD 1080p HDR',
   79  => 'DINION HD 1080p HDR',
   86  => 'DINION HD 720p IVA',
   94  => 'FLEXIDOME micro 5000 MP',
   77  => 'AUTODOME 7000 HD',
   85  => 'VIP X16 XF E',
   45  => 'DINION NBN-498-P IVA',
   86  => 'DINION NBN-71013-B',
);


my $port = 1756;
my $sock;
my $clientId = 0;
my %cam_enc = ();


sub rcp_connect {
    eval {
        my $iaddr = inet_aton( $ip );
        my $paddr = sockaddr_in( $port, $iaddr );
        my $tcpProto = getprotobyname('tcp');
        socket( $sock, PF_INET, SOCK_STREAM, $tcpProto ) || die $!;
        connect( $sock, $paddr ) || die $!;
    };
    return 0 if $@;
    return 1;
}

sub rcp_close {
    shutdown( $sock, 2 );
    close $sock;
}

sub rcp_send {
    my( $tag, $data_type, $rw, $cont, $action, $session_id, $num_descr, $data ) = @_;
    #warn join( ',', @_ );
    my $version = 3;
    my $payload_len = length $data;
    my $reserved = int(rand(256));
    #warn $client_id;
    my $msg =
        pack( 'nCCCCnNnn', $tag,
        $data_type,
        $version * 16 + $rw,
        #$cont + $action * 2,
        $cont * 128 + $action,
        $reserved,
        $clientId,
        $session_id,
        $num_descr,
        $payload_len );
    my $hdr = pack( 'CCn', 3, 0, 4 + length( $msg ) + length( $data ) );
    #warn unpack( 'H*', $msg );
    eval {
        send( $sock, $hdr.$msg.$data, 0 );
    };
    # TODO: legal close
    die $@ if $@;
    #return undef if $@;
}

sub rcp_recv {
    my $msg;
    my $hdr;
    local $SIG{ALRM} = sub{ die 'TIMEOUT' };
    alarm $timeout;
    #warn "---";
    # TODO: legal close
    die $! if !defined
    recv( $sock, $hdr, 4, 0 );
    my( $ver, $zero, $dlen ) = unpack( 'CCn', $hdr );
    #warn $dlen;
    # TODO: legal close
    die $! if !defined
    recv( $sock, $msg, 16, 0 );
    #warn "---";
    my( $tag, $data_type, $verrw, $caction, $reserved, $client_id, $session_id, $num_descr, $payload_len ) = unpack( 'nCCCCnNnn', $msg );
    my $extra;
    if( $payload_len > 0 ) {
        #warn "---";
        # TODO: legal close
        die $! if !defined
        recv( $sock, $extra, $payload_len, 0 );
        #warn "---";
    }
    alarm 0;
    my $rw = $verrw & 15;
    my $version = ( $verrw & 15*16 ) / 16;
    my $cont = $caction > 127 ? 1 : 0;
    my $action = $caction & 127;
    return ( $tag, $data_type, $version, $rw, $cont, $action, $reserved, $client_id, $session_id, $num_descr, $payload_len, $extra );
}

sub rcp_comm {
    rcp_send @_;
    return rcp_recv();
}

sub ifnull {
    my( $p, $f ) = @_;
    return( $p ) if defined $p;
    return $f;
}

sub rcp_comh {
    my( $h ) = @_;
    die "undefined tag" if !defined $h->{'tag'};
    rcp_send(
        $h->{'tag'},
        ifnull( $h->{'data_type'}, $DTYPE_FLAG ),
        ifnull( $h->{'rw'}, $RW_GET ),
        ifnull( $h->{'continuation'}, $CONT_NO ),
        ifnull( $h->{'action'}, $ACTION_REQUEST ),
        ifnull( $h->{'session_id'}, 0 ),
        ifnull( $h->{'num_descr'}, 0 ),
        ifnull( $h->{'data'}, '' )
    );
    my $r;
    ( $r->{tag}, $r->{data_type}, $r->{version}, $r->{rw}, $r->{continuation},
        $r->{action}, $r->{reserved}, $r->{client_id}, $r->{session_id}, $r->{num_descr},
        $r->{payload_len}, $r->{data} ) = rcp_recv();
    return $r;
}

sub auto_res {
    my( $h ) = @_;
    return undef if $h->{'action'} != $ACTION_REPLY;
    if( $h->{'data_type'} == $DTYPE_FLAG ) {
        return unpack( 'C', $h->{'data'} );
    } elsif( $h->{'data_type'} == $DTYPE_T_OCTET ) {
        return unpack( 'C', $h->{'data'} );
    } elsif( $h->{'data_type'} == $DTYPE_T_WORD ) {
        return unpack( 'n', $h->{'data'} );
    } elsif( $h->{'data_type'} == $DTYPE_T_INT ) {
        return unpack( 'N', $h->{'data'} );
    } elsif( $h->{'data_type'} == $DTYPE_T_DWORD ) {
        return unpack( 'N', $h->{'data'} );
    } elsif( $h->{'data_type'} == $DTYPE_P_OCTET ) {
        return unpack( 'C*', $h->{'data'} );
    } elsif( $h->{'data_type'} == $DTYPE_P_STRING ) {
        return $h->{'data'};
    } elsif( $h->{'data_type'} == $DTYPE_P_UNICODE ) {
        return $h->{'data'};
    }
}

sub init {
    my $initsucc = rcp_connect();
    return 0 if !$initsucc;
    my $auth = "+$user:$pass+";
    #my $auth = "\x00";
    my( $tag, $dt, $ver, $rw, $c, $act, undef, $cid, $sid, $nd, $pl, $data ) =
        rcp_comm( $CONF_RCP_CLIENT_REGISTRATION, $DTYPE_P_OCTET, $RW_SET, $CONT_NO, $ACTION_REQUEST, 0, 0, pack( 'CCnCCn', 1, 0, 0, 0, length $auth, 0, 0 ).$auth );
    #warn "T$tag D$dt V$ver RW$rw C$c A$act C$cid S$sid N$nd L$pl ".unpack( 'H*', $data );
    my( $success, $level, $client_id ) = unpack( 'CCn', $data );
    #warn $level;
    ( $clientId = $client_id ) if $success;
    return ( 1, $success ? $level : 255 );
}

sub detect_test_udp {
    my $fm = pack( 'H8C4H4n', '9939A427', int(rand(256)), int(rand(256)), int(rand(256)), int(rand(256)), '0000', 1758 );
    my $ss;
    socket( $ss, PF_INET, SOCK_DGRAM, getprotobyname('udp') );
    my $iaddr = inet_aton( $ip );
    my $paddr = sockaddr_in( 1757, $iaddr );
    send( $ss, $fm, 0, $paddr );
    close( $ss );
    my $ssr;
    socket( $ssr, PF_INET, SOCK_DGRAM, getprotobyname('udp') );
    my $paddrr = sockaddr_in( 1758, $iaddr );
    bind( $ssr, $paddrr );
    my $inm;
    warn '---';
    recv( $ssr, $inm, 32, 0 );
    close( $ssr );
    warn unpack( 'H*', $inm );
}

sub leave {
    my( $tag, $dt, $ver, $rw, $c, $act, undef, $cid, $sid, $nd, $pl, $data ) =
        rcp_comm( $CONF_RCP_CLIENT_UNREGISTER, $DTYPE_P_OCTET, $RW_SET, $CONT_NO, $ACTION_REQUEST, 0, 0, '' );
    my( $success, $level, undef ) = unpack( 'CCn', $data ) if defined $data;
    rcp_close();
}

sub rcp_get_oem_device_name {
    my( undef, $dt, undef, undef, undef, $act, undef, undef, undef, $nd, $dl, $data ) =
        rcp_comm( $CONF_OEM_DEVICE_NAME, $DTYPE_P_STRING, $RW_GET, $CONT_NO, $ACTION_REQUEST, 0, 0, '' );
    return '' if $act != $ACTION_REPLY;
    $data =~ m/([^\x00]*)/;
    return $1;
}

sub rcp_get_cam_name {
    my( $cam_no ) = @_;
    my $r = rcp_comh { 'tag' => $CONF_CAMNAME, 'data_type' => $DTYPE_P_UNICODE, 'num_descr' => $cam_no };
    return auto_res( $r );
}

sub rcp_get_oem_ext_id {
    my $r = rcp_comh( { 'tag' => $CONF_OEM_EXT_ID } );
    return auto_res( $r );
}

sub rcp_get_oem_device_domain {
    my $r = rcp_comh( { 'tag' => $CONF_OEM_DEVICE_DOMAIN } );
    return '' if $$r{action} != $ACTION_REPLY;
    $$r{data} =~ m/([^\x00]*)/;
    return $1;
}

sub rcp_get_device_type {
    my $r = rcp_comh( { 'tag' => $CONF_HARDWARE_VERSION, 'data_type' => $DTYPE_P_STRING } );
    #warn Dumper( $r );
    #warn Dumper(%modelnames_new);
    return undef if $$r{action} != $ACTION_REPLY;
    if( substr($$r{data},0,1) eq 'F' ) {
        my $id = hex( substr( $$r{data}, 4, 2 ) );
        return (defined $modelnames_new{ $id }) ? $modelnames_new{ $id } : "Bosch Model #$id";
    } else {
        my $id = hex( substr( $$r{data}, 0, 1 ) );
        return (defined $modelnames_old{ $id }) ? $modelnames_old{ $id } : "Bosch Model #$id";
    }
}

sub rcp_get_firmware {
    my $r = rcp_comh( { 'tag' => $CONF_SOFTWARE_VERSION, 'data_type' => $DTYPE_P_STRING } );
    return undef if $$r{action} != $ACTION_REPLY;
    # drop leading zero
    return int(substr($$r{data},4,2)).".".substr($$r{data},6,2);
}

sub rcp_get_video_in_number {
    my $r = rcp_comh { 'tag' => $CONF_NBR_OF_VIDEO_IN, 'data_type' => $DTYPE_T_DWORD };
    return auto_res( $r );
}

sub rcp_get_vid_encoder_state {
    my $r = rcp_comh( { 'tag' => $CONF_VID_ENCODER_ON } );
    return auto_res( $r );
}

sub rcp_get_mpeg2_current_params {
    my( $coder_instance ) = @_;
    my $r = rcp_comh( { 'tag' => $CONF_MPEG2_CURRENT_PARAMS, 'data_type' => $DTYPE_T_DWORD , 'num_descr' => $coder_instance } );
    return auto_res( $r );
}

sub rcp_get_mpeg4_current_params {
    my( $coder_instance ) = @_;
    my $r = rcp_comh( { 'tag' => $CONF_MPEG4_CURRENT_PARAMS, 'data_type' => $DTYPE_T_DWORD , 'num_descr' => $coder_instance } );
    return auto_res( $r );
}

sub rcp_set_mpeg4_current_params {
    my( $coder_instance, $profile ) = @_;
    my $r = rcp_comh { 'tag' => $CONF_MPEG4_CURRENT_PARAMS, 'rw' => $RW_SET, 'data_type' => $DTYPE_T_DWORD ,
        'num_descr' => $coder_instance, 'data' => pack( 'N', $profile ) };
    return auto_res( $r );
}

sub rcp_get_mpeg4_bandwidth {
    my( $profile ) = @_;
    my $r = rcp_comh( { 'tag' => $CONF_MPEG4_BANDWIDTH_KBPS, 'data_type' => $DTYPE_T_DWORD, 'num_descr' => $profile } );
    return auto_res( $r );
}

sub rcp_set_mpeg4_bandwidth {
    my( $profile, $kbps ) = @_;
    return undef unless $kbps =~ /\d+/;
    my $r = rcp_comh { 'tag' => $CONF_MPEG4_BANDWIDTH_KBPS, 'rw' => $RW_SET, 'data_type' => $DTYPE_T_DWORD,
        'num_descr' => $profile, 'data' => pack( 'N', int($kbps) ) };
    return auto_res( $r );
}

sub rcp_get_mpeg4_frame_skip_ratio {
    my( $profile ) = @_;
    my $r = rcp_comh( { 'tag' => $CONF_MPEG4_FRAME_SKIP_RATIO, 'data_type' => $DTYPE_T_DWORD, 'num_descr' => $profile } );
    return auto_res( $r );
}

sub rcp_set_mpeg4_frame_skip_ratio {
    my( $profile, $fsr ) = @_;
    my $r = rcp_comh( { 'tag' => $CONF_MPEG4_FRAME_SKIP_RATIO, 'rw' => $RW_SET, 'data_type' => $DTYPE_T_DWORD,
        'num_descr' => $profile, 'data' => pack( 'N', $fsr ) } );
    return auto_res( $r );
}

sub rcp_get_mpeg4_bandwidth_soft_limit {
    my( $profile ) = @_;
    my $r = rcp_comh( { 'tag' => $CONF_MPEG4_BANDWIDTH_KBPS_SOFT_LIMIT, 'data_type' => $DTYPE_T_DWORD, 'num_descr' => $profile } );
    return auto_res( $r );
}

sub rcp_set_mpeg4_bandwidth_soft_limit {
    my( $profile, $kbps ) = @_;
    my $r = rcp_comh( { 'tag' => $CONF_MPEG4_BANDWIDTH_KBPS_SOFT_LIMIT, 'rw' => $RW_SET,
        'data_type' => $DTYPE_T_DWORD, 'num_descr' => $profile, 'data' => pack( 'N', $kbps ) } );
    return auto_res( $r );
}

sub rcp_get_mpeg4_bandwidth_hard_limit {
    my( $profile ) = @_;
    my $r = rcp_comh( { 'tag' => $CONF_MPEG4_BANDWIDTH_KBPS_HARD_LIMIT, 'data_type' => $DTYPE_T_DWORD, 'num_descr' => $profile } );
    return auto_res( $r );
}

sub rcp_set_mpeg4_bandwidth_hard_limit {
    my( $profile, $kbps ) = @_;
    my $r = rcp_comh { 'tag' => $CONF_MPEG4_BANDWIDTH_KBPS_HARD_LIMIT, 'data_type' => $DTYPE_T_DWORD,
        'rw' => $RW_SET, 'num_descr' => $profile, 'data' => pack( 'N', $kbps ) };
    return auto_res( $r );
}

sub rcp_get_mpeg4_Iframe_distance {
    my( $profile ) = @_;
    my $r = rcp_comh( { 'tag' => $CONF_MPEG4_INTRA_FRAME_DISTANCE, 'data_type' => $DTYPE_T_DWORD, 'num_descr' => $profile } );
    return auto_res( $r );
}

sub rcp_set_mpeg4_Iframe_distance {
    my( $profile, $num ) = @_;
    my $r = rcp_comh( { 'tag' => $CONF_MPEG4_INTRA_FRAME_DISTANCE, 'data_type' => $DTYPE_T_DWORD,
	 'rw' => $RW_SET, 'num_descr' => $profile, 'data' => pack( 'N', $num ) } );
    return auto_res( $r );
}

sub rcp_get_mpeg2_resolution {
    my( $profile ) = @_;
    my $r = rcp_comh { 'tag' => $CONF_MPEG2_RESOLUTION, 'data_type' => $DTYPE_T_DWORD, 'num_descr' => $profile };
    return auto_res( $r );
}

sub rcp_get_mpeg4_resolution {
    my( $profile ) = @_;
    my $r = rcp_comh { 'tag' => $CONF_MPEG4_RESOLUTION, 'data_type' => $DTYPE_T_DWORD, 'num_descr' => $profile };
    return auto_res( $r );
}

sub rcp_set_mpeg4_resolution {
    my( $profile, $res ) = @_;
    my $r = rcp_comh { 'tag' => $CONF_MPEG4_RESOLUTION, 'rw' => $RW_SET, 'data_type' => $DTYPE_T_DWORD,
        'num_descr' => $profile, 'data' => pack( 'N', $res ) };
    return auto_res( $r );
}

sub rcp_get_mpeg4_field_mode {
    my( $profile ) = @_;
    my $r = rcp_comh { 'tag' => $CONF_MPEG4_FIELD_MODE, 'data_type' => $DTYPE_T_DWORD, 'num_descr' => $profile };
    return auto_res( $r );
}

sub rcp_get_mpeg4_Iframe_quant {
    my( $profile ) = @_;
    my $r = rcp_comh { 'tag' => $CONF_MPEG4_I_FRAME_QUANT, 'data_type' => $DTYPE_T_DWORD, 'num_descr' => $profile };
    return auto_res( $r );
}

sub rcp_get_mpeg4_Pframe_quant {
    my( $profile ) = @_;
    my $r = rcp_comh { 'tag' => $CONF_MPEG4_P_FRAME_QUANT, 'data_type' => $DTYPE_T_DWORD, 'num_descr' => $profile };
    return auto_res( $r );
}

sub rcp_get_mpeg4_profile_count {
    my $r = rcp_comh { 'tag' => $CONF_MPEG4_PARAMS_MAX_NUM, 'data_type' => $DTYPE_T_DWORD };
    return auto_res( $r );
}

sub rcp_get_default_connection_mode {
    my $r = rcp_comh { 'tag' => $CONF_DEFAULT_CONNECTION_MODE, 'data_type' => $DTYPE_T_OCTET };
    return auto_res( $r );
}

sub rcp_get_cap_list {
    my $r = rcp_comh { 'tag' => $CONF_CAPABILITY_LIST, 'data_type' => $DTYPE_P_OCTET };
    return undef unless defined $$r{'action'};
    #warn Dumper($r);
    #warn unpack( 'H*', $$r{data} );
    my $data = $$r{'data'};
    my( $v, $c ) = ( 0, 6 );
    # read main header
    my( $baba, $ver, $sec_cnt ) = unpack( 'nnn', substr($data,$v,$c) );
    $v += $c;
    return undef unless ( $baba == hex 'baba' ) && ( $ver == 1 );
    my $R = { 'VIDEO' => [], 'AUDIO' => [] };
    for( my $i = 0; $i < $sec_cnt; $i++ ) {
        $c = 6;
        # read section header
        my( $type, $size, $el_cnt ) = unpack( 'nnn', substr( $data, $v, $c ) );
        $v += $c;
        # 6 - size of header - type+size+element count
        if( $el_cnt > 0 ) { $c = ( $size - 6 ) / $el_cnt; } else { $c = 0; }
        if( $type == 1 ) { # 1 == video
            # $c = 10; # 10 - sizeof video element
            for( my $e = 0; $e < $el_cnt; $e++ ) {
                my( $e_type, $e_id, $e_compr, $e_input_no, $e_resol ) = unpack( 'nnnnn', substr( $data, $v, $c ) );
                # FIXME: just debug
                if( $c < 10 ) { $e_resol = hex '00'; }
                $v += $c;
                push @{$$R{'VIDEO'}}, { type => $e_type, id => $e_id, compression => $e_compr, input_no => $e_input_no, resolution => $e_resol };
            }
        } elsif( $type == 2 ) { # 2 == audio
            # $c = 6;
            for( my $e = 0; $e < $el_cnt; $e++ ) {
                my( $e_type, $e_id, $e_compr ) = unpack( 'nnn', substr( $data, $v, $c ) );
                $v += $c;
                push @{$$R{'AUDIO'}}, { type => $e_type, id => $e_id, compression => $e_compr };
            }
        } elsif( $type == 3 ) {
            # 3 == serial
            # $c = 4;
            for( my $e = 0; $e < $el_cnt; $e++ ) {
                my( $e_type, $e_id ) = unpack( 'nn', substr( $data, $v, $c ) );
                $v += $c;
                push @{$$R{'SERIAL'}}, { type => $e_type, id => $e_id };
            }
        } elsif( $type == 4 ) {
            # 4 == IO
            # $c = 4;
            for( my $e = 0; $e < $el_cnt; $e++ ) {
                my( $e_type, $e_id ) = unpack( 'nn', substr( $data, $v, $c ) );
                $v += $c;
                push @{$$R{'IO'}}, { type => $e_type, id => $e_id };
            }
        }
    }
    return $R;
}

sub rcp_get_video_coder_list {
    my( $cam ) = @_;
    my $r = rcp_comh { 'tag' => $CONF_RCP_CODER_LIST, 'data_type' => $DTYPE_P_OCTET, 'num_descr' => $cam,
        'data' => pack( 'CCC', 1, 0, 1 ) };
    return undef unless $$r{'action'} == $ACTION_REPLY;
    my $rec_no = $$r{'payload_len'} / 16;
    my @p = ();
    for( my $i = 0; $i < $rec_no; $i++ ) {
        my $cd;
        ( $$cd{code_nbr}, $$cd{coding_caps}, $$cd{coding_curr}, $$cd{resol_caps}, $$cd{resol_curr}, undef, undef ) =
            unpack( 'nnnnnnN', substr( $$r{'data'}, $i * 16, 16 ) );
        push( @{$$cd{coding_caps_list}}, 'h.263' ) if $$cd{coding_caps} & hex '0002';
        push( @{$$cd{coding_caps_list}}, 'mpeg4' ) if $$cd{coding_caps} & hex '0004';
        push( @{$$cd{coding_caps_list}}, 'mpeg2' ) if $$cd{coding_caps} & hex '0008';
        push( @{$$cd{coding_caps_list}}, 'meta data' ) if $$cd{coding_caps} & hex '0010';
        push( @{$$cd{coding_caps_list}}, 'h.263-1998' ) if $$cd{coding_caps} & hex '0020';
        push( @{$$cd{coding_caps_list}}, 'rec media' ) if $$cd{coding_caps} & hex '4000';
        push( @{$$cd{coding_caps_list}}, 'mpeg2 prgstr' ) if $$cd{coding_caps} & hex '8000';
        push @p, $cd;
    }
    return @p;
}

sub rcp_get_audio_g711 {
    my $r = rcp_comh { 'tag' => $CONF_AUDIO_G711 };
    return auto_res( $r );
}

sub rcp_set_audio_g711 {
    my( $snd ) = @_;
    my $r = rcp_comh { 'tag' => $CONF_AUDIO_G711, 'rw' => $RW_SET, 'data' => pack( 'C', $snd ) };
    return auto_res( $r );
}

#-------------------------

sub macro_get_cam_mpeg4_info {
    my( $cam ) = @_;
    return undef unless exists $cam_enc{$cam};
    my $profile = rcp_get_mpeg4_current_params( $cam_enc{$cam}->[0] );
    return (
        rcp_get_mpeg4_resolution( $profile ),
        rcp_get_mpeg4_bandwidth( $profile ),
        rcp_get_mpeg4_frame_skip_ratio( $profile ),
        rcp_get_mpeg4_bandwidth_soft_limit( $profile ) || '0',
        rcp_get_mpeg4_Iframe_distance( $profile ) || '0'
    );
}

sub macro_set_cam_mpeg4_info {
    my( $cam, $res, $kbps, $fsr, $maxkbps, $gop, $modelid, $media_format ) = @_;
    return undef unless exists $cam_enc{$cam};
    rcp_set_mpeg4_current_params( $cam_enc{$cam}->[0], $cam );
    my $profile = rcp_get_mpeg4_current_params( $cam_enc{$cam}->[0] );

    # setting active profile for h264
    if($modelid eq $modelnames_new{$bosch_new_nbc}) {
	rcp_comh( { 'tag' => hex '0x0aa4', 'rw' => $RW_SET, 'data_type' => $DTYPE_T_DWORD, 'num_descr' => $cam_enc{$cam}->[0], 'data' => pack( 'N', 1 ) } ) if $media_format eq 'h264';
    } elsif($modelid eq $modelnames_new{$bosch_new_ippanel}) {
	rcp_comh( { 'tag' => hex '0x0a9c', 'rw' => $RW_SET, 'data_type' => $DTYPE_T_DWORD, 'num_descr' => $cam_enc{$cam}->[0], 'data' => pack( 'N', 2 ) } ) if $media_format eq 'h264';
    }

    rcp_set_mpeg4_resolution( $profile, $res ) if $res =~ /^\d+$/; #$revresolution{$res} );
    rcp_set_mpeg4_bandwidth( $profile, $kbps ) if $kbps =~ /^\d+$/;
    rcp_set_mpeg4_frame_skip_ratio( $profile, $fsr ) if $fsr =~ /^\d+$/;
    rcp_set_mpeg4_bandwidth_soft_limit( $profile, $maxkbps ) if $maxkbps =~ /^\d+$/;
    rcp_set_mpeg4_Iframe_distance( $profile, $gop ) if $gop =~ /^\d+$/;

    rcp_set_mpeg4_current_params( $cam_enc{$cam}->[0], $cam );
}

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

# --------- check required parameters: DEVID,USRNAME,PASSWD,
my $conf=ProbeInit();  # uses <BRAND> from path and ARGV
ProbeErr("PCE-0001","configuration is not found") if not defined $conf->{DEVID};
ProbeErr("PCE-0003","DEVIP is not defined")       if not defined $conf->{DEVIP};
ProbeErr("PCE-0002","USRNAME and PASSWD should be provided")
                 if not defined $conf->{USRNAME} or not defined $conf->{PASSWD};
ProbeWarn("PCW-0009","PROBE=RESET is not supported") if $conf->{PROBE} eq 'RESET';
#------------------------------------------------------------------------------
# Probe camera MODELID & FIRMWARE
#------------------------------------------------------------------------------
my %result=(MODELID=>'0',FIRMWARE=>'0.0',STATUS=>'OK',RC_SET=>'NONE',AUDIO_SET=>'NONE');

#---------------------------------------
# init connection on rcp+ protocol
#---------------------------------------
$ip = $conf->{DEVIP};
$user = $conf->{USRNAME};
$pass = $conf->{PASSWD};
my( $ok, $lvl ) = init();
ProbeErr("PCE-0500","Device does not respond") if !$ok;
if( $lvl != 2 ) {
    leave();
    ProbeErr("PCE-0401","Wrong username or password");
}

#------------------------
#
#------------------------

my $respond =ProbeHttpHeader("/");
if($respond!~ /^HTTP ERROR/) {
  $result{MODELID} = $1 if $respond =~ /^(.+)-Webserver/i;
}else {
  my ($err)= $respond=~/^HTTP ERROR \[(\d+)\]/;
  ProbeErr("PCE-0500","Device does not respond",$respond) if $err=~/^5\d\d/;
  ProbeErr("PCE-0401","Authorization error",    $respond) if $err==401;
}
ProbeErr("PCE-0030","Cannot get MODELID or FIRMWARE",$respond) if ! $result{MODELID};

$result{MODELID} = rcp_get_device_type();
$result{FIRMWARE} = rcp_get_firmware();
my @cl = 1 .. rcp_get_video_in_number();
my $cap_list = rcp_get_cap_list();
#warn Dumper $cap_list;
$result{CAMERA_LIST} = join( ',', @cl );

# Check MODELID & FIRMWARE ---------------------------------------------------
if(defined $conf->{MODELID} and $result{MODELID} ne $conf->{MODELID}) {
  $result{STATUS}="WARNING: PCW-0001 [$conf->{DEVID}] MODELID does not match configuration";
}elsif(defined $conf->{CAMERAFIRMWARE} and $result{FIRMWARE} ne $conf->{CAMERAFIRMWARE}) {
  $result{STATUS}="WARNING: PCW-0001 [$conf->{DEVID}] FIRMWARE does not match configuration";
}

#------------------------------------------------------------------------------
# get Sample picture
#------------------------------------------------------------------------------
$result{SNAPSHOT_LIST}=ProbeSnapshotList(@cl);
#if($conf->{PROBE} eq 'DEFINE') {
#   $result{SNAPSHOT}=ProbeSamplePicture();
#}

#------------------------------------------------------------------------------
# get video and audio properties
#------------------------------------------------------------------------------

my $video_list = {'mjpg'=>1};
my $supp_resol = {};
if (defined $result{MODELID}) {
	$$supp_resol{0} = 1 if $result{MODELID} eq $modelnames_old{$bosch_old_vj10}; # QCIF
	$$supp_resol{1} = 1 if $result{MODELID} eq $modelnames_old{$bosch_old_vj10}; # CIF
	$$supp_resol{2} = 1 if $result{MODELID} eq $modelnames_old{$bosch_old_vj10}; # 2CIF
	$$supp_resol{3} = 1 if 0; # 4CIF
	$$supp_resol{4} = 1 if 0; # custom == 1/2 D1
	$$supp_resol{5} = 1 if $result{MODELID} eq $modelnames_new{$bosch_new_vipx2} or $result{MODELID} eq $modelnames_new{$bosch_new_ippanel}; # 2/3 D1 not described in caplist but present in VIP X2 and Dinion-IP-NWC-0495
	$$supp_resol{6} = 1 if $result{MODELID} eq $modelnames_new{$bosch_new_nbc};  # QVGA not described in caplist but present in NBC-255-P
	$$supp_resol{7} = 1 if $result{MODELID} eq $modelnames_new{$bosch_new_nbc};  #  VGA not described in caplist but present in NBC-255-P
}

#$$enc_list{'mpeg2'}=1 if defined rcp_get_mpeg2_current_params(1);
#$$enc_list{'mpeg4'}=1 if defined rcp_get_mpeg4_current_params(1);
foreach my $video_descr ( @{ $$cap_list{VIDEO} } ) {
    #warn Dumper ($video_descr);
    #$cam_enc{$$video_descr{input_no}} = $$video_descr{id} unless exists $cam_enc{$$video_descr{input_no}};
    push @{$cam_enc{$$video_descr{input_no}}}, $$video_descr{id};
    #$$video_list{'h263'} = 1 if $$video_descr{compression} & 2; # not supported yet
    $$video_list{'h264'} = 1 if $$video_descr{compression} & 4;
    if (defined $result{MODELID}) {
    	$$supp_resol{0} = 1 if $$video_descr{resolution} & 1 and $result{MODELID} ne $modelnames_new{$bosch_new_nbc}; # QCIF
    	$$supp_resol{1} = 1 if $$video_descr{resolution} & 2 and $result{MODELID} ne $modelnames_new{$bosch_new_nbc}; # CIF
    	$$supp_resol{2} = 1 if $$video_descr{resolution} & 4 and $result{MODELID} ne $modelnames_new{$bosch_new_nbc}; # 2CIF
    	#$$supp_resol{2} = 1 if $$video_descr{resolution} & 4 and $result{MODELID} ne $modelnames_new{$bosch_new_nbc} and $result{MODELID} ne $modelnames_new{$bosch_new_ippanel}; # 2CIF
    	$$supp_resol{3} = 1 if $$video_descr{resolution} & 8 and $result{MODELID} ne $modelnames_new{$bosch_new_nbc}; # 4CIF
    	$$supp_resol{4} = 1 if $$video_descr{resolution} & 16 and $result{MODELID} ne $modelnames_old{$bosch_old_vip1000}; # custom == 1/2 D1
    	#$$supp_resol{4} = 1 if $$video_descr{resolution} & 16 and $result{MODELID} ne $modelnames_old{$bosch_old_vip1000} and $result{MODELID} ne $modelnames_new{$bosch_new_ippanel}; # custom == 1/2 D1
   }
}

$result{MEDIA_FORMAT_LIST} = join( ',', sort keys %$video_list );
$result{FRAMERATE_LIST} = join ',', @frame_rate;
#$result{IMAGESIZE_LIST} = join ',', map { $resolution[$_] } sort keys %$supp_resol;
my @rl=();
for( my $i = 0; $i < scalar @resolution; $i++ ) {
    $resolution[$i] =~ /^(\d+):/;
    push @rl, $resolution[$i] if $$supp_resol{int($1)};
}
$result{IMAGESIZE_LIST} = EscapeList( 'mjpg', 'S:176x144/120,M:352x288/240,L:704x288/240,XL:704x576/480', 'mpeg4', (join ',', @rl), 'h264', join ',', @rl );
#warn Dumper( [rcp_get_video_coder_list( 1 )] );
#warn Dumper( [rcp_get_video_coder_list( 2 )] );

my $audio_list = {};
foreach my $video_descr ( @{ $$cap_list{AUDIO} } ) {
    $$audio_list{'mpeg2'} = 1 if $$video_descr{compression} == 1;
    $$audio_list{'g711'} = 1 if $$video_descr{compression} == 2;
}
$result{AUDIO_FORMAT_LIST} = join( ',', sort keys %$audio_list );

$result{AUDIO_LIST} = '0:off,1:on';

$result{AUDIO} = rcp_get_audio_g711();
if( defined $conf->{MEDIA_FORMAT} and $conf->{MEDIA_FORMAT} ne 'mjpg' ) {
    ( $result{IMAGESIZE}, $result{RC_TARGETBITRATE}, $result{FRAMERATE}, $result{RC_MAXBITRATE}, $result{GOP} ) = macro_get_cam_mpeg4_info( $conf->{CAMERA} ) if $conf->{PROBE} =~ /^(DEFINE|FAST)$/ and exists $conf->{CAMERA} and $conf->{CAMERA};
}

#------------------------------------------------------------------------------
# interim report & exit
#------------------------------------------------------------------------------
if( $conf->{PROBE} =~ /^(DEFINE|FAST)$/ ) { leave(); ProbeResult(\%result); }
#if( $conf->{DEVID}==0 ) { leave(); ProbeResult(\%result); }

#------------------------------------------------------------------------------
# set RC (rate control) parameters + quality + imagesize
#------------------------------------------------------------------------------

# FIXME: why frame skip rate not works for VIP X2? or vlc don't understand that
# even through web interface
my $res = 0;
for( my $i = 0; $i < scalar @resolution; $i++ ) {
    if($resolution[$i] =~ /^(\d+):$conf->{IMAGESIZE}/) {
	$res = $1;
	last;
    }
}
#my $fsr = ($conf->{MEDIA_FORMAT} eq 'mjpg') ? floor(30/$conf->{FRAMERATE}+0.5) : 1;
my $fsr = 1;
if (defined $conf->{FRAMERATE}){
    my $fsr = floor(30/$conf->{FRAMERATE}+0.5);
}
macro_set_cam_mpeg4_info( $conf->{CAMERA}, $conf->{IMAGESIZE} ? $conf->{IMAGESIZE} : 0, $conf->{RC_TARGETBITRATE}, $fsr, $conf->{RC_MAXBITRATE}, $conf->{GOP}, $conf->{MODELID}, $conf->{MEDIA_FORMAT} );
$result{RC_SET}='OK';

#------------------------------------------------------------------------------
# set AudioParams
#------------------------------------------------------------------------------
#if ( $conf->{AUDIO} eq 'on' ) {
# no code for Bosch
#}
rcp_set_audio_g711( $conf->{AUDIO} ) if exists $conf->{AUDIO} and $conf->{AUDIO} =~ /^\d$/;
# final report-----------------------------------------------------------------------
leave();
ProbeResult(\%result);

