Delphi-PRAXiS - Delphi DNS-Server mit Indys TIdDNSServer = Verwirrung

Auf Nachfrage hier grob wie man sich mit Hilfe der IdUDPServer Komponente einen eigenen DNS-Server programmiert, der nicht so überladen ist wie der IdDNSServer aus der Indy-Sammlung.
Schwierigkeit: Fortgeschritten(+)
Ich habe den Code auf das grundlegendste gekürzt !!
Vorweg einen Link, auf dessen Basis ich den folgenden Code aufbaue:

RFC-1035

Das Prinzip: Man erzeugt eine neue Klasse, welche Nachfahre von TIdUDPServer ist, da DNS auf UDP-Basis arbeitet, und auf Port 53 (DNS-Standard) lauscht. Jedes eintreffende Packet wird in die Form wie im RFC beschrieben zerlegt und abgearbeitet. Die daraus entstehende Antwort (falls es eine gibt) wird dann in der selben Session zurückgesendet.

Die Klasse könnte so aussehen:

Delphi-Quellcode:

			type

  TSimpleDNSServer = class(TIdUDPServer)

  protected

    procedure DoUDPRead(AData: TIdBytes; ABinding: TIdSocketHandle); override; // die Prozedur, wird bei eintreffenden Daten aufgerufen

  private

    // Packetverwaltung

    function ReadPackage(Data: TBytes): TDNSPackage; // Packet "zerlegen"

    procedure HandlePackage(var DNSPackage: TDNSPackage; Binding: TIdSocketHandle); // Packet behandeln

    procedure SendDNSPackage(DNSPackage: TDNSPackage; Binding: TIdSocketHandle); // Antwort zurücksenden

  end;

Die Klasse TDNSPackage, ist lediglich ein record, der die eintreffenden Byte-Daten ordentlich getrennt in passende Variablentypen aufteilt.
Könnte so aussehen: (Die Konnentare sind teilweise aus dem RFC kopiert)

Delphi-Quellcode:

			type

  TDNSHeader = record

    ID: Word; // 16bitu Identifier

    QR: Boolean; // 1bit False=Query True=Response

    OPCODE: Array[0..3] of Boolean; // 4bit 0=Query 1=IQuery 2=Status 3-15 Reserved

    AA: Boolean; // 1bit True in Response - Authoritative Answer

    TC: Boolean; // 1bit TrunCation

    RD: Boolean; // 1bit Recursion Desired

    RA: Boolean; // 1bit Recursion Available

    Z: Array[0..2] of Boolean; // 3bit Reserved --> 0

    RCODE: Array[0..3] of Boolean; // 4bit - Response Code

    QDCOUNT: Word; // 16bitu Number of Entries in Question Section

    ANCOUNT: Word; // 16bitu Number of RRs in Answer Section

    NSCOUNT: Word; // 16bitu Number of Nameserver RRs in the Authority Records Section

    ARCOUNT: Word; // 16bitu Number of RRs in Additional Records Section

  end;

Wie es im RFC steht, beinhaltet das Packet ausser dem Header natürlich noch die Anfrage:

Delphi-Quellcode:

			type

  TDNSQuestion = record

   QNAME: String; // Query-Name

   NamePointer: Integer; // Compression (etwas komplizierter, erkläre ich später)

   QTYPE: Word; // 16bitu Type of Query

   QCLASS: Word; // 16bitu Class of Query

  end;

Alle anderen Teile des Packets bestehen aus sogenannten ResourceRecords:

Delphi-Quellcode:

			type

  TResorceRecord = record

    NAME: TBytes; // a domain name to which this resource record pertains.

    RTYPE: Word; // 16bitu Meaning of Data in RDATA

    RCLASS: Word; // 16bitu Class of Data in RDATA

    TTL: LongWord; // 32bitu Cache-Time

    RDLENGTH: Word; // 16bitu Number of Octets in RDATA

    RDATA: TBytes; // Datenspeicher

  end;

Und das ganze vereinen wir dann in einer Klasse DNSPackage:

Delphi-Quellcode:

			type

  TDNSPackage = record

    Header    : TDNSHeader;

    Question  : Array of TDNSQuestion;

    Answer    : Array of TResorceRecord;

    //Authority : Array of TResorceRecord; // für den grundlegenden Server uninteressant, gehe ich hier also nicht weiter drauf ein

    //Additional: Array of TResorceRecord; // s.o.

  end;

