reolink: Add timelapse video generation

1 files changed, 261 insertions, 28 deletions

diff --git a/reolink/reolink b/reolink/reolink
index 6ec6c62..376524c 100755
--- a/reolink/reolink
+++ b/reolink/reolink
@@ -9,15 +9,19 @@ use warnings;
 
 my %default_config = (
                       socket => '/var/run/reolink.sock',
-                      config => '/etc/reolink.conf'
+                      config => '/etc/reolink.conf',
+                      spool  => '/var/spool/reolink'
                      );
 my %debug_config   = (
                       socket => "$ENV{HOME}/reolink.sock",
-                      config => "$ENV{HOME}/reolink.conf"
+                      config => "$ENV{HOME}/reolink.conf",
+                      spool  => "$ENV{HOME}/spool"
                      );
 my $global_config = \%default_config;
 
-my ($min_interval, $max_interval) = (10, 600); # seconds
+# 30s is 1920 shots over 16 hours. At 24fps, this makes a 1:20 video.
+my ($min_interval, $interval, $max_interval) = (10, 30, 600);
+my $default_video_range = '0530-2130';
 
 my %commands = (
                 interval  => {
@@ -27,30 +31,36 @@ my %commands = (
                               help     => 'Set snapshot interval'
                              },
                 snapshot  => {
-                              args   => 0,
-                              server => \&Server::snapshot,
-                              help   => 'Take a snapshot now'
+                              args     => 0,
+                              server   => \&Server::snapshot,
+                              help     => 'Take a snapshot now'
                              },
                 status    => {
-                              args   => 0,
-                              server => \&Server::server_status,
-                              help   => 'Send status of the server'
+                              args     => 0,
+                              server   => \&Server::server_status,
+                              help     => 'Send status of the server'
                              },
-                ping      => {alias => 'status'},
+                ping      => {alias    => 'status'},
                 pid       => {
-                              args   => 0,
-                              server => \&Server::server_pid,
-                              help   => 'Send the pid of the server'
+                              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'
+                              args     => 0,
+                              server   => \&Server::server_terminate,
+                              help     => 'Stop the server'
                              },
-                quit      => {alias => 'exit'},
-                terminate => {alias => 'exit'},
-                term      => {alias => 'exit'},
-                die       => {alias => 'exit'}
+                quit      => {alias    => 'exit'},
+                terminate => {alias    => 'exit'},
+                term      => {alias    => 'exit'},
+                die       => {alias    => 'exit'}
                );
 
 package Server;
@@ -61,7 +71,7 @@ use File::Spec;
 use Getopt::Long;
 use IO::Select;
 use OpenBSD::Pledge;
-use POSIX 'setsid';
+use POSIX qw(setsid :sys_wait_h);
 use Socket;
 use Sys::Syslog qw/:standard :macros/;
 
@@ -77,9 +87,9 @@ BEGIN {
   Reolink->import();
 }
 
-my %server_params = (interval   => 60,
+my %server_params = (interval   => $interval,
                      reolink_ip => '192.168.127.1',
-                     spool_dir  => '/home/jon/spool');
+                     video      => $default_video_range);
 my $camera_host = '192.168.127.10';
 my ($debug, $local) = (0, 0);
 
@@ -113,13 +123,16 @@ sub save_params {
   print $fh "interval: $server_params{interval}\n";
   print $fh "spool_dir: $server_params{spool_dir}\n";
   print $fh "reolink_ip: $server_params{reolink_ip}\n";
+  print $fh "video: $server_params{video}\n";
 
   close ($fh);
 
-  message ("saved $global_config->{config}\n");
+  message ("saved $global_config->{config}");
 }
 
 sub load_params {
+  $server_params{spool_dir} = $global_config->{spool_dir} if not defined $server_params{spool_dir};
+
   open (my $fh, '<', $global_config->{config}) or return;
 
   foreach my $line (<$fh>) {
@@ -127,13 +140,15 @@ sub load_params {
     $line =~ s/^\s*#.*//;
     if ($line =~ m/^\s*(\S+)\s*[=:]\s*(\S+)/) {
       my ($key, $value) = ($1, $2);
-      debug ("config: found $key '$value'\n");
+      debug ("config: found $key '$value'");
       if ($key eq 'interval' and $commands{interval}->{validate} ($value)) {
         $server_params{interval} = $value;
       } elsif ($key =~ m/^spool(?:_dir)?$/) {
         $server_params{spool_dir} = $value;
       } elsif ($key =~ m/^(?:reolink|camera)(?:_ip)?$/) {
         $server_params{reolink_ip} = $value;
+      } elsif ($key =~ m/^video(?:[-_]?times?)?$/ and $commands{video}->{validate} ($value)) {
+        $server_params{video} = $value;
       }
     }
   }
@@ -159,7 +174,7 @@ sub daemonize {
 
 sub open_socket {
   socket (my $server_socket, PF_UNIX, SOCK_STREAM, 0) || die "socket error: $!";
-  debug ("open($global_config->{socket})\n");
+  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: $!";
@@ -195,6 +210,12 @@ sub set_interval {
   "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";
@@ -202,12 +223,12 @@ sub snapshot {
 
   my @t = localtime;
   my $fn = sprintf ("$server_params{spool_dir}/%04d%02d%02d-%02d%02d%02d.jpg",
-                    $t[5]+1900, $t[4], $t[3], $t[2], $t[1], $t[0]);
+                    $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\n");
+  debug ("snapshot => $fn");
 
   # take snapshot
   if ($r->Snap ($fn)) {
@@ -261,6 +282,88 @@ sub process_command {
   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 ($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
+
+}
+
+sub upload {
+  # Send link to page and current IP to rockgeeks.net
+
+}
+
+
 sub run {
   @saved_argv = (File::Spec->rel2abs ($0), @_);
 
@@ -292,6 +395,8 @@ sub run {
 
   do {
     snapshot;
+    maybe_generate_video ();
+    respool ();
 
     for (my $remaining = $server_params{interval}, my $start_time = time; $remaining > 0 && $keep_going;) {
       $! = 0;
@@ -404,10 +509,138 @@ sub run {
 
 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}/$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}/$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);