| ︙ | | | ︙ | |
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
|
;; stml is a list of html strings
;; (declare (unit stml))
(module stml2
*
(import (chicken random) (chicken base) (chicken string) (chicken time) scheme queues srfi-13 (chicken port) (chicken io) (chicken file) srfi-69 srfi-1 (chicken condition) (chicken time posix) (chicken process-context posix) (chicken pathname) (chicken blob) (chicken format) (chicken process) (chicken process-context))
(import cookie)
(import (prefix dbi dbi:) (prefix crypt c:) typed-records)
;; (declare (uses misc-stml))
(import regex)
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
|
<
<
>
|
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
|
;; stml is a list of html strings
;; (declare (unit stml))
(module stml2
*
(import
(chicken base)
(chicken blob)
(chicken condition)
(chicken file)
(chicken format)
(chicken io)
(chicken pathname)
(chicken port)
(chicken process)
(chicken process-context posix)
(chicken process-context)
(chicken random)
(chicken string)
(chicken time posix)
(chicken time)
(prefix crypt c:)
(prefix dbi dbi:)
cookie
queues
regex
scheme
srfi-1
srfi-13
srfi-69
typed-records
)
;; The (usually global) sdat contains everything about the session
;;
(defstruct sdat
;; database
(dbtype 'pg)
(dbinit #f)
|
| ︙ | | | ︙ | |
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
|
((string? val) (string->number val))
((symbol? val) (string->number (symbol->string val)))
(else #f)))
;; NB// this is *illegal* pgint
(define (s:illegal-pgint val)
(cond
((> val 2147483647) 1)
((< val -2147483648) -1)
(else #f)))
(define (s:any->pgint val)
(let ((n (s:any->number val)))
(if n
(if (s:illegal-pgint n)
#f
|
|
|
|
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
|
((string? val) (string->number val))
((symbol? val) (string->number (symbol->string val)))
(else #f)))
;; NB// this is *illegal* pgint
(define (s:illegal-pgint val)
(cond
((> val 2147483640.0) 1) ;; 2147483647
((< val -2147483640.0) -1) ;; -2147483648
(else #f)))
(define (s:any->pgint val)
(let ((n (s:any->number val)))
(if n
(if (s:illegal-pgint n)
#f
|
| ︙ | | | ︙ | |
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
|
(formdat:load-all-port (current-input-port))
(make-formdat:formdat))))
;; (s:process-cgi-input (caaar dat))
(define (formdat:load-all-port inp)
(let* ((formdat (make-formdat:formdat))
(debugp #f))
;; (open-output-file (conc "/tmp/delme-" (current-user-id) ".log"))))
(let ((alldats (formdat:dat->list inp 10e6 debug-port: debugp)))
(if debugp (format debugp "formdat : alldats: ~A\n" alldats))
(let ((firstitem (car alldats))
(multipass #f))
(if (and (not (null? firstitem))
(not (null? (car firstitem))))
(if (string-match formdat:delim-patt-rex (caar firstitem))
(set! multipass #t)))
|
|
|
|
|
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
|
(formdat:load-all-port (current-input-port))
(make-formdat:formdat))))
;; (s:process-cgi-input (caaar dat))
(define (formdat:load-all-port inp)
(let* ((formdat (make-formdat:formdat))
(debugp #f))
;; (open-output-file (conc "/tmp/delme-" (current-user-id) ".log"))))
;; (write-string (read-string #f inp) #f debugp) ;; destroys all data!
(formdat:initialize formdat)
(let ((alldats (formdat:dat->list inp 10e6 debug-port: #f debugp)))
#;(if debugp (format debugp "formdat : alldats: ~A\n" alldats))
(let ((firstitem (car alldats))
(multipass #f))
(if (and (not (null? firstitem))
(not (null? (car firstitem))))
(if (string-match formdat:delim-patt-rex (caar firstitem))
(set! multipass #t)))
|
| ︙ | | | ︙ | |
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
|
;; (munged (s:process-cgi-input datstr)))
;; (print "datstr: " datstr " munged: " munged)
(if (and (not (null? alldats))
(not (null? (car alldats)))
(not (null? (caar alldats))))
(formdat:load formdat (s:process-cgi-input (caaar alldats))))) ;; munged))
;; (format debugp "formdat : name: ~A content: ~A\n" name content)
(if debugp (close-output-port debugp))
;; (sdat-formdat-set! s:session formdat)
formdat))))
#|
(define inp (open-input-file "tests/example.post.in"))
(define dat (read-string #f inp))
(define datstr (open-input-string dat))
|
|
|
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
|
;; (munged (s:process-cgi-input datstr)))
;; (print "datstr: " datstr " munged: " munged)
(if (and (not (null? alldats))
(not (null? (car alldats)))
(not (null? (caar alldats))))
(formdat:load formdat (s:process-cgi-input (caaar alldats))))) ;; munged))
;; (format debugp "formdat : name: ~A content: ~A\n" name content)
#;(if debugp (close-output-port debugp))
;; (sdat-formdat-set! s:session formdat)
formdat))))
#|
(define inp (open-input-file "tests/example.post.in"))
(define dat (read-string #f inp))
(define datstr (open-input-string dat))
|
| ︙ | | | ︙ | |