/
Curl.pm6
142 lines (130 loc) · 4.21 KB
/
Curl.pm6
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
use v6;
use HTTP::Tinyish::Base;
use HTTP::Tinyish::FileTempFactory;
unit class HTTP::Tinyish::Curl is HTTP::Tinyish::Base;
my constant DEBUG = %*ENV<HTTP_TINYISH_DEBUG>;
has $.async = False;
has $.curl = "curl";
has Int $.timeout = 60;
has Int $.max-redirect = 5;
has $.agent = $?PACKAGE.perl;
has %.default-headers;
has Bool $.verify-ssl = True;
method request($method, $url, Bool :$bin = False, *%opts) {
my $factory = HTTP::Tinyish::FileTempFactory.new;
my ($out-file, $out-fh) = $factory.tempfile;
my ($err-file, $err-fh) = $factory.tempfile;
my ($header-file, $header-fh) = $factory.tempfile;
my @cmd =
$!curl,
"-X", $method,
self!build-options($factory, $url, |%opts),
"--dump-header", $header-file
;
@cmd.push("--head") if $method eq "HEAD";
@cmd.push($url);
warn "=> @cmd[]" if DEBUG;
my &process = sub ($status) {
$_.close for $out-fh, $err-fh; # XXX
if $status.exitcode != 0 {
my $err = $err-file.IO.slurp(:$bin);
return self.internal-error($url, $err);
}
my %res = url => $url, content => $out-file.IO.slurp(:$bin);
self.parse-http-header($header-file.IO.slurp, %res);
return %res;
};
if $.async {
my $proc = Proc::Async.new(|@cmd);
$proc.stdout.tap: -> $v { $out-fh.print($v) };
$proc.stderr.tap: -> $v { $err-fh.print($v) };
$proc.start.then: -> $promise {
LEAVE $factory.cleanup;
my $status = $promise.result;
&process($status);
};
} else {
LEAVE $factory.cleanup;
my $status = run |@cmd, :out($out-fh), :err($err-fh);
&process($status);
}
}
method mirror($url, $file, Bool :$bin = False, *%opts) {
my $factory = HTTP::Tinyish::FileTempFactory.new;
my ($out-file, $out-fh) = $factory.tempfile;
my ($err-file, $err-fh) = $factory.tempfile;
my ($header-file, $header-fh) = $factory.tempfile;
my @cmd =
$!curl,
self!build-options($factory, $url, |%opts),
"-z", $file,
"-o", $file,
"--dump-header", $header-file,
"--remote-time",
$url,
;
warn "=> @cmd[]" if DEBUG;
my &process = sub ($status) {
$_.close for $out-fh, $err-fh; # XXX
if ($status.exitcode != 0) {
my $err = $err-file.IO.slurp(:$bin);
return self.internal-error($url, $err);
}
my %res = url => $url, content => $out-file.IO.slurp(:$bin);
self.parse-http-header($header-file.IO.slurp, %res);
return %res;
};
if $.async {
my $proc = Proc::Async.new(|@cmd);
$proc.stdout.tap: -> $v { $out-fh.print($v) };
$proc.stderr.tap: -> $v { $err-fh.print($v) };
$proc.start.then: -> $promise {
LEAVE $factory.cleanup;
my $status = $promise.result;
&process($status);
};
} else {
LEAVE $factory.cleanup;
my $status = run |@cmd, :out($out-fh), :err($err-fh);
&process($status);
}
}
method !build-options($factory, $url, *%opts) {
my %headers;
if %!default-headers {
%headers = |%!default-headers;
}
if %opts<headers> {
%headers = |%headers, |%opts<headers>;
}
my @options =
'--location',
'--silent',
'--max-time', $!timeout,
'--max-redirs', $!max-redirect,
'--user-agent', $!agent,
;
self!translate-headers(%headers, @options);
@options.push("--insecure") unless $.verify-ssl;
if %opts<content>:exists {
my ($data-file, $data-fh) = $factory.tempfile;
if %opts<content> ~~ Callable {
while %opts<content>() -> $chunk {
$data-fh.write($chunk ~~ Str ?? $chunk.encode !! $chunk);
}
} else {
$data-fh.write(%opts<content> ~~ Str ?? %opts<content>.encode !! %opts<content>);
}
@options.push('--data-binary', "\@$data-file");
}
|@options;
}
method !translate-headers(%headers, @options) {
for %headers.kv -> $field, $value {
if $value ~~ Positional {
@options.append( $value.map({|("-H", "$field:$_")}) );
} else {
@options.push("-H", "$field:$value");
}
}
}