[Gd-chatter] r11071 - in trunk/libraries/network: koala/sources/examples/buddha web-framework
hannes at gwydiondylan.org
hannes at gwydiondylan.org
Sun Dec 17 03:39:16 CET 2006
Author: hannes
Date: Sun Dec 17 03:39:06 2006
New Revision: 11071
Added:
trunk/libraries/network/koala/sources/examples/buddha/ipv6.dylan (contents, props changed)
Modified:
trunk/libraries/network/koala/sources/examples/buddha/buddha.dylan
trunk/libraries/network/koala/sources/examples/buddha/buddha.lid
trunk/libraries/network/koala/sources/examples/buddha/cidr.dylan
trunk/libraries/network/koala/sources/examples/buddha/config.dylan
trunk/libraries/network/koala/sources/examples/buddha/host.dylan
trunk/libraries/network/koala/sources/examples/buddha/ipv4.dylan
trunk/libraries/network/koala/sources/examples/buddha/network.dylan
trunk/libraries/network/koala/sources/examples/buddha/subnet.dylan
trunk/libraries/network/koala/sources/examples/buddha/zone.dylan
trunk/libraries/network/web-framework/class-editor.dylan
trunk/libraries/network/web-framework/storage.dylan
trunk/libraries/network/web-framework/web-macro.dylan
Log:
Bug: 7257
*initial IPv6 support
Modified: trunk/libraries/network/koala/sources/examples/buddha/buddha.dylan
==============================================================================
--- trunk/libraries/network/koala/sources/examples/buddha/buddha.dylan (original)
+++ trunk/libraries/network/koala/sources/examples/buddha/buddha.dylan Sun Dec 17 03:39:06 2006
@@ -5,6 +5,8 @@
define constant $privileges = #(#"root", #"noc", #"helpdesk", #"viewer");
+define constant $bottom-v6-subnet = make(<bottom-v6-subnet>, cidr: as(<cidr>, "ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff/128"));
+
define variable *nameserver* = list(make(<nameserver>,
ns-name: "auth-int.congress.ccc.de"),
make(<nameserver>,
@@ -32,7 +34,7 @@
h1("Welcome to buddha, please create an initial admin-user!"),
div(id => "content") {
do(add-form(<user>, "Users", storage(<user>), refer: "login")),
- b("Please set the admin flag!")
+ b("Please choose root as access level to be able to add new users!")
}
}
}
@@ -68,9 +70,9 @@
end;
dynamic-bind(*user* = current-user())
if (request.request-method = #"get")
- respond-to-get(as(<symbol>, ?"name"), request, response)
+ respond-to-get(?#"name", request, response)
elseif (request.request-method = #"post")
- respond-to-post(as(<symbol>, ?"name"), request, response)
+ respond-to-post(?#"name", request, response)
end;
end;
end;
@@ -104,6 +106,23 @@
define page add end;
define page admin end;
+define page ipv4-network-detail end;
+define page ipv6-network-detail end;
+define page ipv4-subnet-detail end;
+define page ipv6-subnet-detail end;
+
+define method respond-to-get (page == #"ipv4-network-detail", request :: <request>, response :: <response>, #key errors)
+ respond-to-get(#"network-detail", request, response, errors: errors);
+end;
+define method respond-to-get (page == #"ipv6-network-detail", request :: <request>, response :: <response>, #key errors)
+ respond-to-get(#"network-detail", request, response, errors: errors);
+end;
+define method respond-to-get (page == #"ipv4-subnet-detail", request :: <request>, response :: <response>, #key errors)
+ respond-to-get(#"subnet-detail", request, response, errors: errors);
+end;
+define method respond-to-get (page == #"ipv6-subnet-detail", request :: <request>, response :: <response>, #key errors)
+ respond-to-get(#"subnet-detail", request, response, errors: errors);
+end;
define responder dhcp-responder ("/dhcp")
(request, response)
respond-to-get(#"dhcp", request, response);
@@ -482,16 +501,8 @@
{ td { a(show(x.cidr),
href => concatenate("/network-detail?network=",
get-reference(x))) },
- td(show(x.dhcp?)),
- td,
- td { do(if(x.dhcp?)
- with-xml()
- a("dhcpd.conf",
- href => concatenate("/dhcp?network=",
- get-reference(x)))
- end
- end) }
- }
+ do(collect-dhcp-into-table(x))
+ }
end);
reset-color(storage(<subnet>));
res := concatenate(res,
@@ -501,7 +512,11 @@
td { a(show(y.cidr),
href => concatenate("/subnet-detail?subnet=",
get-reference(y))) },
- td(show(y.dhcp?)),
+ do(if(instance?(y, <ipv4-subnet>))
+ with-xml() td(show(y.dhcp?)) end;
+ else
+ with-xml() td end;
+ end),
td { a(show(y.vlan.number),
href => concatenate("/vlan-detail?vlan=",
get-reference(y.vlan))) },
@@ -524,7 +539,14 @@
request :: <request>,
response :: <response>,
#key errors)
- let dnetwork = get-object(get-query-value("network"));
+ let net = get-query-value("network");
+ unless (net)
+ net := get-query-value("ipv4-network");
+ end;
+ unless (net)
+ net := get-query-value("ipv6-network");
+ end;
+ let dnetwork = get-object(net);
let out = output-stream(response);
with-buddha-template(out, concatenate("Network ", show(dnetwork), " detail"))
collect(show-errors(errors));
@@ -540,30 +562,7 @@
value => get-reference(dnetwork))
end)),
do(remove-form(dnetwork, storage(<network>), url: "network")),
- //dhcp options add|edit|remove
- h2(concatenate("DHCP options for subnet ", show(dnetwork))),
- do(if (dnetwork.dhcp-options.size > 0)
- with-xml()
- ul { do(map(method(x)
- with-xml()
- li { text(x), do(remove-form(x, dnetwork.dhcp-options,
- url: "network-detail",
- xml: with-xml()
- input(type => "hidden",
- name => "network",
- value => get-reference(dnetwork))
- end)) }
- end
- end, dnetwork.dhcp-options)) }
- end;
- end),
- do(add-form(<string>, "dhcp options", dnetwork.dhcp-options,
- refer: "network-detail",
- xml: with-xml()
- input(type => "hidden",
- name => "network",
- value => get-reference(dnetwork))
- end)),
+ do(dhcp-stuff(dnetwork)),
//add subnet with filled-in network?!
h2(concatenate("Subnets in network ", show(dnetwork))),
table { tr { th("CIDR"), th("dhcp?") },
@@ -573,7 +572,7 @@
{ td {a(show(x),
href => concatenate("/subnet-detail?subnet=",
get-reference(x))) },
- td(show(x.dhcp?)) }
+ td(if (instance?(x, <ipv4-subnet>)) show(x.dhcp?) else "" end) }
end
end, choose(method(y) y.network = dnetwork end, storage(<subnet>)))) }
}
@@ -599,13 +598,13 @@
map(method(x) with-xml()
tr(class => next-color(storage(<subnet>)))
{ td { a(show(x.cidr),
- href => concatenate("/subnet-detail?subnet=",
- get-reference(x))) },
- td(show(x.dhcp?)),
- td { a(show(x.vlan),
- href => concatenate("/vlan-detail?vlan=",
- get-reference(x.vlan))) }
- }
+ href => concatenate("/subnet-detail?subnet=",
+ get-reference(x))) },
+ do(collect-dhcp-into-table(x)),
+ td { a(show(x.vlan),
+ href => concatenate("/vlan-detail?vlan=",
+ get-reference(x.vlan))) }
+ }
end
end, storage(<subnet>)))
}
@@ -619,8 +618,23 @@
request :: <request>,
response :: <response>,
#key errors)
- let dsubnet = get-object(get-query-value("subnet"));
+ let sub = get-query-value("subnet");
+ unless (sub)
+ sub := get-query-value("ipv4-subnet");
+ end;
+ unless (sub)
+ sub := get-query-value("ipv6-subnet");
+ end;
+ let dsubnet = get-object(sub);
let out = output-stream(response);
+ if (instance?(dsubnet, <bottom-v6-subnet>))
+ with-buddha-template(out, "No IPv6 for you")
+ collect(with-xml()
+ div(id => "content")
+ { h1("This page was intentionally left blank...")}
+ end);
+ end;
+ else
with-buddha-template(out, concatenate("Subnet ", show(dsubnet), " detail"))
collect(show-errors(errors));
collect(with-xml()
@@ -642,30 +656,7 @@
href => concatenate("/network-detail?network=",
get-reference(dsubnet.network))) }
},
- //dhcp options edit|remove
- h2(concatenate("DHCP options for subnet ", show(dsubnet))),
- do(if (dsubnet.dhcp-options.size > 0)
- with-xml()
- ul { do(map(method(x) with-xml()
- li { text(x),
- do(remove-form(x, dsubnet.dhcp-options,
- url: "subnet-detail",
- xml: with-xml()
- input(type => "hidden",
- name => "subnet",
- value => get-reference(dsubnet))
- end)) }
- end
- end, dsubnet.dhcp-options)) }
- end
- end),
- do(add-form(<string>, "dhcp options", dsubnet.dhcp-options,
- refer: "subnet-detail",
- xml: with-xml()
- input(type => "hidden",
- name => "subnet",
- value => get-reference(dsubnet))
- end)),
+ do(dhcp-stuff(dsubnet)),
h2(concatenate("Hosts in subnet ", show(dsubnet))),
table { tr { th("Hostname"), th("IP"), th("Mac")},
do(reset-color(storage(<host>));
@@ -677,11 +668,12 @@
td(show(x.ipv4-address)),
td(show(x.mac-address)) }
end
- end, choose(method(y) y.subnet = dsubnet end, storage(<host>)))) }
+ end, choose(method(y) y.ipv4-subnet = dsubnet end, storage(<host>)))) }
//add host with predefined subnet (cause we have the context)?
}
end);
end;
+ end;
end;
define method insert-br (list :: <collection>) => (res :: <collection>)
@@ -763,7 +755,7 @@
{ td { a(show(x.cidr),
href => concatenate("/subnet-detail?subnet=",
get-reference(x))) },
- td(show(x.dhcp?)) }
+ do(collect-dhcp-into-table(x)) }
end
end, choose(method(x) x.vlan = dvlan end, storage(<subnet>))))
}
@@ -786,7 +778,7 @@
{
table
{
- tr { th("Hostname"), th("IP-Address"), th("Subnet"), th("Zone") },
+ tr { th("Hostname"), th("IPv4-Address"), th("IPv4-Subnet"), th("IPv6-Address"), th("IPv6-Subnet"), th("Zone") },
do(reset-color(storage(<host>));
map(method(x) with-xml()
tr(class => next-color(storage(<host>)))
@@ -794,9 +786,13 @@
href => concatenate("/host-detail?host=",
get-reference(x))) },
td (show(x.ipv4-address)),
- td { a(show(x.subnet),
+ td { a(show(x.ipv4-subnet),
+ href => concatenate("/subnet-detail?subnet=",
+ get-reference(x.ipv4-subnet))) },
+ td (if (instance?(x.ipv6-subnet, <bottom-v6-subnet>)) "" else show(x.ipv6-address) end),
+ td { a(show(x.ipv6-subnet),
href => concatenate("/subnet-detail?subnet=",
- get-reference(x.subnet))) },
+ get-reference(x.ipv6-subnet))) },
td { a(show(x.zone),
href => concatenate("/zone-detail?zone=",
get-reference(x.zone))) }
@@ -830,9 +826,12 @@
value => get-reference(host))
end)),
do(remove-form(host, storage(<host>), url: "host")),
- ul { li { text("Subnet "), a(show(host.subnet),
- href => concatenate("/subnet-detail?subnet=",
- get-reference(host.subnet))) },
+ ul { li { text("IPv4 Subnet "), a(show(host.ipv4-subnet),
+ href => concatenate("/subnet-detail?subnet=",
+ get-reference(host.ipv4-subnet))) },
+ li { text("IPv6 Subnet "), a(show(host.ipv6-subnet),
+ href => concatenate("/subnet-detail?subnet=",
+ get-reference(host.ipv6-subnet))) },
li { text("Zone "), a(show(host.zone),
href => concatenate("/zone-detail?zone=",
get-reference(host.zone))) }
Modified: trunk/libraries/network/koala/sources/examples/buddha/buddha.lid
==============================================================================
--- trunk/libraries/network/koala/sources/examples/buddha/buddha.lid (original)
+++ trunk/libraries/network/koala/sources/examples/buddha/buddha.lid Sun Dec 17 03:39:06 2006
@@ -8,6 +8,7 @@
subnet
cidr
ipv4
+ ipv6
host
zone
mac
Modified: trunk/libraries/network/koala/sources/examples/buddha/cidr.dylan
==============================================================================
--- trunk/libraries/network/koala/sources/examples/buddha/cidr.dylan (original)
+++ trunk/libraries/network/koala/sources/examples/buddha/cidr.dylan Sun Dec 17 03:39:06 2006
@@ -8,6 +8,13 @@
required-init-keyword: netmask:;
end class;
+define method ip-version (cidr :: <cidr>) => (res :: <integer>)
+ if (instance?(cidr.cidr-network-address, <ipv4-address>))
+ 4
+ elseif (instance?(cidr.cidr-network-address, <ipv6-address>))
+ 6;
+ end;
+end;
define method \< (a :: <cidr>, b :: <cidr>)
=> (res :: <boolean>)
a.cidr-network-address < b.cidr-network-address
@@ -36,6 +43,9 @@
define method as(class == <cidr>, string :: <string>)
=> (res :: <cidr>)
let address-and-mask = split(string, '/');
+ unless (address-and-mask.size = 2)
+ signal(make(<web-error>, error: "CIDR syntax wrong IP/Netmask[prefixlen]"));
+ end;
let network-address = address-and-mask[0];
let netmask = address-and-mask[1];
network-address := make(<ip-address>, data: network-address);
@@ -61,7 +71,7 @@
let mask = map(method(x)
logand(255, lognot(x));
end, netmask-address(cidr));
- make(<ip-address>,
+ make(cidr.cidr-network-address.object-class,
data: map(logior,
network-address(cidr),
mask));
@@ -74,7 +84,7 @@
define method netmask-address (cidr :: <cidr>)
=> (ip-address :: <ip-address>)
- as(<ip-address>, cidr.cidr-netmask);
+ as(cidr.cidr-network-address.object-class, cidr.cidr-netmask);
end;
define method cidr-in-cidr? (smaller :: <cidr>, bigger :: <cidr>)
Modified: trunk/libraries/network/koala/sources/examples/buddha/config.dylan
==============================================================================
--- trunk/libraries/network/koala/sources/examples/buddha/config.dylan (original)
+++ trunk/libraries/network/koala/sources/examples/buddha/config.dylan Sun Dec 17 03:39:06 2006
@@ -100,20 +100,20 @@
signal(make(<web-error>,
error: "A record already exists in zone"));
elseif (size(choose(method(x) x.ipv4-address = host.ipv4-address end,
- choose(method(x) x.subnet = host.subnet end, storage(<host>)))) > test-result)
+ choose(method(x) x.ipv4-subnet = host.ipv4-subnet end, storage(<host>)))) > test-result)
signal(make(<web-error>,
error: "Host with same IP address already exists in subnet"));
- elseif (host.subnet.dhcp?
+ elseif (host.ipv4-subnet.dhcp?
& size(choose(method(x) x.mac-address = host.mac-address end,
- choose(method(x) x.subnet = host.subnet end,
+ choose(method(x) x.ipv4-subnet = host.ipv4-subnet end,
storage(<host>)))) > test-result)
signal(make(<web-error>,
error: "Host with same MAC address already exists in subnet"));
- elseif ((host.ipv4-address = network-address(host.subnet.cidr)) |
- (host.ipv4-address = broadcast-address(host.subnet.cidr)))
+ elseif ((host.ipv4-address = network-address(host.ipv4-subnet.cidr)) |
+ (host.ipv4-address = broadcast-address(host.ipv4-subnet.cidr)))
signal(make(<web-error>,
error: "Host can't have the network or broadcast address as IP"));
- elseif (~ ip-in-net?(host.subnet, host.ipv4-address))
+ elseif (~ ip-in-net?(host.ipv4-subnet, host.ipv4-address))
signal(make(<web-error>,
error: "Host is not in specified network"))
else
@@ -157,7 +157,7 @@
end if;
end;
-define method check (subnet :: <subnet>, #key test-result = 0)
+define method check (subnet :: <ipv4-subnet>, #key test-result = 0)
=> (res :: <boolean>)
unless (network-address(subnet.cidr) = base-network-address(subnet.cidr))
signal(make(<web-form-warning>,
Modified: trunk/libraries/network/koala/sources/examples/buddha/host.dylan
==============================================================================
--- trunk/libraries/network/koala/sources/examples/buddha/host.dylan (original)
+++ trunk/libraries/network/koala/sources/examples/buddha/host.dylan Sun Dec 17 03:39:06 2006
@@ -3,10 +3,12 @@
define web-class <host> (<object>)
data host-name :: <string>;
- data ipv4-address :: <ip-address>;
- data time-to-live :: <integer> = 300;
data mac-address :: <mac-address> = as(<mac-address>, "00deadbeef00");
- has-a subnet;
+ data ipv4-address :: <ipv4-address>;
+ data ipv6-address :: <ipv6-address>, autoconf-v6(object.ipv6-subnet, object.mac-address);
+ data time-to-live :: <integer> = 300;
+ has-a ipv4-subnet;
+ has-a ipv6-subnet = $bottom-v6-subnet;
has-a zone;
end;
Modified: trunk/libraries/network/koala/sources/examples/buddha/ipv4.dylan
==============================================================================
--- trunk/libraries/network/koala/sources/examples/buddha/ipv4.dylan (original)
+++ trunk/libraries/network/koala/sources/examples/buddha/ipv4.dylan Sun Dec 17 03:39:06 2006
@@ -10,7 +10,35 @@
#key data,
#all-keys) => (res :: <ip-address>)
if (instance?(data, <string>))
- as(<ip-address>, data);
+ let v4-address? = split(data, '.');
+ if (v4-address?.size = 4)
+ as(<ipv4-address>, data);
+ else
+ as(<ipv6-address>, data);
+ end;
+ elseif (data.size = 4)
+ apply(make, <ipv4-address>, rest)
+ elseif (data.size = 16)
+ apply(make, <ipv6-address>, rest)
+ end;
+end;
+define class <ipv4-address> (<ip-address>)
+end;
+
+define method address-size (ip == <ipv4-address>)
+ 4;
+end;
+
+define method address-size (ip :: <ipv4-address>)
+ 4;
+end;
+define method make (ip-address == <ipv4-address>,
+ #next next-method,
+ #rest rest,
+ #key data,
+ #all-keys) => (res :: <ipv4-address>)
+ if (instance?(data, <string>))
+ as(<ipv4-address>, data);
else
apply(next-method, ip-address, rest);
end if;
@@ -23,7 +51,7 @@
format(stream, "%s", as(<string>, ip));
end;
-define method get-ptr (ip :: <ip-address>) => (res :: <string>)
+define method get-ptr (ip :: <ipv4-address>) => (res :: <string>)
concatenate(integer-to-string(ip[3]), "-", integer-to-string(ip[2]));
end;
@@ -31,14 +59,14 @@
define method \+ (a :: <ip-address>, b :: <integer>)
=> (res :: <ip-address>)
let rem :: <integer> = b;
- let res = make(<byte-vector>, size: 4, fill: 0);
+ let res = make(<byte-vector>, size: address-size(a), fill: 0);
for (ele in reverse(a),
- i from 3 by -1)
+ i from address-size(a) - 1 by -1)
let (quotient, remainder) = truncate/(ele + rem, 256);
res[i] := remainder;
rem := quotient;
end;
- res := make(<ip-address>, data: res);
+ res := make(a.object-class, data: res);
res;
end;
@@ -50,9 +78,9 @@
define method \- (a :: <ip-address>, b :: <integer>)
=> (res :: <ip-address>)
let rem :: <integer> = b;
- let res = make(<byte-vector>, size: 4, fill: 0);
+ let res = make(<byte-vector>, size: address-size(a), fill: 0);
for (ele in reverse(a),
- i from 3 by -1)
+ i from address-size(a) - 1 by -1)
if (ele - rem < 0)
res[i] := modulo(ele - rem, 256);
rem := abs(truncate/(rem, 256));
@@ -61,7 +89,7 @@
rem := 0;
end;
end;
- make(<ip-address>, data: res);
+ make(a.object-class, data: res);
end;
define method \< (a :: <ip-address>, b :: <ip-address>)
@@ -94,7 +122,7 @@
// conversions (string, ip, integer)
-define method as (class == <string>, ip-address :: <ip-address>)
+define method as (class == <string>, ip-address :: <ipv4-address>)
=> (res :: <string>)
let strings = make(<list>);
for (ele in ip-address)
@@ -105,10 +133,10 @@
end, reverse(strings));
end;
-define method as (class == <ip-address>, netmask :: <integer>)
+define method as (class :: subclass(<ip-address>), netmask :: <integer>)
=> (res :: <ip-address>)
- let res = make(<byte-vector>, size: 4, fill: 255);
- for (i from 0 below 4,
+ let res = make(<byte-vector>, size: address-size(class), fill: 255);
+ for (i from 0 below address-size(class),
mask from netmask by -8)
if (mask < 0)
res[i] := 0;
@@ -116,18 +144,18 @@
res[i] := logand(255, ash(255, 8 - mask));
end if
end for;
- make(<ip-address>, data: res);
+ make(class, data: res);
end;
-define method as (class == <ip-address>, string :: <string>)
- => (res :: <ip-address>)
+define method as (class == <ipv4-address>, string :: <string>)
+ => (res :: <ipv4-address>)
let numbers = split(string, '.');
let ints = map(string-to-integer, numbers);
let res = make(<byte-vector>, size: 4, fill: 0);
for (i from 0 below res.size)
res[i] := as(<byte>, ints[i]);
end;
- make(<ip-address>, data: res);
+ make(<ipv4-address>, data: res);
end;
Added: trunk/libraries/network/koala/sources/examples/buddha/ipv6.dylan
==============================================================================
--- (empty file)
+++ trunk/libraries/network/koala/sources/examples/buddha/ipv6.dylan Sun Dec 17 03:39:06 2006
@@ -0,0 +1,90 @@
+module: buddha
+Author: Hannes Mehnert <hannes at mehnert.org>
+
+define class <ipv6-address> (<ip-address>)
+end;
+
+define method address-size (ip == <ipv6-address>)
+ 16
+end;
+define method address-size (ip :: <ipv6-address>)
+ 16
+end;
+
+
+define method autoconf-v6 (subnet :: <bottom-v6-subnet>, mac :: <mac-address>)
+ => (res :: <ipv6-address>)
+ $bottom-v6-address
+end;
+define method autoconf-v6 (subnet :: <ipv6-subnet>, mac :: <mac-address>)
+ => (res :: <ipv6-address>)
+ //hmm, well, ok, this is an evil hack which will not work always....
+ //preconditions: prefixlen == 64 (otherwise will be padded with 0s)
+ let res = network-address(subnet.cidr);
+ res[15] := string-to-integer(mac[5], base: 16);
+ res[14] := string-to-integer(mac[4], base: 16);
+ res[13] := string-to-integer(mac[3], base: 16);
+ res[12] := #xfe;
+ res[11] := #xff;
+ res[10] := string-to-integer(mac[2], base: 16);
+ res[9] := string-to-integer(mac[1], base: 16);
+ res[8] := string-to-integer(mac[0], base: 16);
+ res;
+end;
+
+define method as (class == <ipv6-address>, data :: <string>) => (res :: <ipv6-address>)
+ //XXXX:XXXX::XXXX
+ if (data = "no v6 address assigned")
+ $bottom-v6-address;
+ else
+ let res = make(<byte-vector>, size: 16, fill: 0);
+ let numbers = split(data, ':');
+ let rev-parse? = #f;
+ local method set-bytes (offset :: <integer>, value :: <integer>)
+ res[offset] := ash(value, -8);
+ res[offset + 1] := logand(value, #xff);
+ end;
+ block (ret)
+ for (n in numbers, i from 0 by 2)
+ let n-size = n.size;
+ if (n-size = 0)
+ rev-parse? := #t;
+ ret()
+ else
+ set-bytes(i, string-to-integer(n, base: 16));
+ end;
+ end;
+ end;
+ if (rev-parse?)
+ block(ret)
+ for (i from 14 to 0 by -2,
+ n in reverse(numbers))
+ if (n.size > 0)
+ set-bytes(i, string-to-integer(n, base: 16));
+ else
+ ret();
+ end;
+ end;
+ end;
+ end;
+ make(<ipv6-address>, data: res);
+ end;
+end;
+
+define method as (class == <string>, ip :: <ipv6-address>) => (res :: <string>)
+ if (ip = $bottom-v6-address)
+ "no v6 address assigned"
+ else
+ let strings = make(<list>);
+ for (i from 0 below 16 by 2)
+ let count = ash(ip[i], 8) + ip[i + 1];
+ strings := add!(strings, integer-to-string(count, base: 16));
+ end;
+ reduce1(method(x, y) concatenate(x, ":", y) end, reverse(strings));
+end;
+end;
+
+define constant $bottom-v6-address = as(<ipv6-address>, "ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff");
+
+
+
Modified: trunk/libraries/network/koala/sources/examples/buddha/network.dylan
==============================================================================
--- trunk/libraries/network/koala/sources/examples/buddha/network.dylan (original)
+++ trunk/libraries/network/koala/sources/examples/buddha/network.dylan Sun Dec 17 03:39:06 2006
@@ -1,15 +1,48 @@
module: buddha
author: Hannes Mehnert <hannes at mehnert.org>
-define web-class <network> (<reference-object>)
+define abstract web-class <network> (<reference-object>)
data cidr :: <cidr>;
+end;
+
+define method make (class == <network>,
+ #rest rest, #key cidr, #all-keys) => (res :: <network>)
+ let version =
+ ip-version(if (instance?(cidr, <string>)) as(<cidr>, cidr) else cidr end);
+ if (version = 4)
+ apply(make, <ipv4-network>, rest);
+ elseif (version = 6)
+ apply(make, <ipv6-network>, rest);
+ end;
+end;
+define web-class <ipv6-network> (<network>)
+end;
+
+define method collect-dhcp-into-table (n :: <ipv6-network>) => (res :: <collection>)
+ let e = with-xml() td end;
+ list(e,e,e);
+end;
+define web-class <ipv4-network> (<network>)
data dhcp? :: <boolean> = #t;
data dhcp-default-lease-time :: <integer> = 1800;
data dhcp-max-lease-time :: <integer> = 7200;
- slot reverse-dns? :: <boolean>;
has-many dhcp-option :: <string>;
end;
+define method collect-dhcp-into-table (n :: <ipv4-network>) => (res :: <collection>)
+ let res = make(<stretchy-vector>);
+ add!(res, with-xml() td(show(n.dhcp?)) end);
+ add!(res, with-xml() td end);
+ add!(res, with-xml() td { do(if(n.dhcp?)
+ with-xml()
+ a("dhcpd.conf",
+ href => concatenate("/dhcp?network=",
+ get-reference(n)))
+ end
+ end) }
+ end);
+ res;
+end;
define method \< (a :: <network>, b :: <network>)
=> (res :: <boolean>)
a.cidr < b.cidr;
@@ -48,7 +81,7 @@
format(stream, "Network: CIDR: %s\n", as(<string>, network));
end;
-define method print-isc-dhcpd-file (print-network :: <network>,
+define method print-isc-dhcpd-file (print-network :: <ipv4-network>,
stream :: <stream>)
=> ();
if (print-network.dhcp?)
Modified: trunk/libraries/network/koala/sources/examples/buddha/subnet.dylan
==============================================================================
--- trunk/libraries/network/koala/sources/examples/buddha/subnet.dylan (original)
+++ trunk/libraries/network/koala/sources/examples/buddha/subnet.dylan Sun Dec 17 03:39:06 2006
@@ -9,12 +9,87 @@
//define dynamic generic hosts-setter (h :: <object>, o :: <object>)
// => (r :: <object>);
-define web-class <subnet> (<network>)
+define abstract web-class <subnet> (<network>)
has-a vlan;
has-a network;
- data dhcp-start :: <ip-address>, base-network-address(object.cidr) + 21;
- data dhcp-end :: <ip-address>, broadcast-address(object.cidr) - 1;
- data dhcp-router :: <ip-address>, base-network-address(object.cidr) + 1;
+end;
+
+define method make (class == <subnet>,
+ #rest rest, #key cidr, #all-keys) => (res :: <subnet>)
+ let version =
+ ip-version(if (instance?(cidr, <string>)) as(<cidr>, cidr) else cidr end);
+ if (version = 4)
+ apply(make, <ipv4-subnet>, rest);
+ elseif (version = 6)
+ apply(make, <ipv6-subnet>, rest);
+ end;
+end;
+define web-class <ipv6-subnet> (<subnet>, <ipv6-network>)
+end;
+
+define class <bottom-v6-subnet> (<ipv6-subnet>)
+end;
+
+define method as (class == <string>, f :: <bottom-v6-subnet>) => (res :: <string>);
+ "no ipv6 for you!"
+end;
+define method storage (class == <ipv6-subnet>) => (res)
+ choose(rcurry(instance?, <ipv6-subnet>), storage(<subnet>));
+end;
+define method collect-dhcp-into-table (n :: <ipv6-subnet>)
+ with-xml() td end;
+end;
+
+define method dhcp-stuff (n :: <ipv6-network>)
+ #()
+end;
+
+define web-class <ipv4-subnet> (<subnet>, <ipv4-network>)
+ data dhcp-start :: <ipv4-address>, base-network-address(object.cidr) + 21;
+ data dhcp-end :: <ipv4-address>, broadcast-address(object.cidr) - 1;
+ data dhcp-router :: <ipv4-address>, base-network-address(object.cidr) + 1;
+end;
+
+define method storage (class == <ipv4-subnet>) => (res)
+ choose(rcurry(instance?, <ipv4-subnet>), storage(<subnet>));
+end;
+
+define method collect-dhcp-into-table (x :: <ipv4-subnet>)
+ with-xml()
+ td(show(x.dhcp?))
+ end;
+end;
+
+define method dhcp-stuff (dsubnet :: <ipv4-network>)
+ let res = make(<stretchy-vector>);
+ add!(res, with-xml()
+ h2(concatenate("DHCP options for subnet ", show(dsubnet)))
+ end);
+ if (dsubnet.dhcp-options.size > 0)
+ add!(res, with-xml()
+ ul { do(map(method(x) with-xml()
+ li { text(x),
+ do(remove-form(x, dsubnet.dhcp-options,
+ url: "subnet-detail",
+ xml: with-xml()
+ input(type => "hidden",
+ name => "subnet",
+ value => get-reference(dsubnet))
+ end)) }
+ end
+ end, dsubnet.dhcp-options)) }
+ end);
+ end;
+ add!(res, with-xml()
+ do(add-form(<string>, "dhcp options", dsubnet.dhcp-options,
+ refer: "subnet-detail",
+ xml: with-xml()
+ input(type => "hidden",
+ name => "subnet",
+ value => get-reference(dsubnet))
+ end))
+ end);
+ res;
end;
define method print-object (subnet :: <subnet>, stream :: <stream>)
@@ -27,7 +102,7 @@
as(<string>, subnet.cidr);
end;
-define method print-isc-dhcpd-file (print-subnet :: <subnet>, stream :: <stream>)
+define method print-isc-dhcpd-file (print-subnet :: <ipv4-subnet>, stream :: <stream>)
=> ()
if (print-subnet.dhcp?)
format(stream, "subnet %s netmask %s {\n",
@@ -57,19 +132,19 @@
do(method(x)
print-isc-dhcpd-file(x, stream);
end, choose(method(x)
- x.subnet = print-subnet
+ x.ipv4-subnet = print-subnet
end, storage(<host>)))
end if;
end;
-define method generate-dhcp-ranges (this-subnet :: <subnet>)
+define method generate-dhcp-ranges (this-subnet :: <ipv4-subnet>)
=> (list :: <list>)
- let start-ip :: <ip-address> = this-subnet.dhcp-start;
- let end-ip :: <ip-address> = this-subnet.dhcp-end;
+ let start-ip :: <ipv4-address> = this-subnet.dhcp-start;
+ let end-ip :: <ipv4-address> = this-subnet.dhcp-end;
let res = make(<list>);
for (host in choose(method(x)
- x.subnet = this-subnet
+ x.ipv4-subnet = this-subnet
end, storage(<host>)))
let host-ip = host.ipv4-address;
if ((host-ip > start-ip) & (host-ip <= end-ip))
Modified: trunk/libraries/network/koala/sources/examples/buddha/zone.dylan
==============================================================================
--- trunk/libraries/network/koala/sources/examples/buddha/zone.dylan (original)
+++ trunk/libraries/network/koala/sources/examples/buddha/zone.dylan Sun Dec 17 03:39:06 2006
@@ -23,7 +23,7 @@
define web-class <a-record> (<object>)
data host-name :: <string>;
- data ipv4-address :: <ip-address>;
+ data ipv4-address :: <ipv4-address>;
data time-to-live :: <integer> = 300;
end;
@@ -82,6 +82,7 @@
end;
define web-class <zone> (<reference-object>)
+ slot used-names :: <string-table> = make(<string-table>);
data zone-name :: <string>;
data reverse? :: <boolean> = #f;
has-many cname :: <cname>;
Modified: trunk/libraries/network/web-framework/class-editor.dylan
==============================================================================
--- trunk/libraries/network/web-framework/class-editor.dylan (original)
+++ trunk/libraries/network/web-framework/class-editor.dylan Sun Dec 17 03:39:06 2006
@@ -31,9 +31,12 @@
//of global list of elements...
collect(with-xml()
\select(name => slot.slot-name)
- { do(for (ele in storage(slot.slot-type))
+ { do(let chosen = slot.slot-getter-method(object);
+ let sel = #f;
+ for (ele in storage(slot.slot-type))
if (visible?(ele))
- if (ele = slot.slot-getter-method(object))
+ if (ele = chosen)
+ sel := #t;
collect(with-xml()
option(as(<string>, ele),
value => get-reference(ele),
@@ -46,9 +49,17 @@
end)
end;
end if;
+ end;
+ unless(sel)
+ collect(with-xml()
+ option(as(<string>, chosen),
+ value => get-reference(chosen),
+ selected => "selected")
+ end);
end)
}
end);
+ collect(with-xml() br end);
end),
input(type => "hidden",
name => "parent-object",
@@ -155,9 +166,11 @@
let value = get-object(get-query-value(slot.slot-name));
collect(with-xml()
\select(name => slot.slot-name)
- { do(for (ele in storage(slot.slot-type))
+ { do(let sel = #t;
+ for (ele in storage(slot.slot-type))
if (visible?(ele))
if (fill-from-request & (ele = value))
+ sel := #f;
collect(with-xml()
option(as(<string>, ele),
value => get-reference(ele),
@@ -170,9 +183,17 @@
end);
end;
end;
+ end;
+ if (slot.default & sel)
+ collect(with-xml()
+ option(as(<string>, slot.default),
+ value => get-reference(slot.default),
+ selected => "selected")
+ end);
end)
}
end);
+ collect(with-xml() br end);
end),
input(type => "hidden",
name => "parent-object",
@@ -251,6 +272,7 @@
define method edit-slot (object :: <object>, slot-name :: <string>)
with-xml()
input(type => "text",
+ size => "60",
name => slot-name,
value => as(<string>, object))
end;
@@ -393,6 +415,20 @@
end unless;
slot.slot-setter-method(value, object);
end;
+ unless(object.object-class = object-type)
+ for (slot in data-slots(object.object-class))
+ unless(member?(as(<symbol>, slot.slot-name), init))
+ let value = slot.default | slot.default-function(object);
+ unless (slot.slot-type = <boolean> | value)
+ signal(make(<web-error>,
+ error: concatenate("Please specify ",
+ slot.slot-name,
+ " correctly!")));
+ end unless;
+ slot.slot-setter-method(value, object);
+ end;
+ end;
+ end;
let command = make(<add-command>,
arguments: list(object, parent-object));
Modified: trunk/libraries/network/web-framework/storage.dylan
==============================================================================
--- trunk/libraries/network/web-framework/storage.dylan (original)
+++ trunk/libraries/network/web-framework/storage.dylan Sun Dec 17 03:39:06 2006
@@ -32,7 +32,8 @@
<stretchy-vector>;
end;
-define method storage (type)
+define open generic storage (type) => (res);
+define method storage (type) => (res)
let res = element(*storage*, type, default: #f);
unless (res)
res := make(storage-type(type));
Modified: trunk/libraries/network/web-framework/web-macro.dylan
==============================================================================
--- trunk/libraries/network/web-framework/web-macro.dylan (original)
+++ trunk/libraries/network/web-framework/web-macro.dylan Sun Dec 17 03:39:06 2006
@@ -52,7 +52,7 @@
define method visible? (obj :: <object>) => (res :: <boolean>);
#t;
end;
-define open class <reference-object> (<object>)
+define abstract open class <reference-object> (<object>)
slot visible? :: <boolean> = #t, init-keyword: visible?:;
end;
@@ -127,6 +127,13 @@
type: "<" ## ?slot-name ## ">",
getter: ?slot-name,
setter: ?slot-name ## "-setter"), ... }
+ { has-a ?slot-name:name = ?default:expression; ... }
+ => { make(<slot>,
+ name: ?"slot-name",
+ type: "<" ## ?slot-name ## ">",
+ getter: ?slot-name,
+ setter: ?slot-name ## "-setter",
+ default: ?default), ... }
{ ?other:*; ... }
=> { ... }
end;
@@ -178,7 +185,7 @@
=> { slot ?slot-name ## "s" :: <stretchy-vector> = make(<stretchy-vector>) }
{ has-many ?slot-name:name \:: ?slot-type:* }
=> { slot ?slot-name ## "s" :: <stretchy-vector> = make(<stretchy-vector>) }
- { has-a ?slot-name:name }
+ { has-a ?slot-name:name ?rest:* }
=> { slot ?slot-name /* :: "<" ## ?slot-name ## ">" */,
init-keyword: ?#"slot-name" }
end;
More information about the chatter
mailing list