#!/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   
#   inreset,              Reset is currently executed          
#   canwrite,             access rights, user can write switches masked "1"
#   canread)              access rights, user can read switches masked "1"
#
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,-4);
    return (0) unless isxdigit($answer);
    $switches = substr($answer,0,1);
    $inreset  = substr($answer,1,1);
    $canwrite = substr($answer,2,1);
    $canread  = substr($answer,3,1);
    return (1,$switches,$inreset,$canwrite,$canread);
}

#
# 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    
#   inreset,              Reset is currently executed                   
#   canwrite,             access rights, user can write switches masked "1"
#   canread)              access rights, user can read switches masked "1"
#
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%.1X%.1X%.1X%.1X", 
        $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,-4);
    $switches = substr($answer,0,1);			
    $inreset  = substr($answer,1,1);
    $canwrite = substr($answer,2,1);
    $canread  = substr($answer,3,1);
    return (1,$switches,$inreset,$canwrite,$canread);
}

#
# 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    
#   inreset,              Reset is currently executed                   
#   canwrite,             access rights, user can write switches masked "1"
#   canread)              access rights, user can read switches masked "1"
#
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, 
        0x01,
        0x00,
        0x01,
        $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    
#   inreset,              Reset is currently executed                   
#   canwrite,             access rights, user can write switches masked "1"
#   canread)              access rights, user can read switches masked "1"
#
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,
        0x00,
        0x00,
        $newstate,
        0x00,
        $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 "%6x  ", $ack[1];
    } else
    {
        print "error  ";
    }

    @ack = switchbox_write( $address, $port, (0x01 & $i), $username, $password, $timeout );

    if( $ack[0] )
    {
        printf "%6X ", $ack[1];
    } else
    {
        print "error  ";
    }

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

    print "\n";
}


# reset 
print "\n";
print "Output    Reset     R Rights    W Rights\n";

switchbox_reset(  $address, $port, 0x01, $username, $password, $timeout );

for( $i=0; $i<20; $i++ )
{
    @ack = switchbox_read( $address, $port, $username, $password, $timeout );
    if( $ack[0] )
    {
        printf "  %2X        %2X        %2X          %2X", $ack[1],$ack[2],$ack[3],$ack[4];
    } else
    {
        print "error  ";
    }
    print "\n";
    sleep (1)   
}