Skip to content
This repository
Newer
Older
100644 262 lines (218 sloc) 8.462 kb
fccc6851 »
2011-06-21 Initial open-source release
1 (*
2 Copyright © 2011 MLstate
3
4 This file is part of OPA.
5
6 OPA is free software: you can redistribute it and/or modify it under the
7 terms of the GNU Affero General Public License, version 3, as published by
8 the Free Software Foundation.
9
10 OPA is distributed in the hope that it will be useful, but WITHOUT ANY
11 WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
12 FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
13 more details.
14
15 You should have received a copy of the GNU Affero General Public License
16 along with OPA. If not, see <http://www.gnu.org/licenses/>.
17 *)
0d81e95e »
2011-06-28 [cleanup] open: remove Base in libnet
18
19 (* depends *)
20 module String = BaseString
21 module List = BaseList
22
fccc6851 »
2011-06-21 Initial open-source release
23 open Printf
24 open UserCompatType
25 open Rp_brow
26
27 module UCT = UserCompatType
28 module HSCp = HttpServerCore_parse
29 module HST = HttpServerTypes
30 module HSC = HttpServerCore
31
32 let ug = String.unsafe_get
33
34 (* Optimised version of String.is_contained_from *)
35 let icf p lp s ls n =
36 let fin = ls - lp in
37 let rec aux i =
38 if i > fin
39 then None
40 else
41 let rec aux0 p0 = p0 = lp or (let pp1 = i + p0 in pp1 < ls && ug p p0 = ug s pp1 && aux0 (succ p0)) in
42 if aux0 0 then Some i else aux (succ i)
43 in
44 aux n
45
46 let icfs plplst s ls n =
47 let rec aux = function
48 | (p,lp)::t ->
49 (match icf p lp s ls n with
50 | Some i -> Some i
51 | None -> aux t)
52 | [] -> None
53 in
54 aux plplst
55
461365b0 »
2011-06-23 [cleanup] Base.String: changed String.split to a much simpler String.…
56 let verlstch ch str = List.map int_of_string (String.slice ch str)
fccc6851 »
2011-06-21 Initial open-source release
57
58 let verlst = verlstch '.'
59 let verlstm = verlstch '-'
60
61 let regexp1 = Str.regexp "[ ]*\\([0-9\\.]+\\)[ ]*"
62 let browver str n =
63 if Str.string_match regexp1 str n
64 then verlst (Str.matched_group 1 str)
65 else []
66
67 let wkvar str strlen n =
68 match icf "Chrome/" 7 str strlen n with
69 | Some m -> UCT.Chrome (browver str (m+7))
70 | None ->
71 (match icf "Safari/" 7 str strlen n with
72 | Some m -> UCT.Safari (browver str (m+7))
73 | None -> UCT.UnidentifiedWV)
74
75 let regexp2 = Str.regexp " \\([0-9\\-]+\\);"
76 let wii str strlen n =
77 match icf "Nintendo Wii" 12 str strlen n with
78 | Some _ ->
79 (try
80 match Str.search_forward regexp2 str n with
81 | _ -> UCT.Wii (verlstm (Str.matched_group 1 str))
82 with Not_found -> UCT.Wii [])
83 | None -> UCT.UnidentifiedRE
84
85 let googlebot str strlen n =
86 match icf "Googlebot/" 10 str strlen n with
87 | Some m -> UCT.Bot (UCT.Googlebot (browver str (m+10)))
88 | None -> UCT.UnidentifiedRE
89
90 let regexp3 = Str.regexp " \\([0-9\\.]+\\))"
91 let psp str strlen n =
92 match icfs [("PSP",3);("PLAYSTATION 3",13)] str strlen n with
93 | Some _ ->
94 (try
95 match Str.search_forward regexp3 str n with
96 | _ -> PS (verlst (Str.matched_group 1 str))
97 with Not_found -> PS [])
98 | None -> UCT.UnidentifiedRE
99
100 let mspie str strlen n =
101 match icf "MSPIE" 5 str strlen n with
102 | Some m -> UCT.Trident (browver str (m+5))
103 | None -> UCT.UnidentifiedRE
104
105 let msie str strlen n =
106 match icf "MSIE" 4 str strlen n with
107 | Some m -> UCT.Trident (browver str (m+4))
108 | None -> UCT.UnidentifiedRE
109
110 let chk_specials slst str strlen n =
111 let rec aux = function
112 | (sp::rest) ->
113 let res = sp str strlen n in
114 if res = UCT.UnidentifiedRE
115 then aux rest
116 else res
117 | [] -> UCT.UnidentifiedRE
118 in
119 aux slst
120
121 let fn_Googlebot str strlen n _str =
122 match icf "/" 1 str strlen n with
123 | Some m -> UCT.Bot (UCT.Googlebot (browver str (m+1)))
124 | None ->
125 (match icf "-Image/" 7 str strlen n with
126 | Some m -> UCT.Bot (UCT.Googlebot (browver str (m+7)))
127 | None -> UCT.Bot (UCT.Googlebot []))
128
129 let fn_MSNBOT str strlen n _str =
130 match icf "/" 1 str strlen n with
131 | Some m -> UCT.Bot (UCT.Msnbot (browver str (m+1)))
132 | None -> UCT.Bot (UCT.Msnbot [])
133
134 let fn_msnbot str strlen n _str =
135 match icf "/" 1 str strlen n with
136 | Some m -> UCT.Bot (UCT.Msnbot (browver str (m+1)))
137 | None ->
138 (match icf "-media/" 7 str strlen n with
139 | Some m -> UCT.Bot (UCT.Msnbot (browver str (m+7)))
140 | None ->
141 (match icf "-webmaster/" 11 str strlen n with
142 | Some m -> UCT.Bot (UCT.Msnbot (browver str (m+11)))
143 | None -> UCT.Bot (UCT.Msnbot [])))
144
145 let fn_Yahoobot _str _strlen _n _str = UCT.Bot UCT.Yahoobot
146
147 let fn_YahooSeeker str strlen n _str = msie str strlen n
148
149 let fn_Mozilla str strlen n _str =
150 match icf "AppleWebKit/" 12 str strlen n with
151 | Some m -> UCT.Webkit (browver str (m+12),wkvar str strlen (m+12))
152 | None ->
153 (match icf "Gecko" 5 str strlen n with
154 | Some _ ->
155 (match icf "rv:" 3 str strlen n with
156 | Some l -> UCT.Gecko (browver str (l+3))
157 | None ->
158 (match icf "KHTML/" 6 str strlen n with
159 | Some l -> UCT.KHTML (browver str (l+6))
160 | None -> UCT.UnidentifiedRE))
161 | None -> chk_specials [msie; mspie; psp; googlebot] str strlen n)
162
163 let regexp4 = Str.regexp "(\\([0-9\\.]+\\))"
164 let fn_Nokia str _strlen n _str =
165 try
166 UCT.Nokia (match Str.search_forward regexp4 str n with
167 | _ -> verlst (Str.matched_group 1 str))
168 with Not_found -> UCT.Nokia []
169
170 let fn_Opera str strlen n _str =
171 match icf "Presto/" 7 str strlen n with
172 | Some m -> UCT.Presto (browver str (m+7))
173 | None ->
174 (match wii str strlen n with
175 | UCT.UnidentifiedRE -> UCT.Presto []
176 | re -> re)
177
178 let fn_Microsoft str strlen n _str =
179 match icf "Pocket Internet Explorer/" 25 str strlen n with
180 | Some m -> UCT.Trident (browver str (m+25))
181 | None -> UCT.UnidentifiedRE
182
183 let fn_MOT str strlen n _str = msie str strlen n
184
185 let fn_HTC str strlen n _str = msie str strlen n
186
187 let fn_Text name str strlen n _str =
188 match icf "/" 1 str strlen n with
189 | Some m -> UCT.Text (name,browver str (m+1))
190 | None -> UCT.UnidentifiedRE
191
192 let fn_Seamonkey str strlen n _str =
193 match icf "Gecko" 5 str strlen n with
194 | Some _ ->
195 (match icf "rv:" 3 str strlen n with (* <-- it doesn't actually have this *)
196 | Some l -> UCT.Gecko (browver str (l+3))
197 | None -> UCT.Gecko [])
198 | None -> UCT.Gecko []
199
200 let fn_Dillo str strlen n _str =
201 match icf "/" 1 str strlen n with
202 | Some m -> UCT.Dillo (browver str (m+1))
203 | None -> UCT.UnidentifiedRE
204
205 let fn_PSP str _strlen n _str =
206 try UCT.PS (match Str.search_forward regexp1 str n with
207 | _ -> verlst (Str.matched_group 1 str))
208 with Not_found -> UCT.PS []
209
210 let fn_Links str _strlen n _str =
211 try UCT.Text ("links",
212 match Str.search_forward regexp1 str n with
213 | _ -> verlst (Str.matched_group 1 str))
214 with Not_found -> UCT.Text ("links",[])
215
216 (* MUST be in same order as string list in mkrp.ml *)
217 let browrpfn = [| fn_Mozilla; fn_Nokia; fn_Opera; fn_Microsoft; fn_MOT; fn_HTC; (fn_Text "w3m"); fn_Seamonkey; fn_Dillo; fn_PSP;
218 (fn_Text "wget"); (fn_Text "lwp"); (fn_Text "lynx"); fn_Links; (fn_Text "amaya");
219 fn_Googlebot; fn_msnbot; fn_MSNBOT; fn_Yahoobot; fn_YahooSeeker |]
220
221 let search_forward_opt regexp str n =
222 try Some (Str.search_forward regexp str n)
223 with Not_found -> None
224
225 let regexp6 = Str.regexp "\\(X11\\|Windows\\|MSIE\\|Microsoft\\|Macintosh\\|iPhone\\|iPod\\|Symbian\\|J2ME\\|Wii\\|PSP\\|PLAYSTATION\\|BeOS\\|Konqueror\\)"
226 let get_environment str =
227 match search_forward_opt regexp6 str 0 with
228 | Some _pos ->
229 (match Str.matched_group 1 str with
230 | "X11" | "Konqueror" -> UCT.X11
231 | "Windows" | "MSIE" | "Microsoft" -> UCT.Windows
232 | "Macintosh" -> UCT.Macintosh
233 | "iPhone" | "iPod" -> UCT.IPhone
234 | "Symbian" -> UCT.Symbian
235 | "J2ME" -> UCT.J2ME
236 | "Wii" -> UCT.WII
237 | "PSP" | "PLAYSTATION" -> UCT.PLAYSTATION
238 | "BeOS" -> UCT.BeOS
239 | _ -> UCT.UnidentifiedEIE)
240 | None -> UCT.UnidentifiedEIE
241
242 let get_renderer str =
243 try Rp_brow.brow_call browrpfn str (String.length str)
244 with Rp_brow.ParseFail_brow -> UCT.UnidentifiedRE
245
246 let regexp7 = Str.regexp "\\([0-9]+\\)x\\([0-9]+\\)"
247 let get_resolution str n =
248 match search_forward_opt regexp7 str n with
249 | Some _pos ->
250 {width=int_of_string (Str.matched_group 1 str);
251 height=int_of_string (Str.matched_group 2 str)}
252 | None -> {width=(-1); height=(-1)}
253
254 let get_user_compat req =
255 match List.find_opt (function HSCp.User_Agent _ -> true | _ -> false) req.HST.request_header with
256 | Some (HSCp.User_Agent str) ->
257 let renderer = get_renderer str in
258 let environment = get_environment str in
259 Some { environment = environment; renderer = renderer }
260 | _ -> None
261
Something went wrong with that request. Please try again.