src/utils/lib/magic_magic.ml

   1 (* Copyright 2006 *)
   2 (*
   3     This file is part of mldonkey.
   4
   5     mldonkey is free software; you can redistribute it and/or modify
   6     it under the terms of the GNU General Public License as published by
   7     the Free Software Foundation; either version 2 of the License, or
   8     (at your option) any later version.
   9
  10     mldonkey is distributed in the hope that it will be useful,
  11     but WITHOUT ANY WARRANTY; without even the implied warranty of
  12     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13     GNU General Public License for more details.
  14
  15     You should have received a copy of the GNU General Public License
  16     along with mldonkey; if not, write to the Free Software
  17     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  18 *)
  19
  20 open Magiclib
  21
  22 module type MagicInfo =
  23 sig
  24   val magic_works : unit -> bool
  25
  26 (* magic_fileinfo <file> <return mime value true/false> <libmagic result, None for exceptions> *)
  27   val magic_fileinfo : string -> bool -> string option
  28 end
  29
  30 module MagicInfo : MagicInfo = struct
  31
  32   let magic_cookie () =
  33     Magiclib.create ?flags:(Some [Symlink;Preserve_atime]) []
  34   let magic_cookie_mime () =
  35     Magiclib.create ?flags:(Some [Mime;Symlink;Preserve_atime]) []
  36
  37   let magic_works () =
  38     try
  39       let cookie = magic_cookie_mime () in
  40       Magiclib.close cookie;
  41       true
  42     with e -> false
  43
  44   let magic_fileinfo file mime =
  45     try
  46       let cookie =
  47         if mime then magic_cookie_mime () else magic_cookie ()
  48       in
  49       try
  50         let fileinfo = Magiclib.file cookie file in
  51         Magiclib.close cookie;
  52         Some fileinfo
  53       with e ->
  54         Magiclib.close cookie;
  55         None
  56     with e -> None
  57
  58 end