(* Libraries for HTTP clients and servers are listed at The Caml Hump: *) http://caml.inria.fr/cgi-bin/hump.en.cgi?browse=40 |
(* If you just want to read a URL as a string, Ocamlnet's "Convenience" interface to Http_client is as easy as it gets. For the more powerful general interface to Http_client, see the next example. *) #use "topfind";; #require "netclient";; open Http_client.Convenience let content = http_get url (*-----------------------------*) #!/usr/bin/ocaml (* titlebytes - find the title and size of documents *) #use "topfind";; #require "str";; #require "netclient";; let raw_url = Sys.argv.(1) let url = Neturl.parse_url raw_url let () = Printf.printf "%s =>\n\t%!" (Neturl.string_of_url url); let call = new Http_client.get (Neturl.string_of_url url) in call#set_req_header "User-Agent" "Schmozilla/v9.14 Platinum"; call#set_req_header "Referer" "http://wizard.yellowbrick.oz"; let pipeline = new Http_client.pipeline in pipeline#add call; pipeline#run (); match call#status with | `Successful -> let content = call#get_resp_body () in let bytes = String.length content in let count = ref 0 in String.iter (function '\n' -> incr count | _ -> ()) content; let regexp = Str.regexp_case_fold ".*<title>\\([^<]*\\)</title>.*" in let title = try (ignore (Str.search_forward regexp content 0); Str.matched_group 1 content) with Not_found -> "(untitled)" in let title = Str.global_replace (Str.regexp "\\(^[\n\r\t ]+\\)\\|\\([\n\r\t ]+$\\)") "" title in Printf.printf "%s (%d lines, %d bytes)\n" title !count bytes | `Client_error -> Printf.eprintf "Client error: %d %s\n" call#response_status_code call#response_status_text | `Http_protocol_error e -> Printf.eprintf "HTTP protocol error: %s\n" (Printexc.to_string e) | `Redirection -> Printf.eprintf "Redirection\n" | `Server_error -> Printf.eprintf "Server error\n" | `Unserved -> assert false |
#use "topfind";; #require "netclient";; open Http_client.Convenience (* Submit a form using GET. *) let url = "http://www.perl.com/cgi-bin/cpan_mod?module=DB_File&readme=1" let content = http_get url (* Submit a form using POST. Since we need to follow a redirect here, we can't use the "Convenience" methods. *) let url = "http://www.perl.com/cgi-bin/cpan_mod" let params = ["module", "DB_File"; "readme", "1"] let () = let call = new Http_client.post url params in call#set_redirect_mode Http_client.Redirect; let pipeline = new Http_client.pipeline in pipeline#add call; pipeline#run () let content = call#response_body#value (* GET parameters can be URL encoded with Netencoding.Url.encode. *) let arg = "\"this isn't <EASY> & <FUN>\"" Netencoding.Url.encode arg (* - : string = "%22this+isn%27t+%3CEASY%3E+%26+%3CFUN%3E%22" *) Netencoding.Url.encode ~plus:false arg (* - : string = "%22this%20isn%27t%20%3CEASY%3E%20%26%20%3CFUN%3E%22" *) (* To use a proxy, either set the "http_proxy" environment variable and call "set_proxy_from_environment" on the pipeline (done automatically for the "Convenience" methods) or set the proxy host and port using the "set_proxy" method: *) let () = pipeline#set_proxy "localhost" 3128 |
(* The Nethtml library, part of Ocamlnet, can parse arbitrary HTML from files and web pages. *) #use "topfind";; #require "netstring";; open Nethtml (* Define a function to walk through all the elements in a document and accumulate the results of a user-supplied function for each element. This is known as a "fold" in functional programming. *) let rec fold_elements f accu = function | Element (_, _, children) as element -> let accu = List.fold_right (fun child accu -> fold_elements f accu child) children accu in f accu element | other -> accu (* Define a type for links so we can tell anchors and images apart. *) type link = A of string | IMG of string (* Using fold_elements, define a function that collects the URLs from all the "a" and "img" tags. *) let find_links elements = List.flatten (List.map (fold_elements (fun accu element -> match element with | Element ("a", attribs, _) -> (try A (List.assoc "href" attribs) :: accu with Not_found -> accu) | Element ("img", attribs, _) -> (try IMG (List.assoc "src" attribs) :: accu with Not_found -> accu) | _ -> accu) []) elements) (* Parse an HTML file. *) let elements = parse (new Netchannels.input_channel (open_in filename)) (* Print the links we found. *) let () = List.iter (function | A href -> Printf.printf "ANCHOR: %s\n" href | IMG src -> Printf.printf "IMAGE: %s\n" src) (find_links elements) (*-----------------------------*) #!/usr/bin/ocaml (* xurl - extract unique, sorted list of links from URL *) #use "topfind";; #require "netclient";; open Http_client.Convenience open Nethtml let rec fold_elements f accu = function | Element (_, _, children) as element -> let accu = List.fold_right (fun child accu -> fold_elements f accu child) children accu in f accu element | other -> accu type link = A of string | IMG of string let find_links elements = List.flatten (List.map (fold_elements (fun accu element -> match element with | Element ("a", attribs, _) -> (try A (List.assoc "href" attribs) :: accu with Not_found -> accu) | Element ("img", attribs, _) -> (try IMG (List.assoc "src" attribs) :: accu with Not_found -> accu) | _ -> accu) []) elements) let base_url = Sys.argv.(1) let elements = parse (new Netchannels.input_string (http_get base_url)) let url_syntax = Hashtbl.find Neturl.common_url_syntax "http" let url_syntax = {url_syntax with Neturl.url_enable_fragment = Neturl.Url_part_allowed} let url_syntax = Neturl.partial_url_syntax url_syntax module StringSet = Set.Make(String) let () = StringSet.iter print_endline (List.fold_left (fun accu s -> try StringSet.add (Neturl.string_of_url (Neturl.apply_relative_url (Neturl.url_of_string url_syntax base_url) (Neturl.url_of_string url_syntax s))) accu with Neturl.Malformed_URL -> Printf.eprintf "Malformed URL: %s\n%!" s; accu) StringSet.empty (List.map (function | A href -> href | IMG src -> src) (find_links elements))) |
#!/usr/bin/ocaml (* text2html - trivial html encoding of normal text *) #use "topfind";; #require "str";; #require "netstring";; let line_stream_of_channel channel = Stream.from (fun _ -> try Some (input_line channel) with End_of_file -> None) let paragraph_stream_of_channel channel = let lines = line_stream_of_channel channel in let rec next para_lines i = match Stream.peek lines, para_lines with | None, [] -> None | Some "", [] -> Stream.junk lines; next para_lines i | Some "", _ | None, _ -> Some (String.concat "\n" (List.rev para_lines)) | Some line, _ -> Stream.junk lines; next (line :: para_lines) i in Stream.from (next []) let chop s = if s = "" then s else String.sub s 0 (String.length s - 1);; let substitutions = [ (* embedded URL (good) or guessed URL (bad) *) Str.regexp "\\(<URL:[^>]+>\\)\\|\\(http:[^ \n\r\t]+\\)", (fun s -> let s = if s.[0] = '<' then String.sub s 5 (String.length s - 6) else s in [Nethtml.Element ("a", ["href", s], [Nethtml.Data s])]); (* this is *bold* here *) Str.regexp "\\*[^*]+\\*", (fun s -> [Nethtml.Element ("strong", [], [Nethtml.Data s])]); (* this is _italics_ here *) Str.regexp "_[^ _]+_", (fun s -> [Nethtml.Element ("em", [], [Nethtml.Data s])]); ] let substitute regexp func data = List.flatten (List.map (function | Str.Text s -> [Nethtml.Data s] | Str.Delim s -> func s) (Str.full_split regexp data)) let rec map_data f list = List.flatten (List.map (function | Nethtml.Data data -> f data | Nethtml.Element (name, attrs, children) -> [Nethtml.Element (name, attrs, map_data f children)]) list) let text2html text = (* Create the initial HTML tree. *) let html = [Nethtml.Data text] in (* Split text into lines. *) let html = List.flatten (List.map (function | Nethtml.Data data -> List.map (fun line -> Nethtml.Data (line ^ "\n")) ("" :: Str.split (Str.regexp "\n") data) | Nethtml.Element _ as e -> [e]) html) in (* Perform inline substitutions. *) let html = List.fold_right (fun (regexp, func) -> map_data (substitute regexp func)) substitutions html in (* Add line breaks to quoted text. *) let html = List.flatten (List.map (function | Nethtml.Data line when line.[0] = '>' -> [Nethtml.Data (chop line); Nethtml.Element ("br", [], []); Nethtml.Data "\n"] | Nethtml.Data line -> [Nethtml.Data line] | Nethtml.Element _ as e -> [e]) html) in (* Return the finished document. *) html let buffer = Buffer.create 0 let channel = new Netchannels.output_buffer buffer let write html = Nethtml.write channel (Nethtml.encode html) let paragraphs = paragraph_stream_of_channel stdin (* Main loop *) let () = let first = ref true in Stream.iter (fun para -> if !first then first := false else write [Nethtml.Data "\n\n"]; (* Paragraphs beginning with whitespace are wrapped in <pre> *) let tag, body = if String.length para > 0 && String.contains " \t" para.[0] then "pre", [Nethtml.Data "\n"; Nethtml.Data para; (* indented verbatim *) Nethtml.Data "\n"] else "p", text2html para in (* add paragraph tag *) write [Nethtml.Element (tag, [], body)]) paragraphs; print_endline (Buffer.contents buffer) (*-----------------------------*) (* To format mail headers as a table, add the following just before the main loop. *) let () = let colon_delim = Str.regexp "[ \t]*:[ \t]*" in let continuation = Str.regexp "\n[ \t]+" in try let headers = Stream.next paragraphs in let headers = Str.global_replace continuation " " headers in let lines = Str.split (Str.regexp "\n") headers in let rows = List.flatten (List.map (fun line -> (* parse heading *) let key, value = match Str.bounded_split_delim colon_delim line 2 with | [key; value] -> key, value | _ -> "", line in [Nethtml.Element ("tr", [], [Nethtml.Element ("th", ["align", "left"], [Nethtml.Data key]); Nethtml.Element ("td", [], [Nethtml.Data value])]); Nethtml.Data "\n"]) lines) in write [Nethtml.Element ("table", [], Nethtml.encode rows); Nethtml.Element ("hr", [], []); Nethtml.Data "\n\n"] with Stream.Failure -> () |
#load "unix.cma";; let slurp_channel channel = let buffer_size = 4096 in let buffer = Buffer.create buffer_size in let string = String.create buffer_size in let chars_read = ref 1 in while !chars_read <> 0 do chars_read := input channel string 0 buffer_size; Buffer.add_substring buffer string 0 !chars_read done; Buffer.contents buffer let () = let process = Unix.open_process_in ("lynx -dump " ^ filename) in let ascii = slurp_channel process in ignore (Unix.close_process_in process); (* ... *) |
(* Nethtml can be used to safely isolate and extract the text elements from an HTML document. *) #use "topfind";; #require "netstring";; (* Load the HTML document. *) let channel = new Netchannels.input_channel (open_in filename) let html = Nethtml.parse channel let () = channel#close_in () (* Convert the document to plain text. *) let plain_text = let text = ref [] in let rec loop html = List.iter (function | Nethtml.Data s -> text := s :: !text | Nethtml.Element (_, _, children) -> loop children) html in loop (Nethtml.decode html); String.concat "" (List.rev !text) (*-----------------------------*) #!/usr/bin/ocaml (* htitle - get html title from URL *) #use "topfind";; #require "str";; #require "netclient";; open Http_client.Convenience let ltrim = Str.global_replace (Str.regexp "^[ \r\n\t\x00\x0B]*") "" let rtrim = Str.global_replace (Str.regexp "[ \r\n\t\x00\x0B]*$") "" let trim s = rtrim (ltrim s) let find_title html = let title = ref "" in let rec loop = function | Nethtml.Element ("title", _, Nethtml.Data data :: _) -> title := trim data; raise Exit | Nethtml.Element (_, _, children) -> List.iter loop children | _ -> () in (try List.iter loop html with Exit -> ()); !title let urls = if Array.length Sys.argv > 1 then List.tl (Array.to_list Sys.argv) else (Printf.eprintf "usage: %s url ...\n" Sys.argv.(0); exit 1) let () = List.iter (fun url -> print_string (url ^ ": "); try let res = http_get url in let ch = new Netchannels.input_string res in let html = Nethtml.parse ch in print_endline (find_title html) with | Http_client.Http_error (status, _) -> Printf.printf "%d %s\n" status (Nethttp.string_of_http_status (Nethttp.http_status_of_int status)) | Failure s -> print_endline s) urls |
#!/usr/bin/ocaml (* churl - check urls *) #use "topfind";; #require "netclient";; open Http_client.Convenience open Nethtml let rec fold_elements f accu = function | Element (_, _, children) as element -> let accu = List.fold_right (fun child accu -> fold_elements f accu child) children accu in f accu element | other -> accu type link = A of string | IMG of string let find_links elements = List.flatten (List.map (fold_elements (fun accu element -> match element with | Element ("a", attribs, _) -> (try A (List.assoc "href" attribs) :: accu with Not_found -> accu) | Element ("img", attribs, _) -> (try IMG (List.assoc "src" attribs) :: accu with Not_found -> accu) | _ -> accu) []) elements) let check_url url = Printf.printf " %s: %s\n%!" url (match (http_head_message url)#status with | `Successful -> "OK" | _ -> "BAD") let () = if Array.length Sys.argv <> 2 then (Printf.eprintf "usage: %s <start_url>\n" Sys.argv.(0); exit 1) let base_url = Sys.argv.(1) let elements = parse (new Netchannels.input_string (http_get base_url)) let url_syntax = Hashtbl.find Neturl.common_url_syntax "http" let url_syntax = {url_syntax with Neturl.url_enable_fragment = Neturl.Url_part_allowed} let url_syntax = Neturl.partial_url_syntax url_syntax module StringSet = Set.Make(String) let () = print_endline (base_url ^ ":"); StringSet.iter check_url (List.fold_left (fun accu s -> try StringSet.add (Neturl.string_of_url (Neturl.apply_relative_url (Neturl.url_of_string url_syntax base_url) (Neturl.url_of_string url_syntax s))) accu with Neturl.Malformed_URL -> Printf.eprintf "Malformed URL: %s\n%!" s; accu) StringSet.empty (List.map (function | A href -> href | IMG src -> src) (find_links elements))) |
#!/usr/bin/ocaml (* surl - sort URLs by their last modification date *) #use "topfind";; #require "netclient";; open Http_client.Convenience let dates = ref [] let () = try while true do let url = input_line stdin in let call = http_head_message url in let date = try Some (Netdate.parse (call#response_header#field "Last-Modified")) with Not_found -> None in dates := (date, url) :: !dates done with End_of_file -> () let () = List.iter (fun (date, url) -> Printf.printf "%-25s %s\n" (match date with | Some date -> Netdate.format "%a %b %d %H:%M:%S %Y" date | None -> "<NONE SPECIFIED>") url) (List.rev (List.sort compare !dates)) |
(* Template replacement using regular expressions from the Str module. *) #load "str.cma";; let slurp_channel channel = let buffer_size = 4096 in let buffer = Buffer.create buffer_size in let string = String.create buffer_size in let chars_read = ref 1 in while !chars_read <> 0 do chars_read := input channel string 0 buffer_size; Buffer.add_substring buffer string 0 !chars_read done; Buffer.contents buffer let slurp_file filename = let channel = open_in_bin filename in let result = try slurp_channel channel with e -> close_in channel; raise e in close_in channel; result let template_regexp = Str.regexp "%%\\([^%]+\\)%%" let template filename fillings = let text = slurp_file filename in let eval s = try Hashtbl.find fillings s with Not_found -> "" in let replace _ = eval (Str.matched_group 1 text) in Str.global_substitute template_regexp replace text (*-----------------------------*) (* Alternative implementation: a hand-written stream parser. This version avoids loading the whole template into memory, so it is efficient for large files. *) let template filename fillings = let f = open_in filename in try let buffer = Buffer.create (in_channel_length f) in let text = Stream.of_channel f in let eval s = try Hashtbl.find fillings s with Not_found -> "" in let rec search () = match Stream.peek text with | None -> () | Some '%' -> Stream.junk text; (match Stream.peek text with | None -> Buffer.add_char buffer '%'; search () | Some '%' -> Stream.junk text; replace "" | Some c -> Stream.junk text; Buffer.add_char buffer '%'; Buffer.add_char buffer c; search ()) | Some c -> Stream.junk text; Buffer.add_char buffer c; search () and replace acc = match Stream.peek text with | None -> Buffer.add_string buffer "%%"; Buffer.add_string buffer acc | Some '%' -> Stream.junk text; (match Stream.peek text with | None -> Buffer.add_string buffer "%%"; Buffer.add_string buffer acc; Buffer.add_char buffer '%' | Some '%' -> Stream.junk text; Buffer.add_string buffer (eval acc); search () | Some c -> Stream.junk text; replace (acc ^ "%" ^ (String.make 1 c))) | Some c -> Stream.junk text; replace (acc ^ (String.make 1 c)) in search (); close_in f; Buffer.contents buffer with e -> close_in f; raise e (*-----------------------------*) (* simple.template contains the following: <!-- simple.template for internal template() function --> <HTML><HEAD><TITLE>Report for %%username%%</TITLE></HEAD> <BODY><H1>Report for %%username%%</H1> %%username%% logged in %%count%% times, for a total of %%total%% minutes. *) let () = let fields = Hashtbl.create 3 in Hashtbl.replace fields "username" whats_his_name; Hashtbl.replace fields "count" (string_of_int login_count); Hashtbl.replace fields "total" (string_of_int minute_used); print_endline (template "simple.template" fields) (* Output: <!-- simple.template for internal template() function --> <HTML><HEAD><TITLE>Report for ramen</TITLE></HEAD> <BODY><H1>Report for ramen</H1> ramen logged in 42 times, for a total of 123 minutes. *) (*-----------------------------*) (* userrep - report duration of user logins using SQL database *) let process (cgi : Netcgi.cgi) = cgi#set_header ~content_type:"text/html" (); begin match cgi#argument_value "username" with | "" -> cgi#out_channel#output_string "No username" | user -> let db = Mysql.quick_connect ~user:"user" ~password:"seekritpassword" ~database:"connections" () in let sql = Printf.sprintf " SELECT COUNT(duration),SUM(duration) FROM logins WHERE username='%s' " (Mysql.escape user) in let result = Mysql.exec db sql in let default d = function Some x -> x | None -> d in let (count, total) = match Mysql.fetch result with | None -> ("0", "0") | Some row -> (default "0" row.(0), default "0" row.(1)) in (* template defined in the solution above *) let tpl = template "report.tpl" in let vars = Hashtbl.create 3 in Hashtbl.replace vars "username" user; Hashtbl.replace vars "count" count; Hashtbl.replace vars "total" total; cgi#out_channel#output_string (tpl vars) end; cgi#out_channel#commit_work () let () = let config = Netcgi.default_config in let buffered _ ch = new Netchannels.buffered_trans_channel ch in Netcgi_cgi.run ~config ~output_type:(`Transactional buffered) process |
#use "topfind";; #require "unix";; #require "netclient";; let mirror url file = let call = new Http_client.get url in begin try let mtime = (Unix.stat file).Unix.st_mtime in let date = Netdate.mk_mail_date mtime in call#set_req_header "If-Modified-Since" date with Unix.Unix_error _ -> () end; call#set_response_body_storage (`File (fun () -> file)); let pipeline = new Http_client.pipeline in pipeline#add call; pipeline#run (); if call#response_status = `Ok then (let date = Netdate.parse (call#response_header#field "Last-Modified") in Unix.utimes file 0.0 (Netdate.since_epoch date)); call#response_status |
#load "str.cma";; (* Parse "robots.txt" content from a stream of lines and return a list of user agents and a multi-valued hash table containing the rules for each user agent. *) let parse_robots = let module S = Set.Make(struct type t = string let compare = compare end) in (* Precompile regular expressions. *) let comments = Str.regexp "#.*" in let leading_white = Str.regexp "^[ \t]+" in let trailing_white = Str.regexp "[ \t\r]+$" in let colon_delim = Str.regexp "[ \t]*:[ \t]*" in fun stream -> let user_agent = ref "*" in let user_agents = ref (S.singleton "*") in let rules = Hashtbl.create 0 in Stream.iter (fun s -> let s = Str.replace_first comments "" s in let s = Str.replace_first leading_white "" s in let s = Str.replace_first trailing_white "" s in if String.length s > 0 then match Str.bounded_split_delim colon_delim s 2 with | ["User-agent"; value] -> (* Found a new User-agent. *) user_agent := value; user_agents := S.add value !user_agents | ["Sitemap"; value] -> (* Sitemaps are always global. *) Hashtbl.add rules "*" ("Sitemap", value) | [key; value] -> (* Found a rule for the current User-agent. *) Hashtbl.add rules !user_agent (key, value) | _ -> failwith s) stream; S.elements !user_agents, rules (* Produce a stream of lines from an input channel. *) let line_stream_of_channel channel = Stream.from (fun _ -> try Some (input_line channel) with End_of_file -> None) (* Produce a stream of lines from a string in memory. *) let line_stream_of_string string = Stream.of_list (Str.split (Str.regexp "\n") string) (*-----------------------------*) (* Use Ocamlnet to retrieve a "robots.txt" file and print its rules. *) #use "topfind";; #require "netclient";; open Http_client.Convenience let agents, rules = parse_robots (line_stream_of_string (http_get "http://sourceforge.net/robots.txt")) let () = List.iter (fun agent -> Printf.printf "User-agent: %s\n" agent; List.iter (fun (key, value) -> Printf.printf "\t%s: %s\n" key value) (Hashtbl.find_all rules agent)) agents |
(* Use the Weblogs library by Richard Jones: http://merjis.com/developers/weblogs You will also need the HostIP library: http://merjis.com/developers/hostip *) let log = Weblogs.import_file "/var/log/apache2/access.log" let () = Array.iter (fun {Weblogs.src_ip=client; remote_username=identuser; username=authuser; t=datetime; http_method=method'; full_url=url; http_version=protocol; rcode=status; size=bytes; (* Many more fields are available. See Weblogs API documentation for details. *) } -> (* ... *) ()) log |
#!/usr/bin/ocaml (* sumwww - summarize web server log activity *) #use "topfind";; #require "weblogs";; open Weblogs let file = if Array.length Sys.argv = 2 then Sys.argv.(1) else (Printf.eprintf "usage: %s <logfile>\n" Sys.argv.(0); exit 1) let format_date = CalendarLib.Printer.CalendarPrinter.sprint "%d/%b/%Y" let incr_hash hash key by = Hashtbl.replace hash key (try Hashtbl.find hash key + by with Not_found -> by) let count_hash hash = let count = ref 0 in Hashtbl.iter (fun _ _ -> incr count) hash; !count let add_hash dest src = Hashtbl.iter (incr_hash dest) src let lastdate = ref "" let count = ref 0 let posts = ref 0 let homes = ref 0 let bytesum = ref 0l let hosts = ref (Hashtbl.create 0) let whats = ref (Hashtbl.create 0) let sumcount = ref 0 let allposts = ref 0 let allhomes = ref 0 let bytesumsum = ref 0l let allhosts = ref (Hashtbl.create 0) let allwhats = ref (Hashtbl.create 0) (* display the tallies of hosts and URLs *) let write_report () = Printf.printf "%s %7d %8d %8d %7d %7d %14ld\n%!" !lastdate (count_hash !hosts) !count (count_hash !whats) !posts !homes !bytesum; (* add to summary data *) sumcount := !sumcount + !count; bytesumsum := Int32.add !bytesumsum !bytesum; allposts := !allposts + !posts; allhomes := !allhomes + !homes; (* reset daily data *) count := 0; posts := 0; homes := 0; bytesum := 0l; add_hash !allhosts !hosts; add_hash !allwhats !whats; Hashtbl.clear !hosts; Hashtbl.clear !whats (* read log file and tally hits from the host and to the URL *) let daily_logs () = let log = import_file file in print_endline " Date Hosts Accesses Unidocs POST Home Bytes"; print_endline "----------- ------- -------- -------- ------- ------- --------------"; Array.iter (fun row -> let date = format_date row.t in let host = row.src_ip in let what = row.url in let post = row.http_method = POST in let home = what = "/" in let bytes = match row.size with Some n -> n | None -> 0 in if !lastdate = "" then lastdate := date; if !lastdate <> date then write_report (); lastdate := date; incr count; if post then incr posts; if home then incr homes; incr_hash !hosts host 1; incr_hash !whats what 1; bytesum := Int32.add !bytesum (Int32.of_int bytes)) log; if !count > 0 then write_report () let summary () = lastdate := "Grand Total"; count := !sumcount; bytesum := !bytesumsum; hosts := !allhosts; posts := !allposts; whats := !allwhats; homes := !allhomes; write_report () let () = daily_logs (); summary (); exit 0 (*-----------------------------*) #!/usr/bin/ocaml (* aprept - report on Apache logs *) #use "topfind";; #require "weblogs";; open Weblogs let file = if Array.length Sys.argv = 2 then Sys.argv.(1) else (Printf.eprintf "usage: %s <logfile>\n" Sys.argv.(0); exit 1) let log = import_file file let conn = HostIP.connection () let incr_hash hash key by = Hashtbl.replace hash key (try Hashtbl.find hash key + by with Not_found -> by) let report_countries () = let total = ref 0 in let countries = Hashtbl.create 0 in Array.iter (fun row -> let country = match HostIP.get_country_name conn row.src_ip with | Some country -> country | None -> "UNKNOWN" in incr_hash countries country 1; incr total) log; let country_records = ref [] in Hashtbl.iter (fun country count -> country_records := (count, country) :: !country_records) countries; print_endline "Domain Records"; print_endline "==============================="; List.iter (fun (count, country) -> Printf.printf "%18s %5d %5.2f%%\n%!" country count (float count *. 100. /. float !total)) (List.rev (List.sort compare !country_records)) let report_files () = let total = ref 0 in let totalbytes = ref 0l in let bytes = Hashtbl.create 0 in let records = Hashtbl.create 0 in Array.iter (fun row -> let file = row.url in let size = match row.size with Some n -> n | None -> 0 in incr_hash bytes file size; incr_hash records file 1; totalbytes := Int32.add !totalbytes (Int32.of_int size); incr total) log; let file_records = ref [] in Hashtbl.iter (fun file size -> let count = Hashtbl.find records file in file_records := (file, size, count) :: !file_records) bytes; print_endline "File Bytes Records"; print_endline "========================================================="; List.iter (fun (file, size, count) -> Printf.printf "%-22s %10d %5.2f%% %9d %5.2f%%\n%!" file size (float size *. 100. /. Int32.to_float !totalbytes) count (float count *. 100. /. float !total)) (List.sort compare !file_records) let () = report_countries (); print_newline (); report_files () |
#!/usr/bin/ocaml (* htmlsub - make substitutions in normal text of HTML files *) #use "topfind";; #require "str";; #require "netstring";; let usage () = Printf.eprintf "Usage: %s <from> <to> <file>...\n" Sys.argv.(0); exit 1 let from, to', files = match List.tl (Array.to_list Sys.argv) with | from :: to' :: files -> from, to', files | _ -> usage () let rec map_data f = function | Nethtml.Data data -> Nethtml.Data (f data) | Nethtml.Element (name, attribs, children) -> Nethtml.Element (name, attribs, List.map (map_data f) children) let regexp = Str.regexp_string from let buffer = Buffer.create 0 let out_channel = new Netchannels.output_buffer buffer let write html = Nethtml.write out_channel (Nethtml.encode html) let () = List.iter (fun file -> let in_channel = new Netchannels.input_channel (open_in file) in let html = Nethtml.decode (Nethtml.parse in_channel) in in_channel#close_in (); write (List.map (map_data (Str.global_replace regexp to')) html)) files; print_endline (Buffer.contents buffer) |
#!/usr/bin/ocaml (* hrefsub - make substitutions in <A HREF="..."> fields of HTML files *) #use "topfind";; #require "str";; #require "netstring";; let usage () = Printf.eprintf "Usage: %s <from> <to> <file>...\n" Sys.argv.(0); exit 1 let from, to', files = match List.tl (Array.to_list Sys.argv) with | from :: to' :: files -> from, to', files | _ -> usage () let rec map_attr tag attr f = function | Nethtml.Data _ as d -> d | Nethtml.Element (name, attribs, children) when tag = name && List.mem_assoc attr attribs -> let value = List.assoc attr attribs in Nethtml.Element (name, (attr, f value) :: List.remove_assoc attr attribs, List.map (map_attr tag attr f) children) | Nethtml.Element (name, attribs, children) -> Nethtml.Element (name, attribs, List.map (map_attr tag attr f) children) let regexp = Str.regexp_string from let buffer = Buffer.create 0 let out_channel = new Netchannels.output_buffer buffer let write html = Nethtml.write out_channel (Nethtml.encode html) let () = List.iter (fun file -> let in_channel = new Netchannels.input_channel (open_in file) in let html = Nethtml.decode (Nethtml.parse in_channel) in in_channel#close_in (); write (List.map (map_attr "a" "href" (Str.global_replace regexp to')) html)) files; print_endline (Buffer.contents buffer) |