+++ /dev/null
-(* $Id$
- * ----------------------------------------------------------------------
- *
- *)
-
-
-module Str = Netstring_str;;
-
-module Base64 = struct
- let b64_pattern plus slash =
- [| 'A'; 'B'; 'C'; 'D'; 'E'; 'F'; 'G'; 'H'; 'I'; 'J'; 'K'; 'L'; 'M';
- 'N'; 'O'; 'P'; 'Q'; 'R'; 'S'; 'T'; 'U'; 'V'; 'W'; 'X'; 'Y'; 'Z';
- 'a'; 'b'; 'c'; 'd'; 'e'; 'f'; 'g'; 'h'; 'i'; 'j'; 'k'; 'l'; 'm';
- 'n'; 'o'; 'p'; 'q'; 'r'; 's'; 't'; 'u'; 'v'; 'w'; 'x'; 'y'; 'z';
- '0'; '1'; '2'; '3'; '4'; '5'; '6'; '7'; '8'; '9'; plus; slash |];;
-
-
- let rfc_pattern = b64_pattern '+' '/';;
- let url_pattern = b64_pattern '-' '/';;
-
- let encode_with_options b64 equal s pos len linelen crlf =
- (* encode using "base64".
- * 'b64': The encoding table, created by b64_pattern.
- * 'equal': The character that should be used instead of '=' in the original
- * encoding scheme. Pass '=' to get the original encoding scheme.
- * s, pos, len, linelen: See the interface description of encode_substring.
- *)
- assert (Array.length b64 = 64);
- if len < 0 or pos < 0 or pos > String.length s or linelen < 0 then
- invalid_arg "Netencoding.Base64.encode_with_options";
- if pos + len > String.length s then
- invalid_arg "Netencoding.Base64.encode_with_options";
-
- let linelen =
- (linelen/4) * 4 in
-
- let l_t = if len = 0 then 0 else ((len - 1) / 3 + 1) * 4 in
- (* l_t: length of the result without additional line endings *)
-
- let l_t' =
- if linelen < 4 then
- l_t
- else
- if l_t = 0 then 0 else
- let n_lines = ((l_t - 1) / linelen) + 1 in
- l_t + n_lines * (if crlf then 2 else 1)
- in
- (* l_t': length of the result with CRLF or LF characters *)
-
- let t = String.make l_t' equal in
- let j = ref 0 in
- let q = ref 0 in
- for k = 0 to len / 3 - 1 do
- let p = pos + 3*k in
- (* p >= pos >= 0: this is evident
- * p+2 < pos+len <= String.length s:
- * Because k <= len/3-1
- * 3*k <= 3*(len/3-1) = len - 3
- * pos+3*k+2 <= pos + len - 3 + 2 = pos + len - 1 < pos + len
- * So it is proved that the following unsafe string accesses always
- * work.
- *)
- let bits = (Char.code (String.unsafe_get s (p)) lsl 16) lor
- (Char.code (String.unsafe_get s (p+1)) lsl 8) lor
- (Char.code (String.unsafe_get s (p+2))) in
- (* Obviously, 'bits' is a 24 bit entity (i.e. bits < 2**24) *)
- assert(!j + 3 < l_t');
- String.unsafe_set t !j (Array.unsafe_get b64 ( bits lsr 18));
- String.unsafe_set t (!j+1) (Array.unsafe_get b64 ((bits lsr 12) land 63));
- String.unsafe_set t (!j+2) (Array.unsafe_get b64 ((bits lsr 6) land 63));
- String.unsafe_set t (!j+3) (Array.unsafe_get b64 ( bits land 63));
- j := !j + 4;
- if linelen > 3 then begin
- q := !q + 4;
- if !q + 4 > linelen then begin
- (* The next 4 characters won't fit on the current line. So insert
- * a line ending.
- *)
- if crlf then begin
- t.[ !j ] <- '\013';
- t.[ !j+1 ] <- '\010';
- j := !j + 2;
- end
- else begin
- t.[ !j ] <- '\010';
- incr j
- end;
- q := 0;
- end;
- end;
- done;
- (* padding if needed: *)
- let m = len mod 3 in
- begin
- match m with
- 0 -> ()
- | 1 ->
- let bits = Char.code (s.[pos + len - 1]) in
- t.[ !j ] <- b64.( bits lsr 2);
- t.[ !j + 1 ] <- b64.( (bits land 0x03) lsl 4);
- j := !j + 4;
- q := !q + 4;
- | 2 ->
- let bits = (Char.code (s.[pos + len - 2]) lsl 8) lor
- (Char.code (s.[pos + len - 1])) in
- t.[ !j ] <- b64.( bits lsr 10);
- t.[ !j + 1 ] <- b64.((bits lsr 4) land 0x3f);
- t.[ !j + 2 ] <- b64.((bits lsl 2) land 0x3f);
- j := !j + 4;
- q := !q + 4;
- | _ -> assert false
- end;
-
- (* If required, add another line end: *)
-
- if linelen > 3 & !q > 0 then begin
- if crlf then begin
- t.[ !j ] <- '\013';
- t.[ !j+1 ] <- '\010';
- j := !j + 2;
- end
- else begin
- t.[ !j ] <- '\010';
- incr j
- end;
- end;
-
- t ;;
-
-
-
- let encode ?(pos=0) ?len ?(linelength=0) ?(crlf=false) s =
- let l = match len with None -> String.length s - pos | Some x -> x in
- encode_with_options rfc_pattern '=' s pos l linelength crlf;;
-
-
- let encode_substring s ~pos ~len ~linelength ~crlf =
- encode_with_options rfc_pattern '=' s pos len linelength crlf;;
-
-
- let url_encode ?(pos=0) ?len ?(linelength=0) ?(crlf=false) s =
- let l = match len with None -> String.length s - pos | Some x -> x in
- encode_with_options url_pattern '.' s pos l linelength crlf;;
-
-
- let decode_substring t ~pos ~len ~url_variant:p_url ~accept_spaces:p_spaces =
- if len < 0 or pos < 0 or pos > String.length t then
- invalid_arg "Netencoding.Base64.decode_substring";
- if pos + len > String.length t then
- invalid_arg "Netencoding.Base64.decode_substring";
-
- (* Compute the number of effective characters l_t in 't';
- * pad_chars: number of '=' characters at the end of the string.
- *)
- let l_t, pad_chars =
- if p_spaces then begin
- (* Count all non-whitespace characters: *)
- let c = ref 0 in
- let p = ref 0 in
- for i = pos to pos + len - 1 do
- match String.unsafe_get t i with
- (' '|'\t'|'\r'|'\n') -> ()
- | ('='|'.') as ch ->
- if ch = '.' & not p_url then
- invalid_arg "Netencoding.Base64.decode_substring";
- incr c;
- incr p;
- if !p > 2 then
- invalid_arg "Netencoding.Base64.decode_substring";
- for j = i+1 to pos + len - 1 do
- match String.unsafe_get t j with
- (' '|'\t'|'\r'|'\n'|'.'|'=') -> ()
- | _ ->
- (* Only another '=' or spaces allowed *)
- invalid_arg "Netencoding.Base64.decode_substring";
- done
- | _ -> incr c
- done;
- if !c mod 4 <> 0 then
- invalid_arg "Netencoding.Base64.decode_substring";
- !c, !p
- end
- else
- len,
- ( if len mod 4 <> 0 then
- invalid_arg "Netencoding.Base64.decode_substring";
- if len > 0 then (
- if String.sub t (len - 2) 2 = "==" or
- (p_url & String.sub t (len - 2) 2 = "..") then 2
- else
- if String.sub t (len - 1) 1 = "=" or
- (p_url & String.sub t (len - 1) 1 = ".") then 1
- else
- 0
- )
- else 0
- )
- in
-
- let l_s = (l_t / 4) * 3 - pad_chars in (* sic! *)
- let s = String.create l_s in
-
- let decode_char c =
- match c with
- 'A' .. 'Z' -> Char.code(c) - 65 (* 65 = Char.code 'A' *)
- | 'a' .. 'z' -> Char.code(c) - 71 (* 71 = Char.code 'a' - 26 *)
- | '0' .. '9' -> Char.code(c) + 4 (* -4 = Char.code '0' - 52 *)
- | '+' -> 62
- | '-' -> if not p_url then
- invalid_arg "Netencoding.Base64.decode_substring";
- 62
- | '/' -> 63
- | _ -> invalid_arg "Netencoding.Base64.decode_substring";
- in
-
- (* Decode all but the last quartet: *)
-
- let cursor = ref pos in
- let rec next_char() =
- match t.[ !cursor ] with
- (' '|'\t'|'\r'|'\n') ->
- if p_spaces then (incr cursor; next_char())
- else invalid_arg "Netencoding.Base64.decode_substring"
- | c ->
- incr cursor; c
- in
-
- if p_spaces then begin
- for k = 0 to l_t / 4 - 2 do
- let q = 3*k in
- let c0 = next_char() in
- let c1 = next_char() in
- let c2 = next_char() in
- let c3 = next_char() in
- let n0 = decode_char c0 in
- let n1 = decode_char c1 in
- let n2 = decode_char c2 in
- let n3 = decode_char c3 in
- let x0 = (n0 lsl 2) lor (n1 lsr 4) in
- let x1 = ((n1 lsl 4) land 0xf0) lor (n2 lsr 2) in
- let x2 = ((n2 lsl 6) land 0xc0) lor n3 in
- String.unsafe_set s q (Char.chr x0);
- String.unsafe_set s (q+1) (Char.chr x1);
- String.unsafe_set s (q+2) (Char.chr x2);
- done;
- end
- else begin
- (* Much faster: *)
- for k = 0 to l_t / 4 - 2 do
- let p = pos + 4*k in
- let q = 3*k in
- let c0 = String.unsafe_get t p in
- let c1 = String.unsafe_get t (p + 1) in
- let c2 = String.unsafe_get t (p + 2) in
- let c3 = String.unsafe_get t (p + 3) in
- let n0 = decode_char c0 in
- let n1 = decode_char c1 in
- let n2 = decode_char c2 in
- let n3 = decode_char c3 in
- let x0 = (n0 lsl 2) lor (n1 lsr 4) in
- let x1 = ((n1 lsl 4) land 0xf0) lor (n2 lsr 2) in
- let x2 = ((n2 lsl 6) land 0xc0) lor n3 in
- String.unsafe_set s q (Char.chr x0);
- String.unsafe_set s (q+1) (Char.chr x1);
- String.unsafe_set s (q+2) (Char.chr x2);
- done;
- cursor := pos + l_t - 4;
- end;
-
- (* Decode the last quartet: *)
-
- if l_t > 0 then begin
- let q = 3*(l_t / 4 - 1) in
- let c0 = next_char() in
- let c1 = next_char() in
- let c2 = next_char() in
- let c3 = next_char() in
-
- if (c2 = '=' & c3 = '=') or (p_url & c2 = '.' & c3 = '.') then begin
- let n0 = decode_char c0 in
- let n1 = decode_char c1 in
- let x0 = (n0 lsl 2) lor (n1 lsr 4) in
- s.[ q ] <- Char.chr x0;
- end
- else
- if (c3 = '=') or (p_url & c3 = '.') then begin
- let n0 = decode_char c0 in
- let n1 = decode_char c1 in
- let n2 = decode_char c2 in
- let x0 = (n0 lsl 2) lor (n1 lsr 4) in
- let x1 = ((n1 lsl 4) land 0xf0) lor (n2 lsr 2) in
- s.[ q ] <- Char.chr x0;
- s.[ q+1 ] <- Char.chr x1;
- end
- else begin
- let n0 = decode_char c0 in
- let n1 = decode_char c1 in
- let n2 = decode_char c2 in
- let n3 = decode_char c3 in
- let x0 = (n0 lsl 2) lor (n1 lsr 4) in
- let x1 = ((n1 lsl 4) land 0xf0) lor (n2 lsr 2) in
- let x2 = ((n2 lsl 6) land 0xc0) lor n3 in
- s.[ q ] <- Char.chr x0;
- s.[ q+1 ] <- Char.chr x1;
- s.[ q+2 ] <- Char.chr x2;
- end
-
- end;
-
- s ;;
-
-
-
- let decode ?(pos=0) ?len ?(url_variant=true) ?(accept_spaces=false) s =
- let l = match len with None -> String.length s - pos | Some x -> x in
- decode_substring s pos l url_variant accept_spaces;;
-
- let decode_ignore_spaces s =
- decode_substring s 0 (String.length s) true true;;
-
-
-end
-
-
-
-module QuotedPrintable = struct
-
- let encode_substring s ~pos ~len =
-
- if len < 0 or pos < 0 or pos > String.length s then
- invalid_arg "Netencoding.QuotedPrintable.encode_substring";
- if pos + len > String.length s then
- invalid_arg "Netencoding.QuotedPrintable.encode_substring";
-
- let rec count n i =
- if i < len then
- match String.unsafe_get s (pos+i) with
- ('\r'|'\n') ->
- count (n+1) (i+1)
- | ('\000'..'\031'|'\127'..'\255'|
- '!'|'"'|'#'|'$'|'@'|'['|']'|'^'|'\''|'{'|'|'|'}'|'~'|'=') ->
- count (n+3) (i+1)
- | ' ' ->
- (* Protect spaces only if they occur at the end of a line *)
- if i+1 < len then
- match s.[pos+i+1] with
- ('\r'|'\n') ->
- count (n+3) (i+1)
- | _ ->
- count (n+1) (i+1)
- else
- count (n+3) (i+1)
- | _ ->
- count (n+1) (i+1)
- else
- n
- in
-
- let l = count 0 0 in
- let t = String.create l in
-
- let hexdigit =
- [| '0'; '1'; '2'; '3'; '4'; '5'; '6'; '7';
- '8'; '9'; 'A'; 'B'; 'C'; 'D'; 'E'; 'F'; |] in
-
- let k = ref 0 in
-
- let add_quoted c =
- t.[ !k ] <- '=';
- t.[ !k+1 ] <- hexdigit.( Char.code c lsr 4 );
- t.[ !k+2 ] <- hexdigit.( Char.code c land 15 )
- in
-
- for i = 0 to len - 1 do
- match String.unsafe_get s i with
- ('\r'|'\n') as c ->
- String.unsafe_set t !k c;
- incr k
- | ('\000'..'\031'|'\127'..'\255'|
- '!'|'"'|'#'|'$'|'@'|'['|']'|'^'|'\''|'{'|'|'|'}'|'~'|'=') as c ->
- add_quoted c;
- k := !k + 3
- | ' ' ->
- (* Protect spaces only if they occur at the end of a line *)
- if i+1 < len then
- match s.[pos+i+1] with
- ('\r'|'\n') ->
- add_quoted ' ';
- k := !k + 3;
- | _ ->
- String.unsafe_set t !k ' ';
- incr k
- else begin
- add_quoted ' ';
- k := !k + 3;
- end
- | c ->
- String.unsafe_set t !k c;
- incr k
- done;
-
- t ;;
-
-
- let encode ?(pos=0) ?len s =
- let l = match len with None -> String.length s - pos | Some x -> x in
- encode_substring s pos l;;
-
-
-
- let decode_substring s ~pos ~len =
-
- if len < 0 or pos < 0 or pos > String.length s then
- invalid_arg "Netencoding.QuotedPrintable.decode_substring";
- if pos + len > String.length s then
- invalid_arg "Netencoding.QuotedPrintable.decode_substring";
-
- let decode_hex c =
- match c with
- '0'..'9' -> Char.code c - 48
- | 'A'..'F' -> Char.code c - 55
- | 'a'..'f' -> Char.code c - 87
- | _ ->
- invalid_arg "Netencoding.QuotedPrintable.decode_substring";
- in
-
- let rec count n i =
- if i < len then
- match String.unsafe_get s (pos+i) with
- '=' ->
- if i+1 = len then
- (* A '=' at EOF is ignored *)
- count n (i+1)
- else
- if i+1 < len then
- match s.[pos+i+1] with
- '\r' ->
- (* Official soft break *)
- if i+2 < len & s.[pos+i+2] = '\n' then
- count n (i+3)
- else
- count n (i+2)
- | '\n' ->
- (* Inofficial soft break *)
- count n (i+2)
- | _ ->
- if i+2 >= len then
- invalid_arg
- "Netencoding.QuotedPrintable.decode_substring";
- let _ = decode_hex s.[pos+i+1] in
- let _ = decode_hex s.[pos+i+2] in
- count (n+1) (i+3)
- else
- invalid_arg "Netencoding.QuotedPrintable.decode_substring"
- | _ ->
- count (n+1) (i+1)
- else
- n
- in
-
- let l = count 0 0 in
- let t = String.create l in
- let k = ref pos in
- let e = pos + len in
- let i = ref 0 in
-
- while !i < l do
- match String.unsafe_get s !k with
- '=' ->
- if !k+1 = e then
- (* A '=' at EOF is ignored *)
- ()
- else
- if !k+1 < e then
- match s.[!k+1] with
- '\r' ->
- (* Official soft break *)
- if !k+2 < e & s.[!k+2] = '\n' then
- k := !k + 3
- else
- k := !k + 2
- | '\n' ->
- (* Inofficial soft break *)
- k := !k + 2
- | _ ->
- if !k+2 >= e then
- invalid_arg
- "Netencoding.QuotedPrintable.decode_substring";
- let x1 = decode_hex s.[!k+1] in
- let x2 = decode_hex s.[!k+2] in
- t.[ !i ] <- Char.chr ((x1 lsl 4) lor x2);
- k := !k + 3;
- incr i
- else
- invalid_arg "Netencoding.QuotedPrintable.decode_substring"
- | c ->
- String.unsafe_set t !i c;
- incr k;
- incr i
- done;
-
- t ;;
-
-
- let decode ?(pos=0) ?len s =
- let l = match len with None -> String.length s - pos | Some x -> x in
- decode_substring s pos l;;
-
-end
-
-
-module Q = struct
-
- let encode_substring s ~pos ~len =
-
- if len < 0 or pos < 0 or pos > String.length s then
- invalid_arg "Netencoding.Q.encode_substring";
- if pos + len > String.length s then
- invalid_arg "Netencoding.Q.encode_substring";
-
- let rec count n i =
- if i < len then
- match String.unsafe_get s (pos+i) with
- | ('A'..'Z'|'a'..'z'|'0'..'9') ->
- count (n+1) (i+1)
- | _ ->
- count (n+3) (i+1)
- else
- n
- in
-
- let l = count 0 0 in
- let t = String.create l in
-
- let hexdigit =
- [| '0'; '1'; '2'; '3'; '4'; '5'; '6'; '7';
- '8'; '9'; 'A'; 'B'; 'C'; 'D'; 'E'; 'F'; |] in
-
- let k = ref 0 in
-
- let add_quoted c =
- t.[ !k ] <- '=';
- t.[ !k+1 ] <- hexdigit.( Char.code c lsr 4 );
- t.[ !k+2 ] <- hexdigit.( Char.code c land 15 )
- in
-
- for i = 0 to len - 1 do
- match String.unsafe_get s i with
- | ('A'..'Z'|'a'..'z'|'0'..'9') as c ->
- String.unsafe_set t !k c;
- incr k
- | c ->
- add_quoted c;
- k := !k + 3
- done;
-
- t ;;
-
-
- let encode ?(pos=0) ?len s =
- let l = match len with None -> String.length s - pos | Some x -> x in
- encode_substring s pos l;;
-
-
-
- let decode_substring s ~pos ~len =
-
- if len < 0 or pos < 0 or pos > String.length s then
- invalid_arg "Netencoding.Q.decode_substring";
- if pos + len > String.length s then
- invalid_arg "Netencoding.Q.decode_substring";
-
- let decode_hex c =
- match c with
- '0'..'9' -> Char.code c - 48
- | 'A'..'F' -> Char.code c - 55
- | 'a'..'f' -> Char.code c - 87
- | _ ->
- invalid_arg "Netencoding.Q.decode_substring";
- in
-
- let rec count n i =
- if i < len then
- match String.unsafe_get s (pos+i) with
- '=' ->
- if i+2 >= len then
- invalid_arg "Netencoding.Q.decode_substring";
- let _ = decode_hex s.[pos+i+1] in
- let _ = decode_hex s.[pos+i+2] in
- count (n+1) (i+3)
- | _ -> (* including '_' *)
- count (n+1) (i+1)
- else
- n
- in
-
- let l = count 0 0 in
- let t = String.create l in
- let k = ref pos in
- let e = pos + len in
- let i = ref 0 in
-
- while !i < l do
- match String.unsafe_get s !k with
- '=' ->
- if !k+2 >= e then
- invalid_arg "Netencoding.Q.decode_substring";
- let x1 = decode_hex s.[!k+1] in
- let x2 = decode_hex s.[!k+2] in
- t.[ !i ] <- Char.chr ((x1 lsl 4) lor x2);
- k := !k + 3;
- incr i
- | '_' ->
- String.unsafe_set t !i ' ';
- incr k;
- incr i
- | c ->
- String.unsafe_set t !i c;
- incr k;
- incr i
- done;
-
- t ;;
-
-
- let decode ?(pos=0) ?len s =
- let l = match len with None -> String.length s - pos | Some x -> x in
- decode_substring s pos l ;;
-
-end
-
-
-module Url = struct
- let hex_digits =
- [| '0'; '1'; '2'; '3'; '4'; '5'; '6'; '7';
- '8'; '9'; 'A'; 'B'; 'C'; 'D'; 'E'; 'F' |];;
-
- let to_hex2 k =
- (* Converts k to a 2-digit hex string *)
- let s = String.create 2 in
- s.[0] <- hex_digits.( (k lsr 4) land 15 );
- s.[1] <- hex_digits.( k land 15 );
- s ;;
-
-
- let of_hex1 c =
- match c with
- ('0'..'9') -> Char.code c - Char.code '0'
- | ('A'..'F') -> Char.code c - Char.code 'A' + 10
- | ('a'..'f') -> Char.code c - Char.code 'a' + 10
- | _ ->
- raise Not_found ;;
-
-
-
- let url_encoding_re =
- Str.regexp "[^A-Za-z0-9$_.!*'(),-]";;
-
- let url_decoding_re =
- Str.regexp "\\+\\|%..\\|%.\\|%";;
-
-
- let encode s =
- Str.global_substitute
- url_encoding_re
- (fun r _ ->
- match Str.matched_string r s with
- " " -> "+"
- | x ->
- let k = Char.code(x.[0]) in
- "%" ^ to_hex2 k
- )
- s ;;
-
-
- let decode s =
- let l = String.length s in
- Str.global_substitute
- url_decoding_re
- (fun r _ ->
- match Str.matched_string r s with
- | "+" -> " "
- | _ ->
- let i = Str.match_beginning r in
- (* Assertion: s.[i] = '%' *)
- if i+2 >= l then failwith "Cgi.decode";
- let c1 = s.[i+1] in
- let c2 = s.[i+2] in
- begin
- try
- let k1 = of_hex1 c1 in
- let k2 = of_hex1 c2 in
- String.make 1 (Char.chr((k1 lsl 4) lor k2))
- with
- Not_found ->
- failwith "Cgi.decode"
- end
- )
- s ;;
-
-end
-
-
-module Html = struct
-
- let eref_re =
- Str.regexp
- "&\\(#\\([0-9]+\\);\\|\\([a-zA-Z]+\\);\\)" ;;
- let unsafe_re = Str.regexp "[<>&\"\000-\008\011-\012\014-\031\127-\255]" ;;
-
- let etable =
- [ "lt", "<";
- "gt", ">";
- "amp", "&";
- "quot", "\"";
- (* Note: " is new in HTML-4.0, but it has been widely used
- * much earlier.
- *)
- "nbsp", "\160";
- "iexcl", "\161";
- "cent", "\162";
- "pound", "\163";
- "curren", "\164";
- "yen", "\165";
- "brvbar", "\166";
- "sect", "\167";
- "uml", "\168";
- "copy", "\169";
- "ordf", "\170";
- "laquo", "\171";
- "not", "\172";
- "shy", "\173";
- "reg", "\174";
- "macr", "\175";
- "deg", "\176";
- "plusmn", "\177";
- "sup2", "\178";
- "sup3", "\179";
- "acute", "\180";
- "micro", "\181";
- "para", "\182";
- "middot", "\183";
- "cedil", "\184";
- "sup1", "\185";
- "ordm", "\186";
- "raquo", "\187";
- "frac14", "\188";
- "frac12", "\189";
- "frac34", "\190";
- "iquest", "\191";
- "Agrave", "\192";
- "Aacute", "\193";
- "Acirc", "\194";
- "Atilde", "\195";
- "Auml", "\196";
- "Aring", "\197";
- "AElig", "\198";
- "Ccedil", "\199";
- "Egrave", "\200";
- "Eacute", "\201";
- "Ecirc", "\202";
- "Euml", "\203";
- "Igrave", "\204";
- "Iacute", "\205";
- "Icirc", "\206";
- "Iuml", "\207";
- "ETH", "\208";
- "Ntilde", "\209";
- "Ograve", "\210";
- "Oacute", "\211";
- "Ocirc", "\212";
- "Otilde", "\213";
- "Ouml", "\214";
- "times", "\215";
- "Oslash", "\216";
- "Ugrave", "\217";
- "Uacute", "\218";
- "Ucirc", "\219";
- "Uuml", "\220";
- "Yacute", "\221";
- "THORN", "\222";
- "szlig", "\223";
- "agrave", "\224";
- "aacute", "\225";
- "acirc", "\226";
- "atilde", "\227";
- "auml", "\228";
- "aring", "\229";
- "aelig", "\230";
- "ccedil", "\231";
- "egrave", "\232";
- "eacute", "\233";
- "ecirc", "\234";
- "euml", "\235";
- "igrave", "\236";
- "iacute", "\237";
- "icirc", "\238";
- "iuml", "\239";
- "eth", "\240";
- "ntilde", "\241";
- "ograve", "\242";
- "oacute", "\243";
- "ocirc", "\244";
- "otilde", "\245";
- "ouml", "\246";
- "divide", "\247";
- "oslash", "\248";
- "ugrave", "\249";
- "uacute", "\250";
- "ucirc", "\251";
- "uuml", "\252";
- "yacute", "\253";
- "thorn", "\254";
- "yuml", "\255";
- ] ;;
-
- let quick_etable =
- let ht = Hashtbl.create 50 in
- List.iter (fun (name,value) -> Hashtbl.add ht name value) etable;
- (* Entities to be decoded, but that must not be encoded: *)
- Hashtbl.add ht "apos" "'"; (* used in XML documents *)
- ht ;;
-
- let rev_etable =
- let a = Array.create 256 "" in
- List.iter (fun (name,value) ->
- a.(Char.code(value.[0])) <- "&" ^ name ^ ";") etable;
- for i = 0 to 8 do
- a.(i) <- "&#" ^ string_of_int i ^ ";"
- done;
- for i = 11 to 12 do
- a.(i) <- "&#" ^ string_of_int i ^ ";"
- done;
- for i = 14 to 31 do
- a.(i) <- "&#" ^ string_of_int i ^ ";"
- done;
- for i = 127 to 159 do
- a.(i) <- "&#" ^ string_of_int i ^ ";"
- done;
- a ;;
-
- let decode_to_latin1 s =
- Str.global_substitute
- eref_re
- (fun r _ ->
- let t = Str.matched_string r s in
- try
- let n = int_of_string(Str.matched_group r 2 s) in
- if n < 256 then
- String.make 1 (Char.chr n)
- else
- t
- with
- Not_found ->
- try
- let name = Str.matched_group r 3 s in
- try
- Hashtbl.find quick_etable name
- with
- Not_found ->
- t
- with
- Not_found -> assert false
- )
- s ;;
-
- let encode_from_latin1 s =
- Str.global_substitute
- unsafe_re
- (fun r _ ->
- let t = Str.matched_string r s in
- let i = Char.code (t.[0]) in
- rev_etable.(i)
- )
- s ;;
-end
-
-
-
-(* ======================================================================
- * History:
- *
- * $Log$
- * Revision 1.1 2000/11/17 09:57:27 lpadovan
- * Initial revision
- *
- * Revision 1.5 2000/06/25 22:34:43 gerd
- * Added labels to arguments.
- *
- * Revision 1.4 2000/06/25 21:15:48 gerd
- * Checked thread-safety.
- *
- * Revision 1.3 2000/03/03 17:03:16 gerd
- * Q encoding: CR and LF are quoted.
- *
- * Revision 1.2 2000/03/03 01:08:29 gerd
- * Added Netencoding.Html functions.
- *
- * Revision 1.1 2000/03/02 01:14:48 gerd
- * Initial revision.
- *
- *
- *)
projects / helm.git / blobdiff