author | haftmann |
Fri, 17 Apr 2009 16:41:31 +0200 | |
changeset 30951 | a6e26a248f03 |
parent 30672 | beaadd5af500 |
child 31330 | 7bfbd0e07a40 |
permissions | -rw-r--r-- |
20925 | 1 |
(* Title: Pure/General/secure.ML |
2 |
Author: Makarius |
|
3 |
||
4 |
Secure critical operations. |
|
5 |
*) |
|
6 |
||
7 |
signature SECURE = |
|
8 |
sig |
|
20977 | 9 |
val set_secure: unit -> unit |
20925 | 10 |
val is_secure: unit -> bool |
26080 | 11 |
val deny_secure: string -> unit |
30672
beaadd5af500
more systematic type use_context, with particular values ML_Parse.global_context and ML_Context.local_context;
wenzelm
parents:
30625
diff
changeset
|
12 |
val use_text: use_context -> int * string -> bool -> string -> unit |
beaadd5af500
more systematic type use_context, with particular values ML_Parse.global_context and ML_Context.local_context;
wenzelm
parents:
30625
diff
changeset
|
13 |
val use_file: use_context -> bool -> string -> unit |
30625
d53d1a16d5ee
replaced install_pp/make_pp by more general toplevel_pp based on use_text;
wenzelm
parents:
29606
diff
changeset
|
14 |
val toplevel_pp: string list -> string -> unit |
20925 | 15 |
val commit: unit -> unit |
26220 | 16 |
val system_out: string -> string * int |
20992 | 17 |
val system: string -> int |
20925 | 18 |
end; |
19 |
||
20 |
structure Secure: SECURE = |
|
21 |
struct |
|
22 |
||
20992 | 23 |
(** secure flag **) |
20925 | 24 |
|
25 |
val secure = ref false; |
|
26 |
||
20977 | 27 |
fun set_secure () = secure := true; |
20925 | 28 |
fun is_secure () = ! secure; |
29 |
||
22567
1565d476a9e2
removed assert/deny (avoid clash with Alice keywords and confusion due to strict evaluation);
wenzelm
parents:
22144
diff
changeset
|
30 |
fun deny_secure msg = if is_secure () then error msg else (); |
20925 | 31 |
|
32 |
||
25753 | 33 |
|
20992 | 34 |
(** critical operations **) |
35 |
||
36 |
(* ML evaluation *) |
|
20925 | 37 |
|
38 |
fun secure_mltext () = deny_secure "Cannot evaluate ML source in secure mode"; |
|
39 |
||
30672
beaadd5af500
more systematic type use_context, with particular values ML_Parse.global_context and ML_Context.local_context;
wenzelm
parents:
30625
diff
changeset
|
40 |
val raw_use_text = use_text; |
beaadd5af500
more systematic type use_context, with particular values ML_Parse.global_context and ML_Context.local_context;
wenzelm
parents:
30625
diff
changeset
|
41 |
val raw_use_file = use_file; |
beaadd5af500
more systematic type use_context, with particular values ML_Parse.global_context and ML_Context.local_context;
wenzelm
parents:
30625
diff
changeset
|
42 |
val raw_toplevel_pp = toplevel_pp; |
20925 | 43 |
|
30672
beaadd5af500
more systematic type use_context, with particular values ML_Parse.global_context and ML_Context.local_context;
wenzelm
parents:
30625
diff
changeset
|
44 |
fun use_text context pos verbose txt = (secure_mltext (); raw_use_text context pos verbose txt); |
beaadd5af500
more systematic type use_context, with particular values ML_Parse.global_context and ML_Context.local_context;
wenzelm
parents:
30625
diff
changeset
|
45 |
fun use_file context verbose name = (secure_mltext (); raw_use_file context verbose name); |
23922
707639e9497d
marked some CRITICAL sections (for multithreading);
wenzelm
parents:
22567
diff
changeset
|
46 |
|
30672
beaadd5af500
more systematic type use_context, with particular values ML_Parse.global_context and ML_Context.local_context;
wenzelm
parents:
30625
diff
changeset
|
47 |
fun toplevel_pp path pp = (secure_mltext (); raw_toplevel_pp ML_Parse.global_context path pp); |
30625
d53d1a16d5ee
replaced install_pp/make_pp by more general toplevel_pp based on use_text;
wenzelm
parents:
29606
diff
changeset
|
48 |
|
20925 | 49 |
(*commit is dynamically bound!*) |
30672
beaadd5af500
more systematic type use_context, with particular values ML_Parse.global_context and ML_Context.local_context;
wenzelm
parents:
30625
diff
changeset
|
50 |
fun commit () = raw_use_text ML_Parse.global_context (0, "") false "commit();"; |
20925 | 51 |
|
20992 | 52 |
|
53 |
(* shell commands *) |
|
54 |
||
55 |
fun secure_shell () = deny_secure "Cannot execute shell commands in secure mode"; |
|
56 |
||
26220 | 57 |
val orig_system_out = system_out; |
20992 | 58 |
|
26220 | 59 |
fun system_out s = (secure_shell (); orig_system_out s); |
26332 | 60 |
|
61 |
fun system s = |
|
62 |
(case system_out s of |
|
63 |
("", rc) => rc |
|
64 |
| (out, rc) => (writeln (perhaps (try (unsuffix "\n")) out); rc)); |
|
20992 | 65 |
|
20925 | 66 |
end; |
67 |
||
23978 | 68 |
(*override previous toplevel bindings!*) |
21770 | 69 |
val use_text = Secure.use_text; |
70 |
val use_file = Secure.use_file; |
|
30672
beaadd5af500
more systematic type use_context, with particular values ML_Parse.global_context and ML_Context.local_context;
wenzelm
parents:
30625
diff
changeset
|
71 |
fun use s = Secure.use_file ML_Parse.global_context true s |
beaadd5af500
more systematic type use_context, with particular values ML_Parse.global_context and ML_Context.local_context;
wenzelm
parents:
30625
diff
changeset
|
72 |
handle ERROR msg => (writeln msg; raise Fail "ML error"); |
30625
d53d1a16d5ee
replaced install_pp/make_pp by more general toplevel_pp based on use_text;
wenzelm
parents:
29606
diff
changeset
|
73 |
val toplevel_pp = Secure.toplevel_pp; |
26220 | 74 |
val system_out = Secure.system_out; |
20992 | 75 |
val system = Secure.system; |