#!/usr/bin/perl
#
# Server to take snapshots with a Reolink IP camera every so often.
#
# Includes client that interacts with the server.

use strict;
use warnings;

my %default_config = (
                      socket    => '/var/run/reolink.sock',
                      config    => '/etc/reolink.conf',
                      spool_dir => '/var/spool/reolink'
                     );
my %debug_config   = (
                      socket    => "$ENV{HOME}/reolink.sock",
                      config    => "$ENV{HOME}/reolink.conf",
                      spool_dir => "$ENV{HOME}/spool"
                     );
my $global_config = \%default_config;

# 30s is 1920 shots over 16 hours. At 24fps, this makes a 1:20 video.
my ($min_interval, $interval, $max_interval) = (10, 30, 600);
# Retain images in the spool 24 hours by default
my $spool_retention_time = 24;
my $default_video_range = '0530-2130';

my %commands = (
                interval  => {
                              args     => 1,
                              server   => \&Server::set_interval,
                              validate => sub { $_[0] >= $min_interval && $_[0] <= $max_interval },
                              help     => 'Set snapshot interval'
                             },
                snapshot  => {
                              args     => 0,
                              server   => \&Server::snapshot,
                              help     => 'Take a snapshot now'
                             },
                spooltime => {
                              args     => 1,
                              server   => \&Server::set_spooltime,
                              validate => sub { $_[0] > 0 && int($_[0]) == $_[0] },
                              help     => 'Set spool retention time (in hours)'
                             },
                status    => {
                              args     => 0,
                              server   => \&Server::server_status,
                              help     => 'Send status of the server'
                             },
                ping      => {alias    => 'status'},
                pid       => {
                              args     => 0,
                              server   => \&Server::server_pid,
                              help     => 'Send the pid of the server'
                             },
                video     => {
                              args     => 1,
                              server   => \&Server::video,
                              validate => \&Process::validate_video_times,
                              help     => 'Time range for daily time-lapse video'
                             },
                exit      => {
                              args     => 0,
                              server   => \&Server::server_terminate,
                              help     => 'Stop the server'
                             },
                quit      => {alias    => 'exit'},
                terminate => {alias    => 'exit'},
                term      => {alias    => 'exit'},
                die       => {alias    => 'exit'}
               );

# Load parameters from the config file
sub load_params {
  my $params = $_[0];

  $params->{spool_dir} = $global_config->{spool_dir} if not defined $params->{spool_dir};

  open (my $fh, '<', $global_config->{config}) or return;

  foreach my $line (<$fh>) {
    chomp $line;
    $line =~ s/^\s*#.*//;
    if ($line =~ m/^\s*(\S+)\s*[=:]\s*(\S+)/) {
      my ($key, $value) = ($1, $2);
      if ($key eq 'interval' and $commands{interval}->{validate} ($value)) {
        $params->{interval} = $value;
      } elsif ($key =~ m/^spool(?:_dir)?$/) {
        $params->{spool_dir} = $value;
      } elsif ($key =~ m/^spool[-_]time$/ and $commands{spooltime}->{validate} ($value)) {
        $params->{spooltime} = $value;
      } elsif ($key =~ m/^(?:reolink|camera)(?:_ip)?$/) {
        $params->{reolink_ip} = $value;
      } elsif ($key =~ m/^video(?:[-_]?times?)?$/ and $commands{video}->{validate} ($value)) {
        $params->{video} = $value;
      }
    }
  }

  close ($fh);
}

package Server;

use Errno qw/EINTR/;
use File::Path 'make_path';
use File::Spec;
use Getopt::Long;
use IO::Select;
use OpenBSD::Pledge;
use OpenBSD::Unveil;
use POSIX qw(mktime setsid :sys_wait_h);
use Socket;
use Sys::Syslog qw/:standard :macros/;

BEGIN {
  # If we're running out of the dev tree (or otherwise have the module
  # installed with the executable), prefer the local version.
  my $wd = File::Spec->rel2abs ($0);
  $wd =~ s|/[^/]+$||;
  if (-f "$wd/Reolink.pm") {
    push @INC, $wd;
  }
  require Reolink;
  Reolink->import();
}

