48 lines
		
	
	
		
			1.6 KiB
		
	
	
	
		
			Racket
		
	
	
	
	
	
			
		
		
	
	
			48 lines
		
	
	
		
			1.6 KiB
		
	
	
	
		
			Racket
		
	
	
	
	
	
; 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)))))))
 |