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