| author | wenzelm | 
| Tue, 29 Dec 2015 14:58:15 +0100 | |
| changeset 61957 | 301833d9013a | 
| parent 61556 | 0d4ee4168e41 | 
| child 62484 | 4759dbb35148 | 
| permissions | -rw-r--r-- | 
| 60977 | 1 | (* Title: Pure/Concurrent/bash_windows.ML | 
| 60962 
faa452d8e265
basic setup for native Windows (RAW session without image);
 wenzelm parents: diff
changeset | 2 | Author: Makarius | 
| 
faa452d8e265
basic setup for native Windows (RAW session without image);
 wenzelm parents: diff
changeset | 3 | |
| 60977 | 4 | GNU bash processes, with propagation of interrupts -- Windows version. | 
| 60962 
faa452d8e265
basic setup for native Windows (RAW session without image);
 wenzelm parents: diff
changeset | 5 | *) | 
| 
faa452d8e265
basic setup for native Windows (RAW session without image);
 wenzelm parents: diff
changeset | 6 | |
| 
faa452d8e265
basic setup for native Windows (RAW session without image);
 wenzelm parents: diff
changeset | 7 | signature BASH = | 
| 
faa452d8e265
basic setup for native Windows (RAW session without image);
 wenzelm parents: diff
changeset | 8 | sig | 
| 
faa452d8e265
basic setup for native Windows (RAW session without image);
 wenzelm parents: diff
changeset | 9 |   val process: string -> {out: string, err: string, rc: int, terminate: unit -> unit}
 | 
| 
faa452d8e265
basic setup for native Windows (RAW session without image);
 wenzelm parents: diff
changeset | 10 | end; | 
| 
faa452d8e265
basic setup for native Windows (RAW session without image);
 wenzelm parents: diff
changeset | 11 | |
| 
faa452d8e265
basic setup for native Windows (RAW session without image);
 wenzelm parents: diff
changeset | 12 | structure Bash: BASH = | 
| 
faa452d8e265
basic setup for native Windows (RAW session without image);
 wenzelm parents: diff
changeset | 13 | struct | 
| 
faa452d8e265
basic setup for native Windows (RAW session without image);
 wenzelm parents: diff
changeset | 14 | |
| 60977 | 15 | fun cygwin_bash arg = | 
| 16 | let val cmd = getenv_strict "CYGWIN_ROOT" ^ "\\bin\\bash.exe" | |
| 17 | in Windows.simpleExecute (cmd, quote cmd ^ " -c " ^ quote arg) end; | |
| 18 | ||
| 19 | val process = uninterruptible (fn restore_attributes => fn script => | |
| 20 | let | |
| 21 | datatype result = Wait | Signal | Result of int; | |
| 22 | val result = Synchronized.var "bash_result" Wait; | |
| 23 | ||
| 24 | val id = serial_string (); | |
| 25 |     val script_path = File.tmp_path (Path.basic ("bash_script" ^ id));
 | |
| 26 |     val out_path = File.tmp_path (Path.basic ("bash_out" ^ id));
 | |
| 27 |     val err_path = File.tmp_path (Path.basic ("bash_err" ^ id));
 | |
| 28 |     val pid_path = File.tmp_path (Path.basic ("bash_pid" ^ id));
 | |
| 29 | ||
| 30 | fun cleanup_files () = | |
| 31 | (try File.rm script_path; | |
| 32 | try File.rm out_path; | |
| 33 | try File.rm err_path; | |
| 34 | try File.rm pid_path); | |
| 35 | val _ = cleanup_files (); | |
| 36 | ||
| 37 | val system_thread = | |
| 61556 | 38 |       Standard_Thread.fork {name = "bash", stack_limit = NONE, interrupts = false} (fn () =>
 | 
| 60977 | 39 | Multithreading.with_attributes Multithreading.private_interrupts (fn _ => | 
| 40 | let | |
| 41 | val _ = File.write script_path script; | |
| 42 | val rc = | |
| 43 | cygwin_bash | |
| 44 |                 ("echo $$ > " ^ File.shell_path pid_path ^ "; exec bash " ^
 | |
| 45 | File.shell_path script_path ^ | |
| 46 | " > " ^ File.shell_path out_path ^ | |
| 47 | " 2> " ^ File.shell_path err_path) | |
| 48 | |> Windows.fromStatus |> SysWord.toInt; | |
| 49 | val res = if rc = 130 orelse rc = 512 then Signal else Result rc; | |
| 50 | in Synchronized.change result (K res) end | |
| 51 | handle exn => | |
| 52 | (Synchronized.change result (fn Wait => Signal | res => res); reraise exn))); | |
| 53 | ||
| 54 | fun read_pid 0 = NONE | |
| 55 | | read_pid count = | |
| 56 | (case (Int.fromString (File.read pid_path) handle IO.Io _ => NONE) of | |
| 57 | NONE => (OS.Process.sleep (seconds 0.1); read_pid (count - 1)) | |
| 58 | | some => some); | |
| 59 | ||
| 60 | fun terminate NONE = () | |
| 61 | | terminate (SOME pid) = | |
| 62 | let | |
| 63 | fun kill s = | |
| 64 |               OS.Process.isSuccess (cygwin_bash ("kill -" ^ s ^ " -" ^ string_of_int pid))
 | |
| 65 | handle OS.SysErr _ => false; | |
| 66 | fun multi_kill count s = | |
| 67 | count = 0 orelse | |
| 68 | (kill s; kill "0") andalso | |
| 69 | (OS.Process.sleep (seconds 0.1); multi_kill (count - 1) s); | |
| 70 | val _ = | |
| 71 | multi_kill 10 "INT" andalso | |
| 72 | multi_kill 10 "TERM" andalso | |
| 73 | multi_kill 10 "KILL"; | |
| 74 | in () end; | |
| 75 | ||
| 76 | fun cleanup () = | |
| 61556 | 77 | (Standard_Thread.interrupt_unsynchronized system_thread; | 
| 60977 | 78 | cleanup_files ()); | 
| 79 | in | |
| 80 | let | |
| 81 | val _ = | |
| 82 | restore_attributes (fn () => | |
| 83 | Synchronized.guarded_access result (fn Wait => NONE | x => SOME ((), x))) (); | |
| 84 | ||
| 85 | val out = the_default "" (try File.read out_path); | |
| 86 | val err = the_default "" (try File.read err_path); | |
| 87 | val rc = (case Synchronized.value result of Signal => Exn.interrupt () | Result rc => rc); | |
| 88 | val pid = read_pid 1; | |
| 89 | val _ = cleanup (); | |
| 90 |     in {out = out, err = err, rc = rc, terminate = fn () => terminate pid} end
 | |
| 91 | handle exn => (terminate (read_pid 10); cleanup (); reraise exn) | |
| 92 | end); | |
| 60962 
faa452d8e265
basic setup for native Windows (RAW session without image);
 wenzelm parents: diff
changeset | 93 | |
| 
faa452d8e265
basic setup for native Windows (RAW session without image);
 wenzelm parents: diff
changeset | 94 | end; |