; Copyright (c) 2005,2006 by Peter Busser
; Mostly rewritten 2008 by Joerg F. Wittenberger
; This file has been released under the BSD licence. See magic.html for the
; licence text.


(declare
 (unit libmagic)
 (disable-interrupts)
 (emit-import-library libmagic)
 (foreign-declare #<<EOF
#include <magic.h>
EOF
))

(module
 libmagic
 (
  magic-open
  magic-load
  magic-error
  magic-buffer
  magic-file
  magic-close
  magic-setflags
  magic-errno
  magic-sanitize-mime-type

  mime-type-of-string

  MAGIC_NONE
  MAGIC_DEBUG
  MAGIC_SYMLINK	
  MAGIC_COMPRESS
  MAGIC_DEVICES
  MAGIC_MIME
  MAGIC_CONTINUE
  MAGIC_CHECK
  MAGIC_PRESERVE_ATIME
  MAGIC_RAW
  MAGIC_ERROR
  )
 (import scheme chicken foreign posix)

(define-foreign-variable %MAGIC_NONE int "MAGIC_NONE")
(define MAGIC_NONE %MAGIC_NONE)
(define-foreign-variable %MAGIC_DEBUG int "MAGIC_DEBUG")
(define MAGIC_DEBUG %MAGIC_DEBUG)
(define-foreign-variable %MAGIC_SYMLINK int "MAGIC_SYMLINK")
(define MAGIC_SYMLINK %MAGIC_SYMLINK)
(define-foreign-variable %MAGIC_COMPRESS int "MAGIC_COMPRESS")
(define MAGIC_COMPRESS %MAGIC_COMPRESS)
(define-foreign-variable %MAGIC_DEVICES int "MAGIC_DEVICES")
(define MAGIC_DEVICES %MAGIC_DEVICES)
(define-foreign-variable %MAGIC_MIME int "MAGIC_MIME")
(define MAGIC_MIME %MAGIC_MIME)
(define-foreign-variable %MAGIC_CONTINUE int "MAGIC_CONTINUE")
(define MAGIC_CONTINUE %MAGIC_CONTINUE)
(define-foreign-variable %MAGIC_CHECK int "MAGIC_CHECK")
(define MAGIC_CHECK %MAGIC_CHECK)
(define-foreign-variable %MAGIC_PRESERVE_ATIME int "MAGIC_PRESERVE_ATIME")
(define MAGIC_PRESERVE_ATIME %MAGIC_PRESERVE_ATIME)
(define-foreign-variable %MAGIC_RAW int "MAGIC_RAW")
(define MAGIC_RAW %MAGIC_RAW)
(define-foreign-variable %MAGIC_ERROR int "MAGIC_ERROR")
(define MAGIC_ERROR %MAGIC_ERROR)
(define-foreign-variable %MAGIC_NO_CHECK_APPTYPE int "MAGIC_NO_CHECK_APPTYPE")
(define MAGIC_NO_CHECK_APPTYPE %MAGIC_NO_CHECK_APPTYPE)
(define-foreign-variable %MAGIC_NO_CHECK_ASCII int "MAGIC_NO_CHECK_ASCII")
(define MAGIC_NO_CHECK_ASCII %MAGIC_NO_CHECK_ASCII)
(define-foreign-variable %MAGIC_NO_CHECK_COMPRESS int "MAGIC_NO_CHECK_COMPRESS")
(define MAGIC_NO_CHECK_COMPRESS %MAGIC_NO_CHECK_COMPRESS)
(define-foreign-variable %MAGIC_NO_CHECK_ELF int "MAGIC_NO_CHECK_ELF")
(define MAGIC_NO_CHECK_ELF %MAGIC_NO_CHECK_ELF)
(define-foreign-variable %MAGIC_NO_CHECK_FORTRAN int "MAGIC_NO_CHECK_FORTRAN")
(define MAGIC_NO_CHECK_FORTRAN %MAGIC_NO_CHECK_FORTRAN)
(define-foreign-variable %MAGIC_NO_CHECK_SOFT int "MAGIC_NO_CHECK_SOFT")
(define MAGIC_NO_CHECK_SOFT %MAGIC_NO_CHECK_SOFT)
(define-foreign-variable %MAGIC_NO_CHECK_TAR int "MAGIC_NO_CHECK_TAR")
(define MAGIC_NO_CHECK_TAR %MAGIC_NO_CHECK_TAR)
(define-foreign-variable %MAGIC_NO_CHECK_TOKENS int "MAGIC_NO_CHECK_TOKENS")
(define MAGIC_NO_CHECK_TOKENS %MAGIC_NO_CHECK_TOKENS)
(define-foreign-variable %MAGIC_NO_CHECK_TROFF int "MAGIC_NO_CHECK_TROFF")
(define MAGIC_NO_CHECK_TROFF %MAGIC_NO_CHECK_TROFF)

(define-foreign-type magic-t (pointer (struct "magic_set")))

(define magic-open
  (foreign-lambda magic-t "magic_open" int))

(define magic-load
  (foreign-lambda int "magic_load" magic-t (const c-string)))

(define magic-error
  (foreign-lambda c-string "magic_error" magic-t))

(define magic-file
  (foreign-lambda c-string "magic_file" magic-t (const c-string)))

(define (magic-buffer c s)
  ((foreign-lambda*
    c-string
    ((magic-t c) (scheme-object b) (int size))
    "return(magic_buffer(c, C_c_string(b), size));")
   c s (string-length s)))

(define magic-close
  (foreign-lambda void "magic_close" magic-t))

(define magic-setflags
  (foreign-lambda int "magic_setflags" magic-t int))

(define magic-errno
  (foreign-lambda int "magic_errno" magic-t))

;
; Sanitizes the mime-type provided by magic-file (with the MAGIC_MIME and
; MAGIC_SYMLINK flags set in magic-open). The mime-types stored in the
; file database sometimes do not contain useful information in which case
; this function provides an alternative. Or it contains additional garbage,
; in which case it strips the garbage.
;
(define (magic-sanitize-mime-type raw-mime-type path)
  (if raw-mime-type
    (if (string=? raw-mime-type "")
      "unknown"
      (if (directory? path)
	"directory"
	(car (string-split raw-mime-type ";,"))))
    (if (symbolic-link? path)
      "symlink"
      "unknown")))

(define magic-cookie #f)

(define (mime-type-of-string str)
  (if (not magic-cookie)
      (begin
	(set! magic-cookie (magic-open MAGIC_MIME))
	(magic-load magic-cookie #f)))
  (and magic-cookie (magic-buffer magic-cookie str)))

) ;; module libmagic