Author: hannes
Date: Fri Oct 7 01:28:56 2005
New Revision: 10252
Modified:
trunk/libraries/koala/sources/examples/buddha/buddha.dylan
trunk/libraries/koala/sources/examples/buddha/buddha.lid
trunk/libraries/koala/sources/examples/buddha/cisco-telnet.dylan
trunk/libraries/koala/sources/examples/buddha/class-editor.dylan
trunk/libraries/koala/sources/examples/buddha/config.dylan
trunk/libraries/koala/sources/examples/buddha/host.dylan
trunk/libraries/koala/sources/examples/buddha/ipv4.dylan
trunk/libraries/koala/sources/examples/buddha/library.dylan
trunk/libraries/koala/sources/examples/buddha/network.dylan
trunk/libraries/koala/sources/examples/buddha/subnet.dylan
trunk/libraries/koala/sources/examples/buddha/util.dylan
trunk/libraries/koala/sources/examples/buddha/vlan.dylan
trunk/libraries/koala/sources/examples/buddha/web-macro.dylan
trunk/libraries/koala/sources/examples/buddha/xml.dylan
trunk/libraries/koala/sources/examples/buddha/zone.dylan
Log:
Bug: 7257
use web-class macro... some slot renaming, some more class-editor stuff
Modified: trunk/libraries/koala/sources/examples/buddha/buddha.dylan
==============================================================================
--- trunk/libraries/koala/sources/examples/buddha/buddha.dylan (original)
+++ trunk/libraries/koala/sources/examples/buddha/buddha.dylan Fri Oct 7
01:28:56 2005
@@ -2,8 +2,7 @@
author: Hannes Mehnert <hannes@xxxxxxxxxxx>
define variable *config* = make(<config>,
- name: "config",
- vlans: make(<table>));
+ config-name: "config");
define variable *directory* = "www/buddha/";
@@ -109,7 +108,8 @@
with-buddha-template(out, "Edit")
with-xml()
div(id => "content") {
- do(edit(obj))
+ do(edit-form(obj)),
+ do(list-forms(obj))
}
end;
end;
@@ -263,7 +263,7 @@
div(id => "content")
{
do(let res = #();
- for (net in *config*.config-nets,
+ for (net in *config*.networks,
i from 0)
res := concatenate(gen-xml(net), res);
res := add!(res, with-xml()
@@ -310,17 +310,14 @@
\select(name => "vlan")
{
do(let res = make(<list>);
- do(
- method(x)
- let num = integer-to-string(x.vlan-number);
- res := add!(res, with-xml()
- option(concatenate(num,
- " ",
- x.vlan-name),
- value => num)
- end);
- end, get-sorted-list(*config*.config-vlans));
- reverse(res))
+ for (ele in *config*.vlans,
+ i from 0)
+ res := add!(res, with-xml()
+
option(as(<string>, ele),
+ value =>
integer-to-string(i))
+ end);
+ end;
+ reverse(res))
},
text("DHCP?"),
input(type => "checkbox",
@@ -350,7 +347,7 @@
name => "add-subnet-button",
value => concatenate
("Add subnet to ",
- as(<string>, net.network-cidr)))
+ as(<string>, net.cidr)))
}
}
end);
@@ -411,14 +408,14 @@
value => "remove-vlan"),
input(type => "hidden",
name => "vlan",
- value =>
integer-to-string(x.vlan-number)),
+ value =>
integer-to-string(x.number)),
input(type => "submit",
name => "remove-vlan-button",
value => "Remove VLAN")
}
}
end);
- end, get-sorted-list(*config*.config-vlans));
+ end, *config*.vlans);
reverse(res)),
form(action => "/vlan", \method => "post")
{
@@ -459,11 +456,11 @@
table
{
tr { th("Name"), th("IP"), th("Net"), th("Mac"), th("Zone") },
- do(for (net in *config*.config-nets)
- for (subnet in net.network-subnets)
+ do(for (net in *config*.networks)
+ for (subnet in net.subnets)
do(method(x)
collect(gen-xml(x));
- end, subnet.subnet-hosts);
+ end, subnet.hosts);
end;
end)
},
@@ -477,16 +474,16 @@
input(type => "text", name => "ip"),
text("MAC"),
input(type => "text", name => "mac"),
- \select(name => "zone")
- {
+ \select(name => "zone"),
+/* {
do(do(method(x)
collect(with-xml()
option(x.zone-name, value => x.zone-name)
end);
end, choose(method(x)
- ~ zone-reverse?(x);
- end, *config*.config-zones)))
- },
+ ~ reverse?(x);
+ end, *config*.zones)))
+ }, */
input(type => "submit",
name => "add-host-button",
value => "Add Host")
@@ -512,7 +509,7 @@
tr { th("Name") },
do(do(method(x)
collect(gen-xml(x));
- end, *config*.config-zones))
+ end, *config*.zones))
},
form(action => "/zone", \method => "post")
{
@@ -609,7 +606,7 @@
define method do-action (action == #"gen-dhcpd", response :: <response>)
=> (show-get? :: <boolean>)
let network = get-query-value("network");
- network := *config*.config-nets[string-to-integer(network)];
+ network := *config*.networks[string-to-integer(network)];
set-content-type(response, "text/plain");
print-isc-dhcpd-file(network, output-stream(response));
#f; //we don't want the default page!
@@ -621,34 +618,25 @@
let cidr = get-query-value("cidr");
let vlan = string-to-integer(get-query-value("vlan"));
let dhcp? = if (get-query-value("dhcp") = "dhcp") #t else #f end;
- if (dhcp?)
- let default-lease-time
- = string-to-integer(get-query-value("default-lease-time"));
- let max-lease-time
- = string-to-integer(get-query-value("max-lease-time"));
- format-out("DHCP %= %=\n", default-lease-time, max-lease-time);
- let options = parse-options(get-query-value("options"));
- let dhcp-start = parse-ip(get-query-value("dhcp-start"));
- let dhcp-end = parse-ip(get-query-value("dhcp-end"));
- let dhcp-router = parse-ip(get-query-value("dhcp-router"));
- let subnet = make(<subnet>,
- cidr: cidr,
- vlan: vlan,
- dhcp?: dhcp?,
- default-lease-time: default-lease-time,
- max-lease-time: max-lease-time,
- options: options,
- dhcp-start: dhcp-start,
- dhcp-end: dhcp-end,
- dhcp-router: dhcp-router);
- add-subnet(*config*.config-nets[string-to-integer(network)], subnet);
- else
- let subnet = make(<subnet>,
- cidr: cidr,
- vlan: vlan,
- dhcp?: dhcp?);
- add-subnet(*config*.config-nets[string-to-integer(network)], subnet);
- end;
+ let default-lease-time
+ = string-to-integer(get-query-value("default-lease-time"));
+ let max-lease-time
+ = string-to-integer(get-query-value("max-lease-time"));
+ let options = parse-options(get-query-value("options"));
+ let dhcp-start = as(<ip-address>, get-query-value("dhcp-start"));
+ let dhcp-end = as(<ip-address>, get-query-value("dhcp-end"));
+ let dhcp-router = as(<ip-address>, get-query-value("dhcp-router"));
+ let subnet = make(<subnet>,
+ cidr: make(<cidr>, network-address: cidr),
+ vlan: *config*.vlans[vlan],
+ dhcp?: dhcp?,
+ dhcp-default-lease-time: default-lease-time,
+ dhcp-max-lease-time: max-lease-time,
+ dhcp-options: options,
+ dhcp-start: dhcp-start,
+ dhcp-end: dhcp-end,
+ dhcp-router: dhcp-router);
+ add-subnet(*config*.networks[string-to-integer(network)], subnet);
#t;
end;
@@ -662,11 +650,11 @@
= string-to-integer(get-query-value("max-lease-time"));
let options = parse-options(get-query-value("options"));
let network = make(<network>,
- cidr: cidr,
+ cidr: make(<cidr>, network-address: cidr),
dhcp?: dhcp?,
- max-lease-time: max-lease-time,
- default-lease-time: default-lease-time,
- options: options);
+ dhcp-max-lease-time: max-lease-time,
+ dhcp-default-lease-time: default-lease-time,
+ dhcp-options: options);
add-net(*config*, network);
#t;
end;
@@ -674,7 +662,7 @@
define method do-action (action == #"remove-network", response :: <response>)
=> (show-get? :: <boolean>)
let network = get-query-value("network");
- remove-net(*config*, *config*.config-nets[string-to-integer(network)]);
+ remove-net(*config*, *config*.networks[string-to-integer(network)]);
#t;
end;
@@ -698,7 +686,7 @@
let description = get-query-value("description");
let vlan = make(<vlan>,
number: number,
- name: name,
+ vlan-name: name,
description: description);
add-vlan(*config*, vlan);
#t;
@@ -707,7 +695,9 @@
define method do-action (action == #"remove-vlan", response :: <response>)
=> (show-get? :: <boolean>)
let vlan = string-to-integer(get-query-value("vlan"));
- remove-vlan(*config*, vlan);
+ remove-vlan(*config*, choose(method(x)
+ x.number = vlan
+ end, *config*.vlans)[0]);
#t;
end;
@@ -725,7 +715,7 @@
let mail-exchange = get-query-value("mail-exchange");
let txt = get-query-value("txt");
let zone = make(<zone>,
- name: name,
+ zone-name: name,
hostmaster: hostmaster,
serial: serial,
refresh: refresh,
@@ -736,8 +726,7 @@
nameserver: list(nameserver),
mail-exchange: list(mail-exchange),
txt: list(txt));
- *config*.config-zones :=
- sort!(add!(*config*.config-zones, zone));
+ *config*.zones := sort!(add!(*config*.zones, zone));
respond-to-get(page, request, response);
end;
@@ -749,7 +738,7 @@
let zone = get-query-value("zone");
let network = find-network(find-network(*config*, ip), ip);
let host = make(<host>,
- name: name,
+ host-name: name,
ip: ip,
net: network,
mac: parse-mac(mac),
Modified: trunk/libraries/koala/sources/examples/buddha/buddha.lid
==============================================================================
--- trunk/libraries/koala/sources/examples/buddha/buddha.lid (original)
+++ trunk/libraries/koala/sources/examples/buddha/buddha.lid Fri Oct 7
01:28:56 2005
@@ -3,6 +3,7 @@
files: library
util
xml
+ web-macro
config
network
vlan
@@ -15,5 +16,4 @@
cisco-telnet
class-browser
class-editor
- web-macro
buddha
Modified: trunk/libraries/koala/sources/examples/buddha/cisco-telnet.dylan
==============================================================================
--- trunk/libraries/koala/sources/examples/buddha/cisco-telnet.dylan
(original)
+++ trunk/libraries/koala/sources/examples/buddha/cisco-telnet.dylan Fri Oct
7 01:28:56 2005
@@ -15,7 +15,7 @@
define method connect-to-cisco(cisco :: <cisco-ios-device>)
let address = make(<internet-address>,
- address: as(<string>, cisco.host-ipv4-address));
+ address: as(<string>, cisco.ipv4-address));
let socket = make(<tcp-socket>, host: address, port: 23);
Modified: trunk/libraries/koala/sources/examples/buddha/class-editor.dylan
==============================================================================
--- trunk/libraries/koala/sources/examples/buddha/class-editor.dylan
(original)
+++ trunk/libraries/koala/sources/examples/buddha/class-editor.dylan Fri Oct
7 01:28:56 2005
@@ -1,38 +1,164 @@
module: buddha
author: Hannes Mehnert <hannes@xxxxxxxxxxx>
+define method edit-form (object :: <object>) => (res)
+ with-xml()
+ form(action => "/edit", \method => "post")
+ { div(class => "edit")
+ { do(for (slot in data-slots(object))
+ format-out("SLOTSS %=\n", slot);
+ let object = slot.slot-getter-method(object);
+ format-out("SLOT %= %= %=\n",
+ slot.slot-name,
+ slot.slot-type,
+ object);
+ collect(with-xml() text(concatenate(slot.slot-name, ": ")) end);
+ //XXX check if slot is initialized?
+ collect(edit-slot(object, slot.slot-name));
+ collect(with-xml() br end);
+ end;
+ for (slot in reference-slots(object))
+
+ collect(with-xml() text(concatenate(slot.slot-name, ": ")) end);
+ //get slot, generate select, option field for each element
+ //of global list of elements...
+ collect(with-xml()
+ //probably better address of object?
+ \select(name => slot.slot-name)
+ { do(for (ele in slot.slot-getter-method(*config*))
+ collect(with-xml()
+ option(as(<string>, ele),
+ value => as(<string>, ele))
+ end)
+ end)
+ }
+ end);
+ end),
+ input(type => "hidden",
+ name => "obj-id",
+ value => get-reference(object)),
+ input(type => "hidden",
+ name => "action",
+ value => "save-object"),
+ input(type => "submit",
+ name => "save-button",
+ value => "Save")
+ }
+ }
+ end;
+end;
-define method edit (object :: <object>) => (res)
- let class = object.object-class;
+
+define method add-form (object :: <object>,
+ name :: <string>,
+ list :: <object>) => (foo) // :: <list> ?
+ format-out("ADD FORM name %= list %=\n",
+ name, list);
with-xml()
form(action => "/edit", \method => "post")
{ div(class => "edit")
- { do(for (slot in class.slot-descriptors)
- let name = slot.slot-getter.debug-name;
- collect(with-xml() text(concatenate(name, ": ")) end);
- if (slot-initialized?(object, slot))
- let slot-object = slot.slot-getter(object);
- collect(edit-slot(slot-object, name));
- if (instance?(slot-object, <list>))
- let type = list-type(object, name);
- if (type)
- collect(add-form(type));
- end;
- end if;
+ { do(for (slot in data-slots(object))
+ format-out("DATA SLOT %= %=\n", slot.slot-name, slot.slot-type);
+ collect(with-xml() text(concatenate(slot.slot-name, ": ")) end);
+ //here we should have at least a seperation between integer,
+ //strings and lists... or should we implement all lists with
+ //has-many?
+ if (slot.slot-type = <boolean>)
+ collect(with-xml() input(type => "checkbox",
+ name => slot.slot-name,
+ value => slot.slot-name)
+ end);
else
- //slot not initialized...
- collect(with-xml() input(type => "text", name => name) end)
- end if;
+ collect(with-xml() input(type => "text",
+ name => slot.slot-name)
+ end);
+ end;
collect(with-xml() br end);
+ end;
+ for (slot in reference-slots(object))
+ format-out("REF SLOT %= %= %=\n",
+ slot.slot-name,
+ slot.slot-type,
+ slot.slot-getter-method);
+ collect(with-xml() text(concatenate(slot.slot-name, ": ")) end);
+ //get slot, generate select, option field for each element
+ //of global list of elements...
+ collect(with-xml()
+ //probably better address of object?
+ \select(name => slot.slot-name)
+ { do(for (ele in slot.slot-getter-method(*config*))
+ //this will not work for hosts...
+ //because *config*.subnets is not defined
+ //anyway, when we come to the reference to the
+ //displayed object, it should be the displeyed
+ //object???.... not sure yet
+ collect(with-xml()
+ option(as(<string>, ele),
+ value => as(<string>, ele))
+ end)
+ end)
+ }
+ end);
end),
- input(type => "submit", name => "save-button", value => "Save")
+ input(type => "hidden",
+ name => "obj-id",
+ value => get-reference(list)),
+ input(type => "hidden",
+ name => "action",
+ value => "add-object"),
+ input(type => "submit",
+ name => "add-button",
+ value => concatenate("Add to ", name))
}
}
end;
end;
-define generic add-form (object :: <object>);
+define method list-forms (obj :: <object>) => (res)
+ let res = make(<stretchy-vector>);
+ format-out("LIST FORMS %=\n", obj);
+ for (slot in list-reference-slots(obj))
+ let object = slot.slot-getter-method(obj);
+ res := add!(res, with-xml()
+ text(concatenate(slot.slot-name, ": "))
+ end);
+ res := add!(res, with-xml() br end);
+ for (ele in object)
+ res := add!(res, with-xml()
+ a(as(<string>, ele),
+ href => concatenate("/edit?obj=",
+ get-reference(ele)))
+ end);
+ res := add!(res, with-xml()
+ form(action => "/edit", \method => "post")
+ { div(class => "edit")
+ { input(type => "hidden",
+ name => "obj-id",
+ value => get-reference(ele)),
+ input(type => "hidden",
+ name => "action",
+ value => "remove-object"),
+ input(type => "submit",
+ name => "remove-button",
+ value => "Remove")
+ }
+ }
+ end);
+ res := add!(res, with-xml() br end);
+ end;
+ format-out("Adding form for type %= slot-name %= to %=\n",
+ slot.slot-type,
+ slot.slot-name,
+ object);
+ res := add!(res, add-form(make(slot.slot-type),
+ slot.slot-name,
+ object));
+ end;
+ res;
+end;
+
+/*
define macro add-form-helper
{ add-form-helper(?type:name) end }
=> { define method add-form (type == ?#"type")
@@ -80,7 +206,7 @@
}
end;
end;
-
+*/
define generic edit-slot (object :: <object>, slot-name :: <string>);
define method edit-slot (object :: <object>, slot-name :: <string>)
Modified: trunk/libraries/koala/sources/examples/buddha/config.dylan
==============================================================================
--- trunk/libraries/koala/sources/examples/buddha/config.dylan (original)
+++ trunk/libraries/koala/sources/examples/buddha/config.dylan Fri Oct 7
01:28:56 2005
@@ -1,132 +1,104 @@
module: buddha
author: Hannes Mehnert <hannes@xxxxxxxxxxx>
-define class <config> (<object>)
- constant slot config-name :: <string>, required-init-keyword: name:;
- constant slot config-vlans :: <table>, init-keyword: vlans:;
- slot config-nets :: <list> = #(), init-keyword: nets:;
- slot config-zones :: <list> = #(), init-keyword: zones:;
- //slot config-dirty? :: <boolean> = #f;
+define web-class <config> (<object>)
+ data config-name :: <string>;
+ has-many vlan;
+ has-many network;
+ has-many zone;
+ has-many subnet;
end;
-define method list-type (config :: <config>, slot-name :: <string>)
- if (slot-name = "config-nets")
- as(<symbol>, "<network>")
- elseif (slot-name = "config-zones")
- as(<symbol>, "<zone>")
- end;
-end;
-
-define method make (config == <config>,
- #next next-method,
- #rest rest,
- #key vlans,
- #all-keys) => (res :: <config>)
- let args = rest;
- if (instance?(vlans, <list>))
- args := exclude(args, #"vlans");
- let vlan-table = make(<table>);
- for (vlan in vlans)
- vlan-table[vlan.vlan-number] := vlan;
- end;
- vlans := vlan-table;
- end if;
- apply(next-method, config, vlans: vlans, args);
-end;
-
-define method fits? (config :: <config>, cidr :: <cidr>)
+define method fits? (config :: <config>, fit-cidr :: <cidr>)
=> (res :: <boolean>)
//checks whether cidr is not used in network yet.
//each subnet (network-address and broadcast address)
//must be both greater than the network-address or
//both smaller than broadcast-address
every?(method(x)
- ((network-address(network-cidr(x)) > network-address(cidr)) &
- (broadcast-address(network-cidr(x)) > network-address(cidr))) |
- ((network-address(network-cidr(x)) < broadcast-address(cidr)) &
- (broadcast-address(network-cidr(x)) < broadcast-address(cidr)))
+ ((network-address(cidr(x)) > network-address(fit-cidr)) &
+ (broadcast-address(cidr(x)) > network-address(fit-cidr))) |
+ ((network-address(cidr(x)) < broadcast-address(fit-cidr)) &
+ (broadcast-address(cidr(x)) < broadcast-address(fit-cidr)))
end,
- config.config-nets);
+ config.networks);
end;
define method find-network (config :: <config>, ip-address :: <ip-address>)
=> (network :: false-or(<network>))
block(return)
- for (net in config.config-nets)
+ for (net in config.networks)
if (ip-in-net?(net, ip-address))
return(net)
end if;
end for;
#f;
end block;
-// choose(method(x)
-// ip-in-subnet(x, ip-address)
-// end, network.network-subnets)[0];
end;
define method find-zone (config :: <config>, zone :: <string>)
- choose(method(x)
+ //XXX [0] is obviously wrong here
+/* choose(method(x)
x.zone-name = zone;
- end, config.config-zones)[0];
+ end, config.zones)[0]; */
end;
define method print-object (config :: <config>, stream :: <stream>)
=> ()
format(stream, "Config: %s\n", config.config-name);
- for (net in config.config-nets)
+ for (net in config.networks)
format(stream, "%=\n", net);
end;
- for (vlan in config.config-vlans)
+ for (vlan in config.vlans)
format(stream, "%=\n", vlan);
end for;
- for (zone in config.config-zones)
+ for (zone in config.zones)
format(stream, "%=\n", zone);
end for;
end;
define method add-vlan (config :: <config>, vlan :: <vlan>)
=> ()
- if (element(config.config-vlans, vlan.vlan-number, default: #f))
- format-out("VLAN %d already exists!\n", vlan.vlan-number);
+ if (any?(method(x) x.number = vlan.number end , config.vlans))
+ format-out("VLAN %d already exists!\n", vlan.number);
else
- config.config-vlans[vlan.vlan-number] := vlan;
+ config.vlans := sort!(add!(config.vlans, vlan));
end;
end;
define method add-net (config :: <config>, network :: <network>)
=> ()
- if (fits?(*config*, network.network-cidr))
- config.config-nets := sort!(add!(config.config-nets, network));
+ if (fits?(*config*, network.cidr))
+ config.networks := sort!(add!(config.networks, network));
else
format-out("Network %= overlaps with another network, not added.\n",
- network.network-cidr);
+ network.cidr);
end if;
end;
-define method remove-vlan (config :: <config>, vlan-number :: <integer>)
+define method remove-vlan (config :: <config>, vlan :: <vlan>)
=> ()
- let vlan = config.config-vlans[vlan-number];
- if (vlan.vlan-subnets.size = 0)
- remove-key!(config.config-vlans, vlan-number);
+ if (vlan.subnets.size = 0)
+ remove!(config.vlans, vlan);
else
format-out("Couldn't remove vlan %d because it has subnets.\n",
- vlan-number);
+ vlan.number);
end;
end;
define method remove-net (config :: <config>, network :: <network>)
=> ()
- for (subnet in network.network-subnets)
+ for (subnet in network.subnets)
remove-subnet(network, subnet);
end;
- config.config-nets := remove!(config.config-nets, network);
+ config.networks := remove!(config.networks, network);
end;
define method print-bind-zone-file
(config :: <config>, stream :: <stream>)
=> ()
//we need to print dhcpd.conf file here
- for (zone in config.config-zones)
+ for (zone in config.zones)
print-bind-zone-file(zone, stream)
end;
end;
@@ -134,7 +106,7 @@
define method print-tinydns-zone-file
(config :: <config>, stream :: <stream>)
=> ()
- for (zone in config.config-zones)
+ for (zone in config.zones)
print-tinydns-zone-file(zone, stream)
end;
end;
Modified: trunk/libraries/koala/sources/examples/buddha/host.dylan
==============================================================================
--- trunk/libraries/koala/sources/examples/buddha/host.dylan (original)
+++ trunk/libraries/koala/sources/examples/buddha/host.dylan Fri Oct 7
01:28:56 2005
@@ -1,12 +1,12 @@
module: buddha
author: Hannes Mehnert <hannes@xxxxxxxxxxx>
-define class <host> (<object>)
- slot host-name :: <string>, init-keyword: name:;
- slot host-ipv4-address :: <ip-address>, required-init-keyword: ip:;
- slot host-net :: <subnet>, init-keyword: net:;
- slot host-mac :: <mac-address>, init-keyword: mac:;
- slot host-zone :: <zone>, init-keyword: zone:;
+define web-class <host> (<object>)
+ data host-name :: <string>;
+ data ipv4-address :: <ip-address>;
+ data mac-address :: <mac-address>;
+ has-a subnet;
+ has-a zone;
end;
define method make (host == <host>,
@@ -24,22 +24,22 @@
define method print-object (host :: <host>, stream :: <stream>)
=> ()
- format(stream, "Host %s Zone %s Mac %s\n",
+ format(stream, "Host %s Zone Mac %s\n",
host.host-name,
- host.host-zone.zone-name,
- as(<string>, host.host-mac));
+// host.zone.zone-name,
+ as(<string>, host.mac-address));
format(stream, "IP %s Net %s\n",
- as(<string>, host.host-ipv4-address),
- as(<string>, host.host-net.network-cidr));
+ as(<string>, host.ipv4-address),
+ as(<string>, host.subnet.cidr));
end;
define method \< (a :: <host>, b :: <host>) => (res :: <boolean>)
- a.host-ipv4-address < b.host-ipv4-address
+ a.ipv4-address < b.ipv4-address
end;
define method as (class == <string>, host :: <host>)
=> (res :: <string>)
- concatenate(host.host-name, " ", as(<string>, host.host-ipv4-address));
+ concatenate(host.host-name, " ", as(<string>, host.ipv4-address));
end;
define method gen-xml (host :: <host>)
@@ -47,10 +47,10 @@
tr
{
td(host.host-name),
- td(as(<string>, host.host-ipv4-address)),
- td(as(<string>, host.host-net.network-cidr)),
- td(as(<string>, host.host-mac)),
- td(host.host-zone.zone-name)
+ td(as(<string>, host.ipv4-address)),
+ td(as(<string>, host.subnet.cidr)),
+ td(as(<string>, host.mac-address)),
+// td(host.zone.zone-name)
}
end;
end;
@@ -58,8 +58,8 @@
define method print-isc-dhcpd-file (host :: <host>, stream :: <stream>)
=> ()
format(stream, "host %s {\n", host.host-name);
- format(stream, "\thardware ethernet %s;\n", as(<string>, host.host-mac));
- format(stream, "\tfixed-address %s;\n", as(<string>,
host.host-ipv4-address));
+ format(stream, "\thardware ethernet %s;\n", as(<string>, host.mac-address));
+ format(stream, "\tfixed-address %s;\n", as(<string>, host.ipv4-address));
format(stream, "}\n\n");
end;
Modified: trunk/libraries/koala/sources/examples/buddha/ipv4.dylan
==============================================================================
--- trunk/libraries/koala/sources/examples/buddha/ipv4.dylan (original)
+++ trunk/libraries/koala/sources/examples/buddha/ipv4.dylan Fri Oct 7
01:28:56 2005
@@ -155,8 +155,3 @@
end block;
mask;
end;
-
-define method parse-ip (ip) => (ip-address :: false-or(<ip-address>))
- format-out("PARSE %= %=\n", ip, object-class(ip));
- #f;
-end;
Modified: trunk/libraries/koala/sources/examples/buddha/library.dylan
==============================================================================
--- trunk/libraries/koala/sources/examples/buddha/library.dylan (original)
+++ trunk/libraries/koala/sources/examples/buddha/library.dylan Fri Oct 7
01:28:56 2005
@@ -16,9 +16,33 @@
export buddha;
end;
+define module web-macro
+ use dylan;
+
+ export <slot>,
+ slot-name,
+ slot-type,
+ slot-getter-method;
+
+ export list-reference-slots,
+ reference-slots,
+ data-slots;
+
+ export \web-class-definer;
+end;
+
+define module xml
+ use dylan;
+ use xml-parser;
+
+ export \with-xml,
+ \with-xml-builder,
+ escape-html;
+end;
+
define module buddha
use common-dylan;
- use dylan-extensions;
+ use dylan-extensions, exclude: { slot-type };
use threads;
use format-out;
use format, import: { format };
@@ -32,5 +56,6 @@
use sockets, import: { <tcp-socket>, <internet-address> };
use file-system;
use xml-rpc-common, import: { base64-encode, base64-decode };
- use xml-parser;
+ use xml;
+ use web-macro;
end;
Modified: trunk/libraries/koala/sources/examples/buddha/network.dylan
==============================================================================
--- trunk/libraries/koala/sources/examples/buddha/network.dylan (original)
+++ trunk/libraries/koala/sources/examples/buddha/network.dylan Fri Oct 7
01:28:56 2005
@@ -1,72 +1,50 @@
module: buddha
author: Hannes Mehnert <hannes@xxxxxxxxxxx>
-define class <network> (<object>)
- slot network-cidr :: <cidr>, required-init-keyword: cidr:;
- slot network-subnets :: <list> = #(), init-keyword: subnets:;
- slot dhcp? :: <boolean> = #t, init-keyword: dhcp?:;
- slot dhcp-default-lease-time :: false-or(<integer>) = #f,
- init-keyword: dhcp-default-lease-time:;
- slot dhcp-max-lease-time :: false-or(<integer>) = #f,
- init-keyword: dhcp-max-lease-time:;
- slot dhcp-options :: <list> = #(), init-keyword: dhcp-options:;
-end;
-
-define method list-type(network :: <network>, slot-name :: <string>)
- if (slot-name = "network-subnets")
- as(<symbol>, "<subnet>")
- elseif (slot-name = "dhcp-options")
- as(<symbol>, "<string>")
- end;
+define web-class <network> (<object>)
+ data cidr :: <cidr>;
+ has-many subnet;
+ data dhcp? :: <boolean>;
+ data dhcp-default-lease-time :: <integer>;
+ data dhcp-max-lease-time :: <integer>;
+ data dhcp-options :: <list>;
end;
-define method make (network == <network>,
- #next next-method,
- #rest rest,
- #key cidr,
- #all-keys) => (res :: <network>)
- let args = rest;
- if (instance?(cidr, <string>))
- args := exclude(args, #"cidr");
- cidr := make(<cidr>,
- network-address: cidr);
- end;
- unless (network-address(cidr) = base-network-address(cidr))
+//check in make or initialize (maybe of cidr???
+ /*unless (network-address(cidr) = base-network-address(cidr))
format-out("Network address is not the base network address, fixing
that!\n");
cidr.cidr-network-address := base-network-address(cidr);
- end;
- apply(next-method, network, cidr: cidr, args);
-end;
+ end;*/
define method \< (a :: <network>, b :: <network>)
=> (res :: <boolean>)
- a.network-cidr < b.network-cidr;
+ a.cidr < b.cidr;
end;
define method as (class == <string>, network :: <network>)
=> (res :: <string>)
- as(<string>, network.network-cidr)
+ as(<string>, network.cidr)
end;
-define method fits? (network :: <network>, cidr :: <cidr>)
+define method fits? (network :: <network>, fit-cidr :: <cidr>)
=> (res :: <boolean>)
//checks whether cidr is not used in network yet.
//each subnet (network-address and broadcast address)
//must be both greater than the network-address or
//both smaller than broadcast-address
every?(method(x)
- ((network-address(network-cidr(x)) > network-address(cidr)) &
- (broadcast-address(network-cidr(x)) > network-address(cidr))) |
- ((network-address(network-cidr(x)) < broadcast-address(cidr)) &
- (broadcast-address(network-cidr(x)) < broadcast-address(cidr)))
+ ((network-address(cidr(x)) > network-address(fit-cidr)) &
+ (broadcast-address(cidr(x)) > network-address(fit-cidr))) |
+ ((network-address(cidr(x)) < broadcast-address(fit-cidr)) &
+ (broadcast-address(cidr(x)) < broadcast-address(fit-cidr)))
end,
- network.network-subnets);
+ network.subnets);
end;
define method find-network (network :: <network>, ip-address :: <ip-address>)
=> (subnet :: false-or(<subnet>))
block(return)
- for (net in network.network-subnets)
+ for (net in network.subnets)
//format-out("FN %=\n", net);
if (ip-in-net?(net, ip-address))
return(net)
@@ -81,22 +59,22 @@
define method ip-in-net? (net :: <network>, ip-addr :: <ip-address>)
=> (res :: <boolean>)
- (((ip-addr > network-address(net.network-cidr)) |
- (ip-addr = network-address(net.network-cidr))) &
- (ip-addr <= broadcast-address(net.network-cidr)));
+ (((ip-addr > network-address(net.cidr)) |
+ (ip-addr = network-address(net.cidr))) &
+ (ip-addr <= broadcast-address(net.cidr)));
end;
define method subnet-in-net? (net :: <network>, subnet :: <subnet>)
=> (res :: <boolean>)
- (ip-in-net?(net, network-address(subnet.network-cidr)) &
- ip-in-net?(net, broadcast-address(subnet.network-cidr)))
+ (ip-in-net?(net, network-address(subnet.cidr)) &
+ ip-in-net?(net, broadcast-address(subnet.cidr)))
end;
define method print-object (network :: <network>, stream :: <stream>)
=> ()
format(stream, "Network: CIDR: %=\n",
- network.network-cidr);
- for (subnet in network.network-subnets)
+ network.cidr);
+ for (subnet in network.subnets)
format(stream, "%=\n", subnet);
end for;
end;
@@ -106,7 +84,7 @@
let res = make(<list>);
res := add!(res, with-xml()
text(concatenate("Network CIDR ",
- as(<string>, network.network-cidr)))
+ as(<string>, network.cidr)))
end);
res := add!(res, with-xml()
table
@@ -115,7 +93,7 @@
do(let res = make(<list>);
do(method(x)
res := add!(res, gen-xml(x));
- end, network.network-subnets);
+ end, network.subnets);
reverse(res))
}
end);
@@ -125,26 +103,27 @@
define method add-subnet (network :: <network>, subnet :: <subnet>)
=> ()
if (subnet-in-net?(network, subnet))
- if (fits?(network, subnet.network-cidr))
- network.network-subnets := sort!(add!(network.network-subnets, subnet));
- subnet.subnet-vlan.vlan-subnets
- := sort!(add!(subnet.subnet-vlan.vlan-subnets, subnet));
+ if (fits?(network, subnet.cidr))
+ network.subnets := sort!(add!(network.subnets, subnet));
+ subnet.vlan.subnets
+ := sort!(add!(subnet.vlan.subnets, subnet));
+ *config*.subnets := sort!(add!(*config*.subnets, subnet));
else
format-out("Subnet %= overlaps with another subnet, not added!\n",
- subnet.network-cidr);
+ subnet.cidr);
end if;
else
format-out("Subnet %= not in network %=, not added!\n",
- subnet.network-cidr, network.network-cidr);
+ subnet.cidr, network.cidr);
end;
end;
define method remove-subnet (network :: <network>, subnet :: <subnet>)
=> ()
- network.network-subnets := remove!(network.network-subnets,
- subnet);
- subnet.subnet-vlan.vlan-subnets
- := remove!(subnet.subnet-vlan.vlan-subnets, subnet);
+ network.subnets := remove!(network.subnets, subnet);
+ subnet.vlan.subnets
+ := remove!(subnet.vlan.subnets, subnet);
+ *config*.subnets := remove!(*config*.subnets, subnet);
end;
define method print-isc-dhcpd-file (network :: <network>, stream :: <stream>)
@@ -161,7 +140,7 @@
do(method(x)
format(stream, "\t%s;\n", x);
end, network.dhcp-options);
- for (subnet in network.network-subnets)
+ for (subnet in network.subnets)
print-isc-dhcpd-file(subnet, stream);
end;
end if;
Modified: trunk/libraries/koala/sources/examples/buddha/subnet.dylan
==============================================================================
--- trunk/libraries/koala/sources/examples/buddha/subnet.dylan (original)
+++ trunk/libraries/koala/sources/examples/buddha/subnet.dylan Fri Oct 7
01:28:56 2005
@@ -1,124 +1,92 @@
module: buddha
author: Hannes Mehnert <hannes@xxxxxxxxxxx>
-define class <subnet> (<network>)
- slot subnet-vlan :: false-or(<vlan>) = #f, init-keyword: vlan:;
- slot subnet-hosts :: <list> = #(), init-keyword: hosts:;
- slot dhcp-start :: <ip-address>, init-keyword: dhcp-start:;
- slot dhcp-end :: <ip-address>, init-keyword: dhcp-end:;
- slot dhcp-router :: false-or(<ip-address>) = #f,
- init-keyword: dhcp-router:;
+//XXX: this should be dynamic generated...
+//without these I get lots of warnings:
+//Invalid type for argument object in call to
+// hosts (object :: <object>) => (#rest results :: <object>)
+// : <zone> supplied, <subnet> expected.
+define dynamic generic hosts (o :: <object>) => (r :: <object>);
+define dynamic generic hosts-setter (h :: <object>, o :: <object>)
+ => (r :: <object>);
+
+define web-class <subnet> (<network>)
+ has-a vlan;
+ has-many host;
+ data dhcp-start :: <ip-address>;
+ data dhcp-end :: <ip-address>;
+ data dhcp-router :: <ip-address>;
end;
-define method list-type(subnet :: <subnet>, slot-name :: <string>)
- if (slot-name = "subnet-hosts")
- as(<symbol>, "<host>")
- elseif (slot-name = "dhcp-options")
- as(<symbol>, "<string>")
- end;
-end;
-
-define method make (subnet == <subnet>,
- #next next-method,
- #rest rest,
- #key cidr,
- dhcp-start,
- dhcp-end,
- dhcp-router,
- vlan,
- #all-keys) => (res :: <subnet>)
- let args = rest;
- if (instance?(cidr, <string>))
- args := exclude(args, #"cidr");
- cidr := make(<cidr>,
- network-address: cidr);
- end if;
- if (instance?(vlan, <integer>))
- args := exclude(args, #"vlan");
- vlan := *config*.config-vlans[vlan];
- end;
- unless (dhcp-start)
- args := exclude(args, #"dhcp-start");
- dhcp-start := network-address(cidr) + 1;
- end unless;
- unless (dhcp-end)
- args := exclude(args, #"dhcp-end");
- dhcp-end := broadcast-address(cidr) - 1;
- end unless;
- unless (dhcp-router)
- args := exclude(args, #"dhcp-router");
- dhcp-router := network-address(cidr) + 1;
- end;
+/* chech in make or initialize or before all that stuff
unless (network-address(cidr) = base-network-address(cidr))
format-out("Network address is not the base network address, fixing
this!\n");
cidr.cidr-network-address := base-network-address(cidr);
end;
- apply(next-method, subnet, cidr: cidr, vlan: vlan,
- dhcp-start: dhcp-start, dhcp-end: dhcp-end,
- dhcp-router: dhcp-router, args);
-end;
+dhcp-start in subnet, dhcp-end in subnet, dhcp-router nicht in dhcp-range und
in subnet
+*/
define method print-object (subnet :: <subnet>, stream :: <stream>)
=> ()
- if (subnet.subnet-vlan)
+ if (subnet.vlan)
format(stream, "Subnet vlan %d cidr %=",
- subnet.subnet-vlan.vlan-number,
- subnet.network-cidr);
+ subnet.vlan.number,
+ subnet.cidr);
else
format(stream, "Subnet cidr %=",
- subnet.network-cidr);
+ subnet.cidr);
end;
end;
define method as (class == <string>, subnet :: <subnet>)
=> (res :: <string>)
- as(<string>, subnet.network-cidr);
+ as(<string>, subnet.cidr);
end;
define method gen-xml (subnet :: <subnet>)
with-xml()
- tr { td(as(<string>, subnet.network-cidr)),
- td(integer-to-string(subnet.subnet-vlan.vlan-number))
+ tr { td(as(<string>, subnet.cidr)),
+ td(integer-to-string(subnet.vlan.number))
}
end;
end;
define method add-host (subnet :: <subnet>, host :: <host>)
=> ()
- if ((host.host-ipv4-address = network-address(subnet.network-cidr)) |
- (host.host-ipv4-address = broadcast-address(subnet.network-cidr)))
+ if ((host.ipv4-address = network-address(subnet.cidr)) |
+ (host.ipv4-address = broadcast-address(subnet.cidr)))
format-out("Host can't have the network or broadcast address as IP %=\n",
host);
elseif (member?(host,
- subnet.subnet-hosts,
+ subnet.hosts,
test: method(x, y)
- x.host-ipv4-address = y.host-ipv4-address;
+ x.ipv4-address = y.ipv4-address;
end))
format-out("Host with same IP already exists: %=\n", host);
elseif (member?(host,
- host.host-zone.zone-hosts,
+ host.zone.hosts,
test: method(x, y)
x.host-name = y.host-name
end))
format-out("Host with same name already exists: %=\n", host);
elseif (member?(host,
- subnet.subnet-hosts,
+ subnet.hosts,
test: method(x, y)
- x.host-mac = y.host-mac
+ x.mac-address = y.mac-address
end))
format-out("Host with same mac already exists in this subnet: %=\n", host);
else
- subnet.subnet-hosts := sort!(add!(subnet.subnet-hosts, host));
- host.host-zone.zone-hosts
- := sort!(add!(host.host-zone.zone-hosts, host));
+ subnet.hosts := sort!(add!(subnet.hosts, host));
+ host.zone.hosts
+ := sort!(add!(host.zone.hosts, host));
end;
end;
define method remove-host (subnet :: <subnet>, host :: <host>)
=> ()
- subnet.subnet-hosts := remove!(subnet.subnet-hosts, host);
- host.host-zone.zone-hosts
- := remove!(host.host-zone.zone-hosts, host);
+ subnet.hosts := remove!(subnet.hosts, host);
+ host.zone.hosts
+ := remove!(host.zone.hosts, host);
end;
@@ -126,8 +94,8 @@
=> ()
if (subnet.dhcp?)
format(stream, "subnet %s netmask %s {\n",
- as(<string>, network-address(subnet.network-cidr)),
- as(<string>, netmask-address(subnet.network-cidr)));
+ as(<string>, network-address(subnet.cidr)),
+ as(<string>, netmask-address(subnet.cidr)));
if (subnet.dhcp-router)
format(stream, "\toption routers %s;\n",
as(<string>, subnet.dhcp-router));
@@ -149,7 +117,7 @@
as(<string>, tail(x)));
end, generate-dhcp-ranges(subnet));
format(stream, "}\n\n");
- for (host in subnet.subnet-hosts)
+ for (host in subnet.hosts)
print-isc-dhcpd-file(host, stream);
end;
end if;
@@ -160,8 +128,8 @@
let start-ip :: <ip-address> = subnet.dhcp-start;
let end-ip :: <ip-address> = subnet.dhcp-end;
let res = make(<list>);
- for (host in subnet.subnet-hosts)
- let host-ip = host.host-ipv4-address;
+ for (host in subnet.hosts)
+ let host-ip = host.ipv4-address;
if ((host-ip > start-ip) & (host-ip < end-ip))
res := add!(res, pair(start-ip, host-ip - 1));
end;
Modified: trunk/libraries/koala/sources/examples/buddha/util.dylan
==============================================================================
--- trunk/libraries/koala/sources/examples/buddha/util.dylan (original)
+++ trunk/libraries/koala/sources/examples/buddha/util.dylan Fri Oct 7
01:28:56 2005
@@ -12,13 +12,21 @@
res;
end method;
-define method get-sorted-list (table :: <table>)
- => (list :: <list>)
- let res = make(<list>);
- for (ele in table)
- res := add!(res, ele);
+define method replace-arg (args, symbol, type, new-value-method) => (sequence)
+ let res = make(<stretchy-vector>);
+ for (i from 0 below args.size by 2)
+ add!(res, args[i]);
+ if (args[i] ~= symbol)
+ add!(res, args[i + 1]);
+ else
+ if (instance?(args[i + 1], type))
+ add!(res, new-value-method(args[i + 1]));
+ else
+ add!(res, args[i + 1])
+ end;
+ end;
end;
- sort!(res);
+ res;
end;
define method regexp-match(big :: <string>, regex :: <string>) => (#rest
results);
Modified: trunk/libraries/koala/sources/examples/buddha/vlan.dylan
==============================================================================
--- trunk/libraries/koala/sources/examples/buddha/vlan.dylan (original)
+++ trunk/libraries/koala/sources/examples/buddha/vlan.dylan Fri Oct 7
01:28:56 2005
@@ -1,32 +1,26 @@
module: buddha
author: Hannes Mehnert <hannes@xxxxxxxxxxx>
-define class <vlan> (<object>)
- slot vlan-number :: <integer>, required-init-keyword: number:;
- slot vlan-name :: <string>, init-keyword: name:;
- slot vlan-description :: <string>, init-keyword: description:;
- slot vlan-subnets :: <list> = #();
-end;
-
-define method list-type (vlan :: <vlan>, slot-name :: <string>)
- if (slot-name = "vlan-subnets")
- as(<symbol>, "<subnet>")
- end;
+define web-class <vlan> (<object>)
+ data number :: <integer>;
+ data vlan-name :: <string>;
+ data description :: <string>;
+ has-many subnet;
end;
define method print-object (vlan :: <vlan>, stream :: <stream>)
=> ()
format(stream, "VLAN %d name %s description %s",
- vlan.vlan-number, vlan.vlan-name, vlan.vlan-description);
+ vlan.number, vlan.vlan-name, vlan.description);
end;
define method gen-xml (vlan :: <vlan>)
let res = make(<list>);
res := add!(res, with-xml()
text(concatenate("VLAN ",
- integer-to-string(vlan.vlan-number), " ",
+ integer-to-string(vlan.number), " ",
vlan.vlan-name, " ",
- vlan.vlan-description))
+ vlan.description))
end);
res := add!(res, with-xml()
table
@@ -36,7 +30,7 @@
do(method(x)
res := add!(res, gen-xml(x));
end,
- vlan.vlan-subnets);
+ vlan.subnets);
reverse(res))
}
end);
@@ -45,10 +39,10 @@
define method as (class == <string>, vlan :: <vlan>)
=> (res :: <string>)
- concatenate(integer-to-string(vlan.vlan-number), " ", vlan.vlan-name);
+ concatenate(integer-to-string(vlan.number), " ", vlan.vlan-name);
end;
define method \< (a :: <vlan>, b :: <vlan>)
=> (res :: <boolean>)
- a.vlan-number < b.vlan-number
+ a.number < b.number
end;
Modified: trunk/libraries/koala/sources/examples/buddha/web-macro.dylan
==============================================================================
--- trunk/libraries/koala/sources/examples/buddha/web-macro.dylan
(original)
+++ trunk/libraries/koala/sources/examples/buddha/web-macro.dylan Fri Oct
7 01:28:56 2005
@@ -1,13 +1,49 @@
-module: buddha
+module: web-macro
author: Hannes Mehnert <hannes@xxxxxxxxxxx>
+define class <slot> (<object>)
+ constant slot slot-name :: <string>, init-keyword: name:;
+ constant slot slot-type :: <object>, init-keyword: type:;
+ constant slot slot-getter-method :: <function>, init-keyword: getter:;
+end;
+
+define generic list-reference-slots
+ (object :: <object>, #next next-method)
+ => (res :: <list>);
+
+define generic reference-slots
+ (object :: <object>, #next next-method)
+ => (res :: <list>);
+
+define generic data-slots
+ (object :: <object>, #next next-method)
+ => (res :: <list>);
+
+define method list-reference-slots (object :: <object>)
+ => (res :: <list>)
+ #()
+end;
+
+define method reference-slots (object :: <object>)
+ => (res :: <list>)
+ #()
+end;
+
+define method data-slots (object :: <object>)
+ => (res :: <list>)
+ #()
+end;
+
define macro web-lists
{ web-lists(?slots) } => { list(?slots) }
slots:
{ } => { }
{ has-many ?slot-name:name; ... }
- => { as(<symbol>, ?"slot-name" ## "s"), ... }
+ => { make(<slot>,
+ name: ?"slot-name" ## "s",
+ type: "<" ## ?slot-name ## ">",
+ getter: ?slot-name ## "s"), ... }
{ ?other:*; ... }
=> { ... }
end;
@@ -18,7 +54,10 @@
slots:
{ } => { }
{ has-a ?slot-name:name; ... }
- => { ?#"slot-name", ... }
+ => { make(<slot>,
+ name: ?"slot-name",
+ type: "<" ## ?#"slot-name" ## ">",
+ getter: ?slot-name ## "s"), ... }
{ ?other:*; ... }
=> { ... }
end;
@@ -28,14 +67,17 @@
slots:
{ } => { }
- { data ?slot-name:name ?other:*; ... }
- => { ?#"slot-name", ... }
+ { data ?slot-name:name \:: ?slot-type:*; ... }
+ => { make(<slot>,
+ name: ?"slot-name",
+ type: ?slot-type,
+ getter: ?slot-name), ... }
{ ?other:*; ... }
=> { ... }
end;
define macro define-class
- { define-class(?:name; ?superclass:*; (?slots:*)) }
+ { define-class(?:name; ?superclass:*; ?slots:*) }
=> { define class ?name (?superclass) ?slots end }
slots:
@@ -56,100 +98,20 @@
{ define web-class ?:name (?superclass:*)
?class-slots:*
end }
- => { define-class(?name; ?superclass; (?class-slots));
- define inline method list-reference-slots (object :: ?name)
+ => { define-class(?name; ?superclass; ?class-slots);
+ define inline method list-reference-slots
+ (object :: ?name, #next next-method)
=> (res :: <list>)
- web-lists(?class-slots)
+ concatenate(next-method(), web-lists(?class-slots))
end;
- define inline method reference-slots (object :: ?name)
+ define inline method reference-slots
+ (object :: ?name, #next next-method)
=> (res :: <list>)
- web-reference(?class-slots)
+ concatenate(next-method(), web-reference(?class-slots));
end;
- define inline method data-slots (object :: ?name)
+ define inline method data-slots
+ (object :: ?name, #next next-method)
=> (res :: <list>)
- web-data(?class-slots)
+ concatenate(next-method(), web-data(?class-slots));
end; }
end;
-
-define web-class <foo> (<object>)
- data namen :: <string>;
- has-many vlan;
- has-many network;
- has-many zone;
- data foo :: <string>;
- has-a config;
- has-a host;
- has-many subnet;
-end;
-
-let class = make(<foo>);
-format-out("list: %=\n", list-reference-slots(class));
-format-out("reference: %=\n", reference-slots(class));
-format-out("data: %=\n", data-slots(class));
-for (slot in class.object-class.slot-descriptors)
- format-out("slot: %s\n", slot.slot-getter.debug-name)
-end;
-format-out("class %=\n", class);
-
-/*
-define web-class <config> (<object>)
- data name :: <string>;
- has-many vlan;
- has-many network;
- has-many zone;
-end;
-*/
-/*
-==>
-
-define class <config> (<object>)
- slot name :: <string>, init-keyword: name:;
- slot vlan :: <list> = #();
- slot network :: <list> = #();
- slot zone :: <list> = #();
-end;
-
-define method list-reference-slots (config :: <config>)
- list(#"vlan", #"network", #"zone")
-end;
-
-define method reference-slots (config :: <config>)
- list();
-end;
-
-define method data-slots (config :: <config>)
- list(#"name")
-end;
-*/
-/*
-define web-class <host> (<object>)
- data name :: <string>;
- data ipv4-address :: <ip-address>;
- data mac-address :: <mac-address>;
- has-a subnet;
- has-a zone;
-end;
-*/
-/*
-==>
-
-define class <host> (<object>)
- slot name :: <string>, init-keyword: name:;
- slot ipv4-address :: <ip-address>, init-keyword: ip-address:;
- slot mac-address :: <mac-address>, init-keyword: mac-address:;
- slot subnet :: <subnet>, init-keyword: subnet:;
- slot zone :: <zone>, init-keyword: zone:;
-end;
-
-define method list-reference-slots (host :: <host>)
- list();
-end;
-
-define method reference-slots (host :: <host>)
- list(#"subnet", #"zone")
-end;
-
-define method data-slots (host :: <host>)
- list(#"name", #"ipv4-address", #"mac-address");
-end;
-*/
Modified: trunk/libraries/koala/sources/examples/buddha/xml.dylan
==============================================================================
--- trunk/libraries/koala/sources/examples/buddha/xml.dylan (original)
+++ trunk/libraries/koala/sources/examples/buddha/xml.dylan Fri Oct 7
01:28:56 2005
@@ -1,4 +1,4 @@
-module: buddha
+module: xml
author: Hannes Mehnert <hannes@xxxxxxxxxxx>
/*
Modified: trunk/libraries/koala/sources/examples/buddha/zone.dylan
==============================================================================
--- trunk/libraries/koala/sources/examples/buddha/zone.dylan (original)
+++ trunk/libraries/koala/sources/examples/buddha/zone.dylan Fri Oct 7
01:28:56 2005
@@ -1,33 +1,26 @@
module: buddha
author: Hannes Mehnert <hannes@xxxxxxxxxxx>
-define class <zone> (<object>)
- slot zone-name :: <string>, required-init-keyword: name:;
- slot zone-reverse? :: <boolean> = #f;
- slot zone-hosts :: <list> = #();
- slot zone-cnames :: <list> = #();
- slot zone-hostmaster :: <string>, init-keyword: hostmaster:;
- slot zone-serial :: <integer>, init-keyword: serial:;
- slot zone-refresh :: <integer>, init-keyword: refresh:;
- slot zone-retry :: <integer>, init-keyword: retry:;
- slot zone-expire :: <integer>, init-keyword: expire:;
- slot zone-time-to-live :: <integer>, init-keyword: time-to-live:;
- slot zone-minimum :: <integer>, init-keyword: minimum:;
- slot zone-nameserver :: <list>, init-keyword: nameserver:;
- slot zone-mail-exchange :: <list>, init-keyword: mail-exchange:;
- slot zone-text :: <list> = #(), init-keyword: txt:;
-end class;
-
-define method list-type(zone :: <zone>, slot-name :: <string>)
- if (slot-name = "zone-hosts")
- as(<symbol>, "<host>")
- elseif (slot-name = "zone-nameserver")
- as(<symbol>, "<host>")
- elseif (slot-name = "zone-mail-exchange")
- as(<symbol>, "<host>")
- elseif (slot-name = "zone-text")
- as(<symbol>, "<string>")
- end;
+define class <cname> (<object>)
+ slot source :: <string>, init-keyword: source:;
+ slot target :: <string>, init-keyword: target:;
+end;
+
+define web-class <zone> (<object>)
+ data zone-name :: <string>;
+ data reverse? :: <boolean>;
+ has-many host;
+ has-many cname;
+ data hostmaster :: <string>;
+ data serial :: <integer>;
+ data refresh :: <integer>;
+ data retry :: <integer>;
+ data expire :: <integer>;
+ data time-to-live :: <integer>;
+ data minimum :: <integer>;
+ data nameserver :: <list>;
+ data mail-exchange :: <list>;
+ data text :: <list>;
end;
define method print-object (zone :: <zone>, stream :: <stream>)
@@ -48,76 +41,76 @@
define method print-bind-zone-file (zone :: <zone>, stream :: <stream>)
format(stream, "@\tIN\tSOA\t%s.\t%s. (\n",
- zone.zone-nameserver[0],
- zone.zone-hostmaster);
- format(stream, "\t\t%d\t; Serial\n", zone.zone-serial);
- format(stream, "\t\t%d\t; Refresh\n", zone.zone-refresh);
- format(stream, "\t\t%d\t; Retry\n", zone.zone-retry);
- format(stream, "\t\t%d\t; Expire\n", zone.zone-expire);
- format(stream, "\t\t%d )\t; Minimum\n\n", zone.zone-minimum);
- if (zone.zone-reverse?)
+ zone.nameserver[0],
+ zone.hostmaster);
+ format(stream, "\t\t%d\t; Serial\n", zone.serial);
+ format(stream, "\t\t%d\t; Refresh\n", zone.refresh);
+ format(stream, "\t\t%d\t; Retry\n", zone.retry);
+ format(stream, "\t\t%d\t; Expire\n", zone.expire);
+ format(stream, "\t\t%d )\t; Minimum\n\n", zone.minimum);
+ if (zone.reverse?)
do(method(x)
format(stream, "\tIN\tNS\t%s. \n", x)
- end, zone.zone-nameserver);
+ end, zone.nameserver);
do(method(x)
format(stream, "%d\tIN\tPTR\n%s.%s.\n",
- x.host-ipv4-address[3],
+ x.ipv4-address[3],
x.host-name,
zone.zone-name)
- end, zone.zone-hosts);
+ end, zone.hosts);
else
do(method(x)
format(stream, "\tIN\tNS\t%s. \n", x)
- end, zone.zone-nameserver);
+ end, zone.nameserver);
do(method(x)
format(stream, "\tIN\tMX\t%d\t%s.\n", head(x), tail(x))
- end, zone.zone-mail-exchange);
+ end, zone.mail-exchange);
do(method(x)
format(stream, "%s\tIN\tA\t%s\n",
x.host-name,
- as(<string>, x.host-ipv4-address))
- end, zone.zone-hosts);
+ as(<string>, x.ipv4-address))
+ end, zone.hosts);
do(method(x)
- format(stream, "%s\tCNAME\t%s\n", head(x), tail(x))
- end, zone.zone-cnames);
+ format(stream, "%s\tCNAME\t%s\n", source(x), target(x))
+ end, zone.cnames);
end;
end;
define method print-tinydns-zone-file (zone :: <zone>, stream :: <stream>)
//Zfqdn:mname:rname:ser:ref:ret:exp:min:ttl:timestamp:lo
format(stream, "Z%s:%s:%s:%d:%d:%d:%d:%d:%d\n",
- zone.zone-name, zone.zone-nameserver[0],
- zone.zone-hostmaster, zone.zone-serial,
- zone.zone-refresh, zone.zone-retry,
- zone.zone-expire, zone.zone-minimum,
- zone.zone-time-to-live);
+ zone.zone-name, zone.nameserver[0],
+ zone.hostmaster, zone.serial,
+ zone.refresh, zone.retry,
+ zone.expire, zone.minimum,
+ zone.time-to-live);
//nameserver
do(method(x)
format(stream, "&%s::%s\n", zone.zone-name, x)
- end, zone.zone-nameserver);
- if (zone.zone-reverse?)
+ end, zone.nameserver);
+ if (zone.reverse?)
//PTR
do(method(x)
format(stream, "^%s:%s\n",
x.host-name,
- as(<string>, x.host-ipv4-address));
- end, zone.zone-hosts);
+ as(<string>, x.ipv4-address));
+ end, zone.hosts);
else
//MX
do(method(x)
format(stream, "@%s::%s:%d\n",
zone.zone-name, tail(x), head(x));
- end, zone.zone-mail-exchange);
+ end, zone.mail-exchange);
//A
do(method(x)
format(stream, "+%s:%s\n",
x.host-name,
- as(<string>, x.host-ipv4-address));
- end, zone.zone-hosts);
+ as(<string>, x.ipv4-address));
+ end, zone.hosts);
//CNAME
do(method(x)
format(stream, "C%s:%s\n",
- head(x), tail(x));
- end, zone.zone-cnames);
+ source(x), target(x));
+ end, zone.cnames);
end;
end;
--
Gd-chatter mailing list
Gd-chatter@xxxxxxxxxxxxxxxx
https://gauss.gwydiondylan.org/mailman/listinfo/gd-chatter
|
