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;
