WIP libmagic module for CLISP

link.sh

${MAKE-make} clisp-module \
  CC="${CC}" CPPFLAGS="${CPPFLAGS}" CFLAGS="${CFLAGS}" \
  CLISP_LINKKIT="$absolute_linkkitdir" CLISP="${CLISP}"
NEW_FILES="magic.o"
NEW_LIBS="$NEW_FILES -lmagic"
NEW_MODULES="magic"
TO_LOAD="magic"

magic.lisp

;;;; CLISP module providing access to libmagic.
(defpackage "MAGIC"
  (:use "COMMON-LISP" "FFI")
  (:export :magic_open
           :magic_close
           :magic_error
           :magic_errno
           :magic_file
           :magic_buffer
           :magic_setflags
           :magic_check
           :magic_compile
           :magic_load))

(ffi:default-foreign-language :stdc)

(in-package "MAGIC")

(c-lines "#include <magic.h>~%")
(def-c-type magic_t c-pointer)
(def-c-type size_t)
(def-call-out magic_open (:arguments (flags int))
  (:return-type magic_t)
  (:documentation "Create a magic cookie. NIL on error."))
(def-call-out magic_close (:arguments (cookie magic_t))
  (:documentation "Close database and deallocate any resources used."))
(def-call-out magic_error (:arguments (cookie magic_t))
  (:return-type c-string :none)
  (:documentation "Returns string describing last error, or NIL."))
(def-call-out magic_errno (:arguments (cookie magic_t))
  (:return-type int)
  (:documentation "Returns last operating system error (errno)."))
