src/Pure/Concurrent/bash.ML
author wenzelm
Sat, 27 Nov 2010 19:17:55 +0100
changeset 41002 cb6698d2dbaf
parent 41001 591b6778d076
child 41003 2064991db2ac
permissions -rw-r--r--
prefer Isabelle/ML concurrency elements;
more careful propagation of interrupts;
     1 (*  Title:      Pure/Concurrent/bash.ML
     2     Author:     Makarius
     3 
     4 GNU bash processes, with propagation of interrupts.
     5 *)
     6 
     7 val bash_output = uninterruptible (fn restore_attributes => fn script =>
     8   let
     9     datatype result = Wait | Signal | Result of int;
    10     val result = Synchronized.var "bash_result" Wait;
    11 
    12     val id = serial_string ();
    13     val script_path = File.tmp_path (Path.basic ("bash_script" ^ id));
    14     val output_path = File.tmp_path (Path.basic ("bash_output" ^ id));
    15     val pid_path = File.tmp_path (Path.basic ("bash_pid" ^ id));
    16 
    17     val system_thread =
    18       Simple_Thread.fork false (fn () =>
    19         Multithreading.with_attributes Multithreading.private_interrupts (fn _ =>
    20           let
    21             val _ = File.write script_path script;
    22             val status =
    23               OS.Process.system
    24                 ("exec \"$ISABELLE_HOME/lib/scripts/process\" group " ^
    25                   File.shell_path pid_path ^ " script \"exec bash " ^
    26                   File.shell_path script_path ^ " > " ^
    27                   File.shell_path output_path ^ "\"");
    28             val res =
    29               (case Posix.Process.fromStatus status of
    30                 Posix.Process.W_EXITED => Result 0
    31               | Posix.Process.W_EXITSTATUS 0wx82 => Signal
    32               | Posix.Process.W_EXITSTATUS w => Result (Word8.toInt w)
    33               | Posix.Process.W_SIGNALED s =>
    34                   if s = Posix.Signal.int then Signal
    35                   else Result (256 + LargeWord.toInt (Posix.Signal.toWord s))
    36               | Posix.Process.W_STOPPED s =>
    37                   Result (512 + LargeWord.toInt (Posix.Signal.toWord s)));
    38           in Synchronized.change result (K res) end
    39           handle _ (*sic*) => Synchronized.change result (fn Wait => Signal | res => res)));
    40 
    41     fun cleanup () =
    42      (Simple_Thread.interrupt system_thread;
    43       try File.rm script_path;
    44       try File.rm output_path;
    45       try File.rm pid_path);
    46 
    47     fun kill n =
    48       (case Int.fromString (File.read pid_path) of
    49         SOME pid =>
    50           Posix.Process.kill
    51             (Posix.Process.K_GROUP (Posix.Process.wordToPid (LargeWord.fromInt pid)),
    52               Posix.Signal.int)
    53       | NONE => ())
    54       handle OS.SysErr _ => ()
    55         | IO.Io _ => (OS.Process.sleep (seconds 0.1); if n > 0 then kill (n - 1) else ());
    56   in
    57     let
    58       (*proxy for interrupts*)
    59       val _ =
    60         restore_attributes (fn () =>
    61           Synchronized.guarded_access result (fn Wait => NONE | x => SOME ((), x))) ()
    62         handle exn => (if Exn.is_interrupt exn then kill 10 else (); reraise exn);
    63 
    64       val output = the_default "" (try File.read output_path);
    65       val rc = (case Synchronized.value result of Signal => Exn.interrupt () | Result rc => rc);
    66       val _ = cleanup ();
    67     in (output, rc) end
    68     handle exn => (cleanup (); reraise exn)
    69   end);
    70