diff options
| -rw-r--r-- | geoip/ip.lisp | 50 | ||||
| -rw-r--r-- | geoip/tests.lisp | 6 |
2 files changed, 36 insertions, 20 deletions
diff --git a/geoip/ip.lisp b/geoip/ip.lisp index d97f5c2..2b69233 100644 --- a/geoip/ip.lisp +++ b/geoip/ip.lisp @@ -1,9 +1,16 @@ ;;;; -*- mode: lisp -*- (defpackage :geoip - (:use :common-lisp :cffi :split-sequence)) + (:use :common-lisp :cffi :split-sequence) + (:export + :get-in :parse-ip :query-ip + :make-mmdb :close-mmdb :with-mmdb)) (in-package :geoip) +(defun get-in (data &rest keys) + "Get nested value from alist/map structure" + (reduce (lambda (acc key) (cdr (assoc key acc :test #'equal))) keys :initial-value data)) + (defun parse-ipv4 (ip-address) (reduce (lambda (acc n) (assert (<= 0 n 255)) @@ -60,20 +67,17 @@ (description nil :read-only t :type list)) -(defun get-val (alist key &key (test #'equal)) - (cdr (assoc key alist :test test))) - (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-in data :binary-format-major-version) + :binary-format-minor-version (get-in data :binary-format-minor-version) + :build-epoch (get-in data :build-epoch) + :database-type (get-in data :database-type) + :description (get-in data :description) + :ip-version (get-in data :ip-version) + :languages (get-in data :languages) + :node-count (get-in data :node-count) + :record-size (get-in data :record-size))) (defun metadata-marker-p (ptr offset) (loop for i below #.(length +metadata-marker+) @@ -207,20 +211,26 @@ 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 node-count) mmdb +(defun lookup-ip-bits (mmdb ip-bits) + (with-slots (ptr data-offset node-count) mmdb + (alexandria:when-let* ((record (record-value mmdb ip-bits)) + (offset (+ data-offset (- record node-count 16)))) (mread-data - (make-db-reader - :db-ptr (inc-pointer ptr (+ data-offset (- record node-count 16))) - :head-ptr ptr - :data-offset data-offset))))) + (make-db-reader :db-ptr (inc-pointer ptr offset) + :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))) +(defun query-ip (mmdb ip-string) + (destructuring-bind (ip-v . ip-val) (parse-ip ip-string) + (with-slots (ip-version) mmdb + (when (and (= ip-version 4) (= ip-v 6)) + (error "Can't query IPv6 address in IPv4 database")) + (lookup-ip-bits mmdb (integer-to-bits ip-val (if (= ip-version 4) 32 128)))))) + (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))) diff --git a/geoip/tests.lisp b/geoip/tests.lisp index 3aeebf7..c1d7d40 100644 --- a/geoip/tests.lisp +++ b/geoip/tests.lisp @@ -12,3 +12,9 @@ (is (= 279 (geoip::mread-unsigned r 4))) (is (equal "~ßÜ" (geoip::mread-uft8 r 5)))))) +(test selector + (let ((data '((a . b) (q . 6) (l (:p . q) (r . s))))) + (is (eq (get-in data 'a) 'b)) + (is (eq (get-in data 'q) 6)) + (is (eq (get-in data 'l 'r) 's)) + (is (eq (get-in data 'l :p) 'q)))) |