Artifact
13b176d6effd56173d6b56506b9015e7165e73d4:
0000: 3b 3b 20 43 6f 70 79 72 69 67 68 74 20 32 30 30 ;; Copyright 200
0010: 37 2d 32 30 30 38 2c 20 4d 61 74 74 68 65 77 20 7-2008, Matthew
0020: 57 65 6c 6c 61 6e 64 2e 20 6d 61 74 74 40 6b 69 Welland. matt@ki
0030: 61 74 6f 61 2e 63 6f 6d 20 41 6c 6c 20 72 69 67 atoa.com All rig
0040: 68 74 73 20 72 65 73 65 72 76 65 64 2e 0a 3b 3b hts reserved..;;
0050: 20 0a 3b 3b 20 6d 6f 64 65 6c 73 2f 70 65 72 73 .;; models/pers
0060: 6f 6e 2e 73 63 6d 0a 3b 3b 0a 28 72 65 71 75 69 on.scm.;;.(requi
0070: 72 65 20 22 6d 64 35 22 29 0a 0a 28 64 65 66 69 re "md5")..(defi
0080: 6e 65 20 28 70 65 72 73 6f 6e 3a 67 65 74 2d 64 ne (person:get-d
0090: 61 74 20 65 6d 61 69 6c 29 0a 20 20 28 64 62 69 at email). (dbi
00a0: 3a 67 65 74 2d 6f 6e 65 2d 72 6f 77 20 28 73 3a :get-one-row (s:
00b0: 64 62 29 20 22 53 45 4c 45 43 54 20 69 64 2c 6e db) "SELECT id,n
00c0: 61 6d 65 2c 65 6d 61 69 6c 2c 73 74 61 74 75 73 ame,email,status
00d0: 2c 70 61 73 73 77 6f 72 64 2c 73 63 6f 72 65 20 ,password,score
00e0: 46 52 4f 4d 20 70 65 6f 70 6c 65 20 57 48 45 52 FROM people WHER
00f0: 45 20 65 6d 61 69 6c 3d 3f 3b 22 20 65 6d 61 69 E email=?;" emai
0100: 6c 29 29 0a 0a 3b 3b 20 74 68 69 73 20 65 66 66 l))..;; this eff
0110: 65 63 74 69 76 65 6c 79 20 61 75 74 6f 20 6c 6f ectively auto lo
0120: 67 73 20 69 6e 20 75 73 69 6e 67 20 22 22 20 61 gs in using "" a
0130: 73 20 74 68 65 20 70 61 73 73 77 6f 72 64 0a 28 s the password.(
0140: 64 65 66 69 6e 65 20 28 70 65 72 73 6f 6e 3a 63 define (person:c
0150: 72 65 61 74 65 2d 6f 72 2d 67 65 74 20 65 6d 61 reate-or-get ema
0160: 69 6c 29 0a 20 20 28 6c 65 74 20 28 28 64 61 74 il). (let ((dat
0170: 20 28 70 65 72 73 6f 6e 3a 67 65 74 2d 64 61 74 (person:get-dat
0180: 20 65 6d 61 69 6c 29 29 29 0a 20 20 20 20 28 69 email))). (i
0190: 66 20 64 61 74 0a 09 28 70 65 72 73 6f 6e 3a 61 f dat..(person:a
01a0: 75 74 68 65 6e 74 69 63 61 74 65 20 65 6d 61 69 uthenticate emai
01b0: 6c 20 22 22 29 0a 09 28 70 65 72 73 6f 6e 3a 73 l "")..(person:s
01c0: 65 74 2d 70 61 73 73 77 6f 72 64 20 65 6d 61 69 et-password emai
01d0: 6c 20 22 22 29 29 29 29 0a 0a 28 64 65 66 69 6e l ""))))..(defin
01e0: 65 20 28 70 65 72 73 6f 6e 3a 70 61 73 73 77 6f e (person:passwo
01f0: 72 64 2d 6d 61 74 63 68 3f 20 70 61 73 73 77 6f rd-match? passwo
0200: 72 64 20 63 72 79 70 74 65 64 70 77 29 0a 20 20 rd cryptedpw).
0210: 28 73 74 72 69 6e 67 3d 3f 20 28 6d 64 35 3a 64 (string=? (md5:d
0220: 69 67 65 73 74 20 70 61 73 73 77 6f 72 64 29 20 igest password)
0230: 63 72 79 70 74 65 64 70 77 29 29 0a 0a 28 64 65 cryptedpw))..(de
0240: 66 69 6e 65 20 28 70 65 72 73 6f 6e 3a 61 75 74 fine (person:aut
0250: 68 65 6e 74 69 63 61 74 65 20 65 6d 61 69 6c 20 henticate email
0260: 70 61 73 73 77 6f 72 64 29 0a 20 20 28 6c 65 74 password). (let
0270: 20 28 28 70 64 61 74 20 28 70 65 72 73 6f 6e 3a ((pdat (person:
0280: 67 65 74 2d 64 61 74 20 65 6d 61 69 6c 29 29 29 get-dat email)))
0290: 0a 20 20 20 20 28 69 66 20 70 64 61 74 0a 09 3b . (if pdat..;
02a0: 3b 20 28 69 66 20 28 73 3a 70 61 73 73 77 6f 72 ; (if (s:passwor
02b0: 64 2d 6d 61 74 63 68 3f 20 70 61 73 73 77 6f 72 d-match? passwor
02c0: 64 20 28 76 65 63 74 6f 72 2d 72 65 66 20 70 64 d (vector-ref pd
02d0: 61 74 20 34 29 29 0a 09 28 69 66 20 28 70 65 72 at 4))..(if (per
02e0: 73 6f 6e 3a 70 61 73 73 77 6f 72 64 2d 6d 61 74 son:password-mat
02f0: 63 68 3f 20 70 61 73 73 77 6f 72 64 20 28 76 65 ch? password (ve
0300: 63 74 6f 72 2d 72 65 66 20 70 64 61 74 20 34 29 ctor-ref pdat 4)
0310: 29 0a 09 20 20 20 20 70 64 61 74 20 3b 3b 20 70 ).. pdat ;; p
0320: 61 73 73 77 6f 72 64 20 6d 61 74 63 68 65 64 2c assword matched,
0330: 20 72 65 74 75 72 6e 20 62 61 73 69 63 20 72 65 return basic re
0340: 63 6f 72 64 20 69 64 2c 6e 61 6d 65 2c 65 6d 61 cord id,name,ema
0350: 69 6c 2c 73 74 61 74 75 73 0a 09 20 20 20 20 23 il,status.. #
0360: 66 29 0a 09 23 66 29 29 29 0a 0a 3b 3b 20 73 65 f)..#f)))..;; se
0370: 74 73 20 70 61 73 73 77 6f 72 64 2c 20 63 72 65 ts password, cre
0380: 61 74 65 73 20 75 73 65 72 20 69 66 20 64 6f 65 ates user if doe
0390: 73 6e 27 74 20 65 78 69 73 74 0a 28 64 65 66 69 sn't exist.(defi
03a0: 6e 65 20 28 70 65 72 73 6f 6e 3a 73 65 74 2d 70 ne (person:set-p
03b0: 61 73 73 77 6f 72 64 20 65 6d 61 69 6c 20 70 61 assword email pa
03c0: 73 73 77 6f 72 64 29 0a 20 20 28 6c 65 74 20 28 ssword). (let (
03d0: 28 70 64 61 74 20 28 70 65 72 73 6f 6e 3a 67 65 (pdat (person:ge
03e0: 74 2d 64 61 74 20 65 6d 61 69 6c 29 29 0a 09 3b t-dat email))..;
03f0: 3b 20 28 63 70 77 64 20 28 73 3a 63 72 79 70 74 ; (cpwd (s:crypt
0400: 2d 70 61 73 73 77 64 20 70 61 73 73 77 6f 72 64 -passwd password
0410: 20 23 66 29 29 29 0a 20 20 20 20 20 20 20 20 28 #f))). (
0420: 63 70 77 64 20 28 6d 64 35 3a 64 69 67 65 73 74 cpwd (md5:digest
0430: 20 70 61 73 73 77 6f 72 64 29 29 29 0a 20 20 20 password))).
0440: 20 28 69 66 20 70 64 61 74 0a 09 28 64 62 69 3a (if pdat..(dbi:
0450: 65 78 65 63 20 28 73 3a 64 62 29 0a 09 09 20 20 exec (s:db)...
0460: 22 55 50 44 41 54 45 20 70 65 6f 70 6c 65 20 53 "UPDATE people S
0470: 45 54 20 70 61 73 73 77 6f 72 64 3d 3f 20 57 48 ET password=? WH
0480: 45 52 45 20 65 6d 61 69 6c 3d 3f 3b 22 20 0a 09 ERE email=?;" ..
0490: 09 20 20 63 70 77 64 0a 09 09 20 20 65 6d 61 69 . cpwd... emai
04a0: 6c 29 0a 09 28 64 62 69 3a 65 78 65 63 20 28 73 l)..(dbi:exec (s
04b0: 3a 64 62 29 0a 09 09 20 20 22 49 4e 53 45 52 54 :db)... "INSERT
04c0: 20 49 4e 54 4f 20 70 65 6f 70 6c 65 20 28 6e 61 INTO people (na
04d0: 6d 65 2c 65 6d 61 69 6c 2c 70 61 73 73 77 6f 72 me,email,passwor
04e0: 64 29 20 56 41 4c 55 45 53 28 3f 2c 3f 2c 3f 29 d) VALUES(?,?,?)
04f0: 3b 22 0a 09 09 20 20 22 22 0a 09 09 20 20 65 6d ;"... ""... em
0500: 61 69 6c 0a 09 09 20 20 63 70 77 64 29 29 0a 20 ail... cpwd)).
0510: 20 20 20 28 69 66 20 70 64 61 74 20 0a 09 70 64 (if pdat ..pd
0520: 61 74 0a 09 28 70 65 72 73 6f 6e 3a 67 65 74 2d at..(person:get-
0530: 64 61 74 20 65 6d 61 69 6c 29 29 29 29 0a 0a 28 dat email))))..(
0540: 64 65 66 69 6e 65 20 28 70 65 72 73 6f 6e 3a 6c define (person:l
0550: 65 61 72 6e 5f 65 6e 61 62 6c 65 64 3f 20 65 6d earn_enabled? em
0560: 61 69 6c 29 0a 20 20 28 65 71 3f 20 28 64 62 69 ail). (eq? (dbi
0570: 3a 67 65 74 2d 6f 6e 65 20 28 73 3a 64 62 29 20 :get-one (s:db)
0580: 22 53 45 4c 45 43 54 20 73 74 61 74 75 73 20 46 "SELECT status F
0590: 52 4f 4d 20 70 65 6f 70 6c 65 20 57 48 45 52 45 ROM people WHERE
05a0: 20 65 6d 61 69 6c 3d 3f 3b 22 20 65 6d 61 69 6c email=?;" email
05b0: 29 0a 20 20 20 20 20 20 20 31 29 29 0a 0a 28 64 ). 1))..(d
05c0: 65 66 69 6e 65 28 70 65 72 73 6f 6e 3a 66 69 6c efine(person:fil
05d0: 65 73 5f 65 6e 61 62 6c 65 64 3f 20 65 6d 61 69 es_enabled? emai
05e0: 6c 29 0a 20 20 23 66 29 0a 0a 3b 3b 20 69 64 2c l). #f)..;; id,
05f0: 6e 61 6d 65 2c 65 6d 61 69 6c 2c 73 74 61 74 75 name,email,statu
0600: 73 2c 70 61 73 73 77 6f 72 64 2c 73 63 6f 72 65 s,password,score
0610: 0a 28 64 65 66 69 6e 65 20 28 70 65 72 73 6f 6e .(define (person
0620: 3a 67 65 74 2d 69 64 20 20 20 20 20 20 20 64 61 :get-id da
0630: 74 29 28 76 65 63 74 6f 72 2d 72 65 66 20 64 61 t)(vector-ref da
0640: 74 20 30 29 29 0a 28 64 65 66 69 6e 65 20 28 70 t 0)).(define (p
0650: 65 72 73 6f 6e 3a 67 65 74 2d 6e 61 6d 65 20 20 erson:get-name
0660: 20 20 20 64 61 74 29 28 76 65 63 74 6f 72 2d 72 dat)(vector-r
0670: 65 66 20 64 61 74 20 31 29 29 0a 28 64 65 66 69 ef dat 1)).(defi
0680: 6e 65 20 28 70 65 72 73 6f 6e 3a 67 65 74 2d 65 ne (person:get-e
0690: 6d 61 69 6c 20 20 20 20 64 61 74 29 28 76 65 63 mail dat)(vec
06a0: 74 6f 72 2d 72 65 66 20 64 61 74 20 32 29 29 0a tor-ref dat 2)).
06b0: 28 64 65 66 69 6e 65 20 28 70 65 72 73 6f 6e 3a (define (person:
06c0: 67 65 74 2d 73 74 61 74 75 73 20 20 20 64 61 74 get-status dat
06d0: 29 28 76 65 63 74 6f 72 2d 72 65 66 20 64 61 74 )(vector-ref dat
06e0: 20 33 29 29 0a 28 64 65 66 69 6e 65 20 28 70 65 3)).(define (pe
06f0: 72 73 6f 6e 3a 67 65 74 2d 70 61 73 73 77 6f 72 rson:get-passwor
0700: 64 20 64 61 74 29 28 76 65 63 74 6f 72 2d 72 65 d dat)(vector-re
0710: 66 20 64 61 74 20 34 29 29 0a 28 64 65 66 69 6e f dat 4)).(defin
0720: 65 20 28 70 65 72 73 6f 6e 3a 67 65 74 2d 73 63 e (person:get-sc
0730: 6f 72 65 20 20 20 20 64 61 74 29 28 76 65 63 74 ore dat)(vect
0740: 6f 72 2d 72 65 66 20 64 61 74 20 35 29 29 0a 0a or-ref dat 5))..
0750: 28 64 65 66 69 6e 65 20 28 70 65 72 73 6f 6e 3a (define (person:
0760: 73 65 74 2d 69 64 21 20 20 20 20 20 20 20 64 61 set-id! da
0770: 74 20 76 61 6c 29 28 76 65 63 74 6f 72 2d 73 65 t val)(vector-se
0780: 74 21 20 64 61 74 20 30 20 76 61 6c 29 29 0a 28 t! dat 0 val)).(
0790: 64 65 66 69 6e 65 20 28 70 65 72 73 6f 6e 3a 73 define (person:s
07a0: 65 74 2d 6e 61 6d 65 21 20 20 20 20 20 64 61 74 et-name! dat
07b0: 20 76 61 6c 29 28 76 65 63 74 6f 72 2d 73 65 74 val)(vector-set
07c0: 21 20 64 61 74 20 31 20 76 61 6c 29 29 0a 28 64 ! dat 1 val)).(d
07d0: 65 66 69 6e 65 20 28 70 65 72 73 6f 6e 3a 73 65 efine (person:se
07e0: 74 2d 65 6d 61 69 6c 21 20 20 20 20 64 61 74 20 t-email! dat
07f0: 76 61 6c 29 28 76 65 63 74 6f 72 2d 73 65 74 21 val)(vector-set!
0800: 20 64 61 74 20 32 20 76 61 6c 29 29 0a 28 64 65 dat 2 val)).(de
0810: 66 69 6e 65 20 28 70 65 72 73 6f 6e 3a 73 65 74 fine (person:set
0820: 2d 73 74 61 74 75 73 21 20 20 20 64 61 74 20 76 -status! dat v
0830: 61 6c 29 28 76 65 63 74 6f 72 2d 73 65 74 21 20 al)(vector-set!
0840: 64 61 74 20 33 20 76 61 6c 29 29 0a 28 64 65 66 dat 3 val)).(def
0850: 69 6e 65 20 28 70 65 72 73 6f 6e 3a 73 65 74 2d ine (person:set-
0860: 70 61 73 73 77 6f 72 64 21 20 64 61 74 20 76 61 password! dat va
0870: 6c 29 28 76 65 63 74 6f 72 2d 73 65 74 21 20 64 l)(vector-set! d
0880: 61 74 20 34 20 76 61 6c 29 29 0a 28 64 65 66 69 at 4 val)).(defi
0890: 6e 65 20 28 70 65 72 73 6f 6e 3a 73 65 74 2d 73 ne (person:set-s
08a0: 63 6f 72 65 21 20 20 20 20 64 61 74 20 76 61 6c core! dat val
08b0: 29 28 76 65 63 74 6f 72 2d 73 65 74 21 20 64 61 )(vector-set! da
08c0: 74 20 35 20 76 61 6c 29 29 0a t 5 val)).