diff options
Diffstat (limited to 'geoip')
| -rw-r--r-- | geoip/ip.lisp | 126 |
1 files changed, 63 insertions, 63 deletions
diff --git a/geoip/ip.lisp b/geoip/ip.lisp index 7098c94..c7b8a77 100644 --- a/geoip/ip.lisp +++ b/geoip/ip.lisp @@ -51,12 +51,15 @@ (defstruct maxmind-database + (filename nil :read-only t) (ptr nil :read-only t) (fd nil :read-only t) - (filename nil :read-only t) (size 0 :read-only t) - (metadata nil) - (data-offset -1 :type fixnum)) + (node-count 0 :read-only t :type fixnum) + (record-size 0 :read-only t :type fixnum) + (ip-version 0 :read-only t :type fixnum) + (data-offset -1 :type fixnum) + (metadata nil)) (defstruct db-reader (db-ptr) @@ -80,15 +83,15 @@ (defun make-metadata (data) (make-maxmind-database-metadata - :binary-format-major-version (get-val data "binary-format-major-version") - :binary-format-minor-version (get-val data "binary-format-minor-version") - :build-epoch (get-val data "build-epoch") - :database-type (get-val data "database-type") - :description (get-val data "description") - :ip-version (get-val data "ip-version") - :languages (get-val data "languages") - :node-count (get-val data "node-count") - :record-size (get-val data "record-size"))) + :binary-format-major-version (get-val data :binary-format-major-version) + :binary-format-minor-version (get-val data :binary-format-minor-version) + :build-epoch (get-val data :build-epoch) + :database-type (get-val data :database-type) + :description (get-val data :description) + :ip-version (get-val data :ip-version) + :languages (get-val data :languages) + :node-count (get-val data :node-count) + :record-size (get-val data :record-size))) (defun metadata-marker-p (ptr offset) (loop for i below #.(length *metadata-marker*) @@ -101,21 +104,6 @@ when (metadata-marker-p ptr offset) return (+ offset #.(length *metadata-marker*)))) -(defun mmap->mmdb (file ptr fd size) - (let* ((metadata-start (find-metadata-start ptr size)) - (db-reader (make-db-reader :db-ptr (inc-pointer ptr metadata-start))) - (metadata (make-metadata (mread-data db-reader)))) - (with-slots (record-size node-count) metadata - (make-maxmind-database - :ptr ptr :fd fd :filename file :size size - :metadata metadata - ;; :data-offset (+ 16 (* (/ (* 2 record-size) 8) node-count)) - :data-offset (+ 16 (/ (* record-size node-count) 4)))))) - -(defun make-mmdb (file) - (multiple-value-bind (ptr fd size) (mmap:mmap file) - (mmap->mmdb file ptr fd size))) - (defun read-db-char (reader) (with-slots (db-ptr) reader (prog1 (mem-ref db-ptr :uchar) @@ -167,12 +155,11 @@ (length (ldb (byte 5 0) control-byte))) (when (zerop type) (setf type (+ 7 (read-db-char db-ptr)))) + (when (= type 1) + (incf-pointer (db-reader-db-ptr db-ptr) -1)) (list type (cond - ((= type 1) - (incf-pointer (db-reader-db-ptr db-ptr) -1) - (+ 2 (ash length -3))) - ((< length 29) + ((or (= type 1) (< length 29)) length) ((= length 29) (+ 29 (read-db-char db-ptr))) @@ -228,49 +215,62 @@ (defun read-node-record (mmdb node-number bit) "Read left (bit=0) or right (bit=1) record from node" - (with-slots (ptr metadata) mmdb - (with-slots (record-size) metadata - (let* ((node-bytes (/ record-size 4)) - (record-bytes (floor record-size 8)) - (node-offset (* node-bytes node-number))) - (if (evenp node-bytes) - ;; Simple case: records align to byte boundaries - (mem-uint (inc-pointer ptr (+ node-offset (* bit record-bytes))) record-bytes) - ;; Complex case: records share a byte - (let* ((base-value (mem-uint (inc-pointer ptr (+ node-offset (* bit (1+ record-bytes)))) record-bytes)) - (shared-byte (mem-ref (inc-pointer ptr (+ node-offset record-bytes)) :uchar)) - (high-bits (if (zerop bit) (ash shared-byte -4) (logand shared-byte #xf)))) - (+ (ash high-bits (* record-bytes 8)) base-value))))))) + (with-slots (ptr record-size) mmdb + (let* ((node-bytes (/ record-size 4)) + (record-bytes (floor record-size 8)) + (node-offset (* node-bytes node-number))) + (if (evenp node-bytes) + ;; Simple case: records align to byte boundaries + (mem-uint (inc-pointer ptr (+ node-offset (* bit record-bytes))) record-bytes) + ;; Complex case: records share a byte + (let* ((base-value (mem-uint (inc-pointer ptr (+ node-offset (* bit (1+ record-bytes)))) record-bytes)) + (shared-byte (mem-ref (inc-pointer ptr (+ node-offset record-bytes)) :uchar)) + (high-bits (if (zerop bit) (ash shared-byte -4) (logand shared-byte #xf)))) + (+ (ash high-bits (* record-bytes 8)) base-value)))))) (defun record-value (mmdb ip-bits) - (with-slots (metadata) mmdb - (with-slots (node-count) metadata - (loop with node = 0 - for bit in ip-bits - for next-node = (read-node-record mmdb node bit) - do (setf node next-node) - when (= node node-count) - return nil - when (> node node-count) - return node)))) + (with-slots (node-count) mmdb + (loop with node = 0 + for bit in ip-bits + for next-node = (read-node-record mmdb node bit) + do (setf node next-node) + when (= node node-count) + return nil + when (> node node-count) + return node))) (defun lookup-ip (mmdb ip-bits) (alexandria:when-let ((record (record-value mmdb ip-bits))) - (with-slots (ptr data-offset metadata) mmdb - (with-slots (node-count) metadata - (mread-data - (make-db-reader - :db-ptr (inc-pointer ptr (+ data-offset (- record node-count 16))) - :head-ptr ptr - :data-offset data-offset)))))) + (with-slots (ptr data-offset node-count) mmdb + (mread-data + (make-db-reader + :db-ptr (inc-pointer ptr (+ data-offset (- record node-count 16))) + :head-ptr ptr + :data-offset data-offset))))) (defun integer-to-bits (n bit-count) "Convert integer to list of bits (MSB first)" (loop for i from (1- bit-count) downto 0 collect (if (logbitp i n) 1 0))) -(defvar *refdb* - (cl-maxminddb:make-mmdb "GeoLite2-Country.mmdb")) +(defun mmap->mmdb (file ptr fd size) + (let* ((metadata-start (find-metadata-start ptr size)) + (db-reader (make-db-reader :db-ptr (inc-pointer ptr metadata-start))) + (metadata (make-metadata (mread-data db-reader)))) + (with-slots (record-size node-count ip-version) metadata + (make-maxmind-database + :filename file + :ptr ptr :fd fd :size size + :metadata metadata + :node-count node-count + :record-size record-size + :ip-version ip-version + ;; :data-offset (+ 16 (* (/ (* 2 record-size) 8) node-count)) + :data-offset (+ 16 (/ (* record-size node-count) 4)))))) + +(defun make-mmdb (file) + (multiple-value-bind (ptr fd size) (mmap:mmap file) + (mmap->mmdb file ptr fd size))) (defvar *mmdb* (make-mmdb "GeoLite2-Country.mmdb")) |