reolink: client/server to take snapshots from a Reolink IP camera

1 files changed, 413 insertions, 0 deletions

diff --git a/reolink/reolink b/reolink/reolink
new file mode 100755
index 0000000..6ec6c62
--- /dev/null
+++ b/reolink/reolink
@@ -0,0 +1,413 @@
+#!/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'
+                     );
+my %debug_config   = (
+                      socket => "$ENV{HOME}/reolink.sock",
+                      config => "$ENV{HOME}/reolink.conf"
+                     );
+my $global_config = \%default_config;
+
+my ($min_interval, $max_interval) = (10, 600); # seconds
+
+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'
+                             },
+                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'
+                             },
+                exit      => {
+                              args   => 0,
+                              server => \&Server::server_terminate,
+                              help   => 'Stop the server'
+                             },
+                quit      => {alias => 'exit'},
+                terminate => {alias => 'exit'},
+                term      => {alias => 'exit'},
+                die       => {alias => 'exit'}
+               );
+
+package Server;
+
+use Errno qw/EINTR/;
+use File::Path 'make_path';
+use File::Spec;
+use Getopt::Long;
+use IO::Select;
+use OpenBSD::Pledge;
+use POSIX 'setsid';
+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   => 60,
+                     reolink_ip => '192.168.127.1',
+                     spool_dir  => '/home/jon/spool');
+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 "reolink_ip: $server_params{reolink_ip}\n";
+
+  close ($fh);
+
+  message ("saved $global_config->{config}\n");
+}
+
+sub load_params {
+  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);
+      debug ("config: found $key '$value'\n");
+      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;
+      }
+    }
+  }
+
+  close ($fh);
+}
+
+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})\n");
+  unlink $global_config->{socket};
+  my $umask = umask 0117; # rw-rw----
+  bind ($server_socket, sockaddr_un ($global_config->{socket})) || die "bind error: $!";
+  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 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], $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");
+
+  # 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;
+}
+
+sub run {
+  @saved_argv = (File::Spec->rel2abs ($0), @_);
+
+  GetOptions (debug => sub {
+                $debug = 1;
+                $global_config = \%debug_config;
+              },
+              server => sub {});
+
+  unless ($debug) {
+    pledge (qw/rpath wpath cpath inet proc unix/) or die "Failed to pledge: $!";
+    openlog ('reolinkd', 'PID', LOG_DAEMON);
+    $SIG{__DIE__} = sub { syslog (LOG_CRIT, "fatal: @_") };
+    daemonize;
+  }
+
+  load_params ();
+
+  $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;
+
+    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 main;
+
+if (@ARGV == 0 or map { $_ =~ /^-{0,2}server$/ ? 1 : () } @ARGV) {
+  exit Server::run (@ARGV);
+}
+
+exit Client::run (@ARGV);