my %server_params = (interval   => $interval,
                     reolink_ip => '192.168.127.1',
                     spooltime  => $spool_retention_time,
                     video      => $default_video_range);
my $camera_host = '192.168.127.10';
my ($debug, $local) = (0, 0);

sub message {
  my $priority = @_ > 1 ? shift : LOG_INFO;
  my $msg = join ('', @_);
  if ($debug) {
    print "$msg\n";
  } else {
    syslog ($priority, $msg);
  }
}

sub error {
  my $line = (caller (1))[3];
  message (LOG_ERR, "error: @_ at $line");
}

sub debug {
  message (@_) if $debug;
}

sub save_params {
  my $fh;
  unless (open ($fh, '>', $global_config->{config})) {
    error ("failed to open $global_config->{config}: $!");
    return;
  }

  print $fh "# Autogenerated ".localtime.".\n";
  print $fh "interval: $server_params{interval}\n";
  print $fh "spool_dir: $server_params{spool_dir}\n";
  print $fh "spool_time: $server_params{spooltime}\n";
  print $fh "reolink_ip: $server_params{reolink_ip}\n";
  print $fh "video: $server_params{video}\n";

  close ($fh);

  message ("saved $global_config->{config}");
}

sub daemonize {
  chdir ('/') or die "failed to chdir(/): $!";

  open (STDIN,  '</dev/null') or die "failed to reopen stdin as /dev/null: $!";
  open (STDOUT, '>/dev/null') or die "failed to reopen stdout as /dev/null: $!";

  my $pid = fork();
  die "fork error: $!" unless defined $pid;

  exit if $pid; # parent

  die "setsid failed: $!" if setsid () == -1;

  open (STDERR, '>&', STDOUT) or die "failed to dup stdout: $!";
}

sub open_socket {
  socket (my $server_socket, PF_UNIX, SOCK_STREAM, 0) || die "socket error: $!";
  debug ("open($global_config->{socket})");
  unlink $global_config->{socket};
  my $umask = umask 0117; # rw-rw----
  bind ($server_socket, sockaddr_un ($global_config->{socket})) || die "bind error($global_config->{socket}): $!";
  umask $umask;
  listen ($server_socket, SOMAXCONN) || die "listen error: $!";
  $server_socket;
}

sub setup_reolink {
  my ($resp, $code);

  my $r = Reolink->new (host => $camera_host);
  $r->Login || die "Failed to login\n";
  $r->Errors (1);

  $code = $r->SetNtp (1, $server_params{reolink_ip});
  $code = $r->SetTime; # just enable DST
  $code = $r->SetOsd (0, 0, "Ay, Spy", "Upper Left", 0, "Upper Right");

  $r->Logout;
}

my $keep_going = 1;

sub server_terminate {
  $keep_going = 0;
  'bye';
}

sub set_interval {
  $server_params{interval} = $_[1];
  save_params;
  "ok";
}

sub set_spooltime {
  $server_params{spooltime} = $_[1];
  save_params;
  "ok";
}

sub video {
  $server_params{video} = $_[1];
  save_params;
  "ok";
}

sub snapshot {
  my $r = Reolink->new (host => $camera_host);
  $r->Login || die "Failed to login\n";
  $r->Errors (1);

  my @t = localtime;
  my $fn = sprintf ("$server_params{spool_dir}/%04d%02d%02d-%02d%02d%02d.jpg",
                    $t[5]+1900, $t[4]+1, $t[3], $t[2], $t[1], $t[0]);

  # Could have changed since last time through
  make_path ($server_params{spool_dir}, { mode => 0755 }) unless -d $server_params{spool_dir};

  debug ("snapshot => $fn");

  # take snapshot
  if ($r->Snap ($fn)) {
    warn "Error creating snapshot\n";
  }

  $r->Logout;

  "snap";
}

my @saved_argv;

sub server_reload {
  exec @saved_argv or die "exec for reload failed: $!";
}

sub server_status {
  'alive';
}

sub server_pid {
  "$$";
}