Wie man hier schon sieht: Ein Packet kann mehrere Fragen und Antworten enthalten!
So nun da eine solide Datenstruktur besteht kann man die eingehenden Daten so zerhackstückeln, dass sie auch darein passen.
(Hier sollte man evtl noch einen Try-Finally Block einbauen und prüfen ob das Packet überhaupt beantwortet werden konnte, denn andernfalls brauch man es nicht zurückzusenden)

Delphi-Quellcode:

			procedure TSimpleDNSServer.DoUDPRead(AData: TIdBytes; ABinding: TIdSocketHandle);

var

  DNSPackage: TDNSPackage;

begin

  DNSPackage := ReadPackage(AData);

  HandlePackage(DNSPackage, ABinding);

  SendDNSPackage(DNSPackage, Binding);

  FreePackage(DNSPackage);

end;

Dann geben wir unserer Funktion ReadPackage die "rohen" Daten und lassen uns ein schönes formatiertes DNSPackage zurückgeben:

Delphi-Quellcode:

			function TSimpleDNSServer.ReadPackage(Data: TBytes): TDNSPackage;

var

  Buffer16bit: TBytes;

  Position: Integer;

  Flags, Flags2: Array[0..7] of Boolean; // 1Byte in Bits geteilt 

  i: Integer;

begin

  SetLength(Buffer16bit, 2); // jaa, 16 Bit sind 2 Byte ;)

  Result.Header.ID := BytesToWord(ReadFromBytes(Data, 0, 2));

  Flags := ByteToBits(Data[2]); // die Funktion muss man sich noch selbst basteln und das oben genannte "Array[0..7] of Boolean;" einem Type zuweisen.

  Flags2 := ByteToBits(Data[3]);

  with Result.Header do

  begin

    QR := Flags[0];

    OPCODE[0] := Flags[1];

    OPCODE[1] := Flags[2];

    OPCODE[2] := Flags[3];

    OPCODE[3] := Flags[4];

    AA := Flags[5];

    TC := Flags[6];

    RD := Flags[7];

    RA := Flags2[0];

    Z[0] := Flags2[1];

    Z[1] := Flags2[2];

    Z[2] := Flags2[3];

    RCODE[0] := Flags2[4];

    RCODE[1] := Flags2[5];

    RCODE[2] := Flags2[6];

    RCODE[3] := Flags2[7];

  end;

  Result.Header.QDCOUNT := BytesToWord(ReadFromBytes(Data, 4, 2)); // Diese Funktionen muss man dann auch noch programmieren, sie Lesen z.B. aus TBytes ab einer gewissen Position eine bestimmte Anzahl an Bytes aus und geben sie als TBytes zurück

  Result.Header.ANCOUNT := BytesToWord(ReadFromBytes(Data, 6, 2));

  Result.Header.NSCOUNT := BytesToWord(ReadFromBytes(Data, 8, 2));

  Result.Header.ARCOUNT := BytesToWord(ReadFromBytes(Data, 10, 2));

  SetLength(Result.Question, Result.Header.QDCOUNT); // Platz für alle eingehenden Anfragen reservieren

  Position := 12; // nach dem Header sind wir am 13. Byte

  // Questions

  for i := 0 to Result.Header.QDCOUNT-1 do

  begin

    Result.Question[i].QNAME := GetStringInBytes(Data, Position); // Diese Funktion kopiert einen String (bis zum Zeichen #0 - daher Nullterminiert), aus einem TByte ab einer gewissen Position

    Result.Question[i].NamePointer := Position; // Kompression - etwas komplizierter: Damit der Name nich in Frage und Antwort doppelt steht wird in der Antwort später einfach ein "Zeiger" auf den Namen in der Frage anstatt des kompletten Strings geschrieben. Der "Zeiger" ist eine Zahl, welche angibt mit dem wievielten Byte des Packets der String beginnt

    Position := Position + Length(Result.Question[i].QNAME);

    Result.Question[i].QTYPE := BytesToWord(ReadFromBytes(Data, Position, 2));

    Inc(Position, 2);  

    Result.Question[i].QCLASS := BytesToWord(ReadFromBytes(Data, Position, 2));

    Inc(Position, 2);

  end;

  // Alles andere gehört zu den Teilen die hier nicht behandelt werden, für einen grundlegenden DNS-Server aber auch nicht benötigt werden.

  SetLength(Buffer16bit, 0); // sonst gibts Leaks!

