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