#!/usr/bin/perl


#use MIME::Base64;
# my linux's perl does not have MIME::Base64 module, window's has

use POSIX;
use Socket;

# from ActivePerl
sub encode_base64 ($;$)
{
    my $res = "";
    my $eol = $_[1];
    $eol = "\n" unless defined $eol;
    pos($_[0]) = 0;                          # ensure start at the beginning
    while ($_[0] =~ /(.{1,45})/gs) {
    $res .= substr(pack('u', $1), 1);
    chop($res);
    }
    $res =~ tr|` -_|AA-Za-z0-9+/|;               # `# help emacs
    # fix padding at the end
    my $padding = (3 - length($_[0]) % 3) % 3;
    $res =~ s/.{$padding}$/'=' x $padding/e if $padding;
    # break encoded string into lines of no more than 76 characters each
    if (length $eol) {
    $res =~ s/(.{1,76})/$1$eol/g;
    }
    $res;
}

#
# This is a internal routine
#
# usage
#  switchbox_request( switchbox_ip, port, uri, username, password, timeout )
#
# returns
#  undef   - if no connect or timeout expired
#  html    - if OK
#
sub switchbox_request
{
    my $host = shift;
    my $port = shift;
    my $uri = shift;
    my $username = shift;
    my $password = shift;
    my $timeout = shift;
    my $request;
    my $answer = undef;

    socket( SOCKET, PF_INET, SOCK_STREAM, getprotobyname('tcp') );

    my $inetaddr = inet_aton($host) || return undef;

    connect( SOCKET, sockaddr_in( $port, $inetaddr ) ) || return undef;

    if( $username ne '' )
    {
        my $auth = encode_base64( $username . ':' . $password );
        $auth =~ s/\s+$//; # remove tail '\n'
        $request =
            "GET $uri HTTP/1.0\n".
            "Authorization: Basic $auth\n".
            "\n";
    } else
    {
        $request =
            "GET $uri HTTP/1.0\n".
            "\n";
    }

#    print "{".$request."}\n";

    defined( send( SOCKET, $request, 0 ) ) || return undef;

    my $rout, $rin = '';
    vec( $rin, fileno(SOCKET), 1) = 1;
    $nfound = select( $rout=$rin, undef, undef, $timeout );
    return undef if $nfound==0;

    while( vec( $rout, fileno(SOCKET), 1) )
    {
        my $buf;
        last unless recv( SOCKET, $buf, 0x100, 0 );
        last if 0==length($buf);
        $answer .= $buf;
    }
    close( SOCKET );
#    print "[".$answer."]\n";
    return $answer;
}

#
# usage
#  switchbox_read( switchbox_ip, port, username, password, timeout )
#
# returns
#  (errcode,              false,  if no connect or timeout expired
#   switches,             state of relays             
#   canwrite,             access rights, user can write switches masked "1"
#   canread,              access rights, user can read switches masked "1"
#   inreset,              switches which are in reset state
#   inputs,               inputs
#   denied)               another user is working (only for reference, reading cannot be denied)
#
sub switchbox_read
{
    my $host = shift;
    my $port = shift;
    my $username = shift;
    my $password = shift;
    my $timeout = shift;

    my $answer = switchbox_request( 
        $host,
        $port,
        '/k0',
        $username,
        $password,
        $timeout );

    return (0) unless defined($answer);
    return (0) if substr($answer,0,12) ne 'HTTP/1.1 200';
	$answer = substr($answer,-21);
    return (0) unless isxdigit($answer);
    $switches = hex(substr($answer,0,4));
    $canwrite = hex(substr($answer,4,4));
    $canread  = hex(substr($answer,8,4));
    $inreset  = hex(substr($answer,12,4));
    $inputs   = hex(substr($answer,16,4));
    $denied   = hex(substr($answer,20,1));
    return (1,$switches,$canwrite,$canread,$inreset,$inputs,$denied);
}

