[Gd-chatter] r11654 - in trunk/libraries: packetizer protocols
andreas at gwydiondylan.org
andreas at gwydiondylan.org
Thu Jan 24 22:22:42 CET 2008
Author: andreas
Date: Thu Jan 24 22:22:41 2008
New Revision: 11654
Modified:
trunk/libraries/packetizer/leaf-frames.dylan
trunk/libraries/packetizer/module.dylan
trunk/libraries/packetizer/util.dylan
trunk/libraries/protocols/dns.dylan
Log:
job: 7299
* Better printing of DNS RRs
* <boolean-bit> frame type
Modified: trunk/libraries/packetizer/leaf-frames.dylan
==============================================================================
--- trunk/libraries/packetizer/leaf-frames.dylan (original)
+++ trunk/libraries/packetizer/leaf-frames.dylan Thu Jan 24 22:22:41 2008
@@ -33,11 +33,45 @@
error("read-frame not supported for frame-type %=", frame-type);
end;
+define class <boolean-bit> (<fixed-size-translated-leaf-frame>) end;
+
+define method parse-frame (frame-type == <boolean-bit>,
+ packet :: <byte-sequence>,
+ #key)
+ => (value :: <boolean>, next-unparsed :: <integer>)
+ values(logand(packet[0], #x80) == #x80, 1)
+end;
+
+define method assemble-frame-into-as
+ (frame-type == <boolean-bit>,
+ data :: <boolean>,
+ packet :: <stretchy-byte-vector-subsequence>) => (end-offset :: <integer>)
+ if (data)
+ packet[0] := logior(packet[0], #x80);
+ else
+ packet[0] := logand(packet[0], #x7F)
+ end;
+ 1;
+end;
-define class <unsigned-byte> (<fixed-size-translated-leaf-frame>)
- slot data :: <byte>, init-keyword: data:;
+define inline method field-size (type == <boolean-bit>)
+ => (length :: <integer>)
+ 1
end;
+define method read-frame (type == <boolean-bit>,
+ string :: <string>)
+ => (res)
+ string = "#t" | string = "true"
+end;
+
+define inline method high-level-type (low-level-type == <boolean-bit>)
+ => (res == <boolean>)
+ <boolean>;
+end;
+
+define class <unsigned-byte> (<fixed-size-translated-leaf-frame>) end;
+
define method parse-frame (frame-type == <unsigned-byte>,
packet :: <byte-sequence>,
#key)
@@ -53,11 +87,6 @@
8;
end;
-define method as (class == <string>, frame :: <unsigned-byte>)
- => (string :: <string>)
- concatenate("0x", integer-to-string(frame.data, base: 16, size: 2));
-end;
-
define inline method field-size (type == <unsigned-byte>)
=> (length :: <integer>)
8
Modified: trunk/libraries/packetizer/module.dylan
==============================================================================
--- trunk/libraries/packetizer/module.dylan (original)
+++ trunk/libraries/packetizer/module.dylan Thu Jan 24 22:22:41 2008
@@ -31,7 +31,7 @@
export hexdump;
- export <unsigned-byte>,
+ export <unsigned-byte>, <boolean-bit>,
<3byte-big-endian-unsigned-integer>,
<2byte-big-endian-unsigned-integer>, <2byte-little-endian-unsigned-integer>,
<3byte-little-endian-unsigned-integer>,
Modified: trunk/libraries/packetizer/util.dylan
==============================================================================
--- trunk/libraries/packetizer/util.dylan (original)
+++ trunk/libraries/packetizer/util.dylan Thu Jan 24 22:22:41 2008
@@ -33,6 +33,16 @@
=> (res :: <string>)
concatenate("0x", hex(object))
end;
+
+define method as(type == <string>, object :: <boolean>)
+ => (res :: <string>)
+ if (object) "true" else "false" end
+end;
+
+define method print-object (frame :: <frame>, stream :: <stream>) => ()
+ write(stream, as(<string>, frame))
+end;
+
/*
define method as(type == <string>, object :: <stretchy-vector>)
=> (res :: <string>)
Modified: trunk/libraries/protocols/dns.dylan
==============================================================================
--- trunk/libraries/protocols/dns.dylan (original)
+++ trunk/libraries/protocols/dns.dylan Thu Jan 24 22:22:41 2008
@@ -20,12 +20,17 @@
summary "DNS ID=%=, %= questions, %= answers",
identifier, question-count, answer-count;
field identifier :: <2byte-big-endian-unsigned-integer> = 2342;
- field query-or-response :: <1bit-unsigned-integer> = 0;
- field opcode :: <4bit-unsigned-integer> = 0;
- field authoritative-answer :: <1bit-unsigned-integer> = 0;
- field truncation :: <1bit-unsigned-integer> = 0;
- field recursion-desired :: <1bit-unsigned-integer> = 1;
- field recursion-available :: <1bit-unsigned-integer> = 0;
+ enum field query-or-response :: <1bit-unsigned-integer> = 0,
+ mappings: { 0 <=> #"query",
+ 1 <=> #"response" };
+ enum field opcode :: <4bit-unsigned-integer> = 0,
+ mappings: { 0 <=> #"standard query",
+ 1 <=> #"inverse query",
+ 2 <=> #"server status request" };
+ field authoritative-answer :: <boolean-bit> = #f;
+ field truncation :: <boolean-bit> = #f;
+ field recursion-desired :: <boolean-bit> = #t;
+ field recursion-available :: <boolean-bit> = #f;
field reserved :: <3bit-unsigned-integer> = 0;
field response-code :: <4bit-unsigned-integer> = 0;
field question-count :: <2byte-big-endian-unsigned-integer>,
@@ -69,7 +74,7 @@
end;
define protocol domain-name (container-frame)
- summary "%s", curry(as, <string>);
+ summary "%=", curry(as, <string>);
repeated field fragment :: <domain-name-fragment>,
reached-end?: frame.type-code = 3 | frame.data-length = 0;
end;
@@ -147,8 +152,17 @@
define protocol dns-question (container-frame)
+ summary "%= %s", domainname, question-type;
field domainname :: <domain-name>;
- field question-type :: <2byte-big-endian-unsigned-integer>;
+ enum field question-type :: <2byte-big-endian-unsigned-integer>,
+ mappings: { 1 <=> #"A",
+ 2 <=> #"NS",
+ 5 <=> #"CNAME",
+ 6 <=> #"SOA",
+ 12 <=> #"PTR",
+ 13 <=> #"HINFO",
+ 15 <=> #"MX",
+ 16 <=> #"TXT" };
field question-class :: <2byte-big-endian-unsigned-integer> = 1;
end;
@@ -163,21 +177,25 @@
end;
define protocol a-host-address (dns-resource-record)
+ summary "%= A %=", domainname, ipv4-address;
over <dns-resource-record> 1;
field ipv4-address :: <ipv4-address>;
end;
define protocol name-server (dns-resource-record)
+ summary "%= NS %=", domainname, ns-name;
over <dns-resource-record> 2;
field ns-name :: <domain-name>;
end;
define protocol canonical-name (dns-resource-record)
+ summary "%= CNAME %=", domainname, cname;
over <dns-resource-record> 5;
field cname :: <domain-name>;
end;
define protocol start-of-authority (dns-resource-record)
+ summary "%= SOA", domainname;
over <dns-resource-record> 6;
field nameserver :: <domain-name>;
field hostmaster :: <domain-name>;
@@ -189,6 +207,7 @@
end;
define protocol domain-name-pointer (dns-resource-record)
+ summary "%= PTR %=", domainname, ptr-name;
over <dns-resource-record> 12;
field ptr-name :: <domain-name>;
end;
@@ -199,24 +218,27 @@
length: frame.data-length * 8;
end;
+define method as (class == <string>, frame :: <character-string>)
+ => (res :: <string>)
+ as(<string>, frame.string-data);
+end;
+
define protocol host-information (dns-resource-record)
+ summary "%= HINFO %=, %=", domainname, cpu, operating-system;
over <dns-resource-record> 13;
field cpu :: <character-string>;
field operating-system :: <character-string>;
end;
-define method as (class == <string>, frame :: <character-string>)
- => (res :: <string>)
- as(<string>, frame.string-data);
-end;
-
define protocol mail-exchange (dns-resource-record)
+ summary "%= MX %= %=", domainname, preference, exchange;
over <dns-resource-record> 15;
field preference :: <2byte-big-endian-unsigned-integer>;
field exchange :: <domain-name>;
end;
define protocol text-strings (dns-resource-record)
+ summary "%= TXT %=", domainname, text-data;
over <dns-resource-record> 16;
field text-data :: <character-string>;
end;
More information about the chatter
mailing list