| author | wenzelm | 
| Fri, 24 Feb 2012 20:37:52 +0100 | |
| changeset 46658 | f11400424782 | 
| parent 44200 | ce0112e26b3b | 
| child 56434 | 7acc933bd7cc | 
| 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 | 
| 37239 | 16 | val PG_setup: unit -> unit | 
| 20925 | 17 | val commit: unit -> unit | 
| 18 | end; | |
| 19 | ||
| 20 | structure Secure: SECURE = | |
| 21 | struct | |
| 22 | ||
| 20992 | 23 | (** secure flag **) | 
| 20925 | 24 | |
| 32738 | 25 | val secure = Unsynchronized.ref false; | 
| 20925 | 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: 
22144diff
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: 
30625diff
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: 
30625diff
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: 
30625diff
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: 
30625diff
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: 
30625diff
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: 
22567diff
changeset | 46 | |
| 30672 
beaadd5af500
more systematic type use_context, with particular values ML_Parse.global_context and ML_Context.local_context;
 wenzelm parents: 
30625diff
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: 
29606diff
changeset | 48 | |
| 32739 | 49 | |
| 50 | (* global evaluation *) | |
| 51 | ||
| 52 | val use_global = raw_use_text ML_Parse.global_context (0, "") false; | |
| 53 | ||
| 54 | fun commit () = use_global "commit();"; (*commit is dynamically bound!*) | |
| 37239 | 55 | |
| 38799 
712cb964d113
structure Unsynchronized is never opened and set/reset/toggle have been discontinued;
 wenzelm parents: 
37977diff
changeset | 56 | fun PG_setup () = | 
| 
712cb964d113
structure Unsynchronized is never opened and set/reset/toggle have been discontinued;
 wenzelm parents: 
37977diff
changeset | 57 | use_global "val change = Unsynchronized.change; structure ThyLoad = ProofGeneral.ThyLoad;"; | 
| 20925 | 58 | |
| 59 | end; | |
| 60 | ||
| 23978 | 61 | (*override previous toplevel bindings!*) | 
| 21770 | 62 | val use_text = Secure.use_text; | 
| 63 | val use_file = Secure.use_file; | |
| 42818 
128cc195ced3
timing of Theory_Data operations, with implicit thread positions when functor is applied;
 wenzelm parents: 
40748diff
changeset | 64 | |
| 
128cc195ced3
timing of Theory_Data operations, with implicit thread positions when functor is applied;
 wenzelm parents: 
40748diff
changeset | 65 | fun use s = | 
| 44200 | 66 | Position.setmp_thread_data (Position.file_only s) | 
| 42818 
128cc195ced3
timing of Theory_Data operations, with implicit thread positions when functor is applied;
 wenzelm parents: 
40748diff
changeset | 67 | (fn () => | 
| 
128cc195ced3
timing of Theory_Data operations, with implicit thread positions when functor is applied;
 wenzelm parents: 
40748diff
changeset | 68 | Secure.use_file ML_Parse.global_context true s | 
| 
128cc195ced3
timing of Theory_Data operations, with implicit thread positions when functor is applied;
 wenzelm parents: 
40748diff
changeset | 69 | handle ERROR msg => (writeln msg; error "ML error")) (); | 
| 
128cc195ced3
timing of Theory_Data operations, with implicit thread positions when functor is applied;
 wenzelm parents: 
40748diff
changeset | 70 | |
| 30625 
d53d1a16d5ee
replaced install_pp/make_pp by more general toplevel_pp based on use_text;
 wenzelm parents: 
29606diff
changeset | 71 | val toplevel_pp = Secure.toplevel_pp; | 
| 40748 
591b6778d076
removed bash from ML system bootstrap, and past the Secure ML barrier;
 wenzelm parents: 
38799diff
changeset | 72 |