From a884b8cc88fb61acae86fdd3e9751238e63289a3 Mon Sep 17 00:00:00 2001 From: Tiago Peczenyj Date: Fri, 15 Dec 2023 13:58:48 +0100 Subject: [PATCH 01/13] add code to handle publisher tc, start to implement #13 --- lib/GDPR/IAB/TCFv2.pm | 97 +++++----- lib/GDPR/IAB/TCFv2/BitField.pm | 18 -- lib/GDPR/IAB/TCFv2/Publisher.pm | 82 ++++++++ lib/GDPR/IAB/TCFv2/PublisherRestrictions.pm | 15 +- lib/GDPR/IAB/TCFv2/PublisherTC.pm | 200 ++++++++++++++++++++ t/01-parse.t | 26 ++- t/02-json.t | 16 +- 7 files changed, 371 insertions(+), 83 deletions(-) create mode 100644 lib/GDPR/IAB/TCFv2/Publisher.pm create mode 100644 lib/GDPR/IAB/TCFv2/PublisherTC.pm diff --git a/lib/GDPR/IAB/TCFv2.pm b/lib/GDPR/IAB/TCFv2.pm index a065824..f56f186 100644 --- a/lib/GDPR/IAB/TCFv2.pm +++ b/lib/GDPR/IAB/TCFv2.pm @@ -19,7 +19,7 @@ use GDPR::IAB::TCFv2::BitUtils qw; -use GDPR::IAB::TCFv2::PublisherRestrictions; +use GDPR::IAB::TCFv2::Publisher; use GDPR::IAB::TCFv2::RangeSection; our $VERSION = "0.084"; @@ -31,7 +31,6 @@ use constant { MIN_BYTE_SIZE => 29, }, EXPECTED_TCF_V2_VERSION => 2, - ASSUMED_MAX_VENDOR_ID => 0x7FFF, # 32767 or (1 << 15) -1 MAX_SPECIAL_FEATURE_ID => 12, MAX_PURPOSE_ID => 24, DATE_FORMAT_ISO_8601 => '%Y-%m-%dT%H:%M:%SZ', @@ -117,6 +116,7 @@ sub Parse { vendor_consents => undef, vendor_legitimate_interests => undef, + publisher => undef, publisher_restrictions => undef, }; @@ -332,8 +332,14 @@ sub vendor_legitimate_interest { sub check_publisher_restriction { my ( $self, $purpose_id, $restrict_type, $vendor ) = @_; - return $self->{publisher_restrictions} - ->contains( $purpose_id, $restrict_type, $vendor ); + return $self->{publisher} + ->check_restriction( $purpose_id, $restrict_type, $vendor ); +} + +sub with_publisher_tc { + my ( $self, $callback ) = @_; + + return $self->{publisher}->with_publisher_tc($callback); } sub _format_date { @@ -422,9 +428,7 @@ sub TO_JSON { legitimate_interests => $self->{vendor_legitimate_interests}->TO_JSON, }, - publisher => { - restrictions => $self->{publisher_restrictions}->TO_JSON, - }, + publisher => $self->{publisher}->TO_JSON, }; } @@ -531,17 +535,49 @@ sub _parse_vendor_legitimate_interests { return $pub_restrict_offset; } +sub _parse_publisher_section { + my ( $self, $pub_restrict_offset ) = @_; + + # parse public restrictions + + my $core_data = substr( $self->{core_data}, $pub_restrict_offset ); + my $core_data_size = length( $self->{core_data} ); + + my $publisher = GDPR::IAB::TCFv2::Publisher->Parse( + core_data => $core_data, + core_data_size => $core_data_size, + publisher_tc_data => $self->{publisher_tc_data}, + options => $self->{options}, + ); + + $self->{publisher} = $publisher; +} + +sub _parse_disclosed_vendors { + my $self = shift; + + # TODO parse section disclosed vendors if available + + return unless defined $self->{disclosed_vendors_data}; # if avaliable + +# my $disclosed_vendors = $self->_parse_bitfield_or_range(0, 'disclosed_vendors_data'); + + # $self->{disclosed_vendors} = $disclosed_vendors; +} + sub _parse_bitfield_or_range { - my ( $self, $offset ) = @_; + my ( $self, $offset, $section ) = @_; + + $section ||= q; my $something; - my ( $max_id, $next_offset ) = get_uint16( $self->{core_data}, $offset ); + my ( $max_id, $next_offset ) = get_uint16( $self->{$section}, $offset ); my $is_range; ( $is_range, $next_offset ) = is_set( - $self->{core_data}, + $self->{$section}, $next_offset, ); @@ -549,57 +585,20 @@ sub _parse_bitfield_or_range { ( $something, $next_offset ) = $self->_parse_range_section( $max_id, $next_offset, + $section, ); } else { ( $something, $next_offset ) = $self->_parse_bitfield( $max_id, $next_offset, + $section, ); } return wantarray ? ( $something, $next_offset ) : $something; } -sub _parse_publisher_section { - my ( $self, $pub_restrict_offset ) = @_; - - $self->_parse_publisher_restrictions($pub_restrict_offset); - - # TODO parse section publisher_tc if available - - # $self->{publisher_tc_data}; # if avaliable -} - -sub _parse_publisher_restrictions { - my ( $self, $pub_restrict_offset ) = @_; - - my $data = substr( - $self->{core_data}, $pub_restrict_offset, - ASSUMED_MAX_VENDOR_ID - ); - - my ( $publisher_restrictions, $relative_next_offset ) = - GDPR::IAB::TCFv2::PublisherRestrictions->Parse( - data => $data, - data_size => length( $self->{core_data} ), - max_id => ASSUMED_MAX_VENDOR_ID, - options => $self->{options}, - ); - - $self->{publisher_restrictions} = $publisher_restrictions; - - return $pub_restrict_offset + $relative_next_offset; -} - -sub _parse_disclosed_vendors { - my $self = shift; - - # TODO parse section disclosed vendors if available - - # $self->{disclosed_vendors_data}; # if avaliable -} - sub _parse_range_section { my ( $self, $max_id, $range_section_start_offset, $section ) = @_; diff --git a/lib/GDPR/IAB/TCFv2/BitField.pm b/lib/GDPR/IAB/TCFv2/BitField.pm index 7f287ae..49f911f 100644 --- a/lib/GDPR/IAB/TCFv2/BitField.pm +++ b/lib/GDPR/IAB/TCFv2/BitField.pm @@ -80,24 +80,6 @@ sub TO_JSON { }; } -sub _format_json_subsection2 { - my ( $self, $data, $max ) = @_; - - my ( $false, $true ) = @{ $self->{options}->{json}->{boolean_values} }; - - if ( !!$self->{options}->{json}->{compact} ) { - return [ - grep { $data->{$_} } 1 .. $max, - ]; - } - - my $verbose = !!$self->{options}->{json}->{verbose}; - - return $data if $verbose; - - return { map { $_ => $true } grep { $data->{$_} } keys %{$data} }; -} - 1; __END__ diff --git a/lib/GDPR/IAB/TCFv2/Publisher.pm b/lib/GDPR/IAB/TCFv2/Publisher.pm new file mode 100644 index 0000000..8aee2c8 --- /dev/null +++ b/lib/GDPR/IAB/TCFv2/Publisher.pm @@ -0,0 +1,82 @@ +package GDPR::IAB::TCFv2::Publisher; +use strict; +use warnings; + +use Carp qw; + +use GDPR::IAB::TCFv2::PublisherRestrictions; +use GDPR::IAB::TCFv2::PublisherTC; + + +sub Parse { + my ( $klass, %args ) = @_; + + croak "missing 'core_data'" unless defined $args{core_data}; + croak "missing 'core_data_size'" unless defined $args{core_data_size}; + + croak "missing 'options'" unless defined $args{options}; + croak "missing 'options.json'" unless defined $args{options}->{json}; + + my $core_data = $args{core_data}; + my $core_data_size = $args{core_data_size}; + + my $restrictions = GDPR::IAB::TCFv2::PublisherRestrictions->Parse( + data => $core_data, + data_size => $core_data_size, + options => $args{options}, + ); + + my $self = { + restrictions => $restrictions, + publisher_tc => undef, + }; + + if ( defined $args{publisher_tc_data} ) { + my $publisher_tc_data = $args{publisher_tc_data}; + my $publisher_tc_data_size = + $args{publisher_tc_data_size} || length($publisher_tc_data); + + my $publisher_tc = GDPR::IAB::TCFv2::PublisherTC->Parse( + data => $publisher_tc_data, + data_size => $publisher_tc_data_size, + options => $args{options}, + ); + + $self->{publisher_tc} = $publisher_tc; + } + + bless $self, $klass; + + return $self; +} + +sub check_restriction { + my ( $self, $purpose_id, $restrict_type, $vendor ) = @_; + + return $self->{restrictions} + ->contains( $purpose_id, $restrict_type, $vendor ); +} + +sub with_publish_tc { + my ( $self, $callback ) = @_; + + return unless defined $self->{publisher_tc}; + + return $callback->( $self->{publisher_tc} ); +} + +sub TO_JSON { + my $self = shift; + + my %tags = ( + restrictions => $self->{restrictions}->TO_JSON, + ); + + if ( defined $self->{publisher_tc} ) { + %tags = ( %tags, %{ $self->{publisher_tc}->TO_JSON } ); + } + + return \%tags; +} + +1; diff --git a/lib/GDPR/IAB/TCFv2/PublisherRestrictions.pm b/lib/GDPR/IAB/TCFv2/PublisherRestrictions.pm index 5c00766..35f359b 100644 --- a/lib/GDPR/IAB/TCFv2/PublisherRestrictions.pm +++ b/lib/GDPR/IAB/TCFv2/PublisherRestrictions.pm @@ -6,6 +6,7 @@ use Carp qw; use GDPR::IAB::TCFv2::BitUtils qw; +use constant ASSUMED_MAX_VENDOR_ID => 0x7FFF; # 32767 or (1 << 15) -1 + + sub Parse { my ( $klass, %args ) = @_; croak "missing 'data'" unless defined $args{data}; croak "missing 'data_size'" unless defined $args{data_size}; - croak "missing 'max_id'" - unless defined $args{max_id}; croak "missing 'options'" unless defined $args{options}; croak "missing 'options.json'" unless defined $args{options}->{json}; @@ -27,7 +29,7 @@ sub Parse { my $data = $args{data}; my $data_size = $args{data_size}; my $offset = 0; - my $max_id = $args{max_id}; + my $max_id = ASSUMED_MAX_VENDOR_ID; my $options = $args{options}; my ( $num_restrictions, $next_offset ) = get_uint12( $data, $offset ); @@ -46,7 +48,7 @@ sub Parse { data => $data, data_size => $data_size, offset => $next_offset, - max_id => $max_id, + max_id => ASSUMED_MAX_VENDOR_ID, options => $options, ); @@ -57,18 +59,17 @@ sub Parse { my $self = { restrictions => \%restrictions, - max_id => $max_id, }; bless $self, $klass; - return wantarray ? ( $self, $next_offset ) : $self; + return $self; } sub max_id { my $self = @_; - return $self->{max_id}; + return ASSUMED_MAX_VENDOR_ID; } sub contains { diff --git a/lib/GDPR/IAB/TCFv2/PublisherTC.pm b/lib/GDPR/IAB/TCFv2/PublisherTC.pm new file mode 100644 index 0000000..e8a8b7d --- /dev/null +++ b/lib/GDPR/IAB/TCFv2/PublisherTC.pm @@ -0,0 +1,200 @@ +package GDPR::IAB::TCFv2::PublisherTC; +use strict; +use warnings; + +use Carp qw; + +use GDPR::IAB::TCFv2::BitUtils qw; + +use constant { + SEGMENT_TYPE_PUBLISHER_TC => 3, + MAX_PURPOSE_ID => 24, + OFFSETS => { + SEGMENT_TYPE => 0, + PURPOSE_CONSENT_ALLOWED => 3, + PURPOSE_LIT_ALLOWED => 27, + NUM_CUSTOM_PURPOSES => 51, + CUSTOM_PURPOSES_CONSENT => 57, + }, +}; + +sub Parse { + my ( $klass, %args ) = @_; + + croak "missing 'data'" unless defined $args{data}; + croak "missing 'data_size'" unless defined $args{data_size}; + + croak "missing 'options'" unless defined $args{options}; + croak "missing 'options.json'" unless defined $args{options}->{json}; + + my $data = $args{data}; + my $data_size = $args{data_size}; + my $options = $args{options}; + + croak "invalid min size" if $data_size < 57; + + my $segment_type = get_uint3( $data, OFFSETS->{SEGMENT_TYPE} ); + + croak + "invalid segment type ${segment_type}: expected @{[ SEGMENT_TYPE_PUBLISHER_TC ]}" + if $segment_type != SEGMENT_TYPE_PUBLISHER_TC; + + my $num_custom_purposes = + get_uint6( $data, OFFSETS->{NUM_CUSTOM_PURPOSES} ); + + my $total_expected_size = 2 * $num_custom_purposes + 57; + + croak "invalid size" if $data_size < $total_expected_size; + + my $self = { + data => $data, + options => $options, + num_custom_purposes => $num_custom_purposes, + custom_purpose_lit_offset => OFFSETS->{CUSTOM_PURPOSES_CONSENT} + + $num_custom_purposes, + }; + + bless $self, $klass; + + return $self; +} + +sub num_custom_purposes { + my $self = shift; + + return $self->{num_custom_purposes}; +} + +sub is_purpose_consent_allowed { + my ( $self, $id ) = @_; + + croak "invalid purpose id $id: must be between 1 and @{[ MAX_PURPOSE_ID ]}" + if $id < 1 || $id > MAX_PURPOSE_ID; + + return $self->_safe_is_purpose_consent_allowed($id); +} + +sub is_purpose_legitimate_interest_allowed { + my ( $self, $id ) = @_; + + croak "invalid purpose id $id: must be between 1 and @{[ MAX_PURPOSE_ID ]}" + if $id < 1 || $id > MAX_PURPOSE_ID; + + return $self->_safe_is_purpose_legitimate_interest_allowed($id); +} + +sub is_custom_purpose_consent_allowed { + my ( $self, $id ) = @_; + + croak + "invalid custom purpose id $id: must be between 1 and @{[ $self->{num_custom_purposes} ]}" + if $id < 1 || $id > $self->{num_custom_purposes}; + + return $self->_safe_is_custom_purpose_consent_allowed($id); +} + +sub is_custom_purpose_legitimate_interest_allowed { + my ( $self, $id ) = @_; + + croak + "invalid custom purpose id $id: must be between 1 and @{[ $self->{num_custom_purposes} ]}" + if $id < 1 || $id > $self->{num_custom_purposes}; + + return $self->_safe_is_custom_purpose_legitimate_interest_allowed($id); +} + +sub TO_JSON { + my $self = shift; + + my %consents = map { $_ => $self->_safe_is_purpose_consent_allowed($_) } + 1 .. MAX_PURPOSE_ID; + my %legitimate_interests = + map { $_ => $self->_safe_is_purpose_legitimate_interest_allowed($_) } + 1 .. MAX_PURPOSE_ID; + my %custom_purpose_consents = + map { $_ => $self->_safe_is_custom_purpose_consent_allowed($_) } + 1 .. $self->{num_custom_purposes}; + my %custom_purpose_legitimate_interests = map { + $_ => $self->_safe_is_custom_purpose_legitimate_interest_allowed($_) + } 1 .. $self->{num_custom_purposes}; + + return { + consents => + $self->_format_json_subsection( \%consents, MAX_PURPOSE_ID ), + legitimate_interests => $self->_format_json_subsection( + \%legitimate_interests, MAX_PURPOSE_ID + ), + custom_purpose => { + consents => $self->_format_json_subsection( + \%custom_purpose_consents, $self->{num_custom_purposes} + ), + legitimate_interests => $self->_format_json_subsection( + \%custom_purpose_legitimate_interests, + $self->{num_custom_purposes} + ), + }, + }; +} + +sub _format_json_subsection { + my ( $self, $data, $max ) = @_; + + my ( $false, $true ) = @{ $self->{options}->{json}->{boolean_values} }; + + if ( !!$self->{options}->{json}->{compact} ) { + return [ + grep { $data->{$_} } 1 .. $max, + ]; + } + + my $verbose = !!$self->{options}->{json}->{verbose}; + + return $data if $verbose; + + return { map { $_ => $true } grep { $data->{$_} } keys %{$data} }; +} + +sub _safe_is_purpose_consent_allowed { + my ( $self, $id ) = @_; + return + scalar( + is_set( $self->{data}, OFFSETS->{PURPOSE_CONSENT_ALLOWED} + $id - 1 ) + ); +} + +sub _safe_is_purpose_legitimate_interest_allowed { + my ( $self, $id ) = @_; + + return + scalar( + is_set( $self->{data}, OFFSETS->{PURPOSE_LIT_ALLOWED} + $id - 1 ) ); +} + +sub _safe_is_custom_purpose_consent_allowed { + my ( $self, $id ) = @_; + return + scalar( + is_set( $self->{data}, OFFSETS->{CUSTOM_PURPOSES_CONSENT} + $id - 1 ) + ); +} + +sub _safe_is_custom_purpose_legitimate_interest_allowed { + my ( $self, $id ) = @_; + + return + scalar( + is_set( $self->{data}, $self->{custom_purpose_lit_offset} + $id - 1 ) + ); +} + +# add method TO_JSON + +1; diff --git a/t/01-parse.t b/t/01-parse.t index f4bd902..5711445 100644 --- a/t/01-parse.t +++ b/t/01-parse.t @@ -10,7 +10,7 @@ subtest "valid tcf v2 consent string using bitfield" => sub { my $consent; my $tc_string = - 'CLcVDxRMWfGmWAVAHCENAXCkAKDAADnAABRgA5mdfCKZuYJez-NQm0TBMYA4oCAAGQYIAAAAAAEAIAEgAA.argAC0gAAAAAAAAAAAA'; + 'CLcVDxRMWfGmWAVAHCENAXCkAKDAADnAABRgA5mdfCKZuYJez-NQm0TBMYA4oCAAGQYIAAAAAAEAIAEgAA'; lives_ok { $consent = GDPR::IAB::TCFv2->Parse($tc_string); } @@ -154,6 +154,30 @@ subtest "valid tcf v2 consent string using bitfield" => sub { done_testing; }; +subtest + "valid tcf v2 consent string using bitfield with publisher TC section" => + sub { + my $consent; + + my $tc_string = + 'CLcVDxRMWfGmWAVAHCENAXCkAKDAADnAABRgA5mdfCKZuYJez-NQm0TBMYA4oCAAGQYIAAAAAAEAIAEgAA.argAC0gAAAAAAAAAAAA'; + lives_ok { + $consent = GDPR::IAB::TCFv2->Parse($tc_string); + } + 'should not throw exception'; + + isa_ok $consent, 'GDPR::IAB::TCFv2', 'gdpr iab tcf v2 consent'; + + is $consent->tc_string, $tc_string, 'should return the original tc string'; + + is "${consent}", $tc_string, + 'should return the original tc string in string context'; + + is $consent->version, 2, 'should return version 2'; + + done_testing; + }; + subtest "valid tcf v2 consent string using range" => sub { my $consent; diff --git a/t/02-json.t b/t/02-json.t index 191e5e8..38e2181 100644 --- a/t/02-json.t +++ b/t/02-json.t @@ -14,7 +14,7 @@ subtest subtest "should convert data to json using yyyymmdd as date format" => sub { my $consent = GDPR::IAB::TCFv2->Parse( - 'CLcVDxRMWfGmWAVAHCENAXCkAKDAADnAABRgA5mdfCKZuYJez-NQm0TBMYA4oCAAGQYIAAAAAAEAIAEgAA.argAC0gAAAAAAAAAAAA', + 'CLcVDxRMWfGmWAVAHCENAXCkAKDAADnAABRgA5mdfCKZuYJez-NQm0TBMYA4oCAAGQYIAAAAAAEAIAEgAA', json => { verbose => 0, compact => 1, @@ -37,7 +37,7 @@ subtest subtest "should convert data to json using epoch date format" => sub { my $consent = GDPR::IAB::TCFv2->Parse( - 'CLcVDxRMWfGmWAVAHCENAXCkAKDAADnAABRgA5mdfCKZuYJez-NQm0TBMYA4oCAAGQYIAAAAAAEAIAEgAA.argAC0gAAAAAAAAAAAA', + 'CLcVDxRMWfGmWAVAHCENAXCkAKDAADnAABRgA5mdfCKZuYJez-NQm0TBMYA4oCAAGQYIAAAAAAEAIAEgAA', json => { verbose => 0, compact => 1, @@ -67,7 +67,7 @@ subtest subtest "default non verbose, date as iso 8601" => sub { my $consent = GDPR::IAB::TCFv2->Parse( - 'CLcVDxRMWfGmWAVAHCENAXCkAKDAADnAABRgA5mdfCKZuYJez-NQm0TBMYA4oCAAGQYIAAAAAAEAIAEgAA.argAC0gAAAAAAAAAAAA', + 'CLcVDxRMWfGmWAVAHCENAXCkAKDAADnAABRgA5mdfCKZuYJez-NQm0TBMYA4oCAAGQYIAAAAAAEAIAEgAA', json => { verbose => 0, compact => 0, @@ -87,7 +87,7 @@ subtest subtest "default non verbose, date as iso 8601" => sub { my $consent = GDPR::IAB::TCFv2->Parse( - 'CLcVDxRMWfGmWAVAHCENAXCkAKDAADnAABRgA5mdfCKZuYJez-NQm0TBMYA4oCAAGQYIAAAAAAEAIAEgAA.argAC0gAAAAAAAAAAAA', + 'CLcVDxRMWfGmWAVAHCENAXCkAKDAADnAABRgA5mdfCKZuYJez-NQm0TBMYA4oCAAGQYIAAAAAAEAIAEgAA', json => { verbose => 1, compact => 0, @@ -132,7 +132,7 @@ subtest "publisher" => sub { subtest "TO_JSON method should return the same hashref " => sub { my $consent = GDPR::IAB::TCFv2->Parse( - 'CLcVDxRMWfGmWAVAHCENAXCkAKDAADnAABRgA5mdfCKZuYJez-NQm0TBMYA4oCAAGQYIAAAAAAEAIAEgAA.argAC0gAAAAAAAAAAAA', + 'CLcVDxRMWfGmWAVAHCENAXCkAKDAADnAABRgA5mdfCKZuYJez-NQm0TBMYA4oCAAGQYIAAAAAAEAIAEgAA', json => { verbose => 0, compact => 1, @@ -161,7 +161,7 @@ sub _fixture_compact { 'last_updated' => '2012-01-10T17:10:13Z', 'policy_version' => 2, 'tc_string' => - 'CLcVDxRMWfGmWAVAHCENAXCkAKDAADnAABRgA5mdfCKZuYJez-NQm0TBMYA4oCAAGQYIAAAAAAEAIAEgAA.argAC0gAAAAAAAAAAAA', + 'CLcVDxRMWfGmWAVAHCENAXCkAKDAADnAABRgA5mdfCKZuYJez-NQm0TBMYA4oCAAGQYIAAAAAAEAIAEgAA', 'version' => 2, 'consent_language' => 'EN', 'is_service_specific' => 1, @@ -275,7 +275,7 @@ sub _fixture_default { return { 'tc_string' => - 'CLcVDxRMWfGmWAVAHCENAXCkAKDAADnAABRgA5mdfCKZuYJez-NQm0TBMYA4oCAAGQYIAAAAAAEAIAEgAA.argAC0gAAAAAAAAAAAA', + 'CLcVDxRMWfGmWAVAHCENAXCkAKDAADnAABRgA5mdfCKZuYJez-NQm0TBMYA4oCAAGQYIAAAAAAEAIAEgAA', 'consent_language' => 'EN', 'purpose' => { 'consents' => { @@ -393,7 +393,7 @@ sub _fixture_verbose { return { 'tc_string' => - 'CLcVDxRMWfGmWAVAHCENAXCkAKDAADnAABRgA5mdfCKZuYJez-NQm0TBMYA4oCAAGQYIAAAAAAEAIAEgAA.argAC0gAAAAAAAAAAAA', + 'CLcVDxRMWfGmWAVAHCENAXCkAKDAADnAABRgA5mdfCKZuYJez-NQm0TBMYA4oCAAGQYIAAAAAAEAIAEgAA', 'consent_language' => 'EN', 'purpose' => { 'consents' => { From 72784effbc7674d93ba3de6ccbd46f0a542b53a2 Mon Sep 17 00:00:00 2001 From: Tiago Peczenyj Date: Fri, 15 Dec 2023 13:59:35 +0100 Subject: [PATCH 02/13] add missing changes --- Changes | 1 + 1 file changed, 1 insertion(+) diff --git a/Changes b/Changes index ccfafaf..3ec2066 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,4 @@ + - parse publisher tc section if available - add strict mode (disabled by default) to validate the consent string version 0.084 From 5db4aa42211e665338cee5093339c546436dfce3 Mon Sep 17 00:00:00 2001 From: Tiago Peczenyj Date: Fri, 15 Dec 2023 14:04:36 +0100 Subject: [PATCH 03/13] some refactor --- lib/GDPR/IAB/TCFv2.pm | 7 +++---- lib/GDPR/IAB/TCFv2/Publisher.pm | 6 ++---- 2 files changed, 5 insertions(+), 8 deletions(-) diff --git a/lib/GDPR/IAB/TCFv2.pm b/lib/GDPR/IAB/TCFv2.pm index f56f186..9e13be2 100644 --- a/lib/GDPR/IAB/TCFv2.pm +++ b/lib/GDPR/IAB/TCFv2.pm @@ -117,7 +117,6 @@ sub Parse { vendor_consents => undef, vendor_legitimate_interests => undef, publisher => undef, - publisher_restrictions => undef, }; bless $self, $klass; @@ -336,10 +335,10 @@ sub check_publisher_restriction { ->check_restriction( $purpose_id, $restrict_type, $vendor ); } -sub with_publisher_tc { - my ( $self, $callback ) = @_; +sub publisher_tc { + my $self = shift; - return $self->{publisher}->with_publisher_tc($callback); + return $self->{publisher}->publisher_tc; } sub _format_date { diff --git a/lib/GDPR/IAB/TCFv2/Publisher.pm b/lib/GDPR/IAB/TCFv2/Publisher.pm index 8aee2c8..e48a994 100644 --- a/lib/GDPR/IAB/TCFv2/Publisher.pm +++ b/lib/GDPR/IAB/TCFv2/Publisher.pm @@ -57,12 +57,10 @@ sub check_restriction { ->contains( $purpose_id, $restrict_type, $vendor ); } -sub with_publish_tc { +sub publisher_tc { my ( $self, $callback ) = @_; - return unless defined $self->{publisher_tc}; - - return $callback->( $self->{publisher_tc} ); + return $self->{publisher_tc}; } sub TO_JSON { From 06bca950d411a23cb5b0587ef62e25664d063e38 Mon Sep 17 00:00:00 2001 From: Tiago Peczenyj Date: Fri, 15 Dec 2023 14:13:18 +0100 Subject: [PATCH 04/13] add example --- README.pod | 21 ++++++++++++++++++++- lib/GDPR/IAB/TCFv2.pm | 21 ++++++++++++++++++++- 2 files changed, 40 insertions(+), 2 deletions(-) diff --git a/README.pod b/README.pod index 40f425b..76c24c5 100644 --- a/README.pod +++ b/README.pod @@ -356,7 +356,7 @@ With option C, the encoder will call this method. use GDPR::IAB::TCFv2; my $consent = GDPR::IAB::TCFv2->Parse( - 'COyiILmOyiILmADACHENAPCAAAAAAAAAAAAAE5QBgALgAqgD8AQACSwEygJyAAAAAA', + 'COyiILmOyiILmADACHENAPCAAAAAAAAAAAAAE5QBgALgAqgD8AQACSwEygJyAAAAAA.argAC0gAAAAAAAAAAAA', json => { compact => 1, date_format => sub { # can be omitted, with DateTimeX::TO_JSON @@ -385,6 +385,25 @@ Outputs: "cmp_id" : 3, "purpose_one_treatment" : false, "publisher" : { + "consents" : [ + 2, + 4, + 6, + 8, + 9, + 10 + ], + "legitimate_interests" : [ + 2, + 4, + 5, + 7, + 10 + ], + "custom_purpose" : { + "consents" : [], + "legitimate_interests" : [] + }, "restrictions" : {} }, "special_features_opt_in" : [], diff --git a/lib/GDPR/IAB/TCFv2.pm b/lib/GDPR/IAB/TCFv2.pm index 9e13be2..5689e5f 100644 --- a/lib/GDPR/IAB/TCFv2.pm +++ b/lib/GDPR/IAB/TCFv2.pm @@ -1009,7 +1009,7 @@ With option C, the encoder will call this method. use GDPR::IAB::TCFv2; my $consent = GDPR::IAB::TCFv2->Parse( - 'COyiILmOyiILmADACHENAPCAAAAAAAAAAAAAE5QBgALgAqgD8AQACSwEygJyAAAAAA', + 'COyiILmOyiILmADACHENAPCAAAAAAAAAAAAAE5QBgALgAqgD8AQACSwEygJyAAAAAA.argAC0gAAAAAAAAAAAA', json => { compact => 1, date_format => sub { # can be omitted, with DateTimeX::TO_JSON @@ -1038,6 +1038,25 @@ Outputs: "cmp_id" : 3, "purpose_one_treatment" : false, "publisher" : { + "consents" : [ + 2, + 4, + 6, + 8, + 9, + 10 + ], + "legitimate_interests" : [ + 2, + 4, + 5, + 7, + 10 + ], + "custom_purpose" : { + "consents" : [], + "legitimate_interests" : [] + }, "restrictions" : {} }, "special_features_opt_in" : [], From 057fed306b2bbc2de30f3abb5417bb487274eb3d Mon Sep 17 00:00:00 2001 From: Tiago Peczenyj Date: Fri, 15 Dec 2023 15:15:26 +0100 Subject: [PATCH 05/13] update pod --- README.pod | 6 + lib/GDPR/IAB/TCFv2.pm | 6 + lib/GDPR/IAB/TCFv2/BitField.pm | 34 ++++-- lib/GDPR/IAB/TCFv2/Publisher.pm | 123 +++++++++++++++++++- lib/GDPR/IAB/TCFv2/PublisherRestrictions.pm | 47 ++++---- lib/GDPR/IAB/TCFv2/PublisherTC.pm | 118 ++++++++++++++++++- lib/GDPR/IAB/TCFv2/RangeSection.pm | 32 ++++- t/00-load.t | 30 +++-- 8 files changed, 350 insertions(+), 46 deletions(-) diff --git a/README.pod b/README.pod index 76c24c5..59260d0 100644 --- a/README.pod +++ b/README.pod @@ -340,6 +340,12 @@ For the avoidance of doubt: In case a vendor has declared flexibility for a purpose and there is no legal basis restriction signal it must always apply the default legal basis under which the purpose was registered aside from being registered as flexible. That means if a vendor declared a purpose as legitimate interest and also declared that purpose as flexible it may not apply a "consent" signal without a legal basis restriction signal to require consent. +=head2 publisher_tc + +If the consent string has a C section, we will decode this section as an instance of L. + +Will return undefined if there is no C section. + =head2 TO_JSON Will serialize the consent object into a hash reference. The objective is to be used by L package. diff --git a/lib/GDPR/IAB/TCFv2.pm b/lib/GDPR/IAB/TCFv2.pm index 5689e5f..5bc30dc 100644 --- a/lib/GDPR/IAB/TCFv2.pm +++ b/lib/GDPR/IAB/TCFv2.pm @@ -993,6 +993,12 @@ For the avoidance of doubt: In case a vendor has declared flexibility for a purpose and there is no legal basis restriction signal it must always apply the default legal basis under which the purpose was registered aside from being registered as flexible. That means if a vendor declared a purpose as legitimate interest and also declared that purpose as flexible it may not apply a "consent" signal without a legal basis restriction signal to require consent. +=head2 publisher_tc + +If the consent string has a C section, we will decode this section as an instance of L. + +Will return undefined if there is no C section. + =head2 TO_JSON Will serialize the consent object into a hash reference. The objective is to be used by L package. diff --git a/lib/GDPR/IAB/TCFv2/BitField.pm b/lib/GDPR/IAB/TCFv2/BitField.pm index 49f911f..19c5974 100644 --- a/lib/GDPR/IAB/TCFv2/BitField.pm +++ b/lib/GDPR/IAB/TCFv2/BitField.pm @@ -10,7 +10,8 @@ use Carp qw; sub Parse { my ( $klass, %args ) = @_; - croak "missing 'data'" unless defined $args{data}; + croak "missing 'data'" unless defined $args{data}; + croak "missing 'data_size'" unless defined $args{data_size}; croak "missing 'max_id'" unless defined $args{max_id}; @@ -94,22 +95,37 @@ GDPR::IAB::TCFv2::BitField - Transparency & Consent String version 2 bitfield pa my $max_id_consent = << get 16 bits from $data offset 213 >> my $bit_field = GDPR::IAB::TCFv2::BitField->Parse( - data => $data, - offset => 230, # offset for vendor consents - max_id => $max_id_consent, + data => substr($data, OFFSET), + data_size => length($data), + max_id => $max_id_consent, + options => { json => ... }, ); - if $bit_field->contains(284) { ... } + say "bit field contains id 284" if $bit_field->contains(284); =head1 CONSTRUCTOR -Constructor C receive 3 parameters: data (as sequence of bits), start bit offset and vendor bits required (max vendor id). +Constructor C receives an hash of 4 parameters: -Will die if any parameter is missing. +=over -Will die if data does not contain all bits required. +=item * -Will return an array of two elements: the object itself and the next offset. +Key C is the binary data + +=item * + +Key C is the original binary data size + +=item * + +Key C is the max id (used to validate the ranges if all data is between 1 and C) + +=item * + +Key C is the L options (includes the C field to modify the L method output. + +=back =head1 METHODS diff --git a/lib/GDPR/IAB/TCFv2/Publisher.pm b/lib/GDPR/IAB/TCFv2/Publisher.pm index e48a994..136f0e1 100644 --- a/lib/GDPR/IAB/TCFv2/Publisher.pm +++ b/lib/GDPR/IAB/TCFv2/Publisher.pm @@ -54,7 +54,7 @@ sub check_restriction { my ( $self, $purpose_id, $restrict_type, $vendor ) = @_; return $self->{restrictions} - ->contains( $purpose_id, $restrict_type, $vendor ); + ->check_restriction( $purpose_id, $restrict_type, $vendor ); } sub publisher_tc { @@ -78,3 +78,124 @@ sub TO_JSON { } 1; +__END__ + +=head1 NAME + +GDPR::IAB::TCFv2::Publisher - Transparency & Consent String version 2 publisher + +Combines the creation of L and L based on the data available. + +=head1 SYNOPSIS + + my $publisher = GDPR::IAB::TCFv2::Publisher->Parse( + core_data => $core_data, + core_data_size => $core_data_size, + publisher_tc_data => $publisher_tc_data, # optional + options => { json => ... }, + ); + + say "there is publisher restriction on purpose id 1, type 0 on vendor 284" + if $publisher->check_restriction(1, 0, 284); + +=head1 CONSTRUCTOR + +Constructor C receives an hash of 4 parameters: + +=over + +=item * + +Key C is the binary core data + +=item * + +Key C is the original binary core data size + +=item * + +Key C is the binary publisher data. Optional. + +=item * + +Key C is the L options (includes the C field to modify the L method output. + +=back + +=head1 METHODS + +=head2 check_restriction + +Return true for a given combination of purpose id, restriction type and vendor + + my $purpose_id = 1; + my $restriction_type = 0; + my $vendor = 284; + $ok = $range->check_restriction($purpose_id, $restriction_type, $vendor); + +=head2 publisher_tc + +If the consent string has a C section, we will decode this section as an instance of L. + +Will return undefined if there is no C section. + +=head2 TO_JSON + +Returns a hashref with the following format: + + { + consents => ..., + legitimate_interests => ..., + custom_purposes => { + consents => ..., + legitimate_interests => ..., + }, + restrictions => { + '[purpose id]' => { + # 0 - Not Allowed + # 1 - Require Consent + # 2 - Require Legitimate Interest + '[vendor id]' => 1, + }, + } + } + +Example, by parsing the consent C we can generate this compact hashref. + + { + "consents" : [ + 2, + 4, + 6, + 8, + 9, + 10 + ], + "legitimate_interests" : [ + 2, + 4, + 5, + 7, + 10 + ], + "custom_purpose" : { + "consents" : [], + "legitimate_interests" : [] + }, + "restrictions" : { + "7" : { + "32" : 1 + } + } + } + +However by parsing the consent C without the C +section will omit all fields except C: + + { + "restrictions" : { + "7" : { + "32" : 1 + } + } + } diff --git a/lib/GDPR/IAB/TCFv2/PublisherRestrictions.pm b/lib/GDPR/IAB/TCFv2/PublisherRestrictions.pm index 35f359b..f77826f 100644 --- a/lib/GDPR/IAB/TCFv2/PublisherRestrictions.pm +++ b/lib/GDPR/IAB/TCFv2/PublisherRestrictions.pm @@ -66,13 +66,7 @@ sub Parse { return $self; } -sub max_id { - my $self = @_; - - return ASSUMED_MAX_VENDOR_ID; -} - -sub contains { +sub check_restriction { my ( $self, $purpose_id, $restrict_type, $vendor ) = @_; return 0 @@ -115,36 +109,45 @@ GDPR::IAB::TCFv2::PublisherRestrictions - Transparency & Consent String version =head1 SYNOPSIS - my ($publisher_restrictions, $next_offset) = GDPR::IAB::TCFv2::PublisherRestrictions->Parse( - data => $self->{data}, - offset => $pub_restrict_offset, - max_id =>ASSUMED_MAX_VENDOR_ID, - options => $self->{options}, + my $publisher_restrictions = GDPR::IAB::TCFv2::PublisherRestrictions->Parse( + data => substr($self->{data}, OFFSET ), + data_size => length($self->{data}), + options => { json => ... }, ); - die "there is publisher restriction on purpose id 1, type 0 on vendor 284" - if $range->contains(1, 0, 284); + say "there is publisher restriction on purpose id 1, type 0 on vendor 284" + if $publisher_restrictions->check_restriction(1, 0, 284); =head1 CONSTRUCTOR -Receive 1 parameters: restrictions. Hashref. +Constructor C receives an hash of 3 parameters: + +=over + +=item * + +Key C is the binary data -Will die if it is undefined. +=item * + +Key C is the original binary data size + +=item * + +Key C is the L options (includes the C field to modify the L method output. + +=back =head1 METHODS -=head2 contains +=head2 check_restriction Return true for a given combination of purpose id, restriction type and vendor my $purpose_id = 1; my $restriction_type = 0; my $vendor = 284; - $ok = $range->contains($purpose_id, $restriction_type, $vendor); - -=head2 max_id - -Returns the max vendor id. + $ok = $range->check_restriction($purpose_id, $restriction_type, $vendor); =head2 TO_JSON diff --git a/lib/GDPR/IAB/TCFv2/PublisherTC.pm b/lib/GDPR/IAB/TCFv2/PublisherTC.pm index e8a8b7d..a3ddeb9 100644 --- a/lib/GDPR/IAB/TCFv2/PublisherTC.pm +++ b/lib/GDPR/IAB/TCFv2/PublisherTC.pm @@ -132,7 +132,7 @@ sub TO_JSON { legitimate_interests => $self->_format_json_subsection( \%legitimate_interests, MAX_PURPOSE_ID ), - custom_purpose => { + custom_purposes => { consents => $self->_format_json_subsection( \%custom_purpose_consents, $self->{num_custom_purposes} ), @@ -195,6 +195,118 @@ sub _safe_is_custom_purpose_legitimate_interest_allowed { ); } -# add method TO_JSON - 1; +__END__ + +=head1 NAME + +GDPR::IAB::TCFv2::PublisherTC - Transparency & Consent String version 2 publisher tc + +=head1 SYNOPSIS + + my $publisher_tc = GDPR::IAB::TCFv2::PublisherTC->Parse( + data => $publisher_tc_data, + data_size => length($publisher_tc_data), + options => { json => ... }, + ); + + say num_custom_purposes; + + say "there is publisher restriction on purpose id 1, type 0 on vendor 284" + if $publisher_tc->check_restriction(1, 0, 284); + +=head1 CONSTRUCTOR + +Constructor C receives an hash of 3 parameters: + +=over + +=item * + +Key C is the binary data + +=item * + +Key C is the original binary data size + +=item * + +Key C is the L options (includes the C field to modify the L method output. + +=back + +=head1 METHODS + +=head2 num_custom_purposes + +Custom purpose IDs are numbered 1 to NumberCustomPurposes. Custom purposes will be defined by the publisher and displayed to a user in a CMP user interface. + +If the publisher does not use any Custom Purposes, this method returns 0. + +=head2 is_purpose_consent_allowed + +The user's consent value for each Purpose established on the legal basis of consent, for the publisher. + +=head2 is_purpose_legitimate_interest_allowed + +The Purposes transparency requir'ements are met for each Purpose established on the legal basis of legitimate interest and the user has not exercised their "Right to Object" to that Purpose. + +By default or if the user has exercised their "Right to Object to a Purpose", the corresponding bit for that purpose is set to 0 + +=head2 is_custom_purpose_consent_allowed + +The consent value for each custom purpose id + +=head2 is_custom_purpose_legitimate_interest_allowed + +The legitimate Interest disclosure establishment value for each custom purpose id + +=head2 TO_JSON + +Returns a hashref with the following format: + + { + consents => ..., + legitimate_interests => ..., + custom_purposes => { + consents => ..., + legitimate_interests => ..., + }, + restrictions => { + '[purpose id]' => { + # 0 - Not Allowed + # 1 - Require Consent + # 2 - Require Legitimate Interest + '[vendor id]' => 1, + }, + } + } + +Example, by parsing the consent C we can generate this compact hashref. + + { + "consents" : [ + 2, + 4, + 6, + 8, + 9, + 10 + ], + "legitimate_interests" : [ + 2, + 4, + 5, + 7, + 10 + ], + "custom_purpose" : { + "consents" : [], + "legitimate_interests" : [] + }, + "restrictions" : { + "7" : { + "32" : 1 + } + } + } diff --git a/lib/GDPR/IAB/TCFv2/RangeSection.pm b/lib/GDPR/IAB/TCFv2/RangeSection.pm index b036c07..ff37d59 100644 --- a/lib/GDPR/IAB/TCFv2/RangeSection.pm +++ b/lib/GDPR/IAB/TCFv2/RangeSection.pm @@ -170,16 +170,40 @@ GDPR::IAB::TCFv2::RangeSection - Transparency & Consent String version 2 range s my $max_id_consent = << get 16 bits from $data offset 213 >> my ($range_section, $next_offset) = GDPR::IAB::TCFv2::RangeSection->Parse( - data => $data, - offset => 230, # offset for vendor ranges + data => $data, + offset => 230, # offset for vendor ranges max_id => $max_id_consent, ); - if $range_section->contains(284) { ... } + say "range section contains id 284" if $range_section->contains(284); =head1 CONSTRUCTOR -Constructor C receives 3 parameters: data (as sequence of bits), start bit offset and vendor bits required (max vendor id). +Constructor C receives an hash of 5 parameters: + +=over + +=item * + +Key C is the binary data + +=item * + +Key C is the original binary data size + +=item * + +Key C is the binary data offset. Can be 0. + +=item * + +Key C is the max id (used to validate the ranges if all data is between 1 and C) + +=item * + +Key C is the L options (includes the C field to modify the L method output. + +=back Will die if any parameter is missing. diff --git a/t/00-load.t b/t/00-load.t index 9abbc2e..999318c 100644 --- a/t/00-load.t +++ b/t/00-load.t @@ -8,7 +8,9 @@ BEGIN { use_ok('GDPR::IAB::TCFv2::Constants::RestrictionType'); use_ok('GDPR::IAB::TCFv2::BitUtils'); use_ok('GDPR::IAB::TCFv2::BitField'); + use_ok('GDPR::IAB::TCFv2::Publisher'); use_ok('GDPR::IAB::TCFv2::PublisherRestrictions'); + use_ok('GDPR::IAB::TCFv2::PublisherTC'); use_ok('GDPR::IAB::TCFv2::RangeSection'); use_ok('GDPR::IAB::TCFv2'); } @@ -18,7 +20,9 @@ require_ok('GDPR::IAB::TCFv2::Constants::SpecialFeature'); require_ok('GDPR::IAB::TCFv2::Constants::RestrictionType'); require_ok 'GDPR::IAB::TCFv2::BitUtils'; require_ok 'GDPR::IAB::TCFv2::BitField'; +require_ok('GDPR::IAB::TCFv2::Publisher'); require_ok('GDPR::IAB::TCFv2::PublisherRestrictions'); +require_ok('GDPR::IAB::TCFv2::PublisherTC'); require_ok 'GDPR::IAB::TCFv2::RangeSection'; require_ok 'GDPR::IAB::TCFv2'; @@ -28,13 +32,25 @@ subtest "check interfaces" => sub { isa_ok 'GDPR::IAB::TCFv2::Constants::SpecialFeature', 'Exporter'; isa_ok 'GDPR::IAB::TCFv2::Constants::RestrictionType', 'Exporter'; - my @role_methods = qw; - - can_ok 'GDPR::IAB::TCFv2::BitField', @role_methods; - can_ok 'GDPR::IAB::TCFv2::RangeSection', @role_methods; - can_ok 'GDPR::IAB::TCFv2::PublisherRestrictions', @role_methods; - - can_ok 'GDPR::IAB::TCFv2::RangeSection', qw; + my @role_base_methods = qw; + my @role_decoder_methods = qw; + + + can_ok 'GDPR::IAB::TCFv2::BitField', @role_base_methods, + @role_decoder_methods; + can_ok 'GDPR::IAB::TCFv2::RangeSection', @role_base_methods, + @role_decoder_methods, qw; + + can_ok 'GDPR::IAB::TCFv2::PublisherRestrictions', @role_base_methods, + qw; + can_ok 'GDPR::IAB::TCFv2::Publisher', @role_base_methods, + qw; + can_ok 'GDPR::IAB::TCFv2::PublisherTC', @role_base_methods, + qw; done_testing; }; From 8f8b789176fd605842c8d1520efacdad03893968 Mon Sep 17 00:00:00 2001 From: Tiago Peczenyj Date: Fri, 15 Dec 2023 15:40:48 +0100 Subject: [PATCH 06/13] add unit tests --- lib/GDPR/IAB/TCFv2/BitField.pm | 8 ++++++ lib/GDPR/IAB/TCFv2/RangeSection.pm | 15 +++++++++--- t/01-parse.t | 39 ++++++++++++++++++++++++++++++ t/02-json.t | 30 ++++++++++++++++++++++- 4 files changed, 88 insertions(+), 4 deletions(-) diff --git a/lib/GDPR/IAB/TCFv2/BitField.pm b/lib/GDPR/IAB/TCFv2/BitField.pm index 19c5974..8de6239 100644 --- a/lib/GDPR/IAB/TCFv2/BitField.pm +++ b/lib/GDPR/IAB/TCFv2/BitField.pm @@ -143,3 +143,11 @@ Returns the max vendor id. =head2 all Returns an array of all vendors mapped with the bit enabled. + +=head2 TO_JSON + +By default it returns an hashref mapping id to a boolean, that represent if the id is active or not in the bitfield. + +The json option C controls if all ids between 1 to L will be present on the C or only the ones that are true. + +The json option C change the response, will return an arrayref of all ids active on the bitfield. diff --git a/lib/GDPR/IAB/TCFv2/RangeSection.pm b/lib/GDPR/IAB/TCFv2/RangeSection.pm index ff37d59..3203df5 100644 --- a/lib/GDPR/IAB/TCFv2/RangeSection.pm +++ b/lib/GDPR/IAB/TCFv2/RangeSection.pm @@ -170,9 +170,10 @@ GDPR::IAB::TCFv2::RangeSection - Transparency & Consent String version 2 range s my $max_id_consent = << get 16 bits from $data offset 213 >> my ($range_section, $next_offset) = GDPR::IAB::TCFv2::RangeSection->Parse( - data => $data, - offset => 230, # offset for vendor ranges - max_id => $max_id_consent, + data => $data, + data_size => length($data), + offset => 230, # offset for vendor ranges + max_id => $max_id_consent, ); say "range section contains id 284" if $range_section->contains(284); @@ -230,3 +231,11 @@ Returns the max vendor id. =head2 all Returns an arrayref of all vendors mapped with the bit enabled. + +=head2 TO_JSON + +By default it returns an hashref mapping id to a boolean, that represent if the id is present or not in all ranges sections. + +The json option C controls if all ids between 1 to L will be present on the C or only the ones that are true. + +The json option C change the response, will return an arrayref of all ids present on the ranges section. diff --git a/t/01-parse.t b/t/01-parse.t index 5711445..820902c 100644 --- a/t/01-parse.t +++ b/t/01-parse.t @@ -151,6 +151,10 @@ subtest "valid tcf v2 consent string using bitfield" => sub { ok !$consent->check_publisher_restriction( 1, 0, 284 ), "should have no publisher restriction to vendor 284 regarding purpose id 1 of type 0 'Purpose Flatly Not Allowed by Publisher'"; + my $publisher_tc = $consent->publisher_tc; + + ok !defined($publisher_tc), "should not return publisher_tc"; + done_testing; }; @@ -175,6 +179,37 @@ subtest is $consent->version, 2, 'should return version 2'; + my $publisher_tc = $consent->publisher_tc; + + ok defined($publisher_tc), "should return publisher_tc"; + + is $publisher_tc->num_custom_purposes, 0, + "should not have any custom purposes"; + + subtest "check publisher purpose consent ids" => sub { + plan tests => 24; + + my %allowed_purposes = map { $_ => 1 } ( 2, 4, 6, 8, 9, 10 ); + + foreach my $id ( 1 .. 24 ) { + is !!$publisher_tc->is_purpose_consent_allowed($id), + !!$allowed_purposes{$id}, + "checking publisher purpose id $id for consent"; + } + }; + + subtest "check publisher purpose legitimate interest ids" => sub { + plan tests => 24; + + my %allowed_purposes = map { $_ => 1 } ( 2, 4, 5, 7, 10 ); + + foreach my $id ( 1 .. 24 ) { + is !!$publisher_tc->is_purpose_legitimate_interest_allowed($id), + !!$allowed_purposes{$id}, + "checking publisher purpose id $id for legitimate interest"; + } + }; + done_testing; }; @@ -307,6 +342,10 @@ subtest "valid tcf v2 consent string using range" => sub { ok !$consent->check_publisher_restriction( 1, 0, 284 ), "should have no publisher restriction to vendor 284 regarding purpose id 1 of type 0 'Purpose Flatly Not Allowed by Publisher'"; + my $publisher_tc = $consent->publisher_tc; + + ok !defined($publisher_tc), "should not return publisher_tc"; + done_testing; }; diff --git a/t/02-json.t b/t/02-json.t index 38e2181..4b65d2d 100644 --- a/t/02-json.t +++ b/t/02-json.t @@ -109,7 +109,7 @@ subtest }; -subtest "publisher" => sub { +subtest "publisher section" => sub { my $consent = GDPR::IAB::TCFv2->Parse( 'COwAdDhOwAdDhN4ABAENAPCgAAQAAv___wAAAFP_AAp_4AI6ACACAA', json => { @@ -129,7 +129,35 @@ subtest "publisher" => sub { done_testing; }; +subtest "publisher section with publisher_tc" => sub { + my $consent = GDPR::IAB::TCFv2->Parse( + 'COwAdDhOwAdDhN4ABAENAPCgAAQAAv___wAAAFP_AAp_4AI6ACACAA.argAC0gAAAAAAAAAAAA', + json => { + verbose => 0, + compact => 1, + use_epoch => 0, + boolean_values => [ 0, 1 ], + }, + ); + my $got = $consent->TO_JSON; + my $expected = { + "publisher" => { + "consents" => [ 2, 4, 6, 8, 9, 10 ], + "legitimate_interests" => [ 2, 4, 5, 7, 10 ], + "custom_purposes" => { + "consents" => [], + "legitimate_interests" => [], + }, + "restrictions" => { "7" => { "32" => 1 } } + } + }; + + is_deeply $got->{publisher}, $expected->{publisher}, + "must return the same publisher restriction section"; + + done_testing; +}; subtest "TO_JSON method should return the same hashref " => sub { my $consent = GDPR::IAB::TCFv2->Parse( 'CLcVDxRMWfGmWAVAHCENAXCkAKDAADnAABRgA5mdfCKZuYJez-NQm0TBMYA4oCAAGQYIAAAAAAEAIAEgAA', From fe55804b682c2673b139700c45b464debf0d0ff7 Mon Sep 17 00:00:00 2001 From: Tiago Peczenyj Date: Fri, 15 Dec 2023 16:26:44 +0100 Subject: [PATCH 07/13] add unit tests --- t/01-parse.t | 144 ++++++++++++++++++++++++++++++++++++++++----------- t/02-json.t | 76 +++++++++++++++++++-------- 2 files changed, 168 insertions(+), 52 deletions(-) diff --git a/t/01-parse.t b/t/01-parse.t index 820902c..30cfb76 100644 --- a/t/01-parse.t +++ b/t/01-parse.t @@ -161,53 +161,135 @@ subtest "valid tcf v2 consent string using bitfield" => sub { subtest "valid tcf v2 consent string using bitfield with publisher TC section" => sub { - my $consent; + subtest "without custom purposes" => sub { + my $consent; - my $tc_string = - 'CLcVDxRMWfGmWAVAHCENAXCkAKDAADnAABRgA5mdfCKZuYJez-NQm0TBMYA4oCAAGQYIAAAAAAEAIAEgAA.argAC0gAAAAAAAAAAAA'; - lives_ok { - $consent = GDPR::IAB::TCFv2->Parse($tc_string); - } - 'should not throw exception'; + my $tc_string = + 'CLcVDxRMWfGmWAVAHCENAXCkAKDAADnAABRgA5mdfCKZuYJez-NQm0TBMYA4oCAAGQYIAAAAAAEAIAEgAA.argAC0gAAAAAAAAAAAA'; + lives_ok { + $consent = GDPR::IAB::TCFv2->Parse($tc_string); + } + 'should not throw exception'; - isa_ok $consent, 'GDPR::IAB::TCFv2', 'gdpr iab tcf v2 consent'; + isa_ok $consent, 'GDPR::IAB::TCFv2', 'gdpr iab tcf v2 consent'; - is $consent->tc_string, $tc_string, 'should return the original tc string'; + is $consent->tc_string, $tc_string, + 'should return the original tc string'; - is "${consent}", $tc_string, - 'should return the original tc string in string context'; + is "${consent}", $tc_string, + 'should return the original tc string in string context'; - is $consent->version, 2, 'should return version 2'; + is $consent->version, 2, 'should return version 2'; - my $publisher_tc = $consent->publisher_tc; + my $publisher_tc = $consent->publisher_tc; - ok defined($publisher_tc), "should return publisher_tc"; + ok defined($publisher_tc), "should return publisher_tc"; - is $publisher_tc->num_custom_purposes, 0, - "should not have any custom purposes"; + is $publisher_tc->num_custom_purposes, 0, + "should not have any custom purposes"; - subtest "check publisher purpose consent ids" => sub { - plan tests => 24; + subtest "check publisher purpose consent ids" => sub { + plan tests => 24; - my %allowed_purposes = map { $_ => 1 } ( 2, 4, 6, 8, 9, 10 ); + my %allowed_purposes = map { $_ => 1 } ( 2, 4, 6, 8, 9, 10 ); - foreach my $id ( 1 .. 24 ) { - is !!$publisher_tc->is_purpose_consent_allowed($id), - !!$allowed_purposes{$id}, - "checking publisher purpose id $id for consent"; - } + foreach my $id ( 1 .. 24 ) { + is !!$publisher_tc->is_purpose_consent_allowed($id), + !!$allowed_purposes{$id}, + "checking publisher purpose id $id for consent"; + } + }; + + subtest "check publisher purpose legitimate interest ids" => sub { + plan tests => 24; + + my %allowed_purposes = map { $_ => 1 } ( 2, 4, 5, 7, 10 ); + + foreach my $id ( 1 .. 24 ) { + is !!$publisher_tc->is_purpose_legitimate_interest_allowed( + $id), + !!$allowed_purposes{$id}, + "checking publisher purpose id $id for legitimate interest"; + } + }; + + done_testing; }; - subtest "check publisher purpose legitimate interest ids" => sub { - plan tests => 24; + subtest "with custom purposes" => sub { - my %allowed_purposes = map { $_ => 1 } ( 2, 4, 5, 7, 10 ); + my $consent; - foreach my $id ( 1 .. 24 ) { - is !!$publisher_tc->is_purpose_legitimate_interest_allowed($id), - !!$allowed_purposes{$id}, - "checking publisher purpose id $id for legitimate interest"; + my $tc_string = + 'CLcVDxRMWfGmWAVAHCENAXCkAKDAADnAABRgA5mdfCKZuYJez-NQm0TBMYA4oCAAGQYIAAAAAAEAIAEgAA.YAAAAAAAAXA'; + lives_ok { + $consent = GDPR::IAB::TCFv2->Parse($tc_string); } + 'should not throw exception'; + + isa_ok $consent, 'GDPR::IAB::TCFv2', 'gdpr iab tcf v2 consent'; + + is $consent->tc_string, $tc_string, + 'should return the original tc string'; + + is "${consent}", $tc_string, + 'should return the original tc string in string context'; + + is $consent->version, 2, 'should return version 2'; + + my $publisher_tc = $consent->publisher_tc; + + ok defined($publisher_tc), "should return publisher_tc"; + + is $publisher_tc->num_custom_purposes, 2, + "should have 2 custom purposes"; + + subtest "check publisher purpose consent ids" => sub { + plan tests => 24; + + my %allowed_purposes; + + foreach my $id ( 1 .. 24 ) { + is !!$publisher_tc->is_purpose_consent_allowed($id), + !!$allowed_purposes{$id}, + "checking publisher purpose id $id for consent"; + } + }; + + subtest "check publisher purpose legitimate interest ids" => sub { + plan tests => 24; + + my %allowed_purposes; + + foreach my $id ( 1 .. 24 ) { + is !!$publisher_tc->is_purpose_legitimate_interest_allowed( + $id), + !!$allowed_purposes{$id}, + "checking publisher purpose id $id for legitimate interest"; + } + }; + + + subtest "check publisher custom purpose consent ids" => sub { + plan tests => 2; + + ok $publisher_tc->is_custom_purpose_consent_allowed(1), + "should have custom purpose 1 allowed"; + ok $publisher_tc->is_custom_purpose_consent_allowed(2), + "should have custom purpose 2 allowed"; + }; + + subtest "check publisher custom purpose legitimate interest ids" => + sub { + plan tests => 2; + + ok $publisher_tc->is_custom_purpose_legitimate_interest_allowed(1), + "should have custom purpose 1 allowed"; + ok !$publisher_tc->is_custom_purpose_legitimate_interest_allowed( + 2), "should not have custom purpose 2 allowed"; + }; + + done_testing: }; done_testing; diff --git a/t/02-json.t b/t/02-json.t index 4b65d2d..3cb6f34 100644 --- a/t/02-json.t +++ b/t/02-json.t @@ -130,31 +130,65 @@ subtest "publisher section" => sub { done_testing; }; subtest "publisher section with publisher_tc" => sub { - my $consent = GDPR::IAB::TCFv2->Parse( - 'COwAdDhOwAdDhN4ABAENAPCgAAQAAv___wAAAFP_AAp_4AI6ACACAA.argAC0gAAAAAAAAAAAA', - json => { - verbose => 0, - compact => 1, - use_epoch => 0, - boolean_values => [ 0, 1 ], - }, - ); + subtest "without custom purposes" => sub { + my $consent = GDPR::IAB::TCFv2->Parse( + 'COwAdDhOwAdDhN4ABAENAPCgAAQAAv___wAAAFP_AAp_4AI6ACACAA.argAC0gAAAAAAAAAAAA', + json => { + verbose => 0, + compact => 1, + use_epoch => 0, + boolean_values => [ 0, 1 ], + }, + ); + + my $got = $consent->TO_JSON; + my $expected = { + "publisher" => { + "consents" => [ 2, 4, 6, 8, 9, 10 ], + "legitimate_interests" => [ 2, 4, 5, 7, 10 ], + "custom_purposes" => { + "consents" => [], + "legitimate_interests" => [], + }, + "restrictions" => { "7" => { "32" => 1 } } + } + }; + + is_deeply $got->{publisher}, $expected->{publisher}, + "must return the same publisher restriction section"; + + done_testing; + }; + + subtest "with custom purposes" => sub { + my $consent = GDPR::IAB::TCFv2->Parse( + 'COwAdDhOwAdDhN4ABAENAPCgAAQAAv___wAAAFP_AAp_4AI6ACACAA.YAAAAAAAAXA', + json => { + verbose => 0, + compact => 1, + use_epoch => 0, + boolean_values => [ 0, 1 ], + }, + ); - my $got = $consent->TO_JSON; - my $expected = { - "publisher" => { - "consents" => [ 2, 4, 6, 8, 9, 10 ], - "legitimate_interests" => [ 2, 4, 5, 7, 10 ], - "custom_purposes" => { + my $got = $consent->TO_JSON; + my $expected = { + "publisher" => { "consents" => [], "legitimate_interests" => [], - }, - "restrictions" => { "7" => { "32" => 1 } } - } - }; + "custom_purposes" => { + "consents" => [ 1, 2 ], + "legitimate_interests" => [1], + }, + "restrictions" => { "7" => { "32" => 1 } } + } + }; - is_deeply $got->{publisher}, $expected->{publisher}, - "must return the same publisher restriction section"; + is_deeply $got->{publisher}, $expected->{publisher}, + "must return the same publisher restriction section"; + + done_testing; + }; done_testing; }; From 34f3ec00880806bc71d60a684259aa3aca918baf Mon Sep 17 00:00:00 2001 From: Tiago Peczenyj Date: Fri, 15 Dec 2023 16:37:20 +0100 Subject: [PATCH 08/13] force read the first segment as core string --- lib/GDPR/IAB/TCFv2.pm | 20 +++++++++----------- 1 file changed, 9 insertions(+), 11 deletions(-) diff --git a/lib/GDPR/IAB/TCFv2.pm b/lib/GDPR/IAB/TCFv2.pm index 5bc30dc..a7ec52c 100644 --- a/lib/GDPR/IAB/TCFv2.pm +++ b/lib/GDPR/IAB/TCFv2.pm @@ -434,7 +434,15 @@ sub TO_JSON { sub _decode_tc_string_segments { my $tc_string = shift; - my (@parts) = split CONSENT_STRING_TCF_V2->{SEPARATOR}, $tc_string; + my ( $core, @parts ) = split CONSENT_STRING_TCF_V2->{SEPARATOR}, + $tc_string; + + my $core_data = _validate_and_decode_base64($core); + my $core_data_size = length($core_data) / 8; + + croak + "vendor consent strings are at least @{[ CONSENT_STRING_TCF_V2->{MIN_BYTE_SIZE} ]} bytes long (got ${core_data_size} bytes)" + if $core_data_size < CONSENT_STRING_TCF_V2->{MIN_BYTE_SIZE}; my %segments; @@ -446,19 +454,9 @@ sub _decode_tc_string_segments { $segments{$segment_type} = $decoded; } - croak "missing core section" - unless exists $segments{ SEGMENT_TYPES->{CORE} }; - - my $core_data = $segments{ SEGMENT_TYPES->{CORE} }; my $disclosed_vendors = $segments{ SEGMENT_TYPES->{DISCLOSED_VENDORS} }; my $publisher_tc = $segments{ SEGMENT_TYPES->{PUBLISHER_TC} }; - my $core_data_size = length($core_data) / 8; - - croak - "vendor consent strings are at least @{[ CONSENT_STRING_TCF_V2->{MIN_BYTE_SIZE} ]} bytes long (got ${core_data_size} bytes)" - if $core_data_size < CONSENT_STRING_TCF_V2->{MIN_BYTE_SIZE}; - # return hashref return { core_data => $core_data, From d91a0dd6694b1197b6db9134d18256a0b8ac689a Mon Sep 17 00:00:00 2001 From: Tiago Peczenyj Date: Fri, 15 Dec 2023 16:44:14 +0100 Subject: [PATCH 09/13] verify unit tests --- t/01-parse.t | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/t/01-parse.t b/t/01-parse.t index 30cfb76..d3778e3 100644 --- a/t/01-parse.t +++ b/t/01-parse.t @@ -158,9 +158,10 @@ subtest "valid tcf v2 consent string using bitfield" => sub { done_testing; }; +=pod subtest - "valid tcf v2 consent string using bitfield with publisher TC section" => - sub { + "valid tcf v2 consent string using bitfield with publisher TC section" => sub { + subtest "without custom purposes" => sub { my $consent; @@ -217,7 +218,6 @@ subtest }; subtest "with custom purposes" => sub { - my $consent; my $tc_string = @@ -295,6 +295,8 @@ subtest done_testing; }; +=cut + subtest "valid tcf v2 consent string using range" => sub { my $consent; From 29a787ff476993402169c1ea1b0427a9ded49983 Mon Sep 17 00:00:00 2001 From: Tiago Peczenyj Date: Fri, 15 Dec 2023 16:45:47 +0100 Subject: [PATCH 10/13] narrow unit test --- t/01-parse.t | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/t/01-parse.t b/t/01-parse.t index d3778e3..11ff4a7 100644 --- a/t/01-parse.t +++ b/t/01-parse.t @@ -158,10 +158,12 @@ subtest "valid tcf v2 consent string using bitfield" => sub { done_testing; }; -=pod + subtest - "valid tcf v2 consent string using bitfield with publisher TC section" => sub { + "valid tcf v2 consent string using bitfield with publisher TC section" => + sub { +=pod subtest "without custom purposes" => sub { my $consent; @@ -291,11 +293,11 @@ subtest done_testing: }; +=cut done_testing; }; -=cut subtest "valid tcf v2 consent string using range" => sub { my $consent; From 369e86e17cd1d441142b8e84f04bb5d4bbdbaf0c Mon Sep 17 00:00:00 2001 From: Tiago Peczenyj Date: Fri, 15 Dec 2023 16:47:07 +0100 Subject: [PATCH 11/13] narrow unit test 2 --- t/01-parse.t | 2 ++ 1 file changed, 2 insertions(+) diff --git a/t/01-parse.t b/t/01-parse.t index 11ff4a7..8ea6c02 100644 --- a/t/01-parse.t +++ b/t/01-parse.t @@ -295,6 +295,8 @@ subtest }; =cut +ok 1, "foo"; + done_testing; }; From 08cd89df59fb267150960dbd81b7b3e637bc1e5c Mon Sep 17 00:00:00 2001 From: Tiago Peczenyj Date: Fri, 15 Dec 2023 16:49:38 +0100 Subject: [PATCH 12/13] continue search --- t/01-parse.t | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/t/01-parse.t b/t/01-parse.t index 8ea6c02..9d3cbbc 100644 --- a/t/01-parse.t +++ b/t/01-parse.t @@ -218,6 +218,7 @@ subtest done_testing; }; +=cut subtest "with custom purposes" => sub { my $consent; @@ -293,9 +294,8 @@ subtest done_testing: }; -=cut -ok 1, "foo"; + ok 1, "foo"; done_testing; }; From f3942ee3c7c397d0818efda6460a915e0fda0651 Mon Sep 17 00:00:00 2001 From: Tiago Peczenyj Date: Fri, 15 Dec 2023 16:51:32 +0100 Subject: [PATCH 13/13] fix unit test --- t/01-parse.t | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/t/01-parse.t b/t/01-parse.t index 9d3cbbc..bfd68b5 100644 --- a/t/01-parse.t +++ b/t/01-parse.t @@ -163,7 +163,6 @@ subtest "valid tcf v2 consent string using bitfield with publisher TC section" => sub { -=pod subtest "without custom purposes" => sub { my $consent; @@ -218,7 +217,6 @@ subtest done_testing; }; -=cut subtest "with custom purposes" => sub { my $consent; @@ -292,11 +290,9 @@ subtest 2), "should not have custom purpose 2 allowed"; }; - done_testing: + done_testing; }; - ok 1, "foo"; - done_testing; };