test.pl 19 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531
  1. #!/usr/bin/env perl
  2. # This script is used to test Mongoose web server
  3. # $Id: test.pl 516 2010-05-03 12:54:37Z valenok $
  4. use IO::Socket;
  5. use File::Path;
  6. use strict;
  7. use warnings;
  8. #use diagnostics;
  9. sub on_windows { $^O =~ /win32/i; }
  10. my $port = 23456;
  11. my $pid = undef;
  12. my $num_requests;
  13. my $dir_separator = on_windows() ? '\\' : '/';
  14. my $copy_cmd = on_windows() ? 'copy' : 'cp';
  15. my $test_dir_uri = "test_dir";
  16. my $root = 'test';
  17. my $test_dir = $root . $dir_separator. $test_dir_uri;
  18. my $config = 'mongoose.conf';
  19. my $exe = '.' . $dir_separator . 'mongoose';
  20. my $embed_exe = '.' . $dir_separator . 'embed';
  21. my $unit_test_exe = '.' . $dir_separator . 'unit_test';
  22. my $exit_code = 0;
  23. my @files_to_delete = ('debug.log', 'access.log', $config, "$root/a/put.txt",
  24. "$root/a+.txt", "$root/.htpasswd", "$root/binary_file", "$root/a",
  25. "$root/myperl", $embed_exe, $unit_test_exe);
  26. END {
  27. unlink @files_to_delete;
  28. kill_spawned_child();
  29. File::Path::rmtree($test_dir);
  30. exit $exit_code;
  31. }
  32. sub fail {
  33. print "FAILED: @_\n";
  34. $exit_code = 1;
  35. exit 1;
  36. }
  37. sub get_num_of_log_entries {
  38. open FD, "access.log" or return 0;
  39. my @lines = (<FD>);
  40. close FD;
  41. return scalar @lines;
  42. }
  43. # Send the request to the 127.0.0.1:$port and return the reply
  44. sub req {
  45. my ($request, $inc, $timeout) = @_;
  46. my $sock = IO::Socket::INET->new(Proto=>"tcp",
  47. PeerAddr=>'127.0.0.1', PeerPort=>$port);
  48. fail("Cannot connect: $!") unless $sock;
  49. $sock->autoflush(1);
  50. foreach my $byte (split //, $request) {
  51. last unless print $sock $byte;
  52. select undef, undef, undef, .001 if length($request) < 256;
  53. }
  54. my ($out, $buf) = ('', '');
  55. eval {
  56. alarm $timeout if $timeout;
  57. $out .= $buf while (sysread($sock, $buf, 1024) > 0);
  58. alarm 0 if $timeout;
  59. };
  60. close $sock;
  61. $num_requests += defined($inc) ? $inc : 1;
  62. my $num_logs = get_num_of_log_entries();
  63. unless ($num_requests == $num_logs) {
  64. fail("Request has not been logged: [$request], output: [$out]");
  65. }
  66. return $out;
  67. }
  68. # Send the request. Compare with the expected reply. Fail if no match
  69. sub o {
  70. my ($request, $expected_reply, $message, $num_logs) = @_;
  71. print "==> $message ... ";
  72. my $reply = req($request, $num_logs);
  73. if ($reply =~ /$expected_reply/s) {
  74. print "OK\n";
  75. } else {
  76. #fail("Requested: [$request]\nExpected: [$expected_reply], got: [$reply]");
  77. fail("Expected: [$expected_reply], got: [$reply]");
  78. }
  79. }
  80. # Spawn a server listening on specified port
  81. sub spawn {
  82. my ($cmdline) = @_;
  83. print 'Executing: ', @_, "\n";
  84. if (on_windows()) {
  85. my @args = split /\s+/, $cmdline;
  86. my $executable = $args[0];
  87. $executable .= '.exe';
  88. Win32::Spawn($executable, $cmdline, $pid);
  89. die "Cannot spawn @_: $!" unless $pid;
  90. } else {
  91. unless ($pid = fork()) {
  92. exec $cmdline;
  93. die "cannot exec [$cmdline]: $!\n";
  94. }
  95. }
  96. sleep 1;
  97. }
  98. sub write_file {
  99. open FD, ">$_[0]" or fail "Cannot open $_[0]: $!";
  100. binmode FD;
  101. print FD $_[1];
  102. close FD;
  103. }
  104. sub read_file {
  105. open FD, $_[0] or fail "Cannot open $_[0]: $!";
  106. my @lines = <FD>;
  107. close FD;
  108. return join '', @lines;
  109. }
  110. sub kill_spawned_child {
  111. if (defined($pid)) {
  112. kill(9, $pid);
  113. waitpid($pid, 0);
  114. }
  115. }
  116. ####################################################### ENTRY POINT
  117. unlink @files_to_delete;
  118. $SIG{PIPE} = 'IGNORE';
  119. $SIG{ALRM} = sub { die "timeout\n" };
  120. #local $| =1;
  121. # Make sure we export only symbols that start with "mg_", and keep local
  122. # symbols static.
  123. if ($^O =~ /darwin|bsd|linux/) {
  124. my $out = `(cc -c mongoose.c && nm mongoose.o) | grep ' T '`;
  125. foreach (split /\n/, $out) {
  126. /T\s+_?mg_.+/ or fail("Exported symbol $_")
  127. }
  128. }
  129. if (scalar(@ARGV) > 0 and $ARGV[0] eq 'embedded') {
  130. do_embedded_test();
  131. exit 0;
  132. }
  133. if (scalar(@ARGV) > 0 and $ARGV[0] eq 'unit') {
  134. do_unit_test();
  135. exit 0;
  136. }
  137. # Make sure we load config file if no options are given.
  138. # Command line options override config files settings
  139. write_file($config, "access_log_file access.log\nlistening_ports 12345\n");
  140. spawn("$exe -p $port");
  141. o("GET /test/hello.txt HTTP/1.0\n\n", 'HTTP/1.1 200 OK', 'Loading config file');
  142. unlink $config;
  143. kill_spawned_child();
  144. # Spawn the server on port $port
  145. my $cmd = "$exe ".
  146. "-listening_ports $port ".
  147. "-access_log_file access.log ".
  148. "-error_log_file debug.log ".
  149. "-cgi_environment CGI_FOO=foo,CGI_BAR=bar,CGI_BAZ=baz " .
  150. "-extra_mime_types .bar=foo/bar,.tar.gz=blah,.baz=foo " .
  151. '-put_delete_passwords_file test/passfile ' .
  152. '-access_control_list -0.0.0.0/0,+127.0.0.1 ' .
  153. "-document_root $root ".
  154. "-hide_files_patterns **exploit.pl ".
  155. "-enable_keep_alive yes ".
  156. "-url_rewrite_patterns /aiased=/etc/,/ta=$test_dir";
  157. $cmd .= ' -cgi_interpreter perl' if on_windows();
  158. spawn($cmd);
  159. o("GET /hello.txt HTTP/1.1\n\n GET /hello.txt HTTP/1.0\n\n",
  160. 'HTTP/1.1 200.+keep-alive.+HTTP/1.1 200.+close',
  161. 'Request pipelining', 2);
  162. my $x = 'x=' . 'A' x (200 * 1024);
  163. my $len = length($x);
  164. o("POST /env.cgi HTTP/1.0\r\nContent-Length: $len\r\n\r\n$x",
  165. '^HTTP/1.1 200 OK', 'Long POST');
  166. # Try to overflow: Send very long request
  167. req('POST ' . '/..' x 100 . 'ABCD' x 3000 . "\n\n", 0); # don't log this one
  168. o("GET /hello.txt HTTP/1.0\n\n", 'HTTP/1.1 200 OK', 'GET regular file');
  169. o("GET /hello.txt HTTP/1.0\nContent-Length: -2147483648\n\n",
  170. 'HTTP/1.1 200 OK', 'Negative content length');
  171. o("GET /hello.txt HTTP/1.0\n\n", 'Content-Length: 17\s',
  172. 'GET regular file Content-Length');
  173. o("GET /%68%65%6c%6c%6f%2e%74%78%74 HTTP/1.0\n\n",
  174. 'HTTP/1.1 200 OK', 'URL-decoding');
  175. # Break CGI reading after 1 second. We must get full output.
  176. # Since CGI script does sleep, we sleep as well and increase request count
  177. # manually.
  178. my $slow_cgi_reply;
  179. print "==> Slow CGI output ... ";
  180. fail('Slow CGI output forward reply=', $slow_cgi_reply) unless
  181. ($slow_cgi_reply = req("GET /timeout.cgi HTTP/1.0\r\n\r\n", 0, 1)) =~ /Some data/s;
  182. print "OK\n";
  183. sleep 3;
  184. $num_requests++;
  185. # '+' in URI must not be URL-decoded to space
  186. write_file("$root/a+.txt", '');
  187. o("GET /a+.txt HTTP/1.0\n\n", 'HTTP/1.1 200 OK', 'URL-decoding, + in URI');
  188. # Test HTTP version parsing
  189. o("GET / HTTPX/1.0\r\n\r\n", '400 Bad Request', 'Bad HTTP Version', 0);
  190. o("GET / HTTP/x.1\r\n\r\n", '505 HTTP', 'Bad HTTP maj Version');
  191. o("GET / HTTP/1.1z\r\n\r\n", '505 HTTP', 'Bad HTTP min Version');
  192. o("GET / HTTP/02.0\r\n\r\n", '505 HTTP version not supported',
  193. 'HTTP Version >1.1');
  194. # File with leading single dot
  195. o("GET /.leading.dot.txt HTTP/1.0\n\n", 'abc123', 'Leading dot 1');
  196. o("GET /...leading.dot.txt HTTP/1.0\n\n", 'abc123', 'Leading dot 2');
  197. o("GET /../\\\\/.//...leading.dot.txt HTTP/1.0\n\n", 'abc123', 'Leading dot 3')
  198. if on_windows();
  199. o("GET .. HTTP/1.0\n\n", '400 Bad Request', 'Leading dot 4', 0);
  200. mkdir $test_dir unless -d $test_dir;
  201. o("GET /$test_dir_uri/not_exist HTTP/1.0\n\n",
  202. 'HTTP/1.1 404', 'PATH_INFO loop problem');
  203. o("GET /$test_dir_uri HTTP/1.0\n\n", 'HTTP/1.1 301', 'Directory redirection');
  204. o("GET /$test_dir_uri/ HTTP/1.0\n\n", 'Modified', 'Directory listing');
  205. write_file("$test_dir/index.html", "tralala");
  206. o("GET /$test_dir_uri/ HTTP/1.0\n\n", 'tralala', 'Index substitution');
  207. o("GET / HTTP/1.0\n\n", 'embed.c', 'Directory listing - file name');
  208. o("GET /ta/ HTTP/1.0\n\n", 'Modified', 'Aliases');
  209. o("GET /not-exist HTTP/1.0\r\n\n", 'HTTP/1.1 404', 'Not existent file');
  210. mkdir $test_dir . $dir_separator . 'x';
  211. my $path = $test_dir . $dir_separator . 'x' . $dir_separator . 'index.cgi';
  212. write_file($path, read_file($root . $dir_separator . 'env.cgi'));
  213. chmod(0755, $path);
  214. o("GET /$test_dir_uri/x/ HTTP/1.0\n\n", "Content-Type: text/html\r\n\r\n",
  215. 'index.cgi execution');
  216. o("GET /$test_dir_uri/x/ HTTP/1.0\n\n",
  217. "SCRIPT_FILENAME=test/test_dir/x/index.cgi", 'SCRIPT_FILENAME');
  218. o("GET /ta/x/ HTTP/1.0\n\n", "SCRIPT_NAME=/ta/x/index.cgi",
  219. 'Aliases SCRIPT_NAME');
  220. o("GET /hello.txt HTTP/1.1\nConnection: close\n\n", 'Connection: close',
  221. 'No keep-alive');
  222. $path = $test_dir . $dir_separator . 'x' . $dir_separator . 'a.cgi';
  223. system("ln -s `which perl` $root/myperl") == 0 or fail("Can't symlink perl");
  224. write_file($path, "#!../../myperl\n" .
  225. "print \"Content-Type: text/plain\\n\\nhi\";");
  226. chmod(0755, $path);
  227. o("GET /$test_dir_uri/x/a.cgi HTTP/1.0\n\n", "hi", 'Relative CGI interp path');
  228. o("GET * HTTP/1.0\n\n", "^HTTP/1.1 404", '* URI');
  229. my $mime_types = {
  230. html => 'text/html',
  231. htm => 'text/html',
  232. txt => 'text/plain',
  233. unknown_extension => 'text/plain',
  234. js => 'application/x-javascript',
  235. css => 'text/css',
  236. jpg => 'image/jpeg',
  237. c => 'text/plain',
  238. 'tar.gz' => 'blah',
  239. bar => 'foo/bar',
  240. baz => 'foo',
  241. };
  242. foreach my $key (keys %$mime_types) {
  243. my $filename = "_mime_file_test.$key";
  244. write_file("$root/$filename", '');
  245. o("GET /$filename HTTP/1.0\n\n",
  246. "Content-Type: $mime_types->{$key}", ".$key mime type");
  247. unlink "$root/$filename";
  248. }
  249. # Get binary file and check the integrity
  250. my $binary_file = 'binary_file';
  251. my $f2 = '';
  252. foreach (0..123456) { $f2 .= chr(int(rand() * 255)); }
  253. write_file("$root/$binary_file", $f2);
  254. my $f1 = req("GET /$binary_file HTTP/1.0\r\n\n");
  255. while ($f1 =~ /^.*\r\n/) { $f1 =~ s/^.*\r\n// }
  256. $f1 eq $f2 or fail("Integrity check for downloaded binary file");
  257. my $range_request = "GET /hello.txt HTTP/1.1\nConnection: close\n".
  258. "Range: bytes=3-5\r\n\r\n";
  259. o($range_request, '206 Partial Content', 'Range: 206 status code');
  260. o($range_request, 'Content-Length: 3\s', 'Range: Content-Length');
  261. o($range_request, 'Content-Range: bytes 3-5/17', 'Range: Content-Range');
  262. o($range_request, '\nple$', 'Range: body content');
  263. # Test directory sorting. Sleep between file creation for 1.1 seconds,
  264. # to make sure modification time are different.
  265. mkdir "$test_dir/sort";
  266. write_file("$test_dir/sort/11", 'xx');
  267. select undef, undef, undef, 1.1;
  268. write_file("$test_dir/sort/aa", 'xxxx');
  269. select undef, undef, undef, 1.1;
  270. write_file("$test_dir/sort/bb", 'xxx');
  271. select undef, undef, undef, 1.1;
  272. write_file("$test_dir/sort/22", 'x');
  273. o("GET /$test_dir_uri/sort/?n HTTP/1.0\n\n",
  274. '200 OK.+>11<.+>22<.+>aa<.+>bb<',
  275. 'Directory listing (name, ascending)');
  276. o("GET /$test_dir_uri/sort/?nd HTTP/1.0\n\n",
  277. '200 OK.+>bb<.+>aa<.+>22<.+>11<',
  278. 'Directory listing (name, descending)');
  279. o("GET /$test_dir_uri/sort/?s HTTP/1.0\n\n",
  280. '200 OK.+>22<.+>11<.+>bb<.+>aa<',
  281. 'Directory listing (size, ascending)');
  282. o("GET /$test_dir_uri/sort/?sd HTTP/1.0\n\n",
  283. '200 OK.+>aa<.+>bb<.+>11<.+>22<',
  284. 'Directory listing (size, descending)');
  285. o("GET /$test_dir_uri/sort/?d HTTP/1.0\n\n",
  286. '200 OK.+>11<.+>aa<.+>bb<.+>22<',
  287. 'Directory listing (modification time, ascending)');
  288. o("GET /$test_dir_uri/sort/?dd HTTP/1.0\n\n",
  289. '200 OK.+>22<.+>bb<.+>aa<.+>11<',
  290. 'Directory listing (modification time, descending)');
  291. unless (scalar(@ARGV) > 0 and $ARGV[0] eq "basic_tests") {
  292. # Check that .htpasswd file existence trigger authorization
  293. write_file("$root/.htpasswd", 'user with space, " and comma:mydomain.com:5deda12442309cbdcdffc6b2737a894f');
  294. o("GET /hello.txt HTTP/1.1\n\n", '401 Unauthorized',
  295. '.htpasswd - triggering auth on file request');
  296. o("GET / HTTP/1.1\n\n", '401 Unauthorized',
  297. '.htpasswd - triggering auth on directory request');
  298. # Test various funky things in an authentication header.
  299. o("GET /hello.txt HTTP/1.0\nAuthorization: Digest eq== empty=\"\", empty2=, quoted=\"blah foo bar, baz\\\"\\\" more\\\"\", unterminatedquoted=\" doesn't stop\n\n",
  300. '401 Unauthorized', 'weird auth values should not cause crashes');
  301. my $auth_header = "Digest username=\"user with space, \\\" and comma\", ".
  302. "realm=\"mydomain.com\", nonce=\"1291376417\", uri=\"/\",".
  303. "response=\"e8dec0c2a1a0c8a7e9a97b4b5ea6a6e6\", qop=auth, nc=00000001, cnonce=\"1a49b53a47a66e82\"";
  304. o("GET /hello.txt HTTP/1.0\nAuthorization: $auth_header\n\n", 'HTTP/1.1 200 OK', 'GET regular file with auth');
  305. o("GET / HTTP/1.0\nAuthorization: $auth_header\n\n", '^(.(?!(.htpasswd)))*$',
  306. '.htpasswd is hidden from the directory list');
  307. o("GET / HTTP/1.0\nAuthorization: $auth_header\n\n", '^(.(?!(exploit.pl)))*$',
  308. 'hidden file is hidden from the directory list');
  309. o("GET /.htpasswd HTTP/1.0\nAuthorization: $auth_header\n\n",
  310. '^HTTP/1.1 404 ', '.htpasswd must not be shown');
  311. o("GET /exploit.pl HTTP/1.0\nAuthorization: $auth_header\n\n",
  312. '^HTTP/1.1 404', 'hidden files must not be shown');
  313. unlink "$root/.htpasswd";
  314. o("GET /env.cgi HTTP/1.0\n\r\n", 'HTTP/1.1 200 OK', 'GET CGI file');
  315. o("GET /bad2.cgi HTTP/1.0\n\n", "HTTP/1.1 123 Please pass me to the client\r",
  316. 'CGI Status code text');
  317. o("GET /sh.cgi HTTP/1.0\n\r\n", 'shell script CGI',
  318. 'GET sh CGI file') unless on_windows();
  319. o("GET /env.cgi?var=HELLO HTTP/1.0\n\n", 'QUERY_STRING=var=HELLO',
  320. 'QUERY_STRING wrong');
  321. o("POST /env.cgi HTTP/1.0\r\nContent-Length: 9\r\n\r\nvar=HELLO",
  322. 'var=HELLO', 'CGI POST wrong');
  323. o("POST /env.cgi HTTP/1.0\r\nContent-Length: 9\r\n\r\nvar=HELLO",
  324. '\x0aCONTENT_LENGTH=9', 'Content-Length not being passed to CGI');
  325. o("GET /env.cgi HTTP/1.0\nMy-HdR: abc\n\r\n",
  326. 'HTTP_MY_HDR=abc', 'HTTP_* env');
  327. o("GET /env.cgi HTTP/1.0\n\r\nSOME_TRAILING_DATA_HERE",
  328. 'HTTP/1.1 200 OK', 'GET CGI with trailing data');
  329. o("GET /env.cgi%20 HTTP/1.0\n\r\n",
  330. 'HTTP/1.1 404', 'CGI Win32 code disclosure (%20)');
  331. o("GET /env.cgi%ff HTTP/1.0\n\r\n",
  332. 'HTTP/1.1 404', 'CGI Win32 code disclosure (%ff)');
  333. o("GET /env.cgi%2e HTTP/1.0\n\r\n",
  334. 'HTTP/1.1 404', 'CGI Win32 code disclosure (%2e)');
  335. o("GET /env.cgi%2b HTTP/1.0\n\r\n",
  336. 'HTTP/1.1 404', 'CGI Win32 code disclosure (%2b)');
  337. o("GET /env.cgi HTTP/1.0\n\r\n", '\nHTTPS=off\n', 'CGI HTTPS');
  338. o("GET /env.cgi HTTP/1.0\n\r\n", '\nCGI_FOO=foo\n', '-cgi_env 1');
  339. o("GET /env.cgi HTTP/1.0\n\r\n", '\nCGI_BAR=bar\n', '-cgi_env 2');
  340. o("GET /env.cgi HTTP/1.0\n\r\n", '\nCGI_BAZ=baz\n', '-cgi_env 3');
  341. o("GET /env.cgi/a/b/98 HTTP/1.0\n\r\n", 'PATH_INFO=/a/b/98\n', 'PATH_INFO');
  342. o("GET /env.cgi/a/b/9 HTTP/1.0\n\r\n", 'PATH_INFO=/a/b/9\n', 'PATH_INFO');
  343. # Check that CGI's current directory is set to script's directory
  344. my $copy_cmd = on_windows() ? 'copy' : 'cp';
  345. system("$copy_cmd $root" . $dir_separator . "env.cgi $test_dir" .
  346. $dir_separator . 'env.cgi');
  347. o("GET /$test_dir_uri/env.cgi HTTP/1.0\n\n",
  348. "CURRENT_DIR=.*$root/$test_dir_uri", "CGI chdir()");
  349. # SSI tests
  350. o("GET /ssi1.shtml HTTP/1.0\n\n",
  351. 'ssi_begin.+CFLAGS.+ssi_end', 'SSI #include file=');
  352. o("GET /ssi2.shtml HTTP/1.0\n\n",
  353. 'ssi_begin.+Unit test.+ssi_end', 'SSI #include virtual=');
  354. my $ssi_exec = on_windows() ? 'ssi4.shtml' : 'ssi3.shtml';
  355. o("GET /$ssi_exec HTTP/1.0\n\n",
  356. 'ssi_begin.+Makefile.+ssi_end', 'SSI #exec');
  357. my $abs_path = on_windows() ? 'ssi6.shtml' : 'ssi5.shtml';
  358. my $word = on_windows() ? 'boot loader' : 'root';
  359. o("GET /$abs_path HTTP/1.0\n\n",
  360. "ssi_begin.+$word.+ssi_end", 'SSI #include file= (absolute)');
  361. o("GET /ssi7.shtml HTTP/1.0\n\n",
  362. 'ssi_begin.+Unit test.+ssi_end', 'SSI #include "..."');
  363. o("GET /ssi8.shtml HTTP/1.0\n\n",
  364. 'ssi_begin.+CFLAGS.+ssi_end', 'SSI nested #includes');
  365. # Manipulate the passwords file
  366. my $path = 'test_htpasswd';
  367. unlink $path;
  368. system("$exe -A $path a b c") == 0
  369. or fail("Cannot add user in a passwd file");
  370. system("$exe -A $path a b c2") == 0
  371. or fail("Cannot edit user in a passwd file");
  372. my $content = read_file($path);
  373. $content =~ /^b:a:\w+$/gs or fail("Bad content of the passwd file");
  374. unlink $path;
  375. do_PUT_test();
  376. kill_spawned_child();
  377. do_unit_test();
  378. do_embedded_test();
  379. }
  380. sub do_PUT_test {
  381. # This only works because mongoose currently doesn't look at the nonce.
  382. # It should really be rejected...
  383. my $auth_header = "Authorization: Digest username=guest, ".
  384. "realm=mydomain.com, nonce=1145872809, uri=/put.txt, ".
  385. "response=896327350763836180c61d87578037d9, qop=auth, ".
  386. "nc=00000002, cnonce=53eddd3be4e26a98\n";
  387. o("PUT /a/put.txt HTTP/1.0\nContent-Length: 7\n$auth_header\n1234567",
  388. "HTTP/1.1 201 OK", 'PUT file, status 201');
  389. fail("PUT content mismatch")
  390. unless read_file("$root/a/put.txt") eq '1234567';
  391. o("PUT /a/put.txt HTTP/1.0\nContent-Length: 4\n$auth_header\nabcd",
  392. "HTTP/1.1 200 OK", 'PUT file, status 200');
  393. fail("PUT content mismatch")
  394. unless read_file("$root/a/put.txt") eq 'abcd';
  395. o("PUT /a/put.txt HTTP/1.0\n$auth_header\nabcd",
  396. "HTTP/1.1 411 Length Required", 'PUT 411 error');
  397. o("PUT /a/put.txt HTTP/1.0\nExpect: blah\nContent-Length: 1\n".
  398. "$auth_header\nabcd",
  399. "HTTP/1.1 417 Expectation Failed", 'PUT 417 error');
  400. o("PUT /a/put.txt HTTP/1.0\nExpect: 100-continue\nContent-Length: 4\n".
  401. "$auth_header\nabcd",
  402. "HTTP/1.1 100 Continue.+HTTP/1.1 200", 'PUT 100-Continue');
  403. }
  404. sub do_unit_test {
  405. my $cmd = "cc -g -W -Wall -o $unit_test_exe $root/unit_test.c -I. ".
  406. "-pthread -DNO_SSL ";
  407. if (on_windows()) {
  408. $cmd = "cl $root/embed.c mongoose.c /I. /nologo /DNO_SSL ".
  409. "/DLISTENING_PORT=\\\"$port\\\" /link /out:$embed_exe.exe ws2_32.lib ";
  410. }
  411. print $cmd, "\n";
  412. system($cmd) == 0 or fail("Cannot compile unit test");
  413. system($unit_test_exe) == 0 or fail("Unit test failed!");
  414. }
  415. sub do_embedded_test {
  416. my $cmd = "cc -W -Wall -o $embed_exe $root/embed.c mongoose.c -I. ".
  417. "-pthread -DNO_SSL -DLISTENING_PORT=\\\"$port\\\"";
  418. if (on_windows()) {
  419. $cmd = "cl $root/embed.c mongoose.c /I. /nologo /DNO_SSL ".
  420. "/DLISTENING_PORT=\\\"$port\\\" /link /out:$embed_exe.exe ws2_32.lib ";
  421. }
  422. print $cmd, "\n";
  423. system($cmd) == 0 or fail("Cannot compile embedded unit test");
  424. spawn("./$embed_exe");
  425. o("GET /test_get_header HTTP/1.0\nHost: blah\n\n",
  426. 'Value: \[blah\]', 'mg_get_header', 0);
  427. o("GET /test_get_var?a=b&my_var=foo&c=d HTTP/1.0\n\n",
  428. 'Value: \[foo\]', 'mg_get_var 1', 0);
  429. o("GET /test_get_var?my_var=foo&c=d HTTP/1.0\n\n",
  430. 'Value: \[foo\]', 'mg_get_var 2', 0);
  431. o("GET /test_get_var?a=b&my_var=foo HTTP/1.0\n\n",
  432. 'Value: \[foo\]', 'mg_get_var 3', 0);
  433. o("POST /test_get_var HTTP/1.0\nContent-Length: 10\n\n".
  434. "my_var=foo", 'Value: \[foo\]', 'mg_get_var 4', 0);
  435. o("POST /test_get_var HTTP/1.0\nContent-Length: 18\n\n".
  436. "a=b&my_var=foo&c=d", 'Value: \[foo\]', 'mg_get_var 5', 0);
  437. o("POST /test_get_var HTTP/1.0\nContent-Length: 14\n\n".
  438. "a=b&my_var=foo", 'Value: \[foo\]', 'mg_get_var 6', 0);
  439. o("GET /test_get_var?a=one%2btwo&my_var=foo& HTTP/1.0\n\n",
  440. 'Value: \[foo\]', 'mg_get_var 7', 0);
  441. o("GET /test_get_var?my_var=one%2btwo&b=two%2b HTTP/1.0\n\n",
  442. 'Value: \[one\+two\]', 'mg_get_var 8', 0);
  443. # + in form data MUST be decoded to space
  444. o("POST /test_get_var HTTP/1.0\nContent-Length: 10\n\n".
  445. "my_var=b+c", 'Value: \[b c\]', 'mg_get_var 9', 0);
  446. # Test that big POSTed vars are not truncated
  447. my $my_var = 'x' x 64000;
  448. o("POST /test_get_var HTTP/1.0\nContent-Length: 64007\n\n".
  449. "my_var=$my_var", 'Value size: \[64000\]', 'mg_get_var 10', 0);
  450. # Other methods should also work
  451. o("PUT /test_get_var HTTP/1.0\nContent-Length: 10\n\n".
  452. "my_var=foo", 'Value: \[foo\]', 'mg_get_var 11', 0);
  453. o("POST /test_get_request_info?xx=yy HTTP/1.0\nFoo: bar\n".
  454. "Content-Length: 3\n\na=b",
  455. 'Method: \[POST\].URI: \[/test_get_request_info\].'.
  456. 'HTTP version: \[1.0\].HTTP header \[Foo\]: \[bar\].'.
  457. 'HTTP header \[Content-Length\]: \[3\].'.
  458. 'Query string: \[xx=yy\].'.
  459. 'Remote IP: \[\d+\].Remote port: \[\d+\].'.
  460. 'Remote user: \[\]'
  461. , 'request_info', 0);
  462. o("GET /not_exist HTTP/1.0\n\n", 'Error: \[404\]', '404 handler', 0);
  463. o("bad request\n\n", 'Error: \[400\]', '* error handler', 0);
  464. # o("GET /foo/secret HTTP/1.0\n\n",
  465. # '401 Unauthorized', 'mg_protect_uri', 0);
  466. # o("GET /foo/secret HTTP/1.0\nAuthorization: Digest username=bill\n\n",
  467. # '401 Unauthorized', 'mg_protect_uri (bill)', 0);
  468. # o("GET /foo/secret HTTP/1.0\nAuthorization: Digest username=joe\n\n",
  469. # '200 OK', 'mg_protect_uri (joe)', 0);
  470. kill_spawned_child();
  471. }
  472. print "SUCCESS! All tests passed.\n";