Support SSL URLs when fetching HTML body.
This commit is contained in:
		
							parent
							
								
									155140fd70
								
							
						
					
					
						commit
						0f095addec
					
				
					 1 changed files with 21 additions and 4 deletions
				
			
		| 
						 | 
					@ -1,16 +1,33 @@
 | 
				
			||||||
open Http_client
 | 
					 | 
				
			||||||
open Str
 | 
					open Str
 | 
				
			||||||
 | 
					open Ssl
 | 
				
			||||||
 | 
					open Http_client.Convenience
 | 
				
			||||||
 | 
					open Https_client;;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					Ssl.init();
 | 
				
			||||||
 | 
					Http_client.Convenience.configure_pipeline
 | 
				
			||||||
 | 
					(fun p ->
 | 
				
			||||||
 | 
					  let ctx = Ssl.create_context Ssl.TLSv1 Ssl.Client_context in
 | 
				
			||||||
 | 
					  let tct = Https_client.https_transport_channel_type ctx in
 | 
				
			||||||
 | 
					  p # configure_transport Http_client.https_cb_id tct
 | 
				
			||||||
 | 
					)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(* Regexp required here *)
 | 
					(* Regexp required here *)
 | 
				
			||||||
let is_youtube_url url =
 | 
					let is_youtube_url url =
 | 
				
			||||||
  let regexp = Str.regexp "http://www.youtube.com/.+" in
 | 
					  let regexp = Str.regexp "https://www.youtube.com/.+" in
 | 
				
			||||||
  Str.string_match regexp url 0;;
 | 
					  Str.string_match regexp url 0
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					let get_body url =
 | 
				
			||||||
 | 
					  try Http_client.Convenience.http_get url with
 | 
				
			||||||
 | 
					  | Failure f -> "http fail lol"
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(* Maybe have a list of functions and
 | 
					(* Maybe have a list of functions and
 | 
				
			||||||
 * iter on all the items in the list *)
 | 
					 * iter on all the items in the list *)
 | 
				
			||||||
let evaluate str =
 | 
					let evaluate str =
 | 
				
			||||||
  match str with
 | 
					  match str with
 | 
				
			||||||
  | str when is_youtube_url str -> "that's youtube"
 | 
					  | str when is_youtube_url str -> get_body str
 | 
				
			||||||
  | _ -> str;;
 | 
					  | _ -> str;;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue