- Timestamp:
- 04/28/22 17:42:39 (3 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/DNSDB.pm
r838 r842 1166 1166 return ('OK','OK'); 1167 1167 } # done SRV record 1168 1169 # CAA record 1170 sub _validate_257 { 1171 my $self = shift; 1172 my $dbh = $self->{dbh}; 1173 1174 my %args = @_; 1175 1176 my $code = 'OK'; 1177 my $msg = ''; # Default to no message, because there are a lot of handwavy warning cases. 1178 1179 if ($args{revrec} eq 'n') { 1180 # Coerce all hostnames to end in ".DOMAIN" for group/default records, 1181 # or the intended parent domain for live records. 1182 my $pname = ($args{defrec} eq 'y' ? 'DOMAIN' : $self->domainName($args{id})); 1183 ${$args{host}} =~ s/\.*$/\.$pname/ if ${$args{host}} !~ /$pname$/i; 1184 1185 my ($caaflag, $caatag, $caadetail) = (${$args{val}} =~ /(\d+)\s+(\w+)\s+(.+)/); 1186 1187 return ('FAIL', "Poorly formed CAA record missing one or more of flag, tag, or detail") 1188 if (!defined($caaflag) || !defined($caatag) || !defined($caadetail)); 1189 1190 # flag is a bitfield, only bit 0 currently has meaning as "Issuer Critical" 1191 # Not 100% clear if this flag is permitted on known tags, or if it's 1192 # semantically null since the known tags are already defined. We'll allow it. 1193 return ('FAIL', "CAA flags other than 0 or 128 not currently supported in DNS") if $caaflag ne '0' && $caaflag ne '128'; 1194 1195 # known tags: 1196 # issue 1197 # issuewild 1198 # iodef (RFC5070) 1199 # auth (reserved, do not use) 1200 # path (reserved, do not use) 1201 # policy (reserved, do not use) 1202 return ('FAIL', "CAA tags may only use a-z, A-Z, and 0-9") if $caatag !~ /^[a-zA-Z0-9]+$/; 1203 return ('FAIL', "Can't use reserved CAA tag '$caatag'") if $caatag =~ /^(?:auth|path|policy)$/; 1204 if ($caatag !~ /^(?:issue|issuewild|iodef)$/) { 1205 $code = 'WARN'; 1206 $msg = ($msg ? $msg." " : '')."Unknown CAA tag '$caatag' will be published as-is."; 1207 } 1208 if (length($caatag) > 15) { 1209 $code = 'WARN'; 1210 $msg = ($msg ? $msg." " : '').'Custom CAA tag > 15 characters may not behave as intended.'; 1211 } 1212 1213 if ($caatag eq 'issue' || $caatag eq 'issuewild') { 1214 # Detail format is possibly as complex as: 1215 # [;|cert-authority [; key=value[ key=value ...]] 1216 # but arguably a strict reading says there can only be one key, and the 1217 # rest of the string after first = is the value, even if it appears to 1218 # contain extra key=value pairs. 1219 # See https://datatracker.ietf.org/doc/html/rfc6844 for full ABNF definition. 1220 # Either way all we need to validate is that it's within the specified characters. 1221 if ($caadetail eq ';') { 1222 # No certs permitted 1223 } else { 1224 my ($certauth,$remainder) = ($caadetail =~ /^\s*([a-zA-Z0-9.-]+)\s*((?:;|\s|$).*)?$/); 1225 if (!$certauth) { 1226 # We can't reasonably validate individual domains, just that it's well-formed 1227 return ('FAIL', "CAA authority domain must be a valid domain name"); 1228 } 1229 if ($remainder) { 1230 return ('FAIL', "CAA authority domain and optional key=value entry or entries must be separated by a ';'") 1231 if $remainder !~ /^\s*;/; 1232 $remainder =~ s/\s*;\s*//; 1233 # Just validate the characters in the remainder. Any details are CA-specific and not sanely validateable. 1234 return ('FAIL', "Invalid characters in optional key=value entry or entries") 1235 if $remainder !~ /^[a-zA-Z0-9]+\s*=[\x21-\x7e\s]+$/; 1236 } 1237 } 1238 } # issue/isseuewild 1239 1240 elsif ($caatag eq 'iodef') { 1241 # Two valid forms: 1242 # mailto:address@example.com 1243 # http://iodef.example.com/ 1244 # RFC seems a little handwavy whether https:// is valid or not, but the chained 1245 # RFC for the HTTP-based reporting protocol says that this should be assumed to 1246 # be a dedicated port (4590) and service, requiring TLS. Allowing https:// per 1247 # the detail description in https://datatracker.ietf.org/doc/html/rfc6844#section-5.4. 1248 return ('FAIL', "iodef tag data must reference a mailto: or http: URI") if $caadetail !~ /^(mailto|https?):/; 1249 if ($1 eq 'mailto') { 1250 # not going full RFC on validating form, just "reasonably sane" 1251 return ('FAIL', "Poorly formed email for iodef tag") if $caadetail !~ /^mailto:[^\s]+\@[a-zA-z0-9._-]+$/ 1252 } else { 1253 return ('FAIL', "Poorly formed URI for iodef tag") if $caadetail !~ m,^https?://[a-zA-z0-9._-]+/?$, 1254 } 1255 } # iodef 1256 1257 } else { 1258 # CAA records don't make much sense in reverse zones 1259 return ('FAIL', "CAA records not supported in reverse zones"); 1260 } 1261 1262 # Allow CAA records in default record sets for now, but it's a bit iffy 1263 # whether this makes any sense. Not nice to publish a default "issue ;" 1264 # record, then go through a support mess trying to figure out why a 1265 # customer can't register a cert somewhere. 1266 # if ($args{defrec} eq 'n') { 1267 # } else { 1268 # } 1269 1270 return ($code, $msg); 1271 } # done CAA record 1272 1168 1273 1169 1274 # Now the custom types … … 5943 6048 $warnmsg .= "Suspect record '".$rr->string."' may not be imported correctly: SRV records may not be bare IP addresses\n" 5944 6049 if $val =~ /^(?:(?:\d+\.){3}\d+|[a-fA-F0-9:]+)$/; 5945 } elsif ($type eq 'KEY') { 6050 } 6051 6052 elsif ($type eq 'CAA') { 6053 # Store CAA records without the syntactic quotes 6054 $val = join(" ", $rr->flags, $rr->tag, $rr->value); 6055 } 6056 6057 elsif ($type eq 'KEY') { 5946 6058 # we don't actually know what to do with these... 5947 6059 $val = $rr->flags.":".$rr->protocol.":".$rr->algorithm.":".$rr->key.":".$rr->keytag.":".$rr->privatekeyname; … … 6835 6947 } # SRV 6836 6948 6949 elsif ($typemap{$type} eq 'CAA') { 6950 # CAA records really don't make much sense in reverse zones 6951 #($host,$val) = __revswap($host,$val) if $revrec eq 'y'; 6952 return if $revrec eq 'y'; 6953 6954 # data is a bitfield byte, length byte+string, then "everything else" 6955 6956 my $prefix = ":$host:257:"; 6957 6958 my ($caaflags, $caatag, $caadetail) = ($val =~ /(\d+)\s+(\w+)\s+(.+)/); 6959 $prefix .= sprintf "\\%0.3o", $caaflags; 6960 $prefix .= sprintf "\\%0.3o%s", length($caatag), $caatag; 6961 $caadetail =~ s/:/\\072/g; 6962 $caadetail =~ s/;/\\073/g; # Not strictly necessary but may be helpful validating records by eye 6963 $caadetail =~ s/^\s*"\s*//; # AXFR imports may produce strings with embedded quotes; these 6964 $caadetail =~ s/\s*"\s*$//; # are purely a syntactic crutch for BIND-style zone files 6965 print $datafile "$prefix$caadetail:$ttl:$stamp:$loc\n" or die $!; 6966 } # CAA 6967 6837 6968 elsif ($typemap{$type} eq 'RP') { 6838 6969 ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
Note:
See TracChangeset
for help on using the changeset viewer.