From 93a43784759f36477a5c87a99a79cac5dfcfa418 Mon Sep 17 00:00:00 2001 From: 1computer1 Date: Tue, 9 Jul 2019 05:19:41 -0400 Subject: [PATCH] Initial commit --- .gitignore | 4 + LICENSE | 19 ++++ README.md | 38 +++++++ Setup.hs | 2 + config.dhall | 39 +++++++ languages/apl/Dockerfile | 4 + languages/apl/run.sh | 2 + languages/bash/Dockerfile | 4 + languages/bash/run.sh | 2 + languages/brainfuck/Dockerfile | 12 +++ languages/brainfuck/bf.cpp | 119 ++++++++++++++++++++ languages/brainfuck/run.sh | 1 + languages/c/Dockerfile | 7 ++ languages/c/run.sh | 2 + languages/clojure/Dockerfile | 4 + languages/clojure/run.sh | 2 + languages/cpp/Dockerfile | 7 ++ languages/cpp/run.sh | 2 + languages/csharp/Dockerfile | 4 + languages/csharp/run.sh | 2 + languages/elixir/Dockerfile | 4 + languages/elixir/run.sh | 2 + languages/fsharp/Dockerfile | 4 + languages/fsharp/run.sh | 2 + languages/go/Dockerfile | 4 + languages/go/run.sh | 3 + languages/haskell/Dockerfile | 15 +++ languages/haskell/run.sh | 2 + languages/java/Dockerfile | 4 + languages/java/run.sh | 2 + languages/javascript/Dockerfile | 4 + languages/javascript/run.sh | 1 + languages/julia/Dockerfile | 4 + languages/julia/run.sh | 1 + languages/lua/Dockerfile | 6 ++ languages/lua/run.sh | 2 + languages/ocaml/Dockerfile | 4 + languages/ocaml/run.sh | 2 + languages/pascal/Dockerfile | 4 + languages/pascal/run.sh | 10 ++ languages/perl/Dockerfile | 4 + languages/perl/run.sh | 2 + languages/php/Dockerfile | 4 + languages/php/run.sh | 2 + languages/prolog/Dockerfile | 4 + languages/prolog/run.sh | 2 + languages/python/Dockerfile | 4 + languages/python/run.sh | 2 + languages/racket/Dockerfile | 4 + languages/racket/run.sh | 2 + languages/ruby/Dockerfile | 4 + languages/ruby/run.sh | 2 + languages/rust/Dockerfile | 4 + languages/rust/run.sh | 2 + package.yaml | 73 +++++++++++++ src/Main.hs | 20 ++++ src/Myriad/Core.hs | 82 ++++++++++++++ src/Myriad/Docker.hs | 185 ++++++++++++++++++++++++++++++++ src/Myriad/Server.hs | 57 ++++++++++ src/Myriad/Util.hs | 33 ++++++ stack.yaml | 4 + stack.yaml.lock | 12 +++ 62 files changed, 864 insertions(+) create mode 100644 .gitignore create mode 100644 LICENSE create mode 100644 README.md create mode 100644 Setup.hs create mode 100644 config.dhall create mode 100644 languages/apl/Dockerfile create mode 100644 languages/apl/run.sh create mode 100644 languages/bash/Dockerfile create mode 100644 languages/bash/run.sh create mode 100644 languages/brainfuck/Dockerfile create mode 100644 languages/brainfuck/bf.cpp create mode 100644 languages/brainfuck/run.sh create mode 100644 languages/c/Dockerfile create mode 100644 languages/c/run.sh create mode 100644 languages/clojure/Dockerfile create mode 100644 languages/clojure/run.sh create mode 100644 languages/cpp/Dockerfile create mode 100644 languages/cpp/run.sh create mode 100644 languages/csharp/Dockerfile create mode 100644 languages/csharp/run.sh create mode 100644 languages/elixir/Dockerfile create mode 100644 languages/elixir/run.sh create mode 100644 languages/fsharp/Dockerfile create mode 100644 languages/fsharp/run.sh create mode 100644 languages/go/Dockerfile create mode 100644 languages/go/run.sh create mode 100644 languages/haskell/Dockerfile create mode 100644 languages/haskell/run.sh create mode 100644 languages/java/Dockerfile create mode 100644 languages/java/run.sh create mode 100644 languages/javascript/Dockerfile create mode 100644 languages/javascript/run.sh create mode 100644 languages/julia/Dockerfile create mode 100644 languages/julia/run.sh create mode 100644 languages/lua/Dockerfile create mode 100644 languages/lua/run.sh create mode 100644 languages/ocaml/Dockerfile create mode 100644 languages/ocaml/run.sh create mode 100644 languages/pascal/Dockerfile create mode 100644 languages/pascal/run.sh create mode 100644 languages/perl/Dockerfile create mode 100644 languages/perl/run.sh create mode 100644 languages/php/Dockerfile create mode 100644 languages/php/run.sh create mode 100644 languages/prolog/Dockerfile create mode 100644 languages/prolog/run.sh create mode 100644 languages/python/Dockerfile create mode 100644 languages/python/run.sh create mode 100644 languages/racket/Dockerfile create mode 100644 languages/racket/run.sh create mode 100644 languages/ruby/Dockerfile create mode 100644 languages/ruby/run.sh create mode 100644 languages/rust/Dockerfile create mode 100644 languages/rust/run.sh create mode 100644 package.yaml create mode 100644 src/Main.hs create mode 100644 src/Myriad/Core.hs create mode 100644 src/Myriad/Docker.hs create mode 100644 src/Myriad/Server.hs create mode 100644 src/Myriad/Util.hs create mode 100644 stack.yaml create mode 100644 stack.yaml.lock diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..84d8976 --- /dev/null +++ b/.gitignore @@ -0,0 +1,4 @@ +.stack-work/ +.vscode/ +logs/ +myriad.cabal diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..ce54236 --- /dev/null +++ b/LICENSE @@ -0,0 +1,19 @@ +Copyright 2019 1Computer1 + +Permission is hereby granted, free of charge, to any person obtaining a copy of +this software and associated documentation files (the "Software"), to deal in +the Software without restriction, including without limitation the rights to +use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies +of the Software, and to permit persons to whom the Software is furnished to do +so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/README.md b/README.md new file mode 100644 index 0000000..f644d27 --- /dev/null +++ b/README.md @@ -0,0 +1,38 @@ +# Myriad + +Arbitrary code execution server using Docker. + +## Setup + +- Fill out `config.dhall`, read it for documentation and an example +- Run `stack run` + +## Endpoints + +`GET /languages` +List of enabled languages. +Example response: + +```json +["haskell", "javascript"] +``` + +--- + +`POST /eval` +Evaluate code. +JSON payload with `language` and `code` keys. +The `language` is as in the name of a subfolder in the `language` directory. +Example payload: + +```json +{ "language": "haskell", "code": "main = print (1 + 1)" } +``` + +Example response: + +```json +{ "result": "2\n" } +``` + +Errors with 404 if `language` is not found, `504` if evaluation timed out, or `500` if evaluation failed for other reasons. diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/config.dhall b/config.dhall new file mode 100644 index 0000000..08f3d43 --- /dev/null +++ b/config.dhall @@ -0,0 +1,39 @@ +let LanguageConfig : Type = + { name : Text -- Name of language as in languages folder + , memory : Text -- Maximum memory usage + , cpus : Text -- Maximum CPU usage + , timeout : Natural -- Timeout for code evaluation in seconds + , concurrent : Natural -- Maximum number of concurrent evaluations + , retries : Natural -- Maximum number of retries for unsure errors + } + +-- Creates the default configuration given a language name. +-- For more customization, use the (//) operator e.g. cfg "haskell" // { timeout = 20 } or write the full record out. +let cfg = \(name : Text) -> + { name = name + , memory = "256m" + , cpus = "0.25" + , timeout = 20 + , concurrent = 10 + , retries = 2 + } + +let Config : Type = + { languages : List LanguageConfig -- List of languages to enable + , buildConcurrently : Bool -- Whether to build images concurrently + , prepareContainers : Bool -- Whether to setup all containers on startup + , cleanupInterval : Natural -- The interval in minutes to kill containers periodically + , port : Integer -- Port to run on + } + +-- Write your config here! +let config : Config = + { languages = + [ cfg "javascript" + ] + , buildConcurrently = True + , prepareContainers = False + , cleanupInterval = 30 + , port = 8081 + } +in config diff --git a/languages/apl/Dockerfile b/languages/apl/Dockerfile new file mode 100644 index 0000000..e756f61 --- /dev/null +++ b/languages/apl/Dockerfile @@ -0,0 +1,4 @@ +FROM juergensauermann/gnu-apl +LABEL author="1Computer1" + +COPY run.sh /var/run/ diff --git a/languages/apl/run.sh b/languages/apl/run.sh new file mode 100644 index 0000000..8ac5a27 --- /dev/null +++ b/languages/apl/run.sh @@ -0,0 +1,2 @@ +printf %s "$1" > program.apl +apl --OFF -s -f program.apl || true diff --git a/languages/bash/Dockerfile b/languages/bash/Dockerfile new file mode 100644 index 0000000..91e3a11 --- /dev/null +++ b/languages/bash/Dockerfile @@ -0,0 +1,4 @@ +FROM bash +LABEL author="1Computer1" + +COPY run.sh /var/run/ diff --git a/languages/bash/run.sh b/languages/bash/run.sh new file mode 100644 index 0000000..5dbb459 --- /dev/null +++ b/languages/bash/run.sh @@ -0,0 +1,2 @@ +printf %s "$1" > program.sh +bash program.sh || true diff --git a/languages/brainfuck/Dockerfile b/languages/brainfuck/Dockerfile new file mode 100644 index 0000000..067f601 --- /dev/null +++ b/languages/brainfuck/Dockerfile @@ -0,0 +1,12 @@ +FROM alpine AS build + +RUN apk update && apk add g++ +COPY bf.cpp . +RUN g++ bf.cpp -o bf + +FROM alpine +LABEL author="1Computer1" + +RUN apk update && apk add libstdc++ +COPY --from=build bf /usr/local/bin/ +COPY run.sh /var/run/ diff --git a/languages/brainfuck/bf.cpp b/languages/brainfuck/bf.cpp new file mode 100644 index 0000000..acb83bc --- /dev/null +++ b/languages/brainfuck/bf.cpp @@ -0,0 +1,119 @@ +#include +#include +#include +#include + +int main(int argc, char **argv) { + std::string ops; + if (argc == 1) { + std::string line; + while (std::getline(std::cin, line)) { + ops.append(line); + } + + if (ops.empty()) { + std::cerr << "No input given"; + return 1; + } + } else { + ops.assign(argv[1], strlen(argv[1])); + } + + int len = ops.length(); + std::vector tape = { 0 }; + int oix = 0; + int tix = 0; + while (oix < len) { + switch (ops[oix]) { + case '>': + tix++; + if (tix >= tape.size()) { + tape.push_back(0); + } + + oix++; + break; + case '<': + tix--; + if (tix < 0) { + std::cerr << "Out of bounds"; + return 1; + } + + oix++; + break; + case '+': + tape[tix]++; + oix++; + break; + case '-': + tape[tix]--; + oix++; + break; + case '.': + std::cout << tape[tix]; + oix++; + break; + case ',': + std::cin >> tape[tix]; + oix++; + break; + case '[': + if (tape[tix] == 0) { + int ls = 0; + int rs = 0; + for (int i = oix; i < len; i++) { + switch (ops[i]) { + case '[': + ls++; + break; + case ']': + rs++; + break; + default: + break; + } + + if (ls == rs) { + oix = i + 1; + break; + } + } + } else { + oix++; + } + + break; + case ']': + if (tape[tix] != 0) { + int ls = 0; + int rs = 0; + for (int i = oix; i >= 0; i--) { + switch (ops[i]) { + case '[': + ls++; + break; + case ']': + rs++; + break; + default: + break; + } + + if (ls == rs) { + oix = i + 1; + break; + } + } + } else { + oix++; + } + + break; + default: + oix++; + } + } + + return 0; +} diff --git a/languages/brainfuck/run.sh b/languages/brainfuck/run.sh new file mode 100644 index 0000000..b9bdc7a --- /dev/null +++ b/languages/brainfuck/run.sh @@ -0,0 +1 @@ +printf %s "$1" | bf || true diff --git a/languages/c/Dockerfile b/languages/c/Dockerfile new file mode 100644 index 0000000..1324766 --- /dev/null +++ b/languages/c/Dockerfile @@ -0,0 +1,7 @@ +FROM alpine +LABEL author="1Computer1" + +RUN apk update +RUN apk add gcc libc-dev + +COPY run.sh /var/run/ diff --git a/languages/c/run.sh b/languages/c/run.sh new file mode 100644 index 0000000..f8f5345 --- /dev/null +++ b/languages/c/run.sh @@ -0,0 +1,2 @@ +printf %s "$1" > program.c +gcc program.c -o program && ./program || true diff --git a/languages/clojure/Dockerfile b/languages/clojure/Dockerfile new file mode 100644 index 0000000..d1feee2 --- /dev/null +++ b/languages/clojure/Dockerfile @@ -0,0 +1,4 @@ +FROM clojure:tools-deps-alpine +LABEL author="1Computer1" + +COPY run.sh /var/run/ diff --git a/languages/clojure/run.sh b/languages/clojure/run.sh new file mode 100644 index 0000000..dc5b764 --- /dev/null +++ b/languages/clojure/run.sh @@ -0,0 +1,2 @@ +printf %s "$1" > program.clj +clojure program.clj || true diff --git a/languages/cpp/Dockerfile b/languages/cpp/Dockerfile new file mode 100644 index 0000000..37bc37b --- /dev/null +++ b/languages/cpp/Dockerfile @@ -0,0 +1,7 @@ +FROM alpine +LABEL author="1Computer1" + +RUN apk update +RUN apk add g++ + +COPY run.sh /var/run/ diff --git a/languages/cpp/run.sh b/languages/cpp/run.sh new file mode 100644 index 0000000..d9e2f85 --- /dev/null +++ b/languages/cpp/run.sh @@ -0,0 +1,2 @@ +printf %s "$1" > program.cpp +g++ program.cpp -o program && ./program || true diff --git a/languages/csharp/Dockerfile b/languages/csharp/Dockerfile new file mode 100644 index 0000000..28584bb --- /dev/null +++ b/languages/csharp/Dockerfile @@ -0,0 +1,4 @@ +FROM mono +LABEL author="1Computer1" + +COPY run.sh /var/run/ diff --git a/languages/csharp/run.sh b/languages/csharp/run.sh new file mode 100644 index 0000000..a3b9e1d --- /dev/null +++ b/languages/csharp/run.sh @@ -0,0 +1,2 @@ +printf %s "$1" > program.cs +csc program.cs >/dev/null && mono program.exe || true diff --git a/languages/elixir/Dockerfile b/languages/elixir/Dockerfile new file mode 100644 index 0000000..7f7bbd8 --- /dev/null +++ b/languages/elixir/Dockerfile @@ -0,0 +1,4 @@ +FROM elixir:alpine +LABEL author="1Computer1" + +COPY run.sh /var/run/ diff --git a/languages/elixir/run.sh b/languages/elixir/run.sh new file mode 100644 index 0000000..ab64413 --- /dev/null +++ b/languages/elixir/run.sh @@ -0,0 +1,2 @@ +printf %s "$1" > program.exs +elixir program.exs || true diff --git a/languages/fsharp/Dockerfile b/languages/fsharp/Dockerfile new file mode 100644 index 0000000..15f6c2c --- /dev/null +++ b/languages/fsharp/Dockerfile @@ -0,0 +1,4 @@ +FROM fsharp +LABEL author="1Computer1" + +COPY run.sh /var/run/ diff --git a/languages/fsharp/run.sh b/languages/fsharp/run.sh new file mode 100644 index 0000000..2a0d0a2 --- /dev/null +++ b/languages/fsharp/run.sh @@ -0,0 +1,2 @@ +printf %s "$1" > program.fs +fsharpc --optimize- program.fs >/dev/null && mono program.exe || true diff --git a/languages/go/Dockerfile b/languages/go/Dockerfile new file mode 100644 index 0000000..2dddf77 --- /dev/null +++ b/languages/go/Dockerfile @@ -0,0 +1,4 @@ +FROM golang:alpine +LABEL author="1Computer1" + +COPY run.sh /var/run/ diff --git a/languages/go/run.sh b/languages/go/run.sh new file mode 100644 index 0000000..9f4c157 --- /dev/null +++ b/languages/go/run.sh @@ -0,0 +1,3 @@ +export GOCACHE=/tmp/"$CODEDIR"/cache +printf %s "$1" > program.go +go run program.go || true diff --git a/languages/haskell/Dockerfile b/languages/haskell/Dockerfile new file mode 100644 index 0000000..a9678b0 --- /dev/null +++ b/languages/haskell/Dockerfile @@ -0,0 +1,15 @@ +FROM debian:stretch +LABEL author="1Computer1" +ENV LANG C.UTF-8 + +RUN apt-get update && \ + apt-get install -y --no-install-recommends gnupg dirmngr && \ + echo 'deb http://downloads.haskell.org/debian stretch main' > /etc/apt/sources.list.d/ghc.list && \ + apt-key adv --keyserver keyserver.ubuntu.com --recv-keys BA3CBA3FFE22B574 && \ + apt-get update && \ + apt-get install -y --no-install-recommends ghc-8.6.5 + +ENV PATH /opt/ghc/8.6.5/bin:$PATH + +COPY .ghci $HOME/ +COPY run.sh /var/run/ diff --git a/languages/haskell/run.sh b/languages/haskell/run.sh new file mode 100644 index 0000000..3d7d1f2 --- /dev/null +++ b/languages/haskell/run.sh @@ -0,0 +1,2 @@ +printf %s "$1" > program.hs +ghc -e main program.hs || true diff --git a/languages/java/Dockerfile b/languages/java/Dockerfile new file mode 100644 index 0000000..dcc0975 --- /dev/null +++ b/languages/java/Dockerfile @@ -0,0 +1,4 @@ +FROM openjdk:13-alpine +LABEL author="1Computer1" + +COPY run.sh /var/run/ diff --git a/languages/java/run.sh b/languages/java/run.sh new file mode 100644 index 0000000..db8e8ce --- /dev/null +++ b/languages/java/run.sh @@ -0,0 +1,2 @@ +printf %s "$1" > Main.java +javac Main.java && java Main || true diff --git a/languages/javascript/Dockerfile b/languages/javascript/Dockerfile new file mode 100644 index 0000000..a3e499a --- /dev/null +++ b/languages/javascript/Dockerfile @@ -0,0 +1,4 @@ +FROM node:alpine +LABEL author="1Computer1" + +COPY run.sh /var/run/ diff --git a/languages/javascript/run.sh b/languages/javascript/run.sh new file mode 100644 index 0000000..9cc1877 --- /dev/null +++ b/languages/javascript/run.sh @@ -0,0 +1 @@ +printf %s "$1" | node -p || true diff --git a/languages/julia/Dockerfile b/languages/julia/Dockerfile new file mode 100644 index 0000000..b81a6c8 --- /dev/null +++ b/languages/julia/Dockerfile @@ -0,0 +1,4 @@ +FROM julia +LABEL author="1Computer1" + +COPY run.sh /var/run/ diff --git a/languages/julia/run.sh b/languages/julia/run.sh new file mode 100644 index 0000000..7cf9563 --- /dev/null +++ b/languages/julia/run.sh @@ -0,0 +1 @@ +printf %s "$1" | julia diff --git a/languages/lua/Dockerfile b/languages/lua/Dockerfile new file mode 100644 index 0000000..0835675 --- /dev/null +++ b/languages/lua/Dockerfile @@ -0,0 +1,6 @@ +FROM alpine + +RUN apk update +RUN apk add lua5.3 + +COPY run.sh /var/run/ diff --git a/languages/lua/run.sh b/languages/lua/run.sh new file mode 100644 index 0000000..f229802 --- /dev/null +++ b/languages/lua/run.sh @@ -0,0 +1,2 @@ +printf %s "$1" > program.lua +lua5.3 program.lua || true diff --git a/languages/ocaml/Dockerfile b/languages/ocaml/Dockerfile new file mode 100644 index 0000000..e332bb1 --- /dev/null +++ b/languages/ocaml/Dockerfile @@ -0,0 +1,4 @@ +FROM frolvlad/alpine-ocaml +LABEL author="1Computer1" + +COPY run.sh /var/run/ diff --git a/languages/ocaml/run.sh b/languages/ocaml/run.sh new file mode 100644 index 0000000..cdaaa9a --- /dev/null +++ b/languages/ocaml/run.sh @@ -0,0 +1,2 @@ +printf %s "$1" > program.ml +ocamlopt -cclib --static -o program program.ml && ./program || true diff --git a/languages/pascal/Dockerfile b/languages/pascal/Dockerfile new file mode 100644 index 0000000..981c1aa --- /dev/null +++ b/languages/pascal/Dockerfile @@ -0,0 +1,4 @@ +FROM frolvlad/alpine-fpc +LABEL author="1Computer1" + +COPY run.sh /var/run/ diff --git a/languages/pascal/run.sh b/languages/pascal/run.sh new file mode 100644 index 0000000..99afe11 --- /dev/null +++ b/languages/pascal/run.sh @@ -0,0 +1,10 @@ +printf %s "$1" > program.pas + +# fpc does not use stderr, ld however does, capture both +res="$(fpc program.pas 2>&1)" + +if [ $? -eq 0 ]; then + ./program || true +else + printf %s "$res" +fi diff --git a/languages/perl/Dockerfile b/languages/perl/Dockerfile new file mode 100644 index 0000000..2826c4e --- /dev/null +++ b/languages/perl/Dockerfile @@ -0,0 +1,4 @@ +FROM perl:slim +LABEL author="1Computer1" + +COPY run.sh /var/run/ diff --git a/languages/perl/run.sh b/languages/perl/run.sh new file mode 100644 index 0000000..3ba6d9e --- /dev/null +++ b/languages/perl/run.sh @@ -0,0 +1,2 @@ +printf %s "$1" > program.pl +perl program.pl || true diff --git a/languages/php/Dockerfile b/languages/php/Dockerfile new file mode 100644 index 0000000..980d994 --- /dev/null +++ b/languages/php/Dockerfile @@ -0,0 +1,4 @@ +FROM php:alpine +LABEL author="1Computer1" + +COPY run.sh /var/run/ diff --git a/languages/php/run.sh b/languages/php/run.sh new file mode 100644 index 0000000..aeac323 --- /dev/null +++ b/languages/php/run.sh @@ -0,0 +1,2 @@ +printf %s "$1" > program.php +php program.php || true diff --git a/languages/prolog/Dockerfile b/languages/prolog/Dockerfile new file mode 100644 index 0000000..1d0f232 --- /dev/null +++ b/languages/prolog/Dockerfile @@ -0,0 +1,4 @@ +FROM swipl +LABEL author="1Computer1" + +COPY run.sh /var/run/ diff --git a/languages/prolog/run.sh b/languages/prolog/run.sh new file mode 100644 index 0000000..81cbdee --- /dev/null +++ b/languages/prolog/run.sh @@ -0,0 +1,2 @@ +printf %s "$1" > program.pl +swipl --quiet program.pl || true diff --git a/languages/python/Dockerfile b/languages/python/Dockerfile new file mode 100644 index 0000000..698a384 --- /dev/null +++ b/languages/python/Dockerfile @@ -0,0 +1,4 @@ +FROM python:3-alpine +LABEL author="1Computer1" + +COPY run.sh /var/run/ diff --git a/languages/python/run.sh b/languages/python/run.sh new file mode 100644 index 0000000..480954f --- /dev/null +++ b/languages/python/run.sh @@ -0,0 +1,2 @@ +printf %s "$1" > program.py +python program.py || true diff --git a/languages/racket/Dockerfile b/languages/racket/Dockerfile new file mode 100644 index 0000000..4e26694 --- /dev/null +++ b/languages/racket/Dockerfile @@ -0,0 +1,4 @@ +FROM jackfirth/racket +LABEL author="1Computer1" + +COPY run.sh /var/run/ diff --git a/languages/racket/run.sh b/languages/racket/run.sh new file mode 100644 index 0000000..0b89642 --- /dev/null +++ b/languages/racket/run.sh @@ -0,0 +1,2 @@ +printf %s "$1" > program.rkt +racket program.rkt || true diff --git a/languages/ruby/Dockerfile b/languages/ruby/Dockerfile new file mode 100644 index 0000000..f0bdb21 --- /dev/null +++ b/languages/ruby/Dockerfile @@ -0,0 +1,4 @@ +FROM ruby:alpine +LABEL author="1Computer1" + +COPY run.sh /var/run/ diff --git a/languages/ruby/run.sh b/languages/ruby/run.sh new file mode 100644 index 0000000..688c3b0 --- /dev/null +++ b/languages/ruby/run.sh @@ -0,0 +1,2 @@ +printf %s "$1" > program.rb +ruby program.rb || true diff --git a/languages/rust/Dockerfile b/languages/rust/Dockerfile new file mode 100644 index 0000000..93bf3e3 --- /dev/null +++ b/languages/rust/Dockerfile @@ -0,0 +1,4 @@ +FROM rust:slim +LABEL author="1Computer1" + +COPY run.sh /var/run/ diff --git a/languages/rust/run.sh b/languages/rust/run.sh new file mode 100644 index 0000000..b150608 --- /dev/null +++ b/languages/rust/run.sh @@ -0,0 +1,2 @@ +printf %s "$1" > program.rs +rustc -C opt-level=0 --color never program.rs && ./program || true diff --git a/package.yaml b/package.yaml new file mode 100644 index 0000000..aa16c99 --- /dev/null +++ b/package.yaml @@ -0,0 +1,73 @@ +name: myriad +version: 0.1.0.0 +github: "1computer1/myriad" +license: MIT +author: "1Computer1" +maintainer: "onecomputer00@gmail.com" +copyright: "2019 1Computer1" + +extra-source-files: +- README.md + +synopsis: Arbitrary code execution in Docker +category: Server +description: Please see the README + +dependencies: +- aeson +- async +- base +- bytestring +- containers +- dhall +- lifted-base +- lifted-async +- monad-control +- monad-logger +- mtl +- optparse-applicative +- servant +- servant-server +- snowflake +- stm +- string-conversions +- text +- time +- transformers +- transformers-base +- typed-process +- wai +- warp + +default-extensions: +- BlockArguments +- ConstraintKinds +- DataKinds +- DeriveFunctor +- DeriveGeneric +- FlexibleContexts +- FunctionalDependencies +- GADTs +- LambdaCase +- MultiParamTypeClasses +- MultiWayIf +- NamedFieldPuns +- OverloadedStrings +- PatternSynonyms +- PolyKinds +- RankNTypes +- ScopedTypeVariables +- TupleSections +- TypeApplications +- TypeOperators +- TypeFamilies +- ViewPatterns + +executable: + main: Main.hs + source-dirs: src + ghc-options: + - -threaded + - -rtsopts + - -with-rtsopts=-N + - -Wall diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 index 0000000..d04058e --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,20 @@ +module Main where + +import Control.Monad.Logger + +import Network.Wai.Handler.Warp (run) + +import Myriad.Core +import Myriad.Docker +import Myriad.Server + +main :: IO () +main = do + env <- initEnv "./config.dhall" + runMyriadT env do + buildAllImages + startCleanup + runStdoutLoggingT do + logInfoN "Finished Docker-related setup" + logInfoN "Starting server" + run (fromIntegral . port . config $ env) $ app env diff --git a/src/Myriad/Core.hs b/src/Myriad/Core.hs new file mode 100644 index 0000000..40bfc4f --- /dev/null +++ b/src/Myriad/Core.hs @@ -0,0 +1,82 @@ +module Myriad.Core + ( Language + , ContainerName + , ImageName + , EvalResult(..) + , Env(..) + , MyriadConfig(..) + , LanguageConfig(..) + , MyriadT + , MonadWithIO + , runMyriadT + , initEnv + ) where + +import Control.Monad.Base +import Control.Monad.Logger +import Control.Monad.Reader +import Control.Monad.Trans.Control + +import qualified Data.ByteString.Lazy as BL +import qualified Data.Map.Strict as M +import qualified Data.Text as T +import Dhall +import GHC.Generics (Generic) + +import Control.Concurrent.QSem +import Data.IORef.Lifted +import Data.Snowflake + +type Language = T.Text +type ContainerName = String +type ImageName = String + +data EvalResult = EvalOk BL.ByteString | EvalTimedOut | EvalErrored + +data Env = Env + { config :: MyriadConfig + , containers :: IORef (M.Map Language ContainerName) + , containerSems :: IORef (M.Map Language QSem) + , evalSems :: IORef (M.Map Language QSem) + , snowflakeGen :: SnowflakeGen + } + +data MyriadConfig = MyriadConfig + { languages :: [LanguageConfig] + , buildConcurrently :: Bool + , prepareContainers :: Bool + , cleanupInterval :: Natural + , port :: Integer + } deriving (Show, Generic) + +instance Interpret MyriadConfig + +data LanguageConfig = LanguageConfig + { name :: Language + , memory :: T.Text + , cpus :: T.Text + , timeout :: Natural + , concurrent :: Natural + , retries :: Natural + } deriving (Show, Generic) + +instance Interpret LanguageConfig + +type MyriadT m = ReaderT Env (LoggingT m) + +type MonadWithIO m = (MonadIO m, MonadBase IO m, MonadBaseControl IO m) + +readConfig :: T.Text -> IO MyriadConfig +readConfig path = input auto path + +initEnv :: T.Text -> IO Env +initEnv path = + Env + <$> readConfig path + <*> newIORef M.empty + <*> newIORef M.empty + <*> newIORef M.empty + <*> newSnowflakeGen defaultConfig 0 + +runMyriadT :: MonadIO m => Env -> MyriadT m a -> m a +runMyriadT env f = runStdoutLoggingT $ runReaderT f env diff --git a/src/Myriad/Docker.hs b/src/Myriad/Docker.hs new file mode 100644 index 0000000..48cec88 --- /dev/null +++ b/src/Myriad/Docker.hs @@ -0,0 +1,185 @@ +module Myriad.Docker + ( EvalResult(..) + , buildImage + , buildAllImages + , startCleanup + , setupContainer + , killContainer + , killAllContainers + , killContainerMaybe + , killAllContainersMaybe + , evalCode + ) where + +import Control.Monad.Logger +import Control.Monad.Reader + +import qualified Data.Map.Strict as M + +import Control.Concurrent.Lifted (fork, threadDelay) +import Control.Concurrent.Async.Lifted +import Control.Concurrent.QSem.Lifted +import Control.Exception.Lifted +import Data.IORef.Lifted +import Data.Snowflake +import System.Process.Typed + +import Myriad.Core +import Myriad.Util + +exec :: MonadWithIO m => String -> MyriadT m () +exec = runProcess_ . shell + +buildImage :: MonadWithIO m => LanguageConfig -> MyriadT m () +buildImage lang@LanguageConfig { name, concurrent } = do + logInfoN $ mconcat ["Building image ", cvs $ imageName lang] + let cmd = mconcat ["docker build -t ", imageName lang, " ./languages/", cvs name] + runProcess_ . setStdout nullStream $ shell cmd + logInfoN $ mconcat ["Built image ", cvs $ imageName lang] + Env { config = MyriadConfig { prepareContainers }, containerSems, evalSems } <- ask + csem <- newQSem 1 -- We only want one container to be set up at a time + esem <- newQSem $ fromIntegral concurrent + modifyIORef' containerSems $ M.insert name csem + modifyIORef' evalSems $ M.insert name esem + when_ prepareContainers $ setupContainer lang + +buildAllImages :: MonadWithIO m => MyriadT m () +buildAllImages = do + MyriadConfig { languages, buildConcurrently } <- asks config + if buildConcurrently + then forConcurrently_ languages buildImage + else forM_ languages buildImage + +startCleanup :: MonadWithIO m => MyriadT m () +startCleanup = do + MyriadConfig { cleanupInterval } <- asks config + when_ (cleanupInterval > 0) do + let t = fromIntegral cleanupInterval * 60000000 + fork $ timer t + where + timer :: MonadWithIO m => Int -> MyriadT m () + timer t = forever do + threadDelay t + n <- killAllContainersMaybe + logInfoN $ mconcat ["Cleaned up ", cvs $ show n, " containers"] + timer t + +setupContainer :: MonadWithIO m => LanguageConfig -> MyriadT m ContainerName +setupContainer lang@LanguageConfig { name, memory, cpus } = do + ref <- asks containers + cnts <- readIORef ref + case cnts M.!? name of + Just x -> pure x + Nothing -> do + cnt <- newContainerName lang + let cmd = mconcat + [ "docker run --rm --name=" + , cvs cnt + -- User 1000 will be for setting up the environment + , " -u1000:1000 -w/tmp/ -dt --net=none --cpus=" + , cvs cpus + , " -m=" + , cvs memory + , " --memory-swap=" + , cvs memory + , " " + , imageName lang + , " /bin/sh" + ] + runProcess_ . setStdout nullStream $ shell cmd + -- The `eval` directory is where all the eval work is done + -- 711 so that users can't traverse into other people's code + exec $ mconcat ["docker exec ", cnt, " mkdir eval"] + exec $ mconcat ["docker exec ", cnt, " chmod 711 eval"] + modifyIORef' ref $ M.insert name cnt + logInfoN $ mconcat ["Started container ", cvs cnt] + pure cnt + +killContainer :: MonadWithIO m => Language -> MyriadT m () +killContainer lang = do + ref <- asks containers + containers <- readIORef ref + case containers M.!? lang of + Nothing -> pure () + Just cnt -> do + modifyIORef' ref $ M.delete lang + let cmd = mconcat ["docker kill ", cnt] + runProcess_ . setStderr nullStream . setStdout nullStream $ shell cmd + logInfoN $ mconcat ["Killed container ", cvs cnt] + +killContainerMaybe :: MonadWithIO m => Language -> MyriadT m Bool +killContainerMaybe lang = do + containers <- asks containers >>= readIORef + case containers M.!? lang of + Nothing -> pure False + Just cnt -> do + res :: Either SomeException () <- try $ killContainer lang + case res of + Left err -> do + logErrorN $ mconcat ["An exception occured when killing ", cvs cnt, ":\n", cvs $ show err] + pure False + Right _ -> pure True + +killAllContainers :: MonadWithIO m => MyriadT m () +killAllContainers = do + containers <- asks containers >>= readIORef + forConcurrently_ (M.keys containers) $ killContainer + +killAllContainersMaybe :: MonadWithIO m => MyriadT m Int +killAllContainersMaybe = do + containers <- asks containers >>= readIORef + xs <- forConcurrently (M.keys containers) $ killContainerMaybe + pure . length $ filter id xs + +evalCode :: MonadWithIO m => LanguageConfig -> Int -> String -> MyriadT m EvalResult +evalCode lang@LanguageConfig { name, timeout, retries } numRetries code = do + Env { containerSems, evalSems } <- ask + csem <- (M.! name) <$> readIORef containerSems + esem <- (M.! name) <$> readIORef evalSems + bracket_ (waitQSem esem) (signalQSem esem) $ do + cnt <- bracket_ (waitQSem csem) (signalQSem csem) $ setupContainer lang + doneRef <- newIORef False -- For keeping track of if the evaluation is done, i.e. succeeded or timed out. + void . fork $ timer doneRef -- `race` could not have been used here since some evals can't be cancelled. + res <- try $ eval cnt + case res of + Left (SomeException err) -> do + void $ killContainerMaybe name + done <- readIORef doneRef + if done + -- If we find the eval is done from an exception, then it was timed out. + then do + logInfoN $ mconcat ["Code timed out in container ", cvs cnt] + pure EvalTimedOut + -- Otherwise, the container was killed from another eval, so we should retry. + else do + writeIORef doneRef True + if numRetries < fromIntegral retries + then evalCode lang (numRetries + 1) code + else do + logErrorN $ mconcat ["An exception occured when evaluating in ", cvs cnt, ":\n", cvs $ show err] + pure EvalErrored + Right x -> do + writeIORef doneRef True + pure x + where + timer :: MonadWithIO m => IORef Bool -> MyriadT m () + timer doneRef = do + threadDelay $ fromIntegral timeout * 1000000 + done <- readIORef doneRef + unless_ done do + writeIORef doneRef True + killContainerMaybe name + + eval :: MonadWithIO m => ContainerName -> MyriadT m EvalResult + eval cnt = do + logInfoN $ mconcat ["Running code in container ", cvs cnt, ":\n", cvs code] + snowflakeGen <- asks snowflakeGen + snowflake <- liftIO $ nextSnowflake snowflakeGen + exec $ mconcat ["docker exec ", cvs cnt, " mkdir eval/", show snowflake] + exec $ mconcat ["docker exec ", cvs cnt, " chmod 777 eval/", show snowflake] + -- User 1001 will be used for the actual execution so that they can't access `eval` itself + let args = ["exec", "-u1001:1001", "-w/tmp/eval/" <> show snowflake, cnt, "/bin/sh", "/var/run/run.sh", code] + output <- readProcessInterleaved_ $ proc "docker" args + exec $ mconcat ["docker exec ", cnt, " rm -rf eval/", show snowflake] + logInfoN $ mconcat ["Ran code in container ", cvs cnt] + pure $ EvalOk output diff --git a/src/Myriad/Server.hs b/src/Myriad/Server.hs new file mode 100644 index 0000000..058db9f --- /dev/null +++ b/src/Myriad/Server.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE DeriveAnyClass #-} + +module Myriad.Server + ( app + ) where + +import Control.Monad.Except +import Control.Monad.Logger +import Control.Monad.Reader + +import Data.Aeson +import Data.List (find) +import qualified Data.Text as T +import GHC.Generics + +import Control.Concurrent.Async.Lifted +import Servant + +import Myriad.Core +import Myriad.Docker +import Myriad.Util + +data EvalRequest = EvalRequest { language :: T.Text, code :: String } deriving (Generic, FromJSON) +data EvalResponse = EvalResponse { result :: T.Text } deriving (Generic, ToJSON) + +type API + = "languages" :> Get '[JSON] [T.Text] + :<|> "eval" :> ReqBody '[JSON] EvalRequest :> Post '[JSON] EvalResponse + +app :: Env -> Application +app = serve (Proxy @API) . server + +server :: Env -> Server API +server env = hoistServer (Proxy @API) (runMyriadT env) serverT + +serverT :: forall m. (MonadWithIO m, MonadError ServantErr m) => ServerT API (MyriadT m) +serverT = handleLanguages :<|> handleEval + where + handleLanguages :: MyriadT m [T.Text] + handleLanguages = do + logInfoN $ mconcat ["GET /languages"] + MyriadConfig { languages } <- asks config + pure . map name $ languages + + handleEval :: EvalRequest -> MyriadT m EvalResponse + handleEval EvalRequest { language, code } = do + logInfoN $ mconcat ["POST /eval"] + env <- ask + let MyriadConfig { languages } = config env + case find (\x -> name x == language) languages of + Nothing -> throwError $ err404 { errBody = "Language " <> cvs language <> " was not found" } + Just cfg -> do + res <- withAsync (evalCode cfg 0 $ cvs code) wait + case res of + EvalErrored -> throwError $ err500 { errBody = "Evaluation failed" } + EvalTimedOut -> throwError $ err504 { errBody = "Evaluation timed out" } + EvalOk xs -> pure . EvalResponse $ cvs xs diff --git a/src/Myriad/Util.hs b/src/Myriad/Util.hs new file mode 100644 index 0000000..1dafa42 --- /dev/null +++ b/src/Myriad/Util.hs @@ -0,0 +1,33 @@ +module Myriad.Util + ( newContainerName + , imageName + , cvs + , when_ + , unless_ + ) where + +import Control.Monad.Reader + +import Data.Snowflake +import Data.String.Conversions + +import Myriad.Core + +newContainerName :: MonadIO m => LanguageConfig -> MyriadT m ContainerName +newContainerName LanguageConfig { name } = do + snowflakeGen <- asks snowflakeGen + snowflake <- liftIO $ nextSnowflake snowflakeGen + pure $ "comp_iler-" <> convertString name <> "-" <> show snowflake + +imageName :: LanguageConfig -> ImageName +imageName LanguageConfig { name } = "1computer1/comp_iler:" <> convertString name + +-- Shorthand because laziness +cvs :: ConvertibleStrings a b => a -> b +cvs = convertString + +when_ :: Applicative f => Bool -> f a -> f () +when_ p = when p . void + +unless_ :: Applicative f => Bool -> f a -> f () +unless_ p = unless p . void diff --git a/stack.yaml b/stack.yaml new file mode 100644 index 0000000..fb049b7 --- /dev/null +++ b/stack.yaml @@ -0,0 +1,4 @@ +resolver: lts-13.27 + +packages: +- . diff --git a/stack.yaml.lock b/stack.yaml.lock new file mode 100644 index 0000000..7fb2c31 --- /dev/null +++ b/stack.yaml.lock @@ -0,0 +1,12 @@ +# This file was autogenerated by Stack. +# You should not edit this file by hand. +# For more information, please see the documentation at: +# https://docs.haskellstack.org/en/stable/lock_files + +packages: [] +snapshots: +- completed: + size: 500539 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/13/27.yaml + sha256: 690db832392afe55733b4c7023fd29b1b1c660ee42f1fb505b86b07394ca994e + original: lts-13.27