-
Notifications
You must be signed in to change notification settings - Fork 205
/
post-data.factor
92 lines (65 loc) · 2.26 KB
/
post-data.factor
1
2
3
4
5
6
7
8
9
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
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
! Copyright (C) 2009 Slava Pestov.
! See https://factorcode.org/license.txt for BSD license.
USING: accessors assocs destructors http io io.encodings.ascii
io.encodings.binary io.encodings.string io.encodings.utf8
io.files io.files.info io.pathnames kernel math.parser sequences
strings urls.encoding ;
IN: http.client.post-data
TUPLE: measured-stream stream size ;
C: <measured-stream> measured-stream
<PRIVATE
GENERIC: (set-post-data-headers) ( header data -- header )
M: sequence (set-post-data-headers)
length "content-length" pick set-at ;
M: measured-stream (set-post-data-headers)
size>> "content-length" pick set-at ;
M: object (set-post-data-headers)
drop "chunked" "transfer-encoding" pick set-at ;
PRIVATE>
: set-post-data-headers ( header post-data -- header )
[ data>> (set-post-data-headers) ]
[ content-type>> "content-type" pick set-at ] bi ;
<PRIVATE
GENERIC: (write-post-data) ( data -- )
M: sequence (write-post-data) write ;
M: measured-stream (write-post-data)
stream>> [ [ write ] each-block ] with-input-stream ;
: write-chunk ( chunk -- )
[ length >hex ";\r\n" append ascii encode write ] [ write ] bi ;
M: object (write-post-data)
[ [ write-chunk ] each-block ] with-input-stream
"0;\r\n" ascii encode write ;
: pathname>measured-stream ( pathname -- stream )
string>>
[ binary <file-reader> &dispose ]
[ file-info size>> ] bi
<measured-stream> ;
: normalize-post-data ( request -- request )
dup post-data>> [
dup params>> [
assoc>query ascii encode >>data
] when*
dup data>> pathname? [
[ pathname>measured-stream ] change-data
] when
drop
] when* ;
PRIVATE>
GENERIC: >post-data ( object -- post-data )
M: f >post-data ;
M: post-data >post-data ;
M: string >post-data
utf8 encode
"application/octet-stream" <post-data>
swap >>data ;
M: assoc >post-data
"application/x-www-form-urlencoded" <post-data>
swap >>params ;
M: object >post-data
"application/octet-stream" <post-data>
swap >>data ;
: unparse-post-data ( request -- request )
[ >post-data ] change-post-data
normalize-post-data ;
: write-post-data ( request -- request )
dup post-data>> [ data>> (write-post-data) ] when* ;