(* $Id: index.ml,v 3.1 2002-02-12 21:18:21 stolpmann Exp $ * ---------------------------------------------------------------------- * *) (* Note: This file must be parsed with camlp4, and the syntax * extensions from wdialog-p4. *) open Wd_types let read_directory path = (* Return the file names of the directory "path" as string list *) let d = Unix.opendir path in let rec readrec () = try let name = Unix.readdir d in name :: readrec() with End_of_file -> [] in let names = readrec() in Unix.closedir d; names ;; let permissions kind perm = (* Compute a textual representation of file 'kind' and * permission mode 'perm' *) let first_letter = match kind with Unix.S_REG -> "-" | Unix.S_DIR -> "d" | Unix.S_CHR -> "c" | Unix.S_BLK -> "b" | Unix.S_LNK -> "l" | Unix.S_FIFO -> "p" | Unix.S_SOCK -> "s" in let s = ref "" in let p = ref perm in List.iter (fun letter -> begin if !p mod 2 = 1 then s := letter ^ !s else s := "-" ^ !s end; p := !p / 2) [ "x"; "w"; "r"; "x"; "w"; "r"; "x"; "w"; "r" ]; s := first_letter ^ !s; if (perm land 0o1000) > 0 then begin if !s.[9] = 'x' then !s.[9] <- 't' else !s.[9] <- 'T' end; if (perm land 0o2000) > 0 then begin if !s.[6] = 'x' then !s.[6] <- 's' else !s.[6] <- 'l' end; if (perm land 0o4000) > 0 then begin if !s.[6] = 'x' then !s.[6] <- 's' else !s.[6] <- 'S' end; !s ;; let owner uid = (* Converts the numerical uid to a string *) try (Unix.getpwuid uid).Unix.pw_name with Not_found -> string_of_int uid ;; let group gid = (* Converts the numerical gid to a string *) try (Unix.getgrgid gid).Unix.gr_name with Not_found -> string_of_int gid ;; let timestring t = (* Converts the time value t to a string *) let tm = Unix.localtime t in Printf.sprintf "%04d-%02d-%02d %02d:%02d:%02d" (tm.Unix.tm_year + 1900) (* Y2k-compliant *) (tm.Unix.tm_mon + 1) (tm.Unix.tm_mday) (tm.Unix.tm_hour) (tm.Unix.tm_min) (tm.Unix.tm_sec) ;; class directory universe name env = interactive object (self) inherit Wd_dialog.dialog universe name env method private prepare_show_listing() = let path = _[path:string] in let names = Sort.list (fun a b -> a >= b) (* >=: sic! *) (read_directory path) in (* file names *) (* Get all necessary templates: *) let t_directory_row = self # t_get "directory-row" in let t_filename = self # t_get "filename" in let t_filename_d = self # t_get "filename_d" in let filename_alist = ref [] in let fileperms_alist = ref [] in let fileowner_alist = ref [] in let filegroup_alist = ref [] in let filesize_alist = ref [] in let filemtime_alist = ref [] in let filesymlink_alist = ref [] in List.iter (fun name -> let path_name = Filename.concat path name in let s = Unix.stat path_name in let ls = Unix.lstat path_name in (* If the file is a directory, use t_filename_d instead of * t_filename: *) let t_fname = match s.Unix.st_kind with Unix.S_DIR -> t_filename_d | _ -> t_filename in filename_alist := (name, String_value (self # t_to_string (self # t_apply t_fname [ "value", self # t_text name ]))) :: !filename_alist; fileperms_alist := (name, String_value (permissions s.Unix.st_kind s.Unix.st_perm)) :: !fileperms_alist; fileowner_alist := (name, String_value(owner s.Unix.st_uid)) :: !fileowner_alist; filegroup_alist := (name, String_value (group s.Unix.st_uid)) :: !filegroup_alist; filesize_alist := (name, String_value (string_of_int s.Unix.st_size)) :: !filesize_alist; filemtime_alist := (name, String_value (timestring s.Unix.st_mtime)) :: !filemtime_alist; filesymlink_alist := (name, let t = match ls.Unix.st_kind with Unix.S_LNK -> self # t_apply_byname "symlink" [ "value", self # t_text (Unix.readlink path_name) ] | _ -> self # t_empty in String_value (self # t_to_string t) ) :: !filesymlink_alist; ) names; _[filename:alist] <- !filename_alist; _[fileperms:alist] <- !fileperms_alist; _[fileowner:alist] <- !fileowner_alist; _[filegroup:alist] <- !filegroup_alist; _[filesize:alist] <- !filesize_alist; _[filemtime:alist] <- !filemtime_alist; _[filesymlink:alist] <- !filesymlink_alist; method private handle_show_listing() = match self # event with Indexed_button ("goto_dir", dirname) -> begin match dirname with "." -> () | ".." -> let p = Filename.dirname _[path:string] in _[path:string] <- p | _ -> _[path:string] <- (Filename.concat _[path:string] dirname) end | _ -> () end ;; Wd_run_cgi.run ~reg:(fun universe -> universe # register "directory" (new directory) ) () ;; (* ====================================================================== * History: * * $Log: index.ml,v $ * Revision 3.1 2002-02-12 21:18:21 stolpmann * Initial revision at sourceforge * * Revision 1.2 2002/01/14 15:06:49 gerd * Updated to recent wd version. * * Revision 1.1 2000/04/13 17:43:05 gerd * Initial revision. * * *)