#
# usage
#  switchbox_full_write( switchbox_ip, port, 
#                        mask_turn_on, mask_turn_off, mask_reset, mask_break, 
#                        username, password, timeout )
#
# returns
#  (errcode,              false,  if no connect or timeout expired
#   switches,             state of relays             
#   canwrite,             access rights, user can write switches masked "1"
#   canread,              access rights, user can read switches masked "1"
#   inreset,              switches which are in reset state
#   inputs,               inputs
#   denied)               another user is working 
#
sub switchbox_full_write
{
    my $host = shift;
    my $port = shift;
    my $mask_turn_on = shift;
    my $mask_turn_off = shift;
    my $mask_reset = shift;
    my $mask_break = shift;
    my $username = shift;
    my $password = shift;
    my $timeout = shift;

    my $answer = switchbox_request( 
        $host,
        $port,
        sprintf( "/k1%.4X%.4X%.4X%.4X", 
            $mask_turn_on, $mask_turn_off, $mask_reset, $mask_break ),
        $username,
        $password,
        $timeout );

    return (0) unless defined($answer);
    return (0) if substr($answer,0,12) ne 'HTTP/1.1 200';

    $answer = substr($answer,-21);
    return (0) unless isxdigit($answer);
    $switches = hex(substr($answer,0,4));
    $canwrite = hex(substr($answer,4,4));
    $canread  = hex(substr($answer,8,4));
    $inreset  = hex(substr($answer,12,4));
    $inputs   = hex(substr($answer,16,4));
    $denied   = hex(substr($answer,20,1));
    return (1,$switches,$canwrite,$canread,$inreset,$inputs,$denied);
}

#
# usage
#  switchbox_write( switchbox_ip, port, new_relays_state, username, password, timeout )
#
# returns
#  (errcode,              false,  if no connect or timeout expired
#   switches,             state of relays             
#   canwrite,             access rights, user can write switches masked "1"
#   canread,              access rights, user can read switches masked "1"
#   inreset,              switches which are in reset state
#   inputs,               inputs
#   denied)               another user is working 
#
sub switchbox_write
{
    my $host = shift;
    my $port = shift;
    my $newstate = shift;
    my $username = shift;
    my $password = shift;
    my $timeout = shift;

    return switchbox_full_write( 
        $host, 
        $port,
        $newstate, 
        0xFFFF,
        0x0000,
        0xFFFF,
        $username,
        $password,
        $timeout );
}

#
# usage
#  switchbox_reset( switchbox_ip, port, relays_for_reset, username, password, timeout )
#
# returns
#  (errcode,              false,  if no connect or timeout expired
#   switches,             state of relays             
#   canwrite,             access rights, user can write switches masked "1"
#   canread,              access rights, user can read switches masked "1"
#   inreset,              switches which are in reset state
#   inputs,               inputs
#   denied)               another user is working 
#
sub switchbox_reset
{
    my $host = shift;
    my $port = shift;
    my $newstate = shift;
    my $username = shift;
    my $password = shift;
    my $timeout = shift;

    return switchbox_full_write( 
        $host, 
        $port,
        0x0000,
        0x0000,
        $newstate,
        0x0000,
        $username,
        $password,
        $timeout );
}



# =======================================================================
#
# This is a sample
#
# =======================================================================

my $address = '10.195.70.218';
my $port = 80;
my $username = 'root';
my $password = 'root_pwd';
#my $username = '';
#my $password = '';
my $timeout = 20; # in seconds

print "    Read                Write                  Read\n";

for( $i=0; $i<20; $i++ )
{
#    sleep(1) if $i!=0;

    @ack = switchbox_read( $address, $port, $username, $password, $timeout );
    if( $ack[0] )
    {
        printf "out=%4X in=%4X    ", $ack[1], $ack[5];
    } else
    {
        print "error  ";
    }

# returns
#  (errcode,              false,  if no connect or timeout expired
#   switches,             state of relays             
#   canwrite,             access rights, user can write switches masked "1"
#   canread,              access rights, user can read switches masked "1"
#   inreset,              switches which are in reset state
#   inputs,               inputs
#   denied)               another user is working 

    @ack = switchbox_write( $address, $port, 4+$i*3449, $username, $password, $timeout );
    if( $ack[0] )
    {
        if( $ack[6] )
        {
            print "denied ";
        } else
        {
          printf "out=%4X in=%4X    ", $ack[1], $ack[5];
        }
    } else
    {
        print "error  ";
    }

    @ack = switchbox_read( $address, $port, $username, $password, $timeout );
    if( $ack[0] )
    {
          printf "out=%4X in=%4X    ", $ack[1], $ack[5];
    } else
    {
        print "error  ";
    }

    print "\n";
}

# reset all
switchbox_reset(  $address, $port, 0xFFFF, $username, $password, $timeout );