feat: add scheme challenges

scheme/README.md

@@ -0,0 +1,25 @@
+# Collatz scheme
+Contains 4 challenges in total so just add 0, 1, 2, 3 to the name.
+Description should always be the same.
+
+## Title
+Collatz scheme
+
+## Text
+This is a series of challenges where you need to program something in Scheme, but only a small subset of the language is allowed to be used.
+More information is given on the website: <TODO address of website:8000>.
+Correctly solving one of the challenges will yield a flag. You can try to attack the website itself, however it is not recommend since it contains no vulnerabilities to the best of our knowledge.
+
+## Files
+None
+
+## How to deploy
+A Dockerfile and a docker-compose is provided that starts the server on port 8000. This port needs to be exposed. The description needs to be filled in so participants can connect to the server. See the TODO.
+```
+cd src
+docker-compose up -d
+```
+If any changes are made to the source code, don't forget to run
+```
+docker-compose build
+```

scheme/SOLUTION.md

@@ -0,0 +1,167 @@
+# Solutions for all 4 challenges
+Point estimates are fairly arbitrary and can be changed by the organizers.
+
+## Category
+All of these challenges can be put in something like a programming category.
+
+## Challenge 0
+### Difficulty
+Free (5 points)
+
+### How To Solve
+`(lambda (a) (+ a 1))`
+
+### Flag
+IGCTF{YouPassedTheSanityCheck!}
+
+-------------------------------------
+## Challenge 1
+### Difficulty
+Easy (30 points)
+
+### How To Solve
+The algorithm is fairly simple to implement:
+```scheme
+(define (f n)
+  (if (zero? (- n 1))
+    0
+    (if (even? n)
+      (+ 1 (f (/ n 2)))
+      (+ 1 (f (+ 1 (* n 3)))))))
+```
+Applying the constraints from the challenge gives:
+```scheme
+(begin
+  (define (a b)
+    (if (zero? (- b 1))
+      0
+      (if (even? b)
+        (+ 1 (a (/ b 2)))
+        (+ 1 (a (+ 1 (* b 3)))))))
+  a)
+```
+
+### Flag
+IGCTF{TJMtKPpKsQNRHkUmricn}
+
+-----------------------------------------------
+## Challenge 2
+### Difficulty
+Easy to Average (45 points)
+
+### How To Solve
+We can reuse the code from before, but we'll need to implement multiplication and division ourself. That's not very difficult to do. 
+```scheme
+(begin
+  (define (times x y)
+    (if (= 0 y)
+      0
+      (+ x (times x (- y 1)))))
+  (define (div x y)
+    (if (= x 0)
+      0
+      (+ 1 (div (- x y) y))))
+  (define (f n)
+  (if (zero? (- n 1))
+    0
+    (if (even? n)
+      (+ 1 (f (div n 2)))
+      (+ 1 (f (+ 1 (times n 3)))))))
+  f)
+```
+
+Renaming all variables and turning it into a lambda gives us:
+```scheme
+(begin
+  (define (a b c)
+    (if (zero? c)
+      0
+      (+ b (a b (- c 1)))))
+  (define (b c d)
+    (if (zero? c)
+      0
+      (+ 1 (b (- c d) d))))
+  (define (c d)
+    (if (zero? (- d 1))
+      0
+      (if (even? d)
+        (+ 1 (c (b d 2)))
+        (+ 1 (c (+ 1 (a d 3)))))))
+  c)
+```
+
+### Flag
+IGCTF{KMCxgtSxUqwVuZbqQZkg}
+
+-------
+## Challenge 3
+### Difficulty
+- Hard (75 points)
+
+### How To Solve
+We can start working from the solution to Challenge 1. Two problems need to be solved
+
+1) We can't use define to bind variables, and we don't have any let either. We can work around this by using lambdas instead to bind values.
+2) Without define or letrec, we can't explicitly do recursion. Writing a fixed-point/Y combinator can help us.
+
+First, let's rewrite the solution from the first challenge using a Y combinator, ignoring the other constraints. This eliminates all explicit recursion, which is what we need define for.
+
+```scheme
+(define (collatz n)
+  (define Y
+    (lambda (le)
+      ((lambda (f) (f f))
+       (lambda (f)
+         (le (lambda (x) ((f f) x)))))))
+  (define (collatz-rec f)
+    (lambda (n)
+    (if (zero? (- n 1))
+      0
+      (if (even? n)
+        (+ 1 (f (/ n 2)))
+        (+ 1 (f (+ 1 (* n 3))))))))
+  ((Y collatz-rec) n))
+```
+
+Now all we need to do is apply two transformations:
+1) Replace defines by lambdas, just as you can replace `let` by a lambda application.
+2) Rename our variables.
+
+The first transformation gives us the following code:
+```scheme
+(define (collatz n)
+  ((lambda (Y collatz-rec)
+     ((Y collatz-rec) n))
+   (lambda (le)
+     ((lambda (f) (f f))
+      (lambda (f)
+        (le (lambda (x) ((f f) x))))))
+   (lambda (f)
+     (lambda (n)
+       (if (zero? (- n 1))
+         0
+         (if (even? n)
+           (+ 1 (f (/ n 2)))
+           (+ 1 (f (+ 1 (* n 3))))))))))
+```
+
+Finally, we can rename our variables to the ones required by the challenge and get rid of that top level define. We only have 3 variable names, but if we play it smart that is sufficient. This snipped yields the flag:
+```scheme
+(lambda (a)
+  ((lambda (b c)
+     ((b c) a))
+   (lambda (b)
+     ((lambda (c) (c c))
+      (lambda (c)
+        (b (lambda (a) ((c c) a))))))
+   (lambda (b)
+     (lambda (c)
+       (if (zero? (- c 1))
+         0
+         (if (even? c)
+           (+ 1 (b (/ c 2)))
+           (+ 1 (b (+ 1 (* c 3))))))))))
+```
+
+### Flag
+IGCTF{MEzFXubIUSRRLYQuJfdm}

