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

   1 #directory "..";;
   2 #load "netstring.cma";;
   3
   4 open Neturl;;
   5
   6
   7 let expect_malformed_url f =
   8   try ignore(f()); false with Malformed_URL -> true;;
   9
  10 let works f =
  11   not (expect_malformed_url f)
  12 ;;
  13
  14 (**********************************************************************)
  15 (* extract_url_scheme                                                 *)
  16 (**********************************************************************)
  17
  18 let t001 () =
  19   extract_url_scheme "a:bc" = "a" &&
  20   extract_url_scheme "A:bc" = "a" &&
  21   extract_url_scheme "a:b:c" = "a" &&
  22   extract_url_scheme "a+b-c:d:e" = "a+b-c"
  23 ;;
  24
  25
  26 let t002 () =
  27   let test s =
  28     try ignore(extract_url_scheme s); false with Malformed_URL -> true
  29   in
  30   test "a" &&
  31   test "a/b:c" &&
  32   test "%61:b" &&
  33   test "a%3ab"
  34 ;;
  35
  36 (**********************************************************************)
  37 (* url_syntax                                                         *)
  38 (**********************************************************************)
  39
  40 let hashtbl_for_all f h =
  41   let b = ref true in
  42   Hashtbl.iter
  43     (fun k v -> b := !b && f k v)
  44     h;
  45   !b
  46 ;;
  47
  48 let t010 () =
  49   url_syntax_is_valid null_url_syntax &&
  50   url_syntax_is_valid ip_url_syntax &&
  51   hashtbl_for_all
  52     (fun _ syn ->
  53        url_syntax_is_valid syn
  54     )
  55     common_url_syntax
  56 ;;
  57
  58 let t011 () =
  59   url_syntax_is_valid (partial_url_syntax null_url_syntax) &&
  60   url_syntax_is_valid (partial_url_syntax ip_url_syntax) &&
  61   hashtbl_for_all
  62     (fun _ syn ->
  63        url_syntax_is_valid (partial_url_syntax syn)
  64     )
  65     common_url_syntax
  66 ;;
  67
  68 let t012 () =
  69   let f = fun _ -> true in
  70   let syn =
  71     { url_enable_scheme    = Url_part_not_recognized;
  72       url_enable_user      = Url_part_required;
  73       url_enable_password  = Url_part_allowed;
  74       url_enable_host      = Url_part_required;
  75       url_enable_port      = Url_part_not_recognized;
  76       url_enable_path      = Url_part_required;
  77       url_enable_param     = Url_part_not_recognized;
  78       url_enable_query     = Url_part_not_recognized;
  79       url_enable_fragment  = Url_part_required;
  80       url_enable_other     = Url_part_not_recognized;
  81       url_accepts_8bits    = false;
  82       url_is_valid         = f;
  83     } in
  84   let syn' = partial_url_syntax syn in
  85
  86   (syn'.url_enable_scheme    = Url_part_not_recognized) &&
  87   (syn'.url_enable_user      = Url_part_allowed) &&
  88   (syn'.url_enable_password  = Url_part_allowed) &&
  89   (syn'.url_enable_host      = Url_part_allowed) &&
  90   (syn'.url_enable_port      = Url_part_not_recognized) &&
  91   (syn'.url_enable_path      = Url_part_allowed) &&
  92   (syn'.url_enable_param     = Url_part_not_recognized) &&
  93   (syn'.url_enable_query     = Url_part_not_recognized) &&
  94   (syn'.url_enable_fragment  = Url_part_allowed) &&
  95   (syn'.url_enable_other     = Url_part_not_recognized) &&
  96   (syn'.url_is_valid        == f) &&
  97
  98   url_syntax_is_valid syn &&
  99   url_syntax_is_valid syn'
 100 ;;
 101
 102 (**********************************************************************)
 103 (* make_url                                                           *)
 104 (**********************************************************************)
 105
 106 let t020 () =
 107   (* Basic functionality: *)
 108   let http_syn = Hashtbl.find common_url_syntax "http" in
 109
 110   let u1 = make_url
 111              (* default: not encoded *)
 112              ~scheme:"http"
 113              ~user:"U"
 114              ~password:"%()~$@"
 115              ~host:"a.b.c"
 116              ~port:81
 117              ~path:["";"?";""]
 118              http_syn in
 119
 120   url_provides
 121     ~scheme:true ~user:true ~password:true ~host:true ~port:true ~path:true
 122     u1 &&
 123
 124   not
 125     (url_provides
 126        ~scheme:true ~user:true ~password:true ~host:true ~port:true ~path:true
 127        ~query:true u1) &&
 128
 129   (url_syntax_of_url u1 == http_syn) &&
 130
 131   (url_scheme   u1 = "http") &&
 132   (url_user     u1 = "U") &&
 133   (url_password u1 = "%()~$@") &&
 134   (url_host     u1 = "a.b.c") &&
 135   (url_port     u1 = 81) &&
 136   (url_path     u1 = ["";"?";""]) &&
 137
 138   (url_user     ~encoded:true u1 = "U") &&
 139   (url_password ~encoded:true u1 = "%25()%7E$%40") &&
 140   (url_path     ~encoded:true u1 = ["";"%3F";""]) &&
 141
 142   string_of_url u1 = "http://U:%25()%7E$%40@a.b.c:81/%3F/"
 143 ;;
 144
 145
 146 let t021 () =
 147   (* Basic functionality: *)
 148   let http_syn = Hashtbl.find common_url_syntax "http" in
 149
 150   let u1 = make_url
 151              ~encoded:true
 152              ~scheme:"http"
 153              ~user:"%55"
 154              ~password:"%25()%7e$%40"
 155              ~host:"a.b.c"
 156              ~port:81
 157              ~path:["";"%3F";""]
 158              http_syn in
 159
 160   url_provides
 161     ~scheme:true ~user:true ~password:true ~host:true ~port:true ~path:true
 162     u1 &&
 163
 164   not
 165     (url_provides
 166        ~scheme:true ~user:true ~password:true ~host:true ~port:true ~path:true
 167        ~query:true u1) &&
 168
 169   (url_syntax_of_url u1 == http_syn) &&
 170
 171   (url_scheme   u1 = "http") &&
 172   (url_user     u1 = "U") &&
 173   (url_password u1 = "%()~$@") &&
 174   (url_host     u1 = "a.b.c") &&
 175   (url_port     u1 = 81) &&
 176   (url_path     u1 = ["";"?";""]) &&
 177
 178   (url_user     ~encoded:true u1 = "%55") &&
 179   (url_password ~encoded:true u1 = "%25()%7e$%40") &&
 180   (url_path     ~encoded:true u1 = ["";"%3F";""]) &&
 181
 182   string_of_url u1 = "http://%55:%25()%7e$%40@a.b.c:81/%3F/"
 183 ;;
 184
 185
 186 (* NEGATIVE TESTS *)
 187
 188 let t030 () =
 189   (* It is not possible to add a component which is not recognized *)
 190   let http_syn = Hashtbl.find common_url_syntax "http" in
 191
 192   expect_malformed_url
 193     (fun () ->
 194        make_url
 195          ~scheme:"http"
 196          ~user:"U"
 197          ~password:"%()~$@"
 198          ~host:"a.b.c"
 199          ~port:81
 200          ~path:["";"?";""]
 201          ~fragment:"abc"
 202          http_syn)
 203 ;;
 204
 205
 206 let t031 () =
 207   (* It is not possible to put malformed '%'-encodings into the URL *)
 208   let http_syn = Hashtbl.find common_url_syntax "http" in
 209
 210   works                      (* reference *)
 211     (fun () ->
 212        make_url
 213          ~encoded:true
 214          ~scheme:"http"
 215          ~user:"U"
 216          ~password:"XX"
 217          ~host:"a.b.c"
 218          ~port:81
 219          ~path:["";"a";""]
 220          http_syn) &&
 221
 222   expect_malformed_url
 223     (fun () ->
 224        make_url
 225          ~encoded:true
 226          ~scheme:"http"
 227          ~user:"U"
 228          ~password:"%XX"
 229          ~host:"a.b.c"
 230          ~port:81
 231          ~path:["";"a";""]
 232          http_syn) &&
 233
 234   expect_malformed_url
 235     (fun () ->
 236        make_url
 237          ~encoded:true
 238          ~scheme:"http"
 239          ~user:"U"
 240          ~password:"%X"
 241          ~host:"a.b.c"
 242          ~port:81
 243          ~path:["";"a";""]
 244          http_syn) &&
 245
 246   expect_malformed_url
 247     (fun () ->
 248        make_url
 249          ~encoded:true
 250          ~scheme:"http"
 251          ~user:"U"
 252          ~password:"%"
 253          ~host:"a.b.c"
 254          ~port:81
 255          ~path:["";"a";""]
 256          http_syn)
 257 ;;
 258
 259 let t032 () =
 260   (* It is not possible to put unsafe characters into the URL *)
 261   let http_syn = Hashtbl.find common_url_syntax "http" in
 262
 263   let make c =
 264     make_url
 265       ~encoded:true
 266       ~scheme:"http"
 267       ~user:"U"
 268       ~password:(String.make 1 c)
 269       ~host:"a.b.c"
 270       ~port:81
 271       ~path:["";"a";""]
 272       http_syn
 273   in
 274
 275   works (fun () -> make 'a') &&                   (* reference *)
 276
 277   (* List of unsafe characters taken from RFC1738: *)
 278   expect_malformed_url (fun () -> make '<') &&
 279   expect_malformed_url (fun () -> make '>') &&
 280   expect_malformed_url (fun () -> make '"') &&
 281   expect_malformed_url (fun () -> make '#') &&
 282     (* Note: '#' would be considered as reserved if fragments were enabled *)
 283   expect_malformed_url (fun () -> make '%') &&
 284   expect_malformed_url (fun () -> make '{') &&
 285   expect_malformed_url (fun () -> make '}') &&
 286   expect_malformed_url (fun () -> make '|') &&
 287   expect_malformed_url (fun () -> make '\\') &&
 288   expect_malformed_url (fun () -> make '^') &&
 289   expect_malformed_url (fun () -> make '[') &&
 290   expect_malformed_url (fun () -> make ']') &&
 291   expect_malformed_url (fun () -> make '`') &&
 292   expect_malformed_url (fun () -> make '~') &&
 293     (* Note: '~' is considered as safe in paths: *)
 294   works
 295     (fun () ->
 296     make_url
 297       ~encoded:true
 298       ~scheme:"http"
 299       ~user:"U"
 300       ~password:"a"
 301       ~host:"a.b.c"
 302       ~port:81
 303       ~path:["";"~";""]
 304       http_syn)
 305 ;;
 306
 307 let t033 () =
 308   (* It is not possible to put reserved characters into the URL *)
 309   let http_syn = Hashtbl.find common_url_syntax "http" in
 310
 311   let make_password c =
 312     make_url
 313       ~encoded:true
 314       ~scheme:"http"
 315       ~user:"U"
 316       ~password:(String.make 1 c)
 317       ~host:"a.b.c"
 318       ~port:81
 319       ~path:["";"a";""]
 320       http_syn
 321   in
 322   let make_path c =
 323     make_url
 324       ~encoded:true
 325       ~scheme:"http"
 326       ~user:"U"
 327       ~password:"a"
 328       ~host:"a.b.c"
 329       ~port:81
 330       ~path:["";String.make 1 c;""]
 331       http_syn
 332   in
 333   let make_query c =
 334     make_url
 335       ~encoded:true
 336       ~scheme:"http"
 337       ~user:"U"
 338       ~password:"a"
 339       ~host:"a.b.c"
 340       ~port:81
 341       ~path:["";"a";""]
 342       ~query:(String.make 1 c)
 343       http_syn
 344   in
 345
 346   (* Note: There is a difference between RFC 1738 and RFC 1808 regarding
 347    * which characters are reserved. RFC 1808 defines a fixed set of characters
 348    * as reserved while RFC 1738 defines the reserved characters depending
 349    * on the scheme.
 350    * This implementation of URLs follows RFC 1738 (because of practical
 351    * reasons).
 352    *)
 353
 354   works (fun () -> make_password 'a') &&                   (* reference *)
 355   works (fun () -> make_path 'a') &&
 356   works (fun () -> make_query 'a') &&
 357
 358   expect_malformed_url (fun () -> make_password ':') &&
 359   expect_malformed_url (fun () -> make_password '@') &&
 360   expect_malformed_url (fun () -> make_password '/') &&
 361   works                (fun () -> make_password ';') &&
 362   works                (fun () -> make_password '?') &&
 363   works                (fun () -> make_password '=') &&
 364   works                (fun () -> make_password '&') &&
 365
 366   (* Note: ';' is allowed in path and query because parameters are not
 367    * recognized in HTTP syntax.
 368    *)
 369
 370   expect_malformed_url (fun () -> make_path '/') &&
 371   expect_malformed_url (fun () -> make_path '?') &&
 372   works                (fun () -> make_path ':') &&
 373   works                (fun () -> make_path '@') &&
 374   works                (fun () -> make_path ';') &&
 375   works                (fun () -> make_path '=') &&
 376   works                (fun () -> make_path '&') &&
 377
 378   expect_malformed_url (fun () -> make_query '?') &&
 379   works                (fun () -> make_query '/') &&
 380   works                (fun () -> make_query ':') &&
 381   works                (fun () -> make_query '@') &&
 382   works                (fun () -> make_query ';') &&
 383   works                (fun () -> make_query '=') &&
 384   works                (fun () -> make_query '&')
 385 ;;
 386
 387
 388 let t034 () =
 389   (* It is not possible to create a URL with a password, but without user;
 390    * and neither to create a URL with a port, but without host;
 391    * and neither to create a URL with a user, but without host
 392    *)
 393
 394   expect_malformed_url
 395     (fun () ->
 396        make_url
 397          ~scheme:"http"
 398          ~password:"a"
 399          ~host:"a.b.c"
 400          ~path:["";"a";""]
 401          ip_url_syntax) &&
 402
 403   expect_malformed_url
 404     (fun () ->
 405        make_url
 406          ~scheme:"http"
 407          ~user:"U"
 408          ~path:["";"a";""]
 409          ip_url_syntax) &&
 410
 411   expect_malformed_url
 412     (fun () ->
 413        make_url
 414          ~scheme:"http"
 415          ~port:81
 416          ~path:["";"a";""]
 417          ip_url_syntax)
 418 ;;
 419
 420
 421 let t035 () =
 422   (* It is not possible to create a URL with illegal scheme prefix *)
 423
 424   (* reference: *)
 425   works
 426     (fun () ->
 427        make_url
 428          ~scheme:"a"
 429          ip_url_syntax) &&
 430
 431   expect_malformed_url
 432     (fun () ->
 433        make_url
 434          ~scheme:":"
 435          ip_url_syntax) &&
 436
 437   expect_malformed_url
 438     (fun () ->
 439        make_url
 440          ~scheme:"a=b"
 441          ip_url_syntax) &&
 442
 443   expect_malformed_url
 444     (fun () ->
 445        make_url
 446          ~scheme:"a%62b"
 447          ip_url_syntax) &&
 448
 449   expect_malformed_url
 450     (fun () ->
 451        make_url
 452          ~scheme:"a&b"
 453          ip_url_syntax)
 454 ;;
 455
 456
 457 let t036 () =
 458   (* It is not possible to have a path with double slashes *)
 459
 460   (* reference: *)
 461   works
 462     (fun () ->
 463        make_url
 464          ~path:["";"a";""]
 465          ip_url_syntax) &&
 466
 467   expect_malformed_url
 468     (fun () ->
 469        make_url
 470          ~path:["";""]
 471          ip_url_syntax) &&
 472
 473   expect_malformed_url
 474     (fun () ->
 475        make_url
 476          ~path:["a";"";""]
 477          ip_url_syntax) &&
 478
 479   expect_malformed_url
 480     (fun () ->
 481        make_url
 482          ~path:["";"";"a"]
 483          ip_url_syntax) &&
 484
 485   expect_malformed_url
 486     (fun () ->
 487        make_url
 488          ~path:["a";"";"a"]
 489          ip_url_syntax)
 490 ;;
 491
 492
 493 let t037 () =
 494   (* It is not possible to have port numbers outside 0..65535 *)
 495
 496   (* reference: *)
 497   works
 498     (fun () ->
 499        make_url
 500          ~host:"a"
 501          ~port:1
 502          ip_url_syntax) &&
 503
 504   expect_malformed_url
 505     (fun () ->
 506        make_url
 507          ~host:"a"
 508          ~port:(-1)
 509          ip_url_syntax) &&
 510
 511   expect_malformed_url
 512     (fun () ->
 513        make_url
 514          ~host:"a"
 515          ~port:65536
 516          ip_url_syntax)
 517 ;;
 518
 519
 520 let t038 () =
 521   (* Several cases which are not allowed. *)
 522
 523   expect_malformed_url
 524     (fun () ->
 525        make_url
 526          ~host:"a"
 527          ~path:["a"]
 528          ip_url_syntax
 529     ) &&                       (* illegal: host + relative path *)
 530
 531   expect_malformed_url
 532     (fun () ->
 533        make_url
 534          ~host:"a"
 535          ~path:[]
 536          ~param:["x"]
 537          ip_url_syntax
 538     ) &&                       (* illegal: host + no path + params *)
 539
 540   expect_malformed_url
 541     (fun () ->
 542        make_url
 543          ~host:"a"
 544          ~path:[]
 545          ~query:"x"
 546          ip_url_syntax
 547     )                          (* illegal: host + no path + query *)
 548 ;;
 549
 550 (**********************************************************************)
 551 (* url_of_string                                                      *)
 552 (**********************************************************************)
 553
 554 let t050 () =
 555   (* absolute URLs with ip_url_syntax *)
 556   let identical s =
 557     string_of_url (url_of_string ip_url_syntax s) = s in
 558
 559   let fails s =
 560     try ignore(url_of_string ip_url_syntax s); false
 561     with Malformed_URL -> true
 562   in
 563
 564   identical "http:" &&
 565
 566   identical "http://host" &&
 567   identical "http://user@host" &&
 568   identical "http://user:password@host" &&
 569   identical "http://user@host:99" &&
 570   identical "http://user:password@host:99" &&
 571
 572   identical "http://host/" &&
 573   identical "http://user@host/" &&
 574   identical "http://user:password@host/" &&
 575   identical "http://user@host:99/" &&
 576   identical "http://user:password@host:99/" &&
 577
 578   identical "http://host/a/b" &&
 579   identical "http://user@host/a/b" &&
 580   identical "http://user:password@host/a/b" &&
 581   identical "http://user@host:99/a/b" &&
 582   identical "http://user:password@host:99/a/b" &&
 583
 584   identical "http://host/a/b/" &&
 585   identical "http://user@host/a/b/" &&
 586   identical "http://user:password@host/a/b/" &&
 587   identical "http://user@host:99/a/b/" &&
 588   identical "http://user:password@host:99/a/b/" &&
 589
 590   identical "http://host/?a=b&c=d" &&
 591   identical "http://user@host/?a=b&c=d" &&
 592   identical "http://user:password@host/?a=b&c=d" &&
 593   identical "http://user@host:99/?a=b&c=d" &&
 594   identical "http://user:password@host:99/?a=b&c=d" &&
 595
 596   fails "http://host?a=b&c=d" &&
 597   fails "http://user@host?a=b&c=d" &&
 598   fails "http://user:password@host?a=b&c=d" &&
 599   fails "http://user@host:99?a=b&c=d" &&
 600   fails "http://user:password@host:99?a=b&c=d" &&
 601
 602   identical "http://host/?a=/&c=/" &&
 603   identical "http://user@host/?a=/&c=/" &&
 604   identical "http://user:password@host/?a=/&c=/" &&
 605   identical "http://user@host:99/?a=/&c=/" &&
 606   identical "http://user:password@host:99/?a=/&c=/" &&
 607
 608   identical "http://host/;a;b" &&
 609   identical "http://user@host/;a;b" &&
 610   identical "http://user:password@host/;a;b" &&
 611   identical "http://user@host:99/;a;b" &&
 612   identical "http://user:password@host:99/;a;b" &&
 613
 614   fails "http://host;a;b" &&
 615   fails "http://user@host;a;b" &&
 616   fails "http://user:password@host;a;b" &&
 617   fails "http://user@host:99;a;b" &&
 618   fails "http://user:password@host:99;a;b" &&
 619
 620   identical "http://host/;a;b?a=b&c=d" &&
 621   identical "http://user@host/;a;b?a=b&c=d" &&
 622   identical "http://user:password@host/;a;b?a=b&c=d" &&
 623   identical "http://user@host:99/;a;b?a=b&c=d" &&
 624   identical "http://user:password@host:99/;a;b?a=b&c=d" &&
 625
 626   identical "http:#f" &&
 627
 628   identical "http://host#f" &&
 629   identical "http://user@host#f" &&
 630   identical "http://user:password@host#f" &&
 631   identical "http://user@host:99#f" &&
 632   identical "http://user:password@host:99#f" &&
 633
 634   identical "http://host/;a;b?a=b&c=d#f" &&
 635   identical "http://user@host/;a;b?a=b&c=d#f" &&
 636   identical "http://user:password@host/;a;b?a=b&c=d#f" &&
 637   identical "http://user@host:99/;a;b?a=b&c=d#f" &&
 638   identical "http://user:password@host:99/;a;b?a=b&c=d#f" &&
 639
 640   true
 641 ;;
 642
 643
 644 let t051 () =
 645   (* relative URLs with ip_url_syntax *)
 646   let identical s =
 647     string_of_url (url_of_string ip_url_syntax s) = s in
 648
 649   let fails s =
 650     try ignore(url_of_string ip_url_syntax s); false
 651     with Malformed_URL -> true
 652   in
 653
 654   identical "//host" &&
 655   identical "//user@host" &&
 656   identical "//user:password@host" &&
 657   identical "//user@host:99" &&
 658   identical "//user:password@host:99" &&
 659
 660   identical "//host/" &&
 661   identical "//user@host/" &&
 662   identical "//user:password@host/" &&
 663   identical "//user@host:99/" &&
 664   identical "//user:password@host:99/" &&
 665
 666   identical "//host#f" &&
 667   identical "//user@host#f" &&
 668   identical "//user:password@host#f" &&
 669   identical "//user@host:99#f" &&
 670   identical "//user:password@host:99#f" &&
 671
 672   identical "/" &&
 673   identical "/a" &&
 674   identical "/a/" &&
 675   identical "/a/a" &&
 676
 677   identical "/;a;b" &&
 678   identical "/a;a;b" &&
 679   identical "/a/;a;b" &&
 680   identical "/a/a;a;b" &&
 681
 682   identical "/?a=b&c=d" &&
 683   identical "/a?a=b&c=d" &&
 684   identical "/a/?a=b&c=d" &&
 685   identical "/a/a?a=b&c=d" &&
 686
 687   identical "/;a;b?a=b&c=d" &&
 688   identical "/a;a;b?a=b&c=d" &&
 689   identical "/a/;a;b?a=b&c=d" &&
 690   identical "/a/a;a;b?a=b&c=d" &&
 691
 692   identical "/#f" &&
 693   identical "/a#f" &&
 694   identical "/a/#f" &&
 695   identical "/a/a#f" &&
 696
 697   identical "/;a;b#f" &&
 698   identical "/a;a;b#f" &&
 699   identical "/a/;a;b#f" &&
 700   identical "/a/a;a;b#f" &&
 701
 702   identical "/;a;b?a=b&c=d#f" &&
 703   identical "/a;a;b?a=b&c=d#f" &&
 704   identical "/a/;a;b?a=b&c=d#f" &&
 705   identical "/a/a;a;b?a=b&c=d#f" &&
 706
 707   identical "" &&
 708   identical "a" &&
 709   identical "a/" &&
 710   identical "a/a" &&
 711
 712   identical ";a;b" &&
 713   identical "a;a;b" &&
 714   identical "a/;a;b" &&
 715   identical "a/a;a;b" &&
 716
 717   identical "?a=b&c=d" &&
 718   identical "a?a=b&c=d" &&
 719   identical "a/?a=b&c=d" &&
 720   identical "a/a?a=b&c=d" &&
 721
 722   identical ";a;b?a=b&c=d" &&
 723   identical "a;a;b?a=b&c=d" &&
 724   identical "a/;a;b?a=b&c=d" &&
 725   identical "a/a;a;b?a=b&c=d" &&
 726
 727   identical "#f" &&
 728   identical "a#f" &&
 729   identical "a/#f" &&
 730   identical "a/a#f" &&
 731
 732   identical ";a;b#f" &&
 733   identical "a;a;b#f" &&
 734   identical "a/;a;b#f" &&
 735   identical "a/a;a;b#f" &&
 736
 737   identical ";a;b?a=b&c=d#f" &&
 738   identical "a;a;b?a=b&c=d#f" &&
 739   identical "a/;a;b?a=b&c=d#f" &&
 740   identical "a/a;a;b?a=b&c=d#f" &&
 741
 742   identical "." &&
 743   identical "./" &&
 744   identical "./a" &&
 745
 746   identical ".;a;b" &&
 747   identical "./;a;b" &&
 748   identical "./a;a;b" &&
 749
 750   identical ".?a=b&c=d" &&
 751   identical "./?a=b&c=d" &&
 752   identical "./a?a=b&c=d" &&
 753
 754   identical ".;a;b?a=b&c=d" &&
 755   identical "./;a;b?a=b&c=d" &&
 756   identical "./a;a;b?a=b&c=d" &&
 757
 758   identical ".#f" &&
 759   identical "./#f" &&
 760   identical "./a#f" &&
 761
 762   identical ".;a;b#f" &&
 763   identical "./;a;b#f" &&
 764   identical "./a;a;b#f" &&
 765
 766   identical ".;a;b?a=b&c=d#f" &&
 767   identical "./;a;b?a=b&c=d#f" &&
 768   identical "./a;a;b?a=b&c=d#f" &&
 769
 770   identical ".." &&
 771   identical "../" &&
 772   identical "../a" &&
 773
 774   identical "..;a;b" &&
 775   identical "../;a;b" &&
 776   identical "../a;a;b" &&
 777
 778   identical "..?a=b&c=d" &&
 779   identical "../?a=b&c=d" &&
 780   identical "../a?a=b&c=d" &&
 781
 782   identical "..;a;b?a=b&c=d" &&
 783   identical "../;a;b?a=b&c=d" &&
 784   identical "../a;a;b?a=b&c=d" &&
 785
 786   identical "..#f" &&
 787   identical "../#f" &&
 788   identical "../a#f" &&
 789
 790   identical "..;a;b#f" &&
 791   identical "../;a;b#f" &&
 792   identical "../a;a;b#f" &&
 793
 794   identical "..;a;b?a=b&c=d#f" &&
 795   identical "../;a;b?a=b&c=d#f" &&
 796   identical "../a;a;b?a=b&c=d#f" &&
 797
 798   string_of_url
 799     (make_url ~path:["a:b"] ip_url_syntax) = "a%3Ab" &&
 800
 801   string_of_url
 802     (make_url ~encoded:true ~path:["a:b"] ip_url_syntax) = "./a:b" &&
 803
 804   true
 805 ;;
 806
 807
 808 let t052 () =
 809   (* mailto: URLs *)
 810   let mailto_syn = Hashtbl.find common_url_syntax "mailto" in
 811
 812   let identical s =
 813     string_of_url (url_of_string mailto_syn s) = s in
 814
 815   let fails s =
 816     try ignore(url_of_string mailto_syn s); false
 817     with Malformed_URL -> true
 818   in
 819
 820   identical "mailto:user@host" &&
 821   identical "mailto:user@host;?;?" &&
 822   fails     "mailto:user@host#f"
 823 ;;
 824
 825 (**********************************************************************)
 826 (* split_path/join_path/norm_path:                                    *)
 827 (**********************************************************************)
 828
 829 let t060 () =
 830   (split_path "" = []) &&
 831   (split_path "/" = [ "" ]) &&
 832   (split_path "/a" = [ ""; "a" ]) &&
 833   (split_path "a" = [ "a" ]) &&
 834   (split_path "a/" = [ "a"; "" ]) &&
 835   (split_path "/a/" = [ ""; "a"; "" ]) &&
 836   (split_path "/a/b" = [ ""; "a"; "b" ]) &&
 837   (split_path "/a/b/" = [ ""; "a"; "b"; "" ]) &&
 838   (split_path "/a/b/c" = [ ""; "a"; "b"; "c" ]) &&
 839
 840   (join_path [] = "") &&
 841   (join_path [ "" ] = "/") &&
 842   (join_path [ ""; "a" ] = "/a") &&
 843   (join_path [ "a" ] = "a") &&
 844   (join_path [ "a"; "" ] = "a/") &&
 845   (join_path [ ""; "a"; "" ] = "/a/") &&
 846   (join_path [ ""; "a"; "b" ] = "/a/b") &&
 847   (join_path [ ""; "a"; "b"; "" ] = "/a/b/") &&
 848   (join_path [ ""; "a"; "b"; "c" ] = "/a/b/c") &&
 849
 850   true
 851 ;;
 852
 853
 854 let t061 () =
 855   (norm_path ["."] = []) &&
 856   (norm_path ["."; ""] = []) &&
 857   (norm_path ["a"; "."] = ["a"; ""]) &&
 858   (norm_path ["a"; "b"; "."] = ["a"; "b"; ""]) &&
 859   (norm_path ["a"; "b"; ".."] = ["a"; ""]) &&
 860   (norm_path ["a"; "."; "b"; "."] = ["a"; "b"; ""]) &&
 861   (norm_path [".."] = [".."; ""]) &&
 862   (norm_path [".."; ""] = [".."; ""]) &&
 863   (norm_path ["a"; "b"; ".."; "c" ] = ["a"; "c"]) &&
 864   (norm_path ["a"; "b"; ".."; "c"; ""] = ["a"; "c"; ""]) &&
 865   (norm_path ["";"";"a";"";"b"] = [""; "a"; "b"]) &&
 866   (norm_path ["a"; "b"; ""; ".."; "c"; ""] = ["a"; "c"; ""]) &&
 867   (norm_path ["a"; ".."] = []) &&
 868   (norm_path ["";""] = [""]) &&
 869   (norm_path [""] = [""]) &&
 870   (norm_path [] = []) &&
 871
 872   true
 873 ;;
 874
 875 (**********************************************************************)
 876 (* apply_relative_url:                                                *)
 877 (**********************************************************************)
 878
 879 let t070() =
 880   (* Examples taken from RFC 1808 *)
 881   let url = url_of_string ip_url_syntax in
 882   let base = url "http://a/b/c/d;p?q#f" in
 883   let aru = apply_relative_url base in
 884
 885   (aru (url "g:h")     = url "g:h") &&
 886   (aru (url "g")       = url "http://a/b/c/g") &&
 887   (aru (url "./g")     = url "http://a/b/c/g") &&
 888   (aru (url "g/")      = url "http://a/b/c/g/") &&
 889   (aru (url "/g")      = url "http://a/g") &&
 890   (aru (url "//g")     = url "http://g") &&
 891   (aru (url "?y")      = url "http://a/b/c/d;p?y") &&
 892   (aru (url "g?y")     = url "http://a/b/c/g?y") &&
 893   (aru (url "g?y/./x") = url "http://a/b/c/g?y/./x") &&
 894   (aru (url "#s")      = url "http://a/b/c/d;p?q#s") &&
 895   (aru (url "g#s")     = url "http://a/b/c/g#s") &&
 896   (aru (url "g#s/./x") = url "http://a/b/c/g#s/./x") &&
 897   (aru (url "g?y#s")   = url "http://a/b/c/g?y#s") &&
 898   (aru (url ";x")      = url "http://a/b/c/d;x") &&
 899   (aru (url "g;x")     = url "http://a/b/c/g;x") &&
 900   (aru (url "g;x?y#s") = url "http://a/b/c/g;x?y#s") &&
 901   (aru (url ".")       = url "http://a/b/c/") &&
 902   (aru (url "./")      = url "http://a/b/c/") &&
 903   (aru (url "..")      = url "http://a/b/") &&
 904   (aru (url "../")     = url "http://a/b/") &&
 905   (aru (url "../g")    = url "http://a/b/g") &&
 906   (aru (url "../..")   = url "http://a/") &&
 907   (aru (url "../../")  = url "http://a/") &&
 908   (aru (url "../../g") = url "http://a/g") &&
 909
 910   (aru (url "")              = url "http://a/b/c/d;p?q#f") &&
 911   (aru (url "../../../g")    = url "http://a/../g") &&
 912   (aru (url "../../../../g") = url "http://a/../../g") &&
 913   (aru (url "/./g")          = url "http://a/./g") &&
 914   (aru (url "/../g")         = url "http://a/../g") &&
 915   (aru (url "g.")            = url "http://a/b/c/g.") &&
 916   (aru (url ".g")            = url "http://a/b/c/.g") &&
 917   (aru (url "g..")           = url "http://a/b/c/g..") &&
 918   (aru (url "..g")           = url "http://a/b/c/..g") &&
 919   (aru (url "./../g")        = url "http://a/b/g") &&
 920   (aru (url "./g/.")         = url "http://a/b/c/g/") &&
 921   (aru (url "g/./h")         = url "http://a/b/c/g/h") &&
 922   (aru (url "g/../h")        = url "http://a/b/c/h") &&
 923   (aru (url "http:g")        = url "http:g") &&
 924   (aru (url "http:")         = url "http:") &&
 925
 926   true
 927 ;;
 928
 929
 930 (**********************************************************************)
 931
 932 let test f n =
 933   if f() then
 934     print_endline ("Test " ^ n ^ " ok")
 935   else
 936     print_endline ("Test " ^ n ^ " FAILED!!!!");
 937   flush stdout
 938 ;;
 939
 940 test t001 "001";
 941 test t002 "002";
 942
 943 test t010 "010";
 944 test t011 "011";
 945 test t012 "012";
 946
 947 test t020 "020";
 948 test t021 "021";
 949
 950 test t030 "030";
 951 test t031 "031";
 952 test t032 "032";
 953 test t033 "033";
 954 test t034 "034";
 955 test t035 "035";
 956 test t036 "036";
 957 test t037 "037";
 958 test t038 "038";
 959
 960 test t050 "050";
 961 test t051 "051";
 962 test t052 "052";
 963
 964 test t060 "060";
 965 test t061 "061";
 966
 967 test t070 "070";
 968 ()
 969 ;;