1---------------------------------------------------------------- 2-- IRONSIDES - DNS SERVER 3-- 4-- By: Martin C. Carlisle and Barry S. Fagin 5-- Department of Computer Science 6-- United States Air Force Academy 7-- 8-- This is free software; you can redistribute it and/or 9-- modify without restriction. We do ask that you please keep 10-- the original author information, and clearly indicate if the 11-- software has been modified. 12-- 13-- This software is distributed in the hope that it will be useful, 14-- but WITHOUT ANY WARRANTY; without even the implied warranty 15-- of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 16---------------------------------------------------------------- 17 18WITH Dns_Types, Dns_Table_Pkg, Parser_Utilities, Process_First_Line_Of_Record, Zone_File_Parser, 19 error_msgs, unsigned_types, rr_type; 20with Rr_Type.Dnskey_Record_Type, Rr_type.rrsig_record_type, Rr_Type.Soa_Record_Type; 21WITH Spark.Ada.Text_IO; 22 23use type Rr_Type.RrItemType; 24use type dns_types.Query_Type; 25USE TYPE Spark.Ada.Text_IO.Exception_T; 26use type unsigned_types.unsigned32; 27 28--just in case debugging needed 29 30--WITH Ada.Text_IO, Ada.Integer_Text_IO; 31 32 33package body Zone_File_Io is 34 35 procedure processZoneFile(zoneFile : in out Spark.Ada.Text_IO.File_Type; 36 success : out boolean) 37 is 38 currentLine : rr_type.LineFromFileType := rr_type.LineFromFileType'(others => ' '); 39 LastPos : Natural := 0; 40 LineTooLong : Boolean; 41 KeyTooLong : Boolean := false; 42 BlankLine : Boolean; 43 CommentLine : Boolean := False; --true if line is a comment 44 ControlLine : Boolean := False; --true if line is a control statement (e.g. $TTL) 45 HaveSOARecord : Boolean := false; --set to true if first record is SOA 46 Parseable : Boolean; 47 AllDone : Boolean; 48 returnedType : rr_type.rrItemType := rr_type.Other; 49 RecordSuccessfullyInserted : Boolean := True; 50 LineCount : Unsigned_Types.Unsigned32 := 0; --will wrap around if file has 2^32 lines :-) 51 RRCtr : Unsigned_Types.Unsigned32 := 0; --counts resource recs, see above 52 LastException : Spark.Ada.Text_IO.Exception_T; 53 InMultilineRecord : Boolean := False; 54 lineInRecordCtr : Unsigned_Types.Unsigned32 := 0; --first line of multiline record is 0 55 BegIdx : Rr_Type.LineLengthIndex; 56 endIdx : rr_type.LineLengthIndex; 57 58 currentOrigin : rr_type.DomainNameStringType := rr_type.blankDomainName; 59 currentOwner : rr_type.DomainNameStringType := rr_type.blankDomainName; 60 currentTTL : unsigned_types.Unsigned32 := 0; 61 CurrentClass : Rr_Type.ClassType := Rr_Type.INTERNET; 62 63 CurrentRecordType : Dns_Types.Query_Type := Dns_Types.A; 64 65 --SOA record fields 66 CurrentNameServer : Rr_Type.DomainNameStringType := Rr_Type.BlankDomainName; 67 --if we need a DNSKEY record 68 DNSKEY_Rec : Rr_Type.Dnskey_Record_Type.DNSKeyRecordType; 69 --if we need an RRSIG record 70 RRSIG_Rec : Rr_Type.Rrsig_Record_Type.RRSIGRecordType; 71 72 --(these initial values never used, but make flow errors go away) 73 CurrentEmail : Rr_Type.DomainNameStringType := rr_type.BlankDomainName; 74 currentSerialNumber : unsigned_types.unsigned32 := 0; 75 CurrentRefresh : unsigned_types.unsigned32 := 0; 76 CurrentRetry : unsigned_types.unsigned32 := 0; 77 CurrentExpiry : unsigned_types.unsigned32 := 0; 78 CurrentMinimum : Unsigned_Types.Unsigned32 := 0; 79 80 -- Used to test the last section of an SRV record 81 -- testOwner: rr_type.DomainNameStringType := rr_type.blankDomainName; 82 83 begin 84 --make bogus flow errors go away 85 DNSKEY_Rec := Rr_Type.Dnskey_Record_Type.BlankDNSKeyRecord; 86 RRSIG_Rec := Rr_Type.Rrsig_Record_Type.BlankRRSIGRecord; 87 success := true; 88 lastException := Spark.Ada.Text_IO.Get_Last_Exception_File(zoneFile); 89 90 --grab first line if file opened OK 91 if (lastException = Spark.Ada.Text_IO.No_Exception) then 92 Spark.Ada.Text_IO.Procedure_Get_Line_File(File => zoneFile, 93 Item => CurrentLine, Arg_Last => LastPos); 94 LineCount := LineCount+1; 95 lastException := Spark.Ada.Text_IO.Get_Last_Exception_File(zoneFile); 96 end if; 97 98 WHILE (LastException = Spark.Ada.Text_IO.No_Exception) AND Success LOOP 99 --# assert true; 100 blankLine := (lastPos = 0); 101 LineTooLong := LastPos >= Rr_Type.MaxLineLength; 102 if lineTooLong then 103 error_msgs.printLineLengthErrorInfo(currentLine, lastPos, lineCount); 104 success := false; 105 elsif not blankLine then 106 Parser_Utilities.FindFirstToken(CurrentLine, LastPos, ReturnedType); 107 CommentLine := (ReturnedType = Rr_Type.Comment); 108 ControlLine := (ReturnedType = Rr_Type.Control); 109 end if; 110 111 parseable := (not blankLine) and (not lineTooLong) and (not CommentLine); 112 IF Parseable THEN 113 if not inMultilineRecord then --multiline records treated differently 114 --for monoline records, build record from line and insert in appropriate table 115 if ControlLine then 116 --control statements are monoline, but different from DNS records 117 Zone_File_Parser.ParseControlLine(currentOrigin, currentTTL, currentLine, 118 LastPos, Success); 119 else 120 --if not a control line, grab the owner, TTL, class and record type 121 RRCtr := RRCtr + 1; 122 123 zone_file_parser.parseOwnerTTLClassAndRecordType(currentOwner, currentTTL, 124 CurrentClass, CurrentRecordType, CurrentLine, LastPos, Success); 125 126 IF Success THEN 127 if CurrentTTL = 0 then 128 error_msgs.printZeroTTLWarning(currentLine, lastPos, lineCount); 129 end if; 130 --if domain name does not end in '.', append value of $ORIGIN 131 parser_utilities.checkAndAppendOrigin(currentOwner, currentOrigin, currentLine, lastPos, 132 LineCount, Success); 133 134 --owners for A, AAAA, DNSKEY, or MX records must be valid host names, check those more carefully 135 if CurrentRecordType = Dns_Types.A or CurrentRecordType = Dns_Types.AAAA 136 or CurrentRecordType = Dns_Types.DNSKEY or CurrentRecordType = Dns_Types.MX then 137 parser_utilities.CheckValidHostName(CurrentOwner, Success); 138 elsif CurrentRecordType = Dns_Types.SRV then 139 parser_utilities.checkValidSRVOwner(CurrentOwner, Success); 140 end if; 141 142 if Success then 143 --handle the record and (if not multiline) put it in the DNS table 144 process_first_line_of_record.ProcessFirstLineOfRecord (CurrentRecordType, CurrentOrigin, CurrentOwner, 145 CurrentTTL, CurrentClass, CurrentLine, LastPos, LineCount, 146 InMultilineRecord, lineInRecordCtr, currentNameServer, 147 CurrentEmail, DNSKEY_Rec, RRSIG_Rec, RecordSuccessfullyInserted, 148 Success); 149 end if; 150 end if; --successful parse of owner/ttl/class/recordType 151 end if; --control line or other monoline record 152 else --inside a multiline record 153 case CurrentRecordType is 154 when dns_types.SOA => 155 --parsing the numeric fields of an SOA record ( after the '(' ) 156 --must be one per line 157 lineInRecordCtr := lineInRecordCtr + 1; 158 case lineInRecordCtr is 159 when 1 => 160 Zone_File_Parser.ParseSerialNumber(CurrentSerialNumber, CurrentLine, LastPos, Success); 161 when 2 => 162 Zone_File_Parser.ParseTimeSpec(CurrentRefresh, CurrentLine, LastPos, Success); 163 when 3 => 164 Zone_File_Parser.ParseTimeSpec(CurrentRetry, CurrentLine, LastPos, Success); 165 when 4 => 166 Zone_File_Parser.ParseTimeSpec(CurrentExpiry, CurrentLine, LastPos, Success); 167 when 5 => 168 Zone_File_Parser.ParseTimeSpec(CurrentMinimum, CurrentLine, LastPos, Success); 169 --check if the token after the time specifier is a right paren 170 begIdx := 1; 171 Parser_Utilities.FindNextToken(CurrentLine, LastPos, BegIdx, EndIdx, ReturnedType); 172 --begIdx <= endIdx always true, makes flow errors go away 173 if (ReturnedType = rr_type.DomainNameOrTimeSpec and begIdx <= endIdx and endIdx < LastPos) then 174 BegIdx := EndIdx+1; 175 end if; 176 Parser_Utilities.FindNextToken(CurrentLine, LastPos, BegIdx, EndIdx, ReturnedType); 177 --begIdx <= endIdx always true, makes flow errors go away 178 if ReturnedType = Rr_Type.RParen and begIdx <= endIdx then 179 InMultilineRecord := False; 180 Dns_Table_Pkg.Dns_Table.InsertSOARecord(Rr_Type.ConvertDomainNameToWire(CurrentOwner), 181 Rr_Type.Soa_Record_Type.SoaRecordType'( 182 TtlInSeconds=>CurrentTTL, Class => CurrentClass, 183 NameServer => rr_type.ConvertDomainNameToWire(CurrentNameServer), 184 Email => Rr_Type.ConvertDomainNameToWire(CurrentEmail), 185 SerialNumber => CurrentSerialNumber, Refresh => CurrentRefresh, 186 Retry => CurrentRetry, Expiry => CurrentExpiry, Minimum => CurrentMinimum), 187 RecordSuccessfullyInserted); 188 HaveSOARecord := HaveSOARecord or (RecordSuccessfullyInserted and RRCtr = 1); 189 end if; 190 191 when others => 192 if ReturnedType = Rr_Type.RParen then 193 InMultilineRecord := False; 194 Dns_Table_Pkg.Dns_Table.InsertSOARecord(Rr_Type.ConvertDomainNameToWire(CurrentOwner), 195 Rr_Type.Soa_Record_Type.SoaRecordType'( 196 TtlInSeconds=>CurrentTTL, Class => CurrentClass, 197 NameServer => rr_type.ConvertDomainNameToWire(CurrentNameServer), 198 Email => Rr_Type.ConvertDomainNameToWire(CurrentEmail), 199 SerialNumber => CurrentSerialNumber, Refresh => CurrentRefresh, 200 Retry => CurrentRetry, Expiry => CurrentExpiry, Minimum => CurrentMinimum), 201 RecordSuccessfullyInserted); 202 HaveSOARecord := HaveSOARecord or (RecordSuccessfullyInserted and RRCtr = 1); 203 else 204 Success := False; 205 end if; 206 end case; --lineInRecordCtr value 207 when Dns_Types.DNSKEY => 208 --parsing the lines of a DNSKEY record ( after the '(' ) 209 --each line is a piece of the key, except for the last 210 LineInRecordCtr := LineInRecordCtr + 1; 211 --check if line begins with ')' 212 begIdx := 1; 213 Parser_Utilities.FindNextToken(CurrentLine, LastPos, BegIdx, EndIdx, ReturnedType); 214 --if ')' found, record complete, can insert in table 215 --begIdx <= endIdx always true, makes flow errors go away 216 if ReturnedType = Rr_Type.RParen and begIdx <= endIdx then 217 InMultilineRecord := False; 218 DNSKEY_Rec.TtlInSeconds := CurrentTTL; 219 DNSKEY_Rec.Class := CurrentClass; 220 --flags, protocol, algorithm already set when first line processed, 221 --key and keyLength set when remaining lines processed, so we're done 222 Dns_Table_Pkg.DNS_Table.InsertDNSKEYRecord(Rr_Type.ConvertDomainNameToWire(CurrentOwner), 223 DNSKEY_Rec, RecordSuccessfullyInserted); 224 else --otherwise we're still in the middle of a DNSKEY record, parsing the key 225 Parser_Utilities.AddToKey(DNSKEY_Rec, CurrentLine, LastPos, Success); 226 if not Success then 227 KeyTooLong := True; 228 end if; 229 end if; 230 when Dns_Types.RRSIG => 231 --parsing the lines of an RRSIG record after the first one 232 --2nd line has record fields, the rest of the lines are the key 233 --terminated by a right paren 234 LineInRecordCtr := LineInRecordCtr + 1; 235 case LineInRecordCtr is 236 when 1 => 237 zone_file_parser.ParseRRSig2ndLine(RRSig_Rec, currentLine, LastPos, 238 Success); 239 when others => 240 Parser_Utilities.AddToKeyR(RRSig_Rec, CurrentLine, LastPos, AllDone, 241 Success); 242 if not Success then 243 KeyTooLong := True; 244 ELSIF AllDone THEN 245 RRSIG_Rec.TtlInSeconds := CurrentTTL; 246 RRSIG_Rec.Class := CurrentClass; 247 Dns_Table_Pkg.DNS_Table.InsertRRSIGRecord(Rr_Type.ConvertDomainNameToWire(CurrentOwner), 248 RRSIG_Rec, RecordSuccessfullyInserted); 249 InMultilineRecord := False; 250 end if; 251 end case; 252 253 when others => --other multiline record types can go here 254 null; 255 end case; --multiline record types 256 end if; --parsing a multiline record 257 ELSE 258 null; --non-parseable line, blank lines/comments ignored 259 END IF; 260 261 --check for various error conditions 262 Success := Success AND RecordSuccessfullyInserted; 263 if not RecordSuccessfullyInserted then 264 Error_Msgs.PrintDNSTableFullInfo(CurrentLine, LineCount); 265 elsif KeyTooLong then 266 error_msgs.printKeyLengthErrorInfo(currentLine, lastPos, lineCount); 267 elsIF NOT Success and not lineTooLong THEN 268 Error_Msgs.PrintParseErrorInfo(CurrentLine, LastPos, LineCount); 269 elsif NOT HaveSOARecord and RRCtr > 1 then 270 Success := False; 271 Error_Msgs.PrintMissingSOARecordInfo; 272 elsif not LineTooLong then 273 --looks like we're good, get the next line and repeat 274 Spark.Ada.Text_IO.Procedure_Get_Line_File(File => zoneFile, 275 Item => CurrentLine, Arg_Last => LastPos); 276 --having old characters reset to blank helps with error reporting 277 if LastPos >= 1 and LastPos < rr_type.MaxLineLength then 278 for I in integer range LastPos+1..rr_type.MaxLineLength loop 279 --#assert I >= 1; 280 CurrentLine(I) := ' '; 281 end loop; 282 end if; 283 lineCount := lineCount + 1; 284 LastException := Spark.Ada.Text_IO.Get_Last_Exception_File(ZoneFile); 285 END IF; 286 end loop; --file reading loop, one line per iteration 287 288 --Only possible undetected errors at this point are file errors 289 Success := Success and (LastException = Spark.Ada.Text_IO.End_Error); 290 291 end processZoneFile; 292end zone_file_io; 293