Simple MIME type guesser.

CHANGES.md

@@ -1,10 +1,13 @@
 0.3.0 (unreleased)
 =====
+
 - Add basic example.
 - Add optional custom parser argument to override the default parsing mechanism.
+- Add `MIME` module to guess MIME type of files.
 
 0.2.0 (2023-07-01)
 =====
+
 - Add support for FLAC.
 - id3v2: use "bpm" instead of "tempo".
 - id3v2: convert "tlen" to "duration".
@@ -14,4 +17,5 @@
 
 0.1.0 (2023-02-08)
 =====
+
 - Initial release.

examples/dune

@@ -13,6 +13,11 @@
  (modules dump)
  (libraries metadata))
 
+(executable
+ (name mimetype)
+ (modules mimetype)
+ (libraries metadata))
+
 (executable
  (name test)
  (modules test)

examples/mimetype

@@ -0,0 +1,2 @@
+#!/bin/sh
+dune exec --no-print-directory ./mimetype.exe -- $@

examples/mimetype.ml

@@ -0,0 +1,4 @@
+let () =
+  let fname = Sys.argv.(1) in
+  let mime = try Metadata.MIME.of_file fname with Not_found -> "unknown" in
+  print_endline mime

src/metadata.ml

@@ -1,5 +1,7 @@
 module CharEncoding = MetadataCharEncoding
 
+module MIME = MetadataMIME
+
 module Make (E : CharEncoding.T) = struct
   include MetadataBase
   module ID3v1 = MetadataID3v1

src/metadata.mli

@@ -3,6 +3,16 @@
 (** Functions for handling charset conversion. *)
 module CharEncoding = MetadataCharEncoding
 
+(** Guess the MIME type of a file. *)
+module MIME : sig
+  (** Guess the MIME type from file contents. Raises [Not_found] if none was
+      found. *)
+  val of_string : string -> string
+
+  (** Same as [of_string] but takes a file name as argument. *)
+  val of_file : string -> string
+end
+
 (** Generate metadata parsers given functions for converting charsets. *)
 module Make : functor (_ : CharEncoding.T) -> sig
   (** Raised when the metadata is not valid. *)

src/metadataMIME.ml

@@ -0,0 +1,33 @@
+(** Guess the mime-type of a file. *)
+
+let prefixes =
+  [
+    "ID3", "audio/mpeg";
+    "OggS", "audio/ogg";
+    "%PDF-", "application/pdf";
+    "\137PNG\013\010\026\010", "image/png";
+  ]
+
+let of_string s =
+  let ans = ref "" in
+  try
+    List.iter
+      (fun (prefix, mime) ->
+         if String.starts_with ~prefix s then
+           (
+             ans := mime;
+             raise Exit
+           )
+      ) prefixes;
+    raise Not_found
+  with
+  | Exit -> !ans
+
+let of_file fname =
+  let len = 10 in
+  let buf = Bytes.create len in
+  let ic = open_in fname in
+  let n = input ic buf 0 len in
+  let buf = if n = len then buf else Bytes.sub buf 0 n in
+  let s = Bytes.unsafe_to_string buf in
+  of_string s