scheme/src/Dockerfile

@@ -0,0 +1,10 @@
+FROM ubuntu:latest
+
+# Install dependencies
+RUN apt-get update && apt-get install -y \
+    racket \
+    && rm -rf /var/lib/apt/lists/*
+
+COPY . /racket
+WORKDIR /racket
+ENTRYPOINT ["/racket/docker_entrypoint.sh"]

scheme/src/assets/style.css

@@ -0,0 +1,59 @@
+/*body {
+    background-image: url("rkt.png");
+    background-color: grey;
+}*/
+
+.challenges {
+    padding-top: 10px;
+    max-width: 800px;
+    margin: auto;
+}
+
+.intro {
+    max-width: 800px;
+    margin: auto;
+}
+
+.challenge {
+    border: 4px solid black;
+    padding: 5px;
+    margin-top: 15px;
+}
+
+h1 {
+  color: navy;
+  margin-left: 20px;
+}
+
+.output {
+    border: 2px solid black;
+    padding: 3px;
+    margin-top: 5px;
+    margin-bottom: 5px;
+    margin-right: auto;
+    font-family: monospace;
+    font-size: larger;
+}
+
+textarea {
+    font-family: monospace;
+    font-size: larger;
+    width: 100%;
+    height: 20%;
+    margin-top: 15px;
+    margin-bottom: 15px;
+}
+
+.error {
+    color: #D8000C;
+    background-color: #FFBABA;
+    margin: 10px 0px;
+    padding:12px;
+}
+
+.flag {
+    color: #4F8A10;
+    background-color: #DFF2BF;
+    margin: 10px 0px;
+    padding:12px;
+}

scheme/src/challenge.rkt

