Create a gist now

Instantly share code, notes, and snippets.

What would you like to do?
file(1) wrapper, for newLISP
;; @module libmagic.lsp
;; @description determine file type (use magic library)
;; @author KOBAYASHI Shigeru (kosh) <>
;; @version 0.2
;;; Usage:
;; (load "libmagic.lsp")
;; (Magic:magic-file "libmagic.lsp")
;; => "Lisp/Scheme program text"
;; (Magic:magic-file Magic:libmagic)
;; => "PE32 executable for MS Windows (DLL) (console) Intel 80386 32-bit"
;; (Magic:magic-file Magic:magic-database)
;; => "magic binary file for file(1) cmd (version 7) (little endian)"
;; (Magic:magic-file Magic:magic-database true)
;; => "application/octet-stream; charset=binary"
;; (Magic:magic-buffer (read-file "/usr/bin/newlispdoc"))
;; => "a /usr/bin/newlisp script text executable"
;;; ChangeLog:
;; 2010-01-09 初版
;; 2010-04-07 ファイルが存在しない場合はnewLISP側がエラーを投げるように変更
;;; Code:
(context 'Magic)
;;; NOTE: File for Windows -
(case ostype
(define libmagic "C:/Program Files/GnuWin32/bin/magic1.dll")
(define magic-database "C:/Program Files/GnuWin32/share/misc/magic.mgc")
;; `file' requires `regex' (and `zlib')
(define libregex "C:/Program Files/GnuWin32/bin/regex2.dll")
(import libregex "regcomp")
(import libregex "regexec")
(import libregex "regerror")
(import libregex "regfree")
(define libmagic "")
(define magic-database "/usr/share/file/magic.mgc") ; or "/etc/magic"
(import libmagic "magic_open")
(import libmagic "magic_close")
(import libmagic "magic_file")
(import libmagic "magic_descriptor")
(import libmagic "magic_buffer")
(import libmagic "magic_error")
(import libmagic "magic_setflags")
(import libmagic "magic_load")
(import libmagic "magic_compile")
(import libmagic "magic_check")
(import libmagic "magic_errno")
(define MAGIC_NONE 0x000000)
(define MAGIC_DEBUG 0x000001)
(define MAGIC_SYMLINK 0x000002)
(define MAGIC_COMPRESS 0x000004)
(define MAGIC_DEVICES 0x000008)
(define MAGIC_MIME_TYPE 0x000010)
(define MAGIC_CONTINUE 0x000020)
(define MAGIC_CHECK 0x000040)
(define MAGIC_PRESERVE_ATIME 0x000080)
(define MAGIC_RAW 0x000100)
(define MAGIC_ERROR 0x000200)
(define MAGIC_MIME_ENCODING 0x000400)
(define MAGIC_APPLE 0x000800)
(define MAGIC_NO_CHECK_COMPRESS 0x001000)
(define MAGIC_NO_CHECK_TAR 0x002000)
(define MAGIC_NO_CHECK_SOFT 0x004000)
(define MAGIC_NO_CHECK_APPTYPE 0x008000)
(define MAGIC_NO_CHECK_ELF 0x010000)
(define MAGIC_NO_CHECK_TEXT 0x020000)
(define MAGIC_NO_CHECK_CDF 0x040000)
(define MAGIC_NO_CHECK_TOKENS 0x100000)
(define MAGIC_NO_CHECK_ENCODING 0x200000)
(define MAGIC_NO_CHECK_FORTRAN 0x000000)
(define MAGIC_NO_CHECK_TROFF 0x000000)
(define NULL 0x00)
(setf magic-flags MAGIC_NONE)
(define (error )
(throw-error (apply format (args))))
(letex ((result (sym (uuid))))
(define-macro (unwind-protect )
(local (result)
(if (catch (eval (args 0)) 'result)
(begin (map eval (1 (args))) result)
(begin (map eval (1 (args))) (throw-error (5 result))))))
(define (call-with-magic proc)
(unless (lambda? proc)
(error "function required: %s" (string proc)))
(let ((cookie (magic_open (or magic-flags MAGIC_NONE))))
(if (= cookie NULL)
(error "magic_open: %s" (nth 1 (sys-error)))
(if (= (magic_load cookie magic-database) -1)
(error "magic_load: %s" (get-string (magic_error cookie)))
(let ((addr (proc cookie)))
(if (= addr NULL)
(error "magic_file: %s" (get-string (magic_error cookie)))
(get-string addr))))
(if (!= cookie NULL)
(magic_close cookie))))))
(define (magic-file filename (mime nil))
;(setq filename (real-path filename))
(unless (file? filename)
(error "cannot open `%s' (No such file or directory)" filename))
(let ((magic-flags (| (if mime MAGIC_MIME 0)
(or magic-flags 0))))
(call-with-magic (lambda (c)
(magic_file c filename)))))
(define (magic-buffer str (mime nil))
(let ((magic-flags (| (if mime MAGIC_MIME 0)
(or magic-flags 0))))
(call-with-magic (lambda (c)
(magic_buffer c str (length str))))))
(context MAIN)
;;; EOF
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment