Samsung Aircon Client

samsung.pl

#!/usr/bin/perl

use 5.10.1;
use warnings;
use strict;

use File::Path qw/make_path/;
use IO::Socket::Multicast;
use IO::Socket::SSL;
use XML::Simple;
use File::Slurp qw/write_file read_file/;
use Getopt::Long::Descriptive qw(describe_options);
use Data::Dumper;

my $onoff = [qw/On Off/];

my %attributes = (
        AC_FUN_ENABLE => {
                hidden => 1,
        },
        AC_FUN_POWER => {
                english => 'Power',
                values => $onoff,
        },
        AC_FUN_OPMODE => {
                english => 'Mode',
                values => [qw/Auto Cool Dry Wind Heat/],
        },
        AC_FUN_TEMPSET => {
                english => 'Set temperature',
                min => 16,
                max => 30,
        },
        AC_FUN_COMODE => {
                english => 'Convenient mode',
                values => [qw/Off Quiet Sleep Smart SoftCool TurboMode WindMode1 WindMode2 WindMode3/],
        },
        AC_FUN_ERROR => {
                english => 'Error',
                reader => sub {my $element = shift; return $element->{Value} eq 'NULL' ? '' : $element->{Value}},
        },
        AC_FUN_TEMPNOW => {
                english => 'Current temperature',
        },
        AC_FUN_SLEEP => {
                english => 'Sleep timer',
                #todo - I suspect expressed as 1.5 for 1.5 hours
        },
        AC_FUN_WINDLEVEL => {
                english => 'Wind level (fan speed)',
                values => [qw/Auto Low Mid High Turbo/],
        },
        AC_FUN_DIRECTION => {
                english => 'Wind direction (fan direction)',
                values => [qw/Center Direct Fixed Indirect Left Long Off Right Rotation SwingLR SwingUD Wide/],
        },
        AC_ADD_AUTOCLEAN => {
                english => 'Auto clean',
                values => $onoff,
        },
        AC_ADD_SETKWH => {
                english => 'Set KWH',
                min => 0,
                max => 0,
        },
        AC_ADD_CLEAR_FILTER_ALARM => {
                english => 'Clear filter alarm',
                # Not in cude base...
        },
        AC_ADD_APMODE_END => {
                hidden => 1,
        },
        AC_ADD_STARTWPS => {
                hidden => 1,
        },
        AC_ADD_SPI => {
                english => 'Purifier',
                values => $onoff,
        },
        AC_OUTDOOR_TEMP => {
                english => 'Outdoor temperature',
                reader => sub {my $value = shift->{Value}; return sprintf('%1.1f', (($value - 32) * 5) / 9);},
        },
        AC_COOL_CAPABILITY => {
                english => "Cooling capacity",
        },
        AC_WARM_CAPABILITY => {
                english => "Warming capacity",
        },
        AC_SG_WIFI => {
                english => "Wifi",
        },
        AC_SG_INTERNET => {
                english => "Internet",
        },
        AC_ADD2_USEDWATT => {
                hidden => 1,
        },
        AC_ADD2_VERSION => {
                hidden => 1,
        },
        ##### MAC Address done the hard way
        AC_SG_MACHIGH => {
                hidden => 1,
        },
        AC_SG_MACMID => {
                hidden => 1,
        },
        AC_SG_MACLOW => {
                hidden => 1,
        },
        AC_SG_VENDER01 => {
                hidden => 1,
        },
        AC_SG_VENDER02 => {
                hidden => 1,
        },
        AC_SG_VENDER03 => {
                hidden => 1,
        },
        ##### // end mac
        AC_ADD2_PANEL_VERSION => {
                hidden => 1,
        },
        AC_ADD2_OUT_VERSION => {
                hidden => 1,
        },
        AC_ADD2_OPTIONCODE => { 
                hidden => 1,
        },
        AC_FUN_MODEL => {
                hidden => 1,
        },
        AC_ADD2_USEDPOWER => {
                english => "Used power",
        },
        AC_ADD2_USEDTIME => {
                english => "Online time",
        },
        AC_ADD2_CLEAR_POWERTIME => {
                hidden => 1,
        },
        AC_ADD2_FILTERTIME => {
                hidden => 1,
        },
        AC_ADD2_FILTER_USE_TIME => {
                hidden => 1,
        },
);

my ($token_file, $token, $ip_address, $command, $mac);

