helm/DEVEL/pxp/netstring/tests/test_cgi.ml

   1 #require "str";;
   2 #directory "..";;
   3 #load "netstring.cma";;
   4
   5
   6 open Cgi;;
   7
   8 (**********************************************************************)
   9 (* dest_form_encoded_parameters                                       *)
  10 (**********************************************************************)
  11
  12 let t001 f =
  13   let r =
  14     f
  15       "blah blah
  16 --snip
  17 Content-Disposition: form-data; name=blupp
  18
  19 This is a text
  20 --snip--
  21 blah blah"
  22       "snip"
  23   in
  24   r = ["blupp", "text/plain", "This is a text"]
  25 ;;
  26
  27
  28 let t002 f =
  29   let r =
  30     f
  31       "blah blah
  32 --snip
  33 Content-Disposition: form-data; name=blupp
  34
  35 This is a text
  36 --snip--
  37 blah blah"
  38       "snip"
  39   in
  40   r = ["blupp", "text/plain", "This is a text"]
  41 ;;
  42
  43
  44 let t003 f =
  45   let r =
  46     f
  47       "--snip
  48 Content-Disposition: form-data; name=blupp
  49
  50 This is a text
  51 --snip--"
  52       "snip"
  53   in
  54   r = ["blupp", "text/plain", "This is a text"]
  55 ;;
  56
  57
  58 let t004 f =
  59   let r =
  60     f
  61       "--snip
  62 Content-Disposition: form-data; name=blupp
  63
  64 This is a text
  65
  66 --snip--"
  67       "snip"
  68   in
  69   r = ["blupp", "text/plain", "This is a text\013\n"]
  70 ;;
  71
  72
  73 let t005 f =
  74   let r =
  75     f
  76       "--snip
  77 Content-Disposition: form-data; name=blupp
  78
  79 This is a text
  80
  81 --snip--"
  82       "snip"
  83   in
  84   r = ["blupp", "text/plain", "This is a text\n"]
  85 ;;
  86
  87
  88 let t006 f =
  89   let r =
  90     f
  91       "blah blah
  92 --snip
  93 Content-Disposition: form-data;name= \"blupp\"
  94
  95 This is a text
  96 --snip--
  97 blah blah"
  98       "snip"
  99   in
 100   r = ["blupp", "text/plain", "This is a text"]
 101 ;;
 102
 103
 104 let t007 f =
 105   let r =
 106     f
 107       "blah blah
 108 --snip
 109 Content-Disposition: form-data;name= \"name=blupp\"
 110
 111 This is a text
 112 --snip--
 113 blah blah"
 114       "snip"
 115   in
 116   r = ["name=blupp", "text/plain", "This is a text"]
 117 ;;
 118
 119
 120 let t008 f =
 121   let r =
 122     f
 123       "blah blah
 124 --snip
 125 Content-Disposition: form-data; strange=\"name=blop\"; name= \"blupp\"
 126
 127 This is a text
 128 --snip--
 129 blah blah"
 130       "snip"
 131   in
 132   r = ["blupp", "text/plain", "This is a text"]
 133 ;;
 134
 135
 136 let t009 f =
 137   let r =
 138     f
 139       "blah blah
 140 --snip
 141 Content-Disposition: form-data; strange=\" name=blop \";  name=blupp
 142
 143 This is a text
 144 --snip--
 145 blah blah"
 146       "snip"
 147   in
 148   r = ["blupp", "text/plain", "This is a text"]
 149 ;;
 150
 151
 152 let t010 f =
 153   (* There is a space after "octet-stream"! *)
 154   let r =
 155     f
 156       "--snip
 157 Content-Disposition: form-data; name=blupp
 158 Content-type:  application/octet-stream
 159
 160 This is a text
 161 --snip--"
 162       "snip"
 163   in
 164   r = ["blupp", "application/octet-stream", "This is a text"]
 165 ;;
 166
 167
 168 let t011 f =
 169   let r =
 170     f
 171       "blah blah
 172 --snip
 173 Content-Disposition: form-data; name=blupp
 174
 175 This is a text
 176 --snip
 177 Content-Disposition: form-data; name=blipp
 178
 179 Another line
 180 --snip-- blah
 181 blah blah"
 182       "snip"
 183   in
 184   r = ["blupp", "text/plain", "This is a text";
 185        "blipp", "text/plain", "Another line" ]
 186 ;;
 187
 188
 189 let t012 f =
 190   (* A real example *)
 191    let r =
 192      f
 193 "-----------------------------10843891265508332411092264958
 194 Content-Disposition: form-data; name=\"line\"
 195
 196 aaa
 197 -----------------------------10843891265508332411092264958
 198 Content-Disposition: form-data; name=\"submit\"
 199
 200 Submit
 201 -----------------------------10843891265508332411092264958--
 202 "
 203       "---------------------------10843891265508332411092264958"
 204    in
 205    r = [ "line", "text/plain", "aaa";
 206          "submit", "text/plain", "Submit";
 207        ]
 208 ;;
 209
 210
 211 (**********************************************************************)
 212 (* encode/decode                                                      *)
 213 (**********************************************************************)
 214
 215 let t100() =
 216   let s = String.create 256 in
 217   for i = 0 to 255 do s.[i] <- Char.chr i done;
 218   let r = encode s in
 219   r = ("%00%01%02%03%04%05%06%07%08%09%0A%0B%0C%0D%0E%0F" ^
 220        "%10%11%12%13%14%15%16%17%18%19%1A%1B%1C%1D%1E%1F" ^
 221        "+!%22%23$%25%26'()*%2B,-.%2F" ^
 222        "0123456789%3A%3B%3C%3D%3E%3F" ^
 223        "%40ABCDEFGHIJKLMNOPQRSTUVWXYZ%5B%5C%5D%5E_" ^
 224        "%60abcdefghijklmnopqrstuvwxyz%7B%7C%7D%7E%7F" ^
 225        "%80%81%82%83%84%85%86%87%88%89%8A%8B%8C%8D%8E%8F" ^
 226        "%90%91%92%93%94%95%96%97%98%99%9A%9B%9C%9D%9E%9F" ^
 227        "%A0%A1%A2%A3%A4%A5%A6%A7%A8%A9%AA%AB%AC%AD%AE%AF" ^
 228        "%B0%B1%B2%B3%B4%B5%B6%B7%B8%B9%BA%BB%BC%BD%BE%BF" ^
 229        "%C0%C1%C2%C3%C4%C5%C6%C7%C8%C9%CA%CB%CC%CD%CE%CF" ^
 230        "%D0%D1%D2%D3%D4%D5%D6%D7%D8%D9%DA%DB%DC%DD%DE%DF" ^
 231        "%E0%E1%E2%E3%E4%E5%E6%E7%E8%E9%EA%EB%EC%ED%EE%EF" ^
 232        "%F0%F1%F2%F3%F4%F5%F6%F7%F8%F9%FA%FB%FC%FD%FE%FF")
 233 ;;
 234
 235
 236 let t101() =
 237   let r = String.create 256 in
 238   for i = 0 to 255 do r.[i] <- Char.chr i done;
 239   let s = decode
 240             ("%00%01%02%03%04%05%06%07%08%09%0A%0B%0C%0D%0E%0F" ^
 241              "%10%11%12%13%14%15%16%17%18%19%1A%1B%1C%1D%1E%1F" ^
 242              "+!%22%23$%25%26'()*%2B,-.%2F" ^
 243              "0123456789%3A%3B%3C%3D%3E%3F" ^
 244              "%40ABCDEFGHIJKLMNOPQRSTUVWXYZ%5B%5C%5D%5E_" ^
 245              "%60abcdefghijklmnopqrstuvwxyz%7B%7C%7D%7E%7F" ^
 246              "%80%81%82%83%84%85%86%87%88%89%8A%8B%8C%8D%8E%8F" ^
 247              "%90%91%92%93%94%95%96%97%98%99%9A%9B%9C%9D%9E%9F" ^
 248              "%A0%A1%A2%A3%A4%A5%A6%A7%A8%A9%AA%AB%AC%AD%AE%AF" ^
 249              "%B0%B1%B2%B3%B4%B5%B6%B7%B8%B9%BA%BB%BC%BD%BE%BF" ^
 250              "%C0%C1%C2%C3%C4%C5%C6%C7%C8%C9%CA%CB%CC%CD%CE%CF" ^
 251              "%D0%D1%D2%D3%D4%D5%D6%D7%D8%D9%DA%DB%DC%DD%DE%DF" ^
 252              "%E0%E1%E2%E3%E4%E5%E6%E7%E8%E9%EA%EB%EC%ED%EE%EF" ^
 253              "%F0%F1%F2%F3%F4%F5%F6%F7%F8%F9%FA%FB%FC%FD%FE%FF") in
 254   r = s
 255 ;;
 256
 257
 258 let t102() =
 259   let r = String.create 256 in
 260   for i = 0 to 255 do r.[i] <- Char.chr i done;
 261   let s = decode
 262             ((String.lowercase
 263                 ("%00%01%02%03%04%05%06%07%08%09%0A%0B%0C%0D%0E%0F" ^
 264                  "%10%11%12%13%14%15%16%17%18%19%1A%1B%1C%1D%1E%1F" ^
 265                  "+!%22%23$%25%26'()*%2B,-.%2F" ^
 266                  "0123456789%3A%3B%3C%3D%3E%3F")) ^
 267              "%40ABCDEFGHIJKLMNOPQRSTUVWXYZ%5B%5C%5D%5E_" ^
 268              (String.lowercase
 269                 ("%60abcdefghijklmnopqrstuvwxyz%7B%7C%7D%7E%7F" ^
 270                  "%80%81%82%83%84%85%86%87%88%89%8A%8B%8C%8D%8E%8F" ^
 271                  "%90%91%92%93%94%95%96%97%98%99%9A%9B%9C%9D%9E%9F" ^
 272                  "%A0%A1%A2%A3%A4%A5%A6%A7%A8%A9%AA%AB%AC%AD%AE%AF" ^
 273                  "%B0%B1%B2%B3%B4%B5%B6%B7%B8%B9%BA%BB%BC%BD%BE%BF" ^
 274                  "%C0%C1%C2%C3%C4%C5%C6%C7%C8%C9%CA%CB%CC%CD%CE%CF" ^
 275                  "%D0%D1%D2%D3%D4%D5%D6%D7%D8%D9%DA%DB%DC%DD%DE%DF" ^
 276                  "%E0%E1%E2%E3%E4%E5%E6%E7%E8%E9%EA%EB%EC%ED%EE%EF" ^
 277                  "%F0%F1%F2%F3%F4%F5%F6%F7%F8%F9%FA%FB%FC%FD%FE%FF"))) in
 278   r = s
 279 ;;
 280
 281 (**********************************************************************)
 282 (* dest_url_encoded_parameters                                        *)
 283 (**********************************************************************)
 284
 285 let t200() =
 286   let r = dest_url_encoded_parameters "a=b&c=d" in
 287   r = ["a", "b"; "c", "d" ]
 288 ;;
 289
 290
 291 let t201() =
 292   let r = dest_url_encoded_parameters "a=&c=d" in
 293   r = ["a", ""; "c", "d" ]
 294 ;;
 295
 296
 297 let t202() =
 298   let r = dest_url_encoded_parameters "a=&c=" in
 299   r = ["a", ""; "c", "" ]
 300 ;;
 301
 302
 303 let t203() =
 304   let r = dest_url_encoded_parameters "" in
 305   r = []
 306 ;;
 307
 308
 309 let t204() =
 310   let r = dest_url_encoded_parameters "%41=%42" in
 311   r = ["A", "B"]
 312 ;;
 313
 314
 315 (**********************************************************************)
 316
 317 let test f n =
 318   if f() then
 319     print_endline ("Test " ^ n ^ " ok")
 320   else
 321     print_endline ("Test " ^ n ^ " FAILED!!!!");
 322   flush stdout
 323 ;;
 324
 325
 326 let test_dest_form_encoded_parameters f n =
 327   let dest s b =
 328     let args = dest_form_encoded_parameters s b default_config in
 329     List.map
 330       (fun a -> arg_name a, arg_mimetype a, arg_value a)
 331       args
 332   in
 333   if f dest then
 334     print_endline ("Test dest_form_encoded_parameters " ^ n ^ " ok")
 335   else
 336     print_endline ("Test dest_form_encoded_parameters " ^ n ^ " FAILED!!!!");
 337   flush stdout
 338 ;;
 339
 340
 341 let fill_stream s =
 342   (* Returns a channel that reads from string s.
 343    * This requires forking.
 344    *)
 345   let rd, wr = Unix.pipe() in
 346   let pid = Unix.fork() in
 347   if pid = 0 then begin
 348     Unix.close rd;
 349     let out = Unix.out_channel_of_descr wr in
 350     output_string out s;
 351     close_out out;
 352     exit(0);
 353   end;
 354   Unix.close wr;
 355   Unix.in_channel_of_descr rd
 356 ;;
 357
 358
 359 let test_dest_form_encoded_parameters_from_netstream f n =
 360   let dest s b =
 361     let fd = fill_stream s in
 362     let bs = String.length b * 2 in
 363     let stream = Netstream.create_from_channel fd None bs in
 364     let args = dest_form_encoded_parameters_from_netstream
 365                  stream b default_config in
 366
 367 (*
 368     List.iter
 369       (fun a ->
 370          Printf.printf "name=%s mimetype=%s value=%s\n"
 371            (arg_name a) (arg_mimetype a) (arg_value a))
 372       args;
 373 *)
 374     List.map
 375       (fun a -> arg_name a, arg_mimetype a, arg_value a)
 376       args
 377   in
 378   if f dest then
 379     Printf.printf
 380       "Test dest_form_encoded_parameters_from_netstream %s ok\n"
 381       n
 382   else
 383     print_endline ("Test dest_form_encoded_parameters_from_netstream " ^ n ^ " FAILED!!!!");
 384   flush stdout
 385 ;;
 386
 387
 388
 389 test_dest_form_encoded_parameters t001 "001";;
 390 test_dest_form_encoded_parameters t002 "002";;
 391 test_dest_form_encoded_parameters t003 "003";;
 392 test_dest_form_encoded_parameters t004 "004";;
 393 test_dest_form_encoded_parameters t005 "005";;
 394 test_dest_form_encoded_parameters t006 "006";;
 395 test_dest_form_encoded_parameters t007 "007";;
 396 test_dest_form_encoded_parameters t008 "008";;
 397 test_dest_form_encoded_parameters t009 "009";;
 398 test_dest_form_encoded_parameters t010 "010";;
 399 test_dest_form_encoded_parameters t011 "011";;
 400 test_dest_form_encoded_parameters t012 "012";;
 401
 402 test_dest_form_encoded_parameters_from_netstream t001 "001";;
 403 test_dest_form_encoded_parameters_from_netstream t002 "002";;
 404 test_dest_form_encoded_parameters_from_netstream t003 "003";;
 405 test_dest_form_encoded_parameters_from_netstream t004 "004";;
 406 test_dest_form_encoded_parameters_from_netstream t005 "005";;
 407 test_dest_form_encoded_parameters_from_netstream t006 "006";;
 408 test_dest_form_encoded_parameters_from_netstream t007 "007";;
 409 test_dest_form_encoded_parameters_from_netstream t008 "008";;
 410 test_dest_form_encoded_parameters_from_netstream t009 "009";;
 411 test_dest_form_encoded_parameters_from_netstream t010 "010";;
 412 test_dest_form_encoded_parameters_from_netstream t011 "011";;
 413 test_dest_form_encoded_parameters_from_netstream t012 "012";;
 414
 415 test t100 "100";;
 416 test t101 "101";;
 417 test t102 "102";;
 418
 419 test t200 "200";;
 420 test t201 "201";;
 421 test t202 "202";;
 422 test t203 "203";;
 423 test t204 "204";;