File: //tmp/csf/ConfigServer/JSON.pm
# #
# @app ConfigServer Firewall & Security (CSF)
# Login Failure Daemon (LFD)
# @website https://configserver.dev
# @docs https://docs.configserver.dev
# @download https://download.configserver.dev
# @repo https://github.com/Aetherinox/csf-firewall
# @copyright Copyright (C) 2025-2026 Aetherinox
# Copyright (C) 2006-2025 Jonathan Michaelson
# Copyright (C) 2006-2025 Way to the Web Ltd.
# @license GPLv3
# @updated 02.19.2026
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or (at
# your option) any later version.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, see <https://www.gnu.org/licenses>.
# #
## no critic (RequireUseWarnings, ProhibitExplicitReturnUndef, ProhibitMixedBooleanOperators, RequireBriefOpen)
package ConfigServer::JSON;
use strict;
use lib '/usr/local/csf/lib';
use Carp;
use IPC::Open3;
use ConfigServer::Config;
use Exporter qw(import);
our $VERSION = 1.07;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(decode_json encode_json);
# #
# Security Values
#
# All of these have been defined based on our usage. Should not need to be
# increased in the near future.
#
# MAX_DEPTH Max nesting depth; prevent stack overflow from malicious input.
# default: 64
#
# MAX_SIZE Max input size (bytes); prevent memory exhaustion.
# default: 10MB
#
# MAX_STRING_LEN Max string length (characters); prevent memory exhaustion from single strings.
# default: 1,000,000
#
# MAX_KEYS Max keys per object; prevent hash collision / memory exhaustion.
# default: 10,000
#
# MAX_ARRAY_LEN Max elements per array; prevent array bomb attacks.
# default: 100,000
# #
our $MAX_DEPTH = 64;
our $MAX_SIZE = 10 * 1024 * 1024;
our $MAX_STRING_LEN = 1_000_000;
our $MAX_KEYS = 10_000;
our $MAX_ARRAY_LEN = 100_000;
# #
# JSON Module
#
# Most modern distros can use perl's JSON module. However, since we support VestaCP which uses
# CentOS 7; certain installs will not include the JSON module.
#
# This module utilized as an alternative. (See below):
#
# JSON Recommended perl module; automatically selects the best available backend.
# Priority: JSON::XS => JSON::PP
# JSON::XS C-accelerated implementation; faster.
# JSON::PP Perl implementation; bundled with Perl cores (since Perl 5.14); portable
# fallback for envs where JSON::XS cannot be utilized.
# JSON::MaybeXS Alternative wrapper module
#
# @usage (1) use ConfigServer::JSON qw( encode_json decode_json );
# my $licenseJson = encode_json( $licenseObj );
# (2) my $licenseJson = ConfigServer::JSON->encode_json( $licenseObj );
# @ref https://perldoc.perl.org/JSON::PP
# https://docs.activestate.com/activeperl/5.26/perl/JSON/PP.html
# https://metacpan.org/pod/JSON
# https://perldoc.perl.org/functions/scalar
# #
# #
# JSON › Decode
#
# Parse json string, return data structure.
#
# @usage my $data = decode_json( '{ "name": "ConfigServer", "license": "xxxx-xxxx-xxx-xxxx"}' );
# print $data->{name}; # "ConfigServer"
#
# @scope public
# @param json str json-encoded str
# @return mixed
# #
sub decode_json
{
my ($json) = @_;
return undef unless defined $json && length $json;
# reject oversized input
if ( length($json) > $MAX_SIZE )
{
carp "JSON: Input exceeds max size limit ($MAX_SIZE bytes)";
return undef;
}
# strip utf8 BOM if exists (EF BB BF)
# @ref: https://en.wikipedia.org/wiki/Byte_order_mark
if ( substr( $json, 0, 3 ) eq "\xEF\xBB\xBF" )
{
$json = substr( $json, 3 );
}
my $pos = 0;
my $depth = 0;
my $res = _decodeValue( \$json, \$pos, \$depth ); # pass references
return undef unless defined $res; # error occurred in parsing
_skipWs( \$json, \$pos ); # ensure no trailing crap other than whitespace
if ( $pos < length( $json ) )
{
carp "JSON: Unexpected data near end of decoded JSON at position $pos";
return undef;
}
return $res;
}
# #
# JSON › _decodeValue
#
# Run the correct decoder based on chars provided.
# Supports str, obj, array, bool, null, num
#
# @scope local
# @param json scalarref ref to json str
# pos scalarref ref to current parse pos
# depth scalarref ref to nesting depth
# @return mixed
# #
sub _decodeValue
{
my ( $json, $pos, $depth ) = @_;
_skipWs( $json, $pos );
# out of bounds
if ( $$pos >= length( $$json ) )
{
carp "JSON: Unexpected end of input when decoding value";
return undef;
}
my $char = substr( $$json, $$pos, 1 );
return _decodeStr( $json, $pos ) if $char eq '"'; # str: starts with double quote
return _decodeObj( $json, $pos, $depth) if $char eq '{'; # obj: starts with opening brace
return _decodeArr( $json, $pos, $depth) if $char eq '['; # array: starts with opening bracket
# bool: return 1 if true
if ( substr( $$json, $$pos, 4 ) eq 'true' )
{
$$pos += 4;
return 1;
}
# bool: return 0 if false
if ( substr( $$json, $$pos, 5 ) eq 'false' )
{
$$pos += 5;
return 0;
}
# null: return empty hashref for null (distinguishes from error)
if ( substr( $$json, $$pos, 4 ) eq 'null' )
{
$$pos += 4;
return { _null => 1 };
}
# num: return decoded num (0-9 or minus sign)
if ( $char =~ /^[-0-9]$/ )
{
return _decodeNum( $json, $pos );
}
carp "JSON: Unexpected character '$char' at position $$pos";
return undef;
}
# #
# JSON › _skipWs
#
# Advance parser pos past json whitespace chars.
# Whitespace space ( ) (0x20), tab (\t) (0x09), newline (\n) (0x0A), carriage return (\r) (0x0D)
#
# @scope local
# @param json scalarref ref to json str
# pos scalarref ref to current parse pos
# @return void
# #
sub _skipWs
{
my ( $json, $pos ) = @_;
while ( $$pos < length( $$json ) && index( " \t\n\r", substr( $$json, $$pos, 1 ) ) >= 0 )
{
$$pos++;
}
}
# #
# JSON › _decodeStr
#
# Parse json str, handle escape sequences.
# Escape \", \\, \/, \b, \f, \n, \r, \t, \uXXXX
#
# @scope local
# @param json scalarref ref to json str
# pos scalarref ref to current parse pos
# @return str decoded str
# #
sub _decodeStr
{
my ( $json, $pos ) = @_;
$$pos++;
my $str = '';
while ( $$pos < length( $$json ) )
{
my $char = substr( $$json, $$pos, 1 );
# end of str
if ( $char eq '"' )
{
$$pos++;
# check string length limit
if ( length( $str ) > $MAX_STRING_LEN )
{
carp "JSON: String exceeds max length limit ($MAX_STRING_LEN characters)";
return undef;
}
return $str;
}
# escape sequence
if ( $char eq '\\' )
{
$$pos++;
if ( $$pos >= length( $$json ) )
{
carp "JSON: Unexpected end of string escape during decode";
return undef;
}
my $esc = substr( $$json, $$pos, 1 );
$$pos++;
if ( $esc eq 'n' ) { $str .= "\n"; }
elsif ( $esc eq 'r' ) { $str .= "\r"; }
elsif ( $esc eq 't' ) { $str .= "\t"; }
elsif ( $esc eq 'b' ) { $str .= "\b"; }
elsif ( $esc eq 'f' ) { $str .= "\f"; }
elsif ( $esc eq '\\' ) { $str .= '\\'; }
elsif ( $esc eq '"' ) { $str .= '"'; }
elsif ( $esc eq '/' ) { $str .= '/'; }
elsif ( $esc eq 'u' )
{
# Unicode escape: \uXXXX
if ( $$pos + 4 > length( $$json ) )
{
carp "JSON: Invalid unicode escape during decode";
return undef;
}
my $hex = substr( $$json, $$pos, 4 );
if ( $hex !~ /^[0-9a-fA-F]{4}$/ )
{
carp "JSON: Invalid unicode escape '\\u$hex' during decode";
return undef;
}
$$pos += 4;
$str .= chr( hex( $hex ) );
}
else
{
carp "JSON: Invalid escape sequence '\\$esc' during decode";
return undef;
}
}
# reject unescaped control chars; r => \r; first non-printable char is 0x20 ' '
elsif ( ord( $char ) < 0x20 )
{
carp "JSON: Unescaped control character at position $$pos during decode";
return undef;
}
else
{
$str .= $char;
$$pos++;
}
}
carp "JSON: Unterminated string";
return undef;
}
# #
# JSON › _decodeNum
#
# Parse json num values.
#
# @scope local
# @param json scalarref ref to json str
# pos scalarref ref to current parse pos
# @return num decoded num
# #
sub _decodeNum
{
my ( $json, $pos ) = @_;
my $start = $$pos;
# minus sign: advance pos
if ( substr( $$json, $$pos, 1 ) eq '-' )
{
$$pos++;
}
# leading zero: 01, 02 not allowed; advance pos.
my $first_digit = substr( $$json, $$pos, 1 );
if ( $first_digit eq '0' )
{
$$pos++;
}
# leading num: (1-9); no leading 0; look for additional numbers
elsif ( $first_digit =~ /^[1-9]$/ )
{
$$pos++;
while ( $$pos < length( $$json ) && substr( $$json, $$pos, 1 ) =~ /^[0-9]$/ )
{
$$pos++;
}
}
# not a valid num
else
{
carp "JSON: Invalid number at position $start";
return undef;
}
# decimal points: check if num is floating point; sasve decimal pos; look for trailing nums
if ( $$pos < length( $$json ) && substr( $$json, $$pos, 1 ) eq '.' )
{
$$pos++;
# starting point of decimal
my $dec_pos = $$pos;
while ( $$pos < length( $$json ) && substr( $$json, $$pos, 1 ) =~ /^[0-9]$/ )
{
$$pos++;
}
# no nums following decimal point
if ( $$pos == $dec_pos )
{
carp "JSON: Invalid number - decimal point must be followed by digits";
return undef;
}
}
# exponents: 1e10, 3.14E-2, etc.
if ( $$pos < length( $$json ) && substr( $$json, $$pos, 1 ) =~ /^[eE]$/ )
{
$$pos++;
# sign: + or -
if ($$pos < length( $$json ) && substr( $$json, $$pos, 1 ) =~ /^[+-]$/ )
{
$$pos++;
}
my $exp_pos = $$pos;
while ( $$pos < length( $$json ) && substr( $$json, $$pos, 1 ) =~ /^[0-9]$/ )
{
$$pos++;
}
if ( $$pos == $exp_pos )
{
carp "JSON: Invalid number - exponent must have digits";
return undef;
}
}
my $num_str = substr( $$json, $start, $$pos - $start );
# check for extreme exponents that could cause issues
if ( $num_str =~ /[eE][+-]?(\d+)/ && $1 > 308 )
{
carp "JSON: Number exponent too large (max 308)";
return undef;
}
return 0 + $num_str;
}
# #
# JSON › _decodeObj
#
# Parse json object to hashref.
# { "key": value, ... }
#
# @scope local
# @param json scalarref ref to json str
# pos scalarref ref to current parse pos
# depth scalarref ref to current nesting depth
# @return hashref decoded hash ref
# #
sub _decodeObj
{
my ( $json, $pos, $depth ) = @_;
# dont allow max depth to be exceeded
$$depth++;
if ( $$depth > $MAX_DEPTH )
{
carp "JSON: Max nesting depth exceeded: $MAX_DEPTH";
return undef;
}
$$pos++;
my %hash;
my $key_count = 0;
_skipWs( $json, $pos );
# empty object
if ( substr( $$json, $$pos, 1 ) eq '}' )
{
$$pos++;
$$depth--;
return \%hash;
}
while (1)
{
# check key count limit
$key_count++;
if ( $key_count > $MAX_KEYS )
{
carp "JSON: Object exceeds max key limit ($MAX_KEYS)";
return undef;
}
_skipWs( $json, $pos );
# key should be a string
if ( substr( $$json, $$pos, 1 ) ne '"' )
{
carp "JSON: Expected string key at position $$pos";
return undef;
}
my $key = _decodeStr( $json, $pos );
return undef unless defined $key;
_skipWs( $json, $pos );
# expect colon after key
if ( substr( $$json, $$pos, 1 ) ne ':' )
{
carp "JSON: Expected ':' after object key at position $$pos";
return undef;
}
$$pos++;
# decoded val
my $val = _decodeValue( $json, $pos, $depth );
return undef unless defined $val;
$hash{$key} = $val;
_skipWs( $json, $pos );
my $char = substr( $$json, $$pos, 1 );
$$pos++;
if ( $char eq '}' )
{
$$depth--;
return \%hash;
}
elsif ( $char ne ',' )
{
carp "JSON: Expected ',' or '}' in object at position " . ( $$pos - 1 );
return undef;
}
}
}
# #
# JSON › _decodeArr
#
# Parse json array to arrayref.
# [ value, ... ]
#
# @scope local
# @param json scalarref ref to json str
# pos scalarref ref to current parse pos
# depth scalarref ref to current nesting depth
# @return arrayref decoded array ref
# #
sub _decodeArr
{
my ( $json, $pos, $depth ) = @_;
$$depth++;
if ( $$depth > $MAX_DEPTH )
{
carp "JSON: Max nesting depth exceeded for arrayref during decode: $MAX_DEPTH";
return undef;
}
$$pos++;
my @arr;
_skipWs( $json, $pos );
# array is empty
if ( substr( $$json, $$pos, 1 ) eq ']' )
{
$$pos++;
$$depth--;
return \@arr;
}
while (1)
{
# check array length limit
if ( scalar( @arr ) >= $MAX_ARRAY_LEN )
{
carp "JSON: Array exceeds max element limit ($MAX_ARRAY_LEN)";
return undef;
}
my $val = _decodeValue( $json, $pos, $depth );
return undef unless defined $val;
push @arr, $val;
_skipWs( $json, $pos );
my $char = substr( $$json, $$pos, 1 );
$$pos++;
if ( $char eq ']' )
{
$$depth--;
return \@arr;
}
elsif ( $char ne ',' )
{
carp "JSON: Expected ',' or ']' in array at position " . ( $$pos - 1 );
return undef;
}
}
}
# #
# JSON › encode_json
#
# Convert perl data struct to json str.
#
# Mapping:
# hashref : json obj
# arrayref : json arr
# scalarref to 1 : true
# scalarref to 0 : false
# undef : null
# number : json num
# string : json str
#
# @usage my $csfJson = encode_json( { name => "ConfigServer", valid => \1 } );
# { "name":"ConfigServer","valid":true }
#
# @scope public
# @param data mixed scalar, arrayref, or hashref
# @return str encoded json str
# #
sub encode_json
{
my ($data) = @_;
my $depth = 0;
return _encodeVal( $data, \$depth );
}
# #
# JSON › _encodeVal
#
# Recursively encode val to json.
#
# @scope local
# @param val mixed value to encode
# depth scalarref reference to current nesting depth
# @return str json
# #
sub _encodeVal
{
my ( $val, $depth ) = @_;
return 'null' unless defined $val;
my $ref = ref $val;
# scalarref to json bool
if ( $ref eq 'SCALAR' )
{
return $$val ? 'true' : 'false';
}
# arrayref to json array str
if ( $ref eq 'ARRAY' )
{
$$depth++;
if ( $$depth > $MAX_DEPTH )
{
carp "JSON: Max nesting depth exceeded for arrayref during encode: $MAX_DEPTH";
return 'null';
}
my $result = '[' . join( ',', map { _encodeVal( $_, $depth ) } @$val) . ']';
$$depth--;
return $result;
}
# hashref to json object str
if ( $ref eq 'HASH' )
{
$$depth++;
if ( $$depth > $MAX_DEPTH )
{
carp "JSON: Max nesting depth exceeded for hashref during encode: $MAX_DEPTH";
return 'null';
}
my @pairs;
for my $k ( sort keys %$val )
{
push @pairs, _encodeStr( $k ) . ':' . _encodeVal( $val->{$k}, $depth );
}
$$depth--;
return '{' . join( ',', @pairs ) . '}';
}
# reject any other types
if ( $ref )
{
carp "JSON: Cannot encode reference type: '$ref'";
return 'null';
}
# num: int/floats without leading zeros
if ( $val =~ /^-?(?:0|[1-9]\d*)(?:\.\d+)?(?:[eE][+-]?\d+)?$/ )
{
# must be real num; not a str num
no warnings 'numeric';
if ( $val + 0 eq $val )
{
return $val;
}
}
return _encodeStr( $val );
}
# #
# JSON › _encodeStr
#
# Encode a string to output to json, escape special chars.
#
# @scope local
# @param str str str to encode
# @return str escaped str
# #
sub _encodeStr
{
my ( $str ) = @_;
$str =~ s/\\/\\\\/g; # backslash
$str =~ s/"/\\"/g; # double quotes
$str =~ s/\n/\\n/g; # newline
$str =~ s/\r/\\r/g; # carriage return
$str =~ s/\t/\\t/g; # tab
$str =~ s/\f/\\f/g; # form feed
$str =~ s/\x08/\\b/g; # backspace
# escape rest of chars as \uXXXX
$str =~ s/([\x00-\x1f])/sprintf('\\u%04x', ord($1))/ge;
return qq{"$str"};
}
1;