src/Pure/General/secure.ML
author wenzelm
Sat, 26 Jan 2008 17:08:41 +0100
changeset 25982 caee173104d3
parent 25753 99c9fc5e11f2
child 26080 d920e4c8ba82
permissions -rw-r--r--
added theorem group property;
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
    ID:         $Id$
2d19e511fe2c Secure critical operations.
wenzelm
parents:
diff changeset
     3
    Author:     Makarius
2d19e511fe2c Secure critical operations.
wenzelm
parents:
diff changeset
     4
2d19e511fe2c Secure critical operations.
wenzelm
parents:
diff changeset
     5
Secure critical operations.
2d19e511fe2c Secure critical operations.
wenzelm
parents:
diff changeset
     6
*)
2d19e511fe2c Secure critical operations.
wenzelm
parents:
diff changeset
     7
2d19e511fe2c Secure critical operations.
wenzelm
parents:
diff changeset
     8
signature SECURE =
2d19e511fe2c Secure critical operations.
wenzelm
parents:
diff changeset
     9
sig
20977
dbf1eca9b34e tuned signature;
wenzelm
parents: 20925
diff changeset
    10
  val set_secure: unit -> unit
20925
2d19e511fe2c Secure critical operations.
wenzelm
parents:
diff changeset
    11
  val is_secure: unit -> bool
22144
c33450acd873 use_text: added name argument;
wenzelm
parents: 21770
diff changeset
    12
  val use_text: string -> (string -> unit) * (string -> 'a) -> bool -> string -> unit
21770
ea6f846d8c4b added use_file;
wenzelm
parents: 20992
diff changeset
    13
  val use_file: (string -> unit) * (string -> 'a) -> bool -> string -> unit
20925
2d19e511fe2c Secure critical operations.
wenzelm
parents:
diff changeset
    14
  val use: string -> unit
2d19e511fe2c Secure critical operations.
wenzelm
parents:
diff changeset
    15
  val commit: unit -> unit
20992
05c3703cc6c5 added execute/system;
wenzelm
parents: 20977
diff changeset
    16
  val execute: string -> string
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
24600
5877b88f262c use_text/file: tune text (cf. ML_Parse.fix_ints);
wenzelm
parents: 24058
diff changeset
    40
fun orig_use_text x = use_text ML_Parse.fix_ints x;
5877b88f262c use_text/file: tune text (cf. ML_Parse.fix_ints);
wenzelm
parents: 24058
diff changeset
    41
fun orig_use_file x = use_file ML_Parse.fix_ints x;
20925
2d19e511fe2c Secure critical operations.
wenzelm
parents:
diff changeset
    42
25698
8c335b4641a5 use_text/use_file: non-critical (Poly/ML compiler is thread-safe);
wenzelm
parents: 25503
diff changeset
    43
fun use_text name pr verbose txt =
8c335b4641a5 use_text/use_file: non-critical (Poly/ML compiler is thread-safe);
wenzelm
parents: 25503
diff changeset
    44
  (secure_mltext (); orig_use_text name pr verbose txt);
23922
707639e9497d marked some CRITICAL sections (for multithreading);
wenzelm
parents: 22567
diff changeset
    45
25698
8c335b4641a5 use_text/use_file: non-critical (Poly/ML compiler is thread-safe);
wenzelm
parents: 25503
diff changeset
    46
fun use_file pr verbose name =
8c335b4641a5 use_text/use_file: non-critical (Poly/ML compiler is thread-safe);
wenzelm
parents: 25503
diff changeset
    47
  (secure_mltext (); orig_use_file pr verbose name);
23922
707639e9497d marked some CRITICAL sections (for multithreading);
wenzelm
parents: 22567
diff changeset
    48
23978
6e8d5a05ffe8 added use_noncritical;
wenzelm
parents: 23922
diff changeset
    49
fun use name = use_file Output.ml_output true name;
6e8d5a05ffe8 added use_noncritical;
wenzelm
parents: 23922
diff changeset
    50
20925
2d19e511fe2c Secure critical operations.
wenzelm
parents:
diff changeset
    51
(*commit is dynamically bound!*)
25503
fe14c6857f1d commit: non-critical, otherwise session restart will result in deadlock!
wenzelm
parents: 25204
diff changeset
    52
fun commit () = orig_use_text "" Output.ml_output false "commit();";
20925
2d19e511fe2c Secure critical operations.
wenzelm
parents:
diff changeset
    53
20992
05c3703cc6c5 added execute/system;
wenzelm
parents: 20977
diff changeset
    54
05c3703cc6c5 added execute/system;
wenzelm
parents: 20977
diff changeset
    55
(* shell commands *)
05c3703cc6c5 added execute/system;
wenzelm
parents: 20977
diff changeset
    56
05c3703cc6c5 added execute/system;
wenzelm
parents: 20977
diff changeset
    57
fun secure_shell () = deny_secure "Cannot execute shell commands in secure mode";
05c3703cc6c5 added execute/system;
wenzelm
parents: 20977
diff changeset
    58
05c3703cc6c5 added execute/system;
wenzelm
parents: 20977
diff changeset
    59
val orig_execute = execute;
05c3703cc6c5 added execute/system;
wenzelm
parents: 20977
diff changeset
    60
val orig_system = system;
05c3703cc6c5 added execute/system;
wenzelm
parents: 20977
diff changeset
    61
24858
a3a81e73f552 execute/system: non-critical;
wenzelm
parents: 24663
diff changeset
    62
fun execute s = (secure_shell (); orig_execute s);
a3a81e73f552 execute/system: non-critical;
wenzelm
parents: 24663
diff changeset
    63
fun system s = (secure_shell (); orig_system s);
20992
05c3703cc6c5 added execute/system;
wenzelm
parents: 20977
diff changeset
    64
20925
2d19e511fe2c Secure critical operations.
wenzelm
parents:
diff changeset
    65
end;
2d19e511fe2c Secure critical operations.
wenzelm
parents:
diff changeset
    66
23978
6e8d5a05ffe8 added use_noncritical;
wenzelm
parents: 23922
diff changeset
    67
(*override previous toplevel bindings!*)
21770
ea6f846d8c4b added use_file;
wenzelm
parents: 20992
diff changeset
    68
val use_text = Secure.use_text;
ea6f846d8c4b added use_file;
wenzelm
parents: 20992
diff changeset
    69
val use_file = Secure.use_file;
24663
015a8838e656 improved error behaviour of use (bootstrap version);
wenzelm
parents: 24600
diff changeset
    70
fun use s = Secure.use s handle ERROR msg => (writeln msg; raise Fail "ML error");
20992
05c3703cc6c5 added execute/system;
wenzelm
parents: 20977
diff changeset
    71
val execute = Secure.execute;
05c3703cc6c5 added execute/system;
wenzelm
parents: 20977
diff changeset
    72
val system = Secure.system;