extra/ci/run-process/run-process.factor

   1 ! Copyright (C) 2018 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors assocs calendar combinators environment
   4 escape-strings io io.pathnames io.streams.string kernel math
   5 math.parser namespaces prettyprint prettyprint.config sequences
   6 tools.deploy.backend tools.time unix.groups unix.users uuid ;
   7 IN: ci.run-process
   8
   9 TUPLE: process-autopsy
  10     timestamp os-envs
  11     cwd uid euid gid egid out elapsed os-envs-after process ;
  12
  13 : ci-run-process ( process -- timestamp os-envs cwd uid euid gid egid out elapsed os-envs' process )
  14     [
  15         [
  16             now-gmt os-envs current-directory get
  17             real-user-id effective-user-id
  18             real-group-id effective-group-id
  19         ] dip [
  20             '[ _ run-with-output ] with-string-writer
  21         ] benchmark os-envs
  22     ] keep ;
  23
  24 : ci-run-process>autopsy ( process -- autopsy )
  25     ci-run-process process-autopsy boa ;
  26
  27 : unparse-full ( obj -- str )
  28     [ unparse ] without-limits ;
  29
  30 : autopsy. ( autopsy -- )
  31     {
  32         [ drop "<AUTOPSY: " uuid4 append print nl ]
  33         [
  34             bl bl timestamp>> timestamp>unix-time >float number>string
  35             "unix-time" tag-payload print nl
  36         ]
  37         [
  38             bl bl elapsed>> number>string "elapsed-nanos" tag-payload print nl
  39         ]
  40         [
  41             bl bl cwd>> "cwd" tag-payload print nl
  42         ]
  43         [
  44             bl bl uid>> number>string "uid" tag-payload print nl
  45         ]
  46         [
  47             bl bl euid>> number>string "euid" tag-payload print nl
  48         ]
  49         [
  50             bl bl gid>> number>string "gid" tag-payload print nl
  51         ]
  52         [
  53             bl bl egid>> number>string "egid" tag-payload print nl
  54         ]
  55         [
  56             bl bl os-envs>> unparse-full "os-envs" tag-payload print nl
  57         ]
  58         [
  59             bl bl os-envs>> unparse-full "os-envs-after" tag-payload print nl
  60         ]
  61         [
  62             bl bl [ os-envs-after>> ] [ os-envs>> ] bi assoc-diff unparse-full "os-envs-diff" tag-payload print nl
  63         ]
  64         [
  65             bl bl [ os-envs>> ] [ os-envs-after>> ] bi assoc-diff unparse-full "os-envs-swap-diff" tag-payload print nl
  66         ]
  67         [
  68             bl bl process>> unparse-full "process" tag-payload print nl
  69         ]
  70         [
  71             bl bl out>> "out" tag-payload print nl
  72         ]
  73         [ drop ";AUTOPSY>" print ]
  74     } cleave ;