| 1 | structure AptQuery :> APT_QUERY = |
| 2 | struct |
| 3 | |
| 4 | type info = { name : string, section : string, descr : string, installed : bool } |
| 5 | |
| 6 | fun validName s = CharVector.all (fn ch => Char.isAlphaNum ch orelse ch = #"_" orelse ch = #"-" orelse ch = #".") s |
| 7 | andalso (size s > 0 andalso String.sub (s, 0) <> #"-") |
| 8 | |
| 9 | fun query {node, pkg = name} = |
| 10 | let |
| 11 | val _ = |
| 12 | if validName name then |
| 13 | () |
| 14 | else |
| 15 | raise Fail "Invalid package name" |
| 16 | |
| 17 | val proc = Unix.execute ("/usr/bin/apt-cache", ["show", name]) |
| 18 | val inf = Unix.textInstreamOf proc |
| 19 | |
| 20 | fun loop (section, descr) = |
| 21 | case TextIO.inputLine inf of |
| 22 | NONE => (section, descr) |
| 23 | | SOME line => |
| 24 | if size line >= 9 andalso String.substring (line, 0, 9) = "Section: " then |
| 25 | loop (SOME (String.substring (line, 9, size line - 10)), descr) |
| 26 | else if size line >= 13 andalso String.substring (line, 0, 13) = "Description: " then |
| 27 | loop (section, SOME (String.substring (line, 13, size line - 14))) |
| 28 | else |
| 29 | loop (section, descr) |
| 30 | in |
| 31 | case loop (NONE, NONE) of |
| 32 | (SOME section, SOME descr) => |
| 33 | let |
| 34 | val _ = Unix.reap proc |
| 35 | |
| 36 | val installed = OS.Process.isSuccess (OS.Process.system ("DOMTOOL_USER=apache2.deleuze.hcoop.net /usr/local/bin/domtool-admin package " ^ Init.nodeName node ^ " " ^ name ^ " >/dev/null 2>/dev/null")) |
| 37 | in |
| 38 | SOME {name = name, section = section, descr = descr, installed = installed} |
| 39 | end |
| 40 | | _ => (Unix.reap proc; |
| 41 | NONE) |
| 42 | end |
| 43 | |
| 44 | end |