Created
January 9, 2010 12:45
-
-
Save kosh04/272876 to your computer and use it in GitHub Desktop.
file(1) wrapper, for newLISP
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
;; @module libmagic.lsp | |
;; @description determine file type (use magic library) | |
;; @author KOBAYASHI Shigeru (kosh) <shigeru.kb@gmail.com> | |
;; @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 - http://gnuwin32.sourceforge.net/packages/file.htm | |
(case ostype | |
("Win32" | |
(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") | |
) | |
(true | |
(define libmagic "libmagic.so.1") | |
(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_MIME (| MAGIC_MIME_TYPE MAGIC_MIME_ENCODING)) | |
(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_ASCII MAGIC_NO_CHECK_TEXT) | |
(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))) | |
(unwind-protect | |
(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)))))) | |
;;;###autoload | |
(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))))) | |
;;;###autoload | |
(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