[Gd-chatter] r11057 - in trunk/libraries/network: koala/sources/examples/buddha web-framework
hannes at gwydiondylan.org
hannes at gwydiondylan.org
Mon Dec 11 22:45:44 CET 2006
Author: hannes
Date: Mon Dec 11 22:45:40 2006
New Revision: 11057
Modified:
trunk/libraries/network/koala/sources/examples/buddha/TODO
trunk/libraries/network/koala/sources/examples/buddha/buddha.dylan
trunk/libraries/network/koala/sources/examples/buddha/config.dylan
trunk/libraries/network/koala/sources/examples/buddha/library.dylan
trunk/libraries/network/koala/sources/examples/buddha/vlan.dylan
trunk/libraries/network/koala/sources/examples/buddha/zone.dylan
trunk/libraries/network/web-framework/class-editor.dylan
trunk/libraries/network/web-framework/command.dylan
trunk/libraries/network/web-framework/library.dylan
trunk/libraries/network/web-framework/web-macro.dylan
Log:
Job: minor
* some updates to buddha
* minor stuff
* user rights
* does not yet compile
* some more local changes to storage and users)
web-framework:
* some reordering
* changes to change
Modified: trunk/libraries/network/koala/sources/examples/buddha/TODO
==============================================================================
--- trunk/libraries/network/koala/sources/examples/buddha/TODO (original)
+++ trunk/libraries/network/koala/sources/examples/buddha/TODO Mon Dec 11 22:45:40 2006
@@ -1,3 +1,7 @@
+TEST:
+* reverse zones are hardcoded to be at a /24 boundary,
+ they should be byte-bounded
+
BUGS:
* a-records and c-names with same name as any host record
-> parent is the list of a-records, not the zone
@@ -5,18 +9,17 @@
(a-record, hostname, vlan-name, mx-name, cname-name, ..)
* when using "" in vlan description it fails in edit form...
=> some more escaping needed
-* reverse zones are hardcoded to be at a /24 boundary,
- they should be byte-bounded
FEATURE REQUESTS
*user management:
*at least security levels:
- 0 admin, root
- 1 noc-user (who knows what he is doing)
- 2 noc viewer (no add/edit/remove)
- 3 nochelpdesk (add hosts to some specific subnets,
- view state of switchport/subnet/etc)
+ 0 root
+ 1 noc (who knows what he is doing), but may not change user rights
+ 2 helpdesk (add hosts to some specific subnets,
+ view everything)
+ 3 viewer
+
4 participiant (yourname)
(5 view (no authentication, may only browse all stuff
(apart from entered passwords,
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 Mon Dec 11 22:45:40 2006
@@ -1,28 +1,28 @@
module: buddha
author: Hannes Mehnert <hannes at mehnert.org>
-define variable *directory* = "www/buddha/";
-
define thread variable *user* = #f;
+define constant $privileges = #(#"root", #"noc", #"helpdesk", #"viewer");
+
define variable *nameserver* = list(make(<nameserver>,
ns-name: "auth-int.congress.ccc.de"),
make(<nameserver>,
ns-name: "auth-ext.congress.ccc.de"));
define method initial-responder (request :: <request>, response :: <response>)
- dynamic-bind(*user* = make(<user>,
- username: "admin",
- password: "foo",
- email: "buddhaadmin at local",
- admin: #t))
- block(return)
- if (subsequence-position(as(<string>, request.request-method), "post"))
- respond-to-post(#"edit", request, response);
- return();
- end;
- let stream = output-stream(response);
- let page = with-xml-builder()
+ with-storage (privs = <access-level>)
+ unless (privs.size > 0)
+ do(curry(add!, privs), $privileges);
+ end;
+ end;
+ block(return)
+ if (subsequence-position(as(<string>, request.request-method), "post"))
+ respond-to-post(#"edit", request, response);
+ return();
+ end;
+ let stream = output-stream(response);
+ let page = with-xml-builder()
html(xmlns => "http://www.w3.org/1999/xhtml") {
head {
title("Buddha - Please create initial user!"),
@@ -37,9 +37,8 @@
}
}
end;
- format(stream, "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">\n");
- format(stream, "%=", page);
- end;
+ format(stream, "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">\n");
+ format(stream, "%=", page);
end;
end;
@@ -87,20 +86,6 @@
end;
end;
-/*
-define responder dood-responder ("/dood")
- (request, response)
- let dood = make(<dood>,
- locator: concatenate(*directory*, base64-encode(filename)),
- direction: #"output",
- if-exists: #"replace");
- dood-root(dood) := make(<buddha>);
- dood-commit(dood);
- dood-close(dood);
-
-end;
-*/
-
define page network end;
define page network-detail end;
define page subnet end;
@@ -112,8 +97,6 @@
define page zone end;
define page zone-detail end;
define page user end;
-define page save end;
-define page restore end;
define page edit end;
define page changes end;
define page adduser end;
@@ -155,6 +138,8 @@
li { a("Changes", href => "/changes") }
}
},
+ do(if(*user*.access-level = #"root" | *user*.access-level = #"noc")
+ collect(with-xml()
div (id => "buddha-edit") {
ul {
li("Add:"),
@@ -178,7 +163,19 @@
get-reference(<subnet>),
"&parent-object=",
get-reference(storage(<subnet>)))) }
- },
+ }
+ end);
+ elseif (*user*.access-level = #"helpdesk")
+ collect(with-xml()
+ div (id => "buddha-edit") {
+ ul {
+ li { a("host", href => concatenate("/add?object-type=",
+ get-reference(<host>),
+ "&parent-object=",
+ get-reference(storage(<host>)))) }
+ }
+ }
+ end)),
ul { li{ text("Logged in as "),
strong(*user*.username) } }
}
@@ -201,17 +198,14 @@
collect(show-errors(errors));
collect(with-xml()
div(id => "content")
- { h2("Welcome, stranger"),
+ { h2("Welcome to the admin interface"),
ul {
- li(concatenate("Database version is ", show(version()))),
li(concatenate("There were ", show(size(storage(<change>))), " changes")),
li(concatenate("There are ", show(size(storage(<user>))), " users")),
li{ a("User stats", href => "/koala/user-agents") }
},
ul {
- li { a("User management", href => "/adduser") },
- li { a("Save database", href => "/save") },
- li { a("Restore database", href => "/restore") }
+ li { a("User management", href => "/adduser") }
}
}
end);
@@ -222,7 +216,7 @@
request :: <request>,
response :: <response>,
#key errors = #())
- if (*user*) // & *user*.admin?)
+ if (*user* & *user*.access-level = #"root")
let out = output-stream(response);
with-buddha-template(out, "User management")
collect(show-errors(errors));
@@ -288,12 +282,14 @@
request :: <request>,
response :: <response>,
#key errors = #())
- let real-type = get-object(get-query-value("object-type"));
- let parent-object = get-object(get-query-value("parent-object"));
- let out = output-stream(response);
- with-buddha-template(out, concatenate("Add ", get-url-from-type(real-type)))
- collect(show-errors(errors));
- collect(with-xml()
+ let al = *user*.access-level;
+ if (sl = #"root" | al = #"noc" | al = #"helpdesk")
+ let real-type = get-object(get-query-value("object-type"));
+ let parent-object = get-object(get-query-value("parent-object"));
+ let out = output-stream(response);
+ with-buddha-template(out, concatenate("Add ", get-url-from-type(real-type)))
+ collect(show-errors(errors));
+ collect(with-xml()
div(id => "content")
{
h1(concatenate("Add ", get-url-from-type(real-type))),
@@ -314,6 +310,7 @@
fill-from-request: errors))
}
end);
+ end;
end;
end;
@@ -424,61 +421,6 @@
end;
define method respond-to-get
- (page == #"save",
- request :: <request>,
- response :: <response>,
- #key errors)
- dump-data();
- respond-to-get(#"network",
- request,
- response);
-
-end;
-
-define method respond-to-get
- (page == #"restore",
- request :: <request>,
- response :: <response>,
- #key errors)
- let out = output-stream(response);
- with-buddha-template(out, "Restore Database")
- collect(show-errors(errors));
- collect(with-xml()
- div(id => "content")
- { form(action => "/restore", \method => "post")
- { \select(name => "filename")
- {
- do(do-directory(method(directory :: <pathname>,
- name :: <string>,
- type :: <file-type>)
- if (type == #"file")
- collect(with-xml()
- option(name,
- value => name)
- end);
- end if;
- end, *directory*))
- },
- input(type => "submit",
- name => "restore-button",
- value => "Restore")
- }
- }
- end);
- end;
-end;
-
-define method respond-to-post
- (page == #"restore", request :: <request>, response :: <response>)
- let file = get-query-value("filename");
- restore(file);
- format(output-stream(response), "Restored %s\n", file);
- respond-to-get(page,
- request,
- response);
-end;
-
-define method respond-to-get
(page == #"dhcp",
request :: <request>,
response :: <response>,
@@ -553,7 +495,7 @@
href => concatenate("/subnet-detail?subnet=",
get-reference(y))) },
td(show(y.dhcp?)),
- td { a(show(y.vlan.vlan-number),
+ td { a(show(y.vlan.number),
href => concatenate("/vlan-detail?vlan=",
get-reference(y.vlan))) },
td }
@@ -762,10 +704,10 @@
do(reset-color(storage(<vlan>));
map(method(x) with-xml()
tr(class => next-color(storage(<vlan>)))
- { td { a(show(x.vlan-number),
+ { td { a(show(x.number),
href => concatenate("/vlan-detail?vlan=",
get-reference(x))) },
- td(show(x.vlan-name)),
+ td(show(x.name)),
td { do(insert-br(map(method(y)
with-xml()
a(show(y.cidr),
@@ -791,12 +733,12 @@
#key errors)
let dvlan = get-object(get-query-value("vlan"));
let out = output-stream(response);
- with-buddha-template(out, concatenate("VLAN ", show(dvlan.vlan-number), " detail"))
+ with-buddha-template(out, concatenate("VLAN ", show(dvlan.number), " detail"))
collect(show-errors(errors));
collect(with-xml()
div(id => "content")
{
- h1(concatenate("VLAN ", show(dvlan.vlan-number), ", Name ", dvlan.vlan-name)),
+ h1(concatenate("VLAN ", show(dvlan.number), ", Name ", dvlan.name)),
do(edit-form(dvlan,
refer: "vlan-detail",
xml: with-xml()
@@ -805,7 +747,7 @@
value => get-reference(dvlan))
end)),
do(remove-form(dvlan, storage(<vlan>), url: "vlan")),
- h2(concatenate("Subnets in VLAN ", show(dvlan.vlan-number))),
+ h2(concatenate("Subnets in VLAN ", show(dvlan.number))),
table {
tr { th("CIDR"), th("dhcp?") },
do(reset-color(storage(<subnet>));
@@ -1014,8 +956,8 @@
do(reset-color(dzone.cnames);
map(method(x) with-xml()
tr(class => next-color(dzone.cnames))
- { td(x.cname-source),
- td(x.cname-target),
+ { td(x.source),
+ td(x.target),
td { do(remove-form(x, dzone.cnames,
url: "zone-detail",
xml: with-xml()
@@ -1227,7 +1169,7 @@
end;
define function main () => ()
- dumper();
+ register-url("/buddha.css", maybe-serve-static-file);
block()
start-server();
exception (e :: <condition>)
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 Mon Dec 11 22:45:40 2006
@@ -40,13 +40,13 @@
define method check-in-context (tzone :: <zone>, tcname :: <cname>)
=> (res :: <boolean>)
- if (any?(method(x) x.source = tcname.cname-source end, tzone.cnames))
+ if (any?(method(x) x.source = tcname.source end, tzone.cnames))
signal(make(<web-error>,
error: "Same A record already exists"));
- elseif (any?(method(x) x.host-name = tcname.cname-source end, tzone.a-records))
+ elseif (any?(method(x) x.host-name = tcname.source end, tzone.a-records))
signal(make(<web-error>,
error: "Same A record already exists"));
- elseif (any?(method(x) x.host-name = tcname.cname-source end,
+ elseif (any?(method(x) x.host-name = tcname.source end,
choose(method(y) y.zone = tzone end, storage(<host>))))
signal(make(<web-error>,
error: "Same A record already exists"));
@@ -95,7 +95,7 @@
host.zone.a-records)) > 0)
signal(make(<web-error>,
error: "A record for host already exists in zone"));
- elseif (size(choose(method(x) x.cname-target = host.host-name end,
+ elseif (size(choose(method(x) x.target = host.host-name end,
host.zone.cnames)) > 0)
signal(make(<web-error>,
error: "A record already exists in zone"));
@@ -124,13 +124,13 @@
define method check (vlan :: <vlan>, #key test-result = 0)
=> (res :: <boolean>)
let vlans = storage(<vlan>);
- if ((vlan.vlan-number < 0) | (vlan.vlan-number > 4095))
+ if ((vlan.number < 0) | (vlan.number > 4095))
signal(make(<web-error>,
error: "VLAN not in range 0 - 4095"));
- elseif (size(choose(method(x) x.vlan-number = vlan.vlan-number end , vlans)) > test-result)
+ elseif (size(choose(method(x) x.number = vlan.number end , vlans)) > test-result)
signal(make(<web-error>,
error: "VLAN with same number already exists"));
- elseif (size(choose(method(x) x.vlan-name = vlan.vlan-name end, vlans)) > test-result)
+ elseif (size(choose(method(x) x.name = vlan.name end, vlans)) > test-result)
signal(make(<web-error>,
error: "VLAN with same name already exists"));
else
Modified: trunk/libraries/network/koala/sources/examples/buddha/library.dylan
==============================================================================
--- trunk/libraries/network/koala/sources/examples/buddha/library.dylan (original)
+++ trunk/libraries/network/koala/sources/examples/buddha/library.dylan Mon Dec 11 22:45:40 2006
@@ -56,6 +56,6 @@
use storage;
use object-table;
use users;
- use changes;
+ use change;
use utils;
end;
Modified: trunk/libraries/network/koala/sources/examples/buddha/vlan.dylan
==============================================================================
--- trunk/libraries/network/koala/sources/examples/buddha/vlan.dylan (original)
+++ trunk/libraries/network/koala/sources/examples/buddha/vlan.dylan Mon Dec 11 22:45:40 2006
@@ -2,9 +2,9 @@
author: Hannes Mehnert <hannes at mehnert.org>
define web-class <vlan> (<reference-object>)
- data vlan-number :: <integer>;
- data vlan-name :: <string>;
- data vlan-description :: <string>;
+ data number :: <integer>;
+ data name :: <string>;
+ data description :: <string>;
end;
define method print-object (vlan :: <vlan>, stream :: <stream>)
@@ -14,10 +14,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.name);
end;
define method \< (a :: <vlan>, b :: <vlan>)
=> (res :: <boolean>)
- a.vlan-number < b.vlan-number
+ a.number < b.number
end;
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 Mon Dec 11 22:45:40 2006
@@ -2,8 +2,8 @@
author: Hannes Mehnert <hannes at mehnert.org>
define web-class <cname> (<object>)
- data cname-source :: <string>;
- data cname-target :: <string>;
+ data source :: <string>;
+ data target :: <string>;
end;
define method print-object (cname :: <cname>, stream :: <stream>)
@@ -13,12 +13,12 @@
define method as (class == <string>, cname :: <cname>)
=> (res :: <string>)
- concatenate(cname.cname-source, " => ", cname.cname-target);
+ concatenate(cname.source, " => ", cname.target);
end;
define method \< (a :: <cname>, b :: <cname>)
=> (res :: <boolean>)
- a.cname-source < b.cname-source
+ a.source < b.source
end;
define web-class <a-record> (<object>)
@@ -236,7 +236,7 @@
//CNAME
do(method(x)
format(stream, "C%s.%s:%s.%s\n",
- cname-source(x), print-zone.zone-name, cname-target(x), print-zone.zone-name);
+ source(x), print-zone.zone-name, target(x), print-zone.zone-name);
end, print-zone.cnames);
//a records for dynamic PTR records
let ip = storage(<network>)[0].cidr.cidr-network-address;
@@ -267,7 +267,8 @@
define method add-reverse-zones (network :: <network>) => ()
//XXX: add hostmaster, mx, nameserver,...
- for (subnet in split-cidr(network.cidr, 24))
+ let rev-mask = truncate/(network.cidr.cidr-netmask, 8) * 8;
+ for (subnet in split-cidr(network.cidr, rev-mask))
let zone = make(<zone>,
reverse?: #t,
zone-name: cidr-to-reverse-zone(subnet),
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 Mon Dec 11 22:45:40 2006
@@ -347,32 +347,43 @@
let object-type = get-object(get-query-value("object-type"));
//XXX: hmm, make should probably only be done when all slots
//are successfully parsed and then use init-keywords...
- let object = make(object-type);
- if (instance?(object, <string>))
+ //let object = make(object-type);
+ if (object-type = <string>)
let value = get-query-value("string");
parent-object := add!(parent-object, value);
else
+ let init = make(<stretchy-vector>);
//more complex objects:
//data-slots ref-slots needs to be read and sanity checked
+ let deferred-slot-setter = make(<stretchy-vector>);
for (slot in data-slots(object-type))
let value = parse(slot.slot-name, slot.slot-type);
//then set slots of object
unless ((slot.slot-type = <boolean>) | value)
- value := slot.default-function(object);
- unless (value)
- signal(make(<web-error>,
- error: concatenate("Please specify ",
- slot.slot-name,
- " correctly!")));
- end unless;
+ add!(deferred-slot-setter, slot);
end;
- slot.slot-setter-method(value, object);
+ add!(init, as(<symbol>, slot.slot-name));
+ add!(init, value);
+ //slot.slot-setter-method(value, object);
end;
for (slot in reference-slots(object-type))
let value = get-object(get-query-value(slot.slot-name));
+ add!(init, as(<symbol>, slot.slot-name));
+ add!(init, value);
+ //slot.slot-setter-method(value, object);
+ end;
+ let object = apply(make, object-type, as(<vector>, init));
+ for (slot in deferred-slot-setter)
+ let value = slot.default-function(object);
+ unless (value)
+ signal(make(<web-error>,
+ error: concatenate("Please specify ",
+ slot.slot-name,
+ " correctly!")));
+ end unless;
slot.slot-setter-method(value, object);
end;
- //sanity check it
+
let command = make(<add-command>,
arguments: list(object, parent-object));
redo(command);
Modified: trunk/libraries/network/web-framework/command.dylan
==============================================================================
--- trunk/libraries/network/web-framework/command.dylan (original)
+++ trunk/libraries/network/web-framework/command.dylan Mon Dec 11 22:45:40 2006
@@ -1,4 +1,4 @@
-module: changes
+module: change
author: Hannes Mehnert <hannes at mehnert.org>
define abstract class <command> (<object>)
Modified: trunk/libraries/network/web-framework/library.dylan
==============================================================================
--- trunk/libraries/network/web-framework/library.dylan (original)
+++ trunk/libraries/network/web-framework/library.dylan Mon Dec 11 22:45:40 2006
@@ -7,14 +7,15 @@
use io;
use koala, import: { koala, dsp };
use xml-parser, import: { simple-xml };
- use system, import: { file-system, date };
+ use system, import: { file-system, date, locators };
use dood;
export object-table,
web-framework,
storage,
users,
- changes;
+ changes,
+ change;
end;
define module object-table
@@ -33,6 +34,7 @@
use threads;
use format-out;
use koala;
+ use locators;
export storage,
\with-storage,
@@ -43,7 +45,8 @@
restore,
restore-newest,
version,
- storage-type;
+ storage-type,
+ key;
end;
define module web-framework-macro
@@ -70,7 +73,6 @@
default-help-text;
export check,
- key,
show,
get-url-from-type;
@@ -94,20 +96,25 @@
use web-framework-macro;
//user stuff
+ export <access-level>;
+
export <user>,
username,
+ username-setter,
password,
password-setter,
email,
email-setter,
access,
access-setter,
+ access-level,
+ access-level-setter,
current-user,
login,
logged-in?;
end;
-define module changes
+define module change
use common-dylan;
use dylan;
use date;
@@ -127,6 +134,23 @@
redo,
print-xml;
+ //commands
+ export <add-command>,
+ <remove-command>,
+ <edit-command>;
+
+end;
+define module changes
+ use common-dylan;
+ use dylan;
+ use date;
+ use simple-xml;
+
+ use object-table;
+ use storage;
+ use web-framework-macro;
+ use users;
+ use change, export: all;
//exports
export generate-rss;
@@ -182,11 +206,6 @@
<textile-content>,
<xhtml-content>;
- //commands
- export <add-command>,
- <remove-command>,
- <edit-command>;
-
export <comment>,
name, name-setter,
website, website-setter,
@@ -204,7 +223,7 @@
use web-framework-macro, export: all;
use storage;
- use changes;
+ use change;
export respond-to-get,
respond-to-post;
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 Mon Dec 11 22:45:40 2006
@@ -12,8 +12,6 @@
constant slot error-string :: <string>, required-init-keyword: error:;
end;
-define open generic key (object :: <object>) => (res :: <object>);
-
define open generic check (object :: <object>, #key test-result)
=> (res :: <boolean>);
@@ -49,6 +47,11 @@
constant slot slot-name, init-keyword: slot-name:;
end;
+define generic visible? (obj :: <object>) => (res :: <boolean>);
+
+define method visible? (obj :: <object>) => (res :: <boolean>);
+ #t;
+end;
define open class <reference-object> (<object>)
slot visible? :: <boolean> = #t, init-keyword: visible?:;
end;
@@ -170,13 +173,13 @@
{ data ?slot-name:name \:: ?slot-type:* }
=> { slot ?slot-name :: ?slot-type, init-keyword: ?#"slot-name" }
{ slot ?slot-name:name \:: ?slot-type:* }
- => { slot ?slot-name :: ?slot-type }
+ => { slot ?slot-name :: ?slot-type, init-keyword: ?#"slot-name" }
{ has-many ?slot-name:name }
=> { 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 }
- => { slot ?slot-name :: "<" ## ?slot-name ## ">",
+ => { slot ?slot-name /* :: "<" ## ?slot-name ## ">" */,
init-keyword: ?#"slot-name" }
end;
More information about the chatter
mailing list