-
Notifications
You must be signed in to change notification settings - Fork 6
/
curl.reb
156 lines (139 loc) · 4.9 KB
/
curl.reb
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
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
Rebol [
Title: "cURL"
Author: "Christopher Ross-Gill"
Date: 08-Feb-2019
Home: http://ross-gill.com/page/REST_Protocol
File: %curl.reb
Version: 0.1.5
Purpose: "Rebol wrapper for cURL command."
Rights: http://opensource.org/licenses/Apache-2.0
Type: module
Name: rgchris.curl
Exports: [curl]
History: [
08-Feb-2019 0.1.5 "Ren-C compatibilities"
04-Feb-2018 0.1.4 "Ren-C compatibilities"
18-Jul-2017 0.1.3 "Initial Ren-C version"
02-May-2013 0.1.2 "Use COLLECT; basic Auth support"
21-Oct-2012 0.1.1 "Initial published version"
]
Comment: ["cURL Home Page" http://curl.haxx.se/]
]
curl: use [user-agent form-headers enquote][
user-agent: unspaced ["Rebol/" uppercase/part form system/product 1 " " system/version]
enquote: func [
data [block! any-string!]
/local mark
][
mark: switch system/version/4 [3 [{"}] ("'")]
unspaced compose [mark (data) mark]
]
form-headers: func [headers [block! object!] /local out][
collect [
for-each [header value] switch type of headers [
block! [headers]
object! [body of headers]
][
if value [
keep unspaced [" -H " enquote [as text! header ": " value]]
]
]
]
]
curl: func [
"Wrapper for the cURL shell function"
url [url!] "URL to Retrieve"
/method "Specify HTTP request method"
verb [word! text! blank!] "HTTP request method"
/send "Include request body"
data [text! binary! file! blank!] "Request body"
/header "Specify HTTP headers"
headers [block! object! blank!] "HTTP headers"
/as "Specify user agent"
agent [text!] "User agent"
/user "Provide User Credentials"
name [text! blank!] "User Name"
pass [text! blank!] "User Password"
/full "Include HTTP headers in response"
/binary "Receive response as binary"
/follow "Follow HTTP redirects"
/quiet "Return blank! on 4xx/5xx HTTP responses"
/secure "Disallow 'insecure' SSL transactions"
/into "Specify result string"
out [text! binary! blank!] "String to contain result"
/error "Specify error string"
err [text! blank!] "String to contain error"
/timeout "Specify a time limit"
time [time! integer! blank!] "Time limit"
/local command options code
][
out: any [:out make binary! 0]
err: any [:err make text! 0]
options: unspaced collect [
keep "-s"
case/all [
full [keep "i"]
quiet [keep "f"]
not secure [keep "k"]
follow [keep "L"]
:verb [
keep " -X "
keep verb: uppercase form verb
]
:time [
keep " -m "
keep to integer! time
]
not send [data: _]
file? data [
keep reduce [" -d @" form data]
data: _
]
data [
either empty? data [
data: _
][
keep " -d @-"
data: to binary! data
]
]
all [:name :pass][
keep " -u "
keep enquote [name ":" pass]
]
:headers [keep form-headers headers]
]
keep reduce [
" -A " enquote any [:agent user-agent]
]
]
command: spaced ["curl" options enquote url]
code: call/shell/wait/input/output/error command data out err
switch code [
0 18 [
either binary [out][
to text! out
]
]
1 [
if empty? trim/head/tail err [
err: "Unsupported protocol. This build of curl has no support for this protocol."
]
fail/where :err 'url
]
2 [fail/where "Failed to initialize." 'url]
3 [fail/where "URL malformed. The syntax was not correct." 'url]
4 [fail/where "Feature not included in this cURL build." 'url]
6 [fail/where "Couldn't resolve host. The given remote host was not resolved." 'url]
7 [fail/where "Failed to connect to host." 'url]
22 [_]
28 [fail/where "Request timed out." 'url]
50 [fail/where "OS shell error." 'url]
52 [fail/where "The server didn't reply anything." 'url]
(
code: spaced ["cURL Error Code" code trim/head/tail err]
fail/where :code 'url
)
]
]
]