Merge branch 'master' of caffeine:/users/www/www/
[mspang/www.git] / opencl / register.cgi
1 #!/usr/bin/env racket
2 #lang racket
3 (require srfi/98)
4 (require net/uri-codec)
5 (require net/smtp)
6
7 (define ERROR-HEADER "Location: register-fail\n\n")
8 (define SUCCESS-HEADER "Location: register-success\n\n")
9 (define FRIENDLY-MESSAGE #<<EOF
10 Thank you for registering in the OpenCL contest. Your information has been recorded.
11
12 We'll be emailing you with further details as the registration deadline approaches.
13 EOF
14 )
15
16 (define (is-user? str) (equal? (list str) (regexp-match #rx"[A-Za-z0-9._]+" str)))
17 (define (is-email? str) (equal? (list str) (regexp-match #rx"[A-Za-z0-9._%+-]+@[A-Za-z0-9.-]+" str)))
18
19 (define required-fields `( (quest . ,is-user?) (email . ,is-email?)))
20 (define check-fields '(team open closed))
21
22 (define (identity x) x)
23
24 (let*
25   ((post-data (form-urlencoded->alist (port->string)))
26    (required-extract
27      (map
28        (lambda(x) (let ((e (assoc (car x) post-data)))
29                        (cond [(false? e) #f]
30                              [((cdr x) (cdr e)) e]
31                              [else #f])))
32        required-fields))
33    (check-extract (filter identity (map ((curryr assoc) post-data) check-fields)))
34    (filled-out? (andmap identity required-extract)))
35   (when (not filled-out?)
36     (printf ERROR-HEADER)
37     (exit 0))
38   (smtp-send-message
39     "caffeine.csclub.uwaterloo.ca"
40     "opencl-contest-registration@csclub"
41     (list "init512@gmail.com")
42     "Subject: Contestant registered!\n\n"
43     (list (with-output-to-string
44       (lambda() (write (append required-extract check-extract))))))
45   (smtp-send-message
46     "caffeine.csclub.uwaterloo.ca"
47     "exec@csclub.uwaterloo.ca"
48     (list (cdr (assoc 'email required-extract)))
49     "Subject: OpenCL Registration Received\n\n"
50     (list FRIENDLY-MESSAGE))
51   (printf SUCCESS-HEADER)
52   (exit 0))
53