sub process_command {
  accept (my $s, $_[0]) || die "accept error: $!";
  $s->autoflush;
  my $command = <$s>;
  my $resp = 'error';

  my @command = split ' ', $command;
  my $cmd = shift @command;
  unless (defined $commands{$cmd}) {
    error ("unknown command from client '$cmd'\n");
    goto out;
  }
  if (@command < $commands{$cmd}->{args}) {
    error ("insufficient args from client for '$cmd' (expect $commands{$cmd}->{args}, have ".@command.")");
    goto out;
  }
  if (@command && $commands{$cmd}->{validate} && ! $commands{$cmd}->{validate} (@command)) {
    error ("invalid args from client for '$cmd'");
    goto out;
  }

  $resp = $commands{$cmd}->{server} ($s, @command);

 out:
  print $s "$resp\n";
  close $s;
}


my $process_child;
my @sigchld_handlers;

sub process_complete {
  local ($!, $?);

  while ((my $pid = waitpid (-1, WNOHANG)) > 0) {
    if ($pid == $process_child) {
      debug ("child process $process_child complete");
      if (@sigchld_handlers) {
        $SIG{CHLD} = pop @sigchld_handlers;
      }
      undef $process_child;
    }
  }
}

sub maybe_generate_video {
  # if current time has passed $end_time and no video exists for this date and there is no pending video process

  if (defined ($process_child)) {
    debug ("child process $process_child running...");
    return;
  }

  my ($start_time, $end_time) = $commands{video}->{validate} ($server_params{video});

  my @t = localtime;
  my $time = sprintf ('%d%02d', $t[2], $t[1]);
  if ($time < $end_time) {
    debug ("too early to generate video ($time < $end_time)");
    return;
  }

  my $video_prefix = sprintf ('%04d%02d%02d', $t[5]+1900, $t[4]+1, $t[3]);

  my @videos = <$server_params{spool_dir}/$video_prefix*.webm>;

  if (@videos) {
    debug ("already generated for $video_prefix");
    return;
  }

  debug ("generating video for $video_prefix");

  # extract program name and any "--debug" from @saved_argv
  my @process_args;
  foreach (@saved_argv) {
    next if m/server/;
    push @process_args, $_;
  }
  push @process_args, ('--process' => $video_prefix, '--range' => $server_params{video});

  push @sigchld_handlers, $SIG{CHLD};
  $SIG{CHLD} = \&process_complete;

  $process_child = fork ();
  unless (defined ($process_child)) {
    error ("failed to fork video process");
    pop @sigchld_handlers;
    return;
  }

  if ($process_child == 0) {
    exec @process_args or die "failed to launch child: @process_args: $!";
  }

  debug ("launched video process as pid $process_child");
}

sub respool {
  # Retain only past 24 hours of stills
  my $t = time - $server_params{spooltime} * 60 * 60;

  foreach my $image (<"$server_params{spool_dir}/*.jpg">) {
    if ($image =~ m/(\d{4})(\d{2})(\d{2})-(\d{2})(\d{2})(\d{2})\.jpg/) {
      my $file_time = mktime ($6, $5, $4, $3, $2 - 1, $1 - 1900);
      if ($file_time < $t) {
        debug ("delete $image ($file_time $t)");
        unlink $image;
      }
    }
  }
}

sub upload {
  # Send link to page and current IP to rockgeeks.net

}