$|++;
main();
exit;

sub main {
        my ($opt, $usage) = describe_options(
                "usage: %c %o <ip address> <command>",
                [],
                ['help|?', 'print this help'],
                ['verbose|v', 'be more verbose'],
                [],
                ['timeout|t', 'discovery timeout', { default => 5 }],
                ['rcdir|r', 'where to store tokens', { default => "@{[$ENV{HOME}]}/.config/samsung" }],
        );

        print $usage->text and exit if $opt->help || !@ARGV;

        make_path $opt->rcdir unless -e $opt->rcdir;

        $ip_address = shift @ARGV;
        $command = shift @ARGV // '';
        my $unit =  discover($ip_address, $opt->timeout);;
        $mac = $unit->{mac_addr};

        $token_file = "@{[$opt->rcdir]}/$mac.token";

        say "Found @{[$unit->{nickname}]} on $ip_address ($mac)";

        die "Have no token for this air conditioner, please register first\n" unless $command eq 'register' || -e $token_file;
        $token = read_file $token_file unless $command eq 'register';

        given ($command) {
                cmd_register()                 when /register/i;
                device_control('AC_FUN_POWER') when /power/i;
                cmd_status()                   when /status/i;
                cmd_change_nickname()          when /rename/i;
        }
}

sub cmd_register {
        my $sock = ssl_connect();
        say "Turn your air conditioner off, then hit enter";
        <STDIN>;

        my $xml = read_xml($sock);
        write_xml($sock, {Request => {Type => 'GetToken'}});
        $xml = read_xml($sock);
        if ($xml->{Response}->{Type} eq 'GetToken' && $xml->{Response}->{Status} eq 'Ready') {
                say "Turn your air conditioner on";
                $xml = read_xml($sock);

                die "Authentication timed out\n" if $xml->{Response} && $xml->{Response}->{Type} eq 'Authenticate' && $xml->{Response}->{Status} eq 'Fail';
                die "Unknown issue\n" unless $xml->{Update} && $xml->{Update}->{Type} eq 'GetToken' && $xml->{Update}->{Status} eq 'Completed';

                $token = $xml->{Update}->{Token};

                write_file $token_file, $token;
        }
}

sub cmd_status {
        my $sock = auth_connect();
        write_xml($sock, {Request => {Type => 'DeviceState', DUID => $mac}});
        my $xml = read_xml($sock);
        die "Unknown issue\n" unless $xml->{Response}->{Type} eq 'DeviceState' && $xml->{Response}->{Status} eq 'Okay';
        foreach my $attr (@{$xml->{Response}->{DeviceState}->{Device}->{Attr}}) {
                my $attr_data = $attributes{$attr->{ID}};
                warn "Missing @{[$attr->{ID}]}" unless $attr_data;
                next if $attr_data->{hidden};

                my $extra = $attr_data->{values} ? " [@{[join ' ', @{$attr_data->{values}}]}]" : (
                        $attr_data->{min} ? " [@{[$attr_data->{min}]} <=> @{[$attr_data->{max}]}]" : '');

                my $value = ref $attr_data->{reader} ? &{$attr_data->{reader}}($attr) : $attr->{Value};
                say "@{[$attr_data->{english}]}: $value$extra" unless $attr->{ID} eq 'AC_FUN_ERROR' and !$value;
        }
}

sub cmd_change_nickname {
        my $sock = auth_connect();
        my $nickname = shift @ARGV;

        die "Nickname required" unless $nickname;
        my $nickhex = unpack('H*', pack('a*', $nickname));

        write_xml($sock, {Request => {Type => 'ChangeNickname', ChangeNickname => {DUID => $mac, Nickname => $nickhex}}});
        my $xml = read_xml($sock);

        die "Unknown issue\n" unless $xml->{Response}->{Type} eq 'ChangeNickname' && $xml->{Response}->{Status} eq 'Okay';
        say "Done.";

}

