Author: hannes
Date: Thu Oct 20 02:25:46 2005
New Revision: 10280
Modified:
trunk/libraries/koala/sources/examples/buddha/TODO
trunk/libraries/koala/sources/examples/buddha/buddha.dylan
trunk/libraries/koala/sources/examples/buddha/buddha.lid
trunk/libraries/koala/sources/examples/buddha/class-browser.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/library.dylan
trunk/libraries/koala/sources/examples/buddha/mac.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/zone.dylan
Log:
Bug: 7257
*move lists with more than one reference to <config>
*don't save more than one reference to any object in any list...
only in the global list
*respond with object-type site, not #"edit"
*more and more error checking (shouldn't format-out, but signal an error)
Modified: trunk/libraries/koala/sources/examples/buddha/TODO
==============================================================================
--- trunk/libraries/koala/sources/examples/buddha/TODO (original)
+++ trunk/libraries/koala/sources/examples/buddha/TODO Thu Oct 20 02:25:46 2005
@@ -16,9 +16,6 @@
interface to get the next /XX subnet (or the next subnet with at least Y ips)
-add-form should be able to respond-to-get from the redirecting site, don't
- show /edit by default
-
with-xml:collect only works for elements, not for lists of elements
the following doesn't work (reference to undefined binding "collect" (but
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 Thu Oct 20
02:25:46 2005
@@ -274,23 +274,12 @@
#key errors)
//TODO: remove/edit subnet forms
let out = output-stream(response);
- let obj-list = get-query-value("obj-id");
- let parent-obj = get-query-value("obj-parent");
- obj-list := get-object(obj-list);
- unless (obj-list)
- obj-list := *config*.subnets;
- end;
- parent-obj := get-object(parent-obj);
- unless (parent-obj)
- parent-obj := *config*;
- end;
- with-buddha-template(out, concatenate("Subnets in ",
- as(<string>, parent-obj)))
+ with-buddha-template(out, "Subnets")
with-xml()
div(id => "content")
{
- do(browse-table(<subnet>, obj-list)),
- do(add-form(<subnet>, as(<string>, parent-obj), parent-obj))
+ do(browse-table(<subnet>, *config*.subnets)),
+ do(add-form(<subnet>, "Subnets", *config*.subnets))
}
end;
end;
@@ -314,7 +303,6 @@
end;
end;
-/*
define method respond-to-get
(page == #"host",
request :: <request>,
@@ -332,7 +320,6 @@
end;
end;
end;
-*/
define method respond-to-get
(page == #"zone",
@@ -382,25 +369,6 @@
end;
end;
end;
-
-/*
-define method respond-to-post
- (page == #"user", request :: <request>, response :: <response>)
- let ip = host-address(remote-host(request-socket(request)));
- let name = get-query-value("name");
- let mac = get-query-value("mac");
- let zone = *config*.config-zones[0];
- let network = find-network(*config*, ip);
- let host = make(<host>,
- host-name: name,
- ipv4-address: ip,
- subnet: find-network(network, ip),
- mac-address: parse-mac(mac),
- zone: zone);
- add-host(network, host);
- respond-to-get(page, request, response);
-end;
-*/
define method do-action (action == #"gen-dhcpd", response :: <response>)
=> (show-get? :: <boolean>)
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 Thu Oct 20
02:25:46 2005
@@ -11,8 +11,8 @@
subnet
cidr
ipv4
- zone
host
+ zone
mac
cisco-telnet
class-browser
Modified: trunk/libraries/koala/sources/examples/buddha/class-browser.dylan
==============================================================================
--- trunk/libraries/koala/sources/examples/buddha/class-browser.dylan
(original)
+++ trunk/libraries/koala/sources/examples/buddha/class-browser.dylan Thu Oct
20 02:25:46 2005
@@ -89,9 +89,7 @@
with-xml()
td {
a(show(size(value(object, slot))),
- href => concatenate("/", copy-sequence(slot.slot-type.debug-name,
- start: 1,
- end:
slot.slot-type.debug-name.size - 1),
+ href => concatenate("/", get-url-from-type(slot.slot-type),
"?obj-id=", get-reference(value(object, slot)),
"&obj-parent=", get-reference(object)))
}
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 Thu Oct
20 02:25:46 2005
@@ -218,40 +218,48 @@
end;
define method respond-to-post
- (page == #"edit", request :: <request>, response :: <response>)
+ (page == #"edit",
+ request :: <request>,
+ response :: <response>)
let errors = #();
let action = as(<symbol>, get-query-value("action"));
let object-string = get-query-value("obj-id");
+ let object = get-object(object-string);
+ let answer = #f;
let handler <buddha-form-warning>
= method(e :: <buddha-form-warning>, next-handler :: <function>)
errors := add!(errors, e)
end;
block(return)
//add, save, remove... we may not need this here...
- let object = get-object(object-string);
unless (object)
signal(make(<buddha-form-error>,
error: concatenate("Unknown object: ", object-string)));
end;
- select (action)
- #"add-object" => add-object(object, request);
- #"remove-object" => remove-object(object, request);
- #"save-object" => save-object(object, request);
- otherwise => make(<buddha-form-error>,
- error: concatenate("Unknown action: ",
- as(<string>, action)));
- end select;
+ answer :=
+ select (action)
+ #"add-object" => add-object(object, request);
+ #"remove-object" => remove-object(object, request);
+ #"save-object" => save-object(object, request);
+ otherwise => make(<buddha-form-error>,
+ error: concatenate("Unknown action: ",
+ as(<string>, action)));
+ end select;
exception (e :: <buddha-form-error>)
errors := add!(errors, e);
return();
end;
- respond-to-get(#"edit", request, response, errors: errors);
+ if (answer)
+ answer := as(<symbol>, get-url-from-type(answer))
+ else
+ answer := #"edit"
+ end;
+ respond-to-get(answer, request, response, errors: errors);
end;
define method add-object (parent-object :: <object>, request :: <request>)
//look what type of object needs to be generated
let object-type = get-object(get-query-value("object-type"));
- //if <string>, that's easy
//XXX: hmm, make should probably only be done when all slots
//are successfully parsed and then use init-keywords...
let object = make(object-type);
@@ -263,30 +271,32 @@
//data-slots ref-slots needs to be read and sanity checked
for (slot in data-slots(object-type))
let value = parse(slot.slot-name, slot.slot-type);
- //then set slots of object and add to parent list..
+ //then set slots of object
slot.slot-setter-method(value, object);
end;
for (slot in reference-slots(object-type))
let value = get-object(get-query-value(slot.slot-name));
slot.slot-setter-method(value, object);
- add-to-list(value, object);
end;
- parent-object := add!(parent-object, object);
+ //add to parent list..
+ //XXX: evil hardcoded hack
+ if (any?(method(x)
+ x.slot-type = object-type
+ end, list-reference-slots(<config>)))
+ add-thing(object);
+ else
+ parent-object := add!(parent-object, object);
+ end
end;
- //also may need to be added to other (global) lists
+ object.object-class;
end;
define method remove-object (parent-object :: <object>, request :: <request>)
//read object value, get it from $obj-table
let object = get-object(get-query-value("remove-this"));
//sanity type-check
- //remove from parent list and other has-a references
- for (slot in reference-slots(object.object-class))
- remove-from-list(slot.slot-getter-method(object), object);
- end;
-
parent-object := remove!(parent-object, object);
- //it may need to be removed from several (global) lists...
+ object.object-class;
end;
define method parse (name, type)
@@ -325,37 +335,9 @@
//slot-setter!
let current-object = slot.slot-getter-method(object);
if (value & (value ~= current-object))
- //remove old object from list of objects of referenced object
- remove-from-list(current-object, object);
-
//set slot in object
slot.slot-setter-method(value, object);
-
- //add new object to list of objects of referenced object
- add-to-list(value, object);
end;
end;
-end;
-
-define method find-slot (object :: <object>, name :: <object>)
- => (res)
- let class-name = debug-name(object-class(name));
- let class-getter-name = concatenate(copy-sequence(class-name,
- start: 1,
- end: class-name.size - 1),
- "s");
- let list-slot = choose(method(x)
- x.slot-name = class-getter-name
- end, list-reference-slots(object.object-class))[0];
- list-slot.slot-getter-method(object)
-end;
-
-define method remove-from-list (list :: <object>, element :: <object>)
- let old-list = find-slot(list, element);
- old-list := remove!(old-list, element);
-end;
-
-define method add-to-list (list :: <object>, element :: <object>)
- let new-list = find-slot(list, element);
- new-list := add!(new-list, element);
+ object.object-class;
end;
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 Thu Oct 20
02:25:46 2005
@@ -7,6 +7,7 @@
has-many network;
has-many zone;
has-many subnet;
+ has-many host;
end;
define method as (class == <string>, config :: <config>)
@@ -14,95 +15,120 @@
config.config-name
end;
-define method fits? (config :: <config>, fit-cidr :: <cidr>)
+define method print-object (config :: <config>, stream :: <stream>)
+ => ()
+ format(stream, "Config:%s\n", as(<string>, config))
+end;
+
+define method fits? (network :: <network>) => (res :: <boolean>)
+ fits?-aux (network, *config*.networks)
+end;
+
+define method fits? (subnet :: <subnet>) => (res :: <boolean>)
+ fits?-aux(subnet, *config*.subnets)
+end;
+
+define method fits?-aux (network :: <network>, list :: <collection>)
=> (res :: <boolean>)
//checks whether cidr is not used in network yet.
- //each subnet (network-address and broadcast address)
+ //each network (network-address and broadcast address)
//must be both greater than the network-address or
//both smaller than broadcast-address
every?(method(x)
- ((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)))
+ ((network-address(cidr(x)) > network-address(network.cidr)) &
+ (broadcast-address(cidr(x)) > network-address(network.cidr))) |
+ ((network-address(cidr(x)) < broadcast-address(network.cidr)) &
+ (broadcast-address(cidr(x)) < broadcast-address(network.cidr)))
end,
- config.networks);
+ list);
end;
-define method find-network (config :: <config>, ip-address :: <ip-address>)
- => (network :: false-or(<network>))
- block(return)
- for (net in config.networks)
- if (ip-in-net?(net, ip-address))
- return(net)
- end if;
- end for;
- #f;
- end block;
-end;
-
-define method find-zone (config :: <config>, zone :: <string>)
- //XXX [0] is obviously wrong here
- choose(method(x)
- x.zone-name = zone;
- end, config.zones)[0];
-end;
-define method print-object (config :: <config>, stream :: <stream>)
+define method add-thing (zone :: <zone>)
=> ()
- format(stream, "Config: %s\n", config.config-name);
- for (net in config.networks)
- format(stream, "%=\n", net);
+ if (any?(method(x) x.zone-name = zone.zone-name end , *config*.zones))
+ format-out("Zone %= already exists!\n", zone);
+ else
+ *config*.zones := sort!(add!(*config*.zones, zone));
end;
- for (vlan in config.vlans)
- format(stream, "%=\n", vlan);
- end for;
- for (zone in config.zones)
- format(stream, "%=\n", zone);
- end for;
end;
-define method add-vlan (config :: <config>, vlan :: <vlan>)
+define method add-thing (host :: <host>)
=> ()
- if (any?(method(x) x.number = vlan.number end , config.vlans))
- format-out("VLAN %d already exists!\n", vlan.number);
+ if (any?(method(x) x.host-name = host.host-name end,
+ choose(method(x) x.zone = host.zone end, *config*.hosts)))
+ format-out("Host with same name already exists in zone, didn't add\n");
+ elseif (any?(method(x) x.ipv4-address = host.ipv4-address end,
+ choose(method(x) x.subnet = host.subnet end, *config*.hosts)))
+ format-out("Host with same IP address already exists in subnet, didn't
add\n");
+ elseif (any?(method(x) x.mac-address = host.mac-address end,
+ choose(method(x) x.subnet = host.subnet end, *config*.hosts)))
+ format-out("Host with same MAC address already exists in subnet, didn't
add\n");
+ elseif ((host.ipv4-address = network-address(host.subnet.cidr)) |
+ (host.ipv4-address = broadcast-address(host.subnet.cidr)))
+ format-out("Host can't have the network or broadcast address as IP, didn't
add\n");
else
- config.vlans := sort!(add!(config.vlans, vlan));
+ *config*.hosts := sort!(add!(*config*.hosts, host));
end;
end;
-define method add-net (config :: <config>, network :: <network>)
+define method add-thing (vlan :: <vlan>)
=> ()
- if (fits?(*config*, network.cidr))
- config.networks := sort!(add!(config.networks, network));
+ if (any?(method(x) x.number = vlan.number end , *config*.vlans))
+ format-out("VLAN with same number already exists, didn't add\n");
+ elseif (any?(method(x) x.vlan-name = vlan.vlan-name end, *config*.vlans))
+ format-out("VLAN with same name already exists, didn't add\n");
else
- format-out("Network %= overlaps with another network, not added.\n",
- network.cidr);
- end if;
+ *config*.vlans := sort!(add!(*config*.vlans, vlan));
+ end;
end;
-define method remove-vlan (config :: <config>, vlan :: <vlan>)
+define method add-thing (network :: <network>)
=> ()
- if (vlan.subnets.size = 0)
- remove!(config.vlans, vlan);
- else
- format-out("Couldn't remove vlan %d because it has subnets.\n",
- vlan.number);
+ unless (network-address(network.cidr) = base-network-address(network.cidr))
+ format-out("Network address is not the base network address, fixing
this!\n");
+ network.cidr.cidr-network-address := base-network-address(network.cidr);
end;
+ if (fits?(network))
+ *config*.networks := sort!(add!(*config*.networks, network));
+ else
+ format-out("Network overlaps with another network, didn't add\n");
+ end if;
end;
-define method remove-net (config :: <config>, network :: <network>)
+define method add-thing (subnet :: <subnet>)
=> ()
- for (subnet in network.subnets)
- remove-subnet(network, subnet);
+ unless (network-address(subnet.cidr) = base-network-address(subnet.cidr))
+ format-out("Network address is not the base network address, fixing
this!\n");
+ subnet.cidr.cidr-network-address := base-network-address(subnet.cidr);
end;
- config.networks := remove!(config.networks, network);
+ if (fits?(subnet))
+ if (subnet-in-network? (subnet))
+ if (ip-in-net?(subnet, subnet.dhcp-start))
+ if (ip-in-net?(subnet, subnet.dhcp-end))
+ if (ip-in-net?(subnet, subnet.dhcp-router))
+ *config*.subnets := sort!(add!(*config*.subnets, subnet));
+ else
+ format-out("DHCP router not in subnet, didn't add\n");
+ end
+ else
+ format-out("DHCP end not in subnet, didn't add\n");
+ end
+ else
+ format-out("DHCP start not in subnet, didn't add\n");
+ end
+ else
+ format-out("Subnet not in a defined network, didn't add\n");
+ end
+ else
+ format-out("Subnet overlaps with another subnet, didn't add\n");
+ end if;
end;
define method print-bind-zone-file
(config :: <config>, stream :: <stream>)
=> ()
- //we need to print dhcpd.conf file here
+ //we need to print named.conf file here
for (zone in config.zones)
print-bind-zone-file(zone, stream)
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 Thu Oct 20
02:25:46 2005
@@ -11,13 +11,7 @@
define method print-object (host :: <host>, stream :: <stream>)
=> ()
- format(stream, "Host %s Zone %s Mac %s\n",
- host.host-name,
- host.zone.zone-name,
- as(<string>, host.mac-address));
- format(stream, "IP %s Net %s\n",
- as(<string>, host.ipv4-address),
- as(<string>, host.subnet.cidr));
+ format(stream, "Host: %s\n", as(<string>, host))
end;
define method \< (a :: <host>, b :: <host>) => (res :: <boolean>)
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 Thu Oct 20
02:25:46 2005
@@ -51,13 +51,25 @@
get-object;
end;
+define module utils
+ use common-dylan;
+ use dylan-extensions, import: { debug-name };
+ use regular-expressions;
+ export exclude,
+ regexp-match,
+ get-url-from-type,
+ <wrapper-sequence>,
+ <mutable-wrapper-sequence>,
+ data;
+end;
+
define module class-browser
use common-dylan;
use xml;
use web-macro;
use object-table;
use format-out;
- use dylan-extensions, import: { debug-name };
+ use utils;
export browse-list,
browse-table;
end;
@@ -69,17 +81,21 @@
use format-out;
use format, import: { format };
use print, import: { print-object };
- use koala, exclude: { print-object };
+
use streams;
use standard-io;
use character-type, import: { hex-digit? };
- use dood;
- use regular-expressions;
+
+ use koala, exclude: { print-object };
use sockets, import: { <tcp-socket>, <internet-address> };
+
+ use dood;
use file-system;
use xml-rpc-common, import: { base64-encode, base64-decode };
+
use xml;
use web-macro;
use object-table;
use class-browser;
+ use utils;
end;
Modified: trunk/libraries/koala/sources/examples/buddha/mac.dylan
==============================================================================
--- trunk/libraries/koala/sources/examples/buddha/mac.dylan (original)
+++ trunk/libraries/koala/sources/examples/buddha/mac.dylan Thu Oct 20
02:25:46 2005
@@ -4,8 +4,21 @@
define class <mac-address> (<wrapper-sequence>)
end;
-define method parse-mac (mac :: <string>)
- => (res :: false-or(<mac-address>))
+define method \= (a :: <mac-address>, b :: <mac-address>)
+ => (res :: <boolean>)
+ block(done)
+ for (ele1 in a,
+ ele2 in b)
+ unless (ele1 = ele2)
+ done(#f);
+ end;
+ end;
+ done(#t);
+ end;
+end;
+
+define method as (class == <mac-address>, mac :: <string>)
+ => (res :: <mac-address>)
block(parse-error)
mac := as-lowercase(mac);
if (any?(method(x) x = ':' end, mac))
@@ -39,37 +52,18 @@
parse-error(#f);
end unless;
end for;
- as(<mac-address>, mac);
+ let res = make(<list>, size: 6);
+ for (i from 0 below mac.size by 2,
+ j from 0)
+ res[j] := copy-sequence(mac, start: i, end: i + 2);
+ end;
+ make(<mac-address>,
+ data: res);
else
//something completely different
parse-error(#f);
end if;
end block;
-end;
-
-define method \= (a :: <mac-address>, b :: <mac-address>)
- => (res :: <boolean>)
- block(done)
- for (ele1 in a,
- ele2 in b)
- unless (ele1 = ele2)
- done(#f);
- end;
- end;
- done(#t);
- end;
-end;
-
-define method as (class == <mac-address>, string :: <string>)
- => (res :: <mac-address>)
- //we are sure string is a correct mac-address (12 hex digits)
- let mac = make(<list>, size: 6);
- for (i from 0 below string.size by 2,
- j from 0)
- mac[j] := copy-sequence(string, start: i, end: i + 2);
- end;
- make(<mac-address>,
- data: mac);
end;
define method as (class == <string>, mac :: <mac-address>)
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 Thu Oct 20
02:25:46 2005
@@ -3,19 +3,12 @@
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>;
has-many dhcp-option :: <string>;
end;
-//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;*/
-
define method \< (a :: <network>, b :: <network>)
=> (res :: <boolean>)
a.cidr < b.cidr;
@@ -25,36 +18,13 @@
=> (res :: <string>)
as(<string>, network.cidr)
end;
-
-define method fits? (network :: <network>, fit-cidr :: <cidr>)
+
+define method subnet-in-network? (subnet :: <subnet>)
=> (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(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.subnets);
-end;
-
-define method find-network (network :: <network>, ip-address :: <ip-address>)
- => (subnet :: false-or(<subnet>))
- block(return)
- for (net in network.subnets)
- //format-out("FN %=\n", net);
- 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];
+ fits?-aux(subnet,
+ choose(method(x)
+ x.network = subnet.network
+ end, *config*.networks))
end;
define method ip-in-net? (net :: <network>, ip-addr :: <ip-address>)
@@ -64,63 +34,30 @@
(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.cidr)) &
- ip-in-net?(net, broadcast-address(subnet.cidr)))
-end;
-
define method print-object (network :: <network>, stream :: <stream>)
=> ()
- format(stream, "Network: CIDR: %=\n",
- network.cidr);
- for (subnet in network.subnets)
- format(stream, "%=\n", subnet);
- end for;
+ format(stream, "Network: CIDR: %s\n", as(<string>, network));
end;
-define method add-subnet (network :: <network>, subnet :: <subnet>)
- => ()
- if (subnet-in-net?(network, 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.cidr);
- end if;
- else
- format-out("Subnet %= not in network %=, not added!\n",
- subnet.cidr, network.cidr);
- end;
-end;
-
-define method remove-subnet (network :: <network>, subnet :: <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>)
+define method print-isc-dhcpd-file (print-network :: <network>,
+ stream :: <stream>)
=> ();
- if (network.dhcp?)
- if (network.dhcp-default-lease-time)
+ if (print-network.dhcp?)
+ if (print-network.dhcp-default-lease-time)
format(stream, "\tdefault-lease-time %d;\n",
- network.dhcp-default-lease-time);
+ print-network.dhcp-default-lease-time);
end if;
- if (network.dhcp-max-lease-time)
+ if (print-network.dhcp-max-lease-time)
format(stream, "\tmax-lease-time %d;\n",
- network.dhcp-max-lease-time);
+ print-network.dhcp-max-lease-time);
end if;
do(method(x)
format(stream, "\t%s;\n", x);
- end, network.dhcp-options);
- for (subnet in network.subnets)
- print-isc-dhcpd-file(subnet, stream);
- end;
+ end, print-network.dhcp-options);
+ do(method(x)
+ print-isc-dhcpd-file(x, stream);
+ end, choose(method(x)
+ x.network = print-network
+ end, *config*.subnets))
end if;
end;
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 Thu Oct 20
02:25:46 2005
@@ -12,30 +12,15 @@
define web-class <subnet> (<network>)
has-a vlan;
- has-many host;
+ has-a network;
data dhcp-start :: <ip-address>;
data dhcp-end :: <ip-address>;
data dhcp-router :: <ip-address>;
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;
-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.vlan)
- format(stream, "Subnet vlan %d cidr %=",
- subnet.vlan.number,
- subnet.cidr);
- else
- format(stream, "Subnet cidr %=",
- subnet.cidr);
- end;
+ format(stream, "Subnet %s\n", as(<string>, subnet));
end;
define method as (class == <string>, subnet :: <subnet>)
@@ -43,84 +28,50 @@
as(<string>, subnet.cidr);
end;
-define method add-host (subnet :: <subnet>, host :: <host>)
- => ()
- 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.hosts,
- test: method(x, y)
- x.ipv4-address = y.ipv4-address;
- end))
- format-out("Host with same IP already exists: %=\n", host);
- elseif (member?(host,
- 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.hosts,
- test: method(x, y)
- x.mac-address = y.mac-address
- end))
- format-out("Host with same mac already exists in this subnet: %=\n", host);
- else
- 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.hosts := remove!(subnet.hosts, host);
- host.zone.hosts
- := remove!(host.zone.hosts, host);
-end;
-
-
-define method print-isc-dhcpd-file (subnet :: <subnet>, stream :: <stream>)
+define method print-isc-dhcpd-file (print-subnet :: <subnet>, stream ::
<stream>)
=> ()
- if (subnet.dhcp?)
+ if (print-subnet.dhcp?)
format(stream, "subnet %s netmask %s {\n",
- as(<string>, network-address(subnet.cidr)),
- as(<string>, netmask-address(subnet.cidr)));
- if (subnet.dhcp-router)
+ as(<string>, network-address(print-subnet.cidr)),
+ as(<string>, netmask-address(print-subnet.cidr)));
+ if (print-subnet.dhcp-router)
format(stream, "\toption routers %s;\n",
- as(<string>, subnet.dhcp-router));
+ as(<string>, print-subnet.dhcp-router));
end if;
- if (subnet.dhcp-default-lease-time)
+ if (print-subnet.dhcp-default-lease-time)
format(stream, "\tdefault-lease-time %d;\n",
- subnet.dhcp-default-lease-time);
+ print-subnet.dhcp-default-lease-time);
end if;
- if (subnet.dhcp-max-lease-time)
+ if (print-subnet.dhcp-max-lease-time)
format(stream, "\tmax-lease-time %d;\n",
- subnet.dhcp-max-lease-time);
+ print-subnet.dhcp-max-lease-time);
end if;
do(method(x)
format(stream, "\t%s;\n", x);
- end, subnet.dhcp-options);
+ end, print-subnet.dhcp-options);
do(method(x)
format(stream, "\trange %s %s;\n",
as(<string>, head(x)),
as(<string>, tail(x)));
- end, generate-dhcp-ranges(subnet));
+ end, generate-dhcp-ranges(print-subnet));
format(stream, "}\n\n");
- for (host in subnet.hosts)
- print-isc-dhcpd-file(host, stream);
- end;
+ do(method(x)
+ print-isc-dhcpd-file(x, stream);
+ end, choose(method(x)
+ x.subnet = print-subnet
+ end, *config*.hosts))
+
end if;
end;
-define method generate-dhcp-ranges (subnet :: <subnet>)
+define method generate-dhcp-ranges (this-subnet :: <subnet>)
=> (list :: <list>)
- let start-ip :: <ip-address> = subnet.dhcp-start;
- let end-ip :: <ip-address> = subnet.dhcp-end;
+ let start-ip :: <ip-address> = this-subnet.dhcp-start;
+ let end-ip :: <ip-address> = this-subnet.dhcp-end;
let res = make(<list>);
- for (host in subnet.hosts)
+ for (host in choose(method(x)
+ x.subnet = this-subnet
+ end, *config*.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));
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 Thu Oct 20
02:25:46 2005
@@ -1,4 +1,4 @@
-module: buddha
+module: utils
author: Hannes Mehnert <hannes@xxxxxxxxxxx>
define method exclude (list, symbol) => (sequence)
@@ -44,6 +44,12 @@
end
end;
apply(values, result)
+end;
+
+define method get-url-from-type (type) => (string :: <string>)
+ copy-sequence(type.debug-name,
+ start: 1,
+ end: type.debug-name.size - 1)
end;
define class <wrapper-sequence> (<sequence>)
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 Thu Oct 20
02:25:46 2005
@@ -5,13 +5,11 @@
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.number, vlan.vlan-name, vlan.description);
+ format(stream, "VLAN %s\n", as(<string>, vlan))
end;
define method as (class == <string>, vlan :: <vlan>)
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 Thu Oct 20
02:25:46 2005
@@ -9,7 +9,6 @@
define web-class <zone> (<object>)
data zone-name :: <string>;
data reverse? :: <boolean>;
- has-many host;
has-many cname;
data hostmaster :: <string>;
data serial :: <integer>;
@@ -25,7 +24,7 @@
define method print-object (zone :: <zone>, stream :: <stream>)
=> ();
- format(stream, "%s", zone.zone-name);
+ format(stream, "Zone: %s\n", as(<string>, zone));
end method;
define method as (class == <string>, zone :: <zone>)
@@ -33,78 +32,98 @@
zone.zone-name;
end;
-define method print-bind-zone-file (zone :: <zone>, stream :: <stream>)
+define method print-bind-zone-file (print-zone :: <zone>, stream :: <stream>)
format(stream, "@\tIN\tSOA\t%s.\t%s. (\n",
- zone.nameservers[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?)
+ print-zone.nameservers[0],
+ print-zone.hostmaster);
+ format(stream, "\t\t%d\t; Serial\n", print-zone.serial);
+ format(stream, "\t\t%d\t; Refresh\n", print-zone.refresh);
+ format(stream, "\t\t%d\t; Retry\n", print-zone.retry);
+ format(stream, "\t\t%d\t; Expire\n", print-zone.expire);
+ format(stream, "\t\t%d )\t; Minimum\n\n", print-zone.minimum);
+ if (print-zone.reverse?)
do(method(x)
format(stream, "\tIN\tNS\t%s. \n", x)
- end, zone.nameservers);
+ end, print-zone.nameservers);
do(method(x)
format(stream, "%d\tIN\tPTR\n%s.%s.\n",
x.ipv4-address[3],
x.host-name,
- zone.zone-name)
- end, zone.hosts);
+ print-zone.zone-name)
+ end, choose(method(x)
+ ip-in-net?(parse-cidr(print-zone.zone-name),
+ x.ipv4-address)
+ end, *config*.hosts));
else
do(method(x)
format(stream, "\tIN\tNS\t%s. \n", x)
- end, zone.nameservers);
+ end, print-zone.nameservers);
do(method(x)
format(stream, "\tIN\tMX\t%d\t%s.\n", head(x), tail(x))
- end, zone.mail-exchanges);
+ end, print-zone.mail-exchanges);
do(method(x)
format(stream, "%s\tIN\tA\t%s\n",
x.host-name,
as(<string>, x.ipv4-address))
- end, zone.hosts);
+ end, choose(method(x)
+ x.zone = print-zone
+ end, *config*.hosts));
do(method(x)
format(stream, "%s\tCNAME\t%s\n", source(x), target(x))
- end, zone.cnames);
+ end, print-zone.cnames);
end;
end;
-define method print-tinydns-zone-file (zone :: <zone>, stream :: <stream>)
+define method print-tinydns-zone-file (print-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.nameservers[0],
- zone.hostmaster, zone.serial,
- zone.refresh, zone.retry,
- zone.expire, zone.minimum,
- zone.time-to-live);
+ print-zone.zone-name, print-zone.nameservers[0],
+ print-zone.hostmaster, print-zone.serial,
+ print-zone.refresh, print-zone.retry,
+ print-zone.expire, print-zone.minimum,
+ print-zone.time-to-live);
//nameserver
do(method(x)
- format(stream, "&%s::%s\n", zone.zone-name, x)
- end, zone.nameservers);
- if (zone.reverse?)
+ format(stream, "&%s::%s\n", print-zone.zone-name, x)
+ end, print-zone.nameservers);
+ if (print-zone.reverse?)
//PTR
do(method(x)
format(stream, "^%s:%s\n",
x.host-name,
as(<string>, x.ipv4-address));
- end, zone.hosts);
+ end, choose(method(x)
+ ip-in-net?(parse-cidr(print-zone.zone-name),
+ x.ipv4-address)
+ end, *config*.hosts));
else
//MX
do(method(x)
format(stream, "@%s::%s:%d\n",
- zone.zone-name, tail(x), head(x));
- end, zone.mail-exchanges);
+ print-zone.zone-name, tail(x), head(x));
+ end, print-zone.mail-exchanges);
//A
do(method(x)
format(stream, "+%s:%s\n",
x.host-name,
as(<string>, x.ipv4-address));
- end, zone.hosts);
+ end, choose(method(x)
+ x.zone = print-zone
+ end, *config*.hosts));
//CNAME
do(method(x)
format(stream, "C%s:%s\n",
source(x), target(x));
- end, zone.cnames);
+ end, print-zone.cnames);
end;
end;
+
+define method parse-cidr (zone-name :: <string>) => (network :: <network>)
+ //XXX: needs to be done
+ //zone-name should be something like 1.2.3.in-addr.arpa for 3.2.1.0/24
+ make(<network>, cidr: "10.0.0.0/24");
+end;
+
+define method add-reverse-zones (network :: <network>) => ()
+ //XXX: add reverse zone for each /24 in network
+end;
\ No newline at end of file
--
Gd-chatter mailing list
Gd-chatter@xxxxxxxxxxxxxxxx
https://gauss.gwydiondylan.org/mailman/listinfo/gd-chatter
|
