| 1 | (* application/x-www-form-urlencoded bodies and Cookie headers. *) |
| 2 | |
| 3 | let hex c = |
| 4 | match c with |
| 5 | | '0' .. '9' -> Some (Char.code c - 48) |
| 6 | | 'a' .. 'f' -> Some (Char.code c - 87) |
| 7 | | 'A' .. 'F' -> Some (Char.code c - 55) |
| 8 | | _ -> None |
| 9 | |
| 10 | (* Decodes '+' as a space and %XX as a byte. A malformed escape is kept |
| 11 | as it is, the way browsers treat it. *) |
| 12 | let decode s = |
| 13 | let n = String.length s in |
| 14 | let b = Buffer.create n in |
| 15 | let rec go i = |
| 16 | if i < n then |
| 17 | match s.[i] with |
| 18 | | '+' -> Buffer.add_char b ' '; go (i + 1) |
| 19 | | '%' when i + 2 < n -> ( |
| 20 | match (hex s.[i + 1], hex s.[i + 2]) with |
| 21 | | Some h, Some l -> Buffer.add_char b (Char.chr ((h lsl 4) lor l)); go (i + 3) |
| 22 | | _ -> Buffer.add_char b '%'; go (i + 1)) |
| 23 | | c -> Buffer.add_char b c; go (i + 1) |
| 24 | in |
| 25 | go 0; |
| 26 | Buffer.contents b |
| 27 | |
| 28 | let parse body = |
| 29 | String.split_on_char '&' body |
| 30 | |> List.filter_map (fun pair -> |
| 31 | if pair = "" then None |
| 32 | else |
| 33 | match String.index_opt pair '=' with |
| 34 | | Some i -> |
| 35 | Some (decode (String.sub pair 0 i), |
| 36 | decode (String.sub pair (i + 1) (String.length pair - i - 1))) |
| 37 | | None -> Some (decode pair, "")) |
| 38 | |
| 39 | (* The value of the first cookie called [name] in a Cookie header. *) |
| 40 | let cookie header name = |
| 41 | String.split_on_char ';' header |
| 42 | |> List.find_map (fun part -> |
| 43 | match String.index_opt part '=' with |
| 44 | | Some i when String.trim (String.sub part 0 i) = name -> |
| 45 | Some (String.trim (String.sub part (i + 1) (String.length part - i - 1))) |
| 46 | | _ -> None) |
| 47 | |
| 48 | (* Unicode White_Space, plus U+FEFF (byte order mark), the set JavaScript's |
| 49 | String.prototype.trim removes. *) |
| 50 | let is_space u = |
| 51 | match Uchar.to_int u with |
| 52 | | 0x09 | 0x0A | 0x0B | 0x0C | 0x0D | 0x20 | 0x85 | 0xA0 | 0x1680 | 0x2028 | 0x2029 | 0x202F |
| 53 | | 0x205F | 0x3000 | 0xFEFF -> |
| 54 | true |
| 55 | | n -> n >= 0x2000 && n <= 0x200A |
| 56 | |
| 57 | (* Removes leading and trailing whitespace by that definition, so a title |
| 58 | of only non-breaking spaces trims to nothing. [s] is valid UTF-8. *) |
| 59 | let trim s = |
| 60 | let n = String.length s in |
| 61 | let rec go i first last = |
| 62 | if i >= n then (first, last) |
| 63 | else |
| 64 | let d = String.get_utf_8_uchar s i in |
| 65 | let next = i + Uchar.utf_decode_length d in |
| 66 | if is_space (Uchar.utf_decode_uchar d) then go next first last |
| 67 | else go next (if first < 0 then i else first) next |
| 68 | in |
| 69 | match go 0 (-1) 0 with |
| 70 | | -1, _ -> "" |
| 71 | | first, last -> String.sub s first (last - first) |
| 72 | |
amadan