end;

Das war der schwerste Teil.. Wers nicht verstanden hat: Im RFC nachgucken was die einzelnen Werte zu sagen haben und dann nochmal lesen :P
Jetz wo man die eigentliche Anfrage hat bearbeitet man sie. Der String der Anfrage ist in Question[x].QNAME wie im vorherigen Code zu erkennen ist.
Man sollte sich vorher eine Tabelle anlegen, welche alle Namen und dazugehörigen IP-Addressen kennt (TStrings, TStringGrid und was es da alles gibt.. PointerArrays sind hier am schnellsten). Das wäre dann die Procedure HandlePackage(..)
Sieht dann ca so aus:

Delphi-Quellcode:

			procedure TSimpleDNSServer.HandlePackage(var DNSPackage: TDNSPackage; Binding: TIdSocketHandle);

var

  i: Integer;

  CompressionBytes: TBytes;

  Compression1: Array[0..7] of Boolean;

  IPAddress: Array[0..3] of Byte;

begin

  if DNSPackage.Header.QR then // ist keine Anfrage sondern bereits eine Antwort

    Exit;

  with DNSPackage do

  begin

    with Header do

    begin

      QR := True; // jetzt ist es eine Antwort!

      AA := False;

      RA := True;

      RCODE := // 0 zurückgeben falls kein Fehler bisher

      ANCOUNT := DNSPackage.Header.QDCOUNT; // wir veruschen jede Frage zu beantworten!

    end;

  end;

  SetLength(DNSPackage.Answer, DNSPackage.Header.ANCOUNT); // Speicher für die Antworten reservieren

  for i := 0 to DNSPackage.Header.QDCOUNT-1 do

  begin

    if (DNSPackage.Question[i].QTYPE = 1) and (DNSPackage.Question[i].QCLASS = 1) then // IP-Request - Internet(auch LAN)

    begin

      with DNSPackage.Answer[i] do

      begin

        IPAddress := // Irgendwie in der oben erwähnten Tabelle nachschlagen anhand des Namens: DNSPackage.Question[i].QNAME

        // Kompression

        CompressionBytes := WordToBytes(DNSPackage.Question[i].NamePointer); // Hier wird der Zeiger den wir vorher vermerkt haben dann eingefügt

        Compression1 := ByteToBits(CompressionBytes[0]);

        Compression1[0] := True;

        Compression1[1] := True;  

        CompressionBytes[0] := BitsToByte(Compression1);

        SetLength(NAME, 2);

        NAME[0] := CompressionBytes[0];

        NAME[1] := CompressionBytes[1];

        RTYPE := 1; // IP

        RCLASS := 1; // Internet(auch LAN)

        TTL := 300; // s. RFC

        RDLENGTH := 4;

        SetLength(RDATA, 4);

        RDATA[0] := IPAddress[0];

        RDATA[1] := IPAddress[1];

        RDATA[2] := IPAddress[2];

        RDATA[3] := IPAddress[3];

      end;

    end;

  end;

end;

Das Beispiel kann und wird also NUR IP-Anfragen beantworten.. Es gibt noch viele weitere Funktionen des DNS. Steht alles im RFC!
Aber wir brauchen ja erstmal nur die IP-Anfrage.
Das fertig beantwortete Packet kann dann (falls sinnvolle Antworten enthalten sind) zurückgesendet werden:

Delphi-Quellcode:

			procedure TSimpleDNSServer.SendDNSPackage(DNSPackage: TDNSPackage; Binding: TIdSocketHandle);

var

  Bytes: TBytes;

  Flags, Flags2: Array[0..7] of Boolean;

  i: Integer;

  Position: Integer;