@@ -0,0 +1,40 @@
+#lang racket
+
+(require racket/format)
+
+(provide make-challenge add-status (struct-out challenge))
+
+(struct challenge (id description flag input output allowed status err))
+
+; This list is non-exhaustive, you can help by expanding it.
+(define never-allow '(read string->symbol))
+
+(define (verify-allowed allowed)
+  (define res 
+    (map (lambda (sym)
+           (define found (member sym never-allow))
+           (if found
+             (car found)
+             '()))
+         allowed))
+  (flatten res))
+
+(define (make-challenge id description flag input output allowed)
+  (define bad-allowed (verify-allowed allowed))
+  (cond 
+    ((not (null? bad-allowed))
+     (error "Error: you allowed a variable in a challenge that may lead to remote code execution: " (~v bad-allowed)))
+    ((not (= (length input) (length output)))
+     (error "Input and output of a challenge needs to be of the same length"))
+    (else
+      (challenge id description flag input output allowed #f ""))))
+
+(define (add-status status err c)
+  (challenge (challenge-id c)
+             (challenge-description c)
+             (challenge-flag c)
+             (challenge-input c)
+             (challenge-output c)
+             (challenge-allowed c)
+             status
+             err))

scheme/src/challenges.rkt

@@ -0,0 +1,44 @@
+#lang racket
+
+(require "challenge.rkt")
+
+(provide challenges)
+
+;This file contains the challenges of the platform
+;Make sure the id's are incremental, starting from 0 and correspond to the challenges displayed on the platform
+;VERY IMPORTANT: NEVER ALLOW STATE! If state is allowed e.g. through set! it can be abused to simply hardcode the output
+;I also recommend making the first challenge a sanity check for instance by having the input and output be the same
+
+(define variable-names
+  '(a b c d e f g h i j k l m n o p q r s t u v w x y z))
+
+(define challenges
+  (list
+    (make-challenge
+      0
+      "Alright brother, this challenge is the sanity check! Just try writing a lambda that adds one to its argument. If you're stuck on this one, then it’s better to not waste your time on the Scheme challenges. Nah joking just ask one of the organisers for help."
+      "IGCTF{Sheeeuuushhhhh}"
+      (list 1 2 3 4 5 6 7 8 9 10)
+      (list 2 3 4 5 6 7 8 9 10 11)
+      `(,@(take variable-names 1) + lambda))
+    (make-challenge
+      1
+      "Aight, let’s make it a little bit more difficult. Write a function to determine if a number is a multiple of 3. Use only lambda, if, and modulo."
+      "IGCTF{RonalsoIs3xBetterThanMessi}"
+      (list 3 5 9 14 21 28 30 42 56 60)
+      (list #t #f #t #f #t #f #t #t #f #t)
+      `(,@(take variable-names 1) lambda if modulo =))
+    (make-challenge
+      2
+      "Now write code to find the greatest of three numbers. No conditionals (like if or cond) are allowed!"
+      "IGCTF{RonalsoIsTheGOAT}"
+      (list '(3 7 5) '(12 9 15) '(8 8 8) '(1 0 -1) '(23 56 78))
+      (list 7 15 8 1 78)
+      `(,@(take variable-names 3) lambda max apply))
+    (make-challenge
+      3
+      "Aight, now try this one: Determine if all numbers in a list are positive, and map them to a boolean value. You are not allowed to use recursion!"
+      "IGCTF{NotPositive?DrinkMonsterEnergy(itKindaRhymes)}"
+      (list '(1 2 3) '(-1 2 3) '(0 2 3) '(5 10 20) '(-5 -10 -20))
+      (list #t #f #f #t #f)
+      `(,@(take variable-names 3) lambda max andmap <))))

scheme/src/docker-compose.yml

@@ -0,0 +1,6 @@
+
+services:
+  scheme-challenge:
+    build: .
+    ports:
+      - 80:8000

scheme/src/docker_entrypoint.sh

@@ -0,0 +1,5 @@
+#!/bin/sh
+chmod +x /racket/docker_entrypoint.sh
+
+
+racket server.rkt

scheme/src/either.rkt

@@ -0,0 +1,75 @@
+#lang racket
+
+(provide left right left? right? squash
+         >>= return reduce <*> e-map do)
+
+(struct either (tag value))
+
+(define (left val)
+  (either 'left val))
+
+(define (right val)
+  (either 'right val))
+
+(define (left? val)
+  (and (either? val) (eq? (either-tag val) 'left)))
+
+(define (right? val)
+  (not (left? val)))
+
+(define (>>= e f)
+  (if (eq? (either-tag e) 'left)
+    e
+    (f (either-value e))))
+
+(define (return x)
+  (right x))
+
+(define (reduce f-left f-right e)
+  (if (eq? (either-tag e) 'left)
+    (f-left (either-value e))
+    (f-right (either-value e))))
+
+(define (<*> f e)
+  (cond
+    ((eq? 'left (either-tag f))
+     f)
+    ((eq? 'left (either-tag e))
+     e)
+    (else
+      (right ((either-value f) (either-value e))))))
+
+(define (e-map f e)
+  (if (eq? 'left (either-tag e))
+    e
+    (right (f (either-value e)))))
+
+(define (squash e)
+  (if (and (right? e) (either? (either-value e)))
+    (either-value e)
+    e))
+
+; (do
+;  (<- var1 exp1)
+;  (exp2)
+;  (let var2 exp3)
+;  (return var2))
+;
+;  -->
+; (>>= exp1 (lambda (var1) (exp2) (let ((var2 exp3)) (return var2))))
+
+(define-syntax (do stx)
+  (define (do->lambda exprs)
+    (define expr (car exprs))
+    (cond
+      ((and (pair? expr) (eq? (car expr) '<-))
+       `(>>= ,(caddr expr) (lambda (,(cadr expr)) ,(do->lambda (cdr exprs)))))
+      ((and (pair? expr) (eq? (car expr) 'let))
+       `(let ((,(cadr expr) ,(caddr expr))) ,(do->lambda (cdr exprs))))
+      ((null? (cdr exprs))
+       expr)
+      (else
+        `(begin ,expr ,(do->lambda (cdr exprs))))))
+  (let* ((ast (syntax->datum stx))
+         (transformed (do->lambda (cdr ast))))
+    (datum->syntax stx transformed)))

scheme/src/server.rkt

@@ -0,0 +1,139 @@
+#lang racket
+
+(require web-server/servlet
+         web-server/servlet-env)
+
+(require "challenge.rkt")
+(require "either.rkt")
+(require "challenges.rkt")
+(require "validate.rkt")
+(require racket/format)
+
+; start: request -> response
+; Consumes a request and produces a page that displays all of the
+; web content.
+(define (start request)
+  (define updated-challenges
+    (cond ((can-parse-attempt? (request-bindings request))
+           (process-attempt (request-bindings request)))
+          (else
+           challenges)))
+  (render-page updated-challenges))
+
+; Produces true if bindings contains values for 'id and 'code
+(define (can-parse-attempt? bindings)
+  (and (exists-binding? 'id bindings)
+       (exists-binding? 'code bindings)))
+
+; The main piece of code for processing a request
+; Takes care of all necesarry error handling and updates a challenge based on the results
+(define (process-attempt bindings)
+  (define input-id (extract-binding/single 'id bindings))
+  (define result
+    (do
+      (<- id (parse-id input-id))
+      (let code (extract-binding/single 'code bindings))
+      (<- challenge (get-challenge id))
+      (let allowed (challenge-allowed challenge))
+      (<- validated-code (validate code allowed))
+      (run challenge validated-code)))
+  (reduce (add-response input-id 'fail) (add-response input-id 'success) result))
+
+
+; Parse the id of the request
+(define (parse-id id)
+  (define num (string->number id))
+  (if num
+    (right num)
+    (left "Error parsing challenge id, not a valid number")))
+
+; Adds a result to a single challenge (1 arg curried)
+(define (add-response id status)
+  (define id-num (string->number id))
+  (lambda (err)
+    (map (lambda (ch)
+           (if (equal? id-num (challenge-id ch))
+             (add-status status err ch)
+             ch))
+         challenges)))
+
+; Tries to obtain a certain challenge
+(define (get-challenge id)
+  (if (or (< id 0) (>= id (length challenges)))
+    (left "Bad challenge id given, stop hacking my platform >:(")
+    (right (list-ref challenges id))))
+
+; Renders the entire page
+(define (render-page challenges)
+  (response/xexpr
+   `(html (head
+            (title "Scheme Challenges!")
+            (link ((rel "stylesheet") (href "style.css")))
+            (link ((rel "shortcut icon") (href "favicon.ico") (type "image/x-icon"))))
+          (body
+           ,(render-intro)
+           ,(render-challenges challenges)
+           (p
+             (small "I really dislike writing frontends, please don't laugh at my CSS"))
+           (div ((style "display: none;"))
+                (a ((href "sicp.jpg")) "Hidden url :o "))))))
+
+(define (render-intro)
+  `(div ((class "intro"))
+        (h2 "Scheme Programming Challenges")
+        (h3 "Instructions")
+        (ul
+          (li (b "You must write an expression in Scheme that evaluates to a function."))
+          (li "This function should have one parameter.")
+          (li "The function will be called for every given input. If the function returns the expected output every time, you get the flag.")
+          (li "The procedures and variable names you can use are restricted, solve the challenge using only what is available (literals are allowed though).")
+          (li "Please don't write infinite loops, it will cause your session to hang (sorry, I didn't solve the halting problem).")
+          (li "There are no exploits possible (I think), digging through the HTML is most likely a waste of time. Solve the challenge the way it's intended.")
+          (li "Hint: you can only write a single expression, use a begin to make your life easier."))))
+
+; Renders all challenges
+(define (render-challenges challenges)
+  `(div ((class "challenges"))
+        ,@(map render-challenge challenges)))
+
+; Renders a single challenge
+(define (render-challenge challenge)
+  (define status (challenge-status challenge))
+  (define err? (eq? status 'fail))
+  (define succ? (eq? status 'success))
+  `(div ((class "challenge"))
+        (h3 ,(string-append "Challenge " (number->string(challenge-id challenge))))
+        (p ,(challenge-description challenge))
+        (div ((class "input-str"))
+             "Allowed procedures, special-forms and variable names:")
+        (div ((class "output"))
+             ,(apply ~a (challenge-allowed challenge) #:separator " | "))
+        (div ((class "input-str"))
+            "Given input:")
+        (div ((class "output"))
+             ,(apply ~v (challenge-input challenge) #:separator " | "))
+        (div ((class "output-str"))
+            "Expected output:")
+        (div ((class "output"))
+             ,(apply ~v (challenge-output challenge) #:separator " | "))
+        (form
+          (input ((name "id") (type "hidden") (value ,(number->string (challenge-id challenge)))))
+          (textarea ((name "code")))
+          (button ((type "submit")) "Get flag!"))
+        (div ((class "error") (style ,(if err? "" "display: none;")))
+             ,(if (pair? (challenge-err challenge))
+                (apply ~a (challenge-err challenge) #:separator " | ")
+                (~a (challenge-err challenge))))
+        (div ((class "flag") (style ,(if succ? "" "display: none;")))
+             ,(if succ?
+                (challenge-flag challenge)
+                "")))) ;TODO input is cleared after submission
+
+; #:listen-ip #f
+; #:command-line? #t
+(displayln "serving on port 8000")
+(serve/servlet start
+               #:servlet-path "/"
+               #:listen-ip #f
+               #:command-line? #t
+               #:extra-files-paths (list (build-path "assets/")))

scheme/src/validate.rkt

@@ -0,0 +1,47 @@
+; This will be used on the server to validate all source code by the participants before running it
+; Allowed procedures and special-forms will vary with each challenge
+
+#lang racket
+
+(require "challenge.rkt")
+(require "either.rkt")
+(require racket/format)
+
+(provide validate run)
+
+(define (validate str allowed)
+  (call/cc
+    (lambda (c)
+      (call-with-exception-handler
+        (lambda (e)
+          (c (left (exn-message e))))
+        (lambda ()
+          (define expr (read (open-input-string str)))
+          (check-allowed expr allowed))))))
+
+(define (check-allowed expr allowed)
+  (define (get-symbols expr)
+    (if (pair? expr)
+      (flatten (map get-symbols expr))
+      (if (symbol? expr) (list expr) '())))
+  (define syms (get-symbols expr))
+  (define bad-syms (filter (lambda (s) (not (member s allowed))) syms))
+  (if (null? bad-syms)
+    (right expr)
+    (left (apply string-append (cons "error: you used one or more procedures, special forms or variable names that has been disabled: " (map (lambda (s) (string-append " " s " ")) (map symbol->string bad-syms)))))))
+
+; Allowing for functions with multiple arguments is something I leave for the future generation to implement
+; It should be quite trivial add
+(define (run challenge code)
+  (call/cc
+    (lambda (c)
+      (call-with-exception-handler
+        (lambda (e)
+          (c (left (exn-message e))))
+        (lambda ()
+          (define input (challenge-input challenge))
+          (define func (eval code (make-base-namespace)))
+          (define res (map (lambda (in) (apply func (list in))) input))
+          (if (equal? res (challenge-output challenge))
+            (right "")
+            (left res)))))))