]> gitweb.factorcode.org Git - factor.git/commitdiff
ci: Start new vocabs.
authorDoug Coleman <doug.coleman@gmail.com>
Sat, 21 Jul 2018 20:26:37 +0000 (15:26 -0500)
committerDoug Coleman <doug.coleman@gmail.com>
Sat, 21 Jul 2018 20:27:25 +0000 (15:27 -0500)
Add ci.docker for running commands in docker.
Add ci.run-process for running commands and capturing everything from their run.

USE: ci.docker USE: ci.run-process
{ "run" "hello-world" } "docker" find-in-standard-login-path prefix
ci-run-process>autopsy autopsy.

extra/ci/docker/authors.txt [new file with mode: 0644]
extra/ci/docker/docker.factor [new file with mode: 0644]
extra/ci/run-process/authors.txt [new file with mode: 0644]
extra/ci/run-process/run-process.factor [new file with mode: 0644]

diff --git a/extra/ci/docker/authors.txt b/extra/ci/docker/authors.txt
new file mode 100644 (file)
index 0000000..7c1b2f2
--- /dev/null
@@ -0,0 +1 @@
+Doug Coleman
diff --git a/extra/ci/docker/docker.factor b/extra/ci/docker/docker.factor
new file mode 100644 (file)
index 0000000..d66eb6e
--- /dev/null
@@ -0,0 +1,78 @@
+! Copyright (C) 2018 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: io.files.links io.launcher io.standard-paths json.reader
+kernel literals namespaces sequences strings system ;
+IN: ci.docker
+
+SYMBOL: docker-username
+SYMBOL: docker-password
+
+: docker-path ( -- path )
+    "docker" find-in-standard-login-path ;
+
+: docker-machine-path ( -- path )
+    "docker-machine" find-in-standard-login-path ;
+
+: vboxmanage-path ( -- path )
+    "VBoxManage" find-in-standard-login-path ;
+
+: sudo-linux ( seq -- seq' )
+    os linux? [ "sudo" prefix ] when ;
+
+: docker-lines ( seq -- lines )
+    docker-path prefix sudo-linux process-lines ;
+
+: docker-machine-lines ( seq -- lines )
+    docker-machine-path prefix process-lines ;
+
+
+: docker-command ( seq -- )
+    docker-path prefix sudo-linux try-output-process ;
+
+: docker-machine-command ( seq -- )
+    docker-machine-path prefix try-output-process ;
+
+
+: docker-version ( -- string )
+    { "version" } docker-lines ;
+
+: docker-machine-version ( -- string )
+    { "version" } docker-machine-lines ?first ;
+
+
+
+: docker-machine-inspect ( string -- json )
+    { "inspect" } swap suffix docker-machine-lines "" join json> ;
+
+
+: docker-machines ( -- seq )
+    { "ls" "-q" } docker-machine-lines ;
+
+: docker-machine-status ( string -- status )
+    { "status" } swap suffix docker-machine-lines ;
+
+
+: docker-image-names ( -- seq )
+    { "image" "ls" "-q" } docker-lines ;
+
+: docker-image-ls ( -- seq )
+    { "image" "ls" } docker-lines ;
+
+: docker-login ( -- )
+    ${
+        "sudo"
+        docker-path "login"
+        "-p" docker-password get-global
+        "-u" docker-username get-global
+    } run-process drop ;
+
+GENERIC: docker-pull ( obj -- )
+
+M: string docker-pull ( string -- )
+    { "pull" } swap suffix docker-command ;
+
+M: sequence docker-pull ( seq -- )
+    [ docker-pull ] each ;
+
+: docker-hello-world ( -- )
+    { "run" "hello-world" } docker-command ;
diff --git a/extra/ci/run-process/authors.txt b/extra/ci/run-process/authors.txt
new file mode 100644 (file)
index 0000000..7c1b2f2
--- /dev/null
@@ -0,0 +1 @@
+Doug Coleman
diff --git a/extra/ci/run-process/run-process.factor b/extra/ci/run-process/run-process.factor
new file mode 100644 (file)
index 0000000..425afdf
--- /dev/null
@@ -0,0 +1,74 @@
+! Copyright (C) 2018 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors assocs calendar combinators environment
+escape-strings fry io io.pathnames io.streams.string kernel math
+math.parser namespaces prettyprint prettyprint.config sequences
+tools.deploy.backend tools.time unix.groups unix.users uuid ;
+IN: ci.run-process
+
+TUPLE: process-autopsy
+    timestamp os-envs
+    cwd uid euid gid egid out elapsed os-envs-after process ;
+
+: ci-run-process ( process -- timestamp os-envs cwd uid euid gid egid out elapsed os-envs' process )
+    [
+        [
+            gmt os-envs current-directory get
+            real-user-id effective-user-id
+            real-group-id effective-group-id
+        ] dip [
+            '[ _ run-with-output ] with-string-writer
+        ] benchmark os-envs
+    ] keep ;
+
+: ci-run-process>autopsy ( process -- autopsy )
+    ci-run-process process-autopsy boa ;
+
+: unparse-full ( obj -- str )
+    [ unparse ] without-limits ;
+
+: autopsy. ( autopsy -- )
+    {
+        [ drop "<AUTOPSY: " uuid4 append print nl ]
+        [
+            bl bl timestamp>> timestamp>unix-time >float number>string
+            "unix-time" tag-payload print nl
+        ]
+        [
+            bl bl elapsed>> number>string "elapsed-nanos" tag-payload print nl
+        ]
+        [
+            bl bl cwd>> "cwd" tag-payload print nl
+        ]
+        [
+            bl bl uid>> number>string "uid" tag-payload print nl
+        ]
+        [
+            bl bl euid>> number>string "euid" tag-payload print nl
+        ]
+        [
+            bl bl gid>> number>string "gid" tag-payload print nl
+        ]
+        [
+            bl bl egid>> number>string "egid" tag-payload print nl
+        ]
+        [
+            bl bl os-envs>> unparse-full "os-envs" tag-payload print nl
+        ]
+        [
+            bl bl os-envs>> unparse-full "os-envs-after" tag-payload print nl
+        ]
+        [
+            bl bl [ os-envs-after>> ] [ os-envs>> ] bi assoc-diff unparse-full "os-envs-diff" tag-payload print nl
+        ]
+        [
+            bl bl [ os-envs>> ] [ os-envs-after>> ] bi assoc-diff unparse-full "os-envs-swap-diff" tag-payload print nl
+        ]
+        [
+            bl bl process>> unparse-full "process" tag-payload print nl
+        ]
+        [
+            bl bl out>> "out" tag-payload print nl
+        ]
+        [ drop ";AUTOPSY>" print ]
+    } cleave ;
\ No newline at end of file