-
Notifications
You must be signed in to change notification settings - Fork 1
/
scratch.rkt
144 lines (110 loc) · 6.21 KB
/
scratch.rkt
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
; Copyright © 2009-2010 Brown University and Worcester Polytechnic Institute.
;
; This file is part of Margrave.
; Margrave is free software: you can redistribute it and/or modify
; it under the terms of the GNU Lesser General Public License as published by
; the Free Software Foundation, either version 3 of the License, or
; (at your option) any later version.
;
; Margrave is distributed in the hope that it will be useful,
; but WITHOUT ANY WARRANTY; without even the implied warranty of
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
; GNU Lesser General Public License for more details.
;
; You should have received a copy of the GNU Lesser General Public License
; along with Margrave. If not, see <http://www.gnu.org/licenses/>.
#lang racket
; TEMPORARY! Will be a nice module path soon.
(require ;(file "./read.rkt")
"margrave.rkt"
"margrave-xml.rkt"
"margrave-policy-vocab.rkt"
xml)
; Welcome to Margrave! This file contains examples that are separated by (pause-for-user) so that you can
; execute it and read it in tandem.
(start-margrave-engine (current-directory) '() '("-log"))
;(load-policy (build-path (current-directory) "tests" "extconference.p"))
(load-policy (build-path (current-directory) "tests" "conference1.p"))
;(load-policy (build-path (current-directory) "tests" "conference2.p"))
;(load-policy (build-path (current-directory) "tests" "phone1.p"))
(load-policy (build-path (current-directory) "tests" "fwex1.p"))
;(load-policy (build-path (current-directory) "tests" "fwex1a.p"))
;(load-policy (build-path (current-directory) "tests" "fwex2.p"))
;(load-policy (build-path (current-directory) "tests" "fwex3.p"))
;(load-policy (build-path (current-directory) "tests" "happyrouterless.p"))
;(load-policy (build-path (current-directory) "tests" "happyroutermore.p"))
;(load-policy (build-path (current-directory) "tests" "iout.p"))
(load-policy (build-path (current-directory) "tests" "subset.p"))
;(mtext "info")
;(mtext "info fwex1")
;(mtext "info examplefw1")
;(m (xml-make-rename-command "conferencepolicy1" "conf1"))
;(m (xml-make-rename-command "conferencepolicy2" "conf2"))
;(m (xml-make-rename-command "fwex1" "firewall1"))
;(m (xml-make-rename-command "fwex1a" "firewall1a"))
;(m (xml-make-rename-command "fwex2" "firewall2"))
;(m (xml-make-rename-command "happyrouterless" "HRless"))
;(m (xml-make-rename-command "happyroutermore" "HRmore"))
(display-response (mtext "rename conferencepolicy1 conf1"))
;(mtext "rename conferencepolicy2 conf2")
;(mtext "rename fwex1 firewall1")
;(mtext "rename fwex1a firewall1a")
;(mtext "rename fwex2 firewall2")
;(mtext "rename happyrouterless HRless")
;(mtext "rename happyroutermore HRmore")
;(mtext "info")
;(mtext "info conf1")
; Mypol doesn't exist: expect an error on UNDER clause.
;(define test-string "EXPLORE xsort(x) AND xsort(y) UNDER mypol INCLUDE mypol:rule1(x, y), mypol:rule2(x, y), mypol:rule1_applies(x, y), mypol:rule2_applies(x, y) TUPLING")
;(define test-stream (open-input-string test-string))
;(define test-xml (evalxml test-string))
;(m test-xml)
(define theid (mtext "EXPLORE conf1:permit(s, a, r) INCLUDE conf1:permit"))
;(printf "Id: ~a~n" (xml-explore-result->id theid))
(display-response (mtext "GET ONE"))
(display-response (mtext "EXPLORE conf1:permit(s, a, r) INCLUDE conf1:permit(s, a, r), conf1:deny(s, a, r) DEBUG 3 TUPLING"))
; You don't need to pass an EXPLORE id if you're referencing the last explore:
(display-response (mtext "GET ONE"))
(display-response (mtext "SHOW REALIZED conf1:permit(s, a, r), conf1:deny(s, a, r), assigned(s, r)"))
(display-response (mtext "SHOW UNREALIZED conf1:permit(s, a, r), conf1:deny(s, a, r), assigned(s, r)"))
(display-response (mtext "SHOW REALIZED conf1:permit(s, a, r), conf1:deny(s, a, r), assigned(s, r) FOR CASES assigned(s, r), conf1:deny(s, a, r)"))
;(mtext "EXPLORE firewall1:accept(ipsrc, ipdest, portsrc, portdest, pro) INCLUDE firewall1:accept(ipsrc, ipdest, portsrc, portdest, pro) TUPLING")
;(mtext "GET ONE 0")
;(mtext "EXPLORE firewall1:accept(ipsrc, ipdest, portsrc, portdest, pro) INCLUDE firewall1:accept")
;(mtext "GET ONE 0")
;(mtext "create vocabulary myvoc")
;(mtext "add to myvoc sort xsort")
;(mtext "add to myvoc subsort xsort s1")
;(mtext "add to myvoc subsort xsort s2")
;(mtext "add to myvoc decision permit")
;(mtext "add to myvoc decision deny")
;(mtext "add to myvoc requestvar x xsort")
;(mtext "add to myvoc requestvar y xsort")
;(mtext "create policy leaf mypol myvoc")
;(mtext "add rule to mypol rule1 permit (s1 x) (s2 y)")
;(mtext "add rule to mypol rule2 deny (s2 x) (s1 y)")
;(mtext "prepare mypol")
;(mtext "explore xsort(x) and xsort(y) UNDER mypol INCLUDE mypol:rule1(x, y), mypol:rule2(x, y), mypol:rule1_applies(x, y), mypol:rule2_applies(x, y) tupling")
;(mtext "show REALIZED 0 mypol:rule1(x, y), mypol:rule2(x, y) for cases mypol:rule1_applies(x, y), mypol:rule2_applies(x, y)")
;(mtext "info myvoc")
(display-response (mtext "GET QUALIFIED RULES IN conf1"))
(display-response (mtext "EXPLORE subject(x) and subject(y) and subject(z) and x=y and y=z UNDER conf1 TUPLING"))
;(display-response (mtext "EXPLORE subject(x) and notasort(y) and subject(z) and x=y and y=z UNDER conf1 TUPLING"))
;(display-response (mtext "EXPLORE subject(x) and notasort(y) and subject(z) and x=y and y=z TUPLING"))
(display-response (mtext "GET ONE"))
(printf "~a~n" (mtext "SHOW ONE"))
(printf "~a~n" (mtext "SHOW ONE 0"))
(printf "~a~n" (mtext "GET ALL"))
(printf "~n~n~a~n" (mtext "SHOW ALL"))
(display-response (mtext "EXPLORE NOT subject (x) AND x=y and NOT y=z UNDER conf1"))
; Should display x, y, and z anyway.
(printf "~a~n" (mtext "SHOW ONE"))
; No sort inference can be done here. Only know 2 variables x and y.
; Ceiling should be 2, both assertions should be UNIV.
(display-response (mtext "EXPLORE x = y UNDER subspolicy DEBUG 3 TUPLING"))
;(display-response (mtext "EXPLORE x = y AND NOT potato(x) AND NOT tool(x) UNDER subspolicy"))
(printf "~a~n" (mtext "SHOW ALL"))
;(stop-margrave-engine)
(display-response (mtext "EXPLORE conf1:Deny(s, a, r) AND
reviewer(s) AND paper(r) AND readpaper(a)"))
(printf "~a~n" (mtext "SHOW ALL"))