diff --git a/.github/workflows/macos.yml b/.github/workflows/macos.yml index d8a1b8e..d7a342a 100644 --- a/.github/workflows/macos.yml +++ b/.github/workflows/macos.yml @@ -1,11 +1,8 @@ name: macos + on: - push: - branches: - - '*' - tags-ignore: - - '*' - pull_request: + - push + jobs: perl: runs-on: macOS-latest diff --git a/.github/workflows/perltidy.yml b/.github/workflows/perltidy.yml index 080f484..fe553f0 100644 --- a/.github/workflows/perltidy.yml +++ b/.github/workflows/perltidy.yml @@ -1,11 +1,8 @@ name: perltidy + on: - push: - branches: - - '*' - tags-ignore: - - '*' - pull_request: + - push + jobs: perltidy: runs-on: ubuntu-latest diff --git a/.github/workflows/windows.yml b/.github/workflows/windows.yml index be2184d..bf32b52 100644 --- a/.github/workflows/windows.yml +++ b/.github/workflows/windows.yml @@ -1,11 +1,8 @@ name: windows + on: - push: - branches: - - '*' - tags-ignore: - - '*' - pull_request: + - push + jobs: perl: runs-on: windows-latest diff --git a/Changes b/Changes index b37d15c..c72f9ce 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,7 @@ +0.100 + - parse publisher tc section if available + - add strict mode (disabled by default) to validate the consent string version + 0.084 - fix a bug while parsing valid consent strings range-based, see https://github.com/peczenyj/GDPR-IAB-TCFv2/issues/20 diff --git a/MANIFEST b/MANIFEST index 71667e2..90466be 100644 --- a/MANIFEST +++ b/MANIFEST @@ -7,7 +7,9 @@ lib/GDPR/IAB/TCFv2/BitUtils.pm lib/GDPR/IAB/TCFv2/Constants/Purpose.pm lib/GDPR/IAB/TCFv2/Constants/RestrictionType.pm lib/GDPR/IAB/TCFv2/Constants/SpecialFeature.pm +lib/GDPR/IAB/TCFv2/Publisher.pm lib/GDPR/IAB/TCFv2/PublisherRestrictions.pm +lib/GDPR/IAB/TCFv2/PublisherTC.pm lib/GDPR/IAB/TCFv2/RangeSection.pm LICENSE Makefile.PL diff --git a/README.pod b/README.pod index 0b64e1a..2b7df78 100644 --- a/README.pod +++ b/README.pod @@ -26,7 +26,7 @@ GDPR::IAB::TCFv2 - Transparency & Consent String version 2 parser =head1 VERSION -Version 0.084 +Version 0.100 =head1 SYNOPSIS @@ -113,9 +113,10 @@ or boolean_values => [ 0, 1 ], date_format => '%Y%m%d', # yyymmdd }, + strict => 1, ); -Parse may receive an optional hash parameter C with the following properties: +Parse may receive an optional hash of parameters: C (boolean) and C (hashref with the following properties): =over @@ -149,6 +150,10 @@ except if the option C is true. =back +On C mode we will validate if the version of the consent string is the version 2 (or die with an exception). + +The C mode is disabled by default. + =head1 METHODS =head2 tc_string @@ -335,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. @@ -351,7 +362,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 @@ -380,6 +391,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 71a02ab..e82d769 100644 --- a/lib/GDPR/IAB/TCFv2.pm +++ b/lib/GDPR/IAB/TCFv2.pm @@ -12,46 +12,52 @@ use POSIX qw; use GDPR::IAB::TCFv2::BitField; 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"; +our $VERSION = "0.100"; use constant { - CONSENT_STRING_TCF2_SEPARATOR => '.', - CONSENT_STRING_TCF2_PREFIX => 'C', - MIN_BYTE_SIZE => 29, - TCF_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', - - VERSION_OFFSET => 0, - CREATED_OFFSET => 6, - LAST_UPDATED_OFFSET => 42, - CMP_ID_OFFSET => 78, - CMP_VERSION_OFFSET => 90, - CONSENT_SCREEN_OFFSET => 102, - CONSENT_LANGUAGE_OFFSET => 108, - VENDOR_LIST_VERSION_OFFSET => 120, - POLICY_VERSION_OFFSET => 132, - SERVICE_SPECIFIC_OFFSET => 138, - USE_NON_STANDARD_STACKS_OFFSET => 139, - SPECIAL_FEATURE_OPT_IN_OFFSET => 140, - PURPOSE_CONSENT_ALLOWED_OFFSET => 152, - PURPOSE_LIT_ALLOWED_OFFSET => 176, - PURPOSE_ONE_TREATMENT_OFFSET => 200, - PUBLISHER_COUNTRY_CODE_OFFSET => 201, - MAX_VENDOR_ID_CONSENT_OFFSET => 213, - VENDOR_CONSENT_RANGE_ENCODING_OFFSET => 229, - VENDOR_CONSENT_OFFSET => 230, + CONSENT_STRING_TCF_V2 => { + SEPARATOR => quotemeta q<.>, + PREFIX => q, + MIN_BYTE_SIZE => 29, + }, + EXPECTED_TCF_V2_VERSION => 2, + MAX_SPECIAL_FEATURE_ID => 12, + MAX_PURPOSE_ID => 24, + DATE_FORMAT_ISO_8601 => '%Y-%m-%dT%H:%M:%SZ', + SEGMENT_TYPES => { + CORE => 0, + PUBLISHER_TC => 3, + }, + OFFSETS => { + SEGMENT_TYPE => 0, + VERSION => 0, + CREATED => 6, + LAST_UPDATED => 42, + CMP_ID => 78, + CMP_VERSION => 90, + CONSENT_SCREEN => 102, + CONSENT_LANGUAGE => 108, + VENDOR_LIST_VERSION => 120, + POLICY_VERSION => 132, + SERVICE_SPECIFIC => 138, + USE_NON_STANDARD_STACKS => 139, + SPECIAL_FEATURE_OPT_IN => 140, + PURPOSE_CONSENT_ALLOWED => 152, + PURPOSE_LIT_ALLOWED => 176, + PURPOSE_ONE_TREATMENT => 200, + PUBLISHER_COUNTRY_CODE => 201, + VENDOR_CONSENT => 213, + }, }; use overload q<""> => \&tc_string; @@ -88,57 +94,39 @@ sub Parse { croak 'missing gdpr consent string' unless $tc_string; - my $core_tc_string = _get_core_tc_string($tc_string); + my $segments = _decode_tc_string_segments($tc_string); - my $data = unpack 'B*', _validate_and_decode_base64($core_tc_string); - my $data_size = length($data); - - croak "vendor consent strings are at least @{[ MIN_BYTE_SIZE ]} bytes long" - if $data_size < 8 * MIN_BYTE_SIZE; + my $strict = !!$opts{strict}; my %options = ( - json => $opts{json} || {}, + json => $opts{json} || {}, + strict => $strict, ); $options{json}->{date_format} ||= DATE_FORMAT_ISO_8601; $options{json}->{boolean_values} ||= [ _json_false(), _json_true() ]; my $self = { - data => $data, - options => \%options, - tc_string => $tc_string, - vendor_consents => undef, - legitimate_interest_max_vendor => undef, - vendor_legitimate_interests => undef, - publisher_restrictions => undef, + core_data => $segments->{core_data}, + publisher_tc_data => $segments->{publisher_tc}, + options => \%options, + tc_string => $tc_string, + + vendor_consents => undef, + vendor_legitimate_interests => undef, + publisher => undef, }; bless $self, $klass; - croak "consent string is not tcf version @{[ TCF_VERSION ]}" - unless $self->version == TCF_VERSION; + croak "consent string is not tcf version @{[ EXPECTED_TCF_V2_VERSION ]}" + if $strict && $self->version != EXPECTED_TCF_V2_VERSION; croak 'invalid vendor list version' if $self->vendor_list_version == 0; - # parse vendor section - # parse vendor consent - - my $legitimate_interest_offset = $self->_parse_vendor_consents(); - - # parse vendor legitimate interest - - my $pub_restrict_offset = - $self->_parse_vendor_legitimate_interests($legitimate_interest_offset); - - # parse publisher section + my $next_offset = $self->_parse_vendor_section(); - # parse publisher restrictions from section core string - - $self->_parse_publisher_restrictions($pub_restrict_offset); - - # TODO parse section disclosed vendors if available - - # TODO parse section publisher_tc if available + $self->_parse_publisher_section($next_offset); return $self; } @@ -152,13 +140,13 @@ sub tc_string { sub version { my $self = shift; - return scalar( get_uint6( $self->{data}, VERSION_OFFSET ) ); + return scalar( get_uint6( $self->{core_data}, OFFSETS->{VERSION} ) ); } sub created { my $self = shift; - my ( $seconds, $nanoseconds ) = $self->_get_epoch(CREATED_OFFSET); + my ( $seconds, $nanoseconds ) = $self->_get_epoch( OFFSETS->{CREATED} ); return wantarray ? ( $seconds, $nanoseconds ) : $seconds; } @@ -166,7 +154,8 @@ sub created { sub last_updated { my $self = shift; - my ( $seconds, $nanoseconds ) = $self->_get_epoch(LAST_UPDATED_OFFSET); + my ( $seconds, $nanoseconds ) = + $self->_get_epoch( OFFSETS->{LAST_UPDATED} ); return wantarray ? ( $seconds, $nanoseconds ) : $seconds; } @@ -174,7 +163,7 @@ sub last_updated { sub _get_epoch { my ( $self, $offset ) = @_; - my $deciseconds = scalar( get_uint36( $self->{data}, $offset ) ); + my $deciseconds = scalar( get_uint36( $self->{core_data}, $offset ) ); return ( ( $deciseconds / 10 ), @@ -185,49 +174,57 @@ sub _get_epoch { sub cmp_id { my $self = shift; - return scalar( get_uint12( $self->{data}, CMP_ID_OFFSET ) ); + return scalar( get_uint12( $self->{core_data}, OFFSETS->{CMP_ID} ) ); } sub cmp_version { my $self = shift; - return scalar( get_uint12( $self->{data}, CMP_VERSION_OFFSET ) ); + return scalar( get_uint12( $self->{core_data}, OFFSETS->{CMP_VERSION} ) ); } sub consent_screen { my $self = shift; - return scalar( get_uint6( $self->{data}, CONSENT_SCREEN_OFFSET ) ); + return + scalar( get_uint6( $self->{core_data}, OFFSETS->{CONSENT_SCREEN} ) ); } sub consent_language { my $self = shift; - return scalar( get_char6_pair( $self->{data}, CONSENT_LANGUAGE_OFFSET ) ); + return + scalar( + get_char6_pair( $self->{core_data}, OFFSETS->{CONSENT_LANGUAGE} ) ); } sub vendor_list_version { my $self = shift; - return scalar( get_uint12( $self->{data}, VENDOR_LIST_VERSION_OFFSET ) ); + return + scalar( + get_uint12( $self->{core_data}, OFFSETS->{VENDOR_LIST_VERSION} ) ); } sub policy_version { my $self = shift; - return scalar( get_uint6( $self->{data}, POLICY_VERSION_OFFSET ) ); + return + scalar( get_uint6( $self->{core_data}, OFFSETS->{POLICY_VERSION} ) ); } sub is_service_specific { my $self = shift; - return scalar( is_set( $self->{data}, SERVICE_SPECIFIC_OFFSET ) ); + return scalar( is_set( $self->{core_data}, OFFSETS->{SERVICE_SPECIFIC} ) ); } sub use_non_standard_stacks { my $self = shift; - return scalar( is_set( $self->{data}, USE_NON_STANDARD_STACKS_OFFSET ) ); + return + scalar( + is_set( $self->{core_data}, OFFSETS->{USE_NON_STANDARD_STACKS} ) ); } sub is_special_feature_opt_in { @@ -243,9 +240,11 @@ sub is_special_feature_opt_in { sub _safe_is_special_feature_opt_in { my ( $self, $id ) = @_; - return - scalar( - is_set( $self->{data}, SPECIAL_FEATURE_OPT_IN_OFFSET + $id - 1 ) ); + return scalar( + is_set( + $self->{core_data}, OFFSETS->{SPECIAL_FEATURE_OPT_IN} + $id - 1 + ) + ); } sub is_purpose_consent_allowed { @@ -259,9 +258,11 @@ sub is_purpose_consent_allowed { sub _safe_is_purpose_consent_allowed { my ( $self, $id ) = @_; - return - scalar( - is_set( $self->{data}, PURPOSE_CONSENT_ALLOWED_OFFSET + $id - 1 ) ); + return scalar( + is_set( + $self->{core_data}, OFFSETS->{PURPOSE_CONSENT_ALLOWED} + $id - 1 + ) + ); } sub is_purpose_legitimate_interest_allowed { @@ -277,32 +278,38 @@ sub _safe_is_purpose_legitimate_interest_allowed { my ( $self, $id ) = @_; return - scalar( is_set( $self->{data}, PURPOSE_LIT_ALLOWED_OFFSET + $id - 1 ) ); + scalar( + is_set( $self->{core_data}, OFFSETS->{PURPOSE_LIT_ALLOWED} + $id - 1 ) + ); } sub purpose_one_treatment { my $self = shift; - return scalar( is_set( $self->{data}, PURPOSE_ONE_TREATMENT_OFFSET ) ); + return + scalar( is_set( $self->{core_data}, OFFSETS->{PURPOSE_ONE_TREATMENT} ) ); } sub publisher_country_code { my $self = shift; - return - scalar( get_char6_pair( $self->{data}, PUBLISHER_COUNTRY_CODE_OFFSET ) ); + return scalar( + get_char6_pair( + $self->{core_data}, OFFSETS->{PUBLISHER_COUNTRY_CODE} + ) + ); } sub max_vendor_id_consent { my $self = shift; - return scalar( get_uint16( $self->{data}, MAX_VENDOR_ID_CONSENT_OFFSET ) ); + return $self->{vendor_consents}->max_id; } sub max_vendor_id_legitimate_interest { my $self = shift; - return $self->{legitimate_interest_max_vendor}; + return $self->{vendor_legitimate_interests}->max_id; } sub vendor_consent { @@ -320,8 +327,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 publisher_tc { + my $self = shift; + + return $self->{publisher}->publisher_tc; } sub _format_date { @@ -410,106 +423,39 @@ sub TO_JSON { legitimate_interests => $self->{vendor_legitimate_interests}->TO_JSON, }, - publisher => { - restrictions => $self->{publisher_restrictions}->TO_JSON, - }, + publisher => $self->{publisher}->TO_JSON, }; } +sub _decode_tc_string_segments { + my $tc_string = shift; -sub _parse_vendor_consents { - my $self = shift; - - my ( $vendor_consents, $legitimate_interest_offset ); - - if ( $self->_is_vendor_consent_range_encoding ) { - ( $vendor_consents, $legitimate_interest_offset ) = - $self->_parse_range_section( - $self->max_vendor_id_consent, - VENDOR_CONSENT_OFFSET - ); - } - else { - ( $vendor_consents, $legitimate_interest_offset ) = - $self->_parse_bitfield( - $self->max_vendor_id_consent, - VENDOR_CONSENT_OFFSET - ); - } - - $self->{vendor_consents} = $vendor_consents; - - return $legitimate_interest_offset; -} - -sub _parse_vendor_legitimate_interests { - my ( $self, $legitimate_interest_offset ) = @_; - - my ($legitimate_interest_max_vendor, - $is_vendor_legitimate_interest_range_offset - ) = get_uint16( $self->{data}, $legitimate_interest_offset ); - - $self->{legitimate_interest_max_vendor} = $legitimate_interest_max_vendor; + my ( $core, @parts ) = split CONSENT_STRING_TCF_V2->{SEPARATOR}, + $tc_string; - my $data_size = length( $self->{data} ); + my $core_data = _validate_and_decode_base64($core); + my $core_data_size = length($core_data) / 8; croak - "invalid consent data: no legitimate interest start position (got $is_vendor_legitimate_interest_range_offset but $data_size)" - if $is_vendor_legitimate_interest_range_offset > $data_size; + "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 ($is_vendor_legitimate_interest_range, - $vendor_legitimate_interests_offset - ) = is_set( $self->{data}, $is_vendor_legitimate_interest_range_offset ); + my %segments; - my ( $vendor_legitimate_interests, $pub_restrict_offset ); + foreach my $part (@parts) { + my $decoded = _validate_and_decode_base64($part); - if ($is_vendor_legitimate_interest_range) { - ( $vendor_legitimate_interests, $pub_restrict_offset ) = - $self->_parse_range_section( - $self->max_vendor_id_legitimate_interest, - $vendor_legitimate_interests_offset - ); - } - else { - ( $vendor_legitimate_interests, $pub_restrict_offset ) = - $self->_parse_bitfield( - $self->max_vendor_id_legitimate_interest, - $vendor_legitimate_interests_offset - ); - } - - $self->{vendor_legitimate_interests} = $vendor_legitimate_interests; - - return $pub_restrict_offset; -} - -sub _parse_publisher_restrictions { - my ( $self, $pub_restrict_offset ) = @_; - - my $data = - substr( $self->{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->{data} ), - max_id => ASSUMED_MAX_VENDOR_ID, - options => $self->{options}, - ); + my $segment_type = get_uint3( $decoded, OFFSETS->{SEGMENT_TYPE} ); - $self->{publisher_restrictions} = $publisher_restrictions; - - return $pub_restrict_offset + $relative_next_offset; -} - -sub _get_core_tc_string { - my $tc_string = shift; - - my $pos = index( $tc_string, CONSENT_STRING_TCF2_SEPARATOR ); + $segments{$segment_type} = $decoded; + } - return $tc_string if $pos < 0; + my $publisher_tc = $segments{ SEGMENT_TYPES->{PUBLISHER_TC} }; - return substr( $tc_string, 0, $pos ); + return { + core_data => $core_data, + publisher_tc => $publisher_tc, + }; } sub _validate_and_decode_base64 { @@ -527,7 +473,7 @@ sub _validate_and_decode_base64 { \z }x; - return _decode_base64url($s); + return unpack 'B*', _decode_base64url($s); } sub _decode_base64url { @@ -537,22 +483,106 @@ sub _decode_base64url { return decode_base64($s); } -sub _is_vendor_consent_range_encoding { +sub _parse_vendor_section { my $self = shift; - return - scalar( is_set( $self->{data}, VENDOR_CONSENT_RANGE_ENCODING_OFFSET ) ); + # parse vendor consent + + my $legitimate_interest_offset = + $self->_parse_vendor_consents( OFFSETS->{VENDOR_CONSENT} ); + + # parse vendor legitimate interest + + my $pub_restrict_offset = + $self->_parse_vendor_legitimate_interests($legitimate_interest_offset); + + return $pub_restrict_offset; +} + +sub _parse_vendor_consents { + my ( $self, $vendor_consent_offset ) = @_; + + my ( $vendor_consents, $legitimate_interest_offset ) = + $self->_parse_bitfield_or_range( + $vendor_consent_offset, + ); + + $self->{vendor_consents} = $vendor_consents; + + return $legitimate_interest_offset; +} + +sub _parse_vendor_legitimate_interests { + my ( $self, $legitimate_interest_offset ) = @_; + + my ( $vendor_legitimate_interests, $pub_restrict_offset ) = + $self->_parse_bitfield_or_range( + $legitimate_interest_offset, + ); + + $self->{vendor_legitimate_interests} = $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_bitfield_or_range { + my ( $self, $offset ) = @_; + + my $something; + + my ( $max_id, $next_offset ) = get_uint16( $self->{core_data}, $offset ); + + my $is_range; + + ( $is_range, $next_offset ) = is_set( + $self->{core_data}, + $next_offset, + ); + + if ($is_range) { + ( $something, $next_offset ) = $self->_parse_range_section( + $max_id, + $next_offset, + ); + } + else { + ( $something, $next_offset ) = $self->_parse_bitfield( + $max_id, + $next_offset, + ); + } + + return wantarray ? ( $something, $next_offset ) : $something; } sub _parse_range_section { my ( $self, $max_id, $range_section_start_offset ) = @_; - my $data = substr( $self->{data}, $range_section_start_offset ); + my $data = substr( $self->{core_data}, $range_section_start_offset ); + my $data_size = length( $self->{core_data} ); my ( $range_section, $next_offset ) = GDPR::IAB::TCFv2::RangeSection->Parse( data => $data, - data_size => length( $self->{data} ), + data_size => $data_size, offset => 0, max_id => $max_id, options => $self->{options}, @@ -567,11 +597,12 @@ sub _parse_range_section { sub _parse_bitfield { my ( $self, $max_id, $bitfield_start_offset ) = @_; - my $data = substr( $self->{data}, $bitfield_start_offset, $max_id ); + my $data = substr( $self->{core_data}, $bitfield_start_offset, $max_id ); + my $data_size = length( $self->{core_data} ); my ( $bitfield, $next_offset ) = GDPR::IAB::TCFv2::BitField->Parse( data => $data, - data_size => length( $self->{data} ), + data_size => $data_size, max_id => $max_id, options => $self->{options}, ); @@ -586,7 +617,8 @@ sub looksLikeIsConsentVersion2 { return unless defined $gdpr_consent_string; - return rindex( $gdpr_consent_string, CONSENT_STRING_TCF2_PREFIX, 0 ) == 0; + return + rindex( $gdpr_consent_string, CONSENT_STRING_TCF_V2->{PREFIX}, 0 ) == 0; } 1; @@ -620,7 +652,7 @@ GDPR::IAB::TCFv2 - Transparency & Consent String version 2 parser =head1 VERSION -Version 0.084 +Version 0.100 =head1 SYNOPSIS @@ -707,9 +739,10 @@ or boolean_values => [ 0, 1 ], date_format => '%Y%m%d', # yyymmdd }, + strict => 1, ); -Parse may receive an optional hash parameter C with the following properties: +Parse may receive an optional hash of parameters: C (boolean) and C (hashref with the following properties): =over @@ -743,6 +776,10 @@ except if the option C is true. =back +On C mode we will validate if the version of the consent string is the version 2 (or die with an exception). + +The C mode is disabled by default. + =head1 METHODS =head2 tc_string @@ -929,6 +966,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. @@ -945,7 +988,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 @@ -974,6 +1017,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/BitField.pm b/lib/GDPR/IAB/TCFv2/BitField.pm index 48a2f00..8de6239 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}; @@ -41,6 +42,12 @@ sub Parse { return ( $self, $offset + $max_id ); } +sub max_id { + my $self = shift; + + return $self->{max_id}; +} + sub contains { my ( $self, $id ) = @_; @@ -74,24 +81,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__ @@ -106,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: + +=over + +=item * + +Key C is the binary data + +=item * + +Key C is the original binary data size -Will die if any parameter is missing. +=item * -Will die if data does not contain all bits required. +Key C is the max id (used to validate the ranges if all data is between 1 and C) -Will return an array of two elements: the object itself and the next offset. +=item * + +Key C is the L options (includes the C field to modify the L method output. + +=back =head1 METHODS @@ -139,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/BitUtils.pm b/lib/GDPR/IAB/TCFv2/BitUtils.pm index 7231b7e..7d462d9 100644 --- a/lib/GDPR/IAB/TCFv2/BitUtils.pm +++ b/lib/GDPR/IAB/TCFv2/BitUtils.pm @@ -22,6 +22,7 @@ BEGIN { our @EXPORT_OK = 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} + ->check_restriction( $purpose_id, $restrict_type, $vendor ); +} + +sub publisher_tc { + my ( $self, $callback ) = @_; + + return $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; +__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 91697fc..f77826f 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, ); @@ -61,10 +63,10 @@ sub Parse { bless $self, $klass; - return wantarray ? ( $self, $next_offset ) : $self; + return $self; } -sub contains { +sub check_restriction { my ( $self, $purpose_id, $restrict_type, $vendor ) = @_; return 0 @@ -107,32 +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 + +=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. -Will die if it is undefined. +=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); + $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 new file mode 100644 index 0000000..a3ddeb9 --- /dev/null +++ b/lib/GDPR/IAB/TCFv2/PublisherTC.pm @@ -0,0 +1,312 @@ +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_purposes => { + 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 ) + ); +} + +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 fe5611c..3203df5 100644 --- a/lib/GDPR/IAB/TCFv2/RangeSection.pm +++ b/lib/GDPR/IAB/TCFv2/RangeSection.pm @@ -97,6 +97,12 @@ sub _parse_range { return [ $vendor_id, $vendor_id ], $next_offset; } +sub max_id { + my $self = shift; + + return $self->{max_id}; +} + sub contains { my ( $self, $id ) = @_; @@ -164,16 +170,41 @@ 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, ); - 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. @@ -200,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/00-load.t b/t/00-load.t index 54e7870..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; }; diff --git a/t/01-parse.t b/t/01-parse.t index 8f392b1..bfd68b5 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); } @@ -151,9 +151,152 @@ 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; }; + +subtest + "valid tcf v2 consent string using bitfield with publisher TC section" => + sub { + + 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'; + + 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, 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; + }; + + subtest "with custom purposes" => sub { + my $consent; + + 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; + }; + + subtest "valid tcf v2 consent string using range" => sub { my $consent; @@ -283,6 +426,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; }; @@ -389,12 +536,21 @@ subtest "invalid tcf consent string candidates" => sub { } qr/missing gdpr consent string/, 'empty consent string should throw error'; + lives_ok { + my $consent = GDPR::IAB::TCFv2->Parse( + "BOEFEAyOEFEAyAHABDENAI4AAAB9vABAASAAAAAAAAAA"); + + is $consent->version, 1, "tcf v1"; + + } + 'valid tcf v1 consent string should now throw error without strict flag'; + throws_ok { GDPR::IAB::TCFv2->Parse( - "BOEFEAyOEFEAyAHABDENAI4AAAB9vABAASAAAAAAAAAA"); + "BOEFEAyOEFEAyAHABDENAI4AAAB9vABAASAAAAAAAAAA", strict => 1 ); } qr/consent string is not tcf version 2/, - 'valid tcf v1 consent string should throw error (deprecated)'; + 'valid tcf v1 consent string should throw error with strict flag'; throws_ok { GDPR::IAB::TCFv2->Parse("Clc"); @@ -402,12 +558,19 @@ subtest "invalid tcf consent string candidates" => sub { qr/vendor consent strings are at least 29 bytes long/, 'short (less than 29 bytes) tcf v2 consent string should throw error'; + lives_ok { + my $consent = GDPR::IAB::TCFv2->Parse( + "DOEFEAyOEFEAyAHABDENAI4AAAB9vABAASAAAAAAAAAA", strict => 0 ); + is $consent->version, 3, "tcf v3"; + } + 'possible tcf v3 consent string should not throw error without strict flag'; + throws_ok { GDPR::IAB::TCFv2->Parse( - "DOEFEAyOEFEAyAHABDENAI4AAAB9vABAASAAAAAAAAAA"); + "DOEFEAyOEFEAyAHABDENAI4AAAB9vABAASAAAAAAAAAA", strict => 1 ); } qr/consent string is not tcf version 2/, - 'possible tcf v3 consent string should throw error'; + 'possible tcf v3 consent string should throw error with strict flag'; throws_ok { GDPR::IAB::TCFv2->Parse( diff --git a/t/02-json.t b/t/02-json.t index 191e5e8..3cb6f34 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, @@ -109,7 +109,7 @@ subtest }; -subtest "publisher" => sub { +subtest "publisher section" => sub { my $consent = GDPR::IAB::TCFv2->Parse( 'COwAdDhOwAdDhN4ABAENAPCgAAQAAv___wAAAFP_AAp_4AI6ACACAA', json => { @@ -129,10 +129,72 @@ subtest "publisher" => sub { done_testing; }; +subtest "publisher section with publisher_tc" => sub { + 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" => [], + "legitimate_interests" => [], + "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"; + + done_testing; + }; + + done_testing; +}; 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 +223,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 +337,7 @@ sub _fixture_default { return { 'tc_string' => - 'CLcVDxRMWfGmWAVAHCENAXCkAKDAADnAABRgA5mdfCKZuYJez-NQm0TBMYA4oCAAGQYIAAAAAAEAIAEgAA.argAC0gAAAAAAAAAAAA', + 'CLcVDxRMWfGmWAVAHCENAXCkAKDAADnAABRgA5mdfCKZuYJez-NQm0TBMYA4oCAAGQYIAAAAAAEAIAEgAA', 'consent_language' => 'EN', 'purpose' => { 'consents' => { @@ -393,7 +455,7 @@ sub _fixture_verbose { return { 'tc_string' => - 'CLcVDxRMWfGmWAVAHCENAXCkAKDAADnAABRgA5mdfCKZuYJez-NQm0TBMYA4oCAAGQYIAAAAAAEAIAEgAA.argAC0gAAAAAAAAAAAA', + 'CLcVDxRMWfGmWAVAHCENAXCkAKDAADnAABRgA5mdfCKZuYJez-NQm0TBMYA4oCAAGQYIAAAAAAEAIAEgAA', 'consent_language' => 'EN', 'purpose' => { 'consents' => {