begin

  SetLength(Bytes, SizeOfPackage(DNSPackage)); // SizeOfPackage gibt die vorhersehbare größe des Packets zurück (lässt sich leicht berechnen)

  // Header

  WriteToBytes(Bytes, WordToBytes(DNSPackage.Header.ID), 0); // Ab hier ist alles wie im ReadPackage nur wird nicht gelesen sondern geschrieben! BITTE BITTE nie mit SetLength(.. , Length(..) + 1); .. Das ist totaler Code-Müll und stresst den PC enorm! Darum vorher reservieren!

  with DNSPackage.Header do

  begin

    Flags[0] := QR;

    Flags[1] := OPCODE[0];

    Flags[2] := OPCODE[1];

    Flags[3] := OPCODE[2];

    Flags[4] := OPCODE[3];

    Flags[5] := AA;

    Flags[6] := TC;

    Flags[7] := RD;

    Flags2[0] := RA;

    Flags2[1] := Z[0];

    Flags2[2] := Z[1];

    Flags2[3] := Z[2];

    Flags2[4] := RCODE[0];

    Flags2[5] := RCODE[1];

    Flags2[6] := RCODE[2];

    Flags2[7] := RCODE[3];

  end;

  Bytes[2] := BitsToByte(Flags);

  Bytes[3] := BitsToByte(Flags2);

  WriteToBytes(Bytes, WordToBytes(DNSPackage.Header.QDCOUNT), 4);

  WriteToBytes(Bytes, WordToBytes(DNSPackage.Header.ANCOUNT), 6);

  WriteToBytes(Bytes, WordToBytes(DNSPackage.Header.NSCOUNT), 8);

  WriteToBytes(Bytes, WordToBytes(DNSPackage.Header.ARCOUNT), 10);

  Position := 12;

  // Questions

  for i := 0 to DNSPackage.Header.QDCOUNT-1 do

  begin

    WriteToBytes(Bytes, ToBytes(DNSPackage.Question[i].QNAME), Position);

    Inc(Position, Length(DNSPackage.Question[i].QNAME));

    WriteToBytes(Bytes, WordToBytes(DNSPackage.Question[i].QTYPE), Position);

    Inc(Position, 2);

    WriteToBytes(Bytes, WordToBytes(DNSPackage.Question[i].QCLASS), Position);

    Inc(Position, 2);

  end;

  // Answer

  for i := 0 to DNSPackage.Header.ANCOUNT-1 do

  begin

    Bytes[Position] := DNSPackage.Answer[i].NAME[0];

    inc(Position);

    Bytes[Position] := DNSPackage.Answer[i].NAME[1];

    inc(Position);    

    WriteToBytes(Bytes, WordToBytes(DNSPackage.Answer[i].RTYPE), Position);

    Inc(Position, 2);

    WriteToBytes(Bytes, WordToBytes(DNSPackage.Answer[i].RCLASS), Position);

    Inc(Position, 2);

    WriteToBytes(Bytes, LongWordToBytes(DNSPackage.Answer[i].TTL), Position);

    Inc(Position, 4);    

    WriteToBytes(Bytes, WordToBytes(DNSPackage.Answer[i].RDLENGTH), Position);

    Inc(Position, 2);

    WriteToBytes(Bytes, DNSPackage.Answer[i].RDATA, Position);

    Inc(Position, DNSPackage.Answer[i].RDLENGTH);

  end;

  Binding.SendTo(Binding.PeerIP, Binding.PeerPort, Bytes);

end;

So das wars dann auch "schon" ! Hoffe es ist halbwegs verständlich!
Wie gesagt das ist höchstwarscheinlich kein lauffähiger Code. Zeigt aber wie man Daten auf Byte- und Bit-Ebene behandelt um etwas Übersicht zu bekommen. Der Vorteil an dieser Struktur: Man kann es sehr leicht ausbauen auf sämtliche anderen Funktionen!
Der Code ist hier wie gesagt aufs grundlegendste reduziert. Damit das Programm sicher läuft sollte hier und dort Try-Finally Blöcke eingefügt werden und IMMER aller speicher freigegeben werden, der (manuell) reserviert wurde (evtl habe ich hier etwas vergessen)!!!
Ich weis auch, dass der Code nicht sonderlich schön ist, an alle Pingel, die was bemängeln wollen ^^ Aber es geht nur ums Prinzip!
Den Rest müsst ihr euch selbst erdenken!
--> Wer nen Rechtschreibfehler findet darf ihn behalten :P
Grz, NiGhTmArE