(def-call-out magic_descriptor (:arguments (cookie magic_t) (fd int))
  (:return-type c-string :none)
  (:documentation "Returns description of the contents of the descriptor.
NIL on error."))
(def-call-out magic_file (:arguments (cookie magic_t) (filename c-string :in))
  (:return-type c-string :none)
  (:documentation "Returns textual description of the contents of the file,
or stdin if NIL is passed. NIL on error."))
(def-call-out magic_buffer (:arguments (cookie magic_t)
                                       (buffer c-pointer)
                                       (length size_t))
  (:return-type c-string :none)
  (:documentation "Returns a textual description of the buffer."))
(def-call-out magic_setflags (:arguments (cookie magic_t) (flags int))
  (:return-type int)
  (:documentation "Sets the flags."))
(def-call-out magic_check (:arguments (cookie magic_t) (filename c-string :in))
  (:return-type int)
  (:documentation "Check the validity of the passed database, or the default
one if NIL is provided. 0 on success, -1 on failure."))
(def-call-out magic_compile (:arguments (cookie magic_t) (filename c-string :in))
  (:return-type int)
  (:documentation "Compile the passed database, or the default one if NIL is
provided. 0 on success, -1 on failure. Compiled files are named after the
basename of the database, with \".mgc\" appended."))
(def-call-out magic_list (:arguments (cookie magic_t) (filename c-string :in))
  (:return-type int)
  (:documentation "Dump all magic entries in a human readable format."))
(def-call-out magic_load (:arguments (cookie magic_t) (filename c-string :in))
  (:return-type int)
  (:documentation "Load the passed database, nor the default one if NIL is
provided. Must be done before any queries can be performed."))
(def-call-out magic_load_buffers (:arguments (cookie magic_t)
                                             (buffers (c-pointer c-pointer))
                                             (sizes (c-pointer size_t))
                                             (nbuffers size_t))
  (:return-type int)
  (:documentation "Load magic entries from the provided buffers. Usefull for
environments in which magic cannot access the filesystem."))
(def-call-out magic_getparam (:arguments (cookie magic_t)
                                         (param int)
                                         (value c-pointer))
  (:return-type int)
  (:documentation "Get limits related to the magic library."))
(def-call-out magic_setparam (:arguments (cookie magic_t)
                                         (param int)
                                         (value c-pointer))
  (:return-type int)
  (:documentation "Set limits related to the magic library."))
(def-call-out magic_version (:arguments)
  (:return-type int)
  (:documentation "Returns version of the shared library."))

(def-c-const MAGIC_VERSION
    (:documentation "Version this module is compiled against."))


;;; Flags that can be passed to magic_open
(def-c-const MAGIC_NONE
    (:documentation "No special handling."))
(def-c-const MAGIC_DEBUG
    (:documentation "Print debugging messages to stderr."))
(def-c-const MAGIC_SYMLINK
    (:documentation "Allow following symlinks."))
(def-c-const MAGIC_COMPRESS
    (:documentation "Allow unpacking of compressed files."))
(def-c-const MAGIC_DEVICES
    (:documentation "Allow opening of devices."))
(def-c-const MAGIC_MIME_TYPE
    (:documentation "Return MIME type strings instead of textual descriptions."))
(def-c-const MAGIC_MIME_ENCODING
    (:documentation "Return MIME encodings instead of textual descriptions."))
(def-c-const MAGIC_MIME
    (:documentation "Shorthand for MAGIC_MIME_TYPE | MAGIC_MIME_ENCODING."))
(def-c-const MAGIC_CONTINUE
    (:documentation "Return all matches, not just the first."))
(def-c-const MAGIC_CHECK
    (:documentation "Check the magic database for consistency, print warnings."))
(def-c-const MAGIC_PRESERVE_ATIME
    (:documentation "Attempt to preserve atime of analyzed files."))
(def-c-const MAGIC_RAW
    (:documentation "Don't translate unprintable characters."))
(def-c-const MAGIC_ERROR
    (:documentation "Treat OS errors as real erros instead of printing them."))
(def-c-const MAGIC_APPLE
    (:documentation "Return the Apple creator and type."))
(def-c-const MAGIC_EXTENSION
    (:documentation "Return list of extensions for the file type."))
(def-c-const MAGIC_COMPRESS_TRANSP
    (:documentation "Don't report about compression, only about the uncompressed data."))
;; TODO: Only on EMX? Is a feature macro needed?
(def-c-const MAGIC_NO_CHECK_APPTYPE
    (:documentation "Don't check for EMX application type (only on EMX)."))
(def-c-const MAGIC_NO_CHECK_CDF
    (:documentation "Don't get extra information on MS Composite Document Files."))
(def-c-const MAGIC_NO_CHECK_COMPRESSED
    (:documentation "Don't look inside compressed files."))
(def-c-const MAGIC_NO_CHECK_ELF
    (:documentation "Don't print ELF details."))
(def-c-const MAGIC_NO_CHECK_ENCODING
    (:documentation "Don't check text encodings."))
(def-c-const MAGIC_NO_CHECK_SOFT
    (:documentation "Don't consult magic files."))
(def-c-const MAGIC_NO_CHECK_TAR
    (:documentation "Don't examine tar files."))
(def-c-const MAGIC_NO_CHECK_TEXT
    (:documentation "Don't check for various types of text files."))
(def-c-const MAGIC_NO_CHECK_TOKENS
    (:documentation "Don't look for known tokens inside ASCII files."))


;;; Parameters for getparam and setparam
(def-c-const MAGIC_PARAM_INDIR_MAX
    (:documentation "Controls how many levels of recursion will be followed for
indirect magic entries."))
(def-c-const MAGIC_PARAM_NAME_MAX
    (:documentation "Maximum number of calls for name/use."))
(def-c-const MAGIC_PARAM_ELF_NOTES_MAX
    (:documentation "Controls how many ELF notes will be processed."))
(def-c-const MAGIC_PARAM_ELF_PHNUM_MAX
    (:documentation "Controls how many ELF program sections will be processed."))
(def-c-const MAGIC_PARAM_ELF_SHNUM_MAX
    (:documentation "Controls how many ELF sections will be processed."))
(def-c-const MAGIC_PARAM_REGEX_MAX
    (:documentation "??"))




(provide "magic")

Makefile

#CLISP_LINKKIT = $$($(CLISP) -b)/linkkit

srcdir = .
CC = gcc
CPPFLAGS =
CFLAGS = -Wall -O2
CLISP = clisp -q -norc
CLISP_LINKKIT = $(shell $(CLISP) -b)/linkkit


#srcdir = .

LN = ln
LN_S = $(LN) -s

GENERATED = magic.o magic.fas link.sh
DISTRIB = $(GENERATED) Makefile $(srcdir)/magic.lisp

distribdir =

clisp-module: $(GENERATED)

magic.c magic.fas: $(srcdir)/magic.lisp
	$(CLISP) -c $(srcdir)/magic.lisp -o ./
magic.o: magic.c
	$(CC) $(CPPFLAGS) $(CFLAGS) -I$(CLISP_LINKKIT) -c magic.c
link.sh: $(srcdir)/link.sh
	$(LN_S) $(srcdir)/link.sh .


clisp-module-distrib: clisp-module force
	$(LN) $(DISTRIBFILES) $(distribdir)



force: