diff --git a/README.md b/README.md deleted file mode 100644 index d0a5f44..0000000 --- a/README.md +++ /dev/null @@ -1,3 +0,0 @@ -# GDPR-IAB-TCFv2 - -gdpr iab tcf v2 consent string parser diff --git a/README.pod b/README.pod new file mode 100644 index 0000000..dd3aa4a --- /dev/null +++ b/README.pod @@ -0,0 +1,133 @@ +=head1 NAME + +GDPR::IAB::TCFv2 - Transparency & Consent String version 2 parser + +=head1 VERSION + +Version v0.0.1 + +=head1 SYNOPSIS + +The purpose of this package is to parse Transparency & Consent String (TC String) as defined by IAB version 2. + + use strict; + use warnings; + use feature 'say'; + use GDPR::IAB::TCFv2; + + my $consent = GDPR::IAB::TCFv2->Parse( + 'CLcVDxRMWfGmWAVAHCENAXCkAKDAADnAABRgA5mdfCKZuYJez-NQm0TBMYA4oCAAGQYIAAAAAAEAIAEgAA.argAC0gAAAAAAAAAAAA' + ); + + say $consent->version; # 2 + say $consent->created; # epoch 1228644257 + say $consent->last_updated; # epoch 1326215413 + say $consent->cmp_id; # 21 + say $consent->cmp_version; # 7 + say $consent->consent_screen; # 2 + say $consent->consent_language; # "EN" + say $consent->vendor_list_version; # 23 + + use List::Util qw(all); + + say "consent ok for purpose ids 1, 3, 9 and 10" if all { + $consent->is_purpose_consent_allowed($_) + } (1, 3, 9, 10); + +=head1 CONSTRUCTOR + +=head2 Parse + +The Parse method will decode and validate a base64 encoded version of the tcf v2 string. + +Will die if can't decode the string. + + use GDPR::IAB::TCFv2; + + my $consent = GDPR::IAB::TCFv2->Parse( + 'CLcVDxRMWfGmWAVAHCENAXCkAKDAADnAABRgA5mdfCKZuYJez-NQm0TBMYA4oCAAGQYIAAAAAAEAIAEgAA.argAC0gAAAAAAAAAAAA' + ); + +=head1 METHODS + +=head2 version + + +Version number of the encoding format. The value is 2 for this format. + +=head2 created + +Epoch time format when TC String was created in numeric format. You can easily parse with L if needed. + +=head2 last_updated + +Epoch time format when TC String was last updated in numeric format. You can easily parse with L if needed. + +=head2 cmp_id + +Consent Management Platform ID that last updated the TC String. Is a unique ID will be assigned to each Consent Management Platform. + +=head2 cmp_version + +Consent Management Platform version of the CMP that last updated this TC String. +Each change to a CMP should increment their internally assigned version number as a record of which version the user gave consent and transparency was established. + +=head2 consent_screen + +CMP Screen number at which consent was given for a user with the CMP that last updated this TC String. +The number is a CMP internal designation and is CmpVersion specific. The number is used for identifying on which screen a user gave consent as a record. + +=head2 consent_language + +Two-letter L language code in which the CMP UI was presented. + +=head2 vendor_list_version + +Number corresponds to L vendorListVersion. +Version of the GVL used to create this TC String. + +=head2 is_purpose_consent_allowed + +The user's consent value for each Purpose established on the legal basis of consent. + +=head1 FUNCTIONS + +=head2 looksLikeIsConsentVersion2 + +Will check if a given tc string starts with a literal "C". + +=head1 SEE ALSO + +You can find the original documentation of the TCF v2 from IAB documentation L. + +=head1 AUTHOR + +Tiago Peczenyj (tiago dot peczentj at gmail dot com) + +=head1 BUGS + +Please report any bugs or feature requests to L. + +=head1 LICENSE AND COPYRIGHT + +Copyright 2023 Tiago Peczenyj + +This program is free software; you can redistribute it and/or modify it +under the terms of either: the GNU General Public License as published +by the Free Software Foundation; or the Artistic License. + +See L for more information. + +=head1 DISCLAIMER + +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 OWNER 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. + diff --git a/lib/GDPR/IAB/TCFv2.pm b/lib/GDPR/IAB/TCFv2.pm index 35a3a12..f5b9f11 100644 --- a/lib/GDPR/IAB/TCFv2.pm +++ b/lib/GDPR/IAB/TCFv2.pm @@ -1,41 +1,37 @@ package GDPR::IAB::TCFv2; + use strict; use warnings; use integer; use bytes; - use version; our $VERSION = version->declare('v0.0.1'); use MIME::Base64 qw; use Carp qw; -my $CONSENT_STRING_TCF2_SEPARATOR = '.'; -my $CONSENT_STRING_TCF2_PREFIX = 'C'; -my $DECIS_PER_ONE = 10; -my $MIN_BIT_SIZE = 29 * 8; +sub CONSENT_STRING_TCF2_SEPARATOR {'.'} +sub CONSENT_STRING_TCF2_PREFIX {'C'} +sub MIN_BYTE_SIZE {29} +sub MIN_BIT_SIZE { 8 * MIN_BYTE_SIZE } # ABSTRACT: gdpr iab tcf v2 consent string parser sub Parse { - my ( $klass, $gdpr_consent_string ) = @_; + my ( $klass, $tc_string ) = @_; - croak 'missing gdpr consent string' unless $gdpr_consent_string; + croak 'missing gdpr consent string' unless $tc_string; - croak 'consent string is not tcf version 2' - unless isConsentV2($gdpr_consent_string); - - $gdpr_consent_string = substr( - $gdpr_consent_string, 0, - index( $gdpr_consent_string, $CONSENT_STRING_TCF2_SEPARATOR ) - ); + my $core_tc_string = _get_core_tc_string($tc_string); - my $data = unpack 'B*', decode_base64($gdpr_consent_string); + my $data = unpack 'B*', decode_base64($core_tc_string); - croak 'vendor consent strings are at least 29 bytes long' - if length($data) < $MIN_BIT_SIZE; + croak "vendor consent strings are at least @{[ MIN_BYTE_SIZE ]} bytes long" + if length($data) < MIN_BIT_SIZE; my $self = { - data => $data, + data => $data, + tc_string => $tc_string, + core_tc_string => $core_tc_string, }; bless $self, $klass; @@ -47,100 +43,257 @@ sub Parse { return $self; } +sub _get_core_tc_string { + my $tc_string = shift; + + my $pos = index( $tc_string, CONSENT_STRING_TCF2_SEPARATOR ); + + return substr( $tc_string, 0, $pos ); +} + sub version { my $self = shift; - return unpack( - "C", - pack( "B8", ( "0" x ( 8 - 6 ) ) . substr( $self->{data}, 0, 6 ) ) - ); + return $self->_get_uint8( 0, 6 ); } sub created { my $self = shift; - my $deciseconds = unpack( - "Q>", - pack( "B64", ( "0" x ( 64 - 36 ) ) . substr( $self->{data}, 6, 36 ) ) - ); + my $deciseconds = $self->_get_uint64( 6, 36 ); - return $deciseconds / $DECIS_PER_ONE; + return $deciseconds / 10; } sub last_updated { my $self = shift; - my $deciseconds = unpack( - "Q>", - pack( "B64", ( "0" x ( 64 - 36 ) ) . substr( $self->{data}, 42, 36 ) ) - ); + my $deciseconds = $self->_get_uint64( 42, 36 ); - return $deciseconds / $DECIS_PER_ONE; + return $deciseconds / 10; } sub cmp_id { my $self = shift; - return unpack( - "S>", - pack( "B16", ( "0" x ( 16 - 12 ) ) . substr( $self->{data}, 78, 12 ) ) - ); + return $self->_get_uint16( 78, 12 ); } sub cmp_version { my $self = shift; - return unpack( - "S>", - pack( "B16", ( "0" x ( 16 - 12 ) ) . substr( $self->{data}, 90, 12 ) ) - ); + return $self->_get_uint16( 90, 12 ); } sub consent_screen { my $self = shift; - return unpack( - "C", - pack( "B8", ( "0" x ( 8 - 6 ) ) . substr( $self->{data}, 102, 6 ) ) - ); + return $self->_get_uint8( 102, 6 ); } sub consent_language { my $self = shift; - my @letters = unpack "C*", pack( - "B8B8", - ( "0" x ( 8 - 6 ) ) . substr( $self->{data}, 108, 6 ), - ( "0" x ( 8 - 6 ) ) . substr( $self->{data}, 114, 6 ) + return join "", map { chr( $_ + 65 ) } ( + $self->_get_uint8( 108, 6 ), + $self->_get_uint8( 114, 6 ), ); - - return chr( $letters[0] + 65 ) . chr( $letters[1] + 65 ); } sub vendor_list_version { my $self = shift; + $self->_get_uint16( 120, 12 ); +} + +sub is_purpose_consent_allowed { + my ( $self, $id ) = @_; + + croak "invalid purpose id $id: must be between 1 and 24" + if $id < 1 || $id > 24; + + return $self->_is_set( 152 + $id - 1 ); +} + +sub _is_set { + my ( $self, $offset ) = @_; + + return substr( $self->{data}, $offset, 1 ) == 1; +} + +sub _get_uint8 { + my ( $self, $offset, $nbits ) = @_; + + my $padding = "0" x ( 8 - $nbits ); + + return unpack( + "C", + pack( "B8", $padding . substr( $self->{data}, $offset, $nbits ) ) + ); +} + +sub _get_uint16 { + my ( $self, $offset, $nbits ) = @_; + + my $padding = "0" x ( 16 - $nbits ); + return unpack( "S>", - pack( - "B16", ( "0" x ( 16 - 12 ) ) . substr( $self->{data}, 120, 12 ) - ) + pack( "B16", $padding . substr( $self->{data}, $offset, $nbits ) ) ); } -sub is_purpose_allowed { - my $self = shift; - my $id = shift; +sub _get_uint64 { + my ( $self, $offset, $nbits ) = @_; - return if $id > 24; + my $padding = "0" x ( 64 - $nbits ); - return substr( $self->{data}, 151 + $id, 1 ); + return unpack( + "Q>", + pack( "B64", $padding . substr( $self->{data}, $offset, $nbits ) ) + ); } -sub isConsentV2 { +sub looksLikeIsConsentVersion2 { my ($gdpr_consent_string) = @_; - return rindex( $gdpr_consent_string, $CONSENT_STRING_TCF2_PREFIX, 0 ) == 0; + return rindex( $gdpr_consent_string, CONSENT_STRING_TCF2_PREFIX, 0 ) == 0; } 1; +__END__ + +=head1 NAME + +GDPR::IAB::TCFv2 - Transparency & Consent String version 2 parser + +=head1 VERSION + +Version v0.0.1 + +=head1 SYNOPSIS + +The purpose of this package is to parse Transparency & Consent String (TC String) as defined by IAB version 2. + + use strict; + use warnings; + use feature 'say'; + use GDPR::IAB::TCFv2; + + my $consent = GDPR::IAB::TCFv2->Parse( + 'CLcVDxRMWfGmWAVAHCENAXCkAKDAADnAABRgA5mdfCKZuYJez-NQm0TBMYA4oCAAGQYIAAAAAAEAIAEgAA.argAC0gAAAAAAAAAAAA' + ); + + say $consent->version; # 2 + say $consent->created; # epoch 1228644257 + say $consent->last_updated; # epoch 1326215413 + say $consent->cmp_id; # 21 + say $consent->cmp_version; # 7 + say $consent->consent_screen; # 2 + say $consent->consent_language; # "EN" + say $consent->vendor_list_version; # 23 + + use List::Util qw(all); + + say "consent ok for purpose ids 1, 3, 9 and 10" if all { + $consent->is_purpose_consent_allowed($_) + } (1, 3, 9, 10); + +=head1 CONSTRUCTOR + +=head2 Parse + +The Parse method will decode and validate a base64 encoded version of the tcf v2 string. + +Will die if can't decode the string. + + use GDPR::IAB::TCFv2; + + my $consent = GDPR::IAB::TCFv2->Parse( + 'CLcVDxRMWfGmWAVAHCENAXCkAKDAADnAABRgA5mdfCKZuYJez-NQm0TBMYA4oCAAGQYIAAAAAAEAIAEgAA.argAC0gAAAAAAAAAAAA' + ); + +=head1 METHODS + +=head2 version + + +Version number of the encoding format. The value is 2 for this format. + +=head2 created + +Epoch time format when TC String was created in numeric format. You can easily parse with L if needed. + +=head2 last_updated + +Epoch time format when TC String was last updated in numeric format. You can easily parse with L if needed. + +=head2 cmp_id + +Consent Management Platform ID that last updated the TC String. Is a unique ID will be assigned to each Consent Management Platform. + +=head2 cmp_version + +Consent Management Platform version of the CMP that last updated this TC String. +Each change to a CMP should increment their internally assigned version number as a record of which version the user gave consent and transparency was established. + +=head2 consent_screen + +CMP Screen number at which consent was given for a user with the CMP that last updated this TC String. +The number is a CMP internal designation and is CmpVersion specific. The number is used for identifying on which screen a user gave consent as a record. + +=head2 consent_language + +Two-letter L language code in which the CMP UI was presented. + +=head2 vendor_list_version + +Number corresponds to L vendorListVersion. +Version of the GVL used to create this TC String. + +=head2 is_purpose_consent_allowed + +The user's consent value for each Purpose established on the legal basis of consent. + +=head1 FUNCTIONS + +=head2 looksLikeIsConsentVersion2 + +Will check if a given tc string starts with a literal "C". + +=head1 SEE ALSO + +You can find the original documentation of the TCF v2 from IAB documentation L. + +=head1 AUTHOR + +Tiago Peczenyj (tiago dot peczentj at gmail dot com) + +=head1 BUGS + +Please report any bugs or feature requests to L. + +=head1 LICENSE AND COPYRIGHT + +Copyright 2023 Tiago Peczenyj + +This program is free software; you can redistribute it and/or modify it +under the terms of either: the GNU General Public License as published +by the Free Software Foundation; or the Artistic License. + +See L for more information. + +=head1 DISCLAIMER + +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 OWNER 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. + +=cut diff --git a/t/00-load.t b/t/00-load.t index fcc016c..05d94eb 100644 --- a/t/00-load.t +++ b/t/00-load.t @@ -2,4 +2,4 @@ use Test::More tests => 2; BEGIN { use_ok('GDPR::IAB::TCFv2'); } -require_ok 'GDPR::IAB::TCFv2'; \ No newline at end of file +require_ok 'GDPR::IAB::TCFv2'; diff --git a/t/01-parse.t b/t/01-parse.t index e91f569..02af486 100644 --- a/t/01-parse.t +++ b/t/01-parse.t @@ -9,41 +9,50 @@ subtest "valid tcf v2 consent string" => sub { my $consent; lives_ok { - $consent = GDPR::IAB::TCFv2->Parse('CLcVDxRMWfGmWAVAHCENAXCkAKDAADnAABRgA5mdfCKZuYJez-NQm0TBMYA4oCAAGQYIAAAAAAEAIAEgAA.argAC0gAAAAAAAAAAAA'); - } 'should not throw exception'; + $consent = GDPR::IAB::TCFv2->Parse( + 'CLcVDxRMWfGmWAVAHCENAXCkAKDAADnAABRgA5mdfCKZuYJez-NQm0TBMYA4oCAAGQYIAAAAAAEAIAEgAA.argAC0gAAAAAAAAAAAA' + ); + } + 'should not throw exception'; isa_ok $consent, 'GDPR::IAB::TCFv2', 'gdpr iab tcf v2 consent'; is $consent->version, 2, 'should return version 2'; - is $consent->created, 1228644257, 'should return the creation epoch 07/12/2008'; + is $consent->created, 1228644257, + 'should return the creation epoch 07/12/2008'; - is $consent->last_updated, 1326215413, 'should return the last update epoch 10/01/2012'; + is $consent->last_updated, 1326215413, + 'should return the last update epoch 10/01/2012'; is $consent->cmp_id, 21, 'should return the cmp id 21'; - + is $consent->cmp_version, 7, 'should return the cmp version 7'; is $consent->consent_screen, 2, 'should return the consent screen 2'; - is $consent->consent_language, "EN", 'should return the consent language "EN"'; + is $consent->consent_language, "EN", + 'should return the consent language "EN"'; - is $consent->vendor_list_version, 23, 'should return the vendor list version 23'; + is $consent->vendor_list_version, 23, + 'should return the vendor list version 23'; - subtest "check purpose ids" => sub { + subtest "check purpose consent ids" => sub { plan tests => 24; - my %testcases =( - 1 => 1, - 3 => 1, - 9 => 1, + my %allowed_purposes = ( + 1 => 1, + 3 => 1, + 9 => 1, 10 => 1, ); - - foreach my $id (1..24) { - is !!$consent->is_purpose_allowed($id), !!$testcases{$id}, "checking purpose id $id"; + + foreach my $id ( 1 .. 24 ) { + is !!$consent->is_purpose_consent_allowed($id), + !!$allowed_purposes{$id}, + "checking purpose id $id"; } - } + }; }; subtest "invalid tcf consent string candidates" => sub { @@ -51,24 +60,32 @@ subtest "invalid tcf consent string candidates" => sub { throws_ok { GDPR::IAB::TCFv2->Parse(); - } qr/missing gdpr consent string/, 'undefined consent string should throw error'; + } + qr/missing gdpr consent string/, + 'undefined consent string should throw error'; throws_ok { GDPR::IAB::TCFv2->Parse(""); - } qr/missing gdpr consent string/, 'empty consent string should throw error'; + } + qr/missing gdpr consent string/, 'empty consent string should throw error'; throws_ok { - GDPR::IAB::TCFv2->Parse("BOEFEAyOEFEAyAHABDENAI4AAAB9vABAASA"); - } qr/consent string is not tcf version 2/, - 'valid tcf v1 consent string should throw error (deprecated)'; + GDPR::IAB::TCFv2->Parse( + "BOEFEAyOEFEAyAHABDENAI4AAAB9vABAASAAAAAAAAAA"); + } + qr/consent string is not tcf version 2/, + 'valid tcf v1 consent string should throw error (deprecated)'; throws_ok { GDPR::IAB::TCFv2->Parse("Clc"); - } qr/vendor consent strings are at least 29 bytes long/, - 'short (less than 29 bytes) tcf v2 consent string should throw error'; + } + qr/vendor consent strings are at least 29 bytes long/, + 'short (less than 29 bytes) tcf v2 consent string should throw error'; throws_ok { - GDPR::IAB::TCFv2->Parse("DOEFEAyOEFEAyAHABDENAI4AAAB9vABAASA"); - } qr/consent string is not tcf version 2/, - 'possible tcf v3 consent string should throw error'; -}; \ No newline at end of file + GDPR::IAB::TCFv2->Parse( + "DOEFEAyOEFEAyAHABDENAI4AAAB9vABAASAAAAAAAAAA"); + } + qr/consent string is not tcf version 2/, + 'possible tcf v3 consent string should throw error'; +};