File 1601-Add-relaxed-certificate-decoding.patch of Package erlang

From b0ad6cba94483ecab2e979f2d0a697415269655b Mon Sep 17 00:00:00 2001
From: Jan Uhlig <juhlig@hnc-agency.org>
Date: Wed, 24 Sep 2025 10:57:58 +0200
Subject: [PATCH 1/3] Add relaxed certificate decoding

---
 lib/public_key/.gitignore                     |   2 +
 lib/public_key/asn1/Makefile                  |   3 +-
 lib/public_key/asn1/OTP-PKIX-Relaxed.asn1     | 299 ++++++++++++++++++
 .../asn1/OTP-PKIX-Relaxed.asn1config          |  25 ++
 lib/public_key/src/pubkey_cert.erl            |   2 +-
 lib/public_key/src/pubkey_cert_records.erl    |  19 +-
 lib/public_key/src/public_key.app.src         |   1 +
 lib/public_key/src/public_key.erl             |  10 +-
 lib/public_key/test/public_key_SUITE.erl      |  18 ++
 .../public_key_SUITE_data/empty_rdns_cert.pem |  48 +++
 10 files changed, 419 insertions(+), 8 deletions(-)
 create mode 100644 lib/public_key/asn1/OTP-PKIX-Relaxed.asn1
 create mode 100644 lib/public_key/asn1/OTP-PKIX-Relaxed.asn1config
 create mode 100644 lib/public_key/test/public_key_SUITE_data/empty_rdns_cert.pem

diff --git a/lib/public_key/asn1/Makefile b/lib/public_key/asn1/Makefile
index 893b2a14b5..ae903fe34c 100644
--- a/lib/public_key/asn1/Makefile
+++ b/lib/public_key/asn1/Makefile
@@ -60,6 +60,7 @@ ASN_MODULES = \
 	  X509-ML-DSA-2025 \
           OCSP-2024-08 \
           OTP-PKIX \
+	  OTP-PKIX-Relaxed \
           PKCS-1 PKCS-3 PKCS-10 \
           PKIX-CommonTypes-2009 \
           PKIX-X400Address-2009 \
@@ -77,7 +78,7 @@ ASN_MODULES = \
 ASN_ASNS = $(ASN_MODULES:%=%.asn1)
 ASN_ERLS = $(ASN_TOP:%=$(ESRC)/%.erl)
 ASN_HRLS = PKCS-FRAME.hrl
-ASN_CONFIGS = OTP-PKIX.asn1config PKIX1Explicit-2009.asn1config
+ASN_CONFIGS = OTP-PKIX.asn1config OTP-PKIX-Relaxed.asn1config PKIX1Explicit-2009.asn1config
 ASN_DBS = $(ASN_MODULES:%=%.asn1db)
 ASN_TABLES = $(ASN_MODULES:%=%.table)
 
