infinitude

#!/usr/bin/env perl
use strict;
use warnings;
use feature ':5.10';

use FindBin;
use lib "$FindBin::Bin/lib";

use Mojolicious::Lite;
use Mojo::JSON qw/encode_json decode_json/;
use CarBus;
use Carp qw/shortmess/;
use CHI;
use DateTime;
use Path::Tiny;
use Time::HiRes qw/time/;
use Try::Tiny;
use XML::Simple::Minded;


my $store = CHI->new(
    driver         => 'File',
    root_dir       => 'state',
    depth          => 0,
    max_key_length => 256,
    namespace      => ''
);
$store->set(started=>time);

our $config;
our $config_file = path("infinitude.json");

if (my $config_json = $store->get('infinitude.json')) { #migrate older format config
	$config_file->spew($config_json);
	$store->remove('infinitude.json');
} else {
	# Default configuration if no infinitude.json file is found
	# customize config by editing infinitude.json
	try { $config = decode_json($config_file->slurp) };

    #TODO: depricate file-based config in favor of ENV
	$config //= {
#		serial_tty => '/dev/ttyUSB0',  #RS485 serial tty interface
#		serial_socket => '127.0.0.1:23',  #RS485 socket relay
		app_secret => 'Pogotudinal',   #Mojolicious cookie signature
		pass_reqs => 60*5             #Pass requests to Carrier webservice every 5 minutes (set to 0 to disable)
	};
	$config_file->spew(encode_json($config));
}

$config->{serial_tty}    = $ENV{SERIAL_TTY}    || $config->{serial_tty};
$config->{serial_socket} = $ENV{SERIAL_SOCKET} || $config->{serial_socket};
$config->{app_secret}    = $ENV{APP_SECRET}    || $config->{app_secret};
$config->{pass_reqs}     = $ENV{PASS_REQS}     || $config->{pass_reqs};

my $handle;
my $carbus;
my $init_attempt;
my $use_serial = ( (defined($config->{serial_tty})    and $config->{serial_tty})
                or (defined($config->{serial_socket}) and $config->{serial_socket}) );

sub serial_init {
    return unless $use_serial;
    return if $init_attempt and time<($init_attempt+7);
    $init_attempt = time;
    return unless $use_serial;
    if (defined($config->{serial_tty}) and -e $config->{serial_tty}) {
        require IO::Termios;
        warn "Using $config->{serial_tty} serial interface\n";
        $handle ||= IO::Termios->open($config->{serial_tty},"38400,8,n,1");
    } else {
        warn "Can't find serial device: $config->{serial_tty}. Serial monitoring disabled.\n" if $config->{serial_tty};
        delete $config->{serial_tty};
    }
    if (defined($config->{serial_socket}) and not $handle) {
        require IO::Socket::IP;
        my ($host,$port) = split(':',$config->{serial_socket});
        $host //= 'localhost';
        $port //= 'telnet';
        warn "Using $host port $port for serial interface\n";
        $handle ||= IO::Socket::IP->new( PeerHost=>$host, PeerPort=>$port);
    }
    $carbus = CarBus->new(async=>1, fh=>$handle) if $handle;
}
serial_init();

my @inbox = ();
if ($use_serial) {
    my $last_frame_time = time;
    my $frame_inbox_id = Mojo::IOLoop->recurring(0.0625 => sub {
        my $loop = shift;
        $loop->on(finish => sub {
            warn "Frame filler loop finishing";
        });
        $loop->on(reset => sub {
            warn "Frame filler loop resetting";
        });
        if ((time - $last_frame_time) < 10) {
            return unless $carbus;
            $carbus->fh_fill() if $carbus->fh;
            my $frame = $carbus->get_frame;
            if (not $frame->{error}) {
                push(@inbox, $frame);
                $last_frame_time = time;
            }
            shift @inbox if scalar(@inbox)>128;
        } else {
            serial_init();
        }
    });
}

