src/Pure/General/secure.ML
author haftmann
Fri, 17 Apr 2009 16:41:31 +0200
changeset 30951 a6e26a248f03
parent 30672 beaadd5af500
child 31330 7bfbd0e07a40
permissions -rw-r--r--
formal declaration of undefined parameters after class instantiation
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
20925
2d19e511fe2c Secure critical operations.
wenzelm
parents:
diff changeset
     1
(*  Title:      Pure/General/secure.ML
2d19e511fe2c Secure critical operations.
wenzelm
parents:
diff changeset
     2
    Author:     Makarius
2d19e511fe2c Secure critical operations.
wenzelm
parents:
diff changeset
     3
2d19e511fe2c Secure critical operations.
wenzelm
parents:
diff changeset
     4
Secure critical operations.
2d19e511fe2c Secure critical operations.
wenzelm
parents:
diff changeset
     5
*)
2d19e511fe2c Secure critical operations.
wenzelm
parents:
diff changeset
     6
2d19e511fe2c Secure critical operations.
wenzelm
parents:
diff changeset
     7
signature SECURE =
2d19e511fe2c Secure critical operations.
wenzelm
parents:
diff changeset
     8
sig
20977
dbf1eca9b34e tuned signature;
wenzelm
parents: 20925
diff changeset
     9
  val set_secure: unit -> unit
20925
2d19e511fe2c Secure critical operations.
wenzelm
parents:
diff changeset
    10
  val is_secure: unit -> bool
26080
d920e4c8ba82 export deny_secure;
wenzelm
parents: 25753
diff changeset
    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
2d19e511fe2c Secure critical operations.
wenzelm
parents:
diff changeset
    15
  val commit: unit -> unit
26220
d34b68c21f9a common setup for system_out/system;
wenzelm
parents: 26080
diff changeset
    16
  val system_out: string -> string * int
20992
05c3703cc6c5 added execute/system;
wenzelm
parents: 20977
diff changeset
    17
  val system: string -> int
20925
2d19e511fe2c Secure critical operations.
wenzelm
parents:
diff changeset
    18
end;
2d19e511fe2c Secure critical operations.
wenzelm
parents:
diff changeset
    19
2d19e511fe2c Secure critical operations.
wenzelm
parents:
diff changeset
    20
structure Secure: SECURE =
2d19e511fe2c Secure critical operations.
wenzelm
parents:
diff changeset
    21
struct
2d19e511fe2c Secure critical operations.
wenzelm
parents:
diff changeset
    22
20992
05c3703cc6c5 added execute/system;
wenzelm
parents: 20977
diff changeset
    23
(** secure flag **)
20925
2d19e511fe2c Secure critical operations.
wenzelm
parents:
diff changeset
    24
2d19e511fe2c Secure critical operations.
wenzelm
parents:
diff changeset
    25
val secure = ref false;
2d19e511fe2c Secure critical operations.
wenzelm
parents:
diff changeset
    26
20977
dbf1eca9b34e tuned signature;
wenzelm
parents: 20925
diff changeset
    27
fun set_secure () = secure := true;
20925
2d19e511fe2c Secure critical operations.
wenzelm
parents:
diff changeset
    28
fun is_secure () = ! secure;
2d19e511fe2c Secure critical operations.
wenzelm
parents:
diff changeset
    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
2d19e511fe2c Secure critical operations.
wenzelm
parents:
diff changeset
    31
2d19e511fe2c Secure critical operations.
wenzelm
parents:
diff changeset
    32
25753
99c9fc5e11f2 tuned spaces;
wenzelm
parents: 25703
diff changeset
    33
20992
05c3703cc6c5 added execute/system;
wenzelm
parents: 20977
diff changeset
    34
(** critical operations **)
05c3703cc6c5 added execute/system;
wenzelm
parents: 20977
diff changeset
    35
05c3703cc6c5 added execute/system;
wenzelm
parents: 20977
diff changeset
    36
(* ML evaluation *)
20925
2d19e511fe2c Secure critical operations.
wenzelm
parents:
diff changeset
    37
2d19e511fe2c Secure critical operations.
wenzelm
parents:
diff changeset
    38
fun secure_mltext () = deny_secure "Cannot evaluate ML source in secure mode";
2d19e511fe2c Secure critical operations.
wenzelm
parents:
diff changeset
    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
2d19e511fe2c Secure critical operations.
wenzelm
parents:
diff changeset
    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
2d19e511fe2c Secure critical operations.
wenzelm
parents:
diff changeset
    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
2d19e511fe2c Secure critical operations.
wenzelm
parents:
diff changeset
    51
20992
05c3703cc6c5 added execute/system;
wenzelm
parents: 20977
diff changeset
    52
05c3703cc6c5 added execute/system;
wenzelm
parents: 20977
diff changeset
    53
(* shell commands *)
05c3703cc6c5 added execute/system;
wenzelm
parents: 20977
diff changeset
    54
05c3703cc6c5 added execute/system;
wenzelm
parents: 20977
diff changeset
    55
fun secure_shell () = deny_secure "Cannot execute shell commands in secure mode";
05c3703cc6c5 added execute/system;
wenzelm
parents: 20977
diff changeset
    56
26220
d34b68c21f9a common setup for system_out/system;
wenzelm
parents: 26080
diff changeset
    57
val orig_system_out = system_out;
20992
05c3703cc6c5 added execute/system;
wenzelm
parents: 20977
diff changeset
    58
26220
d34b68c21f9a common setup for system_out/system;
wenzelm
parents: 26080
diff changeset
    59
fun system_out s = (secure_shell (); orig_system_out s);
26332
aa54cd3ddc9f system: writeln output, if available;
wenzelm
parents: 26220
diff changeset
    60
aa54cd3ddc9f system: writeln output, if available;
wenzelm
parents: 26220
diff changeset
    61
fun system s =
aa54cd3ddc9f system: writeln output, if available;
wenzelm
parents: 26220
diff changeset
    62
  (case system_out s of
aa54cd3ddc9f system: writeln output, if available;
wenzelm
parents: 26220
diff changeset
    63
    ("", rc) => rc
aa54cd3ddc9f system: writeln output, if available;
wenzelm
parents: 26220
diff changeset
    64
  | (out, rc) => (writeln (perhaps (try (unsuffix "\n")) out); rc));
20992
05c3703cc6c5 added execute/system;
wenzelm
parents: 20977
diff changeset
    65
20925
2d19e511fe2c Secure critical operations.
wenzelm
parents:
diff changeset
    66
end;
2d19e511fe2c Secure critical operations.
wenzelm
parents:
diff changeset
    67
23978
6e8d5a05ffe8 added use_noncritical;
wenzelm
parents: 23922
diff changeset
    68
(*override previous toplevel bindings!*)
21770
ea6f846d8c4b added use_file;
wenzelm
parents: 20992
diff changeset
    69
val use_text = Secure.use_text;
ea6f846d8c4b added use_file;
wenzelm
parents: 20992
diff changeset
    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
d34b68c21f9a common setup for system_out/system;
wenzelm
parents: 26080
diff changeset
    74
val system_out = Secure.system_out;
20992
05c3703cc6c5 added execute/system;
wenzelm
parents: 20977
diff changeset
    75
val system = Secure.system;