sub device_control {
        my $attr_id = shift;
        my $attr_data = $attributes{$attr_id};

        my $value = ucfirst(lc(shift @ARGV // ''));

        die "Value required" unless $value;
        if (my $values = $attr_data->{values}) {
                die "Invalid value" unless grep {$_ eq $value} @{$values};
        }

        my $sock = auth_connect();
        write_xml($sock, {Request => {Type => "DeviceControl", Control => {CommandID => "cmd00000", DUID => $mac, Attr => {ID => $attr_id, Value => $value}}}});
        my $xml = read_xml($sock);

        die "Unknown issue\n" unless $xml->{Response}->{Type} eq 'DeviceControl' && $xml->{Response}->{Status} eq 'Okay';
        say "Done.";
}

sub read_xml {
        my $sock = shift;
        my $xs = XML::Simple->new(KeepRoot => 1, ForceArray => [qw/Attr/]);
        while (my $input = <$sock>) {
                print "[IN ] $input";
                return $xs->XMLin($input) if $input =~ /^<\?xml/is;
        }
}

sub ssl_connect {
        return IO::Socket::SSL->new(
                PeerHost => $ip_address,
                PeerPort => 2878,
                SSL_verify_mode => SSL_VERIFY_NONE,
        ) or die $!;
}

sub auth_connect {
        my $sock = ssl_connect();
        my $xml = read_xml($sock);
        write_xml($sock, {Request => {Type => 'AuthToken', User => {Token => $token}}});
        $xml = read_xml($sock);
        die "Auth token failed, try registering again" if $xml->{Response}->{Type} eq 'AuthToken' && $xml->{Response}->{Status} eq 'Fail';
        die "Unknown issue authenticating\n" unless $xml->{Response}->{Type} eq 'AuthToken' && $xml->{Response}->{Status} eq 'Okay';
        return $sock;
}

sub write_xml {
        my $sock = shift;
        my $args = shift;
        my $xs = XML::Simple->new(KeepRoot => 1, XMLDecl => '<?xml version="1.0" encoding="utf-8" ?>', NoIndent => 1, NoSort => 1);
        my $xml = $xs->XMLout($args);
        $xml =~ s/^\s*//mg;
        $xml =~ s/[\r\n]//sg;
        say "[OUT] $xml";
        print $sock "$xml\n";
}

sub discover {
        my ($ip_address, $timeout) = @_;
        my %response;
        eval {
                $SIG{ALRM} = sub {die "Timeout\n"};
                alarm($timeout);

                my $s = IO::Socket::Multicast->new(
                        Reuse => 1,
                        LocalPort => 1900,
                        PeerPort => 1900,
                        Broadcast => 1
                ) or die $!;

                $s->mcast_loopback(0);
                my $msg = "NOTIFY * HTTP/1.1\rnHOST: 239.255.255.250:1900\r\nCACHE-CONTROL: max-age=20\r\nSERVER: AIR CONDITIONER\r\n\r\nSPEC_VER: MSpec-1.00\r\nSERVICE_NAME: ControlServer-MLib\r\nMESSAGE_TYPE: CONTROLLER_START\r\n";
                $s->mcast_send($msg, "$ip_address:1900");
                my $data = '';
                while ($s->recv($data, 4096)) {
                        %response = map {
                                my ($n, $v) = split /:\s*/, $_, 2;
                                (lc $n => $v)
                        } split /[\r\n]+/, $data;
                        next unless
                                defined $response{message_type} && $response{message_type} eq 'DEVICEDESCRIPTION' &&
                                defined $response{modelcode} && $response{modelcode} eq 'SAMSUNG_DEVICE' &&
                                defined $response{cache_control} && defined $response{mac_addr};

                        last;
                }
                alarm(0);

                $response{location} =~ s/http:\/\///;
                $response{nickname} = unpack('a*', pack('H*', $response{nickname}));

        };

        if (my $err = $@) {
                say "Discovery: $err\n";
                exit 1;
        }

        return \%response;
}

Have a nice time!
Can you please a little help or explain - i have some errors with this very uses-full script
`root@DietPi:~/.node-red# perl samsung.pl 192.168.5.4 status
given is experimental at samsung.pl line 184.
when is experimental at samsung.pl line 185.
when is experimental at samsung.pl line 186.
when is experimental at samsung.pl line 187.
when is experimental at samsung.pl line 188.
Possible precedence issue with control flow operator at samsung.pl line 279.
Found Детская on 192.168.5.4 (BCBCCDBBBDB)
Use of uninitialized value $sock in at samsung.pl line 268.
readline() on unopened filehandle at samsung.pl line 268.
[OUT]
Can't use an undefined value as a symbol reference at samsung.pl line 300.

root@DietPi:~/.node-red# perl -v
This is perl 5, version 20, subversion 2 (v5.20.2) built for armv7l-linux

`
will be very grateful for help, sorry for attention