Reolink perl module: client API

1 files changed, 708 insertions, 0 deletions

diff --git a/Reolink.pm b/Reolink.pm
new file mode 100644
index 0000000..0bc8e19
--- /dev/null
+++ b/Reolink.pm
@@ -0,0 +1,708 @@
+package Reolink;
+
+=head1 NAME
+
+Reolink - perl module that implements an interface to Reolink IP cameras
+
+For more complete information, See official documentation at
+https://drive.google.com/drive/folders/19vQBJia0wKvzwscA-EpTDSFV5OfNYUL6
+
+=head1 SYNOPSIS
+
+    use Reolink;
+
+=head1 DESCRIPTION
+
+TODO
+
+
+=head1 AUTHOR
+
+Jon duSaint E<lt>F<jon@rockgeeks.net>E<gt>
+
+=cut
+
+use strict;
+use warnings;
+
+use Carp;
+use Data::Dumper;
+use HTTP::Tiny;
+use JSON;
+
+our $VERSION = '1.0';
+
+# Reolink defaults
+my ($default_user, $default_pass, $default_proto) = ('admin', '', 'http');
+
+# Internal function to actually invoke the API
+sub api {
+  my ($this, %args) = @_;
+
+  unless ($this->{http}) {
+    $this->{http} = HTTP::Tiny->new (agent           => "Reolink/$VERSION",
+                                     default_headers => {"Content-Type" => "application/json"});
+  }
+
+  my $json = { cmd => $args{cmd} };
+  $json->{action} = $args{action} if $args{action};
+  $json->{param}  = $args{param} // {};
+
+  #print Dumper $json;
+
+  my $token = $this->{token} // 'null';
+  my $url = "$this->{url}?cmd=$args{cmd}&token=$token";
+
+  my $resp = $this->{http}->request ('POST', $url, {content => encode_json ([$json])});
+
+  my $ret = $resp->{success} ? $resp->{content} : '[{"code":-1}]';
+  my $retref = decode_json ($ret);
+
+  carp "Request for command '$args{cmd} failed" unless $resp->{success};
+
+  return $retref->[0];
+}
+
+=head1 METHODS
+
+=over 1
+
+=item C<< new(host => 'hostname') >>
+
+=item C<< new(host => 'hostname', user|username => 'username', pass|password => 'password', proto => 'http|https') >>
+
+Create a new C<Reolink> object
+
+C<user> defaults to C<'admin'>, C<pass> defaults to empty, and C<proto> defaults to C<http>.
+
+=back
+
+=cut
+
+sub new {
+  my ($class, %args) = @_;
+
+  my $this = {
+              host   => $args{host}  // croak ("Missing 'host' parameter"),
+              user   => $args{user}  // $args{username} // $default_user,
+              pass   => $args{pass}  // $args{password} // $default_pass,
+              proto  => $args{proto} // $default_proto,
+              token  => undef,
+              errors => 0
+             };
+  $this->{url} = "$this->{proto}://$this->{host}/cgi-bin/api.cgi";
+
+  bless $this, $class;
+}
+
+################################################################################
+#
+# All the commands with identical calling conventions
+#
+
+# { "cmd" : "$cmd" }
+my @basic_commands = qw/
+                         GetDevInfo
+                         GetHddInfo
+                         Reboot
+                         GetAutoUpgrade
+                         CheckFirmware
+                         UpgradeOnline
+                         UpgradeStatus
+                         GetChannelstatus
+                         Logout
+                         GetOnline
+                         ScanWifi
+                         GetIrLights
+                         GetPowerLed
+                       /;
+
+# { "cmd" : "$cmd", "action" : 1 }
+my @basic_action_commands = qw/
+                                GetTime
+                                GetAutoMaint
+                                GetUser
+                                GetLocalLink
+                                GetDdns
+                                GetEmail
+                                GetFtp
+                                GetFtpV20
+                                GetNtp
+                                GetNetPort
+                                GetUpnp
+                                GetWifi
+                                GetWifiSignal
+                                GetPush
+                                GetP2p
+                                GetNorm
+                                GetAudioAlarm
+                              /;
+
+# { "cmd" : "$cmd", "action" : 1, "param" : { "channel" : $channel } }
+my @channel_commands = qw/
+                           GetDevName
+                           GetEmailV20
+                           GetPushV20
+                           GetImage
+                           GetOsd
+                           GetIsp
+                           GetMask
+                           GetEnc
+                           GetRec
+                           GetRecV20
+                           GetPtzPreset
+                           GetPtzPatrol
+                           GetPtzSerial
+                           GetPtzTattern
+                           GetAutoFocus
+                           GetMdAlarm
+                           GetMdState
+                           GetAudioAlarmV20
+                           GetBuzzerAlarmV20
+                           GetWhiteLed
+                         /;
+
+# Generate method definitions for the above lists
+{
+  no strict 'refs';
+  foreach my $pair (([\@basic_commands,        sub { $_[0]->api (cmd => $_[1]) }],
+                     [\@basic_action_commands, sub { $_[0]->api (cmd => $_[1], action => 1) }],
+                     [\@channel_commands,      sub { $_[0]->api (cmd => $_[1], action => 1, param => {channel => $_[2]}) }])) {
+    foreach my $cmd (@{$pair->[0]}) {
+      *{"Reolink::$cmd"} = sub {
+        my $resp = $pair->[1] ($_[0], $cmd, @_[1..$#_]);
+        maybe_handle_errors ($_[0], $cmd, $resp);
+        $resp;
+      };
+    }
+  }
+}
+
+=over 2
+
+=item C<GetDevInfo()>
+
+=item C<GetHddInfo()>
+
+=item C<Reboot()>
+
+=item C<GetAutoUpgrade()>
+
+=item C<CheckFirmware()>
+
+=item C<UpgradeOnline()>
+
+=item C<UpgradeStatus()>
+
+=item C<GetChannelstatus()>
+
+=item C<Logout()>
+
+=item C<GetOnline()>
+
+=item C<ScanWifi()>
+
+=item C<GetIrLights()>
+
+=item C<GetPowerLed()>
+
+=item C<GetTime()>
+
+=item C<GetAutoMaint()>
+
+=item C<GetUser()>
+
+=item C<GetLocalLink()>
+
+=item C<GetDdns()>
+
+=item C<GetEmail()>
+
+=item C<GetFtp()>
+
+=item C<GetFtpV20()>
+
+=item C<GetNtp()>
+
+=item C<GetNetPort()>
+
+=item C<GetUpnp()>
+
+=item C<GetWifi()>
+
+=item C<GetWifiSignal()>
+
+=item C<GetPush()>
+
+=item C<GetP2p()>
+
+=item C<GetNorm()>
+
+=item C<GetAudioAlarm()>
+
+=item C<GetDevName()>
+
+=item C<GetEmailV20()>
+
+=item C<GetPushV20()>
+
+=item C<GetImage()>
+
+=item C<GetOsd()>
+
+=item C<GetIsp()>
+
+=item C<GetMask()>
+
+=item C<GetEnc()>
+
+=item C<GetRec()>
+
+=item C<GetRecV20()>
+
+=item C<GetPtzPreset()>
+
+=item C<GetPtzPatrol()>
+
+=item C<GetPtzSerial()>
+
+=item C<GetPtzTattern()>
+
+=item C<GetAutoFocus()>
+
+=item C<GetMdAlarm()>
+
+=item C<GetMdState()>
+
+=item C<GetAudioAlarmV20()>
+
+=item C<GetBuzzerAlarmV20()>
+
+=item C<GetWhiteLed()>
+
+=back
+
+=cut
+
+################################################################################
+#
+# All the commands that require parameters
+#
+
+#
+# Wrap a call to the API, including the call to handle errors
+#
+# The subroutine should return a list of args to api (generally "param => { ... }").
+#
+sub wrap_api(&@) {
+  my $sub = shift;
+  my $this = $_[0];
+  my $cmd = (split (/::/, (caller (1))[3]))[-1];
+  my $resp = $this->api (cmd => $cmd, &$sub (@_));
+  $this->maybe_handle_errors ($cmd, $resp);
+  $resp;
+}
+
+=over 2
+
+=item C<GetAbility(username)>
+
+Show the abilities of the specified user.
+
+=back
+
+=cut
+
+sub GetAbility {
+  wrap_api { ( param => { User => {userName => $_[1] } } ) } @_;
+}
+
+=over 2
+
+=item C<SetDevName(name)>
+
+Set the name of the camera.  This name shows up in the on-screen display.
+
+=back
+
+=cut
+
+sub SetDevName {
+  wrap_api { ( param => { DevName => { name => $_[1] } } ) } @_;
+}
+
+
+=over 2
+
+=item C<SetTime(year, month, day, hour, minute, second)>
+
+Set the time on the device.
+
+=item C<SetTime()>
+
+Just enable daylight savings time.
+
+=back
+
+=cut
+
+sub SetTime {
+  if (@_ == 1 || @_ == 7) {
+    wrap_api {
+      if (@_ == 1) {
+        ( param => { Dst => { enable => $_[1] // 1 } } )
+      } else {
+        ( param => { Time => { year => $_[1], mon => $_[2], day => $_[3],
+                               hour => $_[4], min => $_[5], sec => $_[6], timeZone => -28800, timeFmt => "DD/MM/YYYY", hourFmt => 0 } } )
+      }
+    } @_;
+  } else {
+    +{ code => 0 };
+  }
+}
+
+sub unimplemented {
+  return +{ cmd => $_[0], code => 1, error => { rspCode => 1, detail => "$_[0] is unimplemented in Reolink.pm" } };
+}
+
+unimplemented 'SetAutoMaint';
+unimplemented 'Format';
+unimplemented 'Upgrade';
+unimplemented 'Restore';
+unimplemented 'UpgradePrepare';
+unimplemented 'SetAutoUpgrade';
+
+=over 2
+
+=item C<Login()>
+
+Log in to the device.  This should be the first method invoked.
+
+=back
+
+=cut
+
+sub Login {
+  my ($this) = @_;
+
+  my $resp = $this->api (cmd => 'Login',
+                         param => { User => { userName => $this->{user},
+                                              password => $this->{pass} } });
+  if ($resp->{code} == 0) {
+    $this->{token} = $resp->{value}->{Token}->{name};
+    return 1;
+  }
+
+  0;
+}
+
+unimplemented 'AddUser';
+unimplemented 'DelUser';
+unimplemented 'ModifyUser';
+unimplemented 'Disconnect';
+unimplemented 'SetLocalLink';
+unimplemented 'SetDdns';
+unimplemented 'SetEmail';
+unimplemented 'SetEmailV20';
+unimplemented 'TestEmail';
+unimplemented 'SetFtp';
+unimplemented 'SetFtpV20';
+unimplemented 'TestFtp';
+
+=over 2
+
+=item C<SetNtp(enable, [server, [port, [interval]]]>
+
+Set NTP values on the device.  C<enable> turns it on or off.
+C<server>, C<port>, and C<interval> are all optional, and set the
+corresponding attributes.
+
+=back
+
+=cut
+
+sub SetNtp {
+  my ($this, $enable, $server, $port, $interval) = @_;
+  my $req = {};
+  $req->{enable} = $enable if defined $enable;
+  $req->{server} = $server if $server;
+  $req->{port} = $port if $port;
+  $req->{interval} = $interval if $interval;
+
+  if (keys (%$req) == 0) {
+    carp "No ntp params to set";
+    return 0;
+  }
+
+  my $resp = $this->api (cmd => 'SetNtp',
+                         param => {Ntp => $req});
+
+  $resp->{code};
+}
+
+unimplemented 'SetNetPort';
+unimplemented 'SetUpnp';
+unimplemented 'SetWifi';
+unimplemented 'TestWifi';
+unimplemented 'SetPush';
+unimplemented 'SetPushV20';
+unimplemented 'SetP2p';
+unimplemented 'SetNorm';
+unimplemented 'SetImage';
+
+=over 2
+
+=item C<SetOsd(channel,channelEnable,channelName,channelPos,timeEnable,timePos)>
+
+Set on-screen display parameters.
+
+"Channel" name is the name of the camera as set here or with
+C<SetDevName>.  Both "Pos" parameters specify where to display that
+datum.  Valid values are:
+
+    C<Upper Left>
+    C<Top Center>
+    C<Upper Right>
+    C<Lower Left>
+    C<Bottom Center>
+    C<Lower Right>
+
+Unconditionally disables the "Reolink" watermark.
+
+=back
+
+=cut
+
+sub SetOsd {
+  wrap_api {
+    ( param => { Osd => { channel    => $_[1],
+                          watermark  => 0,
+                          osdChannel => { enable => $_[2],
+                                          name   => $_[3],
+                                          pos    => $_[4] },
+                          osdTime    => { enable => $_[5],
+                                          pos    => $_[6] } } } ) } @_;
+}
+
+unimplemented 'SetIsp';
+unimplemented 'SetMask';
+unimplemented 'Preview';
+unimplemented 'GetCrop';
+unimplemented 'SetCrop';
+unimplemented 'SetEnc';
+unimplemented 'SetRec';
+unimplemented 'SetRecV20';
+unimplemented 'Search';
+unimplemented 'Download';
+
+=over 2
+
+=item C<Snap(filename)>
+
+Take a photo and save it to the file specified.  This might take a few
+seconds to run.
+
+=back
+
+=cut
+
+sub Snap {
+  my ($this, $filename) = @_;
+  # Generate random 16 char token.
+  my @valid = ("A".."Z", "a".."z", "0".."9", "-", "_");
+  my $tok = join "", map { $valid[ int (rand (256)) % @valid] } 1..16;
+  my $url = "$this->{url}?cmd=Snap&channel=0&rs=$tok&token=$this->{token}";
+  my $resp = $this->{http}->request ('POST', $url);
+
+  unless ($resp->{success}) {
+    use Data::Dumper;
+    carp "Failed to take snapshot";
+    print Dumper $resp;
+    return 1;
+  }
+
+  my $fh;
+  unless (open ($fh, ">$filename")) {
+    carp "Failed to open '$filename': $!";
+    return 1;
+  }
+
+  binmode $fh;
+  print $fh $resp->{content};
+
+  close $fh;
+
+  0;
+}
+
+unimplemented 'Playback';
+unimplemented 'NvrDownload';
+unimplemented 'SetPtzPreset';
+unimplemented 'SetPtzPatrol';
+unimplemented 'PtzCtrl';
+unimplemented 'SetPtzSerial';
+unimplemented 'SetPtzTattern';
+unimplemented 'SetAutoFocus';
+unimplemented 'GetAlarm';
+unimplemented 'SetAlarm';
+unimplemented 'SetMdAlarm';
+unimplemented 'SetAudioAlarm';
+unimplemented 'SetAudioAlarmV20';
+unimplemented 'SetBuzzerAlarmV20';
+unimplemented 'rtmp=start';
+unimplemented 'rtmp=stop';
+unimplemented 'rtmp=auth';
+
+=over 2
+
+=item C<SetIrLights(channel, state)>
+
+Set the IR LED state.  Valid values for C<state> are C<On>, C<Off>,
+and C<Auto>.
+
+=back
+
+=cut
+
+sub SetIrLights {
+  wrap_api { ( param => { IrLights => { channel => $_[1], state => $_[2] } } ) } @_;
+}
+
+=over 2
+
+=item C<SetPowerLed(channel,state>
+
+Set the state of the power LED.  Valid values for C<state> are C<On> and C<Off>
+
+=back
+
+=cut
+
+sub SetPowerLed {
+  wrap_api { ( param => { PowerLed => { channel => $_[0], state => $_[2] } } ) } @_;
+}
+
+=over 2
+
+=item C<SetWhiteLed(???)
+
+=back
+
+=cut
+
+unimplemented 'SetWhiteLed';
+
+# Error strings and codes, Negative numbers were copied straight out of the API document.
+my %error_strings = (2  => { short => 'invalid parameters', long => 'method called with invalid parameters' },
+                     1  => { short => 'unimplemented', long => 'Method not implemented' },
+                     0  => { short => "success", long => "success" },
+                     -1 => { short => "not exist", long => "Missing parameters" },
+                     -2 => { short => "out of mem", long => "Used up memory" },
+                     -3 => { short => "check err", long => "Check error" },
+                     -4 => { short => "param error", long => "Parameters error" },
+                     -5 => { short => "max session", long => "Reached the max session number." },
+                     -6 => { short => "please login first", long => "Login required" },
+                     -7 => { short => "login failed", long => "Login error" },
+                     -8 => { short => "timeout", long => "Operation timeout" },
+                     -9 => { short => "not support", long => "Not supported" },
+                     -10 => { short => "protocol", long => "Protocol error" },
+                     -11 => { short => "fcgi read failed", long => "Failed to read operation" },
+                     -12 => { short => "get config failed", long => "Failed to get configuration." },
+                     -13 => { short => "set config failed", long => "Failed to set configuration." },
+                     -14 => { short => "malloc failed", long => "Failed to apply for memory" },
+                     -15 => { short => "create socket failed", long => "Failed to created socket" },
+                     -16 => { short => "send failed", long => "Failed to send data" },
+                     -17 => { short => "rcv failed", long => "Failed to receiver data" },
+                     -18 => { short => "open file failed", long => "Failed to open file" },
+                     -19 => { short => "read file failed", long => "Failed to read file" },
+                     -20 => { short => "write file failed", long => "Failed to write file" },
+                     -21 => { short => "error token", long => "Token error" },
+                     -22 => { short => "The length of the string exceeds the limit", long => "The length of the string exceeds the limitmation" },
+                     -23 => { short => "missing param", long => "Missing parameters" },
+                     -24 => { short => "error command", long => "Command error" },
+                     -25 => { short => "internal error", long => "Internal error" },
+                     -26 => { short => "ability error", long => "Ability error" },
+                     -27 => { short => "invalid user", long => "Invalid user" },
+                     -28 => { short => "user already exist", long => "User already exist" },
+                     -29 => { short => "maximum number of users", long => "Reached the maximum number of users" },
+                     -30 => { short => "same version", long => "The version is identical to the current one." },
+                     -31 => { short => "busy", long => "Ensure only one user can upgrade" },
+                     -32 => { short => "ip conflict", long => "Modify IP conflicted with used IP" },
+                     -34 => { short => "need bing email", long => "Cloud login need bind email first" },
+                     -35 => { short => "unbind", long => "Cloud login unbind camera" },
+                     -36 => { short => "network timeout", long => "Cloud login get login information out of time" },
+                     -37 => { short => "password err", long => "Cloud login password error" },
+                     -38 => { short => "uid err", long => "Cloud bind camera uid error" },
+                     -39 => { short => "user not exist", long => "Cloud login user doesn’t exist" },
+                     -40 => { short => "unbind failed", long => "Cloud unbind camera failed" },
+                     -41 => { short => "cloud not support", long => "The device doesn’t support cloud" },
+                     -42 => { short => "login cloud server failed", long => "Cloud login server failed" },
+                     -43 => { short => "bind failed", long => "Cloud bind camera failed" },
+                     -44 => { short => "cloud unknown err", long => "Cloud unknown error" },
+                     -45 => { short => "need verify code", long => "Cloud bind camera need verify code" },
+                     -48 => { short => "Fetching a picture failed", long => "Snap a picture failed" },
+                     -100 => { short => "test failed", long => "Test Email、Ftp、Wifi failed" },
+                     -101 => { short => "check firmware failed", long => "Upgrade checking firmware failed" },
+                     -102 => { short => "download online failed", long => "Upgrade download online failed" },
+                     -103 => { short => "get upgrade status failed", long => "Upgrade get upgrade status failed" }
+                    );
+
+=over 2
+
+=item C<ErrorString(id)>
+
+Return a string that describes the error id.
+
+=item C<ErrorString(id, 0|'short')>
+
+Return a short string that describes the error id.
+
+=back
+
+=cut
+
+sub ErrorString {
+  my $this = shift;
+  my $id = shift;
+  unless (defined $error_strings{$id}) {
+    carp "Invalid error id '$id'";
+    return 'Invalid error id';
+  }
+  if (defined $_[0] && ($_[0] eq 'short' || $_[0] == 0)) {
+    $error_strings{$id}->{short};
+  } else {
+    $error_strings{$id}->{long};
+  }
+}
+
+=over 2
+
+=item C<Errors(0|1)>
+
+Enable or disable internal error reporting.  When set, and when an API
+call results in an error, methods will C<carp> the error string.
+
+=back
+
+=cut
+
+sub Errors {
+  my ($this, $enable) = @_;
+  unless (defined $enable) {
+    return $this->{errors};
+  }
+  $this->{errors} = $enable;
+}
+
+# Internal helper function for error handling
+sub maybe_handle_errors {
+  my ($this, $cmd, $resp) = @_;
+
+  if ($this->{errors} && $resp->{code}) {
+    carp "$cmd error: ".$this->ErrorString ($resp->{error}->{rspCode});
+    return 1;
+  }
+  return 0;
+}
+
+1;