path: root/reolink/Reolink.pm

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::Request;
use IO::Socket::SSL;
use JSON;
use LWP::UserAgent;

our $VERSION = '1.1';

# Reolink defaults
my ($default_user, $default_pass, $default_proto) = ('admin', '', 'http');

sub make_url {
  my $this = shift;
  $this->{url} = "$this->{proto}://$this->{host}/cgi-bin/api.cgi";
}

# Internal function to actually invoke the API
sub api {
  my ($this, %args) = @_;

  unless ($this->{http}) {
    $this->{http} = LWP::UserAgent->new (agent => "Reolink/$VERSION");
    $this->{http}->ssl_opts (SSL_verify_mode => SSL_VERIFY_NONE, verify_hostname => 0);
  }

  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 $req = HTTP::Request->new ('POST', $url, ['Content-Type' => 'application/json', 'Accept' => 'application/json'], encode_json ([$json]));

  my $resp = $this->{http}->request ($req);
  if ($resp->is_redirect && $this->{proto} eq 'http') {
    $this->{proto} = 'https';
    make_url ($this);
    return api ($this, %args);
  }

  if ($this->{debug}) {
    if (! $resp->is_success) {
      print Dumper $resp;
    }
  }

  my $ret = $resp->is_success ? $resp->decoded_content : '[{"code":-1}]';
  my $retref = decode_json ($ret);

  carp "Request for command '$args{cmd} failed" unless $resp->is_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,
              image_quality_workaround => $args{image_quality_workaround} ? 1 : 0,
              debug  => $args{debug} ? 1 : 0
             };

  make_url ($this);

  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

use Image::Magick;
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}->post ($url);

  unless ($resp->is_success) {
    use Data::Dumper;
    carp "Failed to take snapshot";
    print Dumper $resp;
    return 1;
  }

  if ($this->{image_quality_workaround}) {
    my $image = Image::Magick->new ();
    $image->BlobToImage ($resp->decoded_content);
    $image->Set (quality => 66);
    if ($image->Get ('type') ne 'TrueColor') {
      print "Switching type from " . $image->Get ('type') . " to TrueColor\n";
      $image->Set (type => 'TrueColor');
    }
    $image->Write (filename => $filename);
  } else {
    my $fh;
    unless (open ($fh, ">$filename")) {
      carp "Failed to open '$filename': $!";
      return 1;
    }

    binmode $fh;
    print $fh $resp->decoded_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;