sub run {
  @saved_argv = (File::Spec->rel2abs ($0), @_);

  GetOptions (debug => sub {
                $debug = 1;
                $global_config = \%debug_config;
              },
              server => sub {});

  main::load_params (\%server_params);

  unless ($debug) {
    pledge (qw/rpath wpath cpath inet proc unix unveil/) or die "Failed to pledge: $!";
    openlog ('reolink', 'PID', LOG_DAEMON);
    $SIG{__DIE__} = sub { syslog (LOG_CRIT, "fatal: @_") };

    daemonize;

    unveil ($server_params{spool_dir}, 'rwxc') || die "unveil($server_params{spool_dir}): $!";
    unveil ($global_config->{socket}, 'rwc')   || die "unveil($global_config->{socket}): $!";
    unveil ($global_config->{config}, 'rw')    || die "unveil($global_config->{config}): $!";
    unveil ($saved_argv[0], 'rx')              || die "unveil($saved_argv[0]): $!";
    unveil ('/etc/protocols', 'r')             || die "unveil(/etc/protocols): $!"; # HTTP::Tiny
    unveil ('/etc/localtime', 'r')             || die "unveil(/etc/localtime): $!"; # localtime
    unveil ('/usr/share/zoneinfo', 'rx')       || die "unveil (/usr/share/zoneinfo): $!"; # localtime
    unveil ()                                  || die "failed to lock unveil: $!";
  }

  make_path ($server_params{spool_dir}, { mode => 0755 }) unless -d $server_params{spool_dir};
  chdir ($server_params{spool_dir}) || die "chdir($server_params{spool_dir}): $!";

  $SIG{HUP} = \&server_reload;
  $SIG{INT} = \&server_terminate;
  $SIG{TERM} = \&server_terminate;

  setup_reolink ();

  my $s = open_socket ();
  my $i = IO::Select->new ();

  $i->add ($s);

  do {
    snapshot;
    maybe_generate_video ();
    respool ();

    for (my $remaining = $server_params{interval}, my $start_time = time; $remaining > 0 && $keep_going;) {
      $! = 0;
      my @ready = $i->can_read ($server_params{interval});
      if (@ready) {
        process_command (@ready);
      } else {
        die "select error: $!" if $! && !$!{EINTR};
      }

      $remaining = $server_params{interval} - (time - $start_time);
     }
  } while ($keep_going);

  close ($s);
  unlink $global_config->{socket};

  closelog unless $debug;

  return 0;
}

1;

package Client;

use Fcntl;
use Getopt::Long;
use Socket;

sub help {
  my $maxlen = 0;
  map { $maxlen = length $_ if length $_ > $maxlen } keys %commands;
  my %help = ();
  my %alias = ();

  my sub format_command { sprintf "%${maxlen}s  $commands{$_[0]}->{help}\n", $_[0]; };
  my sub format_alias   { sprintf "%${maxlen}s  Alias for $commands{$_[0]}->{alias}\n", $_[0]; };

  foreach my $cmd (sort keys %commands) {
    if (my $alias = $commands{$cmd}->{alias}) {
      my $str = format_alias ($cmd);

      if ($help{$alias}) {
        $help{$alias} .= $str;
      } elsif ($alias{$alias}) {
        $alias{$alias} .= $str;
      } else {
        $alias{$alias} = $str;
      }
    } else {
      $help{$cmd} = format_command ($cmd);
      if ($alias{$cmd}) {
        $help{$cmd} .= $alias{$cmd};
      }
    }
  }

  print "Commands:\n".join ('', map { $help{$_} } sort keys %help);
}

sub client_command {
  my @commands = ();
  while (@_) {
    my $cmd = shift;

    if ($cmd eq 'help') {
      shift @_;
      help ();
      next;
    }

    die "unknown command '$cmd'\n" unless defined $commands{$cmd};
    if (defined ($commands{$cmd}->{alias})) {
      $cmd = $commands{$cmd}->{alias};
    }
    die "insufficient args for '$cmd' (expect $commands{$cmd}->{args}, have ".@_.")" if @_ < $commands{$cmd}->{args};
    my @args = splice @_, 0, $commands{$cmd}->{args};
    if (@args && $commands{$cmd}->{validate}) {
      die "invalid args for '$cmd'" unless $commands{$cmd}->{validate} (@args);
    }
    push @commands, join (' ', ($cmd, @args)) . "\n";
  }
  @commands;
}

sub run {
  GetOptions (debug => sub {
                $global_config = \%debug_config;
              });

  my @commands = client_command (@ARGV);
  return 0 unless @commands;

  socket (my $sock, PF_UNIX, SOCK_STREAM, 0) || die "unable to connect to server socket: $!";
  connect ($sock, sockaddr_un ($global_config->{socket})) || die "connect error: $!";

  $sock->autoflush;

  foreach my $command (@commands) {
    print $sock "$command\n";
    my $response = <$sock>;
    print "$response";
  }

  close $sock;

  return 0;
}

1;

package Process;

use Getopt::Long;

# 4:3 resolutions (native is 2560:1920)
# height:crf values are interpolated from https://developers.google.com/media/vp9/settings/vod/
my @video_params = ({size => '1024:768',  crf => 32},
                    {size => '1280:960',  crf => 32},
                    {size => '1400:1050', crf => 31},
                    {size => '1440:1080', crf => 31},
                    {size => '1600:1200', crf => 28},
                    {size => '1920:1440', crf => 24},
                    {size => '2560:1920', crf => 19});