diff --git a/lib/public_key/asn1/OTP-PKIX-Relaxed.asn1 b/lib/public_key/asn1/OTP-PKIX-Relaxed.asn1
new file mode 100644
index 0000000000..a994b5dfe7
--- /dev/null
+++ b/lib/public_key/asn1/OTP-PKIX-Relaxed.asn1
@@ -0,0 +1,299 @@
+-- %CopyrightBegin%
+--
+-- SPDX-License-Identifier: Apache-2.0
+--
+-- Copyright Ericsson AB 2008-2025. All Rights Reserved.
+--
+-- Licensed under the Apache License, Version 2.0 (the "License");
+-- you may not use this file except in compliance with the License.
+-- You may obtain a copy of the License at
+--
+--     http://www.apache.org/licenses/LICENSE-2.0
+--
+-- Unless required by applicable law or agreed to in writing, software
+-- distributed under the License is distributed on an "AS IS" BASIS,
+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+-- See the License for the specific language governing permissions and
+-- limitations under the License.
+--
+-- %CopyrightEnd%
+
+OTP-PKIX-Relaxed {iso(1) identified-organization(3) dod(6) internet(1)
+		  private(4) enterprices(1) ericsson(193) otp(19) ssl(10)
+		  pkix1(1)}
+
+DEFINITIONS EXPLICIT TAGS ::=
+
+BEGIN
+
+-- EXPORTS ALL
+
+IMPORTS
+        ATTRIBUTE, Extensions{}, SingleAttribute
+        FROM PKIX-CommonTypes-2009
+
+	CertificateSerialNumber, CertExtensions{}, NoticeReference
+	FROM PKIX1Implicit-2009
+	{iso(1) identified-organization(3) dod(6) internet(1) security(5)
+	mechanisms(5) pkix(7) id-mod(0) id-mod-pkix1-implicit-02(59)}
+
+       at-name, at-surname, at-givenName, at-initials, at-generationQualifier,
+       at-x520CommonName, at-x520LocalityName, at-x520StateOrProvinceName,
+       at-x520OrganizationName, at-x520OrganizationalUnitName, at-x520Title,
+       at-x520dnQualifier, at-x520SerialNumber, at-x520Pseudonym,
+       at-domainComponent, at-emailAddress,
+       id-at-name, id-at-surname, id-at-givenName, id-at-initials, id-at-generationQualifier,
+       id-at-commonName, id-at-localityName, id-at-stateOrProvinceName, id-at-organizationName,
+       id-at-organizationalUnitName, id-at-title, id-at-countryName, id-at-serialNumber,
+       id-at-pseudonym, id-emailAddress,
+       ub-name, ub-common-name, ub-locality-name, ub-state-name, ub-organization-name,
+       ub-organizational-unit-name, ub-title, ub-serial-number, ub-pseudonym, ub-emailaddress-length,
+       Validity, Version, SubjectPublicKeyInfo,
+       UniqueIdentifier,
+       id-qt-unotice, id-qt-cps
+       FROM PKIX1Explicit-2009
+       {iso(1) identified-organization(3) dod(6) internet(1)
+	security(5) mechanisms(5) pkix(7) id-mod(0)
+	id-mod-pkix1-explicit-02(51)}
+
+	--Keys and Signatures
+        dsa-with-sha1, DSA-Sig-Value, mda-sha1, pk-dsa, DSA-Params
+        FROM PKIXAlgs-2009
+
+	AlgorithmIdentifier{}, SIGNATURE-ALGORITHM
+	FROM AlgorithmInformation-2009
+	{iso(1) identified-organization(3) dod(6) internet(1) security(5)
+	mechanisms(5) pkix(7) id-mod(0)
+	id-mod-algorithmInformation-02(58)};
+--
+-- Certificate
+--
+
+OTPCertificate  ::=  SEQUENCE  {
+     tbsCertificate       OTPTBSCertificate,
+     signatureAlgorithm    AlgorithmIdentifier{SIGNATURE-ALGORITHM,
+                                    { OTPSignatureAlgorithms }},
+     signature            BIT STRING  }
+
+OTPTBSCertificate  ::=  SEQUENCE  {
+     version         [0]  Version DEFAULT v1,
+     serialNumber         CertificateSerialNumber,
+     signature            AlgorithmIdentifier{SIGNATURE-ALGORITHM,
+                                    { OTPSignatureAlgorithms }},
+     issuer               OTPName,
+     validity             Validity,
+     subject              OTPName,
+     subjectPublicKeyInfo SubjectPublicKeyInfo,
+     ... ,
+      [[2:               -- If present, version MUST be v2
+      issuerUniqueID  [1]  IMPLICIT UniqueIdentifier OPTIONAL,
+      subjectUniqueID [2]  IMPLICIT UniqueIdentifier OPTIONAL
+      ]],
+      [[3:               -- If present, version MUST be v3 --
+      extensions      [3]  Extensions{{CertExtensions}} OPTIONAL
+      ]], ... }
+
+-- Here follows a workaround to handle very old certificates.
+
+OTPSignatureAlgorithms SIGNATURE-ALGORITHM ::= {
+    OTPSignatureAlgs, ...,
+    PKIX1-PSS-OAEP-Algorithms-2009.SignatureAlgs }
+
+OTPSignatureAlgs SIGNATURE-ALGORITHM ::= {
+  PKIXAlgs-2009.sa-rsaWithMD2      |
+  PKIXAlgs-2009.sa-rsaWithMD5      |
+  PKIXAlgs-2009.sa-rsaWithSHA1     |
+  otp-sa-dsaWithSHA1               |
+  PKIXAlgs-2009.sa-ecdsaWithSHA1,
+  ..., -- Extensible
+  PKIXAlgs-2009.sa-dsaWithSHA224   |
+  PKIXAlgs-2009.sa-dsaWithSHA256   |
+  PKIXAlgs-2009.sa-ecdsaWithSHA224 |
+  PKIXAlgs-2009.sa-ecdsaWithSHA256 |
+  PKIXAlgs-2009.sa-ecdsaWithSHA384 |
+  PKIXAlgs-2009.sa-ecdsaWithSHA512
+}
+
+otp-sa-dsaWithSHA1 SIGNATURE-ALGORITHM ::= {
+  IDENTIFIER dsa-with-sha1
+  VALUE DSA-Sig-Value
+-- Allow DSA-Params as well as NULL here.
+  PARAMS TYPE OTP-DSA-Params-Or-NULL ARE absent
+  HASHES { mda-sha1 }
+  PUBLIC-KEYS { pk-dsa }
+  SMIME-CAPS { IDENTIFIED BY dsa-with-sha1 }
+}
+
+OTP-DSA-Params-Or-NULL ::= CHOICE {
+  present DSA-Params,           -- Only in very old certificates.
+  absent NULL
+}
+
+-- OTPName can contain country name and email addresses that don't
+-- follow the standard.
+
+OTPName ::= CHOICE {
+    rdnSequence  RDNSequence }
+
+RDNSequence ::= SEQUENCE OF OTPRelativeDistinguishedName
+
+OTPRelativeDistinguishedName  ::=
+      SET SIZE (1 .. MAX) OF SingleAttribute { {OTPSupportedAttributes} }
+
+OTPSupportedAttributes ATTRIBUTE ::= {
+    otp-at-name | otp-at-surname | otp-at-givenName | otp-at-initials |
+    otp-at-generationQualifier | otp-at-x520CommonName |
+    otp-at-x520LocalityName | otp-at-x520StateOrProvinceName |
+    otp-at-x520OrganizationName | otp-at-x520OrganizationalUnitName |
+    otp-at-x520Title | at-x520dnQualifier | otp-at-x520countryName |
+    otp-at-x520SerialNumber | otp-at-x520Pseudonym | at-domainComponent |
+    otp-at-emailAddress, ... }
+
+OTPDirectoryString{INTEGER:maxSize} ::= CHOICE {
+    teletexString    TeletexString(SIZE (0..maxSize)),
+    printableString  PrintableString(SIZE (0..maxSize)),
+    bmpString        BMPString(SIZE (0..maxSize)),
+    universalString  UniversalString(SIZE (0..maxSize)),
+    -- Note: The tag was spelled as `uTF8String` in the
+    -- RFC for unknown reason. That breaks backward
+    -- for public_key.
+    utf8String       UTF8String(SIZE (0..maxSize))
+}
+
+OTP-X520name ::= OTPDirectoryString { ub-name }
+
+otp-at-name ATTRIBUTE ::= {
+    TYPE OTP-X520name IDENTIFIED BY id-at-name }
+
+otp-at-surname ATTRIBUTE ::= {
+    TYPE OTP-X520name IDENTIFIED BY id-at-surname }
+
+otp-at-givenName ATTRIBUTE ::= {
+    TYPE OTP-X520name IDENTIFIED BY id-at-givenName }
+
+otp-at-initials ATTRIBUTE ::= {
+    TYPE OTP-X520name IDENTIFIED BY id-at-initials }
+
+otp-at-generationQualifier ATTRIBUTE ::= {
+    TYPE OTP-X520name IDENTIFIED BY id-at-generationQualifier }
+
+otp-at-x520LocalityName ATTRIBUTE ::= {
+    TYPE OTP-X520localityName IDENTIFIED BY id-at-localityName }
+OTP-X520localityName ::= OTPDirectoryString { ub-locality-name }
+
+otp-at-x520StateOrProvinceName ATTRIBUTE ::= {
+    TYPE OTP-X520stateOrProvinceName IDENTIFIED BY id-at-stateOrProvinceName }
+OTP-X520stateOrProvinceName ::= OTPDirectoryString { ub-state-name }
+
+otp-at-x520CommonName ATTRIBUTE ::= {
+    TYPE OTP-X520commonName IDENTIFIED BY id-at-commonName }
+OTP-X520commonName ::= OTPDirectoryString { ub-common-name }
+
+otp-at-x520OrganizationName ATTRIBUTE ::= {
+    TYPE OTP-X520organizationName IDENTIFIED BY id-at-organizationName }
+OTP-X520organizationName ::= OTPDirectoryString { ub-organization-name }
+
+otp-at-x520OrganizationalUnitName ATTRIBUTE ::= {
+    TYPE OTP-X520organizationalUnitName IDENTIFIED BY id-at-organizationalUnitName }
+OTP-X520organizationalUnitName ::= OTPDirectoryString { ub-organizational-unit-name }
+
+otp-at-x520Title ATTRIBUTE ::= {
+    TYPE OTP-X520title IDENTIFIED BY id-at-title }
+OTP-X520title ::= OTPDirectoryString { ub-title }
+
+otp-at-x520countryName ATTRIBUTE ::= {
+    TYPE OTP-X520countryName IDENTIFIED BY id-at-countryName }
+-- We accept utf8String encoding of the US-ASCII
+-- country name code and the mix up with other country code systems
+-- that uses three characters instead of two.
+OTP-X520countryName ::= CHOICE {
+    correct PrintableString (SIZE(0) | SIZE (2..3)), -- Correct size is 2.
+    wrong   UTF8String      (SIZE(0) | SIZE (2..3))
+}
+
+otp-at-x520SerialNumber ATTRIBUTE ::= {
+    TYPE OTP-X520serialNumber IDENTIFIED BY id-at-serialNumber }
+OTP-X520serialNumber ::= OTPDirectoryString { ub-serial-number }
+
+otp-at-x520Pseudonym ATTRIBUTE ::= {
+    TYPE OTP-X520pseudonym IDENTIFIED BY id-at-pseudonym }
+OTP-X520pseudonym ::= OTPDirectoryString { ub-pseudonym }
+
+otp-at-emailAddress ATTRIBUTE ::= {
+    TYPE OTP-emailAddress IDENTIFIED BY id-emailAddress }
+OTP-emailAddress ::= CHOICE {
+    correct IA5String (SIZE (0..ub-emailaddress-length)),
+    wrong   UTF8String
+}
+
+-- We use this variation of SingleAttribute/AttributeTypeAndValue
+-- when calculating the "short" hash of the certificate issuer.
+-- See public_key:short_name_hash/1.
+
+HashSingleAttribute ::= SEQUENCE {
+    type      OBJECT IDENTIFIER,
+    value     UTF8String
+}
+
+HashRDNSequence ::= SEQUENCE OF HashRelativeDistinguishedName
+
+HashRelativeDistinguishedName  ::=
+      SET SIZE (1 .. MAX) OF HashSingleAttribute
+
+-- Used to workaround that some CAs create too long User Notices
+
+OTPCertificatePolicies ::= SEQUENCE SIZE (1..MAX) OF OTPPolicyInformation
+
+OTPPolicyInformation ::= SEQUENCE {
+     policyIdentifier   CertPolicyId,
+     policyQualifiers   SEQUENCE SIZE (1..MAX) OF
+                OTPPolicyQualifierInfo OPTIONAL }
+
+CertPolicyId ::= OBJECT IDENTIFIER
+
+CERT-POLICY-QUALIFIER ::= TYPE-IDENTIFIER
+
+OTPPolicyQualifierInfo ::= SEQUENCE {
+       policyQualifierId  CERT-POLICY-QUALIFIER.
+            &id({PolicyQualifierId}),
+       qualifier          CERT-POLICY-QUALIFIER.
+            &Type({PolicyQualifierId}{@policyQualifierId})}
+
+-- Implementations that recognize additional policy qualifiers MUST
+-- augment the following definition for PolicyQualifierId
+
+PolicyQualifierId CERT-POLICY-QUALIFIER ::=
+    { pqid-cps | pqid-unotice, ... }
+
+pqid-cps CERT-POLICY-QUALIFIER ::= { CPSuri IDENTIFIED BY id-qt-cps }
+pqid-unotice CERT-POLICY-QUALIFIER ::= { OTPUserNotice
+    IDENTIFIED BY id-qt-unotice }
+
+-- CPS pointer qualifier
+
+CPSuri ::= IA5String
+
+OTPUserNotice ::= SEQUENCE {
+     noticeRef        NoticeReference OPTIONAL,
+     explicitText     OTPDisplayText OPTIONAL}
+
+-- NoticeReference ::= SEQUENCE {
+--     organization     OTPDisplayText,
+--     noticeNumbers    SEQUENCE OF INTEGER }
+
+OTPDisplayText ::= CHOICE {
+     ia5String        IA5String      (SIZE (1..650)),
+     visibleString    VisibleString  (SIZE (1..650)),
+     bmpString        BMPString      (SIZE (1..650)),
+     utf8String       UTF8String     (SIZE (1..650)) }
+
+-- Extensions
+
+Extensions  ::=  SEQUENCE SIZE (1..MAX) OF OTPExtension
+
+OTPExtension  ::=  SEQUENCE  {
+     extnID      OBJECT IDENTIFIER,
+     critical    BOOLEAN DEFAULT FALSE,
+     extnValue   OCTET STRING  }
+
+END
diff --git a/lib/public_key/asn1/OTP-PKIX-Relaxed.asn1config b/lib/public_key/asn1/OTP-PKIX-Relaxed.asn1config
new file mode 100644
index 0000000000..7b1f9cba3e
--- /dev/null
+++ b/lib/public_key/asn1/OTP-PKIX-Relaxed.asn1config
@@ -0,0 +1,25 @@
+%% -*- erlang -*-
+%%
+%% %CopyrightBegin%
+%%
+%% SPDX-License-Identifier: Apache-2.0
+%%
+%% Copyright Ericsson AB 2008-2025. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%%     http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+
+{exclusive_decode,
+ {'OTP-PKIX-Relaxed',
+  [{decode_TBSCert_exclusive,['OTPCertificate',[{tbsCertificate,undecoded}]]}]}}.
diff --git a/lib/public_key/src/pubkey_cert.erl b/lib/public_key/src/pubkey_cert.erl
index 1ee7160523..84b4eb5ef0 100644
--- a/lib/public_key/src/pubkey_cert.erl
+++ b/lib/public_key/src/pubkey_cert.erl
@@ -280,7 +280,7 @@ validate_signature(Cert, DerCert, Key, KeyParams0,
 %% Description: Extracts data from DerCert needed to call public_key:verify/4.
 %%--------------------------------------------------------------------
 verify_data(DerCert) ->
-    {ok, OtpCert} = pubkey_cert_records:decode_cert(DerCert),
+    {ok, OtpCert} = pubkey_cert_records:decode_cert(DerCert, relaxed),
     extract_verify_data(OtpCert, DerCert).
 
 %%--------------------------------------------------------------------
diff --git a/lib/public_key/src/pubkey_cert_records.erl b/lib/public_key/src/pubkey_cert_records.erl
index 4bc174e39d..60e5bfcd30 100644
--- a/lib/public_key/src/pubkey_cert_records.erl
+++ b/lib/public_key/src/pubkey_cert_records.erl
@@ -27,7 +27,7 @@
 
 -include("public_key_internal.hrl").
 
--export([decode_cert/1,
+-export([decode_cert/1, decode_cert/2,
          transform/2,
          supportedPublicKeyAlgorithms/1,
 	 supportedCurvesTypes/1,
@@ -47,7 +47,20 @@
 %% Description: Recursively decodes a Certificate. 
 %%-------------------------------------------------------------------- 
 decode_cert(DerCert) ->
-    {ok, Cert0} = 'OTP-PKIX':decode('OTPCertificate', DerCert),
+    decode_cert(DerCert, otp).
+
+%%--------------------------------------------------------------------
+-spec decode_cert(DerCert :: binary(), Type :: 'otp' | 'relaxed') -> {ok, #'OTPCertificate'{}}.
+%%
+%% Description: Recursively decodes a Certificate with given decoder Type. 
+%%-------------------------------------------------------------------- 
+decode_cert(DerCert, otp) ->
+    decode_cert1(DerCert, 'OTP-PKIX');
+decode_cert(DerCert, relaxed) ->
+    decode_cert1(DerCert, 'OTP-PKIX-Relaxed').
+
+decode_cert1(DerCert, Mod) ->
+    {ok, Cert0} = Mod:decode('OTPCertificate', DerCert),
     Cert = dec_transform(Cert0),
     {ok, Cert}.
 
@@ -450,7 +463,7 @@ decode_extensions(Exts, WhenCRL) ->
 decode_otp_cert_polices(Ext, Value) ->
     %% RFC 3280 states that certificate users SHOULD gracefully handle
     %% explicitText with more than 200 characters.
-    {ok, CPs} = 'OTP-PKIX':decode('OTPCertificatePolicies', Value),
+    {ok, CPs} = 'OTP-PKIX-Relaxed':decode('OTPCertificatePolicies', Value),
     Ext#'Extension'{extnValue=[translate_cert_polices(CP) || CP <- CPs]}.
 
 translate_cert_polices(#'OTPPolicyInformation'{policyIdentifier = Id, policyQualifiers = Qs0}) ->
diff --git a/lib/public_key/src/public_key.app.src b/lib/public_key/src/public_key.app.src
index b8b4487665..1dce2f5604 100644
--- a/lib/public_key/src/public_key.app.src
+++ b/lib/public_key/src/public_key.app.src
@@ -18,6 +18,7 @@
               'X509-ML-DSA-2025',
               'OCSP-2024-08',
               'OTP-PKIX',
+              'OTP-PKIX-Relaxed',
               'PKCS-1',
               'PKCS-10',
               'PKCS-3',
diff --git a/lib/public_key/src/public_key.erl b/lib/public_key/src/public_key.erl
index 78bd6feb88..a425c49735 100644
--- a/lib/public_key/src/public_key.erl
+++ b/lib/public_key/src/public_key.erl
@@ -987,12 +987,15 @@ Decodes an ASN.1 DER-encoded PKIX certificate.
 
 Option `otp` uses the customized ASN.1 specification OTP-PKIX.asn1 for
 decoding and also recursively decode most of the standard parts.
+
+Option `relaxed` is similar to option `otp` but also allows for empty
+RDNs in issuer and subject.
 """.
 
 -spec pkix_decode_cert(Cert, Type) ->
           #'Certificate'{} | #'OTPCertificate'{}
               when Cert :: der_encoded(),
-                   Type :: plain | otp .
+                   Type :: plain | otp | relaxed.
 %%
 %% Description: Decodes an asn1 der encoded pkix certificate. The otp
 %% option will use the customized asn1 specification OTP-PKIX.asn1 for
@@ -1001,10 +1004,11 @@ decoding and also recursively decode most of the standard parts.
 %% --------------------------------------------------------------------
 pkix_decode_cert(DerCert, plain)  when is_binary(DerCert) ->
     der_decode('Certificate', DerCert);
-pkix_decode_cert(DerCert, otp) when is_binary(DerCert) ->
+pkix_decode_cert(DerCert, Type) when is_binary(DerCert),
+				     Type =:= otp orelse Type =:= relaxed ->
     try 
 	{ok, #'OTPCertificate'{}= Cert} = 
-	    pubkey_cert_records:decode_cert(DerCert),
+	    pubkey_cert_records:decode_cert(DerCert, Type),
 	Cert
     catch
 	error:{badmatch, {error, _}} = Error ->
diff --git a/lib/public_key/test/public_key_SUITE.erl b/lib/public_key/test/public_key_SUITE.erl
index 7cef74bcf3..69e2aeec16 100644
--- a/lib/public_key/test/public_key_SUITE.erl
+++ b/lib/public_key/test/public_key_SUITE.erl
@@ -107,6 +107,8 @@
          pkix_emailaddress/1,
          pkix_decode_cert/0,
          pkix_decode_cert/1,
+	 pkix_decode_cert_empty_rdns/0,
+	 pkix_decode_cert_empty_rdns/1,
          pkix_path_validation/0,
          pkix_path_validation/1,
          pkix_path_validation_root_expired/0,
@@ -193,6 +195,7 @@ all() ->
      pkix_countryname, 
      pkix_emailaddress, 
      pkix_decode_cert,
+     pkix_decode_cert_empty_rdns,
      pkix_path_validation,
      pkix_path_validation_root_expired,
      pkix_ext_key_usage,
@@ -1016,6 +1019,21 @@ pkix_decode_cert(Config) when is_list(Config) ->
 
     #'OTPCertificate'{} = public_key:pkix_decode_cert(Der, otp).
 
+%%--------------------------------------------------------------------
+pkix_decode_cert_empty_rdns() ->
+    [{doc, "Ensure that a certificate with empty RDNs in issuer and subject can be decoded"}].
+pkix_decode_cert_empty_rdns(Config) when is_list(Config) ->
+	DataDir = proplists:get_value(data_dir, Config),
+	{ok, Bin} = file:read_file(filename:join(DataDir, "empty_rdns_cert.pem")),
+
+	[{_, DerCert, _}] = public_key:pem_decode(Bin),
+	try public_key:pkix_decode_cert(DerCert, otp)
+	of #'OTPCertificate'{} -> ct:fail("Unexpected success decoding certificate containing empty RDNs", [])
+	catch error:{badmatch, _} -> ok
+	end,
+	#'OTPCertificate'{} = public_key:pkix_decode_cert(DerCert, relaxed),
+	ok.
+
 %%--------------------------------------------------------------------
 pkix_path_validation() ->
     [{doc, "Test PKIX path validation"}].
diff --git a/lib/public_key/test/public_key_SUITE_data/empty_rdns_cert.pem b/lib/public_key/test/public_key_SUITE_data/empty_rdns_cert.pem
new file mode 100644
index 0000000000..df97657a4b
--- /dev/null
+++ b/lib/public_key/test/public_key_SUITE_data/empty_rdns_cert.pem
@@ -0,0 +1,48 @@
+// %CopyrightBegin%
+//
+// SPDX-License-Identifier: BSD-3-Clause
+//
+// Copyright (c) 2010 IETF Trust and the persons identified as the document authors.  All rights reserved.
+// Copyright Ericsson AB 2025. All Rights Reserved.
+//
+// Redistribution and use in source and binary forms, with or without
+// modification, are permitted provided that the following conditions are met:
+//
+// 1. Redistributions of source code must retain the above copyright notice,
+//    this list of conditions and the following disclaimer.
+//
+// 2. Redistributions in binary form must reproduce the above copyright notice,
+//    this list of conditions and the following disclaimer in the documentation
+//    and/or other materials provided with the distribution.
+//
+// 3. Neither the name of the copyright holder nor the names of its contributors
+//    may be used to endorse or promote products derived from this software
+//    without specific prior written permission.
+//
+// THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS”
+// AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+// IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+// ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
+// LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+// CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+// SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+// INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+// CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+// ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+// POSSIBILITY OF SUCH DAMAGE.
+//
+// %CopyrightEnd%
+
+-----BEGIN CERTIFICATE-----
+MIIBtDCCAR+gAwIBAgIFAJW/cv0wCwYJKoZIhvcNAQELMCExCTAHBgNVBAYTADEJ
+MAcGA1UEChMAMQkwBwYDVQQDEwAwHhcNMjUwNzE2MTU0ODU5WhcNMjYwNzE2MTU0
+ODU5WjAhMQkwBwYDVQQGEwAxCTAHBgNVBAoTADEJMAcGA1UEAxMAMIGdMAsGCSqG
+SIb3DQEBAQOBjQAwgYkCgYEAx0hpK+Lk9TLEnzZApeJc3MxCbeB9ejE5qE0s2tIj
+cuLnSrwjB/zzo0tFeMBTYGSVic0hhYK/UXwlPKwYOce9Jy9SCyy27L82PSytD343
+2k5Zt9tlxn0sXqe2YeCE41pCK6JVtArixC7ZWZu37SMputv7dlqjss7f54Eg6fMS
+KbkCAwEAATALBgkqhkiG9w0BAQsDgYEAlhPrebIs/4Yjzsob9w6s2LDY0K5cBG+0
+5/PGMKESdFKPMtO/aKkb62n3HkJyCoEr7K8GmmPqz+5p2kMCQ/CmhuMW4Zjoc2DJ
+z0sZQlWH+Ux8DVInxibEniroak0KknZIAU3Ep9jrPy3FiuIwsjszHNIn6bM5uTTm
+seFAC9XvydI=
+-----END CERTIFICATE-----
+
-- 
2.51.0

openSUSE Build Service is sponsored by