Artifact
878dfed9dae00b8427f524aa0d7616c0a94ea139:
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 4b 69 61 74 6f 61 2e Welland. Kiatoa.
0030: 63 6f 6d 20 41 6c 6c 20 72 69 67 68 74 73 20 72 com All rights r
0040: 65 73 65 72 76 65 64 2e 0a 3b 3b 20 0a 28 6c 6f eserved..;; .(lo
0050: 61 64 20 28 73 3a 6d 6f 64 65 6c 2d 70 61 74 68 ad (s:model-path
0060: 20 22 70 65 72 73 6f 6e 22 29 29 0a 0a 28 64 65 "person"))..(de
0070: 66 69 6e 65 20 28 6c 6f 67 69 6e 2d 61 63 74 69 fine (login-acti
0080: 6f 6e 20 61 63 74 69 6f 6e 29 0a 20 20 28 63 61 on action). (ca
0090: 73 65 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 se (string->symb
00a0: 6f 6c 20 61 63 74 69 6f 6e 29 0a 20 20 20 20 28 ol action). (
00b0: 27 6c 6f 67 69 6e 0a 20 20 20 20 20 3b 3b 20 74 'login. ;; t
00c0: 68 65 20 61 63 74 75 61 6c 20 6c 6f 67 69 6e 20 he actual login
00d0: 63 6f 64 65 0a 20 20 20 20 20 28 73 3a 6c 6f 67 code. (s:log
00e0: 20 22 47 6f 74 20 68 65 72 65 2c 20 64 6f 69 6e "Got here, doin
00f0: 67 20 6c 6f 67 69 6e 22 29 0a 20 20 20 20 20 28 g login"). (
0100: 6c 65 74 20 28 28 65 6d 61 69 6c 20 20 28 73 3a let ((email (s:
0110: 67 65 74 2d 69 6e 70 75 74 20 27 65 6d 61 69 6c get-input 'email
0120: 2d 61 64 64 72 65 73 73 29 29 0a 20 20 20 20 20 -address)).
0130: 20 20 20 20 20 20 28 70 61 73 73 77 64 20 28 73 (passwd (s
0140: 3a 67 65 74 2d 69 6e 70 75 74 20 27 70 61 73 73 :get-input 'pass
0150: 77 6f 72 64 29 29 29 0a 09 20 20 20 3b 3b 20 28 word))).. ;; (
0160: 70 65 72 73 6f 6e 20 28 6d 61 6b 65 2d 70 65 72 person (make-per
0170: 73 6f 6e 29 29 29 20 3b 3b 20 44 4f 20 57 45 20 son))) ;; DO WE
0180: 4e 45 45 44 20 41 20 50 45 52 53 4f 4e 20 22 4f NEED A PERSON "O
0190: 42 4a 45 43 54 22 3f 0a 20 20 20 20 20 20 20 28 BJECT"?. (
01a0: 73 3a 73 65 74 21 20 22 65 6d 61 69 6c 2d 61 64 s:set! "email-ad
01b0: 64 72 65 73 73 22 20 65 6d 61 69 6c 29 20 3b 3b dress" email) ;;
01c0: 20 70 72 65 73 65 72 76 65 20 75 73 65 72 20 61 preserve user a
01d0: 73 20 65 6d 61 69 6c 2d 61 64 64 72 65 73 73 0a s email-address.
01e0: 20 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 (if (and
01f0: 65 6d 61 69 6c 20 70 61 73 73 77 64 29 0a 09 20 email passwd)..
0200: 20 20 28 6c 65 74 20 28 28 67 6f 6f 64 2d 6c 6f (let ((good-lo
0210: 67 69 6e 20 28 70 65 72 73 6f 6e 3a 61 75 74 68 gin (person:auth
0220: 65 6e 74 69 63 61 74 65 20 65 6d 61 69 6c 20 70 enticate email p
0230: 61 73 73 77 64 29 29 29 0a 09 20 20 20 20 20 28 asswd))).. (
0240: 69 66 20 67 6f 6f 64 2d 6c 6f 67 69 6e 0a 09 09 if good-login...
0250: 20 28 62 65 67 69 6e 0a 09 09 20 20 20 28 73 3a (begin... (s:
0260: 73 65 74 21 20 22 6d 73 67 22 20 22 4c 6f 67 69 set! "msg" "Logi
0270: 6e 20 73 75 63 63 65 73 73 66 75 6c 21 22 29 0a n successful!").
0280: 09 09 20 20 20 28 73 3a 73 65 73 73 69 6f 6e 2d .. (s:session-
0290: 76 61 72 2d 73 65 74 21 20 22 65 6d 61 69 6c 22 var-set! "email"
02a0: 20 65 6d 61 69 6c 29 29 0a 09 09 20 28 73 3a 73 email))... (s:s
02b0: 65 74 21 20 22 6d 73 67 22 20 22 42 61 64 20 70 et! "msg" "Bad p
02c0: 61 73 73 77 6f 72 64 20 6f 72 20 65 6d 61 69 6c assword or email
02d0: 2e 20 50 6c 65 61 73 65 20 74 72 79 20 61 67 61 . Please try aga
02e0: 69 6e 22 29 29 29 0a 09 20 20 20 28 73 3a 73 65 in"))).. (s:se
02f0: 74 21 20 22 6d 73 67 22 20 22 4d 69 73 73 69 6e t! "msg" "Missin
0300: 67 20 70 61 73 73 77 6f 72 64 20 6f 72 20 65 6d g password or em
0310: 61 69 6c 22 29 29 29 29 0a 20 20 20 20 28 27 6c ail")))). ('l
0320: 6f 67 6f 75 74 0a 20 20 20 20 20 28 73 3a 64 65 ogout. (s:de
0330: 6c 65 74 65 2d 73 65 73 73 69 6f 6e 29 29 0a 20 lete-session)).
0340: 20 20 20 28 27 6e 61 64 61 0a 20 20 20 20 20 28 ('nada. (
0350: 73 3a 6c 6f 67 20 22 47 6f 74 20 68 65 72 65 2c s:log "Got here,
0360: 20 61 63 74 69 6f 6e 3d 22 20 61 63 74 69 6f 6e action=" action
0370: 29 29 29 29 0a )))).