/
api.lisp
123 lines (105 loc) · 4.8 KB
/
api.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
(in-package :magicffi)
(defvar *magic-database* nil
"Default magic database files. It can be NIL(default), or a
designator for a non-empty list of pathname designators. NIL means
the default database files defined by libmagic.")
(define-foreign-library libmagic
(t (:default "libmagic")))
(use-foreign-library libmagic)
(defun magic-error (magic)
"Signals an error of type MAGIC-ERROR."
(error 'magic-error
:errno (foreign-funcall "magic_errno" cmagic magic :int)
:error (foreign-funcall "magic_error" cmagic magic :string)))
(defcvar *errno* :int)
(defun magic-open (flags)
"Creates a magic cookie and returns it. An error of type
SIMPLE-ERROR is signaled on failure. FLAGS specifies how the other
magic functions should behave. See README for the flags usage."
(or (foreign-funcall "magic_open" magic-flags flags cmagic)
(error "Error(~A): ~A"
*errno*
(foreign-funcall "strerror" :int *errno* :string))))
(defun magic-close (magic)
"Closes the magic database and deallocates any resources used. It
is permissible to close an already closed magic, and has no effect.
Returns 'true' if an open magic cookie has been closed, or 'false' if
the magic cookie is already closed."
(when (open-magic-p magic)
(foreign-funcall "magic_close"
cmagic magic
:void)
(setf (%magic-cookie magic) nil)
t))
(defun %truename (filespec)
(namestring (truename filespec)))
(defun magic-file (magic pathspec)
"Returns a textual description of the contents of the PATHSPEC
argument. PATHSPEC is a pathname designator. An error of type
MAGIC-ERROR is signaled on failure."
(or (foreign-funcall "magic_file"
cmagic magic
:string (%truename pathspec)
:string)
(magic-error magic)))
(defun magic-buffer (magic string)
"Returns a textual description of the contents of the STRING argument.
An error of type MAGIC-ERROR is signaled on failure."
(let ((size (length string)))
(with-foreign-string (buffer string)
(or (foreign-funcall "magic_buffer"
cmagic magic
:pointer buffer
size size
:string)
(magic-error magic)))))
(defun magic-setflags (magic flags)
"Sets the magic flags. Signals an error of type SIMPLE-ERROR on
systems that don't support utime(2), or utimes(2) when :PRESERVE-ATIME
is set; otherwise, returns 'true'."
(or (foreign-funcall "magic_setflags"
cmagic magic
magic-flags flags
magic-boolean)
(error "~A" "Sets the :PRESERVE-ATIME flag on a system which doesn't support utime(2), or utimes(2).")))
(defun %pathname-concat (seq)
(flet ((%concat (&optional a b)
(and a b (concatenate 'string a ":" b))))
(reduce #'%concat seq :key '%truename)))
(defun %pathlist-to-cstring (pathname-list)
(typecase pathname-list
(null (null-pointer))
(atom (%truename pathname-list))
(cons (%pathname-concat pathname-list))))
(defmacro %database-funcall (name-and-options magic pathname-list)
`(or (let* ((*magic-database* (or ,pathname-list *magic-database*)))
(foreign-funcall ,name-and-options
cmagic ,magic
:string (%pathlist-to-cstring *magic-database*)
magic-boolean))
(magic-error ,magic)))
(defun magic-check (magic &optional pathname-list)
"Checks the validity of database files. PATHNAME-LIST is
NIL(default), which means use \*MAGIC-DATABASE*, or a designator for a
non-empty list of pathname designators. Returns 'true' on success and
signals an error of type MAGIC-ERROR on failure."
(%database-funcall "magic_check" magic pathname-list))
(defun magic-compile (magic &optional pathname-list)
"Compiles database files. PATHNAME-LIST is NIL(default), which
means use \*MAGIC-DATABASE*, or a designator for a non-empty list of
pathname designators. Returns 'true' on success and signals an error
of type MAGIC-ERROR on failure. The compiled files created are named
from the basename(1) of each file argument with `.mgc' appended to
it."
(%database-funcall "magic_compile" magic pathname-list))
(defun magic-load (magic &optional pathname-list)
"Loads database files. PATHNAME-LIST is NIL(default), which means
use \*MAGIC-DATABASE*, or a designator for a non-empty list of
pathname designators. Returns 'true' on success and signals an error
of type MAGIC-ERROR on failure."
(%database-funcall "magic_load" magic pathname-list))
(defmacro with-open-magic ((magic flags) &body body)
"Opens the magic cookie MAGIC, executes BODY and close MAGIC."
`(let* ((,magic (magic-open ,flags)))
(unwind-protect (progn ,@body)
(magic-close ,magic))))