# my @videos = ({index => 3, suffix => '_small'});
my @videos = ({index => 3, suffix => '_small'},
              {index => 6, suffix => ''});

# Input format something like: '0530-2130'
# Return (start, end) with any leading '0' stripped if range validates, otherwise return empty list
sub validate_video_times {
  my $time_re = qr/(?:0?\d|1\d|2[0-3])[0-5]\d/;

  if ($_[0] =~ m/^($time_re)-($time_re)$/) {
    my ($start, $end) = ($1, $2);
    $start =~ s/^0//;
    if ($start < $end) {
      return ($start, $end);
    }
  }
  return ();
}

sub process {
  my $quality = shift;
  my $size = shift;
  my $pass = shift;
  my $outfile = shift;
  my @files = @_;

  # Two pass VP9 webm constant quality encoding
  my $cmd = ("ffmpeg"
             ." -y"
             ." -framerate 24"
             ." -f image2pipe -i -"
             ." -vf scale=$size"
             ." -c:v libvpx-vp9"
             ." -b:v 0"
             ." -quality good"
             ." -crf $quality"
             ." -pass $pass"
             ." -speed ".($pass == 1 ? 4 : 2)
             ." -an"
             .' '.$outfile);

  open (my $ffmpeg, "|-", $cmd) or die "open: $!";

 outer:
  foreach my $file (@files) {
    open (my $fh, "<", "$file") or do { print "error opening $file: $!\n"; next };

    my $chunk = 65536;

    while (my $nbytes = sysread ($fh, my $bytes, $chunk)) {
    again:
      my $outbytes = syswrite ($ffmpeg, $bytes, $nbytes);
      unless (defined ($outbytes)) {
        print "write to ffmpeg error: $!\n";
        last outer;
      }
      if ($outbytes < $nbytes) {
        $nbytes -= $outbytes;
        goto again;
      }
    }

    close ($fh);
  }

  close ($ffmpeg);
}

sub run {
  my ($start_time, $end_time);
  my $range = $default_video_range;

  GetOptions (process => sub {},
              'range=s'   => \$range,
              debug   => sub {
                $global_config = \%debug_config;
              });

  die "Invalid range '$range'\n" unless (($start_time, $end_time) = validate_video_times ($range));
  die "Missing date arg\n" unless @ARGV;

  # Summer: 5:42AM / 8:08PM (DST)
  # Winter: 6:55AM / 4:48PM
  #
  # 05:30 - 21:30 (local) 16 hours
  #
  # 60s, 24fps -> 1440 frames (1/40s)
  # 40s, 24fps -> 960 frames (1/60s)

  my @filelist = map { /-(?|0?(\d{3})|(\d{4}))\d{2}\./ && $1 >= $start_time && $1 <= $end_time ? $_ : () } glob "$global_config->{spool_dir}/$ARGV[0]-*";

  die "no files found with prefix $ARGV[0]\n" unless @filelist;
  print join("\n", @filelist)."\n";
  my @outfiles;
  my @times;
  my @fps;
  foreach my $v (@videos) {
    my $outfile = "$global_config->{spool_dir}/$ARGV[0]$v->{suffix}.webm";
    my $t1 = time;
    process ($video_params[$v->{index}]->{crf}, $video_params[$v->{index}]->{size}, 1, $outfile, @filelist);
    process ($video_params[$v->{index}]->{crf}, $video_params[$v->{index}]->{size}, 2, $outfile, @filelist);
    my $t2 = time;
    push @outfiles, $outfile;
    push @times, $t2 - $t1;
    push @fps, @filelist / $times[-1];
  }
  foreach my $i (0..$#outfiles) {
    printf "Generated $outfiles[$i] in $times[$i]s (%.1f FPS)\n", $fps[$i];
  }
}

1;

package main;

if (@ARGV == 0 or map { $_ =~ /^-{0,2}server$/ ? 1 : () } @ARGV) {
  exit Server::run (@ARGV);
} elsif (map { $_ =~ /^-{0,2}process$/ ? 1 : () } @ARGV) {
  exit Process::run (@ARGV);
}

exit Client::run (@ARGV);