From 00d94fe38bf6df6d666d700f25550a5fe78968bf Mon Sep 17 00:00:00 2001
From: Oscar Najera <hi@oscarnajera.com>
Date: Fri, 6 Jun 2025 13:56:02 +0200
Subject: read node

---
 geoip/ip.lisp | 53 ++++++++++++++++++++++++++++++++++++++++++++++++-----
 1 file changed, 48 insertions(+), 5 deletions(-)

(limited to 'geoip/ip.lisp')

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"))
 
-- 
cgit v1.2.3