Ocaml/FAQ/File Contents

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";;
span class="sy0"> - : Str.split_result list =
[Str.Text "3"; Str.Delim "+"; Str.Text "5"; Str.Delim "-"; Str.Text "2"]
 
# Pcre.split ~pat:"([+-])" "3+5-2";;
span class="sy0"> - : 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))