42 lines
1.4 KiB
Racket
Executable File
42 lines
1.4 KiB
Racket
Executable File
#!/usr/bin/env racket
|
|
#lang racket
|
|
(require srfi/98)
|
|
(require net/uri-codec)
|
|
(require net/smtp)
|
|
|
|
(define ERROR-HEADER "Location: http://csclub.uwaterloo.ca/opencl/register-fail\n\n")
|
|
(define SUCCESS-HEADER "Location: http://csclub.uwaterloo.ca/opencl/register-success\n\n")
|
|
|
|
(define (is-user? str) (equal? (list str) (regexp-match #rx"[A-Za-z0-9._]+" str)))
|
|
(define (is-email? str) (equal? (list str) (regexp-match #rx"[A-Za-z0-9._%+-]+@[A-Za-z0-9.-]+" str)))
|
|
|
|
(define required-fields `( (quest . ,is-user?) (email . ,is-email?)))
|
|
(define check-fields '(team open closed))
|
|
|
|
(define (identity x) x)
|
|
|
|
(let*
|
|
((post-data (form-urlencoded->alist (port->string)))
|
|
(required-extract
|
|
(map
|
|
(lambda(x) (let ((e (assoc (car x) post-data)))
|
|
(cond [(false? e) #f]
|
|
[((cdr x) (cdr e)) e]
|
|
[else #f])))
|
|
required-fields))
|
|
(check-extract (filter identity (map ((curryr assoc) post-data) check-fields)))
|
|
(filled-out? (andmap identity required-extract)))
|
|
(when (not filled-out?)
|
|
(printf ERROR-HEADER)
|
|
(exit 0))
|
|
(smtp-send-message
|
|
"caffeine.csclub.uwaterloo.ca"
|
|
"opencl-contest-registration@csclub"
|
|
(list "init512@gmail.com")
|
|
"Subject: Contestant registered!\n\n"
|
|
(list (with-output-to-string
|
|
(lambda() (write (append required-extract check-extract))))))
|
|
(printf SUCCESS-HEADER)
|
|
(exit 0))
|
|
|