diff options
Diffstat (limited to 'geoip')
| -rw-r--r-- | geoip/ip.lisp | 103 |
1 files changed, 54 insertions, 49 deletions
diff --git a/geoip/ip.lisp b/geoip/ip.lisp index ef18fce..5190143 100644 --- a/geoip/ip.lisp +++ b/geoip/ip.lisp @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- -(ql:quickload '(cffi cffi-libffi split-sequence mmap ironclad babel nibbles fiveam)) +(ql:quickload '(cffi cffi-libffi split-sequence mmap ironclad babel nibbles fiveam local-time)) (defpackage :geoip (:use :common-lisp :cffi :split-sequence)) @@ -49,26 +49,44 @@ #(#xab #xcd #xef) (map 'vector #'char-code "MaxMind.com"))) + +(defstruct maxmind-database + (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)) + +(defstruct db-reader + (db-ptr)) + (defstruct maxmind-database-metadata (node-count 0 :read-only t :type fixnum) (record-size 0 :read-only t :type fixnum) (ip-version 0 :read-only t :type fixnum) (database-type nil :read-only t :type string) - (languages nil :read-only t :type vector) + (languages nil :read-only t :type list) (binary-format-major-version 0 :read-only t :type fixnum) (binary-format-minor-version 0 :read-only t :type fixnum) (build-epoch 0 :read-only t :type fixnum) (description nil :read-only t :type list)) -(defstruct maxmind-database - (ptr nil :read-only t) - (filename nil :read-only t) - (size 0 :read-only t) - (metadata nil) - (data-offset -1 :type fixnum)) -(defstruct db-reader - (db-ptr)) +(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"))) (defun metadata-marker-p (ptr offset) (loop for i below #.(length *metadata-marker*) @@ -76,32 +94,24 @@ (svref *metadata-marker* i)))) (defun find-metadata-start (ptr size) - (loop for offset from (- size 1 14) downto (- size 1 (* 128 1024)) + (loop for offset from (- size 1 #.(length *metadata-marker*)) + downto (- size 1 (* 128 1024)) when (metadata-marker-p ptr offset) - return (+ offset (length *metadata-marker*)))) - -(defun mmap->mmdb (ptr file size) - (bind ((mmdb (make-maxmind-database :ptr ptr :filename file :size size)) - (metadata-start (find-metadata-start ptr size))) - (setf (maxmind-database-data-offset mmdb) metadata-start) - (bind ((metadata (read-metadata mmdb metadata-start)) - ((:structure maxmind-database-metadata- record-size node-count) metadata) - (data-offset (+ 16 (* (/ (* 2 record-size) 8) node-count)))) - (setf (maxmind-database-metadata mmdb) metadata) - (setf (maxmind-database-data-offset mmdb) data-offset)) - mmdb)) + 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)))))) (defun make-mmdb (file) - (multiple-value-bind (ptr fd size) (mmap file) - (declare (ignore fd)) - (mmap->mmdb ptr file size))) - -(defvar *mmdb* - (multiple-value-bind (ptr fd size) (mmap:mmap "GeoLite2-Country.mmdb") - (cons ptr size))) - -(find-metadata-start (car *mmdb*) (cdr *mmdb*)) -;; metaof 7786987 + (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 @@ -114,13 +124,11 @@ do (setf (aref bytes i) (read-db-char db-ptr))) bytes)) -(defun mread-raw-unsigned (ptr size &key (big-endian t)) +(defun mread-unsigned (ptr size &key (big-endian t)) (octet-to-int (bytes-from-foreign ptr size) :big-endian big-endian)) -(mread-raw-unsigned *reader* 2) - (defun mread-datafield-metadata (db-ptr) (let* ((control-byte (read-db-char db-ptr)) (type (ldb (byte 3 5) control-byte)) @@ -134,10 +142,9 @@ ((= length 29) (+ 29 (read-uchar db-ptr))) ((= length 30) - (+ 285 (mread-raw-unsigned db-ptr 2))) + (+ 285 (mread-unsigned db-ptr 2))) ((= length 31) - (+ 65821 (mread-raw-unsigned db-ptr 3))))) - (list type length))) + (+ 65821 (mread-unsigned db-ptr 3))))))) (defun mread-uft8 (db-ptr length) (babel:octets-to-string @@ -148,7 +155,7 @@ (loop repeat length collect (cons - (mread-data db-ptr) + (substitute #\- #\_ (mread-data db-ptr)) (mread-data db-ptr)))) (defun mread-list (db-ptr length) @@ -158,18 +165,16 @@ (destructuring-bind (type length) (mread-datafield-metadata db-ptr) (ecase type (2 (mread-uft8 db-ptr length)) - ((5 6 9 10) (mread-raw-unsigned db-ptr length)) + ((5 6 9 10) (mread-unsigned db-ptr length)) (7 (mread-map db-ptr length)) (11 (mread-list db-ptr length))))) -(mem-ref (car *mmdb*) :uchar 7786987) -(mem-ref (inc-pointer (car *mmdb*) 7786987) :uchar ) -(defvar *reader* - (make-db-reader :db-ptr (inc-pointer (car *mmdb*) 7786987))) -(setf (db-reader-db-ptr *reader*) (inc-pointer (car *mmdb*) 7786987)) -(mread-datafield-metadata *reader*) -(mread-data *reader*) - (defvar *refdb* (cl-maxminddb:make-mmdb "GeoLite2-Country.mmdb")) +(defvar *mmdb* (make-mmdb "GeoLite2-Country.mmdb")) + +(with-slots (metadata) *mmdb* + (with-slots (build-epoch) metadata + (local-time:unix-to-timestamp + build-epoch))) |