| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
################################################################# |
|
2
|
|
|
|
|
|
|
# Copyright (c) 2001, Raphael Manfredi |
|
3
|
|
|
|
|
|
|
# Copyright (c) 2011-2016, Alex Tokarev |
|
4
|
|
|
|
|
|
|
# |
|
5
|
|
|
|
|
|
|
# You may redistribute only under the terms of the Artistic License, |
|
6
|
|
|
|
|
|
|
# as specified in the README file that comes with the distribution. |
|
7
|
|
|
|
|
|
|
# |
|
8
|
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
package CGI::Test; |
|
10
|
|
|
|
|
|
|
|
|
11
|
23
|
|
|
23
|
|
352266
|
use strict; |
|
|
23
|
|
|
|
|
33
|
|
|
|
23
|
|
|
|
|
530
|
|
|
12
|
23
|
|
|
23
|
|
73
|
use warnings; |
|
|
23
|
|
|
|
|
1050
|
|
|
|
23
|
|
|
|
|
460
|
|
|
13
|
|
|
|
|
|
|
|
|
14
|
23
|
|
|
23
|
|
63
|
use Carp; |
|
|
23
|
|
|
|
|
29
|
|
|
|
23
|
|
|
|
|
1143
|
|
|
15
|
23
|
|
|
23
|
|
7989
|
use HTTP::Status; |
|
|
23
|
|
|
|
|
58441
|
|
|
|
23
|
|
|
|
|
3838
|
|
|
16
|
23
|
|
|
23
|
|
8625
|
use URI; |
|
|
23
|
|
|
|
|
95859
|
|
|
|
23
|
|
|
|
|
502
|
|
|
17
|
23
|
|
|
23
|
|
11715
|
use File::Temp qw(mkstemp); |
|
|
23
|
|
|
|
|
254587
|
|
|
|
23
|
|
|
|
|
1051
|
|
|
18
|
23
|
|
|
23
|
|
101
|
use File::Spec; |
|
|
23
|
|
|
|
|
22
|
|
|
|
23
|
|
|
|
|
297
|
|
|
19
|
23
|
|
|
23
|
|
65
|
use File::Basename; |
|
|
23
|
|
|
|
|
17
|
|
|
|
23
|
|
|
|
|
1210
|
|
|
20
|
23
|
|
|
23
|
|
73
|
use Cwd qw(abs_path); |
|
|
23
|
|
|
|
|
23
|
|
|
|
23
|
|
|
|
|
628
|
|
|
21
|
|
|
|
|
|
|
|
|
22
|
23
|
|
|
23
|
|
157
|
use vars qw($VERSION); |
|
|
23
|
|
|
|
|
21
|
|
|
|
23
|
|
|
|
|
1343
|
|
|
23
|
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
$VERSION = '1.111'; |
|
25
|
|
|
|
|
|
|
|
|
26
|
23
|
|
|
23
|
|
72
|
use constant WINDOWS => eval { $^O =~ /Win32|cygwin/ }; |
|
|
23
|
|
|
|
|
23
|
|
|
|
23
|
|
|
|
|
20
|
|
|
|
23
|
|
|
|
|
56728
|
|
|
27
|
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
############################################################################# |
|
29
|
|
|
|
|
|
|
# |
|
30
|
|
|
|
|
|
|
# ->new |
|
31
|
|
|
|
|
|
|
# |
|
32
|
|
|
|
|
|
|
# Creation routine |
|
33
|
|
|
|
|
|
|
# |
|
34
|
|
|
|
|
|
|
# Arguments: |
|
35
|
|
|
|
|
|
|
# base_url URL to cgi-bin, e.g. http://foo:18/cgi-bin |
|
36
|
|
|
|
|
|
|
# cgi_dir physical location of base_url |
|
37
|
|
|
|
|
|
|
# tmp_dir (optional) temporary directory to use |
|
38
|
|
|
|
|
|
|
# cgi_env (optional) default CGI environment |
|
39
|
|
|
|
|
|
|
# doc_dir (optional) physical location of docs, for path translation |
|
40
|
|
|
|
|
|
|
# |
|
41
|
|
|
|
|
|
|
############################################################################# |
|
42
|
|
|
|
|
|
|
sub new |
|
43
|
|
|
|
|
|
|
{ |
|
44
|
25
|
|
|
25
|
0
|
4740
|
my $this = bless {}, shift; |
|
45
|
25
|
|
|
|
|
77
|
my %params = @_; |
|
46
|
|
|
|
|
|
|
|
|
47
|
25
|
|
|
|
|
54
|
my $ubase = $params{-base_url}; |
|
48
|
25
|
|
|
|
|
44
|
my $dir = $params{-cgi_dir}; |
|
49
|
25
|
|
50
|
|
|
147
|
my $doc = $params{-doc_dir} || "."; |
|
50
|
25
|
|
50
|
|
|
202
|
my $tmp = $params{-tmp_dir} || $ENV{TMPDIR} || $ENV{TEMP} || "/tmp"; |
|
51
|
25
|
|
|
|
|
45
|
my $env = $params{-cgi_env}; |
|
52
|
|
|
|
|
|
|
|
|
53
|
25
|
|
|
|
|
100
|
my $uri = URI->new($ubase); |
|
54
|
25
|
50
|
33
|
|
|
109056
|
croak "-base_url $ubase is not within the http scheme" |
|
55
|
|
|
|
|
|
|
unless ( $uri->scheme eq 'http' || $uri->scheme eq 'https' ); |
|
56
|
|
|
|
|
|
|
|
|
57
|
25
|
|
|
|
|
1684
|
my ($server, $path) = $this->split_uri($uri); |
|
58
|
25
|
|
|
|
|
308
|
$this->{host_port} = $server; |
|
59
|
25
|
|
|
|
|
68
|
$this->{scheme} = $uri->scheme; |
|
60
|
25
|
|
|
|
|
351
|
$this->{host} = $uri->host; |
|
61
|
25
|
|
|
|
|
637
|
$this->{port} = $uri->port; |
|
62
|
25
|
|
|
|
|
463
|
$this->{base_path} = $path; |
|
63
|
25
|
|
|
|
|
40
|
$this->{cgi_dir} = $dir; |
|
64
|
25
|
|
|
|
|
33
|
$this->{tmp_dir} = $tmp; |
|
65
|
25
|
100
|
|
|
|
79
|
$env = {} unless defined $env; |
|
66
|
25
|
|
|
|
|
39
|
$this->{cgi_env} = $env; |
|
67
|
25
|
|
|
|
|
31
|
$this->{doc_dir} = $doc; |
|
68
|
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
# |
|
70
|
|
|
|
|
|
|
# The following default settings will apply unless alternatives given |
|
71
|
|
|
|
|
|
|
# by user via the -cgi_env parameter. |
|
72
|
|
|
|
|
|
|
# |
|
73
|
|
|
|
|
|
|
|
|
74
|
25
|
|
|
|
|
67
|
my %dflt = (AUTH_TYPE => "Basic", |
|
75
|
|
|
|
|
|
|
GATEWAY_INTERFACE => "CGI/1.1", |
|
76
|
|
|
|
|
|
|
HTTP_ACCEPT => "*/*", |
|
77
|
|
|
|
|
|
|
HTTP_CONNECTION => "Close", |
|
78
|
|
|
|
|
|
|
HTTP_USER_AGENT => "CGI::Test", |
|
79
|
|
|
|
|
|
|
HTTP_ACCEPT_CHARSET => "iso-8859-1", |
|
80
|
|
|
|
|
|
|
REMOTE_HOST => "localhost", |
|
81
|
|
|
|
|
|
|
REMOTE_ADDR => "127.0.0.1", |
|
82
|
|
|
|
|
|
|
SERVER_NAME => $uri->host, |
|
83
|
|
|
|
|
|
|
SERVER_PORT => $uri->port, |
|
84
|
|
|
|
|
|
|
SERVER_PROTOCOL => "HTTP/1.1", |
|
85
|
|
|
|
|
|
|
SERVER_SOFTWARE => "CGI::Test", |
|
86
|
|
|
|
|
|
|
); |
|
87
|
|
|
|
|
|
|
|
|
88
|
25
|
|
|
|
|
947
|
while (my ($key, $value) = each %dflt) |
|
89
|
|
|
|
|
|
|
{ |
|
90
|
300
|
100
|
|
|
|
801
|
$env->{$key} = $value unless exists $env->{$key}; |
|
91
|
|
|
|
|
|
|
} |
|
92
|
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
# |
|
94
|
|
|
|
|
|
|
# Object types to create depending on returned content-type. |
|
95
|
|
|
|
|
|
|
# If not listed here, "Other" is assummed. |
|
96
|
|
|
|
|
|
|
# |
|
97
|
|
|
|
|
|
|
|
|
98
|
25
|
|
|
|
|
70
|
$this->{_obj_type} = {'text/plain' => 'Text', |
|
99
|
|
|
|
|
|
|
'text/html' => 'HTML', |
|
100
|
|
|
|
|
|
|
}; |
|
101
|
|
|
|
|
|
|
|
|
102
|
25
|
|
|
|
|
201
|
return $this; |
|
103
|
|
|
|
|
|
|
} |
|
104
|
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
###################################################################### |
|
106
|
|
|
|
|
|
|
# |
|
107
|
|
|
|
|
|
|
###################################################################### |
|
108
|
|
|
|
|
|
|
sub make |
|
109
|
|
|
|
|
|
|
{ |
|
110
|
0
|
|
|
0
|
0
|
0
|
my $class = shift; |
|
111
|
0
|
|
|
|
|
0
|
return $class->new(@_); |
|
112
|
|
|
|
|
|
|
} |
|
113
|
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
# |
|
115
|
|
|
|
|
|
|
# Attribute access |
|
116
|
|
|
|
|
|
|
# |
|
117
|
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
###################################################################### |
|
119
|
|
|
|
|
|
|
sub host_port |
|
120
|
|
|
|
|
|
|
{ |
|
121
|
44
|
|
|
44
|
1
|
55
|
my $this = shift; |
|
122
|
44
|
|
|
|
|
86
|
return $this->{host_port}; |
|
123
|
|
|
|
|
|
|
} |
|
124
|
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
###################################################################### |
|
126
|
|
|
|
|
|
|
sub base_uri |
|
127
|
|
|
|
|
|
|
{ |
|
128
|
0
|
|
|
0
|
0
|
0
|
my $this = shift; |
|
129
|
|
|
|
|
|
|
|
|
130
|
0
|
|
|
|
|
0
|
my $scheme = $this->{scheme}; |
|
131
|
0
|
|
|
|
|
0
|
my $host = $this->{host}; |
|
132
|
0
|
|
|
|
|
0
|
my $port = $this->{port}; |
|
133
|
0
|
|
|
|
|
0
|
my $base = $this->{base_path}; |
|
134
|
|
|
|
|
|
|
|
|
135
|
0
|
|
|
|
|
0
|
return $scheme . '://' . $host . ':' . $port . $base; |
|
136
|
|
|
|
|
|
|
} |
|
137
|
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
###################################################################### |
|
139
|
|
|
|
|
|
|
sub host |
|
140
|
|
|
|
|
|
|
{ |
|
141
|
0
|
|
|
0
|
0
|
0
|
my $this = shift; |
|
142
|
0
|
|
|
|
|
0
|
return $this->{host}; |
|
143
|
|
|
|
|
|
|
} |
|
144
|
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
###################################################################### |
|
146
|
|
|
|
|
|
|
sub port |
|
147
|
|
|
|
|
|
|
{ |
|
148
|
0
|
|
|
0
|
0
|
0
|
my $this = shift; |
|
149
|
0
|
|
|
|
|
0
|
return $this->{port}; |
|
150
|
|
|
|
|
|
|
} |
|
151
|
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
###################################################################### |
|
153
|
|
|
|
|
|
|
sub base_path |
|
154
|
|
|
|
|
|
|
{ |
|
155
|
44
|
|
|
44
|
1
|
46
|
my $this = shift; |
|
156
|
44
|
|
|
|
|
95
|
return $this->{base_path}; |
|
157
|
|
|
|
|
|
|
} |
|
158
|
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
###################################################################### |
|
160
|
|
|
|
|
|
|
sub cgi_dir |
|
161
|
|
|
|
|
|
|
{ |
|
162
|
44
|
|
|
44
|
1
|
51
|
my $this = shift; |
|
163
|
44
|
|
|
|
|
65
|
return $this->{cgi_dir}; |
|
164
|
|
|
|
|
|
|
} |
|
165
|
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
###################################################################### |
|
167
|
|
|
|
|
|
|
sub doc_dir |
|
168
|
|
|
|
|
|
|
{ |
|
169
|
16
|
|
|
16
|
1
|
40
|
my $this = shift; |
|
170
|
16
|
|
|
|
|
99
|
return $this->{doc_dir}; |
|
171
|
|
|
|
|
|
|
} |
|
172
|
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
###################################################################### |
|
174
|
|
|
|
|
|
|
sub tmp_dir |
|
175
|
|
|
|
|
|
|
{ |
|
176
|
62
|
|
|
62
|
1
|
82
|
my $this = shift; |
|
177
|
62
|
|
|
|
|
711
|
return $this->{tmp_dir}; |
|
178
|
|
|
|
|
|
|
} |
|
179
|
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
###################################################################### |
|
181
|
|
|
|
|
|
|
sub cgi_env |
|
182
|
|
|
|
|
|
|
{ |
|
183
|
210
|
|
|
210
|
0
|
165
|
my $this = shift; |
|
184
|
210
|
|
|
|
|
1000
|
return $this->{cgi_env}; |
|
185
|
|
|
|
|
|
|
} |
|
186
|
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
###################################################################### |
|
188
|
|
|
|
|
|
|
sub _obj_type |
|
189
|
|
|
|
|
|
|
{ |
|
190
|
28
|
|
|
28
|
|
46
|
my $this = shift; |
|
191
|
28
|
|
|
|
|
192
|
return $this->{_obj_type}; |
|
192
|
|
|
|
|
|
|
} |
|
193
|
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
###################################################################### |
|
195
|
|
|
|
|
|
|
sub http_headers { |
|
196
|
0
|
|
|
0
|
1
|
0
|
my ($self) = @_; |
|
197
|
|
|
|
|
|
|
|
|
198
|
0
|
|
|
|
|
0
|
return $self->{http_headers}; |
|
199
|
|
|
|
|
|
|
} |
|
200
|
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
###################################################################### |
|
202
|
|
|
|
|
|
|
# |
|
203
|
|
|
|
|
|
|
# ->_dpath |
|
204
|
|
|
|
|
|
|
# |
|
205
|
|
|
|
|
|
|
# Returns direct path to final component of argument, |
|
206
|
|
|
|
|
|
|
# i.e. the original path with . and .. items removed. |
|
207
|
|
|
|
|
|
|
# |
|
208
|
|
|
|
|
|
|
# Will probably only work on Unix (possibly Win32 if paths given with "/"). |
|
209
|
|
|
|
|
|
|
# |
|
210
|
|
|
|
|
|
|
###################################################################### |
|
211
|
|
|
|
|
|
|
sub _dpath |
|
212
|
|
|
|
|
|
|
{ |
|
213
|
69
|
|
|
69
|
|
2313
|
my $this = shift; |
|
214
|
69
|
|
|
|
|
97
|
my ($dir) = @_; |
|
215
|
69
|
50
|
|
|
|
327
|
my $root = ($dir =~ s|^/||) ? "/" : ""; |
|
216
|
69
|
|
|
|
|
75
|
my @cur; |
|
217
|
69
|
|
|
|
|
215
|
foreach my $item (split(m|/|, $dir)) |
|
218
|
|
|
|
|
|
|
{ |
|
219
|
119
|
50
|
|
|
|
203
|
next if $item eq '.'; |
|
220
|
119
|
50
|
|
|
|
153
|
if ($item eq '..') |
|
221
|
|
|
|
|
|
|
{ |
|
222
|
0
|
|
|
|
|
0
|
pop(@cur); |
|
223
|
|
|
|
|
|
|
} |
|
224
|
|
|
|
|
|
|
else |
|
225
|
|
|
|
|
|
|
{ |
|
226
|
119
|
|
|
|
|
163
|
push(@cur, $item); |
|
227
|
|
|
|
|
|
|
} |
|
228
|
|
|
|
|
|
|
} |
|
229
|
69
|
|
|
|
|
192
|
my $path = $root . join('/', @cur); |
|
230
|
69
|
|
|
|
|
160
|
$path =~ tr|/||s; |
|
231
|
69
|
|
|
|
|
751
|
return $path; |
|
232
|
|
|
|
|
|
|
} |
|
233
|
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
###################################################################### |
|
235
|
|
|
|
|
|
|
# |
|
236
|
|
|
|
|
|
|
# ->split_uri |
|
237
|
|
|
|
|
|
|
# |
|
238
|
|
|
|
|
|
|
# Split down URI into (server, path, query) components. |
|
239
|
|
|
|
|
|
|
# |
|
240
|
|
|
|
|
|
|
###################################################################### |
|
241
|
|
|
|
|
|
|
sub split_uri |
|
242
|
|
|
|
|
|
|
{ |
|
243
|
69
|
|
|
69
|
1
|
92
|
my $this = shift; |
|
244
|
69
|
|
|
|
|
84
|
my ($uri) = @_; |
|
245
|
69
|
|
|
|
|
187
|
return ($uri->host_port, $this->_dpath($uri->path), $uri->query); |
|
246
|
|
|
|
|
|
|
} |
|
247
|
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
###################################################################### |
|
249
|
|
|
|
|
|
|
# |
|
250
|
|
|
|
|
|
|
# ->GET |
|
251
|
|
|
|
|
|
|
# |
|
252
|
|
|
|
|
|
|
# Perform an HTTP GET request on a CGI URI by running the script directly. |
|
253
|
|
|
|
|
|
|
# Returns a CGI::Test::Page object representing the returned page, or the |
|
254
|
|
|
|
|
|
|
# error. |
|
255
|
|
|
|
|
|
|
# |
|
256
|
|
|
|
|
|
|
# Optional $user provides the name of the "authenticated" user running |
|
257
|
|
|
|
|
|
|
# this script. |
|
258
|
|
|
|
|
|
|
# |
|
259
|
|
|
|
|
|
|
###################################################################### |
|
260
|
|
|
|
|
|
|
sub GET |
|
261
|
|
|
|
|
|
|
{ |
|
262
|
42
|
|
|
42
|
1
|
6188
|
my $this = shift; |
|
263
|
42
|
|
|
|
|
59
|
my ($uri, $user) = @_; |
|
264
|
|
|
|
|
|
|
|
|
265
|
42
|
|
|
|
|
114
|
return $this->_cgi_request($uri, $user, undef); |
|
266
|
|
|
|
|
|
|
} |
|
267
|
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
###################################################################### |
|
269
|
|
|
|
|
|
|
# |
|
270
|
|
|
|
|
|
|
# ->POST |
|
271
|
|
|
|
|
|
|
# |
|
272
|
|
|
|
|
|
|
# Perform an HTTP POST request on a CGI URI by running the script directly. |
|
273
|
|
|
|
|
|
|
# Returns a CGI::Test::Page object representing the returned page, or the |
|
274
|
|
|
|
|
|
|
# error. |
|
275
|
|
|
|
|
|
|
# |
|
276
|
|
|
|
|
|
|
# Data to send to the script are held in $input, a CGI::Test::Input object. |
|
277
|
|
|
|
|
|
|
# |
|
278
|
|
|
|
|
|
|
# Optional $user provides the name of the "authenticated" user running |
|
279
|
|
|
|
|
|
|
# this script. |
|
280
|
|
|
|
|
|
|
# |
|
281
|
|
|
|
|
|
|
###################################################################### |
|
282
|
|
|
|
|
|
|
sub POST |
|
283
|
|
|
|
|
|
|
{ |
|
284
|
2
|
|
|
2
|
1
|
4
|
my $this = shift; |
|
285
|
2
|
|
|
|
|
2
|
my ($uri, $input, $user) = @_; |
|
286
|
|
|
|
|
|
|
|
|
287
|
2
|
|
|
|
|
30
|
return $this->_cgi_request($uri, $user, $input); |
|
288
|
|
|
|
|
|
|
} |
|
289
|
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
###################################################################### |
|
291
|
|
|
|
|
|
|
# |
|
292
|
|
|
|
|
|
|
# ->_cgi_request |
|
293
|
|
|
|
|
|
|
# |
|
294
|
|
|
|
|
|
|
# Common routine to handle GET and POST. |
|
295
|
|
|
|
|
|
|
# |
|
296
|
|
|
|
|
|
|
###################################################################### |
|
297
|
|
|
|
|
|
|
sub _cgi_request |
|
298
|
|
|
|
|
|
|
{ |
|
299
|
44
|
|
|
44
|
|
45
|
my $this = shift; |
|
300
|
44
|
|
|
|
|
50
|
my ($uri, $user, $input) = @_; # $input defined for POST |
|
301
|
|
|
|
|
|
|
|
|
302
|
44
|
|
|
|
|
104
|
my $u = URI->new($uri); |
|
303
|
44
|
50
|
|
|
|
1915
|
croak "URI $uri is not within the http scheme" |
|
304
|
|
|
|
|
|
|
unless $u->scheme eq 'http'; |
|
305
|
|
|
|
|
|
|
|
|
306
|
44
|
|
|
|
|
8423
|
require CGI::Test::Page::Error; |
|
307
|
44
|
|
|
|
|
72
|
my $error = "CGI::Test::Page::Error"; |
|
308
|
|
|
|
|
|
|
|
|
309
|
44
|
|
|
|
|
110
|
my ($userver, $upath, $uquery) = $this->split_uri($u); |
|
310
|
44
|
|
|
|
|
437
|
my $server = $this->host_port; |
|
311
|
44
|
|
|
|
|
101
|
my $base_path = $this->base_path . "/"; |
|
312
|
|
|
|
|
|
|
|
|
313
|
44
|
50
|
|
|
|
130
|
croak "URI $uri is not located on server $server" |
|
314
|
|
|
|
|
|
|
unless $userver eq $server; |
|
315
|
|
|
|
|
|
|
|
|
316
|
44
|
50
|
|
|
|
131
|
croak "URI $uri is not located under the $base_path directory" |
|
317
|
|
|
|
|
|
|
unless substr($upath, 0, length $base_path) eq $base_path; |
|
318
|
|
|
|
|
|
|
|
|
319
|
44
|
|
|
|
|
78
|
substr($upath, 0, length $base_path) = ''; |
|
320
|
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
# |
|
322
|
|
|
|
|
|
|
# We have script + path_info in the $upath variable. To determine where |
|
323
|
|
|
|
|
|
|
# the path_info starts, we have to walk through the components and |
|
324
|
|
|
|
|
|
|
# compare, at each step, the current walk-through path with one on the |
|
325
|
|
|
|
|
|
|
# filesystem under cgi_dir. |
|
326
|
|
|
|
|
|
|
# |
|
327
|
|
|
|
|
|
|
|
|
328
|
44
|
|
|
|
|
87
|
my $cgi_dir = $this->cgi_dir; |
|
329
|
44
|
|
|
|
|
116
|
my @components = split(m|/|, $upath); |
|
330
|
44
|
|
|
|
|
42
|
my @script; |
|
331
|
|
|
|
|
|
|
|
|
332
|
44
|
|
|
|
|
103
|
while (@components) |
|
333
|
|
|
|
|
|
|
{ |
|
334
|
47
|
|
|
|
|
75
|
my $item = shift @components; |
|
335
|
47
|
100
|
|
|
|
1265
|
if (-e File::Spec->catfile($cgi_dir, @script, $item)) |
|
336
|
|
|
|
|
|
|
{ |
|
337
|
44
|
|
|
|
|
149
|
push(@script, $item); |
|
338
|
|
|
|
|
|
|
} |
|
339
|
|
|
|
|
|
|
else |
|
340
|
|
|
|
|
|
|
{ |
|
341
|
3
|
|
|
|
|
9
|
unshift @components, $item; |
|
342
|
3
|
|
|
|
|
3
|
last; |
|
343
|
|
|
|
|
|
|
} |
|
344
|
|
|
|
|
|
|
} |
|
345
|
|
|
|
|
|
|
|
|
346
|
44
|
|
|
|
|
225
|
my $script = File::Spec->catfile($cgi_dir, @script); # Real |
|
347
|
44
|
|
|
|
|
101
|
my $script_name = $base_path . join("/", @script); # Virtual |
|
348
|
44
|
|
|
|
|
79
|
my $path = "/" . join("/", @components); # Virtual |
|
349
|
|
|
|
|
|
|
|
|
350
|
44
|
50
|
|
|
|
291
|
return $error->new(RC_NOT_FOUND, $this) unless -f $script; |
|
351
|
44
|
50
|
|
|
|
280
|
return $error->new(RC_UNAUTHORIZED, $this) unless -x $script; |
|
352
|
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
# |
|
354
|
|
|
|
|
|
|
# Prepare input for POST requests. |
|
355
|
|
|
|
|
|
|
# |
|
356
|
|
|
|
|
|
|
|
|
357
|
44
|
|
|
|
|
69
|
my @post = (); |
|
358
|
44
|
|
|
|
|
562
|
local $SIG{PIPE} = 'IGNORE'; |
|
359
|
44
|
|
|
|
|
125
|
local (*PREAD, *PWRITE); |
|
360
|
|
|
|
|
|
|
|
|
361
|
44
|
|
|
|
|
49
|
my ($in_fh, $out_fh, $in_fname, $out_fname); |
|
362
|
|
|
|
|
|
|
|
|
363
|
44
|
100
|
|
|
|
111
|
if (defined $input) { |
|
364
|
|
|
|
|
|
|
# In Windows, we use temp files instead of pipes to avoid |
|
365
|
|
|
|
|
|
|
# stream duplication errors |
|
366
|
2
|
50
|
|
|
|
18
|
if ( WINDOWS ) { |
|
367
|
0
|
|
|
|
|
0
|
($in_fh, $in_fname) = |
|
368
|
|
|
|
|
|
|
mkstemp(File::Spec->catfile($this->tmp_dir, "cgi_in.XXXXXX")); |
|
369
|
|
|
|
|
|
|
|
|
370
|
0
|
|
|
|
|
0
|
binmode $in_fh; |
|
371
|
|
|
|
|
|
|
|
|
372
|
0
|
|
|
|
|
0
|
syswrite $in_fh, $input->data, $input->length; |
|
373
|
0
|
|
|
|
|
0
|
close $in_fh; |
|
374
|
|
|
|
|
|
|
|
|
375
|
0
|
|
|
|
|
0
|
@post = ( |
|
376
|
|
|
|
|
|
|
-in_fname => $in_fname, |
|
377
|
|
|
|
|
|
|
-input => $input, |
|
378
|
|
|
|
|
|
|
); |
|
379
|
|
|
|
|
|
|
} |
|
380
|
|
|
|
|
|
|
else { |
|
381
|
2
|
50
|
|
|
|
30
|
if ( not pipe(PREAD, PWRITE) ) { |
|
382
|
0
|
|
|
|
|
0
|
warn "can't open pipe: $!"; |
|
383
|
0
|
|
|
|
|
0
|
return $error->new(RC_INTERNAL_SERVER_ERROR, $this); |
|
384
|
|
|
|
|
|
|
} |
|
385
|
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
@post = ( |
|
387
|
2
|
|
|
|
|
14
|
-in => \*PREAD, |
|
388
|
|
|
|
|
|
|
-input => $input, |
|
389
|
|
|
|
|
|
|
); |
|
390
|
|
|
|
|
|
|
} |
|
391
|
|
|
|
|
|
|
} |
|
392
|
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
# |
|
394
|
|
|
|
|
|
|
# Prepare temporary file for storing output, which we'll parse once |
|
395
|
|
|
|
|
|
|
# the script is done. |
|
396
|
|
|
|
|
|
|
# |
|
397
|
|
|
|
|
|
|
|
|
398
|
44
|
|
|
|
|
146
|
($out_fh, $out_fname) = |
|
399
|
|
|
|
|
|
|
mkstemp(File::Spec->catfile($this->tmp_dir, "cgi_out.XXXXXX")); |
|
400
|
|
|
|
|
|
|
|
|
401
|
44
|
50
|
|
|
|
12159
|
close $out_fh if WINDOWS; |
|
402
|
|
|
|
|
|
|
|
|
403
|
44
|
|
|
|
|
284
|
select((select(STDOUT), $| = 1)[ 0 ]); |
|
404
|
44
|
|
|
|
|
109
|
print STDOUT ""; # Flush STDOUT before forking |
|
405
|
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
# |
|
407
|
|
|
|
|
|
|
# Fork... |
|
408
|
|
|
|
|
|
|
# |
|
409
|
|
|
|
|
|
|
|
|
410
|
44
|
|
|
|
|
25354
|
my $pid = fork; |
|
411
|
44
|
50
|
|
|
|
1439
|
die "can't fork: $!" unless defined $pid; |
|
412
|
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
# |
|
414
|
|
|
|
|
|
|
# Child will run the CGI program with no input if it's a GET and |
|
415
|
|
|
|
|
|
|
# output stored to $fh. When issuing a POST, data will be provided |
|
416
|
|
|
|
|
|
|
# by the parent through a pipe in Unixy systems, or through a temp file |
|
417
|
|
|
|
|
|
|
# in Windows. |
|
418
|
|
|
|
|
|
|
# |
|
419
|
|
|
|
|
|
|
|
|
420
|
44
|
100
|
|
|
|
582
|
if ($pid == 0) { |
|
421
|
16
|
100
|
66
|
|
|
669
|
close PWRITE if defined $input && !WINDOWS; # Writing side of the pipe |
|
422
|
|
|
|
|
|
|
|
|
423
|
16
|
|
|
|
|
1189
|
$this->_run_cgi( |
|
424
|
|
|
|
|
|
|
-script_file => $script, # Real path |
|
425
|
|
|
|
|
|
|
-script_name => $script_name, # Virtual path, given in URI |
|
426
|
|
|
|
|
|
|
-user => $user, |
|
427
|
|
|
|
|
|
|
-out => $out_fh, |
|
428
|
|
|
|
|
|
|
-out_fname => $out_fname, |
|
429
|
|
|
|
|
|
|
-uri => $u, |
|
430
|
|
|
|
|
|
|
-path_info => $path, |
|
431
|
|
|
|
|
|
|
@post, # Additional params for POST |
|
432
|
|
|
|
|
|
|
); |
|
433
|
|
|
|
|
|
|
|
|
434
|
0
|
|
|
|
|
0
|
confess "not reachable!"; |
|
435
|
|
|
|
|
|
|
} |
|
436
|
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
# |
|
438
|
|
|
|
|
|
|
# Parent process |
|
439
|
|
|
|
|
|
|
# |
|
440
|
|
|
|
|
|
|
|
|
441
|
28
|
50
|
|
|
|
1212
|
close $out_fh unless WINDOWS; |
|
442
|
|
|
|
|
|
|
|
|
443
|
28
|
100
|
66
|
|
|
220
|
if (defined $input && !WINDOWS) |
|
444
|
|
|
|
|
|
|
{ # Send POST input data |
|
445
|
1
|
|
|
|
|
14
|
close PREAD; |
|
446
|
1
|
|
|
|
|
55
|
syswrite PWRITE, $input->data, $input->length; |
|
447
|
1
|
50
|
|
|
|
6
|
close PWRITE or warn "failure while closing pipe: $!"; |
|
448
|
|
|
|
|
|
|
} |
|
449
|
|
|
|
|
|
|
|
|
450
|
28
|
|
|
|
|
14893645
|
my $child = waitpid $pid, 0; |
|
451
|
|
|
|
|
|
|
|
|
452
|
28
|
50
|
|
|
|
345
|
if ($pid != $child) |
|
453
|
|
|
|
|
|
|
{ |
|
454
|
0
|
|
|
|
|
0
|
warn "waitpid returned with pid=$child, but expected pid=$pid"; |
|
455
|
0
|
0
|
|
|
|
0
|
kill 'TERM', $pid or warn "can't SIGTERM pid $pid: $!"; |
|
456
|
0
|
0
|
|
|
|
0
|
unlink $in_fname or warn "can't unlink $in_fname: $!"; |
|
457
|
0
|
0
|
|
|
|
0
|
unlink $out_fname or warn "can't unlink $out_fname: $!"; |
|
458
|
0
|
|
|
|
|
0
|
return $error->new(RC_NO_CONTENT, $this); |
|
459
|
|
|
|
|
|
|
} |
|
460
|
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
# |
|
462
|
|
|
|
|
|
|
# Get header within generated response, and determine Content-Type. |
|
463
|
|
|
|
|
|
|
# |
|
464
|
|
|
|
|
|
|
|
|
465
|
28
|
|
|
|
|
407
|
my $header = $this->_parse_header($out_fname); |
|
466
|
28
|
50
|
|
|
|
117
|
unless (scalar keys %$header) |
|
467
|
|
|
|
|
|
|
{ |
|
468
|
0
|
|
|
|
|
0
|
warn "script $script_name generated no valid headers"; |
|
469
|
0
|
0
|
|
|
|
0
|
unlink $in_fname or warn "can't unlink $in_fname: $!"; |
|
470
|
0
|
0
|
|
|
|
0
|
unlink $out_fname or warn "can't unlink $out_fname: $!"; |
|
471
|
0
|
|
|
|
|
0
|
return $error->new(RC_INTERNAL_SERVER_ERROR, $this); |
|
472
|
|
|
|
|
|
|
} |
|
473
|
|
|
|
|
|
|
|
|
474
|
|
|
|
|
|
|
# |
|
475
|
|
|
|
|
|
|
# Return error page if we got 5xx status |
|
476
|
|
|
|
|
|
|
# |
|
477
|
|
|
|
|
|
|
|
|
478
|
28
|
50
|
50
|
|
|
238
|
if ( my ($status) = ($header->{Status} || '') =~ /^(5\d\d)/ ) { |
|
479
|
0
|
|
|
|
|
0
|
return $error->new($status, $this); |
|
480
|
|
|
|
|
|
|
} |
|
481
|
|
|
|
|
|
|
|
|
482
|
|
|
|
|
|
|
# |
|
483
|
|
|
|
|
|
|
# Store headers for later retrieval |
|
484
|
|
|
|
|
|
|
# |
|
485
|
|
|
|
|
|
|
|
|
486
|
28
|
|
|
|
|
82
|
$this->{http_headers} = $header; |
|
487
|
|
|
|
|
|
|
|
|
488
|
|
|
|
|
|
|
# |
|
489
|
|
|
|
|
|
|
# Create proper page object, which will parse the results file as needed. |
|
490
|
|
|
|
|
|
|
# |
|
491
|
|
|
|
|
|
|
|
|
492
|
28
|
|
|
|
|
88
|
my $type = $header->{'Content-Type'}; |
|
493
|
28
|
|
|
|
|
74
|
my $base_type = lc($type); |
|
494
|
28
|
|
|
|
|
105
|
$base_type =~ s/;.*//; # Strip type parameters |
|
495
|
28
|
|
50
|
|
|
153
|
my $objtype = $this->_obj_type->{$base_type} || "Other"; |
|
496
|
28
|
|
|
|
|
65
|
$objtype = "CGI::Test::Page::$objtype"; |
|
497
|
|
|
|
|
|
|
|
|
498
|
28
|
|
|
|
|
2758
|
eval "require $objtype"; |
|
499
|
28
|
50
|
|
|
|
158
|
die "can't load module $objtype: $@" if chop $@; |
|
500
|
|
|
|
|
|
|
|
|
501
|
28
|
|
|
|
|
212
|
my $page = $objtype->new( |
|
502
|
|
|
|
|
|
|
-server => $this, |
|
503
|
|
|
|
|
|
|
-file => $out_fname, |
|
504
|
|
|
|
|
|
|
-content_type => $type, # raw type, with parameters |
|
505
|
|
|
|
|
|
|
-user => $user, |
|
506
|
|
|
|
|
|
|
-uri => $u, |
|
507
|
|
|
|
|
|
|
); |
|
508
|
|
|
|
|
|
|
|
|
509
|
28
|
50
|
|
|
|
83
|
if ($in_fname) { |
|
510
|
0
|
0
|
|
|
|
0
|
unlink $in_fname or warn "can't unlink $in_fname: $!"; |
|
511
|
|
|
|
|
|
|
} |
|
512
|
|
|
|
|
|
|
|
|
513
|
28
|
50
|
|
|
|
190112
|
unlink $out_fname or warn "can't unlink $out_fname: $!"; |
|
514
|
|
|
|
|
|
|
|
|
515
|
28
|
|
|
|
|
688
|
return $page; |
|
516
|
|
|
|
|
|
|
} |
|
517
|
|
|
|
|
|
|
|
|
518
|
|
|
|
|
|
|
###################################################################### |
|
519
|
|
|
|
|
|
|
# |
|
520
|
|
|
|
|
|
|
# ->_run_cgi |
|
521
|
|
|
|
|
|
|
# |
|
522
|
|
|
|
|
|
|
# Run the specified script within a CGI environment. |
|
523
|
|
|
|
|
|
|
# |
|
524
|
|
|
|
|
|
|
# The -user is the name of the authenticated user running this script. |
|
525
|
|
|
|
|
|
|
# |
|
526
|
|
|
|
|
|
|
# The -in and -out parameters are file handles where STDIN and STDOUT |
|
527
|
|
|
|
|
|
|
# need to be connected to. If $in is undefined, STDIN is connected |
|
528
|
|
|
|
|
|
|
# to /dev/null. |
|
529
|
|
|
|
|
|
|
# |
|
530
|
|
|
|
|
|
|
# Returns nothing. |
|
531
|
|
|
|
|
|
|
# |
|
532
|
|
|
|
|
|
|
###################################################################### |
|
533
|
|
|
|
|
|
|
sub _run_cgi |
|
534
|
|
|
|
|
|
|
{ |
|
535
|
16
|
|
|
16
|
|
184
|
my $this = shift; |
|
536
|
|
|
|
|
|
|
|
|
537
|
16
|
|
|
|
|
614
|
my %params = @_; |
|
538
|
|
|
|
|
|
|
|
|
539
|
16
|
|
|
|
|
128
|
my $script = $params{-script_file}; |
|
540
|
16
|
|
|
|
|
74
|
my $name = $params{-script_name}; |
|
541
|
16
|
|
|
|
|
91
|
my $user = $params{-user}; |
|
542
|
16
|
|
|
|
|
54
|
my $in = $params{-in}; |
|
543
|
16
|
|
|
|
|
245
|
my $in_fname = $params{-in_fname}; |
|
544
|
16
|
|
|
|
|
54
|
my $out = $params{-out}; |
|
545
|
16
|
|
|
|
|
61
|
my $out_fname = $params{-out_fname}; |
|
546
|
16
|
|
|
|
|
45
|
my $u = $params{-uri}; |
|
547
|
16
|
|
|
|
|
46
|
my $path = $params{-path_info}; |
|
548
|
16
|
|
|
|
|
41
|
my $input = $params{-input}; |
|
549
|
|
|
|
|
|
|
|
|
550
|
|
|
|
|
|
|
# |
|
551
|
|
|
|
|
|
|
# Connect file descriptors. |
|
552
|
|
|
|
|
|
|
# |
|
553
|
|
|
|
|
|
|
|
|
554
|
16
|
50
|
|
|
|
473
|
if ( !WINDOWS ) { |
|
555
|
16
|
100
|
|
|
|
163
|
if (defined $in) |
|
556
|
|
|
|
|
|
|
{ |
|
557
|
1
|
50
|
|
|
|
60
|
open(STDIN, '<&=' . fileno($in)) || die "can't redirect STDIN: $!"; |
|
558
|
|
|
|
|
|
|
} |
|
559
|
|
|
|
|
|
|
else |
|
560
|
|
|
|
|
|
|
{ |
|
561
|
15
|
|
|
|
|
1098
|
my $devnull = File::Spec->devnull; |
|
562
|
15
|
50
|
|
|
|
1325
|
open(STDIN, $devnull) || die "can't open $devnull: $!"; |
|
563
|
|
|
|
|
|
|
} |
|
564
|
16
|
50
|
|
|
|
428
|
open(STDOUT, '>&=' . fileno($out)) || die "can't redirect STDOUT: $!"; |
|
565
|
|
|
|
|
|
|
} |
|
566
|
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
# |
|
568
|
|
|
|
|
|
|
# Setup default CGI environment. |
|
569
|
|
|
|
|
|
|
# |
|
570
|
|
|
|
|
|
|
|
|
571
|
16
|
|
|
|
|
61
|
while (my ($key, $value) = each %{$this->cgi_env}) |
|
|
210
|
|
|
|
|
367
|
|
|
572
|
|
|
|
|
|
|
{ |
|
573
|
194
|
|
|
|
|
1861
|
$ENV{$key} = $value; |
|
574
|
|
|
|
|
|
|
} |
|
575
|
|
|
|
|
|
|
|
|
576
|
|
|
|
|
|
|
# |
|
577
|
|
|
|
|
|
|
# Where there is a script input, setup CONTENT_* variables. |
|
578
|
|
|
|
|
|
|
# If there's no input, delete CONTENT_* variables. |
|
579
|
|
|
|
|
|
|
# |
|
580
|
|
|
|
|
|
|
|
|
581
|
16
|
100
|
|
|
|
107
|
if (defined $input) |
|
582
|
|
|
|
|
|
|
{ |
|
583
|
1
|
|
|
|
|
9
|
$ENV{CONTENT_TYPE} = $input->mime_type; |
|
584
|
1
|
|
|
|
|
22
|
$ENV{CONTENT_LENGTH} = $input->length; |
|
585
|
|
|
|
|
|
|
} |
|
586
|
|
|
|
|
|
|
else |
|
587
|
|
|
|
|
|
|
{ |
|
588
|
15
|
|
|
|
|
110
|
delete $ENV{CONTENT_TYPE}; |
|
589
|
15
|
|
|
|
|
82
|
delete $ENV{CONTENT_LENGTH}; |
|
590
|
|
|
|
|
|
|
} |
|
591
|
|
|
|
|
|
|
|
|
592
|
|
|
|
|
|
|
# |
|
593
|
|
|
|
|
|
|
# Supersede whatever they may have set for the following variables, |
|
594
|
|
|
|
|
|
|
# which are very request-specific: |
|
595
|
|
|
|
|
|
|
# |
|
596
|
|
|
|
|
|
|
|
|
597
|
16
|
100
|
|
|
|
109
|
$ENV{REQUEST_METHOD} = defined $input ? "POST" : "GET"; |
|
598
|
16
|
|
|
|
|
50
|
$ENV{PATH_INFO} = $path; |
|
599
|
16
|
|
|
|
|
66
|
$ENV{SCRIPT_NAME} = $name; |
|
600
|
16
|
|
|
|
|
52
|
$ENV{SCRIPT_FILENAME} = $script; |
|
601
|
16
|
|
|
|
|
438
|
$ENV{HTTP_HOST} = $u->host_port; |
|
602
|
|
|
|
|
|
|
|
|
603
|
16
|
50
|
|
|
|
1350
|
if (length $path) |
|
604
|
|
|
|
|
|
|
{ |
|
605
|
16
|
|
|
|
|
74
|
$ENV{PATH_TRANSLATED} = $this->doc_dir . $path; |
|
606
|
|
|
|
|
|
|
} |
|
607
|
|
|
|
|
|
|
else |
|
608
|
|
|
|
|
|
|
{ |
|
609
|
0
|
|
|
|
|
0
|
delete $ENV{PATH_TRANSLATED}; |
|
610
|
|
|
|
|
|
|
} |
|
611
|
|
|
|
|
|
|
|
|
612
|
16
|
100
|
|
|
|
59
|
if (defined $user) |
|
613
|
|
|
|
|
|
|
{ |
|
614
|
1
|
|
|
|
|
3
|
$ENV{REMOTE_USER} = $user; |
|
615
|
|
|
|
|
|
|
} |
|
616
|
|
|
|
|
|
|
else |
|
617
|
|
|
|
|
|
|
{ |
|
618
|
15
|
|
|
|
|
50
|
delete $ENV{REMOTE_USER}; |
|
619
|
15
|
|
|
|
|
38
|
delete $ENV{AUTH_TYPE}; |
|
620
|
|
|
|
|
|
|
} |
|
621
|
|
|
|
|
|
|
|
|
622
|
16
|
100
|
|
|
|
144
|
if (defined $u->query) |
|
623
|
|
|
|
|
|
|
{ |
|
624
|
12
|
|
|
|
|
249
|
$ENV{QUERY_STRING} = $u->query; |
|
625
|
|
|
|
|
|
|
} |
|
626
|
|
|
|
|
|
|
else |
|
627
|
|
|
|
|
|
|
{ |
|
628
|
4
|
|
|
|
|
84
|
delete $ENV{QUERY_STRING}; |
|
629
|
|
|
|
|
|
|
} |
|
630
|
|
|
|
|
|
|
|
|
631
|
|
|
|
|
|
|
# |
|
632
|
|
|
|
|
|
|
# This is a way of letting Perl test scripts to run under |
|
633
|
|
|
|
|
|
|
# the same Perl version that CGI::Test is running with |
|
634
|
|
|
|
|
|
|
# |
|
635
|
|
|
|
|
|
|
|
|
636
|
16
|
|
|
|
|
165
|
$ENV{PERL} = $^X; |
|
637
|
|
|
|
|
|
|
|
|
638
|
|
|
|
|
|
|
# |
|
639
|
|
|
|
|
|
|
# Make sure the script sees the same @INC as we do currently. |
|
640
|
|
|
|
|
|
|
# This is very important when running a regression test suite, to |
|
641
|
|
|
|
|
|
|
# make sure any CGI script using the module we're testing will see |
|
642
|
|
|
|
|
|
|
# the files from the build directory. |
|
643
|
|
|
|
|
|
|
# |
|
644
|
|
|
|
|
|
|
# Since we're about to chdir() to the cgi-bin directory, we must anchor |
|
645
|
|
|
|
|
|
|
# any relative path to the current working directory. |
|
646
|
|
|
|
|
|
|
# |
|
647
|
16
|
50
|
|
|
|
72
|
my $path_sep = WINDOWS ? ';' : ':'; |
|
648
|
|
|
|
|
|
|
|
|
649
|
16
|
50
|
|
|
|
127
|
$ENV{PERL5LIB} = join($path_sep, map {-e $_ ? abs_path($_) : $_} @INC); |
|
|
167
|
|
|
|
|
6879
|
|
|
650
|
|
|
|
|
|
|
|
|
651
|
|
|
|
|
|
|
# Also make sure that temp directory is available for the script, |
|
652
|
|
|
|
|
|
|
# else older CGI.pm may choke and default to some not-quite-sane |
|
653
|
|
|
|
|
|
|
# values that do not work in Windows |
|
654
|
|
|
|
|
|
|
|
|
655
|
16
|
|
|
|
|
103
|
$ENV{TMPDIR} = $this->tmp_dir; |
|
656
|
|
|
|
|
|
|
|
|
657
|
|
|
|
|
|
|
# |
|
658
|
|
|
|
|
|
|
# Now run the script, changing the current directory to the location |
|
659
|
|
|
|
|
|
|
# of the script, as a web server would. |
|
660
|
|
|
|
|
|
|
# |
|
661
|
|
|
|
|
|
|
|
|
662
|
16
|
|
|
|
|
1508
|
my $directory = dirname($script); |
|
663
|
16
|
|
|
|
|
338
|
my $basename = basename($script); |
|
664
|
|
|
|
|
|
|
|
|
665
|
16
|
50
|
|
|
|
222
|
chdir $directory or die "can't cd to $directory: $!"; |
|
666
|
|
|
|
|
|
|
|
|
667
|
16
|
50
|
|
|
|
106
|
if ( WINDOWS ) { |
|
668
|
0
|
0
|
|
|
|
0
|
my $cmd_line = $input ? "$basename < ${in_fname} > ${out_fname}" |
|
669
|
|
|
|
|
|
|
: "$basename < NUL >${out_fname}" |
|
670
|
|
|
|
|
|
|
; |
|
671
|
|
|
|
|
|
|
|
|
672
|
0
|
|
|
|
|
0
|
exec $cmd_line; |
|
673
|
|
|
|
|
|
|
} |
|
674
|
|
|
|
|
|
|
else { |
|
675
|
16
|
|
|
|
|
0
|
exec "./$basename"; |
|
676
|
|
|
|
|
|
|
} |
|
677
|
|
|
|
|
|
|
|
|
678
|
0
|
|
|
|
|
0
|
die "could not exec $script: $!"; |
|
679
|
|
|
|
|
|
|
} |
|
680
|
|
|
|
|
|
|
|
|
681
|
|
|
|
|
|
|
###################################################################### |
|
682
|
|
|
|
|
|
|
# |
|
683
|
|
|
|
|
|
|
# ->_parse_header |
|
684
|
|
|
|
|
|
|
# |
|
685
|
|
|
|
|
|
|
# Look for a set of leading HTTP headers in the file, and insert them |
|
686
|
|
|
|
|
|
|
# into a hash table (we don't expect duplicates). |
|
687
|
|
|
|
|
|
|
# |
|
688
|
|
|
|
|
|
|
# Returns ref to hash containing the headers. |
|
689
|
|
|
|
|
|
|
# |
|
690
|
|
|
|
|
|
|
###################################################################### |
|
691
|
|
|
|
|
|
|
sub _parse_header |
|
692
|
|
|
|
|
|
|
{ |
|
693
|
28
|
|
|
28
|
|
82
|
my $this = shift; |
|
694
|
28
|
|
|
|
|
111
|
my ($file) = @_; |
|
695
|
28
|
|
|
|
|
55
|
my %header; |
|
696
|
28
|
|
|
|
|
187
|
local *FILE; |
|
697
|
28
|
50
|
|
|
|
1582
|
open(FILE, $file) || warn "can't open $file: $!"; |
|
698
|
28
|
|
|
|
|
131
|
local $_; |
|
699
|
28
|
|
|
|
|
58
|
my $field; |
|
700
|
|
|
|
|
|
|
|
|
701
|
28
|
|
|
|
|
680
|
while () |
|
702
|
|
|
|
|
|
|
{ |
|
703
|
72
|
100
|
66
|
|
|
583
|
last if /^\015?\012$/ || /^\015\012$/; |
|
704
|
44
|
|
|
|
|
309
|
s/\015?\012$//; |
|
705
|
44
|
50
|
|
|
|
437
|
if (s/^\s+/ /) |
|
|
|
50
|
|
|
|
|
|
|
706
|
|
|
|
|
|
|
{ |
|
707
|
0
|
0
|
|
|
|
0
|
last if $field eq ''; # Cannot be a header |
|
708
|
0
|
0
|
|
|
|
0
|
$header{$field} .= $_ if $field ne ''; |
|
709
|
|
|
|
|
|
|
} |
|
710
|
|
|
|
|
|
|
elsif (($field, my $value) = /^([\w-]+)\s*:\s*(.*)/) |
|
711
|
|
|
|
|
|
|
{ |
|
712
|
44
|
|
|
|
|
436
|
$field =~ s/(\w+)/\u\L$1/g; # Normalize spelling |
|
713
|
44
|
50
|
|
|
|
124
|
if (exists $header{$field}) |
|
714
|
|
|
|
|
|
|
{ |
|
715
|
0
|
|
|
|
|
0
|
warn "duplicate $field header in $file"; |
|
716
|
0
|
|
|
|
|
0
|
$header{$field} .= " "; |
|
717
|
|
|
|
|
|
|
} |
|
718
|
44
|
|
|
|
|
345
|
$header{$field} .= $value; |
|
719
|
|
|
|
|
|
|
} |
|
720
|
|
|
|
|
|
|
else |
|
721
|
|
|
|
|
|
|
{ |
|
722
|
0
|
|
|
|
|
0
|
warn "mangled header in $file"; |
|
723
|
0
|
|
|
|
|
0
|
%header = (); # Discard what we read sofar |
|
724
|
0
|
|
|
|
|
0
|
last; |
|
725
|
|
|
|
|
|
|
} |
|
726
|
|
|
|
|
|
|
} |
|
727
|
28
|
|
|
|
|
195
|
close FILE; |
|
728
|
28
|
|
|
|
|
226
|
return \%header; |
|
729
|
|
|
|
|
|
|
} |
|
730
|
|
|
|
|
|
|
|
|
731
|
|
|
|
|
|
|
1; |
|
732
|
|
|
|
|
|
|
|
|
733
|
|
|
|
|
|
|
=head1 NAME |
|
734
|
|
|
|
|
|
|
|
|
735
|
|
|
|
|
|
|
CGI::Test - CGI regression test framework |
|
736
|
|
|
|
|
|
|
|
|
737
|
|
|
|
|
|
|
=head1 SYNOPSIS |
|
738
|
|
|
|
|
|
|
|
|
739
|
|
|
|
|
|
|
# In some t/script.t regression test, for instance |
|
740
|
|
|
|
|
|
|
use CGI::Test; |
|
741
|
|
|
|
|
|
|
use Test::More tests => 7; |
|
742
|
|
|
|
|
|
|
|
|
743
|
|
|
|
|
|
|
my $ct = CGI::Test->new( |
|
744
|
|
|
|
|
|
|
-base_url => "http://some.server:1234/cgi-bin", |
|
745
|
|
|
|
|
|
|
-cgi_dir => "/path/to/cgi-bin", |
|
746
|
|
|
|
|
|
|
); |
|
747
|
|
|
|
|
|
|
|
|
748
|
|
|
|
|
|
|
my $page = $ct->GET("http://some.server:1234/cgi-bin/script?arg=1"); |
|
749
|
|
|
|
|
|
|
like $page->content_type, qr|text/html\b|, "Content type"; |
|
750
|
|
|
|
|
|
|
|
|
751
|
|
|
|
|
|
|
my $form = $page->forms->[0]; |
|
752
|
|
|
|
|
|
|
is $form->action, "/cgi-bin/some_target", "Form action URI"; |
|
753
|
|
|
|
|
|
|
|
|
754
|
|
|
|
|
|
|
my $menu = $form->menu_by_name("months"); |
|
755
|
|
|
|
|
|
|
ok $menu->is_selected("January"), "January selected"; |
|
756
|
|
|
|
|
|
|
ok !$menu->is_selected("March"), "March not selected"; |
|
757
|
|
|
|
|
|
|
ok $menu->multiple, "Menu is multi-choice"; |
|
758
|
|
|
|
|
|
|
|
|
759
|
|
|
|
|
|
|
my $send = $form->submit_by_name("send_form"); |
|
760
|
|
|
|
|
|
|
ok defined $send, "Send form defined"; |
|
761
|
|
|
|
|
|
|
|
|
762
|
|
|
|
|
|
|
# |
|
763
|
|
|
|
|
|
|
# Now interact with the CGI |
|
764
|
|
|
|
|
|
|
# |
|
765
|
|
|
|
|
|
|
|
|
766
|
|
|
|
|
|
|
$menu->select("March"); # "click" on the March label |
|
767
|
|
|
|
|
|
|
my $answer = $send->press; # "click" on the send button |
|
768
|
|
|
|
|
|
|
|
|
769
|
|
|
|
|
|
|
# and make sure we don't get an HTTP error |
|
770
|
|
|
|
|
|
|
ok $answer->is_ok, "Answer response"; |
|
771
|
|
|
|
|
|
|
|
|
772
|
|
|
|
|
|
|
=head1 DESCRIPTION |
|
773
|
|
|
|
|
|
|
|
|
774
|
|
|
|
|
|
|
The C module provides a CGI regression test framework which |
|
775
|
|
|
|
|
|
|
allows you to run your CGI programs offline, i.e. outside a web server, |
|
776
|
|
|
|
|
|
|
and interact with them programmatically, without the need to type data |
|
777
|
|
|
|
|
|
|
and click from a web browser. |
|
778
|
|
|
|
|
|
|
|
|
779
|
|
|
|
|
|
|
If you're using the C module, you may be familiar with its offline |
|
780
|
|
|
|
|
|
|
testing mode. However, this mode is appropriate for simple things, and |
|
781
|
|
|
|
|
|
|
there is no support for conducting a full session with a stateful script. |
|
782
|
|
|
|
|
|
|
C fills this gap by providing the necessary infrastructure to |
|
783
|
|
|
|
|
|
|
run CGI scripts, then parse the output to construct objects that can be |
|
784
|
|
|
|
|
|
|
queried, and on which you can interact to "play" with the script's control |
|
785
|
|
|
|
|
|
|
widgets, finally submitting data back. And so on... |
|
786
|
|
|
|
|
|
|
|
|
787
|
|
|
|
|
|
|
Note that the CGI scripts you can test with C need not be |
|
788
|
|
|
|
|
|
|
implemented in Perl at all. As far as this framework is concerned, CGI |
|
789
|
|
|
|
|
|
|
scripts are executables that are run on a CGI-like environment and which |
|
790
|
|
|
|
|
|
|
produce an output. |
|
791
|
|
|
|
|
|
|
|
|
792
|
|
|
|
|
|
|
To use the C framework, you need to configure a C |
|
793
|
|
|
|
|
|
|
object to act like a web server, by providing the URL base where |
|
794
|
|
|
|
|
|
|
CGI scripts lie on this pseudo-server, and which physical directory |
|
795
|
|
|
|
|
|
|
corresponds to that URL base. |
|
796
|
|
|
|
|
|
|
|
|
797
|
|
|
|
|
|
|
From then on, you may issue GET and POST requests giving an URL, and |
|
798
|
|
|
|
|
|
|
the pseudo-server returns a C object representing the |
|
799
|
|
|
|
|
|
|
outcome of the request. This page may be an error, plain text, some |
|
800
|
|
|
|
|
|
|
binary data, or an HTML page (see L for details). |
|
801
|
|
|
|
|
|
|
|
|
802
|
|
|
|
|
|
|
The latter (an HTML page) can contain one or more CGI forms (identified |
|
803
|
|
|
|
|
|
|
by CFORME> tags), which are described by instances of |
|
804
|
|
|
|
|
|
|
C objects (see L for details). |
|
805
|
|
|
|
|
|
|
|
|
806
|
|
|
|
|
|
|
Forms can be queried to see whether they contain a particular type |
|
807
|
|
|
|
|
|
|
of widget (menu, text area, button, etc...), of a particular name |
|
808
|
|
|
|
|
|
|
(that's the CGI parameter name). Once found, one may interact with |
|
809
|
|
|
|
|
|
|
a widget as the user would from a browser. Widgets are described by |
|
810
|
|
|
|
|
|
|
polymorphic objects which conform to the C type. |
|
811
|
|
|
|
|
|
|
The specific interaction that is offered depends on the dynamic type of |
|
812
|
|
|
|
|
|
|
the object (see L for details). |
|
813
|
|
|
|
|
|
|
|
|
814
|
|
|
|
|
|
|
An interaction with a form ends by a submission of the form data to the |
|
815
|
|
|
|
|
|
|
server, and getting a reply back. This is done by pressing a submit button, |
|
816
|
|
|
|
|
|
|
and the press() routine returns a new page. Naturally, no server is |
|
817
|
|
|
|
|
|
|
contacted at all within the C framework, and the CGI script is |
|
818
|
|
|
|
|
|
|
ran through a proper call to one of the GET/POST method on the |
|
819
|
|
|
|
|
|
|
C object. |
|
820
|
|
|
|
|
|
|
|
|
821
|
|
|
|
|
|
|
=head1 INTERFACE |
|
822
|
|
|
|
|
|
|
|
|
823
|
|
|
|
|
|
|
=head2 Creation Interface |
|
824
|
|
|
|
|
|
|
|
|
825
|
|
|
|
|
|
|
The creation routine C takes the following mandatory parameters: |
|
826
|
|
|
|
|
|
|
|
|
827
|
|
|
|
|
|
|
=over 4 |
|
828
|
|
|
|
|
|
|
|
|
829
|
|
|
|
|
|
|
=item C<-base_url> => I |
|
830
|
|
|
|
|
|
|
|
|
831
|
|
|
|
|
|
|
Defines the URL domain which is handled by C. |
|
832
|
|
|
|
|
|
|
This is the URL of the C directory. |
|
833
|
|
|
|
|
|
|
|
|
834
|
|
|
|
|
|
|
Note that there is no need to have something actually running on the |
|
835
|
|
|
|
|
|
|
specified host or port, and the server name can be any host name, |
|
836
|
|
|
|
|
|
|
whether it exists or not. For instance, if you say: |
|
837
|
|
|
|
|
|
|
|
|
838
|
|
|
|
|
|
|
-base_url => "http://foo.example.com:70/cgi-bin" |
|
839
|
|
|
|
|
|
|
|
|
840
|
|
|
|
|
|
|
you simply declare that the C object will know how to handle |
|
841
|
|
|
|
|
|
|
a GET request for, say: |
|
842
|
|
|
|
|
|
|
|
|
843
|
|
|
|
|
|
|
http://foo.example.com:70/cgi-bin/script |
|
844
|
|
|
|
|
|
|
|
|
845
|
|
|
|
|
|
|
and it will do so I, without contacting C |
|
846
|
|
|
|
|
|
|
on port 70... |
|
847
|
|
|
|
|
|
|
|
|
848
|
|
|
|
|
|
|
=item C<-cgi_dir> => I |
|
849
|
|
|
|
|
|
|
|
|
850
|
|
|
|
|
|
|
Defines the physical path corresponding to the C directory defined |
|
851
|
|
|
|
|
|
|
by the C<-base_url> parameter. |
|
852
|
|
|
|
|
|
|
|
|
853
|
|
|
|
|
|
|
For instance, given the settings: |
|
854
|
|
|
|
|
|
|
|
|
855
|
|
|
|
|
|
|
-base_url => "http://foo.example.com:70/cgi-bin", |
|
856
|
|
|
|
|
|
|
-cgi_dir => "/home/ram/cgi/test" |
|
857
|
|
|
|
|
|
|
|
|
858
|
|
|
|
|
|
|
then requesting |
|
859
|
|
|
|
|
|
|
|
|
860
|
|
|
|
|
|
|
http://foo.example.com:70/cgi-bin/script |
|
861
|
|
|
|
|
|
|
|
|
862
|
|
|
|
|
|
|
will actually run |
|
863
|
|
|
|
|
|
|
|
|
864
|
|
|
|
|
|
|
/home/ram/cgi/test/script |
|
865
|
|
|
|
|
|
|
|
|
866
|
|
|
|
|
|
|
Those things are really easier to understand via examples than via |
|
867
|
|
|
|
|
|
|
formal descriptions, aren't they? |
|
868
|
|
|
|
|
|
|
|
|
869
|
|
|
|
|
|
|
=back |
|
870
|
|
|
|
|
|
|
|
|
871
|
|
|
|
|
|
|
The following optional arguments may also be provided: |
|
872
|
|
|
|
|
|
|
|
|
873
|
|
|
|
|
|
|
=over 4 |
|
874
|
|
|
|
|
|
|
|
|
875
|
|
|
|
|
|
|
=item C<-cgi_env> => I |
|
876
|
|
|
|
|
|
|
|
|
877
|
|
|
|
|
|
|
Defines additional environment variables that must be set, or changes |
|
878
|
|
|
|
|
|
|
hardwirted defaults. Some variables like C really depend |
|
879
|
|
|
|
|
|
|
on the request and will be dynamically computed by C. |
|
880
|
|
|
|
|
|
|
|
|
881
|
|
|
|
|
|
|
For instance: |
|
882
|
|
|
|
|
|
|
|
|
883
|
|
|
|
|
|
|
-cgi_env => { |
|
884
|
|
|
|
|
|
|
HTTP_USER_AGENT => "Mozilla/4.76", |
|
885
|
|
|
|
|
|
|
AUTH_TYPE => "Digest", |
|
886
|
|
|
|
|
|
|
} |
|
887
|
|
|
|
|
|
|
|
|
888
|
|
|
|
|
|
|
See L for more details on which environment |
|
889
|
|
|
|
|
|
|
variables are defined, and which may be superseded. |
|
890
|
|
|
|
|
|
|
|
|
891
|
|
|
|
|
|
|
=item C<-doc_dir> => I |
|
892
|
|
|
|
|
|
|
|
|
893
|
|
|
|
|
|
|
This defines the root directory of the HTTP server, for path translation. |
|
894
|
|
|
|
|
|
|
It defaults to C. |
|
895
|
|
|
|
|
|
|
|
|
896
|
|
|
|
|
|
|
B: C only serves CGI scripts for now, so this setting |
|
897
|
|
|
|
|
|
|
is not terribly useful, unless you care about C. |
|
898
|
|
|
|
|
|
|
|
|
899
|
|
|
|
|
|
|
=item C<-tmp_dir> => I |
|
900
|
|
|
|
|
|
|
|
|
901
|
|
|
|
|
|
|
The temporary directory to use for internal files created while processing |
|
902
|
|
|
|
|
|
|
requests. Defaults to the value of the environment variable C, |
|
903
|
|
|
|
|
|
|
or C if it is not set. |
|
904
|
|
|
|
|
|
|
|
|
905
|
|
|
|
|
|
|
=back |
|
906
|
|
|
|
|
|
|
|
|
907
|
|
|
|
|
|
|
=head2 Object Interface |
|
908
|
|
|
|
|
|
|
|
|
909
|
|
|
|
|
|
|
The following methods, listed in alphabetical order, are available: |
|
910
|
|
|
|
|
|
|
|
|
911
|
|
|
|
|
|
|
=over 4 |
|
912
|
|
|
|
|
|
|
|
|
913
|
|
|
|
|
|
|
=item C I [, I] |
|
914
|
|
|
|
|
|
|
|
|
915
|
|
|
|
|
|
|
Issues an HTTP GET request of the specified URL, given as the string |
|
916
|
|
|
|
|
|
|
I. It must be in the http scheme, and must lie within the |
|
917
|
|
|
|
|
|
|
configured CGI space (i.e. under the base URL given at creation time |
|
918
|
|
|
|
|
|
|
via C<-base_url>). |
|
919
|
|
|
|
|
|
|
|
|
920
|
|
|
|
|
|
|
Optionally, you may specify the name of an authenticated user as the |
|
921
|
|
|
|
|
|
|
I string. C will simply setup the CGI environment |
|
922
|
|
|
|
|
|
|
variable C accordingly. Since we're in a testing framework, |
|
923
|
|
|
|
|
|
|
you can pretend to be anyone you like. See L |
|
924
|
|
|
|
|
|
|
for more information on environment variables, and in particular |
|
925
|
|
|
|
|
|
|
C. |
|
926
|
|
|
|
|
|
|
|
|
927
|
|
|
|
|
|
|
C returns a C polymorphic object, i.e. an object whose |
|
928
|
|
|
|
|
|
|
dynamic type is an heir of C. See L for |
|
929
|
|
|
|
|
|
|
more information on this class hierarchy. |
|
930
|
|
|
|
|
|
|
|
|
931
|
|
|
|
|
|
|
=item C I, I [, I] |
|
932
|
|
|
|
|
|
|
|
|
933
|
|
|
|
|
|
|
Issues an HTTP POST request of the specified URL. See C above for |
|
934
|
|
|
|
|
|
|
a discussion on I and I, which applies to C |
|
935
|
|
|
|
|
|
|
as well. |
|
936
|
|
|
|
|
|
|
|
|
937
|
|
|
|
|
|
|
The I parameter must be a C object. |
|
938
|
|
|
|
|
|
|
It specifies the CGI parameters to be sent to the script. Users normally |
|
939
|
|
|
|
|
|
|
don't issue POST requests manually: they are the result of submits on |
|
940
|
|
|
|
|
|
|
forms, which are obtained via an initial GET. Nonetheless, you can |
|
941
|
|
|
|
|
|
|
create your own input easily and issue a "faked" POST request, to see |
|
942
|
|
|
|
|
|
|
how your script might react to inconsistent (and probably malicious) |
|
943
|
|
|
|
|
|
|
input for instance. See L to learn how to construct |
|
944
|
|
|
|
|
|
|
suitable input. |
|
945
|
|
|
|
|
|
|
|
|
946
|
|
|
|
|
|
|
C returns a C polymorphic object, like C does. |
|
947
|
|
|
|
|
|
|
|
|
948
|
|
|
|
|
|
|
=item C |
|
949
|
|
|
|
|
|
|
|
|
950
|
|
|
|
|
|
|
The base path in the URL space of the base URL configured at creation time. |
|
951
|
|
|
|
|
|
|
It's the URL with the scheme, host and port information removed. |
|
952
|
|
|
|
|
|
|
|
|
953
|
|
|
|
|
|
|
=item C |
|
954
|
|
|
|
|
|
|
|
|
955
|
|
|
|
|
|
|
The configured CGI root directory where scripts to be run are held. |
|
956
|
|
|
|
|
|
|
|
|
957
|
|
|
|
|
|
|
=item C |
|
958
|
|
|
|
|
|
|
|
|
959
|
|
|
|
|
|
|
The configured document root directory. |
|
960
|
|
|
|
|
|
|
|
|
961
|
|
|
|
|
|
|
=item C |
|
962
|
|
|
|
|
|
|
|
|
963
|
|
|
|
|
|
|
The host and port of the base URL you configured at creation time. |
|
964
|
|
|
|
|
|
|
|
|
965
|
|
|
|
|
|
|
=item C I |
|
966
|
|
|
|
|
|
|
|
|
967
|
|
|
|
|
|
|
Splits an URI object into server (host and port), path and query components. |
|
968
|
|
|
|
|
|
|
The path is simplified using UNIX semantics, i.e. C is ignored and |
|
969
|
|
|
|
|
|
|
stripped, and C is resolved by forgetting the path component that |
|
970
|
|
|
|
|
|
|
immediately precedes it (no attempt is made to make sure the translated path |
|
971
|
|
|
|
|
|
|
was indeed pointing to an existing directory: simplification happens in the |
|
972
|
|
|
|
|
|
|
path space). |
|
973
|
|
|
|
|
|
|
|
|
974
|
|
|
|
|
|
|
Returns the list (host, path, query). |
|
975
|
|
|
|
|
|
|
|
|
976
|
|
|
|
|
|
|
=item C |
|
977
|
|
|
|
|
|
|
|
|
978
|
|
|
|
|
|
|
The temporary directory that is being used. |
|
979
|
|
|
|
|
|
|
|
|
980
|
|
|
|
|
|
|
=item C |
|
981
|
|
|
|
|
|
|
|
|
982
|
|
|
|
|
|
|
Returns hashref with parsed HTTP headers received from CGI script. |
|
983
|
|
|
|
|
|
|
|
|
984
|
|
|
|
|
|
|
=back |
|
985
|
|
|
|
|
|
|
|
|
986
|
|
|
|
|
|
|
=head1 CGI ENVIRONMENT VARIABLES |
|
987
|
|
|
|
|
|
|
|
|
988
|
|
|
|
|
|
|
The CGI protocol defines a set of environment variables which are to be set |
|
989
|
|
|
|
|
|
|
by the web server before invoking the script. The environment created by |
|
990
|
|
|
|
|
|
|
C conforms to the CGI/1.1 specifications. |
|
991
|
|
|
|
|
|
|
|
|
992
|
|
|
|
|
|
|
Here is a list of all the known variables. Some of those are marked |
|
993
|
|
|
|
|
|
|
I. It means you may choose to set them via the C<-cgi_env> |
|
994
|
|
|
|
|
|
|
switch of the C routine, but your settings will have no effect and |
|
995
|
|
|
|
|
|
|
C will always compute a suitable value. |
|
996
|
|
|
|
|
|
|
|
|
997
|
|
|
|
|
|
|
Variables are listed in alphabetical order: |
|
998
|
|
|
|
|
|
|
|
|
999
|
|
|
|
|
|
|
=over 4 |
|
1000
|
|
|
|
|
|
|
|
|
1001
|
|
|
|
|
|
|
=item C |
|
1002
|
|
|
|
|
|
|
|
|
1003
|
|
|
|
|
|
|
The authentication scheme used to authenticate the user given by C. |
|
1004
|
|
|
|
|
|
|
This variable is not present in the environment if there was no user specified |
|
1005
|
|
|
|
|
|
|
in the GET/POST requests. |
|
1006
|
|
|
|
|
|
|
|
|
1007
|
|
|
|
|
|
|
By default, it is set to "Basic" when present. |
|
1008
|
|
|
|
|
|
|
|
|
1009
|
|
|
|
|
|
|
=item C |
|
1010
|
|
|
|
|
|
|
|
|
1011
|
|
|
|
|
|
|
Read-only variable, giving the length of data to be read on STDIN by POST |
|
1012
|
|
|
|
|
|
|
requests (as told by C). If is not present for GET requests. |
|
1013
|
|
|
|
|
|
|
|
|
1014
|
|
|
|
|
|
|
=item C |
|
1015
|
|
|
|
|
|
|
|
|
1016
|
|
|
|
|
|
|
Read-only variable, giving the MIME type of data to be read on STDIN by POST |
|
1017
|
|
|
|
|
|
|
requests (as told by C). If is not present for GET requests. |
|
1018
|
|
|
|
|
|
|
|
|
1019
|
|
|
|
|
|
|
=item C |
|
1020
|
|
|
|
|
|
|
|
|
1021
|
|
|
|
|
|
|
The Common Gateway Interface (CGI) version specification. |
|
1022
|
|
|
|
|
|
|
Defaults to "CGI/1.1". |
|
1023
|
|
|
|
|
|
|
|
|
1024
|
|
|
|
|
|
|
=item C |
|
1025
|
|
|
|
|
|
|
|
|
1026
|
|
|
|
|
|
|
The set of Content-Type that are said to be accepted by the client issuing |
|
1027
|
|
|
|
|
|
|
the HTTP request. Since there is no browser making any request here, the |
|
1028
|
|
|
|
|
|
|
default is set to "*/*". |
|
1029
|
|
|
|
|
|
|
|
|
1030
|
|
|
|
|
|
|
It is up to your script to honour the value of this variable if it wishes to |
|
1031
|
|
|
|
|
|
|
be nice with the client. |
|
1032
|
|
|
|
|
|
|
|
|
1033
|
|
|
|
|
|
|
=item C |
|
1034
|
|
|
|
|
|
|
|
|
1035
|
|
|
|
|
|
|
The charset that is said to be accepted by the client issuing the HTTP |
|
1036
|
|
|
|
|
|
|
request. Since there is no browser making any request here, the |
|
1037
|
|
|
|
|
|
|
default is set to "iso-8859-1". |
|
1038
|
|
|
|
|
|
|
|
|
1039
|
|
|
|
|
|
|
=item C |
|
1040
|
|
|
|
|
|
|
|
|
1041
|
|
|
|
|
|
|
Whether the connection should be kept alive by the server or closed after |
|
1042
|
|
|
|
|
|
|
this request. Defaults to "Close", but since there's no connection and |
|
1043
|
|
|
|
|
|
|
no real client... |
|
1044
|
|
|
|
|
|
|
|
|
1045
|
|
|
|
|
|
|
=item C |
|
1046
|
|
|
|
|
|
|
|
|
1047
|
|
|
|
|
|
|
This is the host processing the HTTP request. |
|
1048
|
|
|
|
|
|
|
It is a read-only variable, set to the hostname and port parts of the |
|
1049
|
|
|
|
|
|
|
requested URL. |
|
1050
|
|
|
|
|
|
|
|
|
1051
|
|
|
|
|
|
|
=item C |
|
1052
|
|
|
|
|
|
|
|
|
1053
|
|
|
|
|
|
|
The user agent tag string. This can be used by scripts to emit code that |
|
1054
|
|
|
|
|
|
|
can be understood by the client, and is also further abused to derive the |
|
1055
|
|
|
|
|
|
|
OS type where the user agent runs. |
|
1056
|
|
|
|
|
|
|
|
|
1057
|
|
|
|
|
|
|
In order to be as neutral as possible, it is set to "CGI::Test" by default. |
|
1058
|
|
|
|
|
|
|
|
|
1059
|
|
|
|
|
|
|
=item C |
|
1060
|
|
|
|
|
|
|
|
|
1061
|
|
|
|
|
|
|
Read-only variable set to the extra path information part of the requested URL. |
|
1062
|
|
|
|
|
|
|
Always present, even if empty. |
|
1063
|
|
|
|
|
|
|
|
|
1064
|
|
|
|
|
|
|
=item C |
|
1065
|
|
|
|
|
|
|
|
|
1066
|
|
|
|
|
|
|
This read-only variable is only present when there is a non-empty C |
|
1067
|
|
|
|
|
|
|
variable. It is simply set to the value of C with the document |
|
1068
|
|
|
|
|
|
|
rootdir path prepended to it (the value of the C<-doc_dir> creation argument). |
|
1069
|
|
|
|
|
|
|
|
|
1070
|
|
|
|
|
|
|
=item C |
|
1071
|
|
|
|
|
|
|
|
|
1072
|
|
|
|
|
|
|
This very important read-only variable is the query string present in the |
|
1073
|
|
|
|
|
|
|
requested URL. Note that it may very well be set even for a POST request. |
|
1074
|
|
|
|
|
|
|
|
|
1075
|
|
|
|
|
|
|
=item C |
|
1076
|
|
|
|
|
|
|
|
|
1077
|
|
|
|
|
|
|
The IP address of the client making the requst. Can be used to implement |
|
1078
|
|
|
|
|
|
|
an access policy from within the script. Here, given that there's no real |
|
1079
|
|
|
|
|
|
|
client, the default is set to "127.0.0.1", which is the IP of the local |
|
1080
|
|
|
|
|
|
|
loopback interface. |
|
1081
|
|
|
|
|
|
|
|
|
1082
|
|
|
|
|
|
|
=item C |
|
1083
|
|
|
|
|
|
|
|
|
1084
|
|
|
|
|
|
|
The DNS-translated hostname of the IP address held in C. |
|
1085
|
|
|
|
|
|
|
Here, for testing purposes, it is not computed after C but can |
|
1086
|
|
|
|
|
|
|
be freely set. Defaults to "localhost". |
|
1087
|
|
|
|
|
|
|
|
|
1088
|
|
|
|
|
|
|
=item C |
|
1089
|
|
|
|
|
|
|
|
|
1090
|
|
|
|
|
|
|
This read-only variable is only present when making an authenticated GET or |
|
1091
|
|
|
|
|
|
|
POST request. Its value is the name of the user we are supposed to have |
|
1092
|
|
|
|
|
|
|
successfully authenticated, using the scheme held in C. |
|
1093
|
|
|
|
|
|
|
|
|
1094
|
|
|
|
|
|
|
=item C |
|
1095
|
|
|
|
|
|
|
|
|
1096
|
|
|
|
|
|
|
Read-only variable, whose value is either C or C. |
|
1097
|
|
|
|
|
|
|
|
|
1098
|
|
|
|
|
|
|
=item C |
|
1099
|
|
|
|
|
|
|
|
|
1100
|
|
|
|
|
|
|
Read-only variable set to the filesystem path of the CGI script being run. |
|
1101
|
|
|
|
|
|
|
|
|
1102
|
|
|
|
|
|
|
=item C |
|
1103
|
|
|
|
|
|
|
|
|
1104
|
|
|
|
|
|
|
Read-only variable set to the virtual path of the CGI script being run, |
|
1105
|
|
|
|
|
|
|
i.e. the path given in the requested URL. |
|
1106
|
|
|
|
|
|
|
|
|
1107
|
|
|
|
|
|
|
=item C |
|
1108
|
|
|
|
|
|
|
|
|
1109
|
|
|
|
|
|
|
The host name running the server, which defaults to the host name present |
|
1110
|
|
|
|
|
|
|
in the base URL, provided at creation time as the C<-base_url> argument. |
|
1111
|
|
|
|
|
|
|
|
|
1112
|
|
|
|
|
|
|
=item C |
|
1113
|
|
|
|
|
|
|
|
|
1114
|
|
|
|
|
|
|
The port where the server listens, which defaults to the port present |
|
1115
|
|
|
|
|
|
|
in the base URL, provided at creation time as the C<-base_url> argument. |
|
1116
|
|
|
|
|
|
|
If no port was explicitely given, 80 is assumed. |
|
1117
|
|
|
|
|
|
|
|
|
1118
|
|
|
|
|
|
|
=item C |
|
1119
|
|
|
|
|
|
|
|
|
1120
|
|
|
|
|
|
|
The protocol which must be followed when replying to the client request. |
|
1121
|
|
|
|
|
|
|
Set to "HTTP/1.1" by default. |
|
1122
|
|
|
|
|
|
|
|
|
1123
|
|
|
|
|
|
|
=item C |
|
1124
|
|
|
|
|
|
|
|
|
1125
|
|
|
|
|
|
|
The name of the server software. Defaults to "CGI::Test". |
|
1126
|
|
|
|
|
|
|
|
|
1127
|
|
|
|
|
|
|
=back |
|
1128
|
|
|
|
|
|
|
|
|
1129
|
|
|
|
|
|
|
=head1 BUGS |
|
1130
|
|
|
|
|
|
|
|
|
1131
|
|
|
|
|
|
|
There are some, most probably. Please notify me about them. |
|
1132
|
|
|
|
|
|
|
|
|
1133
|
|
|
|
|
|
|
The following limitations (in decreasing amount of importance) |
|
1134
|
|
|
|
|
|
|
are known and may be lifted one day -- patches welcome: |
|
1135
|
|
|
|
|
|
|
|
|
1136
|
|
|
|
|
|
|
=over 4 |
|
1137
|
|
|
|
|
|
|
|
|
1138
|
|
|
|
|
|
|
=item * |
|
1139
|
|
|
|
|
|
|
|
|
1140
|
|
|
|
|
|
|
There is no support for cookies. A CGI installing cookies and expecting |
|
1141
|
|
|
|
|
|
|
them to be resent on further invocations to friendly scripts is bound |
|
1142
|
|
|
|
|
|
|
to disappointment. |
|
1143
|
|
|
|
|
|
|
|
|
1144
|
|
|
|
|
|
|
=item * |
|
1145
|
|
|
|
|
|
|
|
|
1146
|
|
|
|
|
|
|
There is no support for plain document retrieval: only CGI scripts can |
|
1147
|
|
|
|
|
|
|
be fetched by an HTTP request for now. |
|
1148
|
|
|
|
|
|
|
|
|
1149
|
|
|
|
|
|
|
=back |
|
1150
|
|
|
|
|
|
|
|
|
1151
|
|
|
|
|
|
|
=head1 PUBLIC REPOSITORY |
|
1152
|
|
|
|
|
|
|
|
|
1153
|
|
|
|
|
|
|
CGI::Test now has a publicly accessible Git server provided by Github.com: |
|
1154
|
|
|
|
|
|
|
L |
|
1155
|
|
|
|
|
|
|
|
|
1156
|
|
|
|
|
|
|
=head1 REPORTING BUGS |
|
1157
|
|
|
|
|
|
|
|
|
1158
|
|
|
|
|
|
|
Please use Github issue tracker to open bug reports and maintenance |
|
1159
|
|
|
|
|
|
|
requests. |
|
1160
|
|
|
|
|
|
|
|
|
1161
|
|
|
|
|
|
|
=head1 AUTHORS |
|
1162
|
|
|
|
|
|
|
|
|
1163
|
|
|
|
|
|
|
The original author is Raphael Manfredi. |
|
1164
|
|
|
|
|
|
|
|
|
1165
|
|
|
|
|
|
|
Steven Hilton was long time maintainer of this module. |
|
1166
|
|
|
|
|
|
|
|
|
1167
|
|
|
|
|
|
|
Current maintainer is Alex Tokarev Ftokarev@cpan.orgE>. |
|
1168
|
|
|
|
|
|
|
|
|
1169
|
|
|
|
|
|
|
=head1 LICENSE |
|
1170
|
|
|
|
|
|
|
|
|
1171
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify |
|
1172
|
|
|
|
|
|
|
it under the terms of the Artistic License, a copy of which can be |
|
1173
|
|
|
|
|
|
|
found with Perl 5.6.0. |
|
1174
|
|
|
|
|
|
|
|
|
1175
|
|
|
|
|
|
|
This program is distributed in the hope that it will be useful, |
|
1176
|
|
|
|
|
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of |
|
1177
|
|
|
|
|
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
|
1178
|
|
|
|
|
|
|
Artistic License for more details. |
|
1179
|
|
|
|
|
|
|
|
|
1180
|
|
|
|
|
|
|
=head1 SEE ALSO |
|
1181
|
|
|
|
|
|
|
|
|
1182
|
|
|
|
|
|
|
CGI(3), CGI::Test::Page(3), CGI::Test::Form(3), CGI::Test::Input(3), |
|
1183
|
|
|
|
|
|
|
CGI::Test::Form::Widget(3), HTTP::Status(3), URI(3). |
|
1184
|
|
|
|
|
|
|
|
|
1185
|
|
|
|
|
|
|
=cut |
|
1186
|
|
|
|
|
|
|
|