diff options
Diffstat (limited to 'geoip')
| -rw-r--r-- | geoip/ip.lisp | 53 |
1 files changed, 48 insertions, 5 deletions
diff --git a/geoip/ip.lisp b/geoip/ip.lisp index 8db396d..63c373f 100644 --- a/geoip/ip.lisp +++ b/geoip/ip.lisp @@ -134,13 +134,15 @@ (prog1 (foreign-string-to-lisp db-ptr :count length :encoding :utf-8) (incf-pointer db-ptr length)))) +(defmacro mem-uint (ptr size) + `(let ((r 0)) + (dotimes (i ,size r) + (setf r (+ (ash r 8) (mem-ref ,ptr :uint8 i)))))) + (defun mread-unsigned (reader size) (with-slots (db-ptr) reader - (let ((r 0)) - (dotimes (i size) - (setf r (+ (ash r 8) (mem-ref db-ptr :uint8 i)))) - (incf-pointer db-ptr size) - r))) + (prog1 (mem-uint db-ptr size) + (incf-pointer db-ptr size)))) (defun mread-int32 (db-ptr length) (let ((uval (mread-unsigned db-ptr length))) @@ -197,6 +199,47 @@ (14 (< 0 length)) ; bool ))) +(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))))))) + +(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)))) + +(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))))))))) + +(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")) |