let () = try while true do let line = input_line datafile in let size = String.length line in Printf.printf "%d\n" size (* output size of line *) done with End_of_file -> () (*-----------------------------*) let line_stream_of_channel channel = Stream.from (fun _ -> try Some (input_line channel) with End_of_file -> None) let output_size line = Printf.printf "%d\n" (String.length line) (* output size of line *) let () = Stream.iter output_size (line_stream_of_channel datafile) (*-----------------------------*) let lines = let xs = ref [] in Stream.iter (fun x -> xs := x :: !xs) (line_stream_of_channel datafile); List.rev !xs (*-----------------------------*) 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 whole_file = slurp_file filename (*-----------------------------*) let () = (* Onetwothree *) List.iter (output_string handle) ["One"; "two"; "three"]; (* Sent to default output handle *) print_string "Baa baa black sheep\n" (*-----------------------------*) let buffer = String.make 4096 '\000' let rv = input handle buffer 0 4096 (* rv is the number of bytes read, *) (* buffer holds the data read *) (*-----------------------------*) #load "unix.cma";; let () = Unix.ftruncate descr length; Unix.truncate (Printf.sprintf "/tmp/%d.pid" (Unix.getpid ())) length (*-----------------------------*) let () = let pos = pos_in datafile in Printf.printf "I'm %d bytes from the start of datafile.\n" pos (*-----------------------------*) let () = seek_in in_channel pos; seek_out out_channel pos #load "unix.cma";; let () = Unix.lseek descr 0 Unix.SEEK_END; (* seek to the end *) Unix.lseek descr pos Unix.SEEK_SET; (* seek to pos *) Unix.lseek descr (-20) Unix.SEEK_CUR; (* seek back 20 bytes *) (*-----------------------------*) #load "unix.cma";; let () = let written = Unix.write datafile mystring 0 (String.length mystring) in let read = Unix.read datafile mystring 5 256 in if read <> 256 then Printf.printf "only read %d bytes, not 256\n" read (*-----------------------------*) #load "unix.cma";; let () = (* don't change position *) let pos = Unix.lseek handle 0 Unix.SEEK_CUR in (* ... *) () |
let () = let buffer = Buffer.create 16 in let rec loop () = let line = input_line chan in if line <> "" && line.[String.length line - 1] = '\\' then (Buffer.add_string buffer (String.sub line 0 (String.length line - 1)); loop ()) else Buffer.add_string buffer line; let line = Buffer.contents buffer in Buffer.clear buffer; (* process full record in line here *) loop () in try loop () with End_of_file -> () |
#load "unix.cma";; let () = let proc = Unix.open_process_in ("wc -l < " ^ file) in let count = int_of_string (input_line proc) in ignore (Unix.close_process_in proc); (* count now holds the number of lines read *) () (*-----------------------------*) let () = let count = ref 0 in let chan = open_in file in (try while true do ignore (input_line chan); incr count done with End_of_file -> close_in chan); (* !count now holds the number of lines read *) () (*-----------------------------*) #load "str.cma";; let () = let delim = Str.regexp "[ \n\r\t]*$" in let count = ref 0 in let in_para = ref false in let chan = open_in file in (try while true do if Str.string_match delim (input_line chan) 0 then in_para := false else begin if not !in_para then incr count; in_para := true end done with End_of_file -> close_in chan); (* !count now holds the number of paragraphs read *) () |
let word_stream_of_channel channel = (* Thanks to Mac Mason for figuring this out. *) let buffer = (Scanf.Scanning.from_channel channel) in Stream.from (fun count -> try match Scanf.bscanf buffer " %s " (fun x -> x) with | "" -> None | s -> Some s with End_of_file -> None) (*-----------------------------*) let () = Stream.iter (fun chunk -> (* do something with chunk *) ()) (word_stream_of_channel stdin) (*-----------------------------*) (* Make a word frequency count *) let seen = Hashtbl.create 0 let () = Stream.iter (fun word -> Hashtbl.replace seen word (try Hashtbl.find seen word + 1 with Not_found -> 1)) (word_stream_of_channel stdin) (* output hash in a descending numeric sort of its values *) let () = let words = ref [] in Hashtbl.iter (fun word _ -> words := word :: !words) seen; List.iter (fun word -> Printf.printf "%5d %s\n" (Hashtbl.find seen word) word) (List.sort (fun a b -> compare (Hashtbl.find seen b) (Hashtbl.find seen a)) !words) (*-----------------------------*) (* Line frequency count *) let line_stream_of_channel channel = Stream.from (fun _ -> try Some (input_line channel) with End_of_file -> None) let seen = Hashtbl.create 0 let () = Stream.iter (fun line -> Hashtbl.replace seen line (try Hashtbl.find seen line + 1 with Not_found -> 1)) (line_stream_of_channel stdin) let () = let lines = ref [] in Hashtbl.iter (fun line _ -> lines := line :: !lines) seen; List.iter (fun line -> Printf.printf "%5d %s\n" (Hashtbl.find seen line) line) (List.sort (fun a b -> compare (Hashtbl.find seen b) (Hashtbl.find seen a)) !lines) |
let lines = ref [] let () = try while true do lines := input_line chan :: !lines done with End_of_file -> () let () = List.iter (fun line -> (* do something with line *) ()) !lines |
#load "unix.cma";; let sometime = 1 let () = let chan = open_in file in while Sys.file_exists file do (try let line = input_line chan in (* ... *) () with End_of_file -> Unix.sleep sometime) done; close_in chan |
let () = Random.self_init (); let count = ref 1 in let line = ref "" in try while true do let next = input_line stdin in if Random.int !count < 1 then line := next; incr count done with End_of_file -> (* !line is the random line *) () |
(* assumes the fisher_yates_shuffle function from Chapter 4 *) let shuffle list = let array = Array.of_list list in fisher_yates_shuffle array; Array.to_list array let () = Random.self_init (); let lines = ref [] in (try while true do lines := (input_line input) :: !lines done with End_of_file -> ()); let reordered = shuffle !lines in List.iter (fun line -> output_string output line; output_char output '\n') reordered |
(* Read lines until the desired line number is found. *) let () = let line = ref "" in for i = 1 to desired_line_number do line := input_line handle done; print_endline !line (* Read lines into an array. *) let () = let lines = ref [] in (try while true do lines := input_line handle :: !lines done with End_of_file -> ()); let lines = Array.of_list (List.rev !lines) in let line = lines.(desired_line_number) in print_endline line (* Build an index file containing line offsets. *) let build_index data_file index_file = set_binary_mode_out index_file true; let offset = ref 0 in try while true do ignore (input_line data_file); output_binary_int index_file !offset; offset := pos_in data_file done with End_of_file -> flush index_file (* Read a line using the index file. *) let line_with_index data_file index_file line_number = set_binary_mode_in index_file true; let size = 4 in let i_offset = size * (line_number - 1) in seek_in index_file i_offset; let d_offset = input_binary_int index_file in seek_in data_file d_offset; input_line data_file (*-----------------------------*) #!/usr/bin/ocaml (* print_line-v1 - linear style *) let () = if Array.length Sys.argv <> 3 then (prerr_endline "usage: print_line FILENAME LINE_NUMBER"; exit 255); let filename = Sys.argv.(1) in let line_number = int_of_string Sys.argv.(2) in let infile = try open_in filename with Sys_error e -> (prerr_endline e; exit 255) in let line = ref "" in begin try for i = 1 to line_number do line := input_line infile done with End_of_file -> Printf.eprintf "Didn't find line %d in %s\n" line_number filename; exit 255 end; print_endline !line (*-----------------------------*) #!/usr/bin/ocaml (* print_line-v2 - index style *) #load "unix.cma";; (* build_index and line_with_index from above *) let () = if Array.length Sys.argv <> 3 then (prerr_endline "usage: print_line FILENAME LINE_NUMBER"; exit 255); let filename = Sys.argv.(1) in let line_number = int_of_string Sys.argv.(2) in let orig = try open_in filename with Sys_error e -> (prerr_endline e; exit 255) in (* open the index and build it if necessary *) (* there's a race condition here: two copies of this *) (* program can notice there's no index for the file and *) (* try to build one. This would be easily solved with *) (* locking *) let indexname = filename ^ ".index" in let idx = Unix.openfile indexname [Unix.O_CREAT; Unix.O_RDWR] 0o666 in build_index orig (Unix.out_channel_of_descr idx); let line = try line_with_index orig (Unix.in_channel_of_descr idx) line_number with End_of_file -> Printf.eprintf "Didn't find line %d in %s\n" line_number filename; exit 255 in print_endline line |
(* given "record" with field separated by "pattern", extract "fields". *) #load "str.cma";; let regexp = Str.regexp pattern let fields = Str.split_delim regexp record (* same as above using PCRE library, available at: http://www.ocaml.info/home/ocaml_sources.html#pcre-ocaml *) #directory "+pcre";; #load "pcre.cma";; let fields = Pcre.split ~pat:pattern record (*-----------------------------*) # Str.full_split (Str.regexp "[+-]") "3+5-2";; - : Str.split_result list = [Str.Text "3"; Str.Delim "+"; Str.Text "5"; Str.Delim "-"; Str.Text "2"] # Pcre.split ~pat:"([+-])" "3+5-2";; - : string list = ["3"; "+"; "5"; "-"; "2"] (*-----------------------------*) let fields = Str.split_delim (Str.regexp ":") record let fields = Str.split_delim (Str.regexp "[ \n\r\t]+") record let fields = Str.split_delim (Str.regexp " ") record let fields = Pcre.split ~pat:":" record let fields = Pcre.split ~pat:"\\s+" record let fields = Pcre.split ~pat:" " record |
#load "unix.cma";; let () = let descr = Unix.openfile file [Unix.O_RDWR] 0o666 in let in_channel = Unix.in_channel_of_descr descr in let position = ref 0 in let last_position = ref 0 in begin try while true do ignore (input_line in_channel); last_position := !position; position := pos_in in_channel; done with End_of_file -> () end; Unix.ftruncate descr !last_position; Unix.close descr |
set_binary_mode_in in_channel true set_binary_mode_out out_channel true (*-----------------------------*) let () = let gifname = "picture.gif" in let gif = open_in gifname in set_binary_mode_in gif true; (* now DOS won't mangle binary input from "gif" *) set_binary_mode_out stdout true; (* now DOS won't mangle binary output to "stdout" *) let buff = String.make 8192 '\000' in let len = ref (-1) in while !len <> 0 do len := input gif buff 0 8192; output stdout buff 0 !len done |
let () = let address = recsize * recno in seek_in fh address; really_input fh buffer 0 recsize (*-----------------------------*) let () = let address = recsize * (recno - 1) in (* ... *) () |
let () = let address = recsize * recno in seek_in in_channel address; let buffer = String.create recsize in really_input in_channel buffer 0 recsize; close_in in_channel; (* update fields, then *) seek_out out_channel address; output_string out_channel buffer; close_out out_channel (*-----------------------------*) #!/usr/bin/ocaml (* weekearly -- set someone's login date back a week *) #load "unix.cma";; let sizeof = 4 + 12 + 16 let user = if Array.length Sys.argv > 1 then Sys.argv.(1) else (try Sys.getenv "USER" with Not_found -> Sys.getenv "LOGNAME") let address = (Unix.getpwnam user).Unix.pw_uid * sizeof let () = let lastlog = open_in "/var/log/lastlog" in seek_in lastlog address; let line = String.make 12 ' ' in let host = String.make 16 ' ' in let time = input_binary_int lastlog in really_input lastlog line 0 12; really_input lastlog host 0 16; let buffer = String.create sizeof in really_input lastlog buffer 0 sizeof; close_in lastlog; let time = time - 24 * 7 * 60 * 60 in (* back-date a week *) let lastlog = open_out_gen [Open_wronly] 0o666 "/var/log/lastlog" in seek_out lastlog address; output_binary_int lastlog time; close_out lastlog |
let () = let in_channel = open_in_bin file in seek_in in_channel addr; let buffer = Buffer.create 0 in let ch = ref (input_char in_channel) in while !ch <> '\000' do Buffer.add_char buffer !ch; ch := input_char in_channel; done; close_in in_channel; let string = Buffer.contents buffer in print_endline string (*-----------------------------*) (* bgets - get a string from an address in a binary file *) open Printf let file, addrs = match Array.to_list Sys.argv with | _ :: file :: addrs when List.length addrs > 0 -> file, addrs | _ -> eprintf "usage: %s file addr ...\n" Sys.argv.(0); exit 0 let () = let in_channel = open_in_bin file in List.iter (fun addr -> let addr = int_of_string addr in seek_in in_channel addr; let buffer = Buffer.create 0 in let ch = ref (input_char in_channel) in while !ch <> '\000' do Buffer.add_char buffer !ch; ch := input_char in_channel; done; printf "%#x %#o %d \"%s\"\n" addr addr addr (Buffer.contents buffer)) addrs; close_in in_channel (*-----------------------------*) (* strings - pull strings out of a binary file *) #load "str.cma";; let find_strings = let pat = "[\040-\176\r\n\t ]" in let regexp = Str.regexp (pat ^ pat ^ pat ^ pat ^ "+") in fun f input -> List.iter (function Str.Delim string -> f string | _ -> ()) (Str.full_split regexp input) let file = try Sys.argv.(1) with Invalid_argument _ -> Printf.eprintf "usage: %s file\n" Sys.argv.(0); exit 0 let () = let in_channel = open_in_bin file in try while true do let buffer = Buffer.create 0 in let ch = ref (input_char in_channel) in while !ch <> '\000' do Buffer.add_char buffer !ch; ch := input_char in_channel; done; find_strings print_endline (Buffer.contents buffer) done with End_of_file -> close_in in_channel |
(* Using the Bitstring library by Richard W.M. Jones. http://code.google.com/p/bitstring/ *) let () = try while true do let bitstring = Bitstring.bitstring_of_chan_max file recordsize in let fields = unpack bitstring in (* ... *) () done with Match_failure _ -> () (*-----------------------------*) (* Layout based on /usr/include/bits/utmp.h for a Linux system. *) let recordsize = 384 let unpack bits = bitmatch bits with | { ut_type : 16 : littleendian; _ : 16; (* padding *) ut_pid : 32 : littleendian; ut_line : 256 : string; ut_id : 32 : littleendian; ut_user : 256 : string; ut_host : 2048 : string; ut_exit : 32 : littleendian; ut_session : 32 : littleendian; ut_tv_sec : 32 : littleendian; ut_tv_usec : 32 : littleendian; ut_addr_v6 : 128 : string } -> (ut_type, ut_pid, ut_line, ut_id, ut_user, ut_host, ut_exit, ut_session, ut_tv_sec, ut_tv_usec, ut_addr_v6) |
#load "str.cma";; let user_preferences = Hashtbl.create 0 let () = let comments = Str.regexp "#.*" in let leading_white = Str.regexp "^[ \t]+" in let trailing_white = Str.regexp "[ \t]+$" in let equals_delim = Str.regexp "[ \t]*=[ \t]*" 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 (* anything left? *) if String.length s > 0 then match Str.bounded_split_delim equals_delim s 2 with | [var; value] -> Hashtbl.replace user_preferences var value | _ -> failwith s) (* defined in this chapter's introduction *) (line_stream_of_channel config) (*-----------------------------*) (* load variables from ocaml source - toplevel scripts only *) #use ".progrc";; |
#load "unix.cma";; let () = try let {Unix.st_dev = dev; st_ino = ino; st_kind = kind; st_perm = perm; st_nlink = nlink; st_uid = uid; st_gid = gid; st_rdev = rdev; st_size = size; st_atime = atime; st_mtime = mtime; st_ctime = ctime} = Unix.stat filename in (* ... *) () with Unix.Unix_error (e, _, _) -> Printf.eprintf "no %s: %s\n" filename (Unix.error_message e); exit 0 (*-----------------------------*) let () = let info = try Unix.stat filename with Unix.Unix_error (e, _, _) -> Printf.eprintf "no %s: %s\n" filename (Unix.error_message e); exit 0 in if info.Unix.st_uid = 0 then Printf.printf "Superuser owns %s\n" filename; if info.Unix.st_atime > info.Unix.st_mtime then Printf.printf "%s has been read since it was written.\n" filename (*-----------------------------*) let is_safe path = let info = Unix.stat path in (* owner neither superuser nor me *) (* the real uid can be retrieved with Unix.getuid () *) if (info.Unix.st_uid <> 0) && (info.Unix.st_uid <> Unix.getuid ()) then false else (* check whether the group or other can write file. *) (* use 0o066 to detect either reading or writing *) if info.Unix.st_perm land 0o022 = 0 then true (* no one else can write this *) else if info.Unix.st_kind <> Unix.S_DIR then false (* non-directories aren't safe *) else if info.Unix.st_perm land 0o1000 <> 0 then true (* but directories with the sticky bit (0o1000) are *) else false (*-----------------------------*) let is_verysafe path = let rec loop path parent = if not (is_safe path) then false else if path <> parent then loop parent (Filename.dirname parent) else true in loop path (Filename.dirname path) |
(*pp camlp4o -I /path/to/bitstring bitstring.cma pa_bitstring.cmo *) (* tailwtmp - watch for logins and logouts; *) (* uses linux utmp structure, from utmp(5) *) let days = [| "Sun"; "Mon"; "Tue"; "Wed"; "Thu"; "Fri"; "Sat" |] let months = [| "Jan"; "Feb"; "Mar"; "Apr"; "May"; "Jun"; "Jul"; "Aug"; "Sep"; "Oct"; "Nov"; "Dec" |] let string_of_tm tm = Printf.sprintf "%s %s %2d %02d:%02d:%02d %04d" days.(tm.Unix.tm_wday) months.(tm.Unix.tm_mon) tm.Unix.tm_mday tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec (tm.Unix.tm_year + 1900) let trim_asciiz s = try String.sub s 0 (String.index s '\000') with Not_found -> s let () = let sizeof = 384 in let wtmp = open_in "/var/log/wtmp" in seek_in wtmp (in_channel_length wtmp); while true do let buffer = Bitstring.bitstring_of_chan_max wtmp sizeof in (bitmatch buffer with | { ut_type : 16 : littleendian; _ : 16; (* padding *) ut_pid : 32 : littleendian; ut_line : 256 : string; ut_id : 32 : littleendian; ut_user : 256 : string; ut_host : 2048 : string; ut_exit : 32 : littleendian; ut_session : 32 : littleendian; ut_tv_sec : 32 : littleendian; ut_tv_usec : 32 : littleendian; ut_addr_v6 : 128 : string } -> Printf.printf "%1d %-8s %-12s %10ld %-24s %-16s %5ld %-32s\n%!" ut_type (trim_asciiz ut_user) (trim_asciiz ut_line) ut_id (string_of_tm (Unix.localtime (Int32.to_float ut_tv_sec))) (trim_asciiz ut_host) ut_pid (Digest.to_hex ut_addr_v6) | { _ } -> ()); if pos_in wtmp = in_channel_length wtmp then Unix.sleep 1 done |
#!/usr/bin/ocaml (* tctee - clone that groks process tees *) #load "unix.cma";; let ignore_ints = ref false let append = ref false let unbuffer = ref false let nostdout = ref false let names = ref [] let () = Arg.parse [ "-a", Arg.Set append, "Append to output files"; "-i", Arg.Set ignore_ints, "Ignore interrupts"; "-u", Arg.Set unbuffer, "Unbuffered output"; "-n", Arg.Set nostdout, "No standard output"; ] (fun name -> names := name :: !names) (Printf.sprintf "Usage: %s [-a] [-i] [-u] [-n] [filenames] ..." Sys.argv.(0)); names := List.rev !names let fhs = Hashtbl.create 0 let status = ref 0 let () = if not !nostdout then (* always go to stdout *) Hashtbl.replace fhs stdout "standard output"; if !ignore_ints then List.iter (fun signal -> Sys.set_signal signal Sys.Signal_ignore) [Sys.sigint; Sys.sigterm; Sys.sighup; Sys.sigquit]; List.iter (fun name -> if name.[0] = '|' then Hashtbl.replace fhs (Unix.open_process_out (String.sub name 1 (String.length name - 1))) name else begin let mode = if !append then [Open_wronly; Open_creat; Open_append] else [Open_wronly; Open_creat; Open_trunc] in try Hashtbl.replace fhs (open_out_gen mode 0o666 name) name with Sys_error e -> Printf.eprintf "%s: couldn't open %s: %s\n%!" Sys.argv.(0) name e; incr status end) !names; begin try while true do let line = input_line stdin in Hashtbl.iter (fun fh name -> try output_string fh line; output_string fh "\n"; if !unbuffer then flush fh with Sys_error e -> Printf.eprintf "%s: couldn't write to %s: %s\n%!" Sys.argv.(0) name e; incr status) fhs done with End_of_file -> () end; Hashtbl.iter (fun fh name -> let close = if name.[0] = '|' then fun p -> ignore (Unix.close_process_out p) else close_out in try close fh with Sys_error e -> Printf.eprintf "%s: couldn't close %s: %s\n%!" Sys.argv.(0) name e; incr status) fhs; exit !status |
(* laston - find out when a given user last logged on *) #load "str.cma";; #load "unix.cma";; open Printf open Unix let lastlog = open_in "/var/log/lastlog" let sizeof = 4 + 12 + 16 let line = String.make 12 ' ' let host = String.make 16 ' ' let days = [| "Sun"; "Mon"; "Tue"; "Wed"; "Thu"; "Fri"; "Sat" |] let months = [| "Jan"; "Feb"; "Mar"; "Apr"; "May"; "Jun"; "Jul"; "Aug"; "Sep"; "Oct"; "Nov"; "Dec" |] let format_time time = let tm = localtime time in sprintf "%s %s %2d %02d:%02d:%02d %04d" days.(tm.tm_wday) months.(tm.tm_mon) tm.tm_mday tm.tm_hour tm.tm_min tm.tm_sec (tm.tm_year + 1900) let trim_asciiz s = try String.sub s 0 (String.index s '\000') with Not_found -> s let () = Array.iter (fun user -> try let u = try getpwuid (int_of_string user) with Failure _ -> getpwnam user in seek_in lastlog (u.pw_uid * sizeof); let time = input_binary_int lastlog in really_input lastlog line 0 12; really_input lastlog host 0 16; let line = trim_asciiz line in let host = trim_asciiz host in printf "%-8s UID %5d %s%s%s\n" u.pw_name u.pw_uid (if time <> 0 then format_time (float_of_int time) else "never logged in") (if line <> "" then " on " ^ line else "") (if host <> "" then " from " ^ host else "") with Not_found -> printf "no such uid %s\n" user) (Array.sub Sys.argv 1 (Array.length Sys.argv - 1)) |