Commits

Anonymous committed 9e3f3cc

Uri.parse_params + tests

  • Participants
  • Parent commits 6c4f58f

Comments (0)

Files changed (5)

 value parse_host_portopt s =
   parse_gen Urilex.host_portopt s
 ;
+
+
+value parse_params s =
+  Urilex.query_params [] (Buffer.create 20) (Lexing.from_string s)
+;
 value parse_host_portopt :
   string -> option (Uri_type.host_kind * string * option int)
 ;
+
+(* parses query string "?a=b&c=d" (found in Uri_type.query without '?')
+   to list of ("key", "value") pairs, urldecoding them.  Key-value pairs
+   in query string are delimited by '&' or ';'.  When there is no '='
+   in key-value pair, it's assumed that value is an empty string.
+   Key-value pair "=val" is ignored instead of storing it as ("", "val").
+ *)
+value parse_params : string -> list (string * string)
+;

File src/urilex.mll

 {
 open Uri_type;;
 
-let failwith fmt = Printf.ksprintf failwith fmt
+let failwith fmt = Printf.ksprintf failwith fmt;;
+
+open Cd_All;;
+open Strings.Latin1;;
+
+let query_param_add k v acc =
+  if k = ""
+  then acc
+  else if List.Assoc.mem ~keq:String.eq k acc
+  then acc
+  else (k, v) :: acc
+;;
+
+let add_query_char_unescaped buf c =
+  let c0 = c.[0] in
+  let c =
+    if c0 = '%'
+    then begin
+      match String.(decode_hex_opt c.[1], decode_hex_opt c.[2]) with
+      | Some hi, Some lo -> Char.chr ((hi lsl 4) lor lo)
+      | None, (None | Some _) | Some _, None -> assert false
+    end else
+      c0
+  in
+  Buffer.add_char buf c
+;;
 }
 
 (* common part from rfc2616 *)
 let sub_delims    = [ '!' '$' '&' '\'' '(' ')'
                       '*' '+' ',' ';' '=' ]
 let pchar         = unreserved | pct_encoded | sub_delims | ':' | '@'
-let query         = ( pchar | '/' | '?' )*
+let query_char    = ( pchar | '/' | '?' )
+let query         = query_char*
 let fragment      = ( pchar | '/' | '?' )*
 
 let segment       = pchar*
 let g_cookie_octet =
   [ '\x21' '\x23'-'\x2B' '\x2D'-'\x3A' '\x3C'-'\x5B' '\x5D'-'\x7E' ]
 
+(* query params *)
+
+let qp_pair_delim = [ '&' ';' ]
 
 (* rules *)
 
 
 
 
+and query_params acc buf = parse
 
+  (* first rules have priority over query_char case *)
+  qp_pair_delim
+    { let k = Buffer.contents buf in
+      let acc = query_param_add k "" acc in
+      query_params acc buf lexbuf
+    }
 
+| '='
+    { let k = Buffer.contents buf in
+      Buffer.clear buf;
+      let v = query_param_value buf lexbuf in
+      Buffer.clear buf;
+      let acc = query_param_add k v acc in
+      query_params acc buf lexbuf
+    }
 
+| (* can't use query_char* because of "longest match" and unescaping *)
+  query_char
+    { let c = Lexing.lexeme lexbuf in
+      add_query_char_unescaped buf c;
+      query_params acc buf lexbuf
+    }
 
+| eof | ""
+    { let k = Buffer.contents buf in
+      List.rev (query_param_add k "" acc)
+    }
 
+and query_param_value buf = parse
 
+  qp_pair_delim | eof | ""
+    { Buffer.contents buf }
 
-
-
-
+| query_char
+    { let c = Lexing.lexeme lexbuf in
+      add_query_char_unescaped buf c;
+      query_param_value buf lexbuf
+    }

File tests/test_http_service.ml

 
 open Printf;
 
-value my_func segpath _rq =
-  let txt = sprintf "[%s]\n" &
-    String.concat " ; " &
-    List.map (sprintf "%S") &
-    segpath
+value my_func segpath rq =
+  let txt = sprintf "path: [%s]\nparams string: %s\nparams parsed: %s\n"
+    (String.concat " ; " &
+     List.map (sprintf "%S") &
+     segpath
+    )
+    (match rq.rq_uri.Uri_type.query with
+     [ None -> "None"
+     | Some str -> sprintf "Some %s" str
+     ]
+    )
+    (match rq.rq_uri.Uri_type.query with
+     [ None -> "None"
+     | Some str ->
+         let parsed = Uri.parse_params str in
+         sprintf "Some [%s]"
+           (String.concat " ; "
+              (List.map
+                 (fun (k, v) ->
+                    sprintf "%s = %s" k v
+                 )
+                 parsed
+              )
+           )
+     ]
+    )
   in
   I.return
   { rs_status_code = 200

File tests/test_uri.ml

 value () = Urilex.test1 lb;
 *)
 
+
+(* query params test *)
+
+value qp_tests =
+  [ ( "" , [] )
+  ; ( "\x00" , [] )
+  ; ( "abc" , [("abc", "")] )
+  ; ( "=def" , [] )
+  ; ( "a=b" , [("a", "b")] )
+  ; ( "a=b&c=d" , [("a", "b"); ("c", "d")] )
+  ; ( "a=b;c=d" , [("a", "b"); ("c", "d")] )
+  ; ( "a=b;c=d;a=e" , [("a", "b"); ("c", "d")] )
+  ; ( "a=b;c=d;c=e" , [("a", "b"); ("c", "d")] )
+  ; ( "a=b;c=" , [("a", "b"); ("c", "")] )
+  ; ( "a=b;c=\x00" , [("a", "b"); ("c", "")] )
+  ; ( "&&&;;;a=b;;&&c=d&&;" , [("a", "b"); ("c", "d")] )
+  ; ( "a=b&%D0%BA%D0%B8%D1%81%D0%B0=%D0%BA%D1%83%D0%BA%D1%83&c=d"
+    , [("a", "b"); ("киса", "куку"); ("c", "d")]
+    )
+  ]
+;
+
+value () =
+  List.iter
+    (fun (params, expected) ->
+       let got = Uri.parse_params params in
+       if got = expected
+       then ()
+       else
+         let msg = Printf.sprintf "params: %s, got: %s" params
+           (String.concat "; "
+              (List.map
+                 (fun (k, v) -> Printf.sprintf "%S=%S" k v)
+                 got
+              )
+           )
+         in failwith msg
+    )
+    qp_tests
+;
+value () = print_string "uri tests ok.\n"
+;