app->secrets([$config->{app_secret}]);
push (@{app->static->paths}, ('development' eq ($ENV{MOJO_MODE}//'')) ? 'public/app' : 'public/dist');

#app->plugin('leak_tracker', { ignore_mode=>1, loglevel=>'debug' });

hook before_dispatch => sub {
	my $c = shift;

	my $url = $c->req->url;

	if ($url->to_abs->host =~ /(bryant|carrier|ioncomfort|infinitude|127.0.0.1)/i) { # request from stat or test harness
		my $nk = $url->path->to_string;
		$nk =~ s/\//-/g;
		$nk =~ s/^-//;
		$c->stash->{action_key} = $nk;
		#say "action_key: $nk";

		if ($config->{pass_reqs} and !$store->get('changes') and ($store->get('carrier_changes') or !$store->get($nk))) {
			$store->set($nk, time, $config->{pass_reqs});
			my $o_req = $c->req->clone;
			my $o_url = Mojo::URL->new($o_req->url->to_abs->to_string);
			$o_url->scheme('https');
			$o_req->url($o_url);

			$c->app->log->info("No cache for $nk. Make Carrier request");
			$store->set("req-$nk.txt", $o_req->to_string);
			#say "REQUEST:\n".$o_req->to_string."\n------------";
			my $ua = Mojo::UserAgent->new;
			my $tx = $ua->start(Mojo::Transaction::HTTP->new(req=>$o_req));
			$store->set("res-$nk.txt", $tx->res->to_string);
			#say "RESPONSE:\n".$store->get("res-$nk.txt");
			$c->stash->{pass_res} = $tx->res->body;
			$c->stash->{format} = 'xml' if ($tx->res->headers->content_type//'') =~ /xml/;
			$store->set("$nk.xml", $tx->res->body)
			  if ($tx->res->headers->content_type//'' =~ /xml/);
		} else {
			$c->app->log->info("$nk cached or passthru disabled");
		}

		#Mangle Internet-bound request to self
		my $appurl = $c->url_for('/');
		$url->base($appurl->base);
		$c->app->log->info($url);

		#Stuff data into store
		if (my $data = $c->req->param('data')) {
			my $xml;
			try {
				$xml = XML::Simple::Minded->new($data);
				my ($store_key) = $url->path  =~ /.*\/(.*)$/;
				$c->app->log->info("Saving $store_key");
				$store->set("$store_key.raw", $data);
				$store->set("$store_key.xml" , $xml.'');
				$store->set("$store_key.json", $xml->_as_json);
				$c->stash(store_key=>$store_key);
			} catch {
				$c->stash('error','true');
				$c->app->log->error($url, shortmess(), "Caught error: $_".$@);
				$store->set("error-".time() => 'url:'.$url."\nerror: $_\ndata:".$data);
			};
		}
	}
};

sub qtr_hr {
	my ($hour,$minute) = @_;
	if ($hour =~ /\d:\d/) {
		($hour,$minute) = $hour =~ /(\d+)\:(\d+)/;
	}
	$hour||=(localtime)[2];
	$minute||=(localtime)[1];
	$minute = 15*int(0.5+($minute/15));
	if ($minute==60) {
		$hour+=1;
		$minute=0;
	}
	return sprintf("%02d:%02d",$hour,$minute);
}

# Quick and dirty automation support. Ideally this will turn REST'y
# 	but we want to ensure automation devices eg VeraLite will work first
any '/api/:zone_id/hold' => sub {
	my $c = shift;
	my $xml = XML::Simple::Minded->new($store->get('systems.xml'));

	my $zone;
	my $idx = $c->stash('zone_id')||1;
	if ($idx eq 'wholeHouse') {
		$zone = $xml->system->config->wholeHouse;
	} else {
		$idx--;
		$zone = $xml->system->config->zones->zone->[$idx];
	}

	my $setting = {};

	my $hold = $c->req->param('hold') || '';
	$setting->{hold} = $hold eq 'off' ? 'off' : 'on';
	$zone->hold([$setting->{hold}]);

	my $activities = { home=>'home', away=>'away', sleep=>'sleep', wake=>'wake', manual=>'manual' };
	$setting->{activity} = $activities->{lc($c->req->param('activity'))} || 'home';
	$zone->holdActivity([$setting->{activity}]);

	# default to about an hour from now
	my $until = $c->req->param('until') || ((localtime)[2] + 1);
	$setting->{until} = $until eq 'forever' ? {} : &qtr_hr($until);
	$zone->otmr([$setting->{until}]);

	$store->set('systems.xml',  $xml.'');
	$store->set('systems.json', $xml->_as_json());
	$store->set(changes => 'true');

	#$c->render(text=>$xml, format=>'xml');
	$c->render(json=>$setting);
};

sub api_stat {
       my $c = shift;
       my $status = decode_json($store->get('status.json')||'{}');
       my $zone_id = $c->stash('zone_id')//'';
       if ($zone_id =~ /^\d+$/) {
               my $idx = ($zone_id||1) - 1;
               $status = $status->{status}[0]{zones}[0]{zone}[$idx];
       } else {
               $status = $status->{status}[0];
       }
       my $prop = $c->stash('prop') || $zone_id;
       if ($prop =~ /^[A-Z]/i) {
	       my $val = $status->{$prop};
	       $val = $val->[0] if ref($val) eq 'ARRAY' && scalar(@$val)==1;
	       $val *=1 if defined($val) and $val =~ /^[\.\d]+$/;
	       $status = { $prop=>$val };
       }
       $c->render(json=>$status);
}
get '/api/status/:zone_id/:prop' => \&api_stat;
get '/api/status/:zone_id/' => \&api_stat;
get '/api/status/' => \&api_stat;

any '/api/:zone_id/activity/:activity_id' => sub {
	my $c = shift;
	my $xml = XML::Simple::Minded->new($store->get('systems.xml'));

	my $idx = ($c->stash('zone_id')||1) - 1;
	my $zone = $xml->system->config->zones->zone->[$idx];

	my $setting = {};
	foreach my $activity (@{$zone->activities->activity}) {
		if ($activity->id eq $c->stash('activity_id')) {
			foreach my $set (qw/clsp htsp fan/) {
				$activity->$set([$c->req->param($set)]) if $c->req->param($set);
			}
			$setting = decode_json($activity->_as_json);
			$store->set('systems.xml',  $xml.'');
			$store->set('systems.json', $xml->_as_json());
			$store->set(changes => 'true');
			last;
		}
	}
	$c->render(json=>$setting);
};

get '/api/state_keys' => sub {
	my $c = shift;
	$c->render(json=>[sort $store->get_keys] );
};

# quick and dirty thermostat register request
post '/api/samreq' => sub {
    my $c = shift;
    my $reg = $c->req->json->{register};
    my ($tab,$row) = $reg =~ m/([0-9a-fA-F]{2})\s*([0-9a-fA-F]{2})$/;
    my $frame = $carbus->samreq(hex($tab),hex($row));
    $c->log->debug("Making Virtual SAM request: register $reg table $tab and row $row\n".$frame->frame_hex);
    $c->render( json=>{ frame_hex=>$frame->frame_hex });
};


# access simple system config variables by path
any '/api/*variable_path' => sub {
	my $c = shift;
	my $xml = XML::Simple::Minded->new($store->get('systems.xml'));
	my $search = $xml->system();
	foreach my $node (split('/',$c->stash('variable_path'))) {
		$search = ($node =~ /^\d+$/) ? $search->[$node]
		                             : $search->$node;
	}
	my $setting = { status=>'success' };

	try {
		if (ref($search)) {
			# path returns a structure. Can modify.
			my %sets = %{$c->req->params->to_hash()};
			my $set_changes = delete $sets{set_changes} || 0; #set change flag upon request
			foreach my $key (keys %sets) {
				$set_changes ||= ($search->$key ne $sets{$key}); # set change flag if value has changed
				$search->$key([$sets{$key}]);
			}
			$setting->{data} = { %{$search->TO_JSON()} };
			$store->set('systems.xml',  $xml.'');
			$store->set('systems.json', $xml->_as_json());
			if (('POST' eq $c->req->method) or ('PUT' eq $c->req->method) or $set_changes) {
				$store->set(changes => 'true');
			}
		} else {
			#path is a scalar. return only.
			$setting->{data} = $search;
		}
	} catch {
		$setting->{status} = 'fail';
	};

	$c->render(json=>$setting);
};


get '/' => sub {
  my $c = shift;
  $c->reply->static('index.html');
};

get '/Alive' => sub {
	my $c = shift;
	$c->render(text=>'alive', format=>'txt');
};

get '/time' => sub {
	my $c = shift;
	my $date = DateTime->now();
	my $xml = XML::Simple::Minded->new({
		"time" => {
			version => '1.9',
			utc => [$date->strftime("%FT%TZ")]
		}
	});
	$c->render(text=>$xml, format=>'xml');
};

get '/releaseNotes/#id' => sub {
	my $c = shift;
	my $text = $store->get('releaseNotes-'.$c->stash('id'));
	$c->render(text=>"WARNING: installing new firmware may cause Infinitude to stop working!\n\n$text", format=>'txt');
};

post '/systems/:id' => sub {
	my $c = shift;
	if ($c->stash('id') eq 'infinitude') { # Data is being saved from web client
		my $xml = XML::Simple::Minded->new($c->req->json);
		$store->set('systems.xml'  => $xml.'');
		$store->set('systems.json' => $xml->_as_json);
		$store->set(changes => 'true');
	} else { # Data from thermostat.
		if (!$c->stash('error')) {
			if (my $key = $c->stash('store_key')) {
				$store->set( 'systems.xml' => $store->get("$key.xml") );
				$store->set( 'systems.json' => $store->get("$key.json") );
			}
		}
	}
	$c->render(text=>'',format=>'txt');
};

# stat fetches config if server has changes
get '/systems/:id/config' => sub {
	my $c = shift;
	if ($store->get('carrier_changes') and $c->stash->{pass_res}) {
	  $store->set(carrier_changes => '' );
	  $store->set(changes => time+60); # Force a followup stat->infinitude push/pull cycle after 1m
	  $c->render(text=>$c->stash->{pass_res}, format=>'xml');
	} else {
	  my $xml = XML::Simple::Minded->new($store->get('systems.xml'));
	  my $config = XML::Simple::Minded->new({config=>$xml->system->config()});
	  $c->render(text=>$config, format=>'xml');
	}
};

get '/systems/:id' => sub {
	my $c = shift;
	my $xml = $store->get('systems.xml');
	$c->app->log->info("-------- Getting systems.xml (".$c->stash('id').") from infinitude.");
	$xml
		? $c->render(text=>$xml.'', format=>'xml')
		: $c->render(text=>'', format=>'txt');
};

post '/systems/:system_id/status' => sub {
	my $c = shift;
	my $changes = $store->get('changes') || '';
	if ($changes =~ /\d+/) {
		$changes = (time>$changes) ? 'true' : ''
	}

	$changes = 'true' unless $store->get('systems.xml'); #Force a change cycle if we have no stat config
	my $xml = XML::Simple::Minded->new({
		status => {
			 version => '1.37',
			pingRate => [$changes eq 'true' ? 20 : 12],
			serverHasChanges => [$changes || 'false'],
			configHasChanges => [$changes || 'false'],
		}
	});

	# if infinitude has no changes, and this is a carrier passthru request, return carrier's response
	if (!$changes and $c->stash->{pass_res}) {
	  $c->app->log->info("********** Check Carrier/Bryant change flags ****************");
	  $xml = XML::Simple::Minded->new($c->stash->{pass_res});
	  $xml->status->pingRate([12]);
	  $changes = $xml->status->serverHasChanges eq 'true' ? 1 : 0;
	  $store->set(carrier_changes => time, 120) if $changes; # open a window to Carrier passthru, max of 2 minutes
	}

	if ($changes) {
	  $c->app->log->info("********** There are changes. ****************");
	  $store->set(changes=>'');
	}
	$c->render(text=>$xml, format=>'xml');
};

any '/systems/:system_id/:part' => sub {
	my $c = shift;
	$c->app->log->info('Unimplemented request: ' . $c->stash->{'part'});
	$c->render(text=>'', format=>'txt');
};

my $scantab = 0;
my $scanrow = 0;
my $scansec = 0;
websocket '/serial' => sub {
	my $c = shift;
	unless ($use_serial) {
		$c->app->log->info("Websocket opened, but no streaming source is available");
		return;
	}

	my $socketloop_id = Mojo::IOLoop->recurring(0.03125 => sub {
        my $loop = shift;
		if (my $frame = shift @inbox) {
			my $fstruc = $frame->frame_hash;
			$fstruc->{timestamp} = time;
            my $reg = sprintf("%02x%02x",$frame->frame_hash->{table}, $frame->frame_hash->{row});
            if ($fstruc->{Function} eq 'reply' and my $regparse = $frame->reg_parser($reg)) {
                my $payf = try { $regparse->parse($frame->frame_hash->{data}); };
                if ($payf) {
                    if ($payf->{rows} and $ENV{SCAN_THERMOSTAT}) {
                        $scanrow = $payf->{rows}+1;
                        warn sprintf(">>>>>>>>>>> table %02x has %d rows <<<<<<<<<<<<<<<<<<<", $scantab, $payf->{rows});
                    }
                    $fstruc->{field} = $payf;
                }
            }

            if ($ENV{SCAN_THERMOSTAT}) {
                if (time>=$scansec+3) {
                    $scansec = time;
                    if ($scanrow > 0) {
                        $scanrow--;
                    }
                    if ($scanrow == 0) {
                        $scantab+=1;
                        $scanrow=1;
                        $scantab=0x01 if $scantab>0x51;
                    }
                    $c->log->debug(sprintf("scanning table %02x row %02x", $scantab, $scanrow));
                    $carbus->samreq($scantab, $scanrow);
                }
            }
			$c->send({json=>$fstruc});
		}
	});

	$c->on('finish' => sub {
		my ($c, $code) = @_;
        Mojo::IOLoop->remove($socketloop_id);
		$c->app->log->info("Websocket Closed: $code");
	});
};

any '/*catchall' => sub {
	my $c = shift;
	my $store_key = $c->stash('catchall');
	$store_key =~ s/\//-/g;
	my $text = $c->stash->{pass_res}
	        || $store->get($store_key)
		|| $store->get("$store_key.xml")
		|| $store->get("$store_key.json")
		// '';

	my $format = $c->stash('format')     ? $c->stash('format')
	           : $store_key =~ /\.json$/ ? 'json'
		   : $text =~ /^\s*{/        ? 'json'
	           : $store_key =~ /\.xml$/  ? 'xml'
	           : $text =~ /^\s*</        ? 'xml'
		   :                           'txt';

	$text = '{}' if ($format eq 'json' and !$text);
	$text = "Infinitude doesn't know how to ".$c->req->method." $store_key" unless ($text or $store->is_valid($store_key));

	$c->render(text=>$text, format=>$format);
};

app->log->level($ENV{LOGLEVEL}//app->log->level);
app->start;